Changeset 13701 for NEMO/branches
- Timestamp:
- 2020-10-29T12:17:52+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src
- Files:
-
- 7 edited
-
OCE/TRA/eosbn2.F90 (modified) (7 diffs)
-
OCE/TRA/traadv.F90 (modified) (1 diff)
-
OCE/TRA/traadv_qck.F90 (modified) (2 diffs)
-
OCE/TRA/trasbc.F90 (modified) (5 diffs)
-
OCE/TRA/zpshde.F90 (modified) (17 diffs)
-
OFF/dtadyn.F90 (modified) (1 diff)
-
TOP/TRP/trcadv.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/eosbn2.F90
r13660 r13701 238 238 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 239 239 ! 240 DO_3D( 1, 1, 1, 1, 1, jpkm1 )240 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 241 241 ! 242 242 zh = pdep(ji,jj,jk) * r1_Z0 ! depth … … 274 274 CASE( np_seos ) !== simplified EOS ==! 275 275 ! 276 DO_3D( 1, 1, 1, 1, 1, jpkm1 )276 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 277 277 zt = pts (ji,jj,jk,jp_tem) - 10._wp 278 278 zs = pts (ji,jj,jk,jp_sal) - 35._wp … … 338 338 END DO 339 339 ! 340 DO_3D( 1, 1, 1, 1, 1, jpkm1 )340 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 341 341 ! 342 342 ! compute density (2*nn_sto_eos) times: … … 388 388 ! Non-stochastic equation of state 389 389 ELSE 390 DO_3D( 1, 1, 1, 1, 1, jpkm1 )390 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 391 391 ! 392 392 zh = pdep(ji,jj,jk) * r1_Z0 ! depth … … 426 426 CASE( np_seos ) !== simplified EOS ==! 427 427 ! 428 DO_3D( 1, 1, 1, 1, 1, jpkm1 )428 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 429 429 zt = pts (ji,jj,jk,jp_tem) - 10._wp 430 430 zs = pts (ji,jj,jk,jp_sal) - 35._wp … … 480 480 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 481 481 ! 482 DO_2D( 1, 1, 1, 1)482 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 483 483 ! 484 484 zh = pdep(ji,jj) * r1_Z0 ! depth … … 515 515 CASE( np_seos ) !== simplified EOS ==! 516 516 ! 517 DO_2D( 1, 1, 1, 1)517 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 518 518 ! 519 519 zt = pts (ji,jj,jp_tem) - 10._wp -
NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/traadv.F90
r13660 r13701 150 150 CASE ( np_FCT ) ! FCT scheme : 2nd / 4th order 151 151 IF (nn_hls.EQ.2) THEN ; CALL lbc_lnk_multi( 'traadv', pts(:,:,:,:,Kbb), 'T', 1., pts(:,:,:,:,Kmm), 'T', 1.) 152 CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1. ) ; END IF152 CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.) ; END IF 153 153 CALL tra_adv_fct ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 154 154 CASE ( np_MUS ) ! MUSCL -
NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/traadv_qck.F90
r13660 r13701 176 176 ! 177 177 ! Tracer flux on the x-direction 178 DO jk = 1, jpkm1 179 ! 180 DO_2D( 0, 0, 1, 0 ) 181 zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 182 !--- If the second ustream point is a land point 183 !--- the flux is computed by the 1st order UPWIND scheme 184 zmsk = zdir * zfu(ji,jj,jk) + ( 1. - zdir ) * zfu(ji+1,jj,jk) 185 zwx(ji,jj,jk) = zmsk * zwx(ji,jj,jk) + ( 1. - zmsk ) * zfc(ji,jj,jk) 186 zwx(ji,jj,jk) = zwx(ji,jj,jk) * pU(ji,jj,jk) 187 END_2D 188 END DO 178 DO_3D( 0, 0, 1, 0, 1, jpkm1 ) 179 zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 180 !--- If the second ustream point is a land point 181 !--- the flux is computed by the 1st order UPWIND scheme 182 zmsk = zdir * zfu(ji,jj,jk) + ( 1. - zdir ) * zfu(ji+1,jj,jk) 183 zwx(ji,jj,jk) = zmsk * zwx(ji,jj,jk) + ( 1. - zmsk ) * zfc(ji,jj,jk) 184 zwx(ji,jj,jk) = zwx(ji,jj,jk) * pU(ji,jj,jk) 185 END_3D 189 186 ! 190 187 ! Computation of the trend … … 270 267 ! 271 268 ! Tracer flux on the x-direction 272 DO jk = 1, jpkm1 273 ! 274 DO_2D( 1, 0, 0, 0 ) 275 zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 276 !--- If the second ustream point is a land point 277 !--- the flux is computed by the 1st order UPWIND scheme 278 zmsk = zdir * zfu(ji,jj,jk) + ( 1. - zdir ) * zfu(ji,jj+1,jk) 279 zwy(ji,jj,jk) = zmsk * zwy(ji,jj,jk) + ( 1. - zmsk ) * zfc(ji,jj,jk) 280 zwy(ji,jj,jk) = zwy(ji,jj,jk) * pV(ji,jj,jk) 281 END_2D 282 END DO 269 DO_3D( 1, 0, 0, 0, 1, jpkm1 ) 270 zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 271 !--- If the second ustream point is a land point 272 !--- the flux is computed by the 1st order UPWIND scheme 273 zmsk = zdir * zfu(ji,jj,jk) + ( 1. - zdir ) * zfu(ji,jj+1,jk) 274 zwy(ji,jj,jk) = zmsk * zwy(ji,jj,jk) + ( 1. - zmsk ) * zfc(ji,jj,jk) 275 zwy(ji,jj,jk) = zwy(ji,jj,jk) * pV(ji,jj,jk) 276 END_3D 283 277 ! 284 278 ! Computation of the trend -
NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/trasbc.F90
r13660 r13701 124 124 ENDIF 125 125 ! !== Now sbc tracer content fields ==! 126 DO_2D( nn_hls -1, nn_hls, nn_hls-1, nn_hls-1)126 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 127 127 sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj) ! non solar heat flux 128 128 sbc_tsc(ji,jj,jp_sal) = r1_rho0 * sfx(ji,jj) ! salt flux due to freezing/melting 129 129 END_2D 130 130 IF( ln_linssh ) THEN !* linear free surface 131 DO_2D( nn_hls -1, nn_hls, nn_hls-1, nn_hls-1) !==>> add concentration/dilution effect due to constant volume cell131 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) !==>> add concentration/dilution effect due to constant volume cell 132 132 sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm) 133 133 sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm) … … 138 138 ! 139 139 DO jn = 1, jpts !== update tracer trend ==! 140 DO_2D( nn_hls -1, nn_hls, nn_hls-1, nn_hls-1)140 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 141 141 pts(ji,jj,1,jn,Krhs) = pts(ji,jj,1,jn,Krhs) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) & 142 142 & / e3t(ji,jj,1,Kmm) … … 157 157 IF( ln_rnf ) THEN ! input of heat and salt due to river runoff 158 158 zfact = 0.5_wp 159 DO_2D( 0, 1, 0, 0)159 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 160 160 IF( rnf(ji,jj) /= 0._wp ) THEN 161 161 zdep = zfact / h_rnf(ji,jj) … … 182 182 ! 183 183 IF( ln_linssh ) THEN 184 DO_2D( 0, 1, 0, 0)184 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 185 185 ztim = ssh_iau(ji,jj) / e3t(ji,jj,1,Kmm) 186 186 pts(ji,jj,1,jp_tem,Krhs) = pts(ji,jj,1,jp_tem,Krhs) + pts(ji,jj,1,jp_tem,Kmm) * ztim … … 188 188 END_2D 189 189 ELSE 190 DO_2D( 0, 1, 0, 0)190 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 191 191 ztim = ssh_iau(ji,jj) / ( ht(ji,jj) + 1. - ssmask(ji, jj) ) 192 192 pts(ji,jj,:,jp_tem,Krhs) = pts(ji,jj,:,jp_tem,Krhs) + pts(ji,jj,:,jp_tem,Kmm) * ztim -
NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/zpshde.F90
r13497 r13701 88 88 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 89 89 INTEGER , INTENT(in ) :: kjpt ! number of tracers 90 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in 90 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! 4D tracers fields 91 91 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts 92 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in 92 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(inout), OPTIONAL :: prd ! 3D density anomaly fields 93 93 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) 94 94 ! … … 101 101 ! 102 102 IF( ln_timing ) CALL timing_start( 'zps_hde') 103 IF (nn_hls.EQ.2) THEN ; CALL lbc_lnk( 'zpshde', pta, 'T', 1.0_wp) 104 IF(PRESENT(prd)) CALL lbc_lnk( 'zpshde', prd, 'T', 1.0_wp) ; END IF 103 105 ! 104 106 pgtu(:,:,:) = 0._wp ; zti (:,:,:) = 0._wp ; zhi (:,:) = 0._wp … … 107 109 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! 108 110 ! 109 DO_2D( 1, 0, 1, 0 )111 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! Gradient of density at the last level 110 112 iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points 111 113 ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv - 1 , 1 ) ! if level first is a p-step, ik.m1=1 … … 146 148 END DO 147 149 ! 148 CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond.150 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond. 149 151 ! 150 152 IF( PRESENT( prd ) ) THEN !== horizontal derivative of density anomalies (rd) ==! (optional part) 151 153 pgru(:,:) = 0._wp 152 154 pgrv(:,:) = 0._wp ! depth of the partial step level 153 DO_2D( 1, 0, 1, 0)155 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 154 156 iku = mbku(ji,jj) 155 157 ikv = mbkv(ji,jj) … … 167 169 CALL eos( ztj, zhj, zrj ) ! at the partial step depth output in zri, zrj 168 170 ! 169 DO_2D( 1, 0, 1, 0) ! Gradient of density at the last level171 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! Gradient of density at the last level 170 172 iku = mbku(ji,jj) 171 173 ikv = mbkv(ji,jj) … … 179 181 ENDIF 180 182 END_2D 181 CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp ) ! Lateral boundary conditions183 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp ) ! Lateral boundary conditions 182 184 ! 183 185 END IF … … 239 241 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 240 242 INTEGER , INTENT(in ) :: kjpt ! number of tracers 241 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in 243 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! 4D tracers fields 242 244 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts 243 245 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF) 244 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in 246 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(inout), OPTIONAL :: prd ! 3D density anomaly fields 245 247 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) 246 248 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top) … … 255 257 IF( ln_timing ) CALL timing_start( 'zps_hde_isf') 256 258 ! 259 IF (nn_hls.EQ.2) THEN ; CALL lbc_lnk( 'zpshde', pta, 'T', 1.0_wp) 260 IF (PRESENT(prd)) CALL lbc_lnk( 'zpshde', prd, 'T', 1.0_wp) ; END IF 261 257 262 pgtu (:,:,:) = 0._wp ; pgtv (:,:,:) =0._wp 258 263 pgtui(:,:,:) = 0._wp ; pgtvi(:,:,:) =0._wp … … 262 267 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! 263 268 ! 264 DO_2D( 1, 0, 1, 0)269 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 265 270 266 271 iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points … … 302 307 END DO 303 308 ! 304 CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond.309 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond. 305 310 306 311 ! horizontal derivative of density anomalies (rd) … … 308 313 pgru(:,:)=0.0_wp ; pgrv(:,:)=0.0_wp ; 309 314 ! 310 DO_2D( 1, 0, 1, 0)315 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 311 316 312 317 iku = mbku(ji,jj) … … 329 334 CALL eos( ztj, zhj, zrj ) 330 335 331 DO_2D( 1, 0, 1, 0 ) ! Gradient of density at the last level336 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 332 337 iku = mbku(ji,jj) 333 338 ikv = mbkv(ji,jj) … … 344 349 END_2D 345 350 346 CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp ) ! Lateral boundary conditions351 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp ) ! Lateral boundary conditions 347 352 ! 348 353 END IF … … 351 356 ! 352 357 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! ! 353 DO_2D( 1, 0, 1, 0)358 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 354 359 iku = miku(ji,jj); ikup1 = miku(ji,jj) + 1 355 360 ikv = mikv(ji,jj); ikvp1 = mikv(ji,jj) + 1 … … 395 400 ! 396 401 END DO 397 CALL lbc_lnk_multi( 'zpshde', pgtui(:,:,:), 'U', -1.0_wp , pgtvi(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond.402 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgtui(:,:,:), 'U', -1.0_wp , pgtvi(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond. 398 403 399 404 IF( PRESENT( prd ) ) THEN !== horizontal derivative of density anomalies (rd) ==! (optional part) 400 405 ! 401 406 pgrui(:,:) =0.0_wp; pgrvi(:,:) =0.0_wp; 402 DO_2D( 1, 0, 1, 0)407 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 403 408 404 409 iku = miku(ji,jj) … … 420 425 CALL eos( ztj, zhj, zrj ) ! at the partial step depth output in zri, zrj 421 426 ! 422 DO_2D( 1, 0, 1, 0 ) ! Gradient of density at the last level427 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 423 428 iku = miku(ji,jj) 424 429 ikv = mikv(ji,jj) … … 434 439 435 440 END_2D 436 CALL lbc_lnk_multi( 'zpshde', pgrui, 'U', -1.0_wp , pgrvi, 'V', -1.0_wp ) ! Lateral boundary conditions441 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgrui, 'U', -1.0_wp , pgrvi, 'V', -1.0_wp ) ! Lateral boundary conditions 437 442 ! 438 443 END IF -
NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OFF/dtadyn.F90
r13497 r13701 795 795 !!--------------------------------------------------------------------- 796 796 INTEGER , INTENT(in ) :: kt ! time step 797 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in 797 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) :: pts ! temperature/salinity 798 798 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(out) :: puslp ! zonal isopycnal slopes 799 799 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(out) :: pvslp ! meridional isopycnal slopes -
NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/TOP/TRP/trcadv.F90
r13660 r13701 128 128 CASE ( np_FCT ) ! FCT : 2nd / 4th order 129 129 IF (nn_hls.EQ.2) THEN ; CALL lbc_lnk_multi( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1., ptr(:,:,:,:,Kmm), 'T', 1.) 130 CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1. ) ; END IF130 CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.) ; END IF 131 131 CALL tra_adv_fct( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 132 132 CASE ( np_MUS ) ! MUSCL
Note: See TracChangeset
for help on using the changeset viewer.
