G2WPP.inc
References to this file elsewhere.
1 SUBROUTINE G2WPP
2 1(MEND1 ,NEND1 ,JEND1 ,KQS,KQE ,KQMAX ,MNWAV ,JBLK1,JBLK2 ,
3 2 PNM,WDATA,DATA )
4 C IMPLICIT DOUBLE PRECISION (A-H,O-Z,\)
5 C
6 DIMENSION PNM(MNWAV,JBLK1)
7 DIMENSION DATA(KQMAX,MEND1,JBLK2),WDATA(KQMAX,MNWAV)
8 C
9 NJ=JBLK1/8
10 JREM=MOD(JBLK1,8)
11 L=0
12 DO 300 M=1,MEND1
13 NMAX=MIN(NEND1,JEND1+1-M)
14 J0=0
15 DO 310 IJ=1,NJ
16 DO 320 N=2,NMAX,2
17 *vdir nodep
18 DO 330 K=KQS,KQE
19 C WRITE (6,*) 'G2WPP:K,KQS,KQE',K,KQS,KQE
20 WDATA(K,L+N-1)=WDATA(K,L+N-1)
21 1 +PNM(L+N-1,J0+1)*DATA(K,M,J0+ 1)
22 1 +PNM(L+N-1,J0+2)*DATA(K,M,J0+ 2)
23 1 +PNM(L+N-1,J0+3)*DATA(K,M,J0+ 3)
24 1 +PNM(L+N-1,J0+4)*DATA(K,M,J0+ 4)
25 1 +PNM(L+N-1,J0+5)*DATA(K,M,J0+ 5)
26 1 +PNM(L+N-1,J0+6)*DATA(K,M,J0+ 6)
27 1 +PNM(L+N-1,J0+7)*DATA(K,M,J0+ 7)
28 1 +PNM(L+N-1,J0+8)*DATA(K,M,J0+ 8)
29 WDATA(K,L+N )=WDATA(K,L+N )
30 1 +PNM(L+N,J0+1)*DATA(K,M,JBLK1+J0+ 1)
31 1 +PNM(L+N,J0+2)*DATA(K,M,JBLK1+J0+ 2)
32 1 +PNM(L+N,J0+3)*DATA(K,M,JBLK1+J0+ 3)
33 1 +PNM(L+N,J0+4)*DATA(K,M,JBLK1+J0+ 4)
34 1 +PNM(L+N,J0+5)*DATA(K,M,JBLK1+J0+ 5)
35 1 +PNM(L+N,J0+6)*DATA(K,M,JBLK1+J0+ 6)
36 1 +PNM(L+N,J0+7)*DATA(K,M,JBLK1+J0+ 7)
37 1 +PNM(L+N,J0+8)*DATA(K,M,JBLK1+J0+ 8)
38 330 CONTINUE
39 320 CONTINUE
40 IF(MOD(NMAX,2).NE.0) THEN
41 DO 340 K=KQS,KQE
42 WDATA(K,L+NMAX )=WDATA(K,L+NMAX )
43 1 +PNM(L+NMAX,J0+1)*DATA(K,M,J0+ 1)
44 1 +PNM(L+NMAX,J0+2)*DATA(K,M,J0+ 2)
45 1 +PNM(L+NMAX,J0+3)*DATA(K,M,J0+ 3)
46 1 +PNM(L+NMAX,J0+4)*DATA(K,M,J0+ 4)
47 1 +PNM(L+NMAX,J0+5)*DATA(K,M,J0+ 5)
48 1 +PNM(L+NMAX,J0+6)*DATA(K,M,J0+ 6)
49 1 +PNM(L+NMAX,J0+7)*DATA(K,M,J0+ 7)
50 1 +PNM(L+NMAX,J0+8)*DATA(K,M,J0+ 8)
51 340 CONTINUE
52 END IF
53 J0=J0+8
54 310 CONTINUE
55 IF (JREM.EQ.7) THEN
56 DO 350 N=2,NMAX,2
57 *vdir nodep
58 DO 360 K=KQS,KQE
59 WDATA(K,L+N-1)=WDATA(K,L+N-1)
60 1 +PNM(L+N-1,J0+1)*DATA(K,M,J0+ 1)
61 1 +PNM(L+N-1,J0+2)*DATA(K,M,J0+ 2)
62 1 +PNM(L+N-1,J0+3)*DATA(K,M,J0+ 3)
63 1 +PNM(L+N-1,J0+4)*DATA(K,M,J0+ 4)
64 1 +PNM(L+N-1,J0+5)*DATA(K,M,J0+ 5)
65 1 +PNM(L+N-1,J0+6)*DATA(K,M,J0+ 6)
66 1 +PNM(L+N-1,J0+7)*DATA(K,M,J0+ 7)
67 WDATA(K,L+N )=WDATA(K,L+N )
68 1 +PNM(L+N,J0+1)*DATA(K,M,JBLK1+J0+ 1)
69 1 +PNM(L+N,J0+2)*DATA(K,M,JBLK1+J0+ 2)
70 1 +PNM(L+N,J0+3)*DATA(K,M,JBLK1+J0+ 3)
71 1 +PNM(L+N,J0+4)*DATA(K,M,JBLK1+J0+ 4)
72 1 +PNM(L+N,J0+5)*DATA(K,M,JBLK1+J0+ 5)
73 1 +PNM(L+N,J0+6)*DATA(K,M,JBLK1+J0+ 6)
74 1 +PNM(L+N,J0+7)*DATA(K,M,JBLK1+J0+ 7)
75 360 CONTINUE
76 350 CONTINUE
77 IF(MOD(NMAX,2).NE.0) THEN
78 DO 370 K=KQS,KQE
79 WDATA(K,L+NMAX )=WDATA(K,L+NMAX )
80 1 +PNM(L+NMAX,J0+1)*DATA(K,M,J0+ 1)
81 1 +PNM(L+NMAX,J0+2)*DATA(K,M,J0+ 2)
82 1 +PNM(L+NMAX,J0+3)*DATA(K,M,J0+ 3)
83 1 +PNM(L+NMAX,J0+4)*DATA(K,M,J0+ 4)
84 1 +PNM(L+NMAX,J0+5)*DATA(K,M,J0+ 5)
85 1 +PNM(L+NMAX,J0+6)*DATA(K,M,J0+ 6)
86 1 +PNM(L+NMAX,J0+7)*DATA(K,M,J0+ 7)
87 370 CONTINUE
88 END IF
89 ELSE IF (JREM.EQ.6) THEN
90 DO 380 N=2,NMAX,2
91 *vdir nodep
92 DO 390 K=KQS,KQE
93 WDATA(K,L+N-1)=WDATA(K,L+N-1)
94 1 +PNM(L+N-1,J0+1)*DATA(K,M,J0+ 1)
95 1 +PNM(L+N-1,J0+2)*DATA(K,M,J0+ 2)
96 1 +PNM(L+N-1,J0+3)*DATA(K,M,J0+ 3)
97 1 +PNM(L+N-1,J0+4)*DATA(K,M,J0+ 4)
98 1 +PNM(L+N-1,J0+5)*DATA(K,M,J0+ 5)
99 1 +PNM(L+N-1,J0+6)*DATA(K,M,J0+ 6)
100 WDATA(K,L+N )=WDATA(K,L+N )
101 1 +PNM(L+N,J0+1)*DATA(K,M,JBLK1+J0+ 1)
102 1 +PNM(L+N,J0+2)*DATA(K,M,JBLK1+J0+ 2)
103 1 +PNM(L+N,J0+3)*DATA(K,M,JBLK1+J0+ 3)
104 1 +PNM(L+N,J0+4)*DATA(K,M,JBLK1+J0+ 4)
105 1 +PNM(L+N,J0+5)*DATA(K,M,JBLK1+J0+ 5)
106 1 +PNM(L+N,J0+6)*DATA(K,M,JBLK1+J0+ 6)
107 390 CONTINUE
108 380 CONTINUE
109 IF(MOD(NMAX,2).NE.0) THEN
110 DO 400 K=KQS,KQE
111 WDATA(K,L+NMAX )=WDATA(K,L+NMAX )
112 1 +PNM(L+NMAX,J0+1)*DATA(K,M,J0+ 1)
113 1 +PNM(L+NMAX,J0+2)*DATA(K,M,J0+ 2)
114 1 +PNM(L+NMAX,J0+3)*DATA(K,M,J0+ 3)
115 1 +PNM(L+NMAX,J0+4)*DATA(K,M,J0+ 4)
116 1 +PNM(L+NMAX,J0+5)*DATA(K,M,J0+ 5)
117 1 +PNM(L+NMAX,J0+6)*DATA(K,M,J0+ 6)
118 400 CONTINUE
119 END IF
120 ELSE IF (JREM.EQ.5) THEN
121 DO 410 N=2,NMAX,2
122 *vdir nodep
123 DO 420 K=KQS,KQE
124 WDATA(K,L+N-1)=WDATA(K,L+N-1)
125 1 +PNM(L+N-1,J0+1)*DATA(K,M,J0+ 1)
126 1 +PNM(L+N-1,J0+2)*DATA(K,M,J0+ 2)
127 1 +PNM(L+N-1,J0+3)*DATA(K,M,J0+ 3)
128 1 +PNM(L+N-1,J0+4)*DATA(K,M,J0+ 4)
129 1 +PNM(L+N-1,J0+5)*DATA(K,M,J0+ 5)
130 WDATA(K,L+N )=WDATA(K,L+N )
131 1 +PNM(L+N,J0+1)*DATA(K,M,JBLK1+J0+ 1)
132 1 +PNM(L+N,J0+2)*DATA(K,M,JBLK1+J0+ 2)
133 1 +PNM(L+N,J0+3)*DATA(K,M,JBLK1+J0+ 3)
134 1 +PNM(L+N,J0+4)*DATA(K,M,JBLK1+J0+ 4)
135 1 +PNM(L+N,J0+5)*DATA(K,M,JBLK1+J0+ 5)
136 420 CONTINUE
137 410 CONTINUE
138 IF(MOD(NMAX,2).NE.0) THEN
139 DO 430 K=KQS,KQE
140 WDATA(K,L+NMAX )=WDATA(K,L+NMAX )
141 1 +PNM(L+NMAX,J0+1)*DATA(K,M,J0+ 1)
142 1 +PNM(L+NMAX,J0+2)*DATA(K,M,J0+ 2)
143 1 +PNM(L+NMAX,J0+3)*DATA(K,M,J0+ 3)
144 1 +PNM(L+NMAX,J0+4)*DATA(K,M,J0+ 4)
145 1 +PNM(L+NMAX,J0+5)*DATA(K,M,J0+ 5)
146 430 CONTINUE
147 END IF
148 ELSE IF (JREM.EQ.4) THEN
149 DO 440 N=2,NMAX,2
150 *vdir nodep
151 DO 450 K=KQS,KQE
152 WDATA(K,L+N-1)=WDATA(K,L+N-1)
153 1 +PNM(L+N-1,J0+1)*DATA(K,M,J0+ 1)
154 1 +PNM(L+N-1,J0+2)*DATA(K,M,J0+ 2)
155 1 +PNM(L+N-1,J0+3)*DATA(K,M,J0+ 3)
156 1 +PNM(L+N-1,J0+4)*DATA(K,M,J0+ 4)
157 WDATA(K,L+N )=WDATA(K,L+N )
158 1 +PNM(L+N,J0+1)*DATA(K,M,JBLK1+J0+ 1)
159 1 +PNM(L+N,J0+2)*DATA(K,M,JBLK1+J0+ 2)
160 1 +PNM(L+N,J0+3)*DATA(K,M,JBLK1+J0+ 3)
161 1 +PNM(L+N,J0+4)*DATA(K,M,JBLK1+J0+ 4)
162 450 CONTINUE
163 440 CONTINUE
164 IF(MOD(NMAX,2).NE.0) THEN
165 DO 460 K=KQS,KQE
166 WDATA(K,L+NMAX )=WDATA(K,L+NMAX )
167 1 +PNM(L+NMAX,J0+1)*DATA(K,M,J0+ 1)
168 1 +PNM(L+NMAX,J0+2)*DATA(K,M,J0+ 2)
169 1 +PNM(L+NMAX,J0+3)*DATA(K,M,J0+ 3)
170 1 +PNM(L+NMAX,J0+4)*DATA(K,M,J0+ 4)
171 460 CONTINUE
172 END IF
173 ELSE IF (JREM.EQ.3) THEN
174 DO 470 N=2,NMAX,2
175 *vdir nodep
176 DO 480 K=KQS,KQE
177 WDATA(K,L+N-1)=WDATA(K,L+N-1)
178 1 +PNM(L+N-1,J0+1)*DATA(K,M,J0+ 1)
179 1 +PNM(L+N-1,J0+2)*DATA(K,M,J0+ 2)
180 1 +PNM(L+N-1,J0+3)*DATA(K,M,J0+ 3)
181 WDATA(K,L+N )=WDATA(K,L+N )
182 1 +PNM(L+N,J0+1)*DATA(K,M,JBLK1+J0+ 1)
183 1 +PNM(L+N,J0+2)*DATA(K,M,JBLK1+J0+ 2)
184 1 +PNM(L+N,J0+3)*DATA(K,M,JBLK1+J0+ 3)
185 480 CONTINUE
186 470 CONTINUE
187 IF(MOD(NMAX,2).NE.0) THEN
188 DO 490 K=KQS,KQE
189 WDATA(K,L+NMAX )=WDATA(K,L+NMAX )
190 1 +PNM(L+NMAX,J0+1)*DATA(K,M,J0+ 1)
191 1 +PNM(L+NMAX,J0+2)*DATA(K,M,J0+ 2)
192 1 +PNM(L+NMAX,J0+3)*DATA(K,M,J0+ 3)
193 490 CONTINUE
194 END IF
195 ELSE IF (JREM.EQ.2) THEN
196 DO 500 N=2,NMAX,2
197 *vdir nodep
198 DO 510 K=KQS,KQE
199 WDATA(K,L+N-1)=WDATA(K,L+N-1)
200 1 +PNM(L+N-1,J0+1)*DATA(K,M,J0+ 1)
201 1 +PNM(L+N-1,J0+2)*DATA(K,M,J0+ 2)
202 WDATA(K,L+N )=WDATA(K,L+N )
203 1 +PNM(L+N,J0+1)*DATA(K,M,JBLK1+J0+ 1)
204 1 +PNM(L+N,J0+2)*DATA(K,M,JBLK1+J0+ 2)
205 510 CONTINUE
206 500 CONTINUE
207 IF(MOD(NMAX,2).NE.0) THEN
208 DO 520 K=KQS,KQE
209 WDATA(K,L+NMAX )=WDATA(K,L+NMAX )
210 1 +PNM(L+NMAX,J0+1)*DATA(K,M,J0+ 1)
211 1 +PNM(L+NMAX,J0+2)*DATA(K,M,J0+ 2)
212 520 CONTINUE
213 END IF
214 ELSE IF (JREM.EQ.1) THEN
215 DO 530 N=2,NMAX,2
216 *vdir nodep
217 DO 540 K=KQS,KQE
218 WDATA(K,L+N-1)=WDATA(K,L+N-1)
219 1 +PNM(L+N-1,J0+1)*DATA(K,M,J0+ 1)
220 WDATA(K,L+N )=WDATA(K,L+N )
221 1 +PNM(L+N,J0+1)*DATA(K,M,JBLK1+J0+ 1)
222 540 CONTINUE
223 530 CONTINUE
224 IF(MOD(NMAX,2).NE.0) THEN
225 DO 550 K=KQS,KQE
226 WDATA(K,L+NMAX )=WDATA(K,L+NMAX )
227 1 +PNM(L+NMAX,J0+1)*DATA(K,M,J0+ 1)
228 550 CONTINUE
229 END IF
230 END IF
231 L=L+NMAX
232 300 CONTINUE
233 C
234 RETURN
235 END SUBROUTINE G2WPP
236