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 13247 for NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mpp_lnk_generic.h90 – NEMO

Ignore:
Timestamp:
2020-07-03T19:15:31+02:00 (4 years ago)
Author:
francesca
Message:

dev_r12558_HPC-08_epico_Extra_Halo: merge with trunk@13227, see #2366

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mpp_lnk_generic.h90

    r12993 r13247  
    55#   define OPT_K(k)                 ,ipf 
    66#   if defined DIM_2d 
    7 #      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D)                , INTENT(inout) ::   ptab(f) 
     7#      if defined SINGLE_PRECISION 
     8#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D_sp)                , INTENT(inout) ::   ptab(f) 
     9#      else 
     10#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D_dp)                , INTENT(inout) ::   ptab(f) 
     11#      endif 
    812#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j) 
    913#      define K_SIZE(ptab)             1 
     
    1115#   endif 
    1216#   if defined DIM_3d 
    13 #      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D)                , INTENT(inout) ::   ptab(f) 
     17#      if defined SINGLE_PRECISION 
     18#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D_sp)                , INTENT(inout) ::   ptab(f) 
     19#      else 
     20#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D_dp)                , INTENT(inout) ::   ptab(f) 
     21#      endif 
    1422#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k) 
    1523#      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3) 
     
    1725#   endif 
    1826#   if defined DIM_4d 
    19 #      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D)                , INTENT(inout) ::   ptab(f) 
     27#      if defined SINGLE_PRECISION 
     28#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D_sp)                , INTENT(inout) ::   ptab(f) 
     29#      else 
     30#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D_dp)                , INTENT(inout) ::   ptab(f) 
     31#      endif 
    2032#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l) 
    2133#      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3) 
     
    2335#   endif 
    2436#else 
    25 #   define ARRAY_TYPE(i,j,k,l,f)    REAL(wp)                    , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f) 
     37#   if defined SINGLE_PRECISION 
     38#      define ARRAY_TYPE(i,j,k,l,f)    REAL(sp)                    , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f) 
     39#   else 
     40#      define ARRAY_TYPE(i,j,k,l,f)    REAL(dp)                    , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f) 
     41#   endif 
    2642#   define NAT_IN(k)                cd_nat 
    2743#   define SGN_IN(k)                psgn 
     
    4460#   endif 
    4561#endif 
     62 
     63# if defined SINGLE_PRECISION 
     64#    define PRECISION sp 
     65#    define SENDROUTINE mppsend_sp 
     66#    define RECVROUTINE mpprecv_sp 
     67# else 
     68#    define PRECISION dp 
     69#    define SENDROUTINE mppsend_dp 
     70#    define RECVROUTINE mpprecv_dp 
     71# endif 
    4672 
    4773#if defined MULTI 
     
    6793      REAL(wp) ::   zland 
    6894      INTEGER , DIMENSION(MPI_STATUS_SIZE)        ::   istat          ! for mpi_isend 
    69       REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zsnd_we, zrcv_we, zsnd_ea, zrcv_ea   ! east -west  & west - east  halos 
    70       REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zsnd_so, zrcv_so, zsnd_no, zrcv_no   ! north-south & south-north  halos 
     95      REAL(PRECISION), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zsnd_we, zrcv_we, zsnd_ea, zrcv_ea   ! east -west  & west - east  halos 
     96      REAL(PRECISION), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zsnd_so, zrcv_so, zsnd_no, zrcv_no   ! north-south & south-north  halos 
    7197      LOGICAL  ::   llsend_we, llsend_ea, llsend_no, llsend_so       ! communication send 
    7298      LOGICAL  ::   llrecv_we, llrecv_ea, llrecv_no, llrecv_so       ! communication receive  
     
    168194      ! 
    169195      ! non-blocking send of the western/eastern side using local temporary arrays 
    170       IF( llsend_we )   CALL mppsend( 1, zsnd_we(1,1,1,1,1), isize, nowe, ireq_we ) 
    171       IF( llsend_ea )   CALL mppsend( 2, zsnd_ea(1,1,1,1,1), isize, noea, ireq_ea ) 
     196      IF( llsend_we )   CALL SENDROUTINE( 1, zsnd_we(1,1,1,1,1), isize, nowe, ireq_we ) 
     197      IF( llsend_ea )   CALL SENDROUTINE( 2, zsnd_ea(1,1,1,1,1), isize, noea, ireq_ea ) 
    172198      ! blocking receive of the western/eastern halo in local temporary arrays 
    173       IF( llrecv_we )   CALL mpprecv( 2, zrcv_we(1,1,1,1,1), isize, nowe ) 
    174       IF( llrecv_ea )   CALL mpprecv( 1, zrcv_ea(1,1,1,1,1), isize, noea ) 
     199      IF( llrecv_we )   CALL RECVROUTINE( 2, zrcv_we(1,1,1,1,1), isize, nowe ) 
     200      IF( llrecv_ea )   CALL RECVROUTINE( 1, zrcv_ea(1,1,1,1,1), isize, noea ) 
    175201      ! 
    176202      IF( ln_timing ) CALL tic_tac(.FALSE.) 
     
    275301      ! 
    276302      ! non-blocking send of the southern/northern side 
    277       IF( llsend_so )   CALL mppsend( 3, zsnd_so(1,1,1,1,1), isize, noso, ireq_so ) 
    278       IF( llsend_no )   CALL mppsend( 4, zsnd_no(1,1,1,1,1), isize, nono, ireq_no ) 
     303      IF( llsend_so )   CALL SENDROUTINE( 3, zsnd_so(1,1,1,1,1), isize, noso, ireq_so ) 
     304      IF( llsend_no )   CALL SENDROUTINE( 4, zsnd_no(1,1,1,1,1), isize, nono, ireq_no ) 
    279305      ! blocking receive of the southern/northern halo 
    280       IF( llrecv_so )   CALL mpprecv( 4, zrcv_so(1,1,1,1,1), isize, noso ) 
    281       IF( llrecv_no )   CALL mpprecv( 3, zrcv_no(1,1,1,1,1), isize, nono ) 
     306      IF( llrecv_so )   CALL RECVROUTINE( 4, zrcv_so(1,1,1,1,1), isize, noso ) 
     307      IF( llrecv_no )   CALL RECVROUTINE( 3, zrcv_no(1,1,1,1,1), isize, nono ) 
    282308      ! 
    283309      IF( ln_timing ) CALL tic_tac(.FALSE.) 
     
    362388      ! 
    363389   END SUBROUTINE ROUTINE_LNK 
    364  
     390#undef PRECISION 
     391#undef SENDROUTINE 
     392#undef RECVROUTINE 
    365393#undef ARRAY_TYPE 
    366394#undef NAT_IN 
Note: See TracChangeset for help on using the changeset viewer.