C@PROCESS CHARLEN(14800) 00010000 C MAIN 00020000 C 00030000 C THIS PROGRAM READ AMSU-A LEVEL 1B LAT & LON AND APPLYING 00040000 C WITH ATTITUDE COORECTIONS BY USING S. KIGAWA ROUTINE ELC 00050000 C AND PUT BACK TO THE LEVEL 1B DATASET 00060000 C I. WANG, CSC, 12/02 00070000 C 00080000 C INPUT: 00090000 C 1. FT10: AMSU-A LEVEL 1B DATA 00100000 C OUTPUT: 00110000 C 1. FT15: AMSU-A LEVEL 1B DATA AFTER THE CONSTANT ATTITUDE CORRECTION 00120000 C --------------------------------------------- 00130000 IMPLICIT REAL*8 (A-H, O-Z) 00140000 C 00150000 C EQUATORIAL RADIUS (SEMI-MAJOR AXIS) OF THE EARTH 00160000 C 00170000 REAL*8 AE 00180000 PARAMETER (AE = 6378.135D0) 00190000 C 00200000 C RADIANS TO DEGREES CONVERSION FACTOR 00210000 C 00220000 REAL*8 RTODEG 00230000 C 00240000 C DEGREES TO RADIANS CONVERSION FACTOR 00250000 C 00260000 INTEGER OFFSET 00270000 REAL*8 DEGTOR 00280000 INTEGER*2 I2CNT 00281000 CHARACTER*1 BUF(2560), BUFOUT(2560) 00290000 DIMENSION LAT0(30), LNG0(30), LTLN(60) 00310000 DIMENSION LAT1(30), LNG1(30) 00320000 DIMENSION LATC(30), LNGC(30) 00320100 DIMENSION FLAT0(30), FLNG0(30), FLTLN(60) 00321000 DIMENSION FLAT1(30), FLNG1(30) 00322000 DIMENSION XLATC(30), XLNGC(30) 00330000 DIMENSION ROLLD(30), PITCHD(30), YAWD(30) 00340000 DIMENSION ROLLR(30), PITCHR(30), YAWR(30) 00350000 C EQUIVALENCE (I2CNT, BUF(147)) 00351002 C READ IN DEGREE 00360000 DATA ROLLD/30*0.0/, PITCHD/30*0.0/, YAWD/30*0.0/ 00370000 DATA OFFSET/0/ 00380000 DATA RTODEG/57.29577951308232D0/ 00390000 C 00400000 C ATTITUDE CORRECTIONS NAMELIST/RPYCOR/ 00410000 NAMELIST /RPYCOR/ ROLLD, PITCHD, YAWD 00420000 C 00430000 C INPUT LEVEL 1B 00440000 OPEN (UNIT=10, ACCESS='SEQUENTIAL', FORM='UNFORMATTED') 00450001 C OUTPUT LEVEL 1B 00470000 OPEN (UNIT=15, ACCESS='DIRECT', FORM='UNFORMATTED', 00480000 * IOSTAT=IOERR, RECL=2560) 00490000 C 00500000 C CONVERT FROM DEG TO RADIAN 00510000 DEGTOR = 1D0/RTODEG 00520000 C 00530000 C READ NAMELIST IN DEGREE 00540000 C 00550000 READ(5, FMT=RPYCOR, ERR=70, END=80) 00560000 C SUCCESSFUL READ NAMELIST 00570000 80 CONTINUE 00580000 WRITE(6,RPYCOR) 00590000 C 00600000 C CONVERT TO REDIAN 00610000 C 00620000 DO I=1,30 00630000 ROLLR(I) = ROLLD(I)/RTODEG 00640000 PITCHR(I) = PITCHD(I)/RTODEG 00650000 YAWR(I) = YAWD(I)/RTODEG 00660000 ENDDO 00670000 C 00680000 C READ INPUT HEADER 00690000 READ (10, END = 99, ERR=77) BUF 00700001 CALL FMOVE(BUFOUT(1),2560, BUF(1)) 00710000 C WRITE HEADER TO NEW LEVEL 1B 00720000 WRITE (15, REC=1, IOSTAT=ICODE) BUFOUT 00730000 C -------------------------------------------------- 00740000 C READ 1B DATA RECORDS START FROM REC. 2 00750000 C 00760000 II = 1 00770000 DO 101 K=1, 10000 00780000 II = II + 1 00790000 C 00800000 C READ FIRST SCAN LINE 00810000 READ (10, END= 99, ERR=77) BUF 00820001 CALL FMOVE(BUFOUT(1),2560, BUF(1)) 00830000 C 00840000 CALL FMOVE(LTLN(1), 240, BUF(653)) 00850000 C 00860000 DO 10 I=1,30 00870000 LAT0(I) = LTLN(2*I-1) 00880000 LNG0(I) = LTLN(2*I) 00890000 C AJUST BY SCALING FACTOR 00890100 FLAT0(I) = FLOAT(LAT0(I))*1.D-4 00890200 FLNG0(I) = FLOAT(LNG0(I))*1.D-4 00890300 10 CONTINUE 00900000 C 00910000 C READ 2ND SCAN LINE 00920000 C 00930000 II = II + 1 00940000 READ (10, END= 99, ERR=77) BUF 00950001 C 00960000 CALL FMOVE(LTLN(1), 240, BUF(653)) 00970000 C 00980000 DO 15 I=1,30 00990000 LAT1(I) = LTLN(2*I-1) 01000000 LNG1(I) = LTLN(2*I) 01010000 C AJUST BY SCALING FACTOR AND CONVERT TO REAL 01011000 FLAT1(I) = FLOAT(LAT1(I))*1.D-4 01012000 FLNG1(I) = FLOAT(LNG1(I))*1.D-4 01013000 15 CONTINUE 01020000 C --------------------------------------------------------------- 01030000 C CALL ELC ROUTINE TO PERFORM EARTH LOCATION CORRECTION TO FIRST LINE 01040000 C 01050000 OFFSET = 0 01051000 CALL ELC(FLAT0,FLNG0,FLAT1,FLNG1,ROLLR,PITCHR,YAWR,OFFSET, 01060000 . XLATC,XLNGC) 01070000 C 01080000 C CONVERT XLATC, XLNGC TO DEGREE 01090000 DO N = 1, 30 01100000 XLATC(N) = XLATC(N) * RTODEG 01110000 C ADJUST BY SCALING FACTOR AND CONVERT TO INTEGER*4 01111000 LATC(N) = XLATC(N)*1.D04 01120000 LTLN(2*N-1) = LATC(N) 01121000 XLNGC(N) = XLNGC(N) * RTODEG 01130000 C ADJUST BY SCALING FACTOR AND CONVERT TO INTEGER*4 01130100 LNGC(N) = XLNGC(N)*1.D04 01131000 LTLN(2*N) = LNGC(N) 01140000 ENDDO 01150000 C 01160000 C PUTBACK NEW LAT & LON TO RECORD II-1 01170000 C 01180000 IM = II - 1 01190000 CALL FMOVE(BUFOUT(653), 240, LTLN(1)) 01200000 WRITE (15, REC=IM, IOSTAT=ICODE) BUFOUT 01210000 C SCAN # 01220000 IS = II - 2 01230000 C PRINT 11, IS 01240003 11 FORMAT(1X,'SCAN NUMBER:', I10,/, 01250000 * 3X,'NO.', 9X,'LAT1', 9X, 'LNG1', 15X,'LAT2', 9X, 'LNG2', 01260000 * 11X,'LATN',9X,'LNGN',8X,'ROLL(D)',5X,'PITCH(D)',5X,'YAW(D)',/, 01270000 * 1X,120('-')) 01280000 C 01290000 C DO 29 J =1, 30 01300003 C PRINT 24,J, FLAT0(J), FLNG0(J), FLAT1(J), FLNG1(J), XLATC(J), 01310003 C * XLNGC(J), ROLLD(J), PITCHD(J), YAWD(J) 01320003 C 24 FORMAT(1X,I5, 6F15.5, 3F10.4) 01330003 C 29 CONTINUE 01340003 C------------------------------------------------------------- 01350000 C CALL ELC ROUTINE TO PERFORM EARTH LOCATION CORRECTION TO 2ND LINE 01352000 C 01353000 OFFSET = 1 01353100 CALL ELC(FLAT0,FLNG0,FLAT1,FLNG1,ROLLR,PITCHR,YAWR,OFFSET, 01354000 . XLATC,XLNGC) 01355000 C 01356000 C CONVERT XLATC, XLNGC TO DEGREE 01357000 DO N = 1, 30 01358000 XLATC(N) = XLATC(N) * RTODEG 01359000 C ADJUST BY SCALING FACTOR AND CONVERT TO INTEGER*4 01359100 LATC(N) = XLATC(N)*1.D04 01359200 LTLN(2*N-1) = LATC(N) 01359300 XLNGC(N) = XLNGC(N) * RTODEG 01359400 C ADJUST BY SCALING FACTOR AND CONVERT TO INTEGER*4 01359500 LNGC(N) = XLNGC(N)*1.D04 01359600 LTLN(2*N) = LNGC(N) 01359700 ENDDO 01359800 C 01359900 C PUTBACK NEW LAT & LON TO RECORD II 01360000 C 01360100 IM = II 01360200 CALL FMOVE(BUFOUT(653), 240, LTLN(1)) 01360300 WRITE (15, REC=IM, IOSTAT=ICODE) BUFOUT 01360400 C SCAN # 01360500 IS = II-1 01360600 C PRINT 11, IS 01360703 C 01361200 C DO 39 J =1, 30 01361303 C PRINT 24,J, FLAT0(J), FLNG0(J), FLAT1(J), FLNG1(J), XLATC(J), 01361403 C * XLNGC(J), ROLLD(J), PITCHD(J), YAWD(J) 01361503 C 39 CONTINUE 01361703 C 01380000 101 CONTINUE 01390000 C 01400000 1034 FORMAT(1X, I5,2F20.10,9X,2F20.10,F15.8) 01410000 70 CONTINUE 01420000 C ERROR FOUND 01420100 77 CONTINUE 01420200 PRINT 34, ICODE, II 01420300 34 FORMAT(1X, 'ERROR CODE IS=', I5, ' WHEN READ RECORD #=', I10) 01420400 C END OF RUN 01420500 99 CONTINUE 01421000 PRINT 37, II 01422000 37 FORMAT (1X, 'TOTAL RECORD PROCESSED=', I10) 01423000 STOP 01430000 END 01440000