      SUBROUTINE HYCMD
C--CALLED BY HYPOINVERSE TO GET A COMMAND, THEN ACT ON IT.
      INCLUDE 'common.inc'
C--LASK IS A LOGICAL FUNCTION. THE OS2 COMPILER COMPLAINS WITHOUT THESE LINES
C      LOGICAL LASK
C      EXTERNAL LASK

      CHARACTER TEMPSTR*80
      PARAMETER (NCMD=101)
      CHARACTER CMD(NCMD)*3
      LOGICAL LINST
      SAVE CMD
      DATA POS/1.75/

C--CMD HOLDS THE NAMES OF ALL COMMANDS RECOGNIZED BY THIS ROUTINE.
C--THE STRUCTURE OF THIS STATEMENT MATCHES THAT OF THE COMPUTED GOTO
      DATA CMD /
     2 'SUM','ARC','PRT','ERF','LST','KPR','TOP','REP',
     3 'COP','DLY','CON','DAM','DUR','DIS','RMS','SWT',
     4 'POS','ZTR','ERR','ERC','NET','SHO','CAR','APP',
     5 'H71','STO','CRH','CRT','STA','INP','LOC','PHS',
     6 'MIN','BUG','HEL','ATN','MOR','ST5','MAG','TAU',
     7 'FID','JUN','MUL','ALT','NOD','SNO','DEL','MAX',
     8 'UNK','ATE','VER','FMC','XMC','TYP','MFL','WCR',
     9 'RCR','WST','RST','BAS','PRO','FC1','FC2','XC1',
     1 'XC2','DU2','FCM','XCM','INI','LET','LES','DUB',
     2 'PRE','CAL','LA0','PMA','PAC','PC1','PC2','PMC',
     3 'LAB','KEP','WET','XCH','XTY','200','FIL','DUG',
     4 'XMT','DIG','DID','DI1','PSM','CRL','CRV','SAL',
     5 'MA2','CRE','MAR','RDM','GEO'/

C++++++++++++++++++ COMMAND INTERPRETER ++++++++++++++++++++
C--IF HYPOINVERSE IS A SUBROUTINE, WE HAVE 1 COMMAND LOADED IN CM & INST
C  HYPOINV IS THE MASTER SUBROUTINE NAME MADE FROM THE HYPOINVERSE MAIN PROGRAM
      IF (SUBMOD) THEN
C--IF HYPOINV CALLED HYCMD AFTER FINISHING A STA, CRH, CRT, INP, BUG OR LOC
C  COMMAND READ FROM A COMMAND FILE, WE HAVE NO NEW COMMAND LOADED,
C  AND MUST READ ANOTHER COMMAND FROM THE FILE.
        IF ((ISTAT.GE.1 .AND. ISTAT.LE.7).OR. ISTAT.EQ.9) GOTO 2
C--IF HYPOINV CALLED HYCMD AFTER BEING GIVEN A COMMAND,
C  THERE IS NO NEED TO READ ANOTHER
        GOTO 4
      END IF
      GOTO 5

C--OUTPUT A MESSAGE ON A FREE-FORMAT DECODING ERROR
3     WRITE (6,1000) CM
1000  FORMAT (' *** ERROR IN ',A3,' PARAMETERS - TRY AGAIN ***')
      IRES=-63

C--SUPPLY A PROMPT IF READING FROM THE TERMINAL
C--IF WE JUST PROCESSED A COMMAND & ARE A SUBROUTINE, RETURN TO THE MAIN PROG
5     IF (INP.EQ.5) THEN
        IF (SUBMOD) THEN
          ISTAT=8
          RETURN
        ELSE
          WRITE (6,1011)
1011      FORMAT (' COMMAND? ',$)
        END IF
      END IF

C--READ A COMMAND LINE IF CM AND INST ARENT ALREADY LOADED WITH A COMMAND:
C  1) WE ARE READING FROM A COMMAND FILE (NOT INTERACTIVE);
C  2) OR WE ARE RUNNING AS A MAIN PROGRAM (NOT SUBROUTINE);
C--THERE IS NO COMMAND TO READ IF THE SUBROUTINE HYPOINV (SUBMODE IS TRUE)
C  HAS NO COMMAND FILE.
2     IF (INP.NE.5 .OR. .NOT.SUBMOD) READ (INP,1012,END=9) CM,INST
1012  FORMAT (A3,A)

C--A LINE STARTING WITH * IS IGNORED AS A REMARK
4     IF (CM(1:1).EQ.'*' .OR. CM.EQ.'   ') GOTO 5

C--INTERPRET A ? IN THE FIRST COLUMN AS A REQUEST FOR COMMAND LIST
      IF (CM(1:1).EQ.'?') GOTO 84

C--A STRING PRECEDED BY @ IS INTERPRETED AS A FILENAME TO HOP TO
C  UP TO 4 NESTED COMMAND FILES ARE ALLOWED AT ONE TIME
6     IF (CM(1:1).EQ.'@') THEN

C--GO TO NEXT HIGHER COMMAND FILE UNLESS DEPTH IS EXCEEDED
        IF (INP.GE.11) THEN
          WRITE (6,'('' *** ERROR: MAX DEPTH OF COMMAND FILES IS 4'')')
          IRES=-64
          GOTO 5
        ELSE IF (INP.GE.8) THEN
          INP=INP+1
        ELSE IF (INP.EQ.5) THEN
          INP=8
        END IF

        INFILE(INP-7) (1:2)=CM(2:3)
        INFILE(INP-7) (3:60)=INST
        CALL OPENR (INP,INFILE(INP-7),'F',IOS)
        IF (IOS.NE.0) GOTO 32
        GOTO 5
      END IF

C--IF THE FIRST CHARACTER IS #, EXECUTE THE SYSTEM COMMAND WHICH FOLLOWS
      IF (CM(1:1).EQ.'#') THEN
        TERM=(CM(2:3)//INST)
        CALL SPAWN (TERM)
        GOTO 5
      END IF

C--DETERMINE WHETHER THE PARAMETER FIELD IS BLANK & IF SO SUPPLY PROMPTS
      LINST=INST(1:10).EQ.'          '

C--BE SURE THE COMMAND IS UPPERCASE
      CALL UPSTR (CM,3)

C--BRANCH TO THE APPROPRIATE COMMAND PROCESSOR
C--THIS GOTO CORRESPONDS IN STRUCTURE TO THE COMMAND LIST
      DO 8 I=1,NCMD
      ICMDX=I
      IF (CM.EQ.CMD(ICMDX)) GOTO (
     2  10, 12, 14, 16, 20, 22, 24, 26,
     3  28, 34, 38, 42, 46, 50, 52, 54,
     4  56, 58, 60, 62, 64, 70, 30, 74,
     5  66,140,144,148,152,156,166,168,
     6 176,200, 84, 88, 86, 92, 96,100,
     7 104,108,110,114,116,118,158,180,
     8 184,162,354,172,192,196,208,216,
     9 220,224,228,232,236,240,244,248,
     1 252,256,260,264,268,272,276,280,
     2 284,160,288,292,296,300,304,308,
     3 312,316,320,324,328,332,336,340,
     4 344,348,352, 51, 57,358,362,366,
     5  98,142,370,374,376), ICMDX
8     CONTINUE

C--OUTPUT AN ERROR MESSAGE
      WRITE (6,1001) CM
1001  FORMAT (' *** COMMAND NOT FOUND: ',A3,/
     2 '  TYPE ? OR HEL FOR COMMAND LIST.')
      IRES=-65
      GOTO 5

C--HERE IS THE ERROR MESSAGE FOR NON-EXISTENT COMMAND FILES
32    INP=INP-1
      IF (INP.EQ.7) INP=5
      WRITE (6,1003)
1003  FORMAT (' *** ERROR - COMMAND FILE DOES NOT EXIST ***')
      IRES=-66
      GOTO 5

C--RETURN TO PREVIOUS COMMAND FILE OR INTERACTIVE MODE AT END OF COMMAND FILE
9     IF (INP.EQ.5) THEN
        ISTAT=8
        RETURN
      END IF

      CLOSE (INP)
      INP=INP-1
      IF (INP.EQ.7) INP=5
      GOTO 5

C******************** COMMAND PROCESSORS *************************

C--<SUM> SET SUMMARY OUTPUT FILENAME
10    IF (LINST) THEN
        CALL ASKC('EARTHQUAKE SUMMARY FILE (NONE FOR NONE)',SUMFIL)
      ELSE
        READ (INST,*,ERR=3) SUMFIL
      END IF
      LSUM=.NOT.(SUMFIL(1:4).EQ.'NONE' .OR. SUMFIL(1:4).EQ.'none')
      GOTO 5

C--<ARC> SET ARCHIVE OUTPUT FILENAME
12    IF (LINST) THEN
        CALL ASKC('ARCHIVE FILE (NONE FOR NONE)',ARCFIL)
      ELSE
        READ (INST,*,ERR=3) ARCFIL
      END IF
      LARC=.NOT.(ARCFIL(1:4).EQ.'NONE' .OR. ARCFIL(1:4).EQ.'none')
      GOTO 5

C--<PRT> SET PRINTER OUTPUT FILENAME
14    IF (LINST) THEN
        CALL ASKC('PRINTOUT FILE (NONE FOR NONE)',PRTFIL)
      ELSE
        READ (INST,*,ERR=3) PRTFIL
      END IF
      LPRT=.NOT.(PRTFIL(1:4).EQ.'NONE' .OR. PRTFIL(1:4).EQ.'none')
      GOTO 5

C--<ERF> SEND ERROR MESSAGES TO TERMINAL AS WELL AS PRINT FILE
16    IF (LINST) THEN
        LERR=LASK('SEND ERROR MESSAGES TO TERMINAL',LERR)
      ELSE
        READ (INST,*,ERR=3) LERR
      END IF
      GOTO 5

C--<LST> FLAG TO LIST AVAILABLE STATIONS & CRUST ON THE PRINTER
20    IF (LINST) THEN
        WRITE (6,1002)
1002    FORMAT (' PRINT CODE: 0=EQS ONLY, 1=ADD PARAMS & FILES,')
        JST=JASK(' 2=ADD STATIONS & CRUST',JST)

        IF (JST.EQ.2) THEN
          WRITE (6,'('' QUANTITY OF STATION INFO TO PRINT:'')')
          JST2=JASK
     1    ('0=NO LISTING, 1=LOCATIONS & BASIC DATA, 2=ALL DELAYS',
     2    JST2)
          WRITE (6,'('' QUANTITY OF CRUST MODEL INFO TO PRINT:'')')
          JST3=JASK
     1    ('0=NO CRUST LISTING, 1=LAYERS & NODES FOR EACH MODEL',
     2    JST3)
        END IF

      ELSE
        READ (INST,*,ERR=3) JST
        IF (JST.EQ.2) THEN
          READ (INST,*,IOSTAT=IOS) JST,JST2,JST3
          IF (IOS.NE.0) GOTO 3
        END IF
      END IF
      GOTO 5

C--<KPR> PARAMETER TO CONTROL AMOUNT OF PRINTOUT
22    IF (LINST) THEN
        WRITE (6,*) ' PRINT QUANTITY CONTROL (0-6) 0=FINAL.LOC'
        WRITE (6,*) ' 1=STATION.LIST 2=ITERATIONS 3=EIGENVALUES'
        KPRINT=JASK('6=STATION LIST EACH ITERATION',KPRINT)
      ELSE
        READ (INST,*,ERR=3) KPRINT
      END IF
      GOTO 5

C--<TOP> FLAG TO PAGE EJECT BEFORE EACH EVENT
24    IF (LINST) THEN
        LEJCT=LASK('PRINT PAGE EJECT FOR EACH EVENT',LEJCT)
      ELSE
        READ (INST,*,ERR=3) LEJCT
      END IF
      GOTO 5

C--<REP> FLAG TO REPORT EACH EVENT ON TERMINAL AS LOCATED
26    IF (LINST) THEN
        LREP=LASK('REPORT EACH EVENT AS LOCATED',LREP)
        LPRALL=LASK('PRINT STATIONS WITH NO WEIGHTS IN PRINT FILE',
     2 LPRALL)
      ELSE
        READ (INST,*,IOSTAT=IOS) LREP,LPRALL
        IF (IOS.NE.0) GOTO 3
      END IF
      GOTO 5

C--<COP> SELECT INPUT PHASE DATA FORMAT
28    IF (LINST) THEN
        WRITE (6,2028) 
2028    FORMAT(' USE 200 COMMAND TO SELECT YR 2000 FORMATS.'/
     2  '  1=OLD PHASE 3=ARCHIVE 4=SHADOW PHASE 5=ARCHIVE-SHADOW')
C     3  '  6=ONE-CUSP-EVENT 7=CUSP-LIST')
        JCP=JASK('PHASE FORMAT',JCP)
C        IF (JCP.EQ.6 .OR. JCP.EQ.7) THEN
C          WRITE (6,*) ' LEVEL OF MEM OUTPUT OF LOCATION TO CUSP:'
C          WRITE (6,*)' 0=NONE 1=DATA STRUCTURES 2=SHARED MEMORY REGION'
C          JCPO=JASK ('3=MEM DISK FILE',JCPO)
C        END IF
      ELSE
        READ (INST,*,ERR=3) JCP
      END IF

      IF (JCP.EQ.6 .OR. JCP.EQ.7) THEN
        WRITE (6,*) ' *** ERROR: CUSP INPUT NO LONGER SUPPORTED.'
        WRITE (6,*) ' TRY AGAIN.'
        JCP=3
      END IF
      GOTO 5

C--<CAR> ARCHIVE DATA FORMAT
30    IF (LINST) THEN
        JCA=JASK
     2  ('ARCHIVE FORMAT (1=NO SHADOWS 3=ARCHIVE-SHADOW)',JCA)
      ELSE
        READ (INST,*,ERR=3) JCA
      END IF
      GOTO 5

C--<DLY> STATION DELAY PARAMETERS (SUPERCEDED BY MULTIPLE MODEL ABILITY)
C  DELAY MODEL 1 IS ASSUMED FOR ALL STATIONS UNLESS MULTIPLE MODELS ARE
C  INVOKED WITH THE MUL AND RELATED COMMANDS.
34    WRITE (6,*) 'THE DLY COMMAND NO LONGER OPERATES.'
      WRITE (6,*) 
     2 'SEE THE MUL, NOD & RELATED COMMANDS FOR MULTIPLE MODELS.'

      GOTO 5

C--<CON> TERMINATING LOCATION UPON CONVERGENCE
38    IF (LINST) THEN
        ITRLIM=JASK('MAX ITERATIONS',ITRLIM)
        DQUIT=ASKR('MIN HYPOCENTER ADJUSTMENT',DQUIT)
        DRQT=ASKR('MIN RMS CHANGE',DRQT)
      ELSE
        READ (INST,*,IOSTAT=IOS) ITRLIM,DQUIT,DRQT
        IF (IOS.NE.0) GOTO 3
      END IF
      GOTO 5

