      SUBROUTINE HYPHS
C--READS IN PHASE DATA FOR 1 HYPOINVERSE EARTHQUAKE
C--ALSO CHECK FOR TRIAL HYPOCENTER & MANY ERRORS IN DATA
      INCLUDE 'common.inc'
      LOGICAL LPHFMT,LSHAD
C--USE STRI FOR PHASE LINE INPUT & OUTPUT, STR AS A SCRATCH STRING
C  FOR REFORMATTING, AND STR2 FOR AN EXPECTED SUMMARY (HEADER) LINE
      CHARACTER CSTA*4,CCWT*1, LASTA*5,STA*5, RTPFL*2, STR*188, STRI*188
      CHARACTER STR2*188, COMP1*1,COMP3*3, SNET*2, SHASTR*104, CSTIM*5
      CHARACTER SLOC*2
      DOUBLE PRECISION DT
      SAVE RMKS, RMKA, NLET

C--ARRAYS FOR INPUT (EXTERNAL) MAGNITUDES TO PASS THRU
      CHARACTER BMTYPI*1
      DIMENSION BMTYPI(2),BMAGI(2),TEMPI(2)

C--RMKS IS THE ARRAY OF EVENT REMARKS WHICH ARE RECOGNIZED, ABBREVIATED
C  TO 1 LETTER & OUTPUT AS A SUPPLEMENTARY REMARK.
      PARAMETER (NRMK=9)      !THE NUMBER OF INPUT REMARKS RECOGNIZED
      DIMENSION NLET(NRMK)      !NUMBER OF LETTERS REQUIRED TO RECOGNIZE
      CHARACTER RMKS(NRMK)*3      !INPUT REMARKS RECOGNIZED
      CHARACTER RMKA(NRMK)*1      !TRANSLATED 1-LETTER OUTPUT REMARK CODES
C-- FLT OR F: FELT
C-- TRM OR T: TREMOR ASSOCIATED
C-- LP_ (LPC OR LPD): LONG PERIOD
C-- BLS, Q__ OR *__: QUARRY BLAST
      DATA RMKS/'FLT','F  ','TRM','T  ','LP ','BLS','Q  ','*  ','NTS'/
      DATA RMKA/'F',  'F',  'T',  'T',  'L',  'B',  'Q',  'Q',  'N'  /
      DATA NLET/ 3,    3,    3,    3,    2,    2,    1,    1,    3   /

C--JCP IS THE INPUT FORMAT CONTROL:
C  1= FULL PHASE
C  2= CONDENSED PHASE
C  3= ARCHIVE
C  4= FULL PHASE WITH HEADER & SHADOW RECORDS
C  5= ARCHIVE WITH SHADOW RECORDS

1001  FORMAT (A)

C--DEFINE LOGICAL SHORT-CUTS
      LPHFMT=JCP.EQ.1 .OR. JCP.EQ.4
      LSHAD =JCP.EQ.4 .OR. JCP.EQ.5

C---------------------- PROCESS THE LAST PART OF A LARGE EVENT ---------------
      IF (LTBIG) THEN
C--MORE PHASE CARDS REMAIN FROM EVENT, SO COPY THEM TO OUTPUT
        LTBIG=.FALSE.
C--SEND MESSAGES TO THE PRINT FILE & TERMINAL
        IF (LERR) WRITE (6,1020)
        IF (LPRT) WRITE (15,1020)
1020    FORMAT (' *** ADDITIONAL PHASE DATA FOR ABOVE EVENT',
     2 ' WAS NOT USED BUT WAS COPIED TO OUTPUT.')

C--LOOP TO READ AND COPY ADDITIONAL PHASE DATA
5       CALL READQ (14,STRI,NSTR,IOS)
        IF (IOS.GT.0) GOTO 80
        IF (STRI(1:4).EQ.'    ') THEN

C--THIS IS A TERMINATOR SO COPY IT AS IS
          IF (LARC) WRITE (7,1001) STRI(1:NSTR)
          IF (LSHAD) THEN
            CALL READQ (14,SHADO,LENSHA,IOS)
            IF (IOS.GT.0) GOTO 80
            IF (LARC) WRITE (7,1001) SHADO(1:LENSHA)
          END IF
          GOTO 8
        END IF

C--THIS IS NOT A TERMINATOR, SO PROCESS ACCORDING TO ITS FORMAT
C  COPY FIELDS FROM INPUT TO OUTPUT STRING
        STR=' '
        IF (LPHFMT) THEN
C--FULL FORMAT PHASE CARD. MOVE DATA TO ARCHIVE POSITION.
C--THIS TRANSLATION CODE IS ALSO THE BASIS FOR A TRANSLATION PROGRAM
          IF (L2000) THEN
C--Y2000 ARCHIVE FORMAT
            STR(1:4)=STRI(1:4)		!SITE CODE
            STR(5:5)=STRI(78:78)	!SITE CODE
            STR(6:7)=STRI(82:83)	!NET CODE
            STR(10:12)=STRI(79:81)	!COMP CODE
            STR(14:17)=STRI(5:8)	!P RMK
            STR(18:19)='19'		!CENTURY
            STR(20:34)=STRI(10:24)	!DATE, P TIME
            STR(42:50)=STRI(32:40)	!S TIME, S RMK
            STR(57:59)=STRI(45:47)	!AMP
            STR(60:63)='00 0'		!AMP & UNITS CODE
            STR(82:82)=STRI(51:51)	!AMP MAG WEIGHT CODE
            STR(83:83)=STRI(76:76)	!DUR MAG WEIGHT CODE
            STR(84:86)=STRI(48:50)	!PERIOD OF MAX AMP
            STR(87:91)=STRI(71:75)	!STA RMK, CODA DUR
            STR(109:109)=STRI(41:41)	!DATA SOURCE CODE
            STR(112:113)=STRI(84:85)	!LOCATION CODE
            NSTR=113

          ELSE
