      SUBROUTINE UP1BHD(INSTNU,STRTIM,DSNAME,SPRCID,INSTID,
     1                  RETCOD)
      IMPLICIT NONE
C*********************************************************************
C
C   NAME- UP1BHD
C
C   LANGUAGE- FORTRAN 77     TYPE- SUBROUTINE      COMPUTER- CRAY   
C
C   VERSION- 2.0   DATE- 04/25/95   PROGRAMMER- SURYA JANDHYALA(SMSRC).
C   VERSION- 2.1   DATE- 02/26/96   PROGRAMMER- DAVE MOREL (SMSRC)
C      ATOVS-339 - CHANGED AMSU-A PROCESSING_BLOCK TO PROCESSING_BLOCK_ID.
C                 ALSO ADDED A SHAPE(1)=7 PRIOR TO THE CALL TO AAG1C1.
C                 ALSO MADE TEMP A CHARACTER*10 FROM A CH*8 AND PUT OUT
C                 A 5 DIGIT ORBIT NUMBER INSTEAD OF A 4 DIGIT NUMBER.
C   VERSION- 3.0   DATE- 04/16/96   PROGRAMMER- ALEX POZDNYAK (FDC) 
C      MODIFIED TO RUN ON THE CRAY.  REPLACED I*4 WITH INT.
C   VERSION- 3.1   DATE- 07/10/97   PROGRAMMER- LEAH WILSON (HSTX) 
C      CHANGED HIRS PROCESSING_BLOCK TO PROCESSING_BLOCK_ID, AND CHANGED
C      SHAPE FROM 7 TO 8.  CHANGED HIRS SPACECRAFT_ID TO INSTRUMENT_ID.
C      CHANGE PROCID FROM CH*7 TO CH*8.  EXTRACT HIRS INSTRUMENT_ID VIA
C      HRG1I1 INSTEAD OF HRG1I2.  CHANGE SHAPE OF AMSU-A PROCESSING BLOCK
C      ID FROM 7 TO 8.
C   VERSION- 3.2   DATE- 12/01/97   PROGRAMMER- LEAH WILSON (HSTX)
C      PROCESSING_BLOCK_ID IS INCORRECT PRE-LAUNCH, SO COMMENT OUT ALL
C      REFERENCES TO IT HERE.  IT IS SET IN THE SPGDVR MAIN.
C   VERSION- 3.3   DATE- 06/03/98   PROGRAMMER- LEAH WILSON (HSTX)
C      CHANGE INSTRUMENT_ID BACK TO HRG1I2 FOR VERSION 2.0 OF 1B* UTILITIES.
C   VERSION- 3.4   DATE- 02/04/99   PROGRAMMER- LEAH WILSON RAYTHEON
C      REMOVE ALL REFERENCES TO AMSU-B.
C   VERSION- 3.?   DATE- 01/13/04   PROGRAMMER- F. TILLEY (RAYTHEON)
C      ADDED AMSU-B PROCESSING BACK IN.
C   VERSION- 3.5   DATE- 01/10/05   PROGRAMMER- F. TILLEY (RAYTHEON)
C      CHANGED THE DECLARATION OF 'SHAPE' FROM INTEGER TO INTEGER*4.
C      SUBSTITUTED I*4 VARIABLE 'LENGTH' FOR THE DATA LENGTH IN CALLS
C      TO 1B* UTILITIES. CHANGED 'RETCOD' TO I*4 'STATUS' IN CALLS TO
C      1B* UTILITIES. REMOVED COMMON 'B1ERR' FROM UP1BH$ AND ADDED
C      COMMON 'MSG1BS' AND A CALL TO SUBROUTINE B1SERR TO DUMP THE
C      CONTENTS OF THE 1B* MESSAGE BUFFER TO THE KIDS FILE.
C   VERSION- 3.6   DATE- 05/23/06   PROGRAMMER- FRANK TILLEY (IMSG)
C      FOR WR #303 (PIPELINE PROCESSING) REMOVED 'ENDTIM' FROM CALLING
C      ARGUMENTS AND ALL INTERNAL CODE THAT REFERENCES ORBIT END TIME.
C      REMOVED CALLS TO GET THE CENTURY DAY AND MILLISECOND OF DAY
C      FOR DATA START TIMES FROM THE 1B* HEADERS, SINCE THEY MAY
C      NOT BE AVAILABLE AT THE START OF PIPELINE PROCESSING.
C      ADDED CODE TO EXTRACT THE START DATE AND TIME FROM THE ORIGINAL
C      DSN AND TO CONVERT THE YEAR, DAY OF YEAR, AND START TIME IN
C      HOURS AND MINUTES TO CENTURY DAY AND MILLISECONDS OF DAY.
C 
C   FUNCTION- READS AND UNPACKS HEADER DATA FROM A 1B HEADER RECORD OF
C             A HIRS, AMSU-A OR AN AMSU-B INSTRUMENT. THE DATA RETRIEVED
C             CONSISTS OF THE INSTRUMENT'S START AND END TIMES, THE
C             STARTING AND ENDING ORBIT NUMBERS, THE INSTRUMENT'S DATA
C             SOURCE, THE SPACECRAFT IDENTIFICATION NUMBER AND THE
C             INSTRUMENT IDENTIFICATION NUMBER.
C
C   FILES-  INSTRUMENT 1B* FILE.
C
C   CALLING SEQUENCE PARAMETERS-
C     VARIABLE            TYPE      I/O      DEFINITION
C     ---------           ----      ---      ----------
C     INSTNU               INT       I       THE INSTRUMENT FOR WHICH
C                                            1B HEADER INFORMATION IS
C                                            TO BE RETRIEVED. 1=HIRS,
C                                            2= AMSU-A, 3 = AMSU-B.
C     STRTIM               INT       O       ARRAY OF 1B HEADER START
C                                            TIME. DIMENSIONED 2. THE
C                                            FIRST WORD IS THE CENTURY
C                                            DAY AND THE SECOND WORD IS
C                                            MILLISECOND OF DAY.
C     DSNAME              CH*80      O       DATA SOURCE NAME.
C     SPRCID               INT       O       SPACECRAFT IDENTIFICATION
C                                            NUMBER.
C     INSTID               INT       O       INSTRUMENT IDENTIFICATION
C                                            NUMBER.
C     RETCOD               INT       O       ERROR RETURN CODE.
C                                            SEE EXIT STATES.
C
      CHARACTER*80 DSNAME
      INTEGER      INSTNU,STRTIM(2)
      INTEGER      SPRCID,INSTID,RETCOD
