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

prepared libfapidxx for binary encoding of WID2 data (internally)

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.
the library functions properly path WID2 data through WID2container
encoded Fortran character sequences
WID2container currently not yet provides binary encoding


SVN Path:     http://gpitrsvn.gpi.uni-karlsruhe.de/repos/TFSoftware/trunk
SVN Revision: 3837
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent be2379bb
......@@ -225,11 +225,11 @@ doxyview: $(DOXYWWWPATH)/html/index.html
fapidtestx: fapidtest.o libfapidxx.a
$(FC) -o $@ $< -lfapidxx -ldatrwxx -lsffxx -lgsexx -ltime++ \
-laff -ltf -L$(LOCLIBDIR) -lstdc++
-laff -lsffu -ltf -L$(LOCLIBDIR) -lstdc++
/bin/mv -fv $@ $(LOCBINDIR)
fapidtest: fapidtest.o
$(FC) -o $@ $< -lsff -ltf -L$(LOCLIBDIR)
$(FC) -o $@ $< -lsff -lsffu -ltf -L$(LOCLIBDIR)
/bin/mv -fv $@ $(LOCBINDIR)
# ----- END OF Makefile -----
......@@ -135,7 +135,7 @@ P> fprog
* be extracted from the WID2 line again, to be passed as a WID2 struct to
* libdatrwxx. The step is encoding and decoding WID2 data is not only
* unnecessary, it can also degrade WID2 data since round-off errors can occur
* when passing the sampling interval of a mircosecond offset might get lost,
* when passing the sampling interval or a mircosecond offset might get lost,
* since in cannot be represented in the WID2 line format.
*
* A possible workaround would be to store the WID2 struct in binary for in
......@@ -169,8 +169,15 @@ P> fprog
* </TABLE>
*
* The WID2 line has a size of 132 characters.
*
* This concept is provided by fapidxx::WID2container.
* All WID2 data should be passed only within a WID2container.
* If WID2 data is received in form of a character sequence ist has to be
* passed to a WID2 container which is able to decode it.
* All character string which have to be produced in order to represent the
* WID2 data should be created by WID2container::encode.
*
* \sa sff_PrepWid2(), sff_prepwid2__()
* \sa sff_PrepWid2(), sff_prepwid2__(), fapidxx::WID2container
*/
/* ----- END OF README ----- */
......@@ -26,7 +26,7 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
* ----
*
*
* REVISIONS and CHANGES
* - 18/11/2010 V1.0 Thomas Forbriger
* copied from libtfxx
......
c this is <fapid_sff_PrepWID2.f>
c ----------------------------------------------------------------------------
c ($Id$)
c
c Copyright (c) 2010 by Thomas Forbriger (BFO Schiltach)
c
c Fortran implementation of sff_PrepWID2 function
c
c just copied from stuff.f
c
c REVISIONS and CHANGES
c 23/12/2010 V1.0 Thomas Forbriger
c
c ============================================================================
c
subroutine sff_PrepWid2(nsamp, samprat, station, year, month, day,
& hour, minute, comp, auxid, instyp, second, calib, calper,
& hang, vang, wid2line, ierr)
c
c Prepare a WID2 line from scratch
c
c The routine sets defaults for all variables set either to -1
c for integers, -1. for floats or 'NSP' (not specified) for characters
c If a component e.g. in the form LHZ is given hang and vang are
c determined automatically
c
c Reasonable values must be given for at least
c samprat: sampling rate (= 1./(sampling interval))
c nsamp: number of smaples
c station: station name
c
c Defaults are:
c year: 0
c month. 0
c day: 0
c hour: 0
c minute: 0
c second: 10.0
c comp: NSP
c auxid: NSP
c instyp: NSP
c calib: 1.
c calper: 1.
c hang: -1.
c vang: 90.
c
c Returns wid2line
c
c major changes:
c 22/11/96 T.F. changed format of calib to e10.2 as defined by GSE2.0
c
integer nsamp, year, month, day, hour, minute
character comp*(*), auxid*(*), station*(*), instyp*(*)
real samprat, second, calib, calper, hang, vang
character wid2line*(*)
integer ierr
cE
integer dyear, dmonth, dday, dhour, dminute
character dcomp*3, dauxid*4, dstation*5, dinstyp*6
real dsecond, dcalib, dcalper, dhang, dvang
c
ierr=0
dyear=year
dmonth=month
dday=day
dhour=hour
dminute=minute
dsecond=second
dcalib=calib
dcalper=calper
dhang=hang
dvang=vang
dstation=station(1:5)
c
c defaults
c
if(year.eq.-1) dyear=0
if(month.eq.-1) dmonth=0
if(day.eq.-1) dday=0
if(hour.eq.-1) dhour=0
if(minute.eq.-1) dminute=0
if(comp(1:3).eq.'NSP') then
dcomp='NSP'
else
dcomp=comp(1:min(len(comp),3))
endif
if(auxid(1:3).eq.'NSP') then
dauxid=' NSP'
else
dauxid=auxid(1:min(len(auxid),4))
endif
if(instyp(1:3).eq.'NSP') then
dinstyp=' NSP'
else
dinstyp=instyp(1:min(len(instyp),6))
endif
if(calib .eq. -1.) dcalib=1.0
if(calper .eq. -1.) dcalper=1.0
if(vang .eq. -1.) dvang=90.
if(second .eq. -1.) dsecond=10.0
if(comp.ne.'NSP') then
dhang=-1.0
if(comp(3:3).eq.'N') dhang=0.
if(comp(3:3).eq.'E') dhang=90.
dvang=0.
if(comp(3:3).eq.'N' .or. comp(3:3).eq.'E') dvang=90.
endif
c
200 format(5x,i4.4,2(1h/,i2.2),1x,2(i2.2,1h:),f6.3,1x,a5,1x,a3,1x,
& a4,1x,a3,1x,i8,1x,f11.6,1x,e10.2,1x,f7.3,1x,a6,1x,f5.1,1x,f4.1)
write(wid2line,200)
2 dyear, dmonth, dday, dhour, dminute, dsecond, dstation, dcomp,
3 dauxid, 'CM6', nsamp, samprat, dcalib, dcalper, dinstyp,
4 dhang, dvang
if (wid2line(23:23).eq.' ') wid2line(23:23)='0'
if (wid2line(24:24).eq.' ') wid2line(24:24)='0'
wid2line(1:4)='WID2'
c
return
end
c
c ----- END OF fapid_sff_PrepWID2.f -----
......@@ -26,6 +26,7 @@ c These functions are just copied from stuff.f
c
c REVISIONS and CHANGES
c 17/01/2011 V1.0 Thomas Forbriger
c 01/04/2011 V1.1 decode WID2 line
c
c ============================================================================
c
......@@ -38,7 +39,10 @@ c extract date (yyyy/mm/dd)
c
character wid2line*132, date*(*)
cE
date = wid2line(6:15)
character wid2decoded*132
c
call sff_helper_decode_wid2(wid2line, wid2decoded)
date = wid2decoded(6:15)
return
end
cD
......@@ -49,7 +53,10 @@ c extract time (hh:mm:ss.sss)
c
character wid2line*132, time*(*)
cE
time = wid2line(17:28)
character wid2decoded*132
c
call sff_helper_decode_wid2(wid2line, wid2decoded)
time = wid2decoded(17:28)
return
end
cD
......@@ -60,7 +67,10 @@ c extract station name (a5)
c
character wid2line*132, sta*(*)
cE
sta = wid2line(30:34)
character wid2decoded*132
c
call sff_helper_decode_wid2(wid2line, wid2decoded)
sta = wid2decoded(30:34)
return
end
cD
......@@ -71,7 +81,10 @@ c extract channel name (a3)
c
character wid2line*132, channel*(*)
cE
channel = wid2line(36:38)
character wid2decoded*132
c
call sff_helper_decode_wid2(wid2line, wid2decoded)
channel = wid2decoded(36:38)
return
end
cD
......@@ -83,8 +96,11 @@ c
character wid2line*132
cE
integer n
character wid2decoded*132
c
call sff_helper_decode_wid2(wid2line, wid2decoded)
c
read(wid2line(49:56),'(i8)') n
read(wid2decoded(49:56),'(i8)') n
sff_GetN = n
return
end
......@@ -97,8 +113,11 @@ c
character wid2line*132
cE
real dt
character wid2decoded*132
c
call sff_helper_decode_wid2(wid2line, wid2decoded)
c
read(wid2line(58:68),'(f11.6)') dt
read(wid2decoded(58:68),'(f11.6)') dt
sff_GetDt = 1./dt
return
end
......
/*! \file fapid_sff_helper_decode_wid2.cc
* \brief decode a WID2 character sequence (Fortran interface) (implementation)
*
* ----------------------------------------------------------------------------
*
* $Id$
* \author Thomas Forbriger
* \date 01/04/2011
*
* decode a WID2 character sequence (Fortran interface) (implementation)
*
* Copyright (c) 2011 by Thomas Forbriger (BFO Schiltach)
*
* ----
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
* ----
*
* REVISIONS and CHANGES
* - 01/04/2011 V1.0 Thomas Forbriger
*
* ============================================================================
*/
#define TF_FAPID_SFF_HELPER_DECODE_WID2_CC_VERSION \
"TF_FAPID_SFF_HELPER_DECODE_WID2_CC V1.0"
#define TF_FAPID_SFF_HELPER_DECODE_WID2_CC_CVSID \
"$Id$"
#include <fapidxx/fapidsff.h>
#include <fapidxx/helper.h>
#include <fapidxx/error.h>
int sff_helper_decode_wid2__(char *wid2in, char *wid2out,
ftnlen wid2in_len, ftnlen wid2out_len)
{
fapidxx::WID2container wid2(wid2in, wid2in_len);
fapidxx::fillfstring(wid2.wid2.line(), wid2out, wid2out_len);
return(0);
} // int sff_helper_decode_wid2__
/* ----- END OF fapid_sff_helper_decode_wid2.cc ----- */
......@@ -10,6 +10,22 @@
* Delete existing file (implementation)
*
* Copyright (c) 2010 by Thomas Forbriger (BFO Schiltach)
*
* ----
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
* ----
*
* REVISIONS and CHANGES
* - 25/12/2010 V1.0 Thomas Forbriger
......
/*! \file fapid_sff_prepwid2.cc
* \brief encode WID2 data into a character sequence (implementation)
*
* ----------------------------------------------------------------------------
*
* $Id$
* \author Thomas Forbriger
* \date 01/04/2011
*
* encode WID2 data into a character sequence (implementation)
*
* Copyright (c) 2011 by Thomas Forbriger (BFO Schiltach)
*
* ----
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
* ----
*
* REVISIONS and CHANGES
* - 01/04/2011 V1.0 Thomas Forbriger
*
* ============================================================================
*/
#define TF_FAPID_SFF_PREPWID2_CC_VERSION \
"TF_FAPID_SFF_PREPWID2_CC V1.0 "
#define TF_FAPID_SFF_PREPWID2_CC_CVSID \
"$Id$"
#include <fapidxx/fapidsff.h>
#include <fapidxx/helper.h>
#include <fapidxx/error.h>
/*! \brief Encode WID2 data
*
* \ingroup implemented_functions
*
* Description from stuff.f:
* \code
c----------------------------------------------------------------------
c
c Prepare a WID2 line from scratch
c
c The routine sets defaults for all variables set either to -1
c for integers, -1. for floats or 'NSP' (not specified) for characters
c If a component e.g. in the form LHZ is given hang and vang are
c determined automatically
c
c Reasonable values must be given for at least
c samprat: sampling rate (= 1./(sampling interval))
c nsamp: number of smaples
c station: station name
c
c Defaults are:
c year: 0
c month. 0
c day: 0
c hour: 0
c minute: 0
c second: 10.0
c comp: NSP
c auxid: NSP
c instyp: NSP
c calib: 1.
c calper: 1.
c hang: -1.
c vang: 90.
c
c Returns wid2line
c
c major changes:
c 22/11/96 T.F. changed format of calib to e10.2 as defined by GSE2.0
c
integer nsamp, year, month, day, hour, minute
character comp*(*), auxid*(*), station*(*), instyp*(*)
real samprat, second, calib, calper, hang, vang
character wid2line*(*)
integer ierr
c----------------------------------------------------------------------
* \endcode
*/
int sff_prepwid2__(integer *nsamp, real *samprat, char *station,
integer *year, integer *month, integer *day,
integer *hour, integer *minute, char *comp,
char *auxid, char *instyp, real *second, real *calib,
real *calper, real *hang, real *vang, char *wid2line,
integer *ierr, ftnlen station_len, ftnlen comp_len,
ftnlen auxid_len, ftnlen instyp_len, ftnlen wid2line_len)
{
::sff::WID2 wid2;
wid2.nsamples= *nsamp;
wid2.dt = 1./(*samprat);
wid2.station =fapidxx::stringfromfstring(station, station_len);
double dsecond=*second;
libtime::timeint isecond=static_cast<libtime::timeint>(std::floor(dsecond));
libtime::timeint milsec
=static_cast<libtime::timeint>(std::floor(1.e3*dsecond));
libtime::timeint micsec
=static_cast<libtime::timeint>(std::floor(1.e6*dsecond));
milsec -= 1000*isecond;
micsec -= 1000*(milsec+1000*isecond);
libtime::TAbsoluteTime date(*year, *month, *day, *hour, *minute,
isecond, milsec, micsec);
wid2.date =date;
wid2.channel =fapidxx::stringfromfstring(comp, comp_len);
wid2.auxid =fapidxx::stringfromfstring(auxid, auxid_len);
wid2.instype =fapidxx::stringfromfstring(instyp, instyp_len);
wid2.calib = *calib;
wid2.calper = *calper;
wid2.hang = *hang;
wid2.vang = *vang;
fapidxx::WID2container wid2c(wid2);
wid2c.encode(wid2line, wid2line_len);
*ierr=0;
return(0);
} // int sff_prepwid2__
/* ----- END OF fapid_sff_prepwid2.cc ----- */
......@@ -10,6 +10,22 @@
* mimic sff_WOpenS function - open for writing, passing SRCE line (implementation)
*
* Copyright (c) 2010 by Thomas Forbriger (BFO Schiltach)
*
* ----
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
* ----
*
* REVISIONS and CHANGES
* - 23/12/2010 V1.0 Thomas Forbriger
......
......@@ -10,6 +10,22 @@
* mimic sff_WTraceI function - write a trace with INFO line (implementation)
*
* Copyright (c) 2010 by Thomas Forbriger (BFO Schiltach)
*
* ----
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
* ----
*
* REVISIONS and CHANGES
* - 23/12/2010 V1.0 Thomas Forbriger
......
......@@ -183,11 +183,6 @@ extern int sff_rdata2__(integer *lu, integer *nsamp, integer *idata, char *cbuf,
extern int sff_skipdata__(integer *lu, char *code, logical *last, integer *ierr, ftnlen code_len);
/*! \brief Prepare WID2 line:
* This function is implemented through the Fortran subroutine sff_PrepWid2().
* \ingroup implemented_functions
* \sa \ref sec_comments_prepwid2, sff_PrepWid2()
*/
extern int sff_prepwid2__(integer *nsamp, real *samprat, char *station, integer *year, integer *month, integer *day, integer *hour, integer *minute, char *comp, char *auxid, char *instyp, real *second, real *calib, real *calper, real *hang, real *vang, char *wid2line, integer *ierr, ftnlen station_len, ftnlen comp_len, ftnlen auxid_len, ftnlen instyp_len, ftnlen wid2line_len);
extern int sff_getdate__(char *wid2line, char *date, ftnlen wid2line_len, ftnlen date_len);
......
......@@ -8,6 +8,7 @@ c this is a program to test several steps of fapid development
c
c REVISIONS and CHANGES
c 17/11/2010 V1.0 Thomas Forbriger
c 01/04/2011 V1.1 test file writing
c
c ============================================================================
c
......@@ -15,7 +16,7 @@ c
c
character*(*) version
parameter(version=
& 'FAPIDTEST V1.0 this is a program to test libfapidxx.a')
& 'FAPIDTEST V1.1 this is a program to test libfapidxx.a')
character*(*) FAPIDTEST_CVS_ID
parameter(FAPIDTEST_CVS_ID=
& '$Id$')
......@@ -23,7 +24,7 @@ c
c commandline
integer maxopt, lastarg, iargc
character*80 argument
parameter(maxopt=4)
parameter(maxopt=6)
character*2 optid(maxopt)
character*40 optarg(maxopt)
logical optset(maxopt), opthasarg(maxopt)
......@@ -31,36 +32,15 @@ c debugging
logical debug, verbose
c here are the keys to our commandline options
data optid/2h-d, 2h-v, 2h-x, 2h-t/
data opthasarg/3*.FALSE.,.TRUE./
data optarg/3*1h-,'sff'/
data optid/2h-d, 2h-v, 2h-x, 2h-t, '-w', '-r'/
data opthasarg/3*.FALSE.,3*.TRUE./
data optarg/3*1h-,'sff','testfile.sff','junk.sff'/
c
character*80 filename
character*20 formatid
integer lu
parameter(lu=10)
c sff file header
character code*10, timestamp*13, scs*1, date*6, time*10
real sffversion, sc1, sc2, sc3
character*20 source
c
c sff trace
logical last
character rcs*1, wid2line*132
real rc1, rc2, rc3, tanf, dt
integer nstack
character*40 infile, outfile
logical doread, dowrite
c
c functions
real sffu_offset, sffu_tfirst, ts_max, ts_min, ts_average
real offshift
c
c time series
integer maxsamp, nsamp
parameter(maxsamp=100000)
real fdata(maxsamp)
integer idata(maxsamp)
equivalence(fdata, idata)
c
c------------------------------------------------------------------------------
c basic information
......@@ -70,15 +50,19 @@ c
if (iargc().eq.1) call getarg(1, argument)
if ((argument(1:5).eq.'-help').or.(iargc().lt.1)) then
print *,version
print *,'Usage: fapidtest arguments'
print *,'Usage: fapidtest [-r file] [-w file] [-t type]'
print *,' or: fapidtest -help'
print *,' or: fapidtest -x'
if (argument(1:5).ne.'-help')
& stop 'ERROR: wrong number of arguments'
print *,' '