C--PHASE INPUT TO OLD ARCHIVE FORMAT OUTPUT
            STR(1:9)=STRI(1:9)		!SITE CODE, P RMK
            STR(10:24)=STRI(10:24)	!DATE, P TIME
            STR(32:40)=STRI(32:40)	!S TIME, S RMK
            STR(45:47)=STRI(45:47)	!AMP
            STR(71:75)=STRI(71:75)	!STA RMK, CODA DUR
            STR(95:100)=STRI(78:83)	!NET & COMP CODES
            STR(91:91)=STRI(25:25)	!P/S WEIGHT OUT CODE
            STR(92:92)=STRI(41:41)	!DATA SOURCE CODE
            STR(68:70)=STRI(48:50)	!PERIOD OF MAX AMP
            STR(67:67)=STRI(76:76)	!DUR MAG WEIGHT CODE
            STR(66:66)=STRI(77:77)	!AMP MAG WEIGHT CODE
            NSTR=100
          END IF
          
        ELSE
          IF (L2000) THEN
C--BLANK OUT FIELDS RESERVED FOR DERIVED DATA
C--ARCHIVE 2000 INPUT & OUTPUT
            STR=STRI
            STR(35:41)=' '		!P RESIDUAL & WT
            STR(51:54)=' '		!S RESIDUAL
            STR(64:81)=' '		!S WEIGHT, 2 DELAYS, DIST, EM.ANGLE
            STR(92:108)=' '		!AZIM, MAGS, IMPORTANCE
            STR(110:111)=' '		!MAG CODES
            NSTR=113
          ELSE
          
C--BLANK OUT FIELDS RESERVED FOR DERIVED DATA
C--OLD ARCHIVE INPUT & OUTPUT
            STR=STRI
            STR(25:31)=' '		!P RESIDUAL & WT
            STR(41:44)=' '		!S RESIDUAL
            STR(48:65)=' '		!S WEIGHT, 2 DELAYS, DIST, EM.ANGLE
            STR(76:90)=' '		!AZIM, MAGS, IMPORTANCE
            NSTR=100
          END IF
        END IF

C--LOAD REFORMATTED DATA BACK INTO STRI
        STRI=STR

C--WRITE DATA TO APPROPRIATE FILES
        IF (LARC) WRITE (7,1001) STRI(1:NSTR)
        IF (LPRT) WRITE (15,1049) STRI(1:NSTR)
1049        FORMAT (1X,A)

C--COPY THE SHADOW IF ITS THERE
        IF (LSHAD) THEN
C          READ (14,1014,END=80) LENSHA,SHADO
          CALL READQ (14,SHADO,LENSHA,IOS)
          IF (IOS.GT.0) GOTO 80
          IF (LARC) WRITE (7,1001) SHADO(1:LENSHA)
        END IF
        GOTO 5
      END IF		!END OF BIG EVENT PROCESSING

C-------------------- START REGULAR INPUT -----------------------------
C--INITIALIZATION BEFORE EACH EQ. (IN CASE IT IS NOT GIVEN A VALUE)
8     IL=0
      IDNO=0
      NUNK=0
      CCOR=0.
      RMK1=' '
      RMK2=' '
      CP1=' '
      CP2=' '
      CP3=' '
      LASTA=' '
      BMTYP=' '
C      MBMAG=0
      NBMAG=0
C      BMAG=0.
      BMAG=VNOMAG
      BMTYPX=' '
C      MBMAGX=0
      NBMAGX=0
C      BMAGX=0.
      BMAGX=VNOMAG
      TEPER=0.
      K=0

C--READ THE EVENT REFERENCE TIME IF PHASE FILE IS CONDENSED
C--ALSO DEFINE THE AUXILIARY REMARKS FROM THE HEADER LINE IF THIS IS
C--A CONDENSED FORMAT ARCHIVE FILE.
C      IF (JCP.EQ.2) THEN
C        READ (14,1008,ERR=9,END=80) KYEAR,KMONTH,
C     2 KDAY,KHOUR,KMIN,SEC,RMK1,RMK2
C        KYEAR2=KYEAR+ICENT
C1008    FORMAT (5I2,F4.2,62X,2A1)
C        IF (RMK2.EQ.'#' .OR. RMK2.EQ.'-') RMK2=' '
C        IF (RMK1.EQ.'#' .OR. RMK1.EQ.'-') RMK1=' '
C      END IF

C--READ THE EVENT REMARKS IF THIS IS A FULL-FORMAT ARCHIVE FILE
C--USE THE ID NUMBER, BUT REPLACE IT WITH THAT ON THE TERMINATOR CARD
C  (UNLESS THE EVENT IS TOO BIG AND FILLS ARRAYS BEFORE READING THE END)
      IF (JCP.EQ.3 .OR. JCP.EQ.5) THEN
        READ (14,1001,END=80) STR2
        
        IF (L2000) THEN
          READ (STR2,1212) KYEAR2,KMONTH,KDAY,KHOUR,KMIN, RMK1,RMK2,
     2    CP1, (BMTYPI(I),BMAGI(I),TEMPI(I), I=1,2), IDNO, CP2,CP3

1212      FORMAT (I4,4I2, T81,2A1,
     2    T114,A1, T123,2(A1,F3.2,F3.1), I10, T163,2A1)
          ICNT=KYEAR2/100
          KYEAR=KYEAR2-ICNT*100		!GET 2 DIGIT YEAR IF NEEDED

        ELSE
          READ (STR2,1012) KYEAR,KMONTH,KDAY,KHOUR,KMIN, RMK1,RMK2,
     2    CP1, (BMTYPI(I),BMAGI(I),TEMPI(I), I=1,2), IDNO, CP2,CP3

1012      FORMAT (5I2, T77,2A1,
     2    T106,A1, T115,2(A1,F3.2,F3.1), I10, T153,2A1)
          KYEAR2=KYEAR+ICENT
        END IF

        IF (RMK2.EQ.'#' .OR. RMK2.EQ.'*' .OR. RMK2.EQ.'-') RMK2=' '