C
C   LOCAL PARAMETERS-
C     VARIABLES           TYPE      DEFINITION
C     ---------           ----      ----------
C      DAY                 INT      CONTAINS THE DAY OF THE YEAR.
C      ERSTAT              INT      THE STATUS CODE RETURNED BY THE
C                                   ERROR WRITING ROUTINE.
C      I                   INT      DO LOOP INDEX.
C      ITEMID             CH*32     USED FOR IDENTIFYING THE VALUE
C                                   THAT IS TO BE RETRIEVED FROM THE
C                                   SCAN LINE.
C      INT2VL              I*2      USED FOR RETRIEVING 2 BYTE INTEGER
C                                   VALUES FROM THE SCAN LINE.
C      JDAY                INT      CONTAINS THE JULIAN DAY EXTRACTED
C                                   FROM THE 1B DATASET.
C      LENGTH              I*4      DATA LENGTH FOR 1B* UTILITY CALLS.
C      MONTH               INT      CONTAINS THE MONTH OF THE YEAR.
C      MSGCOD              INT      USED FOR IDENTIFYING THE MESSAGE
C                                   CODE.
C      PROCID             CH*8      CONTAINS PROCESSING BLOCK ID.
C      SHAPE               I*4      LOCAL SHAPE ARRAY, DIMENSIONED (0:7),
C                                   USED IN CALLS TO THE 'GET' ROUTINES.
C      STATUS              I*4      RETURN CODE FROM 1B* UTILITIES.
C      TEMP               CH*10     USED FOR TEMPORARILY STORING THE
C                                   STARTING AND ENDING ORBIT NUMBERS.
C      YEAR                INT      CONTAINS THE YEAR.
C
C   SUBPROGRAMS CALLED- AAG1C1,AAG1I2,AAG1I4,ABG1C1,ABG1I2,ABG1I4,
C                       HRG1C1,HRG1I2,HRG1I4,CENDAY,JULDAY,UP1BH$
C
C   FUNCTIONS USED- MOD
C
C   EXIT STATES- RETCOD=0, NORMAL PROCESSING.
C                RETCOD <> 0, ERROR IN A 1B* UTILITY.
C                RETCOD=10 INVALID INSTRUMENT NUMBER.
C                RETCOD=99 FOR A ERROR IN UP1BH$.
C
C   ASSUMPTIONS- NONE
C********************************************************************
C
      CHARACTER*8   PROCID
      CHARACTER*10  TEMP
      CHARACTER*32  ITEMID
      INTEGER*2     INT2VL
      INTEGER*4     SHAPE(0:7), LENGTH, STATUS
      INTEGER       I,DAY,ERSTAT,MSGCOD,MONTH
      INTEGER       JDAY,YEAR, HOUR, MINS, SECONDS
      CHARACTER*2   C2YEAR, C2HOUR, C2MINS
      CHARACTER*3   CJDAY
