      SUBROUTINE PCSTBL(INUNIT,TBLSIZ,TABLE,NUMREC,CHANUSED,ERSTAT)
      implicit none
C***********************************************************************
C
C   NAME- PCSTBL
C
C   LANGUAGE- VS FORTRAN   TYPE- SUBROUTINE    COMPUTER- CRAY J916
C
C   VERSION- 1.0    DATE- 6/1/93     PROGRAMMER- CARLA A. NEIGH, SMSRC
C   VERSION- 2.0    DATE- 6/1/94     PROGRAMMER- ALEX POZDNYAK,  SMSRC
C            SATOV-16  FIRST GUESS LIBRARY RECORD LENGTH IS INCREASED
C            FROM 416 TO 440. DIMENSIONING OF ARRAYS WILL INCREASE FOR
C            THE NEW RECORD LENGTH.
C   VERSION- 2.1    DATE- 7/28/94    PROGRAMMER- SURYA JANDHYALA,SMSRC
C            XATOV-16  DECLARED TWO NEW LOCAL VARIABLES AND CHANGED THE
C            THE HARD CODED DIMENSIONS OF LIBREC ARRAY WITH PARAMETERS.
C            ADDED A CALLING SEQUENCE PARAMETER NUMLVL.
C   VERSION- 2.2    DATE- 12/28/94   PROGRAMMER- ALEX POZDNYAK,SMSRC
C            XATOV-83  DIMENSION OF LIBREC CHANGED TO (RECORD LENGTH/4),
C            INCLUDE RETPARM ADDED, OPEN AND CLOSE STATEMENTS REMOVED,
C            READ STATEMENTS CHANGED TO CALL TO DREADM, NUMCHN AND
C            NUMLVL REMOVED FROM CALLING ARGUMENTS.
C   VERSION- 2.3    DATE- 02/29/96   PROGRAMMER- DAVE MOREL,SMSRC
C            ATOVS-348  REMOVING DREADM AND PUTTING IN DIRECT ACCESS FORTRAN
C            READ STATEMENTS.  ALSO REMOVING BKBUF AND CHANGING VARIABLE
C            REC TO REC1.
C
C   VERSION- 3.0    DATE- 06/04/96   PROGRAMMER- TIM GARDNER (HSTX)
C   VERSION- 3.1    DATE- 06/10/96   PROGRAMMER- TIM GARDNER (HSTX)
C   VERSION- 3.2    DATE- 08/09/96   PROGRAMMER- TIM GARDNER (HSTX)
C   VERSION- 3.3    DATE- 01/17/97   PROGRAMMER- TIM GARDNER (HSTX)
C   VERSION- 3.4    DATE- 09/05/97   PROGRAMMER- LEAH WILSON (HSTX)
C   VERSION- 3.5    DATE- 04/15/98   PROGRAMMER- LEAH WILSON (RSTX)
C   VERSION- 3.6    DATE- 11/09/00   PROGRAMMER- M.P.FERGUSON (RITSS)
C   VERSION- 3.7    DATE- 06/05/02   PROGRAMMER- RICH KELLEY (CSC) 
C
C   FUNCTION-  THIS SUBROUTINE READS THE FIRST GUESS LIBRARY SPECIFIED
C              BY THE INPUT INUNIT AND BUILDS A TABLE OF PRINCIPAL
C              COMPONENT SCORES, BRIGHTNESS TEMPERATURES, FORECAST
C              SURFACE POTENTIAL TEMPERATURE, LATITUDE, AND TERRAIN
C              TYPE FOR EACH OF THE RECORDS IN THAT LIBRARY.
C
C   VERSION 3.0- DOCUMENTATION AND SYNTAX CHANGES FOR ATOVS BASELINE
C                ON THE CRAY.
C   VERSION 3.1- MODIFIED CODE TO WRITE TO A LIBRARY BUFFER CONTAINING
C                8 BYTE ELEMENTS FROM A BUFFER CONTAINING 4 BYTE ELEMENT
C   VERSION 3.2- ALLOWS INPUT OF FIRST GUESS DATA FROM A FILE CONTAINING
C                8 BYTE WORDS.  CONVERSION OF INPUT DATA FROM 4 TO 8
C                BYTES IS NO LONGER NEEDED.
C   VERSION 3.3- MODIFICATIONS TO EXPAND THE FIRST GUESS
C   VERSION 3.4- FOR OPTIMIZING, READ THE FGLIBS INTO A BUFFER SO AS
C                NOT TO READ THE LIBRARY FOR EACH RETRIEVAL.  ADD RECORD
C                NUMBER TO ERROR HANDLING ROUTINE.
C   VERSION 3.5- ADD DOCUMENTATION ABOUT PCSTBL EXPECTING THERE TO BE
C                NO MISSING VALUES IN FIRST GUESS LIBRARIES.
C   VERSION 3.6  CHANUSED FLAG USED TO DETERMINE WHICH CHANNELS OF THE
C                FIRST GUESS WILL BE CONVERTED TO BRIGHTNESS TEMPERATURES
C                (OTHERS ARE NOT USED).
C   VERSION 3.7- ABSORBED VALUES OF TWO CONSTANTS, CNVFC1 AND CNVFC2 
C                INTO INCLUDE MEMBER PLPHSCON.  THIS WAS DONE IN RESPONSE TO
C                FPDT PR47, DATED 8/13/2001.
C
C   FILES-
C    DSN OR DESCRIPTIVE TITLE  I/O   UNIT    FUNCTIONAL DESCRIPTION
C    ------------------------  ---   ----    ----------------------
C    NSS. ... .FGLIB            I   INUNIT   FIRST GUESS LIBRARY
C
C
C   CALLING SEQUENCE PARAMETERS-
C   NAME    TYPE   I/O   DESCRIPTION
C   ----    ----   ---   -----------
C   INUNIT  INT     I    UNIT NUMBER FOR FIRST GUESS LIBRARY.
C   TBLSIZ  INT     I    NUMBER OF PRINCIPAL COMPONENT SCORE RECORDS
C                        ALLOWED FOR IN THE TABLE.
C   TABLE   REAL    O    ARRAY (DIM RETPARM:NUMCHN + 7 X TBLSIZ)
C                        CONTAINING THE FIRST GUESS LIBRARY PRINCIPAL
C                        COMPONENT SCORES BRIGHTNESS TEMPERATURES,
C                        FORECAST SURFACE POTENTIAL TEMPERATURE,
C                        LATITUDE, AND TERRAIN TYPE.
C   NUMREC  INT     O    NUMBER OF DATA RECORDS IN THE FIRST GUESS
C                        LIBRARY.
C   ERSTAT  INT     O    ERROR RETURN CODE
C                         = 0 IF NO ERROR OCCURRED,
C                         = 99 FATAL ERROR OCCURRED.
C
C   COMMON AREA PARAMETERS- RETPARM
C
C   LOCAL PARAMETERS-
C   NAME    TYPE    DESCRIPTION
C   ----    ----    -----------
C   HEADER  CH*1    FIRST GUESS LIBRARY HEADER RECORD.
C                   (DIM RETPARM:FGLBRL)
C   RECBUF  CH*1    ARRAY (DIM RETPARM:FGLBRL) CONTAINING A RECORD FROM
C                   THE FIRST GUESS LIBRARY.
C   NMLIBR  INT     NUMBER OF ELEMENTS IN THE LIBREC ARRAY.
C   LIBREC  REAL    FIRST GUESS LIBRARY RECORD.
C                   DIMENSION (NMLIBR)
C   I       INT     DO LOOP INDEX.
C   IOERR   INT     I/O ERROR CODE.
C   OFFST1  INT     EQUAL TO NUMLVL + 4
C   OFFST2  INT     EQUAL TO NUMLVL + NUMCHN + 4
C   REC1    INT     DO LOOP INDEX.
C   STATUS  INT     STATUS RETURNED FROM $-ROUTINE.
C   IDUM    INT     INDICATES IF LIBRARY IS CLEAR OR CLOUDY.
C
C
C   FUNCTION USED- IPLRD7
C
      REAL IPLRD7

