source: trunk/src/seismic_processing/hyp2000/hyp.for @ 2768

Revision 2768, 12.7 KB checked in by dietz, 14 years ago (diff)

Incorporated changes from Fred Klein's hyp2000 v1.1 release.
These changes include the option to fix the origin time and
a bunch of little tweaks to make the g77 compiler happy.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
1C--HYP IS THE VAX VERSION OF THE LOCATION PROGRAM HYPOINVERSE. THE PROGRAM
2C  IS DESIGNED TO BE FAST, FILE ORIENTED AND COMMAND DRIVEN.
3
4C--WRITTEN BY FRED KLEIN, 10/2006 VERSION
5
6C++++++++++++++++ LIST OF REQUIRED SUBROUTINES +++++++++++++++++
7C--SUBROUTINES MARKED WITH * REQUIRE THE COMMON BLOCK INCLUDE FILE 'common.inc'
8C  'common.inc' INCLUDES THE FILE 'integer.for' WHERE ARRAYS ARE DECLARED
9C    INTEGER*2 AND LOGICAL*2. *4 VARIABLES MAY BE USED IF NECESSARY.
10C--SUBROUTINES MARKED WITH & HAVE DIFFERENT VERSIONS ON THE SUN, OS2 AND VAX.
11C--USE *.FOR ON ALL SYSTEMS IF IT IS THE ONLY FILE THAT EXISTS.
12C--USE *.F ON SUN AND *.FOR ON THE VAX IF BOTH EXIST.
13C--USE *.OS2 ON OS2 IF IT EXISTS, OTHERWISE *.F THEN *.FOR IN THAT ORDER.
14C--USE integer.os2 INSTEAD OF integer.for ON OS2.
15C  HYP     * MAIN PROGRAM.
16C  HYBDA   * BLOCK DATA INITIALIZATION OF COMMON.
17C  HYBEG  &* INITIALIZATION OF OTHER VARIABLES.
18C  HYCMD   * GETS AND PROCESSES COMMANDS.
19C  HYSTA   * READS IN STATIONS.
20C  HYDEL   * READS IN STATION DELAYS (FOR MULTIPLE MODELS).
21C  HYATE   * READS IN STATION ATTENUATION HISTORY.
22C  HYCAL   * READS IN STATION CALIBRATION FACTOR HISTORY.
23C  HYFMC   * READS IN STATION FMAG CORRECTIONS.
24C  HYXMC   * READS IN STATION XMAG CORRECTIONS.
25C  HYCRH   * READS IN HOMOGENOUS LAYER CRUSTAL MODELS.
26C  HYCRT   * READS IN TRAVEL-TIME-TABLE CRUSTAL MODELS.
27C  HYSTL   * OUTPUTS STATIONS, CRUST & PARAMETERS TO PRINT FILE.
28C  HYOPEN  * OPENS FILES FOR LOCATION RUN.
29C  HYINIT  * INITIALIZES SOME VARIABLES FOR LOCATION RUN.
30C  HYPHS   * READS IN PHASE DATA FOR ONE EVENT.
31C  HYCIN  &* INPUTS PHASE DATA FROM CUSP MEM FILES (ALTERNATE TO HYPHS)
32C  HYCOUT &* OUTPUTS RESULTS TO THE CUSP MEM FILE
33C            (HYCIN & HYCOUT ARE NOT USED IN UNIX/SUN VERSION)
34C  HYTRL   * SETS TRIAL HYPOCENTER.
35C  HYLOC   * LOCATES ONE EVENT.
36C  HYSOL   * PERFORMS INVERSION FOR ONE ITERATION.
37C  HYSVD  &  CANNED SINGLE-VALUE-DECOMPOSITION ROUTINE.
38C            (SEE NOTES IN HYSVD.F AND FPE-TRAPS COMMENT FOR SPECIAL SUN MODS)
39C  HYTRA   * MANAGE CRUST MODEL CHOICE & AVERAGING.
40C  HYTRH   * CALC TRAVEL TIMES AND DERIVS FOR HOMO LAYER MODEL.
41C  HYTRT   * CALC TRAVEL TIMES AND DERIVS FROM TRAV-TIME TABLE.
42C  HYMAG   * COMPUTES ALL MAGNITUDES.
43C  HYMAGP  * COMPUTES P AMPLITUDE MAGNITUDES.
44C  HYPREF  * SELECTS THE PREFERRED MAGNITUDE FROM ALL AVAILABLE.
45C  HYREP   * REPORTS A LOCATION ON THE TERMINAL.
46C  HYSOU   * TABULATES MOST COMMON DATA SOURCE CODES
47C  HYLST   * OUTPUTS DATA BY STATION TO PRINT & ARCHIVE FILES.
48C  HYSUM   * OUTPUTS SUMMARY RECORD (FINAL LOCATION).
49C  HYINP     FOR INTERACTIVE ENTRY OF PHASE DATA.
50C  HYPRO   * INTERACTIVELY PROCESSES A SERIES OF EVENTS.
51C  MEDWT     COMPUTES THE WEIGHTED MEDIAN OF A SERIES OF MAGNITUDES.
52C  HYDELT  & DELETES FILES IN INTERACTIVE PROCESSING
53C  HYEDTI  & RUNS AN EDTIOR WITHIN A PROCESS
54C  HYTIME  & GETS CURRENT SYSTEM TIME FOR LABELING PRINT FILE
55C  UTMCAL    COMPUTES STATION DISTANCES ON A UTM GRID
56
57C--GENERAL PURPOSE SUBROUTINES
58C  KLAS      ASSIGNS A NAME AND NUMBER TO AN EVENT BASED ON LOCATION.
59C  KLASS (NET 1), BOX2 (NET2), BOX3 (NET3), KSIC - USED BY KLAS.
60C  UPSTR     CONVERTS A STRING TO UPPER CASE.
61C  JASK      INTERACTIVE PROMPT & ENTRY OF AN INTEGER.
62C  ASKC      INTERACTIVE PROMPT AND ENTRY OF A STRING.
63C  ASKR      INTERACTIVE PROMPT AND ENTRY OF A REAL VALUE.
64C  LASK      INTERACTIVE PROMPT AND ENTRY OF A LOGICAL VALUE.
65C  LENG      DETERMINES THE NON-BLANK LENGTH OF A STRING.
66C  DAYJL     RETURNS PERPETUAL JULIAN DAY FOR A DATE.
67C  JDATE     RETURNS DATE FOR A PERPETUAL JULIAN DAY.
68C  OPENR  &  OPENS A FILE FOR READING.
69C  OPENW  &  OPENS A FILE FOR WRITING.
70C  ERRSET &  VAX SYSTEM SUBROUTINE ONLY: CONTROLS ERROR MESSAGES ON OVERFLOWS.
71C               (A DUMMY ERRSET.F IS SUPPLIED WITH THE UNIX VERSION)
72C  SPAWN  &  SPAWNS AN OPERATING SYSTEM COMMAND.
73C  READQ  &  READS AN ASCII RECORD AND RETURNS ITS LENGTH.
74C  GETENV &  ON UNIX, RETURNS ENVIRONMENT VAR W/NAME OF INI COMMAND FILE
75C               (A DUMMY GETENV.VAX IS SUPPLIED FOR VAX & OS2 VERSIONS)
76
77C--CUSP SUBROUTINES
78C  MEM_DUMP      READS A CUSP MEM FILE AND PUTS DATA INTO STRUCTURES
79C  OPHASE      PARSES REMARK, WEIGHT & FIRST MOT FROM PHASE DESCRIPTOR
80C  MEM_EQ_UPDATE  PUTS HYPOCENTER & STA INFO INTO CUSP MEMORY (& MEM FILE)
81
82C--DIFFERENCES BETWEEN THE VAX AND SUN/UNIX VERSIONS:
83C--WHERE THEY DIFFER, THE SUBROUTINE SOURCE CODE FILES THAT END IN .F ARE
84C  FOR SUN; THOSE ENDING IN .FOR ARE FOR VAX.  FILES FOR WHICH THERE IS
85C  ONLY A .FOR VERSION WILL COMPILE ON EITHER MACHINE.
86C--ROUTINES WITH DIFFERENT VERSIONS ARE HYBEG, HYDELT, HYEDIT, HYTIME,
87C  SPAWN, INIT_EVENT, HYCIN, OPENR AND OPENW.
88C--HYBEG INITIALIZES FILENAMES AND DEVICES THAT ARE SYSTEM SPECIFIC.
89
90C--THE FOLLOWING "NON-ANSI" FORTRAN FEATURES ARE USED (THESE WERE FLAGGED
91C  BY SUN'S FORTRAN COMPILER WHEN THE -ansi COMMAND FLAG WAS USED):
92C    OPTIONAL INTEGER*2 AND LOGICAL*2 VARIABLES IN COMMON (SEE INTEGER.FOR)
93C    INCLUDE STATEMENT
94C    DO ... END DO STATEMENTS
95C    ! TO BEGIN END OF LINE COMMENTS ('common.' FILE ONLY)
96C    SUBROUTINE NAMES (HYPOINV) LONGER THAN 6 CHARACTERS
97C    LIST-DIRECTED FORMATTING FROM AN INTERNAL STRING
98C    CHARACTER*(*) IN CONCATENATION
99
100C--FPE (FLOATING POINT EXCEPTION) TRAPS.
101C  THE SUN VERSION, WHEN PRESENTED WITH UNDERDETERMINED EARTHQUAKES WITH FEW
102C  READINGS, WOULD SOMETIMES ATTEMPT A ZERO / ZERO OPERATION IN HYSVD. THE
103C  SOLUTION PROGRAMMED INTO HYSVD.F WAS TO TEST THE DIVIDEND AND DIVISOR
104C  BEFORE DIVISION AND TO RETURN A ZERO QUOTIENT IF BOTH WERE 0. THE VAX DOES
105C  THIS AUTOMATICALLY. 0/0 ON THE SUN YIELDS AN IEEE NaN (NOT A NUMBER) WHICH
106C  CONTAMINATES ALL SUCCEEDING VARIABLES THAT DEPEND ON THIS NUMBER. WHEN
107C  EVENTUALLY USED AS A SUBSCRIPT, THE PROGRAM HANGS UNTIL STOPPED WITH ^C.
108C--HERE ARE SUGGESTIONS TO TRAP FPE'S THAT WERE USED TO DETECT THIS 0/0 FPE.
109C  ON THE SUN, COMPILE f77 WITH THE -g OPTION TO STORE LINE NUMBERS IN THE
110C  SOURCE CODE. SUN DOES NOT PERMIT COMPILING THE MAIN PROGRAM WITH BOTH -g
111C  AND A COMMON BLOCK, SO USE A DUMMY MAIN PROGRAM HYPMAIN.F:
112C       CALL TRAPFPE
113C       CALL HYPM
114C       END
115C--THE TRAPFPE SUBROUTINE ENABLES A IEEE HANDLER WHICH IS CALLED WHEN AN FPE
116C  EXCEPTION OCCURS (0/0, OVERFLOW, ETC). THE HANDLER PRINTS THE HEX ADDRESS OF
117C  THE CODE GENERATING THE EXCEPTION, THEN USE THE dbx DEBUGGER TO FIND THE
118C  SOURCE CODE LINE NUMBER. ALTERNATIVELY, USE THE dbxtool WITH CODE COMPILED
119C  WITH THE -g OPTION, AND GIVE THE dbx COMMAND
120c       catch FPE
121C       dbxenv case insensitive ALLOWS EXAMINING HI VARIABLES WITH dbxtool.
122C--SEE SUN'S DEBUGGING TOOLS AND FORTRAN NUMERICAL COMPUTATION DOCUMENTATION
123C  FOR MORE INFO.
124
125C--REMOVAL OF UNNEEDED SUBROUTINES AND DATA TO SAVE MEMORY SPACE:
126C--IF CUSP DATA WILL NOT BE USED (JCP 6 OR 7):
127C    ELIMINATE THE CALLS TO INIT_EVENT AND HYCIN FROM HYP. ALSO ELIMINATE THE
128C    SUBROUTINES CALLED BY HYCIN (SUCH AS GET_* & THE CUSP LIBRARY).
129C    THE COMMAND FID WILL NOT THEN BE NEEDED. ALSO ELIMINATE THE VARIABLES
130C    IRES, LCUSP & FORID FROM COMMON.
131C--IF SHADOW PHASE FORMATS WILL NOT BE USED (JCP 4 & 5):
132C    ELIMINATE THE VARIABLES KSHAD, KLSHA, LENSHA, SHADO, LSHA1 & SHAD1
133C    FROM COMMON, AND REFERENCES TO THEM IN HYPHS AND HYLST.
134C--THE NUMBER OF STATIONS ARE CONTROLED BY THE COMMON PARAMETERS
135C    MAXSTA > MAXPHS > MMAX. THESE CAN BE MADE SMALLER FOR SMALL NETWORKS.
136
137C++++++++++++++++ I/O DEVICE NUMBERS USED ++++++++++++++++++++++
138C  5  TERMINAL INPUT.
139C  6  TERMINAL OUTPUT.
140C  7  ARCHIVE OUTPUT FILE.
141C  8,9,10,11  INPUT COMMAND FILES.
142C 12  SUMMARY OUTPUT FILE.
143C 13  STATION DATA FILES (ATTEN, DELAY, FMAG & XMAG CORRECTIONS).
144C 14  CRUST, STATION & PHASE INPUT FILES.
145C 15  PRINT OUTPUT FILE.
146C 16  MAGNITUDE DATA OUTPUT FILE.
147C 17  EVENT LIST FILE FOR INTERACTIVE PROCESSING
148
149      INCLUDE 'common.inc'
150      CHARACTER XMON(12)*3,CC*1
151      DATA XMON/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP',
152     2 'OCT','NOV','DEC'/
153
154C--DONT GIVE ERROR MESSAGES WHEN DATA OVERFLOW OUTPUT FIELDS
155      CALL ERRSET (63,.TRUE.,.FALSE.,.FALSE.,.FALSE.)
156C--DONT GIVE ERROR MESSAGES WHEN INTEGERS OVERFLOW (BUSTED EVENTS THAT ARE
157C  KICKED OUTSIDE THE NETWORK)
158      CALL ERRSET (70,.TRUE.,.FALSE.,.FALSE.,.FALSE.)
159C--INITIALIZE FLAG TO SUCCESS
160      IRES=1
161
162C--SEND A MESSAGE TO THE TERMINAL. THIS ALSO ASSIGNS UNIT 5 TO TERMINAL
163      WRITE (6,1000)
1641000  FORMAT (' HYPOINVERSE 2000 STARTING'/
165     2' 2/2007 VERSION 1.1 (Can fix origin time)')
166
167C--INITIALIZE VARIABLES NOT INITIALIZED IN BLOCK DATA
168      CALL HYBEG
169
170C--OPEN AND BEGIN READING THE OPTIONAL STARTUP COMMAND FILE HYPINST
171      INP=5
172      CALL OPENR (8,INFILE(1),'F',IOS)
173      IF (IOS.NE.0) GOTO 5
174      INP=8
175
176C--GO GET A COMMAND AND EXECUTE IT. RETURN HERE IF CALLING A SUBROUTINE.
1775     CALL HYCMD
178
179C--ISTAT DIRECTS WHICH SUBROUTINE OR SECTION TO INVOKE.
180C  ISTAT IS ONLY ASSIGNED A VALUE BY HYCMD.
181C  1  CRH  READ LAYER CRUST MODEL
182C  2  CRT  READ GRADIENT TRAVEL TIME TABLE
183C  3  STA  READ STATION FILE
184C  4  INP  INPUT PHASE DATA INTERACTIVELY
185C  5  BUG  READ A PHASE FILE ONLY TO CHECK FOR ERRORS
186C  7  LOC  LOCATE A PHASE FILE
187C  8  STO  STOP HYPOINVERSE, OR RETURN TO MASTER CALLING PROGRAM
188
189      GOTO (10,12,14,74,78,5,84,13), ISTAT
190      GOTO 5
191
192C--<CRH> READ A HOMOGENEOUS LAYER CRUSTAL MODEL
19310    CALL HYCRH
194      CLOSE (14)
195      GOTO 5
196
197C--<CRT> READ A LINEAR GRADIENT CRUSTAL MODEL
19812    CALL HYCRT
199      CLOSE (14)
200      GOTO 5
201
202C--<STO> STOP THE PROGRAM
20313    IF (SUBMOD) THEN
204        CONTINUE
205      ELSE
206        STOP
207      END IF
208
209C--<STA> READ STATION FILE
21014    CALL HYSTA
211      CLOSE (14)
212      GOTO 5
213
214C--<INP> ENTER PHASE DATA MANUALLY INTO A CONDENSED FORMAT FILE.
21574    CALL HYINP
216      GOTO 5
217
218C--<BUG> READ PHASE FILE ONLY TO CHECK FOR ERRORS
219C--OPEN PRINT OUTPUT FILE
22078    LPRT=.TRUE.
221      IF (PRTFIL(1:4).EQ.'    ') PRTFIL=TERMIN
222      IF (LAPP(1)) THEN
223        CALL OPENW (15,PRTFIL,'F',IOS,'A')
224      ELSE
225        CALL OPENW (15,PRTFIL,'F',IOS,'S')
226      END IF
227
228C--OPEN PHASE FILE
229      CALL OPENR (15,PHSFIL,'F',IOS)
230      IF (IOS.NE.0) THEN
231        WRITE (6,1008)
2321008    FORMAT (' *** ERROR - PHASE FILE NOT FOUND')
233        CLOSE (15)
234        IRES=-61
235        GOTO 5
236      END IF
237
238C--LOOP TO READ EVENTS
23980    CALL HYPHS
240      IF (KEND.EQ.0) GOTO 80
241      CLOSE (15)
242      CLOSE (14)
243      GOTO 5
244
245C++++++++++++++++++++ EARTHQUAKE LOCATION SECTION ++++++++++++++++++
246
247C--<LOC>ATE ALL EARTHQUAKES IN THE SPECIFIED FILE, USING PRESENT PARAMETERS
248C--INITIALIZE SOME VARIABLES
24984    CALL HYINIT
250C--OPEN FILES
251      CALL HYOPEN
252
253C--STOP NOW IF THERE IS NO PHASE FILE
254      IF (ISTAT2.EQ.0) GOTO 5
255C--LIST AVAILABLE STATIONS & MODELS IN PRINT FILE
256      CALL HYSTL
257
258      LCUSP=JCP.EQ.6 .OR. JCP.EQ.7
259C--READ IN PHASE DATA FOR ONE EVENT
26050    IF (LCUSP) THEN
261        CALL HYCIN
262      ELSE
263        CALL HYPHS
264      END IF
265
266C--KEND IS SET BY HYPHS DEPENDING ON END-OF-FILE STATUS
267C  =-1  END OF FILE, STOP RIGHT AWAY
268C  = 0  LOCATE THIS EVENT, THEN READ ANOTHER
269C  = 1  END OF FILE, LOCATE THIS EVENT THEN STOP
270C--CLOSE FILES & QUIT IF END OF FILE OCCURRED IN PHASE FILE
271      IF (KEND.LT.0) GOTO 70
272
273C--SET THE TRIAL HYPOCENTER
274      CALL HYTRL
275
276C--PRINT THE EVENT DATE AND TIME AS HEADING
277      IF (LPRT .AND. KPRINT.GT.0) THEN
278        IF (LEJCT) THEN
279          CC='1'
280        ELSE
281          CC=' '
282          WRITE (15,'(1X,21(''####''))')
283        END IF
284
285        WRITE (15,1005) CC,KDAY,XMON(KMONTH),
286     2  KYEAR2,KHOUR,KMIN,INUM,IDNO
2871005    FORMAT (A1,I3,1X,A3,I5,',',I3,':',I2.2,'  SEQUENCE NO.',
288     2  I5,', ID NO.',I10)
289      END IF
290
291C--LOCATE THE EVENT
292      CALL HYLOC
293
294C--ASSIGN A 3-LETTER CODE AND NAME BASED ON LOCATION
295C  I IS THE REGION NUMBER, PRESENTLY UNUSED
296      IF (NET.GT.0) I=KLAS (NET,CLAT,-CLON,Z1,REMK,FULNAM)
297
298C--CALCULATE THE EARTHQUAKE'S MAGNITUDE
299      CALL HYMAG
300
301C--CALCULATE THE EARTHQUAKE'S P AMPLITUDE MAGNITUDE
302      CALL HYMAGP
303
304C--SELECT PREFERRED MAGNITUDE
305      CALL HYPREF
306
307C--TABULATE DATA SOURCE CODES
308      CALL HYSOU
309
310C--GENERATE PRINTED AND ARCHIVE OUTPUT
311      CALL HYLST
312
313C--ABORT THE LOOP IF THERE ARE NOT ENOUGH READINGS
314      IF (NWR.LT.MINSTA) THEN
315        WRITE (6,1002) NWR,KYEAR2,KMONTH,KDAY,KHOUR,KMIN
316        IF (LPRT) WRITE (15,1002) NWR,KYEAR,KMONTH,KDAY,KHOUR,KMIN
3171002    FORMAT (' *** ABANDON EVENT WITH ONLY',I2,' READINGS:',I4,4I3)
318        IRES=-51
319        GOTO 50         !FOR HYP (MAIN PROGRAM) ONLY
320      END IF
321
322C--WRITE RESULTS TO CUSP MEM FILE
323C--JCPO CONTROLS TO WHAT EXTENT RESULTS ARE WRITTEN OUT TO CUSP
324C  =0 NOTHING WRITTEN ANYWHERE
325C  =1 STRUTURES UPDATED
326C  =2 ABOVE PLUS SHARED MEMORY UPDATED
327C  =3 ABOVE PLUS MEM FILE RE-WRITTEN
328      IF (LCUSP .AND. JCPO.GT.0) CALL HYCOUT
329
330C--OUTPUT SUMMARY DATA USING UNIT NUMBER FOR SUMMARY FILE
331      IF (LSUM) CALL HYSUM (12)
332
333C--OUTPUT A MESSAGE ON THE CONSOLE FOR EACH EVENT
334      IF (LREP) CALL HYREP
335
336C--END OF LOCATION LOOP
337      IF (KEND.EQ.0) GOTO 50
338
339C--CLOSE FILES THEN GET ANOTHER COMMAND
34070    CLOSE (12)
341      CLOSE (7)
342      CLOSE (15)
343      CLOSE (14)
344      CLOSE (16)
345      GOTO 5
346
347      END
Note: See TracBrowser for help on using the repository browser.