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

Last change on this file since 2710 was 2710, checked in by smasson, 13 years ago

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