PROGRAM ADP77
      PARAMETER(MXLV8=16)
      CHARACTER ASTA*6,NADD(MXLV8)*10,FLNM*128
C
      LOUT=6
      IU=11
C
      WRITE(*,*)' Enter file name to read '
      READ(*,'(A)')FLNM
      OPEN(IU,FILE=FLNM)
C
      NTOT=0
      NRO=0
    5 CONTINUE
      NR=0
   10 CALL RDADP(IU,IDSRCH,IYR,IMO,IDY,IHR,IDSTYP,XLAT,XLON,
     2 ASTA,XHR,IC25,IC26,IC27,IRTYP,XELEV,IINTYP,LTH,ISTAT)
      IF(ISTAT.NE.0) GO TO 90
      NCE=0
      NR=NR+1
C
C READ CATEGORY 51 DATA
      CALL SADP51(NCNT,SLP,STP,DDD,FFF,AT,DPD,ATMX,ATMN,
     2 QSLP,QSTP,QDDFF,QAT,QDWX,IVV,IPW,IW1,IN,INH,IC1,IZCB,
     3 IC2,IC3,ICPT,IPT)
C
C READ CATEGORY 52 DATA
      CALL SADP52(MCNT,XPC6,XSNO,XPC24,IPCT,IPRW,IZW,IDDW,IPRS,
     2 IZS,SST,ISPH,ISPHD,ISDD,ISFF,XWEQ)
C
C READ CATEGORY 8 DATA
      CALL SADP08(NADD,NLV8,MXLV8)
C     PRINT 1001,NR,IYR,IMO,IDY,IHR,IDSTYP,XLAT,XLON,XELEV,ASTA,XHR,
C    2 IRTYP,LTH,NCNT,MCNT
C1001 FORMAT(1X,I6,3I3,I5,1X,A10,2F7.2,F6.0,1X,A6,1X,F6.2,2I4,2I3)
C     PRINT 1002,SLP,DDD,FFF,AT,DPD,SST
C1002 FORMAT(10X,6F8.2)
      NRO=NRO+1
      WRITE(LOUT,1003)ASTA,IRTYP,XLAT,XLON,XELEV,IYR,IMO,IDY,IHR,XHR,
     2 DDD,FFF,SLP,STP,AT,DPD
 1003 FORMAT(1X,A6,I4,2F7.2,F7.0,3I3,I5,F5.1,2F5.0,2F7.1,3F6.1)
C     WRITE(LOUT,1003)ASTA,IRTYP,XLAT,XLON,XELEV,IYR,IMO,IDY,IHR,XHR,
C    2 DDD,FFF,IVV,IPW,IW1,SLP,STP,AT,DPD,SST,
C    3 IN,INH,IC1,IZCB,IC2,IC3
C1003 FORMAT(1X,A6,I4,2F7.2,F7.0,3I3,I5,F5.1,2F5.0,I4,2I3,2F7.1,3F6.1,
C    2 1X,6I2)
C     PRINT 1004,XLAT,XLON,IYR,IMO,IDY,XHR,IC25,IC26,IC27,ASTA,IRTYP,
C    2 XPC6,XSNO,XPC24,IPCT,(NADD(I),I=1,NLV8)
C1004 FORMAT(1X,2F7.2,3I3,F6.2,3(1X,A1),1X,A6,1X,I5,3F7.2,I3,5(1X,A10),
C    2 /,10(1X,A8))
      GO TO 10
   90 CONTINUE
      PRINT 1000,NR,ISTAT,NTOT,NRO
 1000 FORMAT(' EOF- REC,STATUS ',3I8'  RECS WRITTEN=',I8)
      NCE=NCE+1
C     IF(NCE.LT.2) GO TO 10
   95 CONTINUE
