added optional BLK_BOUNDS to all SYNC and GET_HOST_DATA routines

ecmwf-ifs · Dec 5, 2024 · 7a606ed · 7a606ed
1 parent aef8344
commit 7a606ed
Show file tree

Hide file tree

Showing 2 changed files with 31 additions and 19 deletions.
diff --git 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
@@ -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,17 +618,17 @@ 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
 
   SUBROUTINE ${ftn}$_GET_DEVICE_DATA_RDONLY (SELF, PPTR, QUEUE, BLK_BOUNDS)
     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)