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