added missing blk_bounds to gang methods and updated test

Author: wertysas

src/buffer/field_RANKSUFF_gang_module.fypp

@@ -69,7 +69,7 @@ CONTAINS
     INTEGER(KIND=JPIM), OPTIONAL,  INTENT(IN) :: BLK_BOUNDS(2)
 
     IF (ASSOCIATED (SELF%PARENT)) THEN
-      CALL SELF%PARENT%CREATE_DEVICE_DATA ()
+      CALL SELF%PARENT%CREATE_DEVICE_DATA (BLK_BOUNDS=BLK_BOUNDS)
     ENDIF
 
   END SUBROUTINE
@@ -104,13 +104,13 @@ CONTAINS
 
     IF (ASSOCIATED (SELF%PARENT)) THEN
       IF (IAND (MODE, NWR) /= 0) THEN
-        CALL SELF%PARENT%SYNC_${what}$_RDWR (QUEUE)
+        CALL SELF%PARENT%SYNC_${what}$_RDWR (QUEUE, BLK_BOUNDS)
       ELSEIF (IAND (MODE, NRD) /= 0) THEN
-        CALL SELF%PARENT%SYNC_${what}$_RDONLY (QUEUE)
+        CALL SELF%PARENT%SYNC_${what}$_RDONLY (QUEUE, BLK_BOUNDS)
       ENDIF
     ENDIF
 
-    CALL SELF%${ftn1}$_WRAPPER%GET_${what}$_DATA (MODE, PTR, QUEUE)
+    CALL SELF%${ftn1}$_WRAPPER%GET_${what}$_DATA (MODE, PTR, QUEUE, BLK_BOUNDS=BLK_BOUNDS)
 
   END SUBROUTINE 
 
@@ -257,7 +257,7 @@ CONTAINS
     INTEGER(KIND=JPIM), OPTIONAL,  INTENT(IN) :: BLK_BOUNDS(2)
     INTEGER (KIND=JPIM) :: JFLD
 
-    CALL SELF%${ftn}$_${type}$%CREATE_DEVICE_DATA ()
+    CALL SELF%${ftn}$_${type}$%CREATE_DEVICE_DATA (BLK_BOUNDS=BLK_BOUNDS)
 
 #:set ar = ', '.join ([':'] * (ft.rank-2))
     DO JFLD = 1, SIZE (SELF%CHILDREN)

src/core/field_RANKSUFF_module.fypp

@@ -434,15 +434,14 @@ CONTAINS
   INTEGER (KIND=JPIM),           INTENT(IN) :: KDIR
   INTEGER (KIND=JPIM), OPTIONAL, INTENT(IN) :: QUEUE
   INTEGER(KIND=JPIM), OPTIONAL,  INTENT(IN) :: BLK_BOUNDS(2)
-    
+
   INTEGER(KIND=JPIM) :: LB, UB
   ${ft.type}$, POINTER :: HST_BLK(${ft.shape}$) => NULL()
   REAL :: START, FINISH
-  
+
+  CALL CPU_TIME(START)
   IF ( .NOT. PRESENT(BLK_BOUNDS) ) THEN
-    CALL CPU_TIME(START)
     CALL SELF%COPY_FUNC (SELF%PTR, SELF%DEVPTR, SELF%MAP_DEVPTR, KDIR, QUEUE)
-    CALL CPU_TIME(FINISH)
   ELSE
     LB = LBOUND(SELF%PTR, ${ft.rank}$)
     UB = UBOUND(SELF%PTR, ${ft.rank}$)
@@ -452,6 +451,8 @@ CONTAINS
     HST_BLK => SELF%PTR(${ft.hst_blk}$)
     CALL SELF%COPY_FUNC(HST_BLK, SELF%DEVPTR, SELF%MAP_DEVPTR, KDIR, QUEUE)
   END IF
+  CALL CPU_TIME(FINISH)
+
   IF (KDIR == NH2D) THEN
     CALL SELF%STATS%INC_CPU_TO_GPU_TRANSFER(START, FINISH)
   ELSE IF (KDIR == ND2H) THEN
@@ -546,8 +547,20 @@ CONTAINS
   SUBROUTINE ${ftn}$_CREATE_DEVICE_DATA (SELF, BLK_BOUNDS)
     CLASS(${ftn}$) :: SELF
     INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: BLK_BOUNDS(2)
