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

Revision 3172, 13.1 KB checked in by paulf, 13 years ago (diff)

changes for g77

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
1C--HYP IS THE VAX/SUN 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. SEE GREETING IN HYBDA.FOR FOR 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--VERY PARTIAL VERSION HISTORY
138C
139C  1978 VERSION 0.x (Eclipse computer, simple & compact)
140C  1985 VERSION 0.x (VAX and pro-350 computer, compact)
141C  1989 VERSION 0.x (multiple crust models)
142C  2002 VERSION 1.0 (Full documentation, completely Y2000 capable)
143C  2/2007 VERSION 1.1 (Can fix origin time, many other changes)
144C  5/2007 VERSION 1.11 (Can fix origin time, greeting)
145C  12/2007 VERSION 1.2 (Can fix origin time; g77 compiler)
146
147C++++++++++++++++ I/O DEVICE NUMBERS USED ++++++++++++++++++++++
148C  5  TERMINAL INPUT.
149C  6  TERMINAL OUTPUT.
150C  7  ARCHIVE OUTPUT FILE.
151C  8,9,10,11  INPUT COMMAND FILES.
152C 12  SUMMARY OUTPUT FILE.
153C 13  STATION DATA FILES (ATTEN, DELAY, FMAG & XMAG CORRECTIONS).
154C 14  CRUST, STATION & PHASE INPUT FILES.
155C 15  PRINT OUTPUT FILE.
156C 16  MAGNITUDE DATA OUTPUT FILE.
157C 17  EVENT LIST FILE FOR INTERACTIVE PROCESSING
158
159      INCLUDE 'common.inc'
160      CHARACTER XMON(12)*3,CC*1
161      DATA XMON/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP',
162     2 'OCT','NOV','DEC'/
163
164C--DONT GIVE ERROR MESSAGES WHEN DATA OVERFLOW OUTPUT FIELDS
165      CALL ERRSET (63,.TRUE.,.FALSE.,.FALSE.,.FALSE.)
166C--DONT GIVE ERROR MESSAGES WHEN INTEGERS OVERFLOW (BUSTED EVENTS THAT ARE
167C  KICKED OUTSIDE THE NETWORK)
168      CALL ERRSET (70,.TRUE.,.FALSE.,.FALSE.,.FALSE.)
169C--INITIALIZE FLAG TO SUCCESS
170      IRES=1
171
172C--SEND A MESSAGE TO THE TERMINAL. THIS ALSO ASSIGNS UNIT 5 TO TERMINAL
173      WRITE (6,1000)
1741000  FORMAT (' HYPOINVERSE 2000 STARTING')
175      WRITE (6,'(A)') GREETING
176
177C--INITIALIZE VARIABLES NOT INITIALIZED IN BLOCK DATA
178      CALL HYBEG
179
180C--OPEN AND BEGIN READING THE OPTIONAL STARTUP COMMAND FILE HYPINST
181      INP=5
182      CALL OPENR (8,INFILE(1),'F',IOS)
183      IF (IOS.NE.0) GOTO 5
184      INP=8
185
186C--GO GET A COMMAND AND EXECUTE IT. RETURN HERE IF CALLING A SUBROUTINE.
1875     CALL HYCMD
188
189C--ISTAT DIRECTS WHICH SUBROUTINE OR SECTION TO INVOKE.
190C  ISTAT IS ONLY ASSIGNED A VALUE BY HYCMD.
191C  1  CRH  READ LAYER CRUST MODEL
192C  2  CRT  READ GRADIENT TRAVEL TIME TABLE
193C  3  STA  READ STATION FILE
194C  4  INP  INPUT PHASE DATA INTERACTIVELY
195C  5  BUG  READ A PHASE FILE ONLY TO CHECK FOR ERRORS
196C  7  LOC  LOCATE A PHASE FILE
197C  8  STO  STOP HYPOINVERSE, OR RETURN TO MASTER CALLING PROGRAM
198
199      GOTO (10,12,14,74,78,5,84,13), ISTAT
200      GOTO 5
201
202C--<CRH> READ A HOMOGENEOUS LAYER CRUSTAL MODEL
20310    CALL HYCRH
204      CLOSE (14)
205      GOTO 5
206
207C--<CRT> READ A LINEAR GRADIENT CRUSTAL MODEL
20812    CALL HYCRT
209      CLOSE (14)
210      GOTO 5
211
212C--<STO> STOP THE PROGRAM
21313    IF (SUBMOD) THEN
214        CONTINUE
215      ELSE
216        STOP
217      END IF
218
219C--<STA> READ STATION FILE
22014    CALL HYSTA
221      CLOSE (14)
222      GOTO 5
223
224C--<INP> ENTER PHASE DATA MANUALLY INTO A CONDENSED FORMAT FILE.
22574    CALL HYINP
226      GOTO 5
227
228C--<BUG> READ PHASE FILE ONLY TO CHECK FOR ERRORS
229C--OPEN PRINT OUTPUT FILE
23078    LPRT=.TRUE.
231      IF (PRTFIL(1:4).EQ.'    ') PRTFIL=TERMIN
232      IF (LAPP(1)) THEN
233        CALL OPENW (15,PRTFIL,'F',IOS,'A')
234      ELSE
235        CALL OPENW (15,PRTFIL,'F',IOS,'S')
236      END IF
237
238C--OPEN PHASE FILE
239      CALL OPENR (15,PHSFIL,'F',IOS)
240      IF (IOS.NE.0) THEN
241        WRITE (6,1008)
2421008    FORMAT (' *** ERROR - PHASE FILE NOT FOUND')
243        CLOSE (15)
244        IRES=-61
245        GOTO 5
246      END IF
247
248C--LOOP TO READ EVENTS
24980    CALL HYPHS
250      IF (KEND.EQ.0) GOTO 80
251      CLOSE (15)
252      CLOSE (14)
253      GOTO 5
254
255C++++++++++++++++++++ EARTHQUAKE LOCATION SECTION ++++++++++++++++++
256
257C--<LOC>ATE ALL EARTHQUAKES IN THE SPECIFIED FILE, USING PRESENT PARAMETERS
258C--INITIALIZE SOME VARIABLES
25984    CALL HYINIT
260C--OPEN FILES
261      CALL HYOPEN
262
263C--STOP NOW IF THERE IS NO PHASE FILE
264      IF (ISTAT2.EQ.0) GOTO 5
265C--LIST AVAILABLE STATIONS & MODELS IN PRINT FILE
266      CALL HYSTL
267
268      LCUSP=JCP.EQ.6 .OR. JCP.EQ.7
269C--READ IN PHASE DATA FOR ONE EVENT
27050    IF (LCUSP) THEN
271        CALL HYCIN
272      ELSE
273        CALL HYPHS
274      END IF
275
276C--KEND IS SET BY HYPHS DEPENDING ON END-OF-FILE STATUS
277C  =-1  END OF FILE, STOP RIGHT AWAY
278C  = 0  LOCATE THIS EVENT, THEN READ ANOTHER
279C  = 1  END OF FILE, LOCATE THIS EVENT THEN STOP
280C--CLOSE FILES & QUIT IF END OF FILE OCCURRED IN PHASE FILE
281      IF (KEND.LT.0) GOTO 70
282
283C--SET THE TRIAL HYPOCENTER
284      CALL HYTRL
285
286C--PRINT THE EVENT DATE AND TIME AS HEADING
287      IF (LPRT .AND. KPRINT.GT.0) THEN
288        IF (LEJCT) THEN
289          CC='1'
290        ELSE
291          CC=' '
292          WRITE (15,'(1X,21(''####''))')
293        END IF
294
295        WRITE (15,1005) CC,KDAY,XMON(KMONTH),
296     2  KYEAR2,KHOUR,KMIN,INUM,IDNO
2971005    FORMAT (A1,I3,1X,A3,I5,',',I3,':',I2.2,'  SEQUENCE NO.',
298     2  I5,', ID NO.',I10)
299      END IF
300
301C--LOCATE THE EVENT
302      CALL HYLOC
303
304C--ASSIGN A 3-LETTER CODE AND NAME BASED ON LOCATION
305C  I IS THE REGION NUMBER, PRESENTLY UNUSED
306      IF (NET.GT.0) I=KLAS (NET,CLAT,-CLON,Z1,REMK,FULNAM)
307
308C--CALCULATE THE EARTHQUAKE'S MAGNITUDE
309      CALL HYMAG
310
311C--CALCULATE THE EARTHQUAKE'S P AMPLITUDE MAGNITUDE
312      CALL HYMAGP
313
314C--SELECT PREFERRED MAGNITUDE
315      CALL HYPREF
316
317C--TABULATE DATA SOURCE CODES
318      CALL HYSOU
319
320C--GENERATE PRINTED AND ARCHIVE OUTPUT
321      CALL HYLST
322
323C--ABORT THE LOOP IF THERE ARE NOT ENOUGH READINGS
324      IF (NWR.LT.MINSTA) THEN
325        WRITE (6,1002) NWR,KYEAR2,KMONTH,KDAY,KHOUR,KMIN
326        IF (LPRT) WRITE (15,1002) NWR,KYEAR,KMONTH,KDAY,KHOUR,KMIN
3271002    FORMAT (' *** ABANDON EVENT WITH ONLY',I2,' READINGS:',I4,4I3)
328        IRES=-51
329        GOTO 50         !FOR HYP (MAIN PROGRAM) ONLY
330      END IF
331
332C--WRITE RESULTS TO CUSP MEM FILE
333C--JCPO CONTROLS TO WHAT EXTENT RESULTS ARE WRITTEN OUT TO CUSP
334C  =0 NOTHING WRITTEN ANYWHERE
335C  =1 STRUTURES UPDATED
336C  =2 ABOVE PLUS SHARED MEMORY UPDATED
337C  =3 ABOVE PLUS MEM FILE RE-WRITTEN
338      IF (LCUSP .AND. JCPO.GT.0) CALL HYCOUT
339
340C--OUTPUT SUMMARY DATA USING UNIT NUMBER FOR SUMMARY FILE
341      IF (LSUM) CALL HYSUM (12)
342
343C--OUTPUT A MESSAGE ON THE CONSOLE FOR EACH EVENT
344      IF (LREP) CALL HYREP
345
346C--END OF LOCATION LOOP
347      IF (KEND.EQ.0) GOTO 50
348
349C--CLOSE FILES THEN GET ANOTHER COMMAND
35070    CLOSE (12)
351      CLOSE (7)
352      CLOSE (15)
353      CLOSE (14)
354      CLOSE (16)
355      GOTO 5
356
357      END
Note: See TracBrowser for help on using the repository browser.