- Timestamp:
- 2018-10-29T13:03:40+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90
r10246 r10249 26 26 PUBLIC bdy_orlanski_2d ! routine called where? 27 27 PUBLIC bdy_orlanski_3d ! routine called where? 28 PUBLIC bdy_nmn ! routine called where? 28 29 29 30 !!---------------------------------------------------------------------- … … 354 355 END SUBROUTINE bdy_orlanski_3d 355 356 357 SUBROUTINE bdy_nmn( idx, igrd, phia ) 358 !!---------------------------------------------------------------------- 359 !! *** SUBROUTINE bdy_nmn *** 360 !! 361 !! ** Purpose : Duplicate the value at open boundaries, zero gradient. 362 !! 363 !!---------------------------------------------------------------------- 364 INTEGER, INTENT(in) :: igrd ! grid index 365 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: phia ! model after 3D field (to be updated) 366 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 367 !! 368 REAL(wp) :: zcoef, zcoef1, zcoef2 369 REAL(wp), POINTER, DIMENSION(:,:,:) :: pmask ! land/sea mask for field 370 REAL(wp), POINTER, DIMENSION(:,:) :: bdypmask ! land/sea mask for field 371 INTEGER :: ib, ik ! dummy loop indices 372 INTEGER :: ii, ij, ip, jp ! 2D addresses 373 !!---------------------------------------------------------------------- 374 ! 375 IF( nn_timing == 1 ) CALL timing_start('bdy_nmn') 376 ! 377 SELECT CASE(igrd) 378 CASE(1) 379 pmask => tmask(:,:,:) 380 bdypmask => bdytmask(:,:) 381 CASE(2) 382 pmask => umask(:,:,:) 383 bdypmask => bdyumask(:,:) 384 CASE(3) 385 pmask => vmask(:,:,:) 386 bdypmask => bdyvmask(:,:) 387 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for igrd in bdy_nmn' ) 388 END SELECT 389 DO ib = 1, idx%nblenrim(igrd) 390 ii = idx%nbi(ib,igrd) 391 ij = idx%nbj(ib,igrd) 392 DO ik = 1, jpkm1 393 ! search the sense of the gradient 394 zcoef1 = bdypmask(ii-1,ij )*pmask(ii-1,ij,ik) + bdypmask(ii+1,ij )*pmask(ii+1,ij,ik) 395 zcoef2 = bdypmask(ii ,ij-1)*pmask(ii,ij-1,ik) + bdypmask(ii ,ij+1)*pmask(ii,ij+1,ik) 396 IF ( nint(zcoef1+zcoef2) == 0) THEN 397 ! corner **** we probably only want to set the tangentail component for the dynamics here 398 zcoef = pmask(ii-1,ij,ik) + pmask(ii+1,ij,ik) + pmask(ii,ij-1,ik) + pmask(ii,ij+1,ik) 399 IF (zcoef > .5_wp) THEN ! Only set none isolated points. 400 phia(ii,ij,ik) = phia(ii-1,ij ,ik) * pmask(ii-1,ij ,ik) + & 401 & phia(ii+1,ij ,ik) * pmask(ii+1,ij ,ik) + & 402 & phia(ii ,ij-1,ik) * pmask(ii ,ij-1,ik) + & 403 & phia(ii ,ij+1,ik) * pmask(ii ,ij+1,ik) 404 phia(ii,ij,ik) = ( phia(ii,ij,ik) / zcoef ) * pmask(ii,ij,ik) 405 ELSE 406 phia(ii,ij,ik) = phia(ii,ij ,ik) * pmask(ii,ij ,ik) 407 ENDIF 408 ELSEIF ( nint(zcoef1+zcoef2) == 2) THEN 409 ! oblique corner **** we probably only want to set the normal component for the dynamics here 410 zcoef = pmask(ii-1,ij,ik)*bdypmask(ii-1,ij ) + pmask(ii+1,ij,ik)*bdypmask(ii+1,ij ) + & 411 & pmask(ii,ij-1,ik)*bdypmask(ii,ij -1 ) + pmask(ii,ij+1,ik)*bdypmask(ii,ij+1 ) 412 phia(ii,ij,ik) = phia(ii-1,ij ,ik) * pmask(ii-1,ij ,ik)*bdypmask(ii-1,ij ) + & 413 & phia(ii+1,ij ,ik) * pmask(ii+1,ij ,ik)*bdypmask(ii+1,ij ) + & 414 & phia(ii ,ij-1,ik) * pmask(ii ,ij-1,ik)*bdypmask(ii,ij -1 ) + & 415 & phia(ii ,ij+1,ik) * pmask(ii ,ij+1,ik)*bdypmask(ii,ij+1 ) 416 417 phia(ii,ij,ik) = ( phia(ii,ij,ik) / MAX(1._wp, zcoef) ) * pmask(ii,ij,ik) 418 ELSE 419 ip = nint(bdypmask(ii+1,ij )*pmask(ii+1,ij,ik) - bdypmask(ii-1,ij )*pmask(ii-1,ij,ik)) 420 jp = nint(bdypmask(ii ,ij+1)*pmask(ii,ij+1,ik) - bdypmask(ii ,ij-1)*pmask(ii,ij-1,ik)) 421 phia(ii,ij,ik) = phia(ii+ip,ij+jp,ik) * pmask(ii+ip,ij+jp,ik) 422 ENDIF 423 END DO 424 END DO 425 ! 426 IF( nn_timing == 1 ) CALL timing_stop('bdy_nmn') 427 ! 428 END SUBROUTINE bdy_nmn 429 356 430 357 431 #else … … 366 440 WRITE(*,*) 'bdy_orlanski_3d: You should not have seen this print! error?', kt 367 441 END SUBROUTINE bdy_orlanski_3d 442 SUBROUTINE bdy_nmn( idx, igrd, phia ) ! Empty routine 443 WRITE(*,*) 'bdy_nmn: You should not have seen this print! error?', kt 444 END SUBROUTINE bdy_nmn 368 445 #endif 369 446
Note: See TracChangeset
for help on using the changeset viewer.