Skip to content

GitLab

Commit 840f7e31 authored by thomas.forbriger's avatar thomas.forbriger
Browse files

master [MERGE]: stuplo 

provide new feature for stuplo
parents 62af9bd8 43d41fcf
Hide whitespace changes
Inline Side-by-side
src/ts/plot/Makefile
View file @ 840f7e31
......@@ -103,12 +103,12 @@ clean: ;
# targets
stuplo splot susplo: %: %.o
$(FC) $< -o $@ -ltf -lsff $(PGPLOTLIB) $(LDFLAGS)
$(FC) $< -o $@ -ltf -lsff -lsffu -ltime $(PGPLOTLIB) $(LDFLAGS)
pamo damplo: %: %.o
$(FC) $< -o $@ -ltf -lsffu -ltime -lsff $(PGPLOTLIB) $(LDFLAGS)
stuplox: %x: %.o
$(FC) $< -o $@ -ltf $(PGPLOTLIB) $(LDFLAGS) \
-lfapidxx -ldatrwxx -lsffxx -lgsexx -ltime++ -laff
-lfapidxx -ldatrwxx -lsffxx -lgsexx -laff -lsffu -ltime++
pamox damplox: %x: %.o
$(FC) $< -o $@ -ltf -lsffu -ltime \
-lfapidxx -ldatrwxx -lsffxx -lgsexx -ltime++ -laff \
......
src/ts/plot/stuplo.f
View file @ 840f7e31
c this is <stuplo.f> by Thomas Forbriger 1996
c
c Copyright 1996, 2010, 2015 by Thomas Forbriger
c Copyright 1996, 2010, 2015, 2016 by Thomas Forbriger
c
c This is a simple plotting tool for seismic time series in
c SFF format
......@@ -89,6 +89,8 @@ c removed ampfac from sffread
c correct determination of extrema
c V1.31 30/09/11 call sff_close upon closing a data file
c V1.32 19/07/15 introduce winplot options -ra, -py, -n1, and -n2
c V1.33 16/11/16 introduce option -st to set time axis relative to
c source
c
c======================================================================
program stuplo
......@@ -99,8 +101,8 @@ c
c version
character*77 version, creator
parameter(version=
& 'STUPLO V1.32 plot seismic time series')
parameter(creator='1996, 2015 by Thomas Forbriger (IfG Stuttgart)')
& 'STUPLO V1.33 plot seismic time series')
parameter(creator='1996, 2016 by Thomas Forbriger (IfG Stuttgart)')
c parameter definitions
integer maxsamples, maxselect, lu, maxtraces, maxchain, maxstyle
parameter(maxsamples=6 000 000)
......@@ -145,6 +147,7 @@ c arras to hold information on data
c file reading variables
character*200 infile
logical moretraces
integer srcedate(7)
c using selections
logical useselect
logical selection(maxselect)
......@@ -157,6 +160,7 @@ c marker
real xmark
c plot style
logical optgrid, optscalex, optscaley, optinline, optabstime
logical optsrcetime
logical opttbox, ftoplab, fbotlab, optfixed, optcolor, optcenter
logical optblack, optvertlab, opttitle, optxlabel, optpgenv
logical optnoxlabels, optsetxrange, optsetyrange, optwhitepaper
......@@ -194,7 +198,7 @@ c variables related to pgplot
real timeax(maxsamples)
c commandline
integer maxopt, lastarg, iargc
parameter(maxopt=41)
parameter(maxopt=42)
character*3 optid(maxopt)
character*200 optarg(maxopt)
logical optset(maxopt), opthasarg(maxopt)
......@@ -202,13 +206,14 @@ c here are the keys to our commandline options
data optid/'-d','-D','-g','-c','-u','-s','-i','-a','-t','-f','-A','-k',
& '-C','-Y','-R','-L','-z','-m','-v','-N','-l','-h','-V','-X',
& '-T','-S','-E','-nT','-x','-y','-W','-Fc','-oS','-wc','-xt',
& '-nx','-ty','-py','-ra','-n1','-n2'/
& '-nx','-ty','-py','-ra','-n1','-n2','-st'/
data opthasarg/.TRUE.,2*.FALSE.,3*.TRUE.,4*.FALSE.,.TRUE.,2*.FALSE.,
& 3*.TRUE.,.FALSE.,.TRUE.,2*.FALSE.,2*.TRUE.,.FALSE.,3*.TRUE.,
& 2*.FALSE.,2*.TRUE.,4*.FALSE.,3*.TRUE.,2*.false.,2*.true./
& 2*.FALSE.,2*.TRUE.,4*.FALSE.,3*.TRUE.,2*.false.,2*.true.,
& .FALSE./
data optarg/'x11',2*'-','fTt',' ','y',4*'-','*',2*'-','1.',2*'0.','-',
& '0.',2*'-','1.,1.,1.','1.,1.,1.,1.','-',2*'-','0.',2*'-',
& 2*'0.,1.',4*'-','0.,0','0,0.','sff','-','-','0','0'/
& 2*'0.,1.',4*'-','0.,0','0,0.','sff','-','-','0','0','-'/
c----------------------------------------------------------------------
c give basic information and help
line=' '
......@@ -221,7 +226,7 @@ c give help information
elseif ((line(1:5).eq.'-help').or.(iargc().lt.1)) then
print 80,version
print *,creator
print 80,'Usage: stuplo [-d dev] [-g] [-a] [-i] [-t] [-k] [-N]'
print 80,'Usage: stuplo [-d dev] [-g] [-a|-st] [-i] [-t] [-k] [-N]'
print 80,' [-Y fac] [-R fac] [-L fac] [-z] [-C]'
print 80,' [-c options] [-s x|y|xy] [-u units]'
print 80,' [-f] [-A comment] [-m time] [-v] [-V]'
......@@ -303,6 +308,7 @@ c give help information
print *,'-----------------'
print *,' '
print *,'-a use absolute time scale'
print *,'-st adjust time axis to source time'
print *,'-s x|y|xy use same scale for all boxes'
print *,' x all x-axis will have the same range'
print *,' y all y-axis will have the same range'
......@@ -483,6 +489,7 @@ c first read the commandline
read(optarg(40), *, end=96, err=97) discardn1
read(optarg(41), *, end=96, err=97) discardn2
c device='/krm3'
optsrcetime=optset(42)
c----------------------------------------------------------------------
c initialize
do ichain=1,maxchain
......@@ -516,7 +523,8 @@ c is there a new chain to start
if (verbose) print 81,' opening data file ',infile(1:ntrim)
call sff_select_input_format(informat, ierr)
if (ierr.ne.0) stop 'ERROR: selecting input file format'
call sffopen(lu, filep, useselect, selection, maxselect, debug)
call sffopen(lu, filep, useselect, selection, maxselect,
& srcedate, debug)
ftrace=0
c start trace loop
2 continue
......@@ -537,7 +545,7 @@ c start a new chain with this trace
& time, sectime, station, channel, auxid,
& instype, fdata, idata, maxsval, average, minsval,
& optabstime, verbose, partimeoff,
& loccs, locc1, locc2)
& loccs, locc1, locc2, optsrcetime, srcedate)
if (debug) then
print *,'DEBUG: dataset parameters:'
write(6,'(" DEBUG:",6(2h >,a,1h<))')
......@@ -914,7 +922,10 @@ c
if (trace.eq.ntraces) fbotlab=.true.
botlabel=' '
if ((trace.eq.ntraces).or.(.not.(optscalex))) then
if (optabstime) then
if (optsrcetime) then
botlabel='time since source event / sec'
if (opttbox) botlabel='time since source event'
elseif (optabstime) then
botlabel='time since midnight / sec'
if (opttbox) botlabel='time since midnight'
else
......@@ -1152,14 +1163,19 @@ c open sff file
c evaluate selection
c read file header
c
subroutine sffopen(lu, filep, useselect, selection, maxselect, debug)
subroutine sffopen(lu, filep, useselect, selection, maxselect,
& srcedate, debug)
c declare parameters
integer lu, filep, maxselect
integer srcedate(7)
logical useselect, selection(maxselect), debug
c declare variables
integer ierr
real sffversion
character timestamp*13, code*20, line*80, filename*80
character srcetype*20, date*6, time*10, cs
real c1, c2, c3
c go
c evaluate trace selections
call getarg(filep, filename)
......@@ -1187,8 +1203,11 @@ c evaluate trace selections
useselect=.false.
endif
c read file header and ignore optional blocks
call sff_ROpen(lu, filename, sffversion,timestamp,code,ierr)
call sff_ROpenS(lu, filename, sffversion,timestamp,code,
& srcetype, cs, c1, c2, c3, date, time,
& ierr)
if (ierr.ne.0) stop 'ERROR: opening file'
call sffu_timesrce(date, time, srcedate)
return
end
c
......@@ -1204,10 +1223,10 @@ c
& time, sectime, station, channel, auxid,
& instype, fdata, idata, maxsval, average, minsval,
& optabstime, verbose, timeshift,
& loccs, locc1, locc2)
& loccs, locc1, locc2, optsrcetime, srcedate)
c declare parameters
character infile*80
logical moretraces, debug, optabstime
logical moretraces, debug, optabstime, optsrcetime
integer maxsamples, lu, trace, maxtraces
integer nsamples(maxtraces), firstsample(maxtraces)
character*80 filename(maxtraces), firstfree(maxtraces)
......@@ -1226,6 +1245,7 @@ c declare parameters
double precision avg
logical verbose
real timeshift
integer srcedate(7)
c declare variables
integer sample, ierr, ntrim, nstack
character wid2line*132, code*20
......@@ -1234,6 +1254,9 @@ c declare variables
integer maxfree, nfree, mfreelen
parameter(maxfree=50)
character*80 freelines(maxfree)
integer tracedate(7), toffset(7)
real sffu_seconds
integer time_compare
c go
call sff_TrimLen(infile,ntrim)
filename(trace)=infile(1:ntrim)
......@@ -1266,7 +1289,14 @@ c translate data from integer to real
minv=fdata(firstsample(trace))
maxv=minv
avg=0.d0
if (optabstime) then
if (optsrcetime) then
call sffu_timewid2(wid2line, tracedate)
call time_sub(tracedate, srcedate, toffset)
stime=sffu_seconds(toffset)
if (time_compare(tracedate, srcedate).lt.0) then
stime=-stime
endif
elseif (optabstime) then
stime=sectime(trace)
else
stime=0.
......
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

Imprint