diff --git a/field_RANKSUFF_gather_module.fypp b/field_RANKSUFF_gather_module.fypp index bf4833d..304e87c 100644 --- a/field_RANKSUFF_gather_module.fypp +++ b/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}$ diff --git a/field_RANKSUFF_shuffle_module.fypp b/field_RANKSUFF_shuffle_module.fypp index 8efd904..3acb044 100644 --- a/field_RANKSUFF_shuffle_module.fypp +++ b/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 diff --git a/field_gathscat_type_module.fypp b/field_gathscat_type_module.fypp index 28d9f8b..3ff2cf4 100644 --- a/field_gathscat_type_module.fypp +++ b/field_gathscat_type_module.fypp @@ -33,7 +33,7 @@ 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 @@ -41,17 +41,22 @@ 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 diff --git a/field_shuffle_type_module.fypp b/field_shuffle_type_module.fypp index 1e75d00..d482579 100644 --- a/field_shuffle_type_module.fypp +++ b/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)