Changeset 11069

Timestamp:

2019-06-03T12:23:43+02:00 (5 years ago)

Author:

andmirek

Message:

ticket #2197 glob sum for parallel architecture

File:

• NEMO/branches/UKMO/dev_r10037_GPU/src/OCE/lib_fortran.F90 (modified) (10 diffs)

NEMO/branches/UKMO/dev_r10037_GPU/src/OCE/lib_fortran.F90

@@ -89 +89 @@
    END FUNCTION glob_sum_1d
 
+   FUNCTION glob_sum_c1d(ptab, kdim)
+      INTEGER, INTENT(IN) :: kdim
+      COMPLEX(KIND = wp), INTENT(IN), DIMENSION(kdim) :: ptab
+      REAL(KIND = wp) :: glob_sum_c1d
+      COMPLEX(KIND = wp) :: ctmp
+      INTEGER :: ji
+
+      ctmp = CMPLX(0.E0, 0.E0, wp)
+
+      DO ji = 1, kdim
+        CALL DDPDD(ptab(ji), ctmp)
+      END DO
+
+      IF (lk_mpp) CALL mpp_sum(ctmp)
+
+      glob_sum_c1d = REAL(ctmp, wp)
+   END FUNCTION glob_sum_c1d
+
    FUNCTION glob_sum_2d( ptab )
       !!----------------------------------------------------------------------
@@ -101 +119 @@
       REAL(wp)   ::   ztmp
       INTEGER    ::   ji, jj   ! dummy loop indices
-      !!-----------------------------------------------------------------------
-      !
-      ztmp = 0.e0
-      ctmp = CMPLX( 0.e0, 0.e0, wp )
+      COMPLEX(KIND = wp) :: hsum(jpj)
+      !!-----------------------------------------------------------------------
+      !
       DO jj = 1, jpj
+         ctmp = CMPLX( 0.e0, 0.e0, wp )
          DO ji =1, jpi
-         ztmp =  ptab(ji,jj) * tmask_i(ji,jj)
-         CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+            ztmp =  ptab(ji,jj) * tmask_i(ji,jj)
+            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
          END DO
-      END DO
-      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain
-      glob_sum_2d = REAL(ctmp,wp)
+         hsum(jj) = ctmp
+      END DO
+      glob_sum_2d = glob_sum_c1d(hsum, jpj)
       !
    END FUNCTION glob_sum_2d
@@ -130 +148 @@
       INTEGER    ::   ji, jj, jk   ! dummy loop indices
       INTEGER    ::   ijpk ! local variables: size of ptab
+      COMPLEX(KIND = wp), allocatable :: hsum(:)
       !!-----------------------------------------------------------------------
       !
       ijpk = SIZE(ptab,3)
-      !
-      ztmp = 0.e0
-      ctmp = CMPLX( 0.e0, 0.e0, wp )
+      ALLOCATE(hsum(ijpk))
+      !
       DO jk = 1, ijpk
+         ctmp = CMPLX( 0.e0, 0.e0, wp )
          DO jj = 1, jpj
             DO ji =1, jpi
@@ -143 +162 @@
             END DO
          END DO
-      END DO
-      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain
-      glob_sum_3d = REAL(ctmp,wp)
+         hsum(jk) = ctmp
+      END DO
+      glob_sum_3d = glob_sum_c1d(hsum, ijpk) 
+      DEALLOCATE(hsum)
       !
    END FUNCTION glob_sum_3d
@@ -162 +182 @@
       REAL(wp)   ::   ztmp
       INTEGER    ::   ji, jj   ! dummy loop indices
-      !!-----------------------------------------------------------------------
-      !
-      ztmp = 0.e0
-      ctmp = CMPLX( 0.e0, 0.e0, wp )
+      COMPLEX(KIND = wp) :: hsum(jpj)
+      !!-----------------------------------------------------------------------
+      !
       DO jj = 1, jpj
