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/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD – NEMO

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90 @ 4409

Last change on this file since 4409 was 4409, checked in by trackstand2, 10 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: 12.4 KB
RevLine 
[2026]1MODULE trdtra
2   !!======================================================================
3   !!                       ***  MODULE  trdtra  ***
4   !! Ocean diagnostics:  ocean tracers trends
5   !!=====================================================================
[2715]6   !! History :  1.0  !  2004-08  (C. Talandier) Original code
7   !!            2.0  !  2005-04  (C. Deltel)    Add Asselin trend in the ML budget
8   !!            3.3  !  2010-06  (C. Ethe) merge TRA-TRC
[2026]9   !!----------------------------------------------------------------------
10#if  defined key_trdtra || defined key_trdmld || defined key_trdmld_trc 
11   !!----------------------------------------------------------------------
12   !!   trd_tra      : Call the trend to be computed
13   !!----------------------------------------------------------------------
[2715]14   USE dom_oce          ! ocean domain
15   USE trdmod_oce       ! ocean active mixed layer tracers trends
16   USE trdmod           ! ocean active mixed layer tracers trends
17   USE trdmod_trc       ! ocean passive mixed layer tracers trends
18   USE in_out_manager   ! I/O manager
19   USE lib_mpp          ! MPP library
[2026]20
21   IMPLICIT NONE
22   PRIVATE
23
[2715]24   PUBLIC   trd_tra          ! called by all  traXX modules
[2026]25 
[2715]26   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: trdtx, trdty, trdt  !:
[2026]27
[3211]28   !! * Control permutation of array indices
29#  include "dom_oce_ftrans.h90"
30   !! These are all private to the module,
31   !! so we do not need a separate file of ftrans directives
32!FTRANS trdtx trdty trdt :I :I :z
33
[2026]34   !! * Substitutions
35#  include "domzgr_substitute.h90"
36#  include "vectopt_loop_substitute.h90"
37   !!----------------------------------------------------------------------
[2715]38   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
[2281]39   !! $Id$
[2715]40   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
[2026]41   !!----------------------------------------------------------------------
42CONTAINS
43
[2715]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
[2026]55   SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pun, ptra )
56      !!---------------------------------------------------------------------
57      !!                  ***  ROUTINE trd_tra  ***
58      !!
59      !! ** Purpose : Dispatch all trends computation, e.g. vorticity, mld or
60      !!              integral constraints
61      !!
62      !! ** Method/usage : For the mixed-layer trend, the control surface can be either
63      !!       a mixed layer depth (time varying) or a fixed surface (jk level or bowl).
64      !!      Choose control surface with nn_ctls in namelist NAMTRD :
65      !!        nn_ctls = 0  : use mixed layer with density criterion
66      !!        nn_ctls = 1  : read index from file 'ctlsurf_idx'
67      !!        nn_ctls > 1  : use fixed level surface jk = nn_ctls
68      !!----------------------------------------------------------------------
[2715]69      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
70      USE wrk_nemo, ONLY:   ztrds => wrk_3d_10   ! 3D workspace
[3211]71      !! DCSE_NEMO: Need additional directives for renamed module variables
72!FTRANS ztrds :I :I :z
73
[2715]74      !
[2026]75      INTEGER                         , INTENT(in)           ::  kt      ! time step
76      CHARACTER(len=3)                , INTENT(in)           ::  ctype   ! tracers trends type 'TRA'/'TRC'
77      INTEGER                         , INTENT(in)           ::  ktra    ! tracer index
78      INTEGER                         , INTENT(in)           ::  ktrd    ! tracer trend index
[3211]79
80      !! DCSE_NEMO: This style defeats ftrans
81!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)           ::  ptrd    ! tracer trend  or flux
82!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pun     ! velocity
83!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  ptra    ! Tracer variable
84
85!FTRANS ptrd pun ptra :I :I :z
[4409]86      REAL(wp), INTENT(in)           ::  ptrd(jpi,jpj,jpkorig)   ! tracer trend  or flux
87      REAL(wp), INTENT(in), OPTIONAL ::  pun(jpi,jpj,jpkorig)    ! velocity
88      REAL(wp), INTENT(in), OPTIONAL ::  ptra(jpi,jpj,jpkorig)   ! Tracer variable
[2026]89      !!----------------------------------------------------------------------
90
[2715]91      IF( wrk_in_use(3, 10) ) THEN
92         CALL ctl_stop('trd_tra: requested workspace array unavailable')   ;   RETURN
93      ENDIF
94
95      IF( .NOT. ALLOCATED( trdtx ) ) THEN       ! allocate trdtra arrays
96         IF( trd_tra_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trd_tra : unable to allocate arrays' )
97      ENDIF
98     
[2026]99      ! Control of optional arguments
100      IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN
101         IF( PRESENT( ptra ) ) THEN   
102            SELECT CASE( ktrd )            ! shift depending on the direction
103            CASE( jptra_trd_xad )  ;  CALL trd_tra_adv( ptrd, pun, ptra, 'X', trdtx ) 
104            CASE( jptra_trd_yad )  ;  CALL trd_tra_adv( ptrd, pun, ptra, 'Y', trdty ) 
105            CASE( jptra_trd_zad )  ;  CALL trd_tra_adv( ptrd, pun, ptra, 'Z', trdt  ) 
106            END SELECT
107         ELSE
108            trdt(:,:,:) = ptrd(:,:,:)
[2327]109            IF( ktrd == jptra_trd_bbc .OR. ktrd == jptra_trd_qsr ) THEN
110               ztrds(:,:,:) = 0.
111               CALL trd_mod( trdt, ztrds, ktrd, ctype, kt )
112            END IF
[2026]113         END IF
114      END IF
115
116      IF( ctype == 'TRA' .AND. ktra == jp_sal ) THEN
117         IF( PRESENT( ptra ) ) THEN   
118            SELECT CASE( ktrd )            ! shift depending on the direction
119            CASE( jptra_trd_xad ) 
120                                CALL trd_tra_adv( ptrd, pun, ptra, 'X', ztrds ) 
121                                CALL trd_mod( trdtx, ztrds, ktrd, ctype, kt   )
122            CASE( jptra_trd_yad ) 
123                                CALL trd_tra_adv( ptrd, pun, ptra, 'Y', ztrds ) 
124                                CALL trd_mod( trdty, ztrds, ktrd, ctype, kt   )
125            CASE( jptra_trd_zad )   
126                                CALL trd_tra_adv( ptrd, pun, ptra, 'Z', ztrds ) 
127                                CALL trd_mod( trdt , ztrds, ktrd, ctype, kt   )
128            END SELECT
129         ELSE
130            ztrds(:,:,:) = ptrd(:,:,:)
131            CALL trd_mod( trdt, ztrds, ktrd, ctype, kt ) 
132         END IF
133      END IF
134
135      IF( ctype == 'TRC' ) THEN
136         !
137         IF( PRESENT( ptra ) ) THEN 
138            SELECT CASE( ktrd )            ! shift depending on the direction
139            CASE( jptra_trd_xad ) 
140                                CALL trd_tra_adv( ptrd, pun, ptra, 'X', ztrds ) 
141                                CALL trd_mod_trc( ztrds, ktra, ktrd, kt       )
142            CASE( jptra_trd_yad ) 
143                                CALL trd_tra_adv( ptrd, pun, ptra, 'Y', ztrds ) 
144                                CALL trd_mod_trc( ztrds, ktra, ktrd, kt       )
145            CASE( jptra_trd_zad )   
146                                CALL trd_tra_adv( ptrd, pun, ptra, 'Z', ztrds ) 
147                                CALL trd_mod_trc( ztrds, ktra, ktrd, kt       )
148            END SELECT
149         ELSE
150            ztrds(:,:,:) = ptrd(:,:,:)
151            CALL trd_mod_trc( ztrds, ktra, ktrd, kt       ) 
152         END IF
153         !
154      ENDIF
155      !
[2715]156      IF( wrk_not_released(3, 10) )   CALL ctl_stop('trd_tra: failed to release workspace array')
157      !
[2026]158   END SUBROUTINE trd_tra
159
[3211]160   !! * Reset control of array index permutation
161!FTRANS CLEAR
162#  include "dom_oce_ftrans.h90"
163!FTRANS trdtx trdty trdt :I :I :z
[2715]164
[2026]165   SUBROUTINE trd_tra_adv( pf, pun, ptn, cdir, ptrd )
166      !!---------------------------------------------------------------------
167      !!                  ***  ROUTINE trd_tra_adv  ***
168      !!
169      !! ** Purpose :   transformed the i-, j- or k-advective flux into thes
170      !!              i-, j- or k-advective trends, resp.
171      !! ** Method  :   i-advective trends = -un. di-1[T] = -( di-1[fi] - tn di-1[un] )
172      !!                k-advective trends = -un. di-1[T] = -( dj-1[fi] - tn dj-1[un] )
173      !!                k-advective trends = -un. di+1[T] = -( dk+1[fi] - tn dk+1[un] )
174      !!----------------------------------------------------------------------
[3211]175
176      !! DCSE_NEMO: This style defeats ftrans
177!     REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   pf      ! advective flux in one direction
178!     REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   pun     ! now velocity  in one direction
179!     REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   ptn     ! now or before tracer
180
181!FTRANS pf pun ptn :I :I :z
[4409]182      REAL(wp)        , INTENT(in )            ::   pf(jpi,jpj,jpkorig)      ! advective flux in one direction
183      REAL(wp)        , INTENT(in )            ::   pun(jpi,jpj,jpkorig)     ! now velocity  in one direction
184      REAL(wp)        , INTENT(in )            ::   ptn(jpi,jpj,jpkorig)     ! now or before tracer
[2715]185      CHARACTER(len=1), INTENT(in )                         ::   cdir    ! X/Y/Z direction
[3211]186
187!     REAL(wp)        , INTENT(out), DIMENSION(jpi,jpj,jpk) ::   ptrd    ! advective trend in one direction
188!FTRANS ptrd :I :I :z
[4409]189      REAL(wp)        , INTENT(out)            ::   ptrd(jpi,jpj,jpkorig)    ! advective trend in one direction
[2715]190      !
191      INTEGER  ::   ji, jj, jk   ! dummy loop indices
192      INTEGER  ::   ii, ij, ik   ! index shift function of the direction
193      REAL(wp) ::   zbtr         ! local scalar
[2026]194      !!----------------------------------------------------------------------
195
196      SELECT CASE( cdir )            ! shift depending on the direction
197      CASE( 'X' )   ;   ii = 1   ; ij = 0   ;   ik = 0      ! i-advective trend
198      CASE( 'Y' )   ;   ii = 0   ; ij = 1   ;   ik = 0      ! j-advective trend
199      CASE( 'Z' )   ;   ii = 0   ; ij = 0   ;   ik =-1      ! k-advective trend
200      END SELECT
201
202      !                              ! set to zero uncomputed values
203      ptrd(jpi,:,:) = 0.e0   ;   ptrd(1,:,:) = 0.e0
204      ptrd(:,jpj,:) = 0.e0   ;   ptrd(:,1,:) = 0.e0
205      ptrd(:,:,jpk) = 0.e0
206      !
207      !
[3211]208#if defined key_z_first
209      DO jj = 2, jpjm1
210         DO ji = 2, jpim1
211            DO jk = 1, jpkm1
212#else
[2026]213      DO jk = 1, jpkm1
214         DO jj = 2, jpjm1
215            DO ji = fs_2, fs_jpim1   ! vector opt.
[3211]216#endif
[2026]217               zbtr    = 1.e0/ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
218               ptrd(ji,jj,jk) = - zbtr * (      pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)                    &
219                 &                          - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk)  )
220            END DO
221         END DO
222      END DO
223      !
224   END SUBROUTINE trd_tra_adv
225
226#   else
227   !!----------------------------------------------------------------------
[2715]228   !!   Default case :          Dummy module           No trend diagnostics
[2026]229   !!----------------------------------------------------------------------
230   USE par_oce      ! ocean variables trends
231CONTAINS
232   SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pu, ptra )
233      !!----------------------------------------------------------------------
234      INTEGER                         , INTENT(in)           ::  kt      ! time step
235      CHARACTER(len=3)                , INTENT(in)           ::  ctype   ! tracers trends type 'TRA'/'TRC'
236      INTEGER                         , INTENT(in)           ::  ktra    ! tracer index
237      INTEGER                         , INTENT(in)           ::  ktrd    ! tracer trend index
[3211]238      !! DCSE_NEMO: This style defeats ftrans
239!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)           ::  ptrd    ! tracer trend  or flux
240!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pu      ! velocity
241!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  ptra    ! Tracer variable
242
243!FTRANS ptrd pu ptra :I :I :z
[4409]244      REAL(wp), INTENT(in)           ::  ptrd(jpi,jpj,jpkorig)    ! tracer trend  or flux
245      REAL(wp), INTENT(in), OPTIONAL ::  pu(jpi,jpj,jpkorig)      ! velocity
246      REAL(wp), INTENT(in), OPTIONAL ::  ptra(jpi,jpj,jpkorig)    ! Tracer variable
[3211]247
[2715]248      WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd(1,1,1), ptra(1,1,1), pu(1,1,1),   &
249         &                                                               ktrd, ktra, ctype, kt
[2026]250   END SUBROUTINE trd_tra
251#   endif
252   !!======================================================================
253END MODULE trdtra
Note: See TracBrowser for help on using the repository browser.