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

source: branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90 @ 2620

Last change on this file since 2620 was 2590, checked in by trackstand2, 13 years ago

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