$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