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

handles external workspace to be able to write arbitrarily large time

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.
series


SVN Path:     http://gpitrsvn.gpi.uni-karlsruhe.de/repos/TFSoftware/trunk
SVN Revision: 4720
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent 37cd1de7
......@@ -25,6 +25,7 @@ c some routines for easy to use file writing
c
c REVISIONS and CHANGES
c 09/02/2001 V1.0 Thomas Forbriger
c 03/06/2012 V1.1 added simplewrite_external_ws
c
c==============================================================================
c
......@@ -61,30 +62,32 @@ c
c------------------------------------------------------------------------------
cS
c
subroutine sffu_simplewrite(lu, last, x, n, dt, r)
subroutine sffu_simplewrite_external_ws(lu, last, x, n, dt, r,
& ix, mi)
c
c write a single trace with offset
c accept workspace for data sample conversion from user
c
c lu: file unit
c last: true if file is to be closed
c x: time series
c n: number of samples
c r: offset value
c r: receiver offset value
c dt: sampling interval
c ix: workspace for data conversion
c mi: dimension of workspace array
c
c declare parameters
integer lu
logical last
integer n
integer n, mi
real x(n)
integer ix(mi)
real r, dt
c
cE
c declare local variables
integer ierr
integer maxint
parameter (maxint=100000)
integer ix(maxint)
real rate, second, calib, calper, hang, vang
character*10 nsp,station,comp,auxid,instype
character*132 wid2line
......@@ -93,7 +96,8 @@ c declare local variables
real c1,c2,c3
character*1 cs
c
if (n.gt.maxint) stop 'ERROR (sffu_simplewrite): too many samples'
if (n.gt.mi)
& stop 'ERROR (sffu_simplewrite_external_ws): too many samples'
c
rate=1./dt
station=nsp
......@@ -115,7 +119,7 @@ c
& day, hour, minute, comp, auxid, instype, second, calib,
& calper, hang, vang, wid2line, ierr)
if (ierr.ne.0)
& stop 'ERROR (sffu_simplewrite): preparing WID2 line'
& stop 'ERROR (sffu_simplewrite_external_ws): preparing WID2 line'
c
c1=r
c2=0.
......@@ -125,7 +129,41 @@ c
c
call sff_WTraceI(lu, wid2line, n, x, ix, last,
& cs, c1, c2, c3, nstack, ierr)
if (ierr.ne.0) stop 'ERROR (sffu_simplewrite): writing trace'
if (ierr.ne.0)
& stop 'ERROR (sffu_simplewrite_external_ws): writing trace'
c
return
end
c
c------------------------------------------------------------------------------
cS
c
subroutine sffu_simplewrite(lu, last, x, n, dt, r)
c
c write a single trace with offset
c
c lu: file unit
c last: true if file is to be closed
c x: time series
c n: number of samples
c r: receiver offset value
c dt: sampling interval
c
c declare parameters
integer lu
logical last
integer n
real x(n)
real r, dt
c
cE
c declare local variables
integer maxint
parameter (maxint=100000)
integer ix(maxint)
call sffu_simplewrite_external_ws(lu, last, x, n, dt, r,
& ix, maxint)
c
return
end
......
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