C
C   SUBPROGRAMS CALLED- PCSTB$
C
C   EXIT STATES-
C     ERSTAT = 99 : FIRST GUESS LIBRARY TABLE OF PRINCIPAL COMPONENT
C                   SCORES COULD NOT BE BUILT DUE TO I/O ERROR OR
C                   INSUFFICIENT TABLE SIZE.
C
C  NOTE!!!  FOR SPEED, PCSTBL DOES NOT DO ANY ERROR CHECKING ON RADIANCES
C           IT READS FROM THE FIRST GUESS LIBRARIES.  IT IS ASSUMED THAT
C           THE OFF-LINE PROGRAM BLDLIB WILL NOT WRITE OUT LIBRARY RECORDS
C           WITH MISSING RADIANCES FOR ANY CHANNELS.
C
C***********************************************************************
C
      INCLUDE 'RETPARM'
      INCLUDE 'FGLBUF'
      INCLUDE 'PLPHSCON'
C
      INTEGER INUNIT,TBLSIZ,NUMREC,ERSTAT,NMLIBR
C
      PARAMETER (NMLIBR = FGLBRL / 8)
C
      REAL TABLE(NUMCHN+21,TBLSIZ)
C
      CHARACTER*1 RECBUF(FGLBRL)
      CHARACTER*5 NUMRCH
      REAL LIBREC(NMLIBR), PLRAD
      INTEGER REC1,I,STATUS,IOERR,OFFST1,OFFST2,ITERR,IDUM
      INTEGER CHANUSED(2,35)
