disable/comment all parts that won't work with CCE17 (Fortran Cray co…

…mpiler unable resolve polymorphism ...)
ecmwf-ifs · Oct 8, 2024 · e420cc0 · e420cc0
1 parent 9dac243
commit e420cc0
Show file tree

Hide file tree

Showing 5 changed files with 84 additions and 337 deletions.
diff --git a/field_RANKSUFF_factory_module.fypp b/field_RANKSUFF_factory_module.fypp
@@ -23,7 +23,8 @@ INTERFACE FIELD_NEW
 #:for ft in fieldTypeList
   MODULE PROCEDURE ${ft.name}$_NEW_OWNER
   MODULE PROCEDURE ${ft.name}$_NEW_WRAPPER
-#:if ft.ganged
+! : if ft.ganged
+#:if False
   MODULE PROCEDURE ${ft.name}$_NEW_GANG_WRAPPER
   MODULE PROCEDURE ${ft.name}$_NEW_GANG_OWNER
 #:endif
@@ -90,7 +91,8 @@ FIELD_PTR => FIELD_WRAPPER
 
 END SUBROUTINE
 
-#:if ft.ganged
+! : if ft.ganged
+#:if False
 SUBROUTINE ${ft.name}$_NEW_GANG_WRAPPER (FIELD_PTR, CHILDREN, LBOUNDS, PERSISTENT, DATA, SYNC_ON_FINAL)
 
 #:set fieldTypeList1 = fieldType.getFieldTypeList (ranks=[ft.rank-1], kinds=[ft.kind])

diff --git a/field_RANKSUFF_gang_module.fypp b/field_RANKSUFF_gang_module.fypp
@@ -9,254 +9,12 @@
 
 MODULE FIELD_${RANK}$${SUFF}$_GANG_MODULE
 
-USE FIELD_BASIC_MODULE
-USE FIELD_CONSTANTS_MODULE
-USE DEV_ALLOC_MODULE
-
-#:set fieldTypeList = fieldType.getFieldTypeList (ranks=[RANK], kinds=['JP' + str (SUFF)], ganged=True)
-
-#:for ft in fieldTypeList
-
-#:set fieldTypeList1 = fieldType.getFieldTypeList (ranks=[RANK-1], kinds=['JP' + str (SUFF)])
-#:set ft1 = fieldTypeList1[0]
-
-USE ${ft.name}$_MODULE
-USE ${ft1.name}$_MODULE
-
-${fieldType.useParkind1 ()}$
+! USE FIELD_BASIC_MODULE
+! USE FIELD_CONSTANTS_MODULE
+! USE DEV_ALLOC_MODULE
 
 IMPLICIT NONE
 
 PRIVATE
 
