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.
trdtra.F90 in branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/TRD – NEMO

source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 4 years ago

The Dr Hook changes from my perl code.

File size: 23.9 KB
Line 
1MODULE trdtra
2   !!======================================================================
3   !!                       ***  MODULE  trdtra  ***
4   !! Ocean diagnostics:  ocean tracers trends pre-processing
5   !!=====================================================================
6   !! History :  3.3  !  2010-06  (C. Ethe) creation for the TRA/TRC merge
7   !!            3.5  !  2012-02  (G. Madec) update the comments
8   !!----------------------------------------------------------------------
9
10   !!----------------------------------------------------------------------
11   !!   trd_tra       : pre-process the tracer trends
12   !!   trd_tra_adv   : transform a div(U.T) trend into a U.grad(T) trend
13   !!   trd_tra_mng   : tracer trend manager: dispatch to the diagnostic modules
14   !!   trd_tra_iom   : output 3D tracer trends using IOM
15   !!----------------------------------------------------------------------
16   USE oce            ! ocean dynamics and tracers variables
17   USE dom_oce        ! ocean domain
18   USE sbc_oce        ! surface boundary condition: ocean
19   USE zdf_oce        ! ocean vertical physics
20   USE trd_oce        ! trends: ocean variables
21   USE trdtrc         ! ocean passive mixed layer tracers trends
22# if defined key_top
23   USE trc,           ONLY: tra    ! tracer definitions (trn, trb, tra, etc.)
24# endif
25   USE trdglo         ! trends: global domain averaged
26   USE trdpen         ! trends: Potential ENergy
27   USE trdmxl         ! ocean active mixed layer tracers trends
28   USE ldftra_oce     ! ocean active tracers lateral physics
29   USE zdfddm         ! vertical physics: double diffusion
30   USE phycst         ! physical constants
31   USE in_out_manager ! I/O manager
32   USE iom            ! I/O manager library
33   USE lib_mpp        ! MPP library
34   USE wrk_nemo       ! Memory allocation
35
36   USE yomhook, ONLY: lhook, dr_hook
37   USE parkind1, ONLY: jprb, jpim
38
39   IMPLICIT NONE
40   PRIVATE
41
42   PUBLIC   trd_tra   ! called by all tra_... modules
43
44   REAL(wp) ::   r2dt   ! time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0
45
46   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   trdtx, trdty, trdt  ! use to store the temperature trends
47   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avt_evd  ! store avt_evd to calculate EVD trend
48
49   !! * Substitutions
50#  include "domzgr_substitute.h90"
51#  include "zdfddm_substitute.h90"
52#  include "vectopt_loop_substitute.h90"
53   !!----------------------------------------------------------------------
54   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
55   !! $Id$
56   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
57   !!----------------------------------------------------------------------
58CONTAINS
59
60   INTEGER FUNCTION trd_tra_alloc()
61   INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
62   INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
63   REAL(KIND=jprb)               :: zhook_handle
64
65   CHARACTER(LEN=*), PARAMETER :: RoutineName='TRD_TRA_ALLOC'
66
67   IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
68
69      !!---------------------------------------------------------------------
70      !!                  ***  FUNCTION trd_tra_alloc  ***
71      !!---------------------------------------------------------------------
72      ALLOCATE( trdtx(jpi,jpj,jpk) , trdty(jpi,jpj,jpk) , trdt(jpi,jpj,jpk) , avt_evd(jpi,jpj,jpk), STAT= trd_tra_alloc )
73      !
74      IF( lk_mpp             )   CALL mpp_sum ( trd_tra_alloc )
75      IF( trd_tra_alloc /= 0 )   CALL ctl_warn('trd_tra_alloc: failed to allocate arrays')
76   IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
77   END FUNCTION trd_tra_alloc
78
79
80   SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pun, ptra )
81      !!---------------------------------------------------------------------
82      !!                  ***  ROUTINE trd_tra  ***
83      !!
84      !! ** Purpose : pre-process tracer trends
85      !!
86      !! ** Method  : - mask the trend
87      !!              - advection (ptra present) converte the incoming flux (U.T)
88      !!              into trend (U.T => -U.grat(T)=div(U.T)-T.div(U)) through a
89      !!              call to trd_tra_adv
90      !!              - 'TRA' case : regroup T & S trends
91      !!              - send the trends to trd_tra_mng (trdtrc) for further processing
92      !!----------------------------------------------------------------------
93      INTEGER                         , INTENT(in)           ::   kt      ! time step
94      CHARACTER(len=3)                , INTENT(in)           ::   ctype   ! tracers trends type 'TRA'/'TRC'
95      INTEGER                         , INTENT(in)           ::   ktra    ! tracer index
96      INTEGER                         , INTENT(in)           ::   ktrd    ! tracer trend index
97      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)           ::   ptrd    ! tracer trend  or flux
98      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   pun     ! now velocity
99      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   ptra    ! now tracer variable
100      !
101      INTEGER  ::   jk   ! loop indices
102      REAL(wp), POINTER, DIMENSION(:,:,:)  ::   zwt, zws, ztrdt, ztrds   ! 3D workspace
103      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
104      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
105      REAL(KIND=jprb)               :: zhook_handle
106
107      CHARACTER(LEN=*), PARAMETER :: RoutineName='TRD_TRA'
108
109      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
110
111      !!----------------------------------------------------------------------
112      !
113      CALL wrk_alloc( jpi, jpj, jpk, ztrds )
114      !     
115      IF( .NOT. ALLOCATED( trdtx ) ) THEN      ! allocate trdtra arrays
116         IF( trd_tra_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trd_tra : unable to allocate arrays' )
117      ENDIF
118
119      IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN   !==  Temperature trend  ==!
120         !
121         SELECT CASE( ktrd )
122         !                            ! advection: transform the advective flux into a trend
123         CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'X', trdtx ) 
124         CASE( jptra_yad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'Y', trdty ) 
125         CASE( jptra_zad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'Z', trdt  ) 
126         CASE( jptra_bbc,    &        ! qsr, bbc: on temperature only, send to trd_tra_mng
127            &  jptra_qsr )   ;   trdt(:,:,:) = ptrd(:,:,:) * tmask(:,:,:)
128                                 ztrds(:,:,:) = 0._wp
129                                 CALL trd_tra_mng( trdt, ztrds, ktrd, kt )
130         CASE( jptra_evd )   ;   avt_evd(:,:,:) = ptrd(:,:,:) * tmask(:,:,:)
131         CASE DEFAULT                 ! other trends: masked trends
132            trdt(:,:,:) = ptrd(:,:,:) * tmask(:,:,:)              ! mask & store
133         END SELECT
134         !
135      ENDIF
136
137      IF( ctype == 'TRA' .AND. ktra == jp_sal ) THEN      !==  Salinity trends  ==!
138         !
139         SELECT CASE( ktrd )
140         !                            ! advection: transform the advective flux into a trend
141         !                            !            and send T & S trends to trd_tra_mng
142         CASE( jptra_xad  )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'X'  , ztrds ) 
143                                  CALL trd_tra_mng( trdtx, ztrds, ktrd, kt   )
144         CASE( jptra_yad  )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'Y'  , ztrds ) 
145                                  CALL trd_tra_mng( trdty, ztrds, ktrd, kt   )
146         CASE( jptra_zad  )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'Z'  , ztrds ) 
147                                  CALL trd_tra_mng( trdt , ztrds, ktrd, kt   )
148         CASE( jptra_zdfp )           ! diagnose the "PURE" Kz trend (here: just before the swap)
149            !                         ! iso-neutral diffusion case otherwise jptra_zdf is "PURE"
150            CALL wrk_alloc( jpi, jpj, jpk, zwt, zws, ztrdt )
151            !
152            zwt(:,:, 1 ) = 0._wp   ;   zws(:,:, 1 ) = 0._wp            ! vertical diffusive fluxes
153            zwt(:,:,jpk) = 0._wp   ;   zws(:,:,jpk) = 0._wp
154            DO jk = 2, jpk
155               zwt(:,:,jk) = avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk)
156               zws(:,:,jk) = fsavs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / fse3w(:,:,jk) * tmask(:,:,jk)
157            END DO
158            !
159            ztrdt(:,:,jpk) = 0._wp   ;   ztrds(:,:,jpk) = 0._wp
160            DO jk = 1, jpkm1
161               ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / fse3t(:,:,jk)
162               ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / fse3t(:,:,jk) 
163            END DO
164            CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt ) 
165            !
166            !                         ! Also calculate EVD trend at this point.
167            zwt(:,:,:) = 0._wp   ;   zws(:,:,:) = 0._wp            ! vertical diffusive fluxes
168            DO jk = 2, jpk
169               zwt(:,:,jk) = avt_evd(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk)
170               zws(:,:,jk) = avt_evd(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / fse3w(:,:,jk) * tmask(:,:,jk)
171            END DO
172            !
173            ztrdt(:,:,jpk) = 0._wp   ;   ztrds(:,:,jpk) = 0._wp
174            DO jk = 1, jpkm1
175               ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / fse3t(:,:,jk)
176               ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / fse3t(:,:,jk) 
177            END DO
178            CALL trd_tra_mng( ztrdt, ztrds, jptra_evd, kt ) 
179            !
180            CALL wrk_dealloc( jpi, jpj, jpk, zwt, zws, ztrdt )
181            !
182         CASE DEFAULT                 ! other trends: mask and send T & S trends to trd_tra_mng
183            ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:)
184            CALL trd_tra_mng( trdt, ztrds, ktrd, kt ) 
185         END SELECT
186      ENDIF
187
188# if defined key_top
189      IF( ctype == 'TRC' ) THEN                           !==  passive tracer trend  ==!
190         !
191         SELECT CASE( ktrd )
192         !                            ! advection: transform the advective flux into a masked trend
193         CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'X', ztrds ) 
194         CASE( jptra_yad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'Y', ztrds ) 
195         CASE( jptra_zad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'Z', ztrds ) 
196         CASE( jptra_zdfp )           ! diagnose the "PURE" Kz trend (here: just before the swap)
197            !                         ! iso-neutral diffusion case otherwise
198            !                         jptra_zdf is "PURE"
199            CALL wrk_alloc( jpi, jpj, jpk, zws )
200            !
201            zws(:,:, 1 ) = 0._wp                        ! vertical diffusive fluxes
202            zws(:,:,jpk) = 0._wp 
203            DO jk = 2, jpk
204               zws(:,:,jk) = avt(:,:,jk) * (tra(:,:,jk-1,ktra) - tra(:,:,jk,ktra) ) / fse3w(:,:,jk) * tmask(:,:,jk)
205            END DO
206            !
207            ztrds(:,:,jpk) = 0._wp   
208            DO jk = 1, jpkm1
209               ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / fse3t(:,:,jk)
210            END DO
211            CALL wrk_dealloc( jpi, jpj, jpk, zws )
212            !
213         CASE DEFAULT                 ! other trends: just masked
214                                 ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:)
215         END SELECT
216         !                            ! send trend to trd_trc
217         CALL trd_trc( ztrds, ktra, ktrd, kt ) 
218         !
219      ENDIF
220# endif
221      !
222      CALL wrk_dealloc( jpi, jpj, jpk, ztrds )
223      !
224      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
225   END SUBROUTINE trd_tra
226
227
228   SUBROUTINE trd_tra_adv( pf, pun, ptn, cdir, ptrd )
229      !!---------------------------------------------------------------------
230      !!                  ***  ROUTINE trd_tra_adv  ***
231      !!
232      !! ** Purpose :   transformed a advective flux into a masked advective trends
233      !!
234      !! ** Method  :   use the following transformation: -div(U.T) = - U grad(T) + T.div(U)
235      !!       i-advective trends = -un. di-1[T] = -( di-1[fi] - tn di-1[un] )
236      !!       j-advective trends = -un. di-1[T] = -( dj-1[fi] - tn dj-1[un] )
237      !!       k-advective trends = -un. di+1[T] = -( dk+1[fi] - tn dk+1[un] )
238      !!                where fi is the incoming advective flux.
239      !!----------------------------------------------------------------------
240      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pf      ! advective flux in one direction
241      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pun     ! now velocity   in one direction
242      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   ptn     ! now or before tracer
243      CHARACTER(len=1)                , INTENT(in   ) ::   cdir    ! X/Y/Z direction
244      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   ptrd    ! advective trend in one direction
245      !
246      INTEGER  ::   ji, jj, jk   ! dummy loop indices
247      INTEGER  ::   ii, ij, ik   ! index shift as function of the direction
248      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
249      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
250      REAL(KIND=jprb)               :: zhook_handle
251
252      CHARACTER(LEN=*), PARAMETER :: RoutineName='TRD_TRA_ADV'
253
254      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
255
256      !!----------------------------------------------------------------------
257      !
258      SELECT CASE( cdir )      ! shift depending on the direction
259      CASE( 'X' )   ;   ii = 1   ;   ij = 0   ;   ik = 0      ! i-trend
260      CASE( 'Y' )   ;   ii = 0   ;   ij = 1   ;   ik = 0      ! j-trend
261      CASE( 'Z' )   ;   ii = 0   ;   ij = 0   ;   ik =-1      ! k-trend
262      END SELECT
263      !
264      !                        ! set to zero uncomputed values
265      ptrd(jpi,:,:) = 0._wp   ;   ptrd(1,:,:) = 0._wp
266      ptrd(:,jpj,:) = 0._wp   ;   ptrd(:,1,:) = 0._wp
267      ptrd(:,:,jpk) = 0._wp
268      !
269      DO jk = 1, jpkm1         ! advective trend
270         DO jj = 2, jpjm1
271            DO ji = fs_2, fs_jpim1   ! vector opt.
272               ptrd(ji,jj,jk) = - (     pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)                        &
273                 &                  - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk)  )   &
274                 &              / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )  * tmask(ji,jj,jk)
275            END DO
276         END DO
277      END DO
278      !
279      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
280   END SUBROUTINE trd_tra_adv
281
282
283   SUBROUTINE trd_tra_mng( ptrdx, ptrdy, ktrd, kt )
284      !!---------------------------------------------------------------------
285      !!                  ***  ROUTINE trd_tra_mng  ***
286      !!
287      !! ** Purpose :   Dispatch all tracer trends computation, e.g. 3D output,
288      !!                integral constraints, potential energy, and/or
289      !!                mixed layer budget.
290      !!----------------------------------------------------------------------
291      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdx   ! Temperature or U trend
292      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdy   ! Salinity    or V trend
293      INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index
294      INTEGER                   , INTENT(in   ) ::   kt      ! time step
295      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
296      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
297      REAL(KIND=jprb)               :: zhook_handle
298
299      CHARACTER(LEN=*), PARAMETER :: RoutineName='TRD_TRA_MNG'
300
301      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
302
303      !!----------------------------------------------------------------------
304
305      IF( neuler == 0 .AND. kt == nit000    ) THEN   ;   r2dt =      rdt      ! = rdtra (restart with Euler time stepping)
306      ELSEIF(               kt <= nit000 + 1) THEN   ;   r2dt = 2. * rdt      ! = 2 rdttra (leapfrog)
307      ENDIF
308
309      !                   ! 3D output of tracers trends using IOM interface
310      IF( ln_tra_trd )   CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt )
311
312      !                   ! Integral Constraints Properties for tracers trends                                       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
313      IF( ln_glo_trd )   CALL trd_glo( ptrdx, ptrdy, ktrd, 'TRA', kt )
314
315      !                   ! Potential ENergy trends
316      IF( ln_PE_trd  )   CALL trd_pen( ptrdx, ptrdy, ktrd, kt, r2dt )
317
318      !                   ! Mixed layer trends for active tracers
319      IF( ln_tra_mxl )   THEN   
320         !-----------------------------------------------------------------------------------------------
321         ! W.A.R.N.I.N.G :
322         ! jptra_ldf : called by traldf.F90
323         !                 at this stage we store:
324         !                  - the lateral geopotential diffusion (here, lateral = horizontal)
325         !                  - and the iso-neutral diffusion if activated
326         ! jptra_zdf : called by trazdf.F90
327         !                 * in case of iso-neutral diffusion we store the vertical diffusion component in the
328         !                   lateral trend including the K_z contrib, which will be removed later (see trd_mxl)
329         !-----------------------------------------------------------------------------------------------
330
331         SELECT CASE ( ktrd )
332         CASE ( jptra_xad )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_xad, '3D' )   ! zonal    advection
333         CASE ( jptra_yad )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_yad, '3D' )   ! merid.   advection
334         CASE ( jptra_zad )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_zad, '3D' )   ! vertical advection
335         CASE ( jptra_ldf )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_ldf, '3D' )   ! lateral  diffusion
336         CASE ( jptra_bbl )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_bbl, '3D' )   ! bottom boundary layer
337         CASE ( jptra_zdf )
338            IF( ln_traldf_iso ) THEN ; CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_ldf, '3D' )   ! lateral  diffusion (K_z)
339            ELSE                   ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_zdf, '3D' )   ! vertical diffusion (K_z)
340            ENDIF
341         CASE ( jptra_dmp )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_dmp, '3D' )   ! internal 3D restoring (tradmp)
342         CASE ( jptra_qsr )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_for, '3D' )   ! air-sea : penetrative sol radiat
343         CASE ( jptra_nsr )        ;   ptrdx(:,:,2:jpk) = 0._wp   ;   ptrdy(:,:,2:jpk) = 0._wp
344                                       CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_for, '2D' )   ! air-sea : non penetr sol radiation
345         CASE ( jptra_bbc )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_bbc, '3D' )   ! bottom bound cond (geoth flux)
346         CASE ( jptra_npc )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_npc, '3D' )   ! non penetr convect adjustment
347         CASE ( jptra_atf )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_atf, '3D' )   ! asselin time filter (last trend)
348                                   !
349                                       CALL trd_mxl( kt, r2dt )                             ! trends: Mixed-layer (output)
350         END SELECT
351         !
352      ENDIF
353      !
354      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
355   END SUBROUTINE trd_tra_mng
356
357
358   SUBROUTINE trd_tra_iom( ptrdx, ptrdy, ktrd, kt )
359      !!---------------------------------------------------------------------
360      !!                  ***  ROUTINE trd_tra_iom  ***
361      !!
362      !! ** Purpose :   output 3D tracer trends using IOM
363      !!----------------------------------------------------------------------
364     REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdx   ! Temperature or U trend
365     REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdy   ! Salinity    or V trend
366     INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index
367     INTEGER                   , INTENT(in   ) ::   kt      ! time step
368     !!
369     INTEGER ::   ji, jj, jk   ! dummy loop indices
370     INTEGER ::   ikbu, ikbv   ! local integers
371     REAL(wp), POINTER, DIMENSION(:,:)   ::   z2dx, z2dy   ! 2D workspace
372     INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
373     INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
374     REAL(KIND=jprb)               :: zhook_handle
375
376     CHARACTER(LEN=*), PARAMETER :: RoutineName='TRD_TRA_IOM'
377
378     IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
379
380     !!----------------------------------------------------------------------
381     !
382     !!gm Rq: mask the trends already masked in trd_tra, but lbc_lnk should probably be added
383     !
384     ! Trends evaluated every time step that could go to the standard T file and can be output every ts into a 1ts file if 1ts output is selected
385     SELECT CASE( ktrd )
386     ! This total trend is done every time step
387     CASE( jptra_tot  )   ;   CALL iom_put( "ttrd_tot" , ptrdx )           ! model total trend
388        CALL iom_put( "strd_tot" , ptrdy )
389     END SELECT
390
391     ! These trends are done every second time step. When 1ts output is selected must go different (2ts) file from standard T-file
392     IF( MOD( kt, 2 ) == 0 ) THEN
393        SELECT CASE( ktrd )
394        CASE( jptra_xad  )   ;   CALL iom_put( "ttrd_xad" , ptrdx )        ! x- horizontal advection
395           CALL iom_put( "strd_xad" , ptrdy )
396        CASE( jptra_yad  )   ;   CALL iom_put( "ttrd_yad" , ptrdx )        ! y- horizontal advection
397           CALL iom_put( "strd_yad" , ptrdy )
398        CASE( jptra_zad  )   ;   CALL iom_put( "ttrd_zad" , ptrdx )        ! z- vertical   advection
399           CALL iom_put( "strd_zad" , ptrdy )
400           IF( .NOT. lk_vvl ) THEN                   ! cst volume : adv flux through z=0 surface
401              CALL wrk_alloc( jpi, jpj, z2dx, z2dy )
402              z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / fse3t(:,:,1)
403              z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / fse3t(:,:,1)
404              CALL iom_put( "ttrd_sad", z2dx )
405              CALL iom_put( "strd_sad", z2dy )
406              CALL wrk_dealloc( jpi, jpj, z2dx, z2dy )
407           ENDIF
408        CASE( jptra_totad  ) ;   CALL iom_put( "ttrd_totad" , ptrdx )      ! total   advection
409           CALL iom_put( "strd_totad" , ptrdy )
410        CASE( jptra_ldf  )   ;   CALL iom_put( "ttrd_ldf" , ptrdx )        ! lateral diffusion
411           CALL iom_put( "strd_ldf" , ptrdy )
412        CASE( jptra_zdf  )   ;   CALL iom_put( "ttrd_zdf" , ptrdx )        ! vertical diffusion (including Kz contribution)
413           CALL iom_put( "strd_zdf" , ptrdy )
414        CASE( jptra_zdfp )   ;   CALL iom_put( "ttrd_zdfp", ptrdx )        ! PURE vertical diffusion (no isoneutral contribution)
415           CALL iom_put( "strd_zdfp", ptrdy )
416        CASE( jptra_evd )    ;   CALL iom_put( "ttrd_evd", ptrdx )         ! EVD trend (convection)
417           CALL iom_put( "strd_evd", ptrdy )
418        CASE( jptra_dmp  )   ;   CALL iom_put( "ttrd_dmp" , ptrdx )        ! internal restoring (damping)
419           CALL iom_put( "strd_dmp" , ptrdy )
420        CASE( jptra_bbl  )   ;   CALL iom_put( "ttrd_bbl" , ptrdx )        ! bottom boundary layer
421           CALL iom_put( "strd_bbl" , ptrdy )
422        CASE( jptra_npc  )   ;   CALL iom_put( "ttrd_npc" , ptrdx )        ! static instability mixing
423           CALL iom_put( "strd_npc" , ptrdy )
424        CASE( jptra_bbc  )   ;   CALL iom_put( "ttrd_bbc" , ptrdx )        ! geothermal heating   (only on temperature)
425        CASE( jptra_nsr  )   ;   CALL iom_put( "ttrd_qns" , ptrdx(:,:,1) ) ! surface forcing + runoff (ln_rnf=T)
426           CALL iom_put( "strd_cdt" , ptrdy(:,:,1) )        ! output as 2D surface fields
427        CASE( jptra_qsr  )   ;   CALL iom_put( "ttrd_qsr" , ptrdx )        ! penetrative solar radiat. (only on temperature)
428        END SELECT
429        ! the Asselin filter trend  is also every other time step but needs to be lagged one time step
430        ! Even when 1ts output is selected can go to the same (2ts) file as the trends plotted every even time step.
431     ELSE IF( MOD( kt, 2 ) == 1 ) THEN
432        SELECT CASE( ktrd )
433        CASE( jptra_atf  )   ;   CALL iom_put( "ttrd_atf" , ptrdx )        ! asselin time Filter
434           CALL iom_put( "strd_atf" , ptrdy )
435        END SELECT
436     END IF
437     !
438     IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
439   END SUBROUTINE trd_tra_iom
440
441   !!======================================================================
442END MODULE trdtra
Note: See TracBrowser for help on using the repository browser.