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

Last change on this file since 2636 was 2636, checked in by gm, 13 years ago

dynamic mem: #785 ; move ctl_stop & warn in lib_mpp to avoid a circular dependency + ctl_stop improvment
  • 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 :  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_1
65      INTEGER                         , INTENT(in)           ::  kt      ! time step
66      CHARACTER(len=3)                , INTENT(in)           ::  ctype   ! tracers trends type 'TRA'/'TRC'
67      INTEGER                         , INTENT(in)           ::  ktra    ! tracer index
68      INTEGER                         , INTENT(in)           ::  ktrd    ! tracer trend index
69      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)           ::  ptrd    ! tracer trend  or flux
70      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pun     ! velocity
71      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  ptra    ! Tracer variable
72      !!----------------------------------------------------------------------
73
74      IF(wrk_in_use(3, 1) ) THEN
75         CALL ctl_stop('trd_tra: requested workspace array unavailable.')   ;   RETURN
76      ENDIF
77
78      IF( .NOT. ALLOCATED( trdtx ) ) THEN       ! allocate trdtra arrays
79         IF( trd_tra_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trd_tra : unable to allocate arrays' )
80      ENDIF
81     
82      ! Control of optional arguments
83      IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN
84         IF( PRESENT( ptra ) ) THEN   
85            SELECT CASE( ktrd )            ! shift depending on the direction
86            CASE( jptra_trd_xad )  ;  CALL trd_tra_adv( ptrd, pun, ptra, 'X', trdtx ) 
87            CASE( jptra_trd_yad )  ;  CALL trd_tra_adv( ptrd, pun, ptra, 'Y', trdty ) 
88            CASE( jptra_trd_zad )  ;  CALL trd_tra_adv( ptrd, pun, ptra, 'Z', trdt  ) 
89            END SELECT
90         ELSE
91            trdt(:,:,:) = ptrd(:,:,:)
92            IF( ktrd == jptra_trd_bbc .OR. ktrd == jptra_trd_qsr ) THEN
93               ztrds(:,:,:) = 0.
94               CALL trd_mod( trdt, ztrds, ktrd, ctype, kt )
95            END IF
96         END IF
97      END IF
98
99      IF( ctype == 'TRA' .AND. ktra == jp_sal ) THEN
100         IF( PRESENT( ptra ) ) THEN   
101            SELECT CASE( ktrd )            ! shift depending on the direction
102            CASE( jptra_trd_xad ) 
103                                CALL trd_tra_adv( ptrd, pun, ptra, 'X', ztrds ) 
104                                CALL trd_mod( trdtx, ztrds, ktrd, ctype, kt   )
105            CASE( jptra_trd_yad ) 
106                                CALL trd_tra_adv( ptrd, pun, ptra, 'Y', ztrds ) 
107                                CALL trd_mod( trdty, ztrds, ktrd, ctype, kt   )
108            CASE( jptra_trd_zad )   
109                                CALL trd_tra_adv( ptrd, pun, ptra, 'Z', ztrds ) 
110                                CALL trd_mod( trdt , ztrds, ktrd, ctype, kt   )
111            END SELECT
112         ELSE
113            ztrds(:,:,:) = ptrd(:,:,:)
114            CALL trd_mod( trdt, ztrds, ktrd, ctype, kt ) 
115         END IF
116      END IF
117
118      IF( ctype == 'TRC' ) THEN
119         !
120         IF( PRESENT( ptra ) ) THEN 
121            SELECT CASE( ktrd )            ! shift depending on the direction
122            CASE( jptra_trd_xad ) 
123                                CALL trd_tra_adv( ptrd, pun, ptra, 'X', ztrds ) 
124                                CALL trd_mod_trc( ztrds, ktra, ktrd, kt       )
125            CASE( jptra_trd_yad ) 
126                                CALL trd_tra_adv( ptrd, pun, ptra, 'Y', ztrds ) 
127                                CALL trd_mod_trc( ztrds, ktra, ktrd, kt       )
128            CASE( jptra_trd_zad )   
129                                CALL trd_tra_adv( ptrd, pun, ptra, 'Z', ztrds ) 
130                                CALL trd_mod_trc( ztrds, ktra, ktrd, kt       )
131            END SELECT
132         ELSE
133            ztrds(:,:,:) = ptrd(:,:,:)
134            CALL trd_mod_trc( ztrds, ktra, ktrd, kt       ) 
135         END IF
136         !
137      ENDIF
138      !
139      IF(wrk_not_released(3, 1) )   CALL ctl_stop('trd_tra: failed to release workspace array.')
140      !
141   END SUBROUTINE trd_tra
142
143
144   SUBROUTINE trd_tra_adv( pf, pun, ptn, cdir, ptrd )
145      !!---------------------------------------------------------------------
146      !!                  ***  ROUTINE trd_tra_adv  ***
147      !!
148      !! ** Purpose :   transformed the i-, j- or k-advective flux into thes
149      !!              i-, j- or k-advective trends, resp.
150      !! ** Method  :   i-advective trends = -un. di-1[T] = -( di-1[fi] - tn di-1[un] )
151      !!                k-advective trends = -un. di-1[T] = -( dj-1[fi] - tn dj-1[un] )
152      !!                k-advective trends = -un. di+1[T] = -( dk+1[fi] - tn dk+1[un] )
153      !!----------------------------------------------------------------------
154      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk)           ::   pf      ! advective flux in one direction
155      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk)           ::   pun     ! now velocity  in one direction
156      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk)           ::   ptn     ! now or before tracer
157      CHARACTER(len=1), INTENT(in )                                   ::   cdir    ! X/Y/Z direction
158      REAL(wp)        , INTENT(out), DIMENSION(jpi,jpj,jpk)           ::   ptrd    ! advective trend in one direction
159      !!
160      INTEGER                          ::   ji, jj, jk   ! dummy loop indices
161      INTEGER                          ::   ii, ij, ik   ! index shift function of the direction
162      REAL(wp)                         ::   zbtr         ! temporary scalar
163      !!----------------------------------------------------------------------
164
165      SELECT CASE( cdir )            ! shift depending on the direction
166      CASE( 'X' )   ;   ii = 1   ; ij = 0   ;   ik = 0      ! i-advective trend
167      CASE( 'Y' )   ;   ii = 0   ; ij = 1   ;   ik = 0      ! j-advective trend
168      CASE( 'Z' )   ;   ii = 0   ; ij = 0   ;   ik =-1      ! k-advective trend
169      END SELECT
170
171      !                              ! set to zero uncomputed values
172      ptrd(jpi,:,:) = 0.e0   ;   ptrd(1,:,:) = 0.e0
173      ptrd(:,jpj,:) = 0.e0   ;   ptrd(:,1,:) = 0.e0
174      ptrd(:,:,jpk) = 0.e0
175      !
176      !
177      DO jk = 1, jpkm1
178         DO jj = 2, jpjm1
179            DO ji = fs_2, fs_jpim1   ! vector opt.
180               zbtr    = 1.e0/ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
181               ptrd(ji,jj,jk) = - zbtr * (      pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)                    &
182                 &                          - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk)  )
183            END DO
184         END DO
185      END DO
186      !
187   END SUBROUTINE trd_tra_adv
188
189#   else
190   !!----------------------------------------------------------------------
191   !!   Default case :          Dummy module           No trend diagnostics
192   !!----------------------------------------------------------------------
193   USE par_oce      ! ocean variables trends
194CONTAINS
195   SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pu, ptra )
196      !!----------------------------------------------------------------------
197      INTEGER                         , INTENT(in)           ::  kt      ! time step
198      CHARACTER(len=3)                , INTENT(in)           ::  ctype   ! tracers trends type 'TRA'/'TRC'
199      INTEGER                         , INTENT(in)           ::  ktra    ! tracer index
200      INTEGER                         , INTENT(in)           ::  ktrd    ! tracer trend index
201      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)           ::  ptrd    ! tracer trend
202      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pu      ! velocity
203      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  ptra    ! Tracer variable
204      WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd(1,1,1)
205      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ptra(1,1,1)
206      WRITE(*,*) ' "   ": You should not have seen this print! error ?', pu(1,1,1)
207      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ktrd
208      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ktra
209      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ctype
210      WRITE(*,*) ' "   ": You should not have seen this print! error ?', kt
211   END SUBROUTINE trd_tra
212#   endif
213   !!======================================================================
214END MODULE trdtra
Note: See TracBrowser for help on using the repository browser.