Changeset 13727 for NEMO/branches/2020/dev_12905_xios_restart/src/TOP/TRP
- Timestamp:
- 2020-11-05T15:18:53+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_12905_xios_restart
- Files:
-
- 13 edited
-
. (modified) (1 prop)
-
src/TOP/TRP/trcadv.F90 (modified) (3 diffs)
-
src/TOP/TRP/trcatf.F90 (modified) (10 diffs)
-
src/TOP/TRP/trcbbl.F90 (modified) (3 diffs)
-
src/TOP/TRP/trcdmp.F90 (modified) (10 diffs)
-
src/TOP/TRP/trcldf.F90 (modified) (4 diffs)
-
src/TOP/TRP/trcrad.F90 (modified) (3 diffs)
-
src/TOP/TRP/trcsbc.F90 (modified) (10 diffs)
-
src/TOP/TRP/trcsink.F90 (modified) (7 diffs)
-
src/TOP/TRP/trczdf.F90 (modified) (2 diffs)
-
src/TOP/TRP/trdmxl_trc.F90 (modified) (4 diffs)
-
src/TOP/TRP/trdmxl_trc_rst.F90 (modified) (2 diffs)
-
src/TOP/TRP/trdtrc.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_12905_xios_restart
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 8 9 9 # SETTE 10 ^/utils/CI/sette@ HEADsette10 ^/utils/CI/sette@13559 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_12905_xios_restart/src/TOP/TRP/trcadv.F90
r12489 r13727 29 29 USE ldfslp ! Lateral diffusion: slopes of neutral surfaces 30 30 ! 31 USE prtctl _trc! control print31 USE prtctl ! control print 32 32 USE timing ! Timing 33 33 … … 59 59 INTEGER, PARAMETER :: np_QCK = 5 ! QUICK scheme 60 60 61 # include "domzgr_substitute.h90" 61 62 !!---------------------------------------------------------------------- 62 63 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 137 138 IF( sn_cfctl%l_prttrc ) THEN !== print mean trends (used for debugging) 138 139 WRITE(charout, FMT="('adv ')") 139 CALL prt_ctl_ trc_info(charout)140 CALL prt_ctl _trc( tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )140 CALL prt_ctl_info( charout, cdcomp = 'top' ) 141 CALL prt_ctl( tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 141 142 END IF 142 143 ! -
NEMO/branches/2020/dev_12905_xios_restart/src/TOP/TRP/trcatf.F90
r12489 r13727 31 31 USE trd_oce 32 32 USE trdtra 33 # if defined key_qco 34 USE traatfqco 35 # else 33 36 USE traatf 37 # endif 34 38 USE bdy_oce , ONLY: ln_bdy 35 39 USE trcbdy ! BDY open boundaries … … 39 43 ! 40 44 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 41 USE prtctl _trc! Print control for debbuging45 USE prtctl ! Print control for debbuging 42 46 43 47 IMPLICIT NONE … … 50 54 !! * Substitutions 51 55 # include "do_loop_substitute.h90" 56 # include "domzgr_substitute.h90" 52 57 !!---------------------------------------------------------------------- 53 58 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 112 117 ! total trend for the non-time-filtered variables. 113 118 zfact = 1.0 / rn_Dt 114 ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t *T)/e3tn; e3tn cancel from ts(Kmm) terms119 ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3ta*Ta)/e3tn; e3tn cancel from ts(Kmm) terms 115 120 IF( ln_linssh ) THEN ! linear sea surface height only 116 121 DO jn = 1, jptra … … 151 156 ELSE 152 157 IF( .NOT. l_offline ) THEN ! Leap-Frog + Asselin filter time stepping 158 # if defined key_qco 159 IF( ln_linssh ) THEN ; CALL tra_atf_fix_lf( kt, Kbb, Kmm, Kaa, nittrc000, 'TRC', ptr, jptra ) ! linear ssh 160 ELSE ; CALL tra_atf_qco_lf( kt, Kbb, Kmm, Kaa, nittrc000, rn_Dt, 'TRC', ptr, sbc_trc, sbc_trc_b, jptra ) ! non-linear ssh 161 # else 153 162 IF( ln_linssh ) THEN ; CALL tra_atf_fix( kt, Kbb, Kmm, Kaa, nittrc000, 'TRC', ptr, jptra ) ! linear ssh 154 163 ELSE ; CALL tra_atf_vvl( kt, Kbb, Kmm, Kaa, nittrc000, rn_Dt, 'TRC', ptr, sbc_trc, sbc_trc_b, jptra ) ! non-linear ssh 164 # endif 155 165 ENDIF 156 166 ELSE … … 174 184 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 175 185 WRITE(charout, FMT="('nxt')") 176 CALL prt_ctl_ trc_info(charout)177 CALL prt_ctl _trc(tab4d=ptr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm)186 CALL prt_ctl_info( charout, cdcomp = 'top' ) 187 CALL prt_ctl(tab4d_1=ptr(:,:,:,:,Kmm), mask1=tmask, clinfo=ctrcnm) 178 188 ENDIF 179 189 ! … … 182 192 END SUBROUTINE trc_atf 183 193 184 194 # if ! defined key_qco 185 195 SUBROUTINE trc_atf_off( kt, Kbb, Kmm, Kaa, ptr ) 186 196 !!---------------------------------------------------------------------- … … 198 208 !! This can be summurized for tempearture as: 199 209 !! ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] ) ln_dynhpg_imp = T 200 !! /( e3t(:,:, :,Kmm) + rbcp*[ e3t(:,:,:,Kbb) - 2 e3t(:,:,:,Kmm) + e3t(:,:,:,Kaa) ] )210 !! /( e3t(:,:,jk,Kmm) + rbcp*[ e3t(:,:,jk,Kbb) - 2 e3t(:,:,jk,Kmm) + e3t(:,:,jk,Kaa) ] ) 201 211 !! ztm = 0 otherwise 202 212 !! tb = ( e3t_n*tn + rn_atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] ) 203 !! /( e3t(:,:, :,Kmm) + rn_atfp*[ e3t(:,:,:,Kbb) - 2 e3t(:,:,:,Kmm) + e3t(:,:,:,Kaa) ] )213 !! /( e3t(:,:,jk,Kmm) + rn_atfp*[ e3t(:,:,jk,Kbb) - 2 e3t(:,:,jk,Kmm) + e3t(:,:,jk,Kaa) ] ) 204 214 !! tn = ta 205 215 !! ta = zt (NB: reset to 0 after eos_bn2 call) … … 229 239 ! 230 240 DO jn = 1, jptra 231 DO_3D _11_11(1, jpkm1 )241 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 232 242 ze3t_b = e3t(ji,jj,jk,Kbb) 233 243 ze3t_n = e3t(ji,jj,jk,Kmm) … … 257 267 ! 258 268 END SUBROUTINE trc_atf_off 269 # else 270 SUBROUTINE trc_atf_off( kt, Kbb, Kmm, Kaa, ptr ) 271 !!---------------------------------------------------------------------- 272 !! *** ROUTINE tra_atf_off *** 273 !! 274 !! !!!!!!!!!!!!!!!!! REWRITE HEADER COMMENTS !!!!!!!!!!!!!! 275 !! 276 !! ** Purpose : Time varying volume: apply the Asselin time filter 277 !! 278 !! ** Method : - Apply a thickness weighted Asselin time filter on now fields. 279 !! - save in (ta,sa) a thickness weighted average over the three 280 !! time levels which will be used to compute rdn and thus the semi- 281 !! implicit hydrostatic pressure gradient (ln_dynhpg_imp = T) 282 !! - swap tracer fields to prepare the next time_step. 283 !! This can be summurized for tempearture as: 284 !! ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] ) ln_dynhpg_imp = T 285 !! /( e3t(:,:,jk,Kmm) + rbcp*[ e3t(:,:,jk,Kbb) - 2 e3t(:,:,jk,Kmm) + e3t(:,:,jk,Kaa) ] ) 286 !! ztm = 0 otherwise 287 !! tb = ( e3t_n*tn + rn_atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] ) 288 !! /( e3t(:,:,jk,Kmm) + rn_atfp*[ e3t(:,:,jk,Kbb) - 2 e3t(:,:,jk,Kmm) + e3t(:,:,jk,Kaa) ] ) 289 !! tn = ta 290 !! ta = zt (NB: reset to 0 after eos_bn2 call) 291 !! 292 !! ** Action : - (tb,sb) and (tn,sn) ready for the next time step 293 !! - (ta,sa) time averaged (t,s) (ln_dynhpg_imp = T) 294 !!---------------------------------------------------------------------- 295 INTEGER , INTENT(in ) :: kt ! ocean time-step index 296 INTEGER , INTENT(in ) :: Kbb, Kmm, Kaa ! time level indices 297 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers 298 !! 299 INTEGER :: ji, jj, jk, jn ! dummy loop indices 300 REAL(wp) :: ztc_a , ztc_n , ztc_b , ztc_f , ztc_d ! local scalar 301 REAL(wp) :: ze3t_b, ze3t_n, ze3t_a, ze3t_f ! - - 302 !!---------------------------------------------------------------------- 303 ! 304 IF( kt == nittrc000 ) THEN 305 IF(lwp) WRITE(numout,*) 306 IF(lwp) WRITE(numout,*) 'trc_atf_off : Asselin time filtering' 307 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 308 IF( .NOT. ln_linssh ) THEN 309 rfact1 = rn_atfp * rn_Dt 310 rfact2 = rfact1 / rho0 311 ENDIF 312 ! 313 ENDIF 314 ! 315 DO jn = 1, jptra 316 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 317 ze3t_b = 1._wp + r3t(ji,jj,Kbb) * tmask(ji,jj,jk) 318 ze3t_n = 1._wp + r3t(ji,jj,Kmm) * tmask(ji,jj,jk) 319 ze3t_a = 1._wp + r3t(ji,jj,Kaa) * tmask(ji,jj,jk) 320 ! ! tracer content at Before, now and after 321 ztc_b = ptr(ji,jj,jk,jn,Kbb) * ze3t_b 322 ztc_n = ptr(ji,jj,jk,jn,Kmm) * ze3t_n 323 ztc_a = ptr(ji,jj,jk,jn,Kaa) * ze3t_a 324 ! 325 ztc_d = ztc_a - 2. * ztc_n + ztc_b 326 ! 327 ze3t_f = 1._wp + r3t_f(ji,jj)*tmask(ji,jj,jk) 328 ztc_f = ztc_n + rn_atfp * ztc_d 329 ! 330 IF( .NOT. ln_linssh .AND. jk == mikt(ji,jj) ) THEN ! first level 331 ztc_f = ztc_f - rfact1 * ( sbc_trc(ji,jj,jn) - sbc_trc_b(ji,jj,jn) ) 332 ENDIF 333 334 ze3t_f = 1.e0 / ze3t_f 335 ptr(ji,jj,jk,jn,Kmm) = ztc_f * ze3t_f ! time filtered "now" field 336 ! 337 END_3D 338 ! 339 END DO 340 ! 341 END SUBROUTINE trc_atf_off 342 # endif 259 343 260 344 #else -
NEMO/branches/2020/dev_12905_xios_restart/src/TOP/TRP/trcbbl.F90
r12377 r13727 25 25 USE trdtra ! tracer trends 26 26 USE trabbl ! bottom boundary layer 27 USE prtctl _trc! Print control for debbuging27 USE prtctl ! Print control for debbuging 28 28 29 29 PUBLIC trc_bbl ! routine called by trctrp.F90 … … 70 70 CALL tra_bbl_dif( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm ) 71 71 IF( sn_cfctl%l_prttrc ) THEN 72 WRITE(charout, FMT="(' bbl_dif')") ; CALL prt_ctl_ trc_info(charout)73 CALL prt_ctl _trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )72 WRITE(charout, FMT="(' bbl_dif')") ; CALL prt_ctl_info( charout, cdcomp = 'top' ) 73 CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 74 74 ENDIF 75 75 ! … … 81 81 CALL tra_bbl_adv( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm ) 82 82 IF( sn_cfctl%l_prttrc ) THEN 83 WRITE(charout, FMT="(' bbl_adv')") ; CALL prt_ctl_ trc_info(charout)84 CALL prt_ctl _trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )83 WRITE(charout, FMT="(' bbl_adv')") ; CALL prt_ctl_info( charout, cdcomp = 'top' ) 84 CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 85 85 ENDIF 86 86 ! -
NEMO/branches/2020/dev_12905_xios_restart/src/TOP/TRP/trcdmp.F90
r12377 r13727 24 24 ! 25 25 USE iom 26 USE prtctl _trc! Print control for debbuging26 USE prtctl ! Print control for debbuging 27 27 28 28 IMPLICIT NONE … … 45 45 !! * Substitutions 46 46 # include "do_loop_substitute.h90" 47 # include "domzgr_substitute.h90" 47 48 !!---------------------------------------------------------------------- 48 49 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 112 113 ! 113 114 CASE( 0 ) !== newtonian damping throughout the water column ==! 114 DO_3D _00_00(1, jpkm1 )115 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 115 116 ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) ) 116 117 END_3D 117 118 ! 118 119 CASE ( 1 ) !== no damping in the turbocline (avt > 5 cm2/s) ==! 119 DO_3D _00_00(1, jpkm1 )120 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 120 121 IF( avt(ji,jj,jk) <= avt_c ) THEN 121 122 ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) ) … … 124 125 ! 125 126 CASE ( 2 ) !== no damping in the mixed layer ==! 126 DO_3D _00_00(1, jpkm1 )127 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 127 128 IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN 128 129 ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) ) … … 148 149 IF( sn_cfctl%l_prttrc ) THEN 149 150 WRITE(charout, FMT="('dmp ')") 150 CALL prt_ctl_ trc_info(charout)151 CALL prt_ctl _trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )151 CALL prt_ctl_info( charout, cdcomp = 'top' ) 152 CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 152 153 ENDIF 153 154 ! … … 204 205 !Read in mask from file 205 206 CALL iom_open ( cn_resto_tr, imask) 206 CALL iom_get ( imask, jpdom_auto glo, 'resto', restotr)207 CALL iom_get ( imask, jpdom_auto, 'resto', restotr) 207 208 CALL iom_close( imask ) 208 209 ! … … 245 246 ! ! ======================= 246 247 CASE ( 1 ) ! eORCA_R1 configuration 247 ! ! ======================= 248 isrow = 332 - jpjglo 249 ! 250 nctsi1(1) = 333 ; nctsj1(1) = 243 - isrow ! Caspian Sea 251 nctsi2(1) = 342 ; nctsj2(1) = 274 - isrow 252 ! 253 nctsi1(2) = 198 ; nctsj1(2) = 258 - isrow ! Lake Superior 254 nctsi2(2) = 204 ; nctsj2(2) = 262 - isrow 255 ! 256 nctsi1(3) = 201 ; nctsj1(3) = 250 - isrow ! Lake Michigan 257 nctsi2(3) = 203 ; nctsj2(3) = 256 - isrow 258 ! 259 nctsi1(4) = 204 ; nctsj1(4) = 252 - isrow ! Lake Huron 260 nctsi2(4) = 209 ; nctsj2(4) = 256 - isrow 261 ! 262 nctsi1(5) = 206 ; nctsj1(5) = 249 - isrow ! Lake Erie 263 nctsi2(5) = 209 ; nctsj2(5) = 251 - isrow 264 ! 265 nctsi1(6) = 210 ; nctsj1(6) = 252 - isrow ! Lake Ontario 266 nctsi2(6) = 212 ; nctsj2(6) = 252 - isrow 267 ! 268 nctsi1(7) = 321 ; nctsj1(7) = 180 - isrow ! Victoria Lake 269 nctsi2(7) = 322 ; nctsj2(7) = 189 - isrow 270 ! 271 nctsi1(8) = 297 ; nctsj1(8) = 270 - isrow ! Baltic Sea 272 nctsi2(8) = 308 ; nctsj2(8) = 293 - isrow 273 ! 274 ! ! ======================= 248 ! ! ======================= 249 ! 250 isrow = 332 - (Nj0glo + 1) ! was 332 - jpjglo -> jpjglo_old_version = Nj0glo + 1 251 ! 252 nctsi1(1) = 333 ; nctsj1(1) = 243 - isrow ! Caspian Sea 253 nctsi2(1) = 342 ; nctsj2(1) = 274 - isrow 254 ! 255 nctsi1(2) = 198 ; nctsj1(2) = 258 - isrow ! Lake Superior 256 nctsi2(2) = 204 ; nctsj2(2) = 262 - isrow 257 ! 258 nctsi1(3) = 201 ; nctsj1(3) = 250 - isrow ! Lake Michigan 259 nctsi2(3) = 203 ; nctsj2(3) = 256 - isrow 260 ! 261 nctsi1(4) = 204 ; nctsj1(4) = 252 - isrow ! Lake Huron 262 nctsi2(4) = 209 ; nctsj2(4) = 256 - isrow 263 ! 264 nctsi1(5) = 206 ; nctsj1(5) = 249 - isrow ! Lake Erie 265 nctsi2(5) = 209 ; nctsj2(5) = 251 - isrow 266 ! 267 nctsi1(6) = 210 ; nctsj1(6) = 252 - isrow ! Lake Ontario 268 nctsi2(6) = 212 ; nctsj2(6) = 252 - isrow 269 ! 270 nctsi1(7) = 321 ; nctsj1(7) = 180 - isrow ! Victoria Lake 271 nctsi2(7) = 322 ; nctsj2(7) = 189 - isrow 272 ! 273 nctsi1(8) = 297 ; nctsj1(8) = 270 - isrow ! Baltic Sea 274 nctsi2(8) = 308 ; nctsj2(8) = 293 - isrow 275 ! 276 ! ! ======================= 275 277 CASE ( 2 ) ! ORCA_R2 configuration 276 278 ! ! ======================= … … 285 287 nctsi2(3) = 181 ; nctsj2(3) = 112 286 288 ! 287 nctsi1(4) = 2 ; nctsj1(4) = 107 ! Black Sea 2 : est part of the Black Sea289 nctsi1(4) = 2 ; nctsj1(4) = 107 ! Black Sea 2 : est part of the Black Sea 288 290 nctsi2(4) = 6 ; nctsj2(4) = 112 289 291 ! 290 292 nctsi1(5) = 145 ; nctsj1(5) = 116 ! Baltic Sea 291 293 nctsi2(5) = 150 ; nctsj2(5) = 126 294 ! 292 295 ! ! ======================= 293 296 CASE ( 4 ) ! ORCA_R4 configuration … … 305 308 nctsi1(4) = 75 ; nctsj1(4) = 59 ! Baltic Sea 306 309 nctsi2(4) = 76 ; nctsj2(4) = 61 310 ! 307 311 ! ! ======================= 308 312 CASE ( 025 ) ! ORCA_R025 configuration … … 318 322 ! 319 323 ENDIF 324 ! 325 nctsi1(:) = nctsi1(:) + nn_hls - 1 ; nctsi2(:) = nctsi2(:) + nn_hls - 1 ! -1 as x-perio included in old input files 326 nctsj1(:) = nctsj1(:) + nn_hls ; nctsj2(:) = nctsj2(:) + nn_hls 320 327 ! 321 328 ! convert the position in local domain indices -
NEMO/branches/2020/dev_12905_xios_restart/src/TOP/TRP/trcldf.F90
r12377 r13727 25 25 USE trdtra ! trends manager: tracers 26 26 ! 27 USE prtctl _trc! Print control27 USE prtctl ! Print control 28 28 29 29 IMPLICIT NONE … … 44 44 !! * Substitutions 45 45 # include "do_loop_substitute.h90" 46 # include "domzgr_substitute.h90" 46 47 !!---------------------------------------------------------------------- 47 48 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 81 82 zahv(:,:,:) = rldf * ahtv(:,:,:) 82 83 ! !* Enhanced zonal diffusivity coefficent in the equatorial domain 83 DO_3D _11_11(1, jpk )84 DO_3D( 1, 1, 1, 1, 1, jpk ) 84 85 IF( gdept(ji,jj,jk,Kmm) > 200. .AND. gphit(ji,jj) < 5. .AND. gphit(ji,jj) > -5. ) THEN 85 86 zdep = MAX( gdept(ji,jj,jk,Kmm) - 1000., 0. ) / 1000. … … 114 115 IF( sn_cfctl%l_prttrc ) THEN ! print mean trends (used for debugging) 115 116 WRITE(charout, FMT="('ldf ')") 116 CALL prt_ctl_ trc_info(charout)117 CALL prt_ctl _trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )117 CALL prt_ctl_info( charout, cdcomp = 'top' ) 118 CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 118 119 ENDIF 119 120 ! -
NEMO/branches/2020/dev_12905_xios_restart/src/TOP/TRP/trcrad.F90
r12489 r13727 19 19 USE trd_oce 20 20 USE trdtra 21 USE prtctl _trc! Print control for debbuging21 USE prtctl ! Print control for debbuging 22 22 USE lib_fortran 23 23 … … 72 72 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 73 73 WRITE(charout, FMT="('rad')") 74 CALL prt_ctl_ trc_info( charout)75 CALL prt_ctl _trc( tab4d=ptr(:,:,:,:,Kbb), mask=tmask, clinfo=ctrcnm )74 CALL prt_ctl_info( charout, cdcomp = 'top' ) 75 CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Kbb), mask1=tmask, clinfo=ctrcnm ) 76 76 ENDIF 77 77 ! … … 168 168 IF( l_trdtrc ) ztrtrd(:,:,:) = ptr(:,:,:,jn,itime) ! save input tr(:,:,:,:,Kbb) for trend computation 169 169 ! 170 DO_3D _11_11(1, jpkm1 )170 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 171 171 IF( ztrneg(ji,jj,jn) /= 0. ) THEN ! if negative values over the 3x3 box 172 172 ! -
NEMO/branches/2020/dev_12905_xios_restart/src/TOP/TRP/trcsbc.F90
r12969 r13727 18 18 USE oce_trc ! ocean dynamics and active tracers variables 19 19 USE trc ! ocean passive tracers variables 20 USE prtctl _trc! Print control for debbuging20 USE prtctl ! Print control for debbuging 21 21 USE iom 22 22 USE trd_oce … … 30 30 !! * Substitutions 31 31 # include "do_loop_substitute.h90" 32 # include "domzgr_substitute.h90" 32 33 !!---------------------------------------------------------------------- 33 34 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 49 50 !! The surface freshwater flux modify the ocean volume 50 51 !! and thus the concentration of a tracer as : 51 !! tr(Krhs) = tr(Krhs) + emp * tr(Kmm) / e3t for k=152 !! tr(Krhs) = tr(Krhs) + emp * tr(Kmm) / e3t_ for k=1 52 53 !! where emp, the surface freshwater budget (evaporation minus 53 54 !! precipitation ) given in kg/m2/s is divided … … 88 89 IF(lrtxios) CALL iom_swap(crtxios_context) 89 90 DO jn = 1, jptra 90 CALL iom_get( numrtr, jpdom_auto glo, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn), ldxios = lrtxios ) ! before tracer content sbc91 CALL iom_get( numrtr, jpdom_auto, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn), ldxios = lrtxios ) ! before tracer content sbc 91 92 END DO 92 93 IF(lrtxios) CALL iom_swap(cxios_context) … … 122 123 ! 123 124 DO jn = 1, jptra 124 DO_2D _01_00125 DO_2D( 0, 1, 0, 0 ) 125 126 sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rho0 * ptr(ji,jj,1,jn,Kmm) 126 127 END_2D … … 130 131 ! 131 132 DO jn = 1, jptra 132 DO_2D _01_00133 DO_2D( 0, 1, 0, 0 ) 133 134 sbc_trc(ji,jj,jn) = ( zsfx(ji,jj) + fmmflx(ji,jj) ) * r1_rho0 * ptr(ji,jj,1,jn,Kmm) 134 135 END_2D … … 138 139 ! 139 140 DO jn = 1, jptra 140 DO_2D _01_00141 DO_2D( 0, 1, 0, 0 ) 141 142 zse3t = 1. / e3t(ji,jj,1,Kmm) 142 143 ! tracer flux at the ice/ocean interface (tracer/m2/s) … … 156 157 END SELECT 157 158 ! 158 CALL lbc_lnk( 'trcsbc', sbc_trc(:,:,:), 'T', 1. )159 CALL lbc_lnk( 'trcsbc', sbc_trc(:,:,:), 'T', 1.0_wp ) 159 160 ! Concentration dilution effect on tracers due to evaporation & precipitation 160 161 DO jn = 1, jptra … … 162 163 IF( l_trdtrc ) ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) ! save trends 163 164 ! 164 DO_2D _01_00165 DO_2D( 0, 1, 0, 0 ) 165 166 zse3t = zfact / e3t(ji,jj,1,Kmm) 166 167 ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t … … 190 191 ! 191 192 IF( sn_cfctl%l_prttrc ) THEN 192 WRITE(charout, FMT="('sbc ')") ; CALL prt_ctl_ trc_info(charout)193 CALL prt_ctl _trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )193 WRITE(charout, FMT="('sbc ')") ; CALL prt_ctl_info( charout, cdcomp = 'top' ) 194 CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 194 195 ENDIF 195 196 IF( l_trdtrc ) DEALLOCATE( ztrtrd ) -
NEMO/branches/2020/dev_12905_xios_restart/src/TOP/TRP/trcsink.F90
r12377 r13727 26 26 !! * Substitutions 27 27 # include "do_loop_substitute.h90" 28 # include "domzgr_substitute.h90" 28 29 !!---------------------------------------------------------------------- 29 30 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 73 74 iiter(:,:) = 1 74 75 ELSE 75 DO_2D _11_1176 DO_2D( 1, 1, 1, 1 ) 76 77 iiter(ji,jj) = 1 77 78 DO jk = 1, jpkm1 … … 85 86 ENDIF 86 87 87 DO_3D _11_11(1,jpkm1 )88 DO_3D( 1, 1, 1, 1, 1,jpkm1 ) 88 89 IF( tmask(ji,jj,jk) == 1.0 ) THEN 89 90 zwsmax = 0.5 * e3t(ji,jj,jk,Kmm) * rday / rsfact … … 145 146 DO jn = 1, 2 146 147 ! first guess of the slopes interior values 147 DO_2D _11_11148 DO_2D( 1, 1, 1, 1 ) 148 149 ! 149 150 zstep = rsfact / REAL( kiter(ji,jj), wp ) / 2. … … 157 158 ! slopes 158 159 DO jk = 2, jpkm1 159 zign = 0.25 + SIGN( 0.25 , ztraz(ji,jj,jk) * ztraz(ji,jj,jk+1) )160 zign = 0.25 + SIGN( 0.25_wp, ztraz(ji,jj,jk) * ztraz(ji,jj,jk+1) ) 160 161 zakz(ji,jj,jk) = ( ztraz(ji,jj,jk) + ztraz(ji,jj,jk+1) ) * zign 161 162 END DO … … 163 164 ! Slopes limitation 164 165 DO jk = 2, jpkm1 165 zakz(ji,jj,jk) = SIGN( 1. , zakz(ji,jj,jk) ) * &166 zakz(ji,jj,jk) = SIGN( 1.0_wp, zakz(ji,jj,jk) ) * & 166 167 & MIN( ABS( zakz(ji,jj,jk) ), 2. * ABS(ztraz(ji,jj,jk+1)), 2. * ABS(ztraz(ji,jj,jk) ) ) 167 168 END DO … … 185 186 END DO 186 187 187 DO_3D _11_11(1,jpkm1 )188 DO_3D( 1, 1, 1, 1, 1,jpkm1 ) 188 189 zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 189 190 ztrb(ji,jj,jk) = ztrb(ji,jj,jk) + 2. * zflx -
NEMO/branches/2020/dev_12905_xios_restart/src/TOP/TRP/trczdf.F90
r12489 r13727 22 22 !!gm 23 23 USE trdtra ! trends manager: tracers 24 USE prtctl _trc! Print control24 USE prtctl ! Print control 25 25 26 26 IMPLICIT NONE … … 69 69 IF( sn_cfctl%l_prttrc ) THEN 70 70 WRITE(charout, FMT="('zdf ')") 71 CALL prt_ctl_ trc_info(charout)72 CALL prt_ctl _trc( tab4d=tr(:,:,:,:,Kaa), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )71 CALL prt_ctl_info( charout, cdcomp = 'top' ) 72 CALL prt_ctl( tab4d_1=tr(:,:,:,:,Kaa), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 73 73 END IF 74 74 ! -
NEMO/branches/2020/dev_12905_xios_restart/src/TOP/TRP/trdmxl_trc.F90
r12489 r13727 51 51 !! * Substitutions 52 52 # include "do_loop_substitute.h90" 53 # include "domzgr_substitute.h90" 53 54 !!---------------------------------------------------------------------- 54 55 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 124 125 125 126 IF( jpktrd_trc < jpk ) THEN ! description ??? 126 DO_2D _11_11127 DO_2D( 1, 1, 1, 1 ) 127 128 IF( nmld_trc(ji,jj) <= jpktrd_trc ) THEN 128 129 zvlmsk(ji,jj) = tmask(ji,jj,1) … … 147 148 ! ... Weights for vertical averaging 148 149 wkx_trc(:,:,:) = 0.e0 149 DO_3D _11_11( 1, jpktrd_trc )150 DO_3D( 1, 1, 1, 1, 1, jpktrd_trc ) ! initialize wkx_trc with vertical scale factor in mixed-layer 150 151 IF( jk - nmld_trc(ji,jj) < 0 ) wkx_trc(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 151 152 END_3D … … 258 259 ! 259 260 DO jn = 1, jptra 260 DO_2D _11_11261 DO_2D( 1, 1, 1, 1 ) 261 262 ik = nmld_trc(ji,jj) 262 263 IF( ln_trdtrc(jn) ) & -
NEMO/branches/2020/dev_12905_xios_restart/src/TOP/TRP/trdmxl_trc_rst.F90
r12377 r13727 144 144 145 145 DO jn = 1, jptra 146 CALL iom_get( inum, jpdom_auto glo, 'tmlbb_trc_' //ctrcnm(jn), tmlbb_trc (:,:,jn) )147 CALL iom_get( inum, jpdom_auto glo, 'tmlbn_trc_' //ctrcnm(jn), tmlbn_trc (:,:,jn) )148 CALL iom_get( inum, jpdom_auto glo, 'tmlatfb_trc_'//ctrcnm(jn), tmlatfb_trc(:,:,jn) )149 CALL iom_get( inum, jpdom_auto glo, 'tmlradb_trc_'//ctrcnm(jn), tmlradb_trc(:,:,jn) )146 CALL iom_get( inum, jpdom_auto, 'tmlbb_trc_' //ctrcnm(jn), tmlbb_trc (:,:,jn) ) 147 CALL iom_get( inum, jpdom_auto, 'tmlbn_trc_' //ctrcnm(jn), tmlbn_trc (:,:,jn) ) 148 CALL iom_get( inum, jpdom_auto, 'tmlatfb_trc_'//ctrcnm(jn), tmlatfb_trc(:,:,jn) ) 149 CALL iom_get( inum, jpdom_auto, 'tmlradb_trc_'//ctrcnm(jn), tmlradb_trc(:,:,jn) ) 150 150 END DO 151 151 152 152 ELSE 153 CALL iom_get( inum, jpdom_auto glo, 'rmldbn_trc', rmldbn_trc ) ! needed for rmld_sum153 CALL iom_get( inum, jpdom_auto, 'rmldbn_trc', rmldbn_trc ) ! needed for rmld_sum 154 154 155 155 ! ! =========== 156 156 DO jn = 1, jptra ! tracer loop 157 157 ! ! =========== 158 CALL iom_get( inum, jpdom_auto glo, 'tmlatfb_trc_' //ctrcnm(jn), tmlatfb_trc(:,:,jn) )159 CALL iom_get( inum, jpdom_auto glo, 'tmlbb_trc_' //ctrcnm(jn), tmlbb_trc (:,:,jn) )160 CALL iom_get( inum, jpdom_auto glo, 'tmlradb_trc_' //ctrcnm(jn), tmlradb_trc(:,:,jn) )161 162 CALL iom_get( inum, jpdom_auto glo, 'tmlbn_trc_' //ctrcnm(jn), tmlbn_trc (:,:,jn) ) ! needed for tml_sum163 CALL iom_get( inum, jpdom_auto glo, 'tml_sumb_trc_'//ctrcnm(jn), tml_sumb_trc(:,:,jn) )158 CALL iom_get( inum, jpdom_auto, 'tmlatfb_trc_' //ctrcnm(jn), tmlatfb_trc(:,:,jn) ) 159 CALL iom_get( inum, jpdom_auto, 'tmlbb_trc_' //ctrcnm(jn), tmlbb_trc (:,:,jn) ) 160 CALL iom_get( inum, jpdom_auto, 'tmlradb_trc_' //ctrcnm(jn), tmlradb_trc(:,:,jn) ) 161 162 CALL iom_get( inum, jpdom_auto, 'tmlbn_trc_' //ctrcnm(jn), tmlbn_trc (:,:,jn) ) ! needed for tml_sum 163 CALL iom_get( inum, jpdom_auto, 'tml_sumb_trc_'//ctrcnm(jn), tml_sumb_trc(:,:,jn) ) 164 164 165 165 DO jk = 1, jpltrd_trc … … 169 169 WRITE(charout,FMT="('tmltrd_csum_ub_trc_', A3, '_', I2)") ctrcnm(jn), jk 170 170 ENDIF 171 CALL iom_get( inum, jpdom_auto glo, charout, tmltrd_csum_ub_trc(:,:,jk,jn) )171 CALL iom_get( inum, jpdom_auto, charout, tmltrd_csum_ub_trc(:,:,jk,jn) ) 172 172 END DO 173 173 174 CALL iom_get( inum, jpdom_auto glo, 'tmltrd_atf_sumb_trc_'//ctrcnm(jn) , &174 CALL iom_get( inum, jpdom_auto, 'tmltrd_atf_sumb_trc_'//ctrcnm(jn) , & 175 175 & tmltrd_atf_sumb_trc(:,:,jn) ) 176 176 177 CALL iom_get( inum, jpdom_auto glo, 'tmltrd_rad_sumb_trc_'//ctrcnm(jn) , &177 CALL iom_get( inum, jpdom_auto, 'tmltrd_rad_sumb_trc_'//ctrcnm(jn) , & 178 178 & tmltrd_rad_sumb_trc(:,:,jn) ) 179 179 ! ! =========== -
NEMO/branches/2020/dev_12905_xios_restart/src/TOP/TRP/trdtrc.F90
r12377 r13727 18 18 USE trdmxl_trc ! Mixed layer trends diag. 19 19 USE iom ! I/O library 20 USE par_kind 20 21 21 22 IMPLICIT NONE … … 107 108 !!---------------------------------------------------------------------- 108 109 110 USE par_kind 111 109 112 PUBLIC trd_trc 110 113 … … 116 119 INTEGER , INTENT( in ) :: kjn ! tracer index 117 120 INTEGER , INTENT( in ) :: ktrd ! tracer trend index 118 REAL , DIMENSION(:,:,:), INTENT( inout ) :: ptrtrd ! Temperature or U trend121 REAL(wp), DIMENSION(:,:,:), INTENT( inout ) :: ptrtrd ! Temperature or U trend 119 122 WRITE(*,*) 'trd_trc : You should not have seen this print! error?', ptrtrd(1,1,1) 120 123 WRITE(*,*) ' " " : You should not have seen this print! error?', kjn
Note: See TracChangeset
for help on using the changeset viewer.
