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

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

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