$pagewidth 132
C 
C   ********* AOC STANDARD TAPE READING SUBROUTINES ********
C 
C	Revised  01/24/02 NMD  Created simplified subroutines
C

      SUBROUTINE READSTART(LU,ITYP1,TYP2,ITYP3)
C +++++++++++++++++++++++++++++++++++++++++++++++C
C   READSTART - READ IN THE TYPE 1,2 AND 3 DATA  C
C +++++++++++++++++++++++++++++++++++++++++++++++C
      INTEGER*2 ITYP3(250),ITYP1(50) 
      DIMENSION TYP2(202)
      LOGICAL IREW

      IERR = 0
      HDAY = 86400. 
C 
C   READ IN FIRST RECORD
C 
100   READ(LU,IOSTAT=IERR,ERR=510)
     * ITYP1(1),ITYP1(2),(ITYP1(I),I=3,ITYP1(2))
C 
C  IF TAPE NOT AT START 
C 
      IF(ITYP1(1).GT.3)GO TO 500
      IF(ITYP1(1).EQ.2.OR.ITYP1(1).EQ.3)THEN
110     REWIND(LU)
        GO TO 100 
      ENDIF 
C 
C   READ IN NEW STYLE TYPE 2 FILE 
C 
200   READ(LU,IOSTAT=IERR,ERR=525)TYP2
C 
C   READ IN TYPE 3 FILE 
C 
300   READ(LU,IOSTAT=IERR,ERR=530)
     * ITYP3(1),ITYP3(2),(ITYP3(I),I=3,ITYP3(2))
      RETURN
C 
C   FILE NOT AT TAPE START, TYPE 6 FILE, END OF TAPE
C 
500   IF(IERR.NE.0)WRITE(1,'(" On ",I5," read error ",I5)')LU,IERR
      WRITE(1,'(" Tape not at start.")')
      CALL GITLOG('Do you want to rewind ?',irew)
      IF(IREW)GO TO 110
      ITYP1(1)=4
      IF(IERR.EQ.512.OR.IERR.EQ.-1)THEN 
        WRITE(1,'(" Tape at the end. ")') 
        ITYP1(1) = 6
      ENDIF 
      RETURN
510   WRITE(1,'(" READ ERROR ",I5," on Type 1 file.")')ierr
      GO TO 200
525   WRITE(1,'(" READ ERROR ",I5," on Type 2 file.")')ierr
      GO TO 300
530   WRITE(1,'(" READ ERROR ",I5," on Type 3 file.")')ierr
      RETURN
      END 


      SUBROUTINE READ4REC(LU,ITYP4) 
C 
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++C 
C   READ4REC - READ IN ONE TEN SECOND BLOCK OF TYPE 4 DATA      C 
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++C 
C     MODIFIED TO READ VARIABLE RECORD LENGTH BY: 
C               WILLIAM J. NODAL
C               (NOAA/AOML/OCD) 
C               JANUARY 22, 1985
C 
      INTEGER*2 ITYP3(250),ITYP1(50) 
      DIMENSION TYP2(202)
      INTEGER*2 ITYP4(222,10),ITYP5(106,10)
C 
C   READ IN TYPE 4 FILE 
C 
50    READ(LU,IOSTAT=IERR,ERR=910)(ITYP4(1,J),ITYP4(2,J),
     *    (ITYP4(I,J),I=3,ITYP4(2,1)),J=1,10) 
C
C  IF IN HEADER, REWIND AND READ HEADER THEN FIRST RECORD
C
      IF(ITYP4(1,1).LE.3)THEN
        REWIND(LU)
        CALL READSTART(LU,ITYP1,TYP2,ITYP3)
        GO TO 50 
      ENDIF
C
C  IF TYPE 5 FILE, BACKUP TO READ PREVIOUS TYPE 4 FILE
C
      IF(ITYP4(1,1).EQ.5)THEN
        BACKSPACE(LU)
        BACKSPACE(LU)
        GO TO 50
      ENDIF
