var/convertor/kma_wave2grid/G2WDZ.inc

   1       SUBROUTINE G2WDZ
   2      I(MEND1,NEND1 ,JEND1,MNWAV,IMAX,JMAX  ,IMX ,JMAXHF,KMAX ,
   3      I PNMGC,DPNMGC,GU   ,GV   ,ER  ,SINCLT,IFAX,TRIGS,
   4      O QROT ,QDIV ,
   5      W GWRK)
   6 C
   7       DIMENSION QROT  (2,KMAX,MNWAV),QDIV  (2,KMAX,MNWAV)
   8       DIMENSION DPNMGC(MNWAV,JMAXHF),PNMGC (MNWAV,JMAXHF),SINCLT(JMAX)
   9       DIMENSION GU  (IMAX,JMAX,KMAX),GV    (IMAX,JMAX,KMAX)
  10       DIMENSION GWRK(IMX,JMAX,KMAX),IFAX(10),TRIGS(IMAX)
  11 C
  12       ERIV=1.0/ER
  13       LOT =JMAX*KMAX
  14       CALL FFT991(GU,TRIGS,IFAX,1,IMX,IMAX,LOT,-1)
  15       CALL FFT991(GV,TRIGS,IFAX,1,IMX,IMAX,LOT,-1)
  16 C     CALL FFT991(GU  ,GWRK,TRIGS,IFAX,1,IMX,IMAX,LOT,-1)
  17 C     CALL FFT991(GV  ,GWRK,TRIGS,IFAX,1,IMX,IMAX,LOT,-1)
  18 C
  19       CALL RESET(QROT,2*KMAX*MNWAV)
  20       CALL RESET(QDIV,2*KMAX*MNWAV)
  21 C
  22       DO 100 K=1,KMAX
  23 C
  24       DO 120 J=1,JMAXHF
  25       JM=J
  26       JP=JMAX+1-J
  27       ASINCL=ERIV*SINCLT(J)
  28       IF(MOD(JMAX,2).EQ.1.AND.J.EQ.JMAXHF) THEN
  29       DO 140 M=1,MEND1*2
  30       GWRK(M,JM,1)=ASINCL*(GU(M,JM,K)+GU(M,JP,K))
  31       GWRK(M,JM,2)=ASINCL*(GV(M,JM,K)+GV(M,JP,K))
  32   140 CONTINUE
  33       ELSE
  34       DO 160 M=1,MEND1*2
  35       GWRK(M,JM,1)=ASINCL*(GU(M,JM,K)+GU(M,JP,K))
  36       GWRK(M,JP,1)=ASINCL*(GU(M,JM,K)-GU(M,JP,K))
  37       GWRK(M,JM,2)=ASINCL*(GV(M,JM,K)+GV(M,JP,K))
  38       GWRK(M,JP,2)=ASINCL*(GV(M,JM,K)-GV(M,JP,K))
  39   160 CONTINUE
  40       END IF
  41   120 CONTINUE
  42 C
  43       L =0
  44       DO 200 M=1,MEND1
  45       QM  =FLOAT(M-1)
  46       NMAX=MIN(JEND1+1-M,NEND1)
  47       DO 220 N=1,NMAX
  48       IF(MOD(N-1,2).EQ.0) THEN
  49       DO 240 J=1,JMAXHF
  50       JM=       J
  51       JP=JMAX+1-J
  52       QROT(1,K,L+N)=QROT(1,K,L+N)-QM*GWRK(2*M  ,JM,2)* PNMGC(L+N,J)
  53      1                           -   GWRK(2*M-1,JP,1)*DPNMGC(L+N,J)
  54       QROT(2,K,L+N)=QROT(2,K,L+N)+QM*GWRK(2*M-1,JM,2)* PNMGC(L+N,J)
  55      1                           -   GWRK(2*M  ,JP,1)*DPNMGC(L+N,J)
  56       QDIV(1,K,L+N)=QDIV(1,K,L+N)-QM*GWRK(2*M  ,JM,1)* PNMGC(L+N,J)
  57      1                           +   GWRK(2*M-1,JP,2)*DPNMGC(L+N,J)
  58       QDIV(2,K,L+N)=QDIV(2,K,L+N)+QM*GWRK(2*M-1,JM,1)* PNMGC(L+N,J)
  59      1                           +   GWRK(2*M  ,JP,2)*DPNMGC(L+N,J)
  60   240 CONTINUE
  61       ELSE
  62       DO 260 J=1,JMAXHF
  63       JM=       J
  64       JP=JMAX+1-J
  65       QROT(1,K,L+N)=QROT(1,K,L+N)-QM*GWRK(2*M  ,JP,2)* PNMGC(L+N,J)
  66      1                           -   GWRK(2*M-1,JM,1)*DPNMGC(L+N,J)
  67       QROT(2,K,L+N)=QROT(2,K,L+N)+QM*GWRK(2*M-1,JP,2)* PNMGC(L+N,J)
  68      1                           -   GWRK(2*M  ,JM,1)*DPNMGC(L+N,J)
  69       QDIV(1,K,L+N)=QDIV(1,K,L+N)-QM*GWRK(2*M  ,JP,1)* PNMGC(L+N,J)
  70      1                           +   GWRK(2*M-1,JM,2)*DPNMGC(L+N,J)
  71       QDIV(2,K,L+N)=QDIV(2,K,L+N)+QM*GWRK(2*M-1,JP,1)* PNMGC(L+N,J)
  72      1                           +   GWRK(2*M  ,JM,2)*DPNMGC(L+N,J)
  73   260 CONTINUE
  74       END IF
  75   220 CONTINUE
  76       L=L+NMAX
  77   200 CONTINUE
  78 C
  79   100 CONTINUE
  80 C
  81       RETURN
  82       END SUBROUTINE G2WDZ
  83