From 7a606eda793ff666067ef7c1953099bac1f99468 Mon Sep 17 00:00:00 2001 From: Johan Ericsson Date: Thu, 5 Dec 2024 15:28:50 +0100 Subject: [PATCH] added optional BLK_BOUNDS to all SYNC and GET_HOST_DATA routines --- fieldType.py | 2 ++ field_RANKSUFF_module.fypp | 48 +++++++++++++++++++++++--------------- 2 files changed, 31 insertions(+), 19 deletions(-) diff --git a/fieldType.py b/fieldType.py index fa4cd86..57fe7ab 100755 --- a/fieldType.py +++ b/fieldType.py @@ -27,6 +27,8 @@ def __init__ (self, **kwargs): self.viewRank = self.rank-1 self.viewShape = ','.join ([':'] * (self.rank-1)) self.lbptr = ', '.join (list (map (lambda i: "LBOUNDS(" + str (i+1) + "):", range (0, self.rank)))) + self.lbptr_blk = ', '.join([ f"LBOUNDS({i}):" for i in range range(1, self.rank)] + ["BLK_BOUNDS(1):"]) + self.devptr_blk = ':, ' * (ft.rank-1) + 'BLK_BOUNDS(1):BLK_BOUNDS(2)' self.hasView = self.rank > 1 self.ganged = self.rank > 2 diff --git a/field_RANKSUFF_module.fypp b/field_RANKSUFF_module.fypp index 008f310..635146f 100644 --- a/field_RANKSUFF_module.fypp +++ b/field_RANKSUFF_module.fypp @@ -449,9 +449,9 @@ CONTAINS LB = LBOUND(SELF%PTR, ${ft.rank}$) UB = UBOUND(SELF%PTR, ${ft.rank}$) IF ( BLK_BOUNDS(1) < LB .OR. BLK_BOUNDS(2) > UB ) THEN - CALL FIELD_ABORT("BLOCK DIMENSIONS ARE OUR OF RANGE") + CALL FIELD_ABORT("BLOCK DIMENSIONS ARE OUT OF RANGE") END IF - TMP_PTR => SELF%PTR(${':,' * (ft.rank-1) + 'BLK_BOUNDS(1):BLK_BOUNDS(2)'}$) + TMP_PTR => SELF%PTR(${ft.devptr_blk}$) CALL COPY_ARRAY(TMP_PTR, SELF%DEVPTR, SELF%MAP_DEVPTR, KDIR, QUEUE) END IF IF (KDIR == NH2D) THEN @@ -473,15 +473,19 @@ CONTAINS LBOUNDS=LBOUND(SELF%PTR) IF (IAND (SELF%GET_STATUS (), NHSTFRESH) == 0) THEN - CALL SELF%COPY_DATA (ND2H, QUEUE) + CALL SELF%COPY_DATA (ND2H, QUEUE, BLK_BOUNDS=BLK_BOUNDS) CALL SELF%SET_STATUS (IOR (SELF%GET_STATUS (), NHSTFRESH)) ENDIF - PTR (${ft.lbptr}$) => SELF%PTR (${','.join(':' for _ in range(ft.rank))}$) + 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 (NDEVFRESH))) ENDIF - END SUBROUTINE ${ftn}$_GET_HOST_DATA + T SUBROUTINE ${ftn}$_OWNER_GET_HOST_DATA (SELF, MODE, PTR, QUEUE, BLK_BOUNDS) CLASS(${ftn}$_OWNER) :: SELF @@ -507,16 +511,16 @@ CONTAINS INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: QUEUE INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: BLK_BOUNDS(2) - CALL SELF%GET_HOST_DATA (NRD, PPTR, QUEUE, BLK_BOUNDS) + CALL SELF%GET_HOST_DATA (NRD, PPTR, QUEUE, BLK_BOUNDS=BLK_BOUNDS) END SUBROUTINE ${ftn}$_GET_HOST_DATA_RDONLY - SUBROUTINE ${ftn}$_SYNC_HOST_RDONLY (SELF, QUEUE) + SUBROUTINE ${ftn}$_SYNC_HOST_RDONLY (SELF, QUEUE, BLK_BOUNDS) CLASS(${ftn}$) :: SELF INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: QUEUE ${ft.type}$, POINTER :: ZPTR(${ft.shape}$) - CALL SELF%GET_HOST_DATA_RDONLY (ZPTR, QUEUE) + CALL SELF%GET_HOST_DATA_RDONLY (ZPTR, QUEUE, BLK_BOUNDS=BLK_BOUNDS) END SUBROUTINE ${ftn}$_SYNC_HOST_RDONLY @@ -526,7 +530,7 @@ CONTAINS INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: QUEUE INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: BLK_BOUNDS(2) - CALL SELF%GET_HOST_DATA (IOR (NRD, NWR), PPTR, QUEUE, BLK_BOUNDS) + CALL SELF%GET_HOST_DATA (IOR (NRD, NWR), PPTR, QUEUE, BLK_BOUNDS=BLK_BOUNDS) END SUBROUTINE ${ftn}$_GET_HOST_DATA_RDWR @@ -535,7 +539,7 @@ CONTAINS INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: QUEUE ${ft.type}$, POINTER :: ZPTR(${ft.shape}$) - CALL SELF%GET_HOST_DATA_RDWR (ZPTR, QUEUE) + CALL SELF%GET_HOST_DATA_RDWR (ZPTR, QUEUE, BLK_BOUNDS=BLK_BOUNDS) END SUBROUTINE ${ftn}$_SYNC_HOST_RDWR @@ -562,7 +566,11 @@ CONTAINS CALL SELF%COPY_DATA (NH2D, QUEUE, BLK_BOUNDS=BLK_BOUNDS) CALL SELF%SET_STATUS (IOR (SELF%GET_STATUS (), NDEVFRESH)) ENDIF - PTR (${ft.lbptr}$) => SELF%DEVPTR (${','.join(':' for _ in range(ft.rank))}$) + 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 @@ -600,7 +608,7 @@ CONTAINS 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), OPTIONAL, INTENT(IN) :: BLK_BOUNDS(2) IF(SELF%GET_STATUS ()==UNALLOCATED)THEN CALL SELF%CREATE_HOST_DATA () @@ -610,7 +618,7 @@ CONTAINS CALL SELF%SET_STATUS (NHSTFRESH) ENDIF ENDIF - CALL SELF%${ftn}$_GET_DEVICE_DATA(MODE, PTR, QUEUE, BLK_BOUNDS) + CALL SELF%${ftn}$_GET_DEVICE_DATA(MODE, PTR, QUEUE, BLK_BOUNDS=BLK_BOUNDS) END SUBROUTINE ${ftn}$_OWNER_GET_DEVICE_DATA @@ -618,9 +626,9 @@ CONTAINS CLASS(${ftn}$) :: SELF ${ft.type}$, POINTER, INTENT(INOUT) :: PPTR(${ft.shape}$) INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: QUEUE - INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: BLK_BOUNDS(2) + INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: BLK_BOUNDS(2) - CALL SELF%GET_DEVICE_DATA (NRD, PPTR, QUEUE) + CALL SELF%GET_DEVICE_DATA (NRD, PPTR, QUEUE, BLK_BOUNDS=BLK_BOUNDS) END SUBROUTINE ${ftn}$_GET_DEVICE_DATA_RDONLY @@ -631,16 +639,17 @@ CONTAINS INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: BLK_BOUNDS(2) CALL SELF%SET_STATUS (IOR (SELF%GET_STATUS (), NDEVFRESH)) - CALL SELF%GET_DEVICE_DATA (NWR, PPTR, QUEUE) + CALL SELF%GET_DEVICE_DATA (NWR, PPTR, QUEUE, BLK_BOUNDS=BLK_BOUNDS) END SUBROUTINE ${ftn}$_GET_DEVICE_DATA_WRONLY - SUBROUTINE ${ftn}$_SYNC_DEVICE_RDONLY (SELF, QUEUE) + SUBROUTINE ${ftn}$_SYNC_DEVICE_RDONLY (SELF, QUEUE, BLK_BOUNDS) CLASS(${ftn}$) :: SELF INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: QUEUE + INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: BLK_BOUNDS(2) ${ft.type}$, POINTER :: ZPTR(${ft.shape}$) - CALL SELF%GET_DEVICE_DATA_RDONLY (ZPTR, QUEUE) + CALL SELF%GET_DEVICE_DATA_RDONLY (ZPTR, QUEUE, BLK_BOUNDS=BLK_BOUNDS) END SUBROUTINE ${ftn}$_SYNC_DEVICE_RDONLY @@ -654,9 +663,10 @@ CONTAINS END SUBROUTINE ${ftn}$_GET_DEVICE_DATA_RDWR - SUBROUTINE ${ftn}$_SYNC_DEVICE_RDWR (SELF, QUEUE) + SUBROUTINE ${ftn}$_SYNC_DEVICE_RDWR (SELF, QUEUE, BLK_BOUNDS) CLASS(${ftn}$) :: SELF INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: QUEUE + INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: BLK_BOUNDS(2) ${ft.type}$, POINTER :: ZPTR(${ft.shape}$) CALL SELF%GET_DEVICE_DATA_RDWR (ZPTR, QUEUE)