-#:set ftn = ft.name
-#:set ftn1 = ft1.name
-
-TYPE, EXTENDS (${ftn1}$_WRAPPER) :: ${ftn1}$_WRAPPER_HELPER
-  CLASS (FIELD_BASIC), POINTER :: PARENT => NULL ()
-CONTAINS
-  PROCEDURE :: DELETE_DEVICE_DATA => ${ftn1}$_DELETE_DEVICE_DATA_WRAPPER_HELPER
-  PROCEDURE :: CREATE_DEVICE_DATA => ${ftn1}$_CREATE_DEVICE_DATA_WRAPPER_HELPER
-  PROCEDURE :: SET_DEVICE_DIRTY => ${ftn1}$_SET_DEVICE_DIRTY_DATA_WRAPPER_HELPER
-  PROCEDURE :: GET_DEVICE_DATA => ${ftn1}$_GET_DEVICE_DATA_WRAPPER_HELPER
-  PROCEDURE :: GET_HOST_DATA => ${ftn1}$_GET_HOST_DATA_WRAPPER_HELPER
-END TYPE
-
-TYPE ${ftn1}$_WRAPPER_HELPER_PTR
-  CLASS (${ftn1}$_WRAPPER_HELPER), POINTER :: PTR => NULL ()
-END TYPE
-
-#:for type in ['WRAPPER', 'OWNER']
-
-TYPE, EXTENDS (${ftn}$_${type}$) :: ${ftn}$_GANG_${type}$
-  TYPE (${ftn1}$_WRAPPER_HELPER_PTR), POINTER :: CHILDREN (:) => NULL ()
-CONTAINS
-  PROCEDURE :: INIT => ${ftn}$_GANG_${type}$_INIT
-  PROCEDURE :: FINAL => ${ftn}$_GANG_${type}$_FINAL
-  PROCEDURE :: CREATE_DEVICE_DATA => ${ftn}$_GANG_${type}$_CREATE_DEVICE_DATA
-  PROCEDURE :: DELETE_DEVICE_DATA => ${ftn}$_GANG_${type}$_DELETE_DEVICE_DATA
-  PROCEDURE :: SET_STATUS => ${ftn}$_GANG_${type}$_SET_STATUS
-END TYPE ${ftn}$_GANG_${type}$
-
-PUBLIC :: ${ftn}$_GANG_${type}$
-
-#:endfor
-
-CONTAINS
-
-  SUBROUTINE ${ftn1}$_CREATE_DEVICE_DATA_WRAPPER_HELPER (SELF)
-    CLASS(${ftn1}$_WRAPPER_HELPER) :: SELF
-
-    IF (ASSOCIATED (SELF%PARENT)) THEN
-      CALL SELF%PARENT%CREATE_DEVICE_DATA ()
-    ENDIF
-
-  END SUBROUTINE
-
-  SUBROUTINE ${ftn1}$_DELETE_DEVICE_DATA_WRAPPER_HELPER (SELF)
-    CLASS(${ftn1}$_WRAPPER_HELPER) :: SELF
-
-    IF (ASSOCIATED (SELF%PARENT)) THEN
-      CALL SELF%PARENT%DELETE_DEVICE_DATA ()
-    ENDIF
-
-  END SUBROUTINE
-
-  SUBROUTINE ${ftn1}$_SET_DEVICE_DIRTY_DATA_WRAPPER_HELPER (SELF)
-
-    CLASS (${ftn1}$_WRAPPER_HELPER) :: SELF
-
-    IF (ASSOCIATED (SELF%PARENT)) THEN
-      CALL SELF%PARENT%SET_DEVICE_DIRTY ()
-    ENDIF
-
-  END SUBROUTINE 
-
-#:for what in ['HOST', 'DEVICE']
-  SUBROUTINE ${ftn1}$_GET_${what}$_DATA_WRAPPER_HELPER (SELF, MODE, PTR, QUEUE)
-    CLASS(${ftn1}$_WRAPPER_HELPER) :: SELF
-    INTEGER (KIND=JPIM),           INTENT(IN)    :: MODE
-    ${ft1.type}$, POINTER,         INTENT(INOUT) :: PTR(${ft1.shape}$)
-    INTEGER (KIND=JPIM), OPTIONAL, INTENT(IN)    :: QUEUE
-    INTEGER(KIND=JPIM)                           :: LBOUNDS(${ft1.rank}$)
-
-    IF (ASSOCIATED (SELF%PARENT)) THEN
-      IF (IAND (MODE, NWR) /= 0) THEN
-        CALL SELF%PARENT%SYNC_${what}$_RDWR (QUEUE)
-      ELSEIF (IAND (MODE, NRD) /= 0) THEN
-        CALL SELF%PARENT%SYNC_${what}$_RDONLY (QUEUE)
-      ENDIF
-    ENDIF
-
-    CALL SELF%${ftn1}$_WRAPPER%GET_${what}$_DATA (MODE, PTR, QUEUE)
-
-  END SUBROUTINE 
-
-#:endfor
-
-  SUBROUTINE ${ftn}$_GANG_WRAPPER_INIT(SELF, DATA, PERSISTENT, LBOUNDS, MAP_DEVPTR, SYNC_ON_FINAL)
-    CLASS(${ftn}$_GANG_WRAPPER) :: SELF
-    ${ft.type}$, TARGET, INTENT(IN) :: DATA(${ft.shape}$)
-    LOGICAL, INTENT(IN), OPTIONAL :: PERSISTENT
-    INTEGER(KIND=JPIM), INTENT(IN), OPTIONAL :: LBOUNDS(${ft.rank}$)
-    LOGICAL, INTENT(IN), OPTIONAL :: MAP_DEVPTR
-    LOGICAL, INTENT(IN), OPTIONAL :: SYNC_ON_FINAL
-
-    LOGICAL :: LLPERSISTENT
-    INTEGER (KIND=JPIM) :: IFLR, JFLD, NFLD
-    INTEGER (KIND=JPIM) :: LLBOUNDS (${ft.rank}$)
-    CLASS (${ftn1}$_WRAPPER_HELPER), POINTER :: YLFW
-
-
-    CALL SELF%${ftn}$_WRAPPER%INIT (DATA=DATA, PERSISTENT=PERSISTENT, LBOUNDS=LBOUNDS, MAP_DEVPTR=MAP_DEVPTR, SYNC_ON_FINAL=SYNC_ON_FINAL)
-
-    LLBOUNDS = 1
-    IF (PRESENT (LBOUNDS)) LLBOUNDS = LBOUNDS
-
-    IFLR = ${ft.rank}$-1
-    NFLD = SIZE (DATA, IFLR)
-
-    LLBOUNDS(IFLR) = LLBOUNDS (IFLR+1)
-    ALLOCATE (SELF%CHILDREN (NFLD))
-
-#:set ar = ', '.join ([':'] * (ft.rank-2))
-
-    DO JFLD = 1, NFLD
-      ALLOCATE (YLFW)
-      CALL YLFW%INIT (DATA=DATA(${ar}$, JFLD, :), PERSISTENT=PERSISTENT, LBOUNDS=LLBOUNDS(1:IFLR), MAP_DEVPTR=MAP_DEVPTR, SYNC_ON_FINAL=SYNC_ON_FINAL)
-      SELF%CHILDREN (JFLD)%PTR => YLFW
-      CALL SELF%CHILDREN(JFLD)%PTR%SET_STATUS (SELF%GET_STATUS ())
-    ENDDO
-
-  END SUBROUTINE ${ftn}$_GANG_WRAPPER_INIT
-
-  SUBROUTINE ${ftn}$_GANG_OWNER_INIT(SELF, LBOUNDS, UBOUNDS, PERSISTENT, DELAYED, INIT_VALUE, PINNED, MAP_DEVPTR)
-    CLASS(${ftn}$_GANG_OWNER) :: SELF
-    INTEGER(KIND=JPIM), INTENT(IN), OPTIONAL :: LBOUNDS(${ft.rank}$)
-    INTEGER(KIND=JPIM), INTENT(IN) :: UBOUNDS(${ft.rank}$)
-    LOGICAL, INTENT(IN), OPTIONAL :: PERSISTENT
-    LOGICAL, OPTIONAL,  INTENT(IN) :: DELAYED
-    ${ft.type}$, OPTIONAL, INTENT(IN) :: INIT_VALUE
-    LOGICAL, OPTIONAL,  INTENT(IN) :: PINNED
-    LOGICAL, OPTIONAL,  INTENT(IN) :: MAP_DEVPTR
-
-    LOGICAL :: LLPERSISTENT
-    INTEGER (KIND=JPIM) :: IFLR, JFLD, NFLD
-    INTEGER (KIND=JPIM) :: LLBOUNDS (${ft.rank}$)
-    CLASS (${ftn1}$_WRAPPER_HELPER), POINTER :: YLFW
-
-    CALL SELF%${ftn}$_OWNER%INIT (PERSISTENT=PERSISTENT, LBOUNDS=LBOUNDS, UBOUNDS=UBOUNDS, &
-        & DELAYED=.FALSE., INIT_VALUE=INIT_VALUE, PINNED=PINNED, MAP_DEVPTR=MAP_DEVPTR)
-
-    LLBOUNDS = 1
-    IF (PRESENT (LBOUNDS)) LLBOUNDS = LBOUNDS
-
-    IFLR = ${ft.rank}$-1
-    NFLD = UBOUNDS (IFLR)-LLBOUNDS (IFLR)+1
-
-    LLBOUNDS(IFLR) = LLBOUNDS (IFLR+1)
-
-    ALLOCATE (SELF%CHILDREN (NFLD))
-
-#:set ar = ', '.join ([':'] * (ft.rank-2))
-
-    DO JFLD = 1, NFLD
-      ALLOCATE (YLFW)
-      CALL YLFW%INIT (DATA=SELF%PTR (${ar}$, JFLD, :), PERSISTENT=PERSISTENT, LBOUNDS=LLBOUNDS(1:IFLR), SYNC_ON_FINAL=.FALSE.)
-      SELF%CHILDREN (JFLD)%PTR => YLFW
-      CALL SELF%CHILDREN(JFLD)%PTR%SET_STATUS (SELF%GET_STATUS ())
-    ENDDO
-
-  END SUBROUTINE ${ftn}$_GANG_OWNER_INIT
-
-#:for type in ['WRAPPER', 'OWNER']
-  SUBROUTINE ${ftn}$_GANG_${type}$_FINAL(SELF)
-    CLASS(${ftn}$_GANG_${type}$) :: SELF
-    ${ft.type}$, POINTER :: PTR(${ft.shape}$)
-    INTEGER (KIND=JPIM) :: JFLD
-    CLASS (${ftn1}$_WRAPPER_HELPER), POINTER :: YLF
-
-    DO JFLD = 1, SIZE (SELF%CHILDREN)
-      YLF => SELF%CHILDREN(JFLD)%PTR
-      NULLIFY (YLF%DEVPTR)
-      NULLIFY (YLF%PARENT)
-! Mark wrapper as fresh on host, synchronization has to be handled by then parent
-      CALL YLF%SET_STATUS (IOR (SELF%GET_STATUS (), NHSTFRESH))
-      CALL YLF%FINAL ()
-      DEALLOCATE (YLF)
-    ENDDO
-
-    CALL SELF%${ftn}$_${type}$%FINAL ()
-
-    DEALLOCATE (SELF%CHILDREN)  
-    NULLIFY (SELF%CHILDREN)  
-
-  END SUBROUTINE ${ftn}$_GANG_${type}$_FINAL
-
-  SUBROUTINE ${ftn}$_GANG_${type}$_DELETE_DEVICE_DATA(SELF)
-    ! Delete the copy of this field on GPU device
-    CLASS(${ftn}$_GANG_${type}$) :: SELF
-
-    INTEGER (KIND=JPIM) :: JFLD
-
-    IF (ASSOCIATED (SELF%DEVPTR)) THEN
-      DO JFLD = 1, SIZE (SELF%CHILDREN)
-        NULLIFY (SELF%CHILDREN (JFLD)%PTR%DEVPTR)
-      ENDDO
-      CALL DEV_DEALLOCATE (SELF%DEVPTR, SELF%MAP_DEVPTR)
-    ENDIF
-
-  END SUBROUTINE ${ftn}$_GANG_${type}$_DELETE_DEVICE_DATA
-
-  SUBROUTINE ${ftn}$_GANG_${type}$_CREATE_DEVICE_DATA (SELF)
-    CLASS(${ftn}$_GANG_${type}$) :: SELF
-    INTEGER (KIND=JPIM) :: JFLD
-
-    CALL SELF%${ftn}$_${type}$%CREATE_DEVICE_DATA ()
-
-#:set ar = ', '.join ([':'] * (ft.rank-2))
-    DO JFLD = 1, SIZE (SELF%CHILDREN)
-      SELF%CHILDREN (JFLD)%PTR%DEVPTR (${','.join (list (map (lambda i: "LBOUND(SELF%DEVPTR," + str(i) + "):", range (1, ft1.rank))))}$,1:) => SELF%DEVPTR (${ar}$, JFLD, :)
-    ENDDO
-
-  END SUBROUTINE
-
-  SUBROUTINE ${ftn}$_GANG_${type}$_SET_STATUS (SELF, KSTATUS)
-    CLASS(${ftn}$_GANG_${type}$) :: SELF
-    INTEGER (KIND=JPIM), INTENT (IN) :: KSTATUS
-
-    INTEGER (KIND=JPIM) :: JFLD
-
-    CALL SELF%${ftn}$_${type}$%SET_STATUS (KSTATUS)
-
-    DO JFLD = 1, SIZE (SELF%CHILDREN)
-      CALL SELF%CHILDREN(JFLD)%PTR%SET_STATUS (KSTATUS)
-    ENDDO
-
-  END SUBROUTINE
-
-#:endfor
-
-#:endfor
-
 END MODULE FIELD_${RANK}$${SUFF}$_GANG_MODULE
