      PROGRAM READLIB
      IMPLICIT NONE
C***********************************************************************
C
C   NAME- READLIB
C
C   LANGUAGE-  FORTRAN   TYPE- MAIN PROGRAM  COMPUTER- AIX
C
C   VERSION- 1.0    DATE- 03/30/07   PROGRAMMER- FRANK TILLEY (IMSG)
C
C   FUNCTION-  THIS PROGRAM READS RECORDS FROM A FIRST GUESS LIBRARY
C              AND CHECKS FOR GUESS PROFILES WHERE THE DEW POINT
C              TEMPERATURE EXCEEDS THE ATMOSPHERIC TEMPERATURE.
C
C
C   FILES-
C    DSN OR DESCRIPTIVE TITLE  I/O   UNIT    FUNCTIONAL DESCRIPTION
C    ------------------------  ---   ----    ----------------------
C    FIRST GUESS LIB            I     40     FIRST GUESS LIBRARY
C
C
      INCLUDE 'RETPARM'
      INCLUDE 'PLPHSCON'
      INCLUDE 'RTPLVL'
      INCLUDE 'SPVAL'
C
      INTEGER INUNIT,NUMREC,ERSTAT,NMLIBR
C
      PARAMETER (NMLIBR = FGLBRL / 8)
C
      CHARACTER*(FGLBRL) RECBUF
      CHARACTER*5 NUMRCH
      REAL LIBREC(NMLIBR), PLRAD, TEMPS(100),WVMRS(50),FOVLAT,FOVLON
      REAL MR2TDEW, TDEW, TDEW2MR, TEMPC, SATMIX, KELVIN
      INTEGER REC1,I,STATUS,IOERR,OFFST1,OFFST2,IERR,IDUM
      INTEGER RECNUM,ITERR, BADLEV
      LOGICAL BADREC
C
C  SET THE STATUS CODE TO 0, AND SET THE VALUES OF OFFST1 AND OFFST2.
C
      KELVIN = 273.16
      ERSTAT = 0
      NUMREC = 0
      OFFST1 = NUMLVL + 4
      OFFST2 = NUMCHN + NUMLVL + 4
      INUNIT = 40

      OPEN (INUNIT,IOSTAT=IOERR,ACCESS="DIRECT",RECL=FGLBRL)
C
C  READ THE NUMBER OF DATA RECORDS IN THE LIBRARY FROM THE HEADER.
C
      READ(INUNIT,REC=1,IOSTAT=IOERR) RECBUF
C
      NUMRCH(1:5) = RECBUF(76:80)
      print *,'Number of records: ',NUMRCH
      READ(NUMRCH(1:5),'(I5)') RECNUM
C
C  READ THE PRINCIPAL COMPONENT SCORES AND BRIGHTNESS TEMPERATURES FROM
C  THE LIBRARY AND BUILD THE TABLE.
C
      RECNUM = RECNUM+1
      DO 30 REC1 = 2, RECNUM
         READ(INUNIT,REC=REC1,IOSTAT=IOERR) LIBREC
C
C  CHECK THE FIRST WORD IN THE RECORD READ FROM THE LIBRARY, IF
C  THE FIRST WORD HOLDS A MISSING VALUE, WRITE OUT A WARNING MESSAGE
C  AND SKIP TO THE NEXT RECORD.
C
         IF (LIBREC(1).EQ.R4SPV) THEN
            PRINT *,'FIRST VALUE IN LIBRARY RECORD ',REC1,' IS R4SPV'
            GO TO 30
         ELSE
            NUMREC = NUMREC+1
         END IF

C
         ITERR = NINT(LIBREC(194))
         IF(ITERR.NE.0)THEN
            ITERR=2
         ELSE
            ITERR=1
         ENDIF
         DO I = 1, 100
C
C  COMPUTE THE INVERSE OF PLANCK RADIANCE AT 700 CM-1.
C
            PLRAD = LIBREC(I+4)
            TEMPS(I) = CNVFC2/ALOG((CNVFC1/PLRAD) + 1.0)
         END DO
         DO I = 1, 50
            WVMRS(I) = LIBREC(105+I)
         END DO
C
         FOVLAT = LIBREC(232)
         FOVLON = LIBREC(233)
C
C    CONVERT THE MIXING RATIOS TO DEW POINT TEMPERATURE
C    AND COMPARE THE DEW POINT TEMPERATURE AGAINST THE
C    ATMOSPHERIC TEMPERATURE.
         
         BADREC = .FALSE.
         BADLEV = 0
         DO I = 62,100
            TDEW = (MR2TDEW(WVMRS(I-50),PRETLV(I)))+ KELVIN
            IF ((TDEW - TEMPS(I)) .GE. 1.0) THEN
               BADREC = .TRUE.
               IF (BADLEV.EQ.0) BADLEV = I
            END IF
C
C    COMPARE THE MIXING RATIO AGAINST THE SATURATION MIXING RATIO
C
c          TEMPC = TEMPS(I) - 273.16
c          SATMIX = TDEW2MR(PRETLV(I),TEMPC)
c          IF (WVMRS(I-50).GT.SATMIX) THEN
c             print 60, fovlat, fovlon,(INT(PRETLV(I))),WVMRS(I-50),SATMIX
c          END IF
         END DO
         IF (BADREC) THEN
            print *,' '
            DO I = BADLEV,100
               TDEW = (MR2TDEW(WVMRS(I-50),PRETLV(I)))+ KELVIN
               print 50, fovlat, fovlon,(INT(PRETLV(I))),TEMPS(I),TDEW,(TDEW - TEMPS(I))
            END DO
         END IF
            
   50 FORMAT(F6.2,1X,f7.2,1x,I4,' mb ','Temp ',f8.4,' Tdew ',f8.4,' Delta ',F7.3)            
   60 FORMAT(F6.2,1X,f7.2,1x,I4,' mb ','WVMR ',f8.4,' SATMIX ',f8.4)            
C
   30 CONTINUE
      CLOSE(INUNIT)
      STOP
C
      
C
      END

      INCLUDE 'BDRTPLVL'
