Commit 61a9a3ff authored by thomas.forbriger's avatar thomas.forbriger Committed by thomas.forbriger
Browse files

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
parent 677ff3e8
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.
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.
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.
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.
This diff is collapsed.
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 -----
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.
#
# 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 $@
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 -----
This diff is collapsed.
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 -----
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'