C--RMK1 SHOULD NOT BE - OR * OR #
        IF (RMK1.EQ.'#' .OR. RMK1.EQ.'*' .OR. RMK1.EQ.'-') RMK1=' '
C--IF THE 2ND REMARK WAS MADE Q BY HAND, THIS PUTS IT WHERE IT BELONGS
        IF (RMK2.EQ.'Q') THEN
          RMK1='Q'
          RMK2=' '
        END IF

C--EITHER PASS THROUGH THE VERSION REMARK, OR RESET IT FROM LAB COMMAND
        IF (.NOT.LP153) CP2=RUNLAB

C--CHECK FOR & SAVE EXTERNAL MAGNITUDES, TO PASS THRU LOCATION RUN.
C  A IS USED FOR OLDER XMAGS, OUTPUT THROUGH XMAG2
C  L IS BERKELEY NETWORK MAGNITUDE, FORMERLY B, OUTPUT THROUGH BMAG
C  C IS CURRENTLY UNUSED

C--PASS THROUGH AN EXTERNAL MAGNITUDE LABELED 'L', BUT ONLY IN THE EXTERNAL
C  POSITION. AN 'L' MAGNITUDE IN THE XMAG2 POSITION IS RECALCULATED.
C--NOTE: NOW PASS THROUGH ALL EXTERNAL MAGNITUDES. NORMALLY THEY ARE:
C  L  LOCAL MAGNITUDE FROM BERKELEY (NCSN)
C  S  SURFACE WAVE MAGNITUDE MS (HVO, NCSN)
C  B  OLD BERKELEY MAG, SOMEDAY BODY WAVE MAG MB

        IF (BMTYPI(1).NE.' ') THEN
          BMTYP=BMTYPI(1)
          BMAG=BMAGI(1)
          NBMAG=NINT(TEMPI(1))
        END IF

        DO I=1,2
          IF (BMTYPI(I).EQ.'B') THEN
C--CONVERT THE CONFUSING B CODE TO L. THIS WILL ALWAYS BE OUTPUT AS EXTERNAL
C  MAG, NEVER AS THE CALCULATED SECONDARY AMPLITUDE MAG
            BMTYP='L'
            BMAG=BMAGI(I)
            NBMAG=NINT(TEMPI(I))
          END IF
          IF (BMTYPI(I).EQ.'A') THEN
            BMTYPX=BMTYPI(I)
            BMAGX=BMAGI(I)
C            MBMAGX=100.*TEMPI(I)+.5
            NBMAGX=NINT(TEMPI(I))
          END IF
        END DO

C--OPTIONALLY GET TRIAL HYPO FROM HEADER
        IF (IH71T.EQ.3) THEN
          IF (L2000) THEN
            READ (STR2,1124) T1,LAT,IS,XLTM,LON,IE,XLNM,Z1
1124        FORMAT (12X,F4.2,I2,A1,F4.2,I3,A1,F4.2,F5.2)
          ELSE
            READ (STR2,1024) T1,LAT,IS,XLTM,LON,IE,XLNM,Z1
1024        FORMAT (10X,F4.2,I2,A1,F4.2,I3,A1,F4.2,F5.2)
	  END IF
          CLAT=LAT+XLTM/60.
          CLON=LON+XLNM/60.
          IF (IS.EQ.'S') CLAT = -CLAT
          IF (IE.EQ.'E') CLON = -CLON

C--IF USING TRIAL LOCATION & OT FROM THE HEADER, COMPARE ALL PHASES, INCLUDING
C  THE FIRST, TO TRIAL FOR CLOSE TIME AGREEMENT
          DAYFIRST=DAYJL(KYEAR2,KMONTH,KDAY)
        END IF

C--SAVE THE FIRST SHADOW RECORD
        IF (LSHAD) THEN
          CALL READQ (14,SHASTR,LENIN,IOS)
          IF (IOS.GT.0) GOTO 80
          SHAD1(1)=SHASTR
          LSHA1(1)=LENIN
          NSHA1=1
          IF (LSHA1(1) .GT. 100) THEN
            WRITE (6,1019) KYEAR2,KMONTH,KDAY,KHOUR,KMIN
            IF (LPRT) WRITE (15,1019) KYEAR2,KMONTH,KDAY,KHOUR,KMIN
1019        FORMAT (' *** SHADOW RECORD FOLLOWING ',I4,4I3,
     2     ' HEADER IS TOO LONG')
            IRES=-101
            STOP
          END IF
        END IF
      END IF

C--READ THE HEADER IF THIS IS A PHASE FILE WITH SHADOW CARDS
      IF (JCP.EQ.4) THEN
        IF (IH71T.EQ.3) THEN
C--READ TRIAL HYPO IN PRE-2000 HYPO71 FORMAT
          READ (14,1026,END=80) KYEAR,KMONTH,KDAY,KHOUR,KMIN,
     2    T1, LAT,IS,XLTM, LON,IE,XLNM,Z1
1026      FORMAT (3I2,1X,2I2,F6.2,1X, I2,A1,F5.2,1X, I3,A1,F5.2,F7.2)
          KYEAR2=KYEAR+ICENT
          CLAT=LAT+XLTM/60.
          CLON=LON+XLNM/60.
          IF (IS.EQ.'S') CLAT = -CLAT
          IF (IE.EQ.'E') CLON = -CLON

C--IF USING TRIAL LOCATION & OT FROM THE HEADER, COMPARE ALL PHASES, INCLUDING
C  THE FIRST, TO TRIAL FOR CLOSE TIME AGREEMENT
          DAYFIRST=DAYJL(KYEAR2,KMONTH,KDAY)
        ELSE