C--<DAM> ITERATION AND DAMPING CONTROLS
42    IF (LINST) THEN
        DXFIX=ASKR('DXFIX, FIX DEPTH UNTIL EPICEN. ADJ. < THIS',DXFIX)
        DZMAX=ASKR('DZMAX, MAX. DEPTH ADJ.',DZMAX)
        DZAIR=ASKR('DZAIR, MOVE HYPO. UP BY THIS INSTEAD OF AIR',DZAIR)
        DAMP=ASKR('DAMP, MANDATORY DAMPING FACTOR',DAMP)
        EIGTOL=ASKR('EIGTOL, SMALLEST EIGENVALUE PERMITTED',EIGTOL)
        RBACK=ASKR('RBACK, IF RMS INCREASES MORE THAN THIS...',RBACK)
        BACFAC=ASKR('BACFAC,...THEN MOVE HYPO. BACK THIS FACTOR',BACFAC)
        DXMAX=ASKR('DXMAX, MAX. DIST ADJ.',DXMAX)
        D2FAR=ASKR('D2FAR, STOP ITERATING WHEN 2ND STATION DIST > THIS',
     2  D2FAR)
      ELSE
        READ (INST,*,IOSTAT=IOS) DXFIX,DZMAX,DZAIR,DAMP,EIGTOL,RBACK,
     2  BACFAC,DXMAX,D2FAR
        IF (IOS.NE.0) GOTO 3
      END IF
      GOTO 5

C--<DUR> DURATION MAG CONSTANTS
46    IF (LINST) THEN
        WRITE (6,1004)
1004    FORMAT (' MAG CONSTANTS FOR DUR < FMBRK:')
        FMA1=ASKR('CONSTANT    FMA1',FMA1)
        FMB1=ASKR('LOG TERM    FMB1',FMB1)
        FMZ1=ASKR('DEPTH TERM  FMZ1',FMZ1)
        FMD1=ASKR('DIST TERM   FMD1',FMD1)
        FMF1=ASKR('LINEAR TERM FMF1',FMF1)
        WRITE (6,1005)
1005    FORMAT (' MAG CONSTANTS FOR DUR > FMBRK:')
        FMA2=ASKR('CONSTANT    FMA2',FMA2)
        FMB2=ASKR('LOG TERM    FMB2',FMB2)
        FMZ2=ASKR('DEPTH TERM  FMZ2',FMZ2)
        FMD2=ASKR('DIST TERM   FMD2',FMD2)
        FMF2=ASKR('LINEAR TERM FMF2',FMF2)
        FMBRK=ASKR('FMBRK',FMBRK)
        FMGN=ASKR('USE GAIN CORRECTION 0=NO 1=YES',FMGN)
      ELSE
        READ (INST,*,IOSTAT=IOS) FMA1,FMB1,FMZ1,FMD1,FMF1,
     2  FMA2,FMB2,FMZ2,FMD2,FMF2, FMBRK,FMGN
        IF (IOS.NE.0) GOTO 3
      END IF
      GOTO 5

C--<DIS> DISTANCE WEIGHT PARAMETERS
50    IF (LINST) THEN
        ITRDIS=JASK('ITERATION TO BEGIN MAIN DISTANCE WEIGHTING'
     2  ,ITRDIS)
        DISCUT=ASKR('DISCUT (KM)',DISCUT)
        DISW1=ASKR('DISW1 FACTOR',DISW1)
        DISW2=ASKR('DISW2 FACTOR',DISW2)
      ELSE
        READ (INST,*,IOSTAT=IOS) ITRDIS,DISCUT,DISW1,DISW2
        IF (IOS.NE.0) GOTO 3
      END IF
      GOTO 5

C--<DI1> DISTANCE WEIGHT PARAMETERS FOR FIRST ITERATIONS
51    IF (LINST) THEN
        WRITE (6,*) 'DO FIRST DISTANCE WEIGHTING ON FIRST ITERATIONS,'
        WRITE (6,*) 'THEN USE DIS COMMAND WEIGHT PARAMETERS'
        WRITE (6,*) 'FOR MAIN DISTANCE WEIGHTING.'
        ITRDI1=JASK('ITERATION TO BEGIN FIRST DISTANCE WEIGHTING'
     2  ,ITRDI1)
	DISCU1=ASKR('DISCUT-1 (KM)',DISCU1)
        DISW11=ASKR('DISW1 FACTOR',DISW11)
        DISW21=ASKR('DISW2 FACTOR',DISW21)
      ELSE
        READ (INST,*,IOSTAT=IOS) ITRDI1,DISCU1,DISW11,DISW21
        IF (IOS.NE.0) GOTO 3
      END IF
      GOTO 5

C--<RMS> RMS WEIGHTING PARAMETERS
52    IF (LINST) THEN
        ITRRES=JASK('ITERATION TO BEGIN RESIDUAL WEIGHTING',ITRRES)
        RMSCUT=ASKR('RMSCUT (SEC)',RMSCUT)
        RMSW1=ASKR('RMSW1 FACTOR',RMSW1)
        RMSW2=ASKR('RMSW2 FACTOR',RMSW2)
      ELSE
        READ (INST,*,IOSTAT=IOS) ITRRES,RMSCUT,RMSW1,RMSW2
        IF (IOS.NE.0) GOTO 3
      END IF
      GOTO 5

C--<SWT> S ARRIVAL WEIGHTING FACTOR
54    IF (LINST) THEN
        SWT=ASKR('S WEIGHT FACTOR',SWT)
      ELSE
        READ (INST,*,ERR=3) SWT
      END IF
      GOTO 5

C--<POS> VP/VS VELOCITY RATIO FOR ALL MODELS
56    IF (LINST) THEN
        WRITE (6,*) 
     2 ' POS COMMAND SETS POS FOR ALL MODELS TO SAME VALUE'
        WRITE (6,*) 
     3 ' PSM COMMAND WILL SET POS FOR INDIVIDUAL MODELS'
        POS=ASKR('P/S VELOCITY RATIO FOR ALL MODELS',POS)
      ELSE
        READ (INST,*,ERR=3) POS
      END IF
      DO I=1,LM
C--LEAVE POSM SET AT 1 IF IT WAS PREVIOUSLY DEFINED AS AN S MODEL
        IF (MODSAL(I).EQ.0) POSM(I)=POS
        POSB(I)=0.
      END DO
      GOTO 5

C--<PSM> VP/VS VELOCITY RATIO & CONSTANT FOR ONE MODEL
C        S(TT)= POSM*P(TT) +POSB
57    IF (LINST) THEN
        IM=JASK('MODEL NUMBER TO SET P/S VELOCITY RATIO',1)
        IF (IM.LT.1 .OR. IM.GT.LM) THEN
          WRITE (6,*) ' *** PSM ERROR: MODEL NUMBER OUT OF RANGE'
          GOTO 57
        END IF
        WRITE (6,*) 'MODEL NAME: ',CRODE(IM)
        POSM(IM)=ASKR('P/S VELOCITY RATIO FOR THIS MODEL',POSM(IM))
        POSB(IM)=ASKR('Stt CONSTANT POSB (Stt= POSM*Ptt +POSB)',
     2 POSB(IM))
      ELSE
        READ (INST,*,ERR=3) IM
        IF (IM.LT.1 .OR. IM.GT.LM) THEN
          WRITE (6,*) ' ***PSM ERROR: MODEL NUMBER OUT OF RANGE',IM
          GOTO 5
        END IF
        READ (INST,*,IOSTAT=IOS) IM,POSM(IM),POSB(IM)
        IF (IOS.NE.0) GOTO 3
      END IF
      GOTO 5

C--<ZTR> TRIAL DEPTH
58    IF (LINST) THEN
        ZTR=ASKR('TRIAL DEPTH FOR RUN',ZTR)
        DEPFIXA=LASK('FIX ALL DEPTHS FOR THIS RUN? (T OR F)',DEPFIXA)
      ELSE
        READ (INST,*,IOSTAT=IOS) ZTR,DEPFIXA
        IF (IOS.NE.0) GOTO 59
      END IF
      GOTO 5
C--ASSUME DEPTHS NOT FIXED IF NOT SUPPLIED
59    WRITE (6,*)
     2' *** NOW MUST SUPPLY FIX-DEPTH FLAG WITH ZTR COMMAND'
      DEPFIXA=.FALSE.
      GOTO 3

C--<ERR> ESTIMATED READING & TIMING ERROR
60    IF (LINST) THEN
        RDERR=ASKR('ESTIMATED READING & TIMING ERROR',RDERR)
      ELSE
        READ (INST,*,ERR=3) RDERR
      END IF
      GOTO 5

C--<ERC> WEIGHTING FACTOR OF RMS IN ERROR CALCS
62    IF (LINST) THEN
        ERCOF=ASKR('RMS WEIGHTING FACTOR IN ERROR CALCULATIONS',ERCOF)
      ELSE
        READ (INST,*,ERR=3) ERCOF
      END IF
      GOTO 5

C--<NET> NET FOR ASSIGNING 3-LET. NAMES BASED ON LOCATION
64    IF (LINST) THEN
        WRITE (6,*)
     2' NET (REGION) FOR ASSIGNING EARTHQUAKE REGION NAMES:'
        NET=JASK('0=NONE 1=HAWAII 2=N.CALIF 3=NEW.HAWAII',NET)
      ELSE
        READ (INST,*,ERR=3) NET
      END IF
      GOTO 5

C--<H71> SET SUMMARY, INSTRUCTION & STATION FORMAT TYPES
66    IF (LINST) THEN
        WRITE (6,1067)
1067    FORMAT ('SUMMARY FORMAT: 1=HYPOINVERSE 2=HYPO71')
        IH71S=JASK
     2  ('3=READABLE 4=COMMA-DELIM',IH71S)
        IH71T=JASK
     1  ('TERMINATOR FORMAT: 1=HINV 2=HYPO71 3=TRIAL.FR.HEADER',
     2  IH71T)

        WRITE (6,1066)
1066    FORMAT(' OLD FORMAT BEGINS WITH 4-LET CODES,',
     2  '  NEW BEGINS WITH 10-LET CODES:')
        ISTFMT=JASK
     2  ('STATION FORMAT 1=OLD.HYPOINV 2=HYPO71 3=NEW.HYPOINV',ISTFMT)
      ELSE
        READ (INST,*,IOSTAT=IOS) IH71S,IH71T,ISTFMT
        IF (IOS.NE.0) GOTO 3
      END IF
      GOTO 5

C--<SHO> WRITE FILENAMES
70    WRITE (6,'(/'' INPUT FILES:''/'' COMMANDS: '',A/11X,A)')
     2 (INFILE(I),I=1,2)
      IF (LBSTA) THEN
        WRITE (6,'('' BINARY STATION SNAPSHOT FILE: '',A)') BSTAFL
      ELSE
        WRITE (6,'('' STATIONS: '',A)') STAFIL
      END IF

      WRITE (6,1021) JSTA, DELFIL,ATNFIL,CALFIL,FMCFIL,XMCFIL,PHSFIL
1021  FORMAT (' (',I4,' STATIONS IN MEMORY)'/' DELAYS: ',A/
     3 ' ATTENS: ',A/' CALFAC: ',A/' FM.COR: ',A/' XM.COR: ',A/
     4 ' PHASES: ',A)

      IF (LBCRU) THEN
        WRITE (6,'('' BINARY CRUST SNAPSHOT FILE: '',A)') BCRUFL
      ELSE
        DO I=1,MAXMOD
          IF (MODTYP(I).EQ.0) WRITE (6,1022) I,CRUFIL(I)(1:50)
1022      FORMAT (' LINEAR  GRADIENT  CRUST',I3,':  ',A)
          IF (MODTYP(I).EQ.1) WRITE (6,1023) I,CRUFIL(I)(1:50)
1023      FORMAT (' HOMOGENEOUS LAYER CRUST',I3,':  ',A)
        END DO
      END IF

C--WRITE OUTPUT FILENAMES
      WRITE (6,1029)
1029  FORMAT (/' OUTPUT FILES:')
      IF (LPRT) WRITE (6,1030) PRTFIL
1030  FORMAT (' PRINTOUT: ',A)
      IF (LSUM) WRITE (6,1031) SUMFIL
1031  FORMAT (' SUMMARY:  ',A)
      IF (LARC) WRITE (6,1032) ARCFIL
1032  FORMAT (' ARCHIVE:  ',A)
      IF (LMAG) WRITE (6,1049) MAGFIL
1049  FORMAT (' MAGNITUDE DATA: ',A)
      GOTO 5

C--<APP> INDICATE WHETHER OUTPUT FILES SHOULD BE APPENDED TO
C  ORDER IS 1=PRINT 2=SUMMARY 3=ARCHIVE
74    IF (LINST) THEN
        LAPP(1)=LASK('APPEND TO PRINT FILE',LAPP(1))
        LAPP(2)=LASK('APPEND TO SUMMARY FILE',LAPP(2))
        LAPP(3)=LASK('APPEND TO ARCHIVE FILE',LAPP(3))
      ELSE
        READ (INST,*,ERR=3) LAPP
      END IF
      GOTO 5

C--<HEL> HELP LISTING OF COMMANDS
84    WRITE (6,1084)
1084  FORMAT (
     3' ---------I/O FILES-----------  -----MISC. PARAMETERS---'/
     4' PHS -PHASE INPUT FILENAME      ZTR -TRIAL DEPTH'/
     5' STA -READ STATION FILE         POS -P/S VELOCITY RATIO'/
     6' CRH -READ LAYER CRUST FILE     NET -NET FOR REGION NAMES'/
     7' CRT -READ GRADIENT CRUST FILE  DUR,DU2,DUB -DUR. MAGS'/
     8' PRT -PRINTOUT FILENAME         FIL -DETERMINE PHAS.FORMAT'/
     9' SUM -SUMMARY OUTPUT FILENAME   MIN -MINIMUM NO. STATIONS'/
     9' ARC -ARCHIVE OUTPUT FILENAME   CON -CONVERGENCE CONTROLS'/
     1' MFL -MAGNITUDE OUTPUT FILE     DAM -DAMPING CONTROLS'/
     2' --------I/O CONTROLS--------   ATN,CAL -ATTEN/CAL FACTOR')

      WRITE (6,1085)
1085  FORMAT (
     3' COP -PHASE FORMAT              ----WEIGHTING & ERRORS---'/
     4' H71 -HYPO71, STATION FORMATS   SWT -GLOBAL S-TIME WEIGHT'/
     5' LST -LIST STAS. IN PRINTFILE   DIS -DISTANCE WEIGHTING'/
     6' KPR -AMOUNT OF PRINT DATA      RMS -RESIDUAL WEIGHTING'/
     7' TOP -NEW PAGE EACH EVENT       ERR -GLOBAL TIME ERROR'/
     8' REP -REPORT EVENTS TO TERM.    ERC -RMS EFFECT ON ERROR'/
     9' ERF -ERROR MESSAGES TO TERM.   -------DO SOMETHING-----'/
     9' CAR -ARCHIVE FORMAT            LOC -LOCATE EVENTS'/
     1' APP -APPEND TO OUTPUT FILES    STO -STOP THE PROGRAM'/
     2' INP -INTERACTIVE DATA ENTRY    PRO -PROCESS INTERACTIVE'/
     3'              (TYPE MOR FOR MORE COMMANDS)')
      GOTO 5

