      SUBROUTINE HYSUM (IUNIT)
C--CALLED BY HYPOINVERSE TO OUTPUT SUMMARY DATA
C--IUNIT IS THE UNIT NUMBER FOR OUTPUT, 7 FOR ARCHIVE, 12 FOR SUMMARY FILE
      INCLUDE 'common.inc'
      DIMENSION KSIG(3)
      CHARACTER LINE*188,CT1*1, CQ*1

C--CONVERT SOME DATA TO INTEGER FOR OUTPUT TO HYPOINVERSE FORMAT
      KLTM=XLTM*100.+.5
      KLNM=XLNM*100.+.5
      KQ=T1*100.+.5
      KZ=Z1*100.+.5
      KDMIN=DMIN+.5
      IF (KDMIN.GT.999) KDMIN=999
      KRMS=RMS*100.+.5
      IF (KRMS.GT.9999) KRMS=9999
      KERH=ERH*100.+.5
      KERZ=ERZ*100.+.5

      KFMMAD=100.*FMMAD+.5
      IF (KFMMAD.GT.999) KFMMAD=999
      KXMMAD=100.*XMMAD+.5
      IF (KXMMAD.GT.999) KXMMAD=999
      DO 10 I=1,3
10    KSIG(I)=SERR(I)*100.+.5

C--CONVERT SOME DATA TO INTEGER FOR OUTPUT IN OLD FORMAT
C--M*MAG* IS THE TOTAL OF STATION WEIGHTS *100
      LFMAG=FMAG*10.+.5		!DUR MAG
      IFMAG=.1*MFMAG+.5
      IF (IFMAG.GT.999) IFMAG=999
      LXMAG=XMAG*10.+.5		!AMP MAG
      IXMAG=.1*MXMAG+.5
      IF (IXMAG.GT.999) IXMAG=999
      IPMAG=.1*MPMAG+.5		!PREFERRED MAG
      IF (IPMAG.GT.999) IPMAG=999
      IF2MAG=.1*MFMAG2+.5	!ALTERNATE DUR MAG
      IF (IF2MAG.GT.999) IF2MAG=999

      NFM=NFRM
      IF (NFM.GT.99) NFM=99
      NWSR=NWS
      IF (NWSR.GT.99) NWSR=99

C--CONVERT SOME DATA TO INTEGER FOR OUTPUT IN NEW 2000 FORMAT
      LFMAG2=FMAG*100.+.5		!DUR MAG
      IFMAG2=.1*MFMAG+.5
      IF (IFMAG2.GT.9999) IFMAG2=9999
      LXMAG2=XMAG*100.+.5		!AMP MAG
      IXMAG2=.1*MXMAG+.5
      IF (IXMAG2.GT.9999) IXMAG2=9999
      IPMAG2=.1*MPMAG+.5		!PREFERRED MAG
      IF (IPMAG2.GT.9999) IPMAG2=9999
      IF2MAG2=.1*MFMAG2+.5		!ALTERNATE DUR MAG
      IF (IF2MAG2.GT.9999) IF2MAG2=9999

      NFM2=NFRM
      IF (NFM2.GT.999) NFM2=999
      NWSR2=NWS
      IF (NWSR2.GT.999) NWSR2=999

C--XMAG2 THE ALTERNATE AMP MAG
C--OVERWRITE XMAG2 WITH EXTERNAL XMAG (LABEL CODE A) IF IT WAS READ IN
      IF (BMAGX.GT.0. .OR. MBMAGX.GT.0) THEN
        XMAG2=BMAGX
        MXMAG2=MBMAGX
        CT1=BMTYPX
      ELSE
        CT1=LABX2
      END IF

C--ADDITIONAL MAGNITUDES (BOTH FORMATS)
      LBMAG=BMAG*100.+.5	!EXTERNAL (BERKELEY) MAG
      IBMAG=MBMAG*.1+.5
      IF (IBMAG.GT.999) IBMAG=999
      LX2MAG=XMAG2*100.+.5	!ALTERNATE AMP MAG
      IX2MAG=.1*MXMAG2+.5
      IF (IX2MAG.GT.999) IX2MAG=999
      LXPMAG=PMAG*100.+.5	!PREFERRED MAG
      LF2MAG=FMAG2*100.+.5	!ALTERNATE DUR MAG
 
