Aufnahme aller Quelltexte in CVS

This is a legacy commit from before 2015-03-01.
It may be incomplete as well as inconsistent.
See COPYING.legacy and README.history for details.


SVN Path:     http://gpitrsvn.gpi.uni-karlsruhe.de/repos/TFSoftware/trunk
SVN Revision: 2
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c

src/COPYING.legacy

+This is a legacy version of the repository. It may be incomplete as well as
+inconsistent. See README.history for details. For the old stock of the
+repository copyright and licence conditions apply as specified for versions
+commited after 2015-03-01. Use recent versions as a base for new development.
+The legacy version is only stored to keep a record of history.

src/conv/COPYING.legacy

+This is a legacy version of the repository. It may be incomplete as well as
+inconsistent. See README.history for details. For the old stock of the
+repository copyright and licence conditions apply as specified for versions
+commited after 2015-03-01. Use recent versions as a base for new development.
+The legacy version is only stored to keep a record of history.

src/green/COPYING.legacy

+This is a legacy version of the repository. It may be incomplete as well as
+inconsistent. See README.history for details. For the old stock of the
+repository copyright and licence conditions apply as specified for versions
+commited after 2015-03-01. Use recent versions as a base for new development.
+The legacy version is only stored to keep a record of history.

src/green/disan/COPYING.legacy

+This is a legacy version of the repository. It may be incomplete as well as
+inconsistent. See README.history for details. For the old stock of the
+repository copyright and licence conditions apply as specified for versions
+commited after 2015-03-01. Use recent versions as a base for new development.
+The legacy version is only stored to keep a record of history.

src/green/disan/greda.inc

+c this is <greda.inc>
+c------------------------------------------------------------------------------
+c
+c 23/10/97 by Thomas Forbriger (IfG Stuttgart)
+c
+c This file contains the matrix inversion common block for greda.f
+c
+c REVISIONS and CHANGES
+c    23/10/97   V1.0   Thomas Forbriger
+c
+c==============================================================================
+c
+c number of linear equations (=number of stations)
+      integer ntr
+c some other dimensions
+      integer nslo, nsamp, nom
+c
+c maximum number of linear equations (=number of stations)
+      integer maxtr
+      parameter(maxtr=250)
+c other dimension limits
+      integer maxsamp, maxslo, maxom
+c      parameter(maxom=2100,maxslo=5*maxtr,maxsamp=maxom*2+1)
+      parameter(maxom=2100,maxslo=2*maxtr,maxsamp=maxom*2+1)
+c
+c gram matrix
+      double precision gram(maxtr, maxtr)
+c
+c expansion coefficients to hilbert space representers
+      double complex alpha(maxsamp)
+c
+c complex seismogram spectra
+      double complex spectra(maxtr, maxsamp)
+c
+c common blocks
+      common /hilbert/alpha, gram
+      common /seismo/spectra, nsamp, nom, ntr, nslo
+c
+c ----- END OF greda.inc -----

src/green/gremlin1/COPYING.legacy

+This is a legacy version of the repository. It may be incomplete as well as
+inconsistent. See README.history for details. For the old stock of the
+repository copyright and licence conditions apply as specified for versions
+commited after 2015-03-01. Use recent versions as a base for new development.
+The legacy version is only stored to keep a record of history.

src/green/gremlin1/Makefile