C
C  INITIALIZE THE ERROR STATUS TO 0.
C
      ERSTAT=0
      MSGCOD=0
C
C INITIALIZE ALL ELEMENTS OF THE SHAPE ARRAY TO 0.
C
      DO 10, I = 1, 8
         SHAPE(I-1) = 0
   10 CONTINUE
C
C  BASED ON THE INSTRUMENT NUMBER, BRANCH TO READ IN THE CORRECT
C  HEADER INFORMATION. IF THE INSTRUMENT NUMBER IS NOT VALID, SET THE
C  RETURN CODE TO 10 AND WRITE AN ERROR MESSAGE TO THE KIDS FILE.
C
      IF(INSTNU .EQ. 1) THEN
          GO TO 100
      ELSEIF(INSTNU .EQ. 2) THEN
          GO TO 200
      ELSEIF(INSTNU .EQ. 3) THEN
          GO TO 300
      ELSE
          MSGCOD = 304
          RETCOD = 10
          GO TO 900
      ENDIF
C
C  HIRS INSTRUMENT.
C
  100 CONTINUE
C
C  UNPACK THE DATA SET NAME.
C
      SHAPE(0) = 1
      SHAPE(1) = 80
      LENGTH = 80
      ITEMID = 'ORIGINAL_DATA_SET_NAME           '
      CALL HRG1C1(ITEMID,DSNAME,LENGTH,SHAPE,STATUS)
      RETCOD = STATUS
      IF (RETCOD .NE. 0) GO TO 900
C
C  RETRIEVE THE SATELLITE ID FROM THE 1B HEADER.
C
      SHAPE(1) = 1
      LENGTH = 1
      ITEMID = 'INSTRUMENT_ID                   '
      CALL HRG1I2(ITEMID,INT2VL,LENGTH,SHAPE,STATUS)
      RETCOD = STATUS
      IF (RETCOD .NE. 0) GO TO 900
      SPRCID = INT2VL
C
C  RETRIEVE THE DATA TYPE CODE.
C
      ITEMID = 'DATA_TYPE_CODE                  '
      CALL HRG1I2(ITEMID,INT2VL,LENGTH,SHAPE,STATUS)
      RETCOD = STATUS
      IF (RETCOD .NE. 0) GO TO 900
      INSTID = INT2VL
