Merge pull request #37 from pmarguinaud/alias-jprb

Make FIELD_2RB an alias of FIELD_2RD or FIELD_2RM

CMakeLists.txt

@@ -90,7 +90,7 @@ if( NOT fiat_FOUND )
   list(APPEND srcs ${ABOR1_PATH} ${OML_PATH} ${PARKIND1_PATH})
 endif()
 
-list(APPEND srcs field_basic_module.F90 field_defaults_module.F90 dev_alloc.c c_malloc.c field_constants_module.F90 field_abort_module.F90 field_statistics_module.F90)
+list(APPEND srcs field_async_module.F90 field_basic_module.F90 field_defaults_module.F90 dev_alloc.c c_malloc.c field_constants_module.F90 field_abort_module.F90 field_statistics_module.F90)
 
 ## check for CUDA
 include(CheckLanguage)
@@ -114,10 +114,10 @@ if(HAVE_CUDA)
 endif()
 
 ## preprocess fypp files
-foreach (SUFF IN ITEMS IM RM RB RD LM)
+foreach (SUFF IN ITEMS IM RM RD LM)
   string (TOLOWER ${SUFF} suff)
   foreach (RANK RANGE 1 5)
-    foreach (FUNC IN ITEMS "" _shuffle _access _util _array_util _gang _factory _gather _data)
+    foreach (FUNC IN ITEMS "" _shuffle _access _util _array _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
@@ -170,6 +170,10 @@ foreach(prec ${precisions})
                               INTERFACE $<BUILD_INTERFACE:${CMAKE_BINARY_DIR}/include/${LIBNAME}_${prec}> 
                               INTERFACE $<INSTALL_INTERFACE:${CMAKE_INSTALL_INCLUDEDIR}/${LIBNAME}_${prec}> 
                             )
+
+  if( prec MATCHES sp )
+      target_compile_definitions( ${LIBNAME}_${prec} PRIVATE PARKIND1_SINGLE )
+  endif()
 
   # set install location for .mod files
   install(DIRECTORY ${CMAKE_BINARY_DIR}/include/${LIBNAME}_${prec} DESTINATION ${CMAKE_INSTALL_INCLUDEDIR})

dev_alloc_module.fypp

@@ -9,7 +9,7 @@
 
 MODULE DEV_ALLOC_MODULE
 
-#:set fieldTypeList = list (filter (lambda ft: not ft.alias, fieldType.getFieldTypeList ()))
+#:set fieldTypeList = fieldType.getFieldTypeList ()
 
 ${fieldType.useParkind1 ()}$
 

fieldType.py

@@ -20,7 +20,6 @@ def __init__ (self, **kwargs):
 
     self.type = th[tt] + '(KIND=' + self.kind + ')'
     self.default = td[tt] + '_' + self.kind
-    self.alias = self.suffix == 'RB'
 
     self.name = 'FIELD_%s%s' % (self.rank, self.suffix);
     self.rank = int (self.rank)
@@ -32,18 +31,15 @@ def __init__ (self, **kwargs):
     self.ganged = self.rank > 2
 
 
-kinds = ['JPRM', 'JPRB', 'JPRD', 'JPIM', 'JPLM']
+kinds = ['JPRM', 'JPRD', 'JPIM', 'JPLM']
 
-def getFieldTypeList (ranks=[1,2,3,4,5], kinds=kinds, hasView=None, alias=None, ganged=None):
+def getFieldTypeList (ranks=[1,2,3,4,5], kinds=kinds, hasView=None, ganged=None):
 
   l = [fieldType (kind=kind, rank=rank) for (kind) in kinds for rank in ranks]
 
   if hasView != None:
     l = [ft for ft in l if ft.hasView == hasView]
 
-  if alias != None:
-    l = [ft for ft in l if ft.alias == alias] 
-
   if ganged != None:
     l = [ft for ft in l if ft.ganged == ganged]
 

field_RANKSUFF_access_module.fypp

@@ -12,7 +12,8 @@ MODULE FIELD_${RANK}$${SUFF}$_ACCESS_MODULE
 #:set fieldTypeList = fieldType.getFieldTypeList (ranks=[RANK], kinds=['JP' + SUFF])
 #:set dumsize = '1'
 
-USE FIELD_MODULE
+USE FIELD_${RANK}$${SUFF}$_MODULE
+
 ${fieldType.useParkind1 ()}$
 
 IMPLICIT NONE

field_RANKSUFF_array_module.fypp

