Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Small fixes to COPY_DATA #22

Merged
merged 4 commits into from
Feb 5, 2024
Merged

Small fixes to COPY_DATA #22

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
3a2d68a
Promote fully-contiguous field transfers to the top of nested SELECT …
awnawab Jan 24, 2024
9a8d3d1
Use acc host_data instead of runtime ACC_DEVICEPTR in COPY_DIM_CONTIG…
awnawab Jan 24, 2024
a68b7bf
Resolve COPY function at object creation
pmarguinaud Jan 24, 2024
14eb55b
Fix for v large data transfers
awnawab Jan 30, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
70 changes: 52 additions & 18 deletions field_RANKSUFF_data_module.fypp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -23,65 +23,99 @@ 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

#: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}$)
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')
END SELECT
#:endfor
CASE (${ft.rank}$)
CALL ${ftn}$_COPY_DIM${ft.rank}$_CONTIGUOUS (HST, DEV, MAP_DEVPTR, KDIR, QUEUE)
#: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)
SUBROUTINE ${ftn}$_COPY_DIM${d}$_CONTIGUOUS (HST, DEV, MAP_DEVPTR, KDIR, QUEUE)
#ifdef _OPENACC
USE OPENACC
#endif
USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY : INT64
${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
INTEGER (KIND=JPIM) :: ISIZE
INTEGER (KIND=INT64) :: ISIZE
INTEGER :: ${', '.join (['J'] + list (map (lambda i: 'J' + str (i+1), range (d, ft.rank))))}$
#ifdef _OPENACC
TYPE(C_DEVPTR) :: DEVPTR
Expand All @@ -94,19 +128,19 @@ CONTAINS
#:set indent = ' ' * (ft.rank - e)
#ifdef _OPENACC
${indent}$ IF(MAP_DEVPTR)THEN
${indent}$ DEVPTR = ACC_DEVICEPTR(DEV (${ar}$))
${indent}$ !$acc host_data use_device(DEV)
${indent}$ DEVPTR = C_DEVLOC(DEV (${ar}$))
${indent}$ !$acc end host_data
${indent}$ ELSE
#:if defined('CUDA')
!$acc data deviceptr(DEVPTR, DEV)
${indent}$ !$acc data deviceptr(DEVPTR, DEV)
${indent}$ DEVPTR = C_DEVLOC(DEV (${ar}$))
!$acc end data
#:endif
${indent}$ !$acc end data
${indent}$ ENDIF
#endif
#:if d == 0
${indent}$ ISIZE = KIND (HST)
#:else
${indent}$ ISIZE = KIND (HST) * SIZE (HST (${ar}$))
${indent}$ ISIZE = SIZEOF (HST)
#:endif
${indent}$ IF (KDIR == NH2D) THEN
#ifdef _OPENACC
Expand Down
18 changes: 16 additions & 2 deletions field_RANKSUFF_module.fypp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -139,6 +145,7 @@ CONTAINS
SUBROUTINE ${ftn}$_WRAPPER_INIT(SELF, DATA, PERSISTENT, LBOUNDS, MAP_DEVPTR, SYNC_ON_FINAL)
USE FIELD_ABORT_MODULE
USE FIELD_DEFAULTS_MODULE
USE ${ftn}$_DATA_MODULE, ONLY : ${ftn}$_COPY_FUNC

! Create FIELD object by wrapping existing data
CLASS(${ftn}$_WRAPPER) :: SELF
Expand Down Expand Up @@ -183,10 +190,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}$)
Expand Down Expand Up @@ -256,6 +266,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)
Expand Down Expand Up @@ -384,15 +397,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
Expand Down
Loading