C--<MOR> HELP FOR MORE COMMANDS
86    WRITE (6,1086)
1086  FORMAT (
     2' -------MAGNITUDE INFO ------   -------MULTIPLE MODELS-------'/
     3' ATN -USE STATION ATTENUATION   ALT -ASSIGN STAS TO DIFF MODELS'/
     4' FC1,FC2 -SELECT FMAG COMPS.    MUL -USE REGIONAL MODELS'/
     5' MAG -CODA MAGNITUDE TYPE       NOD -GEOGR. NODE FOR A MODEL'/
     6' TAU -TAU CODA MAG CONSTANTS    SNO -DISPLAY CURRENT NODES'/
     8' XC1,XC2 -SELECT XMAG COMPS.    -------MORE STATION DATA------'/
     7' FCM,XCM -COMPONENT MAG CORRS.  DEL -READ STATION DELAY FILE'/
     8' PRE -SET PREFERRED MAG ORDER   UNK -STAS:NO ERROR IF MISSING'/
     7' PMA -P AMP MAG CHOICES         LET -LENGTH OF STA. NAMES'/
     8' PAC -PMAG COMPONENT WEIGHTS    LES -OLD 1-LET STA COMPONENTS'/
     9' LA0 -DIST CORR TERM (AMP MAG)  ATE -READ STATION ATTEN FILE'/
     1' XCH,XTY -AMP MAG BY INST TYP   CAL -READ STATION CAL FACTORS')

      WRITE (6,1087)
1087  FORMAT (
     1' --------MORE COMMANDS--------  FMC -READ FMAG CORRECTIONS'/
     2' MAX -LIST MAX ARRAY SIZES      XMC -READ XMAG CORRECTIONS'/
     3' FID -CUSP-ID READ FORMAT       ------- BINARY FILES -------'/
     3' SHO -SHOW CURRENT FILES        WCR -WRITE CRUST SNAPSHOT'/
     4' BUG -DEBUG PHASE FILE          RCR -READ CRUST SNAPSHOT'/
     9' BAS -INTERACT. PROCESSING      WST -WRITE STATION SNAPSHOT'/
     1' JUN -FORCE EQS WITH FEW DATA   RST -READ STATION SNAPSHOT'/
     3' INI -INITIALIZE WITH STD. COMMAND FILE'/
     4' KEP -OUTPUT UNRECOGNIZED STATIONS'/
     5' WET -WEIGHTS FOR PHASE WEIGHT CODES 0-3')
      GOTO 5

C--<ATN> SET FLAG TO CONVERT STATION ATTENUATION TO A CAL FACTOR
88    IF (LINST) THEN
        LATEN=LASK
     1  ('ASSUME STATIONS HAVE ATTENUATIONS, NOT CAL FACTORS',
     2  LATEN)
      ELSE
        READ (INST,*,ERR=3) LATEN
      END IF
      GOTO 5

C--<ST5> USE 4 OR 5 LETTER STATION NAMES, 0, 1 OR 3 LETTER COMPONENT CODES
92    WRITE (6,1092)
1092  FORMAT (' *** ST5 COMMAND ELIMINATED.'/
     2 '  USE LET COMMAND TO SET LENGTHS OF STA, NET & COMP. CODES')
      GOTO 5

C--<MAG> SELECT TRADITIONAL CODA OR TAU (ELAPSED TIME) FOR 1ST & 2ND MAGNITUDE
96    IF (LINST) THEN
        MAGSEL=JASK('FIRST FMAG: 1=CODA, 2=ELAPSED TIME, 3=2nd CODA',
     2  MAGSEL)
        LCOWT=LASK
     1  ('T=USE ASSIGNED CODA WEIGHTS, F=GIVE ALL FULL WEIGHT',
     2  LCOWT)
        MAGSL2=JASK('2nd FMAG: 1=CODA, 2=ELAPSED TIME, 3=2nd CODA',
     2  MAGSL2)

        WRITE (6,1096)
1096    FORMAT (' THE LOG(A0) RELATIONS ARE: 1=EATON 2=BAKUN & JOYNER'/
     2 ' 3=RICHTER 4=BKY-NORDQUIST 5=RICHTER TABLE')
        MLOGA0=JASK('LOG(A0) RELATION CHOICE',MLOGA0)

      ELSE
        READ (INST,*,IOSTAT=IOS) MAGSEL,LCOWT,MAGSL2,MLOGA0
        IF (IOS.NE.0) GOTO 3
      END IF
      GOTO 5

C--<MA2> SELECT MINIMUM MAGNITUDE (NO MAGNITUDE VALUE) & MEDIAN FLAG
98    IF (LINST) THEN

        WRITE (6,1097)
1097    FORMAT (' CODE FOR NO-MAG (MINIMUM) VALUE: ')
        NOMAGV=JASK('0 FOR 0.0, 1 FOR -1.0, 2 FOR -9.0',NOMAGV)

        LMED=LASK('T FOR WEIGHED MEDIAN, F FOR WEIGHED MEAN',LMED)

      ELSE
        READ (INST,*,IOSTAT=IOS) NOMAGV,LMED
        IF (IOS.NE.0) GOTO 3
      END IF

      IF (NOMAGV.EQ.0) THEN
        VNOMAG=0.
        MINMAG=0
      ELSE IF (NOMAGV.EQ.1) THEN
        VNOMAG=-1.
        MINMAG=-100
      ELSE IF (NOMAGV.EQ.2) THEN
        VNOMAG=-9.
        MINMAG=-900
      ELSE
        WRITE (6,*) '*** ERROR: NOMAGV MUST BE 0, 1, OR 2'
        NOMAGV=0
        VNOMAG=0.
        MINMAG=0
      END IF
      GOTO 5

C--<TAU> SET CONSTANTS IN ELAPSED TIME (TAU) MAGNITUDE RELATION
100   IF (LINST) THEN
        WRITE (6,*) 
     2  'SET COEFFICIENTS IN ELAPSED TIME (TAU) MAG EXPRESSION:'
        DMA0=ASKR('CONSTANT',DMA0)
        DMA1=ASKR('COEFFICIENT OF LOG(TAU)',DMA1)
        DMA2=ASKR('COEFFICIENT OF LOG**2(TAU)',DMA2)
        DMLI=ASKR('COEFFICIENT OF TAU',DMLI)
        DMZ=ASKR('COEFFICIENT OF DEPTH',DMZ)
        DMGN=ASKR('USE GAIN CORRECTION 0=NO 1=YES',DMGN)
      ELSE
        READ (INST,*,IOSTAT=IOS) DMA0,DMA1,DMA2,DMLI,DMZ,DMGN
        IF (IOS.NE.0) GOTO 3
      END IF
      GOTO 5

C--<FID> FORMAT FOR READING CUSP-ID NUMBERS FROM A FILE
104   WRITE (6,*) ' ***FID: CUSP PROCESSING NO LONGER SUPPORTED'
C104   IF (LINST) THEN
C        CALL ASKC('FORMAT FOR READING CUSP-ID NUMBERS',FORID)
C      ELSE
C        READ (INST,*,ERR=3) FORID
C      END IF
      GOTO 5

C--<JUN> FLAG TO SUPPRESS DIST & RESIDUAL WEIGHTING WHEN FEWER THAN 4 READINGS
C  ARE LEFT
108   IF (LINST) THEN
        WRITE (6,*) 
     2  'T TO USE ALL READINGS (NO DISTANCE OR RESIDUAL WEIGHTING)'
        LJUNK=LASK('WHEN TOO MANY READINGS WOULD BE WEIGHTED OUT',LJUNK)
      ELSE
        READ (INST,*,ERR=3) LJUNK
      END IF
      GOTO 5

C--<MUL> SET FLAG TO SELECT MULTIPLE MODEL PROCESSING
110   IF (LINST) THEN
        LMULT=LASK('PROCESS EQS WITH REGION-DEPENDENT MODELS',LMULT)
        IF (LMULT) MODDEF=JASK('DEFAULT MODEL NUMBER',MODDEF)
      ELSE
        READ (INST,*,ERR=3) LMULT
        IF (LMULT) THEN
          READ (INST,*,IOSTAT=IOS) LMULT,MODDEF
          IF (IOS.NE.0) GOTO 3
        END IF
      END IF
      LBCRU=.FALSE.
      GOTO 5

C--<ALT> SPECIFY AN ALTERNATE MODEL FOR STATIONS SO DESIGNATED
114   IF (LINST) THEN
C--LIST EXISTING ALTERNATE MODEL PAIRS:
        WRITE (6,1114)
1114    FORMAT (' EXISTING PAIRS OF MODEL NUMBER & ITS ALTERNATE:')
        DO I=1,MAXMOD
          IF (MODALT(I).GT.0) WRITE (6,'(2I4)') I,MODALT(I)
        END DO

        I=JASK('PRIMARY MODEL NUMBER TO HAVE AN ALTERNATE',1)
        J=MODALT(I)
        MODALT(I)=JASK('ALTERNATE MODEL NO. (0 FOR NONE)',J)
      ELSE
        READ (INST,*,IOSTAT=IOS) I,MODALT(I)
        IF (IOS.NE.0) GOTO 3
      END IF
      LBCRU=.FALSE.
      GOTO 5

C--<NOD> ADD A NODE TO THE PRESENT LIST (NO DEFAULTS)
116   IF (NNODE.GE.NODMAX) THEN
        WRITE (6,*)'YOU HAVE',NODMAX,' NODES AND CANT HAVE MORE'
        GOTO 5
      END IF
      NNODE=NNODE+1
      IF (LINST) THEN
        TMP1=ASKR('NODE LAT (DEG)',0.)
        TMP2=ASKR('NODE LAT (MIN)',0.)
        TMP3=ASKR('NODE LON (DEG - POSITIVE WEST)',0.)
        TMP4=ASKR('NODE LON (MIN - POSITIVE WEST)',0.)
        RAD1(NNODE)=ASKR('RADIUS FOR 100% OF THIS MODEL (KM)',0.)
        DRAD(NNODE)=ASKR
     2  ('TRANSITION WIDTH OUTSIDE CIRCLE (KM, >0.1)',0.)
        MODH(NNODE)=JASK('CRUST MODEL NUMBER FOR THIS NODE',1)
      ELSE
        READ (INST,*,IOSTAT=IOS) TMP1,TMP2,TMP3,TMP4,RAD1(NNODE),
     2  DRAD(NNODE),MODH(NNODE)
        IF (IOS.NE.0) GOTO 3
      END IF

C--CHECK MODEL NUMBER
      IF (MODH(NNODE).GT.LM) THEN
        WRITE (6,*)'*** ERROR - NODE MODEL NUMBER TOO HIGH:',
     2  MODH(NNODE)
        NNODE=NNODE-1
        IRES=-67
        GOTO 5
      END IF

C--COMPLETE THE NODE DATA
      HLAT(NNODE)=TMP1+TMP2/60.
      HLON(NNODE)=TMP3+TMP4/60.
      IF (DRAD(NNODE).LT..1) THEN
        WRITE (6,*)'*** TRANSITION ZONE INCREASED TO 0.1 KM'
        DRAD(NNODE)=.1
      END IF
      RAD2(NNODE)=RAD1(NNODE)+DRAD(NNODE)
      LBCRU=.FALSE.
      GOTO 5

C--<SNO> LIST THE CURRENT NODES AT THE TERMINAL
118   IF (NNODE.EQ.0) THEN
        WRITE (6,*)'NO NODES ARE DEFINED'
        GOTO 5
      END IF
      WRITE (6,1016)
1016  FORMAT 
     2 (' NODE CENTER-LAT CENTER-LON MOD INNER-RADIUS RING-WIDTH')
      WRITE (6,1017) (I,HLAT(I),HLON(I),MODH(I),RAD1(I),DRAD(I),
     2 I=1,NNODE)
1017  FORMAT ((I4,F10.4,F12.4,I4,F10.2,F12.2))
      GOTO 5

C--<STO> STOP THE PROGRAM
140   ISTAT=8
      RETURN

C--<CRE> READ A HYPOELLIPSE LAYER CRUSTAL MODEL
142   IF (LINST) THEN
        MOD=JASK('HYPOELLIPSE LAYER CRUST MODEL NO. (1-35)',1)
        IF (MOD.LT.1 .OR. MOD.GT.LH) GOTO 146
        IF (MODTYP(MOD).GE.0) WRITE (6,1018) MOD
        
        CALL ASKC('HYPOELLIPSE LAYER MODEL FILENAME',CRUFIL(MOD))
        ELEVMX(MOD)=ASKR('REFERENCE (MAX) ELEV ABOVE S.L. IN KM',
     2  ELEVMX(MOD))
        LELEV(MOD)=LASK('T TO USE STA ELEVS, F ALL AT REF ELEV',
     2  LELEV(MOD))
      ELSE
        READ (INST,*,ERR=3) MOD
        IF (MOD.LT.1 .OR. MOD.GT.LH) GOTO 146
        IF (MODTYP(MOD).GE.0) WRITE (6,1018) MOD
        READ (INST,*,IOSTAT=IOS) MOD,CRUFIL(MOD),ELEVMX(MOD),
     2   LELEV(MOD)
        IF (IOS.NE.0) GOTO 3
      END IF
C--SET THE LARGEST MODEL NUMBER
      IF (MOD.GT.MAXMOD) MAXMOD=MOD

C--OPEN FILE & READ MODEL
      CALL OPENR (14,CRUFIL(MOD),'F',IOS)
      IF (IOS.NE.0) GOTO 145
      ISTAT=9
      LBCRU=.FALSE.
      RETURN

C--<CRH> READ A HOMO LAYER CRUSTAL MODEL
144   IF (LINST) THEN
        MOD=JASK('HOMOGENEOUS LAYER CRUST MODEL NO. (1-35)',1)
        IF (MOD.LT.1 .OR. MOD.GT.LH) GOTO 146
        IF (MODTYP(MOD).GE.0) WRITE (6,1018) MOD
        CALL ASKC('CRUST MODEL FILENAME',CRUFIL(MOD))
      ELSE
        READ (INST,*,ERR=3) MOD
        IF (MOD.LT.1 .OR. MOD.GT.LH) GOTO 146
        IF (MODTYP(MOD).GE.0) WRITE (6,1018) MOD
        READ (INST,*,IOSTAT=IOS) MOD,CRUFIL(MOD)
        IF (IOS.NE.0) GOTO 3
      END IF
