      SUBROUTINE POLRED(HIRANC,RETANC,HSCTIM,RNGRDP,RTOTLN,RNANC,
     &                  HNSPOT,HTOTLN,HNANC,PRFLAG,ERSTAT)
C***********************************************************************
C
C   NAME- POLRED
C
C   LANGUAGE- VS FORTRAN  TYPE- SUBROUTINE      COMPUTER- CRAY J916
C
C   VERSION- 1.0    DATE- 09/06/92     PROGRAMMER- TIM GARDNER (HSTX)
C   VERSION- 3.0    DATE- 06/19/97     PROGRAMMER- LEAH WILSON (HSTX)
C   VERSION- 3.1    DATE- 08/04/97     PROGRAMMER- LEAH WILSON (HSTX)
C
C   FUNCTION- THIS ROUTINE DETERMINES WHETHER ANY RETRIEVALS WITHIN
C             THE FRAME SHOULD BE CLASSIFIED AS POLAR REDUNDANT BASED
C             ON THE LATITUDE AND TIME OF THE MIDDLE RETRIEVAL SPOT.
C   VERSION- 3.0 MODIFICATIONS FOR INCLUSION INTO ATOVS.  INCLUDE
C                ENDING POLRED IF NO RETRIEVALS ARE MADE IN A FRAME.
C   VERSION- 3.1 CONVERSION TO NEW 8-BYTE CDB CONVENTION.
C   VERSION- 4.0    DATE- 02/27/03   PROGRAMMER- Rickey Rollins (CSC)
C        Replace R4SPV equivalence test with ISR4SPV function
C
C   CALLING SEQUENCE PARAMETERS-
C   NAME    TYPE   I/O  DESCRIPTION
C   ----    ----   ---  -----------
C  HIRANC   REAL    I   ARRAY OF DIMENSION (HNSPOT,HTOTLN,
C                       HNANC) WHICH HOLDS THE ANCILLARY
C                       INFORMATION FROM THE HIRS INSTR.
C  RETANC   REAL    I   ARRAY OF DIMENSION (RNGRDP,RTOTLN)
C                       RNANC) WHICH HOLDS THE ANCILLARY
C                       RETRIEVAL INFORMATION.
C  HSCTIM   INT     I   ARRAY OF DIMENSION (2,50) STORING
C                       HIRS SCAN TIMES.
C  RNGRDP   INT     I   NUMBER OF RETRIEVAL GRID POINTS.
C  RTOTLN   INT     I   NUMBER OF RETRIEVAL LINES.
C  RNANC    INT     I   NUMBER OF RETRIEVAL ANCILLARY VALUES.
C  HNSPOT   INT     I   NUMBER OF HIRS SPOTS.
C  HTOTLN   INT     I   NUMBER OF HIRS LINES.
C  HNANC    INT     I   NUMBER OF HIRS ANCILLARY VALUES.
C  PRFLAG   LOG     O   ARRAY OF DIMENSION (RNGRDP,RTOTLN) 
C                       THAT IS TRUE IF A RETRIEVAL LOCATION
C                       IS POLAR REDUNDANT.
C  ERSTAT
C
C   COMMON AREA PARAMETERS- SPVAL, SPGUNT
C
C   SUBROUTINES CALLED- INTCOEF
C
C   FUNCTIONS USED- NONE
C
C   EXIT STATES- NONE
C
C   ASSUMPTIONS- THIS ROUTINE ASSUMES THE CDB AND KIDS FILES HAVE
C                BEEN PREVIOUSLY OPENED.
C
C
C***********************************************************************
C
      INCLUDE 'SPVAL'
      INCLUDE 'SPGUNT'
C
      INTEGER RTTIME, TIMEPD(8), STATUS, MDRTSP, MDRTLN, MDHLIN
      INTEGER MDHSPT, HSPTNO, HNSPOT, CENDAY, MILSEC, CNVTIM(3)
      INTEGER HTOTLN, LINE, SPOT, RNGRDP, RTOTLN, LIMBPR, SPTDEL
      INTEGER HNANC, RNANC, HSCTIM(2,50), RTSP, RTLN, RTHOUR, RTMIN
      INTEGER ERSTAT
      REAL    SPTLAT, SNDTIM(3), RETLAT
      REAL    HIRANC(HNSPOT,HTOTLN,HNANC),RETANC(RNGRDP,RTOTLN,RNANC)
      REAL    PRFCTR, DG2RAD
      LOGICAL RDTIME, CHK4PR, PRFLAG(RNGRDP,RTOTLN)
      LOGICAL   ISR4SPV
C
      PARAMETER (DG2RAD = .0174532925)
C
      DATA RDTIME /.TRUE./
C
      SAVE RDTIME, TIMEPD
C
C  IF THE SYNOPTIC TIMES HAVE NOT BEEN DEFINED YET READ THEM FROM CDB
C
      IF (RDTIME) THEN
        CALL INTCOEF(CDBUNT,'RETRIEVE','POLRED  ','TIMEPDS ',
     1               8,0,0,0,TIMEPD,'GET',STATUS)
        RDTIME = .FALSE.
      ENDIF