C     END FILE LOUT
      STOP
      END
      SUBROUTINE RDADP(IU,IDSRCH,IYR,IMO,IDY,IHR,IDSTYP,XLAT,XLON,
     2 ASTA,XHR,IC25,IC26,IC27,IRTYP,XELEV,IINTYP,LTH,ISTAT)
      SAVE
      DIMENSION IOB(1006)
      PARAMETER (NDIM=10000,LIM=NDIM/8)
      CHARACTER NBF*10000,ASTA*6,IDSTYP*10,IDSRCH*10
      DATA IOB/1006*0/
      COMMON /ADPB/NBF
      COMMON/ADPC/NU,NA,LTHR
      DATA NU,NA,LTHR/99999,0,0/
      NU=NU+LTHR
    5 CONTINUE
      IST=1
      READ(IU,'(A)',END=90)NBF
      IST=0
      NU=1
C
C PRINT RECORD FOR DIAGNOSTICS
C     WRITE(6,'(A60)')NBF(1:60)
C GET DATE FROM LEADER
      READ(NBF(1:10),'(2X,4I2)',ERR=80)IYR,IMO,IDY,IHR
C GET ID FOR CURRENT REPORT
      NU=11
      READ(NBF(NU:NU+39),1001,ERR=80)XLAT,XLON,ASTA,XHR,
     2 IC25,IC26,IC27,IRTYP,XELEV,IINTYP,LTH
 1001 FORMAT(F5.2,F5.2,A6,F4.2,4X,3A1,I3,F5.0,I2,I3)
C
      LTHR=LTH*10
      ISTAT=0
      IF(LTHR.GT.40) RETURN
   80 CONTINUE
      PRINT 1002,NU,NBF(NU:NU+39)
 1002 FORMAT(' ERR IN RDADP- NU,NBF ',I5,1X,A40)
      GO TO 5
   90 CONTINUE
      ISTAT=IST
      RETURN
      END
      SUBROUTINE SADP51(NCNT,SLP,STP,DDD,FFF,AT,DPD,ATMX,ATMN,
     2 QSLP,QSTP,QDDFF,QAT,QDWX,IVV,IPW,IW1,IN,INH,IC1,IZCB,
     3 IC2,IC3,ICPT,IPT)
      SAVE
C
C DECODE PARAMETERS FROM CAT 51 DATA, ALL ARGMENTS ARE OUTPUT.
C NCNT=0 MEANS NO CAT 51 DATA IN THIS REPORT.
C NCNT=-1 MEANS ERROR IN DECODE OF THE DATA
C
      CHARACTER NBF*10000,NMSG*60
      COMMON /ADPB/NBF
      COMMON/ADPC/NU,NA,LTHR
      DATA NMSG/'9999999999999999999999999999999999999999999999999999999
     299999'/
      NTU=NU+40
      NCNT=0
C
C LOOK FOR CATEGORY 51
    5 CONTINUE
      IF(NBF(NTU:NTU+9).EQ.'END REPORT') GO TO 90
      READ(NBF(NTU:NTU+9),'(I2,I3,I2,I3)',ERR=95)NCC,NTN,NENT,NCCC
      IF(NTN.LE.0) GO TO 95
      IF(NCC.EQ.51) GO TO 20
      NTU=NU+10*(NTN-1)
      GO TO 5
C
   20 CONTINUE