C--SKIP HEADER (& HOPE THAT DATE ISN'T NEEDED FOR SHADOW ERROR MESSAGE)
          READ (14,*,END=80)
        END IF

C--SAVE THE FIRST SHADOW RECORD
C        READ (14,1014,END=80) LSHA1(1),SHAD1(1)
        CALL READQ (14,SHASTR,LENIN,IOS)
        IF (IOS.GT.0) GOTO 80
        SHAD1(1)=SHASTR
        LSHA1(1)=LENIN
        NSHA1=1
        IF (LSHA1(1) .GT. 100) THEN
          WRITE (6,1019) KYEAR2,KMONTH,KDAY,KHOUR,KMIN
          IF (LPRT) WRITE (15,1019) KYEAR2,KMONTH,KDAY,KHOUR,KMIN
          STOP
        END IF
      END IF
C      GOTO 10

C--LOOP TO READ PHASE CARDS **************************************************
10    DO 50 K=1,MAXPHS
      GOTO 15

C--PRINT AN ERROR MESSAGE & SKIP A BAD PHASE CARD
12    IF (LPRT) WRITE (15,1000) STRI(1:NSTR)
      IF (LERR) WRITE (6,1000) STRI(1:NSTR)
1000  FORMAT (' *** SKIP BAD PHASE CARD:'/1X,A)
      GOTO 14

C--PRINT AN ERROR MESSAGE & SKIP A BAD ARCHIVE CARD
13    IF (LPRT) WRITE (15,1300) STRI(1:NSTR)
      IF (LERR) WRITE (6,1300) STRI(1:NSTR)
1300  FORMAT (' *** SKIP BAD INPUT ARCHIVE CARD:'/1X,A)

C--REMAINING ERROR PROCESSING
14    IF (LSHAD) THEN
        CALL READQ (14,STRI,NSTR,IOS)
        IF (IOS.GT.0) GOTO 80
        IF (LPRT) WRITE (15,1200) STRI(1:NSTR)
        IF (LERR) WRITE (6,1200) STRI(1:NSTR)
1200    FORMAT (' *** ALSO SKIP NEXT CARD, ASSUMED TO BE A SHADOW CARD'/
     2  1X,A)
      END IF
      IRES=-14
      GOTO 15

C      WRITE (6,*) 'STA= ',STA
C      WRITE (6,*) 'NET= ',SNET
C      WRITE (6,*) 'COMP1= ',COMP1
C      WRITE (6,*) 'COMP3= ',COMP3
C      WRITE (6,*) 'PRK= ',KPRK(K)
C      WRITE (6,*) 'PWT= ',LPWT
C      WRITE (6,*) 'DATE= ',LYEAR2,LMONTH,LDAY,LHOUR,LMIN
C      WRITE (6,*) 'P= ',P
C      WRITE (6,*) 'S= ',S
C      WRITE (6,*) 'SRK= ',KSRK(K)
C      WRITE (6,*) 'SWT= ',LSWT
C      WRITE (6,*) 'AMP= ',AMPK(K)
C      WRITE (6,*) 'AMPU= ',KAMPU(K)
C      WRITE (6,*) 'XWT= ',KXWT(K)
C      WRITE (6,*) 'FWT= ',CCWT
C      WRITE (6,*) 'PER= ',TEPER
C      WRITE (6,*) 'SRMK= ',KRMK(K)
C      WRITE (6,*) 'DUR= ',FMP
C      WRITE (6,*) 'SOU= ',KSOU(K)

C--READ A PHASE CARD
15    CALL READQ (14,STRI,NSTR,IOS)
      IF (IOS.GT.0) GOTO 80

C--ALLOW FOR ADDITIONAL SHADOWS TO THE HEADER IF READING ARCHIVE SHADOW FORMAT
      IF (JCP.EQ.5 .AND. K.EQ.1) THEN
        IF (STRI(1:1).EQ.'$') THEN
          NSHA1=NSHA1+1
          IF (NSHA1.GT.MSHA) THEN
            WRITE (6,1021) KYEAR2,KMONTH,KDAY,KHOUR,KMIN
1021        FORMAT (' *** TOO MANY HEADER SHADOW RECORDS IN EVENT, '/
     2      ' OR TOO MANY BAD PASE CARDS AT START OF EVENT.',I4,4I3)
            IRES=-102
            STOP
          END IF
          LSHA1(NSHA1)=NSTR
          SHAD1(NSHA1)=STRI
          GOTO 15
        END IF
      END IF

C--INTERPRET A CARD WITH A BLANK STATION NAME AS A TERMINATOR CARD
      CSTA=STRI(1:4)
      IF (CSTA.EQ.'    ') GOTO 60

C      IF (JCP.EQ.2) THEN
C---------------------- CONDENSED PHASE CARD FORMAT --------------------
C--INITIALIZE DATA IN CASE IT IS NOT GIVEN A VALUE READING CONDENSED FORMAT
C        KP(K)=0
C        KSOU(K)=' '
C        KPRK(K)='  '
C        KWT(K)=0
C        KS(K)=0
C        KFMP(K)=0
C        AMPK(K)=0.
C        KSRK(K)='  '
C        KRMK(K)=' '

C--IF THIS LINE INCLUDES DATA FROM THE STATION ON PREVIOUS LINE,
C  DONT INCREMENT THE STATION INDEX
C        READ (STRI,1010,ERR=12) STA(1:4),CM,I,TEMP,FMP
C1010    FORMAT (A4,A3,I1,F5.2,F4.0)
C        STA(5:5)=' '
C        IK=K
C        IF (STA.EQ.LASTA) IK=K-1
C        CTEMP=CM(2:2)
C        IF (FMP.NE.0.) KFMP(IK)=FMP+.5

C--THIS IS A P TIME 
C        IF (CTEMP.EQ.'P') THEN
C          KPRK(IK)=CM
C          KWT(IK)=KWT(IK)+I
C          KP(IK)=NINT(100.*(TEMP+SEC))
C        END IF

C--THIS IS AN S TIME
C        IF (CTEMP.EQ.'S') THEN
C          KSRK(IK)=CM
C          KWT(IK)=KWT(IK)+10*I
C          KS(IK)=NINT(100.*(TEMP+SEC))
C        END IF

C--THIS IS AN AMPLITUDE
C        IF (CTEMP.EQ.'A') AMPK(IK)=TEMP
C        IF (IK.EQ.K) GOTO 18
C        GOTO 15
C      END IF

C------------------- READ FULL FORMATS -----------------------------
      IF (LPHFMT) THEN
        KRMK6(K)=' '
C--ASSUME A FULL PHASE CARD
        READ (STRI,1002,ERR=12) STA(1:4),KPRK(K),LPWT,COMP1,LYEAR,
     2  LMONTH,LDAY,LHOUR,LMIN,P, S,KSRK(K),LSWT,KSOU(K),
     3  AMPK(K),TEPER,KXWT(K),IL, TECAL,KRMK6(K),CCOR, KRMK(K),FMP,
     4  CCWT,STA(5:5),COMP3,SNET,SLOC

1002    FORMAT (BZ,A4,A3,I1,A1,
     2  5I2,F5.2,1X,6X, F5.2,A2,1X,I1,A1,3X,
     3  F3.0,F3.2,I1,3X,I4, F4.1,A3,F5.2, A1,F4.0,
     4  A1,1X,A1,A3,2A2)
        LYEAR2=LYEAR+ICENT
        IF (AMPK(K).GT.0.) KAMPU(K)=IAMPU
        KAMPTYP(K)=0
      ELSE

C--ASSUME AN ARCHIVE CARD
        TECAL=0.
        IF (L2000) THEN
          READ (STRI,1213,ERR=13) STA,SNET,COMP1,COMP3, KPRK(K),LPWT,
     2    LYEAR2,LMONTH,LDAY,LHOUR,LMIN,P, S,KSRK(K),LSWT,AMPK(K),
     3    KAMPU(K),KXWT(K), CCWT,TEPER,KRMK(K), FMP,KSOU(K),SLOC,
     4    KAMPTYP(K)
 
1213      FORMAT (BZ,A5,A2,1X,A1,A3,1X, A3,I1,
     2    I4,4I2,F5.2,7X, F5.2,A2,1X,I1,4X,F7.2,
     3    I2,18X,I1, A1,F3.2,A1, F4.0,17X,A1,2X,A2,
     4    I2)

          CSTIM=STRI(42:46)
          ICNT=LYEAR2/100
          LYEAR=LYEAR2-ICNT*100		!GET 2 DIGIT YEAR IF NEEDED
        ELSE

C--OLD 20TH CENT FORMAT
          READ (STRI,1013,ERR=13) STA(1:4),KPRK(K),LPWT,COMP1,LYEAR,
     2    LMONTH,LDAY,LHOUR,LMIN,P, S,KSRK(K),LSWT,AMPK(K),
     3    KXWT(K),CCWT,TEPER,KRMK(K), FMP,KSOU(K),
     4    STA(5:5),COMP3,SNET,SLOC

1013      FORMAT (BZ,A4,A3,I1,A1,
     2    5I2,F5.2,7X, F5.2,A2,1X,I1,4X,F3.0,
     3    18X,I1,A1,F3.2,A1, F4.0,15X,1X,A1,
     4    2X,A1,A3,2A2)
     
          LYEAR2=LYEAR+ICENT
          IF (AMPK(K).GT.0.) KAMPU(K)=IAMPU
          CSTIM=STRI(32:36)
          KAMPTYP(K)=0
        END IF
      END IF

C--USE THE 1-LETTER COMPONENT FOR MATCHING IF THE FLAG IS SET
C      IF (LCOMP1) COMP3=COMP1

C--GET THE CODA WEIGHT CODE, BUT DONT LET ALPHA DATA CAUSE A FATAL ERROR
C  KEEP THE INTEGER VALUE, OR SET TO 9 IF WEIGHT CODE IS NOT AN INTEGER.
      IF (LCOWT) THEN
        KFWT(K)=ICHAR(CCWT)-48
C--TREAT A BLANK AS FULL WEIGHT (CODE 0)
        IF (KFWT(K).EQ.-16) KFWT(K)=0
        IF (KFWT(K).LT.0 .OR. KFWT(K).GT.9) KFWT(K)=9
      ELSE
        KFWT(K)=0
        IF (CCWT.EQ.'N' .OR. CCWT.EQ.'X') KFWT(K)=4
      END IF

C---------------------- LOAD THE DATA INTO ARRAYS -----------------------
      FMPK(K)=FMP
      KPER(K)=TEPER*100.
      KCAL(K)=100.*TECAL

C--IF THE S TIME IS BLANK, MAKE SURE NO S IS USED BY BLANKING THE S REMARK
      IF (CSTIM .EQ. '     ') KSRK(K)='  '
C--IF THE S TIME IS NOT ZERO, BE SURE S HAS A REMARK (PHASE FORMAT ONLY)
      IF (S.NE.0. .AND. KSRK(K).EQ.'  ' .AND. LPHFMT) KSRK(K)=' S'

C--KEEP THE FIRST NON-ZERO ID NUMBER ON A PHASE CARD, BUT REPLACE IT WITH
C  THE ID NO. ON THE TERMINATOR CARD IF PRESENT
      IF (IDNO.EQ.0) IDNO=IL

C--TEST ALL PHASE CARDS FOR CLOSE TIME AGREEMENT TO:
C  1) THE TIME ON THE HEADER CARD IF IT'S USED FOR THE TRIAL, OR
C  2) THE TIME ON THE FIRST PHASE CARD IF IT'S USED FOR THE TRIAL.

