diff --git a/src/LIB/SURCOUCHE/src/mode_allocbuff.f90 b/src/LIB/SURCOUCHE/src/mode_allocbuff.f90
index 4f2c3df4b13c5864c5a7f095013390f58bed92c0..78c2500311a7d549e9fa40edf1009e9bff58146f 100644
--- a/src/LIB/SURCOUCHE/src/mode_allocbuff.f90
+++ b/src/LIB/SURCOUCHE/src/mode_allocbuff.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2024 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -18,14 +18,15 @@ PRIVATE
INTERFACE ALLOCBUFFER_ll
MODULE PROCEDURE &
- ALLOCBUFFER_X1, ALLOCBUFFER_X2, ALLOCBUFFER_X3, &
+ ALLOCBUFFER_X1, ALLOCBUFFER_NEW_X1, ALLOCBUFFER_X2, ALLOCBUFFER_X3, &
ALLOCBUFFER_X4, ALLOCBUFFER_X5, ALLOCBUFFER_X6, &
- ALLOCBUFFER_N1, ALLOCBUFFER_N2, ALLOCBUFFER_N3, &
+ ALLOCBUFFER_N1, ALLOCBUFFER_NEW_N1, ALLOCBUFFER_N2, ALLOCBUFFER_N3, &
ALLOCBUFFER_N4, &
- ALLOCBUFFER_L1
+ ALLOCBUFFER_L1, ALLOCBUFFER_NEW_L1
END INTERFACE
-PUBLIC ALLOCBUFFER_ll
+PUBLIC :: ALLOCBUFFER_ll
+
CONTAINS
@@ -53,6 +54,26 @@ CASE default
END SELECT
END SUBROUTINE ALLOCBUFFER_N1
+SUBROUTINE ALLOCBUFFER_NEW_N1( LTAB_OUT, LTAB_IN, HDIR )
+ !
+ INTEGER, DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: LTAB_OUT
+ INTEGER, DIMENSION(:), INTENT(IN) :: LTAB_IN
+ CHARACTER(LEN=*), INTENT(IN) :: HDIR
+
+ INTEGER :: IIMAX, IJMAX
+
+ SELECT CASE(HDIR)
+ CASE('XX')
+ CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+ ALLOCATE(LTAB_OUT(IIMAX+2*JPHEXT))
+ CASE('YY')
+ CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+ ALLOCATE(LTAB_OUT(IJMAX+2*JPHEXT))
+ CASE default
+ ALLOCATE( LTAB_OUT, MOLD = LTAB_IN )
+ END SELECT
+END SUBROUTINE ALLOCBUFFER_NEW_N1
+
SUBROUTINE ALLOCBUFFER_N2(KTAB_P,KTAB,HDIR,OALLOC)
USE MODD_IO, ONLY: LPACK, L2D
!
@@ -181,6 +202,26 @@ CASE default
END SELECT
END SUBROUTINE ALLOCBUFFER_L1
+SUBROUTINE ALLOCBUFFER_NEW_L1( LTAB_OUT, LTAB_IN, HDIR )
+ !
+ LOGICAL, DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: LTAB_OUT
+ LOGICAL, DIMENSION(:), INTENT(IN) :: LTAB_IN
+ CHARACTER(LEN=*), INTENT(IN) :: HDIR
+
+ INTEGER :: IIMAX, IJMAX
+
+ SELECT CASE(HDIR)
+ CASE('XX')
+ CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+ ALLOCATE(LTAB_OUT(IIMAX+2*JPHEXT))
+ CASE('YY')
+ CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+ ALLOCATE(LTAB_OUT(IJMAX+2*JPHEXT))
+ CASE default
+ ALLOCATE( LTAB_OUT, MOLD = LTAB_IN )
+ END SELECT
+END SUBROUTINE ALLOCBUFFER_NEW_L1
+
SUBROUTINE ALLOCBUFFER_X1(PTAB_P,PTAB,HDIR,OALLOC, KIMAX_ll, KJMAX_ll)
!
REAL,DIMENSION(:),POINTER :: PTAB_P
@@ -217,6 +258,38 @@ CASE default
END SELECT
END SUBROUTINE ALLOCBUFFER_X1
+SUBROUTINE ALLOCBUFFER_NEW_X1( PTAB_OUT, PTAB_IN, HDIR, KIMAX_ll, KJMAX_ll )
+ !
+ REAL, DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: PTAB_OUT
+ REAL, DIMENSION(:), INTENT(IN) :: PTAB_IN
+ CHARACTER(LEN=*), INTENT(IN) :: HDIR
+ INTEGER, OPTIONAL, INTENT(IN) ::KIMAX_ll
+ INTEGER, OPTIONAL, INTENT(IN) ::KJMAX_ll
+
+ INTEGER :: IIMAX,IJMAX
+
+ SELECT CASE(HDIR)
+ CASE('XX')
+ IF( PRESENT(KIMAX_ll) .AND. PRESENT(KJMAX_ll) ) THEN
+ IIMAX = KIMAX_ll
+ IJMAX = KJMAX_ll
+ ELSE
+ CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+ ENDIF
+ ALLOCATE(PTAB_OUT(IIMAX+2*JPHEXT))
+ CASE('YY')
+ IF( PRESENT(KIMAX_ll) .AND. PRESENT(KJMAX_ll) ) THEN
+ IIMAX = KIMAX_ll
+ IJMAX = KJMAX_ll
+ ELSE
+ CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+ ENDIF
+ ALLOCATE(PTAB_OUT(IJMAX+2*JPHEXT))
+ CASE default
+ ALLOCATE( PTAB_OUT, MOLD = PTAB_IN )
+ END SELECT
+END SUBROUTINE ALLOCBUFFER_NEW_X1
+
SUBROUTINE ALLOCBUFFER_X2(PTAB_P,PTAB,HDIR,OALLOC, KIMAX_ll, KJMAX_ll)
USE MODD_IO, ONLY: LPACK, L2D
!
diff --git a/src/LIB/SURCOUCHE/src/mode_io_field_read.f90 b/src/LIB/SURCOUCHE/src/mode_io_field_read.f90
index cf22c530e3f781c54ce5164d64ce76edfe61ebfa..44a565132e9b782fbdafa471ab32cd63f1e63da1 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_field_read.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_field_read.f90
@@ -28,6 +28,7 @@ USE MODD_IO, ONLY : NVERB_FATAL,NVERB_ERROR,NVERB_WARNING,NVERB_INFO,NVERB_DEBUG
USE MODD_MPIF
use modd_precision, only: MNHINT_MPI, MNHLOG_MPI, MNHREAL_MPI, MNHTIME
!
+use mode_allocbuffer_ll, only: Allocbuffer_ll
use mode_field, only: Find_field_id_from_mnhname
USE MODE_IO_READ_LFI
#ifdef MNH_IOCDF4
@@ -243,7 +244,6 @@ USE MODD_IO, ONLY: ISP, GSMONOPROC, ISNPROC
USE MODD_STRUCTURE_ll, ONLY: ZONE_ll
!
USE MODE_SCATTER_ll
-USE MODE_ALLOCBUFFER_ll
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
CLASS(TFIELDMETADATA), INTENT(INOUT) :: TPFIELD
@@ -253,17 +253,14 @@ INTEGER, OPTIONAL, INTENT(IN) :: KIMAX_ll
INTEGER, OPTIONAL, INTENT(IN) :: KJMAX_ll
TYPE(ZONE_ll), DIMENSION(ISNPROC), OPTIONAL, INTENT(IN) :: TPSPLITTING ! splitting of the domain
!
-INTEGER :: IERR
-REAL,DIMENSION(:),POINTER :: ZFIELDP
-LOGICAL :: GALLOC
-logical :: glfi, gnc4
-INTEGER :: IRESP
+INTEGER :: IERR
+INTEGER :: IRESP
+logical :: glfi, gnc4
+REAL, DIMENSION(:), ALLOCATABLE :: zfield ! Intermediate data (always used for reads to not overwrite data in case of error)
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_X1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
-GALLOC = .FALSE.
IRESP = 0
-ZFIELDP => NULL()
!
CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_X1',IRESP)
@@ -271,17 +268,18 @@ call IO_Format_read_select( tpfile, glfi, gnc4 )
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, pfield, iresp )
- if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, pfield, iresp )
+ allocate( zfield, mold = pfield )
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, zfield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, zfield, iresp )
+ if ( iresp == 0 .or. iresp == -111 ) pfield(:) = zfield(:)
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,TPFIELD%CDIR,GALLOC, KIMAX_ll, KJMAX_ll)
- if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, zfieldp, iresp )
- if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, zfieldp, iresp )
+ call Allocbuffer_ll( zfield, pfield, tpfield%cdir, kimax_ll, kjmax_ll )
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, zfield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, zfield, iresp )
ELSE
!Not really necessary but useful to suppress alerts with Valgrind
- ALLOCATE(ZFIELDP(0))
- GALLOC = .TRUE.
+ allocate( zfield(0) )
END IF
!
CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
@@ -290,18 +288,20 @@ IF (IRESP==0) THEN
!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' .AND. TPFIELD%CDIR /='YY') THEN
- ! Broadcast Field
- CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MNHREAL_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
- ELSE
- !Scatter Field
- CALL SCATTER_XXFIELD(TPFIELD%CDIR,ZFIELDP,PFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM,TPSPLITTING)
- END IF
+ !Share data only if no error
+ if ( iresp == 0 .or. iresp == -111 ) then
+ IF (TPFIELD%CDIR /= 'XX' .AND. TPFIELD%CDIR /='YY') THEN
+ if ( isp == tpfile%nmaster_rank ) pfield(:) = zfield(:)
+ ! Broadcast Field
+ CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MNHREAL_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ ELSE
+ !Scatter Field
+ CALL SCATTER_XXFIELD(TPFIELD%CDIR,zfield,PFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM,TPSPLITTING)
+ END IF
+ end if
END IF
END IF
!
-IF (GALLOC) DEALLOCATE (ZFIELDP)
-!
IF (IRESP==-111) IRESP = 0 !-111 is not really an error (metadata has changed)
!
IF (PRESENT(KRESP)) KRESP = IRESP
@@ -1431,7 +1431,6 @@ SUBROUTINE IO_Field_read_byfield_N1(TPFILE,TPFIELD,KFIELD,KRESP)
!
USE MODD_IO, ONLY: ISP, GSMONOPROC
!
-USE MODE_ALLOCBUFFER_ll
USE MODE_SCATTER_ll
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -1439,17 +1438,14 @@ CLASS(TFIELDMETADATA), INTENT(INOUT) :: TPFIELD
INTEGER, DIMENSION(:), INTENT(INOUT) :: KFIELD ! array containing the data field
INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
!
-INTEGER :: IERR
-INTEGER :: IRESP
-INTEGER,DIMENSION(:),POINTER :: IFIELDP
-LOGICAL :: GALLOC
+INTEGER :: IERR
+INTEGER :: IRESP
+INTEGER, DIMENSION(:), ALLOCATABLE :: ifield ! Intermediate data (always used for reads to not overwrite data in case of error)
logical :: glfi, gnc4
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_N1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
-GALLOC = .FALSE.
IRESP = 0
-IFIELDP => NULL()
!
CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_N1',IRESP)
@@ -1457,17 +1453,18 @@ call IO_Format_read_select( tpfile, glfi, gnc4 )
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, kfield, iresp )
- if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, kfield, iresp )
+ allocate( ifield, mold = kfield )
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, ifield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, ifield, iresp )
+ if ( iresp == 0 .or. iresp == -111 ) kfield(:) = ifield(:)
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
- CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,TPFIELD%CDIR,GALLOC)
- if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, ifieldp, iresp )
- if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, ifieldp, iresp )
+ call Allocbuffer_ll( ifield, kfield, tpfield%cdir )
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, ifield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, ifield, iresp )
ELSE
!Not really necessary but useful to suppress alerts with Valgrind
- ALLOCATE(IFIELDP(0))
- GALLOC = .TRUE.
+ allocate( ifield(0) )
END IF
!
CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
@@ -1476,18 +1473,20 @@ IF (IRESP==0) THEN
!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' .AND. TPFIELD%CDIR /='YY') THEN
- ! Broadcast Field
- CALL MPI_BCAST(KFIELD,SIZE(KFIELD),MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
- ELSE
- !Scatter Field
- CALL SCATTER_XXFIELD(TPFIELD%CDIR,IFIELDP,KFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
- END IF
+ !Share data only if no error
+ if ( iresp == 0 .or. iresp == -111 ) then
+ IF (TPFIELD%CDIR /= 'XX' .AND. TPFIELD%CDIR /='YY') THEN
+ if ( isp == tpfile%nmaster_rank ) kfield(:) = ifield(:)
+ ! Broadcast Field
+ CALL MPI_BCAST(KFIELD,SIZE(KFIELD),MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ ELSE
+ !Scatter Field
+ CALL SCATTER_XXFIELD(TPFIELD%CDIR,ifield,KFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
+ END IF
+ 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
@@ -1911,6 +1910,7 @@ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
INTEGER :: IERR
INTEGER :: IRESP
logical :: glfi, gnc4
+LOGICAL, DIMENSION(:), ALLOCATABLE :: gfield ! Intermediate data (always used for reads to not overwrite data in case of error)
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_L1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -1922,12 +1922,15 @@ call IO_Format_read_select( tpfile, glfi, gnc4 )
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, ofield, iresp )
- if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, ofield, iresp )
+ allocate( gfield, mold = ofield )
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, gfield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, gfield, iresp )
+ if ( iresp == 0 .or. iresp == -111 ) ofield(:) = gfield(:)
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
- if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, ofield, iresp )
- if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, ofield, iresp )
+ call Allocbuffer_ll( gfield, ofield, tpfield%cdir )
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, gfield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, gfield, iresp )
END IF
!
CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
@@ -1936,7 +1939,19 @@ IF (IRESP==0) THEN
!because metadata of field has been modified in IO_Field_read_xxx
IF (IRESP==-111) CALL IO_Field_metadata_bcast(TPFILE,TPFIELD)
!
- CALL MPI_BCAST(OFIELD,SIZE(OFIELD),MNHLOG_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ !Share data only if no error
+ if ( iresp == 0 .or. iresp == -111 ) then
+ IF (TPFIELD%CDIR /= 'XX' .AND. TPFIELD%CDIR /='YY') THEN
+ if ( isp == tpfile%nmaster_rank ) ofield(:) = gfield(:)
+ ! Broadcast Field
+ CALL MPI_BCAST(OFIELD,SIZE(OFIELD),MNHLOG_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ ELSE
+ !Scatter Field
+ !CALL SCATTER_XXFIELD(TPFIELD%CDIR,gfield,OFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
+ call Print_msg( NVERB_FATAL, 'IO', 'IO_Field_read_byfield_L1', &
+ 'reading of 1D logical arrays with CDIR /=XX or YY not implemented' )
+ END IF
+ end if
END IF
END IF
!