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.
trazdf_exp_tam.F90 in branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/TRA – NEMO

source: branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/TRA/trazdf_exp_tam.F90 @ 3611

Last change on this file since 3611 was 3611, checked in by pabouttier, 11 years ago

Add TAM code and ORCA2_TAM configuration - see Ticket #1007
  • Property svn:executable set to *
File size: 22.5 KB
Line 
1MODULE trazdf_exp_tam
2#ifdef key_tam
3   !!==============================================================================
4   !!                    ***  MODULE  trazdf_exp_tam  ***
5   !! Ocean active tracers:  vertical component of the tracer mixing trend using
6   !!                        a split-explicit time-stepping
7   !!                        Tangent and Adjoint module
8   !!==============================================================================
9   !! History of the direct module :
10   !!   OPA           !  1990-10  (B. Blanke)  Original code
11   !!            7.0  !  1991-11  (G. Madec)
12   !!                 !  1992-06  (M. Imbard)  correction on tracer trend loops
13   !!                 !  1996-01  (G. Madec)  statement function for e3
14   !!                 !  1997-05  (G. Madec)  vertical component of isopycnal
15   !!                 !  1997-07  (G. Madec)  geopotential diffusion in s-coord
16   !!                 !  2000-08  (G. Madec)  double diffusive mixing
17   !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form and module
18   !!             -   !  2004-08  (C. Talandier) New trends organisation
19   !!             -   !  2005-11  (G. Madec)  New organisation
20   !!            3.0  !  2008-04  (G. Madec)  leap-frog time stepping done in trazdf
21   !! History of the T&A module :
22   !!                 !  2009-01  (A. Vidard) tam of the 2008-04 version
23   !!----------------------------------------------------------------------
24
25   !!----------------------------------------------------------------------
26   !!   tra_zdf_exp_tan  : compute the tracer the vertical diffusion trend using a
27   !!                  split-explicit time stepping and provide the after tracer (tangent)
28   !!   tra_zdf_exp_adj  : compute the tracer the vertical diffusion trend using a
29   !!                  split-explicit time stepping and provide the after tracer (adjoint)
30   !!----------------------------------------------------------------------
31   USE par_oce
32   USE oce_tam
33   USE dom_oce
34   USE zdf_oce
35   USE zdfddm
36   USE in_out_manager
37   USE gridrandom
38   USE dotprodfld
39   USE paresp
40   USE tstool_tam
41   USE trc_oce
42   USE trc_oce_tam
43   USE lib_mpp
44   USE wrk_nemo
45   USE timing
46
47   IMPLICIT NONE
48   PRIVATE
49
50   PUBLIC   tra_zdf_exp_tan       ! routine called by tra_zdf_tan.F90
51   PUBLIC   tra_zdf_exp_adj       ! routine called by tra_zdf_adj.F90
52   PUBLIC   tra_zdf_exp_adj_tst   ! routine called by tst.F90
53
54   !! * Substitutions
55#  include "domzgr_substitute.h90"
56#  include "zdfddm_substitute.h90"
57#  include "vectopt_loop_substitute.h90"
58   !!----------------------------------------------------------------------
59   !! NEMO/OPA  3.0 , LOCEAN-IPSL (2008)
60   !! $Id: trazdf_exp.F90 1146 2008-06-25 11:42:56Z rblod $
61   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
62   !!----------------------------------------------------------------------
63
64CONTAINS
65
66   SUBROUTINE tra_zdf_exp_tan( kt, kit000, cdtype, p2dt, kn_zdfexp,   &
67      &                                ptb_tl , pta_tl      , kjpt  )
68      !!----------------------------------------------------------------------
69      !!                  ***  ROUTINE tra_zdf_exp_tan  ***
70      !!
71      !! ** Purpose of the direct routine:
72      !!      Compute the after tracer fields due to the vertical
73      !!      tracer mixing alone, and then due to the whole tracer trend.
74      !!
75      !! ** Method of the direct routine :
76      !!               - The after tracer fields due to the vertical diffusion
77      !!      of tracers alone is given by:
78      !!                zwx = tb + p2dt difft
79      !!      where difft = dz( avt dz(tb) ) = 1/e3t dk+1( avt/e3w dk(tb) )
80      !!           (if lk_zdfddm=T use avs on salinity instead of avt)
81      !!      difft is evaluated with an Euler split-explit scheme using a
82      !!      no flux boundary condition at both surface and bottomi boundaries.
83      !!      (N.B. bottom condition is applied through the masked field avt).
84      !!              - the after tracer fields due to the whole trend is
85      !!      obtained in leap-frog environment by :
86      !!          ta = zwx + p2dt ta
87      !!              - in case of variable level thickness (lk_vvl=T) the
88      !!     the leap-frog is applied on thickness weighted tracer. That is:
89      !!          ta = [ tb*e3tb + e3tn*( zwx - tb + p2dt ta ) ] / e3tn
90      !!
91      !! ** Action : - after tracer fields (ta,sa)
92      !!---------------------------------------------------------------------
93      INTEGER , INTENT(in)                 ::   kt     ! ocean time-step index
94      INTEGER                              , INTENT(in   ) ::   kit000      ! first time step index
95      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype      ! =TRA or TRC (tracer indicator)
96      INTEGER                              , INTENT(in   ) ::   kjpt        ! number of tracers
97      INTEGER                              , INTENT(in   ) ::   kn_zdfexp   ! number of sub-time step
98      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt        ! vertical profile of tracer time-step
99      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb_tl      ! before and now tracer fields
100      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta_tl      ! tracer trend
101      !!
102      INTEGER  ::   ji, jj, jk, jl, jn            ! dummy loop indices
103      REAL(wp) ::   zlavmr, zave3r, ze3tr     ! temporary scalars
104      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwxtl, zwytl   ! 3D workspace
105      !!---------------------------------------------------------------------
106      !
107      IF( nn_timing == 1 )  CALL timing_start('tra_zdf_exp_tan')
108      !
109      CALL wrk_alloc( jpi, jpj, jpk, zwxtl, zwytl )
110      !
111      IF( kt == kit000 ) THEN
112         IF(lwp) WRITE(numout,*)
113         IF(lwp) WRITE(numout,*) 'tra_zdf_exp_tan : explicit vertical mixing on ', cdtype
114         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~'
115      ENDIF
116
117      ! Initializations
118      ! ---------------
119      zlavmr = 1. / float( kn_zdfexp )                           ! Local constant
120      !
121      Do jn = 1, kjpt
122         zwytl(:,:, 1 ) = 0.0_wp                ! surface boundary conditions: no flux
123         zwytl(:,:,jpk) = 0.0_wp                ! bottom  boundary conditions: no flux
124         !
125         zwxtl(:,:,:)   = ptb_tl(:,:,:,jn)      ! zwx and zwz arrays set to before tracer values
126
127         ! Split-explicit loop  (after tracer due to the vertical diffusion alone)
128         ! -------------------
129         !
130         DO jl = 1, kn_zdfexp
131            !                     ! first vertical derivative
132            DO jk = 2, jpk
133               DO jj = 2, jpjm1
134                  DO ji = fs_2, fs_jpim1   ! vector opt.
135                     zave3r = 1.e0 / fse3w_n(ji,jj,jk)
136                     IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN  ! temperature : use of avt
137                        zwytl(ji,jj,jk) =   avt(ji,jj,jk) * ( zwxtl(ji,jj,jk-1) - zwxtl(ji,jj,jk) ) * zave3r
138                     ELSE
139                        zwytl(ji,jj,jk) = fsavs(ji,jj,jk) * ( zwxtl(ji,jj,jk-1) - zwxtl(ji,jj,jk) ) * zave3r
140                     END IF
141                  END DO
142               END DO
143            END DO
144            !
145            DO jk = 1, jpkm1      ! second vertical derivative   ==> tracer at kt+l*2*rdt/n_zdfexp
146               DO jj = 2, jpjm1
147                  DO ji = fs_2, fs_jpim1   ! vector opt.
148                     ze3tr = zlavmr / fse3t_n(ji,jj,jk)
149                     zwxtl(ji,jj,jk) = zwxtl(ji,jj,jk) + p2dt(jk) * ( zwytl(ji,jj,jk) - zwytl(ji,jj,jk+1) ) * ze3tr
150                  END DO
151               END DO
152            END DO
153            !
154         END DO
155
156         ! After tracer due to all trends
157         ! ------------------------------
158         IF( lk_vvl ) THEN          ! variable level thickness : leap-frog on tracer*e3t
159            IF(lwp) WRITE(numout,*) "key_vvl net available in tangent yet"
160            CALL abort
161         ELSE                       ! fixed level thickness : leap-frog on tracers
162            DO jk = 1, jpkm1
163               DO jj = 2, jpjm1
164                  DO ji = fs_2, fs_jpim1   ! vector opt.
165                     pta_tl(ji,jj,jk,jn) = ( zwxtl(ji,jj,jk) + p2dt(jk) * pta_tl(ji,jj,jk,jn) ) *tmask(ji,jj,jk)
166                  END DO
167               END DO
168            END DO
169         ENDIF
170         !
171      END DO
172      !
173      CALL wrk_dealloc( jpi, jpj, jpk, zwxtl, zwytl )
174      !
175      IF( nn_timing == 1 )  CALL timing_stop('tra_zdf_exp_tan')
176      !
177   END SUBROUTINE tra_zdf_exp_tan
178
179   SUBROUTINE tra_zdf_exp_adj( kt, kit000, cdtype, p2dt, kn_zdfexp,   &
180      &                                ptb_ad , pta_ad      , kjpt )
181      !!----------------------------------------------------------------------
182      !!                  ***  ROUTINE tra_zdf_exp_adj  ***
183      !!
184      !! ** Purpose of the direct routine:
185      !!      Compute the after tracer fields due to the vertical
186      !!      tracer mixing alone, and then due to the whole tracer trend.
187      !!
188      !! ** Method of the direct routine :
189      !!               - The after tracer fields due to the vertical diffusion
190      !!      of tracers alone is given by:
191      !!                zwx = tb + p2dt difft
192      !!      where difft = dz( avt dz(tb) ) = 1/e3t dk+1( avt/e3w dk(tb) )
193      !!           (if lk_zdfddm=T use avs on salinity instead of avt)
194      !!      difft is evaluated with an Euler split-explit scheme using a
195      !!      no flux boundary condition at both surface and bottomi boundaries.
196      !!      (N.B. bottom condition is applied through the masked field avt).
197      !!              - the after tracer fields due to the whole trend is
198      !!      obtained in leap-frog environment by :
199      !!          ta = zwx + p2dt ta
200      !!              - in case of variable level thickness (lk_vvl=T) the
201      !!     the leap-frog is applied on thickness weighted tracer. That is:
202      !!          ta = [ tb*e3tb + e3tn*( zwx - tb + p2dt ta ) ] / e3tn
203      !!
204      !! ** Action : - after tracer fields (ta,sa)
205      !!---------------------------------------------------------------------
206      INTEGER , INTENT(in)                 ::   kt     ! ocean time-step index
207      INTEGER                              , INTENT(in   ) ::   kit000      ! first time step index
208      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype      ! =TRA or TRC (tracer indicator)
209      INTEGER                              , INTENT(in   ) ::   kjpt        ! number of tracers
210      INTEGER                              , INTENT(in   ) ::   kn_zdfexp   ! number of sub-time step
211      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt        ! vertical profile of tracer time-step
212      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   ptb_ad      ! before and now tracer fields
213      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta_ad      ! tracer trend
214      !!
215      INTEGER  ::   ji, jj, jk, jl, jn            ! dummy loop indices
216      REAL(wp) ::   zlavmr, zave3r, ze3tr     ! temporary scalars
217      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwxad, zwyad                 ! 3D workspace
218      !!---------------------------------------------------------------------
219      !
220      IF( nn_timing == 1 )  CALL timing_start('tra_zdf_exp_adj')
221      !
222      CALL wrk_alloc( jpi, jpj, jpk, zwxad, zwyad )
223      !
224      IF( kt == nitend ) THEN
225         IF(lwp) WRITE(numout,*)
226         IF(lwp) WRITE(numout,*) 'tra_zdf_exp_adj : explicit vertical mixing on ', cdtype
227         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~'
228      ENDIF
229
230      ! Initializations
231      ! ---------------
232      zlavmr = 1. / float( kn_zdfexp )                           ! Local constant
233      DO jn = 1, kjpt
234         !
235         zwxad(:,:,:) = 0.0_wp
236         zwyad(:,:,:) = 0.0_wp
237         ! After tracer due to all trends
238         ! ------------------------------
239         IF( lk_vvl ) THEN          ! variable level thickness : leap-frog on tracer*e3t
240            IF(lwp) WRITE(numout,*) "key_vvl net available in adjoint yet"
241            CALL abort
242         ELSE                       ! fixed level thickness : leap-frog on tracers
243            DO jk = 1, jpkm1
244               DO jj = 2, jpjm1
245                  DO ji = fs_2, fs_jpim1   ! vector opt.
246                     zwxad(ji,jj,jk) = zwxad(ji,jj,jk) + pta_ad(ji,jj,jk,jn) * tmask(ji,jj,jk)
247                     pta_ad(ji,jj,jk,jn) = p2dt(jk) * pta_ad(ji,jj,jk,jn) * tmask(ji,jj,jk)
248                  END DO
249               END DO
250            END DO
251         ENDIF
252         !
253
254         ! Split-explicit loop  (after tracer due to the vertical diffusion alone)
255         ! -------------------
256         !
257         DO jl = 1, kn_zdfexp
258            DO jk =  jpkm1, 1, -1      ! second vertical derivative   ==> tracer at kt+l*2*rdt/n_zdfexp
259               DO jj = 2, jpjm1
260                  DO ji = fs_2, fs_jpim1   ! vector opt.
261                     ze3tr = zlavmr / fse3t_n(ji,jj,jk)
262                     zwyad(ji,jj,jk  ) = zwyad(ji,jj,jk  ) + p2dt(jk) * zwxad(ji,jj,jk) * ze3tr
263                     zwyad(ji,jj,jk+1) = zwyad(ji,jj,jk+1) - p2dt(jk) * zwxad(ji,jj,jk) * ze3tr
264                  END DO
265               END DO
266            END DO
267            !                     ! first vertical derivative
268            DO jk = jpk, 2, -1
269               DO jj = 2, jpjm1
270                  DO ji = fs_2, fs_jpim1   ! vector opt.
271                     zave3r = 1.e0 / fse3w_n(ji,jj,jk)
272                     IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN  ! temperature : use of avt
273                        zwxad(ji,jj,jk-1) = zwxad(ji,jj,jk-1) + avt(ji,jj,jk) * zwyad(ji,jj,jk) * zave3r
274                        zwxad(ji,jj,jk  ) = zwxad(ji,jj,jk  ) - avt(ji,jj,jk) * zwyad(ji,jj,jk) * zave3r
275                        zwyad(ji,jj,jk  ) = 0.0_wp
276                     ELSE
277                        zwxad(ji,jj,jk-1) = zwxad(ji,jj,jk-1) + fsavs(ji,jj,jk) * zwyad(ji,jj,jk) * zave3r
278                        zwxad(ji,jj,jk  ) = zwxad(ji,jj,jk  ) - fsavs(ji,jj,jk) * zwyad(ji,jj,jk) * zave3r
279                        zwyad(ji,jj,jk  ) = 0.0_wp
280                     ENDIF
281                  END DO
282               END DO
283            END DO
284            !
285            !
286         END DO
287         !
288         ptb_ad(:,:,:,jn) = ptb_ad(:,:,:,jn) + zwxad(:,:,:)
289      END DO
290      !
291      CALL wrk_dealloc( jpi, jpj, jpk, zwxad, zwyad )
292      !
293      IF( nn_timing == 1 )  CALL timing_stop('tra_zdf_exp_adj')
294      !
295   END SUBROUTINE tra_zdf_exp_adj
296
297   SUBROUTINE tra_zdf_exp_adj_tst( kumadt )
298      !!-----------------------------------------------------------------------
299      !!
300      !!                  ***  ROUTINE tra_zdf_exp_adj_tst ***
301      !!
302      !! ** Purpose : Test the adjoint routine.
303      !!
304      !! ** Method  : Verify the scalar product
305      !!
306      !!                 ( L dx )^T W dy  =  dx^T L^T W dy
307      !!
308      !!              where  L   = tangent routine
309      !!                     L^T = adjoint routine
310      !!                     W   = diagonal matrix of scale factors
311      !!                     dx  = input perturbation (random field)
312      !!                     dy  = L dx
313      !!
314      !!
315      !! History :
316      !!        ! 08-08 (A. Vidard)
317      !!-----------------------------------------------------------------------
318      !! * Modules used
319
320      !! * Arguments
321      INTEGER, INTENT(IN) :: &
322         & kumadt             ! Output unit
323
324      !! * Local declarations
325      INTEGER ::  &
326         & ji,    &        ! dummy loop indices
327         & jj,    &
328         & jk
329      REAL(KIND=wp) ::   &
330         & zsp1,         & ! scalar product involving the tangent routine
331         & zsp2            ! scalar product involving the adjoint routine
332      REAL(KIND=wp), DIMENSION(:,:,:), ALLOCATABLE :: &
333         & zta_tlin ,     & ! Tangent input
334         & ztb_tlin ,     & ! Tangent input
335#if defined key_obc
336         & ztb_tlout, zsb_tlout, ztb_adin, zsb_adin,  &
337#endif
338         & zsa_tlin ,     & ! Tangent input
339         & zsb_tlin ,     & ! Tangent input
340         & zta_tlout,     & ! Tangent output
341         & zsa_tlout,     & ! Tangent output
342         & zta_adin ,     & ! Adjoint input
343         & zsa_adin ,     & ! Adjoint input
344         & zta_adout,     & ! Adjoint output
345         & ztb_adout,     & ! Adjoint output
346         & zsa_adout,     & ! Adjoint output
347         & zsb_adout,     & ! Adjoint output
348         & zr             ! 3D random field
349      CHARACTER(LEN=14) :: cl_name
350      ! Allocate memory
351
352      ALLOCATE( &
353         & zta_tlin( jpi,jpj,jpk),     &
354         & zsa_tlin( jpi,jpj,jpk),     &
355         & ztb_tlin( jpi,jpj,jpk),     &
356         & zsb_tlin( jpi,jpj,jpk),     &
357         & zta_tlout(jpi,jpj,jpk),     &
358         & zsa_tlout(jpi,jpj,jpk),     &
359         & zta_adin( jpi,jpj,jpk),     &
360         & zsa_adin( jpi,jpj,jpk),     &
361         & zta_adout(jpi,jpj,jpk),     &
362         & zsa_adout(jpi,jpj,jpk),     &
363         & ztb_adout(jpi,jpj,jpk),     &
364         & zsb_adout(jpi,jpj,jpk),     &
365         & zr(       jpi,jpj,jpk)      &
366         & )
367
368#if defined key_obc
369      ALLOCATE( ztb_tlout(jpi,jpj,jpk),  zsb_tlout(jpi,jpj,jpk),     &
370           &    ztb_adin (jpi,jpj,jpk),  zsb_adin (jpi,jpj,jpk) )
371#endif
372
373      !==================================================================
374      ! 1) dx = ( un_tl, vn_tl, hdivn_tl ) and
375      !    dy = ( hdivb_tl, hdivn_tl )
376      !==================================================================
377
378      !--------------------------------------------------------------------
379      ! Reset the tangent and adjoint variables
380      !--------------------------------------------------------------------
381          zta_tlin( :,:,:) = 0.0_wp
382          ztb_tlin( :,:,:) = 0.0_wp
383          zsa_tlin( :,:,:) = 0.0_wp
384          zsb_tlin( :,:,:) = 0.0_wp
385          zta_tlout(:,:,:) = 0.0_wp
386          zsa_tlout(:,:,:) = 0.0_wp
387          zta_adin( :,:,:) = 0.0_wp
388          zsa_adin( :,:,:) = 0.0_wp
389          zta_adout(:,:,:) = 0.0_wp
390          zsa_adout(:,:,:) = 0.0_wp
391          ztb_adout(:,:,:) = 0.0_wp
392          zsb_adout(:,:,:) = 0.0_wp
393          zr(       :,:,:) = 0.0_wp
394
395          tsa_tl(:,:,:,:)     = 0.0_wp
396          tsb_tl(:,:,:,:)     = 0.0_wp
397          tsa_ad(:,:,:,:)     = 0.0_wp
398          tsb_ad(:,:,:,:)     = 0.0_wp
399      !--------------------------------------------------------------------
400      ! Initialize the tangent input with random noise: dx
401      !--------------------------------------------------------------------
402      CALL grid_random(  zr, 'T', 0.0_wp, stdt )
403      DO jk = 1, jpk
404        DO jj = nldj, nlej
405           DO ji = nldi, nlei
406              zta_tlin(ji,jj,jk) = zr(ji,jj,jk)
407           END DO
408        END DO
409      END DO
410      CALL grid_random(  zr, 'T', 0.0_wp, stdt )
411      DO jk = 1, jpk
412        DO jj = nldj, nlej
413           DO ji = nldi, nlei
414              ztb_tlin(ji,jj,jk) = zr(ji,jj,jk)
415           END DO
416        END DO
417      END DO
418      CALL grid_random(  zr, 'T', 0.0_wp, stds )
419      DO jk = 1, jpk
420        DO jj = nldj, nlej
421           DO ji = nldi, nlei
422              zsa_tlin(ji,jj,jk) = zr(ji,jj,jk)
423           END DO
424        END DO
425      END DO
426      CALL grid_random(  zr, 'T', 0.0_wp, stds )
427      DO jk = 1, jpk
428        DO jj = nldj, nlej
429           DO ji = nldi, nlei
430              zsb_tlin(ji,jj,jk) = zr(ji,jj,jk)
431           END DO
432        END DO
433      END DO
434      tsa_tl(:,:,:,jp_tem) = zta_tlin(:,:,:)
435      tsa_tl(:,:,:,jp_sal) = zsa_tlin(:,:,:)
436      tsb_tl(:,:,:,jp_tem) = ztb_tlin(:,:,:)
437      tsb_tl(:,:,:,jp_sal) = zsb_tlin(:,:,:)
438      CALL tra_zdf_exp_tan ( nit000, nit000, 'TRA', r2dtra, 1, tsb_tl, tsa_tl, jpts )
439      zta_tlout(:,:,:) = tsa_tl(:,:,:,jp_tem)
440      zsa_tlout(:,:,:) = tsa_tl(:,:,:,jp_sal)
441#if defined key_obc
442      ztb_tlout(:,:,:) = tsb_tl(:,:,:,jp_tem)
443      zsb_tlout(:,:,:) = tsb_tl(:,:,:,jp_sal)
444#endif
445
446      !--------------------------------------------------------------------
447      ! Initialize the adjoint variables: dy^* = W dy
448      !--------------------------------------------------------------------
449
450      DO jk = 1, jpk
451        DO jj = nldj, nlej
452           DO ji = nldi, nlei
453              zta_adin(ji,jj,jk) = zta_tlout(ji,jj,jk) &
454                 &               * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) &
455                 &               * tmask(ji,jj,jk) * wesp_t(jk)
456              zsa_adin(ji,jj,jk) = zsa_tlout(ji,jj,jk) &
457                 &               * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) &
458                 &               * tmask(ji,jj,jk) * wesp_s(jk)
459#if defined key_obc
460              ztb_adin(ji,jj,jk) = ztb_tlout(ji,jj,jk) &
461                 &               * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) &
462                 &               * tmask(ji,jj,jk) * wesp_t(jk)
463              zsb_adin(ji,jj,jk) = zsb_tlout(ji,jj,jk) &
464                 &               * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) &
465                 &               * tmask(ji,jj,jk) * wesp_s(jk)
466
467#endif
468            END DO
469         END DO
470      END DO
471      !--------------------------------------------------------------------
472      ! Compute the scalar product: ( L dx )^T W dy
473      !--------------------------------------------------------------------
474
475      zsp1 = DOT_PRODUCT( zta_tlout, zta_adin ) &
476         & + DOT_PRODUCT( zsa_tlout, zsa_adin )
477
478#if defined key_obc
479      zsp1 = zsp1 + DOT_PRODUCT( ztb_tlout, ztb_adin ) &
480           &      + DOT_PRODUCT( zsb_tlout, zsb_adin )
481#endif
482
483      !--------------------------------------------------------------------
484      ! Call the adjoint routine: dx^* = L^T dy^*
485      !--------------------------------------------------------------------
486
487      tsa_ad(:,:,:,jp_tem) = zta_adin(:,:,:)
488      tsa_ad(:,:,:,jp_sal) = zsa_adin(:,:,:)
489
490#if defined key_obc
491      tsb_ad(:,:,:,jp_tem) = ztb_adin(:,:,:)
492      tsb_ad(:,:,:,jp_sal) = zsb_adin(:,:,:)
493#endif
494
495      CALL tra_zdf_exp_adj ( nit000, nit000, 'TRA', r2dtra, 1, tsb_ad, tsa_ad, jpts )
496
497      zta_adout(:,:,:) = tsa_ad(:,:,:,jp_tem)
498      zsa_adout(:,:,:) = tsa_ad(:,:,:,jp_sal)
499      ztb_adout(:,:,:) = tsb_ad(:,:,:,jp_tem)
500      zsb_adout(:,:,:) = tsb_ad(:,:,:,jp_sal)
501
502      zsp2 = DOT_PRODUCT( zta_tlin, zta_adout ) &
503         & + DOT_PRODUCT( zsa_tlin, zsa_adout ) &
504         & + DOT_PRODUCT( ztb_tlin, ztb_adout ) &
505         & + DOT_PRODUCT( zsb_tlin, zsb_adout )
506
507      ! 14 char:'12345678901234'
508      cl_name = 'trazdf_exp_adj'
509      CALL prntst_adj( cl_name, kumadt, zsp1, zsp2 )
510
511      DEALLOCATE(   &
512         & zta_tlin,  &
513         & ztb_tlin,  &
514         & zsa_tlin,  &
515         & zsb_tlin,  &
516         & zta_tlout, &
517         & zsa_tlout, &
518         & zta_adin,  &
519         & zsa_adin,  &
520         & zta_adout, &
521         & ztb_adout, &
522         & zsa_adout, &
523         & zsb_adout, &
524         & zr       &
525         & )
526
527
528
529   END SUBROUTINE tra_zdf_exp_adj_tst
530
531   !!==============================================================================
532#endif
533END MODULE trazdf_exp_tam
Note: See TracBrowser for help on using the repository browser.