Changeset 11024
- Timestamp:
- 2019-05-21T16:07:24+02:00 (6 years ago)
- Location:
- NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE
- Files:
-
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdy_oce.F90
r10934 r11024 26 26 INTEGER , POINTER, DIMENSION(:,:) :: nbr 27 27 INTEGER , POINTER, DIMENSION(:,:) :: nbmap 28 INTEGER , POINTER, DIMENSION(:,:) :: ntreat 28 29 REAL(wp), POINTER, DIMENSION(:,:) :: nbw 29 30 REAL(wp), POINTER, DIMENSION(:,:) :: nbd -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdydyn2d.F90
r10529 r11024 256 256 !! ** Purpose : Duplicate sea level across open boundaries 257 257 !! 258 !! ** Method : - take the average of free ocean neighbours 259 !! 260 !! ___ ! _| ! |_____| ! ___| ! __|x o ! ___| 261 !! __|x ! __|x o ! x ! x o ! o ! x o 262 !! o ! o ! o ! o ! ! o 263 !! 264 !! (special treatments) 265 !! ! |_ _| ! | 266 !! ! |_| ! |x o 267 !! ! o x o ! |x_x_ 268 !! ! o 258 269 !!---------------------------------------------------------------------- 259 270 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: zssh ! Sea level … … 261 272 INTEGER :: ib_bdy, ib, igrd ! local integers 262 273 INTEGER :: ii, ij, zcoef, zcoef1, zcoef2, ip, jp ! " " 263 274 INTEGER :: flagu, flagv ! short cuts 275 REAL(wp) :: zr_3 276 !!---------------------------------------------------------------------- 264 277 igrd = 1 ! Everything is at T-points here 265 278 zr_3 = 1. / 3. 279 ! 266 280 DO ib_bdy = 1, nb_bdy 267 281 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 268 282 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 269 283 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 270 ! Set gradient direction: 271 zcoef1 = bdytmask(ii-1,ij ) + bdytmask(ii+1,ij ) 272 zcoef2 = bdytmask(ii ,ij-1) + bdytmask(ii ,ij+1) 273 IF ( zcoef1+zcoef2 == 0 ) THEN ! corner 274 zcoef = bdytmask(ii-1,ij-1) + bdytmask(ii+1,ij+1) + bdytmask(ii+1,ij-1) + bdytmask(ii-1,ij+1) 275 zssh(ii,ij) = zssh( ii-1, ij-1 ) * bdytmask( ii-1, ij-1) + & 276 & zssh( ii+1, ij+1 ) * bdytmask( ii+1, ij+1) + & 277 & zssh( ii+1, ij-1 ) * bdytmask( ii+1, ij-1) + & 278 & zssh( ii-1, ij+1 ) * bdytmask( ii-1, ij+1) 279 zssh(ii,ij) = ( zssh(ii,ij) / MAX( 1, zcoef) ) * tmask(ii,ij,1) 280 ELSE 281 ip = bdytmask(ii+1,ij ) - bdytmask(ii-1,ij ) 282 jp = bdytmask(ii ,ij+1) - bdytmask(ii ,ij-1) 283 zssh(ii,ij) = zssh(ii+ip,ij+jp) * tmask(ii+ip,ij+jp,1) 284 ENDIF 284 SELECT CASE( idx_bdy(ib_bdy)%ntreat(ib,igrd) ) 285 CASE( 0 ) 286 flagu = NINT( idx_bdy(ib_bdy)%flagu(ib,igrd) ) 287 flagv = NINT( idx_bdy(ib_bdy)%flagv(ib,igrd) ) 288 IF( flagu == 0 .OR. flagv == 0 ) THEN ! linear bdy o 289 zssh(ii,ij) = zssh(ii+flagu,ij+flagv) ! ___x___ 290 ELSE ! ___ o 291 ! | x o 292 zssh(ii,ij) = ( zssh(ii+flagu,ij) + zssh(ii,ij+flagv) ) * 0.5 293 END IF 294 ! ! ! _____ ! _____ 295 ! 1 | o ! 2 o | ! 3 | x ! 4 x | 296 ! |_x_ _ ! _ _x_| ! | o ! o | 297 CASE( 1 ) ; zssh(ii,ij) = zssh(ii+1,ij+1) 298 CASE( 2 ) ; zssh(ii,ij) = zssh(ii-1,ij+1) 299 CASE( 3 ) ; zssh(ii,ij) = zssh(ii+1,ij-1) 300 CASE( 4 ) ; zssh(ii,ij) = zssh(ii-1,ij-1) 301 ! |_ o ! o _| ! ¨¨|_|¨¨ ! o 302 ! 5 _| x o ! 6 o x |_ ! 7 o x o ! 8 o x o 303 ! | o ! o | ! o ! __|¨|__ 304 CASE( 5 ) ; zssh(ii,ij) = ( zssh(ii ,ij+1) + zssh(ii+1,ij ) + zssh(ii ,ij-1) ) * zr_3 305 CASE( 6 ) ; zssh(ii,ij) = ( zssh(ii ,ij+1) + zssh(ii-1,ij ) + zssh(ii ,ij-1) ) * zr_3 306 CASE( 7 ) ; zssh(ii,ij) = ( zssh(ii-1,ij ) + zssh(ii ,ij-1) + zssh(ii+1,ij ) ) * zr_3 307 CASE( 8 ) ; zssh(ii,ij) = ( zssh(ii-1,ij ) + zssh(ii ,ij+1) + zssh(ii+1,ij ) ) * zr_3 308 END SELECT 285 309 END DO 286 310 -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdydyn3d.F90
r10529 r11024 346 346 igrd = 2 ! Neumann bc on u-velocity; 347 347 ! 348 CALL bdy_nmn( idx, igrd, ua ) 348 CALL bdy_nmn( idx, igrd, ua ) ! ua is masked 349 349 350 350 igrd = 3 ! Neumann bc on v-velocity 351 351 ! 352 CALL bdy_nmn( idx, igrd, va ) 352 CALL bdy_nmn( idx, igrd, va ) ! va is masked 353 353 ! 354 354 CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy ) ! Boundary points should be updated -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdyini.F90
r10983 r11024 131 131 INTEGER :: jpbdtau, jpbdtas ! - - 132 132 INTEGER :: ib_bdy1, ib_bdy2, ib1, ib2 ! - - 133 INTEGER :: i_offset, j_offset 133 INTEGER :: i_offset, j_offset, inbdy ! - - 134 134 INTEGER , POINTER :: nbi, nbj, nbr ! short cuts 135 135 REAL(wp), POINTER, DIMENSION(:,:) :: pmask ! pointer to 2D mask fields … … 144 144 INTEGER :: iw_b(4), ie_b(4), is_b(4), in_b(4) ! Arrays for neighbours coordinates 145 145 REAL(wp), TARGET, DIMENSION(jpi,jpj) :: zfmask ! temporary fmask array excluding coastal boundary condition (shlat) 146 LOGICAL :: llnobdy, llsobdy, lleabdy, llwebdy ! local logicals 146 147 !! 147 148 CHARACTER(LEN=1) :: ctypebdy ! - - … … 893 894 & idx_bdy(ib_bdy)%nbd (ilen1,jpbgrd) , & 894 895 & idx_bdy(ib_bdy)%nbdout(ilen1,jpbgrd) , & 896 & idx_bdy(ib_bdy)%ntreat(ilen1,jpbgrd) , & 895 897 & idx_bdy(ib_bdy)%nbmap (ilen1,jpbgrd) , & 896 898 & idx_bdy(ib_bdy)%nbw (ilen1,jpbgrd) , & … … 1243 1245 ! 1244 1246 END DO 1247 1248 ! detect corners and their orientation index 1 to 4 depending on the orientation 1249 ! detect geometries with 3 neighbours index 5 to 8 depending on the orientation 1250 ! else index 0 1251 DO ib_bdy = 1, nb_bdy 1252 DO igrd = 1, jpbgrd 1253 SELECT CASE( igrd ) 1254 CASE( 1 ) ; pmask => bdytmask 1255 CASE( 2 ) ; pmask => bdyumask 1256 CASE( 3 ) ; pmask => bdyvmask 1257 END SELECT 1258 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 1259 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 1260 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 1261 !IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj ) CYCLE 1262 llnobdy = pmask(ii ,ij+1) == 1. 1263 llsobdy = pmask(ii ,ij-1) == 1. 1264 lleabdy = pmask(ii+1,ij ) == 1. 1265 llwebdy = pmask(ii-1,ij ) == 1. 1266 inbdy = COUNT( (/ llnobdy, llsobdy, lleabdy, llwebdy /) ) 1267 IF( inbdy == 0 ) THEN ! no neighbours -> interior of a corner 1268 ! ! ! _____ ! _____ 1269 ! 1 | o ! 2 o | ! 3 | x ! 4 x | 1270 ! |_x_ _ ! _ _x_| ! | o ! o | 1271 IF( pmask(ii+1,ij+1) == 1. ) idx_bdy(ib_bdy)%ntreat(ib,igrd) = 1 1272 IF( pmask(ii-1,ij+1) == 1. ) idx_bdy(ib_bdy)%ntreat(ib,igrd) = 2 1273 IF( pmask(ii+1,ij-1) == 1. ) idx_bdy(ib_bdy)%ntreat(ib,igrd) = 3 1274 IF( pmask(ii-1,ij-1) == 1. ) idx_bdy(ib_bdy)%ntreat(ib,igrd) = 4 1275 END IF 1276 IF( inbdy == 1 ) THEN ! middle of linear bdy 1277 idx_bdy(ib_bdy)%ntreat(ib,igrd) = 0 ! regular treatment with flags 1278 END IF 1279 IF( inbdy == 2 ) THEN ! exterior of a corner 1280 idx_bdy(ib_bdy)%ntreat(ib,igrd) = 0 ! regular treatment with flags 1281 END IF 1282 IF( inbdy == 3 ) THEN ! 3 neighbours __ __ 1283 ! |_ o ! o _| ! |_| ! o 1284 ! 5 _| x o ! 6 o x |_ ! 7 o x o ! 8 o x o 1285 ! | o ! o | ! o ! __|¨|__ 1286 IF( llnobdy .AND. lleabdy .AND. llsobdy ) idx_bdy(ib_bdy)%ntreat(ib,igrd) = 5 1287 IF( llnobdy .AND. llwebdy .AND. llsobdy ) idx_bdy(ib_bdy)%ntreat(ib,igrd) = 6 1288 IF( llwebdy .AND. llsobdy .AND. lleabdy ) idx_bdy(ib_bdy)%ntreat(ib,igrd) = 7 1289 IF( llwebdy .AND. llnobdy .AND. lleabdy ) idx_bdy(ib_bdy)%ntreat(ib,igrd) = 8 1290 END IF 1291 IF( inbdy == 4 ) THEN 1292 WRITE(ctmp1,*) ' E R R O R : Problem with ',cgrid(igrd) ,' grid points,', & 1293 ' some points on boundary set ', ib_bdy, ' have 4 neighbours' 1294 WRITE(ctmp2,*) ' ========== ' 1295 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1296 END IF 1297 END DO 1298 END DO 1299 !CALL lbc_lnk( 'bdyini', ) 1300 END DO 1245 1301 ! 1246 1302 ! Tidy up -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdylib.F90
r10529 r11024 436 436 !!---------------------------------------------------------------------- 437 437 INTEGER, INTENT(in) :: igrd ! grid index 438 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: phia ! model after 3D field (to be updated) 438 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: phia ! model after 3D field (to be updated), must be masked 439 439 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 440 440 !! 441 REAL(wp) :: z coef, zcoef1, zcoef2442 REAL(wp), POINTER, DIMENSION(:,:,:) :: pmask! land/sea mask for field441 REAL(wp) :: zweight 442 REAL(wp), POINTER, DIMENSION(:,:,:) :: pmask ! land/sea mask for field 443 443 REAL(wp), POINTER, DIMENSION(:,:) :: bdypmask ! land/sea mask for field 444 444 INTEGER :: ib, ik ! dummy loop indices 445 INTEGER :: ii, ij, ip, jp ! 2D addresses 445 INTEGER :: ii, ij ! 2D addresses 446 INTEGER :: flagu, flagv ! short cuts 447 INTEGER :: ii1, ii2, ii3, ij1, ij2, ij3 446 448 !!---------------------------------------------------------------------- 447 449 ! 448 450 SELECT CASE(igrd) 449 CASE(1) 450 pmask => tmask(:,:,:) 451 bdypmask => bdytmask(:,:) 452 CASE(2) 453 pmask => umask(:,:,:) 454 bdypmask => bdyumask(:,:) 455 CASE(3) 456 pmask => vmask(:,:,:) 457 bdypmask => bdyvmask(:,:) 451 CASE(1) ; pmask => tmask(:,:,:) 452 CASE(2) ; pmask => umask(:,:,:) 453 CASE(3) ; pmask => vmask(:,:,:) 458 454 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for igrd in bdy_nmn' ) 459 455 END SELECT 456 ! 460 457 DO ib = 1, idx%nblenrim(igrd) 461 458 ii = idx%nbi(ib,igrd) 462 459 ij = idx%nbj(ib,igrd) 463 DO ik = 1, jpkm1 464 ! search the sense of the gradient 465 zcoef1 = bdypmask(ii-1,ij )*pmask(ii-1,ij,ik) + bdypmask(ii+1,ij )*pmask(ii+1,ij,ik) 466 zcoef2 = bdypmask(ii ,ij-1)*pmask(ii,ij-1,ik) + bdypmask(ii ,ij+1)*pmask(ii,ij+1,ik) 467 IF ( nint(zcoef1+zcoef2) == 0) THEN 468 ! corner **** we probably only want to set the tangentail component for the dynamics here 469 zcoef = pmask(ii-1,ij,ik) + pmask(ii+1,ij,ik) + pmask(ii,ij-1,ik) + pmask(ii,ij+1,ik) 470 IF (zcoef > .5_wp) THEN ! Only set none isolated points. 471 phia(ii,ij,ik) = phia(ii-1,ij ,ik) * pmask(ii-1,ij ,ik) + & 472 & phia(ii+1,ij ,ik) * pmask(ii+1,ij ,ik) + & 473 & phia(ii ,ij-1,ik) * pmask(ii ,ij-1,ik) + & 474 & phia(ii ,ij+1,ik) * pmask(ii ,ij+1,ik) 475 phia(ii,ij,ik) = ( phia(ii,ij,ik) / zcoef ) * pmask(ii,ij,ik) 476 ELSE 477 phia(ii,ij,ik) = phia(ii,ij ,ik) * pmask(ii,ij ,ik) 478 ENDIF 479 ELSEIF ( nint(zcoef1+zcoef2) == 2) THEN 480 ! oblique corner **** we probably only want to set the normal component for the dynamics here 481 zcoef = pmask(ii-1,ij,ik)*bdypmask(ii-1,ij ) + pmask(ii+1,ij,ik)*bdypmask(ii+1,ij ) + & 482 & pmask(ii,ij-1,ik)*bdypmask(ii,ij -1 ) + pmask(ii,ij+1,ik)*bdypmask(ii,ij+1 ) 483 phia(ii,ij,ik) = phia(ii-1,ij ,ik) * pmask(ii-1,ij ,ik)*bdypmask(ii-1,ij ) + & 484 & phia(ii+1,ij ,ik) * pmask(ii+1,ij ,ik)*bdypmask(ii+1,ij ) + & 485 & phia(ii ,ij-1,ik) * pmask(ii ,ij-1,ik)*bdypmask(ii,ij -1 ) + & 486 & phia(ii ,ij+1,ik) * pmask(ii ,ij+1,ik)*bdypmask(ii,ij+1 ) 487 488 phia(ii,ij,ik) = ( phia(ii,ij,ik) / MAX(1._wp, zcoef) ) * pmask(ii,ij,ik) 489 ELSE 490 ip = nint(bdypmask(ii+1,ij )*pmask(ii+1,ij,ik) - bdypmask(ii-1,ij )*pmask(ii-1,ij,ik)) 491 jp = nint(bdypmask(ii ,ij+1)*pmask(ii,ij+1,ik) - bdypmask(ii ,ij-1)*pmask(ii,ij-1,ik)) 492 phia(ii,ij,ik) = phia(ii+ip,ij+jp,ik) * pmask(ii+ip,ij+jp,ik) 493 ENDIF 494 END DO 460 SELECT CASE( idx%ntreat(ib,igrd) ) ! select free ocean neighbours 461 ! ! ! _____ ! _____ 462 ! 1 | o ! 2 o | ! 3 | x ! 4 x | 463 ! |_x_ _ ! _ _x_| ! | o ! o | 464 CASE( 1 ) ; ii1 = ii+1 ; ij1 = ij+1 465 CASE( 2 ) ; ii1 = ii-1 ; ij1 = ij+1 466 CASE( 3 ) ; ii1 = ii+1 ; ij1 = ij-1 467 CASE( 4 ) ; ii1 = ii-1 ; ij1 = ij-1 468 ! |_ o ! o _| ! ¨¨|_|¨¨ ! o 469 ! 5 _| x o ! 6 o x |_ ! 7 o x o ! 8 o x o 470 ! | o ! o | ! o ! __|¨|__ 471 CASE( 5 ) ; ii1 = ii ; ij1 = ij+1 ; ii2 = ii+1 ; ij2 = ij ; ii3 = ii ; ij3 = ij-1 472 CASE( 6 ) ; ii1 = ii ; ij1 = ij+1 ; ii2 = ii-1 ; ij2 = ij ; ii3 = ii ; ij3 = ij-1 473 CASE( 7 ) ; ii1 = ii-1 ; ij1 = ij ; ii2 = ii ; ij2 = ij-1 ; ii3 = ii+1 ; ij3 = ij 474 CASE( 8 ) ; ii1 = ii-1 ; ij1 = ij ; ii2 = ii ; ij2 = ij+1 ; ii3 = ii+1 ; ij3 = ij 475 CASE DEFAULT 476 END SELECT 477 ! 478 SELECT CASE( idx%ntreat(ib,igrd) ) 479 CASE( 0 ) 480 flagu = NINT( idx%flagu(ib,igrd) ) 481 flagv = NINT( idx%flagv(ib,igrd) ) 482 IF( flagu == 0 .OR. flagv == 0 ) THEN ! linear bdy o 483 DO ik = 1, jpkm1 ! ___x___ 484 IF( pmask(ii+flagu,ij+flagv,ik) /= 0. ) phia(ii,ij,ik) = phia(ii+flagu,ij+flagv,ik) 485 END DO 486 ELSE 487 DO ik = 1, jpkm1 ! ___ o 488 zweight = pmask(ii+flagu,ij,ik) + pmask(ii,ij+flagv,ik) ! | x o 489 IF( zweight /= 0. ) phia(ii,ij,ik) = ( phia(ii+flagu,ij,ik) + phia(ii,ij+flagv,ik) ) / zweight 490 END DO 491 END IF 492 CASE( 1:4 ) 493 DO ik = 1, jpkm1 494 IF( pmask(ii1,ij1,ik) /= 0. ) phia(ii,ij,ik) = phia(ii1,ij1,ik) 495 END DO 496 CASE( 5:8 ) 497 DO ik = 1, jpkm1 498 zweight = pmask(ii1,ij1,ik) + pmask(ii2,ij2,ik) + pmask(ii3,ij3,ik) 499 IF( zweight /= 0. ) phia(ii,ij,ik) = ( phia(ii1,ij1,ik) + phia (ii2,ij2,ik) + phia (ii3,ij3,ik) ) / zweight 500 END DO 501 END SELECT 495 502 END DO 496 503 ! -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdytra.F90
r10529 r11024 65 65 CASE('frs' ) ; CALL bdy_frs ( idx_bdy(ib_bdy), tsa(:,:,:,jn), zdta(jn)%tra ) 66 66 CASE('specified' ) ; CALL bdy_spe ( idx_bdy(ib_bdy), tsa(:,:,:,jn), zdta(jn)%tra ) 67 CASE('neumann' ) ; CALL bdy_nmn ( idx_bdy(ib_bdy), igrd , tsa(:,:,:,jn) ) 67 CASE('neumann' ) ; CALL bdy_nmn ( idx_bdy(ib_bdy), igrd , tsa(:,:,:,jn) ) ! tsa masked 68 68 CASE('orlanski' ) ; CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), zdta(jn)%tra, ll_npo=.false. ) 69 69 CASE('orlanski_npo') ; CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), zdta(jn)%tra, ll_npo=.true. ) -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/DYN/dynkeg.F90
r10996 r11024 75 75 ! 76 76 INTEGER :: ji, jj, jk, jb ! dummy loop indices 77 INTEGER :: i fu, ifv, igrd, ib_bdy! local integers77 INTEGER :: igrd, ib_bdy ! local integers 78 78 REAL(wp) :: zu, zv ! local scalars 79 79 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhke
Note: See TracChangeset
for help on using the changeset viewer.