source: NEMO/branches/2018/dev_r9759_HPC09_ESIWACE/src/OCE/LBC/lbc_lnk_multi_generic.h90 @ 10136

#if defined DIM_2d
#   define ARRAY_TYPE(i,j,k,l)   REAL(wp), DIMENSION(i,j)
#   define PTR_TYPE              TYPE(PTR_2D)
#   define PTR_ptab              pt2d
#endif
#if defined DIM_3d
#   define ARRAY_TYPE(i,j,k,l)   REAL(wp), DIMENSION(i,j,k)
#   define PTR_TYPE              TYPE(PTR_3D)
#   define PTR_ptab              pt3d
#endif
#if defined DIM_4d
#   define ARRAY_TYPE(i,j,k,l)   REAL(wp), DIMENSION(i,j,k,l)
#   define PTR_TYPE              TYPE(PTR_4D)
#   define PTR_ptab              pt4d
#endif
#if defined ASYNC
   SUBROUTINE ROUTINE_MULTI( rname, loop_fct &
                           , pt1, cdna1, psgn1, pt2, cdna2, psgn2, pt3, cdna3, psgn3   &
      &                    , pt4, cdna4, psgn4, pt5, cdna5, psgn5, pt6, cdna6, psgn6   &
      &                    , pt7, cdna7, psgn7, pt8, cdna8, psgn8, pt9, cdna9, psgn9, cd_mpp, pval)
#else
   SUBROUTINE ROUTINE_MULTI( rname, pt1, cdna1, psgn1, pt2, cdna2, psgn2, pt3, cdna3, psgn3   &
      &                    , pt4, cdna4, psgn4, pt5, cdna5, psgn5, pt6, cdna6, psgn6   &
      &                    , pt7, cdna7, psgn7, pt8, cdna8, psgn8, pt9, cdna9, psgn9, cd_mpp, pval)
#endif
      !!---------------------------------------------------------------------
      ARRAY_TYPE(:,:,:,:)          , TARGET, INTENT(inout) ::   pt1     ! arrays on which the lbc is applied
      ARRAY_TYPE(:,:,:,:), OPTIONAL, TARGET, INTENT(inout) ::   pt2  ,  pt3  , pt4  , pt5  , pt6  , pt7  , pt8  , pt9
      CHARACTER(len=1)                     , INTENT(in   ) ::   cdna1   ! nature of pt2D. array grid-points
      CHARACTER(len=1)   , OPTIONAL        , INTENT(in   ) ::   cdna2,  cdna3, cdna4, cdna5, cdna6, cdna7, cdna8, cdna9
      REAL(wp)                             , INTENT(in   ) ::   psgn1   ! sign used across the north fold
      REAL(wp)           , OPTIONAL        , INTENT(in   ) ::   psgn2,  psgn3, psgn4, psgn5, psgn6, psgn7, psgn8, psgn9   
      CHARACTER(len=3)   , OPTIONAL        , INTENT(in   ) ::   cd_mpp  ! fill the overlap area only
      REAL(wp)           , OPTIONAL        , INTENT(in   ) ::   pval    ! background value (used at closed boundaries)
#ifdef ASYNC
      interface
        subroutine loop_fct(i0, i1, j0, j1, k0, k1, buf)
          integer, intent(in) :: i0, i1, j0, j1, k0, k1
          REAL*8, dimension(:,:,:,:,:,:), optional, intent(out) :: buf
        end subroutine loop_fct
      end interface
#endif
      !!
      INTEGER                         ::   kfld        ! number of elements that will be attributed
      PTR_TYPE         , DIMENSION(9) ::   ptab_ptr    ! pointer array
      CHARACTER(len=1) , DIMENSION(9) ::   cdna_ptr    ! nature of ptab_ptr grid-points
      REAL(wp)         , DIMENSION(9) ::   psgn_ptr    ! sign used across the north fold boundary
      CHARACTER(len=*),             INTENT(in   ) ::   rname       ! name of the calling subroutine
      !!---------------------------------------------------------------------
      !
      kfld = 0          ! initial array of pointer size
      !
      !                 ! Load the first array
      CALL ROUTINE_LOAD( pt1, cdna1, psgn1, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
      !
      !                 ! Look if more arrays are added
      IF( PRESENT(psgn2) )   CALL ROUTINE_LOAD( pt2, cdna2, psgn2, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
      IF( PRESENT(psgn3) )   CALL ROUTINE_LOAD( pt3, cdna3, psgn3, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
      IF( PRESENT(psgn4) )   CALL ROUTINE_LOAD( pt4, cdna4, psgn4, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
      IF( PRESENT(psgn5) )   CALL ROUTINE_LOAD( pt5, cdna5, psgn5, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
      IF( PRESENT(psgn6) )   CALL ROUTINE_LOAD( pt6, cdna6, psgn6, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
      IF( PRESENT(psgn7) )   CALL ROUTINE_LOAD( pt7, cdna7, psgn7, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
      IF( PRESENT(psgn8) )   CALL ROUTINE_LOAD( pt8, cdna8, psgn8, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
      IF( PRESENT(psgn9) )   CALL ROUTINE_LOAD( pt9, cdna9, psgn9, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
      !
#ifdef ASYNC
      CALL lbc_lnk_ptr_async( rname, ptab_ptr, cdna_ptr, psgn_ptr, loop_fct, kfld, cd_mpp, pval )
#else
      CALL lbc_lnk_ptr( rname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, cd_mpp, pval )
#endif
      !
   END SUBROUTINE ROUTINE_MULTI


   SUBROUTINE ROUTINE_LOAD( ptab, cdna, psgn, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
      !!---------------------------------------------------------------------
      ARRAY_TYPE(:,:,:,:)   , TARGET, INTENT(inout) ::   ptab       ! arrays on which the lbc is applied
      CHARACTER(len=1)              , INTENT(in   ) ::   cdna       ! nature of pt2d array grid-points
      REAL(wp)                      , INTENT(in   ) ::   psgn       ! sign used across the north fold boundary
      PTR_TYPE        , DIMENSION(:), INTENT(inout) ::   ptab_ptr   ! array of pointers
      CHARACTER(len=1), DIMENSION(:), INTENT(inout) ::   cdna_ptr   ! nature of pt2d_array array grid-points
      REAL(wp)        , DIMENSION(:), INTENT(inout) ::   psgn_ptr   ! sign used across the north fold boundary
      INTEGER                       , INTENT(inout) ::   kfld       ! number of elements that has been attributed
      !!---------------------------------------------------------------------
      !
      kfld                    =  kfld + 1
      ptab_ptr(kfld)%PTR_ptab => ptab
      cdna_ptr(kfld)          =  cdna
      psgn_ptr(kfld)          =  psgn
      !
   END SUBROUTINE ROUTINE_LOAD
#undef ARRAY_TYPE
#undef PTR_TYPE
#undef PTR_ptab