source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90 @ 4409

Last change on this file since 4409 was 4409, checked in by trackstand2, 7 years ago

Changes to allow jpk to be modified to deepest level within a subdomain. jpkorig holds original value.

  • Property svn:keywords set to Id
File size: 9.7 KB
Line 
1MODULE trazdf_exp
2   !!==============================================================================
3   !!                    ***  MODULE  trazdf_exp  ***
4   !! Ocean  tracers:  vertical component of the tracer mixing trend using
5   !!                  a split-explicit time-stepping
6   !!==============================================================================
7   !! History :  OPA  !  1990-10  (B. Blanke)  Original code
8   !!            7.0  !  1991-11  (G. Madec)
9   !!                 !  1992-06  (M. Imbard)  correction on tracer trend loops
10   !!                 !  1996-01  (G. Madec)  statement function for e3
11   !!                 !  1997-05  (G. Madec)  vertical component of isopycnal
12   !!                 !  1997-07  (G. Madec)  geopotential diffusion in s-coord
13   !!                 !  2000-08  (G. Madec)  double diffusive mixing
14   !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form and module
15   !!             -   !  2004-08  (C. Talandier) New trends organisation
16   !!             -   !  2005-11  (G. Madec)  New organisation
17   !!            3.0  !  2008-04  (G. Madec)  leap-frog time stepping done in trazdf
18   !!            3.3  !  2010-06  (C. Ethe, G. Madec) Merge TRA-TRC
19   !!----------------------------------------------------------------------
20
21   !!----------------------------------------------------------------------
22   !!   tra_zdf_exp  : compute the tracer the vertical diffusion trend using a
23   !!                  split-explicit time stepping and provide the after tracer
24   !!----------------------------------------------------------------------
25   USE oce             ! ocean dynamics and active tracers
26   USE dom_oce         ! ocean space and time domain
27   USE domvvl          ! variable volume levels
28   USE zdf_oce         ! ocean vertical physics
29   USE zdfddm          ! ocean vertical physics: double diffusion
30   USE trc_oce         ! share passive tracers/Ocean variables
31   USE in_out_manager  ! I/O manager
32   USE lib_mpp         ! MPP library
33
34   IMPLICIT NONE
35   PRIVATE
36
37   PUBLIC   tra_zdf_exp   ! routine called by step.F90
38
39   !! * Control permutation of array indices
40#  include "oce_ftrans.h90"
41#  include "dom_oce_ftrans.h90"
42#  include "domvvl_ftrans.h90"
43#  include "zdf_oce_ftrans.h90"
44#  include "zdfddm_ftrans.h90"
45#  include "trc_oce_ftrans.h90"
46
47   !! * Substitutions
48#  include "domzgr_substitute.h90"
49#  include "zdfddm_substitute.h90"
50#  include "vectopt_loop_substitute.h90"
51   !!----------------------------------------------------------------------
52   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
53   !! $Id$
54   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
55   !!----------------------------------------------------------------------
56CONTAINS
57
58   SUBROUTINE tra_zdf_exp( kt, cdtype, p2dt, kn_zdfexp,   &
59      &                                ptb , pta      , kjpt )
60      !!----------------------------------------------------------------------
61      !!                  ***  ROUTINE tra_zdf_exp  ***
62      !!                   
63      !! ** Purpose :   Compute the after tracer fields due to the vertical
64      !!      tracer mixing alone, and then due to the whole tracer trend.
65      !!
66      !! ** Method  : - The after tracer fields due to the vertical diffusion
67      !!      of tracers alone is given by:
68      !!                zwx = ptb + p2dt difft
69      !!      where difft = dz( avt dz(ptb) ) = 1/e3t dk+1( avt/e3w dk(ptb) )
70      !!           (if lk_zdfddm=T use avs on salinity and passive tracers instead of avt)
71      !!      difft is evaluated with an Euler split-explit scheme using a
72      !!      no flux boundary condition at both surface and bottomi boundaries.
73      !!      (N.B. bottom condition is applied through the masked field avt).
74      !!              - the after tracer fields due to the whole trend is
75      !!      obtained in leap-frog environment by :
76      !!          pta = zwx + p2dt pta
77      !!              - in case of variable level thickness (lk_vvl=T) the
78      !!     the leap-frog is applied on thickness weighted tracer. That is:
79      !!          pta = [ ptb*e3tb + e3tn*( zwx - ptb + p2dt pta ) ] / e3tn
80      !!
81      !! ** Action : - after tracer fields pta
82      !!---------------------------------------------------------------------
83      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
84      USE wrk_nemo, ONLY:   zwx => wrk_3d_6, zwy => wrk_3d_7     ! 3D workspace
85
86      !! DCSE_NEMO: need additional directives for renamed module variables
87!FTRANS zwx zwy :I :I :z
88      !
89      INTEGER                              , INTENT(in   ) ::   kt          ! ocean time-step index
90      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype      ! =TRA or TRC (tracer indicator)
91      INTEGER                              , INTENT(in   ) ::   kjpt        ! number of tracers
92      INTEGER                              , INTENT(in   ) ::   kn_zdfexp   ! number of sub-time step
93      REAL(wp), DIMENSION(       jpkorig  ), INTENT(in   ) ::   p2dt        ! vertical profile of tracer time-step
94
95      !! DCSE_NEMO: This style defeats ftrans
96!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb         ! before and now tracer fields
97!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta         ! tracer trend
98
99!FTRANS ptb pta :I :I :z :
100      REAL(wp), INTENT(in   ) ::   ptb(jpi,jpj,jpkorig,kjpt)         ! before and now tracer fields
101      REAL(wp), INTENT(inout) ::   pta(jpi,jpj,jpkorig,kjpt)         ! tracer trend
102      !
103      INTEGER  ::  ji, jj, jk, jn, jl        ! dummy loop indices
104      REAL(wp) ::  zlavmr, zave3r, ze3tr     ! local scalars
105      REAL(wp) ::  ztra, ze3tb               !   -      -
106      !!---------------------------------------------------------------------
107
108      IF( wrk_in_use(3, 6,7) ) THEN
109         CALL ctl_stop('tra_zdf_exp: requested workspace arrays unavailable')   ;   RETURN
110      ENDIF
111
112      IF( kt == nit000 )  THEN
113         IF(lwp) WRITE(numout,*)
114         IF(lwp) WRITE(numout,*) 'tra_zdf_exp : explicit vertical mixing on ', cdtype
115         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
116      ENDIF
117
118      ! Initializations
119      ! ---------------
120      zlavmr = 1. / float( kn_zdfexp )         ! Local constant
121      !
122      !
123      DO jn = 1, kjpt                          ! loop over tracers
124         !
125         zwy(:,:, 1 ) = 0.e0     ! surface boundary conditions: no flux
126         zwy(:,:,jpk) = 0.e0     ! bottom  boundary conditions: no flux
127         !
128         zwx(:,:,:)   = ptb(:,:,:,jn)  ! zwx array set to before tracer values
129
130         ! Split-explicit loop  (after tracer due to the vertical diffusion alone)
131         ! -------------------
132         !
133         DO jl = 1, kn_zdfexp
134            !                     ! first vertical derivative
135#if defined key_z_first
136            DO jj = 2, jpjm1 
137               DO ji = 2, jpim1   ! vector opt.
138                  DO jk = 2, jpk
139#else
140            DO jk = 2, jpk
141               DO jj = 2, jpjm1 
142                  DO ji = fs_2, fs_jpim1   ! vector opt.
143#endif
144                     zave3r = 1.e0 / fse3w_n(ji,jj,jk) 
145                     IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN  ! temperature : use of avt
146                        zwy(ji,jj,jk) =   avt(ji,jj,jk) * ( zwx(ji,jj,jk-1) - zwx(ji,jj,jk) ) * zave3r
147                     ELSE                                           ! salinity or pass. tracer : use of avs
148                        zwy(ji,jj,jk) = fsavs(ji,jj,jk) * ( zwx(ji,jj,jk-1) - zwx(ji,jj,jk) ) * zave3r
149                     END IF
150                  END DO
151               END DO
152            END DO
153            !
154#if defined key_z_first
155            ! second vertical derivative   ==> tracer at kt+l*2*rdt/nn_zdfexp
156            DO jj = 2, jpjm1 
157               DO ji = 2, jpim1
158                  DO jk = 1, jpkm1
159#else
160            DO jk = 1, jpkm1      ! second vertical derivative   ==> tracer at kt+l*2*rdt/nn_zdfexp
161               DO jj = 2, jpjm1 
162                  DO ji = fs_2, fs_jpim1   ! vector opt.
163#endif
164                     ze3tr = zlavmr / fse3t_n(ji,jj,jk)
165                     zwx(ji,jj,jk) = zwx(ji,jj,jk) + p2dt(jk) * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) ) * ze3tr
166                  END DO
167               END DO
168            END DO
169            !
170         END DO
171
172         ! After tracer due to all trends
173         ! ------------------------------
174         IF( lk_vvl ) THEN          ! variable level thickness : leap-frog on tracer*e3t
175#if defined key_z_first
176            DO jj = 2, jpjm1 
177               DO ji = 2, jpim1
178                  DO jk = 1, jpkm1
179#else
180            DO jk = 1, jpkm1
181               DO jj = 2, jpjm1 
182                  DO ji = fs_2, fs_jpim1   ! vector opt.
183#endif
184                     ze3tb = fse3t_b(ji,jj,jk) / fse3t(ji,jj,jk)                          ! before e3t
185                     ztra  = zwx(ji,jj,jk) - ptb(ji,jj,jk,jn) + p2dt(jk) * pta(ji,jj,jk,jn)       ! total trends * 2*rdt
186                     pta(ji,jj,jk,jn) = ( ze3tb * ptb(ji,jj,jk,jn) + ztra ) * tmask(ji,jj,jk)
187                  END DO
188               END DO
189            END DO
190         ELSE                       ! fixed level thickness : leap-frog on tracers
191#if defined key_z_first
192            DO jj = 2, jpjm1 
193               DO ji = 2, jpim1
194                  DO jk = 1, jpkm1
195#else
196            DO jk = 1, jpkm1
197               DO jj = 2, jpjm1 
198                  DO ji = fs_2, fs_jpim1   ! vector opt.
199#endif
200                     pta(ji,jj,jk,jn) = ( zwx(ji,jj,jk) + p2dt(jk) * pta(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
201                  END DO
202               END DO
203            END DO
204         ENDIF
205         !
206      END DO
207      !
208      IF( wrk_not_released(3, 6,7) )   CALL ctl_stop('tra_zdf_exp: failed to release workspace arrays')
209      !
210   END SUBROUTINE tra_zdf_exp
211
212   !!==============================================================================
213END MODULE trazdf_exp
Note: See TracBrowser for help on using the repository browser.