MODULE lbcnfd
   !!======================================================================
   !!                       ***  MODULE  lbcnfd  ***
   !! Ocean        : north fold  boundary conditions
   !!======================================================================
   !! History :  3.2  ! 2009-03  (R. Benshila)  Original code 
   !!            3.5  ! 2013-07  (I. Epicoco, S. Mocavero - CMCC) MPP optimization
   !!            4.0  ! 2017-04  (G. Madec) automatique allocation of array argument (use any 3rd dimension)
   !!----------------------------------------------------------------------

   !!----------------------------------------------------------------------
   !!   lbc_nfd       : generic interface for lbc_nfd_3d and lbc_nfd_2d routines
   !!   lbc_nfd_3d    : lateral boundary condition: North fold treatment for a 3D arrays   (lbc_nfd)
   !!   lbc_nfd_2d    : lateral boundary condition: North fold treatment for a 2D arrays   (lbc_nfd)
   !!   lbc_nfd_nogather       : generic interface for lbc_nfd_nogather_3d and 
   !!                            lbc_nfd_nogather_2d routines (designed for use
   !!                            with ln_nnogather to avoid global width arrays
   !!                            mpi all gather operations)
   !!----------------------------------------------------------------------
   USE dom_oce        ! ocean space and time domain 
   USE in_out_manager ! I/O manager

   IMPLICIT NONE
   PRIVATE

   INTERFACE lbc_nfd
      MODULE PROCEDURE   lbc_nfd_2d    , lbc_nfd_3d    , lbc_nfd_4d
      MODULE PROCEDURE   lbc_nfd_2d_ptr, lbc_nfd_3d_ptr, lbc_nfd_4d_ptr
   END INTERFACE
   !
   INTERFACE lbc_nfd_nogather
!                        ! Currently only 4d array version is needed
!     MODULE PROCEDURE   lbc_nfd_nogather_2d    , lbc_nfd_nogather_3d
      MODULE PROCEDURE   lbc_nfd_nogather_4d
!     MODULE PROCEDURE   lbc_nfd_nogather_2d_ptr, lbc_nfd_nogather_3d_ptr
!     MODULE PROCEDURE   lbc_nfd_nogather_4d_ptr
   END INTERFACE

   TYPE, PUBLIC ::   PTR_2D   !: array of 2D pointers (also used in lib_mpp)
      REAL(wp), DIMENSION (:,:)    , POINTER ::   pt2d
   END TYPE PTR_2D
   TYPE, PUBLIC ::   PTR_3D   !: array of 3D pointers (also used in lib_mpp)
      REAL(wp), DIMENSION (:,:,:)  , POINTER ::   pt3d
   END TYPE PTR_3D
   TYPE, PUBLIC ::   PTR_4D   !: array of 4D pointers (also used in lib_mpp)
      REAL(wp), DIMENSION (:,:,:,:), POINTER ::   pt4d
   END TYPE PTR_4D

   PUBLIC   lbc_nfd            ! north fold conditions
   PUBLIC   lbc_nfd_nogather   ! north fold conditions (no allgather case)

   INTEGER, PUBLIC, PARAMETER            ::   jpmaxngh = 3               !:
   INTEGER, PUBLIC                       ::   nsndto, nfsloop, nfeloop   !:
   INTEGER, PUBLIC, DIMENSION (jpmaxngh) ::   isendto                    !: processes to which communicate

   !!----------------------------------------------------------------------
   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
   !! $Id$
   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
   !!----------------------------------------------------------------------
CONTAINS

   !!----------------------------------------------------------------------
   !!                   ***  routine lbc_nfd_(2,3,4)d  ***
   !!----------------------------------------------------------------------
   !!
   !! ** Purpose :   lateral boundary condition 
   !!                North fold treatment without processor exchanges. 
   !!
   !! ** Method  :   
   !!
   !! ** Action  :   ptab with updated values along the north fold
   !!----------------------------------------------------------------------
   !
   !                       !==  2D array and array of 2D pointer  ==!
   !
#  define DIM_2d
#     define ROUTINE_NFD           lbc_nfd_2d
#     include "lbc_nfd_generic.h90"
#     undef ROUTINE_NFD
#     define MULTI
#     define ROUTINE_NFD           lbc_nfd_2d_ptr
#     include "lbc_nfd_generic.h90"
#     undef ROUTINE_NFD
#     undef MULTI
#  undef DIM_2d
   !
   !                       !==  3D array and array of 3D pointer  ==!
   !
