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

a lot of new command line options are now waiting for you...

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: 175
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent ff7e33f9
......@@ -29,7 +29,8 @@ REFSUB=refract_readdata.o refract_skipdata.o refract_setdefaults.o \
refract_selstyle.o refract_pgnamscal.o refract_pgfilenames.o \
refract_varplot.o refract_pgparameters.o refract_ttreduce.o \
refract_message.o refract_dopicks.o refract_domodel.o refract_usage.o \
refract_cmdopt.o
refract_cmdopt.o refract_selfilestyle.o refract_preread.o \
refract_pgdefaults.o
REFOBS=refract.o $(addprefix sub/, $(REFSUB))
include make.incdep
......
c this is <refract_opt.inc>
c------------------------------------------------------------------------------
c $Id: refract_opt.inc,v 1.2 2000-05-24 15:27:16 thof Exp $
c
c 17/03/98 by Thomas Forbriger (IfG Stuttgart)
c
......@@ -7,8 +8,52 @@ c options common block for refract
c
c REVISIONS and CHANGES
c 17/03/98 V1.0 Thomas Forbriger
c 24/05/00 V1.1 activated
c
c==============================================================================
c
c titles, labels, legends
character*120 opt_Ttitle
character*120 opt_Txlabel
character*120 opt_Tylabel
logical opt_Tmode, opt_Tlegend, opt_Tmodel
real opt_Tscale, opt_Tmodx, opt_Tmodt
c
c line and color options
integer opt_Lwidth, opt_Lmax, opt_Cmax, opt_Lttwidth
real opt_Cbgrgb(3), opt_Cfgrgb(3)
logical opt_Lcycle, opt_Ccycle, opt_Cswap
c
c elements and style
logical opt_Egrid, opt_Ewiggle, opt_Ebubble
logical opt_Epicks, opt_Ewave, opt_Ett
logical opt_ECpicks, opt_ECwave, opt_ECtt
c
c file reading
character*80 opt_Fpicks
character*80 opt_Farrival
character*80 opt_Ftaper
character*80 opt_Fmodel
c
c scaling
real opt_Sxmin, opt_Sxmax, opt_Stmin, opt_Stmax
real opt_Sexp, opt_Samp, opt_Sclip, opt_Svel, opt_Sminoff, opt_Sradius
integer opt_Smode
logical opt_Sinv, opt_Savg, opt_Sxrange, opt_Strange, opt_Sreduce
c
c common blocks
common /refract_optS/ opt_Ttitle, opt_Txlabel, opt_Tylabel,
& opt_Fpicks, opt_Farrival, opt_Ftaper, opt_Fmodel
common /refract_optI/ opt_Lwidth, opt_Lmax, opt_Cmax, opt_Smode
common /refract_optR/ opt_Tscale, opt_Cbgrgb(3), opt_Cfgrgb(3),
& opt_Sxmin, opt_Sxmax, opt_Stmin, opt_Stmax,
& opt_Sexp, opt_Samp, opt_Sclip, opt_Svel,
& opt_Sminoff, opt_Sradius, opt_Tmodx, opt_Tmodt,
& opt_Lttwidth
common /refract_optL/ opt_Tmode, opt_Tlegend, opt_Tmodel, opt_Lcycle,
& opt_Ccycle, opt_Cswap, opt_Egrid, opt_Ewiggle,
& opt_Ebubble, opt_Epicks, opt_Ewave, opt_Ett,
& opt_ECpicks, opt_ECwave, opt_ECtt, opt_Sinv,
& opt_Savg, opt_Sxrange, opt_Strange, opt_Sreduce
c
c ----- END OF refract_opt.inc -----
c this is <refract_pgpara.inc>
c------------------------------------------------------------------------------
c $Id: refract_pgpara.inc,v 1.2 2000-05-24 09:28:45 thof Exp $
c $Id: refract_pgpara.inc,v 1.3 2000-05-24 15:27:16 thof Exp $
c
c 01/05/98 by Thomas Forbriger (IfG Stuttgart)
c
......@@ -8,7 +8,10 @@ c pure pgplot style settings
c
c REVISIONS and CHANGES
c 01/05/98 V1.0 Thomas Forbriger
c 24/05/00 V1.1 file specific style settings
c 24/05/00 V1.1 - file specific style settings
c - axis labels
c - line width and character height
c - fg and bg RGB
c
c==============================================================================
c
......@@ -31,8 +34,24 @@ c plotting parameters for file names
real pg_nam_relwidth(maxfiles)
real pg_nam_ch, pg_nam_xsep, pg_nam_ysep, pg_nam_scale
c
c standard line width
integer pg_std_lw
c
c standard character height
real pg_std_ch
c
c RGB values
real pg_std_fgrgb(3), pg_std_bgrgb(3)
c
c line width for synthetic travel time curves
integer pg_syntt_lw
c
c program title
character*80 pg_title
character*100 pg_title
c
c axis labels
character*100 pg_xlabel
character*100 pg_ylabel
c
c actual pmmode
character*20 pg_pmmode
......@@ -42,9 +61,12 @@ c actual pickmode
c
c common blocks
common /refr_pgpara/ pg_maindevice
common /refr_pgstrings/ pg_title, pg_pmmode, pg_pickmode
common /refr_pgstrings/ pg_title, pg_xlabel, pg_ylabel,
& pg_pmmode, pg_pickmode
common /refr_pgnam/ pg_nam_relwidth, pg_nam_maxheight, pg_nam_rest,
& pg_nam_ch, pg_nam_xsep, pg_nam_ysep, pg_nam_scale
common /refr_pgfile/ pg_file_ls, pg_file_lw, pg_file_ci, pg_file_rgb
common /refr_pgstd/ pg_std_lw, pg_std_ch, pg_std_fgrgb, pg_std_bgrgb
common /refr_pgsettings/ pg_syntt_lw
c
c ----- END OF refract_pgpara.inc -----
c this is <refract.f>
c------------------------------------------------------------------------------
c $Id: refract.f,v 1.3 2000-05-24 09:28:45 thof Exp $
c $Id: refract.f,v 1.4 2000-05-24 15:27:16 thof Exp $
c
c 09/01/98 by Thomas Forbriger (IfG Stuttgart)
c
......@@ -35,27 +35,14 @@ c get common blocks
include 'include/refract_data.inc'
include 'include/refract_para.inc'
include 'include/refract_pgpara.inc'
c commandline
integer maxopt, lastarg, iargc
include 'include/refract_seipar.inc'
include 'include/refract_opt.inc'
c
integer iargc, lastarg
character*80 argument
parameter(maxopt=15)
character*3 optid(maxopt)
character*80 optarg(maxopt)
logical optset(maxopt), opthasarg(maxopt)
c bounding box
real bbt1,bbt2,ttr1,bbr2
logical optbbset
c amplitude scape, etc.
real optamp, optclip, optlwidth, optch
logical optampset, optclipset, optlwidthset, optchset
c pgplot
integer pgp_open
character*80 device
c here are the keys to our commandline options
data optid/2h-D,2h-d,2h-v,2h-p,2h-C,2h-L,2h-M,2h-e,2h-R,2h-O,2h-c,
& 2h-a,2h-H,2h-l,2h-b/
data opthasarg/.FALSE.,.TRUE.,4*.FALSE.,9*.TRUE./
data optarg/1h-,3hx11,4*1h-,1h1,2h0.,7*3h-1./
c
c------------------------------------------------------------------------------
c basic information
......@@ -69,25 +56,7 @@ c
c------------------------------------------------------------------------------
c read command line arguments
c
call tf_cmdline(1, lastarg, maxopt, optid,
& optarg, optset, opthasarg)
c
c set defaults before evaluating command line
call setdefaults
c
debug=optset(1)
device=optarg(2)
verbose=optset(3)
flag_pick=optset(4)
plflag_color=optset(5)
plflag_linestyle=optset(6)
if (optset(7)) read (optarg(7), '(i10)') plpar_mode
if (optset(8)) read (optarg(8), '(f10.3)') plpar_expo
if (debug) print *,'DEBUG is active'
read(optarg(9), *) plpar_radius
if (optset(10)) read(optarg(10), *) plpar_minoff
c
pg_title=version
call refract_cmdopt(version,device,lastarg)
c
c------------------------------------------------------------------------------
c read input data files
......@@ -100,9 +69,29 @@ c read input data files
c
call mpcfactors
call setfullrange
c
c------------------------------------------------------------------------------
c read files
c
call refract_preread
c
c------------------------------------------------------------------------------
c plot and loop
c
pg_maindevice=pgp_open(device)
if (pg_maindevice.le.0) stop 'ERROR: opening pgplot device'
call refract_pgdefaults
call refract_pgnamscal
c
c set window to command line settings
if (opt_Sxrange) then
tov_rmin=opt_Sxmin
tov_rmax=opt_Sxmax
endif
if (opt_Strange) then
tov_tmin=opt_Stmin
tov_tmax=opt_Stmax
endif
c
call doplot(pg_maindevice)
do while (flag_pick)
......
......@@ -2,7 +2,7 @@ c this is <refract_cmdopt.f>
c------------------------------------------------------------------------------
cS
c ($Source: /home/tforb/svnbuild/cvssource/CVS/thof/src/ts/refract/sub/refract_cmdopt.f,v $)
c ($Id: refract_cmdopt.f,v 1.1 2000-05-24 09:28:45 thof Exp $)
c ($Id: refract_cmdopt.f,v 1.2 2000-05-24 15:27:16 thof Exp $)
c
c 24/05/2000 by Thomas Forbriger (IfG Stuttgart)
c
......@@ -13,17 +13,210 @@ c 24/05/2000 V1.0 Thomas Forbriger
c
c==============================================================================
c
subroutine refract_cmdopt
subroutine refract_cmdopt(version, device, lastarg)
c
c declare parameters
c
c version: refract version string (input)
c device: selected PGPLOT device (output)
c lastarg: last argument index returned by tf_cmdline (output)
c
character*(*) version, device
integer lastarg
c
include 'refract_dim.inc'
include 'refract_para.inc'
include 'refract_pgpara.inc'
include 'refract_opt.inc'
include 'refract_model.inc'
c
cE
c declare local variables
integer i
c CVS Id
character*(*) refract_cmdopt_id
parameter (refract_cmdopt_id='$Id: refract_cmdopt.f,v 1.1 2000-05-24 09:28:45 thof Exp $')
parameter (refract_cmdopt_id='$Id: refract_cmdopt.f,v 1.2 2000-05-24 15:27:16 thof Exp $')
c commandline
integer maxopt
parameter(maxopt=55)
character*3 optid(maxopt)
character*120 optarg(maxopt)
logical optset(maxopt), opthasarg(maxopt)
c here are the keys to our commandline options
c old command line options
data (optid(i), i=1,15)/2h-D,2h-d,2h-v,2h-p,2h-C,2h-L,
& 2h-M,2h-e,2h-R,2h-O,2h--,
& 2h--,2h--,2h--,2h--/
data (opthasarg(i), i=1,15)/.FALSE.,.TRUE.,4*.FALSE.,9*.TRUE./
data (optarg(i),i=1,15) /1h-,3hx11,4*1h-,1h1,2h0.,7*3h-1./
c titles, labels, legends
data (optid(i), i=16,22) /'-Tt','-Tx','-Ty','-Tm','-Tl',
& '-Ts','-TM'/
data (opthasarg(i), i=16,22) /7*.TRUE./
data (optarg(i), i=16,22) /3*'-',2*'T','1.','0.,0.'/
c line options and color options
data (optid(i), i=23,30) /'-Lw','-Lc','-Lm','-Cb','-Cf',
& '-CW','-Cc','-Cm'/
data (opthasarg(i), i=23,30) /.TRUE.,.FALSE.,3*.TRUE.,2*.FALSE.,.TRUE./
data (optarg(i), i=23,30) /'1','-','4','1.,1.,1.','0.,0.,0.',
& 2*'-','5'/
c elements and style options
data (optid(i), i=31,39) /'-Eg','-Ev','-Eb','-EP','-ES','-ET',
& '-Ew','-Et','-Ep'/
data (opthasarg(i), i=31,39) /3*.FALSE.,6*.TRUE./
data (optarg(i), i=31,39) /3*'-',6*'T'/
c file reading
data (optid(i), i=40,43) /'-Fp','-Fa','-Ft','-Fm'/
data (opthasarg(i), i=40,43) /4*.TRUE./
data (optarg(i), i=40,43) /4*'-NONE-'/
c seismograms scaling
data (optid(i), i=44,54) /'-Sx','-St','-Se','-Sa','-Sc','-Sm',
& '-Sr','-Si','-SM','-SO','-SR'/
data (opthasarg(i), i=44,54) /7*.TRUE.,2*.FALSE.,2*.TRUE./
data (optarg(i), i=44,54) /2*'-','0.',2*'-1.','1','3.',2*'-',
& '0.1','-1.'/
c
c additionals
data (optid(i), i=55,55) /'-Lt'/
data (opthasarg(i), i=55,55) /.TRUE./
data (optarg(i), i=55,55) /'4'/
c
c------------------------------------------------------------------------------
c go
call tf_cmdline(1, lastarg, maxopt, optid,
& optarg, optset, opthasarg)
c
c set defaults before evaluating command line
call setdefaults
c
c process traditional options
c ===========================
debug=optset(1)
device=optarg(2)
verbose=optset(3)
flag_pick=optset(4)
plflag_color=optset(5)
plflag_linestyle=optset(6)
if (optset(7)) read (optarg(7), '(i10)') plpar_mode
if (optset(8)) read (optarg(8), '(f10.3)') plpar_expo
if (debug) print *,'DEBUG is active'
read(optarg(9), *) plpar_radius
if (optset(10)) read(optarg(10), *) plpar_minoff
c
c process options
c ===============
c
c line and color options
read(optarg(23), *) opt_Lwidth
opt_Lcycle=optset(24)
read(optarg(25), *) opt_Lmax
read(optarg(26), *) (opt_Cbgrgb(i),i=1,3)
read(optarg(27), *) (opt_Cfgrgb(i),i=1,3)
opt_Cswap=optset(28)
opt_Ccycle=optset(29)
read(optarg(30), *) opt_Cmax
read(optarg(55), *) opt_Lttwidth
c
c elements and style
opt_Egrid=optset(31)
opt_Ewiggle=optset(32)
opt_Ebubble=optset(33)
read(optarg(34), *) opt_ECpicks
read(optarg(35), *) opt_ECwave
read(optarg(36), *) opt_ECtt
read(optarg(37), *) opt_Ewave
read(optarg(38), *) opt_Ett
read(optarg(39), *) opt_Epicks
c
c file reading
opt_Fpicks=optarg(40)
opt_Farrival=optarg(41)
opt_Ftaper=optarg(42)
opt_Fmodel=optarg(43)
c
c seismogram scaling
opt_Sxrange=optset(44)
if (opt_Sxrange) read(optarg(44), *) opt_Sxmin,opt_Sxmax
opt_Strange=optset(45)
if (opt_Strange) read(optarg(45), *) opt_Stmin,opt_Stmax
read(optarg(46), *) opt_Sexp
read(optarg(47), *) opt_Samp
read(optarg(48), *) opt_Sclip
read(optarg(49), *) opt_Smode
opt_Sreduce=optset(50)
read(optarg(50), *) opt_Svel
opt_Sinv=optset(51)
opt_Savg=optset(52)
read(optarg(53), *) opt_Sminoff
read(optarg(54), *) opt_Sradius
c
c titles, label, legends
opt_Ttitle=version
opt_Txlabel='time [s]'
if (opt_Sradius.gt.0.) then
opt_Tylabel='offset [^]'
else
opt_Tylabel='offset [m]'
endif
if (optset(16)) opt_Ttitle=optarg(16)
if (optset(17)) opt_Txlabel=optarg(17)
if (optset(18)) opt_Tylabel=optarg(18)
read(optarg(19), *) opt_Tmode
read(optarg(20), *) opt_Tlegend
read(optarg(21), *) opt_Tscale
opt_Tmodel=optset(22)
read(optarg(22), *) opt_Tmodt, opt_Tmodx
c
c override traditional options
c ============================
c
if (optset(24)) plflag_linestyle=opt_Lcycle
if (optset(29)) plflag_color=opt_Ccycle
if (optset(46)) plpar_expo=opt_Sexp
if (optset(49)) plpar_mode=opt_Smode
if (optset(53)) plpar_minoff=opt_Sminoff
if (optset(54)) plpar_radius=opt_Sradius
c
c evaluate options as far as possible
c ===================================
c
pg_title=opt_Ttitle
pg_xlabel=opt_Txlabel
pg_ylabel=opt_Tylabel
elem_filenames=opt_Tlegend
elem_modbox=opt_Tmodel
elem_annot=opt_Tmode
pg_std_ch=opt_Tscale
c
plpar_remav=opt_Savg
plflag_invers=opt_Sinv
plflag_reduce=opt_Sreduce
plpar_vred=opt_Svel
c
plflag_grid=opt_Egrid
plflag_vara=opt_Ewiggle
plflag_bubbles=opt_Ebubble
plflag_seistyle=opt_ECwave
plflag_ttstyle=opt_ECtt
elem_data=opt_Ewave
elem_syntt=opt_Ett
elem_picks=opt_Epicks
c
plpar_colcyc=opt_Cmax
plpar_lscyc=opt_Lmax
pg_std_lw=opt_Lwidth
do i=1,3
if (opt_Cswap) then
pg_std_bgrgb(i)=opt_Cfgrgb(i)
pg_std_fgrgb(i)=opt_Cbgrgb(i)
else
pg_std_fgrgb(i)=opt_Cfgrgb(i)
pg_std_bgrgb(i)=opt_Cbgrgb(i)
endif
enddo
mod_boxx=opt_Tmodt
mod_boxy=opt_Tmodx
pg_syntt_lw=opt_Lttwidth
c
return
c the following line prevents the linker from removing the ID string
......
c this is <refract_domodel.f>
c------------------------------------------------------------------------------
c $Id: refract_domodel.f,v 1.2 2000-05-24 15:27:16 thof Exp $
c
c 05/07/98 by Thomas Forbriger (IfG Stuttgart)
c
......@@ -7,6 +8,8 @@ c some routines we need to work on models
c
c REVISIONS and CHANGES
c 05/07/98 V1.0 Thomas Forbriger
c 24/05/00 V1.1 - subdivided model reading
c - allow line width setting for synthetic traveltimes
c
c==============================================================================
c
......@@ -92,6 +95,7 @@ c
include 'refract_seipar.inc'
include 'refract_model.inc'
include 'refract_para.inc'
include 'refract_pgpara.inc'
c
c declare variables
c
......@@ -106,7 +110,7 @@ c
c save settings
call pgsave
c new settings
call pgslw(4)
call pgslw(pg_syntt_lw)
c
if (plflag_ttstyle) call refract_selstyle(1)
call pgmove(0.,0.)
......@@ -347,27 +351,23 @@ c keep character size
end
c
c----------------------------------------------------------------------
c perform model reading
c
subroutine refract_readmodel
subroutine refract_doreadmodel(filename)
c
include 'refract_model.inc'
include 'refract_dim.inc'
include 'refract_pgpara.inc'
include 'refract_para.inc'
c
character*80 filename
character*(*) filename
c
integer lu, i
parameter(lu=10)
real depth, depthold, velocity
c
if ((mod_valid).and.((elem_modbox).or.(elem_syntt))) flag_replot=.true.
mod_valid=.true.
c
write(6, 50)
read(5,51) filename
c
print *,'reading to ',filename(1:index(filename,' '))
print *,'(will read depth and velocity!)'
c
open(lu, file=filename, status='old', err=99)
c
......@@ -406,8 +406,6 @@ c check model
endif
c
return
50 format('model input filename:')
51 format(a)
52 format(/'earth model containing ',i3,' layers'//
& 'layer',2x,' depth [m]',2x,
& ' thickness [m]',2x,
......@@ -421,6 +419,30 @@ c
end
c
c----------------------------------------------------------------------
c ask for filename and initiate model reading
c
subroutine refract_readmodel
c
include 'refract_model.inc'
include 'refract_dim.inc'
include 'refract_pgpara.inc'
include 'refract_para.inc'
c
character*80 filename
c
write(6, 50)
read(5,51) filename
c
print *,'reading from ',filename(1:index(filename,' '))
print *,'(will read depth and velocity!)'
call refract_doreadmodel(filename)
c
return
50 format('model input filename:')
51 format(a)
end
c
c----------------------------------------------------------------------
c
subroutine refract_writemodel
c
......
c this is <refract_dopicks.f>
c------------------------------------------------------------------------------
c $Id: refract_dopicks.f,v 1.2 2000-05-24 15:27:16 thof Exp $
c
c 05/07/98 by Thomas Forbriger (IfG Stuttgart)
c
......@@ -9,6 +10,7 @@ c REVISIONS and CHANGES
c 05/07/98 V1.0 Thomas Forbriger
c 18/07/98 V1.1 now allow one single pick per each trace
c - changed traveltime units to [km] and [s]
c 24/05/00 V1.2 subdivided readttpicks
c
c==============================================================================
c
......@@ -320,26 +322,23 @@ c
c
c----------------------------------------------------------------------
c
subroutine refract_readttpicks(iset)
subroutine refract_doreadttpicks(filename, iset)
c
c read traveltime picks from file to pickset iset
c perform actual reading
c
include 'refract_picks.inc'
include 'refract_para.inc'
c
integer iset
c
character*80 filename
character*(*) filename
c
integer lu, i
parameter(lu=10)