C
C  EXTRACT THE STARTING DATE AND TIME FROM THE DSN
C  AND CONVERT THE HOUR AND MINUTE TO MILLISECONDS.
C
      C2YEAR(1:2) = DSNAME(14:15)
      CJDAY(1:3)  = DSNAME(16:18)
      C2HOUR(1:2) = DSNAME(21:22)
      C2MINS(1:2) = DSNAME(23:24)
C
      READ(C2YEAR,'(I2)') YEAR
      READ(CJDAY, '(I3)') JDAY 
      READ(C2HOUR,'(I2)') HOUR
      READ(C2MINS,'(I2)') MINS
      MINS = (HOUR*60) + MINS
C
C Convert minutes to seconds, then to milliseconds

      SECONDS = (MINS * 60) 
      STRTIM(2) = (SECONDS*1000)
      GO TO 400
C
C  AMSU-A INSTRUMENT.
C
  200 CONTINUE
C
C  UNPACK THE DATA SET NAME.
C
      SHAPE(0) = 1
      SHAPE(1) = 80
      LENGTH = 80
      ITEMID = 'ORIGINAL_DATA_SET_NAME          '
      CALL AAG1C1(ITEMID,DSNAME,LENGTH,SHAPE,STATUS)
      RETCOD = STATUS
      IF (RETCOD .NE. 0) GO TO 900
C
C  RETRIEVE THE SATELLITE ID FROM THE 1B HEADER.
C
      SHAPE(1) = 1
      LENGTH = 1
      ITEMID = 'SPACECRAFT_ID                   '
      CALL AAG1I2(ITEMID,INT2VL,LENGTH,SHAPE,STATUS)
      RETCOD = STATUS
      IF (RETCOD .NE. 0) GO TO 900
      SPRCID = INT2VL
C
C  RETRIEVE THE DATA TYPE CODE.
C
      ITEMID = 'DATA_TYPE_CODE                  '
      CALL AAG1I2(ITEMID,INT2VL,LENGTH,SHAPE,STATUS)
      RETCOD = STATUS
      IF (RETCOD .NE. 0) GO TO 900
      INSTID = INT2VL
C
C  EXTRACT THE STARTING DATE AND TIME FROM THE DSN
C  AND CONVERT THE HOUR AND MINUTE TO MILLISECONDS.
C
      C2YEAR(1:2) = DSNAME(14:15)
      CJDAY(1:3)  = DSNAME(16:18)
      C2HOUR(1:2) = DSNAME(21:22)
      C2MINS(1:2) = DSNAME(23:24)
C
      READ(C2YEAR,'(I2)') YEAR
      READ(CJDAY, '(I3)') JDAY 
      READ(C2HOUR,'(I2)') HOUR
      READ(C2MINS,'(I2)') MINS
      MINS = (HOUR*60) + MINS
C
C Convert minutes to seconds, then to milliseconds

      SECONDS = (MINS * 60) 
      STRTIM(2) = (SECONDS*1000)
      GO TO 400
C
C  AMSU-B / MHS INSTRUMENT.
C
  300 CONTINUE
C
C  UNPACK THE DATA SET NAME.
C
      SHAPE(0) = 1
      SHAPE(1) = 80
      LENGTH = 80
      ITEMID = 'ORIGINAL_DATA_SET_NAME          '
      CALL ABG1C1(ITEMID,DSNAME,LENGTH,SHAPE,STATUS)
      RETCOD = STATUS
      IF (RETCOD .NE. 0) GO TO 900
C
C  RETRIEVE THE SATELLITE ID FROM THE 1B HEADER.
C
      SHAPE(1) = 1
      LENGTH = 1
      ITEMID = 'SPACECRAFT_ID                   ' 
      CALL ABG1I2(ITEMID,INT2VL,LENGTH,SHAPE,STATUS)
      RETCOD = STATUS
      IF (RETCOD .NE. 0) GO TO 900
      SPRCID = INT2VL