C  DONT RESET A REFERENCE DATE & TIME IF WE GOT IT AS A TRIAL FROM HEADER
      IF (K.EQ.1 .AND. IH71T.NE.3) THEN
        KYEAR=LYEAR
        KYEAR2=LYEAR2
        KMONTH=LMONTH
        KDAY=LDAY
        KHOUR=LHOUR
        KMIN=LMIN
        DAYFIRST=DAYJL(KYEAR2,KMONTH,KDAY)
        DT=0.
      END IF

C--SIMPLE TEST NOT ALLOWING EVENT TO SPAN A MONTH BOUNDARY
C        IF (LYEAR2-KYEAR2 +LMONTH-KMONTH .NE. 0 .OR.
C     2  ABS(((LDAY-KDAY)*24 +LHOUR-KHOUR)*60+LMIN-KMIN).GT.6) THEN

C--COMPLEX TEST ALLOWING EVENT TO SPAN A CENTURY BOUNDARY
C  DT IS THE NUMBER OF MINUTES THE PRESENT PHASE IS BEHIND THE TRIAL OT
      DT=((DAYJL(LYEAR2,LMONTH,LDAY) -DAYFIRST)*24. 
     2 +LHOUR-KHOUR)*60.+LMIN-KMIN

      IF (DABS(DT).GT. 6.D0) THEN
        IF (LPRT) WRITE (15,1003) STRI(1:NSTR)
        IF (LERR) WRITE (6,1003) STRI(1:NSTR)
