New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
dynldf_tam.F90 in branches/2012/dev_v3_4_STABLE_2012/NEMOGCM/NEMO/OPATAM_SRC/DYN – NEMO

source: branches/2012/dev_v3_4_STABLE_2012/NEMOGCM/NEMO/OPATAM_SRC/DYN/dynldf_tam.F90 @ 4576

Last change on this file since 4576 was 4576, checked in by pabouttier, 10 years ago

Store and restore nldf flag at the end of adjoint test routine of dynldf_tam, see Ticket #1271
  • Property svn:executable set to *
File size: 21.2 KB
Line 
1MODULE dynldf_tam
2#ifdef key_tam
3   !!======================================================================
4   !!                       ***  MODULE  dynldf_tam  ***
5   !! Ocean physics:  lateral diffusivity trends
6   !!                 Tangent and Adjoint module
7   !!=====================================================================
8   !! History of the direct module:
9   !!          9.0  !  05-11  (G. Madec)  Original code (new step architecture)
10   !! History of the TAM module
11   !!          9.0  !  08-06  (A. Vidard) Skeleton
12   !!               !  08-08  (A. Vidard) TAM of 9.0
13   !!   NEMO   3.4  !  12-07  (P.-A. Bouttier) Phasing with 3.4
14   !!----------------------------------------------------------------------
15   !!----------------------------------------------------------------------
16   !!   dyn_ldf     : update the dynamics trend with the lateral diffusion
17   !!   dyn_ldf_init_tam : initialization, namelist read, and parameters control
18   !!----------------------------------------------------------------------
19   USE par_kind
20   USE par_oce
21   USE oce_tam
22   USE dom_oce
23   USE ldfdyn_oce
24   USE ldfslp
25!   USE dynldf_bilapg_tam    ! lateral mixing       (dyn_ldf_bilapg routine)
26   USE dynldf_bilap_tam
27!   USE dynldf_iso_tam       ! lateral mixing       (dyn_ldf_iso    routine)
28   USE dynldf_lap_tam
29   USE in_out_manager
30!   USE lib_mpp        , ONLY: & ! distribued memory computing library
31!   USE lbclnk         , ONLY: & ! ocean lateral boundary conditions (or mpp link)
32   USE gridrandom
33   USE dotprodfld
34   USE tstool_tam
35   USE timing
36   USE wrk_nemo
37
38   IMPLICIT NONE
39   PRIVATE
40
41   PUBLIC   dyn_ldf_tan        ! called by step_tam module
42   PUBLIC   dyn_ldf_adj        ! called by step_tam module
43   PUBLIC   dyn_ldf_adj_tst    ! called by the tst  module
44   PUBLIC   dyn_ldf_init_tam
45
46   INTEGER ::   nldf = -2   ! type of lateral diffusion used defined from ln_dynldf_... namlist logicals)
47
48   !! * Substitutions
49#  include "domzgr_substitute.h90"
50#  include "vectopt_loop_substitute.h90"
51   !!---------------------------------------------------------------------------------
52
53CONTAINS
54
55   SUBROUTINE dyn_ldf_tan( kt )
56      !!----------------------------------------------------------------------
57      !!                  ***  ROUTINE dyn_ldf_tan  ***
58      !!
59      !! ** Purpose of the direct routine:
60      !!            compute the lateral ocean dynamics physics.
61      !!----------------------------------------------------------------------
62      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
63      !
64      !!----------------------------------------------------------------------
65      !
66      IF( nn_timing == 1 )  CALL timing_start('dyn_ldf_tan')
67      !
68      SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend
69      !
70      CASE ( 0 )
71         CALL dyn_ldf_lap_tan    ( kt )      ! iso-level laplacian
72      CASE ( 1 )
73         CALL ctl_stop('dyn_ldf_iso_tan not available yet')
74!         CALL dyn_ldf_iso_tan    ( kt )      ! rotated laplacian (except dk[ dk[.] ] part)
75      CASE ( 2 )
76         CALL dyn_ldf_bilap_tan  ( kt )      ! iso-level bilaplacian
77      CASE ( 3 )
78         CALL ctl_stop('dyn_ldf_bilapg_tan not available yet')
79!         CALL dyn_ldf_bilapg_tan ( kt )      ! s-coord. horizontal bilaplacian
80      CASE ( 4 )                                        ! iso-level laplacian + bilaplacian
81         CALL dyn_ldf_lap_tan    ( kt )
82         CALL dyn_ldf_bilap_tan  ( kt )
83      CASE ( 5 )                                        ! rotated laplacian + bilaplacian (s-coord)
84         CALL ctl_stop('dyn_ldf_bilapg_tan not available yet')
85         !CALL dyn_ldf_iso    ( kt )
86         !CALL dyn_ldf_bilapg ( kt )
87      !
88      CASE ( -2 )                                       ! neither laplacian nor bilaplacian schemes used
89         IF( kt == nit000 ) THEN
90            IF(lwp) WRITE(numout,*)
91            IF(lwp) WRITE(numout,*) 'dyn_ldf_tan : no lateral diffusion on momentum setup'
92            IF(lwp) WRITE(numout,*) '~~~~~~~ '
93         ENDIF
94      END SELECT
95      IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_tan')
96      !
97   END SUBROUTINE dyn_ldf_tan
98
99   SUBROUTINE dyn_ldf_adj( kt )
100      !!----------------------------------------------------------------------
101      !!                  ***  ROUTINE dyn_ldf_adj  ***
102      !!
103      !! ** Purpose of the direct routine:
104      !!            compute the lateral ocean dynamics physics.
105      !!----------------------------------------------------------------------
106      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
107      !
108      IF( nn_timing == 1 )  CALL timing_start('dyn_ldf_adj')
109      SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend
110      !
111      CASE ( 0 )
112         CALL dyn_ldf_lap_adj    ( kt )      ! iso-level laplacian
113      CASE ( 1 )
114         CALL ctl_stop('dyn_ldf_iso_adj not available yet')
115!         CALL dyn_ldf_iso_adj    ( kt )      ! rotated laplacian (except dk[ dk[.] ] part)
116      CASE ( 2 )
117         CALL dyn_ldf_bilap_adj  ( kt )      ! iso-level bilaplacian
118      CASE ( 3 )
119         CALL ctl_stop('dyn_ldf_bilapg_adj not available yet')
120!         CALL dyn_ldf_bilapg_adj ( kt )      ! s-coord. horizontal bilaplacian
121      CASE ( 4 )                                        ! iso-level laplacian + bilaplacian
122         CALL dyn_ldf_lap_adj    ( kt )
123         CALL dyn_ldf_bilap_adj  ( kt )
124      CASE ( 5 )                                        ! rotated laplacian + bilaplacian (s-coord)
125         CALL ctl_stop('dyn_ldf_bilapg_tan not available yet')
126         !CALL dyn_ldf_iso    ( kt )
127         !CALL dyn_ldf_bilapg ( kt )
128      !
129      CASE ( -2 )                                       ! neither laplacian nor bilaplacian schemes used
130         IF( kt == nit000 ) THEN
131            IF(lwp) WRITE(numout,*)
132            IF(lwp) WRITE(numout,*) 'dyn_ldf_adj : no lateral diffusion on momentum setup'
133            IF(lwp) WRITE(numout,*) '~~~~~~~ '
134         ENDIF
135      !
136      END SELECT      !
137      IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_adj')
138   END SUBROUTINE dyn_ldf_adj
139
140   SUBROUTINE dyn_ldf_init_tam
141      !!----------------------------------------------------------------------
142      !!                  ***  ROUTINE dyn_ldf_ctl_tam  ***
143      !!
144      !! ** Purpose of the direct routine:
145      !!            initializations of the horizontal ocean dynamics physics
146      !!----------------------------------------------------------------------
147      INTEGER ::   ioptio, ierr         ! temporary integers
148      !!----------------------------------------------------------------------
149
150      !                                   ! Namelist nam_dynldf: already read in ldfdyn module
151
152      IF(lwp) THEN                        ! Namelist print
153         WRITE(numout,*)
154         WRITE(numout,*) 'dyn_ldf_init_tam : Choice of the lateral diffusive operator on dynamics'
155         WRITE(numout,*) '~~~~~~~~~~~~~~'
156         WRITE(numout,*) '       Namelist nam_dynldf : set lateral mixing parameters (type, direction, coefficients)'
157         WRITE(numout,*) '          laplacian operator          ln_dynldf_lap   = ', ln_dynldf_lap
158         WRITE(numout,*) '          bilaplacian operator        ln_dynldf_bilap = ', ln_dynldf_bilap
159         WRITE(numout,*) '          iso-level                   ln_dynldf_level = ', ln_dynldf_level
160         WRITE(numout,*) '          horizontal (geopotential)   ln_dynldf_hor   = ', ln_dynldf_hor
161         WRITE(numout,*) '          iso-neutral                 ln_dynldf_iso   = ', ln_dynldf_iso
162      ENDIF
163      !                                   ! control the consistency
164      ioptio = 0
165      IF( ln_dynldf_lap   )   ioptio = ioptio + 1
166      IF( ln_dynldf_bilap )   ioptio = ioptio + 1
167      IF( ioptio < 1 ) CALL ctl_stop( '          use ONE of the 2 lap/bilap operator type on dynamics' )
168      ioptio = 0
169      IF( ln_dynldf_level )   ioptio = ioptio + 1
170      IF( ln_dynldf_hor   )   ioptio = ioptio + 1
171      IF( ln_dynldf_iso   )   ioptio = ioptio + 1
172      IF( ioptio > 1 ) CALL ctl_stop( '          use only ONE direction (level/hor/iso)' )
173      !                                   ! Set nldf, the type of lateral diffusion, from ln_dynldf_... logicals
174      ierr = 0
175      IF ( ln_dynldf_lap ) THEN      ! laplacian operator
176         IF ( ln_zco ) THEN                ! z-coordinate
177            IF ( ln_dynldf_level )   nldf = 0      ! iso-level  (no rotation)
178            IF ( ln_dynldf_hor   )   nldf = 0      ! horizontal (no rotation)
179            IF ( ln_dynldf_iso   )   nldf = 1      ! isoneutral (   rotation)
180         ENDIF
181         IF ( ln_zps ) THEN             ! z-coordinate
182            IF ( ln_dynldf_level )   ierr = 1      ! iso-level not allowed
183            IF ( ln_dynldf_hor   )   nldf = 0      ! horizontal (no rotation)
184            IF ( ln_dynldf_iso   )   nldf = 1      ! isoneutral (   rotation)
185         ENDIF
186         IF ( ln_sco ) THEN             ! s-coordinate
187            IF ( ln_dynldf_level )   nldf = 0      ! iso-level  (no rotation)
188            IF ( ln_dynldf_hor   )   nldf = 1      ! horizontal (   rotation)
189            IF ( ln_dynldf_iso   )   nldf = 1      ! isoneutral (   rotation)
190         ENDIF
191      ENDIF
192
193      IF( ln_dynldf_bilap ) THEN      ! bilaplacian operator
194         IF ( ln_zco ) THEN                ! z-coordinate
195            IF ( ln_dynldf_level )   nldf = 2      ! iso-level  (no rotation)
196            IF ( ln_dynldf_hor   )   nldf = 2      ! horizontal (no rotation)
197            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
198         ENDIF
199         IF ( ln_zps ) THEN             ! z-coordinate
200            IF ( ln_dynldf_level )   ierr = 1      ! iso-level not allowed
201            IF ( ln_dynldf_hor   )   nldf = 2      ! horizontal (no rotation)
202            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
203         ENDIF
204         IF ( ln_sco ) THEN             ! s-coordinate
205            IF ( ln_dynldf_level )   nldf = 2      ! iso-level  (no rotation)
206            IF ( ln_dynldf_hor   )   nldf = 3      ! horizontal (   rotation)
207            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
208         ENDIF
209      ENDIF
210
211      IF( ln_dynldf_lap .AND. ln_dynldf_bilap ) THEN  ! mixed laplacian and bilaplacian operators
212         IF ( ln_zco ) THEN                ! z-coordinate
213            IF ( ln_dynldf_level )   nldf = 4      ! iso-level  (no rotation)
214            IF ( ln_dynldf_hor   )   nldf = 4      ! horizontal (no rotation)
215            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
216         ENDIF
217         IF ( ln_zps ) THEN             ! z-coordinate
218            IF ( ln_dynldf_level )   ierr = 1      ! iso-level not allowed
219            IF ( ln_dynldf_hor   )   nldf = 4      ! horizontal (no rotation)
220            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
221         ENDIF
222         IF ( ln_sco ) THEN             ! s-coordinate
223            IF ( ln_dynldf_level )   nldf = 4      ! iso-level  (no rotation)
224            IF ( ln_dynldf_hor   )   nldf = 5      ! horizontal (   rotation)
225            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
226         ENDIF
227      ENDIF
228
229
230      IF( ierr == 1 )   CALL ctl_stop( 'iso-level in z-coordinate - partial step, not allowed' )
231      IF( ierr == 2 )   CALL ctl_stop( 'isoneutral bilaplacian operator does not exist' )
232      IF( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation
233         IF( .NOT.lk_ldfslp )   CALL ctl_stop( 'the rotation of the diffusive tensor require key_ldfslp' )
234      ENDIF
235
236      IF(lwp) THEN
237         WRITE(numout,*)
238         IF( nldf == -2 )   WRITE(numout,*) '              neither laplacian nor bilaplacian schemes used'
239         IF( nldf == -1 )   WRITE(numout,*) '              ESOPA test All scheme used'
240         IF( nldf ==  0 )   WRITE(numout,*) '              laplacian operator'
241         IF( nldf ==  1 )   WRITE(numout,*) '              rotated laplacian operator'
242         IF( nldf ==  2 )   WRITE(numout,*) '              bilaplacian operator'
243         IF( nldf ==  3 )   WRITE(numout,*) '              rotated bilaplacian'
244         IF( nldf ==  4 )   WRITE(numout,*) '              laplacian and bilaplacian operators'
245         IF( nldf ==  5 )   WRITE(numout,*) '              rotated laplacian and bilaplacian operators'
246      ENDIF
247      !
248   END SUBROUTINE dyn_ldf_init_tam
249
250   SUBROUTINE dyn_ldf_adj_tst( kumadt )
251      !!-----------------------------------------------------------------------
252      !!
253      !!                  ***  ROUTINE dyn_ldf_adj_tst ***
254      !!
255      !! ** Purpose : Test the adjoint routine.
256      !!
257      !! ** Method  : Verify the scalar product
258      !!
259      !!                 ( L dx )^T W dy  =  dx^T L^T W dy
260      !!
261      !!              where  L   = tangent routine
262      !!                     L^T = adjoint routine
263      !!                     W   = diagonal matrix of scale factors
264      !!                     dx  = input perturbation (random field)
265      !!                     dy  = L dx
266      !!
267      !! ** Action  : Separate tests are applied for the following dx and dy:
268      !!
269      !!              1) dx = ( SSH ) and dy = ( SSH )
270      !!
271      !! History :
272      !!        ! 08-08 (A. Vidard)
273      !!-----------------------------------------------------------------------
274      !! * Modules used
275
276      !! * Arguments
277      INTEGER, INTENT(IN) :: &
278         & kumadt             ! Output unit
279
280      INTEGER :: &
281         & ji,    &        ! dummy loop indices
282         & jj,    &
283         & jk,    &
284         & jt
285      INTEGER, DIMENSION(jpi,jpj) :: &
286         & iseed_2d        ! 2D seed for the random number generator
287
288      !! * Local declarations
289      REAL(KIND=wp), DIMENSION(:,:,:), ALLOCATABLE :: &
290         & zua_tlin,     & ! Tangent input: after u-velocity
291         & zva_tlin,     & ! Tangent input: after u-velocity
292         & zua_tlout,    & ! Tangent output:after u-velocity
293         & zva_tlout,    & ! Tangent output:after v-velocity
294         & zua_adin,     & ! adjoint input: after u-velocity
295         & zva_adin,     & ! adjoint input: after v-velocity
296         & zua_adout,    & ! adjoint output:after v-velocity
297         & zva_adout,    & ! adjoint output:after u-velocity
298         & zrotb_tlin,   &
299         & zhdivb_tlin,  &
300         & zrotb_adout,  &
301         & zhdivb_adout, &
302         & zrotb,        & ! 3D random field for rotb
303         & zhdivb,       & ! 3D random field for hdivb
304         & zau,          & ! 3D random field for u
305         & zav             ! 3D random field for v
306      REAL(KIND=wp) :: &
307         & zsp1,         & ! scalar product involving the tangent routine
308         & zsp1_1,       & !   scalar product components
309         & zsp1_2,       &
310         & zsp2,         & ! scalar product involving the adjoint routine
311         & zsp2_1,       & !   scalar product components
312         & zsp2_2,       &
313         & zsp2_3,       &
314         & zsp2_4
315      CHARACTER(LEN=14) :: cl_name
316
317      INTEGER :: ildf !: store the nldf flag
318
319      ! Allocate memory
320
321      ALLOCATE( &
322         & zua_tlin(jpi,jpj,jpk),     &
323         & zva_tlin(jpi,jpj,jpk),     &
324         & zua_tlout(jpi,jpj,jpk),    &
325         & zva_tlout(jpi,jpj,jpk),    &
326         & zua_adin(jpi,jpj,jpk),     &
327         & zva_adin(jpi,jpj,jpk),     &
328         & zua_adout(jpi,jpj,jpk),    &
329         & zva_adout(jpi,jpj,jpk),    &
330         & zrotb_tlin(jpi,jpj,jpk),   &
331         & zhdivb_tlin(jpi,jpj,jpk),  &
332         & zrotb_adout(jpi,jpj,jpk),  &
333         & zhdivb_adout(jpi,jpj,jpk), &
334         & zrotb(jpi,jpj,jpk),        &
335         & zhdivb(jpi,jpj,jpk),       &
336         & zau(jpi,jpj,jpk),          &
337         & zav(jpi,jpj,jpk)           &
338         & )
339
340      ildf = nldf
341
342      DO jt = 1, 2
343
344         IF (jt == 1) nldf=0  ! iso-level laplacian
345         IF (jt == 2) nldf=2  ! iso-level bilaplacian
346
347         !==================================================================
348         ! 1)      dx = ( ua_tl, va_tl, rotb_tl, hdivb_tl )
349         !    and  dy = ( ua_tl, va_tl )
350         !==================================================================
351
352         !--------------------------------------------------------------------
353         ! Reset the tangent and adjoint variables
354         !--------------------------------------------------------------------
355         zua_tlin(:,:,:)     = 0.0_wp
356         zva_tlin(:,:,:)     = 0.0_wp
357         zrotb_tlin(:,:,:)   = 0.0_wp
358         zhdivb_tlin(:,:,:)  = 0.0_wp
359         zua_tlout(:,:,:)    = 0.0_wp
360         zva_tlout(:,:,:)    = 0.0_wp
361         zua_adin(:,:,:)     = 0.0_wp
362         zva_adin(:,:,:)     = 0.0_wp
363         zrotb_adout(:,:,:)  = 0.0_wp
364         zhdivb_adout(:,:,:) = 0.0_wp
365         zua_adout(:,:,:)    = 0.0_wp
366         zva_adout(:,:,:)    = 0.0_wp
367         zrotb(:,:,:)        = 0.0_wp
368         zhdivb(:,:,:)       = 0.0_wp
369         zau(:,:,:)          = 0.0_wp
370         zav(:,:,:)          = 0.0_wp
371
372         ua_tl(:,:,:)    = 0.0_wp
373         va_tl(:,:,:)    = 0.0_wp
374         ua_ad(:,:,:)    = 0.0_wp
375         va_ad(:,:,:)    = 0.0_wp
376         rotb_tl(:,:,:)  = 0.0_wp
377         hdivb_tl(:,:,:) = 0.0_wp
378         rotb_ad(:,:,:)  = 0.0_wp
379         hdivb_ad(:,:,:) = 0.0_wp
380
381         !--------------------------------------------------------------------
382         ! Initialize the tangent input with random noise: dx
383         !--------------------------------------------------------------------
384
385         CALL grid_random(  zau, 'U', 0.0_wp, stdu )
386         CALL grid_random(  zav, 'V', 0.0_wp, stdv )
387         CALL grid_random(  zrotb, 'F', 0.0_wp, stdr )
388         CALL grid_random(  zhdivb, 'T', 0.0_wp, stdh )
389
390         DO jk = 1, jpk
391            DO jj = nldj, nlej
392               DO ji = nldi, nlei
393                  zua_tlin   (ji,jj,jk) = zau   (ji,jj,jk)
394                  zva_tlin   (ji,jj,jk) = zav   (ji,jj,jk)
395                  zhdivb_tlin(ji,jj,jk) = zhdivb(ji,jj,jk)
396                  zrotb_tlin (ji,jj,jk) = zrotb (ji,jj,jk)
397               END DO
398            END DO
399         END DO
400         hdivb_tl(:,:,:) = zhdivb_tlin(:,:,:)
401         rotb_tl (:,:,:) = zrotb_tlin (:,:,:)
402         ua_tl   (:,:,:) = zua_tlin   (:,:,:)
403         va_tl   (:,:,:) = zva_tlin   (:,:,:)
404
405         IF (nldf == 0 )  CALL dyn_ldf_lap_tan(   nit000 )
406         IF (nldf == 2 )  CALL dyn_ldf_bilap_tan( nit000 )
407
408         zua_tlout(:,:,:) = ua_tl(:,:,:)
409         zva_tlout(:,:,:) = va_tl(:,:,:)
410
411         !--------------------------------------------------------------------
412         ! Initialize the adjoint variables: dy^* = W dy
413         !--------------------------------------------------------------------
414
415         DO jk = 1, jpk
416            DO jj = nldj, nlej
417               DO ji = nldi, nlei
418                  zua_adin(ji,jj,jk) = zua_tlout(ji,jj,jk) &
419                       &               * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) &
420                       &               * umask(ji,jj,jk)
421                  zva_adin(ji,jj,jk) = zva_tlout(ji,jj,jk) &
422                       &               * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) &
423                       &               * vmask(ji,jj,jk)
424               END DO
425            END DO
426         END DO
427
428         !--------------------------------------------------------------------
429         ! Compute the scalar product: ( L dx )^T W dy
430         !--------------------------------------------------------------------
431
432         zsp1_1 = DOT_PRODUCT( zua_tlout, zua_adin )
433         zsp1_2 = DOT_PRODUCT( zva_tlout, zva_adin )
434         zsp1   = zsp1_1 + zsp1_2
435
436         !--------------------------------------------------------------------
437         ! Call the adjoint routine: dx^* = L^T dy^*
438         !--------------------------------------------------------------------
439
440         ua_ad(:,:,:) = zua_adin(:,:,:)
441         va_ad(:,:,:) = zva_adin(:,:,:)
442
443         IF (nldf == 0 )  CALL dyn_ldf_lap_adj(   nit000 )
444         IF (nldf == 2 )  CALL dyn_ldf_bilap_adj( nit000 )
445
446         zua_adout   (:,:,:) = ua_ad   (:,:,:)
447         zva_adout   (:,:,:) = va_ad   (:,:,:)
448         zrotb_adout (:,:,:) = rotb_ad (:,:,:)
449         zhdivb_adout(:,:,:) = hdivb_ad(:,:,:)
450
451         !--------------------------------------------------------------------
452         ! Compute the scalar product: dx^T dx^*
453         !--------------------------------------------------------------------
454
455         zsp2_1 = DOT_PRODUCT( zua_tlin,    zua_adout    )
456         zsp2_2 = DOT_PRODUCT( zva_tlin,    zva_adout    )
457         zsp2_3 = DOT_PRODUCT( zrotb_tlin,  zrotb_adout  )
458         zsp2_4 = DOT_PRODUCT( zhdivb_tlin, zhdivb_adout )
459         zsp2   = zsp2_1 + zsp2_2 + zsp2_3 + zsp2_4
460
461      ! Compare the scalar products
462      ! 14 char:'12345678901234'
463         IF (nldf == 0 )  cl_name = 'dynldf_adj lap'
464         IF (nldf == 2 )  cl_name = 'dynldf_adj blp'
465         CALL prntst_adj( cl_name, kumadt, zsp1, zsp2 )
466
467      END DO
468
469      nldf = ildf ! restore nldf
470     
471      DEALLOCATE( &
472         & zua_tlin,     &
473         & zva_tlin,     &
474         & zua_tlout,    &
475         & zva_tlout,    &
476         & zua_adin,     &
477         & zva_adin,     &
478         & zua_adout,    &
479         & zva_adout,    &
480         & zrotb_tlin,   &
481         & zhdivb_tlin,  &
482         & zrotb_adout,  &
483         & zhdivb_adout, &
484         & zrotb,        &
485         & zhdivb,       &
486         & zau,          &
487         & zav           &
488         & )
489   END SUBROUTINE dyn_ldf_adj_tst
490   !!======================================================================
491#endif
492END MODULE dynldf_tam
Note: See TracBrowser for help on using the repository browser.