#  define DIM_3d
#     define ROUTINE_NFD           lbc_nfd_3d
#     include "lbc_nfd_generic.h90"
#     undef ROUTINE_NFD
#     define MULTI
#     define ROUTINE_NFD           lbc_nfd_3d_ptr
#     include "lbc_nfd_generic.h90"
#     undef ROUTINE_NFD
#     undef MULTI
#  undef DIM_3d
   !
   !                       !==  4D array and array of 4D pointer  ==!
   !
#  define DIM_4d
#     define ROUTINE_NFD           lbc_nfd_4d
#     include "lbc_nfd_generic.h90"
#     undef ROUTINE_NFD
#     define MULTI
#     define ROUTINE_NFD           lbc_nfd_4d_ptr
#     include "lbc_nfd_generic.h90"
#     undef ROUTINE_NFD
#     undef MULTI
#  undef DIM_4d
   !
   !  lbc_nfd_nogather routines
   !
   !                       !==  2D array and array of 2D pointer  ==!
   !
!#  define DIM_2d
!#     define ROUTINE_NFD           lbc_nfd_nogather_2d
!#     include "lbc_nfd_nogather_generic.h90"
!#     undef ROUTINE_NFD
!#     define MULTI
!#     define ROUTINE_NFD           lbc_nfd_nogather_2d_ptr
!#     include "lbc_nfd_nogather_generic.h90"
!#     undef ROUTINE_NFD
!#     undef MULTI
!#  undef DIM_2d
   !
   !                       !==  3D array and array of 3D pointer  ==!
   !
!#  define DIM_3d
!#     define ROUTINE_NFD           lbc_nfd_nogather_3d
!#     include "lbc_nfd_nogather_generic.h90"
!#     undef ROUTINE_NFD
!#     define MULTI
!#     define ROUTINE_NFD           lbc_nfd_nogather_3d_ptr
!#     include "lbc_nfd_nogather_generic.h90"
!#     undef ROUTINE_NFD
!#     undef MULTI
!#  undef DIM_3d
   !
   !                       !==  4D array and array of 4D pointer  ==!
   !
#  define DIM_4d
#     define ROUTINE_NFD           lbc_nfd_nogather_4d
#     include "lbc_nfd_nogather_generic.h90"
#     undef ROUTINE_NFD
!#     define MULTI
!#     define ROUTINE_NFD           lbc_nfd_nogather_4d_ptr
!#     include "lbc_nfd_nogather_generic.h90"
!#     undef ROUTINE_NFD
!#     undef MULTI
#  undef DIM_4d

   !!----------------------------------------------------------------------


