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.F90 in NEMO/branches/UKMO/dev_r12745_HPC-02_Daley_Tiling_trial_structure/src/OCE/TRA – NEMO

source: NEMO/branches/UKMO/dev_r12745_HPC-02_Daley_Tiling_trial_structure/src/OCE/TRA/traldf_iso.F90 @ 12766

Last change on this file since 12766 was 12766, checked in by hadcv, 4 years ago

tra_ldf_iso trial using structures
  • Property svn:keywords set to Id
File size: 19.6 KB
Line 
1MODULE traldf_iso
2   !!======================================================================
3   !!                   ***  MODULE  traldf_iso  ***
4   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
5   !!======================================================================
6   !! History :  OPA  ! 1994-08  (G. Madec, M. Imbard)
7   !!            8.0  ! 1997-05  (G. Madec)  split into traldf and trazdf
8   !!            NEMO ! 2002-08  (G. Madec)  Free form, F90
9   !!            1.0  ! 2005-11  (G. Madec)  merge traldf and trazdf :-)
10   !!            3.3  ! 2010-09  (C. Ethe, G. Madec) Merge TRA-TRC
11   !!            3.7  ! 2014-01  (G. Madec, S. Masson)  restructuration/simplification of aht/aeiv specification
12   !!             -   ! 2014-02  (F. Lemarie, G. Madec)  triad operator (Griffies) + Method of Stabilizing Correction
13   !!----------------------------------------------------------------------
14
15   !!----------------------------------------------------------------------
16   !!   tra_ldf_iso   : update the tracer trend with the horizontal component of a iso-neutral laplacian operator
17   !!                   and with the vertical part of the isopycnal or geopotential s-coord. operator
18   !!----------------------------------------------------------------------
19   USE oce            ! ocean dynamics and active tracers
20   USE dom_oce        ! ocean space and time domain
21   USE trc_oce        ! share passive tracers/Ocean variables
22   USE zdf_oce        ! ocean vertical physics
23   USE ldftra         ! lateral diffusion: tracer eddy coefficients
24   USE ldfslp         ! iso-neutral slopes
25   USE diaptr         ! poleward transport diagnostics
26   USE diaar5         ! AR5 diagnostics
27   !
28   USE in_out_manager ! I/O manager
29   USE iom            ! I/O library
30   USE phycst         ! physical constants
31   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
32
33   IMPLICIT NONE
34   PRIVATE
35
36   PUBLIC   tra_ldf_iso   ! routine called by step.F90
37
38   !! * Substitutions
39#  include "do_loop_substitute.h90"
40   !!----------------------------------------------------------------------
41   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
42   !! $Id$
43   !! Software governed by the CeCILL license (see ./LICENSE)
44   !!----------------------------------------------------------------------
45CONTAINS
46
47  SUBROUTINE tra_ldf_iso( ktile, kt, Kmm, kit000, cdtype, pahu, pahv,                    &
48      &                                            pgu , pgv    ,   pgui, pgvi,   &
49      &                                       pt , pt2 , pt_rhs , kjpt  , kpass )
50      !!----------------------------------------------------------------------
51      !!                  ***  ROUTINE tra_ldf_iso  ***
52      !!
53      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive
54      !!      trend for a laplacian tensor (ezxcept the dz[ dz[.] ] term) and
55      !!      add it to the general trend of tracer equation.
56      !!
57      !! ** Method  :   The horizontal component of the lateral diffusive trends
58      !!      is provided by a 2nd order operator rotated along neural or geopo-
59      !!      tential surfaces to which an eddy induced advection can be added
60      !!      It is computed using before fields (forward in time) and isopyc-
61      !!      nal or geopotential slopes computed in routine ldfslp.
62      !!
63      !!      1st part :  masked horizontal derivative of T  ( di[ t ] )
64      !!      ========    with partial cell update if ln_zps=T
65      !!                  with top     cell update if ln_isfcav
66      !!
67      !!      2nd part :  horizontal fluxes of the lateral mixing operator
68      !!      ========   
69      !!         zftu =  pahu e2u*e3u/e1u di[ tb ]
70      !!               - pahu e2u*uslp    dk[ mi(mk(tb)) ]
71      !!         zftv =  pahv e1v*e3v/e2v dj[ tb ]
72      !!               - pahv e2u*vslp    dk[ mj(mk(tb)) ]
73      !!      take the horizontal divergence of the fluxes:
74      !!         difft = 1/(e1e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  }
75      !!      Add this trend to the general trend (ta,sa):
76      !!         ta = ta + difft
77      !!
78      !!      3rd part: vertical trends of the lateral mixing operator
79      !!      ========  (excluding the vertical flux proportional to dk[t] )
80      !!      vertical fluxes associated with the rotated lateral mixing:
81      !!         zftw = - {  mi(mk(pahu)) * e2t*wslpi di[ mi(mk(tb)) ]
82      !!                   + mj(mk(pahv)) * e1t*wslpj dj[ mj(mk(tb)) ]  }
83      !!      take the horizontal divergence of the fluxes:
84      !!         difft = 1/(e1e2t*e3t) dk[ zftw ]
85      !!      Add this trend to the general trend (ta,sa):
86      !!         pt_rhs = pt_rhs + difft
87      !!
88      !! ** Action :   Update pt_rhs arrays with the before rotated diffusion
89      !!----------------------------------------------------------------------
90      TYPE(TILE)                           , INTENT(in   ) ::   ktile      ! Tile indices
91      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
92      INTEGER                              , INTENT(in   ) ::   kit000     ! first time step index
93      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
94      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
95      INTEGER                              , INTENT(in   ) ::   kpass      ! =1/2 first or second passage
96      INTEGER                              , INTENT(in   ) ::   Kmm        ! ocean time level index
97      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s]
98      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
99      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels
100      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt         ! tracer (kpass=1) or laplacian of tracer (kpass=2)
101      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt2        ! tracer (only used in kpass=2)
102      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs     ! tracer trend
103      !
104      LOGICAL  ::  l_ptr                                 ! flag to compute poleward transport
105      LOGICAL  ::  l_hst                                 ! flag to compute heat transport
106      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
107      INTEGER  ::  ikt
108      INTEGER  ::  ierr             ! local integer
109      REAL(wp) ::  zmsku, zahu_w, zabe1, zcof1, zcoef3   ! local scalars
110      REAL(wp) ::  zmskv, zahv_w, zabe2, zcof2, zcoef4   !   -      -
111      REAL(wp) ::  zcoef0, ze3w_2, zsign                 !   -      -
112      REAL(wp), DIMENSION(IND_2D)     ::   zdkt, zdk1t, z2d
113      REAL(wp), DIMENSION(IND_2D,jpk) ::   zdit, zdjt, zftu, zftv, ztfw
114      !!----------------------------------------------------------------------
115      !
116      IF( kpass == 1 .AND. kt == kit000 )  THEN
117         IF( ktile % ntile == 1 )  THEN               ! Do only on the first tile
118            ! TODO: TO BE TILED
119            IF(lwp) WRITE(numout,*)
120            IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype
121            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
122         ENDIF
123         !
124         DO_3D_11_11_T( 1, jpk )
125            akz     (ji,jj,jk) = 0._wp
126            ah_wslp2(ji,jj,jk) = 0._wp
127         END_3D
128      ENDIF
129      !   
130      l_hst = .FALSE.
131      l_ptr = .FALSE.
132      IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) )     l_ptr = .TRUE. 
133      IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
134         &                        iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )   l_hst = .TRUE.
135      !
136      !
137      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0)
138      ELSE                    ;   zsign = -1._wp
139      ENDIF
140         
141      !!----------------------------------------------------------------------
142      !!   0 - calculate  ah_wslp2 and akz
143      !!----------------------------------------------------------------------
144      !
145      IF( kpass == 1 ) THEN                  !==  first pass only  ==!
146         !
147         DO_3D_00_00_T( 2, jpkm1 )
148            !
149            zmsku = wmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          &
150               &                           + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk) , 1._wp  )
151            zmskv = wmask(ji,jj,jk) / MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)          &
152               &                           + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk) , 1._wp  )
153               !
154            zahu_w = (   pahu(ji  ,jj,jk-1) + pahu(ji-1,jj,jk)    &
155               &       + pahu(ji-1,jj,jk-1) + pahu(ji  ,jj,jk)  ) * zmsku
156            zahv_w = (   pahv(ji,jj  ,jk-1) + pahv(ji,jj-1,jk)    &
157               &       + pahv(ji,jj-1,jk-1) + pahv(ji,jj  ,jk)  ) * zmskv
158               !
159            ah_wslp2(ji,jj,jk) = zahu_w * wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   &
160               &               + zahv_w * wslpj(ji,jj,jk) * wslpj(ji,jj,jk)
161         END_3D
162         !
163         IF( ln_traldf_msc ) THEN                ! stabilizing vertical diffusivity coefficient
164            DO_3D_00_00_T( 2, jpkm1 )
165               akz(ji,jj,jk) = 0.25_wp * (                                                                     &
166                  &              ( pahu(ji  ,jj,jk) + pahu(ji  ,jj,jk-1) ) / ( e1u(ji  ,jj) * e1u(ji  ,jj) )   &
167                  &            + ( pahu(ji-1,jj,jk) + pahu(ji-1,jj,jk-1) ) / ( e1u(ji-1,jj) * e1u(ji-1,jj) )   &
168                  &            + ( pahv(ji,jj  ,jk) + pahv(ji,jj  ,jk-1) ) / ( e2v(ji,jj  ) * e2v(ji,jj  ) )   &
169                  &            + ( pahv(ji,jj-1,jk) + pahv(ji,jj-1,jk-1) ) / ( e2v(ji,jj-1) * e2v(ji,jj-1) )   )
170            END_3D
171            !
172            IF( ln_traldf_blp ) THEN                ! bilaplacian operator
173               DO_3D_10_10_T( 2, jpkm1 )
174                  akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk)   &
175                     &          * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) )  )
176               END_3D
177            ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator
178               DO_3D_10_10_T( 2, jpkm1 )
179                  ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm)
180                  zcoef0 = rDt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  )
181                  akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * r1_Dt
182               END_3D
183           ENDIF
184           !
185         ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit
186            DO_3D_11_11_T( 1, jpk )
187               akz(ji,jj,jk) = ah_wslp2(ji,jj,jk)
188            END_3D
189         ENDIF
190      ENDIF
191      !
192      !                                                          ! ===========
193      DO jn = 1, kjpt                                            ! tracer loop
194         !                                                       ! ===========
195         !                                               
196         !!----------------------------------------------------------------------
197         !!   I - masked horizontal derivative
198         !!----------------------------------------------------------------------
199!!gm : bug.... why (x,:,:)?   (1,jpj,:) and (jpi,1,:) should be sufficient....
200         zdit (1,:,:) = 0._wp     ;     zdit (jpi,:,:) = 0._wp
201         zdjt (1,:,:) = 0._wp     ;     zdjt (jpi,:,:) = 0._wp
202         !!end
203
204         ! Horizontal tracer gradient
205         DO_3D_10_10_T( 1, jpkm1 )
206            zdit(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk)
207            zdjt(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
208         END_3D
209         IF( ln_zps ) THEN      ! botton and surface ocean correction of the horizontal gradient
210            DO_2D_10_10_T
211               zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)         
212               zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn)
213            END_2D
214            IF( ln_isfcav ) THEN      ! first wet level beneath a cavity
215               DO_2D_10_10_T
216                  IF( miku(ji,jj) > 1 )   zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn)         
217                  IF( mikv(ji,jj) > 1 )   zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn)     
218               END_2D
219            ENDIF
220         ENDIF
221         !
222         !!----------------------------------------------------------------------
223         !!   II - horizontal trend  (full)
224         !!----------------------------------------------------------------------
225         !
226         DO jk = 1, jpkm1                                 ! Horizontal slab
227            !
228            DO_2D_11_11_T
229               !                             !== Vertical tracer gradient
230               zdk1t(ji,jj) = ( pt(ji,jj,jk,jn) - pt(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1)     ! level jk+1
231               !
232               IF( jk == 1 ) THEN   ;   zdkt(ji,jj) = zdk1t(ji,jj)                          ! surface: zdkt(jk=1)=zdkt(jk=2)
233               ELSE                 ;   zdkt(ji,jj) = ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) * wmask(ji,jj,jk)
234               ENDIF
235            END_2D
236            !
237            DO_2D_10_10_T
238               zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm)
239               zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm)
240               !
241               zmsku = 1. / MAX(  wmask(ji+1,jj,jk  ) + wmask(ji,jj,jk+1)   &
242                  &             + wmask(ji+1,jj,jk+1) + wmask(ji,jj,jk  ), 1. )
243               !
244               zmskv = 1. / MAX(  wmask(ji,jj+1,jk  ) + wmask(ji,jj,jk+1)   &
245                  &             + wmask(ji,jj+1,jk+1) + wmask(ji,jj,jk  ), 1. )
246               !
247               zcof1 = - pahu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku
248               zcof2 = - pahv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv
249               !
250               zftu(ji,jj,jk ) = (  zabe1 * zdit(ji,jj,jk)   &
251                  &               + zcof1 * (  zdkt (ji+1,jj) + zdk1t(ji,jj)      &
252                  &                          + zdk1t(ji+1,jj) + zdkt (ji,jj)  )  ) * umask(ji,jj,jk)
253               zftv(ji,jj,jk) = (  zabe2 * zdjt(ji,jj,jk)   &
254                  &               + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj)      &
255                  &                          + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  ) * vmask(ji,jj,jk)                 
256            END_2D
257            !
258            DO_2D_00_00_T
259               pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + zsign * (  zftu(ji,jj,jk) - zftu(ji-1,jj,jk)      &
260                  &                                                 + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )   &
261                  &                                              * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
262            END_2D
263         END DO                                        !   End of slab 
264
265         !!----------------------------------------------------------------------
266         !!   III - vertical trend (full)
267         !!----------------------------------------------------------------------
268         !
269         ! Vertical fluxes
270         ! ---------------
271         !                          ! Surface and bottom vertical fluxes set to zero
272         ztfw(:,:, 1 ) = 0._wp      ;      ztfw(:,:,jpk) = 0._wp
273         
274         DO_3D_00_00_T( 2, jpkm1 )
275            !
276            zmsku = wmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          &
277               &                           + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk) , 1._wp  )
278            zmskv = wmask(ji,jj,jk) / MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)          &
279               &                           + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk) , 1._wp  )
280               !
281            zahu_w = (   pahu(ji  ,jj,jk-1) + pahu(ji-1,jj,jk)    &
282               &       + pahu(ji-1,jj,jk-1) + pahu(ji  ,jj,jk)  ) * zmsku
283            zahv_w = (   pahv(ji,jj  ,jk-1) + pahv(ji,jj-1,jk)    &
284               &       + pahv(ji,jj-1,jk-1) + pahv(ji,jj  ,jk)  ) * zmskv
285               !
286            zcoef3 = - zahu_w * e2t(ji,jj) * zmsku * wslpi (ji,jj,jk)   !wslpi & j are already w-masked
287            zcoef4 = - zahv_w * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk)
288            !
289            ztfw(ji,jj,jk) = zcoef3 * (   zdit(ji  ,jj  ,jk-1) + zdit(ji-1,jj  ,jk)      &
290               &                        + zdit(ji-1,jj  ,jk-1) + zdit(ji  ,jj  ,jk)  )   &
291               &           + zcoef4 * (   zdjt(ji  ,jj  ,jk-1) + zdjt(ji  ,jj-1,jk)      &
292               &                        + zdjt(ji  ,jj-1,jk-1) + zdjt(ji  ,jj  ,jk)  )
293         END_3D
294         !                                !==  add the vertical 33 flux  ==!
295         IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz
296            DO_3D_00_00_T( 2, jpkm1 )
297               ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk)   &
298                  &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )               &
299                  &                            * (  pt(ji,jj,jk-1,jn) -  pt(ji,jj,jk,jn) )
300            END_3D
301            !
302         ELSE                                   ! bilaplacian
303            SELECT CASE( kpass )
304            CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2
305               DO_3D_00_00_T( 2, jpkm1 )
306                  ztfw(ji,jj,jk) = ztfw(ji,jj,jk)                       &
307                     &           + ah_wslp2(ji,jj,jk)  * e1e2t(ji,jj)   &
308                     &           * ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk)
309               END_3D
310            CASE(  2  )                         ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt  and pt2 gradients, resp.
311               DO_3D_00_00_T( 2, jpkm1 )
312                  ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk)                  &
313                     &                            * (  ah_wslp2(ji,jj,jk) * ( pt (ji,jj,jk-1,jn) - pt (ji,jj,jk,jn) )   &
314                     &                            +         akz(ji,jj,jk) * ( pt2(ji,jj,jk-1,jn) - pt2(ji,jj,jk,jn) )   )
315               END_3D
316            END SELECT
317         ENDIF
318         !         
319         DO_3D_00_00_T( 1, jpkm1 )
320            pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + zsign * (  ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1)  )   &
321               &                                              * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
322         END_3D
323         !
324         IF( ktile % ntile == jpnijtile )  THEN                ! Do only after all tiles finish
325            IF( ( kpass == 1 .AND. ln_traldf_lap ) .OR.  &     !==  first pass only (  laplacian)  ==!
326                ( kpass == 2 .AND. ln_traldf_blp ) ) THEN      !==  2nd   pass      (bilaplacian)  ==!
327               !
328               !                             ! "Poleward" diffusive heat or salt transports (T-S case only)
329                  ! note sign is reversed to give down-gradient diffusive transports )
330               ! TODO: TO BE TILED
331               IF( l_ptr )  CALL dia_ptr_hst( jn, 'ldf', -zftv(:,:,:)  )
332               !                          ! Diffusive heat transports
333               ! TODO: TO BE TILED
334               IF( l_hst )  CALL dia_ar5_hst( jn, 'ldf', -zftu(:,:,:), -zftv(:,:,:) )
335               !
336            ENDIF                                                    !== end pass selection  ==!
337         ENDIF
338         !
339         !                                                        ! ===============
340      END DO                                                      ! end tracer loop
341      !
342   END SUBROUTINE tra_ldf_iso
343
344   !!==============================================================================
345END MODULE traldf_iso
Note: See TracBrowser for help on using the repository browser.