C--SET THE LARGEST MODEL NUMBER, AND REFERENCE ELEVATION
      IF (MOD.GT.MAXMOD) MAXMOD=MOD
      ELEVMX(MOD)=0.	!FWK 1.37

C--OPEN FILE & READ MODEL
      CALL OPENR (14,CRUFIL(MOD),'F',IOS)
      IF (IOS.NE.0) GOTO 145
      ISTAT=1
      LBCRU=.FALSE.
      RETURN

C--HERE IS THE ERROR MESSAGE FOR NON-EXISTENT FILES
145   WRITE (6,1455) CRUFIL(MOD)
1455  FORMAT (' *** ERROR - CRUST FILE DOES NOT EXIST: ***'/1X,A)
      IRES=-68
      GOTO 5

C--ERROR MESSAGE FOR BAD MODEL NUMBER
146   WRITE (6,1014) MOD
1014  FORMAT (' *** THIS CRUST MODEL NUMBER IS OUT OF RANGE:',I3)
      IRES=-69
      GOTO 5

C--ERROR MESSAGE FOR PREVIOUSLY DEFINED MODEL
1018  FORMAT (' *** WARNING: MODEL NUMBER',I3,' IS BEING REDEFINED')

C--<CRT> READ ONE OF THE LINEAR GRADIENT CRUSTAL MODELS
148   IF (LINST) THEN
        MOD=JASK('LINEAR GRADIENT CRUST MODEL NO. (1-20)',1)
        IF (MOD.LT.1 .OR. MOD.GT.LN) GOTO 146
        IF (MODTYP(MOD).GE.0) WRITE (6,1018) MOD
          CALL ASKC('CRUST MODEL FILENAME',CRUFIL(MOD))
      ELSE
        READ (INST,*,ERR=3) MOD
        IF (MOD.LT.1 .OR. MOD.GT.LN) GOTO 146
        IF (MODTYP(MOD).GE.0) WRITE (6,1018) MOD
        READ (INST,*,IOSTAT=IOS) MOD,CRUFIL(MOD)
        IF (IOS.NE.0) GOTO 3
      END IF
C--SET THE LARGEST MODEL NUMBER, AND REFERENCE ELEVATION
      IF (MOD.GT.MAXMOD) MAXMOD=MOD
      ELEVMX(MOD)=0.	!FWK 1.37

C--OPEN FILE & READ MODEL
      CALL OPENR (14,CRUFIL(MOD),'F',IOS)
      IF (IOS.NE.0) GOTO 145
      ISTAT=2
      LBCRU=.FALSE.
      RETURN

C--<STA> READ IN A LIST OF SEISMIC STATIONS
152   IF (LINST) THEN
        CALL ASKC('STATION FILENAME',STAFIL)
      ELSE
        READ (INST,*,ERR=3) STAFIL
      END IF

      CALL OPENR (14,STAFIL,'F',IOS)
      IF (IOS.EQ.0) THEN
        ISTAT=3
        LBSTA=.FALSE.
        RETURN

      ELSE
        WRITE (6,1153) STAFIL
1153    FORMAT (' *** ERROR - STATION FILE DOES NOT EXIST: ***'/1X,A)
        IRES=-70
        GOTO 5
      END IF

C--<INP> ENTER PHASE DATA MANUALLY
156   ISTAT=4
      RETURN

C--<DEL> READ IN STATION DELAYS
C  READ IN ALL DELAYS FROM ONE FILE (OLD WAY), OR DELAYS FROM JUST ONE MODEL
158   IF (LINST) THEN
        MODB=JASK('MODEL NO. (-1=ALT.LIST, 0=ALL MODS, 1-32=MODEL NO.)'
     2 ,1)
        CALL ASKC('STATION DELAY FILENAME (MUST READ STAS FIRST)'
     2 ,DELFIL)
      ELSE
C--WHEN NO MODEL NO. IS SUPPLIED, READ ALL DELAYS FROM ONE FILE
        READ (INST,*,IOSTAT=IOS) MODB,DELFIL
        IF (IOS.NE.0) GOTO 3
      END IF

C--OPEN FILE, READ DELAYS
      CALL OPENR (13,DELFIL,'F',IOS)
      IF (IOS.NE.0) THEN
        WRITE (6,1159) DELFIL
1159    FORMAT (' *** ERROR - DELAY FILE DOES NOT EXIST: ***'/1X,A)
        IRES=-71
        GOTO 5
      END IF

      CALL HYDEL(MODB)
      LBSTA=.FALSE.
      GOTO 5

C--<CAL> READ HISTORY FILE OF STATION CAL FACTORS
160   IF (LINST) THEN
        CALL ASKC('STA. CAL FACTOR HISTORY FILE (INST.TYPE 3)',CALFIL)
        WRITE (6,1600)
1600    FORMAT (' ENTER START DATE OF CAL FACTORS TO LOAD (I.E.',/,
     2 ' DATE OF FIRST EARTHQ.) USE 0 TO LOAD EARLIEST CAL FACTOR.')
        ICY=JASK('START YEAR (4 DIGITS)',0)
        IF (ICY.EQ.0) THEN
          ICDATE=0
          GOTO 161
        END IF
        ICM=JASK('START MONTH',0)
        ICD=JASK('START   DAY',0)
        ICH=JASK('START  HOUR',0)
      ELSE
        READ (INST,*,IOSTAT=IOS) CALFIL,ICY
        IF (IOS.NE.0) GOTO 3
        IF (ICY.EQ.0) THEN
          ICDATE=0
          GOTO 161
        END IF
        READ (INST,*,IOSTAT=IOS) CALFIL,ICY,ICM,ICD,ICH
        IF (IOS.NE.0) GOTO 3
      END IF

      IF (ICY.LT.100) ICY=ICY+ICENT
      ICDATE=ICH +100*ICD +10000*ICM +1000000*ICY
161   CALL HYCAL
      GOTO 5

C--<ATE> READ HISTORY FILE OF STATION ATTENUATIONS
162   IF (LINST) THEN
        CALL ASKC('STA. ATTENUATION HISTORY FILE (INST.TYPE 1)',ATNFIL)
        WRITE (6,1620)
1620    FORMAT (' ENTER START DATE OF ATTENUATIONS TO LOAD (I.E.',/,
     2 ' DATE OF FIRST EARTHQ.) USE 0 TO LOAD EARLIEST ATTENUATION.')
        ICY=JASK('START YEAR (4 DIGITS)',0)
        IF (ICY.EQ.0) THEN
          ICDATE=0
          GOTO 164
        END IF
        ICM=JASK('START MONTH',0)
        ICD=JASK('START   DAY',0)
        ICH=JASK('START  HOUR',0)
      ELSE
        READ (INST,*,IOSTAT=IOS) ATNFIL,ICY
        IF (IOS.NE.0) GOTO 3
        IF (ICY.EQ.0) THEN
          ICDATE=0
          GOTO 164
        END IF
        READ (INST,*,IOSTAT=IOS) ATNFIL,ICY,ICM,ICD,ICH
        IF (IOS.NE.0) GOTO 3
      END IF

      IF (ICY.LT.100) ICY=ICY+ICENT
      ICDATE=ICH +100*ICD +10000*ICM +1000000*ICY
164   CALL HYATE
      GOTO 5

C--<LOC> LOCATE EVENTS
166   ISTAT=7
C--GET CUSP ID NUMBER IF REQUIRED
C      IF (JCP.EQ.6) THEN
C        IF (LINST) THEN
C          IDNO=JASK('CUSP-ID NUMBER',0)
C          MEMDSK=JASK('0=GET FROM MEMORY, 1=GET FROM DISK',1)
C        ELSE
C          READ (INST,*,ERR=3) IDNO,MEMDSK
C        END IF
C      END IF
      RETURN

C--<PHS> SPECIFY PHASE INPUT FILE
168   IF (LINST) THEN
        CALL ASKC('PHASE FILENAME',PHSFIL)
      ELSE
        READ (INST,*,ERR=3) PHSFIL
      END IF
      GOTO 5

C--<FMC> SET TARGET DATE & READ FILE OF FMAG CORRECTIONS & THEIR EXPIR DATES
172   IF (LINST) THEN
        CALL ASKC('STA. FMAG CORRECTION HISTORY FILE',FMCFIL)
        WRITE (6,1721)
1721    FORMAT(' ANSWER T TO USE FMAG WEIGHTS ON STATION CARD,'/
     2  ' F TO FORCE CORRECTION FILE TO SET ALL WEIGHTS.'/
     3  ' IF F, STATION MUST BE IN CORRECTION FILE TO BE USED:')
        LNOFMC=LASK('USE STATIONS NOT IN CORRECTION FILE',LNOFMC)

        WRITE (6,1720)
1720    FORMAT (' ENTER START DATE OF FMAG CORRECTIONS TO LOAD'/,
     2  ' (I.E. DATE OF FIRST EARTHQ.)'/,
     4  ' USE 0 TO LOAD EARLIEST FMAG CORRECTION.')
        ICY=JASK('START YEAR (4 DIGITS)',0)
        IF (ICY.EQ.0) THEN
          IFDATE=0
          GOTO 174
        END IF
        ICM=JASK('START MONTH',0)
        ICD=JASK('START   DAY',0)
        ICH=JASK('START  HOUR',0)

      ELSE
        READ (INST,*,IOSTAT=IOS) FMCFIL,LNOFMC,ICY
        IF (IOS.NE.0) GOTO 3
        IF (ICY.EQ.0) THEN
          IFDATE=0
          GOTO 174
        END IF
        READ (INST,*,IOSTAT=IOS) FMCFIL,LNOFMC,ICY,ICM,ICD,ICH
        IF (IOS.NE.0) GOTO 3
      END IF

      IFDATE=ICH +100*ICD +10000*ICM +1000000*ICY
174   CALL HYFMC
      GOTO 5

C--<MIN> SET MIN NO. OF PHASE CARDS TO ATTEMPT A LOCATION
176   IF (LINST) THEN
        MINSTA=JASK('MIN NO. OF PHASES TO ATTEMPT A LOCATION',
     2  MINSTA)
      ELSE
        READ (INST,*,ERR=3) MINSTA
      END IF

      IF (MINSTA.LT.4) THEN
        WRITE (6,1033)
1033    FORMAT (' *** ERROR: MINSTA MUST BE 4 OR MORE')
        MINSTA=4
      END IF
      GOTO 5

C--<MAX> LIST THE MAX ARRAY SIZES ON THE TERMINAL
180   WRITE (6,1180) MAXSTA,MAXPHS,MMAX,MAXUNK, LH,LN,LM, NODMAX,NLYR
1180  FORMAT (' --- THE MAXIMUM SPACE OF VARIOUS ARRAYS ARE: ---'//
     1 ' +++ STATIONS AND PHASES +++'/
     2 I5,' = NUMBER OF STATIONS IN STATION FILE.'/
     3 I5,' = NUMBER OF PHASE CARDS (STATIONS) PER EVENT.'/
     4 I5,' = NUMBER OF PHASES (P OR S) PER EVENT.'/
     5 I5,' = NUMBER OF UNKNOWN STATIONS PER EVENT',
     3 ' (TO COPY TO ARCHIVE FILE).'/
     4 8X   ,'(MAX OF POSSIBLE STATIONS SET WITH UNK COMMAND IS 10)'//
     4 ' +++ MULTIPLE CRUSTAL MODELS +++'/
     5 I5,' = NUMBER OF HOMOGENEOUS LAYER CRUST MODELS.'/
     6 I5,' = NUMBER OF LINEAR GRADIENT CRUST MODELS.'/
     7 I5,' = NUMBER OF CRUSTAL MODELS OF ANY TYPE.'/
     8 I5,' = NUMBER OF NODES FOR CRUST MODEL REGIONS.'/
     9 I5,' = NUMBER OF LAYERS PER CRUSTAL MODEL.'/)
      GOTO 5

C--<UNK> LIST STATIONS NOT TO COMPLAIN ABOUT IF NOT IN STATION FILE
184   IF (LINST) THEN
        WRITE (6,1184)
1184    FORMAT (' ENTER LIST OF 4-LETTER STAS FOR WHICH NO ERROR.'/
     2 '  MESSAGE WILL RESULT WHEN MISSING FROM STATION LIST:')
        NLUNK=JASK('NUMBER OF STAS TO EXPECT MISSING (0-10)',NLUNK)
        IF (NLUNK.GT.10) THEN
        WRITE (6,*)' *** UNK: MAXIMUM NUMBER OF UNKNOWN STATIONS IS 10'
          NLUNK=10
        END IF
        DO I=1,NLUNK
          CALL ASKC('STATION',LUNK(I))
        END DO
      ELSE
        READ (INST,*,ERR=3) NLUNK
        IF (NLUNK.GT.10) THEN
        WRITE (6,*)' *** UNK: MAXIMUM NUMBER OF UNKNOWN STATIONS IS 10'
          NLUNK=10
          IRES=-41
        END IF
        IF (NLUNK.GT.0) THEN
          READ (INST,*,IOSTAT=IOS) NLUNK,(LUNK(I),I=1,NLUNK)
          IF (IOS.NE.0) GOTO 3
        END IF
      END IF
      GOTO 5

C--<XMC> SET TARGET DATE & READ FILE OF XMAG CORRECTIONS
192   IF (LINST) THEN
        CALL ASKC('STA. XMAG CORRECTION HISTORY FILE',XMCFIL)
        WRITE (6,1921)
1921    FORMAT(' ANSWER T TO USE XMAG WEIGHTS ON STATION CARD,'/
     2  ' F TO FORCE CORRECTION FILE TO SET ALL WEIGHTS.'/
     3  ' IF F, STATION MUST BE IN CORRECTION FILE TO BE USED:')
        LNOXMC=LASK('USE STATIONS NOT IN CORRECTION FILE',LNOXMC)

        WRITE (6,1920)
1920    FORMAT (' ENTER START DATE OF XMAG CORRECTIONS TO LOAD'/,
     2  ' (I.E. DATE OF FIRST EARTHQ.)'/,
     4  ' USE 0 TO LOAD EARLIEST XMAG CORRECTION.')
        ICY=JASK('START YEAR (4 DIGITS)',0)
        IF (ICY.EQ.0) THEN
          IXDATE=0
          GOTO 194
        END IF
        ICM=JASK('START MONTH',0)
        ICD=JASK('START   DAY',0)
        ICH=JASK('START  HOUR',0)
      ELSE
        READ (INST,*,IOSTAT=IOS) XMCFIL,LNOXMC,ICY
        IF (IOS.NE.0) GOTO 3
        IF (ICY.EQ.0) THEN
          IXDATE=0
          GOTO 194
        END IF
        READ (INST,*,IOSTAT=IOS) XMCFIL,LNOXMC,ICY,ICM,ICD,ICH
        IF (IOS.NE.0) GOTO 3
      END IF

      IXDATE=ICH +100*ICD +10000*ICM +1000000*ICY
194   CALL HYXMC
      GOTO 5

