MODULE bdylib
   !!======================================================================
   !!                       ***  MODULE  bdylib  ***
   !! Unstructured Open Boundary Cond. :  Library module of generic boundary algorithms.
   !!======================================================================
   !! History :  3.6  !  2013     (D. Storkey) original code
   !!            4.0  !  2014     (T. Lovato) Generalize OBC structure
   !!----------------------------------------------------------------------
   !!----------------------------------------------------------------------
   !!   bdy_orlanski_2d
   !!   bdy_orlanski_3d
   !!----------------------------------------------------------------------
   USE oce            ! ocean dynamics and tracers 
   USE dom_oce        ! ocean space and time domain
   USE bdy_oce        ! ocean open boundary conditions
   USE phycst         ! physical constants
   USE bdyini
   !
   USE in_out_manager !
   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
   USE lib_mpp, ONLY: ctl_stop

   IMPLICIT NONE
   PRIVATE

   PUBLIC   bdy_frs, bdy_spe, bdy_nmn, bdy_orl
   PUBLIC   bdy_orlanski_2d
   PUBLIC   bdy_orlanski_3d

   !!----------------------------------------------------------------------
   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
   !! $Id: bdylib.F90 13527 2020-09-25 16:00:14Z smasson $ 
   !! Software governed by the CeCILL license (see ./LICENSE)
   !!----------------------------------------------------------------------
