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.
traldf_iso_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/traldf_iso_tam.F90 @ 3660

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

Add TAM code and ORCA2_TAM configuration - see Ticket #1007
  • Property svn:executable set to *
File size: 40.5 KB
Line 
1MODULE traldf_iso_tam
2#if defined key_tam
3   !!======================================================================
4   !!                   ***  MODULE  traldf_iso_tam  ***
5   !! Ocean active tracers:  horizontal component of the lateral tracer mixing trend
6   !!                        Tangent and adjoint module
7   !!======================================================================
8   !! History of the direct module:
9   !!                  !  94-08  (G. Madec, M. Imbard)
10   !!                  !  97-05  (G. Madec)  split into traldf and trazdf
11   !!             8.5  !  02-08  (G. Madec)  Free form, F90
12   !!             9.0  !  05-11  (G. Madec)  merge traldf and trazdf :-)
13   !! History of the T&A module:
14   !!             9.0  !  2008-12 (A. Vidard) original version
15   !!              -   !  2009-01 (A. Weaver) misc. bug fixes
16   !!      NEMO   3.2  !  2010-04 (F. Vigilant) 3.2 version
17   !!      NEMO   3.4  !  2012-07 (P.-A. Bouttier) 3.4 version
18   !!----------------------------------------------------------------------
19# if   defined key_ldfslp   ||   defined key_esopa
20   !!----------------------------------------------------------------------
21   !!   'key_ldfslp'               slope of the lateral diffusive direction
22   !!----------------------------------------------------------------------
23   !!----------------------------------------------------------------------
24   !!   tra_ldf_iso  : update the tracer trend with the horizontal
25   !!                  component of a iso-neutral laplacian operator
26   !!                  and with the vertical part of
27   !!                  the isopycnal or geopotential s-coord. operator
28   !!----------------------------------------------------------------------
29   USE par_oce
30   USE oce_tam
31   USE dom_oce
32   USE ldftra_oce
33!   USE zdf_oce         ! ocean vertical physics
34   USE in_out_manager
35   USE ldfslp
36   USE gridrandom
37   USE dotprodfld
38   USE tstool_tam
39   USE paresp
40   USE wrk_nemo        ! Memory Allocation
41   USE timing          ! Timing
42   USE trc_oce
43
44   IMPLICIT NONE
45   PRIVATE
46
47   PUBLIC   tra_ldf_iso_tan     ! routine called by tralfd_tam.F90
48   PUBLIC   tra_ldf_iso_adj     ! routine called by traldf_tam.F90
49   PUBLIC   tra_ldf_iso_adj_tst ! routine called by traldf_tam.F90
50
51   !! * Substitutions
52#  include "domzgr_substitute.h90"
53#  include "ldftra_substitute.h90"
54#  include "vectopt_loop_substitute.h90"
55   !!----------------------------------------------------------------------
56   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
57   !!----------------------------------------------------------------------
58
59CONTAINS
60
61   SUBROUTINE tra_ldf_iso_tan( kt, kit000, cdtype, pgu_tl, pgv_tl,              &
62      &                                ptb_tl, pta_tl, kjpt, pahtb0 )
63      !!----------------------------------------------------------------------
64      !!                  ***  ROUTINE tra_ldf_iso_tan  ***
65      !!
66      !! ** Purpose of the direct routine:
67      !!      Compute the before horizontal tracer (t & s) diffusive
68      !!      trend for a laplacian tensor (ezxcept the dz[ dz[.] ] term) and
69      !!      add it to the general trend of tracer equation.
70      !!
71      !! ** Method of the direct routine:
72      !!      The horizontal component of the lateral diffusive trends
73      !!      is provided by a 2nd order operator rotated along neural or geopo-
74      !!      tential surfaces to which an eddy induced advection can be added
75      !!      It is computed using before fields (forward in time) and isopyc-
76      !!      nal or geopotential slopes computed in routine ldfslp.
77      !!
78      !!      1st part :  masked horizontal derivative of T & S ( di[ t ] )
79      !!      ========    with partial cell update if ln_zps=T.
80      !!
81      !!      2nd part :  horizontal fluxes of the lateral mixing operator
82      !!      ========
83      !!         zftu = (aht+ahtb0) e2u*e3u/e1u di[ tb ]
84      !!               - aht       e2u*uslp    dk[ mi(mk(tb)) ]
85      !!         zftv = (aht+ahtb0) e1v*e3v/e2v dj[ tb ]
86      !!               - aht       e2u*vslp    dk[ mj(mk(tb)) ]
87      !!      take the horizontal divergence of the fluxes:
88      !!         difft = 1/(e1t*e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  }
89      !!      Add this trend to the general trend (ta,sa):
90      !!         ta = ta + difft
91      !!
92      !!      3rd part: vertical trends of the lateral mixing operator
93      !!      ========  (excluding the vertical flux proportional to dk[t] )
94      !!      vertical fluxes associated with the rotated lateral mixing:
95      !!         zftw =-aht {  e2t*wslpi di[ mi(mk(tb)) ]
96      !!                     + e1t*wslpj dj[ mj(mk(tb)) ]  }
97      !!      take the horizontal divergence of the fluxes:
98      !!         difft = 1/(e1t*e2t*e3t) dk[ zftw ]
99      !!      Add this trend to the general trend (ta,sa):
100      !!         ta = ta + difft
101      !!
102      !! ** Action :   Update (ta,sa) arrays with the before rotated diffusion
103      !!            trend (except the dk[ dk[.] ] term)
104      !!----------------------------------------------------------------------
105
106      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index
107      INTEGER                              , INTENT(in   ) ::   kit000           ! first time step index
108      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype           ! =TRA or TRC (tracer indicator)
109      INTEGER                              , INTENT(in   ) ::   kjpt             ! number of tracers
110      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu_tl, pgv_tl   ! tracer gradient at pstep levels
111      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb_tl           ! before and now tracer fields
112      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta_tl           ! tracer trend
113      REAL(wp)                             , INTENT(in   ) ::   pahtb0           ! background diffusion coef
114      !!
115      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
116      INTEGER  ::   iku, ikv     ! temporary integer
117      REAL(wp) ::   zmsku, zabe1, zcof1, zcoef3, ztatl   ! temporary scalars
118      REAL(wp) ::   zmskv, zabe2, zcof2, zcoef4, zsatl   !    "         "
119      REAL(wp) ::   zcoef0, zbtr                       !    "         "
120      REAL(wp), POINTER, DIMENSION(:,:)   ::   zdkttl , zdk1ttl, zftutl, zftvtl           ! 2D workspace
121      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdittl, zdjttl, ztfwtl     ! 3D workspace
122      !!----------------------------------------------------------------------
123      !
124      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_iso_tan')
125      !
126      CALL wrk_alloc( jpi, jpj,      zdkttl, zdk1ttl, zftutl, zftvtl )
127      CALL wrk_alloc( jpi, jpj, jpk, zdittl, zdjttl, ztfwtl  )
128      !
129      IF( kt == nit000 ) THEN
130         IF(lwp) WRITE(numout,*)
131         IF(lwp) WRITE(numout,*) 'tra_ldf_iso_tan : rotated laplacian diffusion operator on ', cdtype
132         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~'
133      ENDIF
134
135      DO jn = 1, kjpt
136         !!----------------------------------------------------------------------
137         !!   I - masked horizontal derivative of T & S
138         !!----------------------------------------------------------------------
139   !!bug ajout.... why?   ( 1,jpj,:) and (jpi,1,:) should be sufficient....
140         zdittl (1,:,:) = 0.e0     ;     zdittl (jpi,:,:) = 0.e0
141         zdjttl (1,:,:) = 0.e0     ;     zdjttl (jpi,:,:) = 0.e0
142   !!end
143
144         ! Horizontal temperature and salinity gradient
145         DO jk = 1, jpkm1
146            DO jj = 1, jpjm1
147               DO ji = 1, fs_jpim1   ! vector opt.
148                  zdittl(ji,jj,jk) = ( ptb_tl(ji+1,jj  ,jk, jn) - ptb_tl(ji,jj,jk, jn) ) * umask(ji,jj,jk)
149                  zdjttl(ji,jj,jk) = ( ptb_tl(ji  ,jj+1,jk, jn) - ptb_tl(ji,jj,jk, jn) ) * vmask(ji,jj,jk)
150               END DO
151            END DO
152         END DO
153         IF( ln_zps ) THEN      ! partial steps correction at the last level
154            DO jj = 1, jpjm1
155               DO ji = 1, fs_jpim1   ! vector opt.
156                  ! last level
157                  zdittl(ji,jj,mbku(ji,jj)) = pgu_tl(ji,jj,jn)
158                  zdjttl(ji,jj,mbkv(ji,jj)) = pgv_tl(ji,jj,jn)
159               END DO
160            END DO
161         ENDIF
162
163         !!----------------------------------------------------------------------
164         !!   II - horizontal trend of T & S (full)
165         !!----------------------------------------------------------------------
166
167         !                                                ! ===============
168         DO jk = 1, jpkm1                                 ! Horizontal slab
169            !                                             ! ===============
170            ! 1. Vertical tracer gradient at level jk and jk+1
171            ! ------------------------------------------------
172            ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
173
174            zdk1ttl(:,:) = ( ptb_tl(:,:,jk,jn) - ptb_tl(:,:,jk+1,jn) ) * tmask(:,:,jk+1)
175
176            IF( jk == 1 ) THEN
177               zdkttl(:,:) = zdk1ttl(:,:)
178            ELSE
179               zdkttl(:,:) = ( ptb_tl(:,:,jk-1,jn) - ptb_tl(:,:,jk,jn) ) * tmask(:,:,jk)
180            ENDIF
181
182            ! 2. Horizontal fluxes
183            ! --------------------
184
185            DO jj = 1 , jpjm1
186               DO ji = 1, fs_jpim1   ! vector opt.
187
188                  zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj)
189                  zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj)
190
191                  zmsku = 1.0_wp / MAX(  tmask(ji+1,jj,jk  ) + tmask(ji,jj,jk+1)   &
192                     &                 + tmask(ji+1,jj,jk+1) + tmask(ji,jj,jk  ), 1.0_wp )
193
194                  zmskv = 1.0_wp / MAX(  tmask(ji,jj+1,jk  ) + tmask(ji,jj,jk+1)   &
195                     &                 + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk  ), 1.0_wp )
196
197                  ! *** NOTE ***  uslp() and vslp() are not linearized.
198
199                  zcof1 = -fsahtu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku
200                  zcof2 = -fsahtv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv
201
202                  zftutl(ji,jj) = (  zabe1 * zdittl(ji,jj,jk)   &
203                     &              + zcof1 * (  zdkttl (ji+1,jj) + zdk1ttl(ji,jj)      &
204                     &                         + zdk1ttl(ji+1,jj) + zdkttl (ji,jj)  )  ) * umask(ji,jj,jk)
205                  zftvtl(ji,jj) = (  zabe2 * zdjttl(ji,jj,jk)   &
206                     &              + zcof2 * (  zdkttl (ji,jj+1) + zdk1ttl(ji,jj)      &
207                     &                         + zdk1ttl(ji,jj+1) + zdkttl (ji,jj)  )  ) * vmask(ji,jj,jk)
208               END DO
209            END DO
210
211
212            ! II.4 Second derivative (divergence) and add to the general trend
213            ! ----------------------------------------------------------------
214            DO jj = 2 , jpjm1
215               DO ji = fs_2, fs_jpim1   ! vector opt.
216                  zbtr= 1.0_wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
217                  ztatl = zbtr * (   zftutl(ji,jj) - zftutl(ji-1,jj  ) &
218                     &             + zftvtl(ji,jj) - zftvtl(ji  ,jj-1)  )
219                  pta_tl(ji,jj,jk,jn) = pta_tl(ji,jj,jk,jn) + ztatl
220               END DO
221            END DO
222            !                                          ! ===============
223         END DO                                        !   End of slab
224         !                                             ! ===============
225
226         !!----------------------------------------------------------------------
227         !!   III - vertical trend of T & S (extra diagonal terms only)
228         !!----------------------------------------------------------------------
229
230         ! Local constant initialization
231         ! -----------------------------
232         ztfwtl(1,:,:) = 0.0_wp     ;     ztfwtl(jpi,:,:) = 0.0_wp
233
234
235         ! Vertical fluxes
236         ! ---------------
237
238         ! Surface and bottom vertical fluxes set to zero
239         ztfwtl(:,:, 1 ) = 0.0_wp   ;     ztfwtl(:,:,jpk) = 0.0_wp
240
241         ! interior (2=<jk=<jpk-1)
242         DO jk = 2, jpkm1
243            DO jj = 2, jpjm1
244               DO ji = fs_2, fs_jpim1   ! vector opt.
245                  zcoef0 = - fsahtw(ji,jj,jk) * tmask(ji,jj,jk)
246
247                  zmsku = 1.0_wp / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)      &
248                     &                  + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk), 1.0_wp  )
249
250                  zmskv = 1.0_wp / MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)      &
251                     &                  + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk), 1.0_wp  )
252
253                  ! *** NOTE ***  wslpi() and wslpj() are not linearized.
254
255                  zcoef3 = zcoef0 * e2t(ji,jj) * zmsku * wslpi(ji,jj,jk)
256                  zcoef4 = zcoef0 * e1t(ji,jj) * zmskv * wslpj(ji,jj,jk)
257
258                  ztfwtl(ji,jj,jk) = zcoef3 * ( zdittl(ji  ,jj  ,jk-1) + zdittl(ji-1,jj  ,jk)      &
259                     &                        + zdittl(ji-1,jj  ,jk-1) + zdittl(ji  ,jj  ,jk)  )   &
260                     &             + zcoef4 * ( zdjttl(ji  ,jj  ,jk-1) + zdjttl(ji  ,jj-1,jk)      &
261                     &                        + zdjttl(ji  ,jj-1,jk-1) + zdjttl(ji  ,jj  ,jk)  )
262               END DO
263            END DO
264         END DO
265
266
267         ! I.5 Divergence of vertical fluxes added to the general tracer trend
268         ! -------------------------------------------------------------------
269
270         DO jk = 1, jpkm1
271            DO jj = 2, jpjm1
272               DO ji = fs_2, fs_jpim1   ! vector opt.
273                  zbtr =  1.0_wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
274
275                  ztatl = ( ztfwtl(ji,jj,jk) - ztfwtl(ji,jj,jk+1) ) * zbtr
276                  pta_tl(ji,jj,jk,jn) = pta_tl(ji,jj,jk,jn) + ztatl
277               END DO
278            END DO
279         END DO
280      END DO
281      !
282      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_iso_tan')
283      !
284      CALL wrk_dealloc( jpi, jpj,      zdkttl, zdk1ttl )
285      CALL wrk_dealloc( jpi, jpj, jpk, zdittl, zdjttl, ztfwtl  )
286      !
287   END SUBROUTINE tra_ldf_iso_tan
288
289   SUBROUTINE tra_ldf_iso_adj( kt, kit000, cdtype, pgu_ad, pgv_ad,              &
290      &                                ptb_ad, pta_ad, kjpt, pahtb0  )
291      !!----------------------------------------------------------------------
292      !!                  ***  ROUTINE tra_ldf_iso_adj  ***
293      !!
294      !! ** Purpose of the direct routine:
295      !!      Compute the before horizontal tracer (t & s) diffusive
296      !!      trend for a laplacian tensor (ezxcept the dz[ dz[.] ] term) and
297      !!      add it to the general trend of tracer equation.
298      !!
299      !! ** Method of the direct routine:
300      !!      The horizontal component of the lateral diffusive trends
301      !!      is provided by a 2nd order operator rotated along neural or geopo-
302      !!      tential surfaces to which an eddy induced advection can be added
303      !!      It is computed using before fields (forward in time) and isopyc-
304      !!      nal or geopotential slopes computed in routine ldfslp.
305      !!
306      !!      1st part :  masked horizontal derivative of T & S ( di[ t ] )
307      !!      ========    with partial cell update if ln_zps=T.
308      !!
309      !!      2nd part :  horizontal fluxes of the lateral mixing operator
310      !!      ========
311      !!         zftu = (aht+ahtb0) e2u*e3u/e1u di[ tb ]
312      !!               - aht       e2u*uslp    dk[ mi(mk(tb)) ]
313      !!         zftv = (aht+ahtb0) e1v*e3v/e2v dj[ tb ]
314      !!               - aht       e2u*vslp    dk[ mj(mk(tb)) ]
315      !!      take the horizontal divergence of the fluxes:
316      !!         difft = 1/(e1t*e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  }
317      !!      Add this trend to the general trend (ta,sa):
318      !!         ta = ta + difft
319      !!
320      !!      3rd part: vertical trends of the lateral mixing operator
321      !!      ========  (excluding the vertical flux proportional to dk[t] )
322      !!      vertical fluxes associated with the rotated lateral mixing:
323      !!         zftw =-aht {  e2t*wslpi di[ mi(mk(tb)) ]
324      !!                     + e1t*wslpj dj[ mj(mk(tb)) ]  }
325      !!      take the horizontal divergence of the fluxes:
326      !!         difft = 1/(e1t*e2t*e3t) dk[ zftw ]
327      !!      Add this trend to the general trend (ta,sa):
328      !!         ta = ta + difft
329      !!
330      !! ** Action :   Update (ta,sa) arrays with the before rotated diffusion
331      !!            trend (except the dk[ dk[.] ] term)
332      !!----------------------------------------------------------------------
333
334      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
335      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
336      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
337      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
338      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(inout   ) ::   pgu_ad, pgv_ad   ! tracer gradient at pstep levels
339      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout   ) ::   ptb_ad        ! before and now tracer fields
340      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout   ) ::   pta_ad        ! tracer trend
341      REAL(wp)                             , INTENT(in   ) ::   pahtb0     ! background diffusion coef
342      !!
343      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
344      INTEGER  ::   iku, ikv     ! temporary integer
345      REAL(wp) ::   zmsku, zabe1, zcof1, zcoef3, ztaad   ! temporary scalars
346      REAL(wp) ::   zmskv, zabe2, zcof2, zcoef4, zsaad   !    "         "
347      REAL(wp) ::   ztf3, ztf4, zsf3, zsf4               !
348      REAL(wp) ::   zcoef0, zbtr                       !    "         "
349      REAL(wp), POINTER, DIMENSION(:,:)     ::   zdktad , zdk1tad, zftuad, zftvad   ! 2D workspace
350      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zditad, zdjtad, zdisad, zdjsad, ztfwad     ! 3D workspace
351      !!----------------------------------------------------------------------
352      !
353      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_iso_adj')
354      !
355      CALL wrk_alloc( jpi, jpj,      zdktad, zdk1tad, zftuad, zftvad )
356      CALL wrk_alloc( jpi, jpj, jpk, zditad, zdjtad, ztfwad, zdjsad, zdisad  )
357      !
358      zditad(:,:,:) = 0.0_wp ;  zdjtad(:,:,:) = 0.0_wp ;  ztfwad(:,:,:) = 0.0_wp
359      zdktad(:,:) = 0.0_wp ;  zdk1tad(:,:) = 0.0_wp
360      zftuad(:,:) = 0.0_wp ;  zftvad (:,:) = 0.0_wp
361
362      IF( kt == nitend ) THEN
363         IF(lwp) WRITE(numout,*)
364         IF(lwp) WRITE(numout,*) 'tra_ldf_iso_adj : rotated laplacian diffusion operator on ', cdtype
365         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~'
366      ENDIF
367
368      DO jn = 1, kjpt
369         !!----------------------------------------------------------------------
370         !!   III - vertical trend of T & S (extra diagonal terms only)
371         !!----------------------------------------------------------------------
372         ! I.5 Divergence of vertical fluxes added to the general tracer trend
373         ! -------------------------------------------------------------------
374
375         DO jk = jpkm1, 1, -1
376            DO jj = jpjm1, 2, -1
377               DO ji = fs_jpim1, fs_2, -1   ! vector opt.
378                  zbtr =  1.0_wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
379                  ztaad = pta_ad(ji,jj,jk,jn) * zbtr
380                  ztfwad(ji,jj,jk  ) = ztfwad(ji,jj,jk  ) + ztaad
381                  ztfwad(ji,jj,jk+1) = ztfwad(ji,jj,jk+1) - ztaad
382               END DO
383            END DO
384         END DO
385         ! interior (2=<jk=<jpk-1)
386         DO jk = jpkm1, 2, -1
387            DO jj = jpjm1, 2, -1
388               DO ji = fs_jpim1, fs_2, -1   ! vector opt.
389                  zcoef0 = - fsahtw(ji,jj,jk) * tmask(ji,jj,jk)
390
391                  zmsku = 1.0_wp / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)      &
392                     &                  + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk), 1.0_wp  )
393
394                  zmskv = 1.0_wp / MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)      &
395                     &                  + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk), 1.0_wp  )
396
397                  ! *** NOTE ***  wslpi() and wslpj() are not linearized.
398
399                  zcoef3 = zcoef0 * e2t(ji,jj) * zmsku * wslpi(ji,jj,jk)
400                  zcoef4 = zcoef0 * e1t(ji,jj) * zmskv * wslpj(ji,jj,jk)
401
402                  ztf3 = ztfwad(ji,jj,jk) * zcoef3
403                  ztf4 = ztfwad(ji,jj,jk) * zcoef4
404
405                  zditad(ji  ,jj  ,jk-1) = zditad(ji  ,jj  ,jk-1) + ztf3
406                  zditad(ji-1,jj  ,jk  ) = zditad(ji-1,jj  ,jk  ) + ztf3
407                  zditad(ji-1,jj  ,jk-1) = zditad(ji-1,jj  ,jk-1) + ztf3
408                  zditad(ji  ,jj  ,jk  ) = zditad(ji  ,jj  ,jk  ) + ztf3
409
410                  zdjtad(ji  ,jj  ,jk-1) = zdjtad(ji  ,jj  ,jk-1) + ztf4
411                  zdjtad(ji  ,jj-1,jk  ) = zdjtad(ji  ,jj-1,jk  ) + ztf4
412                  zdjtad(ji  ,jj-1,jk-1) = zdjtad(ji  ,jj-1,jk-1) + ztf4
413                  zdjtad(ji  ,jj  ,jk  ) = zdjtad(ji  ,jj  ,jk  ) + ztf4
414
415                  ztfwad(ji,jj,jk) = 0.0_wp
416               END DO
417            END DO
418         END DO
419
420         ! Local constant initialization
421         ! -----------------------------
422         ztfwad(1,:,:) = 0.0_wp     ;     ztfwad(jpi,:,:) = 0.0_wp
423
424         ! Vertical fluxes
425         ! ---------------
426
427         ! Surface and bottom vertical fluxes set to zero
428         ztfwad(:,:, 1 ) = 0.0_wp   ;     ztfwad(:,:,jpk) = 0.0_wp
429
430         !!----------------------------------------------------------------------
431         !!   II - horizontal trend of T & S (full)
432         !!----------------------------------------------------------------------
433
434         !                                                ! ===============
435         DO jk = jpkm1, 1, -1                             ! Horizontal slab
436            !                                             ! ===============
437            ! II.4 Second derivative (divergence) and add to the general trend
438            ! ----------------------------------------------------------------
439            DO jj = jpjm1, 2, -1
440               DO ji = fs_jpim1, fs_2, -1   ! vector opt.
441
442                  zbtr= 1.0_wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
443                  ztaad = pta_ad(ji,jj,jk,jn) * zbtr
444
445                  zftuad(ji  ,jj  ) = zftuad(ji  ,jj  ) + ztaad
446                  zftuad(ji-1,jj  ) = zftuad(ji-1,jj  ) - ztaad
447                  zftvad(ji  ,jj  ) = zftvad(ji  ,jj  ) + ztaad
448                  zftvad(ji  ,jj-1) = zftvad(ji  ,jj-1) - ztaad
449               END DO
450            END DO
451
452            ! 2. Horizontal fluxes
453            ! --------------------
454            DO jj = jpjm1, 1, -1
455               DO ji = fs_jpim1, 1, -1   ! vector opt.
456                  zabe1 = umask(ji,jj,jk) * ( fsahtu(ji,jj,jk) + ahtb0 ) &
457                     &                    * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj)
458                  zabe2 = vmask(ji,jj,jk) * ( fsahtv(ji,jj,jk) + ahtb0 ) &
459                     &                    * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj)
460
461                  zmsku = 1.0_wp / MAX(  tmask(ji+1,jj,jk  ) + tmask(ji,jj,jk+1)   &
462                     &                 + tmask(ji+1,jj,jk+1) + tmask(ji,jj,jk  ), 1.0_wp )
463
464                  zmskv = 1.0_wp / MAX(  tmask(ji,jj+1,jk  ) + tmask(ji,jj,jk+1)   &
465                     &                 + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk  ), 1.0_wp )
466
467                  ! *** NOTE ***  uslp() and vslp() are not linearized.
468
469                  zcof1 = -fsahtu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku * umask(ji,jj,jk)
470                  zcof2 = -fsahtv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv * vmask(ji,jj,jk)
471
472                  zditad(ji,jj,jk) = zditad(ji,jj,jk) + zftuad(ji,jj) * zabe1
473
474                  zdktad (ji+1,jj) = zdktad (ji+1,jj) + zftuad(ji,jj) * zcof1
475                  zdktad (ji  ,jj) = zdktad (ji  ,jj) + zftuad(ji,jj) * zcof1
476                  zdk1tad(ji  ,jj) = zdk1tad(ji  ,jj) + zftuad(ji,jj) * zcof1
477                  zdk1tad(ji+1,jj) = zdk1tad(ji+1,jj) + zftuad(ji,jj) * zcof1
478                  zftuad (ji  ,jj) = 0.0_wp
479                  !
480                  zdjtad(ji,jj,jk) = zdjtad(ji,jj,jk) + zftvad(ji,jj) * zabe2
481
482                  zdktad (ji,jj+1) = zdktad (ji,jj+1) + zftvad(ji,jj) * zcof2
483                  zdktad (ji,jj  ) = zdktad (ji,jj  ) + zftvad(ji,jj) * zcof2
484                  zdk1tad(ji,jj  ) = zdk1tad(ji,jj  ) + zftvad(ji,jj) * zcof2
485                  zdk1tad(ji,jj+1) = zdk1tad(ji,jj+1) + zftvad(ji,jj) * zcof2
486                  zftvad (ji,jj  ) = 0.0_wp
487                  !
488               END DO
489            END DO
490
491            ! 1. Vertical tracer gradient at level jk and jk+1
492            ! ------------------------------------------------
493            ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
494
495            IF( jk == 1 ) THEN
496               zdk1tad(:,:) = zdk1tad(:,:) + zdktad(:,:)
497               zdktad(:,:)  = 0.0_wp
498            ELSE
499               ptb_ad(:,:,jk-1,jn) = ptb_ad(:,:,jk-1,jn) + zdktad(:,:) * tmask(:,:,jk)
500               ptb_ad(:,:,jk,jn  ) = ptb_ad(:,:,jk, jn ) - zdktad(:,:) * tmask(:,:,jk)
501               zdktad(:,:) = 0.0_wp
502            ENDIF
503            ptb_ad(:,:,jk,jn  ) = ptb_ad(:,:,jk,jn  ) + zdk1tad(:,:) * tmask(:,:,jk+1)
504            ptb_ad(:,:,jk+1,jn) = ptb_ad(:,:,jk+1,jn) - zdk1tad(:,:) * tmask(:,:,jk+1)
505            zdk1tad(:,:) = 0.0_wp
506            !                                          ! ===============
507         END DO                                        !   End of slab
508         !                                             ! ===============
509         !!----------------------------------------------------------------------
510         !!   I - masked horizontal derivative of T & S
511         !!----------------------------------------------------------------------
512         IF( ln_zps ) THEN      ! partial steps correction at the last level
513            DO jj = jpjm1, 1, -1
514               DO ji = fs_jpim1, 1, -1   ! vector opt.
515                  ! last level
516                  pgu_ad(ji,jj,jn) = pgu_ad(ji,jj,jn) + zditad(ji,jj,mbku(ji,jj))
517                  pgv_ad(ji,jj,jn) = pgv_ad(ji,jj,jn) + zdjtad(ji,jj,mbkv(ji,jj))
518
519                  zditad(ji,jj,mbku(ji,jj)) = 0.0_wp
520                  zdjtad(ji,jj,mbkv(ji,jj)) = 0.0_wp
521
522                  zdisad(ji,jj,mbku(ji,jj)) = 0.0_wp
523                  zdjsad(ji,jj,mbkv(ji,jj)) = 0.0_wp
524              END DO
525            END DO
526         ENDIF
527
528         ! Horizontal temperature and salinity gradient
529         DO jk = jpkm1, 1, -1
530            DO jj = jpjm1, 1, -1
531               DO ji = fs_jpim1, 1, -1   ! vector opt.
532                  zditad(ji,jj,jk) = zditad(ji,jj,jk) * umask(ji,jj,jk)
533                  zdjtad(ji,jj,jk) = zdjtad(ji,jj,jk) * vmask(ji,jj,jk)
534                  ptb_ad(ji+1,jj  ,jk,jn) = ptb_ad(ji+1,jj  ,jk,jn) + zditad(ji,jj,jk)
535                  ptb_ad(ji  ,jj  ,jk,jn) = ptb_ad(ji  ,jj  ,jk,jn) - zditad(ji,jj,jk)
536                  ptb_ad(ji  ,jj+1,jk,jn) = ptb_ad(ji  ,jj+1,jk,jn) + zdjtad(ji,jj,jk)
537                  ptb_ad(ji  ,jj  ,jk,jn) = ptb_ad(ji  ,jj  ,jk,jn) - zdjtad(ji,jj,jk)
538               END DO
539            END DO
540         END DO
541      END DO
542      !
543      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_iso_adj')
544      !
545      CALL wrk_dealloc( jpi, jpj,      zdktad, zdk1tad, zftuad, zftvad )
546      CALL wrk_dealloc( jpi, jpj, jpk, zditad, zdjtad, ztfwad  )
547      !
548   END SUBROUTINE tra_ldf_iso_adj
549
550   SUBROUTINE tra_ldf_iso_adj_tst ( kumadt )
551      !!-----------------------------------------------------------------------
552      !!
553      !!                  ***  ROUTINE example_adj_tst ***
554      !!
555      !! ** Purpose : Test the adjoint routine.
556      !!
557      !! ** Method  : Verify the scalar product
558      !!
559      !!                 ( L dx )^T W dy  =  dx^T L^T W dy
560      !!
561      !!              where  L   = tangent routine
562      !!                     L^T = adjoint routine
563      !!                     W   = diagonal matrix of scale factors
564      !!                     dx  = input perturbation (random field)
565      !!                     dy  = L dx
566      !!
567      !! History :
568      !!        ! 08-08 (A. Vidard)
569      !!-----------------------------------------------------------------------
570      !! * Modules used
571
572      !! * Arguments
573      INTEGER, INTENT(IN) :: &
574         & kumadt             ! Output unit
575
576      !! * Local declarations
577      INTEGER ::  &
578         & ji,    &        ! dummy loop indices
579         & jj,    &
580         & jk
581      INTEGER, DIMENSION(jpi,jpj) :: &
582         & iseed_2d        ! 2D seed for the random number generator
583      REAL(KIND=wp) :: &
584         & zsp1,         & ! scalar product involving the tangent routine
585         & zsp1_T,       &
586         & zsp1_S,       &
587         & zsp2,         & ! scalar product involving the adjoint routine
588         & zsp2_1,       &
589         & zsp2_2,       &
590         & zsp2_3,       &
591         & zsp2_4,       &
592         & zsp2_5,       &
593         & zsp2_6,       &
594         & zsp2_7,       &
595         & zsp2_8,       &
596         & zsp2_T,       &
597         & zsp2_S
598      REAL(KIND=wp), DIMENSION(:,:,:), ALLOCATABLE :: &
599         & ztb_tlin ,      & ! Tangent input
600         & zsb_tlin ,      & ! Tangent input
601         & zta_tlin ,      & ! Tangent input
602         & zsa_tlin ,      & ! Tangent input
603         & zta_tlout,      & ! Tangent output
604         & zsa_tlout,      & ! Tangent output
605         & zta_adin,       & ! Adjoint input
606         & zsa_adin,       & ! Adjoint input
607         & ztb_adout ,     & ! Adjoint output
608         & zsb_adout ,     & ! Adjoint output
609         & zta_adout ,     & ! Adjoint output
610         & zsa_adout ,     & ! Adjoint output
611         & z3r               ! 3D random field
612      REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: &
613         & zgtu_tlin ,     & ! Tangent input
614         & zgsu_tlin ,     & ! Tangent input
615         & zgtv_tlin ,     & ! Tangent input
616         & zgsv_tlin ,     & ! Tangent input
617         & zgtu_adout ,    & ! Adjoint output
618         & zgsu_adout ,    & ! Adjoint output
619         & zgtv_adout ,    & ! Adjoint output
620         & zgsv_adout ,    & ! Adjoint output
621         & z2r               ! 2D random field
622      CHARACTER(LEN=14) :: cl_name
623      ! Allocate memory
624
625      ALLOCATE( &
626         & ztb_tlin(jpi,jpj,jpk),      &
627         & zsb_tlin(jpi,jpj,jpk),      &
628         & zta_tlin(jpi,jpj,jpk),      &
629         & zsa_tlin(jpi,jpj,jpk),      &
630         & zgtu_tlin(jpi,jpj),         &
631         & zgsu_tlin(jpi,jpj),         &
632         & zgtv_tlin(jpi,jpj),         &
633         & zgsv_tlin(jpi,jpj),         &
634         & zta_tlout(jpi,jpj,jpk),     &
635         & zsa_tlout(jpi,jpj,jpk),     &
636         & zta_adin(jpi,jpj,jpk),      &
637         & zsa_adin(jpi,jpj,jpk),      &
638         & ztb_adout(jpi,jpj,jpk),     &
639         & zsb_adout(jpi,jpj,jpk),     &
640         & zta_adout(jpi,jpj,jpk),     &
641         & zsa_adout(jpi,jpj,jpk),     &
642         & zgtu_adout(jpi,jpj),        &
643         & zgsu_adout(jpi,jpj),        &
644         & zgtv_adout(jpi,jpj),        &
645         & zgsv_adout(jpi,jpj),        &
646         & z3r(jpi,jpj,jpk),           &
647         & z2r(jpi,jpj)                &
648         & )
649
650      ! Initialize the reference state
651      uslp (:,:,:) = 2.0_wp
652      vslp (:,:,:) = 3.0_wp
653      wslpi(:,:,:) = 4.0_wp
654      wslpj(:,:,:) = 5.0_wp
655
656      !=======================================================================
657      ! 1) dx = ( tb_tl, ta_tl, sb_tl, sa_tl, gtu_tl, gtv_tl, gsu_tl, gsv_tl )
658      !    dy = ( ta_tl, sa_tl )
659      !=======================================================================
660
661      !--------------------------------------------------------------------
662      ! Reset the tangent and adjoint variables
663      !--------------------------------------------------------------------
664
665      ztb_tlin(:,:,:)  = 0.0_wp
666      zsb_tlin(:,:,:)  = 0.0_wp
667      zta_tlin(:,:,:)  = 0.0_wp
668      zsa_tlin(:,:,:)  = 0.0_wp
669      zgtu_tlin(:,:)   = 0.0_wp
670      zgsu_tlin(:,:)   = 0.0_wp
671      zgtv_tlin(:,:)   = 0.0_wp
672      zgsv_tlin(:,:)   = 0.0_wp
673      zta_tlout(:,:,:) = 0.0_wp
674      zsa_tlout(:,:,:) = 0.0_wp
675      zta_adin(:,:,:)  = 0.0_wp
676      zsa_adin(:,:,:)  = 0.0_wp
677      ztb_adout(:,:,:) = 0.0_wp
678      zsb_adout(:,:,:) = 0.0_wp
679      zta_adout(:,:,:) = 0.0_wp
680      zsa_adout(:,:,:) = 0.0_wp
681      zgtu_adout(:,:)  = 0.0_wp
682      zgsu_adout(:,:)  = 0.0_wp
683      zgtv_adout(:,:)  = 0.0_wp
684      zgsv_adout(:,:)  = 0.0_wp
685
686      tsb_tl(:,:,:,:) = 0.0_wp
687      tsa_tl(:,:,:,:) = 0.0_wp
688      gtsu_tl(:,:,:)  = 0.0_wp
689      gtsv_tl(:,:,:)  = 0.0_wp
690      tsb_ad(:,:,:,:) = 0.0_wp
691      tsa_ad(:,:,:,:) = 0.0_wp
692      gtsu_ad(:,:,:)  = 0.0_wp
693      gtsv_ad(:,:,:)  = 0.0_wp
694
695      !--------------------------------------------------------------------
696      ! Initialize the tangent input with random noise: dx
697      !--------------------------------------------------------------------
698
699      CALL grid_random(  z3r, 'T', 0.0_wp, stdt )
700      DO jk = 1, jpk
701        DO jj = nldj, nlej
702           DO ji = nldi, nlei
703              ztb_tlin(ji,jj,jk) = z3r(ji,jj,jk)
704            END DO
705         END DO
706      END DO
707      CALL grid_random(  z3r, 'T', 0.0_wp, stds )
708      DO jk = 1, jpk
709        DO jj = nldj, nlej
710           DO ji = nldi, nlei
711              zsb_tlin(ji,jj,jk) = z3r(ji,jj,jk)
712            END DO
713         END DO
714      END DO
715      CALL grid_random(  z3r, 'T', 0.0_wp, stdt )
716      DO jk = 1, jpk
717        DO jj = nldj, nlej
718           DO ji = nldi, nlei
719              zta_tlin(ji,jj,jk) = z3r(ji,jj,jk)
720            END DO
721         END DO
722      END DO
723      CALL grid_random(  z3r, 'T', 0.0_wp, stds )
724      DO jk = 1, jpk
725        DO jj = nldj, nlej
726           DO ji = nldi, nlei
727              zsa_tlin(ji,jj,jk) = z3r(ji,jj,jk)
728            END DO
729         END DO
730      END DO
731      CALL grid_random(  z2r, 'U', 0.0_wp, stds )
732      DO jj = nldj, nlej
733         DO ji = nldi, nlei
734            zgtu_tlin(ji,jj) = z2r(ji,jj)
735         END DO
736      END DO
737      CALL grid_random(  z2r, 'U', 0.0_wp, stds )
738      DO jj = nldj, nlej
739        DO ji = nldi, nlei
740           zgsu_tlin(ji,jj) = z2r(ji,jj)
741        END DO
742      END DO
743      CALL grid_random(  z2r, 'V', 0.0_wp, stds )
744      DO jj = nldj, nlej
745        DO ji = nldi, nlei
746           zgtv_tlin(ji,jj) = z2r(ji,jj)
747        END DO
748      END DO
749      CALL grid_random(  z2r, 'V', 0.0_wp, stds )
750      DO jj = nldj, nlej
751        DO ji = nldi, nlei
752           zgsv_tlin(ji,jj) = z2r(ji,jj)
753        END DO
754      END DO
755
756      tsb_tl(:,:,:,jp_tem) = ztb_tlin(:,:,:)
757      tsb_tl(:,:,:,jp_sal) = zsb_tlin(:,:,:)
758      tsa_tl(:,:,:,jp_tem) = zta_tlin(:,:,:)
759      tsa_tl(:,:,:,jp_sal) = zsa_tlin(:,:,:)
760      gtsu_tl(:,:,jp_tem)  = zgtu_tlin(:,:)
761      gtsu_tl(:,:,jp_sal)  = zgsu_tlin(:,:)
762      gtsv_tl(:,:,jp_tem)  = zgtv_tlin(:,:)
763      gtsv_tl(:,:,jp_sal)  = zgsv_tlin(:,:)
764
765      CALL tra_ldf_iso_tan( nit000, nit000, 'TRA', gtsu_tl, gtsv_tl, tsb_tl, tsa_tl, jpts, ahtb0 )
766
767      zta_tlout(:,:,:) = tsa_tl(:,:,:,jp_tem)
768      zsa_tlout(:,:,:) = tsa_tl(:,:,:,jp_sal)
769
770      !--------------------------------------------------------------------
771      ! Initialize the adjoint variables: dy^* = W dy
772      !--------------------------------------------------------------------
773
774      DO jk = 1, jpk
775        DO jj = nldj, nlej
776           DO ji = nldi, nlei
777              zsa_adin(ji,jj,jk) = zsa_tlout(ji,jj,jk) &
778                 &               * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) &
779                 &               * tmask(ji,jj,jk) * wesp_s(jk)
780              zta_adin(ji,jj,jk) = zta_tlout(ji,jj,jk) &
781                 &               * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) &
782                 &               * tmask(ji,jj,jk) * wesp_t(jk)
783            END DO
784         END DO
785      END DO
786
787      !--------------------------------------------------------------------
788      ! Compute the scalar product: ( L dx )^T W dy
789      !--------------------------------------------------------------------
790
791      zsp1_T = DOT_PRODUCT( zta_tlout, zta_adin )
792      zsp1_S = DOT_PRODUCT( zsa_tlout, zsa_adin )
793      zsp1 = zsp1_T + zsp1_S
794
795      !--------------------------------------------------------------------
796      ! Call the adjoint routine: dx^* = L^T dy^*
797      !--------------------------------------------------------------------
798
799      tsa_ad(:,:,:,jp_tem) = zta_adin(:,:,:)
800      tsa_ad(:,:,:,jp_sal) = zsa_adin(:,:,:)
801
802      CALL tra_ldf_iso_adj( nit000, nit000, 'TRA', gtsu_ad, gtsv_ad, tsb_ad, tsa_ad, jpts, ahtb0 )
803
804      ztb_adout(:,:,:) = tsb_ad(:,:,:,jp_tem)
805      zsb_adout(:,:,:) = tsb_ad(:,:,:,jp_sal)
806      zta_adout(:,:,:) = tsa_ad(:,:,:,jp_tem)
807      zsa_adout(:,:,:) = tsa_ad(:,:,:,jp_sal)
808      zgtu_adout(:,:)  = gtsu_ad(:,:,jp_tem)
809      zgsu_adout(:,:)  = gtsu_ad(:,:,jp_sal)
810      zgtv_adout(:,:)  = gtsv_ad(:,:,jp_tem)
811      zgsv_adout(:,:)  = gtsv_ad(:,:,jp_sal)
812
813      zsp2_1 = DOT_PRODUCT( ztb_tlin , ztb_adout  )
814      zsp2_2 = DOT_PRODUCT( zta_tlin , zta_adout  )
815      zsp2_3 = DOT_PRODUCT( zgtu_tlin, zgtu_adout )
816      zsp2_4 = DOT_PRODUCT( zgtv_tlin, zgtv_adout )
817      zsp2_5 = DOT_PRODUCT( zsb_tlin , zsb_adout  )
818      zsp2_6 = DOT_PRODUCT( zsa_tlin , zsa_adout  )
819      zsp2_7 = DOT_PRODUCT( zgsu_tlin, zgsu_adout )
820      zsp2_8 = DOT_PRODUCT( zgsv_tlin, zgsv_adout )
821
822      zsp2_T = zsp2_1 + zsp2_2 + zsp2_3 + zsp2_4
823      zsp2_S = zsp2_5 + zsp2_6 + zsp2_7 + zsp2_8
824      zsp2   = zsp2_T + zsp2_S
825
826      cl_name = 'tra_ldf_iso_ad'
827      CALL prntst_adj( cl_name, kumadt, zsp1, zsp2 )
828
829      DEALLOCATE(         &
830         & ztb_tlin,      & ! Tangent input
831         & zsb_tlin,      & ! Tangent input
832         & zta_tlin,      & ! Tangent input
833         & zsa_tlin,      & ! Tangent input
834         & zgtu_tlin,     & ! Tangent input
835         & zgsu_tlin,     & ! Tangent input
836         & zgtv_tlin,     & ! Tangent input
837         & zgsv_tlin,     & ! Tangent input
838         & zta_tlout,     & ! Tangent output
839         & zsa_tlout,     & ! Tangent output
840         & zta_adin,      & ! Adjoint input
841         & zsa_adin,      & ! Adjoint input
842         & ztb_adout,     & ! Adjoint output
843         & zsb_adout,     & ! Adjoint output
844         & zta_adout,     & ! Adjoint output
845         & zsa_adout,     & ! Adjoint output
846         & zgtu_adout,    & ! Adjoint output
847         & zgsu_adout,    & ! Adjoint output
848         & zgtv_adout,    & ! Adjoint output
849         & zgsv_adout,    & ! Adjoint output
850         & z3r,           & ! 3D random field
851         & z2r            &
852         & )
853
854   END SUBROUTINE tra_ldf_iso_adj_tst
855# else
856   !!----------------------------------------------------------------------
857   !!   default option :   Dummy code   NO rotation of the diffusive tensor
858   !!----------------------------------------------------------------------
859CONTAINS
860   SUBROUTINE tra_ldf_iso_tan( kt, kit000, cdtype, pgu_tl, pgv_tl,    &
861      &                                ptb_tl, pta_tl, kjpt, pahtb0 )  ! Empty routine
862      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index
863      INTEGER                              , INTENT(in   ) ::   kit000           ! first time step index
864      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype           ! =TRA or TRC (tracer indicator)
865      INTEGER                              , INTENT(in   ) ::   kjpt             ! number of tracers
866      REAL, DIMENSION(:,:,:), INTENT(in   ) ::   pgu_tl, pgv_tl   ! tracer gradient at pstep levels
867      REAL, DIMENSION(:,:,:,:), INTENT(in   ) ::   ptb_tl           ! before and now tracer fields
868      REAL, DIMENSION(:,:,:,:), INTENT(inout) ::   pta_tl           ! tracer trend
869      REAL                             , INTENT(in   ) ::   pahtb0           ! background diffusion coef
870      !!
871      WRITE(*,*) 'tra_ldf_iso_tan: You should not have seen this print! error?', kt
872   END SUBROUTINE tra_ldf_iso_tan
873   SUBROUTINE tra_ldf_iso_adj( kt, kit000, cdtype, pgu_ad, pgv_ad,    &
874      &                                ptb_ad, pta_ad, kjpt, pahtb0  ) ! Empty routine
875      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
876      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
877      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
878      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
879      REAL, DIMENSION(:,:,:), INTENT(inout   ) ::   pgu_ad, pgv_ad   ! tracer gradient at pstep levels
880      REAL, DIMENSION(:,:,:,:), INTENT(inout   ) ::   ptb_ad        ! before and now tracer fields
881      REAL, DIMENSION(:,:,:,:), INTENT(inout   ) ::   pta_ad        ! tracer trend
882      REAL                             , INTENT(in   ) ::   pahtb0     ! background diffusion coef
883      !!
884      WRITE(*,*) 'tra_ldf_iso_adj: You should not have seen this print! error?', kt
885   END SUBROUTINE tra_ldf_iso_adj
886   SUBROUTINE tra_ldf_iso_adj_tst ( kumadt )
887      WRITE(*,*) 'tra_ldf_iso_adj_tst: You should not have seen this print! error?', kt
888   END SUBROUTINE tra_ldf_iso_adj_tst
889# endif
890#endif
891
892   !!==============================================================================
893END MODULE traldf_iso_tam
Note: See TracBrowser for help on using the repository browser.