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

Last change on this file since 2287 was 2287, checked in by smasson, 14 years ago

update licence of all NEMO files...
  • Property svn:keywords set to Id
File size: 9.9 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         END IF
74      END IF
75
76      IF( ctype == 'TRA' .AND. ktra == jp_sal ) THEN
77         IF( PRESENT( ptra ) ) THEN   
78            SELECT CASE( ktrd )            ! shift depending on the direction
79            CASE( jptra_trd_xad ) 
80                                CALL trd_tra_adv( ptrd, pun, ptra, 'X', ztrds ) 
81                                CALL trd_mod( trdtx, ztrds, ktrd, ctype, kt   )
82            CASE( jptra_trd_yad ) 
83                                CALL trd_tra_adv( ptrd, pun, ptra, 'Y', ztrds ) 
84                                CALL trd_mod( trdty, ztrds, ktrd, ctype, kt   )
85            CASE( jptra_trd_zad )   
86                                CALL trd_tra_adv( ptrd, pun, ptra, 'Z', ztrds ) 
87                                CALL trd_mod( trdt , ztrds, ktrd, ctype, kt   )
88            END SELECT
89         ELSE
90            ztrds(:,:,:) = ptrd(:,:,:)
91            CALL trd_mod( trdt, ztrds, ktrd, ctype, kt ) 
92         END IF
93      END IF
94
95      IF( ctype == 'TRC' ) THEN
96         !
97         IF( PRESENT( ptra ) ) THEN 
98            SELECT CASE( ktrd )            ! shift depending on the direction
99            CASE( jptra_trd_xad ) 
100                                CALL trd_tra_adv( ptrd, pun, ptra, 'X', ztrds ) 
101                                CALL trd_mod_trc( ztrds, ktra, ktrd, kt       )
102            CASE( jptra_trd_yad ) 
103                                CALL trd_tra_adv( ptrd, pun, ptra, 'Y', ztrds ) 
104                                CALL trd_mod_trc( ztrds, ktra, ktrd, kt       )
105            CASE( jptra_trd_zad )   
106                                CALL trd_tra_adv( ptrd, pun, ptra, 'Z', ztrds ) 
107                                CALL trd_mod_trc( ztrds, ktra, ktrd, kt       )
108            END SELECT
109         ELSE
110            ztrds(:,:,:) = ptrd(:,:,:)
111            CALL trd_mod_trc( ztrds, ktra, ktrd, kt       ) 
112         END IF
113         !
114      ENDIF
115      !
116   END SUBROUTINE trd_tra
117
118   SUBROUTINE trd_tra_adv( pf, pun, ptn, cdir, ptrd )
119      !!---------------------------------------------------------------------
120      !!                  ***  ROUTINE trd_tra_adv  ***
121      !!
122      !! ** Purpose :   transformed the i-, j- or k-advective flux into thes
123      !!              i-, j- or k-advective trends, resp.
124      !! ** Method  :   i-advective trends = -un. di-1[T] = -( di-1[fi] - tn di-1[un] )
125      !!                k-advective trends = -un. di-1[T] = -( dj-1[fi] - tn dj-1[un] )
126      !!                k-advective trends = -un. di+1[T] = -( dk+1[fi] - tn dk+1[un] )
127      !!----------------------------------------------------------------------
128      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk)           ::   pf      ! advective flux in one direction
129      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk)           ::   pun     ! now velocity  in one direction
130      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk)           ::   ptn     ! now or before tracer
131      CHARACTER(len=1), INTENT(in )                                   ::   cdir    ! X/Y/Z direction
132      REAL(wp)        , INTENT(out), DIMENSION(jpi,jpj,jpk)           ::   ptrd    ! advective trend in one direction
133      !!
134      INTEGER                          ::   ji, jj, jk   ! dummy loop indices
135      INTEGER                          ::   ii, ij, ik   ! index shift function of the direction
136      REAL(wp)                         ::   zbtr         ! temporary scalar
137      !!----------------------------------------------------------------------
138
139      SELECT CASE( cdir )            ! shift depending on the direction
140      CASE( 'X' )   ;   ii = 1   ; ij = 0   ;   ik = 0      ! i-advective trend
141      CASE( 'Y' )   ;   ii = 0   ; ij = 1   ;   ik = 0      ! j-advective trend
142      CASE( 'Z' )   ;   ii = 0   ; ij = 0   ;   ik =-1      ! k-advective trend
143      END SELECT
144
145      !                              ! set to zero uncomputed values
146      ptrd(jpi,:,:) = 0.e0   ;   ptrd(1,:,:) = 0.e0
147      ptrd(:,jpj,:) = 0.e0   ;   ptrd(:,1,:) = 0.e0
148      ptrd(:,:,jpk) = 0.e0
149      !
150      !
151      DO jk = 1, jpkm1
152         DO jj = 2, jpjm1
153            DO ji = fs_2, fs_jpim1   ! vector opt.
154               zbtr    = 1.e0/ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
155               ptrd(ji,jj,jk) = - zbtr * (      pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)                    &
156                 &                          - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk)  )
157            END DO
158         END DO
159      END DO
160      !
161   END SUBROUTINE trd_tra_adv
162
163#   else
164   !!----------------------------------------------------------------------
165   !!   Default case :                                         Empty module
166   !!----------------------------------------------------------------------
167   USE par_oce      ! ocean variables trends
168
169CONTAINS
170
171   SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pu, ptra )
172      !!----------------------------------------------------------------------
173      INTEGER                         , INTENT(in)           ::  kt      ! time step
174      CHARACTER(len=3)                , INTENT(in)           ::  ctype   ! tracers trends type 'TRA'/'TRC'
175      INTEGER                         , INTENT(in)           ::  ktra    ! tracer index
176      INTEGER                         , INTENT(in)           ::  ktrd    ! tracer trend index
177      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)           ::  ptrd    ! tracer trend
178      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pu      ! velocity
179      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  ptra    ! Tracer variable
180      WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd(1,1,1)
181      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ptra(1,1,1)
182      WRITE(*,*) ' "   ": You should not have seen this print! error ?', pu(1,1,1)
183      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ktrd
184      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ktra
185      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ctype
186      WRITE(*,*) ' "   ": You should not have seen this print! error ?', kt
187   END SUBROUTINE trd_tra
188#   endif
189   !!======================================================================
190END MODULE trdtra
Note: See TracBrowser for help on using the repository browser.