+#
+# Makefile for prog/invers
+#
+
+LINLIB=-llapex -lblasex
+# LINLIB=-lf2cimslmath
+BUGGY=
+F2CLIB=-lf2c -lm -L${SERVERLIBDIR}
+F2CFLAGS=-f -u
+PGPLOTLIB=-lf2cpgplot52 -lX11 -L/usr/X11/lib
+PGPLOTLIB77=-lpgplot52 -lX11 -L/usr/X11/lib -L${SERVERLIBDIR}
+CC=gcc
+CFLAGS=-O2 -I${SERVERINCLUDEDIR} -I${LOCINCLUDEDIR} 
+GFLAG=
+
+.f.o:
+	f2c $(F2CFLAGS) $<
+	$(CC) $(CFLAGS) $(<:.f=.c) -c 
+	@rm  $(<:.f=.c)
+
+%.o77: %.f
+	g77 -O2 -o $@ -c $< -Wall -ffixed-line-length-0 -fno-backslash
+
+clean:
+	-/bin/rm *.o *.bak
+
+make.incdep: *.f
+	incdep > make.incdep
+-include make.incdep
+
+all:
+	(cd libs; make libs)
+	make allhere
+
+allhere: gremlin mocon pmotra mop mops splimo clemo gredim dig
+
+flow:
+	flow -f -R gremlin.f gremlin_help.f libs/*.f
+
+allgremlin:
+	(cd libs; make libgin.a)
+	make gremlin
+
+gredaimsl: greda.o
+	gcc -o greda greda.o -lts -ltf -lf2cimslmath \
+        -lnumrec -ltime -lf2cstuff $(F2CLIB)\
+        -L$(LOCLIBDIR) -L$(SERVERLIBDIR)
+	newprog greda
+
+greda: greda.o greda.inc
+	gcc -o greda greda.o -lts -ltf -llapex -lblasex \
+        -lnumrec -ltime -lf2cstuff $(F2CLIB)\
+        -L$(LOCLIBDIR) -L$(SERVERLIBDIR)
+	newprog greda
+
+grempol: $(POLGREMOBS) gremlin.o gremlinold.o 
+	gcc -o grempol $(POLGREMOBS) \
+        gremlinold.o gremlin.o -lpolrefsub -lrefread \
+        $(LINLIB) -ltf $(PGPLOTLIB) \
+        $(BUGGY) $(F2CLIB) -L$(LOCLIBDIR)
+	newprog grempol
+
+pmotra: pmotra.o
+	gcc -o pmotra pmotra.o \
+        -lgin -lgrrefsub -lrefread \
+        $(LINLIB) -ltf $(PGPLOTLIB) \
+        $(BUGGY) $(F2CLIB) -L$(LOCLIBDIR)
+	newprog pmotra
+
+# the same rule to be used on old systems
+goldsys: gremlin.o gremlin_help.o
+	gcc -o $@ $^ \
+        -lgin \
+        -lgrrefsub -lrefread \
+        $(LINLIB) -ltf $(PGPLOTLIB) \
+        $(BUGGY) $(F2CLIB) -L$(LOCLIBDIR)
+	newprog $@
+
+gremlin: gremlin.o gremlin_help.o
+	gcc -o gremlin $^ \
+        -lgin \
+        -lgrrefsub -lrefread \
+        $(LINLIB) -ltf $(PGPLOTLIB) \
+        $(BUGGY) $(F2CLIB) -L$(LOCLIBDIR)
+	newprog gremlin
+
+# version using wang code
+wgremlin: gremlin.o gremlin_help.o
+	gcc -o $@ $^ \
+        -lgin \
+        -lwrefsub -lrefread \
+        $(LINLIB) -ltf $(PGPLOTLIB) \
+        $(BUGGY) $(F2CLIB) -L$(LOCLIBDIR)
+	newprog $@
+
+mocon: mocon.o 
+	gcc -o mocon mocon.o -lginmod \
+        -L$(LOCLIBDIR) -lrefread -ltf $(F2CLIB)
+	newprog mocon
+
+gredim: gredim.o
+	gcc -o gredim gredim.o $(GFLAG) $(F2CLIB)
+
+mop77: mop.o77
+	g77 -o $@ mop.o77 -lgin \
+        -ltf77 $(PGPLOTLIB77) \
+        -L$(LOCLIBDIR)
+	strip -v --strip-all $@
+	newprog $@
+
+mop: mop.o 
+	gcc -o mop mop.o -lgin \
+        -llapex -lblasex -lgrrefsub -lrefread \
+        -ltf $(PGPLOTLIB) \
+        $(F2CLIB) -L$(LOCLIBDIR)
+	strip -v --strip-all mop
+	newprog mop
+
+mops: mops.o 
+	gcc -o mops mops.o -lginmod -ltf \
+        $(F2CLIB) -L$(LOCLIBDIR)
+	newprog mops
+
+splimo: splimo.o 
+	gcc -o $(LOCBINDIR)/splimo splimo.o -lginmod -ltf \
+        $(F2CLIB) -L$(LOCLIBDIR)
+
+clemo: clemo.o 
+	gcc -o clemo clemo.o -lgin -ltf \
+        $(F2CLIB) -L$(LOCLIBDIR)
+	newprog clemo
+
+magres: magres.o 
+	gcc -o $@ $< -ltf \
+        $(F2CLIB) -L$(LOCLIBDIR)
+	newprog $@
+
+dig: dig.o 
+	gcc -o dig dig.o -ltf \
+        $(F2CLIB) -L$(LOCLIBDIR)
+	newprog dig
+
+moval: moval.o 
+	gcc -o $@ $< -lginmod -ltf \
+        $(F2CLIB) -L$(LOCLIBDIR)
+	newprog $@
+

src/green/gremlin1/gredim.f

+c this is <gredim.f>
+c------------------------------------------------------------------------------
+c
+c 12/12/97 by Thomas Forbriger (IfG Stuttgart)
+c
+c give me an idea on how large my program may become
+c
+c REVISIONS and CHANGES
+c    12/12/97   V1.0   Thomas Forbriger
+c    19/12/97   V1.1   double complex version
+c    25/03/98   V1.2   take dat_response into account
+c
+c==============================================================================
+c
+      program gredim
+c
+      character*79 version
+      parameter(version='GREDIM   V1.2   GREmlin DIMensions')
+c 
+      include 'libs/glq_dim.inc'
+c 
+      character*80 line
+      integer summe, dcsumme
+      common /forall/ summe, dcsumme
+c
+c
+c------------------------------------------------------------------------------
+c basic information
+c
+      print *,version
+      print *,' '
+c
+c
+c------------------------------------------------------------------------------
+c go
+      open(10, file='glq_dim.inc', err=99)
+      do while (.true.)
+        read(10, '(a80)', end=1, err=98) line
+        if (line(1:7).eq.'c glqm_') print 50,line(2:80)
+        if (line(1:7).eq.'c glqd_') print 50,line(2:80)
+      enddo
+    1 close(10, err=97)
+      print *,' '
+c 
+      summe=0
+      dcsumme=0
+c 
+      print 51,'glqm_msec', glqm_msec
+      print 51,'glqm_mpol', glqm_mpol
+      print 51,'glqm_mpar', glqm_mpar
+      print 51,'glqm_mmod', glqm_mmod
+      print 51,'glqm_cpar', glqm_cpar
+      print 51,'glqm_mlay', glqm_mlay
+      print 51,'glqm_mano', glqm_mano
+      print 51,'glqd_mslo', glqd_mslo
+      print 51,'glqd_mfre', glqd_mfre
+      print 51,'glqd_mtts', glqd_mtts
+      print 51,'glqd_mdat', glqd_mdat
+      print 51,'glqd_mano', glqd_mano
+      print *,' '
+      print 50,'data:'
+      call sar('dat_slo',glqd_mslo)
+      call sar('dat_fre',glqd_mfre)
+      call sar('dat_om',glqd_mfre)
+      call dctar('green',glqd_mslo,glqd_mfre,glqd_mdat)
+      call cdar('readgreen',glqd_mslo,glqd_mfre)
+      call sar('travx',glqd_mtts)
+      call dar('travt',glqd_mtts,glqd_mdat)
+      call dar('rgweight',glqd_mslo,glqd_mfre)
+      call dar('gweight',glqd_mslo,glqd_mfre)
+      call sar('rtweight',glqd_mtts)
+      call sar('tweight',glqd_mtts)
+      call car('dat_response',glqd_mfre)
+      print *,' '
+      print 50,'models:'
+      call dar('glqm_npol',glqm_msec,glqm_mpar)
+      call qar('model',glqm_mpol,glqm_msec,glqm_mpar,glqm_mmod)
+      call dar('mdepth',glqm_msec,glqm_mmod)
+      call sar('destim',glqm_msec)
+      call dar('mestim',glqm_msec,glqm_mpar)
+      call sar('mdelta',glqm_mano)
+      call sar('mweight',glqm_mano)
+      call dar('dmodel',glqm_mlay,glqm_cpar)
+      print *,' '
+      print 50,'inversion workspace:'
+      call dcdar('lq_d',glqd_mano,glqm_mano)
+      call dcdar('lq_dss',glqd_mano,glqm_mano)
+      call dcdar('lq_dssd',glqm_mano,glqm_mano)
+      call dcsar('lq_dssdelta',glqm_mano)
+      call dcsar('lq_mestim',glqm_mano)
+      call dcdar('lq_dssd_nuww',glqm_mano,glqm_mano)
+      print *,' '
+      print 52,'sum:',summe,dcsumme
+c
+      stop
+   50 format(a)
+   51 format(a15,':',i10)
+   52 format(a15,t42,i11,t55,i11)
+   99 stop 'ERROR: opening glq_dim.inc'
+   98 stop 'ERROR: reading glq_dim.inc'
+   97 stop 'ERROR: closing glq_dim.inc'
+      end
+c 
+c----------------------------------------------------------------------
+c 
+      subroutine car(c,d1)
+      integer summe, dcsumme
+      common /forall/ summe, dcsumme
+      character c*(*)
+      integer d1
+      print 50, c, d1, d1*8
+      summe=summe+d1*8
+      return
+   50 format(a15,'(',i5,')',t42,':',i10)
+      end
+c 
+c----------------------------------------------------------------------
+c 
+      subroutine sar(c,d1)
+      integer summe, dcsumme
+      common /forall/ summe, dcsumme
+      character c*(*)
+      integer d1
+      print 50, c, d1, d1*4
+      summe=summe+d1*4
+      return
+   50 format(a15,'(',i5,')',t42,':',i10)
+      end
+c 
+c----------------------------------------------------------------------
+c 
+      subroutine dar(c,d1,d2)
+      integer summe, dcsumme
+      common /forall/ summe, dcsumme
+      character c*(*)
+      integer d1,d2
+      print 50, c, d1, d2, d2*d1*4
+      summe=summe+d1*4*d2
+      return
+   50 format(a15,'(',i5,',',i5,')',t42,':',i10)
+      end
+c 
+c----------------------------------------------------------------------
+c 
+      subroutine qar(c,d1,d2,d3,d4)
+      integer summe, dcsumme
+      common /forall/ summe, dcsumme
+      character c*(*)
+      integer d1,d2,d3,d4
+      print 50, c, d1, d2, d3, d4, d3*d2*d1*4*d4
+      summe=summe+d1*4*d2*d3*d4
+      return
+   50 format(a15,'(',i5,3(',',i5),')',t42,':',i10)
+      end
+c 
+c----------------------------------------------------------------------
+c 
+      subroutine csar(c,d1)
+      integer summe, dcsumme
+      common /forall/ summe, dcsumme
+      character c*(*)
+      integer d1
+      print 50, c, d1, d1*8
+      summe=summe+d1*8
+      return
+   50 format(a15,'(',i5,')',t42,':',i10)
+      end
+c 
+c----------------------------------------------------------------------
+c 
+      subroutine cdar(c,d1,d2)
+      integer summe, dcsumme
+      common /forall/ summe, dcsumme
+      character c*(*)
+      integer d1,d2
+      print 50, c, d1, d2, d2*d1*8
+      summe=summe+d1*8*d2
+      return
+   50 format(a15,'(',i5,',',i5,')',t42,':',i10)
+      end
+c 
+c----------------------------------------------------------------------
+c 
+      subroutine ctar(c,d1,d2,d3)
+      integer summe, dcsumme
+      common /forall/ summe, dcsumme
+      character c*(*)
+      integer d1,d2,d3
+      print 50, c, d1, d2, d3, d2*d1*8*d3
+      summe=summe+d1*8*d2*d3
+      return
+   50 format(a15,'(',i5,2(',',i5),')',t42,':',i10)
+      end
+c
+c----------------------------------------------------------------------
+c 
+      subroutine dcsar(c,d1)
+      integer summe, dcsumme
+      common /forall/ summe, dcsumme
+      character c*(*)
+      integer d1
+      print 50, c, d1, d1*8, d1*16
+      summe=summe+d1*8
+      dcsumme=dcsumme+d1*16
+      return
+   50 format(a15,'(',i5,')',t42,':',i10,t56,i10)
+      end
+c 
+c----------------------------------------------------------------------
+c 
+      subroutine dcdar(c,d1,d2)
+      integer summe, dcsumme
+      common /forall/ summe, dcsumme
+      character c*(*)
+      integer d1,d2
+      print 50, c, d1, d2, d2*d1*8, d2*d1*16
+      summe=summe+d1*8*d2
+      dcsumme=dcsumme+d1*16*d2
+      return
+   50 format(a15,'(',i5,',',i5,')',t42,':',i10,t56,i10)
+      end
+c 
+c----------------------------------------------------------------------
+c 
+      subroutine dctar(c,d1,d2,d3)
+      integer summe, dcsumme
+      common /forall/ summe, dcsumme
+      character c*(*)
+      integer d1,d2,d3
+      print 50, c, d1, d2, d3, d2*d1*8*d3, d2*d1*16*d3
+      summe=summe+d1*8*d2*d3
+      dcsumme=dcsumme+d1*16*d2*d3
+      return
+   50 format(a15,'(',i5,2(',',i5),')',t42,':',i10,t56,i10)
+      end
+c
+c ----- END OF gredim.f -----

src/green/gremlin1/gremlin.inc

+c this is <gremlin.inc>
+c------------------------------------------------------------------------------
+c
+c 05/12/97 by Thomas Forbriger (IfG Stuttgart)
+c
+c this file will be used by gremlin.f to define global data space
+c
+c REVISIONS and CHANGES
+c    05/12/97   V1.0   Thomas Forbriger
+c    10/12/97   V1.1   use direct access to common blocks
+c
+c==============================================================================
+c
+c plotting
+      character*80 device
+      logical doask
+      common /plots/device,doask
+c
+c ----- END OF gremlin.inc -----

src/green/gremlin1/gremlin_help.f

+c this is <gremlin_help.f>
+c------------------------------------------------------------------------------
+c
+c 25/03/98 by Thomas Forbriger (IfG Stuttgart)
+c
+c Here is some extra help on gremlin commands
+c
+c REVISIONS and CHANGES
+c    25/03/98   V1.0   Thomas Forbriger
+c    14/01/99   V1.1   removed link to old gremlin code
+c    04/03/99   V1.2   file/mtt explanation
+c
+c==============================================================================
+c
+      subroutine gremhelp_main
+c
+c give help for main menu
+c
+      call gremhelp_tit('main')
+      call gremhelp_subtit('display data')
+      print *,' dgr            display real green data in different modes'
+      print *,' dtt            display travel time data'
+      print *,' dgi index      plot green data from data array index'
+      print *,' dti index      plot traveltime data from data array index'
+      call gremhelp_subtit('display/edit model')
+      print *,' dre            display reference model in a table'
+      print *,' dwo            display working copy of model in a table'
+      print *,' med            edit actual model (model will be written to'
+      print *,'                file edit.p.mod and will be read again)'
+      print *,' dmo file       display basic control screen for model in "file"'
+      print *,' dmi index      display named model of index'
+      call gremhelp_subtit('set/display free parameters')
+      print *,' spc            set free model parameters'
+      print *,' imo mode       preset parameters for inversion modes'
+      print *,'                (what you would do by "spc" normally)'
+      print *,'     sgrad        shear wave gradient'
+      print *,'     pvel         p-wave model'
+      print *,' weight para    call mod_weight with "para" (modifies'
+      print *,'                "spc" settings)'
+      print *,' sano para      call par_sano with "para" (modifies'
+      print *,'                "spc" settings)'
+      print *,' dpc            display free parameter settings in a table'
+      print *,'                similar to the "spc" mask'
+      print *,' tpc            display free parameter settings in a table'
+      call gremhelp_subtit('set/display inversion parameters')
+      print *,' spa            set various parameters'
+      print *,' dpa            display all parameter settings'
+      call gremhelp_subtit('control inversion')
+      print *,' dda            display basic crontrol screen'
+      print *,' opt lim,step   optimize model with extra break condition'
+      print *,'     lim          stop when X2 reaches "lim"'
+      print *,'     step         stop after a maximum os "step" iterations'
+      print *,' ofi nu,lim,step,mode'
+      print *,'                optimize at fixed "nu"'
+      print *,'     lim          stop when X2 reaches "lim"'
+      print *,'     step         stop after a maximum os "step" iterations'
+      print *,'     mode         1: plot improvement'
+      print *,'                  2: plot improvement, model and data'
+      print *,' x2c numin,numax,npts'
+      print *,'                plot X2 development'
+      print *,'     numin        start with this nu'
+      print *,'     numax        end with this nu'
+      print *,'     npts         number of points to plot'
+      print *,' lx2 numin,numax,npts'
+      print *,'                plot X2 development for linearized problem'
+      print *,'     numin        start with this nu'
+      print *,'     numax        end with this nu'
+      print *,'     npts         number of points to plot'
+      print *,' tpa para       fetch new model for given "nu"'
+      print *,'     para         parameter to calculate "nu" from'
+      call gremhelp_subtit('misc')
+      print *,' verb           set verbosity modes'
+      print *,' mon            switch monitor devices on/off'
+      print *,' pgpar          set plot parameters'
+      print *,' dpg            display pgplot parameters'
+      print *,' dev device     change pgplot device'
+      print *,' file           read/write various files'
+      print *,' reso           linear resolution analysis'
+c      print *,' old            enter old ancient gremlin code'
+c      print *,'                (on your own risk)'
+      print *,' term           use "term" to exit the program'
+      return
+      end
+c
+c----------------------------------------------------------------------
+c 
+      subroutine gremhelp_resan
+c
+c help on resolution analysis menu
+c
+      call gremhelp_tit('resolution analysis')
+      print *,' '
+      print *,' parder         rate partial derivatives'
+      print *,' tpd ival       plot travel time partial derivatives for parameter ival'
+      print *,' tpda           plot travel time partial derivatives for all parameters'
+      print *,' gpd ival       plot green partial derivatives for parameter ival'
+      print *,' gpda           plot green partial derivatives for all parameters'
+      print *,' ense f,t,nu,rms   rate model parameters with index from ''f'' to'
+      print *,'                ''t'' when optimizing all other free parameters'
+      print *,'                stabilized with ''nu'' and accepting an rms-error'
+      print *,'                of ''rms'' in a linear approximation'
+      print *,' sense f,t,nu,rms  just like ''ense'' but puts rating for each'
+      print *,'                parameter on a different page'
+      call gremhelp_subtit('tests')
+      print *,' orth           calculate scalar products and normalized scalar'
+      print *,'                products of vectors of partial derivatives'
+      call gremhelp_subtit('parameter control')
+      print *,' spc            set free model parameters'
+      print *,' dpc            display free parameter settings in a table'
+      print *,'                similar to the "spc" mask'