Changeset 13226 for NEMO/trunk/src/OCE/LBC/mpp_nfd_generic.h90

Timestamp:

2020-07-02T16:24:31+02:00 (4 years ago)

Author:

orioltp

Message:

Merging dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation into the trunk

File:

• NEMO/trunk/src/OCE/LBC/mpp_nfd_generic.h90 (modified) (10 diffs)

NEMO/trunk/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, kfld )
@@ -66 +94 @@
       INTEGER, DIMENSION(:,:),          ALLOCATABLE ::   jj_s  ! position of sent lines
       INTEGER, DIMENSION(:),            ALLOCATABLE ::   ipj_s ! number of sent lines
-      REAL(wp), DIMENSION(:,:,:)      , ALLOCATABLE ::   ztabl
-      REAL(wp), DIMENSION(:,:,:,:,:)  , ALLOCATABLE ::   ztab, ztabr
-      REAL(wp), DIMENSION(:,:,:,:,:)  , ALLOCATABLE ::   znorthloc, zfoldwk      
-      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   znorthgloio
+      REAL(PRECISION), DIMENSION(:,:,:)      , ALLOCATABLE ::   ztabl
+      REAL(PRECISION), DIMENSION(:,:,:,:,:)  , ALLOCATABLE ::   ztab, ztabr
+      REAL(PRECISION), DIMENSION(:,:,:,:,:)  , ALLOCATABLE ::   znorthloc, zfoldwk      
+      REAL(PRECISION), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   znorthgloio
       !!----------------------------------------------------------------------
       !
@@ -160 +188 @@
          DO jr = 1, nsndto
             IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN
-               CALL mppsend( 5, znorthloc, ibuffsize, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) )
+               CALL SENDROUTINE( 5, znorthloc, ibuffsize, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) )
             ENDIF
          END DO
@@ -176 +204 @@
             ENDIF
             IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN
-               CALL mpprecv(5, zfoldwk, ibuffsize, iproc)
+               CALL RECVROUTINE(5, zfoldwk, ibuffsize, iproc)
                js = 0
                DO jf = 1, ipf ; DO jj = 1, ipj_s(jf)
@@ -246 +274 @@
          ! 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
@@ -298 +326 @@
    END SUBROUTINE ROUTINE_NFD
 
+#undef PRECISION
+#undef MPI_TYPE
+#undef SENDROUTINE
+#undef RECVROUTINE
 #undef ARRAY_TYPE
 #undef NAT_IN