refract_cmdopt.f 11.1 KB
Newer Older
1
2
3
4
5
6
c this is <refract_cmdopt.f>
c------------------------------------------------------------------------------
cS
c
c 24/05/2000 by Thomas Forbriger (IfG Stuttgart)
c
thomas.forbriger's avatar
thomas.forbriger committed
7
c ----
8
c refract is free software; you can redistribute it and/or modify
thomas.forbriger's avatar
thomas.forbriger committed
9
10
11
12
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 
13
c refract is distributed in the hope that it will be useful,
thomas.forbriger's avatar
thomas.forbriger committed
14
15
16
17
18
19
20
21
22
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
23
24
25
26
c read command line options
c
c REVISIONS and CHANGES
c    24/05/2000   V1.0   Thomas Forbriger
thomas.forbriger's avatar
thomas.forbriger committed
27
c    29/07/2000   V1.1   introduced annotations option
28
c    11/01/2001   V1.2   introduced plflag_hypoffset
29
c    18/01/2001   V1.3   corrected braces around units
thomas.forbriger's avatar
thomas.forbriger committed
30
c    17/06/2003   V1.4   introduced new option plflag_tracenum
thomas.forbriger's avatar
thomas.forbriger committed
31
c    09/09/2004   V1.5   introduced new option plflag_tracename
thomas.forbriger's avatar
thomas.forbriger committed
32
c    04/12/2009   V1.6   use correct DIN notation for units
thomas.forbriger's avatar
thomas.forbriger committed
33
c    26/11/2010   V1.7   provide means to select file formats
34
c    14/11/2011   V1.8   remember whether minoff is forced
35
c    12/11/2012   V1.9   new option -Sn
36
c    13/11/2012   V1.10  new option -Ef and -TL
37
c    20/11/2012   V1.11  new option -Eu
38
39
c    24/10/2013   V1.12  - new option -So
c                        - new option -S3
thomas.forbriger's avatar
thomas.forbriger committed
40
c    18/11/2013   V1.13  new option -TF
41
c    21/03/2104 thof:    new option -TR
42
43
44
c
c==============================================================================
c
45
      subroutine refract_cmdopt(version, device, lastarg)
46
47
48
c
c declare parameters
c
49
50
51
52
53
54
55
56
57
58
59
60
61
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
62
63
cE
c declare local variables
64
65
66
      integer i
c commandline
      integer maxopt
67
      parameter(maxopt=68)
68
69
70
71
72
      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
73
74
75
      data (optid(i), i=1,15)/'-D','-d','-v','-p','-C','-L',
     &  '-M','-e','-R','-O','--',
     &  '--','--','--','--'/
76
      data (opthasarg(i), i=1,15)/.FALSE.,.TRUE.,4*.FALSE.,9*.TRUE./
77
      data (optarg(i),i=1,15)    /'-','x11',4*'-','1','0.',7*'-1.'/
78
79
80
81
82
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.'/
83
84
85
      data optid(63)               /'-TL'/
      data opthasarg(63)           /.TRUE./
      data optarg(63)              /'5'/
thomas.forbriger's avatar
thomas.forbriger committed
86
87
88
      data optid(67)               /'-TF'/
      data opthasarg(67)           /.FALSE./
      data optarg(67)              /'-'/
89
90
91
      data optid(68)               /'-TR'/
      data opthasarg(68)           /.FALSE./
      data optarg(68)              /'-'/
92
93
94
95
96
97
98
99
100
101
102
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'/
thomas.forbriger's avatar
thomas.forbriger committed
103
104
105
      data optid(58)               /'-En'/
      data opthasarg(58)           /.FALSE./
      data optarg(58)              /'-'/
thomas.forbriger's avatar
thomas.forbriger committed
106
107
108
      data optid(59)               /'-Es'/
      data opthasarg(59)           /.FALSE./
      data optarg(59)              /'-'/
109
110
111
      data optid(62)               /'-Ef'/
      data opthasarg(62)           /.FALSE./
      data optarg(62)              /'-'/
112
113
114
      data optid(64)               /'-Eu'/
      data opthasarg(64)           /.FALSE./
      data optarg(64)              /'-'/
115
116
117
118
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-'/
thomas.forbriger's avatar
thomas.forbriger committed
119
120
121
      data optid(60)               /'-ty'/
      data opthasarg(60)           /.TRUE./
      data optarg(60)              /'sff'/
122
123
124
125
126
127
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.'/
128
129
130
      data optid(57)               /'-Sh'/
      data opthasarg(57)           /.FALSE./
      data optarg(57)              /'-'/