@@ -0,0 +1,82 @@
+#! (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}$_ARRAY_MODULE
+
+#:set fieldTypeList = fieldType.getFieldTypeList (ranks=[RANK], kinds=['JP' + str (SUFF)])
+
+#:for ft in fieldTypeList
+USE ${ft.name}$_MODULE
+USE ${ft.name}$_FACTORY_MODULE
+#:endfor
+
+${fieldType.useParkind1 ()}$
+
+IMPLICIT NONE
+
+PRIVATE
+
+#:for ft in fieldTypeList
+TYPE ${ft.name}$_ARRAY
+  CLASS (${ft.name}$), POINTER :: F_P => NULL ()
+#:if ft.hasView
+  ${ft.type}$, POINTER :: P (${ft.viewShape}$) => NULL()
+#:endif
+CONTAINS
+  PROCEDURE :: INIT => INIT_${ft.name}$_ARRAY
+  PROCEDURE :: FINAL => FINAL_${ft.name}$_ARRAY
+#:if ft.hasView
+  PROCEDURE :: UPDATE_VIEW => UPDATE_VIEW_${ft.name}$_ARRAY
+#:endif
+END TYPE
+
+PUBLIC :: ${ft.name}$_ARRAY
+
+#:endfor
+
+CONTAINS
+
+#:for ft in fieldTypeList
+SUBROUTINE INIT_${ft.name}$_ARRAY (SELF, P, LBOUNDS)
+
+CLASS (${ft.name}$_ARRAY) :: SELF
+${ft.type}$, INTENT (IN), TARGET :: P (${ft.shape}$)
+INTEGER (KIND=JPIM), INTENT (IN), OPTIONAL :: LBOUNDS (${ft.rank}$)
+
+CALL FIELD_NEW (SELF%F_P, DATA=P, PERSISTENT=.TRUE., LBOUNDS=LBOUNDS)
+
+END SUBROUTINE
+
+#:if ft.hasView
+SUBROUTINE UPDATE_VIEW_${ft.name}$_ARRAY (SELF, BLOCK_INDEX)
+CLASS (${ft.name}$_ARRAY) :: SELF
+INTEGER (KIND=JPIM), INTENT (IN) :: BLOCK_INDEX
+
+IF (ASSOCIATED (SELF%F_P)) THEN
+  SELF%P => SELF%F_P%GET_VIEW (BLOCK_INDEX)
+ENDIF
+
+END SUBROUTINE
+#:endif
+
+SUBROUTINE FINAL_${ft.name}$_ARRAY (SELF)
+CLASS (${ft.name}$_ARRAY) :: SELF
+
+IF (ASSOCIATED (SELF%F_P)) THEN
+  CALL FIELD_DELETE (SELF%F_P)
+#:if ft.hasView
+  SELF%P => NULL ()
+#:endif
+ENDIF
+
+END SUBROUTINE
+
+#:endfor
+
+END MODULE

field_RANKSUFF_factory_module.fypp

@@ -11,8 +11,14 @@ MODULE FIELD_${RANK}$${SUFF}$_FACTORY_MODULE
 
 #:set fieldTypeList = fieldType.getFieldTypeList (ranks=[RANK], kinds=['JP' + SUFF])
 
-USE FIELD_MODULE
-USE FIELD_GANG_MODULE
+#:for ft in fieldTypeList
+USE ${ft.name}$_MODULE
+#:if ft.ganged
+USE FIELD_${ft.rank-1}$${SUFF}$_MODULE
+USE ${ft.name}$_GANG_MODULE
+#:endif
+#:endfor
+
 ${fieldType.useParkind1 ()}$
 
 IMPLICIT NONE

field_RANKSUFF_gather_module.fypp

@@ -11,9 +11,9 @@ MODULE FIELD_${RANK}$${SUFF}$_GATHER_MODULE
 
 #:set fieldTypeList = fieldType.getFieldTypeList (ranks=[RANK], kinds=['JP' + str (SUFF)], hasView=True)
 
-USE FIELD_MODULE
-USE FIELD_ACCESS_MODULE
-USE FIELD_FACTORY_MODULE
+USE FIELD_${RANK}$${SUFF}$_MODULE
+USE FIELD_${RANK}$${SUFF}$_ACCESS_MODULE
+USE FIELD_${RANK}$${SUFF}$_FACTORY_MODULE
 USE FIELD_SHUFFLE_TYPE_MODULE
 ${fieldType.useParkind1 ()}$
 

field_RANKSUFF_shuffle_module.fypp

