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/2012/dev_r3309_LOCEAN12_Ediag/NEMOGCM/NEMO/OPA_SRC/TRD – NEMO

source: branches/2012/dev_r3309_LOCEAN12_Ediag/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90 @ 3317

Last change on this file since 3317 was 3317, checked in by gm, 12 years ago

Ediag branche: #927 restructuration of the trdicp computation - part I
  • Property svn:keywords set to Id
File size: 12.1 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#if  defined key_trdtra || defined key_trdmld || defined key_trdmld_trc 
10   !!----------------------------------------------------------------------
11   !!   trd_tra       : pre-process the tracer trends and calll trd_mod(_trc)
12   !!   trd_tra_adv   : transform a div(U.T) trend into a U.grad(T) trend
13   !!----------------------------------------------------------------------
14   USE oce            ! ocean dynamics and tracers variables
15   USE dom_oce        ! ocean domain
16   USE zdf_oce        ! ocean vertical physics
17   USE zdfddm         ! vertical physics: double diffusion
18   USE trdmod_oce     ! ocean active mixed layer tracers trends
19   USE trdmod         ! ocean active mixed layer tracers trends
20   USE trdmod_trc     ! ocean passive mixed layer tracers trends
21   USE ldftra_oce     ! ocean active tracers lateral physics
22   USE in_out_manager ! I/O manager
23   USE lib_mpp        ! MPP library
24   USE wrk_nemo       ! Memory allocation
25
26   IMPLICIT NONE
27   PRIVATE
28
29   PUBLIC   trd_tra   ! called by all tra_... modules
30 
31   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   trdtx, trdty, trdt   ! use to store the temperature trends
32
33   !! * Substitutions
34#  include "domzgr_substitute.h90"
35#  include "zdfddm_substitute.h90"
36#  include "vectopt_loop_substitute.h90"
37   !!----------------------------------------------------------------------
38   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
39   !! $Id$
40   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
41   !!----------------------------------------------------------------------
42CONTAINS
43
44   INTEGER FUNCTION trd_tra_alloc()
45      !!---------------------------------------------------------------------
46      !!                  ***  FUNCTION trd_tra_alloc  ***
47      !!---------------------------------------------------------------------
48      ALLOCATE( trdtx(jpi,jpj,jpk) , trdty(jpi,jpj,jpk) , trdt(jpi,jpj,jpk) , STAT= trd_tra_alloc )
49      !
50      IF( lk_mpp             )   CALL mpp_sum ( trd_tra_alloc )
51      IF( trd_tra_alloc /= 0 )   CALL ctl_warn('trd_tra_alloc: failed to allocate arrays')
52   END FUNCTION trd_tra_alloc
53
54
55   SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pun, ptra )
56      !!---------------------------------------------------------------------
57      !!                  ***  ROUTINE trd_tra  ***
58      !!
59      !! ** Purpose : pre-process tracer trends
60      !!
61      !! ** Method  : - mask the trend
62      !!              - advection (ptra present) converte the incoming flux (U.T)
63      !!              into trend (U.T => -U.grat(T)=div(U.T)-T.div(U)) through a
64      !!              call to trd_tra_adv
65      !!              - 'TRA' case : regroup T & S trends
66      !!              - send the trends to trd_mod(_trc) for further processing
67      !!----------------------------------------------------------------------
68      INTEGER                         , INTENT(in)           ::   kt      ! time step
69      CHARACTER(len=3)                , INTENT(in)           ::   ctype   ! tracers trends type 'TRA'/'TRC'
70      INTEGER                         , INTENT(in)           ::   ktra    ! tracer index
71      INTEGER                         , INTENT(in)           ::   ktrd    ! tracer trend index
72      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)           ::   ptrd    ! tracer trend  or flux
73      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   pun     ! now velocity
74      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   ptra    ! now tracer variable
75      !
76      INTEGER  ::   jk   ! loop indices
77      REAL(wp), POINTER, DIMENSION(:,:,:)  ::   zwt, zws, ztrdt, ztrds   ! 3D workspace
78      !!----------------------------------------------------------------------
79      !
80      CALL wrk_alloc( jpi, jpj, jpk, ztrds )
81      !     
82      IF( .NOT. ALLOCATED( trdtx ) ) THEN      ! allocate trdtra arrays
83         IF( trd_tra_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trd_tra : unable to allocate arrays' )
84      ENDIF
85
86      IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN   !==  Temperature trend  ==!
87         !
88         IF( PRESENT( ptra ) ) THEN                       ! advection: transform flux into trend
89            SELECT CASE( ktrd )     
90            CASE( jptra_trd_xad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'X', trdtx ) 
91            CASE( jptra_trd_yad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'Y', trdty ) 
92            CASE( jptra_trd_zad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'Z', trdt  ) 
93            END SELECT
94         ELSE                                             ! other trends:
95            trdt(:,:,:) = ptrd(:,:,:) * tmask(:,:,:)                      ! mask & store
96            IF( ktrd == jptra_trd_bbc .OR. ktrd == jptra_trd_qsr ) THEN   ! qsr, bbc: on temperature only
97               ztrds(:,:,:) = 0._wp
98               CALL trd_mod( trdt, ztrds, ktrd, ctype, kt )                  ! send to trd_mod
99            ENDIF
100         ENDIF
101         !
102      ENDIF
103
104      IF( ctype == 'TRA' .AND. ktra == jp_sal ) THEN      !==  Salinity trends  ==!
105         !
106         IF( PRESENT( ptra ) ) THEN      ! advection: transform the advective flux into a trend
107            SELECT CASE( ktrd )          !            and send T & S trends to trd_mod
108            CASE( jptra_trd_xad )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'X'  , ztrds ) 
109                                        CALL trd_mod    ( trdtx, ztrds, ktrd, ctype, kt    )
110            CASE( jptra_trd_yad )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'Y'  , ztrds ) 
111                                    ;   CALL trd_mod    ( trdty, ztrds, ktrd, ctype, kt    )
112            CASE( jptra_trd_zad )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'Z'  , ztrds ) 
113                                        CALL trd_mod    ( trdt , ztrds, ktrd, ctype, kt    )
114            END SELECT
115         ELSE                            ! other trends: mask and send T & S trends to trd_mod
116            ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:)
117            CALL trd_mod( trdt, ztrds, ktrd, ctype, kt ) 
118         ENDIF
119         !
120         IF( ktrd == jptra_trd_zdfp ) THEN     ! diagnose the "PURE" Kz trend (here: just before the swap)
121            !
122            IF( ln_traldf_iso ) THEN      ! iso-neutral diffusion only otherwise jptra_trd_zdf is "PURE"
123               !
124               CALL wrk_alloc( jpi, jpj, jpk, zwt, zws, ztrdt )
125               !
126               zwt(:,:, 1 ) = 0._wp   ;   zws(:,:, 1 ) = 0._wp            ! vertical diffusive fluxes
127               zwt(:,:,jpk) = 0._wp   ;   zws(:,:,jpk) = 0._wp
128               DO jk = 2, jpk
129                  zwt(:,:,jk) =   avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk)
130                  zws(:,:,jk) = fsavs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / fse3w(:,:,jk) * tmask(:,:,jk)
131               END DO
132               !
133               ztrdt(:,:,jpk) = 0._wp   ;   ztrds(:,:,jpk) = 0._wp
134               DO jk = 1, jpkm1
135                  ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / fse3t(:,:,jk)
136                  ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / fse3t(:,:,jk) 
137               END DO
138               CALL trd_mod( ztrdt, ztrds, jptra_trd_zdfp, ctype, kt ) 
139               !
140               CALL wrk_dealloc( jpi, jpj, jpk, zwt, zws, ztrdt )
141               !
142            ENDIF
143            !
144         ENDIF
145      ENDIF
146
147      IF( ctype == 'TRC' ) THEN                           !==  passive tracer trend  ==!
148         !
149         IF( PRESENT( ptra ) ) THEN                          ! advection: transform flux into a trend
150            SELECT CASE( ktrd )
151            CASE( jptra_trd_xad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'X', ztrds ) 
152            CASE( jptra_trd_yad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'Y', ztrds ) 
153            CASE( jptra_trd_zad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'Z', ztrds ) 
154            END SELECT
155         ELSE                                                ! other trends: mask
156            ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:)
157         END IF
158         !                                 
159         CALL trd_mod_trc( ztrds, ktra, ktrd, kt )           ! send trend to trd_mod_trc
160         !
161      ENDIF
162      !
163      CALL wrk_dealloc( jpi, jpj, jpk, ztrds )
164      !
165   END SUBROUTINE trd_tra
166
167
168   SUBROUTINE trd_tra_adv( pf, pun, ptn, cdir, ptrd )
169      !!---------------------------------------------------------------------
170      !!                  ***  ROUTINE trd_tra_adv  ***
171      !!
172      !! ** Purpose :   transformed a advective flux into a masked advective trends
173      !!
174      !! ** Method  :   use the following transformation: -div(U.T) = - U grad(T) + T.div(U)
175      !!       i-advective trends = -un. di-1[T] = -( di-1[fi] - tn di-1[un] )
176      !!       j-advective trends = -un. di-1[T] = -( dj-1[fi] - tn dj-1[un] )
177      !!       k-advective trends = -un. di+1[T] = -( dk+1[fi] - tn dk+1[un] )
178      !!                where fi is the incoming advective flux.
179      !!----------------------------------------------------------------------
180      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pf      ! advective flux in one direction
181      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pun     ! now velocity   in one direction
182      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   ptn     ! now or before tracer
183      CHARACTER(len=1)                , INTENT(in   ) ::   cdir    ! X/Y/Z direction
184      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   ptrd    ! advective trend in one direction
185      !
186      INTEGER  ::   ji, jj, jk   ! dummy loop indices
187      INTEGER  ::   ii, ij, ik   ! index shift as function of the direction
188      !!----------------------------------------------------------------------
189      !
190      SELECT CASE( cdir )      ! shift depending on the direction
191      CASE( 'X' )   ;   ii = 1   ;   ij = 0   ;   ik = 0      ! i-trend
192      CASE( 'Y' )   ;   ii = 0   ;   ij = 1   ;   ik = 0      ! j-trend
193      CASE( 'Z' )   ;   ii = 0   ;   ij = 0   ;   ik =-1      ! k-trend
194      END SELECT
195      !
196      !                        ! set to zero uncomputed values
197      ptrd(jpi,:,:) = 0._wp   ;   ptrd(1,:,:) = 0._wp
198      ptrd(:,jpj,:) = 0._wp   ;   ptrd(:,1,:) = 0._wp
199      ptrd(:,:,jpk) = 0._wp
200      !
201      DO jk = 1, jpkm1         ! advective trend
202         DO jj = 2, jpjm1
203            DO ji = fs_2, fs_jpim1   ! vector opt.
204               ptrd(ji,jj,jk) = - (     pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)                        &
205                 &                  - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk)  )   &
206                 &              / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )  * tmask(ji,jj,jk)
207            END DO
208         END DO
209      END DO
210      !
211   END SUBROUTINE trd_tra_adv
212
213#else
214   !!----------------------------------------------------------------------
215   !!   Default case :          Dummy module           No trend diagnostics
216   !!----------------------------------------------------------------------
217   USE par_oce      ! ocean variables trends
218CONTAINS
219   SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pu, ptra )
220      !!----------------------------------------------------------------------
221      CHARACTER(len=3)                , INTENT(in)           ::  ctype   
222      INTEGER                         , INTENT(in)           ::  kt, ktra, ktrd
223      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)           ::  ptrd   
224      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pu, ptra    ! Tracer variable
225      WRITE(*,*) 'trd_tra: You should not have seen this print! error ?',   &
226         &   ptrd(1,1,1), ptra(1,1,1), pu(1,1,1), ktrd, ktra, ctype, kt
227   END SUBROUTINE trd_tra
228#endif
229
230   !!======================================================================
231END MODULE trdtra
Note: See TracBrowser for help on using the repository browser.