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

stopped that project

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: 2272
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent e4b55e11
# this is <Makefile>
# ----------------------------------------------------------------------------
# $Id: Makefile,v 1.7 2003-09-09 13:20:30 tforb Exp $
# $Id: Makefile,v 1.8 2007-05-09 13:16:51 tforb Exp $
#
# Copyright (c) 2002 by Thomas Forbriger (IMG Frankfurt)
#
......@@ -43,6 +43,9 @@ REFMATOBS=refmat_basinf.o refmet_rmain.o refmet_rmod.o\
RESUSOBS=refmet_output.o refmet_preptrace.o refmet_wtrace.o lmath.o\
resus_basinf.o refmet_rmain.o refmet_rsource.o refmet_rrcv.o\
refmet_intro.o refmet_comments.o
RESUSNOBS=refmet_output.o refmet_preptrace.o refmet_wtrace.o lmath.o\
resusnoise_basinf.o refmet_rmain.o refmet_rsource.o refmet_rrcv.o\
refmet_intro.o refmet_comments.o
GRESYSUB=main/gresy.o sub/refmet_rrcv.o
LIBREFMETOBS=$(addprefix sub/,refmet_basinf.o refmet_rmain.o refmet_rmod.o \
refmet_rsource.o refmet_rrcv.o refmet_intro.o refmet_comments.o)
......@@ -82,6 +85,7 @@ ref2mu: $(REFMUOBS)
refmet: main/refmet.o $(addprefix sub/, $(REFMETOBS))
reamp: main/reamp.o $(addprefix sub/, $(REAMPOBS))
resus: main/resus.o $(addprefix sub/, $(RESUSOBS))
resusnoise: main/resusnoise.o $(addprefix sub/, $(RESUSNOBS))
refmat: main/refmat.o $(addprefix sub/, $(REFMATOBS))
refmatsh: main/refmatsh.o $(addprefix sub/, $(REFMETOBS))
......@@ -90,6 +94,11 @@ refmatsh refmat resus reamp refmet:
$(F2CLIB) -L$(LOCLIBDIR) $(CFLAGS)
newprog $@
resusnoise:
$(CC) $^ -o $@ -lsff -lemod -ltf -lgsl -lgslcblas \
$(F2CLIB) -L$(LOCLIBDIR) $(CFLAGS)
newprog $@
librefread77.a: $(LIBREFMETOBS77)
ar rcv $@ $^
ranlib $@
......
c this is <resusnoise.f>
c ----------------------------------------------------------------------------
c ($Id: resusnoise.f,v 1.1 2007-05-04 15:28:51 tforb Exp $)
c ($Id: resusnoise.f,v 1.2 2007-05-09 13:16:51 tforb Exp $)
c
c Copyright (c) 2007 by Thomas Forbriger (BFO Schiltach)
c
c NOTICE: It appears to be too complex to implement this here just for some
c tests. I will rather make a modification of gresy.f from the gremlin stuff.
c
c Create noise seismograms from refmat coefficients
c
c this is a version derived from resus.f
c convolves the data of each receiver with gaussian noise
c all receivers will be stacked immediatly
c
c REVISIONS and CHANGES
c 04/05/2007 V1.0 Thomas Forbriger
c
......@@ -34,51 +41,17 @@ c
c this is a special version calculating seismograms from a matrix-file
c
c======================================================================
c
c REVISIONS and CHANGES (only major changes are reported in detail)
c
c 14/02/1997 V1.0 * copied from refmet.f (V2.1)
c * reduced code to what is needed calculating seismograms
c 15/02/1997 V1.1 * included amplitude correction for receivers
c between pi and 2pi
c * check array dimensions
c 20/02/1997 V1.2 * appropriate amplitude correction for epicentral
c distances greater than 180 degrees
c 24/02/1997 V1.3 * selector for delta pulse is srcsig not typ
c 10/06/1997 V1.4 * this code now uses a specific usage information
c resus_basinf
c 22/10/1997 V1.5 * introduced a phase shifting amplitude
c correction for distances greater than 180 deg
c 18/06/1998 V1.6 * make phase-shift trick switchable, as it does not
c hold for other combinations than Mzz --> Uz
c 19/06/1998 V1.7 * test the sign inversion for all horizontal components
c when calculating seismograms behind the antipode
c This trick now holds for all components
c 22/12/1998 V1.8 * introduced option for sign-inversion without
c polar-phase-shift behind antipode
c 16/02/1999 V1.9 * changed two of the late frequency loops to
c fmi,fma from 1,SL
c * changed campcorr to ampcoor (now real again)
c * introduced correct hilbert transformation and
c factor variable hilbfact
c * now calls tf_cmdline (not tflib_cmdline)
c 19/02/1999 V1.10 * had to correct tred calculation (that was the 1,SL
c loop at 16/02/99)
c 25/02/1999 V1.11 allow output coordinates format S
c 26/02/1999 correct comment for polar phase shift
c 30/04/1999 V1.12 provide butterworth filter on output
c 16/09/2003 V1.13 increased size of command-line arguments
c
c======================================================================
PROGRAM resus
PROGRAM resusnoise
character*70 version
parameter(version=
& 'RESUS V1.13 Reflectivity Sum to Seismograms')
& 'RESUS V1.0 reflectivity stacked noise')
c array dimension declaration
integer me, msl, mf
PARAMETER (ME=10)
integer msl, mf, maxrec
c integer me, msl, mf
c PARAMETER (ME=10)
PARAMETER (maxrec=1000)
PARAMETER (MSL=2050)
PARAMETER (Mf=MSL/2+1)
c----------------------------------------------------------------------
......@@ -601,7 +574,7 @@ c transform source depth
c
c some files explicitly concerned to resus:
c
c resus_basinf.f gives help information
c resusnoise_basinf.f gives help information
c refmet_intro.f some additional text to basinf
c refmet_comments.f some additional text to basinf
c refmet_rmain.f reads main configuration file
......@@ -628,11 +601,11 @@ c parameter declaration
REAL*8 Du,u,umin,umax,uwil,uwir,utap,uQ,gew,ZQ,
& Df,Dt,fmin,fmax,fwil,fwir,FL,Fny,TL,radius,
& fr(MSL),ftap(Mf),t(MSL),w(MSL),
& phi(ME),phiB(ME),r(ME),FFI,NFI,
& phi(maxrec),phiB(maxrec),r(maxrec),FFI,NFI,
& ap,hfkt,Thd,The,T1,T2,tvar,
& tred(MSL,ME),Tli,Tre,Vred,help,
& tred(MSL),Tli,Tre,Vred,help,
& M0,M0dim,Mxx,Myy,Mzz,Mxy,Mxz,Myz,
& K0(ME),K1(ME),K2(ME),K3(ME),L1(ME),L2(ME)
& K0,K1,K2,K3,L1,L2
COMPLEX*16 ah,bh,alphCh,betaCh,alphCtop,betaCtop,atop,btop
......@@ -644,8 +617,8 @@ c parameter declaration
COMPLEX*16 IDFr,IDFphi,IDFz,
& IDNr,IDNphi,IDNz,
& VFr(MSL,ME),VFphi(MSL,ME),VFz(MSL,ME),
& VNr(MSL,ME),VNphi(MSL,ME),VNz(MSL,ME), C(MSL)
& VFr(MSL),VFphi(MSL),VFz(MSL),
& VNr(MSL),VNphi(MSL),VNz(MSL), C(MSL)
COMPLEX IRM11(Mf),IRM12(Mf),IRM21(Mf),
& IRM22(Mf),ITR11(Mf),ITR12(Mf),
......@@ -675,7 +648,7 @@ c source function
c distance correction
real*8 ampcorr(ME), delta, deltaflat
integer correx
logical behindap(me)
logical behindap
c output signal filters
integer fil_maxstage,fil_hpstages,fil_lpstages
parameter(fil_maxstage=20)
......@@ -688,7 +661,7 @@ c hilbert tranformation
double complex hilbfact
c sff FREE
integer sff_maxfree, sff_nfree, sff_freebase
parameter(sff_maxfree=100+2*ME+2*fil_maxstage)
parameter(sff_maxfree=100+2*fil_maxstage)
character*80 sff_free(sff_maxfree)
c sff data
real fdata(MSL)
......@@ -754,8 +727,8 @@ c basic setup part
c
c----------------------------------------------------------------------
c give basic information
call resus_basinf(version, mainfile, lev1, lev2, lev3, lev4,
& ME, 0, MSL, Mf, sff_maxfree, hfktstr)
call resusnoise_basinf(version, mainfile, lev1, lev2, lev3, lev4,
& 1, maxrec, MSL, Mf, sff_maxfree, hfktstr)
c call buggy
......@@ -842,7 +815,7 @@ c
c----------------------------------------------------------------------
c read receiver configuration
call refmet_rrcv(receiverfile, receivertext,
& Vred, Tli, Tre, NE, ME, r, phi, radius,
& Vred, Tli, Tre, NE, maxrec, r, phi, radius,
& cl_vlevel, lev2, cl_debug)
if (cl_debug) then
print *,'DEBUG receivers ',(r(E), E=1,NE)
......@@ -870,18 +843,16 @@ C Initialisierung des Frequenzfilters ftap(f)
185 CONTINUE
C Initialisierung
DO 190 E=1,NE
C der normierten Teilspektren bis zur Nyquistfrequenz
behindap(e)=.false.
DO 184 f=1,SL
VFr(f,E) =dcmplx(0.,0.)
VFphi(f,E)=dcmplx(0.,0.)
VFz(f,E) =dcmplx(0.,0.)
VNr(f,E) =dcmplx(0.,0.)
VNphi(f,E)=dcmplx(0.,0.)
VNz(f,E) =dcmplx(0.,0.)
184 CONTINUE
190 CONTINUE
C der normierten Teilspektren bis zur Nyquistfrequenz
behindap=.false.
DO 184 f=1,SL
VFr(f) =dcmplx(0.,0.)
VFphi(f)=dcmplx(0.,0.)
VFz(f) =dcmplx(0.,0.)
VNr(f) =dcmplx(0.,0.)
VNphi(f)=dcmplx(0.,0.)
VNz(f) =dcmplx(0.,0.)
184 CONTINUE
C**********************************************************************C
C 5. Vorberechnungen fuer Langsamkeit C
......
c this is <resusnoise_basinf.f>
c ----------------------------------------------------------------------------
c ($Id: resusnoise_basinf.f,v 1.1 2007-05-09 13:16:52 tforb Exp $)
c
c Copyright (c) 2007 by Thomas Forbriger (BFO Schiltach)
c
c description of resusnoise
c
c REVISIONS and CHANGES
c 09/05/2007 V1.0 Thomas Forbriger
c
c======================================================================
c
c give basic information
c
subroutine resus_basinf(version, mainfile, lev1, lev2, lev3, lev4,
& maxrec, MS, MSL, Mf, sff_maxfree, hfktstr)
c
character version*(*), mainfile*(*), hfktstr*(*)
integer lev1, lev2, lev3, lev4
integer maxrec, MSL, MS, Mf, sff_maxfree
c
integer iargc
c
print *, version
print *, 'Usage: resusnoise [-d] [-v level] [-o basename] [-c]'
print *, ' [-s select] [-p] [-i] -m file file'
print *,' [-l n,f,o[,f,o,...]] [-h n,f,o,[,f,o,...]]'
print *, ' or: resusnoise -help'
if (iargc().lt.1) stop 'ERROR: missing parameters'
call getarg(1, mainfile)
if (mainfile.eq.'-help') then
call refmet_intro
print *,' '
print *,' NOTICE: This is not refmet this is RESUSNOISE.'
print *,' NOTICE: This will need a precalculated response'
print *,' matrix to serve you with seismograms!'
print *,' (use refmat to calculate a response matrix)'
print *,' '
print *,'commandline parameters are:'
print *,' '
print *,'-d Give debugging output.'
print *,'-v level Set verbosity level. The parameter may be'
print *,' any integer value. The higher the value'
print *,' the more output will be produced.'
print *,'-o basename Define output files basename.'
print *,' (default is: refmet.out)'
print *,'-c Output will be sortet one component per file'
print *,' instead of one receiver per file.'
print *,'-s select This option selects components that should not'
print *,' be written to the output files. The string select'
print *,' is any set of two-character combinations that'
print *,' specify components: TZ, TR, TT, FZ, FR, FT,'
print *,' NZ, NR and NT are allowed. T stands for total'
print *,' field, F for far field and N for near field.'
print *,' Z means vertical component, R radial component'
print *,' and T transverse component.'
print *,' In the case of a vertical single force select'
print *,' is set to TTFZFRFTNZNRNT by default, which'
print *,' disables the transverse component and all'
print *,' near field and far field output.'
print *,'-m file Name of matrix file created by refmat.'
print *,'-p Introduce a polar phase shift by the heuristic'
print *,' trick to apply a hilbert transform to all'
print *,' waveforms behind the antipode. In addition the'
print *,' coordinate system for seismograms behind the'
print *,' antipode point is rotated by 180° in the'
print *,' horizontal plane.'
print *,'-i Invert sign of all horizontal coordinates'
print *,' behind 180°, but do not apply polar phase'
print *,' shift.'
print *,'-l n,f,o[,f,o,...] Define lowpass Butterworth filters.'
print *,' The output signal will be filtered with n'
print *,' stages of butterworth filters. Each stage has'
print *,' to be defined by an eigenfrequency f (Hz) and'
print *,' its order o.'
print *,'-h n,f,o[,f,o,...] Define highpass Butterworth filters.'
print *,' The output signal will be filtered with n'
print *,' stages of butterworth filters. Each stage has'
print *,' to be defined by an eigenfrequency f (Hz) and'
print *,' its order o.'
print *,' '
print *,'file Is the name of the main configuration file.'
print *,' It contains the names of the three file'
print *,' containing the earth model, the source model'
print *,' and the receiver coordinates. In addition there'
print *,' must be given some numerical parameters for the'
print *,' calculation.'
print *,' '
print *,'This programs uses a precalculated response matrix (see '
print *,'refmat) for layered media to build synthetic seismograms. '
print *,'Therefore we do not use a modelfile. You must provide this '
print *,'program with a main configuration file which must set '
print *,'a source configuration and a receiver configuration file. '
print *,' '
print *,'The following parameters given in your configuration will '
print *,'be overwritten by the values stored in the response matrix '
print *,'file: '
print *,' '
print *,' - the sampling interval '
print *,' - the seismogram length '
print *,' - the minimum and maximum frequency '
print *,' - the minimum and maximum slowness '
print *,' - the number of slowness steps'
print *,' - the source depth'
print *,' - the earth radius'
print *,' - and (as you did expect) all earth model parameters'
print *,' '
print *,'You have still got the freedom to apply any taper '
print *,'in the frequency and slowness domain. '
print *,' '
call refmet_comments
print *,' '
print *,'Verbosity levels are: '
print *,' =',lev1,' no output'
print *,' >',lev1,' report basic configuration'
print *,' >',lev2,' report reading and writing files'
print *,' >',lev3,' model, receivers and source are reported'
print *,' >',lev4,' report on results'
print *,'The same values but with negative sign will cause a'
print *,'report on calculation progress.'
print *,' '
print *,'Array dimensions compiled into this version:'
print *,' maximum number of receivers: ',maxrec
print *,' maximum number of samples: ',MSL
print *,' maximum number of frequnecies: ',Mf
print *,' maximum number of FREE lines: ',sff_maxfree
c call other info routine
call refmet_maininf
call refmet_sourinf(hfktstr)
call refmet_rcvinf
stop
endif
return
end
c
c ----- END OF resusnoise_basinf.f -----
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment