Changeset 11044 for NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdylib.F90
- Timestamp:
- 2019-05-23T17:13:38+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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.
