Changeset 11024 for NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdylib.F90
- Timestamp:
- 2019-05-21T16:07:24+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
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 !
Note: See TracChangeset
for help on using the changeset viewer.