C DECODE CATEGORY 51
      NTU=NTU+10
      READ(NBF(NTU:NTU+59),1002,ERR=95)SLP,STP,DDD,FFF,AT,DPD,ATMX,ATMN,
     2 QSLP,QSTP,QDDFF,QAT,QDWX,IVV,IPW,IW1,IN,INH,IC1,
     3 IZCB,IC2,IC3,ICPT,IPT
 1002 FORMAT(F5.1,F5.1,2F3.0,F4.1,F3.1,2F4.1,5A1,2I3,7I2,I1,I3)
      NCNT=NCNT+1
      RETURN
   90 CONTINUE
      READ(NMSG,1002,ERR=95)SLP,STP,DDD,FFF,AT,DPD,ATMX,ATMN,
     2 QSLP,QSTP,QDDFF,QAT,QDWX,IVV,IPW,IW1,IN,INH,IC1,
     3 IZCB,IC2,IC3,ICPT,IPT
      RETURN
   95 CONTINUE
      PRINT 1003,NBF(NTU:NTU+59)
 1003 FORMAT(' DECODE ERROR IN CAT51 ',A60)
      NCNT=-1
      RETURN
      END
      SUBROUTINE SADP52(NCNT,XPC6,XSNO,XPC24,IPCT,IPW,IZW,IDDS,IPS,
     2 IZS,SST,ISPH,ISPHD,ISDD,ISFF,XWEQ)
      SAVE
C
C DECODE PARAMETERS FROM CAT 52 DATA, ALL ARGMENTS ARE OUTPUT.
C NCNT=0 MEANS NO CAT 52 DATA IN THIS REPORT.
C NCNT=-1 MEANS ERROR IN DECODE OF THE DATA
C
      CHARACTER NBF*10000,NMSG*40
      COMMON /ADPB/NBF
      COMMON/ADPC/NU,NA,LTHR
      DATA NMSG/'9999999999999999999999999999999999999999'/
      NTU=NU+40
      NCNT=0
C
C LOOK FOR CATEGORY 52
    5 CONTINUE
      IF(NBF(NTU:NTU+9).EQ.'END REPORT') GO TO 90
      READ(NBF(NTU:NTU+9),'(I2,I3,I2,I3)',ERR=95)NCC,NTN,NENT,NCCC
      IF(NTN.LE.0) GO TO 95
      IF(NCC.EQ.52) GO TO 20
      NTU=NU+10*(NTN-1)
      GO TO 5
C
   20 CONTINUE
C DECODE CATEGORY 52
      NTU=NTU+10
      READ(NBF(NTU:NTU+39),1002,ERR=95)XPC6,XSNO,XPC24,IPCT,IPW,IZW,
     2 IDDS,IPS,IZS,SST,ISPH,ISPHD,ISDD,ISFF,XWEQ
 1002 FORMAT(F4.2,F3.0,F4.2,I1,5I2,F4.1,2I2,I1,I2,F7.2)
      NCNT=NENT
C     NCNT=NCNT+1
      RETURN
   90 CONTINUE
      READ(NMSG,1002,ERR=95)XPC6,XSNO,XPC24,IPCT,IPW,IZW,
     2 IDDS,IPS,IZS,SST,ISPH,ISPHD,ISDD,ISFF,XWEQ
      RETURN
   95 CONTINUE
      PRINT 1003,NBF(NTU:NTU+39)
 1003 FORMAT(' DECODE ERROR IN CAT52 ',A40)
      NCNT=-1
      RETURN
      END
      SUBROUTINE MANADP(P,Z,T,H,D,F,Q,NCNT,MAXLEV)
      SAVE
      DIMENSION P(1),Z(1),T(1),H(1),D(1),F(1),Q(1)
      CHARACTER NBF*10000,NMSG*40
      COMMON /ADPB/NBF
      COMMON/ADPC/NU,NA,LTHR
      DATA NMSG/'9999999999999999999999999999999999999999'/
      DIMENSION PM(20)
      DATA PM/1000.,850.,700.,500.,400.,300.,250.,200.,150.,100.,70.,
     2 50.,30.,20.,10.,7.,5.,3.,2.,1./
      NTU=NU+40
      NCNT=0
      NLV=0
C
C LOOK FOR CATEGORY  1
    2 CONTINUE
      IF(NBF(NTU:NTU+9).EQ.'END REPORT') GO TO 90
      READ(NBF(NTU:NTU+9),'(I2,I3,I2,I3)',ERR=95)NCC,NTN,NENT,NCCC
      IF(NTN.LE.0) GO TO 95
      IF(NCC.EQ. 1) GO TO  3
      NTU=NU+10*(NTN-1)
      GO TO 2
