Changeset 3187 for branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90

Timestamp:

2011-11-28T17:44:46+01:00 (12 years ago)

Author:

spickles2

Message:

Stephen Pickles, 28 Nov 2011.
First commit of dCSE NEMO project work, part 1 - index re-ordering,
OPA_SRC top level only. Includes fix for sub-optimal auto-partitioning
in nemogcm.F90.

File:

• branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90 (modified) (8 diffs)

branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90

@@ -28 +28 @@
 
    INTERFACE glob_sum
-      MODULE PROCEDURE glob_sum_2d, glob_sum_3d,glob_sum_2d_a, glob_sum_3d_a 
+      MODULE PROCEDURE glob_sum_2d, glob_sum_3d, glob_sum_2d_a, glob_sum_3d_a 
    END INTERFACE
 
@@ -39 +39 @@
 #endif
 
+   !! * Control permutation of array indices
+#  include "dom_oce_ftrans.h90"
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -69 +72 @@
       !! ** Purpose : perform a masked sum on the inner global domain of a 3D array
       !!-----------------------------------------------------------------------
+!FTRANS ptab :I :I :z 
       REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab       ! input 3D array
       REAL(wp)                               ::   glob_sum   ! global masked sum
       !!
       INTEGER :: jk
+#if defined key_z_first
+      INTEGER :: ji, jj
+      REAL(wp) :: ztmask
+#endif
       !!-----------------------------------------------------------------------
       !
       glob_sum = 0.e0
+#if defined key_z_first
+      DO jj = 1, jpj
+        DO ji = 1, jpi
+          ztmask = tmask_i(ji,jj)
+          DO jk = 1, jpk
+            glob_sum = glob_sum + ptab(ji,jj,jk)*ztmask
+          END DO
+        END DO
+      END DO
+#else
       DO jk = 1, jpk
          glob_sum = glob_sum + SUM( ptab(:,:,jk)*tmask_i(:,:) )
       END DO
+#endif
       IF( lk_mpp )   CALL mpp_sum( glob_sum )
       !
@@ -107 +126 @@
       !! ** Purpose : perform a masked sum on the inner global domain of two 3D array
       !!-----------------------------------------------------------------------
+!FTRANS ptab1 :I :I :z 
+!FTRANS ptab2 :I :I :z 
       REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2   ! input 3D array
       REAL(wp)            , DIMENSION(2)     ::   glob_sum       ! global masked sum
       !!
       INTEGER :: jk
+#if defined key_z_first
+      INTEGER :: ji, jj
+      REAL(wp) :: ztmask
+#endif
       !!-----------------------------------------------------------------------
       !
       glob_sum(:) = 0.e0
+#if defined key_z_first
+      DO jj = 1, jpj
+        DO ji = 1, jpi
+          ztmask = tmask_i(ji,jj)
+          DO jk = 1, jpk
+            glob_sum(1) = glob_sum(1) + ptab1(ji,jj,jk)*ztmask
+            glob_sum(2) = glob_sum(2) + ptab2(ji,jj,jk)*ztmask
+          END DO
+        END DO
+      END DO
+#else
       DO jk = 1, jpk
          glob_sum(1) = glob_sum(1) + SUM( ptab1(:,:,jk)*tmask_i(:,:) )
          glob_sum(2) = glob_sum(2) + SUM( ptab2(:,:,jk)*tmask_i(:,:) )
       END DO
+#endif
       IF( lk_mpp )   CALL mpp_sum( glob_sum, 2 )
       !
@@ -161 +198 @@
       !! ** Purpose : perform a sum on a 3D array in calling DDPDD routine
       !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   ptab
-      REAL(wp)                                     ::   glob_sum   ! global masked sum
+!FTRANS ptab :I :I :z 
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab
+      REAL(wp)                               ::   glob_sum   ! global masked sum
       !!
       COMPLEX(wp)::   ctmp
@@ -171 +209 @@
       ztmp = 0.e0
       ctmp = CMPLX( 0.e0, 0.e0, wp )
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji =1, jpi
+            DO jk = 1, jpk
+#else
       DO jk = 1, jpk
          DO jj = 1, jpj
             DO ji =1, jpi
+#endif
             ztmp =  ptab(ji,jj,jk) * tmask_i(ji,jj)
             CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
@@ -221 +265 @@
       !! ** Purpose : perform a sum on two 3D array in calling DDPDD routine
       !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   ptab1, ptab2
-      REAL(wp)                                     ::   glob_sum   ! global masked sum
+      REAL(wp), INTENT(in), DIMENSION(:,:,:)   ::   ptab1, ptab2
+!FTRANS ptab1 :I :I :z 
+!FTRANS ptab2 :I :I :z 
+      REAL(wp)                                 ::   glob_sum   ! global masked sum
       !!
       COMPLEX(wp)::   ctmp
@@ -231 +277 @@
       ztmp = 0.e0
       ctmp = CMPLX( 0.e0, 0.e0, wp )
+#if defined key_z_first
+      DO jj = 1, jpj
+         DO ji =1, jpi
+            DO jk = 1, jpk
+#else
       DO jk = 1, jpk
          DO jj = 1, jpj
             DO ji =1, jpi
+#endif
             ztmp =  ptab1(ji,jj,jk) * tmask_i(ji,jj)
             CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )