From ab8b447c606ecfc4e569e735a9c238e9a130f1ce Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Fri, 25 May 2018 14:24:52 +0200
Subject: [PATCH] Philippe 25/05/2018: IO: detect and abort when errors at OPEN
+ set more precise STATUS when opening LFI file
---
src/LIB/NEWLFI/src/NEWLFI_ALL.f | 3 ++-
src/LIB/SURCOUCHE/src/mode_fm.f90 | 26 +++++++++++++++++---------
src/LIB/SURCOUCHE/src/mode_io.f90 | 26 ++++++++++++++++++++++++--
3 files changed, 43 insertions(+), 12 deletions(-)
diff --git a/src/LIB/NEWLFI/src/NEWLFI_ALL.f b/src/LIB/NEWLFI/src/NEWLFI_ALL.f
index 5354d0493..8eb4553ae 100644
--- a/src/LIB/NEWLFI/src/NEWLFI_ALL.f
+++ b/src/LIB/NEWLFI/src/NEWLFI_ALL.f
@@ -6679,7 +6679,7 @@ C NEES SUR LE FICHIER, INITIALEMENT.
C (ZERO SI CREATION)
INTEGER JPNBST
C
- PARAMETER ( JPNBST=4 )
+ PARAMETER ( JPNBST=5 )
C
CHARACTER CPNOMD*(*)
PARAMETER ( CPNOMD='%%%%% FICHIER SANS NOM %%%%%' )
@@ -6726,6 +6726,7 @@ C DATA CLSTEX /'OLD', 'NEW', 'UNKNOWN', 'SCRATCH'/
CLSTEX(2) = 'NEW'
CLSTEX(3) = 'UNKNOWN'
CLSTEX(4) = 'SCRATCH'
+ CLSTEX(5) = 'REPLACE'
C**
C 1. - CONTROLES DIVERS, ET INITIALISATIONS.
C-----------------------------------------------------------------------
diff --git a/src/LIB/SURCOUCHE/src/mode_fm.f90 b/src/LIB/SURCOUCHE/src/mode_fm.f90
index 2092da2a5..b95852bfa 100644
--- a/src/LIB/SURCOUCHE/src/mode_fm.f90
+++ b/src/LIB/SURCOUCHE/src/mode_fm.f90
@@ -239,6 +239,7 @@ INTEGER :: IFTYPE ! type of FM-file
INTEGER :: IROWF,IRESP
CHARACTER(LEN=7) :: YACTION ! Action upon the file ('READ' or 'WRITE')
CHARACTER(LEN=:),ALLOCATABLE :: YFILEM ! name of the file
+CHARACTER(LEN=:),ALLOCATABLE :: YFORSTATUS ! Status for open of a file (for LFI) ('OLD','NEW','UNKNOWN','SCRATCH','REPLACE')
CHARACTER(LEN=8) :: YRESP
LOGICAL :: GSTATS
LOGICAL :: GNAMFI,GFATER,GNEWFI
@@ -361,15 +362,22 @@ IF (TPFILE%LMASTER) THEN
GFATER8 = GFATER
GSTATS8 = GSTATS
!
- CALL LFIOUV(IRESOU, &
- INUMBR8, &
- GNAMFI8, &
- TRIM(YFILEM)//'.lfi', &
- "UNKNOWN", &
- GFATER8, &
- GSTATS8, &
- IMELEV, &
- INPRAR, &
+ SELECT CASE (YACTION)
+ CASE('READ')
+ YFORSTATUS = 'OLD'
+ CASE('WRITE')
+ YFORSTATUS = 'REPLACE'
+ END SELECT
+ !
+ CALL LFIOUV(IRESOU, &
+ INUMBR8, &
+ GNAMFI8, &
+ TRIM(YFILEM)//'.lfi', &
+ YFORSTATUS, &
+ GFATER8, &
+ GSTATS8, &
+ IMELEV, &
+ INPRAR, &
ININAR)
TPFILE%NLFININAR = ININAR
IF (IRESOU /= 0 ) THEN
diff --git a/src/LIB/SURCOUCHE/src/mode_io.f90 b/src/LIB/SURCOUCHE/src/mode_io.f90
index 0490663db..741cccab1 100644
--- a/src/LIB/SURCOUCHE/src/mode_io.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io.f90
@@ -254,6 +254,7 @@ CONTAINS
#endif
CHARACTER(len=20) :: YACTION
CHARACTER(len=20) :: YMODE
+ CHARACTER(LEN=256) :: YIOERRMSG
INTEGER :: IOS,IERR,IRESP
INTEGER(KIND=IDCDF_KIND) :: IOSCDF
INTEGER :: ICOMM
@@ -265,6 +266,7 @@ CONTAINS
LOGICAL :: GPARALLELIO
TYPE(TFILEDATA),POINTER :: TZSPLITFILE
CHARACTER(LEN=:),ALLOCATABLE :: YPREFILENAME !To store the directory + filename
+ CHARACTER(LEN=:),ALLOCATABLE :: YFORSTATUS ! Status for open of a file (for LFI) ('OLD','NEW','UNKNOWN','SCRATCH','REPLACE')
CALL PRINT_MSG(NVERB_DEBUG,'IO','OPEN_ll','opening '//TRIM(TPFILE%CNAME)//' for '//TRIM(TPFILE%CMODE))
!
@@ -404,6 +406,7 @@ CONTAINS
STATUS=STATUS, &
ACCESS=ACCESS, &
IOSTAT=IOS, &
+ IOMSG=YIOERRMSG, &
FORM=FORM, &
RECL=IRECSIZE, &
BLANK=BLANK, &
@@ -421,6 +424,7 @@ CONTAINS
STATUS=YSTATUS, &
ACCESS=YACCESS, &
IOSTAT=IOS, &
+ IOMSG=YIOERRMSG, &
FORM=YFORM, &
ACTION=YACTION)
ELSEIF (YACCESS=='DIRECT') THEN
@@ -429,6 +433,7 @@ CONTAINS
STATUS=YSTATUS, &
ACCESS=YACCESS, &
IOSTAT=IOS, &
+ IOMSG=YIOERRMSG, &
FORM=YFORM, &
RECL=YRECL, &
ACTION=YACTION)
@@ -440,6 +445,7 @@ CONTAINS
STATUS=YSTATUS, &
ACCESS=YACCESS, &
IOSTAT=IOS, &
+ IOMSG=YIOERRMSG, &
FORM=YFORM, &
RECL=YRECL, &
BLANK=YBLANK, &
@@ -453,6 +459,7 @@ CONTAINS
STATUS=YSTATUS, &
ACCESS=YACCESS, &
IOSTAT=IOS, &
+ IOMSG=YIOERRMSG, &
FORM=YFORM, &
RECL=YRECL, &
BLANK=YBLANK, &
@@ -467,6 +474,7 @@ CONTAINS
STATUS=YSTATUS, &
ACCESS=YACCESS, &
IOSTAT=IOS, &
+ IOMSG=YIOERRMSG, &
FORM=YFORM, &
RECL=YRECL, &
POSITION=YPOSITION, &
@@ -494,6 +502,7 @@ CONTAINS
STATUS=STATUS, &
ACCESS=ACCESS, &
IOSTAT=IOS, &
+ IOMSG=YIOERRMSG, &
FORM=FORM, &
RECL=RECL, &
BLANK=BLANK, &
@@ -504,7 +513,7 @@ CONTAINS
#endif
#endif
-
+ IF (IOS/=0) CALL PRINT_MSG(NVERB_FATAL,'IO','OPEN_ll','Problem when opening '//TRIM(YPREFILENAME)//': '//TRIM(YIOERRMSG))
ELSE
!! NON I/O processors case
IOS = 0
@@ -525,6 +534,7 @@ CONTAINS
STATUS=STATUS, &
ACCESS=ACCESS, &
IOSTAT=IOS, &
+ IOMSG=YIOERRMSG, &
FORM=FORM, &
RECL=IRECSIZE, &
BLANK=BLANK, &
@@ -541,6 +551,7 @@ CONTAINS
STATUS=YSTATUS, &
ACCESS=YACCESS, &
IOSTAT=IOS, &
+ IOMSG=YIOERRMSG, &
FORM=YFORM, &
RECL=YRECL, &
ACTION=YACTION)
@@ -551,6 +562,7 @@ CONTAINS
STATUS=YSTATUS, &
ACCESS=YACCESS, &
IOSTAT=IOS, &
+ IOMSG=YIOERRMSG, &
FORM=YFORM, &
RECL=YRECL, &
BLANK=YBLANK, &
@@ -564,6 +576,7 @@ CONTAINS
STATUS=YSTATUS, &
ACCESS=YACCESS, &
IOSTAT=IOS, &
+ IOMSG=YIOERRMSG, &
FORM=YFORM, &
RECL=YRECL, &
BLANK=YBLANK, &
@@ -579,6 +592,7 @@ CONTAINS
STATUS=STATUS, &
ACCESS=ACCESS, &
IOSTAT=IOS, &
+ IOMSG=YIOERRMSG, &
FORM=FORM, &
RECL=RECL, &
BLANK=BLANK, &
@@ -589,6 +603,7 @@ CONTAINS
#endif
#endif
+ IF (IOS/=0) CALL PRINT_MSG(NVERB_FATAL,'IO','OPEN_ll','Problem when opening '//TRIM(YPREFILENAME)//': '//TRIM(YIOERRMSG))
@@ -729,13 +744,20 @@ CONTAINS
ENDIF
INPRAR = 49
!
+ SELECT CASE (YACTION)
+ CASE('READ')
+ YFORSTATUS = 'OLD'
+ CASE('WRITE')
+ YFORSTATUS = 'REPLACE'
+ END SELECT
+ !
! JUAN open lfi file temporary modif
!
CALL LFIOUV(IRESOU, &
TZSPLITFILE%NLFIFLU, &
GNAMFI8, &
TRIM(YPREFILENAME)//'.lfi', &
- "UNKNOWN", &
+ YFORSTATUS, &
GFATER8, &
GSTATS8, &
IMELEV, &
--
GitLab