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

correction

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: 2292
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent 33469f48
c this is <gresynoise.f>
c ----------------------------------------------------------------------------
c ($Id: gresynoise.f,v 1.13 2007-05-24 15:18:12 tforb Exp $)
c ($Id: gresynoise.f,v 1.14 2007-05-24 15:27:22 tforb Exp $)
c
c Copyright (c) 2007 by Thomas Forbriger (BFO Schiltach)
c
......@@ -17,6 +17,7 @@ c 21/05/2007 V1.4 provide longer seismograms by keep multiple copies of
c noisymized Fourier coefficients
c 24/05/2007 V1.5 write north and east component
c corrected buffer indexing
c V1.6 return to vertical and radial component
c
c ============================================================================
c
......@@ -47,10 +48,10 @@ c
c
character*(*) version
parameter(version=
&'GRESYNOISE V1.5 calculate noise seismograms')
&'GRESYNOISE V1.6 calculate noise seismograms')
character*(*) GRESYNOISE_CVS_ID
parameter(GRESYNOISE_CVS_ID=
&'$Id: gresynoise.f,v 1.13 2007-05-24 15:18:12 tforb Exp $')
&'$Id: gresynoise.f,v 1.14 2007-05-24 15:27:22 tforb Exp $')
c
c dimensions
integer maxtr, maxsetsamp, maxom, maxu, maxset, maxsamp
......@@ -571,6 +572,8 @@ c
cstation='NSP'
cauxid='NSP'
cinstype='NSP'
c only one trace per file
last=.true.
c vertical component
c ------------------
if (optnew) call sff_New(lu, Zseisname, ierr)
......@@ -590,29 +593,17 @@ c prepare wid2line
& cs, c1, c2, c3, nstack, ierr)
if (debug) print *,'did writing'
if (ierr.ne.0) stop 'ERROR: writing trace'
c north component
c radial component
c ---------------
c writing the same trace twice with equivalence buffers requires copying
do i=1,nsamp
Zfdata(i)=Rfdata(i)
enddo
c prepare wid2line
if (debug) print *,'go and write',nsamp
cchannel='N'
call sff_prepwid2(nsamp, 1./dt, cstation, 1999, 4, 18, 0, 0,
& cchannel, cauxid, cinstype,
& 0., -1., -1., -1., -1., wid2line, ierr)
if (ierr.ne.0) stop 'ERROR: preparing WID2 line'
call sff_WTraceI(lu, wid2line, nsamp, Zfdata, Zidata, last,
& cs, c1, c2, c3, nstack, ierr)
if (debug) print *,'written'
if (ierr.ne.0) stop 'ERROR: writing trace'
c east component
c --------------
last=.true.
if (optnew) call sff_New(lu, Rseisname, ierr)
if (ierr.ne.0) stop 'ERROR: deleting seismogram file'
call sff_WOpenFS(lu, Rseisname,
& free, nfree, srctype, cs, c1 ,c2 ,c3,
& date, time, ierr)
if (ierr.ne.0) stop 'ERROR: opening seismogram file'
c prepare wid2line
if (debug) print *,'go and write',nsamp
cchannel='E'
cchannel='R'
call sff_prepwid2(nsamp, 1./dt, cstation, 1999, 4, 18, 0, 0,
& cchannel, cauxid, cinstype,
& 0., -1., -1., -1., -1., wid2line, ierr)
......
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