      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
      LOGICAL LASK
      EXTERNAL LASK
      CHARACTER TEMPSTR*80
      PARAMETER (NCMD=92)
      CHARACTER CMD(NCMD)*3
      LOGICAL LINST
      SAVE CMD

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'/

C++++++++++++++++++ COMMAND INTERPRETER ++++++++++++++++++++
C--IF HYPOINVERSE IS A SUBROUTINE, WE HAVE 1 COMMAND LOADED IN CM & INST
      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) 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,188,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), 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) READ (INST,*,ERR=3) JST,JST2,JST3
      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,*,ERR=27) LREP,LPRALL
      END IF
      GOTO 5

C--FORMAT ERROR
27    READ (INST,*,ERR=3) LREP
      WRITE (6,'('' *** WARNING: PARAMETER ADDED TO REP COMMAND'')')
      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'/
     3  '  6=ONE-CUSP-EVENT 7=CUSP-LIST')
        JCP=JASK('PHASE FORMAT',JCP)
        IF (JCP.EQ.6 .OR. JCP.EQ.7) THEN
          WRITE (6,*) ' LEVEL OF MEM OUTPUT OF LOCATION TO CUSP:'
          WRITE (6,*)' 0=NONE 1=DATA STRUCTURES 2=SHARED MEMORY REGION'
          JCPO=JASK ('3=MEM DISK FILE',JCPO)
        END IF
      ELSE
        READ (INST,*,ERR=3) JCP
        IF (JCP.EQ.6 .OR. JCP.EQ.7) READ (INST,*,ERR=3) JCP,JCPO
      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.'

C34      IF (LINST) THEN
C        KDLY=JASK('KDLY, DELAY MODEL CONTROL (1-4)',KDLY)
C        IF (KDLY.LT.3) GOTO 5
C        DLYAZ=ASKR('DLYAZ',DLYAZ)
C        DLYWD=ASKR('DLYWD',DLYWD)
C        DLYLON=ASKR('DLYLON',DLYLON)
C        DLYLAT=ASKR('DLYLAT',DLYLAT)
C      ELSE
C        READ (INST,*,ERR=3) KDLY
C        IF (KDLY.LT.3) GOTO 5
C        READ (INST,*,ERR=3) KDLY,DLYAZ,DLYWD,DLYLON,DLYLAT
C      END IF
      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,*,ERR=3) ITRLIM,DQUIT,DRQT
      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,*,ERR=3) DXFIX,DZMAX,DZAIR,DAMP,EIGTOL,RBACK,BACFAC,
     2 DXMAX,D2FAR
      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,*,ERR=48) FMA1,FMB1,FMZ1,FMD1,FMF1,
     2  FMA2,FMB2,FMZ2,FMD2,FMF2, FMBRK,FMGN
      END IF
      GOTO 5

C--FORMAT ERROR
48    READ (INST,*,ERR=3) FMA1,FMB1,FMZ1,FMD1,
     2 FMA2,FMB2,FMZ2,FMD2, FMBRK,FMGN
      WRITE (6,'(''*** WARNING: NEW PARAMETERS ADDED TO DUR COMMAND'')')
      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,*,ERR=3) ITRDIS,DISCUT,DISW1,DISW2
      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,*,ERR=3) ITRDI1,DISCU1,DISW11,DISW21
      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,*,ERR=3) ITRRES,RMSCUT,RMSW1,RMSW2
      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
56    IF (LINST) THEN
        POS=ASKR('P/S VELOCITY RATIO',POS)
      ELSE
        READ (INST,*,ERR=3) POS
      END IF
      GOTO 5

C--<ZTR> TRIAL DEPTH
58    IF (LINST) THEN
        ZTR=ASKR('TRIAL DEPTH, NEG TO FIX DEPTH',ZTR)
      ELSE
        READ (INST,*,ERR=3) ZTR
      END IF
      GOTO 5

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
        IH71S=JASK
     2  ('SUMMARY FORMAT: 1=HYPOINVERSE 2=HYPO71',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,*,ERR=3) IH71S,IH71T,ISTFMT
      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=P AMP MAG')
        MLOGA0=JASK('LOG(A0) RELATION CHOICE',MLOGA0)

      ELSE
        READ (INST,*,ERR=97) MAGSEL,LCOWT,MAGSL2,MLOGA0
      END IF
      GOTO 5