1003    FORMAT (' *** SKIP OVER PHASE CARD WITH WRONG TIME:'/1X,A)
        IRES=-13
C--SKIP EXPECTED SHADOW CARD
        IF (LSHAD) READ (14,*,END=80)
        GOTO 15
      END IF

C--OPTIONALLY SAVE THE NEXT LINE AS SHADOW PHASE DATA
      IF (LSHAD) THEN
        CALL READQ (14,SHASTR,LENIN,IOS)
        IF (IOS.GT.0) GOTO 80
        KSHAD(K)=SHASTR
        KDEV(K)=SHASTR(93:95)
        KLSHA(K)=LENIN
      ELSE
        KDEV(K)='   '
      END IF

      IF (KLSHA(K).GT.104) THEN
        WRITE (6,1015) STRI(1:NSTR)
        IF (LPRT) WRITE (15,1015) STRI(1:NSTR)
1015    FORMAT(' *** THE SHADOW RECORD FOLLOWING THIS PHASE CARD',
     2  ' IS TOO LONG:'/1X,A)
        IRES=-101
        STOP
      END IF

C--READ THE P AMPLITUDE INFO FROM THE SHADOW CARD
C      IF (LSHAD .AND. LPMAG) THEN
C        KPAMP(K)=0 
C        READ (KSHAD(K),1055,END=80,ERR=17) RTPFL
C1055    FORMAT (41X,A2)
C
C--ONLY READ AND USE THE P AMPLITUDE IF THIS IS AN RTP STATION
C        IF (RTPFL .NE. 'PH') GOTO 18 
C        READ (KSHAD(K),1056,END=80,ERR=17) PARMK(K),KPAWT(K),KPAMP(K)
C1056    FORMAT (43X,A1,I1,I5)
C--THE WEIGHT CODE KPAWT IS THE NUMBER OF CLIPPED PEAKS IN THE FIRST 3: 0-3
C      END IF

      GOTO 18
C--ERROR ON READ OF SHADOW CARD
17    WRITE (6,1057) KLSHA(K)
      IF (LPRT) WRITE (15,1057) KLSHA(K)
1057  FORMAT (' *** BAD FORMAT SHADOW CARD:'/1X,A)
      IRES=-19

C--DERIVE THE AUXILIARY REMARKS FROM CERTAIN EVENT REMARKS
18    IF (LPHFMT) THEN
        DO I=1,NRMK
          IF (KRMK6(K)(1:NLET(I)) .EQ. RMKS(I)(1:NLET(I))) THEN
            IF (RMK1.EQ.' ') THEN
              RMK1=RMKA(I)
            END IF
            GOTO 24
          END IF
        END DO
      END IF

C--KEEP TRACK OF THE CURRENT STATION FOR NEXT PASS THRU LOOP
24    LASTA=STA

C--TEST TO SEE IF THE STATION IS ON THE LOOK-UP LIST. GOTO 35 IF MATCH IS
C  COMPLETE.
      DO J=1,JSTA
        IF (SLOC.EQ.'  ' .OR. SLOC.EQ.'--') THEN
          LLOC2= SLOC .EQ. JSLOC2(J)
        END IF
        IF (STA(1:NSTLET) .EQ. STANAM(J)(1:NSTLET) .AND.
     2  SNET(1:NETLET) .EQ. JNET(J)(1:NETLET) .AND.
     3  COMP3(1:NCOMP) .EQ. JCOMP3(J)(1:NCOMP) .AND.
     4  (SLOC(1:NSLOC) .EQ. JSLOC(J)(1:NSLOC) .OR.
     5  SLOC(1:NSLOC) .EQ. JSLOC2(J)(1:NSLOC)) ) GOTO 35
      END DO

C--PRINT AN ERROR MESSAGE IF STATION NOT ON EXPECTED UNKNOWN LIST
      DO I=1,NLUNK
        IF (LUNK(I)(1:NSTLET) .EQ. STA(1:NSTLET)) GOTO 32
      END DO
      IF (LPRT) WRITE (15,1004) STRI(1:NSTR)
      IF (LERR) WRITE (6,1004) STRI(1:NSTR)
1004  FORMAT (' *** SKIP PHASE CARD WITH UNKNOWN STATION:'/1X,A)
      IRES=-15

C--FOR THE PHASE & ARCHIVE FORMATS, SAVE THE UNKNOWN STATION FOR OUTPUT TO
C  THE ARCHIVE FILE.
32    IF (JCP.EQ.2 .OR. .NOT.LARC .OR. .NOT.LKEEP) GOTO 15

C--IGNORE ANY UNKNOWN STAS BEYOND THE MAXIMUM, BUT COMPLAIN
      IF (NUNK.GE.MAXUNK) THEN
        WRITE (6,1023) MAXUNK,STRI(1:NSTR)
        IF (LPRT) WRITE (15,1023) MAXUNK,STRI(1:NSTR)
1023    FORMAT (' *** MORE THAN',I3,' UNKNOWN STATIONS IN THIS EVENT. ',
     2  'SKIP THIS ONE:'/1X,A)
        IRES=-16
        GOTO 15
      END IF