C
    3 CONTINUE
   10 CONTINUE
      NLV=NENT
      IF (NLV .LE. MAXLEV) GO TO 12
      PRINT 1001,NLV
 1001 FORMAT('0TOO MANY LEVELS IN MANADP',I10)
      NLV=MAXLEV
   12 CONTINUE
      NTU=NTU+10
      DO 20 I=1,NLV
      P(I)=PM(I)
      READ(NBF(NTU:NTU+21),1002,ERR=95)Z(I),T(I),H(I),D(I),F(I),Q(I)
 1002 FORMAT(F5.0,F4.1,F3.1,2F3.0,A4)
   20 NTU=NTU+22
   90 NCNT=NLV
      RETURN
   95 CONTINUE
      PRINT 1003,NBF(NTU:NTU+21)
 1003 FORMAT(' DECODE ERROR IN CAT01 ',A22)
      NCNT=-1
      RETURN
      END

      SUBROUTINE SIGADP(P,T,H,Q,NCNT,MAXLEV)
      SAVE
      DIMENSION P(1),T(1),H(1),Q(1)
      CHARACTER NBF*10000,NMSG*40
      COMMON /ADPB/NBF
      COMMON/ADPC/NU,NA,LTHR
      DATA NMSG/'9999999999999999999999999999999999999999'/
      NTU=NU+40
      NCNT=0
      NLV=0
C
C LOOK FOR CATEGORY  2
    2 CONTINUE
      IF(NBF(NTU:NTU+9).EQ.'END REPORT') GO TO 90
      READ(NBF(NTU:NTU+9),'(I2,I3,I2,I3)',ERR=95)NCC,NTN,NENT,NCCC
      IF(NTN.LE.0) GO TO 95
      IF(NCC.EQ. 2) GO TO  3
      NTU=NU+10*(NTN-1)
      GO TO 2