!!gm   CAUTION HERE  optional pr2dj  not implemented in generic case
!!gm                 furthermore, in the _org routine it is OK only for T-point pivot !!


   SUBROUTINE lbc_nfd_2d_org( pt2d, cd_nat, psgn, pr2dj )
      !!----------------------------------------------------------------------
      !!                  ***  routine lbc_nfd_2d  ***
      !!
      !! ** Purpose :   2D lateral boundary condition : North fold treatment
      !!       without processor exchanges. 
      !!
      !! ** Method  :   
      !!
      !! ** Action  :   pt2d with updated values along the north fold
      !!----------------------------------------------------------------------
      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 2D array on which the boundary condition is applied
      CHARACTER(len=1)        , INTENT(in   ) ::   cd_nat   ! nature of pt2d grid-point
      REAL(wp)                , INTENT(in   ) ::   psgn      ! sign used across north fold
      INTEGER , OPTIONAL      , INTENT(in   ) ::   pr2dj     ! number of additional halos
      !
      INTEGER  ::   ji, jl, ipr2dj
      INTEGER  ::   ijt, iju, ijpj, ijpjm1
      !!----------------------------------------------------------------------

      SELECT CASE ( jpni )
      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
      END SELECT
      !
      IF( PRESENT(pr2dj) ) THEN           ! use of additional halos
         ipr2dj = pr2dj
         IF( jpni > 1 )   ijpj = ijpj + ipr2dj
      ELSE
         ipr2dj = 0 
      ENDIF
      !
      ijpjm1 = ijpj-1


      SELECT CASE ( npolj )
      !
      CASE ( 3, 4 )                       ! *  North fold  T-point pivot
         !
         SELECT CASE ( cd_nat )
         !
         CASE ( 'T' , 'W' )                               ! T- , W-points
            DO jl = 0, ipr2dj
               DO ji = 2, jpiglo
                  ijt=jpiglo-ji+2
                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl)
               END DO
            END DO
            pt2d(1,ijpj)   = psgn * pt2d(3,ijpj-2)
            DO ji = jpiglo/2+1, jpiglo
               ijt=jpiglo-ji+2
               pt2d(ji,ijpj-1) = psgn * pt2d(ijt,ijpj-1)
            END DO
         CASE ( 'U' )                                     ! U-point
            DO jl = 0, ipr2dj
               DO ji = 1, jpiglo-1
                  iju = jpiglo-ji+1
                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl)
               END DO
            END DO
            pt2d(   1  ,ijpj  ) = psgn * pt2d(    2   ,ijpj-2)
            pt2d(jpiglo,ijpj  ) = psgn * pt2d(jpiglo-1,ijpj-2)
            pt2d(1     ,ijpj-1) = psgn * pt2d(jpiglo  ,ijpj-1)   
            DO ji = jpiglo/2, jpiglo-1
               iju = jpiglo-ji+1
               pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)
            END DO
         CASE ( 'V' )                                     ! V-point
            DO jl = -1, ipr2dj
               DO ji = 2, jpiglo
                  ijt = jpiglo-ji+2
                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-3-jl)
               END DO
            END DO
            pt2d( 1 ,ijpj)   = psgn * pt2d( 3 ,ijpj-3) 
         CASE ( 'F' )                                     ! F-point
            DO jl = -1, ipr2dj
               DO ji = 1, jpiglo-1
                  iju = jpiglo-ji+1
                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-3-jl)
               END DO
            END DO
            pt2d(   1  ,ijpj)   = psgn * pt2d(    2   ,ijpj-3)
            pt2d(jpiglo,ijpj)   = psgn * pt2d(jpiglo-1,ijpj-3)
            pt2d(jpiglo,ijpj-1) = psgn * pt2d(jpiglo-1,ijpj-2)      
            pt2d(   1  ,ijpj-1) = psgn * pt2d(    2   ,ijpj-2)      
         CASE ( 'I' )                                     ! ice U-V point (I-point)
            DO jl = 0, ipr2dj
               pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)
               DO ji = 3, jpiglo
                  iju = jpiglo - ji + 3
                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
               END DO
            END DO
         END SELECT
         !
      CASE ( 5, 6 )                        ! *  North fold  F-point pivot
         !
         SELECT CASE ( cd_nat )
         CASE ( 'T' , 'W' )                               ! T-, W-point
            DO jl = 0, ipr2dj
               DO ji = 1, jpiglo
                  ijt = jpiglo-ji+1
                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-1-jl)
               END DO
            END DO
         CASE ( 'U' )                                     ! U-point
            DO jl = 0, ipr2dj
               DO ji = 1, jpiglo-1
                  iju = jpiglo-ji
                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
               END DO
            END DO
            pt2d(jpiglo,ijpj) = psgn * pt2d(1,ijpj-1)
         CASE ( 'V' )                                     ! V-point
            DO jl = 0, ipr2dj
               DO ji = 1, jpiglo
                  ijt = jpiglo-ji+1
                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl)
               END DO
            END DO
            DO ji = jpiglo/2+1, jpiglo
               ijt = jpiglo-ji+1
               pt2d(ji,ijpjm1) = psgn * pt2d(ijt,ijpjm1)
            END DO
         CASE ( 'F' )                               ! F-point
            DO jl = 0, ipr2dj
               DO ji = 1, jpiglo-1
                  iju = jpiglo-ji
                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl)
               END DO
            END DO
            pt2d(jpiglo,ijpj) = psgn * pt2d(1,ijpj-2)
            DO ji = jpiglo/2+1, jpiglo-1
               iju = jpiglo-ji
               pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)
            END DO
         CASE ( 'I' )                                  ! ice U-V point (I-point)
            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0._wp
            DO jl = 0, ipr2dj
               DO ji = 2 , jpiglo-1
                  ijt = jpiglo - ji + 2
                  pt2d(ji,ijpj+jl)= 0.5 * ( pt2d(ji,ijpj-1-jl) + psgn * pt2d(ijt,ijpj-1-jl) )
               END DO
            END DO
         END SELECT
         !
      CASE DEFAULT                           ! *  closed : the code probably never go through
         !
         SELECT CASE ( cd_nat)
         CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
            pt2d(:, 1:1-ipr2dj     ) = 0._wp
            pt2d(:,ijpj:ijpj+ipr2dj) = 0._wp
         CASE ( 'F' )                                   ! F-point
            pt2d(:,ijpj:ijpj+ipr2dj) = 0._wp
         CASE ( 'I' )                                   ! ice U-V point
            pt2d(:, 1:1-ipr2dj     ) = 0._wp
            pt2d(:,ijpj:ijpj+ipr2dj) = 0._wp
         END SELECT
         !
      END SELECT
      !
   END SUBROUTINE lbc_nfd_2d_org

   !!======================================================================
END MODULE lbcnfd