+         ctmp = CMPLX( 0.e0, 0.e0, wp )
          DO ji =1, jpi
-         ztmp =  ptab1(ji,jj) * tmask_i(ji,jj)
-         CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
-         ztmp =  ptab2(ji,jj) * tmask_i(ji,jj)
-         CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+            ztmp =  ptab1(ji,jj) * tmask_i(ji,jj)
+            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+            ztmp =  ptab2(ji,jj) * tmask_i(ji,jj)
+            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
          END DO
-      END DO
-      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain
-      glob_sum_2d_a = REAL(ctmp,wp)
+         hsum(jj) = ctmp
+      END DO
+      glob_sum_2d_a = glob_sum_c1d(hsum, jpj)
       !
    END FUNCTION glob_sum_2d_a
@@ -193 +213 @@
       INTEGER    ::   ji, jj, jk   ! dummy loop indices
       INTEGER    ::   ijpk ! local variables: size of ptab
+      COMPLEX(KIND = wp), allocatable :: hsum(:)
       !!-----------------------------------------------------------------------
       !
       ijpk = SIZE(ptab1,3)
-      !
-      ztmp = 0.e0
-      ctmp = CMPLX( 0.e0, 0.e0, wp )
+      ALLOCATE(hsum(ijpk))
+      !
       DO jk = 1, ijpk
+         ctmp = CMPLX( 0.e0, 0.e0, wp )
          DO jj = 1, jpj
             DO ji = 1, jpi
@@ -208 +229 @@
             END DO
          END DO    
-      END DO
-      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain
-      glob_sum_3d_a = REAL(ctmp,wp)
+         hsum(jk) = ctmp
+      END DO
+      glob_sum_3d_a = glob_sum_c1d(hsum, ijpk)
+      DEALLOCATE(hsum)
       !
    END FUNCTION glob_sum_3d_a   
@@ -226 +248 @@
       REAL(wp)   ::   ztmp
       INTEGER    ::   ji, jj   ! dummy loop indices
-      !!-----------------------------------------------------------------------
-      !
-      ztmp = 0.e0
-      ctmp = CMPLX( 0.e0, 0.e0, wp )
+      COMPLEX(KIND = wp) :: hsum(jpj)
+      !!-----------------------------------------------------------------------
+      !
       DO jj = 1, jpj
+         ctmp = CMPLX( 0.e0, 0.e0, wp )
          DO ji =1, jpi
-         ztmp =  ptab(ji,jj) * tmask_h(ji,jj) 
-         CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+            ztmp =  ptab(ji,jj) * tmask_h(ji,jj) 
+            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
          END DO
-      END DO
-      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain
-      glob_sum_full_2d = REAL(ctmp,wp)
+         hsum(jj) = ctmp
+      END DO
+      glob_sum_full_2d = glob_sum_c1d(hsum, jpj)
       !
    END FUNCTION glob_sum_full_2d
@@ -254 +276 @@
       INTEGER    ::   ji, jj, jk   ! dummy loop indices
       INTEGER    ::   ijpk ! local variables: size of ptab
+      COMPLEX(KIND = wp), allocatable :: hsum(:)
       !!-----------------------------------------------------------------------
       !
       ijpk = SIZE(ptab,3)
-      !
-      ztmp = 0.e0
-      ctmp = CMPLX( 0.e0, 0.e0, wp )
+      ALLOCATE(hsum(ijpk))
+      !
       DO jk = 1, ijpk
+         ctmp = CMPLX( 0.e0, 0.e0, wp )
          DO jj = 1, jpj
             DO ji =1, jpi
@@ -267 +290 @@
             END DO
          END DO
-      END DO
-      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain
-      glob_sum_full_3d = REAL(ctmp,wp)
+         hsum(jk) = ctmp
+      END DO
+      glob_sum_full_3d = glob_sum_c1d(hsum, ijpk)
+      DEALLOCATE(hsum)
       !
    END FUNCTION glob_sum_full_3d