C
    3 CONTINUE
   10 CONTINUE
      NLV=NENT
      IF (NLV .LE. MAXLEV) GO TO 12
      PRINT 1001,NLV
 1001 FORMAT('0TOO MANY LEVELS IN SIGADP',I10)
      NLV=MAXLEV
   12 CONTINUE
      NTU=NTU+10
      DO 20 I=1,NLV
      READ(NBF(NTU:NTU+14),1002,ERR=95)P(I),T(I),H(I),Q(I)
 1002 FORMAT(F5.1,F4.1,F3.1,A3)
   20 NTU=NTU+15
   90 NCNT=NLV
      RETURN
   95 CONTINUE
      PRINT 1003,NBF(NTU:NTU+14)
 1003 FORMAT(' DECODE ERROR IN CAT02 ',A15)
      NCNT=-1
      RETURN
      END

      SUBROUTINE STKADP(P,Z,T,H,D,F,Q,NLV,MAXLEV)
      SAVE
      DIMENSION P(1),Z(1),H(1),D(1),F(1),Q(1),T(1)
      NLV=0
      CALL MANADP(P,Z,T,H,D,F,Q,NMLV,MAXLEV)
      J=0
      IF (NMLV .LE. 0) GO TO 6
      DO 5 I=1,NMLV
      IF (T(I) .GT. 90. .AND. H(I) .GT. 90. .AND. Z(I) .GT. 90000. .AND.
     2 D(I) .GT. 900.) GO TO 5
      J=J+1
      IF (J .EQ. I) GO TO 5
      P(J)=P(I)
      Z(J)=Z(I)
      T(J)=T(I)
      H(J)=H(I)
      D(J)=D(I)
      F(J)=F(I)
      Q(J)=Q(I)
    5 CONTINUE
      NMLV=J
    6 CONTINUE
      MLEV=MAXLEV-NMLV
      I=NMLV+1
      CALL SIGADP(P(I),T(I),H(I),Q(I),NSLV,MLEV)
      NLV=NMLV+NSLV
      IF (NSLV .EQ. 0) RETURN
      DO 10 J=I,NLV
      D(J)=999.
      F(J)=999.
   10 Z(J)=99999.
      IF (NMLV .EQ. 0) RETURN
      IL=NMLV
   15 IL=IL+1
   16 IF (IL .GT. NLV) GO TO 40
      IS=IL
   18 IS=IS-1
      IF (IS .LT. 1) GO TO 22
      IF (P(IL) .GT. P(IS)) GO TO 18
      IF (P(IL) .NE. P(IS)) GO TO 22
      NLV=NLV-1
      IF (IL .GT. NLV) GO TO 40
      DO 20 K=IL,NLV
      J=K+1
      P(K)=P(J)
      Z(K)=Z(J)
      T(K)=T(J)
      H(K)=H(J)
      D(K)=D(J)
      F(K)=F(J)
   20 Q(K)=Q(J)
      GO TO 16
   22 CONTINUE
      IS=IS+1
      XP=P(IL)
      XZ=P(IL)
      XZ=Z(IL)
      XT=T(IL)
      XH=H(IL)
      XD=D(IL)
      XF=F(IL)
      QN=Q(IL)
      IB=1
      IE=IL-IS
      DO 25 J=IB,IE
      K=IL-J
      L=K+1
      P(L)=P(K)
      Z(L)=Z(K)
      T(L)=T(K)
      H(L)=H(K)
      D(L)=D(K)
      F(L)=F(K)
   25 Q(L)=Q(K)
      P(IS)=XP
      Z(IS)=XZ
      T(IS)=XT
      H(IS)=XH
      D(IS)=XD
      F(IS)=XF
      Q(IS)=QN
      GO TO 15
   40 CONTINUE
      RETURN
      END

      SUBROUTINE WPPADP(P,D,F,Q,NCNT,MAXLEV)
      SAVE
      DIMENSION P(1),D(1),F(1),Q(1)
      CHARACTER NBF*10000,NMSG*40
      COMMON /ADPB/NBF
      COMMON/ADPC/NU,NA,LTHR
      DATA NMSG/'9999999999999999999999999999999999999999'/
      LCAT=3
      XMUL=.1
      GO TO 1
      ENTRY WZZADP(P,D,F,Q,NCNT,MAXLEV)
      LCAT=4
      XMUL=1.
    1 CONTINUE
      NTU=NU+40
      NCNT=0
      NLV=0
C
C LOOK FOR CATEGORY  LCAT
    2 CONTINUE
      IF(NBF(NTU:NTU+9).EQ.'END REPORT') GO TO 90
      READ(NBF(NTU:NTU+9),'(I2,I3,I2,I3)',ERR=95)NCC,NTN,NENT,NCCC
      IF(NTN.LE.0) GO TO 95
      IF(NCC.EQ. LCAT) GO TO  3
      NTU=NU+10*(NTN-1)
      GO TO 2
C
    3 CONTINUE
   10 CONTINUE
      NLV=NENT
      IF (NLV .LE. MAXLEV) GO TO 12
      PRINT 1001,NLV
 1001 FORMAT('0TOO MANY LEVELS IN WXXADP',I10)
      NLV=MAXLEV
   12 CONTINUE
      NTU=NTU+10
      DO 20 I=1,NLV
      READ(NBF(NTU:NTU+12),1002,ERR=95)P(I),D(I),F(I),Q(I)
 1002 FORMAT(F5.0,2F3.0,A2)
      P(I)=P(I)*XMUL
   20 NTU=NTU+13
   90 NCNT=NLV
      RETURN
   95 CONTINUE
      PRINT 1003,LCAT,NBF(NTU:NTU+12)
 1003 FORMAT(' DECODE ERROR IN CAT',I2,1X,A13)
      NCNT=-1
      RETURN
      END

      SUBROUTINE TRPADP(P,T,H,D,F,Q,NCNT,MAXLEV)
      SAVE
      DIMENSION P(1),T(1),H(1),D(1),F(1),Q(1)
      CHARACTER NBF*10000,NMSG*40
      COMMON /ADPB/NBF
      COMMON/ADPC/NU,NA,LTHR
      DATA NMSG/'9999999999999999999999999999999999999999'/
      LCAT=5
      XMUL=.1
      GO TO 1
      ENTRY AFTADP(P,T,H,D,F,Q,NCNT,MAXLEV)
      LCAT=6
      XMUL=1.
    1 CONTINUE
      NTU=NU+40
      NCNT=0
      NLV=0
