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

set time in compliance with libfapidxx

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: 3868
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent 042666a6
......@@ -192,6 +192,7 @@ c go
call sff_select_format(optfileformat, i)
if (i.ne.0) stop 'ERROR: selecting file format'
call readdata(lastarg)
if (debug) print *,'DEBUG: read ',ntraces,' traces'
c
if (optdestack) call destack
c
......
......@@ -61,7 +61,8 @@ c FREE block
character*80 free(maxfree)
c WID2 info
character*132 wid2line
integer wid2date(7), refdate(7), startdate(7)
integer wid2date(7), refdate(7), startdate(7), day, month
real second
c
if (overwrite) then
if (verbose) print *,'removing file ',
......@@ -73,9 +74,17 @@ c
endif
endif
c
c prepare time and date values
c refdate: SRCE time and date
c startdate: time offset of trace with respect to SRCE
c wid2date: time and date of first sample
call time_clear(refdate)
refdate(1)=1998
refdate(2)=1
c dummy reference time and SRCE information
sdate='980101'
stime='000000.000'
call sffu_srcetime(refdate, sdate, stime)
c sdate='980101'
c stime='000000.000'
stype='unknown'
c create file FREE block
free(1)='file was created by'
......@@ -103,6 +112,8 @@ c
endif
c
i=firstinchain
if (debug) print *,'DEBUG: number of traces to be written: ',
& ntraces
do itrace=1,ntraces
if (verbose) print 50,itrace,ntraces,i,roffset(i)
last=.false.
......@@ -135,18 +146,23 @@ c
endif
c
ifile=fileindex(i)
c prepare WID2 line
c prepare time and date values
c refdate: SRCE time and date
c startdate: time offset of trace with respect to SRCE
c wid2date: time and date of first sample
call time_clear(startdate)
call time_clear(refdate)
if (timeofsample(firstsample(i)).lt.0.)
& stop 'ERROR: cannot handle negative delays'
call sffu_dttotime(timeofsample(firstsample(i)), startdate)
refdate(1)=1998
refdate(2)=1
call time_add(refdate, startdate, wid2date)
call sff_PrepWid2(nsamples(i), 1./dt(i), station(i), 0, 0, 0, 0, 0,
& channel(i), auxid(i), instype(i), 0., -1., -1., -1., -1.,
call time_getdate(day, month, wid2date)
second=wid2date(5)+1.e-3*wid2date(6)
c prepare WID2 line
call sff_PrepWid2(nsamples(i), 1./dt(i), station(i),
& wid2date(1), month, day, wid2date(3), wid2date(4),
& channel(i), auxid(i), instype(i), second, -1., -1., -1., -1.,
& wid2line, ierr)
if (ierr.ne.0) stop 'ERROR (writedata): preparing WID2 line'
call sffu_setwid2time(wid2line, wid2date)
c create FREE block
free(1)='seismic source was '//source(ifile)
free(2)='original datafile was'
......
Markdown is supported
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