Improve block range reshuffling

field_RANKSUFF_gather_module.fypp

@@ -53,7 +53,8 @@ CLASS (${ft.name}$),   POINTER, INTENT (IN) :: YLF
 
 ${ft.type}$, POINTER :: PTR(${ft.shape}$)
 
-PTR => PAIR_GATHER_${what}$_DATA_${mode}$ (SELF%${ft.name}$_LIST, SELF%LNULL, SELF%LFULL, SELF%KLON_G, SELF%KGPBLKS_G, SELF%YLFINDS, YLF)
+PTR => PAIR_GATHER_${what}$_DATA_${mode}$ (SELF%${ft.name}$_LIST, SELF%LNULL, SELF%LFULL, &
+& SELF%KLON_G, SELF%KGPBLKS_G, SELF%YLFINDS, YLF, SELF%KBLKMIN, SELF%KBLKMAX)
 
 END FUNCTION ${ft.name}$_GATHER_${what}$_DATA_${mode}$
 

field_RANKSUFF_shuffle_module.fypp

@@ -66,12 +66,14 @@ CONTAINS
 #:for what in ['DEVICE', 'HOST']
 #:for mode in ['RDONLY', 'RDWR']
 
-FUNCTION PAIR_${ft.name}$_GATHER_${what}$_DATA_${mode}$ (YDPAIR, LDNULL, LDFULL, KLON, KGPBLKS, YDFINDS, YLF) RESULT (PTR)
+FUNCTION PAIR_${ft.name}$_GATHER_${what}$_DATA_${mode}$ (YDPAIR, LDNULL, LDFULL, KLON, KGPBLKS, YDFINDS, YLF, KBLKMIN, KBLKMAX) RESULT (PTR)
 TYPE (${ft.name}$_SHUFFLE_PAIR), POINTER              :: YDPAIR
 LOGICAL,                                   INTENT (IN) :: LDNULL, LDFULL
 INTEGER (KIND=JPIM),                       INTENT (IN) :: KLON, KGPBLKS
 CLASS (FIELD_3IM),                POINTER              :: YDFINDS 
 CLASS (${ft.name}$),              POINTER, INTENT (IN) :: YLF
+INTEGER (KIND=JPIM),                       INTENT (IN) :: KBLKMIN
+INTEGER (KIND=JPIM),                       INTENT (IN) :: KBLKMAX
 
 ${ft.type}$, POINTER :: PTR(${ft.shape}$), ZTRG(${ft.shape}$), ZTRS(${ft.shape}$)
 ${ft.type}$, POINTER :: PTR1(${ft.shape}$)
@@ -92,7 +94,12 @@ ELSEIF (LDFULL) THEN
   PTR => GET_${what}$_DATA_${mode}$ (YLF)
 
   ! Set last lbound to 1
-  PTR (${','.join (list (map (lambda i: "LBOUND(PTR," + str (i) + "):", range (1, ft.rank))))}$, 1:) => PTR
+
+  ILBOUNDS = LBOUND (PTR)
+
+  PTR1 => PTR (${','.join ([':'] * (ft.rank-1))}$, KBLKMIN:KBLKMAX)
+
+  PTR (${','.join (list (map (lambda i: "ILBOUNDS(" + str (i) + "):", range (1, ft.rank))))}$, 1:) => PTR1
 
 ELSE
 

field_gathscat_type_module.fypp

@@ -33,25 +33,30 @@ INTEGER (KIND=JPIM), PARAMETER :: NLONDIM = 1, NBLKDIM = 2
 
 CONTAINS
 
-SUBROUTINE INIT_FIELD_GATHSCAT (SELF, YDFCOND, KGPTOT, KLON_S, KLON_G)
+SUBROUTINE INIT_FIELD_GATHSCAT (SELF, YDFCOND, KGPTOT, KLON_S, KLON_G, KBLKMIN, KBLKMAX)
 
 USE FIELD_ABORT_MODULE
 
 CLASS (FIELD_GATHSCAT) :: SELF
 CLASS (FIELD_2LM), POINTER :: YDFCOND
 INTEGER (KIND=JPIM), INTENT (IN) :: KGPTOT
 INTEGER (KIND=JPIM), INTENT (IN), OPTIONAL :: KLON_S, KLON_G
+INTEGER (KIND=JPIM), INTENT (IN), OPTIONAL :: KBLKMIN, KBLKMAX
 
 LOGICAL, POINTER :: LLF (:,:)
 INTEGER (KIND=JPIM), POINTER :: INDS (:,:,:)
 INTEGER (KIND=JPIM) :: JLONS, JBLKS, JLONG, JBLKG, I1S, I2S
 INTEGER (KIND=JPIM) :: JBOFF
 
-
 LLF => GET_HOST_DATA_RDONLY (YDFCOND)
 
+SELF%KBLKMIN = LBOUND (LLF, 2)
+IF (PRESENT (KBLKMIN)) SELF%KBLKMIN = KBLKMIN
+SELF%KBLKMAX = UBOUND (LLF, 2)
+IF (PRESENT (KBLKMAX)) SELF%KBLKMAX = KBLKMAX
+
 SELF%KLON_S    = SIZE (LLF, 1)
-SELF%KGPBLKS_S = SIZE (LLF, 2)
+SELF%KGPBLKS_S = SELF%KBLKMAX - SELF%KBLKMIN + 1
 SELF%KGPTOT_S  = KGPTOT
 
 ! Reduction
@@ -79,8 +84,8 @@ SELF%KLON    =  SELF%KLON_G
 SELF%KGPBLKS =  SELF%KGPBLKS_G
 
 ! Does not work anymore with partial block ranges
-!SELF%LFULL = SELF%KGPTOT_G == SELF%KGPTOT_S
-SELF%LFULL = .FALSE.
+SELF%LFULL = SELF%KGPTOT_G == SELF%KGPTOT_S
+!SELF%LFULL = .FALSE.
 SELF%LNULL = SELF%KGPTOT_G == 0
 
 IF (SELF%LNULL) THEN

field_shuffle_type_module.fypp

@@ -28,6 +28,7 @@ TYPE FIELD_SHUFFLE
   INTEGER (KIND=JPIM) :: KGPBLKS_G = -1, KLON_G = -1, KGPTOT_G = -1
   INTEGER (KIND=JPIM) :: KGPBLKS_S = -1, KLON_S = -1, KGPTOT_S = -1
   INTEGER (KIND=JPIM) :: KGPBLKS   = -1, KLON   = -1, KGPTOT   = -1 ! alias for KGPBLKS, KLON, KGPTOT
+  INTEGER (KIND=JPIM) :: KBLKMIN, KBLKMAX
   LOGICAL :: LFULL = .FALSE.  ! No need to gather/scatter, all columns are OK, return pointers based on original fields
   LOGICAL :: LNULL = .FALSE.  ! No need to gather/scatter, all columns are KO, return pointers on empty arrays
   CLASS (FIELD_3IM), POINTER :: YLFINDS => NULL ()
@@ -74,6 +75,9 @@ SELF%KGPTOT  =  SELF%KGPTOT_G
 SELF%KLON    =  SELF%KLON_G   
 SELF%KGPBLKS =  SELF%KGPBLKS_G
 
+SELF%KBLKMIN = IBLKOFF
+SELF%KBLKMAX = SELF%KGPBLKS+IBLKOFF-1
+
 CALL FIELD_NEW (SELF%YLFINDS, UBOUNDS=[2, SELF%KLON_G, SELF%KGPBLKS_G], PERSISTENT=.TRUE.)
 INDS => GET_HOST_DATA_RDWR (SELF%YLFINDS)