CONTAINS

   SUBROUTINE bdy_frs( idx, phia, dta )
      !!----------------------------------------------------------------------
      !!                 ***  SUBROUTINE bdy_frs  ***
      !!
      !! ** Purpose : Apply the Flow Relaxation Scheme for tracers at open boundaries.
      !!
      !! Reference : Engedahl H., 1995, Tellus, 365-382.
      !!----------------------------------------------------------------------
      TYPE(OBC_INDEX),                     INTENT(in) ::   idx  ! OBC indices
      REAL(dp), DIMENSION(:,:), POINTER,   INTENT(in) ::   dta  ! OBC external data
      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   phia  ! tracer trend
      !!
      REAL(dp) ::   zwgt           ! boundary weight
      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
      INTEGER  ::   ii, ij         ! 2D addresses
      !!----------------------------------------------------------------------
      !
      igrd = 1                       ! Everything is at T-points here
      DO ib = 1, idx%nblen(igrd)
         DO ik = 1, jpkm1
            ii = idx%nbi(ib,igrd) 
            ij = idx%nbj(ib,igrd)
            zwgt = idx%nbw(ib,igrd)
            phia(ii,ij,ik) = ( phia(ii,ij,ik) + zwgt * (dta(ib,ik) - phia(ii,ij,ik) ) ) * tmask(ii,ij,ik)
         END DO
      END DO
      !
   END SUBROUTINE bdy_frs


   SUBROUTINE bdy_spe( idx, phia, dta )
      !!----------------------------------------------------------------------
      !!                 ***  SUBROUTINE bdy_spe  ***
      !!
      !! ** Purpose : Apply a specified value for tracers at open boundaries.
      !!
      !!----------------------------------------------------------------------
      TYPE(OBC_INDEX),                     INTENT(in) ::   idx  ! OBC indices
      REAL(dp), DIMENSION(:,:), POINTER,   INTENT(in) ::   dta  ! OBC external data
      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   phia  ! tracer trend
      !!
      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
      INTEGER  ::   ii, ij         ! 2D addresses
      !!----------------------------------------------------------------------
      !
      igrd = 1                       ! Everything is at T-points here
      DO ib = 1, idx%nblenrim(igrd)
         ii = idx%nbi(ib,igrd)
         ij = idx%nbj(ib,igrd)
         DO ik = 1, jpkm1
            phia(ii,ij,ik) = dta(ib,ik) * tmask(ii,ij,ik)
         END DO
      END DO
      !
   END SUBROUTINE bdy_spe


   SUBROUTINE bdy_orl( idx, phib, phia, dta, lrim0, ll_npo )
      !!----------------------------------------------------------------------
      !!                 ***  SUBROUTINE bdy_orl  ***
      !!
      !! ** Purpose : Apply Orlanski radiation for tracers at open boundaries.
      !!              This is a wrapper routine for bdy_orlanski_3d below
      !!
      !!----------------------------------------------------------------------
      TYPE(OBC_INDEX),                   INTENT(in   ) ::   idx  ! OBC indices
      REAL(dp), DIMENSION(:,:), POINTER, INTENT(in   ) ::   dta  ! OBC external data
      REAL(dp), DIMENSION(jpi,jpj,jpk),  INTENT(inout) ::   phib  ! before tracer field
      REAL(dp), DIMENSION(jpi,jpj,jpk),  INTENT(inout) ::   phia  ! tracer trend
      LOGICAL ,                          INTENT(in   ) ::   lrim0   ! indicate if rim 0 is treated
      LOGICAL ,                          INTENT(in   ) ::   ll_npo  ! switch for NPO version
      !!
      INTEGER  ::   igrd                                    ! grid index
      !!----------------------------------------------------------------------
      !
      igrd = 1                       ! Everything is at T-points here
      !
      CALL bdy_orlanski_3d( idx, igrd, phib(:,:,:), phia(:,:,:), dta, lrim0, ll_npo )
      !
   END SUBROUTINE bdy_orl


   SUBROUTINE bdy_orlanski_2d( idx, igrd, phib, phia, phi_ext, lrim0, ll_npo )
      !!----------------------------------------------------------------------
      !!                 ***  SUBROUTINE bdy_orlanski_2d  ***
      !!             
      !!              - Apply Orlanski radiation condition adaptively to 2D fields:
      !!                  - radiation plus weak nudging at outflow points
      !!                  - no radiation and strong nudging at inflow points
      !! 
      !!
      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)    
      !!----------------------------------------------------------------------
      TYPE(OBC_INDEX),                   INTENT(in   ) ::   idx      ! BDY indices
      INTEGER ,                          INTENT(in   ) ::   igrd     ! grid index
      REAL(dp), DIMENSION(:,:),          INTENT(in   ) ::   phib     ! model before 2D field
      REAL(dp), DIMENSION(:,:),          INTENT(inout) ::   phia     ! model after 2D field (to be updated)
      REAL(dp), DIMENSION(:  ), POINTER, INTENT(in   ) ::   phi_ext  ! external forcing data
      LOGICAL ,                          INTENT(in   ) ::   lrim0    ! indicate if rim 0 is treated
      LOGICAL ,                          INTENT(in   ) ::   ll_npo   ! switch for NPO version
      !
      INTEGER  ::   jb                                     ! dummy loop indices
      INTEGER  ::   ii, ij, iibm1, iibm2, ijbm1, ijbm2     ! 2D addresses
      INTEGER  ::   iijm1, iijp1, ijjm1, ijjp1             ! 2D addresses
      INTEGER  ::   iibm1jp1, iibm1jm1, ijbm1jp1, ijbm1jm1 ! 2D addresses
      INTEGER  ::   ii_offset, ij_offset                   ! offsets for mask indices
      INTEGER  ::   flagu, flagv                           ! short cuts
      INTEGER  ::   ibeg, iend                             ! length of rim to be treated (rim 0 or rim 1 or both)
      REAL(dp) ::   zmask_x, zmask_y1, zmask_y2
      REAL(dp) ::   zex1, zex2, zey, zey1, zey2
      REAL(dp) ::   zdt, zdx, zdy, znor2, zrx, zry         ! intermediate calculations
      REAL(dp) ::   zout, zwgt, zdy_centred
      REAL(dp) ::   zdy_1, zdy_2, zsign_ups
      REAL(wp), PARAMETER :: zepsilon = 1.e-30                 ! local small value
      REAL(wp), POINTER, DIMENSION(:,:)          :: zmask      ! land/sea mask for field
      REAL(wp), POINTER, DIMENSION(:,:)          :: zmask_xdif ! land/sea mask for x-derivatives
      REAL(wp), POINTER, DIMENSION(:,:)          :: zmask_ydif ! land/sea mask for y-derivatives
      REAL(dp), POINTER, DIMENSION(:,:)          :: pe_xdif    ! scale factors for x-derivatives
      REAL(dp), POINTER, DIMENSION(:,:)          :: pe_ydif    ! scale factors for y-derivatives
      !!----------------------------------------------------------------------
      !
      ! ----------------------------------!
      ! Orlanski boundary conditions     :!
      ! ----------------------------------! 
     
      SELECT CASE(igrd)
         CASE(1)
            zmask      => tmask(:,:,1)
            zmask_xdif => umask(:,:,1)
            zmask_ydif => vmask(:,:,1)
            pe_xdif    => e1u(:,:)
            pe_ydif    => e2v(:,:)
            ii_offset = 0
            ij_offset = 0
         CASE(2)
            zmask      => umask(:,:,1)
            zmask_xdif => tmask(:,:,1)
            zmask_ydif => fmask(:,:,1)
            pe_xdif    => e1t(:,:)
            pe_ydif    => e2f(:,:)
            ii_offset = 1
            ij_offset = 0
         CASE(3)
            zmask      => vmask(:,:,1)
            zmask_xdif => fmask(:,:,1)
            zmask_ydif => tmask(:,:,1)
            pe_xdif    => e1f(:,:)
            pe_ydif    => e2t(:,:)
            ii_offset = 0
            ij_offset = 1
         CASE DEFAULT ;   CALL ctl_stop( 'unrecognised value for igrd in bdy_orlanksi_2d' )
      END SELECT
      !
      IF( lrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd)   ! rim 0
      ELSE               ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd)    ! rim 1
      ENDIF
      !
      DO jb = ibeg, iend
         ii  = idx%nbi(jb,igrd)
         ij  = idx%nbj(jb,igrd) 
         IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )   CYCLE
         flagu = int( idx%flagu(jb,igrd) )
         flagv = int( idx%flagv(jb,igrd) )
         !
         ! Calculate positions of b-1 and b-2 points for this rim point
         ! also (b-1,j-1) and (b-1,j+1) points
         iibm1 = ii + flagu ; iibm2 = ii + 2*flagu 
         ijbm1 = ij + flagv ; ijbm2 = ij + 2*flagv
          !
         iijm1 = ii - abs(flagv) ; iijp1 = ii + abs(flagv) 
         ijjm1 = ij - abs(flagu) ; ijjp1 = ij + abs(flagu)
         !
         iibm1jm1 = ii + flagu - abs(flagv) ; iibm1jp1 = ii + flagu + abs(flagv) 
         ijbm1jm1 = ij + flagv - abs(flagu) ; ijbm1jp1 = ij + flagv + abs(flagu) 
         !
         ! Calculate scale factors for calculation of spatial derivatives.        
         zex1 = ( abs(iibm1-iibm2) * pe_xdif(iibm1   +ii_offset,ijbm1             )   &
        &       + abs(ijbm1-ijbm2) * pe_ydif(iibm1             ,ijbm1   +ij_offset) ) 
         zex2 = ( abs(iibm1-iibm2) * pe_xdif(iibm2   +ii_offset,ijbm2             )   &
        &       + abs(ijbm1-ijbm2) * pe_ydif(iibm2             ,ijbm2   +ij_offset) ) 
         zey1 = ( (iibm1-iibm1jm1) * pe_xdif(iibm1jm1+ii_offset,ijbm1jm1          )   & 
        &      +  (ijbm1-ijbm1jm1) * pe_ydif(iibm1jm1          ,ijbm1jm1+ij_offset) ) 
         zey2 = ( (iibm1jp1-iibm1) * pe_xdif(iibm1   +ii_offset,ijbm1             )   &
        &      +  (ijbm1jp1-ijbm1) * pe_ydif(iibm1             ,ijbm1   +ij_offset) ) 
         ! make sure scale factors are nonzero
         if( zey1 .lt. rsmall ) zey1 = zey2
         if( zey2 .lt. rsmall ) zey2 = zey1
         zex1 = max(zex1,rsmall); zex2 = max(zex2,rsmall)
         zey1 = max(zey1,rsmall); zey2 = max(zey2,rsmall); 
         !
         ! Calculate masks for calculation of spatial derivatives.
         zmask_x  = ( abs(iibm1-iibm2) * zmask_xdif(iibm2   +ii_offset,ijbm2               )   &
        &           + abs(ijbm1-ijbm2) * zmask_ydif(iibm2             ,ijbm2   +ij_offset) ) 
         zmask_y1 = ( (iibm1-iibm1jm1) * zmask_xdif(iibm1jm1+ii_offset,ijbm1jm1            )   & 
        &          +  (ijbm1-ijbm1jm1) * zmask_ydif(iibm1jm1          ,ijbm1jm1+ij_offset) ) 
         zmask_y2 = ( (iibm1jp1-iibm1) * zmask_xdif(iibm1   +ii_offset,ijbm1               )   &
        &          +  (ijbm1jp1-ijbm1) * zmask_ydif(iibm1             ,ijbm1   +ij_offset) ) 

         ! Calculation of terms required for both versions of the scheme. 
         ! Mask derivatives to ensure correct land boundary conditions for each variable.
         ! Centred derivative is calculated as average of "left" and "right" derivatives for 
         ! this reason. 
         ! Note no rn_Dt factor in expression for zdt because it cancels in the expressions for 
         ! zrx and zry.
         zdt   =     phia(iibm1   ,ijbm1   ) - phib(iibm1   ,ijbm1   )
         zdx   = ( ( phia(iibm1   ,ijbm1   ) - phia(iibm2   ,ijbm2   ) ) / zex2 ) * zmask_x 
         zdy_1 = ( ( phib(iibm1   ,ijbm1   ) - phib(iibm1jm1,ijbm1jm1) ) / zey1 ) * zmask_y1    
         zdy_2 = ( ( phib(iibm1jp1,ijbm1jp1) - phib(iibm1   ,ijbm1   ) ) / zey2 ) * zmask_y2 
         zdy_centred = 0.5 * ( zdy_1 + zdy_2 )
