Changeset 13247 for NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mpp_nfd_generic.h90

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:

• NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mpp_nfd_generic.h90 (modified) (10 diffs)

NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mpp_nfd_generic.h90

@@ -5 +5 @@
 #   define LBC_ARG                  (jf)
 #   if defined DIM_2d
-#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D)     , INTENT(inout) ::   ptab(f)
+#      if defined SINGLE_PRECISION
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D_sp)     , INTENT(inout) ::   ptab(f)
+#      else
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D_dp)     , INTENT(inout) ::   ptab(f)
+#      endif
 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
 #      define K_SIZE(ptab)             1
@@ -11 +15 @@
 #   endif
 #   if defined DIM_3d
-#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D)     , INTENT(inout) ::   ptab(f)
+#      if defined SINGLE_PRECISION
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D_sp)     , INTENT(inout) ::   ptab(f)
+#      else
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D_dp)     , INTENT(inout) ::   ptab(f)
+#      endif
 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
 #      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3)
@@ -17 +25 @@
 #   endif
 #   if defined DIM_4d
-#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D)     , INTENT(inout) ::   ptab(f)
+#      if defined SINGLE_PRECISION
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D_sp)     , INTENT(inout) ::   ptab(f)
+#      else
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D_dp)     , INTENT(inout) ::   ptab(f)
+#      endif
 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
 #      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
@@ -24 +36 @@
 #else
 !                          !==  IN: ptab is an array  ==!
-#   define ARRAY_TYPE(i,j,k,l,f)    REAL(wp)         , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f)
+#   if defined SINGLE_PRECISION
+#      define ARRAY_TYPE(i,j,k,l,f)    REAL(sp)         , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f)
+#   else
+#      define ARRAY_TYPE(i,j,k,l,f)    REAL(dp)         , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f)
+#   endif
 #   define NAT_IN(k)                cd_nat
 #   define SGN_IN(k)                psgn
@@ -45 +61 @@
 #   endif
 #endif
+
+# if defined SINGLE_PRECISION
+#    define PRECISION sp
+#    define SENDROUTINE mppsend_sp
+#    define RECVROUTINE mpprecv_sp
+#    define MPI_TYPE MPI_REAL
+# else
+#    define PRECISION dp
+#    define SENDROUTINE mppsend_dp
+#    define RECVROUTINE mpprecv_dp
+#    define MPI_TYPE MPI_DOUBLE_PRECISION
+# endif
 
    SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kfillmode, pfillval, kfld )
@@ -72 +100 @@
       INTEGER , DIMENSION(:,:)        , ALLOCATABLE ::   jj_b  ! position of buffer lines
       INTEGER , DIMENSION(:)          , ALLOCATABLE ::   ipj_s ! number of sent lines
-      REAL(wp), DIMENSION(:,:,:,:)    , ALLOCATABLE ::   ztabb, ztabr, ztabw  ! buffer, receive and work arrays
-      REAL(wp), DIMENSION(:,:,:,:,:)  , ALLOCATABLE ::   ztab, znorthloc
-      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   znorthgloio
+      REAL(PRECISION), DIMENSION(:,:,:,:)    , ALLOCATABLE ::   ztabb, ztabr, ztabw  ! buffer, receive and work arrays
+      REAL(PRECISION), DIMENSION(:,:,:,:,:)  , ALLOCATABLE ::   ztab, znorthloc
+      REAL(PRECISION), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   znorthgloio
       !!----------------------------------------------------------------------
       !
@@ -165 +193 @@
             iproc = nfproc(isendto(jr))
             IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN
-               CALL mppsend( 5, ztabb, ibuffsize, iproc, ml_req_nf(jr) )
+               CALL SENDROUTINE( 5, ztabb, ibuffsize, iproc, ml_req_nf(jr) )
             ENDIF
          END DO
@@ -224 +252 @@
             ELSE                               ! get data from a neighbour trough communication
                !  
-               CALL mpprecv(5, ztabw, ibuffsize, iproc)
+               CALL RECVROUTINE(5, ztabw, ibuffsize, iproc)
                DO jl = 1, ipl   ;   DO jk = 1, ipk
                   DO jj = 1, ipj_b
@@ -286 +314 @@
          ! start waiting time measurement
          IF( ln_timing ) CALL tic_tac(.TRUE.)
-         CALL MPI_ALLGATHER( znorthloc  , ibuffsize, MPI_DOUBLE_PRECISION,                &
-            &                znorthgloio, ibuffsize, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+         CALL MPI_ALLGATHER( znorthloc  , ibuffsize, MPI_TYPE,                &
+            &                znorthgloio, ibuffsize, MPI_TYPE, ncomm_north, ierr )
          !
          ! stop waiting time measurement
@@ -335 +363 @@
    END SUBROUTINE ROUTINE_NFD
 
+#undef PRECISION
+#undef MPI_TYPE
+#undef SENDROUTINE
+#undef RECVROUTINE
 #undef ARRAY_TYPE
 #undef NAT_IN