From aa1e91b035fe290825bccf3dd534792ddff2a98f Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Fri, 21 Jun 2024 13:36:42 +0200
Subject: [PATCH] Philippe 21/06/2024: IO_Field_read: 0D fields: ensure that
data can not be overwritten in case of read error
---
src/LIB/SURCOUCHE/src/mode_io_field_read.f90 | 110 ++++++++++++-------
1 file changed, 73 insertions(+), 37 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/mode_io_field_read.f90 b/src/LIB/SURCOUCHE/src/mode_io_field_read.f90
index eb27e129c..cf22c530e 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_field_read.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_field_read.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2023 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,6 +18,7 @@
! J. Escobar 11/02/2020: for GA & // IO, add update_halo + sync, & mpi_allreduce for error handling in // IO
! P. Wautelet 22/09/2020: add IO_Format_read_select subroutine
! P. Wautelet 22/09/2020: use ldimreduced to allow reduction in the number of dimensions of fields (used by 2D simulations)
+! P. Wautelet 21/06/2024: ensure that data can not be overwritten in case of read error
!-----------------------------------------------------------------
MODULE MODE_IO_FIELD_READ
@@ -167,6 +168,7 @@ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
INTEGER :: IERR
INTEGER :: IRESP
logical :: glfi, gnc4
+real :: 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_X0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -178,12 +180,13 @@ 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 )
+ 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
- if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, pfield, iresp )
- if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, pfield, iresp )
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, zfield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, zfield, iresp )
END IF
!
CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
@@ -192,8 +195,12 @@ 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)
!
- ! Broadcast Field
- CALL MPI_BCAST(PFIELD,1,MNHREAL_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ !Share data only if no error
+ if ( iresp == 0 .or. iresp == -111 ) then
+ if ( isp == tpfile%nmaster_rank ) pfield = zfield
+ ! Broadcast Field
+ CALL MPI_BCAST(PFIELD,1,MNHREAL_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ end if
END IF
END IF
!
@@ -1357,6 +1364,7 @@ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
!
INTEGER :: IERR
INTEGER :: IRESP
+integer :: 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_N0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
@@ -1369,12 +1377,13 @@ 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 )
+ 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
- if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, kfield, iresp )
- if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, kfield, iresp )
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, ifield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, ifield, iresp )
END IF
!
CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
@@ -1383,7 +1392,11 @@ 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(KFIELD,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ !Share data only if no error
+ if ( iresp == 0 .or. iresp == -111 ) then
+ if ( isp == tpfile%nmaster_rank ) kfield = ifield
+ CALL MPI_BCAST(KFIELD,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ end if
END IF
END IF
!
@@ -1822,6 +1835,7 @@ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
!
INTEGER :: IERR
INTEGER :: IRESP
+logical :: gfield ! 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_L0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
@@ -1834,12 +1848,13 @@ 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 )
+ 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 )
+ 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)
@@ -1848,7 +1863,12 @@ 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,1,MNHLOG_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ !Share data only if no error
+ if ( iresp == 0 .or. iresp == -111 ) then
+ if ( isp == tpfile%nmaster_rank ) ofield = gfield
+ ! Broadcast Field
+ CALL MPI_BCAST(OFIELD,1,MNHLOG_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ end if
END IF
END IF
!
@@ -1956,9 +1976,10 @@ CLASS(TFIELDMETADATA), INTENT(INOUT) :: TPFIELD
CHARACTER(LEN=*), INTENT(INOUT) :: HFIELD ! array containing the data field
INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
!
-INTEGER :: IERR
-INTEGER :: IRESP
-logical :: glfi, gnc4
+CHARACTER(LEN=:), ALLOCATABLE :: YFIELD ! Intermediate data (always used for reads to not overwrite data in case of error)
+INTEGER :: IERR
+INTEGER :: IRESP
+logical :: glfi, gnc4
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_C0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -1969,13 +1990,15 @@ CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_C0',IRESP)
call IO_Format_read_select( tpfile, glfi, gnc4 )
IF (IRESP==0) THEN
+ allocate( yfield, mold = hfield )
IF (GSMONOPROC) THEN ! sequential execution
- if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, hfield, iresp )
- if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, hfield, iresp )
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, yfield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, yfield, iresp )
+ if ( iresp == 0 .or. iresp == -111 ) hfield(:) = yfield(:)
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
- if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, hfield, iresp )
- if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, hfield, iresp )
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, yfield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, yfield, iresp )
END IF
!
CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
@@ -1984,7 +2007,12 @@ 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(HFIELD,LEN(HFIELD),MPI_CHARACTER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ !Share data only if no error
+ if ( iresp == 0 .or. iresp == -111 ) then
+ if ( isp == tpfile%nmaster_rank ) hfield(:) = yfield(:)
+ ! Broadcast Field
+ CALL MPI_BCAST(HFIELD,LEN(HFIELD),MPI_CHARACTER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ end if
END IF
END IF
!
@@ -2031,6 +2059,7 @@ INTEGER :: IERR
INTEGER :: IRESP
INTEGER,DIMENSION(3) :: ITDATE
logical :: glfi, gnc4
+type(date_time) :: tzdata ! Intermediate data (always used for reads to not overwrite data in case of error)
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_T0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -2042,15 +2071,13 @@ 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, tpdata, iresp )
- if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, tpdata, iresp )
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, tzdata, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, tzdata, iresp )
+ if ( iresp == 0 .or. iresp == -111 ) tpdata = tzdata
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
- if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, tpdata, iresp )
- if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, tpdata, iresp )
- ITDATE(1) = TPDATA%nyear
- ITDATE(2) = TPDATA%nmonth
- ITDATE(3) = TPDATA%nday
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, tzdata, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, tzdata, iresp )
END IF
!
CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
@@ -2059,11 +2086,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)
!
- CALL MPI_BCAST( ITDATE, 3, MNHINT_MPI, TPFILE%NMASTER_RANK-1, TPFILE%NMPICOMM, IERR )
- CALL MPI_BCAST( TPDATA%xtime, 1, MNHREAL_MPI, TPFILE%NMASTER_RANK-1, TPFILE%NMPICOMM, IERR )
- TPDATA%nyear = ITDATE(1)
- TPDATA%nmonth = ITDATE(2)
- TPDATA%nday = ITDATE(3)
+ !Share data only if no error
+ if ( iresp == 0 .or. iresp == -111 ) then
+ if ( isp == tpfile%nmaster_rank ) then
+ tpdata = tzdata
+ ITDATE(1) = TPDATA%nyear
+ ITDATE(2) = TPDATA%nmonth
+ ITDATE(3) = TPDATA%nday
+ end if
+ CALL MPI_BCAST( ITDATE, 3, MNHINT_MPI, TPFILE%NMASTER_RANK-1, TPFILE%NMPICOMM, IERR )
+ CALL MPI_BCAST( TPDATA%xtime, 1, MNHREAL_MPI, TPFILE%NMASTER_RANK-1, TPFILE%NMPICOMM, IERR )
+ TPDATA%nyear = ITDATE(1)
+ TPDATA%nmonth = ITDATE(2)
+ TPDATA%nday = ITDATE(3)
+ end if
END IF
END IF
!
--
GitLab