Redistribute field data with a different NPROMA

CMakeLists.txt

@@ -117,7 +117,7 @@ endif()
 foreach (SUFF IN ITEMS IM RM RB RD LM)
   string (TOLOWER ${SUFF} suff)
   foreach (RANK RANGE 1 5)
-    foreach (FUNC IN ITEMS "" _gathscat _access _util _array_util _gang _factory _gather _data)
+    foreach (FUNC IN ITEMS "" _shuffle _access _util _array_util _gang _factory _gather _data)
       add_custom_command (OUTPUT field_${RANK}${suff}${FUNC}_module.F90
 	      COMMAND ${FYPP} -DRANK=${RANK} -DSUFF='${SUFF}' ${fypp_defines} -m os -M ${CMAKE_CURRENT_SOURCE_DIR} -m fieldType 
         ${CMAKE_CURRENT_SOURCE_DIR}/field_RANKSUFF${FUNC}_module.fypp > field_${RANK}${suff}${FUNC}_module.F90
@@ -130,7 +130,8 @@ foreach (SUFF IN ITEMS IM RM RB RD LM)
 endforeach ()
 
 foreach (SRC IN ITEMS dev_alloc_module field_factory_module field_access_module field_gang_module field_array_module field_module 
-                      field_gathscat_module field_util_module field_array_util_module field_gathscat_type_module host_alloc_module)
+                      field_shuffle_module field_util_module field_array_util_module field_shuffle_type_module host_alloc_module
+                      field_gathscat_module field_gathscat_type_module)
   add_custom_command (OUTPUT ${SRC}.F90
 	  COMMAND ${FYPP} -m os ${fypp_defines} -M ${CMAKE_CURRENT_SOURCE_DIR} -m fieldType ${CMAKE_CURRENT_SOURCE_DIR}/${SRC}.fypp > ${SRC}.F90
     DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/${SRC}.fypp

field_RANKSUFF_gather_module.fypp

@@ -14,19 +14,19 @@ MODULE FIELD_${RANK}$${SUFF}$_GATHER_MODULE
 USE FIELD_MODULE
 USE FIELD_ACCESS_MODULE
 USE FIELD_FACTORY_MODULE
-USE FIELD_GATHSCAT_TYPE_MODULE
+USE FIELD_SHUFFLE_TYPE_MODULE
 ${fieldType.useParkind1 ()}$
 
 #:for ft in fieldTypeList
-USE ${ft.name}$_GATHSCAT_MODULE
+USE ${ft.name}$_SHUFFLE_MODULE
 #:endfor
 
 
 IMPLICIT NONE
 
 PRIVATE
 
-PUBLIC :: FIELD_GATHSCAT
+PUBLIC :: FIELD_SHUFFLE
 
 #:for what in ['DEVICE', 'HOST']
 #:for mode in ['RDONLY', 'RDWR']
@@ -48,12 +48,12 @@ CONTAINS
 #:for ft in fieldTypeList
 FUNCTION ${ft.name}$_GATHER_${what}$_DATA_${mode}$ (SELF, YLF) RESULT (PTR)
 
-CLASS (FIELD_GATHSCAT)                      :: SELF
+CLASS (FIELD_SHUFFLE)                      :: SELF
 CLASS (${ft.name}$),   POINTER, INTENT (IN) :: YLF
 
 ${ft.type}$, POINTER :: PTR(${ft.shape}$)
 
-PTR => PAIR_GATHER_${what}$_DATA_${mode}$ (SELF%${ft.name}$_LIST, SELF%LNULL, SELF%LFULL, SELF%KGPBLKS, SELF%YLFINDS, YLF)
+PTR => PAIR_GATHER_${what}$_DATA_${mode}$ (SELF%${ft.name}$_LIST, SELF%LNULL, SELF%LFULL, SELF%KLON_G, SELF%KGPBLKS_G, SELF%YLFINDS, YLF)
 
 END FUNCTION ${ft.name}$_GATHER_${what}$_DATA_${mode}$
 

field_RANKSUFF_gathscat_module.fypp → field_RANKSUFF_shuffle_module.fypp

@@ -7,7 +7,7 @@
 #! granted to it by virtue of its status as an intergovernmental organisation
 #! nor does it submit to any jurisdiction.
 
-MODULE FIELD_${RANK}$${SUFF}$_GATHSCAT_MODULE
+MODULE FIELD_${RANK}$${SUFF}$_SHUFFLE_MODULE
 
 #:set fieldTypeList = fieldType.getFieldTypeList (ranks=[RANK], kinds=['JP' + SUFF], hasView=True)
 
@@ -44,15 +44,15 @@ END INTERFACE PAIR_SCATTER_DATA
 PUBLIC :: PAIR_SCATTER_DATA
 
 #:for ft in fieldTypeList
-TYPE ${ft.name}$_GATHSCAT_PAIR
+TYPE ${ft.name}$_SHUFFLE_PAIR
   INTEGER (KIND=JPIM) :: IMODE = -1
   INTEGER (KIND=JPIM) :: IWHAT = -1
   CLASS (${ft.name}$), POINTER :: YLSCAT => NULL ()
   CLASS (${ft.name}$), POINTER :: YLGATH => NULL ()
-  TYPE (${ft.name}$_GATHSCAT_PAIR), POINTER :: NEXT => NULL ()
-END TYPE ${ft.name}$_GATHSCAT_PAIR
+  TYPE (${ft.name}$_SHUFFLE_PAIR), POINTER :: NEXT => NULL ()
+END TYPE ${ft.name}$_SHUFFLE_PAIR
 
-PUBLIC :: ${ft.name}$_GATHSCAT_PAIR
+PUBLIC :: ${ft.name}$_SHUFFLE_PAIR
 
 #:endfor
 
@@ -66,16 +66,16 @@ CONTAINS
 #:for what in ['DEVICE', 'HOST']
 #:for mode in ['RDONLY', 'RDWR']
 
-FUNCTION PAIR_${ft.name}$_GATHER_${what}$_DATA_${mode}$ (YDPAIR, LDNULL, LDFULL, KGPBLKS, YDFINDS, YLF) RESULT (PTR)
-TYPE (${ft.name}$_GATHSCAT_PAIR), POINTER              :: YDPAIR
+FUNCTION PAIR_${ft.name}$_GATHER_${what}$_DATA_${mode}$ (YDPAIR, LDNULL, LDFULL, KLON, KGPBLKS, YDFINDS, YLF) RESULT (PTR)
+TYPE (${ft.name}$_SHUFFLE_PAIR), POINTER              :: YDPAIR
 LOGICAL,                                   INTENT (IN) :: LDNULL, LDFULL
-INTEGER (KIND=JPIM),                       INTENT (IN) :: KGPBLKS
+INTEGER (KIND=JPIM),                       INTENT (IN) :: KLON, KGPBLKS
 CLASS (FIELD_3IM),                POINTER              :: YDFINDS 
 CLASS (${ft.name}$),              POINTER, INTENT (IN) :: YLF
 
 ${ft.type}$, POINTER :: PTR(${ft.shape}$), ZTRG(${ft.shape}$), ZTRS(${ft.shape}$)
 ${ft.type}$, POINTER :: PTR1(${ft.shape}$)
-TYPE (${ft.name}$_GATHSCAT_PAIR), POINTER :: YLPAIR
+TYPE (${ft.name}$_SHUFFLE_PAIR), POINTER :: YLPAIR
 CLASS (${ft.name}$), POINTER :: YLGATH_DUMM
 INTEGER (KIND=JPIM) :: ILBOUNDS (${ft.rank}$), IUBOUNDS (${ft.rank}$)
 INTEGER (KIND=JPIM), POINTER :: INDS (:,:,:)
@@ -104,6 +104,7 @@ ELSE
 
   ILBOUNDS = LBOUND (PTR)
   IUBOUNDS = UBOUND (PTR)
+  IUBOUNDS (1) = KLON
   IUBOUNDS (${ft.rank}$) = KGPBLKS
   CALL FIELD_NEW (YLPAIR%YLGATH, LBOUNDS=ILBOUNDS, UBOUNDS=IUBOUNDS, PERSISTENT=.TRUE.)
 
@@ -159,10 +160,10 @@ END FUNCTION PAIR_${ft.name}$_GATHER_${what}$_DATA_${mode}$
 #:for ft in fieldTypeList
 
 SUBROUTINE PAIR_${ft.name}$_SCATTER_DATA (YDPAIR, YDFINDS)
-TYPE (${ft.name}$_GATHSCAT_PAIR), POINTER              :: YDPAIR
+TYPE (${ft.name}$_SHUFFLE_PAIR), POINTER              :: YDPAIR
 CLASS (FIELD_3IM),                POINTER              :: YDFINDS 
 
-TYPE (${ft.name}$_GATHSCAT_PAIR), POINTER :: YLPAIR
+TYPE (${ft.name}$_SHUFFLE_PAIR), POINTER :: YLPAIR
 ${ft.type}$, POINTER :: PTRG(${ft.shape}$), PTRS(${ft.shape}$)
 INTEGER (KIND=JPIM), POINTER :: INDS (:,:,:)
 
@@ -233,4 +234,4 @@ END SUBROUTINE PAIR_${ft.name}$_SCATTER_DATA
 
 #:endfor
 
-END MODULE FIELD_${RANK}$${SUFF}$_GATHSCAT_MODULE
+END MODULE FIELD_${RANK}$${SUFF}$_SHUFFLE_MODULE

field_gathscat_module.fypp

@@ -18,7 +18,6 @@ USE FIELD_GATHSCAT_TYPE_MODULE
 ${fieldType.useParkind1 ()}$
 
 #:for ft in fieldTypeList
-USE ${ft.name}$_GATHSCAT_MODULE
 USE ${ft.name}$_GATHER_MODULE
 #:endfor
 

field_gathscat_type_module.fypp

@@ -14,28 +14,17 @@ MODULE FIELD_GATHSCAT_TYPE_MODULE
 USE FIELD_MODULE
 USE FIELD_ACCESS_MODULE
 USE FIELD_FACTORY_MODULE
+USE FIELD_SHUFFLE_TYPE_MODULE
 ${fieldType.useParkind1 ()}$
 
-#:for ft in fieldTypeList
-USE ${ft.name}$_GATHSCAT_MODULE
-#:endfor
-
 IMPLICIT NONE
 
 PRIVATE
 
-TYPE FIELD_GATHSCAT
-  INTEGER (KIND=JPIM) :: KGPBLKS = -1, KLON = -1, KGPTOT = -1
-  LOGICAL :: LFULL = .FALSE.  ! No need to gather/scatter, all columns are OK, return pointers based on original fields
-  LOGICAL :: LNULL = .FALSE.  ! No need to gather/scatter, all columns are KO, return pointers on empty arrays
-  CLASS (FIELD_2LM), POINTER :: YLFCOND => NULL ()
-  CLASS (FIELD_3IM), POINTER :: YLFINDS => NULL ()
-#:for ft in fieldTypeList
-  TYPE (${ft.name}$_GATHSCAT_PAIR), POINTER :: ${ft.name}$_LIST => NULL ()
-#:endfor
+TYPE, EXTENDS (FIELD_SHUFFLE) :: FIELD_GATHSCAT
 CONTAINS
-  PROCEDURE :: INIT => INIT_FIELD_GATHSCAT
-  PROCEDURE :: SCATTER => SCATTER_FIELD_GATHSCAT
+  GENERIC :: INIT => INIT_FIELD_GATHSCAT
+  PROCEDURE :: INIT_FIELD_GATHSCAT
 END TYPE FIELD_GATHSCAT
 
 PUBLIC :: FIELD_GATHSCAT
@@ -44,65 +33,75 @@ INTEGER (KIND=JPIM), PARAMETER :: NLONDIM = 1, NBLKDIM = 2
 
 CONTAINS
 
-SUBROUTINE INIT_FIELD_GATHSCAT (SELF, YLFCOND, KGPTOT)
+SUBROUTINE INIT_FIELD_GATHSCAT (SELF, YDFCOND, KGPTOT, KLON_S, KLON_G)
 
 USE FIELD_ABORT_MODULE
 
 CLASS (FIELD_GATHSCAT) :: SELF
-CLASS (FIELD_2LM), POINTER :: YLFCOND
+CLASS (FIELD_2LM), POINTER :: YDFCOND
 INTEGER (KIND=JPIM), INTENT (IN) :: KGPTOT
+INTEGER (KIND=JPIM), INTENT (IN), OPTIONAL :: KLON_S, KLON_G
 
 LOGICAL, POINTER :: LLF (:,:)
 INTEGER (KIND=JPIM), POINTER :: INDS (:,:,:)
-INTEGER (KIND=JPIM) :: ICOUNT
-INTEGER (KIND=JPIM) :: JLONS, JBLKS, JLONG, JBLKG, I1S, I2S, IPROMA
+INTEGER (KIND=JPIM) :: JLONS, JBLKS, JLONG, JBLKG, I1S, I2S
 
-SELF%YLFCOND => YLFCOND
 
-LLF => GET_HOST_DATA_RDONLY (YLFCOND)
+LLF => GET_HOST_DATA_RDONLY (YDFCOND)
 
-IPROMA = SIZE (LLF, 1)
+SELF%KLON_S    = SIZE (LLF, 1)
+SELF%KGPBLKS_S = SIZE (LLF, 2)
+SELF%KGPTOT_S  = KGPTOT
 
 ! Reduction
 
-ICOUNT = 0
+SELF%KGPTOT_G = 0
 
-DO JBLKS = 1, SIZE (LLF, 2)
+DO JBLKS = 1, SELF%KGPBLKS_S
   I1S = 1
-  I2S = MIN (IPROMA, KGPTOT - (JBLKS - 1) * IPROMA)
-  ICOUNT = ICOUNT + COUNT (LLF (I1S:I2S,JBLKS))
+  I2S = MIN (SELF%KLON_S, SELF%KGPTOT_S - (JBLKS - 1) * SELF%KLON_S)
+  SELF%KGPTOT_G = SELF%KGPTOT_G + COUNT (LLF (I1S:I2S,JBLKS))
 ENDDO
 
-SELF%KGPBLKS = (ICOUNT+IPROMA-1) / IPROMA
-SELF%KLON = IPROMA
-SELF%KGPTOT = ICOUNT
 
-SELF%LFULL = SELF%KGPTOT == KGPTOT
-SELF%LNULL = SELF%KGPTOT == 0
+IF (PRESENT (KLON_G)) THEN
+  SELF%KLON_G = KLON_G
+ELSE
+  SELF%KLON_G = SELF%KLON_S
+ENDIF
+
+SELF%KGPBLKS_G = (SELF%KGPTOT_G+SELF%KLON_G-1) / SELF%KLON_G
+
+SELF%KGPTOT  =  SELF%KGPTOT_G 
+SELF%KLON    =  SELF%KLON_G   
+SELF%KGPBLKS =  SELF%KGPBLKS_G
+
+SELF%LFULL = SELF%KGPTOT_G == SELF%KGPTOT_S
+SELF%LNULL = SELF%KGPTOT_G == 0
 
 IF (SELF%LNULL) THEN
   ! Do nothing
 ELSEIF (SELF%LFULL) THEN
   ! Do nothing
 ELSE
 
-  CALL FIELD_NEW (SELF%YLFINDS, UBOUNDS=[2, IPROMA, SELF%KGPBLKS], PERSISTENT=.TRUE.)
+  CALL FIELD_NEW (SELF%YLFINDS, UBOUNDS=[2, SELF%KLON_G, SELF%KGPBLKS_G], PERSISTENT=.TRUE.)
   INDS => GET_HOST_DATA_RDWR (SELF%YLFINDS)
 
   ! Create indices (serial code)
 
   JBLKG = 1
   JLONG = 1
-  DO JBLKS = 1, SIZE (LLF, 2)
-    DO JLONS = 1, MIN (IPROMA, KGPTOT - (JBLKS - 1) * IPROMA)
+  DO JBLKS = 1, SELF%KGPBLKS_S
+    DO JLONS = 1, MIN (SELF%KLON_S, SELF%KGPTOT_S - (JBLKS - 1) * SELF%KLON_S)
       IF (LLF (JLONS, JBLKS)) THEN
         IF ((JLONG > SIZE (INDS, 2)) .OR. (JBLKG > SIZE (INDS, 3))) THEN
-          CALL FIELD_ABORT ('INIT_FIELD_GATHSCAT: OUT OF BOUNDS')
+          CALL FIELD_ABORT ('INIT_FIELD_SHUFFLE: OUT OF BOUNDS')
         ENDIF
         INDS (NLONDIM, JLONG, JBLKG) = JLONS
         INDS (NBLKDIM, JLONG, JBLKG) = JBLKS
         JLONG = JLONG + 1
-        IF (JLONG > IPROMA) THEN
+        IF (JLONG > SELF%KLON_G) THEN
           JLONG = 1
           JBLKG = JBLKG + 1
         ENDIF
@@ -111,7 +110,7 @@ ELSE
   ENDDO
 
   IF (JBLKG <= SIZE (INDS, 3)) THEN
-    DO WHILE (JLONG <= IPROMA)
+    DO WHILE (JLONG <= SELF%KLON_G)
       INDS (NLONDIM, JLONG, JBLKG) = -9999999
       INDS (NBLKDIM, JLONG, JBLKG) = -9999999
       JLONG = JLONG + 1
@@ -122,33 +121,4 @@ ENDIF
 
 END SUBROUTINE
 
-SUBROUTINE SCATTER_FIELD_GATHSCAT (SELF)
-CLASS (FIELD_GATHSCAT) :: SELF
-#:for ft in fieldTypeList
-TYPE (${ft.name}$_GATHSCAT_PAIR), POINTER :: ${ft.name}$_LIST, ${ft.name}$_NEXT
-#:endfor
-
-IF (SELF%LNULL) THEN
-  ! Do nothing
-ELSEIF (SELF%LFULL) THEN
-  ! Do nothing
-ELSE
-
-#:for ft in fieldTypeList
-  CALL PAIR_SCATTER_DATA (SELF%${ft.name}$_LIST, SELF%YLFINDS)
-
-#:endfor
-
-  CALL FIELD_DELETE (SELF%YLFINDS)
-
-ENDIF
-
-SELF%YLFCOND => NULL ()
-SELF%YLFINDS => NULL ()
-SELF%KGPBLKS = -1
-SELF%KLON = -1
-SELF%KGPTOT = -1
-
-END SUBROUTINE
-
 END MODULE FIELD_GATHSCAT_TYPE_MODULE

field_shuffle_module.fypp

@@ -0,0 +1,40 @@
+#! (C) Copyright 2022- ECMWF.
+#! (C) Copyright 2022- Meteo-France.
+#!
+#! This software is licensed under the terms of the Apache Licence Version 2.0
+#! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+#! In applying this licence, ECMWF does not waive the privileges and immunities
+#! granted to it by virtue of its status as an intergovernmental organisation
+#! nor does it submit to any jurisdiction.
+
+MODULE FIELD_SHUFFLE_MODULE
+
+#:set fieldTypeList = fieldType.getFieldTypeList ()
+
+USE FIELD_MODULE
+USE FIELD_ACCESS_MODULE
+USE FIELD_FACTORY_MODULE
+USE FIELD_SHUFFLE_TYPE_MODULE
+${fieldType.useParkind1 ()}$
+
+#:for ft in fieldTypeList
+USE ${ft.name}$_SHUFFLE_MODULE
+USE ${ft.name}$_GATHER_MODULE
+#:endfor
+
+
+IMPLICIT NONE
+
+PRIVATE
+
+PUBLIC :: FIELD_SHUFFLE
+
+#:for what in ['DEVICE', 'HOST']
+#:for mode in ['RDONLY', 'RDWR']
+
+PUBLIC :: GATHER_${what}$_DATA_${mode}$
+
+#:endfor
+#:endfor
+
+END MODULE FIELD_SHUFFLE_MODULE