C--MOVE FIELDS TO THE RIGHT PLACE & BLANK OTHERS IF THIS IS A PHASE CARD
      IF (LPHFMT) THEN
C--FULL FORMAT PHASE CARD. MOVE DATA TO ARCHIVE POSITION.
C--THIS TRANSLATION CODE IS ALSO THE BASIS FOR A TRANSLATION PROGRAM
          IF (L2000) THEN
C--PHASE INPUT TO Y2000 ARCHIVE FORMAT
            STR=' '
            STR(1:4)=STRI(1:4)		!SITE CODE
            STR(5:5)=STRI(78:78)	!SITE CODE
            STR(6:7)=STRI(82:83)	!NET CODE
            STR(10:12)=STRI(79:81)	!COMP CODE
            STR(14:17)=STRI(5:8)	!P RMK
            STR(18:19)='19'		!CENTURY
            STR(20:34)=STRI(10:24)	!DATE, P TIME
            STR(42:50)=STRI(32:40)	!S TIME, S RMK
            STR(57:59)=STRI(45:47)	!AMP
            STR(60:63)='00 0'		!AMP & UNITS CODE
            STR(82:82)=STRI(51:51)	!AMP MAG WEIGHT CODE
            STR(83:83)=STRI(76:76)	!DUR MAG WEIGHT CODE
            STR(84:86)=STRI(48:50)	!PERIOD OF MAX AMP
            STR(87:91)=STRI(71:75)	!STA RMK, CODA DUR
            STR(109:109)=STRI(41:41)	!DATA SOURCE CODE
            STR(112:113)=STRI(84:85)	!STATION LOCATION CODE
            NSTR=113

          ELSE
C--PHASE INPUT TO OLD ARCHIVE FORMAT OUTPUT
            STR(1:9)=STRI(1:9)		!SITE CODE, P RMK
            STR(10:24)=STRI(10:24)	!DATE, P TIME
            STR(32:40)=STRI(32:40)	!S TIME, S RMK
            STR(45:47)=STRI(45:47)	!AMP
            STR(71:75)=STRI(71:75)	!STA RMK, CODA DUR
            STR(95:100)=STRI(78:83)	!NET & COMP CODES
            STR(91:91)=STRI(25:25)	!P/S WEIGHT OUT CODE
            STR(92:92)=STRI(41:41)	!DATA SOURCE CODE
            STR(68:70)=STRI(48:50)	!PERIOD OF MAX AMP
            STR(67:67)=STRI(76:76)	!DUR MAG WEIGHT CODE
            STR(66:66)=STRI(77:77)	!AMP MAG WEIGHT CODE
            STR(101:102)=STRI(84:85)	!STATION LOCATION CODE
            NSTR=102
          END IF
C--LOAD REFORMATTED DATA BACK INTO STRI
          STRI=STR
      END IF

C--SAVE THE PHASE & SHADOW RECORDS
      NUNK=NUNK+1
      PUNK(NUNK)=STRI
      IF (LSHAD) THEN
        SUNK(NUNK)=KSHAD(K)
        NSUNK(NUNK)=KLSHA(K)
      END IF
      GOTO 15

C--SET REFERENCE INDEX FOR THIS STATION & ENCODE DATA
35    KINDX(K)=J
      IF (JCP.EQ.2) GOTO 50

C--CORRECT ARRIVAL TIMES TO SAME MINUTE
      LSHIF=NINT(DT*60.)
C--STORE TIMES IN .01 SEC, ROUNDED TO NEAREST INTEGER
      KP(K)=NINT(100.*(P+LSHIF+CCOR))
      KS(K)=NINT(100.*(S+LSHIF+CCOR))

C--STORE P & S WEIGHTS
      KWT(K)=10*LSWT+LPWT
50    CONTINUE

C-------------- TERMINATOR CARD PROCESSING ------------------------
C--TREATMENT OF EXCESS PHASE CARDS IN EVENT
      KSTA=MAXPHS
      IF (LPRT) WRITE (15,1005) STRI(1:NSTR)
      IF (LERR) WRITE (6,1005) STRI(1:NSTR)
1005  FORMAT (' *** TOO MANY STATIONS. COPY REST TO OUTPUT FILES.',
     2 ' LAST STATION FOR THIS EVENT IS:'/1X,A)
      IRES=-17
C--ZERO THE TRIAL COORDINATES AS IF A BLANK CARD WAS READ
      T1=0.
      Z1=0.
      CLON=0.
      CLAT=0.
      IDNO=0
      IL=0
C--SET FLAG SO REST CAN BE COPIED WHEN WE RETURN TO HYPHS. NOTE THAT COPYING
C  OF TERMINATOR TO ARCHIVE PRESEVES TRIAL HYPO & ID NO., BUT DOES NOT USE IT
C  IN CURRENT LOCATION RUN.
      LTBIG=.TRUE.
      RETURN

C--OPTIONALLY STORE THE SHADOW RECORD AFTER THE TERMINATOR
60    IF (LSHAD) THEN
        CALL READQ (14,SHADO,LENSHA,IOS)
        IF (IOS.GT.0) GOTO 80
        IF (LENSHA .GT. 100) THEN
          WRITE (6,1016) KYEAR2,KMONTH,KDAY,KHOUR,KMIN
          IF (LPRT) WRITE (15,1016) KYEAR2,KMONTH,KDAY,KHOUR,KMIN
1016      FORMAT (' *** SHADOW RECORD FOLLOWING ',I4,4I3,
     2    ' TERMINATOR IS TOO LONG')
          IRES=-101
          STOP
        END IF
      END IF

C--COME HERE FOR NORMAL EVENT TERMINATION WITH AN INSTRUCTION (TERMINATOR) CARD
      KSTA=K-1
C--SKIP AN EVENT WITH FEWER THAN 3 PHASE CARDS
      IF (KSTA.LT.3) THEN
        IF (LPRT) WRITE (15,1006) KYEAR2,KMONTH,KDAY,KHOUR,KMIN
        IF (LERR) WRITE (6,1006) KYEAR2,KMONTH,KDAY,KHOUR,KMIN
