Add 3D gather/scatter capability

src/shuffle/CMakeLists.txt

@@ -28,6 +28,48 @@ field_api_expand_fypp(
    OUTPUT_SRCS            srcs
 )
 
+## expand unified collapse templates for COLLAPSE=1 and COLLAPSE=2
+foreach (SUFF IN ITEMS IM RM RD LM)
+  string (TOLOWER ${SUFF} suff)
+  foreach (RANK RANGE 1 5)
+    foreach (COLLAPSE IN ITEMS 1 2)
+      foreach (FUNC IN ITEMS _shuffle _gather)
+        add_custom_command (
+          OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/field_${RANK}${suff}${FUNC}_collapse${COLLAPSE}_module.F90
+          COMMAND ${FYPP} -DRANK=${RANK} -DSUFF='${SUFF}' -DCOLLAPSE=${COLLAPSE} ${fypp_defines} -m os -M ${PROJECT_SOURCE_DIR}/python_utils -m fieldType
+            -DOFFLOAD_MODEL="${FIELD_API_OFFLOAD_MODEL}" -M ${PROJECT_SOURCE_DIR}/python_utils -m offload_macros
+            ${CMAKE_CURRENT_SOURCE_DIR}/field_RANKSUFF${FUNC}_collapseCOLLAPSE_module.fypp
+            > ${CMAKE_CURRENT_BINARY_DIR}/field_${RANK}${suff}${FUNC}_collapse${COLLAPSE}_module.F90
+          DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/field_RANKSUFF${FUNC}_collapseCOLLAPSE_module.fypp
+          VERBATIM)
+        list(APPEND srcs ${CMAKE_CURRENT_BINARY_DIR}/field_${RANK}${suff}${FUNC}_collapse${COLLAPSE}_module.F90)
+      endforeach ()
+    endforeach ()
+  endforeach ()
+endforeach ()
+
+foreach (COLLAPSE IN ITEMS 1 2)
+  add_custom_command (
+    OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/field_gathscat_collapse${COLLAPSE}_module.F90
+    COMMAND ${FYPP} -DCOLLAPSE=${COLLAPSE} ${fypp_defines} -m os -M ${PROJECT_SOURCE_DIR}/python_utils -m fieldType
+      -DOFFLOAD_MODEL="${FIELD_API_OFFLOAD_MODEL}" -M ${PROJECT_SOURCE_DIR}/python_utils -m offload_macros
+      ${CMAKE_CURRENT_SOURCE_DIR}/field_gathscat_collapseCOLLAPSE_module.fypp
+      > ${CMAKE_CURRENT_BINARY_DIR}/field_gathscat_collapse${COLLAPSE}_module.F90
+    DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/field_gathscat_collapseCOLLAPSE_module.fypp
+    VERBATIM)
+  list(APPEND srcs ${CMAKE_CURRENT_BINARY_DIR}/field_gathscat_collapse${COLLAPSE}_module.F90)
+
+  add_custom_command (
+    OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/field_gathscat_collapse${COLLAPSE}_type_module.F90
+    COMMAND ${FYPP} -DCOLLAPSE=${COLLAPSE} ${fypp_defines} -m os -M ${PROJECT_SOURCE_DIR}/python_utils -m fieldType
+      -DOFFLOAD_MODEL="${FIELD_API_OFFLOAD_MODEL}" -M ${PROJECT_SOURCE_DIR}/python_utils -m offload_macros
+      ${CMAKE_CURRENT_SOURCE_DIR}/field_gathscat_collapseCOLLAPSE_type_module.fypp
+      > ${CMAKE_CURRENT_BINARY_DIR}/field_gathscat_collapse${COLLAPSE}_type_module.F90
+    DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/field_gathscat_collapseCOLLAPSE_type_module.fypp
+    VERBATIM)
+  list(APPEND srcs ${CMAKE_CURRENT_BINARY_DIR}/field_gathscat_collapse${COLLAPSE}_type_module.F90)
+endforeach ()
+
 ## define object library
 field_api_add_object_library(
     LIBNAME        field_api_shuffle

src/shuffle/field_RANKSUFF_gather_collapseCOLLAPSE_module.fypp

@@ -0,0 +1,105 @@
+#! (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_${RANK}$${SUFF}$_GATHER_COLLAPSE${COLLAPSE}$_MODULE
+
+#:set fieldTypeList = fieldType.getFieldTypeList (ranks=[RANK], kinds=['JP' + str (SUFF)], hasView=True)
+
+USE FIELD_${RANK}$${SUFF}$_MODULE
+USE FIELD_${RANK}$${SUFF}$_ACCESS_MODULE
+USE FIELD_${RANK}$${SUFF}$_FACTORY_MODULE
+USE FIELD_GATHSCAT_COLLAPSE${COLLAPSE}$_TYPE_MODULE
+USE FIELD_${RANK}$${SUFF}$_SHUFFLE_COLLAPSE${COLLAPSE}$_MODULE
+${fieldType.useParkind1 ()}$
+
+IMPLICIT NONE
+
+PRIVATE
+
+PUBLIC :: FIELD_GATHSCAT_COLLAPSE${COLLAPSE}$
+
+#:for what in ['DEVICE', 'HOST']
+#:for mode in ['RDONLY', 'RDWR']
+
+#:for ft in fieldTypeList
+#:if ft.rank >= COLLAPSE + 1
+
+PUBLIC :: ${ft.name}$_GATHER_COLLAPSE${COLLAPSE}$_${what}$_DATA_${mode}$
+PUBLIC :: S${ft.name}$_GATHER_COLLAPSE${COLLAPSE}$_${what}$_DATA_${mode}$
+
+#:endif
+#:endfor
+
+#:endfor
+#:endfor
+
+CONTAINS
+
+#:for ft in fieldTypeList
+#:if ft.rank >= COLLAPSE + 1
+
+#:if COLLAPSE == 1
+#:set gathered_shape = ft.shape
+#:elif COLLAPSE == 2
+#:set gathered_rank = ft.rank - 1
+#:set gathered_shape = ','.join([':'] * gathered_rank)
+#:endif
+
+#:for what in ['DEVICE', 'HOST']
+#:for mode in ['RDONLY', 'RDWR']
+
+FUNCTION ${ft.name}$_GATHER_COLLAPSE${COLLAPSE}$_${what}$_DATA_${mode}$ (SELF, YLF) RESULT (PTR)
+
+CLASS (FIELD_GATHSCAT_COLLAPSE${COLLAPSE}$)           :: SELF
+CLASS (${ft.name}$),   POINTER, INTENT (IN) :: YLF
+
+${ft.type}$, POINTER :: PTR(${gathered_shape}$)
+
+CALL S${ft.name}$_GATHER_COLLAPSE${COLLAPSE}$_${what}$_DATA_${mode}$ (SELF, PTR, YLF)
+
+END FUNCTION ${ft.name}$_GATHER_COLLAPSE${COLLAPSE}$_${what}$_DATA_${mode}$
+
+SUBROUTINE S${ft.name}$_GATHER_COLLAPSE${COLLAPSE}$_${what}$_DATA_${mode}$ (SELF, PTR, YLF) 
+
+USE FIELD_${RANK}$${SUFF}$_ACCESS_MODULE
+
+CLASS (FIELD_GATHSCAT_COLLAPSE${COLLAPSE}$)           :: SELF
+${ft.type}$,           POINTER             :: PTR(${gathered_shape}$)
+CLASS (${ft.name}$),   POINTER, OPTIONAL   :: YLF
+
+#:if COLLAPSE == 2
+${ft.type}$,           POINTER             :: PTR1(${ft.shape}$)
+#:endif
+
+IF (PRESENT (YLF)) THEN
+
+  CALL PAIR_GATHER_COLLAPSE${COLLAPSE}$_${what}$_DATA_${mode}$ (SELF%${ft.name}$_C${COLLAPSE}$LIST, SELF%LNULL, SELF%LFULL, &
+  & SELF%KLON_G, SELF%KGPBLKS_G, SELF%YLFINDS, PTR, YLF, SELF%KBLKMIN, SELF%KBLKMAX)
+
+ELSE
+
+
+#:if COLLAPSE == 2
+  CALL SGET_${what}$_DATA_${mode}$ (PTR1, YLF)
+  PTR => PTR1 (${gathered_shape}$, 1)
+#:elif COLLAPSE == 1
+  CALL SGET_${what}$_DATA_${mode}$ (PTR, YLF)
+#:endif
+
+ENDIF
+
+END SUBROUTINE S${ft.name}$_GATHER_COLLAPSE${COLLAPSE}$_${what}$_DATA_${mode}$
+
+#:endfor
+#:endfor
+
+#:endif
+#:endfor
+
+END MODULE FIELD_${RANK}$${SUFF}$_GATHER_COLLAPSE${COLLAPSE}$_MODULE

src/shuffle/field_RANKSUFF_gather_module.fypp

@@ -60,13 +60,22 @@ END FUNCTION ${ft.name}$_GATHER_${what}$_DATA_${mode}$
 
 SUBROUTINE S${ft.name}$_GATHER_${what}$_DATA_${mode}$ (SELF, PTR, YLF) 
 
+USE FIELD_${RANK}$${SUFF}$_ACCESS_MODULE
+
 CLASS (FIELD_SHUFFLE)                      :: SELF
 ${ft.type}$,           POINTER             :: PTR(${ft.shape}$)
 CLASS (${ft.name}$),   POINTER, OPTIONAL   :: YLF
 
+IF (PRESENT (YLF)) THEN
+
+  CALL PAIR_GATHER_${what}$_DATA_${mode}$ (SELF%${ft.name}$_LIST, SELF%LNULL, SELF%LFULL, &
+  & SELF%KLON_G, SELF%KGPBLKS_G, SELF%YLFINDS, PTR, YLF, SELF%KBLKMIN, SELF%KBLKMAX)
+
+ELSE
+
+  CALL SGET_${what}$_DATA_${mode}$ (PTR, YLF)
 
-CALL PAIR_GATHER_${what}$_DATA_${mode}$ (SELF%${ft.name}$_LIST, SELF%LNULL, SELF%LFULL, &
-& SELF%KLON_G, SELF%KGPBLKS_G, SELF%YLFINDS, PTR, YLF, SELF%KBLKMIN, SELF%KBLKMAX)
+ENDIF
 
 END SUBROUTINE S${ft.name}$_GATHER_${what}$_DATA_${mode}$