!!$         zdy_centred = phib(iibm1jp1,ijbm1jp1) - phib(iibm1jm1,ijbm1jm1)
         ! upstream differencing for tangential derivatives
         zsign_ups = sign( 1.0_wp, zdt * zdy_centred )
         zsign_ups = 0.5*( zsign_ups + abs(zsign_ups) )
         zdy = zsign_ups * zdy_1 + (1. - zsign_ups) * zdy_2
         znor2 = zdx * zdx + zdy * zdy
         znor2 = max(znor2,zepsilon)
         !
         zrx = zdt * zdx / ( zex1 * znor2 ) 
!!$         zrx = min(zrx,2.0_wp)
         zout = sign( 1.0_wp, zrx )
         zout = 0.5*( zout + abs(zout) )
         zwgt = 2.*rn_Dt*( (1.-zout) * idx%nbd(jb,igrd) + zout * idx%nbdout(jb,igrd) )
         ! only apply radiation on outflow points 
         if( ll_npo ) then     !! NPO version !!
            phia(ii,ij) = (1.-zout) * ( phib(ii,ij) + zwgt * ( phi_ext(jb) - phib(ii,ij) ) )        &
           &            + zout      * ( phib(ii,ij) + zrx*phia(iibm1,ijbm1)                         &
           &                            + zwgt * ( phi_ext(jb) - phib(ii,ij) ) ) / ( 1. + zrx ) 
         else                  !! full oblique radiation !!
            zsign_ups = sign( 1.0_wp, zdt * zdy )
            zsign_ups = 0.5*( zsign_ups + abs(zsign_ups) )
            zey = zsign_ups * zey1 + (1.-zsign_ups) * zey2 
            zry = zdt * zdy / ( zey * znor2 ) 
            phia(ii,ij) = (1.-zout) * ( phib(ii,ij) + zwgt * ( phi_ext(jb) - phib(ii,ij) ) )        &
           &            + zout      * ( phib(ii,ij) + zrx*phia(iibm1,ijbm1)                         &
           &                    - zsign_ups      * zry * ( phib(ii   ,ij   ) - phib(iijm1,ijjm1 ) ) &
           &                    - (1.-zsign_ups) * zry * ( phib(iijp1,ijjp1) - phib(ii   ,ij    ) ) &
           &                    + zwgt * ( phi_ext(jb) - phib(ii,ij) ) ) / ( 1. + zrx ) 
         endif
         phia(ii,ij) = phia(ii,ij) * zmask(ii,ij)
      END DO
      !
   END SUBROUTINE bdy_orlanski_2d


   SUBROUTINE bdy_orlanski_3d( idx, igrd, phib, phia, phi_ext, lrim0, ll_npo )
      !!----------------------------------------------------------------------
      !!                 ***  SUBROUTINE bdy_orlanski_3d  ***
      !!             
      !!              - Apply Orlanski radiation condition adaptively to 3D fields:
      !!                  - radiation plus weak nudging at outflow points
      !!                  - no radiation and strong nudging at inflow points
      !! 
      !!
      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)    
      !!----------------------------------------------------------------------
      TYPE(OBC_INDEX),                     INTENT(in   ) ::   idx      ! BDY indices
      INTEGER ,                            INTENT(in   ) ::   igrd     ! grid index
      REAL(dp), DIMENSION(:,:,:),          INTENT(in   ) ::   phib     ! model before 3D field
      REAL(dp), DIMENSION(:,:,:),          INTENT(inout) ::   phia     ! model after 3D field (to be updated)
      REAL(dp), DIMENSION(:,:  ), POINTER, INTENT(in   ) ::   phi_ext  ! external forcing data
      LOGICAL ,                            INTENT(in   ) ::   lrim0    ! indicate if rim 0 is treated
      LOGICAL ,                            INTENT(in   ) ::   ll_npo   ! switch for NPO version
      !
      INTEGER  ::   jb, jk                                 ! dummy loop indices
      INTEGER  ::   ii, ij, iibm1, iibm2, ijbm1, ijbm2     ! 2D addresses
      INTEGER  ::   iijm1, iijp1, ijjm1, ijjp1             ! 2D addresses
      INTEGER  ::   iibm1jp1, iibm1jm1, ijbm1jp1, ijbm1jm1 ! 2D addresses
      INTEGER  ::   ii_offset, ij_offset                   ! offsets for mask indices
      INTEGER  ::   flagu, flagv                           ! short cuts
      INTEGER  ::   ibeg, iend                             ! length of rim to be treated (rim 0 or rim 1 or both)
      REAL(dp) ::   zmask_x, zmask_y1, zmask_y2
      REAL(dp) ::   zex1, zex2, zey, zey1, zey2
      REAL(dp) ::   zdt, zdx, zdy, znor2, zrx, zry         ! intermediate calculations
      REAL(dp) ::   zout, zwgt, zdy_centred
      REAL(dp) ::   zdy_1, zdy_2,  zsign_ups
      REAL(wp), PARAMETER :: zepsilon = 1.e-30                 ! local small value
      REAL(wp), POINTER, DIMENSION(:,:,:)        :: zmask      ! land/sea mask for field
      REAL(wp), POINTER, DIMENSION(:,:,:)        :: zmask_xdif ! land/sea mask for x-derivatives
      REAL(wp), POINTER, DIMENSION(:,:,:)        :: zmask_ydif ! land/sea mask for y-derivatives
      REAL(dp), POINTER, DIMENSION(:,:)          :: pe_xdif    ! scale factors for x-derivatives
      REAL(dp), POINTER, DIMENSION(:,:)          :: pe_ydif    ! scale factors for y-derivatives
      !!----------------------------------------------------------------------
      !
      ! ----------------------------------!
      ! Orlanski boundary conditions     :!
      ! ----------------------------------! 
      !
      SELECT CASE(igrd)
         CASE(1)
            zmask      => tmask(:,:,:)
            zmask_xdif => umask(:,:,:)
            zmask_ydif => vmask(:,:,:)
            pe_xdif    => e1u(:,:)
            pe_ydif    => e2v(:,:)
            ii_offset = 0
            ij_offset = 0
         CASE(2)
            zmask      => umask(:,:,:)
            zmask_xdif => tmask(:,:,:)
            zmask_ydif => fmask(:,:,:)
            pe_xdif    => e1t(:,:)
            pe_ydif    => e2f(:,:)
            ii_offset = 1
            ij_offset = 0
         CASE(3)
            zmask      => vmask(:,:,:)
            zmask_xdif => fmask(:,:,:)
            zmask_ydif => tmask(:,:,:)
            pe_xdif    => e1f(:,:)
            pe_ydif    => e2t(:,:)
            ii_offset = 0
            ij_offset = 1
         CASE DEFAULT ;   CALL ctl_stop( 'unrecognised value for igrd in bdy_orlanksi_2d' )
      END SELECT
      !
      IF( lrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd)   ! rim 0
      ELSE               ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd)    ! rim 1
      ENDIF
      !
      DO jk = 1, jpk
         !            
         DO jb = ibeg, iend
            ii  = idx%nbi(jb,igrd)
            ij  = idx%nbj(jb,igrd) 
            IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )   CYCLE
            flagu = int( idx%flagu(jb,igrd) )
            flagv = int( idx%flagv(jb,igrd) )
            !
            ! calculate positions of b-1 and b-2 points for this rim point
            ! also (b-1,j-1) and (b-1,j+1) points
            iibm1 = ii + flagu ; iibm2 = ii + 2*flagu 
            ijbm1 = ij + flagv ; ijbm2 = ij + 2*flagv
            !
            iijm1 = ii - abs(flagv) ; iijp1 = ii + abs(flagv) 
            ijjm1 = ij - abs(flagu) ; ijjp1 = ij + abs(flagu)
            !
            iibm1jm1 = ii + flagu - abs(flagv) ; iibm1jp1 = ii + flagu + abs(flagv) 
            ijbm1jm1 = ij + flagv - abs(flagu) ; ijbm1jp1 = ij + flagv + abs(flagu) 
            !
            ! Calculate scale factors for calculation of spatial derivatives.        
            zex1 = ( abs(iibm1-iibm2) * pe_xdif(iibm1   +ii_offset,ijbm1             )   &
           &       + abs(ijbm1-ijbm2) * pe_ydif(iibm1             ,ijbm1+ij_offset   ) ) 
            zex2 = ( abs(iibm1-iibm2) * pe_xdif(iibm2   +ii_offset,ijbm2             )   &
           &       + abs(ijbm1-ijbm2) * pe_ydif(iibm2             ,ijbm2+ij_offset   ) ) 
            zey1 = ( (iibm1-iibm1jm1) * pe_xdif(iibm1jm1+ii_offset,ijbm1jm1          )   & 
           &      +  (ijbm1-ijbm1jm1) * pe_ydif(iibm1jm1          ,ijbm1jm1+ij_offset) ) 
            zey2 = ( (iibm1jp1-iibm1) * pe_xdif(iibm1   +ii_offset,ijbm1             )   &
           &      +  (ijbm1jp1-ijbm1) * pe_ydif(iibm1             ,ijbm1+ij_offset   ) ) 
            ! make sure scale factors are nonzero
            if( zey1 .lt. rsmall ) zey1 = zey2
            if( zey2 .lt. rsmall ) zey2 = zey1
            zex1 = max(zex1,rsmall); zex2 = max(zex2,rsmall); 
            zey1 = max(zey1,rsmall); zey2 = max(zey2,rsmall); 
            !
            ! Calculate masks for calculation of spatial derivatives.        
            zmask_x  = ( abs(iibm1-iibm2) * zmask_xdif(iibm2   +ii_offset,ijbm2             ,jk)   &
           &           + abs(ijbm1-ijbm2) * zmask_ydif(iibm2             ,ijbm2   +ij_offset,jk) ) 
            zmask_y1 = ( (iibm1-iibm1jm1) * zmask_xdif(iibm1jm1+ii_offset,ijbm1jm1          ,jk)   & 
           &          +  (ijbm1-ijbm1jm1) * zmask_ydif(iibm1jm1          ,ijbm1jm1+ij_offset,jk) ) 
            zmask_y2 = ( (iibm1jp1-iibm1) * zmask_xdif(iibm1   +ii_offset,ijbm1             ,jk)   &
           &          +  (ijbm1jp1-ijbm1) * zmask_ydif(iibm1             ,ijbm1   +ij_offset,jk) ) 
            !
            ! Calculate normal (zrx) and tangential (zry) components of radiation velocities.
            ! Mask derivatives to ensure correct land boundary conditions for each variable.
            ! Centred derivative is calculated as average of "left" and "right" derivatives for 
            ! this reason. 
            zdt   =     phia(iibm1   ,ijbm1   ,jk) - phib(iibm1   ,ijbm1   ,jk)
            zdx   = ( ( phia(iibm1   ,ijbm1   ,jk) - phia(iibm2   ,ijbm2   ,jk) ) / zex2 ) * zmask_x                  
            zdy_1 = ( ( phib(iibm1   ,ijbm1   ,jk) - phib(iibm1jm1,ijbm1jm1,jk) ) / zey1 ) * zmask_y1  
            zdy_2 = ( ( phib(iibm1jp1,ijbm1jp1,jk) - phib(iibm1   ,ijbm1   ,jk) ) / zey2 ) * zmask_y2      
            zdy_centred = 0.5 * ( zdy_1 + zdy_2 )