1006    FORMAT (' *** SKIP EVENT WITH LESS THAN 3 PHASE CARDS:',I4,4I3)
        IRES=-52
        GOTO 8
      END IF

C--GET TRIAL DATA (IF ANY) FROM TERMINATOR CARD
      IF (IH71T.EQ.2) THEN
        FIXCHR=' '
C--CHOOSE HYPO71 INSTRUCTION (TERMINATOR) FORMAT
        READ (STRI,1011,ERR=84) NSTR,Z1, IL
1011    FORMAT (18X,I1,F5.2, T63,I10)
        IF (NSTR.EQ.1) THEN
          DEPFIX=.TRUE.
          FIXCHR='-'
        END IF
        CLAT=0.
        CLON=0.
        T1=0.
      ELSE IF (IH71T.EQ.1) THEN

C--CHOOSE HYPOINVERSE TERMINATOR FORMAT
C--THE FIRST PART OF THE LINE IS IN OLD HI SUMMARY FORMAT, EXCEPT
C  THE DATE IS IGNORED AND THE ID NO IS I10 STARTING IN COL 63.

        READ (STRI,1007,ERR=84) MHOUR,MINIT,T, LAT,IS,
     2  XLTM,LON,IE,XLNM, Z1,FIXCHR,IL
1007    FORMAT (6X,2I2,F4.2, I2,A1,
     2  F4.2,I3,A1,F4.2, F5.2,A1,T63,I10)

C--LOAD LAT & LON
        CLAT=LAT+XLTM/60.
        CLON=LON+XLNM/60.
        IF (IS.EQ.'S') CLAT=-CLAT
        IF (IE.EQ.'E') CLON=-CLON

C--ANNOUNCE THAT A TRIAL HYPOCENTER WAS GIVEN
        IF (CLAT.NE.0. .AND. CLON.NE.0. .AND. LPRT) 
     2  WRITE (15,1076) KYEAR2,KMONTH,KDAY,KHOUR,KMIN
1076    FORMAT (' USE SUPPLIED TRIAL HYPOCENTER FOR EVENT: ',I4,4I3)

C--OPTIONALLY FIX THE HYPOCENTER FOR THIS EVENT
        DEPFIX=FIXCHR.EQ.'-' .OR. FIXCHR.EQ.'X' .OR. FIXCHR.EQ.'O'
     2   .OR. DEPFIXA
        HYPOFIX=FIXCHR.EQ.'X' .OR. FIXCHR.EQ.'O'
        ALLFIX=FIXCHR.EQ.'O'

C--DONT FIX HYPOCENTER IF WE WERNT GIVEN A LOCATION 
        IF (HYPOFIX .AND. (CLAT.EQ.0. .OR. CLON.EQ.0.)) THEN
          IF (LPRT) WRITE (15,1078) KYEAR2,KMONTH,KDAY,KHOUR,KMIN
          IF (LERR) WRITE (6,1078) KYEAR2,KMONTH,KDAY,KHOUR,KMIN
1078      FORMAT (' *** CANT FIX HYPOCENTER BECAUSE WE WERNT GIVEN',
     2'   A LOCATION: ',I4,4I3)
          IRES=-12
          HYPOFIX=.FALSE.
        END IF

C--DONT FIX ORIGIN IF WE WERNT GIVEN AN ORIGIN TIME 
        IF (ALLFIX .AND. (MHOUR.EQ.0 .AND. MINIT.EQ.0 .AND. 
     2  T.EQ.0.)) THEN
          IF (LPRT) WRITE (15,1079) KYEAR2,KMONTH,KDAY,KHOUR,KMIN
          IF (LERR) WRITE (6,1079) KYEAR2,KMONTH,KDAY,KHOUR,KMIN
1079      FORMAT (' *** CANT FIX ORIGIN BECAUSE WE WERNT GIVEN',
     2'   AN ORIGIN TIME: ',I4,4I3)
          IRES=-12
          HYPOFIX=.FALSE.
          ALLFIX=.FALSE.
        END IF

C--ALLOW FOR FIXING DEPTH OR O.T. TO ZERO, 
C  ZERO (OR BLANK) IS NORMALLY TREATED AS "NOT SUPPLIED"
	IF ((HYPOFIX .OR. ALLFIX) .AND. Z1.EQ.0.) Z1=0.001
	IF (ALLFIX .AND. T.EQ.0.) T=0.001

C--DONT INTERPRET AN OLD STYLE INSTRUCTION PARAMETER IN COLS 18-19
C  AS A TRIAL LATITUDE.
        IF (ABS(CLAT).LT..4 .AND. CLON.EQ.0.) CLAT=0.
        TEMP=MHOUR+MINIT+T
        IF (TEMP.EQ.0.) THEN
          T1=0.
        ELSE
          T1=T+((MHOUR-KHOUR)*60+MINIT-KMIN)*60
        END IF

C-- IF IH71T.EQ.3, WE GOT A TRIAL HYPO & ID FROM THE HEADER
      END IF

C--SAVE THE TERMINATOR CARD TO OUTPUT IT INTACT
      TERM=STRI

C--USE EVENT ID NUMBER IF ON TERMINATOR CARD
      IF (IL.NE.0) IDNO=IL
74    RETURN

C--COME HERE IF AN END OF FILE WAS JUST READ
80    KSTA=K-1
      KEND=1
      IF (KSTA.LT.2) KEND=-1
      RETURN

C--COME HERE FOR AN ERROR READING THE TERMINATOR CARD
84    IF (LERR) WRITE (6,1017) STRI(1:NSTR)
      IF (LPRT) WRITE (15,1017) STRI(1:NSTR)
1017  FORMAT (' *** BAD TERMINATOR LINE:'/1X,A)
      IRES=-18
      CLAT=0.
      CLON=0.
      T1=0.
      Z1=0.
      IL=0
      HYPOFIX=.FALSE.
      RETURN
      END
