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
