From 55343af48faa7d16e9575985d523461616213fe4 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Tue, 25 Jun 2019 14:46:50 +0200
Subject: [PATCH] Philippe 25/06/2019: IO: added IO_Field_read for 3D integer
arrays
---
src/LIB/SURCOUCHE/src/mode_io_field_read.f90 | 128 ++++++++++++++++++-
src/LIB/SURCOUCHE/src/mode_io_read_lfi.f90 | 37 +++++-
src/LIB/SURCOUCHE/src/mode_io_read_nc4.f90 | 74 ++++++++++-
src/LIB/SURCOUCHE/src/mode_scatter.f90 | 87 ++++++++++++-
4 files changed, 316 insertions(+), 10 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/mode_io_field_read.f90 b/src/LIB/SURCOUCHE/src/mode_io_field_read.f90
index b6d25f347..f2b16e1cb 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_field_read.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_field_read.f90
@@ -14,6 +14,7 @@
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 12/04/2019: use MNHTIME for time measurement variables
! P. Wautelet 26/04/2019: use modd_precision parameters for datatypes of MPI communications
+! P. Wautelet 25/06/2019: added IO_Field_read for 3D integer arrays (IO_Field_read_byname_N3 and IO_Field_read_byfield_N3)
!-----------------------------------------------------------------
MODULE MODE_IO_FIELD_READ
@@ -41,7 +42,7 @@ INTERFACE IO_Field_read
IO_Field_read_byname_X4, IO_Field_read_byname_X5, &
IO_Field_read_byname_X6, &
IO_Field_read_byname_N0, IO_Field_read_byname_N1, &
- IO_Field_read_byname_N2, &
+ IO_Field_read_byname_N2, IO_Field_read_byname_N3, &
IO_Field_read_byname_L0, IO_Field_read_byname_L1, &
IO_Field_read_byname_C0, &
IO_Field_read_byname_T0, &
@@ -50,7 +51,7 @@ INTERFACE IO_Field_read
IO_Field_read_byfield_X4,IO_Field_read_byfield_X5, &
IO_Field_read_byfield_X6, &
IO_Field_read_byfield_N0,IO_Field_read_byfield_N1, &
- IO_Field_read_byfield_N2, &
+ IO_Field_read_byfield_N2,IO_Field_read_byfield_N3, &
IO_Field_read_byfield_L0,IO_Field_read_byfield_L1, &
IO_Field_read_byfield_C0, &
IO_Field_read_byfield_T0
@@ -1468,6 +1469,129 @@ IF (PRESENT(KRESP)) KRESP = IRESP
END SUBROUTINE IO_Field_read_byfield_N2
+SUBROUTINE IO_Field_read_byname_N3(TPFILE,HNAME,KFIELD,KRESP)
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
+INTEGER,DIMENSION(:,:,:),INTENT(INOUT) :: KFIELD ! array containing the data field
+INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+!
+INTEGER :: ID ! Index of the field
+INTEGER :: IRESP ! return_code
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byname_N3',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
+!
+CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
+!
+IF(IRESP==0) CALL IO_Field_read(TPFILE,TFIELDLIST(ID),KFIELD,IRESP)
+!
+IF (PRESENT(KRESP)) KRESP = IRESP
+!
+END SUBROUTINE IO_Field_read_byname_N3
+
+SUBROUTINE IO_Field_read_byfield_N3(TPFILE,TPFIELD,KFIELD,KRESP)
+!
+USE MODD_IO, ONLY: GSMONOPROC, ISP, LPACK, L1D, L2D
+USE MODD_PARAMETERS_ll, ONLY: JPHEXT
+USE MODD_TIMEZ, ONLY: TIMEZ
+!
+USE MODE_ALLOCBUFFER_ll
+USE MODE_SCATTER_ll
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+INTEGER,DIMENSION(:,:,:),TARGET,INTENT(INOUT) :: KFIELD ! array containing the data field
+INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+!
+INTEGER :: IERR
+INTEGER,DIMENSION(:,:,:),POINTER :: IFIELDP
+LOGICAL :: GALLOC
+INTEGER :: IRESP
+INTEGER :: IHEXTOT
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_N3',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+!
+GALLOC = .FALSE.
+IRESP = 0
+IFIELDP => NULL()
+!
+IHEXTOT = 2*JPHEXT+1
+CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_N3',IRESP)
+!
+IF (IRESP==0) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==IHEXTOT .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
+ IFIELDP=>KFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1,:)
+ ELSE IF (LPACK .AND. L2D .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
+ IFIELDP=>KFIELD(:,JPHEXT+1:JPHEXT+1,:)
+ ELSE
+ IFIELDP=>KFIELD(:,:,:)
+ END IF
+ IF (TPFILE%CFORMAT=='NETCDF4') THEN
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
+ ELSE IF (TPFILE%CFORMAT=='LFI') THEN
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,IFIELDP,IRESP)
+ ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
+ END IF
+ IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==IHEXTOT .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
+ KFIELD(:,:,:)=SPREAD(SPREAD(KFIELD(JPHEXT+1,JPHEXT+1,:),DIM=1,NCOPIES=IHEXTOT),DIM=2,NCOPIES=IHEXTOT)
+ ELSE IF (LPACK .AND. L2D .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
+ KFIELD(:,:,:)=SPREAD(KFIELD(:,JPHEXT+1,:),DIM=2,NCOPIES=IHEXTOT)
+ END IF
+ ELSE
+ IF (ISP == TPFILE%NMASTER_RANK) THEN
+ ! I/O process case
+ CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,TPFIELD%CDIR,GALLOC)
+ IF (TPFILE%CFORMAT=='NETCDF4') THEN
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
+ ELSE IF (TPFILE%CFORMAT=='LFI') THEN
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,IFIELDP,IRESP)
+ ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
+ END IF
+ ELSE
+ !Not really necessary but useful to suppress alerts with Valgrind
+ ALLOCATE(IFIELDP(0,0,0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ !
+ !Broadcast header only if IRESP==-111
+ !because metadata of field has been modified in IO_Field_read_xxx
+ IF (IRESP==-111) CALL IO_Field_metadata_bcast(TPFILE,TPFIELD)
+ !
+ IF (TPFIELD%CDIR == 'XX' .OR. TPFIELD%CDIR == 'YY') THEN
+ ! XX or YY Scatter Field
+ CALL SCATTER_XXFIELD(TPFIELD%CDIR,IFIELDP,KFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
+ ! Broadcast Field
+ CALL MPI_BCAST(KFIELD,SIZE(KFIELD),MNHREAL_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ ELSE IF (TPFIELD%CDIR == 'XY') THEN
+ IF (LPACK .AND. L2D) THEN
+ ! 2D compact case
+ CALL SCATTER_XXFIELD('XX',IFIELDP(:,1,:),KFIELD(:,JPHEXT+1,:),TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
+ KFIELD(:,:,:) = SPREAD(KFIELD(:,JPHEXT+1,:),DIM=2,NCOPIES=IHEXTOT)
+ ELSE
+ ! XY Scatter Field
+ CALL SCATTER_XYFIELD(IFIELDP,KFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
+ END IF
+ ELSE
+ IF (ISP == TPFILE%NMASTER_RANK) KFIELD = IFIELDP
+ CALL MPI_BCAST(KFIELD,SIZE(KFIELD),MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ END IF
+ END IF
+END IF
+!
+IF (GALLOC) DEALLOCATE (IFIELDP)
+!
+IF (IRESP==-111) IRESP = 0 !-111 is not really an error (metadata has changed)
+!
+IF (PRESENT(KRESP)) KRESP = IRESP
+!
+END SUBROUTINE IO_Field_read_byfield_N3
+
+
SUBROUTINE IO_Field_read_byname_L0(TPFILE,HNAME,OFIELD,KRESP)
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
diff --git a/src/LIB/SURCOUCHE/src/mode_io_read_lfi.f90 b/src/LIB/SURCOUCHE/src/mode_io_read_lfi.f90
index 525930eef..01b03897d 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_read_lfi.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_read_lfi.f90
@@ -9,6 +9,7 @@
! P. Wautelet 14/12/2018: split fmreadwrit.f90
! P. Wautelet 21/02/2019: bugfix: intent of read fields: OUT->INOUT to keep initial value if not found in file
! P. Wautelet 05/03/2019: rename IO subroutines and modules
+! P. Wautelet 25/06/2019: added IO_Field_read for 3D integer arrays (IO_Field_read_lfi_N3)
!-----------------------------------------------------------------
module mode_io_read_lfi
!
@@ -34,7 +35,7 @@ INTERFACE IO_Field_read_lfi
IO_Field_read_lfi_X4, IO_Field_read_lfi_X5, &
IO_Field_read_lfi_X6, &
IO_Field_read_lfi_N0, IO_Field_read_lfi_N1, &
- IO_Field_read_lfi_N2, &
+ IO_Field_read_lfi_N2, IO_Field_read_lfi_N3, &
IO_Field_read_lfi_L0, IO_Field_read_lfi_L1, &
IO_Field_read_lfi_C0, &
IO_Field_read_lfi_T0
@@ -387,6 +388,40 @@ IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
END SUBROUTINE IO_Field_read_lfi_N2
!
!
+SUBROUTINE IO_Field_read_lfi_N3(TPFILE,TPFIELD,KFIELD,KRESP)
+USE MODE_MSG
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+INTEGER,DIMENSION(:,:,:),INTENT(INOUT) :: KFIELD ! array containing the data field
+INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
+!
+!* 0.2 Declarations of local variables
+!
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
+INTEGER :: ILENG
+INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
+LOGICAL :: GGOOD
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_N3',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+!
+ILENG = SIZE(KFIELD)
+!
+CALL IO_Field_read_check_lfi(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
+!
+IF (GGOOD) KFIELD(:,:,:) = RESHAPE(IWORK(IWORK(2)+3:),SHAPE(KFIELD))
+!
+KRESP=IRESP
+!
+IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
+!
+END SUBROUTINE IO_Field_read_lfi_N3
+!
+!
SUBROUTINE IO_Field_read_lfi_L0(TPFILE,TPFIELD,OFIELD,KRESP)
USE MODE_MSG
!
diff --git a/src/LIB/SURCOUCHE/src/mode_io_read_nc4.f90 b/src/LIB/SURCOUCHE/src/mode_io_read_nc4.f90
index 3aaed8fb9..74c69fbcf 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_read_nc4.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_read_nc4.f90
@@ -11,6 +11,7 @@
! P. Wautelet 10/01/2019: replace handle_err by IO_Err_handle_nc4 for better netCDF error messages
! P. Wautelet 21/02/2019: bugfix: intent of read fields: OUT->INOUT to keep initial value if not found in file
! P. Wautelet 05/03/2019: rename IO subroutines and modules
+! P. Wautelet 25/06/2019: added IO_Field_read for 3D integer arrays (IO_Field_read_nc4_N3)
!-----------------------------------------------------------------
#if defined(MNH_IOCDF4)
module mode_io_read_nc4
@@ -39,7 +40,7 @@ INTERFACE IO_Field_read_nc4
IO_Field_read_nc4_X4,IO_Field_read_nc4_X5, &
IO_Field_read_nc4_X6, &
IO_Field_read_nc4_N0,IO_Field_read_nc4_N1, &
- IO_Field_read_nc4_N2, &
+ IO_Field_read_nc4_N2,IO_Field_read_nc4_N3, &
IO_Field_read_nc4_L0,IO_Field_read_nc4_L1, &
IO_Field_read_nc4_C0, &
IO_Field_read_nc4_T0
@@ -968,6 +969,77 @@ KRESP = IRESP
END SUBROUTINE IO_Field_read_nc4_N2
+SUBROUTINE IO_Field_read_nc4_N3(TPFILE, TPFIELD, KFIELD, KRESP)
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+INTEGER, DIMENSION(:,:,:), INTENT(INOUT) :: KFIELD
+INTEGER, INTENT(OUT) :: KRESP ! return-code
+
+INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: INCID
+INTEGER(KIND=CDFINT) :: IVARID
+INTEGER(KIND=CDFINT) :: ITYPE ! variable type
+INTEGER(KIND=CDFINT) :: IDIMS ! number of dimensions
+INTEGER(KIND=CDFINT),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER(KIND=CDFINT),DIMENSION(3) :: IDIMLEN
+INTEGER :: IRESP
+
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_nc4_N3',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+
+IRESP = 0
+! Get the Netcdf file ID
+INCID = TPFILE%NNCID
+
+CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
+
+! Get variable ID, NDIMS and TYPE
+STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (STATUS /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N3','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+ GOTO 1000
+END IF
+STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
+IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N3','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+
+!Neglect the time dimension (of size 1)
+IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
+
+!NF90_INT1 is for the case a boolean was written
+IF (IDIMS == SIZE(SHAPE(KFIELD)) .AND. (ITYPE == NF90_INT .OR. ITYPE == NF90_INT64 .OR. ITYPE == NF90_INT1) ) THEN
+ ! Check size of variable before reading
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N3','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N3','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N3','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+
+ IF (IDIMLEN(1) == SIZE(KFIELD,1) .AND. IDIMLEN(2) == SIZE(KFIELD,2) .AND. IDIMLEN(3) == SIZE(KFIELD,3)) THEN
+ ! Read variable
+ STATUS = NF90_GET_VAR(INCID, IVARID, KFIELD)
+ IF (STATUS /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N3','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ GOTO 1000
+ END IF
+ ! Read and check attributes of variable
+ CALL IO_Field_attr_read_check_nc4(TPFILE,TPFIELD,IVARID,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_N3',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong size)')
+ IRESP = -3
+ END IF
+ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_N3',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong number of dimensions or wrong type)')
+ IRESP = -3
+END IF
+
+1000 CONTINUE
+KRESP = IRESP
+
+END SUBROUTINE IO_Field_read_nc4_N3
+
SUBROUTINE IO_Field_read_nc4_L0(TPFILE, TPFIELD, OFIELD, KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
diff --git a/src/LIB/SURCOUCHE/src/mode_scatter.f90 b/src/LIB/SURCOUCHE/src/mode_scatter.f90
index f16f8f614..32eaa7290 100644
--- a/src/LIB/SURCOUCHE/src/mode_scatter.f90
+++ b/src/LIB/SURCOUCHE/src/mode_scatter.f90
@@ -6,6 +6,7 @@
! Modifications:
! J. Escobar 10/02/2012: bug in MPI_RECV: replace MPI_STATUSES_IGNORE with MPI_STATUS_IGNORE
! P. Wautelet 26/04/2019: use modd_precision parameters for datatypes of MPI communications
+! P. Wautelet 25/06/2019: added IO_Field_read for 3D integer arrays (SCATTERXX_N3 and SCATTERXY_N3)
!-----------------------------------------------------------------
MODULE MODE_SCATTER_ll
@@ -19,14 +20,17 @@ IMPLICIT NONE
PRIVATE
INTERFACE SCATTER_XXFIELD
- MODULE PROCEDURE SCATTERXX_X1,SCATTERXX_X2,SCATTERXX_X3&
- & ,SCATTERXX_X4,SCATTERXX_X5,SCATTERXX_X6,&
- & SCATTERXX_N1,SCATTERXX_N2
+ MODULE PROCEDURE &
+ SCATTERXX_X1, SCATTERXX_X2, SCATTERXX_X3, &
+ SCATTERXX_X4, SCATTERXX_X5, SCATTERXX_X6, &
+ SCATTERXX_N1, SCATTERXX_N2, SCATTERXX_N3
END INTERFACE
-INTERFACE SCATTER_XYFIELD
- MODULE PROCEDURE SCATTERXY_X2,SCATTERXY_X3,SCATTERXY_X4,&
- & SCATTERXY_X5,SCATTERXY_X6,SCATTERXY_N2
+INTERFACE SCATTER_XYFIELD
+ MODULE PROCEDURE &
+ SCATTERXY_X2, SCATTERXY_X3, &
+ SCATTERXY_X4, SCATTERXY_X5, SCATTERXY_X6, &
+ SCATTERXY_N2, SCATTERXY_N3
END INTERFACE
PUBLIC SCATTER_XXFIELD,SCATTER_XYFIELD,GET_DOMREAD_ll
@@ -371,6 +375,44 @@ END IF
END SUBROUTINE SCATTERXX_N2
+SUBROUTINE SCATTERXX_N3(HDIR,KSEND,KRECV,KROOT,KCOMM)
+USE MODD_IO, ONLY: ISP, ISNPROC
+
+CHARACTER(LEN=*), INTENT(IN) :: HDIR
+INTEGER,DIMENSION(:,:,:), TARGET, INTENT(IN) :: KSEND
+INTEGER,DIMENSION(:,:,:), INTENT(INOUT) :: KRECV
+INTEGER, INTENT(IN) :: KROOT
+INTEGER, INTENT(IN) :: KCOMM
+
+INTEGER :: IERR
+INTEGER :: JI
+INTEGER :: IXO,IXE,IYO,IYE
+INTEGER,DIMENSION(:,:,:), POINTER :: TI2DP
+
+IF (ISP == KROOT) THEN
+ DO JI = 1,ISNPROC
+ CALL GET_DOMREAD_ll(JI,IXO,IXE,IYO,IYE)
+ IF (HDIR == 'XX') THEN
+ TI2DP=>KSEND(IXO:IXE,:,:)
+ ELSE ! HDIR ='YY'
+ TI2DP=>KSEND(IYO:IYE,:,:)
+ END IF
+
+ IF (ISP /= JI) THEN
+ CALL MPI_BSEND(TI2DP,SIZE(TI2DP),MNHINT_MPI,JI-1,199+KROOT,KCOMM&
+ & ,IERR)
+ ELSE
+ KRECV(:,:,:) = TI2DP(:,:,:)
+ END IF
+ END DO
+ELSE
+ CALL MPI_RECV(KRECV,SIZE(KRECV),MNHINT_MPI,KROOT-1,199+KROOT,KCOMM&
+ & ,MPI_STATUS_IGNORE,IERR)
+END IF
+
+END SUBROUTINE SCATTERXX_N3
+
+
SUBROUTINE SCATTERXY_X2(PSEND,PRECV,KROOT,KCOMM)
USE MODD_IO, ONLY: ISP, ISNPROC
USE MODD_VAR_ll, ONLY: MNH_STATUSES_IGNORE
@@ -584,6 +626,39 @@ END IF
END SUBROUTINE SCATTERXY_N2
+SUBROUTINE SCATTERXY_N3(KSEND,KRECV,KROOT,KCOMM)
+USE MODD_IO, ONLY: ISP, ISNPROC
+
+INTEGER,DIMENSION(:,:,:),TARGET,INTENT(IN) :: KSEND
+INTEGER,DIMENSION(:,:,:), INTENT(INOUT) :: KRECV
+INTEGER, INTENT(IN) :: KROOT
+INTEGER, INTENT(IN) :: KCOMM
+
+INTEGER :: IERR
+INTEGER :: JI
+INTEGER :: IXO,IXE,IYO,IYE
+INTEGER,DIMENSION(:,:,:), POINTER :: TI3DP
+
+IF (ISP == KROOT) THEN
+ DO JI = 1,ISNPROC
+ CALL GET_DOMREAD_ll(JI,IXO,IXE,IYO,IYE)
+ TI3DP=>KSEND(IXO:IXE,IYO:IYE,:)
+
+ IF (ISP /= JI) THEN
+ CALL MPI_BSEND(TI3DP,SIZE(TI3DP),MNHINT_MPI,JI-1,199+KROOT,KCOMM&
+ & ,IERR)
+ ELSE
+ KRECV(:,:,:) = TI3DP(:,:,:)
+ END IF
+ END DO
+ELSE
+ CALL MPI_RECV(KRECV,SIZE(KRECV),MNHINT_MPI,KROOT-1,199+KROOT,KCOMM&
+ & ,MPI_STATUS_IGNORE,IERR)
+END IF
+
+END SUBROUTINE SCATTERXY_N3
+
+
SUBROUTINE GET_DOMREAD_ll(KIP,KXOR,KXEND,KYOR,KYEND)
USE MODD_STRUCTURE_ll, ONLY: MODELSPLITTING_ll
USE MODD_VAR_ll, ONLY: TCRRT_PROCONF
--
GitLab