refract_mpc.f 5.76 KB
Newer Older
1
2
c this is <refract_mpc.f>
c------------------------------------------------------------------------------
thomas.forbriger's avatar
thomas.forbriger committed
3
c $Id$
4
5
6
7
8
c
c 30/04/98 by Thomas Forbriger (IfG Stuttgart)
c
c calculate mpc-factors for all traces
c
thomas.forbriger's avatar
thomas.forbriger committed
9
c ----
10
c refract is free software; you can redistribute it and/or modify
thomas.forbriger's avatar
thomas.forbriger committed
11
12
13
14
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 
15
c refract is distributed in the hope that it will be useful,
thomas.forbriger's avatar
thomas.forbriger committed
16
17
18
19
20
21
22
23
24
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
25
26
27
28
29
30
31
32
c (mpc means 'meters per count' and is in fact the amplitude scaling factor)
c
c REVISIONS and CHANGES
c    30/04/98   V1.0   Thomas Forbriger
c    03/07/98   V1.1   ok - after puzzling hard I admit that there is no way
c                      do find a global reference scale to a global reference 
c                      offset for scaling mode 3 as the actual offset
c                      dependency is unknown
33
34
c    20/11/12   V1.2   use field offset for scaling purposes, not plot
c                      offset
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
c
c==============================================================================
cS
c
      subroutine mpcfactors
c
c calculate mpc-factors for all traces
c
      include 'refract_dim.inc'
      include 'refract_data.inc'
      include 'refract_seipar.inc'
      include 'refract_para.inc'
c
cE
      integer i,j,tref
      real trefoff, refmpc, maxamp
c
c scaling mode 1: individual scaling
c ----------------------------------
      if (plpar_mode.eq.1) then
        do j=1,ntraces
          if (plpar_remav) then
            maxamp=max(abs(maxval(j)-average(j)),abs(minval(j)-average(j)))
          else
            maxamp=max(abs(maxval(j)),abs(minval(j)))
          endif
          trv_mpc(j)=plpar_amp/maxamp
          if (debug) print *,'DEBUG (mpcfactors): trace, mpc ',j,trv_mpc(j)
          if (debug) print *,'DEBUG (mpcfactors): maxamp ',maxamp
          if (debug) print *,'DEBUG (mpcfactors): maxval ',maxval(j)
          if (debug) print *,'DEBUG (mpcfactors): minval ',minval(j)
        enddo
c
c scaling mode 2: least offset trace is reference
c -----------------------------------------------
      elseif (plpar_mode.eq.2) then
71
c find trace with least fieldoffset
72
        tref=1
73
        trefoff=fieldoffset(1)
74
        do j=1,ntraces
75
          if (fieldoffset(j).lt.trefoff) then
76
            tref=j
77
            trefoff=fieldoffset(j)
78
79
80
81
82
83
84
85
86
          endif
        enddo
c calculate reference scale
        if (plpar_remav) then
          maxamp=max(abs(maxval(tref)-average(tref)),
     &      abs(minval(tref)-average(tref)))
        else
          maxamp=max(abs(maxval(tref)),abs(minval(tref)))
        endif
87
        refmpc=plpar_amp/(fieldoffset(tref)**plpar_expo)/maxamp
88
89
c set mpc factors
        do j=1,ntraces
90
          trv_mpc(j)=refmpc*(fieldoffset(j)**plpar_expo)
91
92
93
94
95
96
97
        enddo
c
c scaling mode 3: least offset trace in dataset is reference
c ----------------------------------------------------------
      elseif (plpar_mode.eq.3) then
c go for files
        do i=1,nfiles
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
          print *,'ifile ',i
          if (plflag_m3avg) then
c refer scaling to amplitude average
            navg=0
            maxamp=0.
            do j=1,ntraces
              print *,'itrace ',j,' offset ',fieldoffset(j)
              if ((fileindex(j).eq.i)
     &            .and.(fieldoffset(j).ge.plpar_m3avgxmin)
     &            .and.(fieldoffset(j).le.plpar_m3avgxmax)) then
                navg=navg+1
                if (plpar_remav) then
                  maxamp=maxamp+max(abs(maxval(j)-average(j)),
     &              abs(minval(j)-average(j)))
                else
                  maxamp=maxamp+max(abs(maxval(j)),abs(minval(j)))
                endif
              endif
            enddo
            if (navg.lt.1) then
              print *,'ERROR (mpc): ',
     &          'file ',filename(i)(1:index(filename(i),' ')-1),
     &          ' has no traces in offset range selected by -S3'
              stop 'aborting...'
            endif
            maxamp=maxamp/navg
          else
c refer scaling to nearest offset trace
126
c find trace with least fieldoffset within file
127
128
129
130
            tref=0
            do j=1,ntraces
              if (fileindex(j).eq.i) then
                if (tref.eq.0) then
131
                  tref=j
132
                  trefoff=fieldoffset(j)
133
134
135
136
137
                else
                  if (fieldoffset(j).lt.trefoff) then
                    tref=j
                    trefoff=fieldoffset(j)
                  endif
138
139
                endif
              endif
140
141
142
            enddo
            if (debug) print *,'DEBUG: file ',i,' tref ',tref,
     &        ' trefoff ',trefoff
143
c calculate reference scale with respect to total reference
144
145
146
147
148
149
            if (plpar_remav) then
              maxamp=max(abs(maxval(tref)-average(tref)),
     &          abs(minval(tref)-average(tref)))
            else
              maxamp=max(abs(maxval(tref)),abs(minval(tref)))
            endif
150
          endif
151
          refmpc=plpar_amp/(maxamp*(fieldoffset(tref)**plpar_expo))
152
153
154
c set mpc factors within file
          do j=1,ntraces
            if (fileindex(j).eq.i) then
155
              trv_mpc(j)=refmpc*(fieldoffset(j)**plpar_expo)
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
            endif
          enddo
        enddo
      else
        stop 'ERROR (mpcfactors): unknown scaling mode'
      endif
c 
      if (debug) then
        do j=1,ntraces
          print *,'DEBUG: trace ',j,' mpc: ',trv_mpc(j)
        enddo
      endif
c 
      return
      end
c
c ----- END OF refract_mpc.f -----