C--<TYP> TYPE A MESSAGE TO THE TERMINAL (OR BATCH LOG FILE)
196   I=LENG(INST)
      WRITE (6,'(1X,A)') INST (1:I)
      GOTO 5

C--<BUG> READ PHASE FILE & GENERATE ONLY ERROR OUTPUT
C--A STATION FILE MUST HAVE BEEN READ
200   ISTAT=5
      RETURN

C--<MFL> SET THE OUTPUT MAGNITUDE FILENAME
208   IF (LINST) THEN
        CALL ASKC('MAGNITUDE DATA OUTPUT FILE (NONE FOR NONE)',MAGFIL)
      ELSE
        READ (INST,*,ERR=3) MAGFIL
      END IF
      LMAG=MAGFIL(1:4).NE.'NONE' .AND. MAGFIL(1:4).NE.'none'
      GOTO 5

C--<WCR> WRITE BINARY SNAPSHOT OF ALL CRUST MODELS
216   IF (LINST) THEN
        CALL ASKC ('CRUST MODEL SNAPSHOT FILE TO WRITE',BCRUFL)
      ELSE
        READ (INST,*,ERR=3) BCRUFL
      END IF

      CALL OPENW (14,BCRUFL,'U',IOS,'S')
      WRITE (14) MODTYP,MODNAM,CRODE,MAXMOD	!MODEL INFO
      WRITE (14) MODALT,LMULT,MODDEF
      WRITE (14) LAY,VEL,VSQ,D,THK		!LAYER MODELS
      WRITE (14) DD1,ND1,ND,DD2,ND2,GD1,GD2	!TRAVEL TIME TABLES
      WRITE (14) DZ1,NZ1,NZ,DZ2,NZ2,GZ1,GZ2,REDV
      WRITE (14) KDHR
      WRITE (14) KT
      WRITE (14) NNODE,HLAT,HLON,RAD1,RAD2,DRAD,MODH	!NODES
      WRITE (14) ELEVMX,VREF,VGRAD,VSEA,THICK,VHALF	!LIN GRADIENT MODELS
      WRITE (14) POSM,POSB,MODSAL		!P/S VELOCITY RELATION
      WRITE (14) LELEV			!HYPOELLIPSE MODEL INFO
      CLOSE (14)
      GOTO 5

C--<RCR> READ BINARY SNAPSHOT OF ALL CRUST MODELS 
C--(REPLACES CRT,CRH,CRE,CRL,CRV,NOD,MUL,ALT,POS,PSM)
220   IF (LINST) THEN
        CALL ASKC ('CRUST MODEL SNAPSHOT FILE TO READ',BCRUFL)
      ELSE
        READ (INST,*,ERR=3) BCRUFL
      END IF

      CALL OPENR (14,BCRUFL,'U',IOS)
      IF (IOS.NE.0) THEN
        WRITE (6,'('' *** ERROR - CRUST SNAPSHOT FILE NOT FOUND'')')
        IRES=-72
        GOTO 5
      END IF

      READ (14) MODTYP,MODNAM,CRODE,MAXMOD	!MODEL INFO
      READ (14) MODALT,LMULT,MODDEF
      READ (14) LAY,VEL,VSQ,D,THK		!LAYER MODELS
      READ (14) DD1,ND1,ND,DD2,ND2,GD1,GD2	!TRAVEL TIME TABLES
      READ (14) DZ1,NZ1,NZ,DZ2,NZ2,GZ1,GZ2,REDV
      READ (14) KDHR
      READ (14) KT
      READ (14) NNODE,HLAT,HLON,RAD1,RAD2,DRAD,MODH	!NODES
      READ (14) ELEVMX,VREF,VGRAD,VSEA,THICK,VHALF	!LIN GRADIENT MODELS
      READ (14) POSM,POSB,MODSAL		!P/S VELOCITY RELATION
      READ (14) LELEV			!HYPOELLIPSE MODEL INFO

      LBCRU=.TRUE.
      WRITE (6,'(I6,'' CRUST MODELS READ IN BINARY'')') MAXMOD
      CLOSE (14)

C--COMPUTE ARRAYS FOR REFRACTION CALCULATIONS (FROM HYPOEL INPUT SUB)
C  THAT ARE NOT STORED IN THE BINARY FILE. THESE ARRAYS ALSO CALCULATED
C  IN HYCRE WHEN MODEL READ IN
C  DO THIS FOR ALL MODELS OF TYPE 4. MOD IS THE MODEL # PASSED THRU COMMON
      DO I=1,MAXMOD
        MOD=I
        IF (MODTYP(MOD).EQ.4) CALL HYCRE2
      END DO

      GOTO 5

C--<WST> WRITE BINARY SNAPSHOT OF ALL STATION DATA
224   IF (LINST) THEN
        CALL ASKC ('STATION DATA SNAPSHOT FILE TO WRITE',BSTAFL)
      ELSE
        READ (INST,*,ERR=3) BSTAFL
      END IF

      CALL OPENW (14,BSTAFL,'U',IOS,'S')
      WRITE (14) JSTA,STANAM,JNET,JCOMP1,JCOMP3
      WRITE (14) JLATD,JLATM,JLOND,JLONM
      WRITE (14) JCAL,JLMOD,JFCOR,JXCOR,JPSWT,JXWT,JFWT,STRMK,JPD
      WRITE (14) JTYPE,JSLOC,JSLOC2,JFGWT,JCOMPA
      WRITE (14) JELEV,JPER
      CLOSE (14)
      GOTO 5

C--<RST> READ BINARY SNAPSHOT OF ALL STATION DATA (REPLACES STA, DEL COMMANDS)
228   IF (LINST) THEN
        CALL ASKC ('STATION DATA SNAPSHOT FILE TO READ',BSTAFL)
      ELSE
        READ (INST,*,ERR=3) BSTAFL
      END IF

      CALL OPENR (14,BSTAFL,'U',IOS)
      IF (IOS.NE.0) THEN
        WRITE (6,'('' *** ERROR - STATION SNAPSHOT FILE NOT FOUND'')')
        IRES=-73
        GOTO 5
      END IF

      READ (14) JSTA,STANAM,JNET,JCOMP1,JCOMP3
      READ (14) JLATD,JLATM,JLOND,JLONM
      READ (14) JCAL,JLMOD,JFCOR,JXCOR,JPSWT,JXWT,JFWT,STRMK,JPD
      READ (14) JTYPE,JSLOC,JSLOC2,JFGWT,JCOMPA
      READ (14) JELEV,JPER

      LBSTA=.TRUE.
      WRITE (6,'(I6,'' STATIONS READ IN BINARY'')') JSTA
      CLOSE (14)
      GOTO 5

C--<BAS> SET STRINGS FOR READING & MAKING INTERACTIVE PROCESSING FILENAMES
232   IF (LINST) THEN
        WRITE (6,1232)
1232    FORMAT (' I/O FILENAMES ARE MADE FROM A BASE NAME AND',
     2 ' AND EXTENSION.'/' USE THE EXTENSION "NONE" TO DISABLE.')
        CALL ASKC ('FILE TO READ BASE EVENT NAMES',LSTFIL)
        NCBASE=JASK('NO. OF CHARS TO READ FOR BASE NAMES',NCBASE)
        CALL ASKC ('FORMAT FOR READING BASE EVENT NAMES',LSTFOR)
        CALL ASKC ('PHASE FILE EXTENSION',EXTPHS)
        CALL ASKC ('ARCHIVE FILE EXTENSION',EXTARC)
        CALL ASKC ('SUMMARY FILE EXTENSION',EXTSUM)
        CALL ASKC ('PRINTOUT FILE EXTENSION',EXTPRT)
        WRITE (6,1233)
1233    FORMAT (' VAX EDITOR: 1=EDT 2=GENERAL ED'/
     2 ' SUN EDITOR: 1=DTPAD 2=VI 3=TEXTEDIT')
        IEDFLG=JASK('EDITOR',IEDFLG)
      ELSE
        READ (INST,*,IOSTAT=IOS) LSTFIL,NCBASE,LSTFOR, EXTPHS,
     2  EXTARC,EXTSUM,EXTPRT,IEDFLG
        IF (IOS.NE.0) GOTO 3
      END IF

      LARC=EXTARC(1:4).NE.'NONE' .AND. EXTARC(1:4).NE.'none'
      LSUM=EXTSUM(1:4).NE.'NONE' .AND. EXTSUM(1:4).NE.'none'
      LPRT=EXTPRT(1:4).NE.'NONE' .AND. EXTPRT(1:4).NE.'none'
      GOTO 5

C--<PRO> GO DO INTERACTIVE PROCESSING
236   CALL HYPRO
      GOTO 5

C--<FC1> GET STATION COMPONENTS TO USE FOR 1ST DURATION MAGNITUDE
240   IF (LINST) THEN
        CALL ASKC('1-LETTER LABEL CODE FOR FMAG1',LABF1)
        IF (NCPF1.EQ.0) THEN
          WRITE (6,
     2    '('' NO COMPONENTS USED TO CALCULATE FIRST DUR MAG'')')
        ELSE IF (NCPF1.GT.0) THEN
          WRITE (6,2400) NCPF1,(COMPF1(I),I=1,NCPF1)
2400      FORMAT (I3,' COMPONENTS USED TO CALCULATE FIRST DUR MAG:'/,
     2    20(1X,A3))
        ELSE
          WRITE (6,*)' ALL COMPONENTS USED TO CALCULATE FIRST DUR MAG'
        END IF

        NCPF1=JASK
     1  ('NO. OF COMPONENTS TO USE FOR FMAG1 (-1=ALL, OR 0-20)'
     2  ,NCPF1)
        IF (NCPF1.GT.20) THEN
          WRITE (6,*) ' *** ERROR-TOO MANY FC1 COMPONENTS REQUESTED'
          GOTO 5
        END IF
        IF (NCPF1.GT.0) THEN
          DO I=1,NCPF1
            CALL ASKC('COMPONENT FOR FMAG1 (I.E. VHZ)',COMPF1(I))
          END DO
        END IF
      ELSE

        READ (INST,*,IOSTAT=IOS) LABF1,NCPF1
        IF (IOS.NE.0) GOTO 3
        IF (NCPF1.GT.20) THEN
          WRITE (6,*) ' *** ERROR-TOO MANY FC1 COMPONENTS REQUESTED'
          GOTO 5
        END IF
        IF (NCPF1.GT.0) READ (INST,*,IOSTAT=IOS) LABF1,NCPF1,
     2  (COMPF1(I),I=1,NCPF1)
        IF (IOS.NE.0) GOTO 3
      END IF

C--BLANK OUT REMAINING COMPONENTS TO SELECT ON
      IF (NCPF1.GE.0) THEN
        DO I=NCPF1+1,20
          COMPF1(I)=' '
        END DO
      END IF
      GOTO 5

C--<FC2> GET STATION COMPONENTS TO USE FOR 2ND DURATION MAGNITUDE
244   IF (LINST) THEN
        CALL ASKC('1-LETTER LABEL CODE FOR FMAG2',LABF2)
        IF (NCPF2.EQ.0) THEN
          WRITE (6,
     2   '('' NO COMPONENTS USED TO CALCULATE SECOND DUR MAG'')')
        ELSE IF (NCPF2.GT.0) THEN
          WRITE (6,2400) NCPF2,(COMPF2(I),I=1,NCPF2)
2440      FORMAT (I3,' COMPONENTS USED TO CALCULATE SECOND DUR MAG:'/,
     2   20(1X,A3))
        ELSE
          WRITE (6,
     2   '('' ALL COMPONENTS USED TO CALCULATE SECOND DUR MAG'')')
        END IF

        NCPF2=JASK
     1  ('NO. OF COMPONENTS TO USE FOR FMAG2 (-1=ALL, OR 0-20)'
     2 ,NCPF2)
        IF (NCPF2.GT.20) THEN
          WRITE (6,*) ' *** ERROR-TOO MANY FC2 COMPONENTS REQUESTED'
          GOTO 5
        END IF
        IF (NCPF2.GT.0) THEN
          DO I=1,NCPF2
            CALL ASKC('COMPONENT FOR FMAG2 (I.E. VLZ)',COMPF2(I))
          END DO
        END IF
      ELSE

        READ (INST,*,IOSTAT=IOS) LABF2,NCPF2
        IF (IOS.NE.0) GOTO 3
        IF (NCPF2.GT.20) THEN
          WRITE (6,*) ' *** ERROR-TOO MANY FC2 COMPONENTS REQUESTED'
          GOTO 5
        END IF
        IF (NCPF2.GT.0) READ (INST,*,IOSTAT=IOS) LABF2,NCPF2,
     2  (COMPF2(I),I=1,NCPF2)
        IF (IOS.NE.0) GOTO 3
      END IF

C--BLANK OUT REMAINING COMPONENTS TO SELECT ON
      IF (NCPF2.GE.0) THEN
        DO I=NCPF2+1,20
          COMPF2(I)=' '
        END DO
      END IF
      GOTO 5

C--<XC1> GET STATION COMPONENTS TO USE FOR 1ST AMPLITUDE MAGNITUDE
248   IF (LINST) THEN
        CALL ASKC('1-LETTER LABEL CODE FOR XMAG1',LABX1)
        IF (NCPX1.EQ.0) THEN
          WRITE (6,
     2   '('' NO COMPONENTS USED TO CALCULATE FIRST AMP MAG'')')
        ELSE IF (NCPX1.GT.0) THEN
          WRITE (6,2400) NCPX1,(COMPX1(I),I=1,NCPX1)
2480      FORMAT (I3,' COMPONENTS USED TO CALCULATE FIRST AMP MAG: '/,
     2    20(1X,A3))
        ELSE
          WRITE (6,
     2   '('' ALL COMPONENTS USED TO CALCULATE FIRST AMP MAG'')')
        END IF

        NCPX1=JASK
     1  ('NO. OF COMPONENTS TO USE FOR XMAG1 (-1=ALL, OR 0-20)'
     2  ,NCPX1)
        IF (NCPX1.GT.20) THEN
          WRITE (6,*) ' *** ERROR-TOO MANY XC1 COMPONENTS REQUESTED'
          GOTO 5
        END IF
        IF (NCPX1.GT.0) THEN
          DO I=1,NCPX1
            CALL ASKC('COMPONENT FOR XMAG1 (I.E. VHZ)',COMPX1(I))
          END DO
        END IF
      ELSE

        READ (INST,*,IOSTAT=IOS) LABX1,NCPX1
        IF (IOS.NE.0) GOTO 3
        IF (NCPX1.GT.20) THEN
          WRITE (6,*) ' *** ERROR-TOO MANY XC1 COMPONENTS REQUESTED'
          GOTO 5
        END IF
        IF (NCPX1.GT.0) READ (INST,*,IOSTAT=IOS) LABX1,NCPX1,
     2  (COMPX1(I),I=1,NCPX1)
        IF (IOS.NE.0) GOTO 3
      END IF