C
C  IF TYPE 6 FILE, NOTIFY USER
C
      IF(ITYP4(1,1).EQ.6)THEN
        WRITE(1,'(" End of tape reached. ")') 
        RETURN
      ENDIF
      RETURN
C 
C  ****  ERRORS ****
C 
C   FOR FILE TYPE 4
C 
910   WRITE(1,'(" Tape ",I5," Type 4 read error ",2I5)')LU,IERR
      STOP
      END 


      SUBROUTINE READ5REC(LU,ITYP5) 
C 
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++C 
C   READ5REC - READ IN ONE TEN SECOND BLOCK OF TYPE 5 DATA      C 
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++C 
C     MODIFIED TO READ VARIABLE RECORD LENGTH BY: 
C               WILLIAM J. NODAL
C               (NOAA/AOML/OCD) 
C               JANUARY 22, 1985
C 
      INTEGER*2 ITYP3(250),ITYP1(50) 
      DIMENSION TYP2(202)
      INTEGER*2 ITYP4(222,10),ITYP5(106,10)
C 
C   READ IN TYPE 5 FILE 
C 
100   READ(LU,IOSTAT=IERR,ERR=960)(ITYP5(1,J),ITYP5(2,J),
     *    (ITYP5(I,J),I=3,ITYP5(2,1)),J=1,10) 
C
C  IF HEADER FILE, REWIND AND READ IN HEADER
C   THEN FIRST TWO DATA FILES
C
      IF(ITYP4(1,1).LE.3)THEN
        REWIND(LU)
        CALL READSTART(LU,ITYP1,TYP2,ITYP3)
        CALL READ4REC(LU,ITYP4) 
        GO TO 100 
      ENDIF
C
C  IF TYPE 4 FILE, THEN READ NEXT TYPE 5 RECORD
C
      IF(ITYP4(1,1).EQ.4)GO TO 100
C
C  IF TYPE 6 FILE, NOTIFY USER
      IF(ITYP4(1,1).EQ.6)THEN
        WRITE(1,'(" End of tape reached. ")') 
        RETURN
      ENDIF
      RETURN
C 
C  ****  ERRORS ****
C   FOR FILE TYPE 5
C 
960   WRITE(1,'(" Tape ",I5," Type 5 read error ",2I5)')LU,IERR
      STOP
      END 


      SUBROUTINE RECTFY4(PARVAL,TYP2,ITYP4,INUM,ISEC)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++C 
C  PROGRAM TO RECTIFY TYPE 4 PARAMETER INUM RETURNING PARVAL  C
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++C 

      INTEGER*2 ITYP4(222,10)
      DIMENSION TYP2(202)

C
C  CHECK IF PARAMETER IN RANGE
C
      IF(INUM.LT.1 .OR. INUM.GT.222)THEN
        WRITE(1,'("POSITION ",I5," OUTSIDE ARRAY.")')INUM
        RETURN
      ENDIF
      PARVAL = ITYP4(INUM,ISEC)
C 
C    FOR NAVIGATION DATA
C 
      IF(INUM.GE.20.AND.INUM.LE.96)THEN 
        IF(INUM.GE.20.AND.INUM.LE.56) 
     *      CALL ONAV(INUM,PARVAL,ISEC,ITYP4) 
        IF(INUM.GE.57.AND.INUM.LE.76) 
     *      CALL NAV(INUM,PARVAL,ISEC,ITYP4)
        IF(INUM.GE.77.AND.INUM.LE.96) 
     *      CALL NAV(INUM-20,PARVAL,ISEC,ITYP4) 
        RETURN
      ENDIF 
C 
C                  OTHERWISE
C   SEARCH TYPE 2 FILE FOR CORRECTION FACTORS 
C 
      DO 35 IX = 3,202,5
        IF(TYP2(IX).EQ.INUM)THEN
            C4 = TYP2(IX+1) 
            F4 = C4*(PARVAL**3) 
            C3 = TYP2(IX+2)   
            F3 = C3*(PARVAL**2) 
            C2 = TYP2(IX+3)   
            F2 = C2*PARVAL
            C1 = TYP2(IX+4)   
            PARVAL = C1+F2+F3+F4
            RETURN
        ENDIF 
      ENDDO
      WRITE(1,'(" PARAMETER ",I5," NOT MODIFIED.")')INUM
      RETURN 
      END

      SUBROUTINE RECTFY5(PARVAL,ITYP3,ITYP5,INUM,ISEC)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++C 