C--OLD FORMAT ERROR
97    READ (INST,*,ERR=3) MAGSEL,LCOWT
      WRITE (6,*)' *** WARNING: ADD NEW ARGUMENTS TO MAG COMMAND'
      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,*,ERR=3) DMA0,DMA1,DMA2,DMLI,DMZ,DMGN
      END IF
      GOTO 5

C--<FID> FORMAT FOR READING CUSP-ID NUMBERS FROM A FILE
104   IF (LINST) THEN
        CALL ASKC('FORMAT FOR READING CUSP-ID NUMBERS',FORID)
      ELSE
        READ (INST,*,ERR=3) FORID
      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) READ (INST,*,ERR=3) LMULT,MODDEF
      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,*,ERR=3) I,MODALT(I)
      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,*,ERR=3) TMP1,TMP2,TMP3,TMP4,RAD1(NNODE),
     2  DRAD(NNODE),MODH(NNODE)
      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--<CRH> READ A HOMO LAYER CRUSTAL MODEL
144   IF (LINST) THEN
        MOD=JASK('HOMOGENEOUS LAYER CRUST MODEL NO. (1-20)',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,*,ERR=3) MOD,CRUFIL(MOD)
      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=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,*,ERR=3) MOD,CRUFIL(MOD)
      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=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,*,ERR=3) MODB,DELFIL
      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,*,ERR=3) CALFIL,ICY
        IF (ICY.EQ.0) THEN
          ICDATE=0
          GOTO 161
        END IF
        READ (INST,*,ERR=3) CALFIL,ICY,ICM,ICD,ICH
      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,*,ERR=3) ATNFIL,ICY
        IF (ICY.EQ.0) THEN
          ICDATE=0
          GOTO 164
        END IF
        READ (INST,*,ERR=3) ATNFIL,ICY,ICM,ICD,ICH
      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
      IF (JCP.EQ.6) THEN
        IF (LINST) THEN
          IDNO=JASK('CUSP-ID NUMBER',0)
          MEMDSK=JASK('0=GET FROM MEMORY, 1=GET FROM DISK',1)
        ELSE
          READ (INST,*,ERR=3) IDNO,MEMDSK
        END IF
      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,*,ERR=3) FMCFIL,LNOFMC,ICY
        IF (ICY.EQ.0) THEN
          IFDATE=0
          GOTO 174
        END IF
        READ (INST,*,ERR=3) FMCFIL,LNOFMC,ICY,ICM,ICD,ICH
      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) READ (INST,*,ERR=3) NLUNK,(LUNK(I),I=1,NLUNK)
      END IF
      GOTO 5

C--<VER> SET XMAG CORRECTION FOR SHORT PERIOD VERTICAL STATIONS
C  (TYPE=1 AND 5TH LETTER OF STATION CODE =V OR Z)
C--THE VER COMMAND IS SUPERCEDED BY THE XCM COMMAND, WHICH CAN CORRECT
C  ANY COMPONENT
188   WRITE (6,*)' *** THE XCM COMMAND REPLACES THE VER COMMAND ***'
      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,*,ERR=3) XMCFIL,LNOXMC,ICY
        IF (ICY.EQ.0) THEN
          IXDATE=0
          GOTO 194
        END IF
        READ (INST,*,ERR=3) XMCFIL,LNOXMC,ICY,ICM,ICD,ICH
      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,LAY,MODNAM,CRODE,VEL,VSQ,D,THK,REDV
      WRITE (14) DD1,ND1,ND,DD2,ND2,GD1,GD2
      WRITE (14) DZ1,NZ1,NZ,DZ2,NZ2,GZ1,GZ2
      WRITE (14) KDHR,MAXMOD
      WRITE (14) KT
      WRITE (14) NNODE,HLAT,HLON,RAD1,RAD2,DRAD,MODH
      WRITE (14) MODALT,LMULT,MODDEF
      CLOSE (14)
      GOTO 5