diff --git a/field_gang_module.fypp b/field_gang_module.fypp
@@ -9,21 +9,8 @@
 
 MODULE FIELD_GANG_MODULE
 
-#:set fieldTypeList = fieldType.getFieldTypeList (ganged=True)
-
-#:for ft in fieldTypeList
-USE ${ft.name}$_GANG_MODULE
-#:endfor
-
-${fieldType.useParkind1 ()}$
-
 IMPLICIT NONE
 
 PRIVATE
 
-#:for ft in fieldTypeList
-PUBLIC :: ${ft.name}$_GANG_WRAPPER
-PUBLIC :: ${ft.name}$_GANG_OWNER
-#:endfor
-
 END MODULE FIELD_GANG_MODULE
diff --git a/tests/test_field_gang_simple.F90 b/tests/test_field_gang_simple.F90
@@ -16,52 +16,52 @@ PROGRAM TEST_FIELD_GANG_SIMPLE
 
         IMPLICIT NONE
 
-        CLASS(FIELD_3RB), POINTER :: BUFFER => NULL()
-        TYPE(FIELD_2RB_PTR), ALLOCATABLE :: FIELDS(:)
+        ! CLASS(FIELD_3RB), POINTER :: BUFFER => NULL()
+        ! TYPE(FIELD_2RB_PTR), ALLOCATABLE :: FIELDS(:)
 
