G2WDZ.inc
References to this file elsewhere.
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