From 9b318a1fa18e68b10bf8ce49578a767859e550b5 Mon Sep 17 00:00:00 2001 From: Philippe Marguinaud Date: Wed, 24 Jan 2024 20:26:42 +0000 Subject: [PATCH] Resolve COPY function at object creation --- field_RANKSUFF_data_module.fypp | 53 ++++++++++++++++++++++++++------- field_RANKSUFF_module.fypp | 18 +++++++++-- 2 files changed, 59 insertions(+), 12 deletions(-) diff --git a/field_RANKSUFF_data_module.fypp b/field_RANKSUFF_data_module.fypp index af5d7195..7a5d7ec0 100644 --- a/field_RANKSUFF_data_module.fypp +++ b/field_RANKSUFF_data_module.fypp @@ -23,7 +23,18 @@ PRIVATE #:set ftn = ft.name PUBLIC :: ${ftn}$_COPY +PUBLIC :: ${ftn}$_COPY_FUNC +PUBLIC :: ${ftn}$_COPY_INTF +ABSTRACT INTERFACE + SUBROUTINE ${ftn}$_COPY_INTF (HST, DEV, MAP_DEVPTR, KDIR, QUEUE) + IMPORT :: JPIM, ${ft.kind}$ + ${ft.type}$, POINTER :: HST (${ft.shape}$), DEV (${ft.shape}$) + LOGICAL, INTENT (IN) :: MAP_DEVPTR + INTEGER (KIND=JPIM), INTENT (IN) :: KDIR + INTEGER (KIND=JPIM), OPTIONAL, INTENT (IN) :: QUEUE + END SUBROUTINE +END INTERFACE #:endfor CONTAINS @@ -31,30 +42,35 @@ CONTAINS #:for ft in fieldTypeList #:set ftn = ft.name - SUBROUTINE ${ftn}$_COPY (HST, DEV, MAP_DEVPTR, KDIR, QUEUE) + FUNCTION ${ftn}$_COPY_FUNC (HST, DEV) RESULT (FUNC) USE FIELD_ABORT_MODULE - ${ft.type}$, POINTER :: HST (${ft.shape}$), DEV (${ft.shape}$) - LOGICAL, INTENT (IN) :: MAP_DEVPTR - INTEGER (KIND=JPIM), INTENT (IN) :: KDIR - INTEGER (KIND=JPIM), OPTIONAL, INTENT (IN) :: QUEUE + PROCEDURE (${ftn}$_COPY_INTF), POINTER :: FUNC + + ${ft.type}$, POINTER, OPTIONAL :: HST (${ft.shape}$), DEV (${ft.shape}$) + INTEGER :: LAST_CONTIG_DIM INTEGER :: NEXT_CONTIG_DIM - LAST_CONTIG_DIM = ${ftn}$_GET_LAST_CONTIGUOUS_DIMENSION (HST, 0) - NEXT_CONTIG_DIM = ${ftn}$_GET_LAST_CONTIGUOUS_DIMENSION (HST, LAST_CONTIG_DIM+1) + IF (PRESENT (HST)) THEN + LAST_CONTIG_DIM = ${ftn}$_GET_LAST_CONTIGUOUS_DIMENSION (HST, 0) + NEXT_CONTIG_DIM = ${ftn}$_GET_LAST_CONTIGUOUS_DIMENSION (HST, LAST_CONTIG_DIM+1) + ELSE + LAST_CONTIG_DIM = ${ft.rank}$ + NEXT_CONTIG_DIM = ${ft.rank}$ + ENDIF SELECT CASE (LAST_CONTIG_DIM) #:if defined('CUDA') CASE (${ft.rank}$) - CALL ${ftn}$_COPY_DIM${ft.rank}$_CONTIGUOUS (HST, DEV, MAP_DEVPTR, KDIR, QUEUE) + FUNC => ${ftn}$_COPY_DIM${ft.rank}$_CONTIGUOUS #:for d1 in range (ft.rank) CASE (${d1}$) SELECT CASE (NEXT_CONTIG_DIM) #:for d2 in range (d1+1, ft.rank+1) CASE (${d2}$) - CALL ${ftn}$_COPY_2D_DIM${d1}$_${d2}$_CONTIGUOUS (HST, DEV, MAP_DEVPTR, KDIR, QUEUE) + FUNC => ${ftn}$_COPY_2D_DIM${d1}$_${d2}$_CONTIGUOUS #:endfor CASE DEFAULT CALL FIELD_ABORT ('INTERNAL ERROR: UNEXPECTED NEXT_CONTIG_DIM') @@ -63,13 +79,30 @@ CONTAINS #:else #:for d in range (ft.rank + 1) CASE (${d}$) - CALL ${ftn}$_COPY_DIM${d}$_CONTIGUOUS (HST, DEV, MAP_DEVPTR, KDIR, QUEUE) + FUNC => ${ftn}$_COPY_DIM${d}$_CONTIGUOUS #:endfor #:endif CASE DEFAULT CALL FIELD_ABORT ('INTERNAL ERROR: UNEXPECTED LAST_CONTIG_DIM') END SELECT + END FUNCTION + + SUBROUTINE ${ftn}$_COPY (HST, DEV, MAP_DEVPTR, KDIR, QUEUE) + + USE FIELD_ABORT_MODULE + + ${ft.type}$, POINTER :: HST (${ft.shape}$), DEV (${ft.shape}$) + LOGICAL, INTENT (IN) :: MAP_DEVPTR + INTEGER (KIND=JPIM), INTENT (IN) :: KDIR + INTEGER (KIND=JPIM), OPTIONAL, INTENT (IN) :: QUEUE + + PROCEDURE (${ftn}$_COPY_INTF), POINTER :: FUNC + + FUNC => ${ftn}$_COPY_FUNC (HST, DEV) + + CALL FUNC (HST, DEV, MAP_DEVPTR, KDIR, QUEUE) + END SUBROUTINE #:for d in range (0, ft.rank+1) diff --git a/field_RANKSUFF_module.fypp b/field_RANKSUFF_module.fypp index 8785fafa..8b37e6db 100644 --- a/field_RANKSUFF_module.fypp +++ b/field_RANKSUFF_module.fypp @@ -27,6 +27,11 @@ USE OPENACC #endif ${fieldType.useParkind1 ()}$ +#:for ft in fieldTypeList +#:set ftn = ft.name +USE FIELD_${RANK}$${SUFF}$_DATA_MODULE, ONLY : ${ftn}$_COPY_INTF +#:endfor + IMPLICIT NONE PRIVATE @@ -36,6 +41,7 @@ PRIVATE TYPE, ABSTRACT, EXTENDS (FIELD_BASIC) :: ${ftn}$ ${ft.type}$, POINTER :: PTR(${ft.shape}$) => NULL() ${ft.type}$, POINTER, CONTIGUOUS :: DEVPTR(${ft.shape}$) => NULL() + PROCEDURE (${ftn}$_COPY_INTF), POINTER, NOPASS :: COPY_FUNC => NULL () CONTAINS PROCEDURE :: FINAL => ${ftn}$_FINAL @@ -137,6 +143,7 @@ CONTAINS #:set ftn = ft.name SUBROUTINE ${ftn}$_WRAPPER_INIT(SELF, DATA, PERSISTENT, LBOUNDS, MAP_DEVPTR) USE FIELD_ABORT_MODULE + USE ${ftn}$_DATA_MODULE, ONLY : ${ftn}$_COPY_FUNC ! Create FIELD object by wrapping existing data CLASS(${ftn}$_WRAPPER) :: SELF @@ -173,10 +180,13 @@ CONTAINS ENDIF ENDIF + SELF%COPY_FUNC => ${ftn}$_COPY_FUNC (SELF%PTR, SELF%DEVPTR) + END SUBROUTINE ${ftn}$_WRAPPER_INIT SUBROUTINE ${ftn}$_OWNER_INIT (SELF, LBOUNDS, UBOUNDS, PERSISTENT, DELAYED, INIT_VALUE, PINNED, MAP_DEVPTR) USE FIELD_ABORT_MODULE + USE ${ftn}$_DATA_MODULE, ONLY : ${ftn}$_COPY_FUNC CLASS(${ftn}$_OWNER) :: SELF INTEGER(KIND=JPIM), INTENT(IN), OPTIONAL :: LBOUNDS(${ft.rank}$) @@ -245,6 +255,9 @@ CONTAINS CALL SELF%SET_STATUS (NHSTFRESH) ENDIF ENDIF + + SELF%COPY_FUNC => ${ftn}$_COPY_FUNC () + END SUBROUTINE ${ftn}$_OWNER_INIT SUBROUTINE ${ftn}$_CREATE_HOST_DATA (SELF) @@ -371,15 +384,16 @@ CONTAINS END SUBROUTINE ${ftn}$_WIPE_OBJECT SUBROUTINE ${ftn}$_COPY_DATA (SELF, KDIR, QUEUE) - USE ${ftn}$_DATA_MODULE + CLASS(${ftn}$) :: SELF INTEGER (KIND=JPIM), INTENT(IN) :: KDIR INTEGER (KIND=JPIM), OPTIONAL, INTENT(IN) :: QUEUE REAL :: START, FINISH CALL CPU_TIME(START) - CALL ${ftn}$_COPY (SELF%PTR, SELF%DEVPTR, SELF%MAP_DEVPTR, KDIR, QUEUE) + CALL SELF%COPY_FUNC (SELF%PTR, SELF%DEVPTR, SELF%MAP_DEVPTR, KDIR, QUEUE) CALL CPU_TIME(FINISH) + IF (KDIR == NH2D) THEN CALL SELF%STATS%INC_CPU_TO_GPU_TRANSFER(START, FINISH) ELSE IF (KDIR == ND2H) THEN