-        REAL(KIND=JPRB), POINTER :: BUFFER_CPU(:,:,:)
-        REAL(KIND=JPRB), POINTER :: BUFFER_GPU(:,:,:)
-        REAL(KIND=JPRB), POINTER :: FIELD_PTR(:,:)
+        ! REAL(KIND=JPRB), POINTER :: BUFFER_CPU(:,:,:)
+        ! REAL(KIND=JPRB), POINTER :: BUFFER_GPU(:,:,:)
+        ! REAL(KIND=JPRB), POINTER :: FIELD_PTR(:,:)
 
-        LOGICAL :: RES
-        INTEGER(KIND=JPIM) :: NFIELDS, IFIELD, I, J
+        ! LOGICAL :: RES
+        ! INTEGER(KIND=JPIM) :: NFIELDS, IFIELD, I, J
 
-        NFIELDS = 3
-        CALL FIELD_NEW(BUFFER, FIELDS, LBOUNDS=[10,1,1], UBOUNDS=[21,NFIELDS,10], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB)
+        ! NFIELDS = 3
+        ! CALL FIELD_NEW(BUFFER, FIELDS, LBOUNDS=[10,1,1], UBOUNDS=[21,NFIELDS,10], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB)
 
-        CALL BUFFER%GET_DEVICE_DATA_RDWR(BUFFER_GPU)
-        !$ACC SERIAL PRESENT (BUFFER_GPU)
-        DO J=1,10
-          DO IFIELD=1,NFIELDS
-            DO I=10,21
-              BUFFER_GPU(I,IFIELD,J) = 42._JPRB
-            END DO
-          END DO
-        END DO
-        !$ACC END SERIAL
+        ! CALL BUFFER%GET_DEVICE_DATA_RDWR(BUFFER_GPU)
+        ! !$ACC SERIAL PRESENT (BUFFER_GPU)
+        ! DO J=1,10
+        !   DO IFIELD=1,NFIELDS
+        !     DO I=10,21
+        !       BUFFER_GPU(I,IFIELD,J) = 42._JPRB
+        !     END DO
+        !   END DO
+        ! END DO
+        ! !$ACC END SERIAL
 
