New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 10136 for NEMO/branches/2018 – NEMO

Changeset 10136 for NEMO/branches/2018


Ignore:
Timestamp:
2018-09-17T15:16:43+02:00 (6 years ago)
Author:
dguibert
Message:

bull: async/datatype

Experimental changes to enable/study/bench various mpi "optimisations":

  • BULL_ASYNC
  • BULL_DATATYPE_VECTOR/SUBARRAY

this has been applied to the nonosc subroutine (only for now).

Location:
NEMO/branches/2018/dev_r9759_HPC09_ESIWACE
Files:
54 added
1 deleted
6 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2018/dev_r9759_HPC09_ESIWACE/src/OCE/LBC/lbc_lnk_multi_generic.h90

    r9814 r10136  
    1414#   define PTR_ptab              pt4d 
    1515#endif 
     16#if defined ASYNC 
     17   SUBROUTINE ROUTINE_MULTI( rname, loop_fct & 
     18                           , pt1, cdna1, psgn1, pt2, cdna2, psgn2, pt3, cdna3, psgn3   & 
     19      &                    , pt4, cdna4, psgn4, pt5, cdna5, psgn5, pt6, cdna6, psgn6   & 
     20      &                    , pt7, cdna7, psgn7, pt8, cdna8, psgn8, pt9, cdna9, psgn9, cd_mpp, pval) 
     21#else 
    1622   SUBROUTINE ROUTINE_MULTI( rname, pt1, cdna1, psgn1, pt2, cdna2, psgn2, pt3, cdna3, psgn3   & 
    1723      &                    , pt4, cdna4, psgn4, pt5, cdna5, psgn5, pt6, cdna6, psgn6   & 
    1824      &                    , pt7, cdna7, psgn7, pt8, cdna8, psgn8, pt9, cdna9, psgn9, cd_mpp, pval) 
     25#endif 
    1926      !!--------------------------------------------------------------------- 
    2027      ARRAY_TYPE(:,:,:,:)          , TARGET, INTENT(inout) ::   pt1     ! arrays on which the lbc is applied 
    … …  
    2633      CHARACTER(len=3)   , OPTIONAL        , INTENT(in   ) ::   cd_mpp  ! fill the overlap area only 
    2734      REAL(wp)           , OPTIONAL        , INTENT(in   ) ::   pval    ! background value (used at closed boundaries) 
     35#ifdef ASYNC 
     36      interface 
     37        subroutine loop_fct(i0, i1, j0, j1, k0, k1, buf) 
     38          integer, intent(in) :: i0, i1, j0, j1, k0, k1 
     39          REAL*8, dimension(:,:,:,:,:,:), optional, intent(out) :: buf 
     40        end subroutine loop_fct 
     41      end interface 
     42#endif 
    2843      !! 
    2944      INTEGER                         ::   kfld        ! number of elements that will be attributed 
    … …  
    4964      IF( PRESENT(psgn9) )   CALL ROUTINE_LOAD( pt9, cdna9, psgn9, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    5065      ! 
     66#ifdef ASYNC 
     67      CALL lbc_lnk_ptr_async( rname, ptab_ptr, cdna_ptr, psgn_ptr, loop_fct, kfld, cd_mpp, pval ) 
     68#else 
    5169      CALL lbc_lnk_ptr( rname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, cd_mpp, pval ) 
     70#endif 
    5271      ! 
    5372   END SUBROUTINE ROUTINE_MULTI 

  • NEMO/branches/2018/dev_r9759_HPC09_ESIWACE/src/OCE/LBC/lbclnk.F90

    r9814 r10136  
    5050   PUBLIC   lbc_lnk_icb   ! iceberg lateral boundary conditions 
    5151 
     52#ifdef BULL_ASYNC 
     53   INTERFACE lbc_lnk_async 
     54      MODULE PROCEDURE   mpp_lnk_2d_async      , mpp_lnk_3d_async      , mpp_lnk_4d_async 
     55   END INTERFACE 
     56   INTERFACE lbc_lnk_ptr_async 
     57      MODULE PROCEDURE   mpp_lnk_2d_ptr_async  , mpp_lnk_3d_ptr_async  , mpp_lnk_4d_ptr_async 
     58   END INTERFACE 
     59   INTERFACE lbc_lnk_multi_async 
     60      MODULE PROCEDURE   lbc_lnk_2d_multi_async, lbc_lnk_3d_multi_async, lbc_lnk_4d_multi_async 
     61   END INTERFACE 
     62 
     63   PUBLIC   lbc_lnk_async       ! ocean/ice  lateral boundary conditions 
     64   PUBLIC   lbc_lnk_multi_async ! modified ocean/ice lateral boundary conditions 
     65#endif 
     66 
    5267   PUBLIC   simulated_lbc_lnk 
    5368 
    … …  
    91106      MODULE PROCEDURE   lbc_lnk_2d_multi, lbc_lnk_3d_multi, lbc_lnk_4d_multi 
    92107   END INTERFACE 
     108 
    93109   ! 
    94110   INTERFACE lbc_bdy_lnk 
    … …  
    104120   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions 
    105121   PUBLIC   lbc_lnk_icb   ! iceberg lateral boundary conditions 
    106     
     122   
    107123   !!---------------------------------------------------------------------- 
    108124   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    327343#     undef ROUTINE_LOAD 
    328344#  undef DIM_4d 
     345 
     346#ifdef BULL_ASYNC 
     347#define ASYNC 
     348#  define DIM_2d 
     349#     define ROUTINE_MULTI          lbc_lnk_2d_multi_async 
     350#     define ROUTINE_LOAD           load_ptr_2d_async 
     351#     include "lbc_lnk_multi_generic.h90" 
     352#     undef ROUTINE_MULTI 
     353#     undef ROUTINE_LOAD 
     354#  undef DIM_2d 
     355 
     356 
     357#  define DIM_3d 
     358#     define ROUTINE_MULTI          lbc_lnk_3d_multi_async 
     359#     define ROUTINE_LOAD           load_ptr_3d_async 
     360#     include "lbc_lnk_multi_generic.h90" 
     361#     undef ROUTINE_MULTI 
     362#     undef ROUTINE_LOAD 
     363#  undef DIM_3d 
     364 
     365 
     366#  define DIM_4d 
     367#     define ROUTINE_MULTI          lbc_lnk_4d_multi_async 
     368#     define ROUTINE_LOAD           load_ptr_4d_async 
     369#     include "lbc_lnk_multi_generic.h90" 
     370#     undef ROUTINE_MULTI 
     371#     undef ROUTINE_LOAD 
     372#  undef DIM_4d 
     373 
     374#undef ASYNC 
     375#endif 
    329376 
    330377   SUBROUTINE simulated_lbc_lnk () 

  • NEMO/branches/2018/dev_r9759_HPC09_ESIWACE/src/OCE/LBC/lib_mpp.F90

    r9814 r10136  
    7272   PUBLIC   mpp_lnk_2d_ptr, mpp_lnk_3d_ptr, mpp_lnk_4d_ptr 
    7373   ! 
     74#ifdef BULL_ASYNC 
     75   ! Interface associated to the mpp_lnk_... routines is defined in lbclnk 
     76   PUBLIC   mpp_lnk_2d_async    , mpp_lnk_3d_async    , mpp_lnk_4d_async 
     77   PUBLIC   mpp_lnk_2d_ptr_async, mpp_lnk_3d_ptr_async, mpp_lnk_4d_ptr_async 
     78#endif 
    7479!!gm  this should be useless 
    7580   PUBLIC   mpp_nfd_2d    , mpp_nfd_3d    , mpp_nfd_4d 
    … …  
    270275            WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send     ;   ii = ii + 1 
    271276            kstop = kstop + 1 
     277            WRITE(*,*) '           bad value for cn_mpi_send = ', cn_mpi_send     ;   ii = ii + 1 
    272278         END SELECT 
    273279         ! 
    … …  
    276282         WRITE(ldtxt(ii),*) '          without calling MPI_Init before ! '                ;   ii = ii + 1 
    277283         kstop = kstop + 1 
     284         WRITE(*,*) ' lib_mpp: You cannot provide a local communicator '          ;   ii = ii + 1 
    278285      ELSE 
    279286         SELECT CASE ( cn_mpi_send ) 
    … …  
    292299            WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send     ;   ii = ii + 1 
    293300            kstop = kstop + 1 
     301            WRITE(*,*) '           bad value for cn_mpi_send = ', cn_mpi_send     ;   ii = ii + 1 
    294302         END SELECT 
    295303         ! 
    … …  
    383391#     undef MULTI 
    384392#  undef DIM_4d 
     393 
     394#ifdef BULL_ASYNC 
     395# define ASYNC 
     396 
     397#if (defined BULL_MPI_DATATYPE || defined BULL_MPI_DATATYPE_SUBARRAY) 
     398# define MPI_DATATYPE_SUBARRAY 
     399#warning "MPI_DATATYPE_SUBARRAY" 
     400#ifdef BULL_MPI_DATATYPE_VECTOR 
     401#undef MPI_DATATYPE_VECTOR 
     402#warning "BULL_MPI_DATATYPE_SUBARRAY and BULL_MPI_DATATYPE_VECTOR are defined: undef BULL_MPI_DATATYPE_VECTOR" 
     403#endif 
     404#endif 
     405#ifdef BULL_MPI_DATATYPE_VECTOR 
     406# define MPI_DATATYPE_VECTOR 
     407#warning "MPI_DATATYPE_VECTOR" 
     408#endif 
     409   !!---------------------------------------------------------------------- 
     410   !!                   ***  routine mpp_lnk_(2,3,4)d  *** 
     411   !! 
     412   !!   * Argument : dummy argument use in mpp_lnk_... routines 
     413   !!                ptab   :   array or pointer of arrays on which the boundary condition is applied 
     414   !!                cd_nat :   nature of array grid-points 
     415   !!                psgn   :   sign used across the north fold boundary 
     416   !!                kfld   :   optional, number of pt3d arrays 
     417   !!                cd_mpp :   optional, fill the overlap area only 
     418   !!                pval   :   optional, background value (used at closed boundaries) 
     419   !!---------------------------------------------------------------------- 
     420   ! 
     421   !                       !==  2D array and array of 2D pointer  ==! 
     422   ! 
     423#  define DIM_2d 
     424#     define ROUTINE_LNK           mpp_lnk_2d_async 
     425#     include "mpp_lnk_generic.h90" 
     426#     undef ROUTINE_LNK 
     427#     define MULTI 
     428#     define ROUTINE_LNK           mpp_lnk_2d_ptr_async 
     429#     include "mpp_lnk_generic.h90" 
     430#     undef ROUTINE_LNK 
     431#     undef MULTI 
     432#  undef DIM_2d 
     433   ! 
     434   !                       !==  3D array and array of 3D pointer  ==! 
     435   ! 
     436#  define DIM_3d 
     437#     define ROUTINE_LNK           mpp_lnk_3d_async 
     438#     include "mpp_lnk_generic.h90" 
     439#     undef ROUTINE_LNK 
     440#     define MULTI 
     441#     define ROUTINE_LNK           mpp_lnk_3d_ptr_async 
     442#     include "mpp_lnk_generic.h90" 
     443#     undef ROUTINE_LNK 
     444#     undef MULTI 
     445#  undef DIM_3d 
     446   ! 
     447   !                       !==  4D array and array of 4D pointer  ==! 
     448   ! 
     449#  define DIM_4d 
     450#     define ROUTINE_LNK           mpp_lnk_4d_async 
     451#     include "mpp_lnk_generic.h90" 
     452#     undef ROUTINE_LNK 
     453#     define MULTI 
     454#     define ROUTINE_LNK           mpp_lnk_4d_ptr_async 
     455#     include "mpp_lnk_generic.h90" 
     456#     undef ROUTINE_LNK 
     457#     undef MULTI 
     458#  undef DIM_4d 
     459 
     460#undef ASYNC 
     461#undef MPI_DATATYPE 
     462#endif 
    385463 
    386464   !!---------------------------------------------------------------------- 

  • NEMO/branches/2018/dev_r9759_HPC09_ESIWACE/src/OCE/LBC/mpp_lnk_generic.h90

    r9844 r10136  
    11#if defined MULTI 
    2 #   define NAT_IN(k)                cd_nat(k)    
     2#   define NAT_IN(k)                cd_nat(k) 
    33#   define SGN_IN(k)                psgn(k) 
    44#   define F_SIZE(ptab)             kfld 
    … …  
    99#      define K_SIZE(ptab)             1 
    1010#      define L_SIZE(ptab)             1 
     11#      define _INDEX(i,j,k,l)          (i+((j)+((0)+(0)*ipk)*jpj)*jpi) 
    1112#   endif 
    1213#   if defined DIM_3d 
    … …  
    1516#      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3) 
    1617#      define L_SIZE(ptab)             1 
     18#      define _INDEX(i,j,k,l)          (i+((j)+((k)+(0)*ipk)*jpj)*jpi) 
    1719#   endif 
    1820#   if defined DIM_4d 
    … …  
    2123#      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3) 
    2224#      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4) 
     25#      define _INDEX(i,j,k,l)          (i+((j)+((k)+(l)*ipk)*jpj)*jpi) 
    2326#   endif 
    2427#else 
    … …  
    2730#   define SGN_IN(k)                psgn 
    2831#   define F_SIZE(ptab)             1 
    29 #   define OPT_K(k)                  
     32#   define OPT_K(k) 
    3033#   if defined DIM_2d 
    3134#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j) 
    3235#      define K_SIZE(ptab)          1 
    3336#      define L_SIZE(ptab)          1 
     37#      define _INDEX(i,j,k,l)          (i+((j)+((0)+(0)*ipk)*jpj)*jpi) 
    3438#   endif 
    3539#   if defined DIM_3d 
    … …  
    3741#      define K_SIZE(ptab)          SIZE(ptab,3) 
    3842#      define L_SIZE(ptab)          1 
     43#      define _INDEX(i,j,k,l)          (i+((j)+((k)+(0)*ipk)*jpj)*jpi) 
    3944#   endif 
    4045#   if defined DIM_4d 
    … …  
    4247#      define K_SIZE(ptab)          SIZE(ptab,3) 
    4348#      define L_SIZE(ptab)          SIZE(ptab,4) 
     49#      define _INDEX(i,j,k,l)          (i+((j)+((k)+(l)*ipk)*jpj)*jpi) 
    4450#   endif 
    4551#endif 
    4652 
    4753#if defined MULTI 
    48    SUBROUTINE ROUTINE_LNK( rname, ptab, cd_nat, psgn, kfld, cd_mpp, pval ) 
     54#if defined ASYNC 
     55   SUBROUTINE ROUTINE_LNK( rname, ptab, cd_nat, psgn, loop_fct, kfld, cd_mpp, pval ) 
    4956      INTEGER                     , INTENT(in   ) ::   kfld        ! number of pt3d arrays 
    5057#else 
    51    SUBROUTINE ROUTINE_LNK( rname, ptab, cd_nat, psgn      , cd_mpp, pval ) 
     58   SUBROUTINE ROUTINE_LNK( rname, ptab, cd_nat, psgn          , kfld, cd_mpp, pval ) 
     59      INTEGER                     , INTENT(in   ) ::   kfld        ! number of pt3d arrays 
     60#endif 
     61#else 
     62#if defined ASYNC 
     63   SUBROUTINE ROUTINE_LNK( rname, ptab, cd_nat, psgn, loop_fct,       cd_mpp, pval ) 
     64#else 
     65   SUBROUTINE ROUTINE_LNK( rname, ptab, cd_nat, psgn,                 cd_mpp, pval ) 
     66#endif 
     67#endif 
     68#ifdef SCOREP_USER_ENABLE 
     69#include "scorep/SCOREP_User.inc" 
     70#else 
     71#define SCOREP_USER_REGION_BEGIN ! 
     72#define SCOREP_USER_REGION_END   ! 
    5273#endif 
    5374      ARRAY_TYPE(:,:,:,:,:)                                        ! array or pointer of arrays on which the boundary condition is applied 
    … …  
    5677      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp      ! fill the overlap area only 
    5778      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval        ! background value (used at closed boundaries) 
     79#ifdef ASYNC 
     80      interface 
     81        subroutine loop_fct(i0, i1, j0, j1, k0, k1, buf) 
     82          integer, intent(in) :: i0, i1, j0, j1, k0, k1 
     83          ! @BULL_FIXME 
     84          ! lib_mpp.f90(4209): error #6683: A kind type parameter must be a compile-time constant.   [WP] 
     85          !          REAL(wp), dimension(:), optional, intent(out) :: buf 
     86          REAL*8, dimension(:,:,:,:,:,:), optional, intent(out) :: buf 
     87        end subroutine loop_fct 
     88      end interface 
     89#endif 
    5890      CHARACTER(len=*),             INTENT(in   ) ::   rname       ! name of the calling subroutine 
    5991      ! 
    … …  
    6698      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! north-south & south-north  halos 
    6799      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! east -west  & west - east  halos 
     100#ifdef ASYNC 
     101      integer :: iflag, i 
     102      logical :: finished 
     103#if (defined MPI_DATATYPE_SUBARRAY || defined MPI_DATATYPE_VECTOR) 
     104      integer :: ml_reqs(8,F_SIZE(ptab)) 
     105#else 
     106      integer :: ml_reqs(8) 
     107#endif 
     108#endif 
     109#ifdef SCOREP_USER_ENABLE 
     110      integer :: ier 
     111      SCOREP_USER_REGION_DEFINE( reg_cb ) 
     112      SCOREP_USER_REGION_DEFINE( reg_cbWhole ) 
     113      SCOREP_USER_REGION_DEFINE( reg_cbWE ) 
     114      SCOREP_USER_REGION_DEFINE( reg_cbNS ) 
     115      SCOREP_USER_REGION_DEFINE( reg_cbCenter ) 
     116      SCOREP_USER_REGION_DEFINE( reg_pack ) 
     117      SCOREP_USER_REGION_DEFINE( reg_unpack ) 
     118#if (defined MPI_DATATYPE_SUBARRAY || defined MPI_DATATYPE_VECTOR) 
     119      SCOREP_USER_REGION_DEFINE( reg_datatype ) 
     120#endif 
     121#endif 
     122#ifdef MPI_DATATYPE_VECTOR 
     123      integer :: type_ns, type_ew 
     124#endif 
     125#ifdef MPI_DATATYPE_SUBARRAY 
     126      integer :: ndims 
     127      integer, dimension(4) :: array_of_sizes 
     128      integer, dimension(4) :: array_of_subsizes 
     129      integer, dimension(4) :: array_of_starts 
     130      integer :: type_north_halo, type_north_ghost 
     131      integer :: type_south_halo, type_south_ghost 
     132      integer :: type_west_halo, type_west_ghost 
     133      integer :: type_east_halo, type_east_ghost 
     134#endif 
     135      real*8 :: t0 
     136      real*8, save :: time=0.0 
     137 
     138#ifdef ASYNC 
     139      ml_reqs = MPI_REQUEST_NULL 
     140#endif 
    68141      !!---------------------------------------------------------------------- 
    69142      ! 
    … …  
    72145      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers) 
    73146      ! 
     147#if !(defined MPI_DATATYPE_SUBARRAY || defined MPI_DATATYPE_VECTOR) 
    74148      ALLOCATE( zt3ns(jpi,nn_hls,ipk,ipl,ipf,2), zt3sn(jpi,nn_hls,ipk,ipl,ipf,2),   & 
    75149         &      zt3ew(jpj,nn_hls,ipk,ipl,ipf,2), zt3we(jpj,nn_hls,ipk,ipl,ipf,2)  ) 
     150#endif 
    76151      ! 
    77152      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value 
    … …  
    79154      ENDIF 
    80155 
     156#ifndef ASYNC 
    81157      ! ------------------------------- ! 
    82158      !   standard boundary treatment   !    ! CAUTION: semi-column notation is often impossible 
    … …  
    133209      ! we play with the neigbours AND the row number because of the periodicity 
    134210      ! 
     211      SCOREP_USER_REGION_BEGIN( reg_pack, "pack", SCOREP_USER_REGION_TYPE_COMMON ) 
    135212      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
    136213      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
    … …  
    147224         END DO 
    148225      END SELECT 
     226      SCOREP_USER_REGION_END( reg_pack ) 
    149227      ! 
    150228      !                           ! Migrations 
    … …  
    210288      iihom = nlci-nn_hls 
    211289      ! 
     290      SCOREP_USER_REGION_BEGIN( reg_unpack, "unpack", SCOREP_USER_REGION_TYPE_COMMON ) 
    212291      SELECT CASE ( nbondi ) 
    213292      CASE ( -1 ) 
    … …  
    243322         END DO 
    244323      END SELECT 
     324      SCOREP_USER_REGION_END( reg_unpack ) 
    245325 
    246326      ! 3. North and south directions 
    … …  
    248328      ! always closed : we play only with the neigbours 
    249329      ! 
     330      SCOREP_USER_REGION_BEGIN( reg_pack, "pack", SCOREP_USER_REGION_TYPE_COMMON ) 
    250331      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
    251332         ijhom = nlcj-nrecj 
    … …  
    261342         END DO 
    262343      ENDIF 
     344#ifdef SCOREP_USER_ENABLE 
     345      SCOREP_USER_REGION_END( reg_pack ) 
     346#endif 
    263347      ! 
    264348      !                           ! Migrations 
    … …  
    271355         ! 
    272356         CALL tic_tac(.TRUE.) 
    273          !  
     357         ! 
    274358         SELECT CASE ( nbondj ) 
    275359         CASE ( -1 ) 
    … …  
    295379      ! 
    296380      !                           ! Write Dirichlet lateral conditions 
     381      SCOREP_USER_REGION_BEGIN( reg_unpack, "unpack", SCOREP_USER_REGION_TYPE_COMMON ) 
    297382      ijhom = nlcj-nn_hls 
    298383      ! 
    … …  
    330415         END DO 
    331416      END SELECT 
    332  
     417      SCOREP_USER_REGION_END( reg_unpack ) 
     418#else 
     419! ASYNC implementation 
     420 
     421! prepare receptions 
     422   !SUBROUTINE mpprecv( ktyp, pmess, kbytes, ksource ) 
     423   !CALL mpi_recv( pmess, kbytes, mpi_double_precision, use_source, ktyp, mpi_comm_oce, istatus, iflag ) 
     424#ifdef MPI_DATATYPE_VECTOR 
     425!      IF( ln_timing )  t0=MPI_Wtime()  
     426      SCOREP_USER_REGION_BEGIN( reg_datatype, "datatype vector", SCOREP_USER_REGION_TYPE_COMMON ) 
     427      ! int MPI_Type_vector(int count, 
     428      !                 int blocklength, 
     429      !                 int stride, 
     430      !                 MPI_Datatype old_type, 
     431      !                 MPI_Datatype *newtype_p)         
     432#ifdef DIM_2d 
     433      ! NS 
     434      call MPI_Type_contiguous((jpi-2*nn_hls), MPI_DOUBLE_PRECISION, type_ns, iflag) 
     435      call MPI_Type_commit(type_ns, iflag) 
     436      ! EW 
     437      call MPI_Type_vector((jpj-2*nn_hls), nn_hls, jpi, MPI_DOUBLE_PRECISION, type_ew, iflag) 
     438      call MPI_Type_commit(type_ew, iflag) 
     439#endif 
     440#   if (defined DIM_3d || defined DIM_4d) 
     441      ! NS 
     442      call MPI_Type_vector(nn_hls             *ipk*ipl,          (jpi-2*nn_hls), jpi*jpj, MPI_DOUBLE_PRECISION, type_ns, iflag) 
     443      call MPI_Type_commit(type_ns, iflag) 
     444      ! EW 
     445      call MPI_Type_vector(       (jpj-2*nn_hls)*ipk*ipl, nn_hls               , jpi,     MPI_DOUBLE_PRECISION, type_ew, iflag) 
     446      call MPI_Type_commit(type_ew, iflag) 
     447#endif 
     448      SCOREP_USER_REGION_END( reg_datatype ) 
     449!      IF( ln_timing ) time=time+MPI_Wtime()-t0 
     450!      IF( ln_timing ) write(*,*) 'timing datatype vector: ',time 
     451 
     452      DO jf = 1, ipf 
     453         SELECT CASE ( nbondi ) 
     454         CASE ( -1 ) 
     455           call mpi_irecv(ARRAY_IN(1,2,1,1,jf), 1, type_ew, noea, 8*jf+1, mpi_comm_oce, ml_reqs(1,jf), iflag) 
     456         CASE ( 0 ) 
     457           call mpi_irecv(ARRAY_IN(1,2,1,1,jf), 1, type_ew, noea, 8*jf+1, mpi_comm_oce, ml_reqs(1,jf), iflag) 
     458           call mpi_irecv(ARRAY_IN(jpi-nn_hls,2,1,1,jf), 1, type_ew, nowe, 8*jf+2, mpi_comm_oce, ml_reqs(2,jf), iflag) 
     459         CASE ( 1 ) 
     460           call mpi_irecv(ARRAY_IN(jpi-nn_hls,2,1,1,jf), 1, type_ew, nowe, 8*jf+2, mpi_comm_oce, ml_reqs(2,jf), iflag) 
     461         END SELECT 
     462 
     463         SELECT CASE ( nbondj ) 
     464         CASE ( -1 ) 
     465           call mpi_irecv(ARRAY_IN(2,jpj-nn_hls,1,1,jf), 1, type_ns, nono, 8*jf+3, mpi_comm_oce, ml_reqs(3,jf), iflag) 
     466         CASE ( 0 ) 
     467           call mpi_irecv(ARRAY_IN(2,jpj-nn_hls,1,1,jf), 1, type_ns, nono, 8*jf+3, mpi_comm_oce, ml_reqs(3,jf), iflag) 
     468           call mpi_irecv(ARRAY_IN(2,1,1,1,jf), 1, type_ns, noso, 8*jf+4, mpi_comm_oce, ml_reqs(4,jf), iflag) 
     469         CASE ( 1 ) 
     470           call mpi_irecv(ARRAY_IN(2,1,1,1,jf), 1, type_ns, noso, 8*jf+4, mpi_comm_oce, ml_reqs(4,jf), iflag) 
     471         END SELECT 
     472      end do 
     473#endif 
     474 
     475#ifdef MPI_DATATYPE_SUBARRAY 
     476      IF( ln_timing )   CALL timing_start('datatype subarray') 
     477      SCOREP_USER_REGION_BEGIN( reg_datatype, "datatype", SCOREP_USER_REGION_TYPE_COMMON ) 
     478 
     479      array_of_sizes = (/ jpi, jpj, ipk, ipl /) 
     480      array_of_subsizes(3:4) = (/ ipk, ipl /) 
     481      array_of_starts(3:4) = 0 
     482#   if defined DIM_2d 
     483      ndims = 2 
     484#   endif 
     485#   if defined DIM_3d 
     486      ndims = 3 
     487#   endif 
     488#   if defined DIM_4d 
     489      ndims = 4 
     490#   endif 
     491      ! ------------------------------- ! 
     492      !      East and west exchange     ! 
     493      ! ------------------------------- ! 
     494      array_of_subsizes(1:2) = (/ nn_hls, jpj-2*nn_hls /) 
     495 
     496      array_of_starts(1:2) = (/ 1, 1 /) ! zero indexing (as in C) 
     497      call MPI_Type_create_subarray( ndims, array_of_sizes, array_of_subsizes, array_of_starts, MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, type_west_halo, iflag) 
     498      call MPI_Type_commit(type_west_halo, iflag) 
     499      array_of_starts(1:2) = (/ 0, 1 /) ! zero indexing (as in C) 
     500      call MPI_Type_create_subarray( ndims, array_of_sizes, array_of_subsizes, array_of_starts, MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, type_west_ghost, iflag) 
     501      call MPI_Type_commit(type_west_ghost, iflag) 
     502 
     503      array_of_starts(1:2) = (/ jpi-1-nn_hls, 1 /) ! zero indexing (as in C) 
     504      call MPI_Type_create_subarray( ndims, array_of_sizes, array_of_subsizes, array_of_starts, MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, type_east_halo, iflag) 
     505      call MPI_Type_commit(type_east_halo, iflag) 
     506      array_of_starts(1:2) = (/ jpi-nn_hls, 1 /) ! zero indexing (as in C) 
     507      call MPI_Type_create_subarray( ndims, array_of_sizes, array_of_subsizes, array_of_starts, MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, type_east_ghost, iflag) 
     508      call MPI_Type_commit(type_east_ghost, iflag) 
     509 
     510      ! ------------------------------- ! 
     511      !      North and south exchange     ! 
     512      ! ------------------------------- ! 
     513      array_of_subsizes(1:2) = (/ jpi-2*nn_hls, nn_hls /) 
     514 
     515      array_of_starts(1:2) = (/ 1, 1 /) ! zero indexing (as in C) 
     516      call MPI_Type_create_subarray( ndims, array_of_sizes, array_of_subsizes, array_of_starts, MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, type_south_halo, iflag) 
     517      call MPI_Type_commit(type_south_halo, iflag) 
     518      array_of_starts(1:2) = (/ 1, 0 /) ! zero indexing (as in C) 
     519      call MPI_Type_create_subarray( ndims, array_of_sizes, array_of_subsizes, array_of_starts, MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, type_south_ghost, iflag) 
     520      call MPI_Type_commit(type_south_ghost, iflag) 
     521 
     522      array_of_starts(1:2) = (/ 1, jpj-1-nn_hls /) ! zero indexing (as in C) 
     523      call MPI_Type_create_subarray( ndims, array_of_sizes, array_of_subsizes, array_of_starts, MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, type_north_halo, iflag) 
     524      call MPI_Type_commit(type_north_halo, iflag) 
     525      array_of_starts(1:2) = (/ 1, jpj-nn_hls /) ! zero indexing (as in C) 
     526      call MPI_Type_create_subarray( ndims, array_of_sizes, array_of_subsizes, array_of_starts, MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, type_north_ghost, iflag) 
     527      call MPI_Type_commit(type_north_ghost, iflag) 
     528#ifdef SCOREP_USER_ENABLE 
     529      SCOREP_USER_REGION_END( reg_datatype ) 
     530#endif 
     531      IF( ln_timing )   CALL timing_stop('datatype subarray') 
     532 
     533      DO jf = 1, ipf 
     534         SELECT CASE ( nbondi ) 
     535         CASE ( -1 ) 
     536           call mpi_irecv(ARRAY_IN(:,:,:,:,jf), 1, type_east_ghost, noea, 8*jf+1, mpi_comm_oce, ml_reqs(1,jf), iflag) 
     537         CASE ( 0 ) 
     538           call mpi_irecv(ARRAY_IN(:,:,:,:,jf), 1, type_east_ghost, noea, 8*jf+1, mpi_comm_oce, ml_reqs(1,jf), iflag) 
     539           call mpi_irecv(ARRAY_IN(:,:,:,:,jf), 1, type_west_ghost, nowe, 8*jf+2, mpi_comm_oce, ml_reqs(2,jf), iflag) 
     540         CASE ( 1 ) 
     541           call mpi_irecv(ARRAY_IN(:,:,:,:,jf), 1, type_west_ghost, nowe, 8*jf+2, mpi_comm_oce, ml_reqs(2,jf), iflag) 
     542         END SELECT 
     543 
     544         SELECT CASE ( nbondj ) 
     545         CASE ( -1 ) 
     546           call mpi_irecv(ARRAY_IN(:,:,:,:,jf), 1, type_north_ghost, nono, 8*jf+3, mpi_comm_oce, ml_reqs(3,jf), iflag) 
     547         CASE ( 0 ) 
     548           call mpi_irecv(ARRAY_IN(:,:,:,:,jf), 1, type_north_ghost, nono, 8*jf+3, mpi_comm_oce, ml_reqs(3,jf), iflag) 
     549           call mpi_irecv(ARRAY_IN(:,:,:,:,jf), 1, type_south_ghost, noso, 8*jf+4, mpi_comm_oce, ml_reqs(4,jf), iflag) 
     550         CASE ( 1 ) 
     551           call mpi_irecv(ARRAY_IN(:,:,:,:,jf), 1, type_south_ghost, noso, 8*jf+4, mpi_comm_oce, ml_reqs(4,jf), iflag) 
     552         END SELECT 
     553      end do 
     554#endif 
     555#if !(defined MPI_DATATYPE_SUBARRAY || defined MPI_DATATYPE_VECTOR) 
     556      !                           ! Migrations 
     557      imigr = nn_hls * jpj * ipk * ipl * ipf 
     558      ! 
     559      SELECT CASE ( nbondi ) 
     560      CASE ( -1 ) 
     561        call mpi_irecv(zt3ew(1,1,1,1,1,2), imigr, MPI_DOUBLE_PRECISION, noea, 1, mpi_comm_oce, ml_reqs(1), iflag) 
     562      CASE ( 0 ) 
     563        call mpi_irecv(zt3ew(1,1,1,1,1,2), imigr, MPI_DOUBLE_PRECISION, noea, 1, mpi_comm_oce, ml_reqs(1), iflag) 
     564        call mpi_irecv(zt3we(1,1,1,1,1,2), imigr, MPI_DOUBLE_PRECISION, nowe, 2, mpi_comm_oce, ml_reqs(2), iflag) 
     565      CASE ( 1 ) 
     566        call mpi_irecv(zt3we(1,1,1,1,1,2), imigr, MPI_DOUBLE_PRECISION, nowe, 2, mpi_comm_oce, ml_reqs(2), iflag) 
     567      END SELECT 
     568 
     569      imigr = nn_hls * jpi * ipk * ipl * ipf 
     570      SELECT CASE ( nbondj ) 
     571      CASE ( -1 ) 
     572        call mpi_irecv(zt3ns(1,1,1,1,1,2), imigr, MPI_DOUBLE_PRECISION, nono, 3, mpi_comm_oce, ml_reqs(3), iflag) 
     573      CASE ( 0 ) 
     574        call mpi_irecv(zt3ns(1,1,1,1,1,2), imigr, MPI_DOUBLE_PRECISION, nono, 3, mpi_comm_oce, ml_reqs(3), iflag) 
     575        call mpi_irecv(zt3sn(1,1,1,1,1,2), imigr, MPI_DOUBLE_PRECISION, noso, 4, mpi_comm_oce, ml_reqs(4), iflag) 
     576      CASE ( 1 ) 
     577        call mpi_irecv(zt3sn(1,1,1,1,1,2), imigr, MPI_DOUBLE_PRECISION, noso, 4, mpi_comm_oce, ml_reqs(4), iflag) 
     578      END SELECT 
     579#endif 
     580 
     581! compute West 
     582#define TI 1 
     583#define TJ 1 
     584 
     585#define I0 2 
     586#define I1 jpi-1 
     587#define J0 2 
     588#define J1 jpj-1 
     589 
     590#define FULL_ROWS (I0 == 2 && I1 == jpi-1) 
     591#define FULL_COLUMNS (J0 == 2 && J1 == jpi-1) 
     592#define WHOLE_RANGE (FULL_ROWS && FULL_COLUMNS) 
     593 
     594#if (FULL_ROWS && FULL_COLUMNS) 
     595#warning "BULL: lib_mpp will compute whole cb " 
     596      SCOREP_USER_REGION_BEGIN( reg_cb, "cb", SCOREP_USER_REGION_TYPE_COMMON ) 
     597      SCOREP_USER_REGION_BEGIN( reg_cbWhole, "cb whole", SCOREP_USER_REGION_TYPE_COMMON ) 
     598      call loop_fct( I0, I1 & 
     599                   , J0, J1  & ! stand for 3,jpjm2 
     600                   , 1, jpkm1 & ! TODO check if always jpkm1 
     601                   ) 
     602      SCOREP_USER_REGION_END( reg_cbWhole ) 
     603      SCOREP_USER_REGION_END( reg_cb ) 
     604#endif 
     605 
     606#if !FULL_COLUMNS 
     607#warning "BULL: lib_mpp will compute cb S" 
     608      SCOREP_USER_REGION_BEGIN( reg_cb, "cb", SCOREP_USER_REGION_TYPE_COMMON ) 
     609      SCOREP_USER_REGION_BEGIN( reg_cbNS, "cbns", SCOREP_USER_REGION_TYPE_COMMON ) 
     610! asynchrously send South 
     611      call loop_fct( I0, I1 & 
     612                   , J0-1, J0-1 & 
     613                   , 1, jpkm1 & ! TODO check if always jpkm1 
     614                   ) 
     615      SCOREP_USER_REGION_END( reg_cbNS ) 
     616      SCOREP_USER_REGION_END( reg_cb ) 
     617#endif 
     618      ! 3. South directions 
     619      ! ----------------------------- 
     620      SCOREP_USER_REGION_BEGIN( reg_pack, "pack", SCOREP_USER_REGION_TYPE_COMMON ) 
     621#ifdef MPI_DATATYPE_SUBARRAY 
     622      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
     623      CASE ( 0, 1 )                ! all exept 2 (i.e. close case) 
     624        DO jf = 1, ipf 
     625#ifdef BULL_ISEND 
     626          call mpi_isend(ARRAY_IN(:,:,:,:,jf), 1, type_south_halo, noso, 8*jf+3, mpi_comm_oce, ml_reqs(4+3,jf), iflag) 
     627#else 
     628          call mpi_send(ARRAY_IN(:,:,:,:,jf), 1, type_south_halo, noso, 8*jf+3, mpi_comm_oce, iflag) 
     629#endif 
     630        END DO 
     631      END SELECT 
     632#elif (defined MPI_DATATYPE_VECTOR) 
     633      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
     634      CASE ( 0, 1 )                ! all exept 2 (i.e. close case) 
     635        DO jf = 1, ipf 
     636#ifdef BULL_ISEND 
     637          call mpi_isend(ARRAY_IN(2,2,1,1,jf), 1, type_ns, noso, 8*jf+3, mpi_comm_oce, ml_reqs(4+3,jf), iflag) 
     638#else 
     639          call mpi_send(ARRAY_IN(2,2,1,1,jf), 1, type_ns, noso, 8*jf+3, mpi_comm_oce, iflag) 
     640#endif 
     641        END DO 
     642      END SELECT 
     643#else 
     644      ! always closed : we play only with the neigbours 
     645      ! 
     646      imigr = nn_hls * jpi * ipk * ipl * ipf 
     647      SELECT CASE ( nbondj )      ! Read Dirichlet lateral conditions 
     648      CASE ( 0, 1 )                ! all exept 2 (i.e. close case) 
     649         ijhom = nlcj-nrecj 
     650         DO jf = 1, ipf 
     651            DO jl = 1, ipl 
     652               DO jk = 1, ipk 
     653                  DO jh = 1, nn_hls 
     654                     zt3ns(:,jh,jk,jl,jf,1) = ARRAY_IN(:,nn_hls+jh,jk,jl,jf) 
     655                  END DO 
     656               END DO 
     657            END DO 
     658         END DO 
     659         call mpi_isend(zt3ns(1,1,1,1,1,1), imigr, MPI_DOUBLE_PRECISION, noso, 3, mpi_comm_oce, ml_reqs(4+3), iflag) 
     660      END SELECT 
     661#endif 
     662      SCOREP_USER_REGION_END( reg_pack ) 
     663 
     664      ! progress all previous operations 
     665#if !(defined MPI_DATATYPE_SUBARRAY || defined MPI_DATATYPE_VECTOR) 
     666      call MPI_Testall(8, ml_reqs, finished, MPI_STATUSES_IGNORE, iflag) 
     667#else 
     668      call MPI_Testall(8*ipf, ml_reqs, finished, MPI_STATUSES_IGNORE, iflag) 
     669#endif 
     670  
     671! compute North 
     672#if !FULL_COLUMNS 
     673#warning "BULL: lib_mpp will compute cb N" 
     674      SCOREP_USER_REGION_BEGIN( reg_cb, "cb", SCOREP_USER_REGION_TYPE_COMMON ) 
     675      SCOREP_USER_REGION_BEGIN( reg_cbNS, "cbns", SCOREP_USER_REGION_TYPE_COMMON ) 
     676      call loop_fct( I0, I1   & 
     677                   , J1+1, J1+1   & 
     678                   , 1, jpkm1 & ! TODO check if always jpkm1 
     679                   ) 
     680      SCOREP_USER_REGION_END( reg_cbNS ) 
     681      SCOREP_USER_REGION_END( reg_cb ) 
     682#endif 
     683      ! 3. North directions 
     684      ! ----------------------------- 
     685      SCOREP_USER_REGION_BEGIN( reg_pack, "pack", SCOREP_USER_REGION_TYPE_COMMON ) 
     686#ifdef MPI_DATATYPE_SUBARRAY 
     687      ! always closed : we play only with the neigbours 
     688 
     689      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
     690      CASE ( -1, 0 )                ! all exept 2 (i.e. close case) 
     691        DO jf = 1, ipf 
     692#ifdef BULL_ISEND 
     693          call mpi_isend(ARRAY_IN(:,:,:,:,jf), 1, type_north_halo, nono, 8*jf+4, mpi_comm_oce, ml_reqs(4+4,jf), iflag) 
     694#else 
     695          call mpi_send(ARRAY_IN(:,:,:,:,jf), 1, type_north_halo, nono, 8*jf+4, mpi_comm_oce, iflag) 
     696#endif 
     697        END DO 
     698      END SELECT 
     699#elif (defined MPI_DATATYPE_VECTOR) 
     700      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
     701      CASE ( 0, 1 )                ! all exept 2 (i.e. close case) 
     702        DO jf = 1, ipf 
     703#ifdef BULL_ISEND 
     704          call mpi_isend(ARRAY_IN(2,jpj-nn_hls,1,1,jf), 1, type_ns, nono, 8*jf+4, mpi_comm_oce, ml_reqs(4+3,jf), iflag) 
     705#else 
     706          call mpi_send(ARRAY_IN(2,jpj-nn_hls,1,1,jf), 1, type_ns, nono, 8*jf+4, mpi_comm_oce, iflag) 
     707#endif 
     708        END DO 
     709      END SELECT 
     710#else 
     711      ! 
     712      imigr = nn_hls * jpi * ipk * ipl * ipf 
     713      SELECT CASE ( nbondj )      ! Read Dirichlet lateral conditions 
     714      CASE ( -1, 0 )                ! all exept 2 (i.e. close case) 
     715         ijhom = nlcj-nrecj ! jpj-2*nn_hls 
     716         DO jf = 1, ipf 
     717            DO jl = 1, ipl 
     718               DO jk = 1, ipk 
     719                  DO jh = 1, nn_hls 
     720                     zt3sn(:,jh,jk,jl,jf,1) = ARRAY_IN(:,ijhom +jh,jk,jl,jf) 
     721                  END DO 
     722               END DO 
     723            END DO 
     724         END DO 
     725         call mpi_isend(zt3sn(1,1,1,1,1,1), imigr, MPI_DOUBLE_PRECISION, nono, 4, mpi_comm_oce, ml_reqs(4+4), iflag) 
     726      END SELECT 
     727#endif 
     728      SCOREP_USER_REGION_END( reg_pack ) 
     729 
     730      ! progress all previous operations 
     731#if !(defined MPI_DATATYPE_SUBARRAY || defined MPI_DATATYPE_VECTOR) 
     732      call MPI_Testall(8, ml_reqs, finished, MPI_STATUSES_IGNORE, iflag) 
     733#else 
     734      call MPI_Testall(8*ipf, ml_reqs, finished, MPI_STATUSES_IGNORE, iflag) 
     735#endif 
     736 
     737#if !FULL_ROWS 
     738#warning "BULL: lib_mpp will compute cb W" 
     739      SCOREP_USER_REGION_BEGIN( reg_cb, "cb", SCOREP_USER_REGION_TYPE_COMMON ) 
     740      SCOREP_USER_REGION_BEGIN( reg_cbWE, "cbew", SCOREP_USER_REGION_TYPE_COMMON ) 
     741      call loop_fct( I0-1, I0-1 & 
     742                   , J0, J1  & ! stand for 3,jpjm2 
     743                   , 1, jpkm1 & ! TODO check if always jpkm1 
     744                   ) 
     745      SCOREP_USER_REGION_END( reg_cbWE ) 
     746      SCOREP_USER_REGION_END( reg_cb ) 
     747#endif 
     748      ! ------------------------------- ! 
     749      !      West exchange     ! 
     750      ! ------------------------------- ! 
     751      SCOREP_USER_REGION_BEGIN( reg_pack, "pack", SCOREP_USER_REGION_TYPE_COMMON ) 
     752#ifdef MPI_DATATYPE_SUBARRAY 
     753      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
     754      CASE ( 0, 1 )                ! all exept 2 (i.e. close case) 
     755        DO jf = 1, ipf 
     756#ifdef BULL_ISEND 
     757           call mpi_isend(ARRAY_IN(:,:,:,:,jf), 1, type_west_halo, nowe, 8*jf+1, mpi_comm_oce, ml_reqs(4+1,jf), iflag) 
     758#else 
     759           call mpi_send(ARRAY_IN(:,:,:,:,jf), 1, type_west_halo, nowe, 8*jf+1, mpi_comm_oce, iflag) 
     760#endif 
     761        END DO 
     762      END SELECT 
     763#elif (defined MPI_DATATYPE_VECTOR) 
     764      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
     765      CASE ( 0, 1 )                ! all exept 2 (i.e. close case) 
     766        DO jf = 1, ipf 
     767#ifdef BULL_ISEND 
     768          call mpi_isend(ARRAY_IN(2,2,1,1,jf), 1, type_ew, nowe, 8*jf+1, mpi_comm_oce, ml_reqs(4+3,jf), iflag) 
     769#else 
     770          call mpi_send(ARRAY_IN(2,2,1,1,jf), 1, type_ew, nowe, 8*jf+1, mpi_comm_oce, iflag) 
     771#endif 
     772        END DO 
     773      END SELECT 
     774#else 
     775      ! we play with the neigbours AND the row number because of the periodicity 
     776      ! 
     777      imigr = nn_hls * jpj * ipk * ipl * ipf 
     778      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
     779      CASE ( 0, 1 )                ! all exept 2 (i.e. close case) 
     780        DO jf = 1, ipf 
     781           DO jl = 1, ipl 
     782              DO jk = 1, ipk 
     783                 DO jh = 1, nn_hls 
     784                    zt3ew(:,jh,jk,jl,jf,1) = ARRAY_IN(nn_hls+jh,:,jk,jl,jf) 
     785                 END DO 
     786              END DO 
     787           END DO 
     788        END DO 
     789        call mpi_isend(zt3ew(1,1,1,1,1,1), imigr, MPI_DOUBLE_PRECISION, nowe, 1, mpi_comm_oce, ml_reqs(4+1), iflag) 
     790      END SELECT 
     791#endif 
     792      SCOREP_USER_REGION_END( reg_pack ) 
     793 
     794      ! progress all previous operations 
     795#if !(defined MPI_DATATYPE_SUBARRAY || defined MPI_DATATYPE_VECTOR) 
     796      call MPI_Testall(8, ml_reqs, finished, MPI_STATUSES_IGNORE, iflag) 
     797#else 
     798      call MPI_Testall(8*ipf, ml_reqs, finished, MPI_STATUSES_IGNORE, iflag) 
     799#endif 
     800 
     801! compute East 
     802#if !FULL_ROWS 
     803#warning "BULL: lib_mpp will compute cb E" 
     804      SCOREP_USER_REGION_BEGIN( reg_cb, "cb", SCOREP_USER_REGION_TYPE_COMMON ) 
     805      SCOREP_USER_REGION_BEGIN( reg_cbWE, "cbew", SCOREP_USER_REGION_TYPE_COMMON ) 
     806      call loop_fct( I1+1, I1+1 & 
     807                   , J0, J1  & ! stand for 3,jpjm2 
     808                   , 1, jpkm1 & ! TODO check if always jpkm1 
     809                   ) 
     810      SCOREP_USER_REGION_END( reg_cbWE ) 
     811      SCOREP_USER_REGION_END( reg_cb ) 
     812#endif 
     813      ! ------------------------------- ! 
     814      !      East exchange     ! 
     815      ! ------------------------------- ! 
     816      SCOREP_USER_REGION_BEGIN( reg_pack, "pack", SCOREP_USER_REGION_TYPE_COMMON ) 
     817#ifdef MPI_DATATYPE_SUBARRAY 
     818      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
     819      CASE ( -1, 0 )                ! all exept 2 (i.e. close case) 
     820        DO jf = 1, ipf 
     821#ifdef BULL_ISEND 
     822          call mpi_isend(ARRAY_IN(:,:,:,:,jf), 1, type_east_halo, noea, 8*jf+2, mpi_comm_oce, ml_reqs(4+2,jf), iflag) 
     823#else 
     824          call mpi_send(ARRAY_IN(:,:,:,:,jf), 1, type_east_halo, noea, 8*jf+2, mpi_comm_oce, iflag) 
     825#endif 
     826        END DO 
     827      END SELECT 
     828#elif (defined MPI_DATATYPE_VECTOR) 
     829      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
     830      CASE ( 0, 1 )                ! all exept 2 (i.e. close case) 
     831        DO jf = 1, ipf 
     832#ifdef BULL_ISEND 
     833          call mpi_isend(ARRAY_IN(jpi-nn_hls,2,1,1,jf), 1, type_ew, noea, 8*jf+2, mpi_comm_oce, ml_reqs(4+3,jf), iflag) 
     834#else 
     835          call mpi_send(ARRAY_IN(jpi-nn_hls,2,1,1,jf), 1, type_ew, noea, 8*jf+2, mpi_comm_oce, iflag) 
     836#endif 
     837        END DO 
     838      END SELECT 
     839#else 
     840      ! we play with the neigbours AND the row number because of the periodicity 
     841      ! 
     842      imigr = nn_hls * jpj * ipk * ipl * ipf 
     843      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
     844      CASE ( -1, 0 )                ! all exept 2 (i.e. close case) 
     845         iihom = nlci-nreci ! jpi-2*nn_hls 
     846         DO jf = 1, ipf 
     847            DO jl = 1, ipl 
     848               DO jk = 1, ipk 
     849                  DO jh = 1, nn_hls 
     850                     zt3we(:,jh,jk,jl,jf,1) = ARRAY_IN(iihom +jh,:,jk,jl,jf) 
     851                  END DO 
     852               END DO 
     853            END DO 
     854         END DO 
     855         call mpi_isend(zt3we(1,1,1,1,1,1), imigr, MPI_DOUBLE_PRECISION, noea, 2, mpi_comm_oce, ml_reqs(4+2), iflag) 
     856      END SELECT 
     857#endif 
     858      SCOREP_USER_REGION_END( reg_pack ) 
     859 
     860      ! progress all previous operations 
     861#if !(defined MPI_DATATYPE_SUBARRAY || defined MPI_DATATYPE_VECTOR) 
     862      call MPI_Testall(8, ml_reqs, finished, MPI_STATUSES_IGNORE, iflag) 
     863#else 
     864      call MPI_Testall(8*ipf, ml_reqs, finished, MPI_STATUSES_IGNORE, iflag) 
     865#endif 
     866 
     867! compute Inner 
     868#if !(FULL_ROWS && FULL_COLUMNS) 
     869#warning "BULL: lib_mpp will compute inner cb" 
     870      SCOREP_USER_REGION_BEGIN( reg_cb, "cb", SCOREP_USER_REGION_TYPE_COMMON ) 
     871      SCOREP_USER_REGION_BEGIN( reg_cbCenter, "cbcenter", SCOREP_USER_REGION_TYPE_COMMON ) 
     872      call loop_fct( I0, I1 & 
     873                   , J0, J1  & ! stand for 3,jpjm2 
     874                   , 1, jpkm1 & ! TODO check if always jpkm1 
     875                   ) 
     876      SCOREP_USER_REGION_END( reg_cbCenter ) 
     877      SCOREP_USER_REGION_END( reg_cb ) 
     878#endif 
     879 
     880      ! ------------------------------- ! 
     881      !   standard boundary treatment   !    ! CAUTION: semi-column notation is often impossible 
     882      ! ------------------------------- ! 
     883      ! 
     884      IF( PRESENT( cd_mpp ) ) THEN     !==  halos filled with inner values  ==! 
     885         ! 
     886         DO jf = 1, ipf                      ! number of arrays to be treated 
     887            ! 
     888            DO jl = 1, ipl                   ! CAUTION: ptab is defined only between nld and nle 
     889               DO jk = 1, ipk 
     890                  DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
     891                     ARRAY_IN(nldi  :nlei  ,jj,jk,jl,jf) = ARRAY_IN(nldi:nlei,nlej,jk,jl,jf) 
     892                     ARRAY_IN(1     :nldi-1,jj,jk,jl,jf) = ARRAY_IN(nldi     ,nlej,jk,jl,jf) 
     893                     ARRAY_IN(nlei+1:nlci  ,jj,jk,jl,jf) = ARRAY_IN(     nlei,nlej,jk,jl,jf) 
     894                  END DO 
     895                  DO ji = nlci+1, jpi                 ! added column(s) (full) 
     896                     ARRAY_IN(ji,nldj  :nlej  ,jk,jl,jf) = ARRAY_IN(nlei,nldj:nlej,jk,jl,jf) 
     897                     ARRAY_IN(ji,1     :nldj-1,jk,jl,jf) = ARRAY_IN(nlei,nldj     ,jk,jl,jf) 
     898                     ARRAY_IN(ji,nlej+1:jpj   ,jk,jl,jf) = ARRAY_IN(nlei,     nlej,jk,jl,jf) 
     899                  END DO 
     900               END DO 
     901            END DO 
     902            ! 
     903         END DO 
     904         ! 
     905      ELSE                              !==  standard close or cyclic treatment  ==! 
     906         ! 
     907         DO jf = 1, ipf                      ! number of arrays to be treated 
     908            ! 
     909            !                                ! East-West boundaries 
     910            IF( l_Iperio ) THEN                    !* cyclic 
     911               ARRAY_IN( 1 ,:,:,:,jf) = ARRAY_IN(jpim1,:,:,:,jf) 
     912               ARRAY_IN(jpi,:,:,:,jf) = ARRAY_IN(  2  ,:,:,:,jf) 
     913            ELSE                                   !* closed 
     914               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(     1       :nn_hls,:,:,:,jf) = zland    ! east except F-point 
     915                                               ARRAY_IN(nlci-nn_hls+1:jpi   ,:,:,:,jf) = zland    ! west 
     916            ENDIF 
     917            !                                ! North-South boundaries 
     918            IF( l_Jperio ) THEN                    !* cyclic (only with no mpp j-split) 
     919               ARRAY_IN(:, 1 ,:,:,jf) = ARRAY_IN(:, jpjm1,:,:,jf) 
     920               ARRAY_IN(:,jpj,:,:,jf) = ARRAY_IN(:,   2  ,:,:,jf) 
     921            ELSE                                   !* closed 
     922               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(:,     1       :nn_hls,:,:,jf) = zland    ! south except F-point 
     923                                               ARRAY_IN(:,nlcj-nn_hls+1:jpj   ,:,:,jf) = zland    ! north 
     924            ENDIF 
     925         END DO 
     926         ! 
     927      ENDIF 
     928 
     929! Wait for any reception (unpack?) 
     930#if !(defined MPI_DATATYPE_SUBARRAY || defined MPI_DATATYPE_VECTOR) 
     931      call MPI_Waitall(4, ml_reqs, MPI_STATUSES_IGNORE, iflag) 
     932#endif 
     933      !                           ! Write Dirichlet lateral conditions 
     934#if !(defined MPI_DATATYPE_SUBARRAY || defined MPI_DATATYPE_VECTOR) 
     935      SCOREP_USER_REGION_BEGIN( reg_unpack, "unpack", SCOREP_USER_REGION_TYPE_COMMON ) 
     936      iihom = nlci-nn_hls 
     937      ! 
     938      SELECT CASE ( nbondi ) 
     939      CASE ( -1 ) 
     940         DO jf = 1, ipf 
     941            DO jl = 1, ipl 
     942               DO jk = 1, ipk 
     943                  DO jh = 1, nn_hls 
     944                     ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2) 
     945                  END DO 
     946               END DO 
     947            END DO 
     948         END DO 
     949      CASE ( 0 ) 
     950         DO jf = 1, ipf 
     951            DO jl = 1, ipl 
     952               DO jk = 1, ipk 
     953                  DO jh = 1, nn_hls 
     954                     ARRAY_IN(jh      ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2) 
     955                     ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2) 
     956                  END DO 
     957               END DO 
     958            END DO 
     959         END DO 
     960      CASE ( 1 ) 
     961         DO jf = 1, ipf 
     962            DO jl = 1, ipl 
     963               DO jk = 1, ipk 
     964                  DO jh = 1, nn_hls 
     965                     ARRAY_IN(jh      ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2) 
     966                  END DO 
     967               END DO 
     968            END DO 
     969         END DO 
     970      END SELECT 
     971      !                           ! Write Dirichlet lateral conditions 
     972      ijhom = nlcj-nn_hls 
     973      ! 
     974      SELECT CASE ( nbondj ) 
     975      CASE ( -1 ) 
     976         DO jf = 1, ipf 
     977            DO jl = 1, ipl 
     978               DO jk = 1, ipk 
     979                  DO jh = 1, nn_hls 
     980                     ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2) 
     981                  END DO 
     982               END DO 
     983            END DO 
     984         END DO 
     985      CASE ( 0 ) 
     986         DO jf = 1, ipf 
     987            DO jl = 1, ipl 
     988               DO jk = 1, ipk 
     989                  DO jh = 1, nn_hls 
     990                     ARRAY_IN(:,      jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2) 
     991                     ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2) 
     992                  END DO 
     993               END DO 
     994            END DO 
     995         END DO 
     996      CASE ( 1 ) 
     997         DO jf = 1, ipf 
     998            DO jl = 1, ipl 
     999               DO jk = 1, ipk 
     1000                  DO jh = 1, nn_hls 
     1001                     ARRAY_IN(:,jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2) 
     1002                  END DO 
     1003               END DO 
     1004            END DO 
     1005         END DO 
     1006      END SELECT 
     1007      SCOREP_USER_REGION_END( reg_unpack ) 
     1008#endif 
     1009#endif 
    3331010      ! 4. north fold treatment 
    3341011      ! ----------------------- 
    … …  
    3431020      ENDIF 
    3441021      ! 
     1022#ifdef ASYNC 
     1023! wait all sending messages 
     1024#if !(defined MPI_DATATYPE_SUBARRAY || defined MPI_DATATYPE_VECTOR) 
     1025      call MPI_Waitall(4, ml_reqs(5), MPI_STATUSES_IGNORE, iflag) 
     1026#else 
     1027      call MPI_Waitall(8*ipf, ml_reqs, MPI_STATUSES_IGNORE, iflag) 
     1028#endif 
     1029      !                           ! Write Dirichlet lateral conditions 
     1030#ifdef MPI_DATATYPE_SUBARRAY 
     1031      SCOREP_USER_REGION_BEGIN( reg_datatype, "datatype", SCOREP_USER_REGION_TYPE_COMMON ) 
     1032      call MPI_Type_free(type_north_halo, iflag) 
     1033      call MPI_Type_free(type_south_halo, iflag) 
     1034      call MPI_Type_free(type_east_halo, iflag) 
     1035      call MPI_Type_free(type_west_halo, iflag) 
     1036      call MPI_Type_free(type_north_ghost, iflag) 
     1037      call MPI_Type_free(type_south_ghost, iflag) 
     1038      call MPI_Type_free(type_east_ghost, iflag) 
     1039      call MPI_Type_free(type_west_ghost, iflag) 
     1040      SCOREP_USER_REGION_END( reg_datatype ) 
     1041#endif 
     1042#ifdef MPI_DATATYPE_VECTOR 
     1043      SCOREP_USER_REGION_BEGIN( reg_datatype, "datatype vector", SCOREP_USER_REGION_TYPE_COMMON ) 
     1044      call MPI_Type_free(type_ew, iflag) 
     1045      call MPI_Type_free(type_ns, iflag) 
     1046      SCOREP_USER_REGION_END( reg_datatype ) 
     1047#endif 
     1048#endif 
     1049#if !(defined MPI_DATATYPE_SUBARRAY || defined MPI_DATATYPE_VECTOR) 
    3451050      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we ) 
     1051#endif 
    3461052      ! 
    3471053   END SUBROUTINE ROUTINE_LNK 
    … …  
    3551061#undef F_SIZE 
    3561062#undef OPT_K 
     1063#undef _INDEX 

  • NEMO/branches/2018/dev_r9759_HPC09_ESIWACE/src/OCE/TRA/traadv_fct.F90

    r10103 r10136  
    2727   USE lbclnk         ! ocean lateral boundary condition (or mpp link)  
    2828   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     29   USE timing         ! Timing 
    2930 
    3031   IMPLICIT NONE 
    … …  
    325326 
    326327   SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt ) 
     328#ifdef SCOREP_USER_ENABLE 
     329         use mpi 
     330#include "scorep/SCOREP_User.inc" 
     331#endif 
    327332      !!--------------------------------------------------------------------- 
    328333      !!                    ***  ROUTINE nonosc  *** 
    … …  
    346351      REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      - 
    347352      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zbetup, zbetdo, zbup, zbdo 
     353      !dir$ attributes align:64 :: zbetup, zbetdo, zbup, zbdo 
     354#ifdef SCOREP_USER_ENABLE 
     355      integer :: ier 
     356      SCOREP_USER_REGION_DEFINE( reg_nonosc ) 
     357      SCOREP_USER_REGION_DEFINE( reg_nonosc_setup ) 
     358      SCOREP_USER_REGION_DEFINE( reg_nonosc_cb1 ) 
     359      SCOREP_USER_REGION_DEFINE( reg_nonosc_cb2 ) 
     360      SCOREP_USER_REGION_DEFINE( reg_nonosc_barrier ) 
     361      SCOREP_USER_REGION_DEFINE( reg_nonosc_imbalance ) 
     362 
     363      SCOREP_USER_REGION_BEGIN( reg_nonosc_barrier, "nonosc barrier", SCOREP_USER_REGION_TYPE_COMMON ) 
     364      call MPI_Barrier(MPI_COMM_WORLD, ier) 
     365      SCOREP_USER_REGION_END( reg_nonosc_barrier ) 
     366      SCOREP_USER_REGION_BEGIN( reg_nonosc, "nonosc", SCOREP_USER_REGION_TYPE_FUNCTION ) 
     367      SCOREP_USER_REGION_BEGIN( reg_nonosc_setup, "nonosc setup", SCOREP_USER_REGION_TYPE_COMMON ) 
     368#endif 
     369      IF( ln_timing )   CALL timing_start( 'nonosc' ) 
    348370      !!---------------------------------------------------------------------- 
    349371      ! 
    350372      zbig  = 1.e+40_wp 
    351373      zrtrn = 1.e-15_wp 
     374#ifndef BULL_NONOSC_INIT 
    352375      zbetup(:,:,:) = 0._wp   ;   zbetdo(:,:,:) = 0._wp 
     376#else 
     377      zbetup(:,:,jpk) = 0._wp   ;   zbetdo(:,:,jpk) = 0._wp 
     378#endif 
    353379 
    354380      ! Search local extrema 
    … …  
    360386         &        paft * tmask + zbig * ( 1._wp - tmask )  ) 
    361387 
     388#ifdef SCOREP_USER_ENABLE 
     389      SCOREP_USER_REGION_END( reg_nonosc_setup ) 
     390#endif 
     391 
     392#ifndef BULL_ASYNC 
     393#ifdef SCOREP_USER_ENABLE 
     394      SCOREP_USER_REGION_BEGIN( reg_nonosc_cb1, "cb1", SCOREP_USER_REGION_TYPE_LOOP ) 
     395#endif 
     396! loads: 
     397! - zbup: ji-1/ji/ji+1, jj-1/jj/jj+1, ji/jk+1/jk-1 
     398! - zbdo: " 
     399! - paa:  ji-1/ji 
     400! - pbb:  jj-1/jj 
     401! - pcc: ji, jj, jk/jk+1 
     402! - e1e2t, e3t_n, paft (*2): ji,jj,jk 
     403! 
     404! stores: 
     405! - zbetup 
     406! - zbetdo 
    362407      DO jk = 1, jpkm1 
    363408         ikm1 = MAX(jk-1,1) 
    … …  
    394439         END DO 
    395440      END DO 
     441#ifdef SCOREP_USER_ENABLE 
     442      SCOREP_USER_REGION_END( reg_nonosc_cb1 ) 
     443#endif 
    396444      CALL lbc_lnk_multi("traadv_fct",zbetup, 'T', 1. , zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign) 
    397  
     445#else 
     446      call lbc_lnk_multi_async( "traadv_fct", cb1, zbetup, 'T', 1. , zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign) 
     447#endif 
     448 
     449#ifndef BULL_ASYNC 
    398450      ! 3. monotonic flux in the i & j direction (paa & pbb) 
    399451      ! ---------------------------------------- 
     452#ifdef SCOREP_USER_ENABLE 
     453      SCOREP_USER_REGION_BEGIN( reg_nonosc_cb2, "cb2", SCOREP_USER_REGION_TYPE_LOOP ) 
     454#endif 
    400455      DO jk = 1, jpkm1 
    401456         DO jj = 2, jpjm1 
    … …  
    420475         END DO 
    421476      END DO 
     477#ifdef SCOREP_USER_ENABLE 
     478      SCOREP_USER_REGION_END( reg_nonosc_cb2 ) 
     479#endif 
    422480      CALL lbc_lnk_multi("traadv_fct",paa, 'U', -1. , pbb, 'V', -1. )   ! lateral boundary condition (changed sign) 
    423       ! 
     481#else 
     482      call lbc_lnk_multi_async( "traadv_fct", cb2, paa, 'U', -1. , pbb, 'V', -1. )   ! lateral boundary condition (changed sign) 
     483#endif 
     484      ! 
     485      IF( ln_timing )   CALL timing_stop( 'nonosc' ) 
     486#ifdef SCOREP_USER_ENABLE 
     487      SCOREP_USER_REGION_END( reg_nonosc ) 
     488      SCOREP_USER_REGION_BEGIN( reg_nonosc_imbalance, "nonosc imbalance", SCOREP_USER_REGION_TYPE_COMMON ) 
     489      call MPI_Barrier(MPI_COMM_WORLD, ier) 
     490      SCOREP_USER_REGION_END( reg_nonosc_imbalance ) 
     491#endif 
     492#ifdef BULL_ASYNC 
     493      contains 
     494        subroutine cb1(i0, i1, j0, j1, k0, k1, buf) 
     495          integer, intent(in) :: i0, i1, j0, j1, k0, k1 
     496          real(wp), dimension(:,:,:,:,:,:), optional, intent(out) :: buf 
     497          integer jji, jjj, jjk 
     498          real(wp) :: p2dt_inv 
     499      !REAL(wp), DIMENSION (40,jpj,jpk) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions 
     500      !REAL(wp), DIMENSION (40,jpj,jpk) ::   e3t_n, paft 
     501      !REAL(wp), DIMENSION (40,jpj) :: e1e2t 
     502      !REAL(wp), DIMENSION(40,jpj,jpk) :: zbetup, zbetdo, zbup, zbdo 
     503          !DIR$ ASSUME_ALIGNED zbup:64 
     504          !DIR$ ASSUME (jpi .EQ.40) 
     505          !DIR$ ASSUME (jpj .EQ.42) 
     506          !DIR$ ASSUME (jpk .EQ.75) 
     507 
     508          p2dt_inv = 1._wp * p2dt 
     509          if(i0 == i1) then 
     510             ji=i0 
     511      !  DO jjj = j0, j1, 8 
     512             DO jk = k0, k1 
     513                ikm1 = MAX(jk-1,1) 
     514!DIR$ vector always 
     515                DO jj = j0, j1 
     516                !DO jj = jjj, min(jjj+7, j1) 
     517                       ! search maximum in neighbourhood 
     518                       zup = MAX(  zbup(ji  ,jj  ,jk  ),   & 
     519                          &        zbup(ji-1,jj  ,jk  ), zbup(ji+1,jj  ,jk  ),   & 
     520                          &        zbup(ji  ,jj-1,jk  ), zbup(ji  ,jj+1,jk  ),   & 
     521                          &        zbup(ji  ,jj  ,ikm1), zbup(ji  ,jj  ,jk+1)  ) 
     522 
     523                       ! search minimum in neighbourhood 
     524                       zdo = MIN(  zbdo(ji  ,jj  ,jk  ),   & 
     525                          &        zbdo(ji-1,jj  ,jk  ), zbdo(ji+1,jj  ,jk  ),   & 
     526                          &        zbdo(ji  ,jj-1,jk  ), zbdo(ji  ,jj+1,jk  ),   & 
     527                          &        zbdo(ji  ,jj  ,ikm1), zbdo(ji  ,jj  ,jk+1)  ) 
     528 
     529                       ! positive part of the flux 
     530                       zpos = MAX( 0., paa(ji-1,jj  ,jk  ) ) - MIN( 0., paa(ji  ,jj  ,jk  ) )   & 
     531                          & + MAX( 0., pbb(ji  ,jj-1,jk  ) ) - MIN( 0., pbb(ji  ,jj  ,jk  ) )   & 
     532                          & + MAX( 0., pcc(ji  ,jj  ,jk+1) ) - MIN( 0., pcc(ji  ,jj  ,jk  ) ) 
     533 
     534                       ! negative part of the flux 
     535                       zneg = MAX( 0., paa(ji  ,jj  ,jk  ) ) - MIN( 0., paa(ji-1,jj  ,jk  ) )   & 
     536                          & + MAX( 0., pbb(ji  ,jj  ,jk  ) ) - MIN( 0., pbb(ji  ,jj-1,jk  ) )   & 
     537                          & + MAX( 0., pcc(ji  ,jj  ,jk  ) ) - MIN( 0., pcc(ji  ,jj  ,jk+1) ) 
     538 
     539                       ! up & down beta terms 
     540                       zbt = e1e2t(ji,jj) * e3t_n(ji,jj,jk) * p2dt_inv 
     541                       zbetup(ji,jj,jk) = ( zup            - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt 
     542                       zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo            ) / ( zneg + zrtrn ) * zbt 
     543 
     544#ifdef BULL_CB_WITH_BUF 
     545                       ! zt3ew(:,jh,jk,jl,jf,1) = ARRAY_IN(nn_hls+jh,:,jk,jl,jf 
     546                       buf(jj,1,jk,1,1,1) = zbetup(ji,jj,jk) 
     547                       buf(jj,1,jk,1,2,1) = zbetdo(ji,jj,jk) 
     548#endif 
     549                 END DO 
     550              END DO 
     551              !end do 
     552          else 
     553             DO jk = k0, k1 
     554                ikm1 = MAX(jk-1,1) 
     555                DO jj = j0, j1 
     556!DIR$ vector always 
     557                   DO ji = i0, i1 
     558 
     559                       ! search maximum in neighbourhood 
     560                       zup = MAX(  zbup(ji  ,jj  ,jk  ),   & 
     561                          &        zbup(ji-1,jj  ,jk  ), zbup(ji+1,jj  ,jk  ),   & 
     562                          &        zbup(ji  ,jj-1,jk  ), zbup(ji  ,jj+1,jk  ),   & 
     563                          &        zbup(ji  ,jj  ,ikm1), zbup(ji  ,jj  ,jk+1)  ) 
     564 
     565                       ! search minimum in neighbourhood 
     566                       zdo = MIN(  zbdo(ji  ,jj  ,jk  ),   & 
     567                          &        zbdo(ji-1,jj  ,jk  ), zbdo(ji+1,jj  ,jk  ),   & 
     568                          &        zbdo(ji  ,jj-1,jk  ), zbdo(ji  ,jj+1,jk  ),   & 
     569                          &        zbdo(ji  ,jj  ,ikm1), zbdo(ji  ,jj  ,jk+1)  ) 
     570 
     571                       ! positive part of the flux 
     572                       zpos = MAX( 0., paa(ji-1,jj  ,jk  ) ) - MIN( 0., paa(ji  ,jj  ,jk  ) )   & 
     573                          & + MAX( 0., pbb(ji  ,jj-1,jk  ) ) - MIN( 0., pbb(ji  ,jj  ,jk  ) )   & 
     574                          & + MAX( 0., pcc(ji  ,jj  ,jk+1) ) - MIN( 0., pcc(ji  ,jj  ,jk  ) ) 
     575 
     576                       ! negative part of the flux 
     577                       zneg = MAX( 0., paa(ji  ,jj  ,jk  ) ) - MIN( 0., paa(ji-1,jj  ,jk  ) )   & 
     578                          & + MAX( 0., pbb(ji  ,jj  ,jk  ) ) - MIN( 0., pbb(ji  ,jj-1,jk  ) )   & 
     579                          & + MAX( 0., pcc(ji  ,jj  ,jk  ) ) - MIN( 0., pcc(ji  ,jj  ,jk+1) ) 
     580 
     581                       ! up & down beta terms 
     582                       zbt = e1e2t(ji,jj) * e3t_n(ji,jj,jk) * p2dt_inv 
     583                       zbetup(ji,jj,jk) = ( zup            - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt 
     584                       zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo            ) / ( zneg + zrtrn ) * zbt 
     585 
     586                    END DO 
     587                 END DO 
     588              END DO 
     589           endif 
     590 
     591        end subroutine 
     592        subroutine cb2(i0, i1, j0, j1, k0, k1, buf) 
     593          integer, intent(in) :: i0, i1, j0, j1, k0, k1 
     594          real(wp), dimension(:,:,:,:,:,:), optional, intent(out) :: buf 
     595          integer jji, jjj, jjk 
     596 
     597          ! 3. monotonic flux in the i & j direction (paa & pbb) 
     598          if(i0 == i1) then 
     599             ji=i0 
     600             do jjj=j0, j1, 8 
     601             DO jk = k0, k1 
     602!DIR$ vector always 
     603                !DO jj = j0, j1 
     604                DO jj = jjj, min(jjj+7, j1) 
     605                      zau = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) ) 
     606                      zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) ) 
     607                      zcu =       ( 0.5  + SIGN( 0.5 , paa(ji,jj,jk) ) ) 
     608                      paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1._wp - zcu) * zbu ) 
     609 
     610                      zav = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) ) 
     611                      zbv = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) ) 
     612                      zcv =       ( 0.5  + SIGN( 0.5 , pbb(ji,jj,jk) ) ) 
     613                      pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1._wp - zcv) * zbv ) 
     614 
     615             ! monotonic flux in the k direction, i.e. pcc 
     616             ! ------------------------------------------- 
     617                      za = MIN( 1., zbetdo(ji,jj,jk+1), zbetup(ji,jj,jk) ) 
     618                      zb = MIN( 1., zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) ) 
     619                      zc =       ( 0.5  + SIGN( 0.5 , pcc(ji,jj,jk+1) ) ) 
     620                      pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb ) 
     621#ifdef BULL_CB_WITH_BUF 
     622                       ! zt3ew(:,jh,jk,jl,jf,1) = ARRAY_IN(nn_hls+jh,:,jk,jl,jf 
     623                       buf(jj,1,jk,1,1,1) = paa(ji,jj,jk) 
     624                       buf(jj,1,jk,1,2,1) = pbb(ji,jj,jk) 
     625#endif 
     626                END DO 
     627             END DO 
     628             end do 
     629          else 
     630             DO jk = k0, k1 
     631                DO jj = j0, j1 
     632!DIR$ vector always 
     633                   DO ji = i0, i1 
     634                      zau = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) ) 
     635                      zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) ) 
     636                      zcu =       ( 0.5  + SIGN( 0.5 , paa(ji,jj,jk) ) ) 
     637                      paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1._wp - zcu) * zbu ) 
     638 
     639                      zav = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) ) 
     640                      zbv = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) ) 
     641                      zcv =       ( 0.5  + SIGN( 0.5 , pbb(ji,jj,jk) ) ) 
     642                      pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1._wp - zcv) * zbv ) 
     643 
     644             ! monotonic flux in the k direction, i.e. pcc 
     645             ! ------------------------------------------- 
     646                      za = MIN( 1., zbetdo(ji,jj,jk+1), zbetup(ji,jj,jk) ) 
     647                      zb = MIN( 1., zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) ) 
     648                      zc =       ( 0.5  + SIGN( 0.5 , pcc(ji,jj,jk+1) ) ) 
     649                      pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb ) 
     650                   END DO 
     651                END DO 
     652             END DO 
     653           endif 
     654        end subroutine 
     655#endif 
    424656   END SUBROUTINE nonosc 
    425657 

  • NEMO/branches/2018/dev_r9759_HPC09_ESIWACE/tests/demo_cfgs.txt

    r9766 r10136  
    66VORTEX OCE NST 
    77WAD OCE 
    8 BENCH OCE 
     8BENCH_1 OCE 
     9BENCH_025 OCE 
     10BENCH_12 OCE 
Note: See TracChangeset for help on using the changeset viewer.