Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
r2528 r2715 4 4 !! Ocean diagnostics: ocean tracers trends 5 5 !!===================================================================== 6 !! History : 9.0 ! 2004-08 (C. Talandier) Original code7 !! 8 !! NEMO3.3 ! 2010-06 (C. Ethe) merge TRA-TRC6 !! 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 9 !!---------------------------------------------------------------------- 10 10 #if defined key_trdtra || defined key_trdmld || defined key_trdmld_trc … … 12 12 !! trd_tra : Call the trend to be computed 13 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 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 18 20 19 21 IMPLICIT NONE 20 22 PRIVATE 21 23 22 PUBLIC trd_tra ! called by all traXX modules24 PUBLIC trd_tra ! called by all traXX modules 23 25 24 !! * Module declaration 25 REAL(wp), DIMENSION(jpi,jpj,jpk), SAVE :: trdtx, trdty, trdt !: 26 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: trdtx, trdty, trdt !: 26 27 27 28 !! * Substitutions … … 29 30 # include "vectopt_loop_substitute.h90" 30 31 !!---------------------------------------------------------------------- 31 !! NEMO/OPA 3.3 , NEMO Consortium (2010)32 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 32 33 !! $Id$ 33 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 34 !!---------------------------------------------------------------------- 35 34 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 35 !!---------------------------------------------------------------------- 36 36 CONTAINS 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 37 48 38 49 SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pun, ptra ) … … 50 61 !! nn_ctls > 1 : use fixed level surface jk = nn_ctls 51 62 !!---------------------------------------------------------------------- 63 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 64 USE wrk_nemo, ONLY: ztrds => wrk_3d_10 ! 3D workspace 65 ! 52 66 INTEGER , INTENT(in) :: kt ! time step 53 67 CHARACTER(len=3) , INTENT(in) :: ctype ! tracers trends type 'TRA'/'TRC' … … 57 71 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pun ! velocity 58 72 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: ptra ! Tracer variable 59 !! 60 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrds ! 61 !!---------------------------------------------------------------------- 62 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 63 83 ! Control of optional arguments 64 84 IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN … … 118 138 ENDIF 119 139 ! 140 IF( wrk_not_released(3, 10) ) CALL ctl_stop('trd_tra: failed to release workspace array') 141 ! 120 142 END SUBROUTINE trd_tra 143 121 144 122 145 SUBROUTINE trd_tra_adv( pf, pun, ptn, cdir, ptrd ) … … 130 153 !! k-advective trends = -un. di+1[T] = -( dk+1[fi] - tn dk+1[un] ) 131 154 !!---------------------------------------------------------------------- 132 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) 133 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) 134 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) 135 CHARACTER(len=1), INTENT(in ) 136 REAL(wp) , INTENT(out), DIMENSION(jpi,jpj,jpk) 137 ! !138 INTEGER 139 INTEGER 140 REAL(wp) :: zbtr ! temporaryscalar155 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 141 164 !!---------------------------------------------------------------------- 142 165 … … 167 190 # else 168 191 !!---------------------------------------------------------------------- 169 !! Default case : Empty module192 !! Default case : Dummy module No trend diagnostics 170 193 !!---------------------------------------------------------------------- 171 194 USE par_oce ! ocean variables trends 172 173 195 CONTAINS 174 175 196 SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pu, ptra ) 176 197 !!---------------------------------------------------------------------- … … 182 203 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pu ! velocity 183 204 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: ptra ! Tracer variable 184 WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd(1,1,1) 185 WRITE(*,*) ' " ": You should not have seen this print! error ?', ptra(1,1,1) 186 WRITE(*,*) ' " ": You should not have seen this print! error ?', pu(1,1,1) 187 WRITE(*,*) ' " ": You should not have seen this print! error ?', ktrd 188 WRITE(*,*) ' " ": You should not have seen this print! error ?', ktra 189 WRITE(*,*) ' " ": You should not have seen this print! error ?', ctype 190 WRITE(*,*) ' " ": You should not have seen this print! error ?', kt 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 191 207 END SUBROUTINE trd_tra 192 208 # endif
Note: See TracChangeset
for help on using the changeset viewer.