C--WRITE A SUMMARY RECORD
C--HYPO71 FORMAT--------------------------------------------------
      IF (IH71S.EQ.2 .AND. IUNIT.EQ.12) THEN
C        KSFL=' '
C        IF (NWS.GT.0) KSFL='S'
        CALL QUALITY (CQ,RMS,MAXGAP,ERH,ERZ,NWR,Z1,DMIN)
        
C--YEAR 2000 HYPO71 FORMAT
        IF (L2000) THEN
          WRITE (12,1202) KYEAR2,KMONTH,KDAY,KHOUR,KMIN,T1,LAT,IS,
     2    XLTM,LON,IE,XLNM,Z1, LABPR,PMAG,
     3    NWR,MAXGAP,DMIN,RMS,ERH,ERZ, RMK1,CQ,SOUCOD,RMK2,
     4    IDNO,CP2,REMK
1202      FORMAT (I4,2I2.2,1X,2I2.2,F6.2,I3,A1,
     2    F5.2,I4,A1,F5.2,F7.2,1X, A1,F5.2,
     3    I3,I4,F5.1,F5.2,2F5.1, 4A1,
     4    I10,1X,A1,A3)

C--OLD HYPO71 FORMAT ENHANCED
        ELSE
          WRITE (12,1002) KYEAR,KMONTH,KDAY,KHOUR,KMIN,T1,LAT,IS,
     2    XLTM,LON,IE,XLNM,Z1, LABPR,PMAG,
     3    NWR,MAXGAP,DMIN,RMS,ERH,ERZ, RMK1,CQ,SOUCOD,RMK2,
     4    IDNO,CP2

1002      FORMAT (3I2.2,1X,2I2.2,F6.2,I3,A1,
     2    F5.2,I4,A1,F5.2,F7.2,1X, A1,F5.2,
     3    I3,I4,F5.1,F5.2,2F5.1, 4A1,
     4    I10,A1)

        END IF
      ELSE

C--YEAR 2000 HYPOINVERSE FORMAT
        IF (L2000) THEN
          WRITE (LINE,1201) KYEAR2,KMONTH,KDAY,KHOUR,KMIN, KQ,LAT,IS,
     2    KLTM,LON,IE,KLNM,KZ, LXMAG2,NWR,MAXGAP, KDMIN,KRMS,
     3    (IAZ(I),IDIP(I),KSIG(I),I=1,2), LFMAG2,REMK,KSIG(3),
     4    RMK1,RMK2,NWSR2, KERH,KERZ,NFM2, IXMAG2,IFMAG2,KXMMAD,KFMMAD,
     5    CRODE(MOD),CP1, SOUCOD,FMSOU,XMSOU,LABF1, NVR,LABX1,
     6    BMTYP,LBMAG,IBMAG, CT1,LX2MAG,IX2MAG, IDNO,
     7    LABPR,LXPMAG,IPMAG2, LABF2,LF2MAG,IF2MAG2, CP2,CP3

1201      FORMAT (I4,4I2.2, I4.4,I2,A1,
     2    I4,I3,A1,I4,I5, 4I3,I4,
     3    2(I3,I2,I4), I3,A3,I4,
     4    2A1,I3, 2I4,I3, 2I4,2I3,
     5    A3,A1, 4A1, I3,A1,
     6    2(A1,2I3), I10,
     7    2(A1,I3,I4), 2A1)
     
          LENLIN=164

        ELSE
C--OLD HYPOINVERSE FORMAT
          WRITE (LINE,1001) KYEAR,KMONTH,KDAY,KHOUR,KMIN, KQ,LAT,IS,
     2    KLTM,LON,IE,KLNM,KZ, LXMAG,NWR,MAXGAP, KDMIN,KRMS,
     3    (IAZ(I),IDIP(I),KSIG(I),I=1,2), LFMAG,REMK,KSIG(3),
     4    RMK1,RMK2,NWSR, KERH,KERZ,NFM, IXMAG,IFMAG,KXMMAD,KFMMAD,
     5    CRODE(MOD),CP1, SOUCOD,FMSOU,XMSOU,LABF1, NVR,LABX1,
     6    BMTYP,LBMAG,IBMAG, CT1,LX2MAG,IX2MAG, IDNO,
     7    LABPR,LXPMAG,IPMAG, LABF2,LF2MAG,IF2MAG, CP2,CP3

