SUBROUTINE GETHPD(MSGUN,IYR,IMMDD,NVALSD,ITIMD,HPWRD,NDXD,IQLD,
     +                  ISTAT,IWRK,IBLK,IUNPK,LREC)
C          This routine returns 1 day of values for the input year, IYR
C          (4 digit) and month-day, IMMDD.  Returned values are:
C                NVALSD = number of values in the following arrays:
C                ITIMD  = U.T. hour and minute of day
C                HPWRD  = Hemispheric power input (units = GWatts)
C                NDXD   = Dave Evans hemispheric power index
C                IQLD   = HPWRD qualifier; contains the measurement
C                         satellite id in the tens digit and the
C                         hemisphere of measurement in the units digit:
C                         if the tens digit is 0, TIROS-N made the
C                         measurement, otherwise the digit is the number
C                         of the NOAA satellite; for hemispheres the
C                         units digit is 0 if northern hemisphere and 1
C                         for the southern hemisphere; e.g., 61 => NOAA-6
C                         in the southern hemisphere.
C                ISTAT  = Status flag
C                       = 99999 ON INPUT, implies only fatal errors
C                         will cause diagnostic messages to be printed,
C                         nonfatal errors will be signified only by the
C                         returned value of ISTAT (thus allowing user
C                         control of most diagnostic print messages).
C                         ISTAT VALUES ON RETURN:
C                       = 0 => ok
C                       = 2 => Request time before first available
C                       = 3 => Request time after last available
C          Notes:
C          - MSGUN is the fortran unit number to print diagnostic
C            messages; see also ISTAT above!
C          - It is assumed that input IYEAR and IMMDD are reasonable
C            since GETEHP does this checking.
C          - The following arrays are used by RDBLK6, which must be
C            dimensioned appropriately by the initial calling routine:
C              IWRK  = Work array (contains fortran unit to read
C                      indicies, etc - see RDBLK6)
C              IBLK  = Packed physical record buffer.
C              IUNPK = Unpacked block buffer.
C              LREC  = Logical record.
C          Formal parameter argument declarations:
C          (the arrays in the first line should be dimmed NVALSD)
      DIMENSION ITIMD(*),HPWRD(*),NDXD(*),IQLD(*),
     +          IWRK(*),IBLK(*),IUNPK(*),LREC(*)
 
C          Local declarations:
      DOUBLE PRECISION IDIF , IOLDIF  , I1DA , JDIF
      PARAMETER (MPAR=6 , NOPRT=99999 , I1DA=8640000D0)
      DIMENSION IT(4) , LBEGT(4) , IOLDB(4)
      LOGICAL ATBEGN
      SAVE    ATBEGN,LBEGT,IOLDB,ISTRD
      DATA    ATBEGN,LBEGT,IOLDB,ISTRD
     +        /.TRUE. , 1940,0101,0,0, 1940,0101,0,0 , 0/
 
C          See if already read past the requested date:
      IT(1) = IYR
      IT(2) = IMMDD
      IT(3) = 0
      IT(4) = 0
      CALL TIMDIF(LBEGT,IT,IDIF)
      IF (IDIF .EQ. 0D0) GO TO 1000
      IF (IDIF .GT. 0D0) THEN
C          Must read more but first see if already at EOD
        IF(ISTRD .NE. 3)GO TO 100
        IF(ISTAT .NE. NOPRT)WRITE(MSGUN,9100)IYR,IMMDD,(LREC(I),I=5,6)
        ISTAT = 3
        RETURN
      ENDIF
C          Already read past the request date
      IF(ATBEGN)THEN
        IF(ISTAT .NE. NOPRT)WRITE(MSGUN,9200)(IT(I),I=1,2),
     +                                     (LREC(J),J=5,6)
        ISTAT = 2
        RETURN
      ENDIF
C          Maybe no data are available for request date
      CALL TIMDIF(IOLDB,LBEGT,IOLDIF)
C          IOLDIF = time of last lrec read - previous one
      IF (IOLDIF .GT. I1DA) THEN
        NVALSD = 0
        RETURN
      ENDIF
      CALL REWBLK(IWRK)
      IWRK(7) = 1
      ATBEGN  = .TRUE.
 
C          Read a new lrec, compute & test the new difference
  100 NVALSD = 0
      CALL RDBLK6(IWRK,LREC,IBLK,IUNPK,ISTRD)
      IF(ISTRD .EQ. 0 .AND. LREC(2) .NE. 1002)GO TO 100
      IOLDB(1) = LBEGT(1)
      IOLDB(2) = LBEGT(2)
      LBEGT(1) = LREC(5)
      LBEGT(2) = LREC(6)
      CALL TIMDIF(LBEGT,IT,JDIF)
      IF (JDIF .GT. 0D0) THEN
        ATBEGN = .FALSE.
        IF(ISTRD .NE. 3)GO TO 100
        IF(ISTAT .NE. NOPRT)WRITE(MSGUN,9100)(IT(I),I=1,2),
     +                                       (LREC(J),J=5,6)
        ISTAT = 3
        RETURN
      ELSEIF (JDIF .LT. 0D0) THEN
        IF(ATBEGN)THEN
          IF(ISTAT .NE. NOPRT)WRITE(MSGUN,9200)(IT(I),I=1,2),
     +                                        (LREC(J),J=5,6)
          ISTAT = 2
        ENDIF
        RETURN
      ENDIF
 
C          Assign new last begin time read and values, then return
 1000 NVALSD   = LREC(16)
      JOFF=16
      DO 1100 I=1,NVALSD
      JOFF=JOFF+MPAR
      ITIMD(I) =       LREC(3+JOFF)
      HPWRD(I) = FLOAT(LREC(4+JOFF)) / 10.
      NDXD (I) =       LREC(5+JOFF)
 1100 IQLD (I) =       LREC(6+JOFF)
      RETURN
 
C          Error trap messages:
 9100 FORMAT('0GETHPD:  Requested date',2I5,' is after last available:
     +',2I5)
 9200 FORMAT('0GETHPD:  Requested date',2I5,' is before first available
     +: ',2I5)
      END