Changeset 14789 for NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/trabbl.F90
- Timestamp:
- 2021-05-05T13:18:04+02:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev _r12970_AGRIF_CMEMSext/AGRIF5 ^/vendors/AGRIF/dev@HEAD ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 ^/vendors/PPR@HEAD ext/PPR 8 9 9 10 # SETTE 10 ^/utils/CI/sette@1 3559sette11 ^/utils/CI/sette@14244 sette
-
- Property svn:externals
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/trabbl.F90
r13532 r14789 31 31 USE trdtra ! trends: active tracers 32 32 ! 33 USE iom ! IOM library 33 USE iom ! IOM library 34 34 USE in_out_manager ! I/O manager 35 35 USE lbclnk ! ocean lateral boundary conditions 36 36 USE prtctl ! Print control 37 37 USE timing ! Timing 38 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 38 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 39 39 40 40 IMPLICIT NONE … … 106 106 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation 107 107 ! 108 INTEGER :: ji, jj, jk ! Dummy loop indices 108 109 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds 109 110 !!---------------------------------------------------------------------- … … 112 113 ! 113 114 IF( l_trdtra ) THEN !* Save the T-S input trends 114 ALLOCATE( ztrdt(jpi,jpj,jpk) 115 ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) 115 116 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 116 117 ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) … … 125 126 CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_ldf - Ta: ', mask1=tmask, & 126 127 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 127 ! lateral boundary conditions ; just need for outputs128 CALL lbc_lnk_multi( 'trabbl', ahu_bbl, 'U', 1.0_wp , ahv_bbl, 'V', 1.0_wp )129 CALL iom_put( "ahu_bbl", ahu_bbl ) ! bbl diffusive flux i-coef130 CALL iom_put( "ahv_bbl", ahv_bbl ) ! bbl diffusive flux j-coef128 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 129 CALL iom_put( "ahu_bbl", ahu_bbl ) ! bbl diffusive flux i-coef 130 CALL iom_put( "ahv_bbl", ahv_bbl ) ! bbl diffusive flux j-coef 131 ENDIF 131 132 ! 132 133 ENDIF … … 136 137 CALL tra_bbl_adv( pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, Kmm ) 137 138 IF(sn_cfctl%l_prtctl) & 138 CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_adv - Ta: ', mask1=tmask, 139 CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_adv - Ta: ', mask1=tmask, & 139 140 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 140 ! lateral boundary conditions ; just need for outputs 141 CALL lbc_lnk_multi( 'trabbl', utr_bbl, 'U', 1.0_wp , vtr_bbl, 'V', 1.0_wp ) 142 CALL iom_put( "uoce_bbl", utr_bbl ) ! bbl i-transport 143 CALL iom_put( "voce_bbl", vtr_bbl ) ! bbl j-transport 141 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 142 ! lateral boundary conditions ; just need for outputs 143 CALL lbc_lnk( 'trabbl', utr_bbl, 'U', 1.0_wp , vtr_bbl, 'V', 1.0_wp ) 144 CALL iom_put( "uoce_bbl", utr_bbl ) ! bbl i-transport 145 CALL iom_put( "voce_bbl", vtr_bbl ) ! bbl j-transport 146 ENDIF 144 147 ! 145 148 ENDIF … … 187 190 INTEGER :: ik ! local integers 188 191 REAL(wp) :: zbtr ! local scalars 189 REAL(wp), DIMENSION( jpi,jpj) :: zptb ! workspace192 REAL(wp), DIMENSION(A2D(nn_hls)) :: zptb ! workspace 190 193 !!---------------------------------------------------------------------- 191 194 ! … … 196 199 zptb(ji,jj) = pt(ji,jj,ik,jn) ! bottom before T and S 197 200 END_2D 198 ! 201 ! 199 202 DO_2D( 0, 0, 0, 0 ) ! Compute the trend 200 203 ik = mbkt(ji,jj) ! bottom T-level index … … 235 238 INTEGER :: iis , iid , ijs , ijd ! local integers 236 239 INTEGER :: ikus, ikud, ikvs, ikvd ! - - 240 INTEGER :: isi, isj ! - - 237 241 REAL(wp) :: zbtr, ztra ! local scalars 238 242 REAL(wp) :: zu_bbl, zv_bbl ! - - 239 243 !!---------------------------------------------------------------------- 240 244 ! 245 IF( ntsi == Nis0 ) THEN ; isi = 1 ; ELSE ; isi = 0 ; ENDIF ! Avoid double-counting when using tiling 246 IF( ntsj == Njs0 ) THEN ; isj = 1 ; ELSE ; isj = 0 ; ENDIF 241 247 ! ! =========== 242 248 DO jn = 1, kjpt ! tracer loop 243 249 ! ! =========== 244 DO jj = 1, jpjm1 245 DO ji = 1, jpim1 ! CAUTION start from i=1 to update i=2 when cyclic east-west 246 IF( utr_bbl(ji,jj) /= 0.e0 ) THEN ! non-zero i-direction bbl advection 247 ! down-slope i/k-indices (deep) & up-slope i/k indices (shelf) 248 iid = ji + MAX( 0, mgrhu(ji,jj) ) ; iis = ji + 1 - MAX( 0, mgrhu(ji,jj) ) 249 ikud = mbku_d(ji,jj) ; ikus = mbku(ji,jj) 250 zu_bbl = ABS( utr_bbl(ji,jj) ) 251 ! 252 ! ! up -slope T-point (shelf bottom point) 253 zbtr = r1_e1e2t(iis,jj) / e3t(iis,jj,ikus,Kmm) 254 ztra = zu_bbl * ( pt(iid,jj,ikus,jn) - pt(iis,jj,ikus,jn) ) * zbtr 255 pt_rhs(iis,jj,ikus,jn) = pt_rhs(iis,jj,ikus,jn) + ztra 256 ! 257 DO jk = ikus, ikud-1 ! down-slope upper to down T-point (deep column) 258 zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,jk,Kmm) 259 ztra = zu_bbl * ( pt(iid,jj,jk+1,jn) - pt(iid,jj,jk,jn) ) * zbtr 260 pt_rhs(iid,jj,jk,jn) = pt_rhs(iid,jj,jk,jn) + ztra 261 END DO 262 ! 263 zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,ikud,Kmm) 264 ztra = zu_bbl * ( pt(iis,jj,ikus,jn) - pt(iid,jj,ikud,jn) ) * zbtr 265 pt_rhs(iid,jj,ikud,jn) = pt_rhs(iid,jj,ikud,jn) + ztra 266 ENDIF 267 ! 268 IF( vtr_bbl(ji,jj) /= 0.e0 ) THEN ! non-zero j-direction bbl advection 269 ! down-slope j/k-indices (deep) & up-slope j/k indices (shelf) 270 ijd = jj + MAX( 0, mgrhv(ji,jj) ) ; ijs = jj + 1 - MAX( 0, mgrhv(ji,jj) ) 271 ikvd = mbkv_d(ji,jj) ; ikvs = mbkv(ji,jj) 272 zv_bbl = ABS( vtr_bbl(ji,jj) ) 273 ! 274 ! up -slope T-point (shelf bottom point) 275 zbtr = r1_e1e2t(ji,ijs) / e3t(ji,ijs,ikvs,Kmm) 276 ztra = zv_bbl * ( pt(ji,ijd,ikvs,jn) - pt(ji,ijs,ikvs,jn) ) * zbtr 277 pt_rhs(ji,ijs,ikvs,jn) = pt_rhs(ji,ijs,ikvs,jn) + ztra 278 ! 279 DO jk = ikvs, ikvd-1 ! down-slope upper to down T-point (deep column) 280 zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,jk,Kmm) 281 ztra = zv_bbl * ( pt(ji,ijd,jk+1,jn) - pt(ji,ijd,jk,jn) ) * zbtr 282 pt_rhs(ji,ijd,jk,jn) = pt_rhs(ji,ijd,jk,jn) + ztra 283 END DO 284 ! ! down-slope T-point (deep bottom point) 285 zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,ikvd,Kmm) 286 ztra = zv_bbl * ( pt(ji,ijs,ikvs,jn) - pt(ji,ijd,ikvd,jn) ) * zbtr 287 pt_rhs(ji,ijd,ikvd,jn) = pt_rhs(ji,ijd,ikvd,jn) + ztra 288 ENDIF 289 END DO 250 DO_2D( isi, 0, isj, 0 ) ! CAUTION start from i=1 to update i=2 when cyclic east-west 251 IF( utr_bbl(ji,jj) /= 0.e0 ) THEN ! non-zero i-direction bbl advection 252 ! down-slope i/k-indices (deep) & up-slope i/k indices (shelf) 253 iid = ji + MAX( 0, mgrhu(ji,jj) ) ; iis = ji + 1 - MAX( 0, mgrhu(ji,jj) ) 254 ikud = mbku_d(ji,jj) ; ikus = mbku(ji,jj) 255 zu_bbl = ABS( utr_bbl(ji,jj) ) 256 ! 257 ! ! up -slope T-point (shelf bottom point) 258 zbtr = r1_e1e2t(iis,jj) / e3t(iis,jj,ikus,Kmm) 259 ztra = zu_bbl * ( pt(iid,jj,ikus,jn) - pt(iis,jj,ikus,jn) ) * zbtr 260 pt_rhs(iis,jj,ikus,jn) = pt_rhs(iis,jj,ikus,jn) + ztra 261 ! 262 DO jk = ikus, ikud-1 ! down-slope upper to down T-point (deep column) 263 zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,jk,Kmm) 264 ztra = zu_bbl * ( pt(iid,jj,jk+1,jn) - pt(iid,jj,jk,jn) ) * zbtr 265 pt_rhs(iid,jj,jk,jn) = pt_rhs(iid,jj,jk,jn) + ztra 266 END DO 267 ! 268 zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,ikud,Kmm) 269 ztra = zu_bbl * ( pt(iis,jj,ikus,jn) - pt(iid,jj,ikud,jn) ) * zbtr 270 pt_rhs(iid,jj,ikud,jn) = pt_rhs(iid,jj,ikud,jn) + ztra 271 ENDIF 290 272 ! 291 END DO 292 ! ! =========== 293 END DO ! end tracer 294 ! ! =========== 273 IF( vtr_bbl(ji,jj) /= 0.e0 ) THEN ! non-zero j-direction bbl advection 274 ! down-slope j/k-indices (deep) & up-slope j/k indices (shelf) 275 ijd = jj + MAX( 0, mgrhv(ji,jj) ) ; ijs = jj + 1 - MAX( 0, mgrhv(ji,jj) ) 276 ikvd = mbkv_d(ji,jj) ; ikvs = mbkv(ji,jj) 277 zv_bbl = ABS( vtr_bbl(ji,jj) ) 278 ! 279 ! up -slope T-point (shelf bottom point) 280 zbtr = r1_e1e2t(ji,ijs) / e3t(ji,ijs,ikvs,Kmm) 281 ztra = zv_bbl * ( pt(ji,ijd,ikvs,jn) - pt(ji,ijs,ikvs,jn) ) * zbtr 282 pt_rhs(ji,ijs,ikvs,jn) = pt_rhs(ji,ijs,ikvs,jn) + ztra 283 ! 284 DO jk = ikvs, ikvd-1 ! down-slope upper to down T-point (deep column) 285 zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,jk,Kmm) 286 ztra = zv_bbl * ( pt(ji,ijd,jk+1,jn) - pt(ji,ijd,jk,jn) ) * zbtr 287 pt_rhs(ji,ijd,jk,jn) = pt_rhs(ji,ijd,jk,jn) + ztra 288 END DO 289 ! ! down-slope T-point (deep bottom point) 290 zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,ikvd,Kmm) 291 ztra = zv_bbl * ( pt(ji,ijs,ikvs,jn) - pt(ji,ijd,ikvd,jn) ) * zbtr 292 pt_rhs(ji,ijd,ikvd,jn) = pt_rhs(ji,ijd,ikvd,jn) + ztra 293 ENDIF 294 END_2D 295 ! ! =========== 296 END DO ! end tracer 297 ! ! =========== 295 298 END SUBROUTINE tra_bbl_adv 296 299 … … 333 336 REAL(wp) :: za, zb, zgdrho ! local scalars 334 337 REAL(wp) :: zsign, zsigna, zgbbl ! - - 335 REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts, zab ! 3D workspace 336 REAL(wp), DIMENSION(jpi,jpj) :: zub, zvb, zdep ! 2D workspace 337 !!---------------------------------------------------------------------- 338 ! 339 IF( kt == kit000 ) THEN 340 IF(lwp) WRITE(numout,*) 341 IF(lwp) WRITE(numout,*) 'trabbl:bbl : Compute bbl velocities and diffusive coefficients in ', cdtype 342 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 338 REAL(wp), DIMENSION(A2D(nn_hls),jpts) :: zts, zab ! 3D workspace 339 REAL(wp), DIMENSION(A2D(nn_hls)) :: zub, zvb, zdep ! 2D workspace 340 !!---------------------------------------------------------------------- 341 ! 342 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 343 IF( kt == kit000 ) THEN 344 IF(lwp) WRITE(numout,*) 345 IF(lwp) WRITE(numout,*) 'trabbl:bbl : Compute bbl velocities and diffusive coefficients in ', cdtype 346 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 347 ENDIF 343 348 ENDIF 344 349 ! !* bottom variables (T, S, alpha, beta, depth, velocity) … … 392 397 za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem) ! 2*(alpha,beta) at u-point 393 398 zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal) 394 ! ! 2*masked bottom density gradient 399 ! ! 2*masked bottom density gradient 395 400 zgdrho = ( za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) ) & 396 401 - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) ) ) * umask(ji,jj,1) … … 516 521 END_2D 517 522 ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 518 zmbku(:,:) = REAL( mbku_d(:,:), wp ) ; zmbkv(:,:) = REAL( mbkv_d(:,:), wp ) 519 CALL lbc_lnk _multi( 'trabbl', zmbku,'U',1.0_wp, zmbkv,'V',1.0_wp)523 zmbku(:,:) = REAL( mbku_d(:,:), wp ) ; zmbkv(:,:) = REAL( mbkv_d(:,:), wp ) 524 CALL lbc_lnk( 'trabbl', zmbku,'U',1.0_wp, zmbkv,'V',1.0_wp) 520 525 mbku_d(:,:) = MAX( INT( zmbku(:,:) ), 1 ) ; mbkv_d(:,:) = MAX( NINT( zmbkv(:,:) ), 1 ) 521 526 ! … … 536 541 e3v_bbl_0(ji,jj) = MIN( e3v_0(ji,jj,mbkt(ji ,jj+1)), e3v_0(ji,jj,mbkt(ji,jj)) ) 537 542 END_2D 538 CALL lbc_lnk _multi( 'trabbl', e3u_bbl_0, 'U', 1.0_wp , e3v_bbl_0, 'V', 1.0_wp ) ! lateral boundary conditions543 CALL lbc_lnk( 'trabbl', e3u_bbl_0, 'U', 1.0_wp , e3v_bbl_0, 'V', 1.0_wp ) ! lateral boundary conditions 539 544 ! 540 545 ! !* masked diffusive flux coefficients
Note: See TracChangeset
for help on using the changeset viewer.