C--BLANK OUT REMAINING COMPONENTS TO SELECT ON
      IF (NCPX1.GE.0) THEN
        DO I=NCPX1+1,20
          COMPX1(I)=' '
        END DO
      END IF
      GOTO 5

C--<XC2> GET STATION COMPONENTS TO USE FOR 2ND AMPLITUDE MAGNITUDE
252   IF (LINST) THEN
        CALL ASKC('1-LETTER LABEL CODE FOR XMAG2',LABX2)
        IF (NCPX2.EQ.0) THEN
          WRITE (6,
     2    '('' NO COMPONENTS USED TO CALCULATE SECOND AMP MAG'')')
        ELSE IF (NCPX2.GT.0) THEN
          WRITE (6,2400) NCPX2,(COMPX2(I),I=1,NCPX2)
2520      FORMAT (I3,' COMPONENTS USED TO CALCULATE SECOND AMP MAG:'/,
     2    20(1X,A3))
        ELSE
          WRITE (6,
     2    '('' ALL COMPONENTS USED TO CALCULATE SECOND AMP MAG'')')
        END IF

        NCPX2=JASK
     1  ('NO. OF COMPONENTS TO USE FOR XMAG2 (-1=ALL, OR 0-20)'
     2  ,NCPX2)
        IF (NCPX2.GT.20) THEN
          WRITE (6,*) ' *** ERROR-TOO MANY XC2 COMPONENTS REQUESTED'
          GOTO 5
        END IF
        IF (NCPX2.GT.0) THEN
          DO I=1,NCPX2
            CALL ASKC('COMPONENT FOR XMAG2 (I.E. WLN)',COMPX2(I))
          END DO
        END IF
      ELSE

        READ (INST,*,IOSTAT=IOS) LABX2,NCPX2
        IF (IOS.NE.0) GOTO 3
        IF (NCPX2.GT.20) THEN
          WRITE (6,*) ' *** ERROR-TOO MANY XC2 COMPONENTS REQUESTED'
          GOTO 5
        END IF
        IF (NCPX2.GT.0) READ (INST,*,IOSTAT=IOS) LABX2,NCPX2,
     2  (COMPX2(I),I=1,NCPX2)
        IF (IOS.NE.0) GOTO 3
      END IF

C--BLANK OUT REMAINING COMPONENTS TO SELECT ON
      IF (NCPX2.GE.0) THEN
        DO I=NCPX2+1,20
          COMPX2(I)=' '
        END DO
      END IF
      GOTO 5

C--<DU2> ADDITIONAL TERMS FOR CODA MAGNITUDE RELATION
256   IF (LINST) THEN
        DCOFM1=ASKR('COEFF. OF D<DBRKM1 FMAG DIST TERM',DCOFM1)
        DBRKM1=ASKR('MAX DIST OF D<DBRKM1 FMAG DIST TERM',DBRKM1)
        DCOFM2=ASKR('COEFF. OF D>DBRKM2 FMAG DIST TERM',DCOFM2)
        DBRKM2=ASKR('START DIST OF D>DBRKM2 FMAG DIST TERM',DBRKM2)
        ZCOFM=ASKR('COEFF. OF Z>ZBRKM FMAG DEPTH TERM',ZCOFM)
        ZBRKM=ASKR('START DEPTH OF Z>ZBRKM FMAG DEPTH TERM',ZBRKM)
      ELSE
        READ (INST,*,IOSTAT=IOS) DCOFM1,DBRKM1,DCOFM2,DBRKM2,
     2   ZCOFM,ZBRKM
        IF (IOS.NE.0) GOTO 3
      END IF
      GOTO 5

C--<FCM> COMPONENT CORRECTIONS FOR CODA MAGNITUDES
260   IF (LINST) THEN
        NFCM=JASK(
     2 'NO. (0-10) OF COMPONENTS TO HAVE INDEP. FMAG CORRECTIONS',NFCM)
        IF (NFCM.GT.10) THEN
          WRITE (6,*) ' *** ERROR-TOO MANY XCM COMPONENTS REQUESTED'
          GOTO 5
        END IF
        DO I=1,NFCM
          CALL ASKC('COMPONENT TO CORRECT',CFCM(I))
          AFCM(I)=ASKR('CORRECTION FOR ABOVE COMPONENT',AFCM(I))
        END DO

      ELSE
        READ (INST,*,ERR=3) NFCM
        IF (NFCM.GT.10) THEN
          WRITE (6,*) ' *** ERROR-TOO MANY XCM COMPONENTS REQUESTED'
          GOTO 5
        END IF
        IF (NFCM.GT.0)
     2  READ (INST,*,IOSTAT=IOS) NFCM,(CFCM(I),AFCM(I),I=1,NFCM)
        IF (IOS.NE.0) GOTO 3
      END IF
      GOTO 5

C--<XCM> COMPONENT CORRECTIONS FOR AMPLITUDE MAGNITUDES
264   IF (LINST) THEN
        NXCM=JASK(
     2 'NO. (0-10) OF COMPONENTS TO HAVE INDEP. XMAG CORRECTIONS',NXCM)
        IF (NXCM.GT.10) THEN
          WRITE (6,*) ' *** ERROR-TOO MANY XCM COMPONENTS REQUESTED'
          GOTO 5
        END IF
        DO I=1,NXCM
          CALL ASKC('COMPONENT TO CORRECT',CXCM(I))
          AXCM(I)=ASKR('CORRECTION FOR ABOVE COMPONENT',AXCM(I))
        END DO

      ELSE
        READ (INST,*,ERR=3) NXCM
        IF (NXCM.GT.10) THEN
          WRITE (6,*) ' *** ERROR-TOO MANY XCM COMPONENTS REQUESTED'
          GOTO 5
        END IF
        IF (NXCM.GT.0) 
     2  READ (INST,*,IOSTAT=IOS) NXCM,(CXCM(I),AXCM(I),I=1,NXCM)
        IF (IOS.NE.0) GOTO 3
      END IF
      GOTO 5

c--<INI> INITIALIZE HYPOINVERSE BY EXECUTING A STANDARD COMMAND FILE.
C  THE NAME OF THE COMMAND FILE IS ASSIGNED BY THE ENVIRONMENT VARIABLE
C  "HYPINITFILE1.3".
268   CALL GETENV ('HYPINITFILE1.3',TEMPSTR)
      IF (TEMPSTR.EQ.'    ') THEN
        WRITE (6,1268) 
1268  FORMAT(' ENVIRONMENT VARIABLE "HYPINITFILE1.3" FOR STARTUP FILE ',
     2 ' NOT FOUND.'/' LETS TRY A STANDARD FILENAME.'/
     3 ' IN THE FUTURE YOU SHOULD DEFINE IT LIKE THIS:'/
     4 ' On andreas:'/
     5 ' setenv HYPINITFILE1.3 /home/ehz/klein/hypfiles/cal20001.3.hyp')
c     6  ' On swave:'/
c     7  '  setenv HYPINITFILE /home1/calnet/klein/hypfiles/cal2000.hyp')
        TEMPSTR=INFILE(0)
      END IF