C
C  RETRIEVE THE DATA TYPE CODE.
C
      ITEMID = 'DATA_TYPE_CODE                  '
      CALL ABG1I2(ITEMID,INT2VL,LENGTH,SHAPE,STATUS)
      RETCOD = STATUS
      IF (RETCOD .NE. 0) GO TO 900
      INSTID = INT2VL
C
C  EXTRACT THE STARTING DATE AND TIME FROM THE DSN
C  AND CONVERT THE HOUR AND MINUTE TO MILLISECONDS.
C
      C2YEAR(1:2) = DSNAME(14:15)
      CJDAY(1:3)  = DSNAME(16:18)
      C2HOUR(1:2) = DSNAME(21:22)
      C2MINS(1:2) = DSNAME(23:24)
C
      READ(C2YEAR,'(I2)') YEAR
      READ(CJDAY, '(I3)') JDAY 
      READ(C2HOUR,'(I2)') HOUR
      READ(C2MINS,'(I2)') MINS
      MINS = (HOUR*60) + MINS
C
C Convert minutes to seconds, then to milliseconds

      SECONDS = (MINS * 60) 
      STRTIM(2) = (SECONDS*1000)
C
  400 CONTINUE
C
C  CONVERT THE DATE EXTRACTED FROM THE 1B HEADER TO A 1B START TIME
C  CENTURY DAY.
C
      CALL JULDAY(JDAY,YEAR,MONTH,DAY)
      CALL CENDAY(YEAR,MONTH,DAY,STRTIM(1))
C
C  RETURN TO THE CALLING ROUTINE.
C
      RETURN
C
C  ERROR IN A 1B* UTILITY.
C
C  I/O ERROR.
C
  900 IF (MSGCOD .EQ. 0) MSGCOD = 301
      CALL UP1BH$(MSGCOD,INSTNU,ITEMID,ERSTAT)
      IF (ERSTAT .EQ. 99) RETCOD = 99
C
      RETURN
      END
C
      SUBROUTINE UP1BH$(MSGCOD,INSTNU,WHAT,ERSTAT)
      IMPLICIT NONE
C
C*********************************************************************
C   NAME- UP1BH$
C
C   LANGUAGE- VS FORTRAN  TYPE- SUBROUTINE     
C
C   VERSION- 2.0   DATE- 05/01/95   PROGRAMMER- SURYA JANDHYALA(SMSRC)
C   VERSION- 3.0   DATE- 08/04/97   PROGRAMMER- LEAH WILSON (HSTX)     
C
C   FILES-
C     DSN                       I/O  UNIT  FUNCTIONAL DESCRIPTION
C     ---                       ---  ----  -----------------------
C     .../KIDS                   O   KUNIT KRAY I/A DOCUMENTATION SYSTEM
C
C   FUNCTION- THIS SUBROUTINE IS THE ERROR HANDLING ROUTINE FOR
C             UP1BHD.
C   VERSION- 3.0 CONVERT FROM MMLF TO KIDS CONVENTION.
C
C   CALLING SEQUENCE PARAMETERS-
C     VARIABLE               TYPE  I/O  FUNCTION
C     --------               ----  ---  --------
C     MSGCOD                  INT   I   MESSAGE CODE USED TO IDENTIFY
C                                       THE ERROR PATTERN.
C     INSTNU                  INT   I   THE INSTRUMENT FOR WHICH
C                                       1B HEADER INFORMATION IS
C                                       BEING RETRIEVED. 1=HIRS,
C                                       2= AMSU-A, 3 = AMSU-B.
C     WHAT                   CH*32  I   ITEM BEING PROCESSED BY A 
C                                       1B* UTILITY.
C     ERSTAT                  INT   O   STATUS CODE IF AN ERROR
C                                       OCCURS DURING I/O.
C
      INTEGER   MSGCOD,INSTNU,ERSTAT
