- Timestamp:
- 2019-05-23T17:13:38+02:00 (5 years ago)
- Location:
- NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY
- Files:
-
- 3 edited
-
bdydyn2d.F90 (modified) (1 diff)
-
bdyini.F90 (modified) (4 diffs)
-
bdylib.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdydyn2d.F90
r11024 r11044 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 269 !!---------------------------------------------------------------------- 270 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: zssh ! Sea level 271 !! 272 INTEGER :: ib_bdy, ib, igrd ! local integers 273 INTEGER :: ii, ij, zcoef, zcoef1, zcoef2, ip, jp ! " " 274 INTEGER :: flagu, flagv ! short cuts 275 REAL(wp) :: zr_3 276 !!---------------------------------------------------------------------- 277 igrd = 1 ! Everything is at T-points here 278 zr_3 = 1. / 3. 279 ! 258 !!---------------------------------------------------------------------- 259 REAL(wp), DIMENSION(jpi,jpj,1), INTENT(inout) :: zssh ! Sea level, need 3 dimensions to be used by bdy_nmn 260 !! 261 INTEGER :: ib_bdy ! bdy index 262 !!---------------------------------------------------------------------- 280 263 DO ib_bdy = 1, nb_bdy 281 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 282 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 283 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 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 309 END DO 310 311 ! Boundary points should be updated 312 CALL lbc_bdy_lnk( 'bdydyn2d', zssh(:,:), 'T', 1., ib_bdy ) 313 END DO 314 264 CALL bdy_nmn( idx_bdy(ib_bdy), 1, zssh ) ! zssh is masked 265 CALL lbc_bdy_lnk( 'bdydyn2d', zssh(:,:,1), 'T', 1., ib_bdy ) 266 END DO 267 ! 315 268 END SUBROUTINE bdy_ssh 316 269 -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdyini.F90
r11024 r11044 1246 1246 END DO 1247 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 1248 ! detect corner interior and its orientation index 1 to 4 depending on the orientation 1249 ! detect corner exterior and its orientation index 5 to 8 depending on the orientation 1250 ! detect geometries with 3 neighbours index 9 to 12 depending on the orientation 1251 ! else index 0 1251 1252 DO ib_bdy = 1, nb_bdy 1252 1253 DO igrd = 1, jpbgrd … … 1259 1260 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 1260 1261 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 1261 !IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj ) CYCLE1262 1262 llnobdy = pmask(ii ,ij+1) == 1. 1263 1263 llsobdy = pmask(ii ,ij-1) == 1. … … 1278 1278 END IF 1279 1279 IF( inbdy == 2 ) THEN ! exterior of a corner 1280 idx_bdy(ib_bdy)%ntreat(ib,igrd) = 0 ! regular treatment with flags 1280 ! o ! o ! _____| ! |_____ 1281 ! 5 ____x o ! 6 o x___ ! 7 x o ! 8 o x 1282 ! | ! | ! o ! o 1283 IF( llnobdy .AND. lleabdy ) idx_bdy(ib_bdy)%ntreat(ib,igrd) = 5 1284 IF( llnobdy .AND. llwebdy ) idx_bdy(ib_bdy)%ntreat(ib,igrd) = 6 1285 IF( llsobdy .AND. lleabdy ) idx_bdy(ib_bdy)%ntreat(ib,igrd) = 7 1286 IF( llsobdy .AND. llwebdy ) idx_bdy(ib_bdy)%ntreat(ib,igrd) = 8 1281 1287 END IF 1282 1288 IF( inbdy == 3 ) THEN ! 3 neighbours __ __ 1283 1289 ! |_ o ! o _| ! |_| ! o 1284 ! 5 _| x o ! 6 o x |_ ! 7 o x o ! 8o x o1285 ! | o ! o | ! o ! __|¨|__ 1286 IF( llnobdy .AND. lleabdy .AND. llsobdy ) idx_bdy(ib_bdy)%ntreat(ib,igrd) = 51287 IF( llnobdy .AND. llwebdy .AND. llsobdy ) idx_bdy(ib_bdy)%ntreat(ib,igrd) = 61288 IF( llwebdy .AND. llsobdy .AND. lleabdy ) idx_bdy(ib_bdy)%ntreat(ib,igrd) = 71289 IF( llwebdy .AND. llnobdy .AND. lleabdy ) idx_bdy(ib_bdy)%ntreat(ib,igrd) = 81290 ! 9 _| x o ! 10 o x |_ ! 11 o x o ! 12 o x o 1291 ! | o ! o | ! o ! __|¨|__ 1292 IF( llnobdy .AND. lleabdy .AND. llsobdy ) idx_bdy(ib_bdy)%ntreat(ib,igrd) = 9 1293 IF( llnobdy .AND. llwebdy .AND. llsobdy ) idx_bdy(ib_bdy)%ntreat(ib,igrd) = 10 1294 IF( llwebdy .AND. llsobdy .AND. lleabdy ) idx_bdy(ib_bdy)%ntreat(ib,igrd) = 11 1295 IF( llwebdy .AND. llnobdy .AND. lleabdy ) idx_bdy(ib_bdy)%ntreat(ib,igrd) = 12 1290 1296 END IF 1291 1297 IF( inbdy == 4 ) THEN … … 1297 1303 END DO 1298 1304 END DO 1299 !CALL lbc_lnk( 'bdyini', )1300 1305 END DO 1301 1306 ! -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdylib.F90
r11024 r11044 75 75 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pta ! tracer trend 76 76 !! 77 REAL(wp) :: zwgt ! boundary weight78 77 INTEGER :: ib, ik, igrd ! dummy loop indices 79 78 INTEGER :: ii, ij ! 2D addresses … … 434 433 !! ** Purpose : Duplicate the value at open boundaries, zero gradient. 435 434 !! 435 !! 436 !! ** Method : - take the average of free ocean neighbours 437 !! 438 !! ___ ! |_____| ! ___| ! __|x o ! |_ _| ! | 439 !! __|x ! x ! x o ! o ! |_| ! |x o 440 !! o ! o ! o ! ! o x o ! |x_x_ 441 !! ! o 436 442 !!---------------------------------------------------------------------- 437 443 INTEGER, INTENT(in) :: igrd ! grid index … … 441 447 REAL(wp) :: zweight 442 448 REAL(wp), POINTER, DIMENSION(:,:,:) :: pmask ! land/sea mask for field 443 REAL(wp), POINTER, DIMENSION(:,:) :: bdypmask ! land/sea mask for field444 449 INTEGER :: ib, ik ! dummy loop indices 445 450 INTEGER :: ii, ij ! 2D addresses 451 INTEGER :: ipkm1 ! size of phia third dimension minus 1 446 452 INTEGER :: flagu, flagv ! short cuts 447 453 INTEGER :: ii1, ii2, ii3, ij1, ij2, ij3 448 454 !!---------------------------------------------------------------------- 455 ! 456 ipkm1 = MAX( SIZE(phia,3) - 1, 1 ) 449 457 ! 450 458 SELECT CASE(igrd) … … 458 466 ii = idx%nbi(ib,igrd) 459 467 ij = idx%nbj(ib,igrd) 468 ! 460 469 SELECT CASE( idx%ntreat(ib,igrd) ) ! select free ocean neighbours 470 ! o 471 ! ___x___ ! either flagu or flagv = 0 472 CASE( 0 ) ; flagu = NINT( idx%flagu(ib,igrd) ) ; ii1 = ii+flagu 473 flagv = NINT( idx%flagv(ib,igrd) ) ; ij1 = ij+flagv 461 474 ! ! ! _____ ! _____ 462 475 ! 1 | o ! 2 o | ! 3 | x ! 4 x | … … 466 479 CASE( 3 ) ; ii1 = ii+1 ; ij1 = ij-1 467 480 CASE( 4 ) ; ii1 = ii-1 ; ij1 = ij-1 481 ! o ! o ! _____| ! |_____ 482 ! 5 ____x o ! 6 o x___ ! 7 x o ! 8 o x 483 ! | ! | ! o ! o 484 CASE( 5 ) ; ii1 = ii ; ij1 = ij+1 ; ii2 = ii+1 ; ij2 = ij 485 CASE( 6 ) ; ii1 = ii ; ij1 = ij+1 ; ii2 = ii-1 ; ij2 = ij 486 CASE( 7 ) ; ii1 = ii ; ij1 = ij-1 ; ii2 = ii+1 ; ij2 = ij 487 CASE( 8 ) ; ii1 = ii ; ij1 = ij-1 ; ii2 = ii-1 ; ij2 = ij 468 488 ! |_ o ! o _| ! ¨¨|_|¨¨ ! o 469 ! 5 _| x o ! 6 o x |_ ! 7 o x o ! 8o x o489 ! 9 _| x o ! 10 o x |_ ! 11 o x o ! 12 o x o 470 490 ! | 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 491 CASE( 9 ) ; ii1 = ii ; ij1 = ij+1 ; ii2 = ii+1 ; ij2 = ij ; ii3 = ii ; ij3 = ij-1 492 CASE( 10 ) ; ii1 = ii ; ij1 = ij+1 ; ii2 = ii-1 ; ij2 = ij ; ii3 = ii ; ij3 = ij-1 493 CASE( 11 ) ; ii1 = ii-1 ; ij1 = ij ; ii2 = ii ; ij2 = ij-1 ; ii3 = ii+1 ; ij3 = ij 494 CASE( 12 ) ; ii1 = ii-1 ; ij1 = ij ; ii2 = ii ; ij2 = ij+1 ; ii3 = ii+1 ; ij3 = ij 476 495 END SELECT 477 496 ! 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 497 SELECT CASE( idx%ntreat(ib,igrd) ) 498 CASE( 0:4 ) 499 DO ik = 1, ipkm1 500 IF( pmask(ii1,ij1,ik) /= 0. ) phia(ii,ij,ik) = phia(ii1,ij1,ik) 501 END DO 496 502 CASE( 5:8 ) 497 DO ik = 1, jpkm1 498 zweight = pmask(ii1,ij1,ik) + pmask(ii2,ij2,ik) + pmask(ii3,ij3,ik) 503 DO ik = 1, ipkm1 504 zweight = pmask(ii1,ij1,ik) + pmask(ii2,ij2,ik) 505 IF( zweight /= 0. ) phia(ii,ij,ik) = ( phia(ii1,ij1,ik) + phia (ii2,ij2,ik) ) / zweight 506 END DO 507 CASE( 9:12 ) 508 DO ik = 1, ipkm1 509 zweight = pmask(ii1,ij1,ik) + pmask(ii2,ij2,ik) + pmask(ii3,ij3,ik) 499 510 IF( zweight /= 0. ) phia(ii,ij,ik) = ( phia(ii1,ij1,ik) + phia (ii2,ij2,ik) + phia (ii3,ij3,ik) ) / zweight 500 511 END DO 501 512 END SELECT 513 ! 502 514 END DO 503 515 !
Note: See TracChangeset
for help on using the changeset viewer.
