refract.f 5.32 KB
Newer Older
1
2
3
c this is <refract.f>
c------------------------------------------------------------------------------
c
4
c Copyright 1998, 2010 by Thomas Forbriger (IfG Stuttgart)
5
6
7
c
c REFRACTion seismics - data interpretation
c
thomas.forbriger's avatar
thomas.forbriger committed
8
c ----
9
c refract is free software; you can redistribute it and/or modify
thomas.forbriger's avatar
thomas.forbriger committed
10
11
12
13
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 
14
c refract is distributed in the hope that it will be useful,
thomas.forbriger's avatar
thomas.forbriger committed
15
16
17
18
19
20
21
22
23
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
24
25
26
27
28
29
30
31
32
33
34
35
36
c REVISIONS and CHANGES
c    09/01/98   V3.0   new version based on include-file data
c    03/07/98   V3.1   worked on scaling modes these days
c    05/07/98   V3.2   introduced menu system and element switching
c    08/07/98   V3.3   finished a lot of minor addon with this version
c                      things like model and pick file writing are implemented
c                      now
c    14/08/98   V3.4   added portrait/landscape postscript output
c    18/08/98   V3.5   pick trace arrivals
c    18/11/98   V3.6   check air-coupled sound wave
c    25/11/98   V3.7   had to change read format for arrival times
c                      to read old refra-created picks files
c    18/02/99   V3.8   allow offset scale in degree on a sphere
37
38
c    24/05/00   V3.9   - increased size of option identifier to 3 characters
c                      - introduced new options
thomas.forbriger's avatar
thomas.forbriger committed
39
40
c    24/05/00   V4.0   allowing almost full parameter control from the command
c                      line justifies the step to the next major revision 
41
c    25/05/00   V4.1   usage quick info was missing
thomas.forbriger's avatar
thomas.forbriger committed
42
c    29/07/00   V4.2   introduced option -Ta
thomas.forbriger's avatar
thomas.forbriger committed
43
c    22/01/01   V4.3   improved wiggle-plot
44
c    19/03/02   V4.4   increased polygon breaks visibility
thomas.forbriger's avatar
thomas.forbriger committed
45
c    16/07/2003 V4.5   new option to label traces
thomas.forbriger's avatar
thomas.forbriger committed
46
c    09/09/2004 V4.6   new option to label traces with station names
thomas.forbriger's avatar
thomas.forbriger committed
47
48
c    16/06/2005 V4.7   - set defaults in doplot subroutine
c                      - prefer blue
thomas.forbriger's avatar
thomas.forbriger committed
49
c    26/11/2010 V4.8   provide additional input formats
50
51
c    15/11/2011 V4.8a  this version does safe amplitude scaling even for
c                      unusual cases (see refract_setscale.f)
52
c    20/11/2012 V4.9   several new plot style options are implemented
53
c    24/10/2013 V4.10  added alternative definitions of ordinate scale
54
c    21/03/2014 V4.12  optionally reverse order of legend strings (-TR)
55
56
57
58
59
60
61
c
c==============================================================================
c
      program refract
c
      character*79 version
      parameter(version=
62
     &  'REFRACT   V4.12  REFRACTion seismics - data interpretation')
63
64
c
c get common blocks
65
66
67
68
69
70
      include 'refract_dim.inc'
      include 'refract_data.inc'
      include 'refract_para.inc'
      include 'refract_pgpara.inc'
      include 'refract_seipar.inc'
      include 'refract_opt.inc'
71
c 
thomas.forbriger's avatar
thomas.forbriger committed
72
      integer iargc, lastarg, i
73
74
75
76
77
78
79
80
81
82
83
      character*80 argument
c pgplot
      integer pgp_open
      character*80 device
c
c------------------------------------------------------------------------------
c basic information
c
      argument=' '
      if (iargc().eq.1) call getarg(1, argument)
      if ((argument(1:5).eq.'-help').or.(iargc().lt.1)) then
84
        call refract_usage(version)
85
86
      elseif (argument(1:6).eq.'-xhelp') then
        call refract_usage_formats(version)
87
88
89
90
91
      endif
c
c------------------------------------------------------------------------------
c read command line arguments
c
92
      call refract_cmdopt(version,device,lastarg)
thomas.forbriger's avatar
thomas.forbriger committed
93
94
95
96
97
98
99
100

      if (debug) then
        do i=1,iargc()
          call getarg(i, argument)
          print '(a,i3,a)','DEBUG: arg# ',i,': '
          print '(a79)',argument(1:79)
        enddo
      endif
101
102
103
c
c------------------------------------------------------------------------------
c read input data files
thomas.forbriger's avatar
thomas.forbriger committed
104
105
106
107
108
109
      if (debug) then
        print *,'DEBUG: lastarg=',lastarg
        print *,'DEBUG: iargc=',iargc()
        print *,'DEBUG: expecting to read ',
     &    iargc()-lastarg,' files'
      endif
110
111
112
113
114
115
116
117
118
      call readdata(lastarg)
      if (debug) then
        print *,'DEBUG: ntraces ',ntraces
        print *,'DEBUG: nfiles ',nfiles
      endif
      call setscale
c
      call mpcfactors
      call setfullrange
119
120
121
122
123
124
125
126
127
c 
c------------------------------------------------------------------------------
c read files
c
      call refract_preread
c 
c------------------------------------------------------------------------------
c plot and loop
c 
128
129
      pg_maindevice=pgp_open(device)
      if (pg_maindevice.le.0) stop 'ERROR: opening pgplot device'
130
131
132
133
134
135
136
137
138
139
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
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
c 
      call doplot(pg_maindevice)
      do while (flag_pick)
        call loopaction
        if (flag_replot) then
          call pgask(.false.)
          call pgpage
          call doplot(pg_maindevice)
        endif
      enddo
      call pgclos
c
      stop
      end
c
c ----- END OF refract.f -----