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

equipped stuplo with libfapidxx interface

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.
polplot.f was never realized - remove it


SVN Path:     http://gpitrsvn.gpi.uni-karlsruhe.de/repos/TFSoftware/branches/su1
SVN Revision: 3681
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent 6d9c75fa
......@@ -21,6 +21,16 @@
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
# ----
#
# targets:
# stuplo: plot seismogram waveforms
# splot: simple spectral analysis (plot amplitude spectrum)
# susplo: plot stacked amplitude spectra
# pamo: plot particle motion
# damplo: plot spatial decay of wave energy
#
# targets available with libfapidxx interface:
# stuplox
#
# REVISIONS and CHANGES
# 30/01/2007 V1.0 Thomas Forbriger
......@@ -28,11 +38,14 @@
# 17/12/2007 V1.2 moved to gfortran
# 08/10/2010 V1.3 migrate to SVN environment
# - discard f2c option
# 13/01/2011 V1.4 - remove polplot from list of standard targets
# polplot has never been realized
# - add target stuplox
#
# ============================================================================
#
PROGRAMS=damplo pamo polplot splot stuplo susplo
PROGRAMS=damplo pamo splot stuplo susplo
all: $(PROGRAMS)
......@@ -85,6 +98,10 @@ stuplo splot susplo: %: %.o
pamo damplo: %: %.o
$(FC) $< -o $@ -ltf -lsffu -ltime -lsff $(PGPLOTLIB) -L$(LOCLIBDIR)
/bin/mv -fv $@ $(LOCBINDIR)
stuplox: %x: %.o
$(FC) $< -o $@ -ltf $(PGPLOTLIB) -L$(LOCLIBDIR) \
-lfapidxx -ldatrwxx -lsffxx -lgsexx -ltime++ -laff
/bin/mv -fv $@ $(LOCBINDIR)
# ----- END OF Makefile -----
c this is <polplot.f>
c $Id$
c
c Copyright 1996, 2010 by Thomas Forbriger
c
c ----
c This program is free software; you can redistribute it and/or modify
c it under the terms of the GNU General Public License as published by
c the Free Software Foundation; either version 2 of the License, or
c (at your option) any later version.
c
c This program is distributed in the hope that it will be useful,
c but WITHOUT ANY WARRANTY; without even the implied warranty of
c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
c GNU General Public License for more details.
c
c You should have received a copy of the GNU General Public License
c along with this program; if not, write to the Free Software
c Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
c ----
c
c plots particle motion
c
c V1.0 09/12/96 Thomas Forbriger
c
c----------------------------------------------------------------------
c
program polplot
character*70 version
parameter(version='POLPLOT V1.0 particle motion')
c datasets
integer maxsamples, maxtraces
parameter(maxsamples=2000000, maxtraces=4)
real fdata(maxsamples)
integer idata(maxsamples)
equivalence (fdata,idata)
integer firstsample(maxtraces)
real xmin(maxtraces), xmax(maxtraces)
real ymin(maxtraces), ymax(maxtraces)
c commandline
integer maxopt, lastarg, iargc
parameter(maxopt=4)
character*2 optid(maxopt)
character*40 optarg(maxopt)
logical optset(maxopt), opthasarg(maxopt)
c variables related to pgplot
character*80 device, botlabel
real timeax(maxsamples)
c here are the keys to our commandline options
data optid/2h-d,2h-D,2h-g,2h-c/
data opthasarg/.TRUE.,2*.FALSE.,.TRUE./
data optarg/3hx11,2*1h-,2hfT/
c----------------------------------------------------------------------
stop
end
c----------------------------------------------------------------------
......@@ -1078,10 +1078,13 @@ c declare variables
character timestamp*13, code*20, line*80, filename*80
c go
c evaluate trace selections
call getarg(filep, filename)
call getarg(filep+1, line)
if (debug) print *,'(DEBUG) line: ',line
if (line(1:2).eq.'t:') then
filep=filep+1
useselect=.true.
if (debug) print *,'(DEBUG): use selection list'
call tf_listselect(maxselect, selection, 3, line, ierr)
if (ierr.eq.1) then
print *,'WARNING: selection exceeds possible range',
......@@ -1099,7 +1102,6 @@ c evaluate trace selections
else
useselect=.false.
endif
call getarg(filep, filename)
c read file header and ignore optional blocks
call sff_ROpen(lu, filename, sffversion,timestamp,code,ierr)
if (ierr.ne.0) stop 'ERROR: opening file'
......@@ -1232,58 +1234,4 @@ c
return
end
c
c----------------------------------------------------------------------
c
c skipdata
c
c skip one complete data block including optional blocks
c
c this function was rewritten because the sff-lib contained
c a bug (the flag moretraces was not returned)
c in sff_SkipData while this program was written
c maybe newer versions of libsff will do it as well
c
subroutine OLDskipdata(lu, moretraces)
c declare parameters
integer lu
logical moretraces
c declare variables
integer ierr, nchar, i
real ampfac
character code*20, lid*5
c go
read(lu, '(a5,1x,i10,1x,e16.6,1x,a)', err=99, end=98)
& lid, nchar, ampfac, code
if (lid.ne.'DAST ')
& stop 'ERROR: data block doesn''t begin with DAST line\n'
read(lu, '(a)', err=99, end=98) lid
if (lid.ne.'WID2 ')
& stop 'ERROR: data block doesn''t contain WID2 line\n'
read(lu, '(a)', err=99, end=98) lid
if (lid.ne.'DAT2 ')
& stop 'ERROR: data block doesn''t contain DAT2 line\n'
do i=1,(nchar/80)
read(lu, '(1x)')
enddo
read(lu, '(a)', err=99, end=98) lid
if (lid.ne.'CHK2 ')
& stop 'ERROR: data block doesn''t end with CHK2 line\n'
i=1
moretraces=.false.
1 if (code(i:i).ne.' ') then
if (code(i:i).eq.'F') then
call sff_SkipFree(lu, ierr)
if (ierr.ne.0) stop 'ERROR: skipping FREE block\n'
endif
if (code(i:i).eq.'I') read(lu,'(1x)', err=99, end=98)
if (code(i:i).eq.'D') moretraces=.true.
i=i+1
goto 1
endif
return
99 stop 'ERROR: reading file\n'
98 stop 'ERROR: unexpected end of file\n'
end
c
c ---- END OF stuplo.f ----
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