@@ -11,9 +11,10 @@ MODULE FIELD_${RANK}$${SUFF}$_SHUFFLE_MODULE
 
 #:set fieldTypeList = fieldType.getFieldTypeList (ranks=[RANK], kinds=['JP' + SUFF], hasView=True)
 
-USE FIELD_MODULE
-USE FIELD_ACCESS_MODULE
-USE FIELD_FACTORY_MODULE
+USE FIELD_${RANK}$${SUFF}$_MODULE
+USE FIELD_${RANK}$${SUFF}$_ACCESS_MODULE
+USE FIELD_${RANK}$${SUFF}$_FACTORY_MODULE
+
 ${fieldType.useParkind1 ()}$
 
 IMPLICIT NONE
@@ -67,6 +68,11 @@ CONTAINS
 #:for mode in ['RDONLY', 'RDWR']
 
 FUNCTION PAIR_${ft.name}$_GATHER_${what}$_DATA_${mode}$ (YDPAIR, LDNULL, LDFULL, KLON, KGPBLKS, YDFINDS, YLF, KBLKMIN, KBLKMAX) RESULT (PTR)
+
+USE FIELD_3IM_MODULE
+USE FIELD_3IM_ACCESS_MODULE
+USE FIELD_3IM_FACTORY_MODULE
+
 TYPE (${ft.name}$_SHUFFLE_PAIR), POINTER              :: YDPAIR
 LOGICAL,                                   INTENT (IN) :: LDNULL, LDFULL
 INTEGER (KIND=JPIM),                       INTENT (IN) :: KLON, KGPBLKS
@@ -185,6 +191,11 @@ END FUNCTION PAIR_${ft.name}$_GATHER_${what}$_DATA_${mode}$
 #:for ft in fieldTypeList
 
 SUBROUTINE PAIR_${ft.name}$_SCATTER_DATA (YDPAIR, YDFINDS)
+
+USE FIELD_3IM_MODULE
+USE FIELD_3IM_ACCESS_MODULE
+USE FIELD_3IM_FACTORY_MODULE
+
 TYPE (${ft.name}$_SHUFFLE_PAIR), POINTER              :: YDPAIR
 CLASS (FIELD_3IM),               POINTER              :: YDFINDS 
 

field_RANKSUFF_util_module.fypp

@@ -11,8 +11,10 @@ MODULE FIELD_${RANK}$${SUFF}$_UTIL_MODULE
 
 #:set fieldTypeList = fieldType.getFieldTypeList (ranks=[RANK], kinds=['JP' + SUFF])
 
-USE FIELD_MODULE
-USE FIELD_ACCESS_MODULE
+USE FIELD_${RANK}$${SUFF}$_MODULE
+USE FIELD_${RANK}$${SUFF}$_ACCESS_MODULE
+
+${fieldType.useParkind1 ()}$
 
 IMPLICIT NONE
 
@@ -58,6 +60,7 @@ END FUNCTION
 SUBROUTINE LOAD_${ft.name}$ (KLUN, YD)
 
 USE FIELD_ABORT_MODULE
+USE PARKIND1, ONLY : JPIM
 
 INTEGER (KIND=JPIM), INTENT (IN) :: KLUN
 CLASS (${ft.name}$), POINTER :: YD
@@ -68,6 +71,7 @@ END SUBROUTINE
 SUBROUTINE SAVE_${ft.name}$ (KLUN, YD)
 
 USE FIELD_ABORT_MODULE
+USE PARKIND1, ONLY : JPIM
 
 INTEGER (KIND=JPIM), INTENT (IN) :: KLUN
 CLASS (${ft.name}$), POINTER :: YD
@@ -115,12 +119,14 @@ END SUBROUTINE
 #:if ft.hasView
 
 SUBROUTINE LOAD_${ft.name}$_VIEW (KLUN, YD)
+USE PARKIND1, ONLY : JPIM
 INTEGER (KIND=JPIM), INTENT (IN) :: KLUN
 CLASS (${ft.name}$_VIEW) :: YD
 ! Do nothing
 END SUBROUTINE
 
 SUBROUTINE SAVE_${ft.name}$_VIEW (KLUN, YD)
+USE PARKIND1, ONLY : JPIM
 INTEGER (KIND=JPIM), INTENT (IN) :: KLUN
 CLASS (${ft.name}$_VIEW) :: YD
 ! Do nothing
@@ -148,6 +154,7 @@ END SUBROUTINE
 SUBROUTINE LOAD_${ft.name}$_PTR (KLUN, YD)
 
 USE FIELD_ABORT_MODULE