C
      EQUIVALENCE (RECBUF(76),NUMRCH)
      EQUIVALENCE (RECBUF,LIBREC)
C
C  SET THE STATUS CODE TO 0, AND SET THE VALUES OF OFFST1 AND OFFST2.
C
      ERSTAT = 0
      OFFST1 = NUMLVL + 4
      OFFST2 = NUMCHN + NUMLVL + 4
      IDUM = INUNIT - 29
      IF(IDUM.NE.1.AND.IDUM.NE.2) THEN
         CALL PCSTB$(104,INUNIT,REC1,IOERR,STATUS)
         ERSTAT=99
         RETURN
      ENDIF
C
C  READ THE NUMBER OF DATA RECORDS IN THE LIBRARY FROM THE HEADER.
C
      READ(INUNIT,REC=1,IOSTAT=IOERR) RECBUF
      IF (IOERR .NE. 0) GOTO 100
C
C  STORE HEADER IN APPROPRIATE FGLLIB BUFFER
C
      READ(NUMRCH(1:5),'(I5)') NUMREC
C
C  WRITE A FATAL ERROR MESSAGE TO THE KIDS IF THE NUMBER OF
C  RECORDS IN THE FIRST GUESS LIBRARY IS GREATER THAN THE ALLOWABLE
C  NUMBER FOR THE TABLE.
C
      IF (NUMREC .GT. TBLSIZ) THEN
         CALL PCSTB$(101,INUNIT,REC1,IOERR,STATUS)
         ERSTAT = 99
         RETURN
      ENDIF
C
C  READ THE PRINCIPAL COMPONENT SCORES AND BRIGHTNESS TEMPERATURES FROM
C  THE LIBRARY AND BUILD THE TABLE.
C
      DO 30 REC1 = 2, (NUMREC+1)
         READ(INUNIT,REC=REC1,IOSTAT=IOERR) LIBREC
         IF (IOERR .NE. 0) GOTO 100
C
C  STORE THIS RECORD IN APPROPRIATE BUFFER
C
         DO 7 I=1,NMLIBR   
            FGLLIB(IDUM,REC1,I) = LIBREC(I)
    7    CONTINUE
C
         DO 10 I = 1, 4
            TABLE(I,REC1-1) = LIBREC(I)
   10    CONTINUE
C
C  ADD TERRAIN AND CLASS INFORMATION TO THE TABLE.
C
         TABLE(NUMCHN+8,REC1-1) = LIBREC(OFFST2+5)
         TABLE(NUMCHN+9,REC1-1) = LIBREC(OFFST2+6)
C
         ITERR = LIBREC(194)
         IF(ITERR.NE.0)THEN
            ITERR=2
         ELSE
            ITERR=1
         ENDIF
         DO 20 I = 1, NUMCHN
            IF (I .NE. 20 .AND. CHANUSED(ITERR,I) .EQ. 1) THEN
C
C  COMPUTE THE INVERSE OF PLANCK RADIANCE AT 700 CM-1.
C
              PLRAD = LIBREC(I+OFFST1)
              TABLE(I+4,REC1-1) = CNVFC2/ALOG((CNVFC1/PLRAD) + 1.0)
            ELSE
              TABLE(I+4,REC1-1) = LIBREC(I+OFFST1)
            ENDIF
   20    CONTINUE
C
C  PUT THE FORECAST SURFACE POTENTIAL TEMPERATURE, LATITUDE, AND
C  TERRAIN TYPE IN THE TABLE.
C
         TABLE(NUMCHN+5,REC1-1) = LIBREC(OFFST2+1)
         TABLE(NUMCHN+6,REC1-1) = LIBREC(OFFST2+3)
         TABLE(NUMCHN+7,REC1-1) = LIBREC(OFFST2+4)
C
   30 CONTINUE
C
      RETURN
C
  100 CALL PCSTB$(102,INUNIT,REC1,IOERR,STATUS)
      ERSTAT = 99
C
      RETURN
      END
C**********************************************************************
      SUBROUTINE PCSTB$(MSGCOD,INUNIT,RECRD,IOER,STAT)