+    INTEGER(KIND=JPIM)                       :: DEVPTR_SIZE
+
+    IF ( PRESENT(BLK_BOUNDS) ) THEN
+      DEVPTR_SIZE = SIZE(SELF%PTR(${':,'*(ft.rank-1)}$ BLK_BOUNDS(1):BLK_BOUNDS(2)))
+    ELSE
+      DEVPTR_SIZE = SIZE(SELF%PTR)
+    ENDIF
+
+    IF (.NOT. ASSOCIATED (SELF%DEVPTR) ) THEN
+      CALL DEV_ALLOCATE_HST (DEV=SELF%DEVPTR, HST=SELF%PTR, MAP_DEVPTR=SELF%MAP_DEVPTR, BLK_BOUNDS=BLK_BOUNDS)
+    ELSE IF ( SIZE(SELF%DEVPTR) < DEVPTR_SIZE ) THEN
+      CALL DEV_ALLOCATE_HST (DEV=SELF%DEVPTR, HST=SELF%PTR, MAP_DEVPTR=SELF%MAP_DEVPTR, BLK_BOUNDS=BLK_BOUNDS)
+    ENDIF
 
-    CALL DEV_ALLOCATE_HST (DEV=SELF%DEVPTR, HST=SELF%PTR, MAP_DEVPTR=SELF%MAP_DEVPTR, BLK_BOUNDS=BLK_BOUNDS)
   END SUBROUTINE
 
   SUBROUTINE ${ftn}$_GET_DEVICE_DATA (SELF, MODE, PTR, QUEUE, BLK_BOUNDS)
@@ -556,19 +569,19 @@ CONTAINS
     ${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}$)
-    
+
     LBOUNDS=LBOUND(SELF%PTR)
-    IF (.NOT. ASSOCIATED (SELF%DEVPTR)) THEN
-      CALL SELF%CREATE_DEVICE_DATA(BLK_BOUNDS=BLK_BOUNDS)
-    ENDIF
+
+    CALL SELF%CREATE_DEVICE_DATA(BLK_BOUNDS=BLK_BOUNDS)
+
     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}$)
+      PTR (${ft.lbptr_blk}$) => SELF%DEVPTR (${ft.devptr_blk}$)
     ELSE
       PTR (${ft.lbptr}$) => SELF%DEVPTR (${','.join(':' for _ in range(ft.rank))}$)
     END IF
@@ -614,7 +627,6 @@ CONTAINS
     IF(SELF%GET_STATUS ()==UNALLOCATED)THEN
       CALL SELF%CREATE_HOST_DATA ()
       IF (SELF%HAS_INIT_VALUE) THEN
-        CALL SELF%CREATE_DEVICE_DATA(BLK_BOUNDS=BLK_BOUNDS)
         SELF%PTR=SELF%INIT_VALUE
         CALL SELF%SET_STATUS (NHSTFRESH)
       ENDIF
@@ -670,7 +682,7 @@ CONTAINS
     INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN)    :: BLK_BOUNDS(2)
     ${ft.type}$, POINTER                        :: ZPTR(${ft.shape}$)
 
-    CALL SELF%GET_DEVICE_DATA_RDWR (ZPTR, QUEUE)
+    CALL SELF%GET_DEVICE_DATA_RDWR (ZPTR, QUEUE, BLK_BOUNDS=BLK_BOUNDS)
 
   END SUBROUTINE ${ftn}$_SYNC_DEVICE_RDWR
 

tests/test_get_device_data_bounds.F90

@@ -16,8 +16,9 @@ PROGRAM TEST_GET_DEVICE_DATA_BOUNDS
   IMPLICIT NONE
 
   CLASS(FIELD_2RB), POINTER :: F_PTR => NULL()
-  REAL(KIND=JPRB), POINTER  :: PTR_CPU(:,:)
-  REAL(KIND=JPRB), POINTER  :: PTR_GPU(:,:)
+  REAL(KIND=JPRB), POINTER  :: PTR_CPU(:,:) => NULL()
+  REAL(KIND=JPRB), POINTER  :: PTR_GPU(:,:) => NULL()
+  REAL(KIND=JPRB), POINTER  :: PTR_GPU2(:,:) => NULL()
   LOGICAL                   :: OKAY
   INTEGER                   :: I,J
 
@@ -36,19 +37,12 @@ PROGRAM TEST_GET_DEVICE_DATA_BOUNDS
       IF ( PTR_GPU(I,J) /= 42 ) THEN
         OKAY = .FALSE.
       END IF
