From 49f6e7b810ed5bb846caf2dd216dd4dcb5ce11a2 Mon Sep 17 00:00:00 2001 From: Johan Ericsson Date: Sat, 21 Dec 2024 19:35:56 +0100 Subject: [PATCH] adding multi-blk support WIP --- dev_alloc_module.fypp | 49 +++++++++++++++++++++++++++++++++ field_RANKSUFF_data_module.fypp | 17 ++++++++++++ field_RANKSUFF_module.fypp | 49 +++++++++++++++++++++++++++++++++ field_basic_module.F90 | 1 + 4 files changed, 116 insertions(+) diff --git a/dev_alloc_module.fypp b/dev_alloc_module.fypp index 9b9d4b7..c1c0ae2 100644 --- a/dev_alloc_module.fypp +++ b/dev_alloc_module.fypp @@ -31,6 +31,12 @@ INTERFACE DEV_ALLOCATE_HST #:endfor END INTERFACE +INTERFACE DEV_ALLOCATE_BLKS +#:for ft in fieldTypeList + MODULE PROCEDURE ${ft.name}$_DEV_ALLOCATE_BLKS +#:endfor +END INTERFACE + #:if defined('USE_BUDDY_MALLOC') INTERFACE DEV_ALLOCATE_DIM #:for ft in fieldTypeList @@ -102,6 +108,25 @@ CALL ${ft.name}$_DEV_ALLOCATE_DIM (DEV, UBOUNDS=IUBOUNDS, LBOUNDS=ILBOUNDS, MAP_ END SUBROUTINE ${ft.name}$_DEV_ALLOCATE_HST +SUBROUTINE ${ft.name}$_DEV_ALLOCATE_BLKS (DEV, HST, MAP_DEVPTR, BLK_SIZE, NBLKS) + +${ft.type}$, POINTER :: DEV(${ft.shape}$) +${ft.type}$, POINTER :: HST(${ft.shape}$) +LOGICAL, INTENT(IN) :: MAP_DEVPTR +INTEGER(KIND=JPIM), INTENT(IN) :: BLK_SIZE +INTEGER(KIND=JPIM), INTENT(IN) :: NBLKS + +INTEGER :: ILBOUNDS (${ft.rank}$) +INTEGER :: IUBOUNDS (${ft.rank}$) + +ILBOUNDS = LBOUND (HST) +IUBOUNDS = UBOUND (HST) +IUBOUNDS(${ft.rank}$) = ILBOUNDS(${ft.rank}$) + BLK_SIZE*NBLKS - 1 + +CALL ${ft.name}$_DEV_ALLOCATE_DIM (DEV, UBOUNDS=IUBOUNDS, LBOUNDS=ILBOUNDS, MAP_DEVPTR=MAP_DEVPTR) + +END SUBROUTINE ${ft.name}$_DEV_ALLOCATE_BLKS + SUBROUTINE ${ft.name}$_DEV_ALLOCATE_DIM (DEV, UBOUNDS, LBOUNDS, MAP_DEVPTR) USE FIELD_STATISTICS_MODULE @@ -206,6 +231,30 @@ IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_DEVICE_ALLOCATE (SIZE (DEV, K END SUBROUTINE ${ft.name}$_DEV_ALLOCATE_HST +SUBROUTINE ${ft.name}$_DEV_ALLOCATE_BLKS (DEV, HST, MAP_DEVPTR, BLK_SIZE, NBLKS) + +USE FIELD_STATISTICS_MODULE + +${ft.type}$, POINTER :: DEV(${ft.shape}$) +${ft.type}$, POINTER :: HST(${ft.shape}$) +LOGICAL, INTENT(IN) :: MAP_DEVPTR +INTEGER(KIND=JPIM), INTENT(IN) :: BLK_SIZE +INTEGER(KIND=JPIM), INTENT(IN) :: NBLKS + +INTEGER :: ILBOUNDS (${ft.rank}$) +INTEGER :: IUBOUNDS (${ft.rank}$) + +ILBOUNDS = LBOUND (HST) +IUBOUNDS = UBOUND (HST) +IUBOUNDS(${ft.rank}$) = ILBOUNDS(${ft.rank}$) + BLK_SIZE*NBLKS - 1 +ALLOCATE (DEV (${ ' '.join([f'ILBOUNDS({i}):IUBOUNDS(i})' for i in range (1, ft.rank+1)])}$)) + +!$acc enter data create (DEV) + +IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_DEVICE_ALLOCATE (SIZE (DEV, KIND=JPIB) * INT (KIND (DEV), KIND=JPIB)) + +END SUBROUTINE ${ft.name}$_DEV_ALLOCATE_BLKS + SUBROUTINE ${ft.name}$_DEV_DEALLOCATE (DEV, MAP_DEVPTR) USE FIELD_STATISTICS_MODULE diff --git a/field_RANKSUFF_data_module.fypp b/field_RANKSUFF_data_module.fypp index c511429..dac3c74 100644 --- a/field_RANKSUFF_data_module.fypp +++ b/field_RANKSUFF_data_module.fypp @@ -109,6 +109,23 @@ CONTAINS END SUBROUTINE + SUBROUTINE ${ftn}$_COPY_ARRAY_BLKS (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 diff --git a/field_RANKSUFF_module.fypp b/field_RANKSUFF_module.fypp index f06d91e..352da0b 100644 --- a/field_RANKSUFF_module.fypp +++ b/field_RANKSUFF_module.fypp @@ -72,6 +72,7 @@ CONTAINS PROCEDURE, PRIVATE :: ${ftn}$_GET_DEVICE_DATA PROCEDURE, PRIVATE :: COPY_DATA => ${ftn}$_COPY_DATA PROCEDURE :: CREATE_DEVICE_DATA => ${ftn}$_CREATE_DEVICE_DATA + PROCEDURE :: CREATE_DEVICE_DATA_BLKS => ${ftn}$_CREATE_DEVICE_BLKS #:if defined('WITH_FIAT') PROCEDURE :: CRC64 => ${ftn}$_CRC64 #:endif @@ -552,6 +553,22 @@ CONTAINS CALL DEV_ALLOCATE_HST (DEV=SELF%DEVPTR, HST=SELF%PTR, MAP_DEVPTR=SELF%MAP_DEVPTR, BLK_BOUNDS=BLK_BOUNDS) END SUBROUTINE + SUBROUTINE ${ftn}$_CREATE_DEVICE_DATA_BLKS(SELF, BLK_SIZE, NBLKS) + + USE FIELD_ABORT_MODULE + + CLASS(${ftn}$) :: SELF + INTEGER(KIND=JPIM), INTENT(IN) :: BLK_SIZE + INTEGER(KIND=JPIM), INTENT(IN) :: NBLKS + + IF ( NBLKS < 2 ) THEN + CALL FIELD_ABORT("NBLKS MUST BE GREATER THAN 1 WHEN DOING A MULTI-BLOCK ALLOCATION ON DEVICE") + ENDIF + + SELF%NBLKS = NBLKS + CALL DEV_ALLOCATE_BLKS(DEV=SELF%DEVPTR, HST=SELF%PTR, MAP_DEVPTR=SELF%MAP_DEVPTR, BLK_SIZE=BLKS_SIZE, NBLKS=NBLKS) + END SUBROUTINE + SUBROUTINE ${ftn}$_GET_DEVICE_DATA (SELF, MODE, PTR, QUEUE, BLK_BOUNDS) CLASS(${ftn}$) :: SELF INTEGER (KIND=JPIM), INTENT(IN) :: MODE @@ -560,6 +577,38 @@ CONTAINS INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: BLK_BOUNDS(2) INTEGER(KIND=JPIM) :: LBOUNDS(${ft.rank}$) + + LBOUNDS=LBOUND(SELF%PTR) + IF (.NOT. ASSOCIATED (SELF%DEVPTR)) THEN + CALL SELF%CREATE_DEVICE_DATA(BLK_BOUNDS=BLK_BOUNDS) + ENDIF + IF (IAND (SELF%GET_STATUS (), NDEVFRESH) == 0) THEN + CALL SELF%COPY_DATA (NH2D, QUEUE, BLK_BOUNDS=BLK_BOUNDS) + CALL SELF%SET_STATUS (IOR (SELF%GET_STATUS (), NDEVFRESH)) + ENDIF + IF ( PRESENT(BLK_BOUNDS) ) THEN + PTR ( ${ft.lbptr_blk}$) => SELF%DEVPTR (${ft.devptr_blk}$) + ELSE + PTR (${ft.lbptr}$) => SELF%DEVPTR (${','.join(':' for _ in range(ft.rank))}$) + END IF + IF (IAND (MODE, NWR) /= 0) THEN + CALL SELF%SET_STATUS (IAND (SELF%GET_STATUS (), NOT (NHSTFRESH))) + ENDIF + + END SUBROUTINE ${ftn}$_GET_DEVICE_DATA + + SUBROUTINE ${ftn}$_GET_DEVICE_DATA_BLKS (SELF, MODE, PTR, QUEUE, BLK_BOUNDS, BLK) + CLASS(${ftn}$) :: SELF + INTEGER (KIND=JPIM), INTENT(IN) :: MODE + ${ft.type}$, POINTER, INTENT(INOUT) :: PTR(${ft.shape}$) + INTEGER (KIND=JPIM), OPTIONAL, INTENT(IN) :: QUEUE + INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: BLK_BOUNDS(2) + + INTEGER(KIND=JPIM) :: LBOUNDS(${ft.rank}$) + + IF (SELF%NBLKS > 1) THEN + CALL SELF + ENDIF LBOUNDS=LBOUND(SELF%PTR) IF (.NOT. ASSOCIATED (SELF%DEVPTR)) THEN diff --git a/field_basic_module.F90 b/field_basic_module.F90 index 1e0e001..03f5162 100644 --- a/field_basic_module.F90 +++ b/field_basic_module.F90 @@ -37,6 +37,7 @@ MODULE FIELD_BASIC_MODULE LOGICAL :: LOBJECT_COPIED = .FALSE. LOGICAL :: MAP_DEVPTR = .TRUE. INTEGER(KIND=JPIM) :: BLKID = 0 + INTEGER(KIND=JPIM) :: NBLKS = 1 CONTAINS PROCEDURE (FIELD_BASIC_SYNC), DEFERRED :: SYNC_HOST_RDWR