C
C**********************************************************************
C
C   NAME- PCSTB$
C
C   LANGUAGE- VS FORTRAN  TYPE- SUBROUTINE      COMPUTER- CRAY J916
C
C   VERSION- 1.0    DATE- 6/1/93   PROGRAMMER- CARLA NEIGH (SMSRC)
C   VERSION- 3.0    DATE- 06/04/96 PROGRAMMER- TIM GARDNER (HSTX)
C   VERSION- 3.1    DATE- 10/07/97 PROGRAMMER- LEAH WILSON (HSTX)
C
C   FUNCTION- THIS SUBROUTINE IS THE ERROR HANDLING SUBROUTINE FOR THE
C             SUBROUTINE PCSTBL.  MESSAGES DEPENDENT UPON THE INPUT
C             VALUE OF MSGCOD ARE WRITTEN TO THE SUPPORT SUBSYSTEMS
C             KIDS FILE.  
C
C   VERSION 3.0- DOCUMENTATION AND SYNTAX CHANGES FOR ATOVS BASELINE
C                ON THE CRAY.
C   VERSION 3.0- WRITE ERROR MESSAGES TO THE KIDS FILE.  INCLUDE /SPGUNT/.
C
C   FILES-
C     DSN OR DESCRIPTIVE TITLE I/O   UNIT  FUNCTIONAL DESCRIPTION
C     ------------------------ ---   ----  ----------------------
C     ...KIDS                   O    KUNIT KRAY INTERACTIVE DOCUMENTATION
C
C   CALLING SEQUENCE PARAMETERS-
C     VARIABLE          TYPE I/O  FUNCTION
C     --------          ---- ---  --------
C     MSGCOD            INT   I   MESSAGE CODE OF ERROR DETECTED.
C     INUNIT            INT   I   FIRST GUESS LIBRARY UNIT NUMBER.
C     RECRD             INT   I   FIRST GUESS LIBRARY RECORD NUMBER.
C     IOER              INT   I   I/O ERROR CODE 'IOSTAT'.
C     STAT              INT   O   NORMALLY SET TO 0 BUT IF AN ERROR
C                                 OCCURS AN ERROR STATUS CODE IS SET.
C
C   COMMON AREA PARAMETERS-
      INCLUDE 'SPGUNT'
      INCLUDE 'ERPARM'
      INCLUDE 'ERINFO'
C
C   LOCAL PARAMETERS-
C     VARIABLE                TYPE    FUNCTION
C     --------                ----    --------
C     I                        INT    DO LOOP CONTROL INDX
C     KMSG                   CH*100   KIDS MESSAGE BUFFER
C     C4TEMP                  CH*4    HOLDING BUFFER FOR WRITING TO KIDS
C
C   SUBROUTINES CALLED- KIDS
C
C   EXIT STATES-
C       STAT =  0; INDICATING NO OR A NON-FATAL ERROR WAS DETECTED
C       STAT = 99; INDICATING A FATAL ERROR WAS DETECTED
C
C***********************************************************************
C
      INTEGER  STAT, I, MSGCOD, RECRD, INUNIT, IOER
      CHARACTER*4   C4TEMP
      CHARACTER*100 KMSG
C
C  SET ERINFO:SUBNAM
C
      SUBNAM = 'SPGDVR'
      STAT = 0
C
      IF (MSGCOD.EQ.101) THEN
        KMSG(1:50)=' * FATAL ERROR * Table size not large enough for l'
        KMSG(51:100)='ibrary on unit     .'
        WRITE(C4TEMP,'(I4)') INUNIT
        KMSG(66:69) = C4TEMP
        STAT = 99
        CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
C
      ELSEIF (MSGCOD.EQ.102) THEN
        KMSG(1:50)=' * FATAL ERROR * Reading 1st guess lib. rec      o'
        KMSG(51:100)='n unit     .'
        WRITE(C4TEMP,'(I4)') RECRD
        KMSG(45:48) = C4TEMP
        WRITE(C4TEMP,'(I4)') INUNIT
        KMSG(58:61) = C4TEMP
        STAT = 99
        CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
C
      ELSEIF (MSGCOD.EQ.103) THEN
        KMSG(1:50)=' * FATAL ERROR * Error converting buffer - 1st gue'
        KMSG(51:100)='ss library on unit     .'
        WRITE(C4TEMP,'(I4)') INUNIT
        KMSG(70:73) = C4TEMP
        STAT = 99
        CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
C
      ELSEIF (MSGCOD.EQ.104) THEN
        KMSG(1:50)=' * FATAL ERROR * Invalid unit number (    ) for Fi'
        KMSG(51:100)='rst Guess Library.'
        WRITE(C4TEMP,'(I4)') INUNIT
        KMSG(39:42) = C4TEMP
        STAT = 99
        CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
C
      ELSE
C
C NOT A VALID MSGCOD
C
        STAT=0
        KMSG = ' Invalid error message code = '
        WRITE(C4TEMP,'(I4)') MSGCOD
        KMSG(31:34) = C4TEMP
        CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
      ENDIF
      RETURN
      END