+USE PARKIND1, ONLY : JPIM
 
 INTEGER (KIND=JPIM), INTENT (IN) :: KLUN
 CLASS (${ft.name}$_PTR) :: YD
@@ -158,6 +165,7 @@ END SUBROUTINE
 SUBROUTINE SAVE_${ft.name}$_PTR (KLUN, YD)
 
 USE FIELD_ABORT_MODULE
+USE PARKIND1, ONLY : JPIM
 
 INTEGER (KIND=JPIM), INTENT (IN) :: KLUN
 CLASS (${ft.name}$_PTR) :: YD

field_array_module.fypp

@@ -9,65 +9,32 @@
 
 MODULE FIELD_ARRAY_MODULE
 
-#:set fieldTypeList = fieldType.getFieldTypeList (hasView=True)
+#:set fieldTypeListOT = fieldType.getFieldTypeList (hasView=True, kinds=['JPIM', 'JPLM'])
+#:set fieldTypeListRM = fieldType.getFieldTypeList (hasView=True, kinds=['JPRM'])
+#:set fieldTypeListRB = fieldType.getFieldTypeList (hasView=True, kinds=['JPRB'])
+#:set fieldTypeListRD = fieldType.getFieldTypeList (hasView=True, kinds=['JPRD'])
 
-USE FIELD_MODULE
-USE FIELD_FACTORY_MODULE
-${fieldType.useParkind1 ()}$
-
-IMPLICIT NONE
-
-PRIVATE
-
-#:for ft in fieldTypeList
-TYPE ${ft.name}$_ARRAY
-  CLASS (${ft.name}$), POINTER :: F_P => NULL ()
-  ${ft.type}$, POINTER :: P (${ft.viewShape}$) => NULL()
-CONTAINS
-  PROCEDURE :: INIT => INIT_${ft.name}$_ARRAY
-  PROCEDURE :: FINAL => FINAL_${ft.name}$_ARRAY
-#:if ft.hasView
-  PROCEDURE :: UPDATE_VIEW => UPDATE_VIEW_${ft.name}$_ARRAY
-#:endif
-END TYPE
-
-PUBLIC :: ${ft.name}$_ARRAY
+#:def useAliasRB (ftlRB, ftlTA, ftlOT)
 
+#:for fta, ftb in zip (ftlTA, ftlRB)
+USE ${fta.name}$_ARRAY_MODULE, ONLY : &
+      & ${ftb.name}$_ARRAY  => ${fta.name}$_ARRAY,  &
+      & ${fta.name}$_ARRAY
 #:endfor
 
-CONTAINS
-
-#:for ft in fieldTypeList
-SUBROUTINE INIT_${ft.name}$_ARRAY (SELF, P, LBOUNDS)
-
-CLASS (${ft.name}$_ARRAY) :: SELF
-${ft.type}$, INTENT (IN), TARGET :: P (${ft.shape}$)
-INTEGER (KIND=JPIM), INTENT (IN), OPTIONAL :: LBOUNDS (${ft.rank}$)
-
-CALL FIELD_NEW (SELF%F_P, DATA=P, PERSISTENT=.TRUE., LBOUNDS=LBOUNDS)
-
-END SUBROUTINE
-
-SUBROUTINE UPDATE_VIEW_${ft.name}$_ARRAY (SELF, BLOCK_INDEX)
-CLASS (${ft.name}$_ARRAY) :: SELF
-INTEGER (KIND=JPIM), INTENT (IN) :: BLOCK_INDEX
-
-IF (ASSOCIATED (SELF%F_P)) THEN
-  SELF%P => SELF%F_P%GET_VIEW (BLOCK_INDEX)
-ENDIF
-
-END SUBROUTINE
-
-SUBROUTINE FINAL_${ft.name}$_ARRAY (SELF)
-CLASS (${ft.name}$_ARRAY) :: SELF
+#:for fto in ftlOT
+USE ${fto.name}$_ARRAY_MODULE
+#:endfor
 
-IF (ASSOCIATED (SELF%F_P)) THEN
-  CALL FIELD_DELETE (SELF%F_P)
-  SELF%P => NULL ()
-ENDIF
+#:enddef
 
-END SUBROUTINE
+#ifdef PARKIND1_SINGLE
+$:useAliasRB (fieldTypeListRB, fieldTypeListRM, fieldTypeListRD + fieldTypeListOT)
+#else
+$:useAliasRB (fieldTypeListRB, fieldTypeListRD, fieldTypeListRM + fieldTypeListOT)
+#endif
+${fieldType.useParkind1 ()}$
 
-#:endfor
+IMPLICIT NONE
 
 END MODULE