var/convertor/wave2grid_kma/Einc_to_Ganl.inc

   1          SUBROUTINE Einc_to_Ganl        !shc start
   2      1   (DPSE,DUE,DVE,DTE,DQE,
   3      2     PSB, UB, VB, TB, QB,
   4      3     PSG, UG, VG, TG, QG,
   5      4     IMAX,JMAX,IMAXE,JMAXE,KMAX,MAXJZ)
   6       INTEGER IDATE(5), IDGES(5), IDSST(5)
   7       CHARACTER*8 FILE, MODEL, RESL
   8       CHARACTER*80 CINF(10)
   9       CHARACTER*4 TYPE, EXPR, KTUNIT, NPROD, NPROM, VCODD, VCODM
  10       CHARACTER*4 LEVEL, ELEM
  11       CHARACTER*32 TITLE
  12       CHARACTER*16 UNIT
  13       CHARACTER*8 MDLINF(4)
  14       REAL        DTHPRO(7)
  15       INTEGER ITYP(2)
  16       CHARACTER*48 LABEL
  17       INTEGER JTINF(2)
  18           CHARACTER*10  FROMUNPACK
  19           INTEGER               IUNPACK
  20 C
  21       DIMENSION GPHIS(IMAX*JMAX)
  22       REAL, DIMENSION(IMAX,JMAX)    :: GAU
  23
  24       DIMENSION DPSE (IMAXE,JMAXE),
  25      1       DUE (IMAXE,JMAXE,KMAX), DVE  (IMAXE,JMAXE,KMAX),
  26      2       DTE (IMAXE,JMAXE,KMAX), DQE  (IMAXE,JMAXE,KMAX)
  27       DIMENSION DPSG (IMAX,JMAX),
  28      1       DUG (IMAX,JMAX,KMAX), DVG  (IMAX,JMAX,KMAX),
  29      2       DTG (IMAX,JMAX,KMAX), DQG  (IMAX,JMAX,KMAX)
  30       DIMENSION PSB (IMAX,JMAX),
  31      1       UB (IMAX,JMAX,KMAX), VB  (IMAX,JMAX,KMAX),
  32      2       TB (IMAX,JMAX,KMAX), QB  (IMAX,JMAX,KMAX)
  33       DIMENSION PSG (IMAX,JMAX),
  34      1       UG (IMAX,JMAX,KMAX), VG  (IMAX,JMAX,KMAX),
  35      2       TG (IMAX,JMAX,KMAX), QG  (IMAX,JMAX,KMAX)
  36
  37       DIMENSION COLRAD(JMAX), DY(JMAX), LY(JMAX)
  38       REAL*8    GAUL(JMAX),GAUW(JMAX),COCOT(JMAX)
  39       DIMENSION RLAT(MAXJZ), ZDAT(MAXJZ,KMAX)
  40 C   =================================================================
  41 C   >>>   GENERATE GAUSSIAN LATITUDES                             <<<
  42 C   =================================================================
  43       CALL GAUSS(GAUL,GAUW,JMAX)
  44       DO 800 J=1,JMAX
  45       COLRAD(J)=ACOS(GAUL(J))
  46   800 CONTINUE
  47       CALL ZMNLAT( RLAT, MAXJZ, COLRAD, JMAX )
  48 C
  49 C---------------------------------------------------------------------
  50 C +++ CONVERT LAT/LON to GAUSS
  51 C---------------------------------------------------------------------
  52         CALL LT2GAU (DPSE,IMAXE,JMAXE,IMAX,JMAX,
  53      1                  COLRAD,DPSG,DY,LY)
  54        DO K = 1, KMAX
  55         CALL LT2GAU (DTE(:,:,K),IMAXE,JMAXE,IMAX,JMAX,
  56      1                  COLRAD,DTG(:,:,K),DY,LY)
  57         CALL LT2GAU (DUE(:,:,K),IMAXE,JMAXE,IMAX,JMAX,
  58      1                  COLRAD,DUG(:,:,K),DY,LY)
  59         CALL LT2GAU (DVE(:,:,K),IMAXE,JMAXE,IMAX,JMAX,
  60      1                  COLRAD,DVG(:,:,K),DY,LY)
  61         CALL LT2GAU (DQE(:,:,K),IMAXE,JMAXE,IMAX,JMAX,
  62      1                  COLRAD,DQG(:,:,K),DY,LY)
  63        ENDDO
  64 C---------------------------------------------------------------------
  65 C +++ ANAL = INCR + BACKG
  66 C---------------------------------------------------------------------
  67        DO I=1,IMAX
  68        DO J=1,JMAX
  69         PSG(I,J)=DPSG(I,J)+PSB(I,J)
  70        DO K=1,KMAX
  71         UG(I,J,K)=DUG(I,J,K)+UB(I,J,K)
  72         VG(I,J,K)=DVG(I,J,K)+VB(I,J,K)
  73         TG(I,J,K)=DTG(I,J,K)+TB(I,J,K)
  74         QG(I,J,K)=DQG(I,J,K)+QB(I,J,K)
  75        ENDDO
  76        ENDDO
  77        ENDDO
  78 C
  79       END SUBROUTINE Einc_to_Ganl       !shc end