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 @ 3211

Last change on this file since 3211 was 3211, checked in by spickles2, 12 years ago

Stephen Pickles, 11 Dec 2011

Commit to bring the rest of the DCSE NEMO development branch
in line with the latest development version. This includes
array index re-ordering of all OPA_SRC/.
  • Property svn:keywords set to Id
File size: 12.4 KB
Line 
1MODULE trdtra
2   !!======================================================================
3   !!                       ***  MODULE  trdtra  ***
4   !! Ocean diagnostics:  ocean tracers trends
5   !!=====================================================================
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
9   !!----------------------------------------------------------------------
10#if  defined key_trdtra || defined key_trdmld || defined key_trdmld_trc 
11   !!----------------------------------------------------------------------
12   !!   trd_tra      : Call the trend to be computed
13   !!----------------------------------------------------------------------
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
20
21   IMPLICIT NONE
22   PRIVATE
23
24   PUBLIC   trd_tra          ! called by all  traXX modules
25 
26   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: trdtx, trdty, trdt  !:
27
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
34   !! * Substitutions
35#  include "domzgr_substitute.h90"
36#  include "vectopt_loop_substitute.h90"
37   !!----------------------------------------------------------------------
38   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
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 : 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      !!----------------------------------------------------------------------
69      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
70      USE wrk_nemo, ONLY:   ztrds => wrk_3d_10   ! 3D workspace
71      !! DCSE_NEMO: Need additional directives for renamed module variables
72!FTRANS ztrds :I :I :z
73
74      !
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
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
86      REAL(wp), INTENT(in)           ::  ptrd(jpi,jpj,jpk)    ! tracer trend  or flux
87      REAL(wp), INTENT(in), OPTIONAL ::  pun(jpi,jpj,jpk)     ! velocity
88      REAL(wp), INTENT(in), OPTIONAL ::  ptra(jpi,jpj,jpk)    ! Tracer variable
89      !!----------------------------------------------------------------------
90
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     
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(:,:,:)
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
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      !
156      IF( wrk_not_released(3, 10) )   CALL ctl_stop('trd_tra: failed to release workspace array')
157      !
158   END SUBROUTINE trd_tra
159
160   !! * Reset control of array index permutation
161!FTRANS CLEAR
162#  include "dom_oce_ftrans.h90"
163!FTRANS trdtx trdty trdt :I :I :z
164
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      !!----------------------------------------------------------------------
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
182      REAL(wp)        , INTENT(in )            ::   pf(jpi,jpj,jpk)      ! advective flux in one direction
183      REAL(wp)        , INTENT(in )            ::   pun(jpi,jpj,jpk)     ! now velocity  in one direction
184      REAL(wp)        , INTENT(in )            ::   ptn(jpi,jpj,jpk)     ! now or before tracer
185      CHARACTER(len=1), INTENT(in )                         ::   cdir    ! X/Y/Z direction
186
187!     REAL(wp)        , INTENT(out), DIMENSION(jpi,jpj,jpk) ::   ptrd    ! advective trend in one direction
188!FTRANS ptrd :I :I :z
189      REAL(wp)        , INTENT(out)            ::   ptrd(jpi,jpj,jpk)    ! advective trend in one direction
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
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      !
208#if defined key_z_first
209      DO jj = 2, jpjm1
210         DO ji = 2, jpim1
211            DO jk = 1, jpkm1
212#else
213      DO jk = 1, jpkm1
214         DO jj = 2, jpjm1
215            DO ji = fs_2, fs_jpim1   ! vector opt.
216#endif
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   !!----------------------------------------------------------------------
228   !!   Default case :          Dummy module           No trend diagnostics
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
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
244      REAL(wp), INTENT(in)           ::  ptrd(jpi,jpj,jpk)    ! tracer trend  or flux
245      REAL(wp), INTENT(in), OPTIONAL ::  pu(jpi,jpj,jpk)      ! velocity
246      REAL(wp), INTENT(in), OPTIONAL ::  ptra(jpi,jpj,jpk)    ! Tracer variable
247
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
250   END SUBROUTINE trd_tra
251#   endif
252   !!======================================================================
253END MODULE trdtra
Note: See TracBrowser for help on using the repository browser.