C
C   COMMON AREA PARAMETERS-
      INCLUDE 'ERPARM'
      INCLUDE 'ERINFO'
      INCLUDE 'MSG1BS'
      INCLUDE 'SPGUNT'
C
C   LOCAL VARIABLES-
C     VARIABLE             TYPE   FUNCTION
C     --------             ----   --------
C     BSHFT                 INT   USED TO SHIFT BITS OF CONFIG.
C     ERR1BS                I*4   RETURN CODE FROM B1SERR CALL.
C     STATUS                INT   STATUS CODE IF AN ERROR OCCURS DURING
C                                 I/O.
C     C4TEMP               CH*4   TEMPORARY FOR WRITING INTO KMSG.
C     KMSG                CH*100  KIDS MESSAGE BUFFER.
C
C   SUBPROGRAMS CALLED- KIDS, B1SERR
C
C   FUNCTIONS USED- IBCLR
C
C   EXIT STATES-
C       ERSTAT = 99;INDICATING A FATAL ERROR WAS DETECTED
C
C*********************************************************************
C
      INTEGER   BSHFT,STATUS,IDX
      INTEGER*4 ERR1BS
      CHARACTER*4 C4TEMP
      CHARACTER*32 WHAT
      CHARACTER*100 KMSG
C
C  SET ERINFO:SUBNAM TO MAIN MODULE SINCE KIDS SETS SUBROUTINE NAME.
C
      SUBNAM = 'SPGDVR'
C
C  FOR AN I/O ERROR.
C
      IF (MSGCOD .EQ. 301) THEN
         KMSG='* ERROR * 1b* utility processing        ' 
         KMSG(34:65) = WHAT
         PRINT *, KMSG
         CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
         KMSG='Instrument #      is turned off'
         WRITE(C4TEMP,'(I4)') INSTNU
         KMSG(14:17) = C4TEMP
         PRINT *, KMSG
         CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
         CALL B1SERR(ERRBUF,LINES,NOUT,ERR1BS)
         IF (NOUT.GT.1) THEN
            DO IDX=1,NOUT
               KMSG(1:60) = ERRBUF(IDX)
               PRINT *,KMSG
               CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
            END DO
         END IF
C
C  SET THE INSTRUMENT BIT TO ZERO.
C
C  IBCLR TREATS THE BITS OF A 4-BYTE WORD AS BEING ORDERED RIGHT TO
C  LEFT FROM 0 TO 31.  FOR OUR PURPOSES IN FRMCNF AND CONFIG, WE
C  CONSIDER BITS AS BEING ORDERED FROM LEFT TO RIGHT FROM 1 TO 32.
C  THUS TO SET WHAT WE CONSIDER TO BE THE CORRECT BIT CORRESPONDING
C  TO INSTR, THE BIT SET WITH IBCLR MUST BE 32-INSTR. (BIT 1
C  CORRESPONDS TO BIT 31, 2 TO 30, 3 TO 29....)
C
         BSHFT=32-INSTNU
         CONFIG=IBCLR(CONFIG,BSHFT)
C
C  INVALID INSTRUMENT NUMBER.
C
      ELSEIF (MSGCOD .EQ. 304) THEN
          KMSG='Invalid instrument number      - processing stops'
          WRITE(C4TEMP,'(I4)') INSTNU
          KMSG(27:30) = C4TEMP
          PRINT *,KMSG
          CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
      ELSE
C
C NOT A VALID MSGCOD
C
        STATUS=0
        KMSG = 'Invalid message code      '
        WRITE(C4TEMP,'(I4)') MSGCOD
        KMSG(22:25) = C4TEMP
        PRINT *,KMSG
        CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
      ENDIF
      RETURN
      END
