- Timestamp:
- 2020-11-06T14:50:17+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE
- Files:
-
- 24 edited
-
BDY/bdyice.F90 (modified) (2 diffs)
-
DIA/diaptr.F90 (modified) (46 diffs)
-
DIU/diu_bulk.F90 (modified) (1 diff)
-
DOM/closea.F90 (modified) (1 diff)
-
DOM/daymod.F90 (modified) (1 diff)
-
DOM/dom_oce.F90 (modified) (1 diff)
-
DOM/domain.F90 (modified) (1 diff)
-
DYN/divhor.F90 (modified) (1 diff)
-
DYN/wet_dry.F90 (modified) (2 diffs)
-
FLO/flo_oce.F90 (modified) (1 diff)
-
ICB/icbtrj.F90 (modified) (1 diff)
-
IOM/iom.F90 (modified) (3 diffs)
-
IOM/iom_def.F90 (modified) (1 diff)
-
ISF/isf_oce.F90 (modified) (1 diff)
-
LBC/lib_mpp.F90 (modified) (7 diffs)
-
LDF/ldftra.F90 (modified) (2 diffs)
-
SBC/sbcfwb.F90 (modified) (1 diff)
-
ZDF/zdfdrg.F90 (modified) (1 diff)
-
ZDF/zdfgls.F90 (modified) (1 diff)
-
ZDF/zdfphy.F90 (modified) (1 diff)
-
ZDF/zdftke.F90 (modified) (1 diff)
-
nemogcm.F90 (modified) (3 diffs)
-
stpctl.F90 (modified) (5 diffs)
-
timing.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/BDY/bdyice.F90
r13553 r13741 61 61 !!---------------------------------------------------------------------- 62 62 ! controls 63 IF( ln_timing ) CALL timing_start('bdy_ice_thd') ! timing 64 IF( ln_icediachk ) CALL ice_cons_hsm(0,'bdy_ice_thd', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 65 IF( ln_icediachk ) CALL ice_cons2D (0,'bdy_ice_thd', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) ! conservation 63 IF( ln_timing ) CALL timing_start('bdy_ice_thd') ! timing 66 64 ! 67 65 CALL ice_var_glo2eqv … … 110 108 ! 111 109 ! controls 112 IF( ln_icectl ) CALL ice_prt ( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) ! prints 113 IF( ln_icediachk ) CALL ice_cons_hsm(1,'bdy_ice_thd', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 114 IF( ln_icediachk ) CALL ice_cons2D (1,'bdy_ice_thd', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) ! conservation 115 IF( ln_timing ) CALL timing_stop ('bdy_ice_thd') ! timing 110 IF( ln_icectl ) CALL ice_prt ( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) ! prints 111 IF( ln_timing ) CALL timing_stop ('bdy_ice_thd') ! timing 116 112 ! 117 113 END SUBROUTINE bdy_ice -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/DIA/diaptr.F90
r13552 r13741 42 42 END INTERFACE 43 43 44 PUBLIC ptr_sj ! call by tra_ldf & tra_adv routines45 PUBLIC ptr_sjk !46 PUBLIC dia_ptr_init ! call in memogcm47 44 PUBLIC dia_ptr ! call in step module 48 45 PUBLIC dia_ptr_hst ! called from tra_ldf/tra_adv routines 49 46 50 ! !!** namelist namptr **51 47 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hstr_adv, hstr_ldf, hstr_eiv !: Heat/Salt TRansports(adv, diff, Bolus.) 52 48 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hstr_ove, hstr_btr, hstr_vtr !: heat Salt TRansports(overturn, baro, merional) 53 49 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: pvtr_int, pzon_int !: Other zonal integrals 54 50 55 LOGICAL , PUBLIC :: l_diaptr !: tracers trend flag (set from namelist in trdini) 56 INTEGER, PARAMETER, PUBLIC :: nptr = 5 ! (glo, atl, pac, ind, ipc) 57 INTEGER, PARAMETER :: jp_msk = 3 58 INTEGER, PARAMETER :: jp_vtr = 4 51 LOGICAL, PUBLIC :: l_diaptr !: tracers trend flag 52 INTEGER, PARAMETER :: jp_msk = 3 53 INTEGER, PARAMETER :: jp_vtr = 4 59 54 60 55 REAL(wp) :: rc_sv = 1.e-6_wp ! conversion from m3/s to Sverdrup … … 65 60 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk34 ! mask out Southern Ocean (=0 south of 34°S) 66 61 67 LOGICAL :: ll_init = .TRUE. !: tracers trend flag (set from namelist in trdini)68 62 LOGICAL :: ll_init = .TRUE. !: tracers trend flag 63 69 64 !! * Substitutions 70 65 # include "do_loop_substitute.h90" … … 89 84 IF( ln_timing ) CALL timing_start('dia_ptr') 90 85 91 IF( kt == nit000 .AND. ll_init ) CALL dia_ptr_init 86 IF( kt == nit000 .AND. ll_init ) CALL dia_ptr_init ! -> will define l_diaptr and nbasin 92 87 ! 93 88 IF( l_diaptr ) THEN … … 123 118 ! 124 119 !overturning calculation 125 REAL(wp), DIMENSION(jpj,jpk,nptr) :: sjk, r1_sjk, v_msf ! i-mean i-k-surface and its inverse 126 REAL(wp), DIMENSION(jpj,jpk,nptr) :: zt_jk, zs_jk ! i-mean T and S, j-Stream-Function 127 128 REAL(wp), DIMENSION(jpi,jpj,jpk,nptr) :: z4d1, z4d2 129 REAL(wp), DIMENSION(jpi,jpj,nptr) :: z3dtr ! i-mean T and S, j-Stream-Function 130 !!---------------------------------------------------------------------- 131 120 REAL(wp), DIMENSION(:,:,: ), ALLOCATABLE :: sjk, r1_sjk, v_msf ! i-mean i-k-surface and its inverse 121 REAL(wp), DIMENSION(:,:,: ), ALLOCATABLE :: zt_jk, zs_jk ! i-mean T and S, j-Stream-Function 122 123 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: z4d1, z4d2 124 REAL(wp), DIMENSION(:,:,: ), ALLOCATABLE :: z3dtr 125 !!---------------------------------------------------------------------- 126 ! 127 ALLOCATE( z3dtr(jpi,jpj,nbasin) ) 128 ! 132 129 IF( PRESENT( pvtr ) ) THEN 133 130 IF( iom_use( 'zomsf' ) ) THEN ! effective MSF 134 DO jn = 1, nptr ! by sub-basins 131 ALLOCATE( z4d1(jpi,jpj,jpk,nbasin) ) 132 ! 133 DO jn = 1, nbasin ! by sub-basins 135 134 z4d1(1,:,:,jn) = pvtr_int(:,:,jp_vtr,jn) ! zonal cumulative effective transport excluding closed seas 136 135 DO jk = jpkm1, 1, -1 … … 142 141 END DO 143 142 CALL iom_put( 'zomsf', z4d1 * rc_sv ) 143 ! 144 DEALLOCATE( z4d1 ) 144 145 ENDIF 145 146 IF( iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) ) THEN 146 DO jn = 1, nptr 147 ALLOCATE( sjk(jpj,jpk,nbasin), r1_sjk(jpj,jpk,nbasin), v_msf(jpj,jpk,nbasin), & 148 & zt_jk(jpj,jpk,nbasin), zs_jk(jpj,jpk,nbasin) ) 149 ! 150 DO jn = 1, nbasin 147 151 sjk(:,:,jn) = pvtr_int(:,:,jp_msk,jn) 148 152 r1_sjk(:,:,jn) = 0._wp … … 156 160 ! 157 161 ENDDO 158 DO jn = 1, n ptr162 DO jn = 1, nbasin 159 163 z3dtr(1,:,jn) = hstr_ove(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 160 164 DO ji = 1, jpi … … 163 167 ENDDO 164 168 CALL iom_put( 'sophtove', z3dtr ) 165 DO jn = 1, n ptr169 DO jn = 1, nbasin 166 170 z3dtr(1,:,jn) = hstr_ove(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 167 171 DO ji = 1, jpi … … 170 174 ENDDO 171 175 CALL iom_put( 'sopstove', z3dtr ) 176 ! 177 DEALLOCATE( sjk, r1_sjk, v_msf, zt_jk, zs_jk ) 172 178 ENDIF 173 179 174 180 IF( iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) ) THEN 175 181 ! Calculate barotropic heat and salt transport here 176 DO jn = 1, nptr 182 ALLOCATE( sjk(jpj,1,nbasin), r1_sjk(jpj,1,nbasin) ) 183 ! 184 DO jn = 1, nbasin 177 185 sjk(:,1,jn) = SUM( pvtr_int(:,:,jp_msk,jn), 2 ) 178 186 r1_sjk(:,1,jn) = 0._wp … … 186 194 ! 187 195 ENDDO 188 DO jn = 1, n ptr196 DO jn = 1, nbasin 189 197 z3dtr(1,:,jn) = hstr_btr(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 198 ! TODO: Change these loop indices in the next commit 190 199 DO ji = 1, jpi 191 200 z3dtr(ji,:,jn) = z3dtr(1,:,jn) … … 193 202 ENDDO 194 203 CALL iom_put( 'sophtbtr', z3dtr ) 195 DO jn = 1, n ptr204 DO jn = 1, nbasin 196 205 z3dtr(1,:,jn) = hstr_btr(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 197 206 DO ji = 1, jpi … … 200 209 ENDDO 201 210 CALL iom_put( 'sopstbtr', z3dtr ) 202 ENDIF 211 ! 212 DEALLOCATE( sjk, r1_sjk ) 213 ENDIF 203 214 ! 204 215 hstr_ove(:,:,:) = 0._wp ! Zero before next timestep … … 207 218 ELSE 208 219 IF( iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. iom_use( 'zosrf' ) ) THEN ! i-mean i-k-surface 209 ! 210 DO jn = 1, nptr 220 ALLOCATE( z4d1(jpi,jpj,jpk,nbasin), z4d2(jpi,jpj,jpk,nbasin) ) 221 ! 222 DO jn = 1, nbasin 211 223 z4d1(1,:,:,jn) = pzon_int(:,:,jp_msk,jn) 212 224 DO ji = 2, jpi … … 216 228 CALL iom_put( 'zosrf', z4d1 ) 217 229 ! 218 DO jn = 1, n ptr230 DO jn = 1, nbasin 219 231 z4d2(1,:,:,jn) = pzon_int(:,:,jp_tem,jn) / MAX( z4d1(1,:,:,jn), 10.e-15 ) 220 232 DO ji = 2, jpi … … 224 236 CALL iom_put( 'zotem', z4d2 ) 225 237 ! 226 DO jn = 1, n ptr238 DO jn = 1, nbasin 227 239 z4d2(1,:,:,jn) = pzon_int(:,:,jp_sal,jn) / MAX( z4d1(1,:,:,jn), 10.e-15 ) 228 240 DO ji = 2, jpi … … 232 244 CALL iom_put( 'zosal', z4d2 ) 233 245 ! 246 DEALLOCATE( z4d1, z4d2 ) 234 247 ENDIF 235 248 ! … … 237 250 IF( iom_use( 'sophtadv' ) .OR. iom_use( 'sopstadv' ) ) THEN 238 251 ! 239 DO jn = 1, n ptr252 DO jn = 1, nbasin 240 253 z3dtr(1,:,jn) = hstr_adv(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 241 254 DO ji = 1, jpi … … 244 257 ENDDO 245 258 CALL iom_put( 'sophtadv', z3dtr ) 246 DO jn = 1, n ptr259 DO jn = 1, nbasin 247 260 z3dtr(1,:,jn) = hstr_adv(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 248 261 DO ji = 1, jpi … … 255 268 IF( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) THEN 256 269 ! 257 DO jn = 1, n ptr270 DO jn = 1, nbasin 258 271 z3dtr(1,:,jn) = hstr_ldf(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 259 272 DO ji = 1, jpi … … 262 275 ENDDO 263 276 CALL iom_put( 'sophtldf', z3dtr ) 264 DO jn = 1, n ptr277 DO jn = 1, nbasin 265 278 z3dtr(1,:,jn) = hstr_ldf(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 266 279 DO ji = 1, jpi … … 273 286 IF( iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) ) THEN 274 287 ! 275 DO jn = 1, n ptr288 DO jn = 1, nbasin 276 289 z3dtr(1,:,jn) = hstr_eiv(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 277 290 DO ji = 1, jpi … … 280 293 ENDDO 281 294 CALL iom_put( 'sophteiv', z3dtr ) 282 DO jn = 1, n ptr295 DO jn = 1, nbasin 283 296 z3dtr(1,:,jn) = hstr_eiv(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 284 297 DO ji = 1, jpi … … 290 303 ! 291 304 IF( iom_use( 'sopstvtr' ) .OR. iom_use( 'sophtvtr' ) ) THEN 292 DO jn = 1, n ptr305 DO jn = 1, nbasin 293 306 z3dtr(1,:,jn) = hstr_vtr(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 294 307 DO ji = 1, jpi … … 297 310 ENDDO 298 311 CALL iom_put( 'sophtvtr', z3dtr ) 299 DO jn = 1, n ptr312 DO jn = 1, nbasin 300 313 z3dtr(1,:,jn) = hstr_vtr(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 301 314 DO ji = 1, jpi … … 322 335 pzon_int(:,:,:,:) = 0._wp 323 336 ENDIF 337 ! 338 DEALLOCATE( z3dtr ) 339 ! 324 340 END SUBROUTINE dia_ptr_iom 325 341 … … 339 355 INTEGER , INTENT(in) :: Kmm ! time level index 340 356 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk), INTENT(in), OPTIONAL :: pvtr ! j-effective transport 341 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk):: zmask ! 3D workspace342 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk,jpts):: zts ! 4D workspace343 REAL(wp), DIMENSION( ST_1Dj(nn_hls),jpk,nptr):: sjk, v_msf ! Zonal sum: i-k surface area, j-effective transport344 REAL(wp), DIMENSION( ST_1Dj(nn_hls),jpk,nptr):: zt_jk, zs_jk ! Zonal sum: i-k surface area * (T, S)357 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zmask ! 3D workspace 358 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zts ! 4D workspace 359 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: sjk, v_msf ! Zonal sum: i-k surface area, j-effective transport 360 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt_jk, zs_jk ! Zonal sum: i-k surface area * (T, S) 345 361 REAL(wp) :: zsfc, zvfc ! i-k surface area 346 362 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 350 366 ! i sum of effective j transport excluding closed seas 351 367 IF( iom_use( 'zomsf' ) .OR. iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) ) THEN 352 DO jn = 1, nptr 368 ALLOCATE( v_msf(ST_1Dj(nn_hls),jpk,nbasin) ) 369 370 DO jn = 1, nbasin 353 371 v_msf(:,:,jn) = ptr_sjk( pvtr(:,:,:), btmsk34(:,:,jn) ) 354 372 ENDDO 355 373 356 374 CALL ptr_sum( pvtr_int(:,:,jp_vtr,:), v_msf(:,:,:) ) 375 376 DEALLOCATE( v_msf ) 357 377 ENDIF 358 378 … … 360 380 IF( iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR. & 361 381 & iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) ) THEN 382 ALLOCATE( zmask(ST_2D(nn_hls),jpk), zts(ST_2D(nn_hls),jpk,jpts), & 383 & sjk(ST_1Dj(nn_hls),jpk,nbasin), & 384 & zt_jk(ST_1Dj(nn_hls),jpk,nbasin), zs_jk(ST_1Dj(nn_hls),jpk,nbasin) ) 385 362 386 zmask(:,:,:) = 0._wp 363 387 zts(:,:,:,:) = 0._wp … … 370 394 END_3D 371 395 372 DO jn = 1, n ptr396 DO jn = 1, nbasin 373 397 sjk(:,:,jn) = ptr_sjk( zmask(:,:,:) , btmsk(:,:,jn) ) 374 398 zt_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) … … 379 403 CALL ptr_sum( pvtr_int(:,:,jp_tem,:), zt_jk(:,:,:) ) 380 404 CALL ptr_sum( pvtr_int(:,:,jp_sal,:), zs_jk(:,:,:) ) 405 406 DEALLOCATE( zmask, zts, sjk, zt_jk, zs_jk ) 381 407 ENDIF 382 408 ELSE 383 409 ! i sum of j surface area - temperature/salinity product on T grid 384 410 IF( iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. iom_use( 'zosrf' ) ) THEN 411 ALLOCATE( zmask(ST_2D(nn_hls),jpk), zts(ST_2D(nn_hls),jpk,jpts), & 412 & sjk(ST_1Dj(nn_hls),jpk,nbasin), & 413 & zt_jk(ST_1Dj(nn_hls),jpk,nbasin), zs_jk(ST_1Dj(nn_hls),jpk,nbasin) ) 414 385 415 zmask(:,:,:) = 0._wp 386 416 zts(:,:,:,:) = 0._wp … … 393 423 END_3D 394 424 395 DO jn = 1, n ptr425 DO jn = 1, nbasin 396 426 sjk(:,:,jn) = ptr_sjk( zmask(:,:,:) , btmsk(:,:,jn) ) 397 427 zt_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) … … 402 432 CALL ptr_sum( pzon_int(:,:,jp_tem,:), zt_jk(:,:,:) ) 403 433 CALL ptr_sum( pzon_int(:,:,jp_sal,:), zs_jk(:,:,:) ) 434 435 DEALLOCATE( zmask, zts, sjk, zt_jk, zs_jk ) 404 436 ENDIF 405 437 406 438 ! i-k sum of j surface area - temperature/salinity product on V grid 407 439 IF( iom_use( 'sopstvtr' ) .OR. iom_use( 'sophtvtr' ) ) THEN 440 ALLOCATE( zts(ST_2D(nn_hls),jpk,jpts) ) 441 408 442 zts(:,:,:,:) = 0._wp 409 443 … … 416 450 CALL dia_ptr_hst( jp_tem, 'vtr', zts(:,:,:,jp_tem) ) 417 451 CALL dia_ptr_hst( jp_sal, 'vtr', zts(:,:,:,jp_sal) ) 452 453 DEALLOCATE( zts ) 418 454 ENDIF 419 455 ENDIF … … 425 461 !! *** ROUTINE dia_ptr_init *** 426 462 !! 427 !! ** Purpose : Initialization , namelist read463 !! ** Purpose : Initialization 428 464 !!---------------------------------------------------------------------- 429 465 INTEGER :: inum, jn ! local integers … … 432 468 !!---------------------------------------------------------------------- 433 469 434 l_diaptr = .FALSE. 435 IF( iom_use( 'zomsf' ) .OR. iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. & 436 & iom_use( 'zosrf' ) .OR. iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR. & 437 & iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) .OR. iom_use( 'sophtadv' ) .OR. & 438 & iom_use( 'sopstadv' ) .OR. iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) .OR. & 439 & iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) .OR. iom_use( 'sopstvtr' ) .OR. & 440 & iom_use( 'sophtvtr' ) .OR. iom_use( 'uocetr_vsum_cumul' ) ) l_diaptr = .TRUE. 441 470 ! l_diaptr is defined with iom_use 471 ! --> dia_ptr_init must be done after the call to iom_init 472 ! --> cannot be .TRUE. without cpp key: key_iom --> nbasin define by iom_init is initialized 473 l_diaptr = iom_use( 'zomsf' ) .OR. iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. & 474 & iom_use( 'zosrf' ) .OR. iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR. & 475 & iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) .OR. iom_use( 'sophtadv' ) .OR. & 476 & iom_use( 'sopstadv' ) .OR. iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) .OR. & 477 & iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) .OR. iom_use( 'sopstvtr' ) .OR. & 478 & iom_use( 'sophtvtr' ) .OR. iom_use( 'uocetr_vsum_cumul' ) 442 479 443 480 IF(lwp) THEN ! Control print … … 445 482 WRITE(numout,*) 'dia_ptr_init : poleward transport and msf initialization' 446 483 WRITE(numout,*) '~~~~~~~~~~~~' 447 WRITE(numout,*) ' Namelist namptr : set ptr parameters'448 484 WRITE(numout,*) ' Poleward heat & salt transport (T) or not (F) l_diaptr = ', l_diaptr 449 485 ENDIF … … 452 488 ! 453 489 IF( dia_ptr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ptr_init : unable to allocate arrays' ) 454 490 ! 455 491 rc_pwatt = rc_pwatt * rho0_rcp ! conversion from K.s-1 to PetaWatt 456 492 rc_ggram = rc_ggram * rho0 ! conversion from m3/s to Gg/s … … 458 494 IF( lk_mpp ) CALL mpp_ini_znl( numout ) ! Define MPI communicator for zonal sum 459 495 460 btmsk(:,:,:) = 0._wp 461 btmsk(:,:,1) = tmask_i(:,:) 462 CALL iom_open( 'subbasins', inum, ldstop = .FALSE. ) 463 CALL iom_get( inum, jpdom_global, 'atlmsk', btmsk(:,:,2) ) ! Atlantic basin 464 CALL iom_get( inum, jpdom_global, 'pacmsk', btmsk(:,:,3) ) ! Pacific basin 465 CALL iom_get( inum, jpdom_global, 'indmsk', btmsk(:,:,4) ) ! Indian basin 466 CALL iom_close( inum ) 467 btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) ) ! Indo-Pacific basin 468 DO jn = 2, nptr 469 btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:) ! interior domain only 496 btmsk(:,:,1) = tmask_i(:,:) 497 IF( nbasin == 5 ) THEN ! nbasin has been initialized in iom_init to define the axis "basin" 498 CALL iom_open( 'subbasins', inum ) 499 CALL iom_get( inum, jpdom_global, 'atlmsk', btmsk(:,:,2) ) ! Atlantic basin 500 CALL iom_get( inum, jpdom_global, 'pacmsk', btmsk(:,:,3) ) ! Pacific basin 501 CALL iom_get( inum, jpdom_global, 'indmsk', btmsk(:,:,4) ) ! Indian basin 502 CALL iom_close( inum ) 503 btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) ) ! Indo-Pacific basin 504 ENDIF 505 DO jn = 2, nbasin 506 btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:) ! interior domain only 470 507 END DO 471 508 ! JD : modification so that overturning streamfunction is available in Atlantic at 34S to compare with observations … … 476 513 END WHERE 477 514 btmsk34(:,:,1) = btmsk(:,:,1) 478 DO jn = 2, n ptr479 btmsk34(:,:,jn) = btmsk(:,:,jn) * zmsk(:,:) ! interior domain only515 DO jn = 2, nbasin 516 btmsk34(:,:,jn) = btmsk(:,:,jn) * zmsk(:,:) ! interior domain only 480 517 ENDDO 481 518 … … 508 545 CHARACTER(len=3) , INTENT(in) :: cptr ! transport type 'adv'/'ldf'/'eiv' 509 546 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) , INTENT(in) :: pvflx ! 3D input array of advection/diffusion 510 REAL(wp), DIMENSION(ST_1Dj(nn_hls),n ptr) :: zsj !547 REAL(wp), DIMENSION(ST_1Dj(nn_hls),nbasin) :: zsj ! 511 548 INTEGER :: jn ! 512 549 513 DO jn = 1, n ptr550 DO jn = 1, nbasin 514 551 zsj(:,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 515 552 ENDDO … … 536 573 !! *** ROUTINE ptr_sum_2d *** 537 574 !!---------------------------------------------------------------------- 538 !! ** Purpose : Add two 2D arrays with (j,n ptr) dimensions575 !! ** Purpose : Add two 2D arrays with (j,nbasin) dimensions 539 576 !! 540 577 !! ** Method : - phstr = phstr + pva … … 543 580 !! ** Action : phstr 544 581 !!---------------------------------------------------------------------- 545 REAL(wp), DIMENSION(jpj,n ptr) , INTENT(inout) :: phstr !546 REAL(wp), DIMENSION(ST_1Dj(nn_hls),n ptr), INTENT(in) :: pva !582 REAL(wp), DIMENSION(jpj,nbasin) , INTENT(inout) :: phstr ! 583 REAL(wp), DIMENSION(ST_1Dj(nn_hls),nbasin), INTENT(in) :: pva ! 547 584 INTEGER :: jj 548 585 #if defined key_mpp_mpi 549 INTEGER, DIMENSION(1) :: ish1d550 INTEGER, DIMENSION(2) :: ish2d551 REAL(wp), DIMENSION(jpj*n ptr):: zwork586 INTEGER, DIMENSION(1) :: ish1d 587 INTEGER, DIMENSION(2) :: ish2d 588 REAL(wp), DIMENSION(jpj*nbasin) :: zwork 552 589 #endif 553 590 … … 558 595 #if defined key_mpp_mpi 559 596 IF( ntile == 0 .OR. ntile == nijtile ) THEN 560 ish1d(1) = jpj*n ptr561 ish2d(1) = jpj ; ish2d(2) = n ptr597 ish1d(1) = jpj*nbasin 598 ish2d(1) = jpj ; ish2d(2) = nbasin 562 599 zwork(:) = RESHAPE( phstr(:,:), ish1d ) 563 600 CALL mpp_sum( 'diaptr', zwork, ish1d(1), ncomm_znl ) … … 572 609 !! *** ROUTINE ptr_sum_3d *** 573 610 !!---------------------------------------------------------------------- 574 !! ** Purpose : Add two 3D arrays with (j,k,n ptr) dimensions611 !! ** Purpose : Add two 3D arrays with (j,k,nbasin) dimensions 575 612 !! 576 613 !! ** Method : - phstr = phstr + pva … … 579 616 !! ** Action : phstr 580 617 !!---------------------------------------------------------------------- 581 REAL(wp), DIMENSION(jpj,jpk,n ptr) , INTENT(inout) :: phstr !582 REAL(wp), DIMENSION(ST_1Dj(nn_hls),jpk,n ptr), INTENT(in) :: pva !618 REAL(wp), DIMENSION(jpj,jpk,nbasin) , INTENT(inout) :: phstr ! 619 REAL(wp), DIMENSION(ST_1Dj(nn_hls),jpk,nbasin), INTENT(in) :: pva ! 583 620 INTEGER :: jj, jk 584 621 #if defined key_mpp_mpi 585 622 INTEGER, DIMENSION(1) :: ish1d 586 623 INTEGER, DIMENSION(3) :: ish3d 587 REAL(wp), DIMENSION(jpj*jpk*n ptr) :: zwork624 REAL(wp), DIMENSION(jpj*jpk*nbasin) :: zwork 588 625 #endif 589 626 … … 596 633 #if defined key_mpp_mpi 597 634 IF( ntile == 0 .OR. ntile == nijtile ) THEN 598 ish1d(1) = jpj*jpk*n ptr599 ish3d(1) = jpj ; ish3d(2) = jpk ; ish3d(3) = n ptr635 ish1d(1) = jpj*jpk*nbasin 636 ish3d(1) = jpj ; ish3d(2) = jpk ; ish3d(3) = nbasin 600 637 zwork(:) = RESHAPE( phstr(:,:,:), ish1d ) 601 638 CALL mpp_sum( 'diaptr', zwork, ish1d(1), ncomm_znl ) … … 615 652 ierr(:) = 0 616 653 ! 654 ! nbasin has been initialized in iom_init to define the axis "basin" 655 ! 617 656 IF( .NOT. ALLOCATED( btmsk ) ) THEN 618 ALLOCATE( btmsk(jpi,jpj,n ptr) , btmsk34(jpi,jpj,nptr), &619 & hstr_adv(jpj,jpts,n ptr), hstr_eiv(jpj,jpts,nptr), &620 & hstr_ove(jpj,jpts,n ptr), hstr_btr(jpj,jpts,nptr), &621 & hstr_ldf(jpj,jpts,n ptr), hstr_vtr(jpj,jpts,nptr), STAT=ierr(1) )622 ! 623 ALLOCATE( pvtr_int(jpj,jpk,jpts+2,n ptr), &624 & pzon_int(jpj,jpk,jpts+1,n ptr), STAT=ierr(2) )657 ALLOCATE( btmsk(jpi,jpj,nbasin) , btmsk34(jpi,jpj,nbasin), & 658 & hstr_adv(jpj,jpts,nbasin), hstr_eiv(jpj,jpts,nbasin), & 659 & hstr_ove(jpj,jpts,nbasin), hstr_btr(jpj,jpts,nbasin), & 660 & hstr_ldf(jpj,jpts,nbasin), hstr_vtr(jpj,jpts,nbasin), STAT=ierr(1) ) 661 ! 662 ALLOCATE( pvtr_int(jpj,jpk,jpts+2,nbasin), & 663 & pzon_int(jpj,jpk,jpts+1,nbasin), STAT=ierr(2) ) 625 664 ! 626 665 dia_ptr_alloc = MAXVAL( ierr ) -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/DIU/diu_bulk.F90
r13295 r13741 22 22 23 23 ! Namelist parameters 24 LOGICAL, PUBLIC :: ln_diurnal 25 LOGICAL, PUBLIC :: ln_diurnal_only 24 LOGICAL, PUBLIC :: ln_diurnal = .false. ! force definition if diurnal_sst_bulk_init is not called 25 LOGICAL, PUBLIC :: ln_diurnal_only = .false. ! force definition if diurnal_sst_bulk_init is not called 26 26 27 27 ! Parameters -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/DOM/closea.F90
r13286 r13741 38 38 LOGICAL, PUBLIC :: ln_clo_rnf !: closed sea treated as runoff (update rnf mask) 39 39 40 LOGICAL, PUBLIC :: l_sbc_clo !: T => net evap/precip over closed seas spread outover the globe/river mouth 41 LOGICAL, PUBLIC :: l_clo_rnf !: T => Some closed seas output freshwater (RNF) to specified runoff points. 42 43 INTEGER, PUBLIC :: ncsg !: number of closed seas global mappings (inferred from closea_mask_glo field) 44 INTEGER, PUBLIC :: ncsr !: number of closed seas rnf mappings (inferred from closea_mask_rnf field) 45 INTEGER, PUBLIC :: ncse !: number of closed seas empmr mappings (inferred from closea_mask_emp field) 40 ! WARNING: keep default definitions in the following lines as dom_clo is called only if ln_closea = .true. 41 LOGICAL, PUBLIC :: l_sbc_clo = .FALSE. !: T => net evap/precip over closed seas spread outover the globe/river mouth 42 LOGICAL, PUBLIC :: l_clo_rnf = .FALSE. !: T => Some closed seas output freshwater (RNF) to specified runoff points. 43 44 INTEGER, PUBLIC :: ncsg = 0 !: number of closed seas global mappings (inferred from closea_mask_glo field) 45 INTEGER, PUBLIC :: ncsr = 0 !: number of closed seas rnf mappings (inferred from closea_mask_rnf field) 46 INTEGER, PUBLIC :: ncse = 0 !: number of closed seas empmr mappings (inferred from closea_mask_emp field) 46 47 47 48 INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_opnsea, mask_csundef !: mask defining the open sea and the undefined closed sea -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/DOM/daymod.F90
r13286 r13741 82 82 ndt05 = NINT( 0.5 * rn_Dt ) 83 83 84 IF( .NOT. l_offline ) CALL day_rst( nit000, 'READ' ) 85 84 lrst_oce = .NOT. l_offline ! force definition of offline 85 IF( lrst_oce ) CALL day_rst( nit000, 'READ' ) 86 86 87 ! set the calandar from ndastp (read in restart file and namelist) 87 88 nyear = ndastp / 10000 -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/DOM/dom_oce.F90
r13514 r13741 230 230 231 231 !!---------------------------------------------------------------------- 232 !! variable defined here to avoid circular dependencies... 233 !! --------------------------------------------------------------------- 234 INTEGER, PUBLIC :: nbasin ! number of basin to be considered in diaprt (glo, atl, pac, ind, ipc) 235 236 !!---------------------------------------------------------------------- 232 237 !! agrif domain 233 238 !!---------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/DOM/domain.F90
r13553 r13741 121 121 WRITE(numout,*) ' cn_cfg = ', TRIM( cn_cfg ), ' nn_cfg = ', nn_cfg 122 122 ENDIF 123 nn_wxios = 0124 ln_xios_read = .FALSE.125 123 ! 126 124 ! !== Reference coordinate system ==! -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/DYN/divhor.F90
r13553 r13741 78 78 ! 79 79 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== Horizontal divergence ==! 80 hdiv(ji,jj,jk) = ( e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) * uu(ji ,jj,jk,Kmm) &80 hdiv(ji,jj,jk) = ( e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) * uu(ji ,jj,jk,Kmm) & 81 81 & - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * uu(ji-1,jj,jk,Kmm) & 82 82 & + e1v(ji,jj ) * e3v(ji,jj ,jk,Kmm) * vv(ji,jj ,jk,Kmm) & -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/DYN/wet_dry.F90
r13553 r13741 57 57 REAL(wp), PUBLIC :: ssh_ref !: height of z=0 with respect to the geoid; 58 58 59 LOGICAL, PUBLIC :: ll_wd !: Wetting/drying activation switch if either ln_wd_il or ln_wd_dl59 LOGICAL, PUBLIC :: ll_wd = .FALSE. !: Wetting/drying activation switch (ln_wd_il or ln_wd_dl) <- default def if wad_init not called 60 60 61 61 PUBLIC wad_init ! initialisation routine called by step.F90 … … 111 111 112 112 r_rn_wdmin1 = 1 / rn_wdmin1 113 ll_wd = .FALSE.114 113 IF( ln_wd_il .OR. ln_wd_dl ) THEN 115 114 ll_wd = .TRUE. -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/FLO/flo_oce.F90
r11536 r13741 19 19 !! ---------------- 20 20 LOGICAL, PUBLIC :: ln_floats !: Activate floats or not 21 INTEGER, PUBLIC :: jpnfl 21 INTEGER, PUBLIC :: jpnfl = 0 !: total number of floats during the run 22 22 INTEGER, PUBLIC :: jpnnewflo !: number of floats added in a new run 23 23 INTEGER, PUBLIC :: jpnrstflo !: number of floats for the restart -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/ICB/icbtrj.F90
r13062 r13741 35 35 PUBLIC icb_trj_end ! routine called in icbstp.F90 module 36 36 37 INTEGER :: num_traj 37 INTEGER :: num_traj = 0 38 38 INTEGER :: n_dim, m_dim 39 39 INTEGER :: ntrajid -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/IOM/iom.F90
r13553 r13741 123 123 REAL(wp), DIMENSION(2,jpkam1) :: za_bnds ! ABL vertical boundaries 124 124 LOGICAL :: ll_closedef = .TRUE. 125 LOGICAL :: ll_exist 125 126 !!---------------------------------------------------------------------- 126 127 ! … … 230 231 CALL iom_set_axis_attr( "ghw_abl", bounds=za_bnds ) 231 232 232 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,jpnfl) /) )233 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,jpnfl) /) ) 233 234 # if defined key_si3 234 235 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) … … 243 244 CALL iom_set_axis_attr( "iax_26C", (/ REAL(26,wp) /) ) ! strange syntaxe and idea... 244 245 CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) ) ! strange syntaxe and idea... 245 CALL iom_set_axis_attr( "basin" , (/ (REAL(ji,wp), ji=1,5) /) ) 246 ! for diaprt, we need to define an axis which size can be 1 (default) or 5 (if the file subbasins.nc exists) 247 INQUIRE( FILE = 'subbasins.nc', EXIST = ll_exist ) 248 nbasin = 1 + 4 * COUNT( (/ll_exist/) ) 249 CALL iom_set_axis_attr( "basin" , (/ (REAL(ji,wp), ji=1,nbasin) /) ) 246 250 ENDIF 247 251 ! -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/IOM/iom_def.F90
r13286 r13741 33 33 INTEGER, PUBLIC :: iom_open_init = 0 !: used to initialize iom_file(:)%nfid to 0 34 34 !XIOS write restart 35 LOGICAL, PUBLIC :: lwxios 36 INTEGER, PUBLIC :: nxioso !: type of restart file when writing using XIOS 1 - single, 2 - multiple35 LOGICAL, PUBLIC :: lwxios = .FALSE. !: write single file restart using XIOS 36 INTEGER, PUBLIC :: nxioso = 0 !: type of restart file when writing using XIOS 1 - single, 2 - multiple 37 37 !XIOS read restart 38 LOGICAL, PUBLIC :: lrxios 38 LOGICAL, PUBLIC :: lrxios = .FALSE. !: read single file restart using XIOS 39 39 LOGICAL, PUBLIC :: lxios_sini = .FALSE. ! is restart in a single file 40 40 LOGICAL, PUBLIC :: lxios_set = .FALSE. -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/ISF/isf_oce.F90
r12077 r13741 74 74 ! 75 75 ! 2.1 -------- ice shelf cavity parameter -------------- 76 LOGICAL , PUBLIC :: l_isfoasis 76 LOGICAL , PUBLIC :: l_isfoasis = .FALSE. 77 77 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: risfload !: ice shelf load 78 78 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fwfisf_oasis -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/LBC/lib_mpp.F90
r13553 r13741 511 511 ALLOCATE(todelay(idvar)%y1d(isz)) 512 512 todelay(idvar)%y1d(:) = CMPLX(todelay(idvar)%z1d(:), 0., wp) ! create %y1d, complex variable needed by mpi_sumdd 513 ndelayid(idvar) = MPI_REQUEST_NULL ! initialised request to a valid value 513 514 END IF 514 515 ENDIF … … 518 519 ALLOCATE(todelay(idvar)%z1d(isz), todelay(idvar)%y1d(isz)) ! allocate also %z1d as used for the restart 519 520 CALL mpi_allreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ierr ) ! get %y1d 520 todelay(idvar)%z1d(:) = REAL(todelay(idvar)%y1d(:), wp) ! define %z1d from %y1d521 ENDIF 522 523 IF( ndelayid(idvar) > 0 )CALL mpp_delay_rcv( idvar ) ! make sure %z1d is received521 ndelayid(idvar) = MPI_REQUEST_NULL 522 ENDIF 523 524 CALL mpp_delay_rcv( idvar ) ! make sure %z1d is received 524 525 525 526 ! send back pout from todelay(idvar)%z1d defined at previous call … … 530 531 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 531 532 CALL mpi_allreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ierr ) 532 ndelayid(idvar) = 1533 ndelayid(idvar) = MPI_REQUEST_NULL 533 534 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 534 535 # else … … 591 592 DEALLOCATE(todelay(idvar)%z1d) 592 593 ndelayid(idvar) = -1 ! do as if we had no restart 594 ELSE 595 ndelayid(idvar) = MPI_REQUEST_NULL 593 596 END IF 594 597 ENDIF … … 598 601 ALLOCATE(todelay(idvar)%z1d(isz)) 599 602 CALL mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ierr ) ! get %z1d 600 ENDIF 601 602 IF( ndelayid(idvar) > 0 ) CALL mpp_delay_rcv( idvar ) ! make sure %z1d is received 603 ndelayid(idvar) = MPI_REQUEST_NULL 604 ENDIF 605 606 CALL mpp_delay_rcv( idvar ) ! make sure %z1d is received 603 607 604 608 ! send back pout from todelay(idvar)%z1d defined at previous call … … 606 610 607 611 ! send p_in into todelay(idvar)%z1d with a non-blocking communication 612 ! (PM) Should we get rid of MPI2 option ? MPI3 was release in 2013. Who is still using MPI2 ? 608 613 # if defined key_mpi2 609 614 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 610 CALL mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_TYPE, mpi_max, ilocalcomm, ndelayid(idvar),ierr )615 CALL mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_TYPE, mpi_max, ilocalcomm, ierr ) 611 616 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 612 617 # else … … 631 636 !!---------------------------------------------------------------------- 632 637 #if defined key_mpp_mpi 633 IF( ndelayid(kid) /= -2 ) THEN 634 #if ! defined key_mpi2 635 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 636 CALL mpi_wait( ndelayid(kid), MPI_STATUS_IGNORE, ierr ) ! make sure todelay(kid) is received 637 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 638 #endif 639 IF( ASSOCIATED(todelay(kid)%y1d) ) todelay(kid)%z1d(:) = REAL(todelay(kid)%y1d(:), wp) ! define %z1d from %y1d 640 ndelayid(kid) = -2 ! add flag to know that mpi_wait was already called on kid 641 ENDIF 638 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 639 ! test on ndelayid(kid) useless as mpi_wait return immediatly if the request handle is MPI_REQUEST_NULL 640 CALL mpi_wait( ndelayid(kid), MPI_STATUS_IGNORE, ierr ) ! after this ndelayid(kid) = MPI_REQUEST_NULL 641 IF( ln_timing ) CALL tic_tac( .FALSE., ld_global = .TRUE.) 642 IF( ASSOCIATED(todelay(kid)%y1d) ) todelay(kid)%z1d(:) = REAL(todelay(kid)%y1d(:), wp) ! define %z1d from %y1d 642 643 #endif 643 644 END SUBROUTINE mpp_delay_rcv -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/LDF/ldftra.F90
r13553 r13741 246 246 ENDIF 247 247 ! 248 IF( ln_ldfeiv .AND. .NOT.( ln_traldf_iso .OR. ln_traldf_triad ) ) & 249 & CALL ctl_stop( 'ln_ldfeiv=T requires iso-neutral laplacian diffusion' ) 250 IF( ln_isfcav .AND. ln_traldf_triad ) & 251 & CALL ctl_stop( ' ice shelf cavity and traldf_triad not tested' ) 248 IF( ln_isfcav .AND. ln_traldf_triad ) CALL ctl_stop( ' ice shelf cavity and traldf_triad not tested' ) 252 249 ! 253 250 IF( nldf_tra == np_lap_i .OR. nldf_tra == np_lap_it .OR. & … … 541 538 IF( ln_traldf_blp ) CALL ctl_stop( 'ldf_eiv_init: eddy induced velocity ONLY with laplacian diffusivity' ) 542 539 ! 540 IF( .NOT.( ln_traldf_iso .OR. ln_traldf_triad ) ) & 541 & CALL ctl_stop( 'ln_ldfeiv=T requires iso-neutral laplacian diffusion' ) 543 542 ! != allocate the aei arrays 544 543 ALLOCATE( aeiu(jpi,jpj,jpk), aeiv(jpi,jpj,jpk), STAT=ierr ) -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/SBC/sbcfwb.F90
r13286 r13741 94 94 snwice_mass_b(:,:) = 0.e0 ! no sea-ice model is being used : no snow+ice mass 95 95 snwice_mass (:,:) = 0.e0 96 snwice_fmass (:,:) = 0.e0 96 97 #endif 97 98 ! -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/ZDF/zdfdrg.F90
r13553 r13741 383 383 IF(ll_bot) zmsk_boost(:,:) = zmsk_boost(:,:) * ssmask(:,:) ! x seafloor mask 384 384 ! 385 l_log_not_linssh = .FALSE. ! default definition 385 386 ! 386 387 SELECT CASE( ndrg ) -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/ZDF/zdfgls.F90
r13553 r13741 815 815 WRITE(numout,*) ' Ice-ocean roughness (used if nn_z0_ice/=0) rn_hsri = ', rn_hsri 816 816 WRITE(numout,*) 817 WRITE(numout,*) ' Namelist namdrg_top/_bot: used values:'818 WRITE(numout,*) ' top ocean cavity roughness (m) rn_z0(_top) = ', r_z0_top819 WRITE(numout,*) ' Bottom seafloor roughness (m) rn_z0(_bot) = ', r_z0_bot820 WRITE(numout,*)821 817 ENDIF 822 818 -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/ZDF/zdfphy.F90
r13553 r13741 337 337 ! 338 338 END SUBROUTINE zdf_phy 339 340 339 341 INTEGER FUNCTION zdf_phy_alloc() 340 342 !!---------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/ZDF/zdftke.F90
r13553 r13741 678 678 CALL ctl_stop( 'zdf_tke_init: wrong value for nn_eice, should be 0,1,2, or 3') 679 679 END SELECT 680 IF( .NOT.ln_drg_OFF ) THEN681 WRITE(numout,*)682 WRITE(numout,*) ' Namelist namdrg_top/_bot: used values:'683 WRITE(numout,*) ' top ocean cavity roughness (m) rn_z0(_top)= ', r_z0_top684 WRITE(numout,*) ' Bottom seafloor roughness (m) rn_z0(_bot)= ', r_z0_bot685 ENDIF686 680 WRITE(numout,*) 687 681 WRITE(numout,*) ' ==>>> critical Richardson nb with your parameters ri_cri = ', ri_cri -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/nemogcm.F90
r13286 r13741 54 54 USE asminc ! assimilation increments 55 55 USE asmbkg ! writing out state trajectory 56 USE diaptr ! poleward transports (dia_ptr_init routine)57 56 USE diadct ! sections transports (dia_dct_init routine) 58 57 USE diaobs ! Observation diagnostics (dia_obs_init routine) … … 472 471 ! ! Lateral physics 473 472 CALL ldf_tra_init ! Lateral ocean tracer physics 474 CALL ldf_eiv_init ! eddy induced velocity param. 473 CALL ldf_eiv_init ! eddy induced velocity param. must be done after ldf_tra_init 475 474 CALL ldf_dyn_init ! Lateral ocean momentum physics 476 475 … … 510 509 CALL flo_init( Nnn ) ! drifting Floats 511 510 IF( ln_diacfl ) CALL dia_cfl_init ! Initialise CFL diagnostics 512 ! CALL dia_ptr_init ! Poleward TRansports initialization513 511 CALL dia_dct_init ! Sections tranports 514 512 CALL dia_hsb_init( Nnn ) ! heat content, salt content and volume budgets -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/stpctl.F90
r13553 r13741 67 67 REAL(wp) :: zzz ! local real 68 68 REAL(wp), DIMENSION(9) :: zmax, zmaxlocal 69 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns 69 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns, ll_0oce 70 70 LOGICAL, DIMENSION(jpi,jpj,jpk) :: llmsk 71 71 CHARACTER(len=20) :: clname … … 125 125 ! 126 126 llmsk(Nis0:Nie0,Njs0:Nje0,1) = ssmask(Nis0:Nie0,Njs0:Nje0) == 1._wp ! define only the inner domain 127 ! 128 ll_0oce = .NOT. ANY( llmsk(:,:,1) ) ! no ocean point in the inner domain? 129 ! 127 130 IF( ll_wd ) THEN 128 131 zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) + ssh_ref ), mask = llmsk(:,:,1) ) ! ssh max … … 149 152 ENDIF 150 153 zmax(9) = REAL( nstop, wp ) ! stop indicator 154 ! 151 155 ! !== get global extrema ==! 152 156 ! !== done by all processes if writting run.stat ==! 153 157 IF( ll_colruns ) THEN 154 158 zmaxlocal(:) = zmax(:) 155 CALL mpp_max( "stpctl", zmax ) ! max over the global domain 159 CALL mpp_max( "stpctl", zmax ) ! max over the global domain: ok even of ll_0oce = .true. 156 160 nstop = NINT( zmax(9) ) ! update nstop indicator (now sheared among all local domains) 157 ENDIF 161 ELSE 162 ! if no ocean point: MAXVAL returns -HUGE => we must overwrite this value to avoid error handling bellow. 163 IF( ll_0oce ) zmax(1:4) = (/ 0._wp, 0._wp, -1._wp, 1._wp /) ! default "valid" values... 164 ENDIF 165 ! 166 zmax(3) = -zmax(3) ! move back from max(-zz) to min(zz) : easier to manage! 167 zmax(5) = -zmax(5) ! move back from max(-zz) to min(zz) : easier to manage! 168 IF( ll_colruns ) THEN 169 zmaxlocal(3) = -zmaxlocal(3) ! move back from max(-zz) to min(zz) : easier to manage! 170 zmaxlocal(5) = -zmaxlocal(5) ! move back from max(-zz) to min(zz) : easier to manage! 171 ENDIF 172 ! 158 173 ! !== write "run.stat" files ==! 159 174 ! !== done only by 1st subdomain at writting timestep ==! 160 175 IF( ll_wrtruns ) THEN 161 WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3), zmax(4) 162 istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ zmax(1)/), (/kt/), (/1/) ) 163 istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/ zmax(2)/), (/kt/), (/1/) ) 164 istatus = NF90_PUT_VAR( nrunid, nvarid(3), (/-zmax(3)/), (/kt/), (/1/) ) 165 istatus = NF90_PUT_VAR( nrunid, nvarid(4), (/ zmax(4)/), (/kt/), (/1/) ) 166 istatus = NF90_PUT_VAR( nrunid, nvarid(5), (/-zmax(5)/), (/kt/), (/1/) ) 167 istatus = NF90_PUT_VAR( nrunid, nvarid(6), (/ zmax(6)/), (/kt/), (/1/) ) 168 IF( ln_zad_Aimp ) THEN 169 istatus = NF90_PUT_VAR( nrunid, nvarid(7), (/ zmax(7)/), (/kt/), (/1/) ) 170 istatus = NF90_PUT_VAR( nrunid, nvarid(8), (/ zmax(8)/), (/kt/), (/1/) ) 171 ENDIF 176 WRITE(numrun,9500) kt, zmax(1), zmax(2), zmax(3), zmax(4) 177 DO ji = 1, 6 + 2 * COUNT( (/ln_zad_Aimp/) ) 178 istatus = NF90_PUT_VAR( nrunid, nvarid(ji), (/zmax(ji)/), (/kt/), (/1/) ) 179 END DO 172 180 IF( kt == nitend ) istatus = NF90_CLOSE(nrunid) 173 181 END IF … … 175 183 ! !== done by all processes at every time step ==! 176 184 ! 177 IF( 178 & 179 & zmax(3) >= 0._wp .OR. & ! negative or zero sea surface salinity180 & 181 & 182 & 183 & 185 IF( zmax(1) > 20._wp .OR. & ! too large sea surface height ( > 20 m ) 186 & zmax(2) > 10._wp .OR. & ! too large velocity ( > 10 m/s) 187 & zmax(3) <= 0._wp .OR. & ! negative or zero sea surface salinity 188 & zmax(4) >= 100._wp .OR. & ! too large sea surface salinity ( > 100 ) 189 & zmax(4) < 0._wp .OR. & ! too large sea surface salinity (keep this line for sea-ice) 190 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR. & ! NaN encounter in the tests 191 & ABS( zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN ! Infinity encounter in the tests 184 192 ! 185 193 iloc(:,:) = 0 … … 221 229 ! 222 230 WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m or |U| > 10 m/s or S <= 0 or S >= 100 or NaN encounter in the tests' 223 CALL wrt_line( ctmp2, kt, '|ssh| max', 224 CALL wrt_line( ctmp3, kt, '|U| max', 225 CALL wrt_line( ctmp4, kt, 'Sal min', -zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) )226 CALL wrt_line( ctmp5, kt, 'Sal max', 231 CALL wrt_line( ctmp2, kt, '|ssh| max', zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 232 CALL wrt_line( ctmp3, kt, '|U| max', zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 233 CALL wrt_line( ctmp4, kt, 'Sal min', zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) ) 234 CALL wrt_line( ctmp5, kt, 'Sal max', zmax(4), iloc(:,4), iareasum(4), iareamin(4), iareamax(4) ) 227 235 IF( Agrif_Root() ) THEN 228 236 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort* files' -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/timing.F90
r13553 r13741 424 424 s_timer => s_timer_root 425 425 DO WHILE ( ASSOCIATED( s_timer%next ) ) 426 IF (.NOT. ASSOCIATED(s_timer%next)) EXIT426 IF (.NOT. ASSOCIATED(s_timer%next)) EXIT 427 427 IF ( s_timer%tsum_clock < s_timer%next%tsum_clock ) THEN 428 428 ALLOCATE(s_wrk) … … 432 432 ll_ord = .FALSE. 433 433 CYCLE 434 ENDIF 435 IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next436 END DO 434 ENDIF 435 IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next 436 END DO 437 437 IF( ll_ord ) EXIT 438 438 END DO … … 447 447 clfmt = '(1x,a,4x,f12.3,6x,f12.3,x,f12.3,2x,f12.3,6x,f7.3,2x,i9)' 448 448 DO WHILE ( ASSOCIATED(s_timer) ) 449 WRITE(numtime,TRIM(clfmt)) s_timer%cname, & 450 & s_timer%tsum_clock,s_timer%tsum_clock*100./t_elaps(2), & 451 & s_timer%tsum_cpu ,s_timer%tsum_cpu*100./t_cpu(2) , & 452 & s_timer%tsum_cpu/s_timer%tsum_clock, s_timer%niter 449 IF( s_timer%tsum_clock > 0._wp ) & 450 WRITE(numtime,TRIM(clfmt)) s_timer%cname, & 451 & s_timer%tsum_clock,s_timer%tsum_clock*100./t_elaps(2), & 452 & s_timer%tsum_cpu ,s_timer%tsum_cpu*100./t_cpu(2) , & 453 & s_timer%tsum_cpu/s_timer%tsum_clock, s_timer%niter 453 454 s_timer => s_timer%next 454 455 END DO … … 613 614 clfmt = '((A),E15.7,2x,f6.2,5x,f12.2,5x,f6.2,5x,f7.2,2x,f12.2,4x,f6.2,2x,f9.2)' 614 615 DO WHILE ( ASSOCIATED(sl_timer_ave) ) 615 WRITE(numtime,TRIM(clfmt)) sl_timer_ave%cname(1:18), & 616 & sl_timer_ave%tsum_clock,sl_timer_ave%tsum_clock*100.*jpnij/tot_etime, & 617 & sl_timer_ave%tsum_cpu ,sl_timer_ave%tsum_cpu*100.*jpnij/tot_ctime , & 618 & sl_timer_ave%tsum_cpu/sl_timer_ave%tsum_clock, & 619 & sl_timer_ave%tmax_clock*100.*jpnij/tot_etime, & 620 & sl_timer_ave%tmin_clock*100.*jpnij/tot_etime, & 621 & sl_timer_ave%niter/REAL(jpnij) 616 IF( sl_timer_ave%tsum_clock > 0. ) & 617 WRITE(numtime,TRIM(clfmt)) sl_timer_ave%cname(1:18), & 618 & sl_timer_ave%tsum_clock,sl_timer_ave%tsum_clock*100.*jpnij/tot_etime, & 619 & sl_timer_ave%tsum_cpu ,sl_timer_ave%tsum_cpu*100.*jpnij/tot_ctime , & 620 & sl_timer_ave%tsum_cpu/sl_timer_ave%tsum_clock, & 621 & sl_timer_ave%tmax_clock*100.*jpnij/tot_etime, & 622 & sl_timer_ave%tmin_clock*100.*jpnij/tot_etime, & 623 & sl_timer_ave%niter/REAL(jpnij) 622 624 sl_timer_ave => sl_timer_ave%next 623 625 END DO
Note: See TracChangeset
for help on using the changeset viewer.
