Changeset 5836 for trunk/NEMOGCM/NEMO/TOP_SRC
- Timestamp:
- 2015-10-26T15:49:40+01:00 (9 years ago)
- Location:
- trunk/NEMOGCM/NEMO/TOP_SRC
- Files:
-
- 2 deleted
- 46 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90
r5215 r5836 50 50 51 51 !! * Substitutions 52 # include "top_substitute.h90" 53 52 # include "domzgr_substitute.h90" 54 53 !!---------------------------------------------------------------------- 55 54 !! NEMO/TOP 3.3 , NEMO Consortium (2010) -
trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcwri_c14b.F90
r5407 r5836 20 20 PUBLIC trc_wri_c14b 21 21 22 # include "top_substitute.h90"23 22 CONTAINS 24 23 -
trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
r4996 r5836 51 51 52 52 !! * Substitutions 53 # include " top_substitute.h90"53 # include "domzgr_substitute.h90" 54 54 !!---------------------------------------------------------------------- 55 55 !! NEMO/TOP 3.3 , NEMO Consortium (2010) -
trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcwri_cfc.F90
r5407 r5836 20 20 PUBLIC trc_wri_cfc 21 21 22 # include "top_substitute.h90"23 22 CONTAINS 24 23 -
trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90
r5407 r5836 20 20 PUBLIC trc_wri_my_trc 21 21 22 # include "top_substitute.h90"23 22 CONTAINS 24 23 -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90
r5656 r5836 59 59 REAL(wp) :: fdbod ! zooplankton mortality fraction that goes to detritus 60 60 61 !!* Substitution 62 # include "top_substitute.h90" 61 !! * Substitutions 62 # include "domzgr_substitute.h90" 63 # include "vectopt_loop_substitute.h90" 63 64 !!---------------------------------------------------------------------- 64 65 !! NEMO/TOP 3.3 , NEMO Consortium (2010) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90
r5215 r5836 41 41 REAL(wp) :: areacot !: surface coastal area 42 42 43 !!* Substitution 44 # include "top_substitute.h90" 43 !! * Substitutions 44 # include "domzgr_substitute.h90" 45 # include "vectopt_loop_substitute.h90" 45 46 !!---------------------------------------------------------------------- 46 47 !! NEMO/TOP 3.3 , NEMO Consortium (2010) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90
r5385 r5836 40 40 REAL(wp), PUBLIC :: reddom ! redfield ratio (C:N) for DOM 41 41 42 !! * Substitution43 # include " top_substitute.h90"42 !! * Substitutions 43 # include "domzgr_substitute.h90" 44 44 !!---------------------------------------------------------------------- 45 45 !! NEMO/TOP 3.3 , NEMO Consortium (2010) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90
r5215 r5836 34 34 REAL(wp), PUBLIC :: xhr ! coeff for martin''s remineralisation profile 35 35 36 !! * Substitution37 # include " top_substitute.h90"36 !! * Substitutions 37 # include "domzgr_substitute.h90" 38 38 !!---------------------------------------------------------------------- 39 39 !! NEMO/TOP 3.3 , NEMO Consortium (2010) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90
r5656 r5836 34 34 PUBLIC p4z_bio 35 35 36 !! * Substitution37 # include " top_substitute.h90"36 !! * Substitutions 37 # include "domzgr_substitute.h90" 38 38 !!---------------------------------------------------------------------- 39 39 !! NEMO/TOP 3.3 , NEMO Consortium (2010) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90
r5656 r5836 164 164 REAL(wp) :: devk55 = 0.3692E-3 165 165 166 !! * Substitution167 # include "top_substitute.h90"166 !! * Substitutions 167 # include "domzgr_substitute.h90" 168 168 !!---------------------------------------------------------------------- 169 169 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 195 195 ! CHEMICAL CONSTANTS - SURFACE LAYER 196 196 ! ---------------------------------- 197 !CDIR NOVERRCHK198 197 DO jj = 1, jpj 199 !CDIR NOVERRCHK200 198 DO ji = 1, jpi 201 199 ! ! SET ABSOLUTE TEMPERATURE … … 227 225 ! OXYGEN SOLUBILITY - DEEP OCEAN 228 226 ! ------------------------------- 229 !CDIR NOVERRCHK230 227 DO jk = 1, jpk 231 !CDIR NOVERRCHK232 228 DO jj = 1, jpj 233 !CDIR NOVERRCHK234 229 DO ji = 1, jpi 235 230 ztkel = tsn(ji,jj,jk,jp_tem) + 273.16 … … 252 247 ! CHEMICAL CONSTANTS - DEEP OCEAN 253 248 ! ------------------------------- 254 !CDIR NOVERRCHK255 249 DO jk = 1, jpk 256 !CDIR NOVERRCHK257 250 DO jj = 1, jpj 258 !CDIR NOVERRCHK259 251 DO ji = 1, jpi 260 252 -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90
r5385 r5836 39 39 REAL(wp) :: kl1, kl2, kb1, kb2, ks, kpr, spd, con, kth 40 40 41 !! * Substitution42 # include " top_substitute.h90"41 !! * Substitutions 42 # include "domzgr_substitute.h90" 43 43 !!---------------------------------------------------------------------- 44 44 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 113 113 ! Chemistry is supposed to be fast enough to be at equilibrium 114 114 ! ------------------------------------------------------------ 115 !CDIR NOVERRCHK116 115 DO jk = 1, jpkm1 117 !CDIR NOVERRCHK118 116 DO jj = 1, jpj 119 !CDIR NOVERRCHK120 117 DO ji = 1, jpi 121 118 ! Calculate ligand concentrations : assume 2/3rd of excess goes to … … 195 192 ! Chemistry is supposed to be fast enough to be at equilibrium 196 193 ! ------------------------------------------------------------ 197 !CDIR NOVERRCHK198 194 DO jk = 1, jpkm1 199 !CDIR NOVERRCHK200 195 DO jj = 1, jpj 201 !CDIR NOVERRCHK202 196 DO ji = 1, jpi 203 197 zTL1(ji,jj,jk) = ztotlig(ji,jj,jk) … … 216 210 ! 217 211 ENDIF 218 212 ! 219 213 zdust = 0. ! if no dust available 220 !CDIR NOVERRCHK 214 ! 221 215 DO jk = 1, jpkm1 222 !CDIR NOVERRCHK223 216 DO jj = 1, jpj 224 !CDIR NOVERRCHK225 217 DO ji = 1, jpi 226 218 zstep = xstep -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90
r5656 r5836 59 59 REAL(wp) :: xconv = 0.01_wp / 3600._wp !: coefficients for conversion 60 60 61 !! * Substitution62 # include " top_substitute.h90"61 !! * Substitutions 62 # include "domzgr_substitute.h90" 63 63 !!---------------------------------------------------------------------- 64 64 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 122 122 123 123 DO jm = 1, 10 124 !CDIR NOVERRCHK125 124 DO jj = 1, jpj 126 !CDIR NOVERRCHK127 125 DO ji = 1, jpi 128 126 … … 155 153 ! ------------------------------------------- 156 154 157 !CDIR NOVERRCHK158 155 DO jj = 1, jpj 159 !CDIR NOVERRCHK160 156 DO ji = 1, jpi 161 157 ztc = MIN( 35., tsn(ji,jj,1,jp_tem) ) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90
r5656 r5836 52 52 REAL(wp) :: xcoef2 = 1.21E-5 * 14. / 55.85 / 7.625 * 0.5 * 1.5 53 53 REAL(wp) :: xcoef3 = 1.15E-4 * 14. / 55.85 / 7.625 * 0.5 54 !!* Substitution 55 # include "top_substitute.h90" 54 56 55 !!---------------------------------------------------------------------- 57 56 !! NEMO/TOP 3.3 , NEMO Consortium (2010) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90
r5656 r5836 80 80 DO jn = 1, 5 ! BEGIN OF ITERATION 81 81 ! 82 !CDIR NOVERRCHK83 82 DO jk = 1, jpkm1 84 !CDIR NOVERRCHK85 83 DO jj = 1, jpj 86 !CDIR NOVERRCHK87 84 DO ji = 1, jpi 88 85 zfact = rhop(ji,jj,jk) / 1000. + rtrn -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90
r5656 r5836 50 50 REAL(wp), PUBLIC :: grazflux !: mesozoo flux feeding rate 51 51 52 !!* Substitution53 # include "top_substitute.h90"54 52 !!---------------------------------------------------------------------- 55 53 !! NEMO/TOP 3.3 , NEMO Consortium (2010) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90
r5656 r5836 49 49 50 50 51 !!* Substitution52 # include "top_substitute.h90"53 51 !!---------------------------------------------------------------------- 54 52 !! NEMO/TOP 3.3 , NEMO Consortium (2010) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90
r5656 r5836 35 35 36 36 37 !!* Substitution38 # include "top_substitute.h90"39 37 !!---------------------------------------------------------------------- 40 38 !! NEMO/TOP 3.3 , NEMO Consortium (2010) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
r5656 r5836 51 51 REAL(wp), DIMENSION(3,61), PUBLIC :: xkrgb !: tabulated attenuation coefficients for RGB absorption 52 52 53 !! * Substitution54 # include " top_substitute.h90"53 !! * Substitutions 54 # include "domzgr_substitute.h90" 55 55 !!---------------------------------------------------------------------- 56 56 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 95 95 ! !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 96 96 DO jk = 1, jpkm1 ! -------------------------------------------------------- 97 !CDIR NOVERRCHK98 97 DO jj = 1, jpj 99 !CDIR NOVERRCHK100 98 DO ji = 1, jpi 101 99 zchl = ( trb(ji,jj,jk,jpnch) + trb(ji,jj,jk,jpdch) + rtrn ) * 1.e6 … … 179 177 180 178 DO jk = 1, nksrp 181 !CDIR NOVERRCHK182 179 DO jj = 1, jpj 183 !CDIR NOVERRCHK184 180 DO ji = 1, jpi 185 181 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN … … 198 194 ! 199 195 DO jk = 1, nksrp 200 !CDIR NOVERRCHK201 196 DO jj = 1, jpj 202 !CDIR NOVERRCHK203 197 DO ji = 1, jpi 204 198 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN … … 264 258 ! 265 259 DO jk = 2, nksrp + 1 266 !CDIR NOVERRCHK267 260 DO jj = 1, jpj 268 !CDIR NOVERRCHK269 261 DO ji = 1, jpi 270 262 pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) * xsi0r ) … … 285 277 ! 286 278 DO jk = 2, nksrp 287 !CDIR NOVERRCHK288 279 DO jj = 1, jpj 289 !CDIR NOVERRCHK290 280 DO ji = 1, jpi 291 281 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
r5656 r5836 54 54 REAL(wp) :: texcret2 !: 1 - excret2 55 55 56 57 !!* Substitution 58 # include "top_substitute.h90" 56 !! * Substitutions 57 # include "domzgr_substitute.h90" 59 58 !!---------------------------------------------------------------------- 60 59 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 148 147 149 148 IF( ln_newprod ) THEN 150 !CDIR NOVERRCHK151 149 DO jk = 1, jpkm1 152 !CDIR NOVERRCHK153 150 DO jj = 1, jpj 154 !CDIR NOVERRCHK155 151 DO ji = 1, jpi 156 152 ! Computation of the P-I slope for nanos and diatoms … … 186 182 END DO 187 183 ELSE 188 !CDIR NOVERRCHK189 184 DO jk = 1, jpkm1 190 !CDIR NOVERRCHK191 185 DO jj = 1, jpj 192 !CDIR NOVERRCHK193 186 DO ji = 1, jpi 194 187 … … 231 224 ! Computation of a proxy of the N/C ratio 232 225 ! --------------------------------------- 233 !CDIR NOVERRCHK234 226 DO jk = 1, jpkm1 235 !CDIR NOVERRCHK236 227 DO jj = 1, jpj 237 !CDIR NOVERRCHK238 228 DO ji = 1, jpi 239 229 zval = MIN( xnanopo4(ji,jj,jk), ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) ) & … … 296 286 297 287 ! Computation of the various production terms 298 !CDIR NOVERRCHK299 288 DO jk = 1, jpkm1 300 !CDIR NOVERRCHK301 289 DO jj = 1, jpj 302 !CDIR NOVERRCHK303 290 DO ji = 1, jpi 304 291 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN … … 331 318 332 319 IF( ln_newprod ) THEN 333 !CDIR NOVERRCHK334 320 DO jk = 1, jpkm1 335 !CDIR NOVERRCHK336 321 DO jj = 1, jpj 337 !CDIR NOVERRCHK338 322 DO ji = 1, jpi 339 323 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN … … 359 343 END DO 360 344 ELSE 361 !CDIR NOVERRCHK362 345 DO jk = 1, jpkm1 363 !CDIR NOVERRCHK364 346 DO jj = 1, jpj 365 !CDIR NOVERRCHK366 347 DO ji = 1, jpi 367 348 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90
r5385 r5836 50 50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: denitnh4 !: - - - - - 51 51 52 !! * Substitution53 # include " top_substitute.h90"52 !! * Substitutions 53 # include "domzgr_substitute.h90" 54 54 !!---------------------------------------------------------------------- 55 55 !! NEMO/TOP 3.3 , NEMO Consortium (2010) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90
r5656 r5836 81 81 82 82 83 !!* Substitution 84 # include "top_substitute.h90" 83 !! * Substitutions 84 # include "domzgr_substitute.h90" 85 # include "vectopt_loop_substitute.h90" 85 86 !!---------------------------------------------------------------------- 86 87 !! NEMO/TOP 3.3 , NEMO Consortium (2010) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90
r5656 r5836 38 38 REAL(wp) :: r1_rday !: inverse of rday 39 39 40 !! * Substitution41 # include " top_substitute.h90"40 !! * Substitutions 41 # include "domzgr_substitute.h90" 42 42 !!---------------------------------------------------------------------- 43 43 !! NEMO/TOP 3.3 , NEMO Consortium (2010) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90
r5656 r5836 65 65 #endif 66 66 67 !! * Substitution68 # include " top_substitute.h90"67 !! * Substitutions 68 # include "domzgr_substitute.h90" 69 69 !!---------------------------------------------------------------------- 70 70 !! NEMO/TOP 3.3 , NEMO Consortium (2010) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90
r5547 r5836 45 45 46 46 47 !! * Substitutions48 # include "top_substitute.h90"49 47 !!---------------------------------------------------------------------- 50 48 !! NEMO/TOP 3.3 , NEMO Consortium (2010) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90
r5385 r5836 27 27 PUBLIC trc_ini_pisces ! called by trcini.F90 module 28 28 29 30 # include "top_substitute.h90"31 29 !!---------------------------------------------------------------------- 32 30 !! NEMO/TOP 3.3 , NEMO Consortium (2010) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcwri_pisces.F90
r4996 r5836 21 21 PUBLIC trc_wri_pisces 22 22 23 # include "top_substitute.h90" 23 !! * Substitutions 24 # include "domzgr_substitute.h90" 25 24 26 CONTAINS 25 27 -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
r5385 r5836 4 4 !! Ocean passive tracers: advection trend 5 5 !!============================================================================== 6 !! History : 2.0 ! 05-11 (G. Madec) Original code 7 !! 3.0 ! 10-06 (C. Ethe) Adapted to passive tracers 6 !! History : 2.0 ! 2005-11 (G. Madec) Original code 7 !! 3.0 ! 2010-06 (C. Ethe) Adapted to passive tracers 8 !! 3.7 ! 2014-05 (G. Madec, C. Ethe) Add 2nd/4th order cases for CEN and FCT schemes 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_top … … 11 12 !! 'key_top' TOP models 12 13 !!---------------------------------------------------------------------- 13 !! trc_adv : compute ocean tracer advection trend 14 !! trc_adv_ctl : control the different options of advection scheme 15 !!---------------------------------------------------------------------- 16 USE oce_trc ! ocean dynamics and active tracers 17 USE trc ! ocean passive tracers variables 18 USE trcnam_trp ! passive tracers transport namelist variables 19 USE traadv_cen2 ! 2nd order centered scheme (tra_adv_cen2 routine) 20 USE traadv_tvd ! TVD scheme (tra_adv_tvd routine) 21 USE traadv_muscl ! MUSCL scheme (tra_adv_muscl routine) 22 USE traadv_muscl2 ! MUSCL2 scheme (tra_adv_muscl2 routine) 23 USE traadv_ubs ! UBS scheme (tra_adv_ubs routine) 24 USE traadv_qck ! QUICKEST scheme (tra_adv_qck routine) 25 USE traadv_eiv ! eddy induced velocity (tra_adv_eiv routine) 26 USE traadv_mle ! ML eddy induced velocity (tra_adv_mle routine) 27 USE ldftra_oce ! lateral diffusion coefficient on tracers 28 USE prtctl_trc ! Print control 14 !! trc_adv : compute ocean tracer advection trend 15 !! trc_adv_ini : control the different options of advection scheme 16 !!---------------------------------------------------------------------- 17 USE oce_trc ! ocean dynamics and active tracers 18 USE trc ! ocean passive tracers variables 19 USE traadv_cen ! centered scheme (tra_adv_cen routine) 20 USE traadv_fct ! FCT scheme (tra_adv_fct routine) 21 USE traadv_mus ! MUSCL scheme (tra_adv_mus routine) 22 USE traadv_ubs ! UBS scheme (tra_adv_ubs routine) 23 USE traadv_qck ! QUICKEST scheme (tra_adv_qck routine) 24 USE traadv_mle ! ML eddy induced velocity (tra_adv_mle routine) 25 USE ldftra ! lateral diffusion coefficient on tracers 26 USE ldfslp ! Lateral diffusion: slopes of neutral surfaces 27 ! 28 USE prtctl_trc ! Print control 29 29 30 30 IMPLICIT NONE 31 31 PRIVATE 32 32 33 PUBLIC trc_adv ! routine called by step module 34 PUBLIC trc_adv_alloc ! routine called by nemogcm module 35 36 INTEGER :: nadv ! choice of the type of advection scheme 33 PUBLIC trc_adv 34 PUBLIC trc_adv_alloc 35 PUBLIC trc_adv_ini 36 37 ! !!* Namelist namtrc_adv * 38 LOGICAL :: ln_trcadv_cen ! centered scheme flag 39 INTEGER :: nn_cen_h, nn_cen_v ! =2/4 : horizontal and vertical choices of the order of CEN scheme 40 LOGICAL :: ln_trcadv_fct ! FCT scheme flag 41 INTEGER :: nn_fct_h, nn_fct_v ! =2/4 : horizontal and vertical choices of the order of FCT scheme 42 INTEGER :: nn_fct_zts ! >=1 : 2nd order FCT with vertical sub-timestepping 43 LOGICAL :: ln_trcadv_mus ! MUSCL scheme flag 44 LOGICAL :: ln_mus_ups ! use upstream scheme in vivcinity of river mouths 45 LOGICAL :: ln_trcadv_ubs ! UBS scheme flag 46 INTEGER :: nn_ubs_v ! =2/4 : vertical choice of the order of UBS scheme 47 LOGICAL :: ln_trcadv_qck ! QUICKEST scheme flag 48 49 ! ! choices of advection scheme: 50 INTEGER, PARAMETER :: np_NO_adv = 0 ! no T-S advection 51 INTEGER, PARAMETER :: np_CEN = 1 ! 2nd/4th order centered scheme 52 INTEGER, PARAMETER :: np_FCT = 2 ! 2nd/4th order Flux Corrected Transport scheme 53 INTEGER, PARAMETER :: np_FCT_zts = 3 ! 2nd order FCT scheme with vertical sub-timestepping 54 INTEGER, PARAMETER :: np_MUS = 4 ! MUSCL scheme 55 INTEGER, PARAMETER :: np_UBS = 5 ! 3rd order Upstream Biased Scheme 56 INTEGER, PARAMETER :: np_QCK = 6 ! QUICK scheme 57 58 INTEGER :: nadv ! chosen advection scheme 59 ! 37 60 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: r2dt ! vertical profile time-step, = 2 rdttra 38 61 ! ! except at nitrrc000 (=rdttra) if neuler=0 … … 42 65 # include "vectopt_loop_substitute.h90" 43 66 !!---------------------------------------------------------------------- 44 !! NEMO/TOP 3. 3 , NEMO Consortium (2010)67 !! NEMO/TOP 3.7 , NEMO Consortium (2015) 45 68 !! $Id$ 46 69 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 52 75 !! *** ROUTINE trc_adv_alloc *** 53 76 !!---------------------------------------------------------------------- 54 77 ! 55 78 ALLOCATE( r2dt(jpk), STAT=trc_adv_alloc ) 56 79 ! 57 80 IF( trc_adv_alloc /= 0 ) CALL ctl_warn('trc_adv_alloc : failed to allocate array.') 58 81 ! 59 82 END FUNCTION trc_adv_alloc 60 83 … … 68 91 !! ** Method : - Update the tracer with the advection term following nadv 69 92 !!---------------------------------------------------------------------- 70 !!71 93 INTEGER, INTENT(in) :: kt ! ocean time-step index 72 94 ! 73 INTEGER :: jk 95 INTEGER :: jk ! dummy loop index 74 96 CHARACTER (len=22) :: charout 75 97 REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn ! effective velocity 76 98 !!---------------------------------------------------------------------- 77 99 ! 78 IF( nn_timing == 1 ) CALL timing_start('trc_adv') 79 ! 80 CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn ) 81 ! 82 83 IF( kt == nittrc000 ) CALL trc_adv_ctl ! initialisation & control of options 84 100 IF( nn_timing == 1 ) CALL timing_start('trc_adv') 101 ! 102 CALL wrk_alloc( jpi,jpj,jpk, zun, zvn, zwn ) 103 ! 85 104 IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN ! at nittrc000 86 105 r2dt(:) = rdttrc(:) ! = rdttrc (use or restarting with Euler time stepping) … … 88 107 r2dt(:) = 2. * rdttrc(:) ! = 2 rdttrc (leapfrog) 89 108 ENDIF 90 ! ! effective transport109 ! !== effective transport ==! 91 110 DO jk = 1, jpkm1 92 ! ! eulerian transport only 93 zun(:,:,jk) = e2u (:,:) * fse3u(:,:,jk) * un(:,:,jk) 111 zun(:,:,jk) = e2u (:,:) * fse3u(:,:,jk) * un(:,:,jk) ! eulerian transport 94 112 zvn(:,:,jk) = e1v (:,:) * fse3v(:,:,jk) * vn(:,:,jk) 95 113 zwn(:,:,jk) = e1e2t(:,:) * wn(:,:,jk) 96 !97 114 END DO 98 115 ! 99 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 116 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! add z-tilde and/or vvl corrections 100 117 zun(:,:,:) = zun(:,:,:) + un_td(:,:,:) 101 118 zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:) 102 119 ENDIF 103 120 ! 104 zun(:,:,jpk) = 0._wp ! no transport trough the bottom 105 zvn(:,:,jpk) = 0._wp ! no transport trough the bottom 106 zwn(:,:,jpk) = 0._wp ! no transport trough the bottom 107 108 IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif ) & ! add the eiv transport (if necessary) 109 & CALL tra_adv_eiv( kt, nittrc000, zun, zvn, zwn, 'TRC' ) 110 ! 111 IF( ln_mle ) CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' ) ! add the mle transport (if necessary) 112 ! 113 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 114 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nittrc000, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) ! 2nd order centered 115 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! TVD 116 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, tra, jptra, ln_trcadv_msc_ups ) ! MUSCL 117 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! MUSCL2 118 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! UBS 119 CASE ( 6 ) ; CALL tra_adv_qck ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! QUICKEST 120 ! 121 CASE (-1 ) !== esopa: test all possibility with control print ==! 122 CALL tra_adv_cen2 ( kt, nittrc000, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) 123 WRITE(charout, FMT="('adv1')") ; CALL prt_ctl_trc_info(charout) 124 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 125 CALL tra_adv_tvd ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) 126 WRITE(charout, FMT="('adv2')") ; CALL prt_ctl_trc_info(charout) 127 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 128 CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, tra, jptra, ln_trcadv_msc_ups ) 129 WRITE(charout, FMT="('adv3')") ; CALL prt_ctl_trc_info(charout) 130 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 131 CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) 132 WRITE(charout, FMT="('adv4')") ; CALL prt_ctl_trc_info(charout) 133 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 134 CALL tra_adv_ubs ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) 135 WRITE(charout, FMT="('adv5')") ; CALL prt_ctl_trc_info(charout) 136 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 137 CALL tra_adv_qck ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) 138 WRITE(charout, FMT="('adv6')") ; CALL prt_ctl_trc_info(charout) 139 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 140 ! 121 IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad ) & 122 & CALL ldf_eiv_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' ) ! add the eiv transport 123 ! 124 IF( ln_mle ) CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' ) ! add the mle transport 125 ! 126 zun(:,:,jpk) = 0._wp ! no transport trough the bottom 127 zvn(:,:,jpk) = 0._wp 128 zwn(:,:,jpk) = 0._wp 129 ! 130 ! 131 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 132 ! 133 CASE ( np_CEN ) ! Centered : 2nd / 4th order 134 CALL tra_adv_cen ( kt, nittrc000,'TRC', zun, zvn, zwn , trn, tra, jptra, nn_cen_h, nn_cen_v ) 135 CASE ( np_FCT ) ! FCT : 2nd / 4th order 136 CALL tra_adv_fct ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v ) 137 CASE ( np_FCT_zts ) ! 2nd order FCT with vertical time-splitting 138 CALL tra_adv_fct_zts( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra , nn_fct_zts ) 139 CASE ( np_MUS ) ! MUSCL 140 CALL tra_adv_mus ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, tra, jptra , ln_mus_ups ) 141 CASE ( np_UBS ) ! UBS 142 CALL tra_adv_ubs ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra , nn_ubs_v ) 143 CASE ( np_QCK ) ! QUICKEST 144 CALL tra_adv_qck ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) 145 ! 141 146 END SELECT 142 143 ! ! print mean trends (used for debugging) 144 IF( ln_ctl ) THEN 147 ! 148 IF( ln_ctl ) THEN !== print mean trends (used for debugging) 145 149 WRITE(charout, FMT="('adv ')") ; CALL prt_ctl_trc_info(charout) 146 150 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 147 151 END IF 148 152 ! 149 CALL wrk_dealloc( jpi, jpj, jpk,zun, zvn, zwn )153 CALL wrk_dealloc( jpi,jpj,jpk, zun, zvn, zwn ) 150 154 ! 151 155 IF( nn_timing == 1 ) CALL timing_stop('trc_adv') … … 154 158 155 159 156 SUBROUTINE trc_adv_ ctl160 SUBROUTINE trc_adv_ini 157 161 !!--------------------------------------------------------------------- 158 !! *** ROUTINE trc_adv_ ctl***162 !! *** ROUTINE trc_adv_ini *** 159 163 !! 160 164 !! ** Purpose : Control the consistency between namelist options for … … 162 166 !!---------------------------------------------------------------------- 163 167 INTEGER :: ioptio 164 !!---------------------------------------------------------------------- 165 166 ioptio = 0 ! Parameter control 167 IF( ln_trcadv_cen2 ) ioptio = ioptio + 1 168 IF( ln_trcadv_tvd ) ioptio = ioptio + 1 169 IF( ln_trcadv_muscl ) ioptio = ioptio + 1 170 IF( ln_trcadv_muscl2 ) ioptio = ioptio + 1 171 IF( ln_trcadv_ubs ) ioptio = ioptio + 1 172 IF( ln_trcadv_qck ) ioptio = ioptio + 1 173 IF( lk_esopa ) ioptio = 1 174 168 INTEGER :: ios ! Local integer output status for namelist read 169 !! 170 NAMELIST/namtrc_adv/ ln_trcadv_cen, nn_cen_h, nn_cen_v, & ! CEN 171 & ln_trcadv_fct, nn_fct_h, nn_fct_v, nn_fct_zts, & ! FCT 172 & ln_trcadv_mus, ln_mus_ups, & ! MUSCL 173 & ln_trcadv_ubs, nn_ubs_v, & ! UBS 174 & ln_trcadv_qck ! QCK 175 !!---------------------------------------------------------------------- 176 ! 177 REWIND( numnat_ref ) ! namtrc_adv in reference namelist 178 READ ( numnat_ref, namtrc_adv, IOSTAT = ios, ERR = 901) 179 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in reference namelist', lwp ) 180 181 REWIND( numnat_cfg ) ! namtrc_adv in configuration namelist 182 READ ( numnat_cfg, namtrc_adv, IOSTAT = ios, ERR = 902 ) 183 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist', lwp ) 184 IF(lwm) WRITE ( numont, namtrc_adv ) 185 186 IF(lwp) THEN ! Namelist print 187 WRITE(numout,*) 188 WRITE(numout,*) 'trc_adv_ini : choice/control of the tracer advection scheme' 189 WRITE(numout,*) '~~~~~~~~~~~' 190 WRITE(numout,*) ' Namelist namtrc_adv : chose a advection scheme for tracers' 191 WRITE(numout,*) ' centered scheme ln_trcadv_cen = ', ln_trcadv_cen 192 WRITE(numout,*) ' horizontal 2nd/4th order nn_cen_h = ', nn_fct_h 193 WRITE(numout,*) ' vertical 2nd/4th order nn_cen_v = ', nn_fct_v 194 WRITE(numout,*) ' Flux Corrected Transport scheme ln_trcadv_fct = ', ln_trcadv_fct 195 WRITE(numout,*) ' horizontal 2nd/4th order nn_fct_h = ', nn_fct_h 196 WRITE(numout,*) ' vertical 2nd/4th order nn_fct_v = ', nn_fct_v 197 WRITE(numout,*) ' 2nd order + vertical sub-timestepping nn_fct_zts = ', nn_fct_zts 198 WRITE(numout,*) ' MUSCL scheme ln_trcadv_mus = ', ln_trcadv_mus 199 WRITE(numout,*) ' + upstream scheme near river mouths ln_mus_ups = ', ln_mus_ups 200 WRITE(numout,*) ' UBS scheme ln_trcadv_ubs = ', ln_trcadv_ubs 201 WRITE(numout,*) ' vertical 2nd/4th order nn_ubs_v = ', nn_ubs_v 202 WRITE(numout,*) ' QUICKEST scheme ln_trcadv_qck = ', ln_trcadv_qck 203 ENDIF 204 ! 205 206 ioptio = 0 !== Parameter control ==! 207 IF( ln_trcadv_cen ) ioptio = ioptio + 1 208 IF( ln_trcadv_fct ) ioptio = ioptio + 1 209 IF( ln_trcadv_mus ) ioptio = ioptio + 1 210 IF( ln_trcadv_ubs ) ioptio = ioptio + 1 211 IF( ln_trcadv_qck ) ioptio = ioptio + 1 212 213 ! 214 IF( ioptio == 0 ) THEN 215 nadv = np_NO_adv 216 CALL ctl_warn( 'trc_adv_init: You are running without tracer advection.' ) 217 ENDIF 175 218 IF( ioptio /= 1 ) CALL ctl_stop( 'Choose ONE advection scheme in namelist namtrc_adv' ) 176 177 ! ! Set nadv 178 IF( ln_trcadv_cen2 ) nadv = 1 179 IF( ln_trcadv_tvd ) nadv = 2 180 IF( ln_trcadv_muscl ) nadv = 3 181 IF( ln_trcadv_muscl2 ) nadv = 4 182 IF( ln_trcadv_ubs ) nadv = 5 183 IF( ln_trcadv_qck ) nadv = 6 184 IF( lk_esopa ) nadv = -1 185 219 ! 220 IF( ln_trcadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 ) & 221 .AND. ( nn_cen_v /= 2 .AND. nn_cen_v /= 4 ) ) THEN 222 CALL ctl_stop( 'trc_adv_init: CEN scheme, choose 2nd or 4th order' ) 223 ENDIF 224 IF( ln_trcadv_fct .AND. ( nn_fct_h /= 2 .AND. nn_fct_h /= 4 ) & 225 .AND. ( nn_fct_v /= 2 .AND. nn_fct_v /= 4 ) ) THEN 226 CALL ctl_stop( 'trc_adv_init: FCT scheme, choose 2nd or 4th order' ) 227 ENDIF 228 IF( ln_trcadv_fct .AND. nn_fct_zts > 0 ) THEN 229 IF( nn_fct_h == 4 ) THEN 230 nn_fct_h = 2 231 CALL ctl_stop( 'trc_adv_init: force 2nd order FCT scheme, 4th order does not exist with sub-timestepping' ) 232 ENDIF 233 IF( lk_vvl ) THEN 234 CALL ctl_stop( 'trc_adv_init: vertical sub-timestepping not allow in non-linear free surface' ) 235 ENDIF 236 IF( nn_fct_zts == 1 ) CALL ctl_warn( 'trc_adv_init: FCT with ONE sub-timestep = FCT without sub-timestep' ) 237 ENDIF 238 IF( ln_trcadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 ) ) THEN 239 CALL ctl_stop( 'trc_adv_init: UBS scheme, choose 2nd or 4th order' ) 240 ENDIF 241 IF( ln_trcadv_ubs .AND. nn_ubs_v == 4 ) THEN 242 CALL ctl_warn( 'trc_adv_init: UBS scheme, only 2nd FCT scheme available on the vertical. It will be used' ) 243 ENDIF 244 IF( ln_isfcav ) THEN ! ice-shelf cavities 245 IF( ln_trcadv_cen .AND. nn_cen_v /= 4 .OR. & ! NO 4th order with ISF 246 & ln_trcadv_fct .AND. nn_fct_v /= 4 ) CALL ctl_stop( 'tra_adv_init: 4th order COMPACT scheme not allowed with ISF' ) 247 ENDIF 248 ! 249 ! !== used advection scheme ==! 250 ! ! set nadv 251 IF( ln_trcadv_cen ) nadv = np_CEN 252 IF( ln_trcadv_fct ) nadv = np_FCT 253 IF( ln_trcadv_fct .AND. nn_fct_zts > 0 ) nadv = np_FCT_zts 254 IF( ln_trcadv_mus ) nadv = np_MUS 255 IF( ln_trcadv_ubs ) nadv = np_UBS 256 IF( ln_trcadv_qck ) nadv = np_QCK 257 ! 186 258 IF(lwp) THEN ! Print the choice 187 259 WRITE(numout,*) 188 IF( nadv == 1 ) WRITE(numout,*) ' 2nd order scheme is used' 189 IF( nadv == 2 ) WRITE(numout,*) ' TVD scheme is used' 190 IF( nadv == 3 ) WRITE(numout,*) ' MUSCL scheme is used' 191 IF( nadv == 4 ) WRITE(numout,*) ' MUSCL2 scheme is used' 192 IF( nadv == 5 ) WRITE(numout,*) ' UBS scheme is used' 193 IF( nadv == 6 ) WRITE(numout,*) ' QUICKEST scheme is used' 194 IF( nadv == -1 ) WRITE(numout,*) ' esopa test: use all advection scheme' 195 ENDIF 196 ! 197 END SUBROUTINE trc_adv_ctl 260 IF( nadv == np_NO_adv ) WRITE(numout,*) ' NO passive tracer advection' 261 IF( nadv == np_CEN ) WRITE(numout,*) ' CEN scheme is used. Horizontal order: ', nn_cen_h, & 262 & ' Vertical order: ', nn_cen_v 263 IF( nadv == np_FCT ) WRITE(numout,*) ' FCT scheme is used. Horizontal order: ', nn_fct_h, & 264 & ' Vertical order: ', nn_fct_v 265 IF( nadv == np_FCT_zts ) WRITE(numout,*) ' use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping' 266 IF( nadv == np_MUS ) WRITE(numout,*) ' MUSCL scheme is used' 267 IF( nadv == np_UBS ) WRITE(numout,*) ' UBS scheme is used' 268 IF( nadv == np_QCK ) WRITE(numout,*) ' QUICKEST scheme is used' 269 ENDIF 270 ! 271 END SUBROUTINE trc_adv_ini 198 272 199 273 #else -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90
r4990 r5836 22 22 USE oce_trc ! ocean dynamics and active tracers variables 23 23 USE trc ! ocean passive tracers variables 24 USE trcnam_trp ! passive tracers transport namelist variables25 24 USE trabbl ! 26 25 USE prtctl_trc ! Print control for debbuging … … 30 29 PUBLIC trc_bbl ! routine called by step.F90 31 30 32 33 !! * Substitutions34 # include "top_substitute.h90"35 31 !!---------------------------------------------------------------------- 36 32 !! NEMO/TOP 3.3 , NEMO Consortium (2010) -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
r5506 r5836 18 18 USE oce_trc ! ocean dynamics and tracers variables 19 19 USE trc ! ocean passive tracers variables 20 USE trcnam_trp ! passive tracers transport namelist variables21 20 USE trcdta 22 21 USE tradmp … … 29 28 PRIVATE 30 29 31 PUBLIC trc_dmp ! routine called by step.F90 32 PUBLIC trc_dmp_clo ! routine called by step.F90 33 PUBLIC trc_dmp_alloc ! routine called by nemogcm.F90 30 PUBLIC trc_dmp 31 PUBLIC trc_dmp_clo 32 PUBLIC trc_dmp_alloc 33 PUBLIC trc_dmp_ini 34 35 INTEGER , PUBLIC :: nn_zdmp_tr ! = 0/1/2 flag for damping in the mixed layer 36 CHARACTER(LEN=200) , PUBLIC :: cn_resto_tr !File containing restoration coefficient 34 37 35 38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: restotr ! restoring coeff. on tracers (s-1) … … 40 43 41 44 !! * Substitutions 42 # include "top_substitute.h90" 45 # include "domzgr_substitute.h90" 46 # include "vectopt_loop_substitute.h90" 43 47 !!---------------------------------------------------------------------- 44 48 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 90 94 IF( nn_timing == 1 ) CALL timing_start('trc_dmp') 91 95 ! 92 ! 0. Initialization (first time-step only)93 ! --------------94 IF( kt == nittrc000 ) CALL trc_dmp_init95 96 96 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrtrd ) ! temporary save of trends 97 97 ! … … 171 171 END SUBROUTINE trc_dmp 172 172 173 SUBROUTINE trc_dmp_ini 174 !!---------------------------------------------------------------------- 175 !! *** ROUTINE trc_dmp_ini *** 176 !! 177 !! ** Purpose : Initialization for the newtonian damping 178 !! 179 !! ** Method : read the nammbf namelist and check the parameters 180 !! called by trc_dmp at the first timestep (nittrc000) 181 !!---------------------------------------------------------------------- 182 ! 183 INTEGER :: ios ! Local integer output status for namelist read 184 INTEGER :: imask !local file handle 185 ! 186 NAMELIST/namtrc_dmp/ nn_zdmp_tr , cn_resto_tr 187 !!---------------------------------------------------------------------- 188 189 IF( nn_timing == 1 ) CALL timing_start('trc_dmp_init') 190 ! 191 192 REWIND( numnat_ref ) ! Namelist namtrc_dmp in reference namelist : Passive tracers newtonian damping 193 READ ( numnat_ref, namtrc_dmp, IOSTAT = ios, ERR = 909) 194 909 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in reference namelist', lwp ) 195 196 REWIND( numnat_cfg ) ! Namelist namtrc_dmp in configuration namelist : Passive tracers newtonian damping 197 READ ( numnat_cfg, namtrc_dmp, IOSTAT = ios, ERR = 910) 198 910 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in configuration namelist', lwp ) 199 IF(lwm) WRITE ( numont, namtrc_dmp ) 200 201 IF(lwp) THEN ! Namelist print 202 WRITE(numout,*) 203 WRITE(numout,*) 'trc_dmp : Passive tracers newtonian damping' 204 WRITE(numout,*) '~~~~~~~' 205 WRITE(numout,*) ' Namelist namtrc_dmp : set damping parameter' 206 WRITE(numout,*) ' mixed layer damping option nn_zdmp_tr = ', nn_zdmp_tr, '(zoom: forced to 0)' 207 WRITE(numout,*) ' Restoration coeff file cn_resto_tr = ', cn_resto_tr 208 ENDIF 209 ! 210 IF( lzoom .AND. .NOT.lk_c1d ) nn_zdmp_tr = 0 ! restoring to climatology at closed north or south boundaries 211 SELECT CASE ( nn_zdmp_tr ) 212 CASE ( 0 ) ; IF(lwp) WRITE(numout,*) ' tracer damping throughout the water column' 213 CASE ( 1 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the turbocline (avt > 5 cm2/s)' 214 CASE ( 2 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the mixed layer' 215 CASE DEFAULT 216 WRITE(ctmp1,*) 'bad flag value for nn_zdmp_tr = ', nn_zdmp_tr 217 CALL ctl_stop(ctmp1) 218 END SELECT 219 220 IF( .NOT.lk_c1d ) THEN 221 IF( .NOT. ln_tradmp ) & 222 & CALL ctl_stop( 'passive trace damping need ln_tradmp to compute damping coef.' ) 223 ! 224 ! ! Read damping coefficients from file 225 !Read in mask from file 226 CALL iom_open ( cn_resto_tr, imask) 227 CALL iom_get ( imask, jpdom_autoglo, 'resto', restotr) 228 CALL iom_close( imask ) 229 ! 230 ENDIF 231 IF( nn_timing == 1 ) CALL timing_stop('trc_dmp_init') 232 ! 233 END SUBROUTINE trc_dmp_ini 234 173 235 SUBROUTINE trc_dmp_clo( kt ) 174 236 !!--------------------------------------------------------------------- … … 303 365 304 366 305 SUBROUTINE trc_dmp_init306 !!----------------------------------------------------------------------307 !! *** ROUTINE trc_dmp_init ***308 !!309 !! ** Purpose : Initialization for the newtonian damping310 !!311 !! ** Method : read the nammbf namelist and check the parameters312 !! called by trc_dmp at the first timestep (nittrc000)313 !!----------------------------------------------------------------------314 !315 INTEGER :: imask !local file handle316 317 IF( nn_timing == 1 ) CALL timing_start('trc_dmp_init')318 !319 320 IF( lzoom ) nn_zdmp_tr = 0 ! restoring to climatology at closed north or south boundaries321 SELECT CASE ( nn_zdmp_tr )322 CASE ( 0 ) ; IF(lwp) WRITE(numout,*) ' tracer damping throughout the water column'323 CASE ( 1 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the turbocline (avt > 5 cm2/s)'324 CASE ( 2 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the mixed layer'325 CASE DEFAULT326 WRITE(ctmp1,*) 'bad flag value for nn_zdmp_tr = ', nn_zdmp_tr327 CALL ctl_stop(ctmp1)328 END SELECT329 330 IF( .NOT. ln_tradmp ) &331 & CALL ctl_stop( 'passive trace damping need key_tradmp to compute damping coef.' )332 !333 ! ! Read damping coefficients from file334 !Read in mask from file335 CALL iom_open ( cn_resto_tr, imask)336 CALL iom_get ( imask, jpdom_autoglo, 'resto', restotr)337 CALL iom_close( imask )338 !339 IF( nn_timing == 1 ) CALL timing_stop('trc_dmp_init')340 !341 END SUBROUTINE trc_dmp_init342 343 367 #else 344 368 !!---------------------------------------------------------------------- -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
r5385 r5836 4 4 !! Ocean Passive tracers : lateral diffusive trends 5 5 !!===================================================================== 6 !! History : 9.0 ! 2005-11 (G. Madec) Original code 7 !! NEMO 3.0 ! 2008-01 (C. Ethe, G. Madec) merge TRC-TRA 6 !! History : 1.0 ! 2005-11 (G. Madec) Original code 7 !! 3.0 ! 2008-01 (C. Ethe, G. Madec) merge TRC-TRA 8 !! 3.7 ! 2014-03 (G. Madec) LDF simplification 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_top … … 11 12 !! 'key_top' TOP models 12 13 !!---------------------------------------------------------------------- 13 !!---------------------------------------------------------------------- 14 !! trc_ldf : update the tracer trend with the lateral diffusion 15 !! ldf_ctl : initialization, namelist read, and parameters control 16 !!---------------------------------------------------------------------- 17 USE oce_trc ! ocean dynamics and active tracers 18 USE trc ! ocean passive tracers variables 19 USE trcnam_trp ! passive tracers transport namelist variables 20 USE ldftra_oce ! lateral diffusion coefficient on tracers 21 USE ldfslp ! ??? 22 USE traldf_bilapg ! lateral mixing (tra_ldf_bilapg routine) 23 USE traldf_bilap ! lateral mixing (tra_ldf_bilap routine) 24 USE traldf_iso ! lateral mixing (tra_ldf_iso routine) 25 USE traldf_iso_grif ! lateral mixing (tra_ldf_iso_grif routine) 26 USE traldf_lap ! lateral mixing (tra_ldf_lap routine) 27 USE trd_oce 28 USE trdtra 14 !! trc_ldf : update the tracer trend with the lateral diffusion 15 !! trc_ldf_ini : initialization, namelist read, and parameters control 16 !!---------------------------------------------------------------------- 17 USE trc ! ocean passive tracers variables 18 USE oce_trc ! ocean dynamics and active tracers 19 USE ldfslp ! lateral diffusion: iso-neutral slope 20 USE traldf_lap ! lateral diffusion: laplacian iso-level operator (tra_ldf_lap routine) 21 USE traldf_iso ! lateral diffusion: laplacian iso-neutral standard operator (tra_ldf_iso routine) 22 USE traldf_triad ! lateral diffusion: laplacian iso-neutral triad operator (tra_ldf_triad routine) 23 USE traldf_blp ! lateral diffusion (iso-level lap/blp) (tra_ldf_lap routine) 24 USE trd_oce ! trends: ocean variables 25 USE trdtra ! trends manager: tracers 26 ! 29 27 USE prtctl_trc ! Print control 30 28 … … 32 30 PRIVATE 33 31 34 PUBLIC trc_ldf ! called by step.F90 35 ! !!: ** lateral mixing namelist (nam_trcldf) ** 36 REAL(wp) :: rldf_rat ! ratio between active and passive tracers diffusive coefficient 32 PUBLIC trc_ldf 33 PUBLIC trc_ldf_ini 34 ! 35 LOGICAL , PUBLIC :: ln_trcldf_lap !: laplacian operator 36 LOGICAL , PUBLIC :: ln_trcldf_blp !: bilaplacian operator 37 LOGICAL , PUBLIC :: ln_trcldf_lev !: iso-level direction 38 LOGICAL , PUBLIC :: ln_trcldf_hor !: horizontal direction (rotation to geopotential) 39 LOGICAL , PUBLIC :: ln_trcldf_iso !: iso-neutral direction (standard) 40 LOGICAL , PUBLIC :: ln_trcldf_triad !: iso-neutral direction (triad) 41 REAL(wp), PUBLIC :: rn_ahtrc_0 !: laplacian diffusivity coefficient for passive tracer [m2/s] 42 REAL(wp), PUBLIC :: rn_bhtrc_0 !: bilaplacian - -- - - [m4/s] 43 ! 44 !!: ** lateral mixing namelist (nam_trcldf) ** 45 REAL(wp) :: rldf ! ratio between active and passive tracers diffusive coefficient 37 46 INTEGER :: nldf = 0 ! type of lateral diffusion used defined from ln_trcldf_... namlist logicals) 47 38 48 !! * Substitutions 39 49 # include "domzgr_substitute.h90" 40 50 # include "vectopt_loop_substitute.h90" 41 51 !!---------------------------------------------------------------------- 42 !! NEMO/TOP 3. 3 , NEMO Consortium (2010)52 !! NEMO/TOP 3.7 , NEMO Consortium (2014) 43 53 !! $Id$ 44 54 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 45 55 !!---------------------------------------------------------------------- 46 47 56 CONTAINS 48 57 … … 58 67 INTEGER :: jn 59 68 CHARACTER (len=22) :: charout 69 REAL(wp), POINTER, DIMENSION(:,:,:) :: zahu, zahv 60 70 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrtrd 61 71 !!---------------------------------------------------------------------- … … 63 73 IF( nn_timing == 1 ) CALL timing_start('trc_ldf') 64 74 ! 65 IF( kt == nittrc000 ) CALL ldf_ctl ! initialisation & control of options66 67 rldf = rldf_rat68 69 75 IF( l_trdtrc ) THEN 70 CALL wrk_alloc( jpi, jpj, jpk, jptra,ztrtrd )76 CALL wrk_alloc( jpi,jpj,jpk,jptra, ztrtrd ) 71 77 ztrtrd(:,:,:,:) = tra(:,:,:,:) 72 78 ENDIF 73 74 SELECT CASE ( nldf ) ! compute lateral mixing trend and add it to the general trend 75 CASE ( 0 ) ; CALL tra_ldf_lap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra ) ! iso-level laplacian 76 CASE ( 1 ) ! rotated laplacian 77 IF( ln_traldf_grif ) THEN 78 CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 79 ELSE 80 CALL tra_ldf_iso ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, rn_ahtb_0 ) 81 ENDIF 82 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra ) ! iso-level bilaplacian 83 CASE ( 3 ) ; CALL tra_ldf_bilapg( kt, nittrc000, 'TRC', trb, tra, jptra ) ! s-coord. horizontal bilaplacian 84 ! 85 CASE ( -1 ) ! esopa: test all possibility with control print 86 CALL tra_ldf_lap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra ) 87 WRITE(charout, FMT="('ldf0 ')") ; CALL prt_ctl_trc_info(charout) 88 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 89 IF( ln_traldf_grif ) THEN 90 CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 91 ELSE 92 CALL tra_ldf_iso ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, rn_ahtb_0 ) 93 ENDIF 94 WRITE(charout, FMT="('ldf1 ')") ; CALL prt_ctl_trc_info(charout) 95 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 96 CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra ) 97 WRITE(charout, FMT="('ldf2 ')") ; CALL prt_ctl_trc_info(charout) 98 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 99 CALL tra_ldf_bilapg( kt, nittrc000, 'TRC', trb, tra, jptra ) 100 WRITE(charout, FMT="('ldf3 ')") ; CALL prt_ctl_trc_info(charout) 101 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 79 ! 80 ! !* set the lateral diffusivity coef. for passive tracer 81 CALL wrk_alloc( jpi,jpj,jpk, zahu, zahv ) 82 zahu(:,:,:) = rldf * ahtu(:,:,:) 83 zahv(:,:,:) = rldf * ahtv(:,:,:) 84 85 SELECT CASE ( nldf ) !* compute lateral mixing trend and add it to the general trend 86 ! 87 CASE ( np_lap ) ! iso-level laplacian 88 CALL tra_ldf_lap ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, 1 ) 89 ! 90 CASE ( np_lap_i ) ! laplacian : standard iso-neutral operator (Madec) 91 CALL tra_ldf_iso ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra, 1 ) 92 ! 93 CASE ( np_lap_it ) ! laplacian : triad iso-neutral operator (griffies) 94 CALL tra_ldf_triad( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra, 1 ) 95 ! 96 CASE ( np_blp , np_blp_i , np_blp_it ) ! bilaplacian: all operator (iso-level, -neutral) 97 CALL tra_ldf_blp ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb , tra, jptra, nldf ) 98 ! 102 99 END SELECT 103 100 ! 104 IF( l_trdtrc ) THEN 101 IF( l_trdtrc ) THEN ! save the horizontal diffusive trends for further diagnostics 105 102 DO jn = 1, jptra 106 103 ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) … … 109 106 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) 110 107 ENDIF 111 ! ! print mean trends (used for debugging) 112 IF( ln_ctl ) THEN 113 WRITE(charout, FMT="('ldf ')") ; CALL prt_ctl_trc_info(charout) 114 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 115 ENDIF 108 ! ! print mean trends (used for debugging) 109 IF( ln_ctl ) THEN 110 WRITE(charout, FMT="('ldf ')") ; CALL prt_ctl_trc_info(charout) 111 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 112 ENDIF 113 ! 114 CALL wrk_dealloc( jpi,jpj,jpk, zahu, zahv ) 116 115 ! 117 116 IF( nn_timing == 1 ) CALL timing_stop('trc_ldf') … … 120 119 121 120 122 SUBROUTINE ldf_ctl121 SUBROUTINE trc_ldf_ini 123 122 !!---------------------------------------------------------------------- 124 123 !! *** ROUTINE ldf_ctl *** 125 124 !! 126 !! ** Purpose : Choice of the operator for the lateral tracerdiffusion125 !! ** Purpose : Define the operator for the lateral diffusion 127 126 !! 128 127 !! ** Method : set nldf from the namtra_ldf logicals 129 !! nldf == -2 No lateral diffusion130 !! nldf == -1 ESOPA test: ALL operators are used131 128 !! nldf == 0 laplacian operator 132 129 !! nldf == 1 Rotated laplacian operator … … 134 131 !! nldf == 3 Rotated bilaplacian 135 132 !!---------------------------------------------------------------------- 136 INTEGER :: ioptio, ierr ! temporary integers 137 !!---------------------------------------------------------------------- 138 139 IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN 140 IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN 141 rldf_rat = 1.0_wp 142 ELSE 143 CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' ) 144 END IF 145 ELSE 146 rldf_rat = rn_ahtrc_0 / rn_aht_0 147 END IF 148 ! Define the lateral mixing oparator for tracers 149 ! =============================================== 150 151 ! ! control the input 133 INTEGER :: ioptio, ierr ! temporary integers 134 INTEGER :: ios ! Local integer output status for namelist read 135 ! 136 NAMELIST/namtrc_ldf/ ln_trcldf_lap, ln_trcldf_blp, & 137 & ln_trcldf_lev, ln_trcldf_hor, ln_trcldf_iso, ln_trcldf_triad, & 138 & rn_ahtrc_0 , rn_bhtrc_0 139 !!---------------------------------------------------------------------- 140 REWIND( numnat_ref ) ! namtrc_ldf in reference namelist 141 READ ( numnat_ref, namtrc_ldf, IOSTAT = ios, ERR = 903) 142 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in reference namelist', lwp ) 143 144 REWIND( numnat_cfg ) ! namtrc_ldf in configuration namelist 145 READ ( numnat_cfg, namtrc_ldf, IOSTAT = ios, ERR = 904 ) 146 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist', lwp ) 147 IF(lwm) WRITE ( numont, namtrc_ldf ) 148 149 IF(lwp) THEN ! Namelist print 150 WRITE(numout,*) 151 WRITE(numout,*) 'trc_ldf_ini : lateral tracer diffusive operator' 152 WRITE(numout,*) '~~~~~~~~~~~' 153 WRITE(numout,*) ' Namelist namtrc_ldf : set lateral mixing parameters (type, direction, coefficients)' 154 WRITE(numout,*) ' operator' 155 WRITE(numout,*) ' laplacian ln_trcldf_lap = ', ln_trcldf_lap 156 WRITE(numout,*) ' bilaplacian ln_trcldf_blp = ', ln_trcldf_blp 157 WRITE(numout,*) ' direction of action' 158 WRITE(numout,*) ' iso-level ln_trcldf_lev = ', ln_trcldf_lev 159 WRITE(numout,*) ' horizontal (geopotential) ln_trcldf_hor = ', ln_trcldf_hor 160 WRITE(numout,*) ' iso-neutral (standard) ln_trcldf_iso = ', ln_trcldf_iso 161 WRITE(numout,*) ' iso-neutral (triad) ln_trcldf_triad = ', ln_trcldf_triad 162 WRITE(numout,*) ' diffusivity coefficient' 163 WRITE(numout,*) ' laplacian rn_ahtrc_0 = ', rn_ahtrc_0 164 WRITE(numout,*) ' bilaplacian rn_bhtrc_0 = ', rn_bhtrc_0 165 ENDIF 166 ! 167 ! ! control the namelist parameters 152 168 ioptio = 0 153 IF( ln_trcldf_lap ) ioptio = ioptio + 1 154 IF( ln_trcldf_bilap ) ioptio = ioptio + 1 155 IF( ioptio > 1 ) CALL ctl_stop( ' use ONE or NONE of the 2 lap/bilap operator type on tracer' ) 156 IF( ioptio == 0 ) nldf = -2 ! No lateral diffusion 169 IF( ln_trcldf_lap ) ioptio = ioptio + 1 170 IF( ln_trcldf_blp ) ioptio = ioptio + 1 171 IF( ioptio > 1 ) CALL ctl_stop( 'trc_ldf_ctl: use ONE or NONE of the 2 lap/bilap operator type on tracer' ) 172 IF( ioptio == 0 ) nldf = np_no_ldf ! No lateral diffusion 173 174 IF( ln_trcldf_lap .AND. ln_trcldf_blp ) CALL ctl_stop( 'trc_ldf_ctl: bilaplacian should be used on both TRC and TRA' ) 175 IF( ln_trcldf_blp .AND. ln_trcldf_lap ) CALL ctl_stop( 'trc_ldf_ctl: laplacian should be used on both TRC and TRA' ) 176 157 177 ioptio = 0 158 IF( ln_trcldf_lev el) ioptio = ioptio + 1159 IF( ln_trcldf_hor 160 IF( ln_trcldf_iso 161 IF( ioptio /= 1 ) CALL ctl_stop( 'use only ONE direction (level/hor/iso)' )178 IF( ln_trcldf_lev ) ioptio = ioptio + 1 179 IF( ln_trcldf_hor ) ioptio = ioptio + 1 180 IF( ln_trcldf_iso ) ioptio = ioptio + 1 181 IF( ioptio /= 1 ) CALL ctl_stop( 'trc_ldf_ctl: use only ONE direction (level/hor/iso)' ) 162 182 163 183 ! defined the type of lateral diffusion from ln_trcldf_... logicals 164 184 ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully 165 185 ierr = 0 166 IF( ln_trcldf_lap ) THEN ! laplacian operator186 IF( ln_trcldf_lap ) THEN !== laplacian operator ==! 167 187 IF ( ln_zco ) THEN ! z-coordinate 168 IF ( ln_trcldf_level ) nldf = 0 ! iso-level (no rotation) 169 IF ( ln_trcldf_hor ) nldf = 0 ! horizontal (no rotation) 170 IF ( ln_trcldf_iso ) nldf = 1 ! isoneutral ( rotation) 171 ENDIF 172 IF ( ln_zps ) THEN ! z-coordinate 173 IF ( ln_trcldf_level ) ierr = 1 ! iso-level not allowed 174 IF ( ln_trcldf_hor ) nldf = 0 ! horizontal (no rotation) 175 IF ( ln_trcldf_iso ) nldf = 1 ! isoneutral ( rotation) 176 ENDIF 177 IF ( ln_sco ) THEN ! z-coordinate 178 IF ( ln_trcldf_level ) nldf = 0 ! iso-level (no rotation) 179 IF ( ln_trcldf_hor ) nldf = 1 ! horizontal ( rotation) 180 IF ( ln_trcldf_iso ) nldf = 1 ! isoneutral ( rotation) 181 ENDIF 182 ENDIF 183 184 IF( ln_trcldf_bilap ) THEN ! bilaplacian operator 188 IF ( ln_trcldf_lev ) nldf = np_lap ! iso-level = horizontal (no rotation) 189 IF ( ln_trcldf_hor ) nldf = np_lap ! iso-level = horizontal (no rotation) 190 IF ( ln_trcldf_iso ) nldf = np_lap_i ! iso-neutral: standard ( rotation) 191 IF ( ln_trcldf_triad ) nldf = np_lap_it ! iso-neutral: triad ( rotation) 192 ENDIF 193 IF ( ln_zps ) THEN ! z-coordinate with partial step 194 IF ( ln_trcldf_lev ) ierr = 1 ! iso-level not allowed 195 IF ( ln_trcldf_hor ) nldf = np_lap ! horizontal (no rotation) 196 IF ( ln_trcldf_iso ) nldf = np_lap_i ! iso-neutral: standard (rotation) 197 IF ( ln_trcldf_triad ) nldf = np_lap_it ! iso-neutral: triad (rotation) 198 ENDIF 199 IF ( ln_sco ) THEN ! s-coordinate 200 IF ( ln_trcldf_lev ) nldf = np_lap ! iso-level (no rotation) 201 IF ( ln_trcldf_hor ) nldf = np_lap_it ! horizontal ( rotation) !!gm a checker.... 202 IF ( ln_trcldf_iso ) nldf = np_lap_i ! iso-neutral: standard (rotation) 203 IF ( ln_trcldf_triad ) nldf = np_lap_it ! iso-neutral: triad (rotation) 204 ENDIF 205 ! ! diffusivity ratio: passive / active tracers 206 IF( ABS(rn_aht_0) < 2._wp*TINY(1.e0) ) THEN 207 IF( ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0) ) THEN 208 rldf = 1.0_wp 209 ELSE 210 CALL ctl_stop( 'STOP', 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' ) 211 ENDIF 212 ELSE 213 rldf = rn_ahtrc_0 / rn_aht_0 214 ENDIF 215 ENDIF 216 ! 217 IF( ln_trcldf_blp ) THEN !== bilaplacian operator ==! 185 218 IF ( ln_zco ) THEN ! z-coordinate 186 IF ( ln_trcldf_level ) nldf = 2 ! iso-level (no rotation) 187 IF ( ln_trcldf_hor ) nldf = 2 ! horizontal (no rotation) 188 IF ( ln_trcldf_iso ) ierr = 2 ! isoneutral ( rotation) 189 ENDIF 190 IF ( ln_zps ) THEN ! z-coordinate 191 IF ( ln_trcldf_level ) ierr = 1 ! iso-level not allowed 192 IF ( ln_trcldf_hor ) nldf = 2 ! horizontal (no rotation) 193 IF ( ln_trcldf_iso ) ierr = 2 ! isoneutral ( rotation) 194 ENDIF 195 IF ( ln_sco ) THEN ! z-coordinate 196 IF ( ln_trcldf_level ) nldf = 2 ! iso-level (no rotation) 197 IF ( ln_trcldf_hor ) nldf = 3 ! horizontal ( rotation) 198 IF ( ln_trcldf_iso ) ierr = 2 ! isoneutral ( rotation) 199 ENDIF 200 ENDIF 201 219 IF ( ln_trcldf_lev ) nldf = np_blp ! iso-level = horizontal (no rotation) 220 IF ( ln_trcldf_hor ) nldf = np_blp ! iso-level = horizontal (no rotation) 221 IF ( ln_trcldf_iso ) nldf = np_blp_i ! iso-neutral: standard (rotation) 222 IF ( ln_trcldf_triad ) nldf = np_blp_it ! iso-neutral: triad (rotation) 223 ENDIF 224 IF ( ln_zps ) THEN ! z-coordinate with partial step 225 IF ( ln_trcldf_lev ) ierr = 1 ! iso-level not allowed 226 IF ( ln_trcldf_hor ) nldf = np_blp ! horizontal (no rotation) 227 IF ( ln_trcldf_iso ) nldf = np_blp_i ! iso-neutral: standard (rotation) 228 IF ( ln_trcldf_triad ) nldf = np_blp_it ! iso-neutral: triad (rotation) 229 ENDIF 230 IF ( ln_sco ) THEN ! s-coordinate 231 IF ( ln_trcldf_lev ) nldf = np_blp ! iso-level (no rotation) 232 IF ( ln_trcldf_hor ) nldf = np_blp_it ! horizontal ( rotation) !!gm a checker.... 233 IF ( ln_trcldf_iso ) nldf = np_blp_i ! iso-neutral: standard (rotation) 234 IF ( ln_trcldf_triad ) nldf = np_blp_it ! iso-neutral: triad (rotation) 235 ENDIF 236 ! ! diffusivity ratio: passive / active tracers 237 IF( ABS(rn_bht_0) < 2._wp*TINY(1.e0) ) THEN 238 IF( ABS(rn_bhtrc_0) < 2._wp*TINY(1.e0) ) THEN 239 rldf = 1.0_wp 240 ELSE 241 CALL ctl_stop( 'STOP', 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' ) 242 ENDIF 243 ELSE 244 rldf = SQRT( ABS( rn_bhtrc_0 / rn_bht_0 ) ) 245 ENDIF 246 ENDIF 247 ! 202 248 IF( ierr == 1 ) CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' ) 203 IF( ierr == 2 ) CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' ) 204 IF( lk_traldf_eiv .AND. .NOT.ln_trcldf_iso ) & 249 IF( ln_ldfeiv .AND. .NOT.ln_trcldf_iso ) & 205 250 CALL ctl_stop( ' eddy induced velocity on tracers', & 206 251 & ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' ) 207 252 IF( nldf == 1 .OR. nldf == 3 ) THEN ! rotation 208 IF( .NOT.lk_ldfslp ) CALL ctl_stop( ' the rotation of the diffusive tensor require key_ldfslp' ) 209 #if defined key_offline 210 l_traldf_rot = .TRUE. ! needed for trazdf_imp 211 #endif 212 ENDIF 213 214 IF( lk_esopa ) THEN 215 IF(lwp) WRITE(numout,*) ' esopa control: use all lateral physics options' 216 nldf = -1 217 ENDIF 218 253 IF( .NOT.l_ldfslp ) CALL ctl_stop( ' the rotation of the diffusive tensor require l_ldfslp' ) 254 ENDIF 255 ! 219 256 IF(lwp) THEN 220 257 WRITE(numout,*) 221 IF( nldf == -2 ) WRITE(numout,*) ' NO lateral diffusion' 222 IF( nldf == -1 ) WRITE(numout,*) ' ESOPA test All scheme used' 223 IF( nldf == 0 ) WRITE(numout,*) ' laplacian operator' 224 IF( nldf == 1 ) WRITE(numout,*) ' Rotated laplacian operator' 225 IF( nldf == 2 ) WRITE(numout,*) ' bilaplacian operator' 226 IF( nldf == 3 ) WRITE(numout,*) ' Rotated bilaplacian' 227 ENDIF 228 229 IF( ln_trcldf_bilap ) THEN 230 IF(lwp) WRITE(numout,*) ' biharmonic tracer diffusion' 231 IF( rn_ahtrc_0 > 0 .AND. .NOT. lk_esopa ) CALL ctl_stop( 'The horizontal diffusivity coef. rn_ahtrc_0 must be negative' ) 232 ELSE 233 IF(lwp) WRITE(numout,*) ' harmonic tracer diffusion (default)' 234 IF( rn_ahtrc_0 < 0 .AND. .NOT. lk_esopa ) CALL ctl_stop('The horizontal diffusivity coef. rn_ahtrc_0 must be positive' ) 235 ENDIF 236 237 ! ratio between active and passive tracers diffusive coef. 238 IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN 239 IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN 240 rldf_rat = 1.0_wp 241 ELSE 242 CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' ) 243 END IF 244 ELSE 245 rldf_rat = rn_ahtrc_0 / rn_aht_0 246 END IF 247 IF( rldf_rat < 0 ) THEN 248 IF( .NOT.lk_offline ) THEN 249 CALL ctl_stop( 'Choose the same type of diffusive scheme both for active & passive tracers' ) 250 ELSE 251 CALL ctl_stop( 'Change the sign of rn_aht_0 in namelist to -/+1' ) 252 ENDIF 253 ENDIF 254 ! 255 END SUBROUTINE ldf_ctl 258 IF( nldf == np_no_ldf ) WRITE(numout,*) ' NO lateral diffusion' 259 IF( nldf == np_lap ) WRITE(numout,*) ' laplacian iso-level operator' 260 IF( nldf == np_lap_i ) WRITE(numout,*) ' Rotated laplacian operator (standard)' 261 IF( nldf == np_lap_it ) WRITE(numout,*) ' Rotated laplacian operator (triad)' 262 IF( nldf == np_blp ) WRITE(numout,*) ' bilaplacian iso-level operator' 263 IF( nldf == np_blp_i ) WRITE(numout,*) ' Rotated bilaplacian operator (standard)' 264 IF( nldf == np_blp_it ) WRITE(numout,*) ' Rotated bilaplacian operator (triad)' 265 ENDIF 266 ! 267 END SUBROUTINE trc_ldf_ini 256 268 #else 257 269 !!---------------------------------------------------------------------- -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
r4990 r5836 22 22 PRIVATE 23 23 24 PUBLIC trc_rad ! routine called by trcstp.F90 25 26 !! * Substitutions 27 # include "top_substitute.h90" 24 PUBLIC trc_rad 25 PUBLIC trc_rad_ini 26 27 LOGICAL , PUBLIC :: ln_trcrad !: flag to artificially correct negative concentrations 28 28 29 !!---------------------------------------------------------------------- 29 30 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 76 77 ! 77 78 END SUBROUTINE trc_rad 79 80 SUBROUTINE trc_rad_ini 81 !!--------------------------------------------------------------------- 82 !! *** ROUTINE trc _rad_ini *** 83 !! 84 !! ** Purpose : read namelist options 85 !!---------------------------------------------------------------------- 86 INTEGER :: ios ! Local integer output status for namelist read 87 NAMELIST/namtrc_rad/ ln_trcrad 88 !!---------------------------------------------------------------------- 89 90 ! 91 REWIND( numnat_ref ) ! namtrc_rad in reference namelist 92 READ ( numnat_ref, namtrc_rad, IOSTAT = ios, ERR = 907) 93 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in reference namelist', lwp ) 94 95 REWIND( numnat_cfg ) ! namtrc_rad in configuration namelist 96 READ ( numnat_cfg, namtrc_rad, IOSTAT = ios, ERR = 908 ) 97 908 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in configuration namelist', lwp ) 98 IF(lwm) WRITE ( numont, namtrc_rad ) 99 100 IF(lwp) THEN ! ! Control print 101 WRITE(numout,*) 102 WRITE(numout,*) ' Namelist namtrc_rad : treatment of negative concentrations' 103 WRITE(numout,*) ' correct artificially negative concen. or not ln_trcrad = ', ln_trcrad 104 ENDIF 105 ! 106 END SUBROUTINE trc_rad_ini 78 107 79 108 SUBROUTINE trc_rad_sms( kt, ptrb, ptrn, jp_sms0, jp_sms1, cpreserv ) -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r5385 r5836 31 31 32 32 !! * Substitutions 33 # include "top_substitute.h90" 33 # include "domzgr_substitute.h90" 34 # include "vectopt_loop_substitute.h90" 34 35 !!---------------------------------------------------------------------- 35 36 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 83 84 CASE( 0 ) ; zswitch = 1 ! (0) standard levitating sea-ice : salt exchange only 84 85 CASE( 1, 2 ) ; zswitch = 0 ! (1) levitating sea-ice: salt and volume exchange but no pressure effect 85 86 ! ! (2) embedded sea-ice : salt and volume fluxes and pressure 86 87 END SELECT 87 88 -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
r5120 r5836 15 15 USE oce_trc ! ocean dynamics and active tracers variables 16 16 USE trc ! ocean passive tracers variables 17 USE trcnam_trp ! passive tracers transport namelist variables18 17 USE trabbl ! bottom boundary layer (trc_bbl routine) 19 18 USE trcbbl ! bottom boundary layer (trc_bbl routine) 20 USE zdfkpp ! KPP non-local tracer fluxes (trc_kpp routine)21 19 USE trcdmp ! internal damping (trc_dmp routine) 22 20 USE trcldf ! lateral mixing (trc_ldf routine) … … 38 36 PUBLIC trc_trp ! called by trc_stp 39 37 40 !! * Substitutions41 # include "top_substitute.h90"42 38 !!---------------------------------------------------------------------- 43 39 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 48 44 CONTAINS 49 45 50 SUBROUTINE trc_trp( k stp)46 SUBROUTINE trc_trp( kt ) 51 47 !!---------------------------------------------------------------------- 52 48 !! *** ROUTINE trc_trp *** … … 57 53 !! - Update the passive tracers 58 54 !!---------------------------------------------------------------------- 59 INTEGER, INTENT( in ) :: k stp! ocean time-step index55 INTEGER, INTENT( in ) :: kt ! ocean time-step index 60 56 !! --------------------------------------------------------------------- 61 57 ! … … 64 60 IF( .NOT. lk_c1d ) THEN 65 61 ! 66 CALL trc_sbc( kstp ) ! surface boundary condition 67 IF( lk_trabbl ) CALL trc_bbl( kstp ) ! advective (and/or diffusive) bottom boundary layer scheme 68 IF( ln_trcdmp ) CALL trc_dmp( kstp ) ! internal damping trends 69 IF( ln_trcdmp_clo ) CALL trc_dmp_clo( kstp ) ! internal damping trends on closed seas only 70 CALL trc_adv( kstp ) ! horizontal & vertical advection 71 CALL trc_ldf( kstp ) ! lateral mixing 72 IF( .NOT. lk_offline .AND. lk_zdfkpp ) & 73 & CALL trc_kpp( kstp ) ! KPP non-local tracer fluxes 62 CALL trc_sbc ( kt ) ! surface boundary condition 63 IF( lk_trabbl ) CALL trc_bbl ( kt ) ! advective (and/or diffusive) bottom boundary layer scheme 64 IF( ln_trcdmp ) CALL trc_dmp ( kt ) ! internal damping trends 65 IF( ln_trcdmp_clo ) CALL trc_dmp_clo( kt ) ! internal damping trends on closed seas only 66 CALL trc_adv ( kt ) ! horizontal & vertical advection 67 ! ! Partial top/bottom cell: GRADh( trb ) 68 IF( ln_zps ) THEN 69 IF( ln_isfcav ) THEN ; CALL zps_hde_isf( kt, jptra, trb, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! both top & bottom 70 ELSE ; CALL zps_hde ( kt, jptra, trb, gtru, gtrv ) ! only bottom 71 ENDIF 72 ENDIF 73 ! 74 CALL trc_ldf ( kt ) ! lateral mixing 74 75 #if defined key_agrif 75 IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc 76 IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc ! tracers sponge 76 77 #endif 77 CALL trc_zdf ( kstp )! vertical mixing and after tracer fields78 CALL trc_nxt ( kstp )! tracer fields at next time step79 IF( ln_trcrad ) CALL trc_rad ( kstp )! Correct artificial negative concentrations78 CALL trc_zdf ( kt ) ! vertical mixing and after tracer fields 79 CALL trc_nxt ( kt ) ! tracer fields at next time step 80 IF( ln_trcrad ) CALL trc_rad ( kt ) ! Correct artificial negative concentrations 80 81 81 82 #if defined key_agrif 82 IF( .NOT. Agrif_Root()) CALL Agrif_Update_Trc( kstp )! Update tracer at AGRIF zoom boundaries : children only83 IF( .NOT.Agrif_Root()) CALL Agrif_Update_Trc( kt ) ! Update tracer at AGRIF zoom boundaries : children only 83 84 #endif 84 85 IF( ln_zps .AND. .NOT. ln_isfcav) &86 & CALL zps_hde ( kstp, jptra, trn, gtru, gtrv ) ! Partial steps: now horizontal gradient of passive87 IF( ln_zps .AND. ln_isfcav) &88 & CALL zps_hde_isf( kstp, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! Partial steps: now horizontal gradient of passive89 ! tracers at the bottom ocean level90 85 ! 91 86 ELSE ! 1D vertical configuration 92 CALL trc_sbc( kstp ) ! surface boundary condition 93 IF( .NOT. lk_offline .AND. lk_zdfkpp ) & 94 & CALL trc_kpp( kstp ) ! KPP non-local tracer fluxes 95 CALL trc_zdf( kstp ) ! vertical mixing and after tracer fields 96 CALL trc_nxt( kstp ) ! tracer fields at next time step 97 IF( ln_trcrad ) CALL trc_rad( kstp ) ! Correct artificial negative concentrations 87 CALL trc_sbc( kt ) ! surface boundary condition 88 IF( ln_trcdmp ) CALL trc_dmp( kt ) ! internal damping trends 89 CALL trc_zdf( kt ) ! vertical mixing and after tracer fields 90 CALL trc_nxt( kt ) ! tracer fields at next time step 91 IF( ln_trcrad ) CALL trc_rad( kt ) ! Correct artificial negative concentrations 98 92 ! 99 93 END IF … … 108 102 !!---------------------------------------------------------------------- 109 103 CONTAINS 110 SUBROUTINE trc_trp( k stp) ! Empty routine111 INTEGER, INTENT(in) :: k stp112 WRITE(*,*) 'trc_trp: You should not have seen this print! error?', k stp104 SUBROUTINE trc_trp( kt ) ! Empty routine 105 INTEGER, INTENT(in) :: kt 106 WRITE(*,*) 'trc_trp: You should not have seen this print! error?', kt 113 107 END SUBROUTINE trc_trp 114 108 #endif -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
r5385 r5836 11 11 !! 'key_top' TOP models 12 12 !!---------------------------------------------------------------------- 13 !! trc_ ldf: update the tracer trend with the lateral diffusion14 !! ldf_ctl: initialization, namelist read, and parameters control13 !! trc_zdf : update the tracer trend with the lateral diffusion 14 !! trc_zdf_ini : initialization, namelist read, and parameters control 15 15 !!---------------------------------------------------------------------- 16 USE oce_trc ! ocean dynamics and active tracers17 USE trc ! ocean passive tracers variables18 USE tr cnam_trp ! passive tracers transport namelistvariables19 USE trazdf_exp 20 USE trazdf_imp 21 USE tr d_oce22 USE trdtra 23 USE prtctl_trc 16 USE trc ! ocean passive tracers variables 17 USE oce_trc ! ocean dynamics and active tracers 18 USE trd_oce ! trends: ocean variables 19 USE trazdf_exp ! vertical diffusion: explicit (tra_zdf_exp routine) 20 USE trazdf_imp ! vertical diffusion: implicit (tra_zdf_imp routine) 21 USE trcldf ! passive tracers: lateral diffusion 22 USE trdtra ! trends manager: tracers 23 USE prtctl_trc ! Print control 24 24 25 25 IMPLICIT NONE 26 26 PRIVATE 27 27 28 PUBLIC trc_zdf ! called by step.F90 29 PUBLIC trc_zdf_alloc ! called by nemogcm.F90 28 PUBLIC trc_zdf ! called by step.F90 29 PUBLIC trc_zdf_ini ! called by nemogcm.F90 30 PUBLIC trc_zdf_alloc ! called by nemogcm.F90 31 32 ! !!** Vertical diffusion (nam_trczdf) ** 33 LOGICAL , PUBLIC :: ln_trczdf_exp !: explicit vertical diffusion scheme flag 34 INTEGER , PUBLIC :: nn_trczdf_exp !: number of sub-time step (explicit time stepping) 30 35 31 36 INTEGER :: nzdf = 0 ! type vertical diffusion algorithm used … … 39 44 # include "vectopt_loop_substitute.h90" 40 45 !!---------------------------------------------------------------------- 41 !! NEMO/TOP 3. 3 , NEMO Consortium (2010)46 !! NEMO/TOP 3.7 , NEMO Consortium (2015) 42 47 !! $Id$ 43 48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 71 76 IF( nn_timing == 1 ) CALL timing_start('trc_zdf') 72 77 ! 73 IF( kt == nittrc000 ) CALL zdf_ctl ! initialisation & control of options74 75 78 IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN ! at nittrc000 76 79 r2dt(:) = rdttrc(:) ! = rdttrc (use or restarting with Euler time stepping) … … 85 88 86 89 SELECT CASE ( nzdf ) ! compute lateral mixing trend and add it to the general trend 87 CASE ( -1 ) ! esopa: test all possibility with control print88 CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )89 WRITE(charout, FMT="('zdf1 ')") ; CALL prt_ctl_trc_info(charout)90 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )91 CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dt, trb, tra, jptra )92 WRITE(charout, FMT="('zdf2 ')") ; CALL prt_ctl_trc_info(charout)93 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )94 90 CASE ( 0 ) ; CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra ) ! explicit scheme 95 91 CASE ( 1 ) ; CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dt, trb, tra, jptra ) ! implicit scheme 96 97 92 END SELECT 98 93 … … 117 112 118 113 119 SUBROUTINE zdf_ctl114 SUBROUTINE trc_zdf_ini 120 115 !!---------------------------------------------------------------------- 121 !! *** ROUTINE zdf_ctl***116 !! *** ROUTINE trc_zdf_ini *** 122 117 !! 123 118 !! ** Purpose : Choose the vertical mixing scheme … … 128 123 !! NB: The implicit scheme is required when using : 129 124 !! - rotated lateral mixing operator 130 !! - TKE, GLS or KPPvertical mixing scheme125 !! - TKE, GLS vertical mixing scheme 131 126 !!---------------------------------------------------------------------- 132 133 ! Define the vertical tracer physics scheme 134 ! ========================================== 135 136 ! Choice from ln_zdfexp already read in namelist in zdfini module 137 IF( ln_trczdf_exp ) THEN ! use explicit scheme 138 nzdf = 0 139 ELSE ! use implicit scheme 140 nzdf = 1 127 INTEGER :: ios ! Local integer output status for namelist read 128 !! 129 NAMELIST/namtrc_zdf/ ln_trczdf_exp , nn_trczdf_exp 130 !!---------------------------------------------------------------------- 131 ! 132 REWIND( numnat_ref ) ! namtrc_zdf in reference namelist 133 READ ( numnat_ref, namtrc_zdf, IOSTAT = ios, ERR = 905) 134 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_zdf in reference namelist', lwp ) 135 ! 136 REWIND( numnat_cfg ) ! namtrc_zdf in configuration namelist 137 READ ( numnat_cfg, namtrc_zdf, IOSTAT = ios, ERR = 906 ) 138 906 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_zdf in configuration namelist', lwp ) 139 IF(lwm) WRITE ( numont, namtrc_zdf ) 140 ! 141 IF(lwp) THEN ! Control print 142 WRITE(numout,*) 143 WRITE(numout,*) ' Namelist namtrc_zdf : set vertical diffusion parameters' 144 WRITE(numout,*) ' time splitting / backward scheme ln_trczdf_exp = ', ln_trczdf_exp 145 WRITE(numout,*) ' number of time step nn_trczdf_exp = ', nn_trczdf_exp 141 146 ENDIF 142 147 143 ! Force implicit schemes 144 IF( ln_trcldf_iso ) nzdf = 1 ! iso-neutral lateral physics 145 IF( ln_trcldf_hor .AND. ln_sco ) nzdf = 1 ! horizontal lateral physics in s-coordinate 146 #if defined key_zdftke || defined key_zdfgls || defined key_zdfkpp 147 nzdf = 1 ! TKE, GLS or KPP physics 148 #endif 149 IF( ln_trczdf_exp .AND. nzdf == 1 ) THEN 150 CALL ctl_stop( 'trc_zdf : If using the rotated lateral mixing operator or TKE, GLS or KPP vertical scheme ', & 151 & ' the implicit scheme is required, set ln_trczdf_exp = .false.' ) 148 ! ! Define the vertical tracer physics scheme 149 IF( ln_trczdf_exp ) THEN ; nzdf = 0 ! explicit scheme 150 ELSE ; nzdf = 1 ! implicit scheme 152 151 ENDIF 153 152 154 ! Test: esopa 155 IF( lk_esopa ) nzdf = -1 ! All schemes used 153 ! ! Force implicit schemes 154 IF( ln_trcldf_iso ) nzdf = 1 ! iso-neutral lateral physics 155 IF( ln_trcldf_hor .AND. ln_sco ) nzdf = 1 ! horizontal lateral physics in s-coordinate 156 #if defined key_zdftke || defined key_zdfgls 157 nzdf = 1 ! TKE or GLS physics 158 #endif 159 IF( ln_trczdf_exp .AND. nzdf == 1 ) & 160 CALL ctl_stop( 'trc_zdf : If using the rotated lateral mixing operator or TKE, GLS vertical scheme ', & 161 & ' the implicit scheme is required, set ln_trczdf_exp = .false.' ) 156 162 157 163 IF(lwp) THEN … … 159 165 WRITE(numout,*) 'trc:zdf_ctl : vertical passive tracer physics scheme' 160 166 WRITE(numout,*) '~~~~~~~~~~~' 161 IF( nzdf == -1 ) WRITE(numout,*) ' ESOPA test All scheme used'162 167 IF( nzdf == 0 ) WRITE(numout,*) ' Explicit time-splitting scheme' 163 168 IF( nzdf == 1 ) WRITE(numout,*) ' Implicit (euler backward) scheme' 164 169 ENDIF 165 166 END SUBROUTINE zdf_ctl 170 ! 171 END SUBROUTINE trc_zdf_ini 172 167 173 #else 168 174 !!---------------------------------------------------------------------- -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90
r5215 r5836 8 8 !! ! 07-06 (C. Deltel) key_gyre : do not call lbc_lnk 9 9 !!---------------------------------------------------------------------- 10 #if defined key_top && ( defined key_trdmxl_trc || defined key_esopa )10 #if defined key_top && defined key_trdmxl_trc 11 11 !!---------------------------------------------------------------------- 12 12 !! 'key_trdmxl_trc' mixed layer trend diagnostics … … 24 24 USE zdfddm , ONLY : avs ! salinity vertical diffusivity coeff. at w-point 25 25 # endif 26 USE trcnam_trp ! passive tracers transport namelist variables27 26 USE trdtrc_oce ! definition of main arrays used for trends computations 28 27 USE in_out_manager ! I/O manager … … 67 66 68 67 !! * Substitutions 69 # include " top_substitute.h90"68 # include "domzgr_substitute.h90" 70 69 # include "zdfddm_substitute.h90" 71 70 !!---------------------------------------------------------------------- -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90
r5215 r5836 14 14 !!---------------------------------------------------------------------- 15 15 USE trc ! tracer definitions (trn, trb, tra, etc.) 16 USE trcnam_trp17 16 USE trd_oce 18 17 USE trdtrc_oce ! definition of main arrays used for trends computations … … 29 28 PUBLIC trd_trc 30 29 31 !! * Substitutions32 # include "top_substitute.h90"33 30 !!---------------------------------------------------------------------- 34 31 !! NEMO/TOP 3.3 , NEMO Consortium (2010) -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90
r5215 r5836 4 4 !! Ocean trends : set tracer and momentum trend variables 5 5 !!====================================================================== 6 #if defined key_top || defined key_esopa6 #if defined key_top 7 7 !!---------------------------------------------------------------------- 8 8 !! 'key_top' TOP models … … 30 30 # endif 31 31 32 # if defined key_trdmxl_trc || defined key_esopa32 # if defined key_trdmxl_trc 33 33 !!---------------------------------------------------------------------- 34 34 !! 'key_trdmxl_trc' mixed layer trends diagnostics -
trunk/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
r5385 r5836 11 11 !! 'key_top' TOP models 12 12 !!---------------------------------------------------------------------- 13 14 ! * Domain size *13 ! 14 ! !* Domain size * 15 15 USE par_oce , ONLY : jpi => jpi !: first dimension of grid --> i 16 16 USE par_oce , ONLY : jpj => jpj !: second dimension of grid --> j … … 20 20 USE par_oce , ONLY : jpkm1 => jpkm1 !: jpk - 1 21 21 USE par_oce , ONLY : jpij => jpij !: jpi x jpj 22 USE par_oce , ONLY : lk_esopa => lk_esopa !: flag to activate the all option23 22 USE par_oce , ONLY : jp_tem => jp_tem !: indice for temperature 24 23 USE par_oce , ONLY : jp_sal => jp_sal !: indice for salinity 25 24 26 !* IO manager * 27 USE in_out_manager 28 29 !* Memory Allocation * 30 USE wrk_nemo 31 32 !* Timing * 33 USE timing 34 35 !* MPP library 36 USE lib_mpp 37 38 !* Fortran utilities 39 USE lib_fortran 40 41 !* Lateral boundary conditions 42 USE lbclnk 43 44 !* physical constants * 45 USE phycst 46 47 !* 1D configuration 48 USE c1d 49 50 !* model domain * 51 USE dom_oce 25 USE in_out_manager !* IO manager * 26 USE wrk_nemo !* Memory Allocation * 27 USE timing !* Timing * 28 USE lib_mpp !* MPP library 29 USE lib_fortran !* Fortran utilities 30 USE lbclnk !* Lateral boundary conditions 31 USE phycst !* physical constants * 32 USE c1d !* 1D configuration 33 USE dom_oce !* model domain * 52 34 53 35 USE domvvl, ONLY : un_td, vn_td !: thickness diffusion transport … … 56 38 57 39 !* ocean fields: here now and after fields * 58 USE oce , ONLY : ua => ua !: i-horizontal velocity (m s-1)59 USE oce , ONLY : va => va !: j-horizontal velocity (m s-1)60 40 USE oce , ONLY : un => un !: i-horizontal velocity (m s-1) 61 41 USE oce , ONLY : vn => vn !: j-horizontal velocity (m s-1) … … 66 46 USE oce , ONLY : rhop => rhop !: potential volumic mass (kg m-3) 67 47 USE oce , ONLY : rhd => rhd !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 48 USE oce , ONLY : hdivn => hdivn !: horizontal divergence (1/s) 49 USE oce , ONLY : sshn => sshn !: sea surface height at t-point [m] 50 USE oce , ONLY : sshb => sshb !: sea surface height at t-point [m] 51 USE oce , ONLY : ssha => ssha !: sea surface height at t-point [m] 68 52 #if defined key_offline 69 53 USE oce , ONLY : rab_n => rab_n !: local thermal/haline expension ratio at T-points 70 54 #endif 71 USE oce , ONLY : hdivn => hdivn !: horizontal divergence (1/s)72 USE oce , ONLY : rotn => rotn !: relative vorticity [s-1]73 USE oce , ONLY : hdivb => hdivb !: horizontal divergence (1/s)74 USE oce , ONLY : rotb => rotb !: relative vorticity [s-1]75 USE oce , ONLY : sshn => sshn !: sea surface height at t-point [m]76 USE oce , ONLY : sshb => sshb !: sea surface height at t-point [m]77 USE oce , ONLY : ssha => ssha !: sea surface height at t-point [m]78 USE oce , ONLY : l_traldf_rot => l_traldf_rot !: rotated laplacian operator for lateral diffusion79 55 80 56 !* surface fluxes * … … 102 78 USE trc_oce 103 79 80 !!gm : I don't understand this as ldftra (where everything is defined) is used by TRC in all cases (ON/OFF-line) 81 !!gm so the following lines should be removed.... logical should be the one of TRC namelist 82 !!gm In case off coarsening.... the ( ahtu, ahtv, aeiu, aeiv) arrays are needed that's all. 104 83 !* lateral diffusivity (tracers) * 105 USE ldftra_oce , ONLY : rldf => rldf !: multiplicative coef. for lateral diffusivity 106 USE ldftra_oce , ONLY : rn_aht_0 => rn_aht_0 !: horizontal eddy diffusivity for tracers (m2/s) 107 USE ldftra_oce , ONLY : aht0 => aht0 !: horizontal eddy diffusivity for tracers (m2/s) 108 USE ldftra_oce , ONLY : ahtb0 => ahtb0 !: background eddy diffusivity for isopycnal diff. (m2/s) 109 USE ldftra_oce , ONLY : ahtu => ahtu !: lateral diffusivity coef. at u-points 110 USE ldftra_oce , ONLY : ahtv => ahtv !: lateral diffusivity coef. at v-points 111 USE ldftra_oce , ONLY : ahtw => ahtw !: lateral diffusivity coef. at w-points 112 USE ldftra_oce , ONLY : ahtt => ahtt !: lateral diffusivity coef. at t-points 113 USE ldftra_oce , ONLY : aeiv0 => aeiv0 !: eddy induced velocity coefficient (m2/s) 114 USE ldftra_oce , ONLY : aeiu => aeiu !: eddy induced velocity coef. at u-points (m2/s) 115 USE ldftra_oce , ONLY : aeiv => aeiv !: eddy induced velocity coef. at v-points (m2/s) 116 USE ldftra_oce , ONLY : aeiw => aeiw !: eddy induced velocity coef. at w-points (m2/s) 117 USE ldftra_oce , ONLY : lk_traldf_eiv => lk_traldf_eiv !: eddy induced velocity flag 84 USE ldftra , ONLY : rn_aht_0 => rn_aht_0 !: laplacian lateral eddy diffusivity [m2/s] 85 USE ldftra , ONLY : rn_bht_0 => rn_bht_0 !: bilaplacian lateral eddy diffusivity [m4/s] 86 USE ldftra , ONLY : ahtu => ahtu !: lateral diffusivity coef. at u-points 87 USE ldftra , ONLY : ahtv => ahtv !: lateral diffusivity coef. at v-points 88 USE ldftra , ONLY : rn_aeiv_0 => rn_aeiv_0 !: eddy induced velocity coefficient (m2/s) 89 USE ldftra , ONLY : aeiu => aeiu !: eddy induced velocity coef. at u-points (m2/s) 90 USE ldftra , ONLY : aeiv => aeiv !: eddy induced velocity coef. at v-points (m2/s) 91 USE ldftra , ONLY : ln_ldfeiv => ln_ldfeiv !: eddy induced velocity flag 92 93 !!gm this should be : ln_trcldf_triad (TRC namelist) 94 USE ldfslp , ONLY : ln_traldf_triad => ln_traldf_triad !: triad scheme (Griffies et al.) 95 96 !* direction of lateral diffusion * 97 USE ldfslp , ONLY : l_ldfslp => l_ldfslp !: slopes flag 98 USE ldfslp , ONLY : uslp => uslp !: i-slope at u-point 99 USE ldfslp , ONLY : vslp => vslp !: j-slope at v-point 100 USE ldfslp , ONLY : wslpi => wslpi !: i-slope at w-point 101 USE ldfslp , ONLY : wslpj => wslpj !: j-slope at w-point 102 !!gm end 118 103 119 104 !* vertical diffusion * … … 128 113 USE zdfmxl , ONLY : hmlp => hmlp !: mixed layer depth (rho=rho0+zdcrit) (m) 129 114 USE zdfmxl , ONLY : hmlpt => hmlpt !: mixed layer depth at t-points (m) 130 131 !* direction of lateral diffusion *132 USE ldfslp , ONLY : lk_ldfslp => lk_ldfslp !: slopes flag133 # if defined key_ldfslp134 USE ldfslp , ONLY : uslp => uslp !: i-direction slope at u-, w-points135 USE ldfslp , ONLY : vslp => vslp !: j-direction slope at v-, w-points136 USE ldfslp , ONLY : wslpi => wslpi !: i-direction slope at u-, w-points137 USE ldfslp , ONLY : wslpj => wslpj !: j-direction slope at v-, w-points138 # endif139 115 140 116 USE diaar5 , ONLY : lk_diaar5 => lk_diaar5 -
trunk/NEMOGCM/NEMO/TOP_SRC/trc.F90
r5385 r5836 143 143 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avs_tm !: vertical double diffusivity coeff. at w-point [m/s] 144 144 # endif 145 #if defined key_ldfslp146 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wslpi_tm !: i-direction slope at u-, w-points147 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wslpj_tm !: j-direction slope at u-, w-points148 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uslp_tm !: j-direction slope at u-, w-points149 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vslp_tm !: j-direction slope at u-, w-points150 #endif151 145 #if defined key_trabbl 152 146 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahu_bbl_tm !: u-, w-points … … 183 177 #endif 184 178 ! 185 #if defined key_ldfslp186 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wslpi_temp, wslpj_temp, uslp_temp, vslp_temp !: hold current values187 #endif188 !189 179 # if defined key_zdfddm 190 180 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avs_temp !: salinity vertical diffusivity coeff. at w-point [m/s] -
trunk/NEMOGCM/NEMO/TOP_SRC/trcdia.F90
r4292 r5836 51 51 INTEGER :: nhoritb !: id for horizontal mesh 52 52 53 !! * Substitutions54 # include "top_substitute.h90"55 53 !!---------------------------------------------------------------------- 56 54 !! NEMO/TOP 3.3 , NEMO Consortium (2010) -
trunk/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r5407 r5836 18 18 USE oce_trc ! shared variables between ocean and passive tracers 19 19 USE trc ! passive tracers common variables 20 USE trcrst ! passive tracers restart21 20 USE trcnam ! Namelist read 22 USE trcini_cfc ! CFC initialisation23 USE trcini_pisces ! PISCES initialisation24 USE trcini_c14b ! C14 bomb initialisation25 USE trcini_my_trc ! MY_TRC initialisation26 USE trcdta ! initialisation from files27 21 USE daymod ! calendar manager 28 USE zpshde ! partial step: hor. derivative (zps_hde routine)29 22 USE prtctl_trc ! Print control passive tracers (prt_ctl_trc_init routine) 30 23 USE trcsub ! variables to substep passive tracers 24 USE trcrst 31 25 USE lib_mpp ! distribued memory computing library 32 26 USE sbc_oce … … 59 53 !! or read data or analytical formulation 60 54 !!--------------------------------------------------------------------- 61 INTEGER :: jk, jn, jl ! dummy loop indices62 CHARACTER (len=25) :: charout63 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 4D workspace64 !!---------------------------------------------------------------------65 55 ! 66 56 IF( nn_timing == 1 ) CALL timing_start('trc_init') … … 70 60 IF(lwp) WRITE(numout,*) '~~~~~~~' 71 61 72 CALL top_alloc() ! allocate TOP arrays 73 62 ! 63 CALL top_alloc() ! allocate TOP arrays 64 ! 65 CALL trc_ini_ctl ! control 66 ! 67 CALL trc_nam ! read passive tracers namelists 68 ! 69 IF(lwp) WRITE(numout,*) 70 ! 71 IF( ln_rsttr .AND. .NOT. lk_offline ) CALL trc_rst_cal( nit000, 'READ' ) ! calendar 72 ! 73 IF(lwp) WRITE(numout,*) 74 ! 75 CALL trc_ini_sms ! SMS 76 ! 77 CALL trc_ini_trp ! passive tracers transport 78 ! 79 CALL trc_ice_ini ! Tracers in sea ice 80 ! 81 IF( lwp ) & 82 & CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea ) 83 ! 84 CALL trc_ini_state ! passive tracers initialisation : from a restart or from clim 85 ! 86 IF( nn_dttrc /= 1 ) CALL trc_sub_ini ! Initialize variables for substepping passive tracers 87 ! 88 CALL trc_ini_inv ! Inventories 89 ! 90 IF( nn_timing == 1 ) CALL timing_stop('trc_init') 91 ! 92 END SUBROUTINE trc_init 93 94 95 SUBROUTINE trc_ini_ctl 96 !!---------------------------------------------------------------------- 97 !! *** ROUTINE trc_ini_ctl *** 98 !! ** Purpose : Control + ocean volume 99 !!---------------------------------------------------------------------- 100 INTEGER :: jk ! dummy loop indices 101 ! 102 ! Define logical parameter ton control dirunal cycle in TOP 74 103 l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 ) 75 104 l_trcdm2dc = l_trcdm2dc .AND. .NOT. lk_offline 76 IF( l_trcdm2dc .AND. lwp ) & 77 & CALL ctl_warn(' Coupling with passive tracers and used of diurnal cycle. & 78 & Computation of a daily mean shortwave for some biogeochemical models) ') 79 80 IF( nn_cla == 1 ) & 81 & CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' ) 82 83 CALL trc_nam ! read passive tracers namelists 84 ! 85 IF(lwp) WRITE(numout,*) 86 ! 87 IF( ln_rsttr .AND. .NOT. lk_offline ) CALL trc_rst_cal( nit000, 'READ' ) ! calendar 88 ! 89 IF(lwp) WRITE(numout,*) 90 ! masked grid volume 105 IF( l_trcdm2dc .AND. lwp ) CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.', & 106 & 'Computation of a daily mean shortwave for some biogeochemical models ' ) 107 ! 108 END SUBROUTINE trc_ini_ctl 109 110 111 SUBROUTINE trc_ini_inv 112 !!---------------------------------------------------------------------- 113 !! *** ROUTINE trc_ini_stat *** 114 !! ** Purpose : passive tracers inventories at initialsation phase 115 !!---------------------------------------------------------------------- 116 INTEGER :: jk, jn ! dummy loop indices 117 CHARACTER (len=25) :: charout 118 !!---------------------------------------------------------------------- 91 119 ! ! masked grid volume 92 120 DO jk = 1, jpk … … 96 124 ! ! total volume of the ocean 97 125 areatot = glob_sum( cvol(:,:,:) ) 98 126 ! 127 trai(:) = 0._wp ! initial content of all tracers 128 DO jn = 1, jptra 129 trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) ) 130 END DO 131 132 IF(lwp) THEN ! control print 133 WRITE(numout,*) 134 WRITE(numout,*) 135 WRITE(numout,*) ' *** Total number of passive tracer jptra = ', jptra 136 WRITE(numout,*) ' *** Total volume of ocean = ', areatot 137 WRITE(numout,*) ' *** Total inital content of all tracers ' 138 WRITE(numout,*) 139 DO jn = 1, jptra 140 WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn) 141 ENDDO 142 WRITE(numout,*) 143 ENDIF 144 IF(lwp) WRITE(numout,*) 145 IF(ln_ctl) THEN ! print mean trends (used for debugging) 146 CALL prt_ctl_trc_init 147 WRITE(charout, FMT="('ini ')") 148 CALL prt_ctl_trc_info( charout ) 149 CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 150 ENDIF 151 9000 FORMAT(' tracer nb : ',i2,' name :',a10,' initial content :',e18.10) 152 ! 153 END SUBROUTINE trc_ini_inv 154 155 156 SUBROUTINE trc_ini_sms 157 !!---------------------------------------------------------------------- 158 !! *** ROUTINE trc_ini_sms *** 159 !! ** Purpose : SMS initialisation 160 !!---------------------------------------------------------------------- 161 USE trcini_cfc ! CFC initialisation 162 USE trcini_pisces ! PISCES initialisation 163 USE trcini_c14b ! C14 bomb initialisation 164 USE trcini_my_trc ! MY_TRC initialisation 165 !!---------------------------------------------------------------------- 99 166 IF( lk_pisces ) CALL trc_ini_pisces ! PISCES bio-model 100 167 IF( lk_cfc ) CALL trc_ini_cfc ! CFC tracers 101 168 IF( lk_c14b ) CALL trc_ini_c14b ! C14 bomb tracer 102 169 IF( lk_my_trc ) CALL trc_ini_my_trc ! MY_TRC tracers 103 104 CALL trc_ice_ini ! Tracers in sea ice 105 106 IF( lwp ) THEN 107 ! 108 CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea ) 109 ! 110 ENDIF 111 170 ! 171 END SUBROUTINE trc_ini_sms 172 173 SUBROUTINE trc_ini_trp 174 !!---------------------------------------------------------------------- 175 !! *** ROUTINE trc_ini_trp *** 176 !! 177 !! ** Purpose : Allocate all the dynamic arrays of the OPA modules 178 !!---------------------------------------------------------------------- 179 USE trcdmp , ONLY: trc_dmp_ini 180 USE trcadv , ONLY: trc_adv_ini 181 USE trcldf , ONLY: trc_ldf_ini 182 USE trczdf , ONLY: trc_zdf_ini 183 USE trcrad , ONLY: trc_rad_ini 184 ! 185 INTEGER :: ierr 186 !!---------------------------------------------------------------------- 187 ! 188 IF( ln_trcdmp ) CALL trc_dmp_ini ! damping 189 CALL trc_adv_ini ! advection 190 CALL trc_ldf_ini ! lateral diffusion 191 CALL trc_zdf_ini ! vertical diffusion 192 CALL trc_rad_ini ! positivity of passive tracers 193 ! 194 END SUBROUTINE trc_ini_trp 195 196 197 SUBROUTINE trc_ini_state 198 !!---------------------------------------------------------------------- 199 !! *** ROUTINE trc_ini_state *** 200 !! ** Purpose : Initialisation of passive tracer concentration 201 !!---------------------------------------------------------------------- 202 USE zpshde ! partial step: hor. derivative (zps_hde routine) 203 USE trcrst ! passive tracers restart 204 USE trcdta ! initialisation from files 205 ! 206 INTEGER :: jk, jn, jl ! dummy loop indices 207 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 4D workspace 208 !!---------------------------------------------------------------------- 209 ! 112 210 IF( ln_trcdta ) CALL trc_dta_init(jptra) 113 114 211 115 212 IF( ln_rsttr ) THEN … … 146 243 147 244 tra(:,:,:,:) = 0._wp 148 IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav ) & ! Partial steps: before horizontal gradient of passive 149 & CALL zps_hde ( nit000, jptra, trn, gtru, gtrv ) ! Partial steps: before horizontal gradient 150 IF( ln_zps .AND. .NOT. lk_c1d .AND. ln_isfcav ) & 151 & CALL zps_hde_isf( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! tracers at the bottom ocean level 152 153 154 ! 155 IF( nn_dttrc /= 1 ) CALL trc_sub_ini ! Initialize variables for substepping passive tracers 156 ! 157 158 trai(:) = 0._wp ! initial content of all tracers 159 DO jn = 1, jptra 160 trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) ) 161 END DO 162 163 IF(lwp) THEN ! control print 164 WRITE(numout,*) 165 WRITE(numout,*) 166 WRITE(numout,*) ' *** Total number of passive tracer jptra = ', jptra 167 WRITE(numout,*) ' *** Total volume of ocean = ', areatot 168 WRITE(numout,*) ' *** Total inital content of all tracers ' 169 WRITE(numout,*) 170 DO jn = 1, jptra 171 WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn) 172 ENDDO 173 WRITE(numout,*) 174 ENDIF 175 IF(lwp) WRITE(numout,*) 176 IF(ln_ctl) THEN ! print mean trends (used for debugging) 177 CALL prt_ctl_trc_init 178 WRITE(charout, FMT="('ini ')") 179 CALL prt_ctl_trc_info( charout ) 180 CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 181 ENDIF 182 9000 FORMAT(' tracer nb : ',i2,' name :',a10,' initial content :',e18.10) 183 ! 184 IF( nn_timing == 1 ) CALL timing_stop('trc_init') 185 ! 186 END SUBROUTINE trc_init 245 ! ! Partial top/bottom cell: GRADh(trn) 246 END SUBROUTINE trc_ini_state 187 247 188 248 -
trunk/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
r5656 r5836 20 20 USE oce_trc ! shared variables between ocean and passive tracers 21 21 USE trc ! passive tracers common variables 22 USE trcnam_trp ! Transport namelist23 22 USE trcnam_pisces ! PISCES namelist 24 23 USE trcnam_cfc ! CFC SMS namelist … … 35 34 PUBLIC trc_nam ! called in trcini 36 35 37 !! * Substitutions38 # include "top_substitute.h90"39 36 !!---------------------------------------------------------------------- 40 37 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 42 39 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 43 40 !!---------------------------------------------------------------------- 44 45 41 CONTAINS 46 47 42 48 43 SUBROUTINE trc_nam … … 57 52 !!--------------------------------------------------------------------- 58 53 INTEGER :: jn ! dummy loop indice 59 ! ! Parameters of the run 60 IF( .NOT. lk_offline ) CALL trc_nam_run 61 62 ! ! passive tracer informations 63 CALL trc_nam_trc 64 65 ! ! Parameters of additional diagnostics 66 CALL trc_nam_dia 67 68 ! ! namelist of transport 69 CALL trc_nam_trp 70 71 72 IF( ln_rsttr ) ln_trcdta = .FALSE. ! restart : no need of clim data 73 ! 74 IF( ln_trcdmp .OR. ln_trcdmp_clo ) ln_trcdta = .TRUE. ! damping : need to have clim data 75 ! 76 IF( .NOT.ln_trcdta ) THEN 77 ln_trc_ini(:) = .FALSE. 78 ENDIF 79 80 IF(lwp) THEN ! control print 54 ! 55 IF( .NOT.lk_offline ) CALL trc_nam_run ! Parameters of the run 56 ! 57 CALL trc_nam_trc ! passive tracer informations 58 ! 59 CALL trc_nam_dia ! Parameters of additional diagnostics 60 ! 61 ! 62 IF( ln_rsttr ) ln_trcdta = .FALSE. ! restart : no need of clim data 63 ! 64 IF( ln_trcdmp .OR. ln_trcdmp_clo ) ln_trcdta = .TRUE. ! damping : need to have clim data 65 ! 66 IF( .NOT.ln_trcdta ) ln_trc_ini(:) = .FALSE. 67 68 IF(lwp) THEN ! control print 81 69 WRITE(numout,*) 82 70 WRITE(numout,*) ' Namelist : namtrc' … … 149 137 ! Call the ice module for tracers 150 138 ! ------------------------------- 151 CALL trc_nam_ice139 CALL trc_nam_ice 152 140 153 141 ! namelist of SMS … … 171 159 END SUBROUTINE trc_nam 172 160 161 173 162 SUBROUTINE trc_nam_run 174 163 !!--------------------------------------------------------------------- … … 180 169 NAMELIST/namtrc_run/ nn_dttrc, nn_writetrc, ln_rsttr, nn_rsttr, ln_top_euler, & 181 170 & cn_trcrst_indir, cn_trcrst_outdir, cn_trcrst_in, cn_trcrst_out 182 183 171 ! 184 172 INTEGER :: ios ! Local integer output status for namelist read 185 186 !!--------------------------------------------------------------------- 187 188 173 !!--------------------------------------------------------------------- 174 ! 189 175 IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists' 190 176 IF(lwp) WRITE(numout,*) '~~~~~~~' … … 220 206 END SUBROUTINE trc_nam_run 221 207 208 222 209 SUBROUTINE trc_nam_ice 223 210 !!--------------------------------------------------------------------- … … 229 216 !! 230 217 !!--------------------------------------------------------------------- 231 ! --- Variable declarations --- !232 218 INTEGER :: jn ! dummy loop indices 233 219 INTEGER :: ios ! Local integer output status for namelist read 234 235 ! --- Namelist declarations --- ! 220 ! 236 221 TYPE(TRC_I_NML), DIMENSION(jptra) :: sn_tri_tracer 222 !! 237 223 NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer 238 224 !!--------------------------------------------------------------------- 225 ! 239 226 IF(lwp) THEN 240 227 WRITE(numout,*) … … 271 258 END SUBROUTINE trc_nam_ice 272 259 260 273 261 SUBROUTINE trc_nam_trc 274 262 !!--------------------------------------------------------------------- … … 278 266 !! 279 267 !!--------------------------------------------------------------------- 280 TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer ! type of tracer for saving if not key_iomput281 !!282 NAMELIST/namtrc/ sn_tracer, ln_trcdta,ln_trcdmp, ln_trcdmp_clo283 284 268 INTEGER :: ios ! Local integer output status for namelist read 285 269 INTEGER :: jn ! dummy loop indice 270 ! 271 TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer ! type of tracer for saving if not key_iomput 272 !! 273 NAMELIST/namtrc/ sn_tracer, ln_trcdta,ln_trcdmp, ln_trcdmp_clo 286 274 !!--------------------------------------------------------------------- 287 275 IF(lwp) WRITE(numout,*) 288 276 IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists' 289 277 IF(lwp) WRITE(numout,*) '~~~~~~~' 290 291 278 292 279 REWIND( numnat_ref ) ! Namelist namtrc in reference namelist : Passive tracer variables … … 306 293 ln_trc_wri(jn) = sn_tracer(jn)%llsave 307 294 END DO 308 309 295 ! 296 END SUBROUTINE trc_nam_trc 310 297 311 298 … … 320 307 !! ( (PISCES, CFC, MY_TRC ) 321 308 !!--------------------------------------------------------------------- 309 INTEGER :: ios ! Local integer output status for namelist read 322 310 INTEGER :: ierr 311 !! 323 312 #if defined key_trdmxl_trc || defined key_trdtrc 324 313 NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & … … 327 316 #endif 328 317 NAMELIST/namtrc_dia/ ln_diatrc, ln_diabio, nn_writedia, nn_writebio 329 330 INTEGER :: ios ! Local integer output status for namelist read331 318 !!--------------------------------------------------------------------- 332 319 -
trunk/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r5513 r5836 25 25 USE oce_trc 26 26 USE trc 27 USE trcnam_trp28 27 USE iom 29 28 USE daymod … … 37 36 38 37 !! * Substitutions 39 # include " top_substitute.h90"38 # include "domzgr_substitute.h90" 40 39 41 40 CONTAINS -
trunk/NEMOGCM/NEMO/TOP_SRC/trcsub.F90
r5215 r5836 25 25 USE zdf_oce 26 26 USE domvvl 27 USE div cur ! hor. divergence and curl (div & cur routines)27 USE divhor ! horizontal divergence (div_hor routine) 28 28 USE sbcrnf, ONLY: h_rnf, nk_rnf ! River runoff 29 29 USE bdy_oce … … 44 44 REAL(wp) :: r1_ndttrcp1 ! 1 / (nn_dttrc+1) 45 45 46 !!* Substitution 47 # include "top_substitute.h90" 46 ! !* iso-neutral slopes (if l_ldfslp=T) 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uslp_temp, vslp_temp, wslpi_temp, wslpj_temp !: hold current values 48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uslp_tm , vslp_tm , wslpi_tm , wslpj_tm !: time mean 49 50 !! * Substitutions 51 # include "domzgr_substitute.h90" 48 52 !!---------------------------------------------------------------------- 49 53 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 93 97 avs_tm (:,:,:) = avs_tm (:,:,:) + avs (:,:,:) * fse3w(:,:,:) 94 98 # endif 95 #if defined key_ldfslp 96 wslpi_tm(:,:,:) = wslpi_tm(:,:,:) + wslpi(:,:,:)97 wslpj_tm(:,:,:) = wslpj_tm(:,:,:) + wslpj(:,:,:)98 uslp_tm (:,:,:) = uslp_tm (:,:,:) + uslp(:,:,:)99 vslp_tm (:,:,:) = vslp_tm (:,:,:) + vslp(:,:,:)100 #endif 99 IF( l_ldfslp ) THEN 100 uslp_tm (:,:,:) = uslp_tm (:,:,:) + uslp (:,:,:) 101 vslp_tm (:,:,:) = vslp_tm (:,:,:) + vslp (:,:,:) 102 wslpi_tm(:,:,:) = wslpi_tm(:,:,:) + wslpi(:,:,:) 103 wslpj_tm(:,:,:) = wslpj_tm(:,:,:) + wslpj(:,:,:) 104 ENDIF 101 105 # if defined key_trabbl 102 106 IF( nn_bbl_ldf == 1 ) THEN … … 131 135 avs_temp (:,:,:) = avs (:,:,:) 132 136 # endif 133 #if defined key_ldfslp 134 wslpi_temp (:,:,:) = wslpi (:,:,:) 135 wslpj_temp (:,:,:) = wslpj (:,:,:) 136 uslp_temp (:,:,:) = uslp (:,:,:) 137 vslp_temp (:,:,:) = vslp (:,:,:) 138 #endif 137 IF( l_ldfslp ) THEN 138 uslp_temp (:,:,:) = uslp (:,:,:) ; wslpi_temp (:,:,:) = wslpi (:,:,:) 139 vslp_temp (:,:,:) = vslp (:,:,:) ; wslpj_temp (:,:,:) = wslpj (:,:,:) 140 ENDIF 139 141 # if defined key_trabbl 140 142 IF( nn_bbl_ldf == 1 ) THEN … … 160 162 wndm_temp (:,:) = wndm (:,:) 161 163 ! ! Variables reset in trc_sub_ssh 162 rotn_temp (:,:,:) = rotn (:,:,:)163 164 hdivn_temp (:,:,:) = hdivn (:,:,:) 164 rotb_temp (:,:,:) = rotb (:,:,:)165 hdivb_temp (:,:,:) = hdivb (:,:,:)166 165 ! 167 166 ! 2. Create averages and reassign variables … … 175 174 avs_tm (:,:,:) = avs_tm (:,:,:) + avs (:,:,:) * fse3w(:,:,:) 176 175 # endif 177 #if defined key_ldfslp 178 wslpi_tm (:,:,:) = wslpi_tm(:,:,:) + wslpi(:,:,:)179 wslpj_tm (:,:,:) = wslpj_tm(:,:,:) + wslpj(:,:,:)180 uslp_tm (:,:,:) = uslp_tm (:,:,:) + uslp(:,:,:)181 vslp_tm (:,:,:) = vslp_tm (:,:,:) + vslp (:,:,:)182 #endif 176 IF( l_ldfslp ) THEN 177 uslp_tm (:,:,:) = uslp_tm (:,:,:) + uslp (:,:,:) 178 vslp_tm (:,:,:) = vslp_tm (:,:,:) + vslp (:,:,:) 179 wslpi_tm (:,:,:) = wslpi_tm(:,:,:) + wslpi(:,:,:) 180 wslpj_tm (:,:,:) = wslpj_tm(:,:,:) + wslpj(:,:,:) 181 ENDIF 183 182 # if defined key_trabbl 184 183 IF( nn_bbl_ldf == 1 ) THEN … … 255 254 tsn (ji,jj,jk,jp_sal) = tsn_tm (ji,jj,jk,jp_sal) * z1_ne3t 256 255 rhop (ji,jj,jk) = rhop_tm (ji,jj,jk) * z1_ne3t 256 !!gm : BUG? ==>> for avt & avs I don't understand the division by e3w 257 257 avt (ji,jj,jk) = avt_tm (ji,jj,jk) * z1_ne3w 258 258 # if defined key_zdfddm 259 259 avs (ji,jj,jk) = avs_tm (ji,jj,jk) * z1_ne3w 260 260 # endif 261 #if defined key_ldfslp 262 wslpi(ji,jj,jk) = wslpi_tm(ji,jj,jk)263 wslpj(ji,jj,jk) = wslpj_tm(ji,jj,jk)264 uslp (ji,jj,jk) = uslp_tm (ji,jj,jk)265 vslp (ji,jj,jk) = vslp_tm (ji,jj,jk)266 #endif 267 ENDDO268 ENDDO269 END DO261 END DO 262 END DO 263 END DO 264 IF( l_ldfslp ) THEN 265 wslpi(:,:,:) = wslpi_tm(:,:,:) 266 wslpj(:,:,:) = wslpj_tm(:,:,:) 267 uslp (:,:,:) = uslp_tm (:,:,:) 268 vslp (:,:,:) = vslp_tm (:,:,:) 269 ENDIF 270 270 ! 271 271 CALL trc_sub_ssh( kt ) ! after ssh & vertical velocity … … 276 276 ! 277 277 END SUBROUTINE trc_sub_stp 278 278 279 279 280 SUBROUTINE trc_sub_ini … … 304 305 tsn_tm (:,:,:,jp_sal) = tsn (:,:,:,jp_sal) * fse3t(:,:,:) 305 306 rhop_tm (:,:,:) = rhop (:,:,:) * fse3t(:,:,:) 307 !!gm : BUG? ==>> for avt & avs I don't understand the division by e3w 306 308 avt_tm (:,:,:) = avt (:,:,:) * fse3w(:,:,:) 307 309 # if defined key_zdfddm 308 310 avs_tm (:,:,:) = avs (:,:,:) * fse3w(:,:,:) 309 311 # endif 310 #if defined key_ldfslp 311 wslpi_tm(:,:,:)= wslpi(:,:,:)312 wslpj_tm(:,:,:)= wslpj(:,:,:)313 uslp_tm (:,:,:)= uslp (:,:,:)314 vslp_tm (:,:,:)= vslp (:,:,:)315 #endif 312 IF( l_ldfslp ) THEN 313 wslpi_tm(:,:,:) = wslpi(:,:,:) 314 wslpj_tm(:,:,:) = wslpj(:,:,:) 315 uslp_tm (:,:,:) = uslp (:,:,:) 316 vslp_tm (:,:,:) = vslp (:,:,:) 317 ENDIF 316 318 sshn_tm (:,:) = sshn (:,:) 317 319 rnf_tm (:,:) = rnf (:,:) … … 365 367 avs (:,:,:) = avs_temp (:,:,:) 366 368 # endif 367 #if defined key_ldfslp 368 wslpi (:,:,:)= wslpi_temp (:,:,:)369 wslpj (:,:,:)= wslpj_temp (:,:,:)370 uslp (:,:,:)= uslp_temp (:,:,:)371 vslp (:,:,:)= vslp_temp (:,:,:)372 #endif 369 IF( l_ldfslp ) THEN 370 wslpi (:,:,:)= wslpi_temp (:,:,:) 371 wslpj (:,:,:)= wslpj_temp (:,:,:) 372 uslp (:,:,:)= uslp_temp (:,:,:) 373 vslp (:,:,:)= vslp_temp (:,:,:) 374 ENDIF 373 375 sshn (:,:) = sshn_temp (:,:) 374 376 sshb (:,:) = sshb_temp (:,:) … … 396 398 ! 397 399 hdivn (:,:,:) = hdivn_temp (:,:,:) 398 rotn (:,:,:) = rotn_temp (:,:,:)399 hdivb (:,:,:) = hdivb_temp (:,:,:)400 rotb (:,:,:) = rotb_temp (:,:,:)401 400 ! 402 403 401 ! Start new averages 404 402 un_tm (:,:,:) = un (:,:,:) * fse3u(:,:,:) … … 411 409 avs_tm (:,:,:) = avs (:,:,:) * fse3w(:,:,:) 412 410 # endif 413 #if defined key_ldfslp 411 IF( l_ldfslp ) THEN 412 uslp_tm (:,:,:) = uslp (:,:,:) 413 vslp_tm (:,:,:) = vslp (:,:,:) 414 414 wslpi_tm(:,:,:) = wslpi(:,:,:) 415 415 wslpj_tm(:,:,:) = wslpj(:,:,:) 416 uslp_tm (:,:,:) = uslp (:,:,:) 417 vslp_tm (:,:,:) = vslp (:,:,:) 418 #endif 416 ENDIF 419 417 ! 420 418 sshb_hold (:,:) = sshn (:,:) … … 487 485 ENDIF 488 486 ! 489 CALL div_ cur( kt ) ! Horizontal divergence & Relative vorticity487 CALL div_hor( kt ) ! Horizontal divergence & Relative vorticity 490 488 ! 491 489 z2dt = 2._wp * rdt ! set time step size (Euler/Leapfrog) … … 551 549 & sshn_temp(jpi,jpj) , sshb_temp(jpi,jpj) , & 552 550 & ssha_temp(jpi,jpj) , & 553 #if defined key_ldfslp554 & wslpi_temp(jpi,jpj,jpk) , wslpj_temp(jpi,jpj,jpk), &555 & uslp_temp(jpi,jpj,jpk) , vslp_temp(jpi,jpj,jpk), &556 #endif557 551 #if defined key_trabbl 558 552 & ahu_bbl_temp(jpi,jpj) , ahv_bbl_temp(jpi,jpj), & … … 569 563 # endif 570 564 & hdivn_temp(jpi,jpj,jpk) , hdivb_temp(jpi,jpj,jpk), & 571 & rotn_temp(jpi,jpj,jpk) , rotb_temp(jpi,jpj,jpk), &572 565 & un_tm(jpi,jpj,jpk) , vn_tm(jpi,jpj,jpk) , & 573 566 & avt_tm(jpi,jpj,jpk) , & … … 577 570 & emp_b_hold(jpi,jpj) , & 578 571 & hmld_tm(jpi,jpj) , qsr_tm(jpi,jpj) , & 579 #if defined key_ldfslp580 & wslpi_tm(jpi,jpj,jpk) , wslpj_tm(jpi,jpj,jpk), &581 & uslp_tm(jpi,jpj,jpk) , vslp_tm(jpi,jpj,jpk), &582 #endif583 572 #if defined key_trabbl 584 573 & ahu_bbl_tm(jpi,jpj) , ahv_bbl_tm(jpi,jpj), & 585 574 & utr_bbl_tm(jpi,jpj) , vtr_bbl_tm(jpi,jpj), & 586 575 #endif 587 & rnf_tm(jpi,jpj) , h_rnf_tm(jpi,jpj) , &588 & STAT=trc_sub_alloc )576 & rnf_tm(jpi,jpj) , h_rnf_tm(jpi,jpj) , STAT=trc_sub_alloc ) 577 ! 589 578 IF( trc_sub_alloc /= 0 ) CALL ctl_warn('trc_sub_alloc: failed to allocate arrays') 590 579 ! 580 IF( l_ldfslp ) THEN 581 ALLOCATE( uslp_temp(jpi,jpj,jpk) , wslpi_temp(jpi,jpj,jpk), & 582 & vslp_temp(jpi,jpj,jpk) , wslpj_temp(jpi,jpj,jpk), & 583 & uslp_tm (jpi,jpj,jpk) , wslpi_tm (jpi,jpj,jpk), & 584 & vslp_tm (jpi,jpj,jpk) , wslpj_tm (jpi,jpj,jpk), STAT=trc_sub_alloc ) 585 ENDIF 586 ! 587 IF( trc_sub_alloc /= 0 ) CALL ctl_warn('trc_sub_alloc: failed to allocate ldf_slp arrays') 591 588 ! 592 589 END FUNCTION trc_sub_alloc -
trunk/NEMOGCM/NEMO/TOP_SRC/trcwri.F90
r3750 r5836 26 26 27 27 PUBLIC trc_wri 28 29 !! * Substitutions30 # include "top_substitute.h90"31 28 32 29 CONTAINS
Note: See TracChangeset
for help on using the changeset viewer.