C    PROGRAM TO RECTIFY TYPE 5 PARAMETER INUM RETURNING PARVAL  C
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++C 

      INTEGER*2 ITYP5(106,10),ITYP3(250)
C 
C   IF BEYOND LIMITS 
C 
      IF(INUM .LT. 1 .OR. INUM .GT. 106)THEN
        WRITE('("PARAMETER OUT OF BOUNDS")')
        RETURN
      ENDIF
      PARVAL = ITYP5(INUM,ISEC)
C
C 
C  FOR LATS AND LONS
C 
      IF(INUM .EQ. 12.OR.INUM .EQ. 13)THEN
        PARVAL = ITYP5(12,ISEC) + ITYP5(13,ISEC)/600. 
        RETURN
      ENDIF 
      IF(INUM .EQ. 14.OR.INUM .EQ. 15)THEN
        PARVAL = ITYP5(14,ISEC) + ITYP5(15,ISEC)/600. 
        RETURN
      ENDIF 
      IF(INUM .EQ. 78.OR.INUM .EQ. 79)THEN
        PARVAL = ITYP5(78,ISEC) + ITYP5(79,ISEC)/600. 
        RETURN
      ENDIF 
      IF(INUM .EQ. 80.OR.INUM .EQ. 81)THEN
        PARVAL = ITYP5(80,ISEC) + ITYP5(81,ISEC)/600. 
        RETURN
      ENDIF 
C 
C        OTHERWISE 
C   DIVIDE BY TYPE 3 FACTOR 
C 
      IF(INUM.LT.78)THEN
       IX = ((INUM-12)*2)+4 
       IF(ITYP3(IX).NE.0)THEN
         PARVAL = PARVAL/ITYP3(IX)
       ENDIF
       RETURN 
      ENDIF 
      WRITE(1,'(" PARAMETER ",I5," NOT MODIFIED.")')INUM
C 
C  *** ERRORS *** 
C 
900    WRITE(1,'(" Value ",I5," is beyond the Pale. ")')INUM
       RETURN 
       END

      SUBROUTINE ONAV(INUM,PARVAL,I,ITYP4)
C ++++++++++++++++++++++++++++++++++++++++++C 
C   ONAV - CALCULATE OMEGA NAVIGATION DATA  C 
C ++++++++++++++++++++++++++++++++++++++++++C 
      INTEGER*2 ITYP4(222,10)
      DIMENSION    IREG(2)
      EQUIVALENCE (IREG,REG)
C 
C     ------------------ OMEGA -------------------- 
C   LATITUDE
      IF(INUM.GE.23.AND.INUM.LE.24)THEN 
         IREG(1)=ITYP4(23,I)
         IREG(2)=ITYP4(24,I)
         PARVAL = PACK(REG)*180.0 
      ENDIF 
C   LONGITUDE 
      IF(INUM.GE.25.AND.INUM.LE.26)THEN 
         IREG(1)=ITYP4(25,I)
         IREG(2)=ITYP4(26,I)
         PARVAL = PACK(REG)*180.0 
      ENDIF 
C   NORTH/SOUTH GROUND SPEED
      IF(INUM.EQ.27)THEN
         IREG(1)=ITYP4(27,I)
         IREG(2)=0
         PARVAL = PACK(REG)*1248.46 
      ENDIF 
C   EAST/WEST GROUND SPEED
      IF(INUM.EQ.28)THEN
         IREG(1)=ITYP4(28,I)
         IREG(2)=0
         PARVAL = PACK(REG)*1248.46 
      ENDIF 