131
132
133
      data optid(61)               /'-Sn'/
      data opthasarg(61)           /.FALSE./
      data optarg(61)              /'-'/
134
135
136
      data optid(65)               /'-So'/
      data opthasarg(65)           /.TRUE./
      data optarg(65)              /'0'/
137
138
139
      data optid(66)               /'-S3'/
      data opthasarg(66)           /.TRUE./
      data optarg(66)              /'0.,100.'/
140
141
c
c additionals
thomas.forbriger's avatar
thomas.forbriger committed
142
143
144
      data (optid(i),     i=55,56) /'-Lt','-Ta'/
      data (opthasarg(i), i=55,56) /2*.TRUE./
      data (optarg(i),    i=55,56) /'4','NSP'/
145
146
147
c
c------------------------------------------------------------------------------
c go
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
      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
thomas.forbriger's avatar
thomas.forbriger committed
192
      plflag_tracenum=optset(58)
thomas.forbriger's avatar
thomas.forbriger committed
193
      plflag_tracename=optset(59)
194
      elem_vpframe=optset(62)
195
      plflag_subscale=optset(64)
196
197
198
199
200
201
c 
c file reading
      opt_Fpicks=optarg(40)      
      opt_Farrival=optarg(41)      
      opt_Ftaper=optarg(42)      
      opt_Fmodel=optarg(43)      
thomas.forbriger's avatar
thomas.forbriger committed
202
      opt_Fformat=optarg(60)
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
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
219
      plflag_hypoffset=optset(57)
220
      opt_Sosnoreduce=optset(61)
221
222
223
      read(optarg(65), *) opt_Sordinate
      if ((opt_Sordinate.lt.0).or.(opt_Sordinate.gt.3))
     &  stop 'ERROR: argument to -So is out of range'
224
225
226
227
228
229
      opt_Savgref=optset(66)
      read(optarg(66), *), opt_Savgrefxmin, opt_Savgrefxmax
      if ((opt_Savgrefxmin.ge.opt_Savgrefxmax)
     &    .or.(opt_Savgrefxmin.lt.0.)
     &    .or.(opt_Savgrefxmax.lt.0.))
     &  stop 'ERROR: inappropriate values of argument to -S3'
230
231
232
c 
c titles, label, legends
      opt_Ttitle=version
thomas.forbriger's avatar
thomas.forbriger committed
233
      opt_Txlabel='time / s'
thomas.forbriger's avatar
thomas.forbriger committed
234
235
236
237
238
239
      if (opt_Sordinate.eq.0) then
        if (opt_Sradius.gt.0.) then
          opt_Tylabel='offset / ^'
        else
          opt_Tylabel='offset / m'
        endif
240
      else
thomas.forbriger's avatar
thomas.forbriger committed
241
242
        opt_Tylabel='x? coordinate / m'
        write (opt_Tylabel(2:2), '(i1)') opt_Sordinate
243
244
245
246
      endif
      if (optset(16)) opt_Ttitle=optarg(16)
      if (optset(17)) opt_Txlabel=optarg(17)
      if (optset(18)) opt_Tylabel=optarg(18)
thomas.forbriger's avatar
thomas.forbriger committed
247
      opt_Tannotate=optarg(56)
248
249
250
251
252
      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
253
254
255
      read(optarg(63), *) pg_nam_maxlines
      if (pg_nam_maxlines.lt.1) 
     &  stop 'ERROR: at least one line must be provided for file names'
thomas.forbriger's avatar
thomas.forbriger committed
256
      opt_Tfilename=optset(67)
257
      opt_Treverselegend=optset(68)
258
259
260
261
262
263
264
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
265
266
      plpar_forceminoff=optset(53)
      if (plpar_forceminoff) plpar_minoff=opt_Sminoff
267
      if (optset(54)) plpar_radius=opt_Sradius
thomas.forbriger's avatar
thomas.forbriger committed
268
269
270
      if (opt_Savgref) opt_Smode=3
      plpar_mode=opt_Smode
      print *,plpar_mode
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
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
286
      plflag_osnoreduce=opt_Sosnoreduce
287
      plpar_vred=opt_Svel
288
289
290
291
c
      plflag_m3avg=opt_Savgref
      plpar_m3avgxmin=opt_Savgrefxmin
      plpar_m3avgxmax=opt_Savgrefxmax
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
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
317
318
319
320
321
c
      return
      end
c
c ----- END OF refract_cmdopt.f -----