C--<RCR> READ BINARY SNAPSHOT OF ALL CRUST MODELS (REPLACES CRT,CRH,NOD,MUL,ALT)
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,LAY,MODNAM,CRODE,VEL,VSQ,D,THK,REDV
      READ (14) DD1,ND1,ND,DD2,ND2,GD1,GD2
      READ (14) DZ1,NZ1,NZ,DZ2,NZ2,GZ1,GZ2
      READ (14) KDHR,MAXMOD
      READ (14) KT
      READ (14) NNODE,HLAT,HLON,RAD1,RAD2,DRAD,MODH
      READ (14) MODALT,LMULT,MODDEF

      LBCRU=.TRUE.
      WRITE (6,'(I6,'' CRUST MODELS READ IN BINARY'')') MAXMOD
      CLOSE (14)
      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,JLATD,JLATM,JLOND,
     2 JLONM,JPER,JCAL,JLMOD,JFCOR,JXCOR,JPSWT,JXWT,JFWT,STRMK,JPD,
     3 JTYPE,JSLOC,JSLOC2,JFGWT,JCOMPA
      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,JLATD,JLATM,JLOND,
     2 JLONM,JPER,JCAL,JLMOD,JFCOR,JXCOR,JPSWT,JXWT,JFWT,STRMK,JPD,
     3 JTYPE,JSLOC,JSLOC2,JFGWT,JCOMPA
      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,*,ERR=3) LSTFIL,NCBASE,LSTFOR, EXTPHS,EXTARC,
     2  EXTSUM,EXTPRT,IEDFLG
      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,*,ERR=3) LABF1,NCPF1
        IF (NCPF1.GT.20) THEN
          WRITE (6,*) ' *** ERROR-TOO MANY FC1 COMPONENTS REQUESTED'
          GOTO 5
        END IF
        IF (NCPF1.GT.0) READ (INST,*,ERR=3) LABF1,NCPF1,
     2  (COMPF1(I),I=1,NCPF1)
      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,*,ERR=3) LABF2,NCPF2
        IF (NCPF2.GT.20) THEN
          WRITE (6,*) ' *** ERROR-TOO MANY FC2 COMPONENTS REQUESTED'
          GOTO 5
        END IF
        IF (NCPF2.GT.0) READ (INST,*,ERR=3) LABF2,NCPF2,
     2  (COMPF2(I),I=1,NCPF2)
      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,*,ERR=3) LABX1,NCPX1
        IF (NCPX1.GT.20) THEN
          WRITE (6,*) ' *** ERROR-TOO MANY XC1 COMPONENTS REQUESTED'
          GOTO 5
        END IF
        IF (NCPX1.GT.0) READ (INST,*,ERR=3) LABX1,NCPX1,
     2  (COMPX1(I),I=1,NCPX1)
      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,*,ERR=3) LABX2,NCPX2
        IF (NCPX2.GT.20) THEN
          WRITE (6,*) ' *** ERROR-TOO MANY XC2 COMPONENTS REQUESTED'
          GOTO 5
        END IF
        IF (NCPX2.GT.0) READ (INST,*,ERR=3) LABX2,NCPX2,
     2  (COMPX2(I),I=1,NCPX2)
      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,*,ERR=3) DCOFM1,DBRKM1,DCOFM2,DBRKM2,ZCOFM,ZBRKM
      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)=JASK('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,*,ERR=3) NFCM,(CFCM(I),AFCM(I),I=1,NFCM)
      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)=JASK('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,*,ERR=3) NXCM,(CXCM(I),AXCM(I),I=1,NXCM)
      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  "HYPINITFILE".
268   CALL GETENV ('HYPINITFILE',TEMPSTR)
      IF (TEMPSTR.EQ.'    ') THEN
        WRITE (6,1268) 
1268    FORMAT (' ENVIRONMENT VARIABLE "HYPINITFILE" FOR STARTUP FILE ',
     2  ' NOT FOUND.'/' LETS TRY A STANDARD FILENAME.'/
     3  ' IN THE FUTURE YOU SHOULD DEFINE IT LIKE THIS:'/
C     4  ' On andreas:'/
C     5  '  setenv HYPINITFILE /we/calnet/klein/hypfiles/cal2000.hyp'/
     6  ' On swave:'/
     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,*,ERR=3) NSTLET, NETLET, NCOMP
        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      IF (LINST) THEN
C        WRITE (6,*) ' IF USING 1-LETTER STATION COMPONENTS,'
C        LCOMP1=LASK
C     2  ('T=USE 1-LET COMP. FIELD, F=USE FIRST LET OF 3-LET FIELD',
C     3  LCOMP1)
C      ELSE
C        READ (INST,*,ERR=3) LCOMP1
C      END IF

C--CHECK TO SEE IF 1-LETTER STATION CODES ARE BEING USED CONSISTENTLY
C      IF (LCOMP1 .AND. NCOMP.NE.1) THEN
C        WRITE (6,*) ' *** YOU CANT READ THE 1-LETTER STATION'
C        WRITE (6,*) ' COMPONENT FIELD BECAUSE YOU HAVE ASKED FOR',
C     2  NCOMP,' COMPONENT LETTERS'
C        LCOMP1=.FALSE.
C        IRES=-74
C      END IF

C--IN CASE STATION FILE HAS ALREADY BEEN READ IN AND MATCHING IS TO BE DONE
C  WITH 1-LETTER COMPONENT FIELD, TRANSFER 1-LET COMPS TO 3-LETT ARRAY, 
C  BECAUSE MATCHING IS ACTUALLY ONLY DONE WITH 3-LET ARRAY.
C      IF (LCOMP1 .AND. JSTA.GT.0) THEN
C        DO J=1,JSTA
C          JCOMP3(J)=JCOMP1(J)
C        END DO
C      END IF
C      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,*,ERR=3) FMA1B,FMB1B,FMZ1B,FMD1B,FMF1B,
     2  FMA2B,FMB2B,FMZ2B,FMD2B,FMF2B, FMBRKB,FMGNB
      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 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) READ (INST,*,ERR=3) NMAGS,
     2  (MPREF(I),MNPREF(I),AMPREF(I),AXPREF(I),I=1,NMAGS)
      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) READ(INST,*,ERR=3)NLA0,(CLA0(I),MLA0(I),I=1,NLA0)
      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,*,ERR=3) LPMAG,LPPRT,CNT2MD,CLPRAT,LATYPP
      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) READ (INST,*,ERR=3) NPWM,
     2  (CPWM(I),WPWM(I),I=1,NPWM)
      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) READ (INST,*,ERR=3) NCNTMM, 
     2  (CCNTMM(I),CNT2MM(I),I=1,NCNTMM)
      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,*,ERR=3) RUNLAB,LP153
      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,*,ERR=3)  NXTYP1,(IXTYP1(I),I=1,3),
     2  NXTYP2,(IXTYP2(I),I=1,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,*,ERR=3) L2000,ICENT,IAMPU
      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) READ (INST,*,ERR=3) IDUG,(CDUG(I),I=1,IDUG)
      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,*,ERR=3) MAG1TYPX, MAG2TYPX
      END IF
      GOTO 5
      
C--<DIG> SET SOME DIGITIZER CODES (3-LET IN, 1-LET OUT)
348   IF (LINST) THEN
        WRITE (6,*)' ENTER DIGITIZER CODES (3-LET IN, 1-LET OUT):'
        IDIG=JASK('FIRST DIGITIZER CODE TO SET',0)
        IF (IDIG.LT.1) THEN
          WRITE (6,*)' CANT BE LESS THAN 1'
          GOTO 5
        END IF

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

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

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

      END      