C
C  CHECK TO SEE IF DATA WITHIN THIS FRAME FALLS WITHIN A SYNOPTIC
C  TIME PERIOD.  FIRST CREATE THE RETRIEVAL TIME FROM THE HOUR AND
C  MINUTE OF THE MIDDLE RETRIEVAL IN THE FRAME.  SET A FLAG TO
C  INDICATE WHETHER ANY RETREIVALS SHOULD BE CHECKED FOR POLAR
C  REDUNDANCY.
C
      CHK4PR = .TRUE.
      MDRTSP = RNGRDP / 2
      MDRTLN = RTOTLN / 2
      HSPTNO = RETANC(MDRTSP,MDRTLN,1)
C
C  IF THE MIDDLE SPOT IS MISSING TRY THE FIRST LINE IN THE FRAME
C  FOR THE SPOT NUMBER
C
      IF (HSPTNO .EQ. 0) HSPTNO = RETANC(MDRTSP,1,1)
C
C  IF THERE ARE NO RETRIEVALS IN THIS FRAME, WRITE MESSAGE TO KIDS
C  FILE AND EXIT POLRED SUBROUTINE.
C
      IF (HSPTNO .EQ. 0) THEN
         CALL POLRE$(100,ERSTAT)
         RETURN
      ENDIF
C
C  FIND TIME OF THIS SPOT AND CONVERT TO YYMM DDHH MMSS FORMAT.  THEN
C  COMPARE AGAINST THE SYNOPTIC TIMES TO DETERMINE WHETHER THIS FRAME
C  SHOULD BE CHECKED FOR POLAR REDUNDANCY. FOR THE TIME OF THE FRAME
C  THE SPOT AT WHICH THE MIDDLE RETRIEVAL IS MADE IS USED.
C
      MDHLIN = (HSPTNO / HNSPOT) + 1
      MDHSPT = MOD(HSPTNO,HNSPOT)
      IF (MDHSPT .EQ. 0) THEN
        MDHLIN = MDHLIN - 1
        MDHSPT = HNSPOT
      ENDIF
C
C  CONVERT FROM DAY OF CENTURY AND MILLISECONDS TO YYMM DDHH MMSS
C
      CENDAY = HSCTIM(1,MDHLIN)
      MILSEC = HSCTIM(2,MDHLIN)
      CALL ODBTIM(CENDAY,MILSEC,CNVTIM)