1001      FORMAT (5I2.2, I4.4,I2,A1,
     2    I4,I3,A1,I4,I5, I2,3I3,I4,
     3    2(I3,I2,I4), I2,A3,I4,
     4    2A1,I2, 2I4,I2, 4I3,
     5    A3,A1, 4A1, I3,A1,
     6    2(A1,2I3), I10,
     7    2(A1,2I3), 2A1)

          LENLIN=154
        END IF

C--ADD PRIMARY P AMP MAG IF THERE IS ONE
C--LEAVE CODE UNIMPLEMENTED UNTIL NEEDED
C        IF (LPMAG .AND. PMUSED.GT.0.) THEN
C          LFMAG= NINT(PAMAG*100.)
C          CT1=' '
C          IF (MINPM.EQ.1) CT1='+'

C          IFMAG= PMUSED*10. +.5
C          IF (IFMAG.GT.9999) IFMAG=9999
C          LXMAG= PMCLIP*10. +.5
C          IF (LXMAG.GT.9999) LXMAG=9999
C          IXMAG= PAMAD*100. +.5
C          IF (IXMAG.GT.999) IXMAG=999

C          WRITE (LINE(155:171),'(A1,I3,A1, 2I4,I3,A1)')
C     2    LABP1,LFMAG,CT1, IFMAG,LXMAG,IXMAG, PSOUR      
C          LENLIN=171
C        END IF

C--ADD SECONDARY P AMP MAG IF THERE IS ONE
C        IF (LPMAG .AND. PMUSD2.GT.0.) THEN
C          LFMAG= NINT(PAMAG2*100.)
C          CT1=' '
C          IF (MINPM2.EQ.1) CT1='+'

C          IFMAG= PMUSD2*10. +.5
C          IF (IFMAG.GT.9999) IFMAG=9999
C          LXMAG= PMCLP2*10. +.5
C          IF (LXMAG.GT.9999) LXMAG=9999
C          IXMAG= PAMAD2*100. +.5
C          IF (IXMAG.GT.999) IXMAG=999

C          WRITE (LINE(172:188),'(A1,I3,A1, 2I4,I3,A1)')
C     2    LABP2,LFMAG,CT1, IFMAG,LXMAG,IXMAG, PSOUR2
C          LENLIN=188
C        END IF

C--WRITE HYPOINVERSE FORMAT LINE
C--WE COULD TRIM LENGTH IF LATER FIELDS WERE UNUSED, BUT FOR NOW SPIT IT ALL
        WRITE (IUNIT,'(A)') LINE(1:LENLIN)
      END IF
      RETURN
      END

      SUBROUTINE QUALITY (CQ,RMS,MAXGAP,ERH,ERZ,NWR,Z1,DMIN)

C--COMPUTE QUALITY LABEL (HYPO71 ONLY) AS AVERAGE OF ERROR AND GEOMETRICAL
C  QUALITIES.
      CHARACTER CQ*1

      IF (RMS.LT.0.15 .AND. ERH.LE.1.0 .AND. ERZ.LE.2.0) THEN
        IQS = 1
      ELSE IF (RMS.LT.0.30 .AND. ERH.LE.2.5 .AND. ERZ.LE.5.0) THEN
        IQS = 2
      ELSE IF (RMS.LT.0.50 .AND. ERH.LE.5.0) THEN
        IQS = 3
      ELSE
        IQS = 4
      ENDIF

      IF (NWR.GE.6 .AND. MAXGAP.LE.90 .AND. 
     1 (DMIN.LE.Z1 .OR. DMIN.LE.5.0)) THEN
        IQD = 1
      ELSE IF (NWR.GE.6 .AND. MAXGAP.LE.135 .AND. 
     1 (DMIN.LE.2.*Z1 .OR. DMIN.LE.10.0)) THEN
	IQD = 2
      ELSE IF (NWR.GE.6 .AND. MAXGAP.LE.180 .AND. DMIN.LE.50.) THEN
        IQD = 3
      ELSE
        IQD = 4
      ENDIF

C--MAKE A LETTER QUALITY 1=A, 2=B, 3=C, 4=D
      IQ = NINT((IQS + IQD)/2.)
      CQ=CHAR(IQ+64)
      RETURN
      END