-        ! Check that children and parent have matching statuses
-        IF(IAND(BUFFER%GET_STATUS(), NHSTFRESH) /= 0) ERROR STOP
-        DO IFIELD=1,NFIELDS
-          IF(IAND(FIELDS(IFIELD)%PTR%GET_STATUS(), NHSTFRESH) /= 0) ERROR STOP
-        ENDDO
+        ! ! Check that children and parent have matching statuses
+        ! IF(IAND(BUFFER%GET_STATUS(), NHSTFRESH) /= 0) ERROR STOP
+        ! DO IFIELD=1,NFIELDS
+        !   IF(IAND(FIELDS(IFIELD)%PTR%GET_STATUS(), NHSTFRESH) /= 0) ERROR STOP
+        ! ENDDO
 
-        CALL BUFFER%SYNC_HOST_RDWR()
+        ! CALL BUFFER%SYNC_HOST_RDWR()
 
-        CALL FIELDS(1)%PTR%GET_HOST_DATA_RDWR(FIELD_PTR)
-        IF(.NOT. ALL(FIELD_PTR == 42)) ERROR STOP
-        CALL FIELDS(2)%PTR%GET_HOST_DATA_RDWR(FIELD_PTR)
-        IF(.NOT. ALL(FIELD_PTR == 42)) ERROR STOP
-        CALL FIELDS(3)%PTR%GET_HOST_DATA_RDWR(FIELD_PTR)
-        IF(.NOT. ALL(FIELD_PTR == 42)) ERROR STOP
+        ! CALL FIELDS(1)%PTR%GET_HOST_DATA_RDWR(FIELD_PTR)
+        ! IF(.NOT. ALL(FIELD_PTR == 42)) ERROR STOP
+        ! CALL FIELDS(2)%PTR%GET_HOST_DATA_RDWR(FIELD_PTR)
+        ! IF(.NOT. ALL(FIELD_PTR == 42)) ERROR STOP
+        ! CALL FIELDS(3)%PTR%GET_HOST_DATA_RDWR(FIELD_PTR)
+        ! IF(.NOT. ALL(FIELD_PTR == 42)) ERROR STOP
 
 
-        ! Check that children and parent have matching statuses
-        IF(IAND(BUFFER%GET_STATUS(), NDEVFRESH) /= 0) ERROR STOP
-        DO IFIELD=1,NFIELDS
-          IF(IAND(FIELDS(IFIELD)%PTR%GET_STATUS(), NDEVFRESH) /= 0) ERROR STOP
-        ENDDO
+        ! ! Check that children and parent have matching statuses
+        ! IF(IAND(BUFFER%GET_STATUS(), NDEVFRESH) /= 0) ERROR STOP
+        ! DO IFIELD=1,NFIELDS
+        !   IF(IAND(FIELDS(IFIELD)%PTR%GET_STATUS(), NDEVFRESH) /= 0) ERROR STOP
+        ! ENDDO
 
-        CALL FIELD_DELETE(BUFFER)
-        DEALLOCATE(FIELDS)
+        ! CALL FIELD_DELETE(BUFFER)
+        ! DEALLOCATE(FIELDS)
 END PROGRAM TEST_FIELD_GANG_SIMPLE