C
C  RETRIEVAL TIME IS NUMBER OF MIN AFTER 00Z. IF THE RETREIVAL TIME
C  IS IN THE LAST HOUR OF THE DAY IT IS SET TO NEGATIVE TO ALLOW
C  IT TO BE CHECKED AGAINST THE SYNOPTIC TIME WINDOWS EASIER (IE. IF
C  A WINDOW CROSSES 00Z, THE BEGINNING TIME OF THE WINDOW IS NEGATIVE
C  WHICH MEANS BEFORE 00Z.
C
      RTHOUR = MOD(CNVTIM(2),100)
      RTMIN = CNVTIM(3)/100
      RTTIME = RTHOUR * 60 + RTMIN
      IF (RTTIME .GE. 1380) RTTIME = RTTIME - 1440
C
C  SET POLAR REDUNDANCY CHECK FLAG TO FALSE IF THE RETRIEVAL IN THE
C  MIDDLE OF THE FRAME IS DURING A SYNOPTIC TIME WINDOW.
C
      DO 10 I = 1,7,2
        IF ((RTTIME .GE. TIMEPD(I)) .AND. (RTTIME .LE. TIMEPD(I+1)))
     &                                               CHK4PR = .FALSE.
   10 CONTINUE
C
C  SET THE POLAR REDUNDANCY FLAGS IN THE FRAME.
C
      DO 40 RTLN = 1, RTOTLN
        DO 30 RTSP = 1, RNGRDP
          PRFLAG(RTSP,RTLN) = .FALSE.
C
C CHECK FOR POLAR REDUNDANCY IF CHECK FLAG IS TRUE
C
          IF (CHK4PR) THEN
            HSPTNO = RETANC(RTSP,RTLN,1)
            IF(HSPTNO.EQ.0) GO TO 30
            LINE = (HSPTNO / HNSPOT) + 1
            SPOT = MOD(HSPTNO,HNSPOT)
            IF (SPOT .EQ. 0) THEN
              LINE = LINE - 1
              SPOT = HNSPOT
            ENDIF
C
C  BASED ON THE LATITUDE OF THE SPOT COMPUTE THE NUMBER OF SPOTS IN
C  THIS LINE WHICH SHOULD BE POLAR REDUNDANT AND CHECK IF THIS SPOT
C  IS ONE OF THEM.
C
            RETLAT = HIRANC(SPOT,LINE,1)
            IF (ISR4SPV(RETLAT)) GOTO 30
            RETRAD = RETLAT * DG2RAD
C
            IF ((RETLAT .GT. -40.0) .AND. (RETLAT .LT. 40.0)) GOTO 30
            PRFCTR = .24 + COS(RETRAD)
            IF (PRFCTR .LT. 1.0) THEN
              LIMBPR = NINT(28 - (PRFCTR * 28))
              IF (LIMBPR .GT. 19) LIMBPR = 19
              IF (SPOT .GT. (HNSPOT/2)) THEN
                SPTDEL = HNSPOT - SPOT + 1
              ELSE
                SPTDEL = SPOT
              END IF
C
C  IF THE DISTANCE OF THE SPOT FROM THE END OF THE LINE IS WITHIN
C  THE POLAR REDUNDANT REGION OF THE LINE SET THE FLAG TO TRUE
C
              IF (SPTDEL .LE. LIMBPR) PRFLAG(RTSP,RTLN) = .TRUE.
            END IF
          END IF
   30   CONTINUE
   40 CONTINUE
C
C  GOTO SUCCESSFUL RETURN
C
      GOTO 910
C
C  ERROR READING THE CDB...WRITE ERROR MESSAGE TO THE KIDS
C
  900 ERSTAT=99
C
  910 RETURN
      END

      SUBROUTINE POLRE$(MSGCOD,ERSTAT)
C**********************************************************************
C   NAME- POLRE$
C
C   LANGUAGE- VS FORTRAN  TYPE- SUBROUTINE      COMPUTER- CRAY J916
C
C   VERSION- 1.0    DATE- 09/12/96  PROGRAMMER- TIM GARDNER (HSTX)
C   VERSION- 3.0    DATE- 06/19/97  PROGRAMMER- LEAH WILSON (HSTX)
C   VERSION- 3.1    DATE- 07/09/97  PROGRAMMER- LEAH WILSON (HSTX)
C
C   FUNCTION- THIS SUBROUTINE IS THE ERROR HANDLING ROUTINE FOR
C             ROUTINE POLRED.
C   VERSION- 3.0 MODIFICATIONS FOR INCLUSION INTO ATOVS.
C   VERSION- 3.1 CONVERT FROM MMLF TO KIDS FORMAT.  ADD MSGCOD=100.
C                REMOVE MSGCOD=101 SINCE CDB UTILITIES HANDLE IT.
C
C   FILES-
C     DSN                  I/O   UNIT    FUNCTIONAL DESCRIPTION
C     ---                  ---  ------   -----------------------
C     ..../KIDS             O    KUNIT   KRAY I/A DOCUMENTATION SYSTEM
C
C   CALLING SEQUENCE PARAMETERS-
C
C     VARIABLE               TYPE  I/O  FUNCTION
C     --------               ----  ---  --------
C     MSGCOD                  INT   I   MESSAGE CODE USED TO
C                                       IDENTITIFY THE ERROR
C
C     ERSTAT                  INT   O   99 = FATAL ERROR, ELSE 0
C
C   PROGRAM CONSTANTS-
C
      INCLUDE 'ERPARM'
C
C   COMMON AREA PARAMETERS-
C
      INCLUDE  'ERINFO'
      INCLUDE  'SPGUNT'
C
C   LOCAL PARAMETERS-
C
C     VARIABLE                TYPE    FUNCTION
C     --------                ----    --------
C     KMSG                   CH*100   KIDS MESSAGE BUFFER
C     C4TEMP                  CH*4    HOLDING BUFFER FOR WRITING TO KIDS
C
C   SUBPROGRAMS CALLED- KIDS 
C
C   ASSUMPTIONS-  THIS ROUTINE ASSUMES KIDS HAS BEEN CALLED PREVIOUSLY
C                 TO OPEN THE KIDS FILE.
C
C**********************************************************************
C
      INTEGER   MSGCOD,ERSTAT
C
      CHARACTER*4 C4TEMP 
      CHARACTER*100 KMSG
C
C  SET ERINFO:SUBNAM TO MAIN MODULE NAME, AS THE KIDS SUBROUTINE EXTRACTS
C  THE SUBROUTINE NAME ITSELF.
C
      SUBNAM = 'SPGDVR'
C
C  CHECK MESSAGE CODE AND WRITE ERROR MESSAGE
C
      IF (MSGCOD .EQ. 100) THEN
          KMSG = 'No POLRED for frame        since no retrievals.'
          WRITE(C4TEMP,'(I4)') FRMNBR 
          KMSG(21:24) = C4TEMP
          CALL KIDS(KUNIT,SUBNAM,2,KMSG,0)
          ERSTAT=0
C
C NOT A VALID MSGCOD
C
      ELSE
        ERSTAT=0
        KMSG = ' Invalid error message code = '
        WRITE(C4TEMP,'(I4)') MSGCOD
        KMSG(31:34) = C4TEMP
        CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
      ENDIF
      RETURN
      END
