1 | MODULE solsor_tam |
---|
2 | !!====================================================================== |
---|
3 | !! *** MODULE solsor_tam *** |
---|
4 | !! NEMOVAR : Tangent linear .... |
---|
5 | !!====================================================================== |
---|
6 | |
---|
7 | !!---------------------------------------------------------------------- |
---|
8 | !! sol_sor_tan : Red-Black Successive Over-Relaxation solver TL |
---|
9 | !!---------------------------------------------------------------------- |
---|
10 | !! * Modules used |
---|
11 | USE par_kind , ONLY: & ! Precision variables |
---|
12 | & wp ! Variable kinds |
---|
13 | USE par_oce , ONLY: & |
---|
14 | & jpi, & |
---|
15 | & jpj, & |
---|
16 | & jpk, & |
---|
17 | & jpr2di, & |
---|
18 | & jpr2dj, & |
---|
19 | & jpiglo |
---|
20 | USE in_out_manager, ONLY: & ! I/O manager |
---|
21 | & nit000, lwp |
---|
22 | USE sol_oce , ONLY: & ! solver variables |
---|
23 | & gcdmat, & |
---|
24 | & rnorme, & |
---|
25 | & eps, & |
---|
26 | & epsr, & |
---|
27 | & nmax, & |
---|
28 | & nmin, & |
---|
29 | & ncut, & |
---|
30 | & nmod, & |
---|
31 | & res, & |
---|
32 | & resmax, & |
---|
33 | & gcp, & |
---|
34 | & sor, & |
---|
35 | & nsol_arp, & |
---|
36 | & c_solver_pt, & |
---|
37 | & niter |
---|
38 | USE lib_mpp , ONLY: & ! distributed memory computing |
---|
39 | & lk_mpp, & |
---|
40 | & mpp_max |
---|
41 | USE lbclnk , ONLY: & ! ocean lateral boundary conditions (or mpp link) |
---|
42 | & lbc_lnk_e |
---|
43 | USE gridsum , ONLY: & ! Global sums |
---|
44 | & global_sum |
---|
45 | USE lbclnk_tam ! ocean lateral boundary conditions (or mpp link) |
---|
46 | USE sol_oce_tam , ONLY: & ! solver variables (assimilation) |
---|
47 | & nitsor, & |
---|
48 | & gcx_tl, & |
---|
49 | & gcb_tl, & |
---|
50 | & gcr_tl, & |
---|
51 | & gcx_ad, & |
---|
52 | & gcb_ad |
---|
53 | USE dom_oce , ONLY: & ! ocean space and time domain |
---|
54 | & mig, & |
---|
55 | & mjg, & |
---|
56 | & nimpp, & |
---|
57 | & njmpp, & |
---|
58 | & e2t, & |
---|
59 | & e1t, & |
---|
60 | & tmask, & |
---|
61 | & nlci, & |
---|
62 | & nlcj, & |
---|
63 | & nldi, & |
---|
64 | & nldj, & |
---|
65 | & nlei, & |
---|
66 | & nlej |
---|
67 | USE gridrandom , ONLY: & ! Random Gaussian noise on grids |
---|
68 | & grid_random |
---|
69 | USE dotprodfld , ONLY: & ! Computes dot product for 3D and 2D fields |
---|
70 | & dot_product |
---|
71 | USE tstool_tam , ONLY: & |
---|
72 | & prntst_adj, & |
---|
73 | & stdgc, & |
---|
74 | & prntst_tlm |
---|
75 | |
---|
76 | |
---|
77 | IMPLICIT NONE |
---|
78 | PRIVATE |
---|
79 | |
---|
80 | !! * Routine accessibility |
---|
81 | PUBLIC sol_sor_adj ! |
---|
82 | PUBLIC sol_sor_tan ! |
---|
83 | PUBLIC sol_sor_adj_tst ! called by tamtst.F90 |
---|
84 | #if defined key_tst_tlm |
---|
85 | PUBLIC sol_sor_tlm_tst ! called by tamtst.F90 |
---|
86 | #endif |
---|
87 | |
---|
88 | CONTAINS |
---|
89 | |
---|
90 | SUBROUTINE sol_sor_tan( kt, kindic ) |
---|
91 | !!---------------------------------------------------------------------- |
---|
92 | !! *** ROUTINE sol_sor_tan : TL of sol_sor *** |
---|
93 | !! |
---|
94 | !! ** Purpose : Solve the ellipic equation for the barotropic stream |
---|
95 | !! function system (lk_dynspg_rl=T) or the transport divergence |
---|
96 | !! system (lk_dynspg_flt=T) using a red-black successive-over- |
---|
97 | !! relaxation method. |
---|
98 | !! In the former case, the barotropic stream function trend has a |
---|
99 | !! zero boundary condition along all coastlines (i.e. continent |
---|
100 | !! as well as islands) while in the latter the boundary condition |
---|
101 | !! specification is not required. |
---|
102 | !! This routine provides a MPI optimization to the existing solsor |
---|
103 | !! by reducing the number of call to lbc. |
---|
104 | !! |
---|
105 | !! ** Method : Successive-over-relaxation method using the red-black |
---|
106 | !! technique. The former technique used was not compatible with |
---|
107 | !! the north-fold boundary condition used in orca configurations. |
---|
108 | !! Compared to the classical sol_sor, this routine provides a |
---|
109 | !! mpp optimization by reducing the number of calls to lnc_lnk |
---|
110 | !! The solution is computed on a larger area and the boudary |
---|
111 | !! conditions only when the inside domain is reached. |
---|
112 | !! |
---|
113 | !! References : |
---|
114 | !! Madec et al. 1988, Ocean Modelling, issue 78, 1-6. |
---|
115 | !! Beare and Stevens 1997 Ann. Geophysicae 15, 1369-1377 |
---|
116 | !! |
---|
117 | !! History of the direct routine: |
---|
118 | !! ! 90-10 (G. Madec) Original code |
---|
119 | !! ! 91-11 (G. Madec) |
---|
120 | !! 7.1 ! 93-04 (G. Madec) time filter |
---|
121 | !! ! 96-05 (G. Madec) merge sor and pcg formulations |
---|
122 | !! 9.0 ! 03-04 (C. Deltel, G. Madec) Red-Black SOR in free form |
---|
123 | !! 9.0 ! 05-09 (R. Benshila, G. Madec) MPI optimization |
---|
124 | !! History of the T&A routine: |
---|
125 | !! ! 96-11 (A. Weaver) correction to preconditioning |
---|
126 | !! 8.2 ! 03-02 (C. Deltel) OPAVAR tangent-linear version |
---|
127 | !! 9.0 ! 07-09 (K. Mogensen) tangent of the 03-04 version |
---|
128 | !! 9.0 ! 09-02 (A. Vidard) tangent of the 05-09 version |
---|
129 | !!---------------------------------------------------------------------- |
---|
130 | !! * Arguments |
---|
131 | INTEGER, INTENT( in ) :: kt ! Current timestep. |
---|
132 | INTEGER, INTENT( inout ) :: kindic ! solver indicator, < 0 if the conver- |
---|
133 | ! ! gence is not reached: the model is |
---|
134 | ! ! stopped in step |
---|
135 | ! ! set to zero before the call of solsor |
---|
136 | !! * Local declarations |
---|
137 | INTEGER :: ji, jj, jn ! dummy loop indices |
---|
138 | INTEGER :: ishift, icount, istp |
---|
139 | REAL(wp) :: ztmp, zres, zres2 |
---|
140 | |
---|
141 | INTEGER :: ijmppodd, ijmppeven |
---|
142 | INTEGER :: ijpr2d |
---|
143 | !!---------------------------------------------------------------------- |
---|
144 | |
---|
145 | ijmppeven = MOD(nimpp+njmpp+jpr2di+jpr2dj ,2) |
---|
146 | ijmppodd = MOD(nimpp+njmpp+jpr2di+jpr2dj+1,2) |
---|
147 | ijpr2d = MAX(jpr2di,jpr2dj) |
---|
148 | icount = 0 |
---|
149 | ! ! ============== |
---|
150 | DO jn = 1, nmax ! Iterative loop |
---|
151 | ! ! ============== |
---|
152 | |
---|
153 | ! applied the lateral boundary conditions |
---|
154 | IF( MOD(icount,ijpr2d+1) == 0 ) CALL lbc_lnk_e( gcx_tl, c_solver_pt, 1.0_wp ) |
---|
155 | |
---|
156 | ! Residuals |
---|
157 | ! --------- |
---|
158 | |
---|
159 | ! Guess black update |
---|
160 | DO jj = 2-jpr2dj, nlcj - 1 + jpr2dj |
---|
161 | ishift = MOD( jj-ijmppodd-jpr2dj, 2 ) |
---|
162 | DO ji = 2-jpr2di+ishift, nlci - 1 + jpr2di, 2 |
---|
163 | ztmp = gcb_tl(ji ,jj ) & |
---|
164 | & - gcp(ji,jj,1) * gcx_tl(ji ,jj-1) & |
---|
165 | & - gcp(ji,jj,2) * gcx_tl(ji-1,jj ) & |
---|
166 | & - gcp(ji,jj,3) * gcx_tl(ji+1,jj ) & |
---|
167 | & - gcp(ji,jj,4) * gcx_tl(ji ,jj+1) |
---|
168 | ! Estimate of the residual |
---|
169 | zres = ztmp - gcx_tl(ji,jj) |
---|
170 | gcr_tl(ji,jj) = zres * gcdmat(ji,jj) * zres |
---|
171 | ! Guess update |
---|
172 | gcx_tl(ji,jj) = sor * ztmp + ( 1.0_wp - sor ) * gcx_tl(ji,jj) |
---|
173 | END DO |
---|
174 | END DO |
---|
175 | icount = icount + 1 |
---|
176 | |
---|
177 | ! applied the lateral boundary conditions |
---|
178 | IF( MOD(icount,ijpr2d+1) == 0 ) CALL lbc_lnk_e( gcx_tl, c_solver_pt, 1.0_wp ) |
---|
179 | |
---|
180 | ! Guess red update |
---|
181 | DO jj = 2-jpr2dj, nlcj-1+jpr2dj |
---|
182 | ishift = MOD( jj-ijmppeven-jpr2dj, 2 ) |
---|
183 | DO ji = 2-jpr2di+ishift, nlci-1+jpr2di, 2 |
---|
184 | ztmp = gcb_tl(ji ,jj ) & |
---|
185 | & - gcp(ji,jj,1) * gcx_tl(ji ,jj-1) & |
---|
186 | & - gcp(ji,jj,2) * gcx_tl(ji-1,jj ) & |
---|
187 | & - gcp(ji,jj,3) * gcx_tl(ji+1,jj ) & |
---|
188 | & - gcp(ji,jj,4) * gcx_tl(ji ,jj+1) |
---|
189 | ! Estimate of the residual |
---|
190 | zres = ztmp - gcx_tl(ji,jj) |
---|
191 | gcr_tl(ji,jj) = zres * gcdmat(ji,jj) * zres |
---|
192 | ! Guess update |
---|
193 | gcx_tl(ji,jj) = sor * ztmp + ( 1.0_wp - sor ) * gcx_tl(ji,jj) |
---|
194 | END DO |
---|
195 | END DO |
---|
196 | icount = icount + 1 |
---|
197 | |
---|
198 | ! test of convergence |
---|
199 | IF ( (jn > nmin .AND. MOD( jn-nmin, nmod ) == 0) .OR. jn==nmax) THEN |
---|
200 | |
---|
201 | SELECT CASE ( nsol_arp ) |
---|
202 | CASE ( 0 ) |
---|
203 | ! absolute precision (maximum value of the residual) |
---|
204 | zres2 = MAXVAL( gcr_tl(2:nlci - 1,2:nlcj - 1) ) |
---|
205 | IF( lk_mpp ) CALL mpp_max( zres2 ) ! max over the global domain |
---|
206 | ! test of convergence |
---|
207 | IF( zres2 < resmax .OR. jn == nmax ) THEN |
---|
208 | res = SQRT( zres2 ) |
---|
209 | niter = jn |
---|
210 | ncut = 999 |
---|
211 | ! Store number of iterations for adjoint computation |
---|
212 | istp = kt - nit000 + 1 |
---|
213 | nitsor(istp) = niter |
---|
214 | ENDIF |
---|
215 | CASE ( 1 ) ! relative precision |
---|
216 | ! rnorme = SUM( gcr_tl(2:nlci - 1,2:nlcj - 1) ) |
---|
217 | ! IF( lk_mpp ) CALL mpp_sum( rnorme ) ! sum over global domain |
---|
218 | rnorme = global_sum(gcr_tl) |
---|
219 | ! test of convergence |
---|
220 | IF( rnorme < epsr .OR. jn == nmax ) THEN |
---|
221 | res = SQRT( rnorme ) |
---|
222 | niter = jn |
---|
223 | ncut = 999 |
---|
224 | ! Store number of iterations for adjoint computation |
---|
225 | istp = kt - nit000 + 1 |
---|
226 | nitsor(istp) = niter |
---|
227 | ENDIF |
---|
228 | END SELECT |
---|
229 | |
---|
230 | !**** |
---|
231 | ! IF(lwp)WRITE(numsol,9300) jn, res, sqrt( epsr ) / eps |
---|
232 | !9300 FORMAT(' niter :',i6,' res :',e20.10,' b :',e20.10) |
---|
233 | !**** |
---|
234 | |
---|
235 | ENDIF |
---|
236 | ! indicator of non-convergence or explosion |
---|
237 | IF( jn == nmax ) nitsor(istp) = jn |
---|
238 | IF( jn == nmax .OR. SQRT(epsr)/eps > 1.e+20 ) kindic = -2 |
---|
239 | IF( ncut == 999 ) GOTO 999 |
---|
240 | |
---|
241 | ! ! ===================== |
---|
242 | END DO ! END of iterative loop |
---|
243 | ! ! ===================== |
---|
244 | |
---|
245 | 999 CONTINUE |
---|
246 | |
---|
247 | ! Output in gcx_tl |
---|
248 | ! ---------------- |
---|
249 | |
---|
250 | CALL lbc_lnk_e( gcx_tl, c_solver_pt, 1.0_wp ) ! Lateral BCs |
---|
251 | |
---|
252 | END SUBROUTINE sol_sor_tan |
---|
253 | SUBROUTINE sol_sor_adj( kt, kindic ) |
---|
254 | !!---------------------------------------------------------------------- |
---|
255 | !! *** ROUTINE sol_sor_adj : adjoint of sol_sor *** |
---|
256 | !! |
---|
257 | !! ** Purpose : Solve the ellipic equation for the barotropic stream |
---|
258 | !! function system (lk_dynspg_rl=T) or the transport divergence |
---|
259 | !! system (lk_dynspg_flt=T) using a red-black successive-over- |
---|
260 | !! relaxation method. |
---|
261 | !! In the former case, the barotropic stream function trend has a |
---|
262 | !! zero boundary condition along all coastlines (i.e. continent |
---|
263 | !! as well as islands) while in the latter the boundary condition |
---|
264 | !! specification is not required. |
---|
265 | !! This routine provides a MPI optimization to the existing solsor |
---|
266 | !! by reducing the number of call to lbc. |
---|
267 | !! |
---|
268 | !! ** Method : Successive-over-relaxation method using the red-black |
---|
269 | !! technique. The former technique used was not compatible with |
---|
270 | !! the north-fold boundary condition used in orca configurations. |
---|
271 | !! Compared to the classical sol_sor, this routine provides a |
---|
272 | !! mpp optimization by reducing the number of calls to lbc_lnk |
---|
273 | !! The solution is computed on a larger area and the boudary |
---|
274 | !! conditions only when the inside domain is reached. |
---|
275 | !! ** Comments on adjoint routine : |
---|
276 | !! When the step in a tangent-linear DO loop is an arbitrary |
---|
277 | !! integer then care must be taken in computing the lower bound |
---|
278 | !! of the adjoint DO loop; i.e., |
---|
279 | !! |
---|
280 | !! If the tangent-linear DO loop is: low_tl, up_tl, step |
---|
281 | !! |
---|
282 | !! then the adjoint DO loop is: low_ad, up_ad, -step |
---|
283 | !! |
---|
284 | !! where low_ad = low_tl + step * INT( ( up_tl - low_tl ) / step ) |
---|
285 | !! up_ad = low_tl |
---|
286 | !! |
---|
287 | !! NB. If step = 1 then low_ad = up_tl |
---|
288 | !! |
---|
289 | !! References : |
---|
290 | !! Madec et al. 1988, Ocean Modelling, issue 78, 1-6. |
---|
291 | !! Beare and Stevens 1997 Ann. Geophysicae 15, 1369-1377 |
---|
292 | !! |
---|
293 | !! History of the direct routine: |
---|
294 | !! ! 90-10 (G. Madec) Original code |
---|
295 | !! ! 91-11 (G. Madec) |
---|
296 | !! 7.1 ! 93-04 (G. Madec) time filter |
---|
297 | !! ! 96-05 (G. Madec) merge sor and pcg formulations |
---|
298 | !! 9.0 ! 03-04 (C. Deltel, G. Madec) Red-Black SOR in free form |
---|
299 | !! 9.0 ! 05-09 (R. Benshila, G. Madec) MPI optimization |
---|
300 | !! History of the T&A routine: |
---|
301 | !! ! 96-11 (A. Weaver) correction to preconditioning |
---|
302 | !! 8.2 ! 03-02 (C. Deltel) OPAVAR tangent-linear version |
---|
303 | !! 9.0 ! 07-09 (K. Mogensen, A. Weaver) adjoint of the 03-04 version |
---|
304 | !! 9.0 ! 09-02 (A. Vidard) adjoint of the 05-09 version |
---|
305 | !!---------------------------------------------------------------------- |
---|
306 | !! * Arguments |
---|
307 | INTEGER, INTENT( in ) :: kt ! Current timestep. |
---|
308 | INTEGER, INTENT( inout ) :: kindic ! solver indicator, < 0 if the conver- |
---|
309 | ! ! gence is not reached: the model is |
---|
310 | ! ! stopped in step |
---|
311 | ! ! set to zero before the call of solsor |
---|
312 | !! * Local declarations |
---|
313 | INTEGER :: ji, jj, jn ! dummy loop indices |
---|
314 | INTEGER :: ishift, icount, istp, iter, ilower |
---|
315 | REAL(wp) :: ztmp, zres, zres2 |
---|
316 | |
---|
317 | INTEGER :: ijmppodd, ijmppeven |
---|
318 | INTEGER :: ijpr2d |
---|
319 | !!---------------------------------------------------------------------- |
---|
320 | |
---|
321 | ijmppeven = MOD(nimpp+njmpp+jpr2di+jpr2dj,2) |
---|
322 | ijmppodd = MOD(nimpp+njmpp+jpr2di+jpr2dj+1,2) |
---|
323 | ijpr2d = MAX(jpr2di,jpr2dj) |
---|
324 | |
---|
325 | ! Fixed number of iterations |
---|
326 | istp = kt - nit000 + 1 |
---|
327 | iter = nitsor(istp) |
---|
328 | icount = iter * 2 |
---|
329 | ! Output in gcx_ad |
---|
330 | ! ---------------- |
---|
331 | |
---|
332 | CALL lbc_lnk_e_adj( gcx_ad, c_solver_pt, 1.0_wp ) ! Lateral BCs |
---|
333 | |
---|
334 | ! ! ============== |
---|
335 | DO jn = iter, 1, -1 ! Iterative loop |
---|
336 | ! ! ============== |
---|
337 | ! Guess red update |
---|
338 | DO jj = nlcj-1+jpr2dj, 2-jpr2dj, -1 |
---|
339 | ishift = MOD( jj-ijmppeven-jpr2dj, 2 ) |
---|
340 | ilower = 2-jpr2dj+ishift + 2 * INT( ( ( nlci-1+jpr2dj )-( 2-jpr2dj+ishift ) ) / 2 ) |
---|
341 | DO ji = ilower, 2-jpr2dj+ishift, -2 |
---|
342 | gcb_ad(ji ,jj ) = gcb_ad(ji ,jj ) + sor * gcx_ad(ji,jj) |
---|
343 | gcx_ad(ji ,jj-1) = gcx_ad(ji ,jj-1) - sor * gcx_ad(ji,jj) & |
---|
344 | & * gcp(ji,jj,1) |
---|
345 | gcx_ad(ji-1,jj ) = gcx_ad(ji-1,jj ) - sor * gcx_ad(ji,jj) & |
---|
346 | & * gcp(ji,jj,2) |
---|
347 | gcx_ad(ji+1,jj ) = gcx_ad(ji+1,jj ) - sor * gcx_ad(ji,jj) & |
---|
348 | & * gcp(ji,jj,3) |
---|
349 | gcx_ad(ji ,jj+1) = gcx_ad(ji ,jj+1) - sor * gcx_ad(ji,jj) & |
---|
350 | & * gcp(ji,jj,4) |
---|
351 | gcx_ad(ji ,jj ) = gcx_ad(ji ,jj ) * ( 1.0_wp - sor ) |
---|
352 | END DO |
---|
353 | END DO |
---|
354 | icount = icount - 1 |
---|
355 | ! applied the lateral boundary conditions |
---|
356 | IF( MOD(icount,ijpr2d+1) == 0 ) CALL lbc_lnk_e_adj( gcx_ad, c_solver_pt, 1.0_wp ) ! Lateral BCs |
---|
357 | |
---|
358 | ! Residus |
---|
359 | ! ------- |
---|
360 | |
---|
361 | ! Guess black update |
---|
362 | DO jj = nlcj - 1+jpr2dj, 2-jpr2dj, -1 |
---|
363 | ishift = MOD( jj-ijmppodd-jpr2dj, 2 ) |
---|
364 | ilower = 2-jpr2dj+ishift + 2 * INT( ( ( nlci-1+jpr2dj )-( 2-jpr2dj+ishift ) ) / 2 ) |
---|
365 | DO ji = ilower, 2-jpr2dj+ishift, -2 |
---|
366 | gcb_ad(ji ,jj ) = gcb_ad(ji ,jj ) + sor * gcx_ad(ji,jj) |
---|
367 | gcx_ad(ji ,jj-1) = gcx_ad(ji ,jj-1) - sor * gcx_ad(ji,jj) & |
---|
368 | & * gcp(ji,jj,1) |
---|
369 | gcx_ad(ji-1,jj ) = gcx_ad(ji-1,jj ) - sor * gcx_ad(ji,jj) & |
---|
370 | & * gcp(ji,jj,2) |
---|
371 | gcx_ad(ji+1,jj ) = gcx_ad(ji+1,jj ) - sor * gcx_ad(ji,jj) & |
---|
372 | & * gcp(ji,jj,3) |
---|
373 | gcx_ad(ji ,jj+1) = gcx_ad(ji ,jj+1) - sor * gcx_ad(ji,jj) & |
---|
374 | & * gcp(ji,jj,4) |
---|
375 | gcx_ad(ji ,jj ) = gcx_ad(ji ,jj ) * ( 1.0_wp - sor ) |
---|
376 | END DO |
---|
377 | END DO |
---|
378 | |
---|
379 | icount = icount - 1 |
---|
380 | ! applied the lateral boundary conditions |
---|
381 | IF( MOD(icount,ijpr2d+1) == 0 ) CALL lbc_lnk_e_adj( gcx_ad, c_solver_pt, 1.0_wp ) ! Lateral BCs |
---|
382 | |
---|
383 | ! ! ===================== |
---|
384 | END DO ! END of iterative loop |
---|
385 | ! ! ===================== |
---|
386 | |
---|
387 | END SUBROUTINE sol_sor_adj |
---|
388 | SUBROUTINE sol_sor_adj_tst( kumadt ) |
---|
389 | !!----------------------------------------------------------------------- |
---|
390 | !! |
---|
391 | !! *** ROUTINE example_adj_tst *** |
---|
392 | !! |
---|
393 | !! ** Purpose : Test the adjoint routine. |
---|
394 | !! |
---|
395 | !! ** Method : Verify the scalar product |
---|
396 | !! |
---|
397 | !! ( L dx )^T W dy = dx^T L^T W dy |
---|
398 | !! |
---|
399 | !! where L = tangent routine |
---|
400 | !! L^T = adjoint routine |
---|
401 | !! W = diagonal matrix of scale factors |
---|
402 | !! dx = input perturbation (random field) |
---|
403 | !! dy = L dx |
---|
404 | !! |
---|
405 | !! |
---|
406 | !! History : |
---|
407 | !! ! 08-08 (A. Vidard) |
---|
408 | !!----------------------------------------------------------------------- |
---|
409 | !! * Modules used |
---|
410 | |
---|
411 | !! * Arguments |
---|
412 | INTEGER, INTENT(IN) :: & |
---|
413 | & kumadt ! Output unit |
---|
414 | |
---|
415 | !! * Local declarations |
---|
416 | INTEGER :: & |
---|
417 | & ji, & ! dummy loop indices |
---|
418 | & jj, & |
---|
419 | & jk, & |
---|
420 | & kindic,& ! flags fo solver convergence |
---|
421 | & kmod, & ! frequency of test for the SOR solver |
---|
422 | & kt ! number of iteration |
---|
423 | INTEGER, DIMENSION(jpi,jpj) :: & |
---|
424 | & iseed_2d ! 2D seed for the random number generator |
---|
425 | REAL(KIND=wp) :: & |
---|
426 | & zsp1, & ! scalar product involving the tangent routine |
---|
427 | & zsp2 ! scalar product involving the adjoint routine |
---|
428 | REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: & |
---|
429 | & zgcb_tlin , & ! Tangent input |
---|
430 | & zgcx_tlin , & ! Tangent input |
---|
431 | & zgcx_tlout, & ! Tangent output |
---|
432 | & zgcx_adin , & ! Adjoint input |
---|
433 | & zgcb_adout, & ! Adjoint output |
---|
434 | & zgcx_adout, & ! Adjoint output |
---|
435 | & zr ! 3D random field |
---|
436 | CHARACTER(LEN=14) :: cl_name |
---|
437 | ! Allocate memory |
---|
438 | |
---|
439 | |
---|
440 | ALLOCATE( & |
---|
441 | & zgcb_tlin( jpi,jpj), & |
---|
442 | & zgcx_tlin( jpi,jpj), & |
---|
443 | & zgcx_tlout(jpi,jpj), & |
---|
444 | & zgcx_adin( jpi,jpj), & |
---|
445 | & zgcx_adout(jpi,jpj), & |
---|
446 | & zgcb_adout(jpi,jpj), & |
---|
447 | & zr( jpi,jpj) & |
---|
448 | & ) |
---|
449 | !================================================================== |
---|
450 | ! 1) dx = ( un_tl, vn_tl, hdivn_tl ) and |
---|
451 | ! dy = ( hdivb_tl, hdivn_tl ) |
---|
452 | !================================================================== |
---|
453 | |
---|
454 | !-------------------------------------------------------------------- |
---|
455 | ! Reset the tangent and adjoint variables |
---|
456 | !-------------------------------------------------------------------- |
---|
457 | zgcb_tlin( :,:) = 0.0_wp |
---|
458 | zgcx_tlin( :,:) = 0.0_wp |
---|
459 | zgcx_tlout(:,:) = 0.0_wp |
---|
460 | zgcx_adin( :,:) = 0.0_wp |
---|
461 | zgcx_adout(:,:) = 0.0_wp |
---|
462 | zgcb_adout(:,:) = 0.0_wp |
---|
463 | zr( :,:) = 0.0_wp |
---|
464 | !-------------------------------------------------------------------- |
---|
465 | ! Initialize the tangent input with random noise: dx |
---|
466 | !-------------------------------------------------------------------- |
---|
467 | |
---|
468 | kt=nit000 |
---|
469 | kindic=0 |
---|
470 | ! kmod = nmod ! store frequency of test for the SOR solver |
---|
471 | ! nmod = 1 ! force frequency to one (remove adj_tst dependancy to nn_nmin) |
---|
472 | |
---|
473 | DO jj = 1, jpj |
---|
474 | DO ji = 1, jpi |
---|
475 | iseed_2d(ji,jj) = - ( 596035 + & |
---|
476 | & mig(ji) + ( mjg(jj) - 1 ) * jpiglo ) |
---|
477 | END DO |
---|
478 | END DO |
---|
479 | CALL grid_random( iseed_2d, zr, c_solver_pt, 0.0_wp, stdgc ) |
---|
480 | DO jj = nldj, nlej |
---|
481 | DO ji = nldi, nlei |
---|
482 | zgcb_tlin(ji,jj) = zr(ji,jj) |
---|
483 | END DO |
---|
484 | END DO |
---|
485 | DO jj = 1, jpj |
---|
486 | DO ji = 1, jpi |
---|
487 | iseed_2d(ji,jj) = - ( 264792 + & |
---|
488 | & mig(ji) + ( mjg(jj) - 1 ) * jpiglo ) |
---|
489 | END DO |
---|
490 | END DO |
---|
491 | CALL grid_random( iseed_2d, zr, c_solver_pt, 0.0_wp, stdgc ) |
---|
492 | DO jj = nldj, nlej |
---|
493 | DO ji = nldi, nlei |
---|
494 | zgcx_tlin(ji,jj) = zr(ji,jj) |
---|
495 | END DO |
---|
496 | END DO |
---|
497 | ncut = 1 ! reinitilize the solver convergence flag |
---|
498 | gcr_tl(:,:) = 0.0_wp |
---|
499 | gcb_tl(:,:) = zgcb_tlin(:,:) |
---|
500 | gcx_tl(:,:) = zgcx_tlin(:,:) |
---|
501 | CALL sol_sor_tan(kt, kindic) |
---|
502 | zgcx_tlout(:,:) = gcx_tl(:,:) |
---|
503 | |
---|
504 | |
---|
505 | !-------------------------------------------------------------------- |
---|
506 | ! Initialize the adjoint variables: dy^* = W dy |
---|
507 | !-------------------------------------------------------------------- |
---|
508 | |
---|
509 | DO jj = nldj, nlej |
---|
510 | DO ji = nldi, nlei |
---|
511 | zgcx_adin(ji,jj) = zgcx_tlout(ji,jj) & |
---|
512 | & * e1t(ji,jj) * e2t(ji,jj) & |
---|
513 | & * tmask(ji,jj,1) |
---|
514 | END DO |
---|
515 | END DO |
---|
516 | !-------------------------------------------------------------------- |
---|
517 | ! Compute the scalar product: ( L dx )^T W dy |
---|
518 | !-------------------------------------------------------------------- |
---|
519 | |
---|
520 | zsp1 = DOT_PRODUCT( zgcx_tlout, zgcx_adin ) |
---|
521 | |
---|
522 | !-------------------------------------------------------------------- |
---|
523 | ! Call the adjoint routine: dx^* = L^T dy^* |
---|
524 | !-------------------------------------------------------------------- |
---|
525 | gcb_ad(:,:) = 0.0_wp |
---|
526 | gcx_ad(:,:) = zgcx_adin(:,:) |
---|
527 | CALL sol_sor_adj(kt, kindic) |
---|
528 | zgcx_adout(:,:) = gcx_ad(:,:) |
---|
529 | zgcb_adout(:,:) = gcb_ad(:,:) |
---|
530 | |
---|
531 | |
---|
532 | zsp2 = DOT_PRODUCT( zgcx_tlin, zgcx_adout ) & |
---|
533 | & + DOT_PRODUCT( zgcb_tlin, zgcb_adout ) |
---|
534 | |
---|
535 | ! 14 char:'12345678901234' |
---|
536 | cl_name = 'sol_sor_adj ' |
---|
537 | CALL prntst_adj( cl_name, kumadt, zsp1, zsp2 ) |
---|
538 | |
---|
539 | ! nmod = kmod ! restore initial frequency of test for the SOR solver |
---|
540 | |
---|
541 | DEALLOCATE( & |
---|
542 | & zgcb_tlin, & |
---|
543 | & zgcx_tlin, & |
---|
544 | & zgcx_tlout, & |
---|
545 | & zgcx_adin, & |
---|
546 | & zgcx_adout, & |
---|
547 | & zgcb_adout, & |
---|
548 | & zr & |
---|
549 | & ) |
---|
550 | |
---|
551 | |
---|
552 | |
---|
553 | END SUBROUTINE sol_sor_adj_tst |
---|
554 | #if defined key_tst_tlm |
---|
555 | SUBROUTINE sol_sor_tlm_tst( kumadt ) |
---|
556 | !!----------------------------------------------------------------------- |
---|
557 | !! |
---|
558 | !! *** ROUTINE example_adj_tst *** |
---|
559 | !! |
---|
560 | !! ** Purpose : Test the tangent routine. |
---|
561 | !! |
---|
562 | !! ** Method : Verify the tangent with Taylor expansion |
---|
563 | !! |
---|
564 | !! M(x+hdx) = M(x) + L(hdx) + O(h^2) |
---|
565 | !! |
---|
566 | !! where L = tangent routine |
---|
567 | !! M = direct routine |
---|
568 | !! dx = input perturbation (random field) |
---|
569 | !! h = ration on perturbation |
---|
570 | !! |
---|
571 | !! In the tangent test we verify that: |
---|
572 | !! M(x+h*dx) - M(x) |
---|
573 | !! g(h) = ------------------ ---> 1 as h ---> 0 |
---|
574 | !! L(h*dx) |
---|
575 | !! and |
---|
576 | !! g(h) - 1 |
---|
577 | !! f(h) = ---------- ---> k (costant) as h ---> 0 |
---|
578 | !! p |
---|
579 | !! |
---|
580 | !! History : |
---|
581 | !! ! 10-02 (A. Vigilant) |
---|
582 | !!----------------------------------------------------------------------- |
---|
583 | #if defined key_tam |
---|
584 | !! * Modules used |
---|
585 | USE solsor ! Red-Black Successive Over-Relaxation solver |
---|
586 | USE tamtrj ! writing out state trajectory |
---|
587 | USE par_tlm, ONLY: & |
---|
588 | & tlm_bch, & |
---|
589 | & cur_loop, & |
---|
590 | & h_ratio |
---|
591 | USE istate_mod |
---|
592 | USE wzvmod ! vertical velocity |
---|
593 | USE gridrandom, ONLY: & |
---|
594 | & grid_rd_sd |
---|
595 | USE trj_tam |
---|
596 | USE sol_oce , ONLY: & ! ocean dynamics and tracers variables |
---|
597 | & gcb, gcx, ncut |
---|
598 | USE oce , ONLY: & ! |
---|
599 | & ua, ub, un |
---|
600 | USE opatam_tst_ini, ONLY: & |
---|
601 | & tlm_namrd |
---|
602 | USE tamctl, ONLY: & ! Control parameters |
---|
603 | & numtan, numtan_sc |
---|
604 | !! * Arguments |
---|
605 | INTEGER, INTENT(IN) :: & |
---|
606 | & kumadt ! Output unit |
---|
607 | |
---|
608 | !! * Local declarations |
---|
609 | INTEGER :: & |
---|
610 | & ji, & ! dummy loop indices |
---|
611 | & jj, & |
---|
612 | & jk, & |
---|
613 | & kindic,& ! flags fo solver convergence |
---|
614 | & kt ! number of iteration |
---|
615 | INTEGER, DIMENSION(jpi,jpj) :: & |
---|
616 | & iseed_2d ! 2D seed for the random number generator |
---|
617 | REAL(KIND=wp) :: & |
---|
618 | & zsp1, zsp2, zsp3, & ! scalar product |
---|
619 | & zsp_gcb, zsp_gcx, & |
---|
620 | & zsp, & |
---|
621 | & gamma, & |
---|
622 | & zgsp1, & |
---|
623 | & zgsp2, & |
---|
624 | & zgsp3, & |
---|
625 | & zgsp4, & |
---|
626 | & zgsp5, & |
---|
627 | & zgsp6, & |
---|
628 | & zgsp7 |
---|
629 | REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: & |
---|
630 | & zgcb_tlin , & ! Tangent input |
---|
631 | & zgcx_tlin , & ! Tangent input |
---|
632 | & zgcb_out , & ! Direct output |
---|
633 | & zgcx_out , & ! Direct output |
---|
634 | & zgcb_wop , & ! Direct output without perturbation |
---|
635 | & zgcx_wop , & ! Direct output without perturbation |
---|
636 | & zr ! 3D random field |
---|
637 | CHARACTER(LEN=14) :: cl_name |
---|
638 | CHARACTER (LEN=128) :: file_out, file_wop, file_xdx |
---|
639 | CHARACTER (LEN=90) :: FMT |
---|
640 | REAL(KIND=wp), DIMENSION(100):: & |
---|
641 | & zscgcb,zscgcx, & |
---|
642 | & zscerrgcb, zscerrgcx |
---|
643 | INTEGER, DIMENSION(100):: & |
---|
644 | & iiposgcb, ijposgcb, & |
---|
645 | & iiposgcx, ijposgcx |
---|
646 | INTEGER:: & |
---|
647 | & ii, & |
---|
648 | & isamp=40, & |
---|
649 | & jsamp=40, & |
---|
650 | & numsctlm |
---|
651 | REAL(KIND=wp), DIMENSION(jpi,jpj) :: & |
---|
652 | & zerrgcb, zerrgcx |
---|
653 | |
---|
654 | ! Allocate memory |
---|
655 | |
---|
656 | ALLOCATE( & |
---|
657 | & zgcb_tlin( jpi,jpj), & |
---|
658 | & zgcx_tlin( jpi,jpj), & |
---|
659 | & zgcb_out ( jpi,jpj), & |
---|
660 | & zgcx_out ( jpi,jpj), & |
---|
661 | & zgcb_wop ( jpi,jpj), & |
---|
662 | & zgcx_wop ( jpi,jpj), & |
---|
663 | & zr( jpi,jpj) & |
---|
664 | & ) |
---|
665 | !================================================================== |
---|
666 | ! 1) dx = ( un_tl, vn_tl, hdivn_tl ) and |
---|
667 | ! dy = ( hdivb_tl, hdivn_tl ) |
---|
668 | !================================================================== |
---|
669 | |
---|
670 | !-------------------------------------------------------------------- |
---|
671 | ! Reset the tangent and adjoint variables |
---|
672 | !-------------------------------------------------------------------- |
---|
673 | zgcb_tlin( :,:) = 0.0_wp |
---|
674 | zgcx_tlin( :,:) = 0.0_wp |
---|
675 | zgcb_out ( :,:) = 0.0_wp |
---|
676 | zgcx_out ( :,:) = 0.0_wp |
---|
677 | zgcb_wop ( :,:) = 0.0_wp |
---|
678 | zgcx_wop ( :,:) = 0.0_wp |
---|
679 | zr( :,:) = 0.0_wp |
---|
680 | |
---|
681 | !-------------------------------------------------------------------- |
---|
682 | ! Initialize the tangent input with random noise: dx |
---|
683 | !-------------------------------------------------------------------- |
---|
684 | |
---|
685 | !-------------------------------------------------------------------- |
---|
686 | ! Output filename Xn=F(X0) |
---|
687 | !-------------------------------------------------------------------- |
---|
688 | CALL tlm_namrd |
---|
689 | gamma = h_ratio |
---|
690 | file_wop='trj_wop_solsor' |
---|
691 | file_xdx='trj_xdx_solsor' |
---|
692 | !-------------------------------------------------------------------- |
---|
693 | ! Initialize the tangent input with random noise: dx |
---|
694 | !-------------------------------------------------------------------- |
---|
695 | IF (( cur_loop .NE. 0) .OR. ( gamma .NE. 0.0_wp) )THEN |
---|
696 | CALL grid_rd_sd( 596035, zr, c_solver_pt, 0.0_wp, stdgc) |
---|
697 | DO jj = nldj, nlej |
---|
698 | DO ji = nldi, nlei |
---|
699 | zgcb_tlin(ji,jj) = zr(ji,jj) |
---|
700 | END DO |
---|
701 | END DO |
---|
702 | CALL grid_rd_sd( 264792, zr, c_solver_pt, 0.0_wp, stdgc) |
---|
703 | DO jj = nldj, nlej |
---|
704 | DO ji = nldi, nlei |
---|
705 | zgcx_tlin(ji,jj) = zr(ji,jj) |
---|
706 | END DO |
---|
707 | END DO |
---|
708 | ENDIF |
---|
709 | |
---|
710 | !-------------------------------------------------------------------- |
---|
711 | ! Complete Init for Direct |
---|
712 | !------------------------------------------------------------------- |
---|
713 | CALL istate_p |
---|
714 | |
---|
715 | ! *** initialize the reference trajectory |
---|
716 | ! ------------ |
---|
717 | |
---|
718 | ! gcx (:,:) = ( ua(:,:,1) + ub(:,:,1) ) / 10.0_wp |
---|
719 | ! gcb (:,:) = ( ua(:,:,3) + ub(:,:,3) ) / 10.0_wp |
---|
720 | CALL trj_rea( nit000-1, 1 ) |
---|
721 | CALL trj_rea( nit000, 1 ) |
---|
722 | gcx (:,:) = un(:,:,1) / 10.0_wp |
---|
723 | gcb (:,:) = un(:,:,3) / 10.0_wp |
---|
724 | |
---|
725 | IF (( cur_loop .NE. 0) .OR. ( gamma .NE. 0.0_wp) )THEN |
---|
726 | zgcb_tlin(:,:) = gamma * zgcb_tlin(:,:) |
---|
727 | gcb(:,:) = gcb(:,:) + zgcb_tlin(:,:) |
---|
728 | |
---|
729 | zgcx_tlin(:,:) = gamma * zgcx_tlin(:,:) |
---|
730 | gcx(:,:) = gcx(:,:) + zgcx_tlin(:,:) |
---|
731 | ENDIF |
---|
732 | |
---|
733 | !-------------------------------------------------------------------- |
---|
734 | ! Compute the direct model F(X0,t=n) = Xn |
---|
735 | !-------------------------------------------------------------------- |
---|
736 | kindic=0 |
---|
737 | ncut=1 |
---|
738 | IF ( tlm_bch /= 2 ) CALL sol_sor(kindic) |
---|
739 | IF ( tlm_bch == 0 ) CALL trj_wri_spl(file_wop) |
---|
740 | IF ( tlm_bch == 1 ) CALL trj_wri_spl(file_xdx) |
---|
741 | !-------------------------------------------------------------------- |
---|
742 | ! Compute the Tangent |
---|
743 | !-------------------------------------------------------------------- |
---|
744 | IF ( tlm_bch == 2 ) THEN |
---|
745 | !-------------------------------------------------------------------- |
---|
746 | ! Initialize the tangent variables: dy^* = W dy |
---|
747 | !-------------------------------------------------------------------- |
---|
748 | gcr_tl(:,:) = 0.0_wp |
---|
749 | gcb_tl (:,:) = zgcb_tlin (:,:) |
---|
750 | gcx_tl (:,:) = zgcx_tlin (:,:) |
---|
751 | |
---|
752 | !----------------------------------------------------------------------- |
---|
753 | ! Initialization of the dynamics and tracer fields for the tangent |
---|
754 | !----------------------------------------------------------------------- |
---|
755 | ncut=1 !reset indicator of solver convergence |
---|
756 | CALL sol_sor_tan(nit000, kindic) |
---|
757 | !-------------------------------------------------------------------- |
---|
758 | ! Compute the scalar product: ( L(t0,tn) gamma dx0 ) ) |
---|
759 | !-------------------------------------------------------------------- |
---|
760 | |
---|
761 | zsp_gcx = DOT_PRODUCT( gcx_tl, gcx_tl ) |
---|
762 | zsp2 = zsp_gcx |
---|
763 | !-------------------------------------------------------------------- |
---|
764 | ! Storing data |
---|
765 | !-------------------------------------------------------------------- |
---|
766 | CALL trj_rd_spl(file_wop) |
---|
767 | zgcx_wop (:,:) = gcx (:,:) |
---|
768 | CALL trj_rd_spl(file_xdx) |
---|
769 | zgcx_out (:,:) = gcx (:,:) |
---|
770 | !-------------------------------------------------------------------- |
---|
771 | ! Compute the Linearization Error |
---|
772 | ! Nn = M( X0+gamma.dX0, t0,tn) - M(X0, t0,tn) |
---|
773 | ! and |
---|
774 | ! Compute the Linearization Error |
---|
775 | ! En = Nn -TL(gamma.dX0, t0,tn) |
---|
776 | !-------------------------------------------------------------------- |
---|
777 | ! Warning: Here we re-use local variables z()_out and z()_wop |
---|
778 | ii=0 |
---|
779 | DO jj = 1, jpj |
---|
780 | DO ji = 1, jpi |
---|
781 | zgcx_out (ji,jj) = zgcx_out (ji,jj) - zgcx_wop (ji,jj) |
---|
782 | zgcx_wop (ji,jj) = zgcx_out (ji,jj) - gcx_tl (ji,jj) |
---|
783 | IF ( gcx_tl(ji,jj) .NE. 0.0_wp ) zerrgcx(ji,jj) = zgcx_out(ji,jj)/gcx_tl(ji,jj) |
---|
784 | IF( (MOD(ji, isamp) .EQ. 0) .AND. & |
---|
785 | & (MOD(jj, jsamp) .EQ. 0) ) THEN |
---|
786 | ii = ii+1 |
---|
787 | iiposgcx(ii) = ji |
---|
788 | ijposgcx(ii) = jj |
---|
789 | IF ( INT(tmask(ji,jj,1)) .NE. 0) THEN |
---|
790 | zscgcx (ii) = zgcx_wop(ji,jj) |
---|
791 | zscerrgcx (ii) = ( zerrgcx(ji,jj) - 1.0_wp ) / gamma |
---|
792 | ENDIF |
---|
793 | ENDIF |
---|
794 | END DO |
---|
795 | END DO |
---|
796 | |
---|
797 | zsp_gcx = DOT_PRODUCT( zgcx_out, zgcx_out ) |
---|
798 | |
---|
799 | zsp1 = zsp_gcx |
---|
800 | |
---|
801 | zsp_gcx = DOT_PRODUCT( zgcx_wop, zgcx_wop ) |
---|
802 | |
---|
803 | zsp3 = zsp_gcx |
---|
804 | !-------------------------------------------------------------------- |
---|
805 | ! Print the linearization error En - norme 2 |
---|
806 | !-------------------------------------------------------------------- |
---|
807 | ! 14 char:'12345678901234' |
---|
808 | cl_name = 'sol_sor: En ' |
---|
809 | zsp = SQRT(zsp3) |
---|
810 | zgsp5 = zsp |
---|
811 | CALL prntst_tlm( cl_name, kumadt, zsp, h_ratio ) |
---|
812 | |
---|
813 | !-------------------------------------------------------------------- |
---|
814 | ! Compute TLM norm2 |
---|
815 | !-------------------------------------------------------------------- |
---|
816 | zsp = SQRT(zsp2) |
---|
817 | |
---|
818 | zgsp4 = zsp |
---|
819 | cl_name = 'sol_sor: Ln2 ' |
---|
820 | CALL prntst_tlm( cl_name, kumadt, zsp, h_ratio ) |
---|
821 | |
---|
822 | !-------------------------------------------------------------------- |
---|
823 | ! Print the linearization error Nn - norme 2 |
---|
824 | !-------------------------------------------------------------------- |
---|
825 | zsp = SQRT(zsp1) |
---|
826 | |
---|
827 | cl_name = 'solsor:Mhdx-Mx' |
---|
828 | CALL prntst_tlm( cl_name, kumadt, zsp, h_ratio ) |
---|
829 | |
---|
830 | zgsp3 = SQRT( zsp3/zsp2 ) |
---|
831 | zgsp7 = zgsp3/gamma |
---|
832 | zgsp1 = zsp |
---|
833 | zgsp2 = zgsp1 / zgsp4 |
---|
834 | zgsp6 = (zgsp2 - 1.0_wp)/gamma |
---|
835 | |
---|
836 | FMT = "(A8,2X,I4.4,2X,E6.1,2X,E20.13,2X,E20.13,2X,E20.13,2X,E20.13,2X,E20.13,2X,E20.13,2X,E20.13)" |
---|
837 | WRITE(numtan,FMT) 'solsor ', cur_loop, h_ratio, zgsp1, zgsp2, zgsp3, zgsp4, zgsp5, zgsp6, zgsp7 |
---|
838 | !-------------------------------------------------------------------- |
---|
839 | ! Unitary calculus |
---|
840 | !-------------------------------------------------------------------- |
---|
841 | FMT = "(A8,2X,A8,2X,I4.4,2X,E6.1,2X,I4.4,2X,I4.4,2X,I4.4,2X,E20.13,1X)" |
---|
842 | cl_name ='sol_sor ' |
---|
843 | IF(lwp) THEN |
---|
844 | DO ii=1, 100, 1 |
---|
845 | IF ( zscgcx(ii) .NE. 0.0_wp ) WRITE(numtan_sc,FMT) cl_name, 'zscgcx ', & |
---|
846 | & cur_loop, h_ratio, ii, iiposgcx(ii), ijposgcx(ii), zscgcx(ii) |
---|
847 | ENDDO |
---|
848 | DO ii=1, 100, 1 |
---|
849 | IF ( zscerrgcx(ii) .NE. 0.0_wp ) WRITE(numtan_sc,FMT) cl_name, 'zscerrgcx ', & |
---|
850 | & cur_loop, h_ratio, ii, iiposgcx(ii), ijposgcx(ii), zscerrgcx(ii) |
---|
851 | ENDDO |
---|
852 | ! write separator |
---|
853 | WRITE(numtan_sc,"(A4)") '====' |
---|
854 | ENDIF |
---|
855 | |
---|
856 | ENDIF |
---|
857 | |
---|
858 | DEALLOCATE( & |
---|
859 | & zgcb_tlin, & |
---|
860 | & zgcx_tlin, & |
---|
861 | & zgcb_out , & |
---|
862 | & zgcx_out , & |
---|
863 | & zgcb_wop , & |
---|
864 | & zgcx_wop , & |
---|
865 | & zr & |
---|
866 | & ) |
---|
867 | #else |
---|
868 | !! * Arguments |
---|
869 | INTEGER, INTENT(IN) :: & |
---|
870 | & kumadt ! Output unit |
---|
871 | ! dummy routine |
---|
872 | #endif |
---|
873 | END SUBROUTINE sol_sor_tlm_tst |
---|
874 | #endif |
---|
875 | END MODULE solsor_tam |
---|