+      PTR_GPU(I,J) = 32
     END DO
   END DO
+  !$acc end serial
 
-  IF ( OKAY ) THEN
-    DO I=1,128
-      DO J = 1,2
-        PTR_GPU(I,J) = 32
-      END DO
-    END DO
-  END IF
-  !$acc end serial 
-
-  IF (.NOT. OKAY) THEN 
+  IF (.NOT. OKAY) THEN
     CALL FIELD_ABORT("ERROR DATA NOT UPDATED ON DEVICE")
   END IF
 
@@ -61,7 +55,7 @@ PROGRAM TEST_GET_DEVICE_DATA_BOUNDS
     END DO
   END DO
 
-  IF (.NOT. OKAY) THEN 
+  IF (.NOT. OKAY) THEN
     CALL FIELD_ABORT("ERROR HOST DATA NOT UPDATED BY SYNC_HOST_RDWR")
   END  IF
 
@@ -71,9 +65,86 @@ PROGRAM TEST_GET_DEVICE_DATA_BOUNDS
     END IF
   END DO
 
-  IF (.NOT. OKAY) THEN 
+  IF (.NOT. OKAY) THEN
     CALL FIELD_ABORT("ERROR HOST 3RD COLUMN OF PTR_CPU SHOULD NOT HAVE BEEN MODIFIED")
   END  IF
 
+  PTR_CPU(:,1) = 38
+  PTR_CPU(:,2) = 38
+  PTR_CPU(:,3) = 39
+  CALL F_PTR%GET_DEVICE_DATA_RDWR(PTR_GPU, BLK_BOUNDS=[3,3])
+  !$acc serial, present(PTR_GPU), copy(OKAY)
+  DO I=1,128
+    IF ( PTR_GPU(I,J) /= 39 ) THEN
+      OKAY = .FALSE.
+    END IF
+    PTR_GPU(I,J) = 40
+  END DO
+  !$acc end serial
+
+  IF (.NOT. OKAY) THEN
+    CALL FIELD_ABORT("ERROR DEVICE DATA NOT UPDATED BY GET_DEVICE_DATA_RDWR")
+  END  IF
+
+  CALL F_PTR%SYNC_HOST_RDWR(BLK_BOUNDS=[3,3])
+
+  DO I=1,128
+   IF ( PTR_CPU(I,J) /= 40 ) THEN
+     OKAY =.FALSE.
+   END IF
+  END DO
+
+  IF (.NOT. OKAY) THEN
+    CALL FIELD_ABORT("ERROR HOST DATA NOT UPDATED BY SYNC_HOST_RDWR")
+  END  IF
+
+  DO I=1,128
+    DO J = 1,2
+      IF ( PTR_CPU(I,J) /= 38 ) THEN
+        OKAY =.FALSE.
+      END IF
+    END DO
+  END DO
+
+  IF (.NOT. OKAY) THEN
+    CALL FIELD_ABORT("ERROR HOST 1ST AND 2ND COLUMN OF PTR_CPU SHOULD NOT HAVE BEEN MODIFIED")
+  END IF
+
+
+  PTR_CPU(:,1) = 41
+  PTR_CPU(:,2) = 42
+  PTR_CPU(:,3) = 43
+
+  CALL F_PTR%GET_DEVICE_DATA_RDWR(PTR_GPU2)
+
+  !$acc serial, present(PTR_GPU2), copy(OKAY)
+  DO J=1,3
+    DO I=1,128
+      IF ( PTR_GPU2(I,J) /= 40+J ) THEN
+        OKAY = .FALSE.
+      END IF
+      PTR_GPU2(I,J) = I*10 + J
+    END DO
+  END DO
+  !$acc end serial
+
+  IF (.NOT. OKAY) THEN
+    CALL FIELD_ABORT("ERROR DEVICE DATA NOT UPDATED BY GET_DEVICE_DATA_RDWR")
+  END  IF
+
+  CALL F_PTR%SYNC_HOST_RDWR()
+  DO J=1,3
+    DO I=1,128
+      IF ( PTR_CPU(I,J) /= I*10+J ) THEN
+        OKAY = .FALSE.
+      END IF
+    END DO
+  END DO
+
+  IF (.NOT. OKAY) THEN
+    CALL FIELD_ABORT("ERROR HOST DATA NOT UPDATED BY SYNC_HOST_RDWR")
+  END  IF
+
+
 END PROGRAM TEST_GET_DEVICE_DATA_BOUNDS