Decouple lower bounds of devptr and hst in FIELD_COPY_DIMd_CONTIGUOUS

dev_alloc_module.fypp

@@ -104,6 +104,7 @@ ${ft.type}$, POINTER :: DEV(${ft.shape}$)
 INTEGER (KIND=JPIM), INTENT (IN) :: UBOUNDS (${ft.rank}$)
 INTEGER (KIND=JPIM), INTENT (IN), OPTIONAL :: LBOUNDS (${ft.rank}$)
 INTEGER (KIND=JPIM) :: ILBOUNDS (${ft.rank}$)
+INTEGER (KIND=JPIM) :: DIMSIZES (${ft.rank}$)
 ${ft.type}$, POINTER :: TMP(${ft.shape}$)
 LOGICAL, INTENT(IN) :: MAP_DEVPTR
 
@@ -115,10 +116,11 @@ INTEGER :: ISTAT
 
 ILBOUNDS = 1
 IF (PRESENT (LBOUNDS)) ILBOUNDS = LBOUNDS
+DIMSIZES = UBOUNDS-ILBOUNDS+1
 
 SIZ = KIND (DEV)
 #:for i in range (1, ft.rank+1, 1)
-SIZ = SIZ * INT (UBOUNDS(${i}$)-ILBOUNDS(${i}$)+1, C_SIZE_T)
+SIZ = SIZ * INT (DIMSIZES(${i}$), C_SIZE_T)
 #:endfor
 
 IF(MAP_DEVPTR)THEN
@@ -129,7 +131,7 @@ ELSE
 #:endif
 ENDIF
 
-CALL C_F_POINTER (PTR, TMP, UBOUNDS-ILBOUNDS+1)
+CALL C_F_POINTER (PTR, TMP, DIMSIZES)
 DEV (${ ', '.join (map (lambda i: 'ILBOUNDS (' + str (i) + '):', range (1, ft.rank+1))) }$) => TMP
 
 IF(MAP_DEVPTR)THEN
@@ -155,7 +157,7 @@ IF (ASSOCIATED (DEV)) THEN
 
   IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_DEVICE_DEALLOCATE (SIZE (DEV, KIND=JPIB) * INT (KIND (DEV), KIND=JPIB))
 
-  PTR = C_LOC (DEV (${ ', '.join (map (lambda i: 'LBOUND (DEV, ' + str (i) + ')', range (1, ft.rank+1))) }$))
+  PTR = C_LOC (DEV)
 
   IF(MAP_DEVPTR)THEN
     CALL DEV_FREE (PTR)

field_RANKSUFF_data_module.fypp

@@ -121,23 +121,28 @@ CONTAINS
     INTEGER (KIND=JPIM), OPTIONAL, INTENT (IN) :: QUEUE
     INTEGER (KIND=INT64)                       :: ISIZE
     INTEGER :: ${', '.join (['J'] + list (map (lambda i: 'J' + str (i+1), range (d, ft.rank))))}$
+    INTEGER :: ${', '.join (['D'] + list (map (lambda i: 'D' + str (i+1), range (d, ft.rank))))}$
+    INTEGER :: ${', '.join (['JD'] + list (map (lambda i: 'JD' + str (i+1), range (d, ft.rank))))}$
 #ifdef _OPENACC
     TYPE(C_DEVPTR) :: DEVPTR
 #endif
 
   #:for e in range (ft.rank, d, -1)
+    ${'  ' * (ft.rank - e)}$D${e}$ = LBOUND(DEV, ${e}$) - LBOUND (HST, ${e}$)
     ${'  ' * (ft.rank - e)}$DO J${e}$ = LBOUND (HST, ${e}$), UBOUND (HST, ${e}$)
+    ${'  ' * (ft.rank - e + 1)}$JD${e}$ = J${e}$ + D${e}$
   #:endfor
   #:set ar = ', '.join ([':'] * d  + list (map (lambda i: 'J' + str (i+1), range (d, ft.rank))))
+  #:set ard = ', '.join ([':'] * d  + list (map (lambda i: 'JD' + str (i+1), range (d, ft.rank))))
   #:set indent = '  ' * (ft.rank - e)
 #ifdef _OPENACC
     ${indent}$  IF(MAP_DEVPTR)THEN
     ${indent}$    !$acc host_data use_device(DEV)
-    ${indent}$    DEVPTR = C_DEVLOC(DEV (${ar}$))
+    ${indent}$    DEVPTR = C_DEVLOC(DEV (${ard}$))
     ${indent}$    !$acc end host_data
     ${indent}$  ELSE
     ${indent}$    !$acc data deviceptr(DEVPTR, DEV)
-    ${indent}$    DEVPTR = C_DEVLOC(DEV (${ar}$))
+    ${indent}$    DEVPTR = C_DEVLOC(DEV (${ard}$))
     ${indent}$    !$acc end data
     ${indent}$  ENDIF
 #endif
@@ -154,7 +159,7 @@ CONTAINS
     ${indent}$      CALL ACC_MEMCPY_TO_DEVICE (DEVPTR , HST (${ar}$), ISIZE)
     ${indent}$    ENDIF
 #else
-    ${indent}$    DEV (${ar}$) = HST (${ar}$)
+    ${indent}$    DEV (${ard}$) = HST (${ar}$)
 #endif
     ${indent}$  ELSEIF (KDIR == ND2H) THEN
 #ifdef _OPENACC
@@ -164,7 +169,7 @@ CONTAINS
     ${indent}$      CALL ACC_MEMCPY_FROM_DEVICE (HST (${ar}$), DEVPTR, ISIZE)
     ${indent}$    ENDIF
 #else
-    ${indent}$    HST (${ar}$) = DEV (${ar}$)
+    ${indent}$    HST (${ar}$) = DEV (${ard}$)
 #endif
     ${indent}$  ENDIF
   #:for e in range (d, ft.rank)
@@ -273,7 +278,6 @@ CONTAINS
   INTEGER (KIND=JPIM) :: J, LB(${ft.rank}$)
 
   ! assume that dimension all dimensions before AFTER are contiguous...
-
   LB = LBOUND(PTR)
   IF (AFTER == 0) THEN
     IPREVIOUS_STRIDE = KIND (PTR)