C--THIS CASE SHOULD ONLY OCCUR IN THE VAX VERSION, WITH NO ENV. VARIABLE SET
      IF (TEMPSTR.EQ.'VAX') THEN
        TEMPSTR=INFILE(0)
      END IF

      WRITE (6,'('' INITIALIZING WITH COMMAND FILE:''/1X,A)') TEMPSTR
      CM=('@'//TEMPSTR(1:2))
      INST=TEMPSTR(3:60)
      GOTO 6

C--<LET> SET THE NUMBER OF LETTERS TO MATCH IN STA, NET & COMP CODES
272   IF (LINST) THEN
        NSTLET=JASK
     2  ('NUMBER OF LETTERS TO CHECK IN STATION SITE CODE (2-5)',NSTLET)
        NETLET=JASK
     2  ('NUMBER OF LETTERS TO CHECK IN STATION NET CODE (0-2)',
     3  NETLET)
        NCOMP=JASK
     2  ('NO. OF LETTERS TO CHECK IN STATION COMPONENT CODE (0-3)',
     3  NCOMP)

        NSLOC=JASK
     2  ('NO. OF LETS TO CHECK IN LOCATION CODE IN PHASE FILES (0-2)',
     3  NSLOC)
        NSLOC2=JASK
     2  ('NO. OF LETS TO CHECK IN LOCATION CODE IN OTHER FILES (0-2)',
     3  NSLOC2)
      ELSE
C--IF NSLOC IS NOT SUPPLIED, ASSUME IT IS ZERO AND DO NOT ISSUE WARNING YET
        READ (INST,*,ERR=273) NSTLET, NETLET, NCOMP, NSLOC, NSLOC2
        GOTO 274
273     READ (INST,*,IOSTAT=IOS) NSTLET, NETLET, NCOMP
        IF (IOS.NE.0) GOTO 3
        WRITE (6,*) 
     2  ' * WARNING: SUPPLY NO. OF LOCATION LETTERS IN LET COMMAND'
        NSLOC=0
      END IF

274   IF (NSLOC.LT.NSLOC2) THEN
        WRITE (6,*)
     2 ' *** ERROR: MUST CHECK AS MANY LOCATION LETTERS IN PHASE FILES'
        WRITE (6,*)' AS IN MAG CORRECTION AND CALIBRATION FILES (LET).'
      END IF
      GOTO 5

C--<LES> ASK WHETHER COMPONENT IS FROM 1-LET OR 3-LET FIELD.
276   WRITE (6,*) '*** LES COMMAND NO LONGER USED'
      GOTO 5
      
C--<DUB> SECOND DURATION MAG CONSTANTS
280   IF (LINST) THEN
        WRITE (6,1272)
1272    FORMAT (' CONSTANTS FOR SECOND DUR MAG. NOTE: NO COMPONENT,'/
     2  ' ADDITIONAL DEPTH OR DISTANCE CORRECTIONS USED.')
        WRITE (6,1274)
1274    FORMAT (' MAG CONSTANTS FOR DUR < FMBRKB:')
        FMA1B=ASKR('CONSTANT    FMA1B',FMA1B)
        FMB1B=ASKR('LOG TERM    FMB1B',FMB1B)
        FMZ1B=ASKR('DEPTH TERM  FMZ1B',FMZ1B)
        FMD1B=ASKR('DIST TERM   FMD1B',FMD1B)
        FMF1B=ASKR('LINEAR TERM FMF1B',FMF1B)
        WRITE (6,1273)
1273    FORMAT (' MAG CONSTANTS FOR DUR > FMBRKB:')
        FMA2B=ASKR('CONSTANT    FMA2B',FMA2B)
        FMB2B=ASKR('LOG TERM    FMB2B',FMB2B)
        FMZ2B=ASKR('DEPTH TERM  FMZ2B',FMZ2B)
        FMD2B=ASKR('DIST TERM   FMD2B',FMD2B)
        FMF2B=ASKR('LINEAR TERM FMF2B',FMF2B)

        FMBRK=ASKR('FMBRKB',FMBRKB)
        FMGNB=ASKR('USE GAIN CORRECTION 0=NO 1=YES',FMGNB)
      ELSE
        READ (INST,*,IOSTAT=IOS) FMA1B,FMB1B,FMZ1B,FMD1B,FMF1B,
     2  FMA2B,FMB2B,FMZ2B,FMD2B,FMF2B, FMBRKB,FMGNB
        IF (IOS.NE.0) GOTO 3
      END IF
      GOTO 5

C--<PRE> SET MAGNITUDE PREFERENCE ORDER FOR PREFERRED MAGNITUDE
284   IF (LINST) THEN
        WRITE (6,*) ' SET MAGNITUDE PREFERENCE ORDER. THE MAGS ARE:'
        WRITE (6,*)
     2  ' 1=FMAG 2=XMAG 3=BMAG 4=XMAG2 5=FMAG2'
C     2  ' 1=FMAG 2=XMAG 3=BMAG 4=XMAG2 5=FMAG2 6=PAMAG1 7=PAMAG2'
        NMAGS=JASK
     2  ('NUMBER OF MAGNITUDES ELIGIBLE FOR PREFERRED MAG (0-10)',
     3  NMAGS)
        DO I=1,NMAGS
          WRITE (6,*)
          WRITE (6,*) ' MAGNITUDE FOR CHOICE NUMBER',I,':'
          MPREF(I)=JASK('MAGNITUDE CHOICE (I.E. 1=FMAG)',MPREF(I))
          MNPREF(I)=JASK('MINIMUM READINGS TO CHOOSE THIS MAG',
     2    MNPREF(I))
          AMPREF(I)=ASKR('MINIMUM MAG VALUE TO CHOOSE THIS MAG',
     2    AMPREF(I))
          AXPREF(I)=ASKR('MAXIMUM MAG VALUE TO CHOOSE THIS MAG',
     2    AXPREF(I))
        END DO
      ELSE
        READ (INST,*,ERR=3) NMAGS
        IF (NMAGS.GT.0) THEN
          READ (INST,*,IOSTAT=IOS) NMAGS,
     2    (MPREF(I),MNPREF(I),AMPREF(I),AXPREF(I),I=1,NMAGS)
          IF (IOS.NE.0) GOTO 3
        END IF
      END IF
      GOTO 5

C--<LA0> SELECT COMPONENTS FOR UNIQUE LOGA0 RELATIONS IN AMP MAGS
288   IF (LINST) THEN
        NLA0=JASK('NUMBER OF COMPS WITH UNIQUE LOGA0s (0-20)',NLA0)
        IF (NLA0.GT.0) THEN
          WRITE (6,1096) 
          DO I=1,NLA0
            WRITE (6,*) ' COMPONENT NUMBER ',I
            CALL ASKC('COMPONENT CODE',CLA0(I))
            MLA0(I)=JASK('LOG(A0) RELATION FOR THIS COMPONENT',MLA0(I))
          END DO
        END IF
      ELSE

        READ (INST,*,ERR=3) NLA0
        IF (NLA0.GT.0) THEN
          READ(INST,*,IOSTAT=IOS)NLA0,(CLA0(I),MLA0(I),I=1,NLA0)
          IF (IOS.NE.0) GOTO 3
        END IF
      END IF
      GOTO 5

C--<PMA> SET FLAGS FPR PMAG PROCESSING
292   IF (LINST) THEN
        LPMAG =LASK('COMPUTE PMAG FROM P AMPS ON SHADOW CARDS',LPMAG)
        LPPRT =LASK('PRINT PMAG INFO IN PRINT FILE STATION LISTING',
     2  LPPRT)
        WRITE (6,
     2  '('' ENTER DEVELOCORDER MM PER COUNT UNIT FOR P-MAGS'')')
        CNT2MD=ASKR('DEFAULT VALUE (RTP=.04, EARTHWORM=.0488)',CNT2MD)

        WRITE (6,2920)
2920    FORMAT (' FRACTION OF CLIPPED PMAGS FOR DECLARING EVENT PMAG')
        CLPRAT=ASKR('A MINIMUM (CLIPPED) VALUE',CLPRAT)
        WRITE (6,1096)
        LATYPP=JASK('LOG(A0) RELATION FOR P MAGS',LATYPP)
      ELSE
        READ (INST,*,IOSTAT=IOS) LPMAG,LPPRT,CNT2MD,CLPRAT,LATYPP
        IF (IOS.NE.0) GOTO 3
      END IF

C--ERROR TO PRINT MAG WITHOUT COMPUTING IT
      IF (LPPRT .AND. .NOT.LPMAG) WRITE (6,1293)
1293  FORMAT (' *** ERROR: YOU MUST COMPUTE PMAGS BEFORE',
     2 ' YOU CAN PRINT THEM')

C--IF PMAG PROCESSING IS SELECTED, CHECK WHETHER SHADOW CARDS ARE USED
      IF (LPMAG .AND. JCP.NE.5) WRITE (6,1292)
1292  FORMAT (' *** WARNING: TO COMPUTE PMAGS, BE SURE ARCHIVE SHADOW'/
     2 ' FORMATS ARE SELECTED WITH "COP 5" AND "CAR 3".')
      GOTO 5

C--<PAC> PRIMARY P AMPLITUDE MAGNITUDE COMPONENT WEIGHTS
296   IF (LINST) THEN
        WRITE (6,1296)
1296    FORMAT (' SET COMPONENTS WITH PRIMARY PMAG WEIGHTS',
     2  ' DIFFERENT FROM 1.0')
        NPWM=JASK
     1  ('NO. OF COMPONENTS WITH DEFINED PMAG WEIGHTS (0-10)'
     2  ,NPWM)
        IF (NPWM.GT.0) THEN
          DO I=1,NPWM
            WRITE (6,'('' COMPONENT NUMBER'',I3)') I
            CALL ASKC('COMPONENT CODE (I.E. VHZ)',CPWM(I))
            WPWM(I)=ASKR('WEIGHT FOR THIS COMPONENT (0.-5.)',
     2      WPWM(I))
          END DO
        END IF
      ELSE

        READ (INST,*,ERR=3) NPWM
        IF (NPWM.GT.0) THEN
          READ (INST,*,IOSTAT=IOS) NPWM,
     2    (CPWM(I),WPWM(I),I=1,NPWM)
          IF (IOS.NE.0) GOTO 3
        END IF
      END IF
      GOTO 5

C--<PC1> PRIMARY P AMP MAGNITUDE SELECTION BY COMPONENT
300   IF (LINST) THEN
        CALL ASKC('1-LETTER LABEL CODE FOR PRIMARY PMAG',LABP1)

        PMA1=ASKR('A VALUE IN PMAG1(OUT)= A +B*PMAG1(CALC)',PMA1)
        PMB1=ASKR('B VALUE IN PMAG1(OUT)= A +B*PMAG1(CALC)',PMB1)

        IF (NCPP1.EQ.0) THEN
          WRITE (6,
     2    '('' NO COMPONENTS NOW USED TO CALCULATE PRIMARY P MAG'')')
        ELSE IF (NCPP1.GT.0) THEN
          WRITE (6,3000) NCPP1,(COMPP1(I),I=1,NCPP1)
3000      FORMAT (I3,' COMPONENTS USED TO CALCULATE FIRST DUR MAG:'/,
     2    10(1X,A3))
        ELSE
          WRITE (6,
     2    '('' ALL COMPONENTS NOW USED TO CALCULATE PRIMARY P MAG'')')
        END IF

        NCPP1=JASK(
     2 'NO. OF COMPONENTS TO USE FOR PMAG1 (-1=ALL, OR 0-10)',NCPP1)
        IF (NCPP1.GT.0) THEN
          DO I=1,NCPP1
            CALL ASKC('COMPONENT FOR PMAG1 (I.E. VHZ)',COMPP1(I))
          END DO
        END IF
      ELSE

        READ (INST,*,ERR=3) LABP1,PMA1,PMB1,NCPP1
        IF (NCPP1.GT.0) READ (INST,*,ERR=3) LABP1,PMA1,PMB1,NCPP1,
     2  (COMPP1(I),I=1,NCPP1)
      END IF

C--BLANK OUT REMAINING COMPONENTS TO SELECT ON
      IF (NCPP1.GE.0) THEN
        DO I=NCPP1+1,10
          COMPP1(I)='   '
        END DO
      END IF
      GOTO 5

C--<PC2> PRIMARY P AMP MAGNITUDE SELECTION BY COMPONENT
304   IF (LINST) THEN
        CALL ASKC('1-LETTER LABEL CODE FOR SECONDARY PMAG',LABP2)

        PMA2=ASKR('A VALUE IN PMAG2(OUT)= A +B*PMAG2(CALC)',PMA2)
        PMB2=ASKR('B VALUE IN PMAG2(OUT)= A +B*PMAG2(CALC)',PMB2)

        IF (NCPP2.EQ.0) THEN
          WRITE (6,
     2    '('' NO COMPONENTS NOW USED TO CALCULATE SECONDARY P MAG'')')
        ELSE IF (NCPP2.GT.0) THEN
          WRITE (6,3040) NCPP2,(COMPP2(I),I=1,NCPP2)
3040      FORMAT (I3,' COMPONENTS USED TO CALC. SECONDARY DUR MAG:'/,
     2    10(1X,A3))
        ELSE
          WRITE (6,
     2    '('' ALL COMPONENTS NOW USED TO CALCULATE SECONDARY P MAG'')')
        END IF

        NCPP2=JASK(
     2 'NO. OF COMPONENTS TO USE FOR PMAG2 (-1=ALL, OR 0-10)',NCPP2)
        IF (NCPP2.GT.0) THEN
          DO I=1,NCPP2
            CALL ASKC('COMPONENT FOR PMAG2 (I.E. VLZ)',COMPP2(I))
          END DO
        END IF
      ELSE

        READ (INST,*,ERR=3) LABP2,PMA2,PMB2,NCPP2
        IF (NCPP2.GT.0) READ (INST,*,ERR=3) LABP2,PMA2,PMB2,NCPP2,
     2  (COMPP2(I),I=1,NCPP2)
      END IF

C--BLANK OUT REMAINING COMPONENTS TO SELECT ON
      IF (NCPP2.GE.0) THEN
        DO I=NCPP2+1,10
          COMPP2(I)='   '
        END DO
      END IF
      GOTO 5

C--<PMC> SPECIFY COUNT-TO-MM CONVERSION FACTORS BY DATA SOURCES
308   IF (LINST) THEN
        WRITE (6,3080)
3080    FORMAT (' ENTER DEVELOCORDER MM PER COUNT UNIT (C-FACTORS)',
     2  ' FOR P-MAGS, BY DATA SOURCE.'/
     3  ' ENTER NUMBER OF DATA-SOURCE SPECIFIC C-FACTORS (0-10).')
        NCNTMM=JASK(
     2  ' ENTER 0 TO USE DEFAULT VALUE FROM PMA COMMAND FOR ALL COMPS',
     3  NCNTMM)
        DO I=1,NCNTMM
          WRITE (6,*) ' DATA SOURCE NUMBER',I,':'
          CALL ASKC('DATA SOURCE CODE (IE. W)',CCNTMM(I))
          CNT2MM(I)=ASKR
     2    ('C-FACTOR VALUE (RTP=.04, EARTHWORM=.0488)',CNT2MM(I))
        END DO

      ELSE
        READ (INST,*,ERR=3) NCNTMM
        IF (NCNTMM.GT.0) THEN
          READ (INST,*,IOSTAT=IOS) NCNTMM, 
     2    (CCNTMM(I),CNT2MM(I),I=1,NCNTMM)
          IF (IOS.NE.0) GOTO 3
        END IF
      END IF
      GOTO 5

C--<LAB> SET A LABEL FOR ENTIRE RUN TO INCLUDE IN OUTPUT FILES
312   IF (LINST) THEN
        CALL ASKC('1-LETTER LABEL FOR RUN, INCLUDED IN OUTPUT FILES',
     2  RUNLAB)
        LP153=LASK(
     2  'F=PUT RUN LABEL IN SUMMARY COL 153, T=PASS COL 153 THRU',LP153)
      ELSE
        READ (INST,*,IOSTAT=IOS) RUNLAB,LP153
        IF (IOS.NE.0) GOTO 3
      END IF
      GOTO 5

C--<KEP> DECIDE WHETHER TO KEEP UNRECOGNIZED STATIONS IN ARC OUTPUT FILE
316   IF (LINST) THEN
        LKEEP=LASK('WRITE UNRECOGNIZED STATIONS TO ARCHIVE FILE',LKEEP)
      ELSE
        READ (INST,*,ERR=3) LKEEP
      END IF
      GOTO 5

C--<WET> SET WEIGHTS FOR PHASE WEIGHT CODES 0-3
320   IF (LINST) THEN
        WRITE (6,*) 'ENTER NUMERICAL WEIGHTS FOR PHASE WEIGHT CODES.'
        WRITE (6,*) 'CODES 4-9 ALWAYS HAVE ZERO WEIGHT.'
        DO I=1,4
          WRITE (6,*) 'CODE',I-1
          WTVALS(I)=ASKR('NUMERICAL WEIGHT FOR PHASE',WTVALS(I))
        END DO
      ELSE
        READ (INST,*,ERR=3) WTVALS
      END IF
      GOTO 5

C--<XCH> CHOOSE STATIONS FOR THE 2 AMP MAGS BY COMPONENT OR TYPE
324   IF (LINST) THEN
        WRITE (6,*) 'CHOOSE WAY TO SELECT STATIONS FOR 2 AMP MAGS:'
        WRITE (6,*) 'USE XTY COMMAND TO SELECT INST TYPES.'
        LXCH=LASK('T=BY COMPONENT LETTER, F=BY INST TYPE',LXCH)
      ELSE
        READ (INST,*,ERR=3) LXCH
      END IF
      GOTO 5

C--<XTY> SET INSTRUMENT TYPE CODES FOR THE 2 AMP MAGS
328   IF (LINST) THEN
        NXTYP1=JASK(
     2 'NUMBER OF INTRUMENT CODES FOR AMP MAG 1 (0-3, -1=ALL)',NXTYP1)
        DO I=1,3
          WRITE (6,*) 'CODE NUMBER',I
          IXTYP1(I)=JASK(
     2    'INSTRUMENT CODE (0=WA, 1=NET, 2=SPRENG 3=NET)',IXTYP1(I))
        END DO

        NXTYP2=JASK(
     2 'NUMBER OF INTRUMENT CODES FOR AMP MAG 2 (0-3, -1=ALL)',NXTYP2)
        DO I=1,3
          WRITE (6,*) 'CODE NUMBER',I
          IXTYP2(I)=JASK(
     2    'INSTRUMENT CODE (0=WA, 1=NET, 2=SPRENG 3=NET)',IXTYP2(I))
        END DO

      ELSE
        READ (INST,*,IOSTAT=IOS)  NXTYP1,(IXTYP1(I),I=1,3),
     2  NXTYP2,(IXTYP2(I),I=1,3)
        IF (IOS.NE.0) GOTO 3
      END IF
      GOTO 5

C--<200> INVOKE YR 2000 FORMATS
332   IF (LINST) THEN
        L2000=LASK('T FOR YR 2000 FORMATS, F=OLD FORMATS',L2000)
        ICENT=JASK('DEFAULT CENTURY FOR OLD PHASE INPUT',ICENT)
        IAMPU=JASK('DEFAULT AMP UNITS CODE FOR OLD PHASE INPUT',
     2  IAMPU)
      ELSE

        READ (INST,*,IOSTAT=IOS) L2000,ICENT,IAMPU
        IF (IOS.NE.0) GOTO 3
      END IF
      GOTO 5

C--<FIL> DETERMINE THE PHASE FILE TYPE AND CHANGE I/O FORMATS
336   WRITE (6,*)
     2' FIND INPUT PHASE FILE TYPE & SET PHS(COP) & ARC(CAR) FORMATS'
      CALL OPENR (14,PHSFIL,'F',IOS)
      IF (IOS.NE.0) THEN
        WRITE (6,*) ' *** ERROR - PHASE FILE DOES NOT EXIST ***'
        WRITE (6,*) ' YOU MUST SPECIFY FILE WITH THE PHS COMMAND FIRST'
        GOTO 5
      END IF
      
C--DETERMINE FORMAT BY READING FIRST RECORD OR 2. ALSO FINDS SUMMARY FORMATS.
      CALL HYFILE (14,ITYPE)
      CLOSE (14)
      IF (ITYPE.EQ.-1) THEN
        WRITE (6,*) ' *** ERROR: INPUT PHASE FILE IS EMPTY'
      ELSE IF (ITYPE.EQ.0) THEN
        WRITE (6,*) ' *** ERROR: INPUT PHASE FILE HAS AN UNKNOWN FORMAT'
      ELSE IF (ITYPE.EQ.1) THEN
        WRITE (6,*) 
     2' *** ERROR: INPUT FILE IS A HYPOINVERSE (PRE 2000) SUMMARY FILE'
      ELSE IF (ITYPE.EQ.2) THEN
        WRITE (6,*) 
     2' *** ERROR: INPUT FILE IS A HYPOINVERSE-2000 SUMMARY FILE'
      ELSE IF (ITYPE.EQ.3) THEN
        WRITE (6,*)
     2' *** ERROR: INPUT FILE IS A HYPO71 (PRE 2000) SUMMARY FILE'
      ELSE IF (ITYPE.EQ.4) THEN
        WRITE (6,*) 
     2' *** ERROR: INPUT FILE IS A HYPO71-2000 SUMMARY FILE'
      ELSE IF (ITYPE.EQ.5) THEN
        WRITE (6,*) 
     2' INPUT IS A TRADITIONAL HYPO71-HYPOINVERSE PHASE FILE'
        WRITE (6,*) ' SETTING FORMATS COP 1, CAR 1'
        JCP=1
        JCA=1
      ELSE IF (ITYPE.EQ.6) THEN
        WRITE (6,*) 
     2' INPUT IS A HYPO71-HYPOINVERSE PHASE FILE WITH SHADOW CARDS'
        WRITE (6,*) ' SETTING FORMATS COP 4, CAR 3'
        JCP=4
        JCA=3
 
      ELSE IF (ITYPE.EQ.7) THEN
        WRITE (6,*) 
     2' INPUT IS A HYPOINVERSE ARCHIVE FILE (PRE 2000), NO SHADOWS'
        IF (L2000) THEN
          WRITE (6,*)
     2' *** ERROR: YOU SHOULD RERUN PROGRAM WITHOUT Y2000 FORMATS'
        ELSE
          WRITE (6,*) ' SETTING FORMATS COP 3, CAR 1'
          JCP=3
          JCA=1
        END IF

      ELSE IF (ITYPE.EQ.8) THEN
        WRITE (6,*) 
     2' INPUT IS A HYPOINVERSE ARCHIVE-2000 FILE, NO SHADOWS'
        IF (.NOT.L2000) THEN
          WRITE (6,*)
     2' *** ERROR: YOU SHOULD RERUN PROGRAM WITH Y2000 FORMATS'
        ELSE
          WRITE (6,*) ' SETTING FORMATS COP 3, CAR 1'
          JCP=3
          JCA=1
        END IF

      ELSE IF (ITYPE.EQ.9) THEN
        WRITE (6,*) 
     2' INPUT IS A HYPOINVERSE ARCHIVE FILE (PRE 2000), WITH SHADOWS'
        IF (L2000) THEN
          WRITE (6,*)
     2' *** ERROR: YOU SHOULD RERUN PROGRAM WITHOUT Y2000 FORMATS'
        ELSE
          WRITE (6,*) ' SETTING FORMATS COP 5, CAR 3'
          JCP=5
          JCA=3
        END IF

      ELSE IF (ITYPE.EQ.10) THEN
        WRITE (6,*) 
     2' INPUT IS A HYPOINVERSE ARCHIVE-2000 FILE, WITH SHADOWS'
        IF (.NOT.L2000) THEN
          WRITE (6,*)
     2' *** ERROR: YOU SHOULD RERUN PROGRAM WITH Y2000 FORMATS'
        ELSE
          WRITE (6,*) ' SETTING FORMATS COP 5, CAR 3'
          JCP=5
          JCA=3
        END IF
      END IF
      GOTO 5

C--<DUG> GET COMPONENTS TO APPLU DURATION GAIN CORRECTION TO
340   IF (LINST) THEN
        WRITE (6,*) ' -1 APPLY GAIN CORR TO ALL COMPS; 0 NO COMPS;'
        WRITE (6,*) ' 1-10 NUMBER OF COMPONENTS TO CORRECT:'
        IDUG=JASK('NUMBER OF DUR GAIN CORRECTION COMPONENTS',IDUG)
        DO I=1,IDUG
          CALL ASKC('COMPONENT TO APPLY DUR GAIN CORRECTION TO: ',
     2    CDUG(I))
        END DO
      ELSE

        READ (INST,*,ERR=3) IDUG
        IF (IDUG.GT.0) THEN
          READ (INST,*,IOSTAT=IOS) IDUG,(CDUG(I),I=1,IDUG)
          IF (IOS.NE.0) GOTO 3
        END IF
      END IF
      GOTO 5
      
C--<XMT> CHOOSE WHICH MAGNITUDE TYPES GO WITH XMAG1 AND XMAG2
344   IF (LINST) THEN
        WRITE (6,*)' CHOOSE TYPES FOR AMP MAGNITUDES 0=ANY 1=ML 2=MX:'
        MAG1TYPX=JASK('TYPE FOR XMAG1',MAG1TYPX)
        MAG2TYPX=JASK('TYPE FOR XMAG2',MAG2TYPX)
      ELSE
        READ (INST,*,IOSTAT=IOS) MAG1TYPX, MAG2TYPX
        IF (IOS.NE.0) GOTO 3
      END IF
      GOTO 5
      
C--<DIG> SET SOME DIGITIZER CODES (3-LET IN, 1-LET OUT)
348   WRITE (6,*) ' ***DIG: CUSP PROCESSING NO LONGER SUPPORTED'
C348   IF (LINST) THEN
C        WRITE (6,*)' ENTER DIGITIZER CODES (3-LET IN, 1-LET OUT):'
C        IDIG=JASK('FIRST DIGITIZER CODE TO SET',0)
C        IF (IDIG.LT.1) THEN
C          WRITE (6,*)' CANT BE LESS THAN 1'
C          GOTO 5
C        END IF

C        JDIG=JASK(' LAST DIGITIZER CODE TO SET',0)
C        IF (JDIG.GT.MAXDIG) THEN
C          WRITE (6,*)' CANT BE MORE THAN ',MAXDIG
C          GOTO 5
C        END IF
        
C        DO I=IDIG,JDIG
C          WRITE (6,*)' CODE ',I,' :'
C          CALL ASKC ('INPUT CUSP 3-LETTER CODE:',DIG3(I))
C          CALL ASKC ('OUTPUT 1-LETTER DATA SOURCE CODE:',DIG1(I))
C        END DO
C        GOTO 5
        
C      ELSE
C        READ (INST,*,ERR=3) IDIG,JDIG
C        IF (IDIG.LT.1) THEN
C          WRITE (6,*)' IDIG CANT BE LESS THAN 1'
C          GOTO 5
C        END IF

C        IF (JDIG.GT.MAXDIG) THEN
C          WRITE (6,*)' JDIG CANT BE MORE THAN ',MAXDIG
C          GOTO 5
C        END IF
        
C        READ (INST,*,ERR=3) IDIG,JDIG,(DIG3(I),DIG1(I),I=IDIG,JDIG)
C      END IF
      GOTO 5

C--<DID> SET NUMBER OF DIGITIZER CODES & DEFAULT CODE
352   WRITE (6,*) ' ***DID: CUSP PROCESSING NO LONGER SUPPORTED'
C352   IF (LINST) THEN
C        NDIG=JASK('TOTAL NUMBER OF DIGITIZER CODES (MAX 50)',NDIG)
C        CALL ASKC('DEFAULT SOURCE CODE WHEN DIGITIZER NOT DEFINED',
C     2  DIGDEF)
C      ELSE
C        READ (INST,*,ERR=3) NDIG,DIGDEF
C      END IF
      GOTO 5

C--<VER> PROCESSING DOMAIN & VERSION FOR SUMMARY CARDS & PRINT FILE
354   IF (LINST) THEN
        CALL ASKC ('2-CHAR PROCESSING DOMAIN',CDOMAN)
        CALL ASKC ('2-CHAR PROCESSING VERSION',CPVERS)
      ELSE
        READ (INST,*,IOSTAT=IOS) CDOMAN,CPVERS
        IF (IOS.NE.0) GOTO 3
      END IF
      GOTO 5
      
C--<CRL> PARAMETERS FOR A LINEAR GRAD CRUSTAL MODEL (HYPOELLIPSE)
C--MAY NOT NEED THIS OPTION BECAUSE CRV CASE INCLUDES THIS
358   IF (LINST) THEN
        MOD=JASK('SINGLE LINEAR GRADIENT CRUST MODEL NO. (1-36)',1)
        IF (MOD.LT.1 .OR. MOD.GT.LH) GOTO 146
        IF (MODTYP(MOD).GE.0) WRITE (6,1018) MOD

        CALL ASKC('MODEL NAME',MODNAM(MOD))
        ELEVMX(MOD)=ASKR('REFERENCE (MAX) ELEV ABOVE S.L. IN KM',
     2  ELEVMX(MOD))
        VREF(MOD)=ASKR('VELOCITY AT REFERENCE ELEV',VREF(MOD))
        VGRAD(MOD)=ASKR('VELOCITY GRADIENT OF ENTIRE MODEL',VGRAD(MOD))
        LELEV(MOD)=LASK('T TO USE STA ELEVS, F ALL AT REF ELEV',
     2  LELEV(MOD))
      ELSE
        READ (INST,*,ERR=3) MOD
        IF (MOD.LT.1 .OR. MOD.GT.LH) GOTO 146
        IF (MODTYP(MOD).GE.0) WRITE (6,1018) MOD
        READ (INST,*,IOSTAT=IOS) MOD,MODNAM(MOD),ELEVMX(MOD),
     2  VREF(MOD),VGRAD(MOD),LELEV(MOD)
        IF (IOS.NE.0) GOTO 3
      END IF
      CRODE(MOD)=MODNAM(MOD)(1:3)
      MODTYP(MOD)=3
C--SET THE LARGEST MODEL NUMBER
      IF (MOD.GT.MAXMOD) MAXMOD=MOD
      GOTO 5

C--<CRV> PARAMETERS FOR A LINEAR GRAD OVER HALFSPACE MODEL (HYPOELLIPSE)
362   IF (LINST) THEN
        MOD=JASK('LINEAR GRADIENT OVER HALFSPACE MODEL NO. (1-36)',1)
        IF (MOD.LT.1 .OR. MOD.GT.LH) GOTO 146
        IF (MODTYP(MOD).GE.0) WRITE (6,1018) MOD

        CALL ASKC('MODEL NAME',MODNAM(MOD))
        VSEA(MOD)=ASKR('VELOCITY AT SEA LEVEL ELEV (KM/S)',VSEA(MOD))
        VGRAD(MOD)=ASKR('VELOCITY GRADIENT OF LAYER',VGRAD(MOD))
        THICK(MOD)=ASKR('THICKNESS OF GRADIENT LAYER (KM)',THICK(MOD))
        VHALF(MOD)=ASKR('VELOCITY OF HALFSPACE',VHALF(MOD))
        ELEVMX(MOD)=ASKR('REFERENCE (MAX) ELEV ABOVE S.L. IN KM',
     2  ELEVMX(MOD))
        LELEV(MOD)=LASK('T TO USE STA ELEVS, F ALL AT SEA LEVEL',
     2  LELEV(MOD))
      ELSE
        READ (INST,*,ERR=3) MOD
        IF (MOD.LT.1 .OR. MOD.GT.LH) GOTO 146
        IF (MODTYP(MOD).GE.0) WRITE (6,1018) MOD
        READ(INST,*,IOSTAT=IOS) MOD,MODNAM(MOD),VSEA(MOD),
     2  VGRAD(MOD),THICK(MOD),VHALF(MOD),ELEVMX(MOD),LELEV(MOD)
        IF (IOS.NE.0) GOTO 3
      END IF
      CRODE(MOD)=MODNAM(MOD)(1:3)
      MODTYP(MOD)=2

C--SET THE LARGEST MODEL NUMBER
      IF (MOD.GT.MAXMOD) MAXMOD=MOD
C--WARN THAT THERE IS A LOW VELOCITY ZONE BELOW THE GRADIENT LAYER
      TEMP=VSEA(MOD) +VGRAD(MOD)*THICK(MOD)
      IF (TEMP.GT.VHALF(MOD)) THEN
        WRITE (6,*) ' *** VELOCITY AT BASE OF GRADIENT LAYER: ',TEMP
        WRITE (6,*) ' EXCEEDS HALF SPACE VELOCITY: ',VHALF(MOD)
      END IF
      GOTO 5

C--<SAL> SPECIFY AN S MODEL ALTERNATE TO A P MODEL
366   IF (LINST) THEN
C--LIST EXISTING P AND S MODEL PAIRS:
        WRITE (6,1366)
1366    FORMAT 
     2  (' EXISTING PAIRS, IF ANY, OF P MODEL NUMBER & ITS S MODEL:')
        DO I=1,MAXMOD
          IF (MODSAL(I).GT.0) WRITE (6,'(2I4)') I,MODSAL(I)
        END DO

        I=JASK('PRIMARY P MODEL NUMBER TO HAVE AN S MODEL',1)
        J=MODSAL(I)
        MODSAL(I)=JASK('S MODEL NO. (0 FOR NONE)',J)
      ELSE
        READ (INST,*,IOSTAT=IOS) I,MODSAL(I)
        IF (IOS.NE.0) GOTO 3
      END IF

C--BE SURE THE P/S VELOCITY RATIO IS SET TO 1 FOR S MODELS
      IF (MODSAL(I).GT.0) THEN
        POSM(I)=1.
        POSB(I)=0.
      END IF
C--TEST TO BE SURE P AND S MODELS ARE OF THE SAME TYPE
      IF (MODSAL(I).NE.0) THEN
        IF (MODTYP(I) .NE. MODTYP(MODSAL(I))) THEN
          WRITE (6,2366) I,MODNAM(I),MODSAL(I),MODNAM(MODSAL(I))
2366      FORMAT ('*** WARNING. P & S MODELS',2(/,I3,2X,A),/,
     2    ' ARE OF DIFFERENT TYPES')
        END IF
      END IF
      GOTO 5

C--<MAR> PARAMETERS FOR 2ND FMAG (FMAG2) IN GEOGRAPHIC BOX
370   IF (LINST) THEN
        USEMAR=LASK ('T FOR FMAG2 IN A LAT/LON BOX',USEMAR)
        WRITE (6,*) 'T TO SWITCH FMAGS 1 & 2 FOR EQS IN BOX'
        SWITCH12=LASK ('ONLY FOR READABLE SUMMARY FORMAT',SWITCH12)

        IF (USEMAR) THEN
C--DO NOT SELECT COMPONENTS FOR FMAG2
          NCPF2=0
          YLATMX=ASKR('MAX LAT FOR FMAG2 BOX',YLATMX)
          YLATMN=ASKR('MIN LAT FOR FMAG2 BOX',YLATMN)
          XLONMX=ASKR('MAX LON FOR FMAG2 BOX, POSITIVE W',XLONMX)
          XLONMN=ASKR('MIN LON FOR FMAG2 BOX, POSITIVE W',XLONMN)
        END IF
      ELSE
        READ (INST,*,ERR=3) USEMAR
        IF (USEMAR) THEN
          READ(INST,*,IOSTAT=IOS) USEMAR,SWITCH12,
     2   YLATMX,YLATMN,XLONMX,XLONMN
          IF (IOS.NE.0) GOTO 3
        END IF
      END IF
      GOTO 5

C--<RDM> CONTROLS FOR MAGS IN READABLE SUMMARY FORMATS
374   IF (LINST) THEN

        LBLANKMAG=LASK (
     1  'T TO BLANK-OUT UNCALC MAGS IN READABLE SUMMARY FILES',
     2  LBLANKMAG)
        NRDMAG=JASK(
     1   'NO. OF INDIVIDUAL MAGS IN READABLE SUMMARY OUTPUT (0-5)',
     2   NRDMAG)
        IF (NRDMAG.GT.0) WRITE (6,*)
     1   'MAG TYPES ARE 1=FMAG1 2=FMAG2 3=XMAG1 4=XMAG2 5=EXT-MAG'
        DO I=1,NRDMAG
          WRITE (6,*) 'MAG TYPE IN POS NUMBER ',I,':'
          MRDMAG(I)=JASK('MAGNITUDE TYPE',MRDMAG(I))
        END DO

      ELSE
        READ (INST,*,IOSTAT=IOS) LBLANKMAG,NRDMAG
        IF (IOS.NE.0) GOTO 3
        IF (NRDMAG.GT.0) THEN
          READ(INST,*,IOSTAT=IOS)
     1    LBLANKMAG,NRDMAG,(MRDMAG(I),I=1,NRDMAG)
          IF (IOS.NE.0) GOTO 3
        END IF
      END IF
      GOTO 5


C--<GEO> TRUE TO CORRECT REPORTED CRT & CRH DEPTHS TO THE GEOID
376   IF (LINST) THEN
        LGEOID=LASK('CORRECT REPORTED CRT & CRH DEPTHS TO GEOID'
     2 ,LGEOID)
      ELSE
        READ (INST,*,ERR=3) LGEOID
      END IF
      GOTO 5
      END      
