Make FIELD%DEVPTR LBOUNDS always one

dev_alloc_module.fypp

@@ -176,6 +176,8 @@ END SUBROUTINE ${ft.name}$_DEV_DEALLOCATE
 
 SUBROUTINE ${ft.name}$_DEV_ALLOCATE_HST (DEV, HST, MAP_DEVPTR)
 
+USE FIELD_STATISTICS_MODULE
+
 ${ft.type}$, POINTER :: DEV(${ft.shape}$)
 ${ft.type}$, POINTER :: HST(${ft.shape}$)
 LOGICAL, INTENT(IN) :: MAP_DEVPTR
@@ -195,6 +197,8 @@ END SUBROUTINE ${ft.name}$_DEV_ALLOCATE_HST
 
 SUBROUTINE ${ft.name}$_DEV_DEALLOCATE (DEV, MAP_DEVPTR)
 
+USE FIELD_STATISTICS_MODULE
+
 ${ft.type}$, POINTER :: DEV(${ft.shape}$)
 LOGICAL, INTENT(IN) :: MAP_DEVPTR
 

field_RANKSUFF_data_module.fypp

@@ -129,15 +129,17 @@ CONTAINS
     ${'  ' * (ft.rank - e)}$DO J${e}$ = LBOUND (HST, ${e}$), UBOUND (HST, ${e}$)
   #:endfor
   #:set ar = ', '.join ([':'] * d  + list (map (lambda i: 'J' + str (i+1), range (d, ft.rank))))
+  #:set lbdiff = lambda i: f'LBOUND(DEV, {i}) - LBOUND (HST, {i})'
+  #:set ard = ', '.join ([':'] * d  + ['J' + str(i+1) + ' + ' + lbdiff(i+1) for i in 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 +156,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 +166,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 +275,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)

tests/CMakeLists.txt

@@ -80,6 +80,7 @@ list(APPEND TEST_FILES
         test_field_array.F90
         test_field_delete_on_null.F90
         test_get_device_data_wronly.F90
+        test_get_device_data_non_contiguous.F90
         test_host_mem_pool.F90
         test_lastdim.F90
         test_legacy.F90

tests/test_get_device_data_non_contiguous.F90

@@ -0,0 +1,46 @@
+! (C) Copyright 2022- ECMWF.
+! (C) Copyright 2022- Meteo-France.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+PROGRAM TEST_GET_DEVICE_DATA_NON_CONTIGUOUS
+        USE FIELD_MODULE
+        USE FIELD_FACTORY_MODULE
+        USE PARKIND1
+        USE FIELD_ABORT_MODULE
+        IMPLICIT NONE
+        CLASS(FIELD_2RB), POINTER     :: W => NULL()
+        REAL(KIND=JPRB),  ALLOCATABLE :: D(:,:,:)
+        REAL(KIND=JPRB),  POINTER :: PTR_CPU(:,:)
+        REAL(KIND=JPRB),  POINTER :: PTR_GPU(:,:)
+        LOGICAL :: OKAY
+        INTEGER :: I,J
+
+        ALLOCATE(D(-4:3, 1:5, -4:3))
+        D= 11
+        CALL FIELD_NEW(W, DATA=D(:,2,:), LBOUNDS=[-4,-4])
+        CALL W%GET_HOST_DATA_RDWR(PTR_CPU)
+        PTR_CPU=42
+
+        CALL W%GET_DEVICE_DATA_RDWR(PTR_GPU)
+        OKAY=.TRUE.
+        !$ACC SERIAL PRESENT (PTR_GPU) COPY(OKAY)
+        DO I=-4,3
+        DO J=-4,3
+        IF(PTR_GPU(I,J) /= 42) THEN
+                OKAY = .FALSE.
+        END IF
+        END DO
+        END DO
+        !$ACC END SERIAL
+
+        IF (.NOT. OKAY) THEN
+                CALL FIELD_ABORT ("PTR_GPU differ from 42")
+        END IF
+        CALL FIELD_DELETE(W)
+END PROGRAM TEST_GET_DEVICE_DATA_NON_CONTIGUOUS
+