C   HEADING 
      IF(INUM.EQ.29)THEN
         IREG(1)=ITYP4(29,I)
         IREG(2)=0
         PARVAL = PACK(REG)*180.0 
         IF(PARVAL.LT.0.)PARVAL=PARVAL+360. 
      ENDIF 
C   PITCH 
      IF(INUM.EQ.30)THEN
         IREG(1)=ITYP4(30,I)
         IREG(2)=0
         PARVAL = PACK(REG)*180.0 
      ENDIF 
C   ROLL
      IF(INUM.EQ.31)THEN
         IREG(1)=ITYP4(31,I)
         IREG(2)=0
         PARVAL = PACK(REG)*180.0 
      ENDIF 
C 
      RETURN
      END 


      SUBROUTINE NAV(INUM,PARVAL,I,ITYP4) 
C ++++++++++++++++++++++++++++++++++++++++++++C 
C   NAV - CALCULATE INERTIAL NAVIGATION DATA  C 
C ++++++++++++++++++++++++++++++++++++++++++++C 
      INTEGER*2 ITYP4(222,10)
      DIMENSION    IREG(2)
      EQUIVALENCE (IREG,REG)
C 
C     ---------------- INERTIAL 1&2 ----------------- 
C 
C   FIND ALTITUDE 
C 
      IF(INUM.GE.57.AND.INUM.LE.58)THEN 
         IREG(1)=ITYP4(57,I)
         IREG(2)=ITYP4(58,I)
         PARVAL = -998768.6081*PACK(REG)/3.3   ! IN METERS
      ENDIF 
C   FIND LATITUDE 
      IF(INUM.GE.59.AND.INUM.LE.60)THEN 
         IREG(1)=ITYP4(59,I)
         IREG(2)=ITYP4(60,I)
         PARVAL = PACK(REG)*720.0 
      ENDIF 
C   FIND LONGITUDE
      IF(INUM.GE.61.AND.INUM.LE.62)THEN 
         IREG(1)=ITYP4(61,I)
         IREG(2)=ITYP4(62,I)
         PARVAL = PACK(REG)*720.0 
      ENDIF 
C   FIND N-S VELOCITY 
      IF(INUM.GE.63.AND.INUM.LE.64)THEN 
         IREG(1)=ITYP4(63,I)
         IREG(2)=ITYP4(64,I)
         PARVAL = PACK(REG)*1685.736
      ENDIF 
C   FIND E-W VELOCITY 
      IF(INUM.GE.65.AND.INUM.LE.66)THEN 
         IREG(1)=ITYP4(65,I)
         IREG(2)=ITYP4(66,I)
         PARVAL = PACK(REG)*1685.736
      ENDIF 
C    FIND VERTICAL VELOCITY 
      IF(INUM.GE.67.AND.INUM.LE.68)THEN 
         IREG(1)=ITYP4(67,I)
         IREG(2)=ITYP4(68,I)
         PARVAL = PACK(REG)*2107.17 
      ENDIF 
C   FIND  DRIFT ANGLE 
      IF(INUM.GE.69.AND.INUM.LE.70)THEN 
         IREG(1)=ITYP4(69,I)
         IREG(2)=ITYP4(70,I)
         PARVAL = PACK(REG)*720.0 
      ENDIF 
C   FIND HEADING
      IF(INUM.GE.71.AND.INUM.LE.72)THEN 
         IREG(1)=ITYP4(71,I)
         IREG(2)=ITYP4(72,I)
         PARVAL = PACK(REG)*720.0 
         IF(PARVAL.LT.0.)PARVAL=PARVAL+360. 
      ENDIF 
C   FIND  PITCH 
      IF(INUM.GE.73.AND.INUM.LE.74)THEN 
         IREG(1)=ITYP4(73,I)
         IREG(2)=ITYP4(74,I)
         PARVAL = PACK(REG)*720.0 
      ENDIF 
C   FIND ROLL 
      IF(INUM.GE.75.AND.INUM.LE.76)THEN 
         IREG(1)=ITYP4(75,I)
         IREG(2)=ITYP4(76,I)
         PARVAL = PACK(REG)*720.0 
      ENDIF 
C 
      RETURN
      END