C
C LOOK FOR CATEGORY  LCAT
    2 CONTINUE
      IF(NBF(NTU:NTU+9).EQ.'END REPORT') GO TO 90
      READ(NBF(NTU:NTU+9),'(I2,I3,I2,I3)',ERR=95)NCC,NTN,NENT,NCCC
      IF(NTN.LE.0) GO TO 95
      IF(NCC.EQ. LCAT) GO TO  3
      NTU=NU+10*(NTN-1)
      GO TO 2
C
    3 CONTINUE
   10 CONTINUE
      NLV=NENT
      IF (NLV .LE. MAXLEV) GO TO 12
      PRINT 1001,NLV
 1001 FORMAT('0TOO MANY LEVELS IN TXXADP',I10)
      NLV=MAXLEV
   12 CONTINUE
      NTU=NTU+10
      DO 20 I=1,NLV
      READ(NBF(NTU:NTU+21),1002,ERR=95)P(I),T(I),H(I),D(I),F(I),Q(I)
 1002 FORMAT(F5.0,F4.1,F3.1,2F3.0,A4)
      P(I)=P(I)*XMUL
   20 NTU=NTU+22
   90 NCNT=NLV
      RETURN
   95 CONTINUE
      PRINT 1003,LCAT,NBF(NTU:NTU+12)
 1003 FORMAT(' DECODE ERROR IN CAT',I2,1X,A13)
      NCNT=-1
      RETURN
      END

      SUBROUTINE SADP08(NADD,NCNT,MAXLEV)
      SAVE
      DIMENSION NADD(1)
      CHARACTER NBF*10000,NMSG*40
      COMMON /ADPB/NBF
      COMMON/ADPC/NU,NA,LTHR
      DATA NMSG/'9999999999999999999999999999999999999999'/
      NTU=NU+40
      NCNT=0
      NLV=0
C
C LOOK FOR CATEGORY  8
    2 CONTINUE
      IF(NBF(NTU:NTU+9).EQ.'END REPORT') GO TO 90
      READ(NBF(NTU:NTU+9),'(I2,I3,I2,I3)',ERR=95)NCC,NTN,NENT,NCCC
C
      IF(NTN.LE.0) GO TO 95
      IF(NCC.EQ. 8) GO TO  3
      NTU=NU+10*(NTN-1)
      GO TO 2
C
    3 CONTINUE
   10 CONTINUE
      NLV=NENT
      IF (NLV .LE. MAXLEV) GO TO 12
      PRINT 1001,NLV
 1001 FORMAT('0TOO MANY LEVELS IN SADP08',I10)
      NLV=MAXLEV
   12 CONTINUE
      NTU=NTU+10
      DO 20 I=1,NLV
      READ(NBF(NTU:NTU+9),1002,ERR=95)NADD(I)
 1002 FORMAT(A10)
   20 NTU=NTU+10
   90 NCNT=NLV
      RETURN
   95 CONTINUE
      PRINT 1003,NBF(NTU:NTU+9)
 1003 FORMAT(' DECODE ERROR IN CAT08 ',A10)
      NCNT=-1
      RETURN
      END