!!$            zdy_centred = phib(iibm1jp1,ijbm1jp1,jk) - phib(iibm1jm1,ijbm1jm1,jk)
            ! upstream differencing for tangential derivatives
            zsign_ups = sign( 1.0_wp, zdt * zdy_centred )
            zsign_ups = 0.5*( zsign_ups + abs(zsign_ups) )
            zdy = zsign_ups * zdy_1 + (1. - zsign_ups) * zdy_2
            znor2 = zdx * zdx + zdy * zdy
            znor2 = max(znor2,zepsilon)
            !
            ! update boundary value:
            zrx = zdt * zdx / ( zex1 * znor2 )
!!$            zrx = min(zrx,2.0_wp)
            zout = sign( 1.0_wp, zrx )
            zout = 0.5*( zout + abs(zout) )
            zwgt = 2.*rn_Dt*( (1.-zout) * idx%nbd(jb,igrd) + zout * idx%nbdout(jb,igrd) )
            ! only apply radiation on outflow points 
            if( ll_npo ) then     !! NPO version !!
               phia(ii,ij,jk) = (1.-zout) * ( phib(ii,ij,jk) + zwgt * ( phi_ext(jb,jk) - phib(ii,ij,jk) ) ) &
              &               + zout      * ( phib(ii,ij,jk) + zrx*phia(iibm1,ijbm1,jk)                     &
              &                            + zwgt * ( phi_ext(jb,jk) - phib(ii,ij,jk) ) ) / ( 1. + zrx ) 
            else                  !! full oblique radiation !!
               zsign_ups = sign( 1.0_wp, zdt * zdy )
               zsign_ups = 0.5*( zsign_ups + abs(zsign_ups) )
               zey = zsign_ups * zey1 + (1.-zsign_ups) * zey2 
               zry = zdt * zdy / ( zey * znor2 ) 
               phia(ii,ij,jk) = (1.-zout) * ( phib(ii,ij,jk) + zwgt * ( phi_ext(jb,jk) - phib(ii,ij,jk) ) )    &
              &               + zout      * ( phib(ii,ij,jk) + zrx*phia(iibm1,ijbm1,jk)                        &
              &                       - zsign_ups      * zry * ( phib(ii   ,ij   ,jk) - phib(iijm1,ijjm1,jk) ) &
              &                       - (1.-zsign_ups) * zry * ( phib(iijp1,ijjp1,jk) - phib(ii   ,ij   ,jk) ) &
              &                       + zwgt * ( phi_ext(jb,jk) - phib(ii,ij,jk) ) ) / ( 1. + zrx ) 
            endif
            phia(ii,ij,jk) = phia(ii,ij,jk) * zmask(ii,ij,jk)
         END DO
         !
      END DO
      !
   END SUBROUTINE bdy_orlanski_3d

   SUBROUTINE bdy_nmn( idx, igrd, phia, lrim0 )
      !!----------------------------------------------------------------------
      !!                 ***  SUBROUTINE bdy_nmn  ***
      !!                    
      !! ** Purpose : Duplicate the value at open boundaries, zero gradient.
      !! 
      !!
      !! ** Method  : - take the average of free ocean neighbours
      !!
      !!      ___   !   |_____|   !   ___|    !   __|x o   !   |_   _|     ! |      
      !!   __|x     !      x      !     x o   !      o     !     |_|       ! |x o   
      !!      o     !      o      !     o     !            !    o x o      ! |x_x_ 
      !!                                                   !      o      
      !!----------------------------------------------------------------------
      INTEGER,                    INTENT(in   )  ::   igrd     ! grid index
      REAL(dp), DIMENSION(:,:,:), INTENT(inout)  ::   phia     ! model after 3D field (to be updated), must be masked
      TYPE(OBC_INDEX),            INTENT(in   )  ::   idx      ! OBC indices
      LOGICAL ,                   INTENT(in   )  ::   lrim0    ! indicate if rim 0 is treated
      !! 
      REAL(dp) ::   zweight
      REAL(wp), POINTER, DIMENSION(:,:,:)      :: zmask         ! land/sea mask for field
      INTEGER  ::   ib, ik   ! dummy loop indices
      INTEGER  ::   ii, ij   ! 2D addresses
      INTEGER  ::   ipkm1    ! size of phia third dimension minus 1
      INTEGER  ::   ibeg, iend                          ! length of rim to be treated (rim 0 or rim 1 or both)
      INTEGER  ::   ii1, ii2, ii3, ij1, ij2, ij3, itreat
      !!----------------------------------------------------------------------
      !
      ipkm1 = MAX( SIZE(phia,3) - 1, 1 ) 
      !
      SELECT CASE(igrd)
         CASE(1)   ;   zmask => tmask(:,:,:)
         CASE(2)   ;   zmask => umask(:,:,:)
         CASE(3)   ;   zmask => vmask(:,:,:)
         CASE DEFAULT ;   CALL ctl_stop( 'unrecognised value for igrd in bdy_nmn' )
      END SELECT
      !
      IF( lrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd)   ! rim 0
      ELSE               ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd)    ! rim 1
      ENDIF
      !
      DO ib = ibeg, iend
         ii = idx%nbi(ib,igrd)
         ij = idx%nbj(ib,igrd)
         itreat = idx%ntreat(ib,igrd)
         CALL find_neib( ii, ij, itreat, ii1, ij1, ii2, ij2, ii3, ij3 )   ! find free ocean neighbours
         SELECT CASE( itreat )
         CASE( 1:8 )
            IF( ii1 < 1 .OR. ii1 > jpi .OR. ij1 < 1 .OR. ij1 > jpj )   CYCLE
            DO ik = 1, ipkm1
               IF( zmask(ii1,ij1,ik) /= 0. )   phia(ii,ij,ik) = phia(ii1,ij1,ik)  
            END DO
         CASE( 9:12 )
            IF( ii1 < 1 .OR. ii1 > jpi .OR. ij1 < 1 .OR. ij1 > jpj )   CYCLE
            IF( ii2 < 1 .OR. ii2 > jpi .OR. ij2 < 1 .OR. ij2 > jpj )   CYCLE
            DO ik = 1, ipkm1
               zweight = zmask(ii1,ij1,ik) + zmask(ii2,ij2,ik)
               IF( zweight /= 0. )   phia(ii,ij,ik) = ( phia(ii1,ij1,ik) + phia(ii2,ij2,ik) ) / zweight
            END DO
         CASE( 13:16 )
            IF( ii1 < 1 .OR. ii1 > jpi .OR. ij1 < 1 .OR. ij1 > jpj )   CYCLE
            IF( ii2 < 1 .OR. ii2 > jpi .OR. ij2 < 1 .OR. ij2 > jpj )   CYCLE
            IF( ii3 < 1 .OR. ii3 > jpi .OR. ij3 < 1 .OR. ij3 > jpj )   CYCLE
            DO ik = 1, ipkm1
               zweight = zmask(ii1,ij1,ik) + zmask(ii2,ij2,ik) + zmask(ii3,ij3,ik)
               IF( zweight /= 0. )   phia(ii,ij,ik) = ( phia(ii1,ij1,ik) + phia(ii2,ij2,ik) + phia(ii3,ij3,ik) ) / zweight
            END DO
         END SELECT
      END DO
      !
   END SUBROUTINE bdy_nmn

   !!======================================================================
END MODULE bdylib