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

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90 @ 2327

Last change on this file since 2327 was 2327, checked in by cetlod, 13 years ago

improvment of the trends routine manager, trdtra.F90

  • Property svn:keywords set to Id
File size: 10.1 KB
Line 
1MODULE trdtra
2   !!======================================================================
3   !!                       ***  MODULE  trdtra  ***
4   !! Ocean diagnostics:  ocean tracers trends
5   !!=====================================================================
6   !! History :  9.0  !  2004-08  (C. Talandier) Original code
7   !!                 !  2005-04  (C. Deltel)    Add Asselin trend in the ML budget
8   !!      NEMO  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
19   IMPLICIT NONE
20   PRIVATE
21
22   PUBLIC trd_tra          ! called by all  traXX modules
23 
24   !! * Module declaration
25   REAL(wp), DIMENSION(jpi,jpj,jpk), SAVE :: trdtx, trdty, trdt  !:
26
27   !! * Substitutions
28#  include "domzgr_substitute.h90"
29#  include "vectopt_loop_substitute.h90"
30   !!----------------------------------------------------------------------
31   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
32   !! $Id$
33   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
34   !!----------------------------------------------------------------------
35
36CONTAINS
37
38   SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pun, ptra )
39      !!---------------------------------------------------------------------
40      !!                  ***  ROUTINE trd_tra  ***
41      !!
42      !! ** Purpose : Dispatch all trends computation, e.g. vorticity, mld or
43      !!              integral constraints
44      !!
45      !! ** Method/usage : For the mixed-layer trend, the control surface can be either
46      !!       a mixed layer depth (time varying) or a fixed surface (jk level or bowl).
47      !!      Choose control surface with nn_ctls in namelist NAMTRD :
48      !!        nn_ctls = 0  : use mixed layer with density criterion
49      !!        nn_ctls = 1  : read index from file 'ctlsurf_idx'
50      !!        nn_ctls > 1  : use fixed level surface jk = nn_ctls
51      !!----------------------------------------------------------------------
52      INTEGER                         , INTENT(in)           ::  kt      ! time step
53      CHARACTER(len=3)                , INTENT(in)           ::  ctype   ! tracers trends type 'TRA'/'TRC'
54      INTEGER                         , INTENT(in)           ::  ktra    ! tracer index
55      INTEGER                         , INTENT(in)           ::  ktrd    ! tracer trend index
56      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)           ::  ptrd    ! tracer trend  or flux
57      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pun     ! velocity
58      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  ptra    ! Tracer variable
59      !!
60      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  ztrds   
61      !!----------------------------------------------------------------------
62
63      ! Control of optional arguments
64      IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN
65         IF( PRESENT( ptra ) ) THEN   
66            SELECT CASE( ktrd )            ! shift depending on the direction
67            CASE( jptra_trd_xad )  ;  CALL trd_tra_adv( ptrd, pun, ptra, 'X', trdtx ) 
68            CASE( jptra_trd_yad )  ;  CALL trd_tra_adv( ptrd, pun, ptra, 'Y', trdty ) 
69            CASE( jptra_trd_zad )  ;  CALL trd_tra_adv( ptrd, pun, ptra, 'Z', trdt  ) 
70            END SELECT
71         ELSE
72            trdt(:,:,:) = ptrd(:,:,:)
73            IF( ktrd == jptra_trd_bbc .OR. ktrd == jptra_trd_qsr ) THEN
74               ztrds(:,:,:) = 0.
75               CALL trd_mod( trdt, ztrds, ktrd, ctype, kt )
76            END IF
77         END IF
78      END IF
79
80      IF( ctype == 'TRA' .AND. ktra == jp_sal ) THEN
81         IF( PRESENT( ptra ) ) THEN   
82            SELECT CASE( ktrd )            ! shift depending on the direction
83            CASE( jptra_trd_xad ) 
84                                CALL trd_tra_adv( ptrd, pun, ptra, 'X', ztrds ) 
85                                CALL trd_mod( trdtx, ztrds, ktrd, ctype, kt   )
86            CASE( jptra_trd_yad ) 
87                                CALL trd_tra_adv( ptrd, pun, ptra, 'Y', ztrds ) 
88                                CALL trd_mod( trdty, ztrds, ktrd, ctype, kt   )
89            CASE( jptra_trd_zad )   
90                                CALL trd_tra_adv( ptrd, pun, ptra, 'Z', ztrds ) 
91                                CALL trd_mod( trdt , ztrds, ktrd, ctype, kt   )
92            END SELECT
93         ELSE
94            ztrds(:,:,:) = ptrd(:,:,:)
95            CALL trd_mod( trdt, ztrds, ktrd, ctype, kt ) 
96         END IF
97      END IF
98
99      IF( ctype == 'TRC' ) THEN
100         !
101         IF( PRESENT( ptra ) ) THEN 
102            SELECT CASE( ktrd )            ! shift depending on the direction
103            CASE( jptra_trd_xad ) 
104                                CALL trd_tra_adv( ptrd, pun, ptra, 'X', ztrds ) 
105                                CALL trd_mod_trc( ztrds, ktra, ktrd, kt       )
106            CASE( jptra_trd_yad ) 
107                                CALL trd_tra_adv( ptrd, pun, ptra, 'Y', ztrds ) 
108                                CALL trd_mod_trc( ztrds, ktra, ktrd, kt       )
109            CASE( jptra_trd_zad )   
110                                CALL trd_tra_adv( ptrd, pun, ptra, 'Z', ztrds ) 
111                                CALL trd_mod_trc( ztrds, ktra, ktrd, kt       )
112            END SELECT
113         ELSE
114            ztrds(:,:,:) = ptrd(:,:,:)
115            CALL trd_mod_trc( ztrds, ktra, ktrd, kt       ) 
116         END IF
117         !
118      ENDIF
119      !
120   END SUBROUTINE trd_tra
121
122   SUBROUTINE trd_tra_adv( pf, pun, ptn, cdir, ptrd )
123      !!---------------------------------------------------------------------
124      !!                  ***  ROUTINE trd_tra_adv  ***
125      !!
126      !! ** Purpose :   transformed the i-, j- or k-advective flux into thes
127      !!              i-, j- or k-advective trends, resp.
128      !! ** Method  :   i-advective trends = -un. di-1[T] = -( di-1[fi] - tn di-1[un] )
129      !!                k-advective trends = -un. di-1[T] = -( dj-1[fi] - tn dj-1[un] )
130      !!                k-advective trends = -un. di+1[T] = -( dk+1[fi] - tn dk+1[un] )
131      !!----------------------------------------------------------------------
132      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk)           ::   pf      ! advective flux in one direction
133      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk)           ::   pun     ! now velocity  in one direction
134      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk)           ::   ptn     ! now or before tracer
135      CHARACTER(len=1), INTENT(in )                                   ::   cdir    ! X/Y/Z direction
136      REAL(wp)        , INTENT(out), DIMENSION(jpi,jpj,jpk)           ::   ptrd    ! advective trend in one direction
137      !!
138      INTEGER                          ::   ji, jj, jk   ! dummy loop indices
139      INTEGER                          ::   ii, ij, ik   ! index shift function of the direction
140      REAL(wp)                         ::   zbtr         ! temporary scalar
141      !!----------------------------------------------------------------------
142
143      SELECT CASE( cdir )            ! shift depending on the direction
144      CASE( 'X' )   ;   ii = 1   ; ij = 0   ;   ik = 0      ! i-advective trend
145      CASE( 'Y' )   ;   ii = 0   ; ij = 1   ;   ik = 0      ! j-advective trend
146      CASE( 'Z' )   ;   ii = 0   ; ij = 0   ;   ik =-1      ! k-advective trend
147      END SELECT
148
149      !                              ! set to zero uncomputed values
150      ptrd(jpi,:,:) = 0.e0   ;   ptrd(1,:,:) = 0.e0
151      ptrd(:,jpj,:) = 0.e0   ;   ptrd(:,1,:) = 0.e0
152      ptrd(:,:,jpk) = 0.e0
153      !
154      !
155      DO jk = 1, jpkm1
156         DO jj = 2, jpjm1
157            DO ji = fs_2, fs_jpim1   ! vector opt.
158               zbtr    = 1.e0/ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
159               ptrd(ji,jj,jk) = - zbtr * (      pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)                    &
160                 &                          - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk)  )
161            END DO
162         END DO
163      END DO
164      !
165   END SUBROUTINE trd_tra_adv
166
167#   else
168   !!----------------------------------------------------------------------
169   !!   Default case :                                         Empty module
170   !!----------------------------------------------------------------------
171   USE par_oce      ! ocean variables trends
172
173CONTAINS
174
175   SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pu, ptra )
176      !!----------------------------------------------------------------------
177      INTEGER                         , INTENT(in)           ::  kt      ! time step
178      CHARACTER(len=3)                , INTENT(in)           ::  ctype   ! tracers trends type 'TRA'/'TRC'
179      INTEGER                         , INTENT(in)           ::  ktra    ! tracer index
180      INTEGER                         , INTENT(in)           ::  ktrd    ! tracer trend index
181      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)           ::  ptrd    ! tracer trend
182      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pu      ! velocity
183      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  ptra    ! Tracer variable
184      WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd(1,1,1)
185      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ptra(1,1,1)
186      WRITE(*,*) ' "   ": You should not have seen this print! error ?', pu(1,1,1)
187      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ktrd
188      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ktra
189      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ctype
190      WRITE(*,*) ' "   ": You should not have seen this print! error ?', kt
191   END SUBROUTINE trd_tra
192#   endif
193   !!======================================================================
194END MODULE trdtra
Note: See TracBrowser for help on using the repository browser.