From dd15c0b68860de5419339a5d63d96d089a64cdb9 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Thu, 9 Nov 2017 15:18:08 +0100
Subject: [PATCH] Philippe 09/11/2017: IO: added 'NML' and 'SURFACE_DATA' types
for IO_FILE_OPEN/CLOSE_ll and IO_FILE_ADD2LIST + manage .des files in
IO_FILE_OPEN/CLOSE_ll
---
src/LIB/SURCOUCHE/src/modd_io.f90 | 7 +-
src/LIB/SURCOUCHE/src/mode_fm.f90 | 324 ++++++++++--------
.../SURCOUCHE/src/mode_io_manage_struct.f90 | 136 +++++---
3 files changed, 281 insertions(+), 186 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/modd_io.f90 b/src/LIB/SURCOUCHE/src/modd_io.f90
index da6be0629..fa7528b8f 100644
--- a/src/LIB/SURCOUCHE/src/modd_io.f90
+++ b/src/LIB/SURCOUCHE/src/modd_io.f90
@@ -91,8 +91,11 @@ TYPE TFILEDATA
LOGICAL :: LNCCOMPRESS = .FALSE. ! Do compression on fields
INTEGER(KIND=IDCDF_KIND) :: NNCCOMPRESS_LEVEL = 0 ! Compression level
!
- !Fields for ASCII files
- INTEGER :: NLU = -1 !Logical unit number
+ !Fields for other files
+ INTEGER :: NLU = -1 !Logical unit number
+ INTEGER :: NRECL = -1 !Fortran RECL (record length)
+ CHARACTER(LEN=11) :: CFORM = "UNKNOWN" !Fortran FORM (FORMATTED/UNFORMATTED)
+ CHARACTER(LEN=10) :: CACCESS = "UNKNOWN" !Fortran ACCESS (DIRECT/SEQUENTIAL)
!
TYPE(TFILEDATA),POINTER :: TDADFILE => NULL() !Corresponding dad file
TYPE(TFILEDATA),POINTER :: TFILE_PREV => NULL()
diff --git a/src/LIB/SURCOUCHE/src/mode_fm.f90 b/src/LIB/SURCOUCHE/src/mode_fm.f90
index 2e6cf8026..23db54929 100644
--- a/src/LIB/SURCOUCHE/src/mode_fm.f90
+++ b/src/LIB/SURCOUCHE/src/mode_fm.f90
@@ -140,7 +140,7 @@ USE MODE_FD_ll, ONLY: FD_ll,GETFD
USE MODE_FIELD, ONLY: TFIELDDATA,TYPEINT
USE MODE_FMREAD
USE MODE_IO_ll, ONLY : OPEN_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_FIND_BYNAME
+USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST,IO_FILE_FIND_BYNAME
!
TYPE(TFILEDATA),POINTER,INTENT(INOUT) :: TPFILE ! File structure
INTEGER, INTENT(OUT), OPTIONAL :: KRESP ! Return code
@@ -152,9 +152,11 @@ INTEGER,DIMENSION(3) :: IMNHVERSION
CHARACTER(LEN=12) :: YMNHVERSION_FILE,YMNHVERSION_CURR
TYPE(FD_ll), POINTER :: TZFDLFI
TYPE(TFIELDDATA) :: TZFIELD
+TYPE(TFILEDATA),POINTER :: TZFILE_DES
TYPE(TFILEDATA),POINTER :: TZFILE_DUMMY
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_FILE_OPEN_ll','opening '//TRIM(TPFILE%CNAME)//' for '//TRIM(TPFILE%CMODE))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_FILE_OPEN_ll','opening '//TRIM(TPFILE%CNAME)//' for '//TRIM(TPFILE%CMODE)// &
+ ' (filetype='//TRIM(TPFILE%CTYPE)//')')
!
IF (.NOT.ASSOCIATED(TPFILE)) CALL PRINT_MSG(NVERB_FATAL,'IO','IO_FILE_OPEN_ll','TPFILE is not associated')
!
@@ -169,95 +171,130 @@ END IF
CALL IO_FILE_FIND_BYNAME(TRIM(TPFILE%CNAME),TZFILE_DUMMY,IRESP)
IF (IRESP/=0) CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_OPEN_ll','file '//TRIM(TPFILE%CNAME)//' not in filelist')
!
-IF (TRIM(TPFILE%CTYPE)/='OUTPUTLISTING') THEN
- CALL FMOPEN_ll(TPFILE,IRESP,OPARALLELIO=OPARALLELIO)
- !
- TZFDLFI=>GETFD(ADJUSTL(TRIM(TPFILE%CNAME)//'.lfi'))
- !TZFDLFI%CDF exists only if ISP == TZFDLFI%OWNER
- IF (TRIM(TPFILE%CMODE) == 'READ' .AND. ISP == TZFDLFI%OWNER) THEN
- IF (LIOCDF4 .AND. .NOT.LLFIREAD) THEN
- TPFILE%NNCID = TZFDLFI%CDF%NCID
- IF (TPFILE%NNCID<0) CALL PRINT_MSG(NVERB_FATAL,'IO','IO_FILE_OPEN_ll','invalid NNCID for '//TRIM(TPFILE%CNAME))
+SELECT CASE(TPFILE%CTYPE)
+ !Namelist files
+ CASE('NML')
+ CALL OPEN_ll(UNIT=TPFILE%NLU,FILE=TPFILE%CNAME,IOSTAT=IRESP,ACTION=TPFILE%CMODE, &
+ DELIM='QUOTE',MODE='GLOBAL')
+
+
+ !OUTPUTLISTING files
+ CASE('OUTPUTLISTING')
+ CALL OPEN_ll(UNIT=TPFILE%NLU,FILE=TPFILE%CNAME,IOSTAT=IRESP,FORM='FORMATTED', &
+ ACTION=TPFILE%CMODE,MODE='GLOBAL')
+
+
+ !SURFACE_DATA files
+ CASE('SURFACE_DATA')
+ IF (TPFILE%CFORM=='FORMATTED') THEN
+ CALL OPEN_ll(UNIT=TPFILE%NLU,FILE=TPFILE%CNAME,IOSTAT=IRESP,ACTION=TPFILE%CMODE, &
+ FORM=TPFILE%CFORM, &
+ MODE='GLOBAL')
+ ELSE IF (TPFILE%CACCESS=='DIRECT') THEN
+ CALL OPEN_ll(UNIT=TPFILE%NLU,FILE=TPFILE%CNAME,IOSTAT=IRESP,ACTION=TPFILE%CMODE, &
+ FORM=TPFILE%CFORM,ACCESS=TPFILE%CACCESS,RECL=TPFILE%NRECL, &
+ MODE='GLOBAL')
ELSE
- TPFILE%NLFIFLU = TZFDLFI%FLU
- IF (TPFILE%NLFIFLU<0) CALL PRINT_MSG(NVERB_FATAL,'IO','IO_FILE_OPEN_ll','invalid NLFIFLU for '//TRIM(TPFILE%CNAME))
- ENDIF
- ELSE IF (TRIM(TPFILE%CMODE) == 'WRITE' .AND. ISP == TZFDLFI%OWNER) THEN
- IF (LIOCDF4) THEN
- TPFILE%NNCID = TZFDLFI%CDF%NCID
- IF (TPFILE%NNCID<0) CALL PRINT_MSG(NVERB_FATAL,'IO','IO_FILE_OPEN_ll','invalid NNCID for '//TRIM(TPFILE%CNAME))
+ CALL OPEN_ll(UNIT=TPFILE%NLU,FILE=TPFILE%CNAME,IOSTAT=IRESP,ACTION=TPFILE%CMODE, &
+ FORM=TPFILE%CFORM, &
+ MODE='GLOBAL')
END IF
- IF (.NOT.LIOCDF4 .OR. LLFIOUT) THEN
- TPFILE%NLFIFLU = TZFDLFI%FLU
- IF (TPFILE%NLFIFLU<0) CALL PRINT_MSG(NVERB_FATAL,'IO','IO_FILE_OPEN_ll','invalid NLFIFLU for '//TRIM(TPFILE%CNAME))
+
+
+ CASE DEFAULT
+ !Do not open '.des' file if OUTPUT
+ IF(TPFILE%CTYPE/='OUTPUT') THEN
+ CALL IO_FILE_ADD2LIST(TZFILE_DES,TRIM(TPFILE%CNAME)//'.des','DES',TPFILE%CMODE,OOLD=.TRUE.) !OOLD=T because the file may already be in the list
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_FILE_OPEN_ll','OPEN_ll for '//TRIM(TPFILE%CNAME)//'.des')
+ CALL OPEN_ll(UNIT=TZFILE_DES%NLU,FILE=TRIM(TPFILE%CNAME)//'.des',FORM='FORMATTED',ACTION=TPFILE%CMODE,DELIM&
+ & ='QUOTE',IOSTAT=IRESP,RECL=1024*8,OPARALLELIO=OPARALLELIO)
+ TZFILE_DES%LOPENED = .TRUE.
+ TZFILE_DES%NOPEN_CURRENT = TZFILE_DES%NOPEN_CURRENT + 1
+ TZFILE_DES%NOPEN = TZFILE_DES%NOPEN + 1
+ ENDIF
+ !
+ CALL FMOPEN_ll(TPFILE,IRESP,OPARALLELIO=OPARALLELIO)
+ !
+ TZFDLFI=>GETFD(ADJUSTL(TRIM(TPFILE%CNAME)//'.lfi'))
+ !TZFDLFI%CDF exists only if ISP == TZFDLFI%OWNER
+ IF (TRIM(TPFILE%CMODE) == 'READ' .AND. ISP == TZFDLFI%OWNER) THEN
+ IF (LIOCDF4 .AND. .NOT.LLFIREAD) THEN
+ IF (TPFILE%NNCID<0) CALL PRINT_MSG(NVERB_FATAL,'IO','IO_FILE_OPEN_ll','invalid NNCID for '//TRIM(TPFILE%CNAME))
+ ELSE
+ TPFILE%NLFIFLU = TZFDLFI%FLU
+ IF (TPFILE%NLFIFLU<0) CALL PRINT_MSG(NVERB_FATAL,'IO','IO_FILE_OPEN_ll','invalid NLFIFLU for '//TRIM(TPFILE%CNAME))
+ ENDIF
+ ELSE IF (TRIM(TPFILE%CMODE) == 'WRITE' .AND. ISP == TZFDLFI%OWNER) THEN
+ IF (LIOCDF4) THEN
+ IF (TPFILE%NNCID<0) CALL PRINT_MSG(NVERB_FATAL,'IO','IO_FILE_OPEN_ll','invalid NNCID for '//TRIM(TPFILE%CNAME))
+ END IF
+ IF (.NOT.LIOCDF4 .OR. LLFIOUT) THEN
+ TPFILE%NLFIFLU = TZFDLFI%FLU
+ IF (TPFILE%NLFIFLU<0) CALL PRINT_MSG(NVERB_FATAL,'IO','IO_FILE_OPEN_ll','invalid NLFIFLU for '//TRIM(TPFILE%CNAME))
+ END IF
+ ELSE IF (TRIM(TPFILE%CMODE) /= 'READ' .AND. TRIM(TPFILE%CMODE) /= 'WRITE') THEN
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_FILE_OPEN_ll','unknown opening mode ('//TRIM(TPFILE%CMODE)//') for '//TRIM(TPFILE%CNAME))
END IF
- ELSE IF (TRIM(TPFILE%CMODE) /= 'READ' .AND. TRIM(TPFILE%CMODE) /= 'WRITE') THEN
- CALL PRINT_MSG(NVERB_FATAL,'IO','IO_FILE_OPEN_ll','unknown opening mode ('//TRIM(TPFILE%CMODE)//') for '//TRIM(TPFILE%CNAME))
- END IF
- !
- !Compare MNHVERSION of file with current version
- IF (TRIM(TPFILE%CMODE) == 'READ') THEN
- IMNHVERSION(:) = 0
- !Use TZFIELD because TFIELDLIST could be not initialised
- TZFIELD%CMNHNAME = 'MNHVERSION'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'MesoNH version'
- TZFIELD%CUNITS = ''
- TZFIELD%CDIR = '--'
- TZFIELD%CCOMMENT = ''
- TZFIELD%NGRID = 0
- TZFIELD%NTYPE = TYPEINT
- TZFIELD%NDIMS = 1
- CALL IO_READ_FIELD(TPFILE,TZFIELD,IMNHVERSION,IRESP2)
- IF (IRESP2/=0) THEN
- TZFIELD%CMNHNAME = 'MASDEV'
- TZFIELD%CLONGNAME = 'MesoNH version (without bugfix)'
- CALL IO_READ_FIELD(TPFILE,TZFIELD,IMASDEV,IRESP2)
+ !
+ !Compare MNHVERSION of file with current version
+ IF (TRIM(TPFILE%CMODE) == 'READ') THEN
+ IMNHVERSION(:) = 0
+ !Use TZFIELD because TFIELDLIST could be not initialised
+ TZFIELD%CMNHNAME = 'MNHVERSION'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'MesoNH version'
+ TZFIELD%CUNITS = ''
+ TZFIELD%CDIR = '--'
+ TZFIELD%CCOMMENT = ''
+ TZFIELD%NGRID = 0
+ TZFIELD%NTYPE = TYPEINT
+ TZFIELD%NDIMS = 1
+ CALL IO_READ_FIELD(TPFILE,TZFIELD,IMNHVERSION,IRESP2)
IF (IRESP2/=0) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILE_OPEN_ll','unknown MASDEV version for '//TRIM(TPFILE%CNAME))
- ELSE
- IMNHVERSION(1)=IMASDEV/10
- IMNHVERSION(2)=MOD(IMASDEV,10)
+ TZFIELD%CMNHNAME = 'MASDEV'
+ TZFIELD%CLONGNAME = 'MesoNH version (without bugfix)'
+ CALL IO_READ_FIELD(TPFILE,TZFIELD,IMASDEV,IRESP2)
+ IF (IRESP2/=0) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILE_OPEN_ll','unknown MASDEV version for '//TRIM(TPFILE%CNAME))
+ ELSE
+ IMNHVERSION(1)=IMASDEV/10
+ IMNHVERSION(2)=MOD(IMASDEV,10)
+ END IF
+ !
+ TZFIELD%CMNHNAME = 'BUGFIX'
+ TZFIELD%CLONGNAME = 'MesoNH bugfix number'
+ CALL IO_READ_FIELD(TPFILE,TZFIELD,IBUGFIX,IRESP2)
+ IF (IRESP2/=0) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILE_OPEN_ll','unknown BUGFIX version for '//TRIM(TPFILE%CNAME))
+ ELSE
+ IMNHVERSION(3)=IBUGFIX
+ END IF
END IF
!
- TZFIELD%CMNHNAME = 'BUGFIX'
- TZFIELD%CLONGNAME = 'MesoNH bugfix number'
- CALL IO_READ_FIELD(TPFILE,TZFIELD,IBUGFIX,IRESP2)
- IF (IRESP2/=0) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILE_OPEN_ll','unknown BUGFIX version for '//TRIM(TPFILE%CNAME))
+ WRITE(YMNHVERSION_FILE,"( I0,'.',I0,'.',I0 )" ) IMNHVERSION(1),IMNHVERSION(2),IMNHVERSION(3)
+ WRITE(YMNHVERSION_CURR,"( I0,'.',I0,'.',I0 )" ) NMNHVERSION(1),NMNHVERSION(2),NMNHVERSION(3)
+ !
+ IF ( IMNHVERSION(1)==0 .AND. IMNHVERSION(2)==0 .AND. IMNHVERSION(3)==0 ) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILE_OPEN_ll','file '//TRIM(TPFILE%CNAME)//&
+ ' was written with an unknown version of MesoNH')
+ ELSE IF ( IMNHVERSION(1)< NMNHVERSION(1) .OR. &
+ (IMNHVERSION(1)==NMNHVERSION(1) .AND. IMNHVERSION(2)< NMNHVERSION(2)) .OR. &
+ (IMNHVERSION(1)==NMNHVERSION(1) .AND. IMNHVERSION(2)==NMNHVERSION(2) .AND. IMNHVERSION(3)<NMNHVERSION(3)) ) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILE_OPEN_ll','file '//TRIM(TPFILE%CNAME)//&
+ ' was written with an older version of MesoNH ('//TRIM(YMNHVERSION_FILE)//&
+ ' instead of '//TRIM(YMNHVERSION_CURR)//')')
+ ELSE IF ( IMNHVERSION(1)> NMNHVERSION(1) .OR. &
+ (IMNHVERSION(1)==NMNHVERSION(1) .AND. IMNHVERSION(2)> NMNHVERSION(2)) .OR. &
+ (IMNHVERSION(1)==NMNHVERSION(1) .AND. IMNHVERSION(2)==NMNHVERSION(2) .AND. IMNHVERSION(3)>NMNHVERSION(3)) ) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILE_OPEN_ll','file '//TRIM(TPFILE%CNAME)//&
+ ' was written with a more recent version of MesoNH ('//TRIM(YMNHVERSION_FILE)//&
+ ' instead of '//TRIM(YMNHVERSION_CURR)//')')
ELSE
- IMNHVERSION(3)=IBUGFIX
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_FILE_OPEN_ll','file '//TRIM(TPFILE%CNAME)//&
+ ' was written with the same version of MesoNH ('//TRIM(YMNHVERSION_CURR)//')')
END IF
END IF
- !
- WRITE(YMNHVERSION_FILE,"( I0,'.',I0,'.',I0 )" ) IMNHVERSION(1),IMNHVERSION(2),IMNHVERSION(3)
- WRITE(YMNHVERSION_CURR,"( I0,'.',I0,'.',I0 )" ) NMNHVERSION(1),NMNHVERSION(2),NMNHVERSION(3)
- !
- IF ( IMNHVERSION(1)==0 .AND. IMNHVERSION(2)==0 .AND. IMNHVERSION(3)==0 ) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILE_OPEN_ll','file '//TRIM(TPFILE%CNAME)//&
- ' was written with an unknown version of MesoNH')
- ELSE IF ( IMNHVERSION(1)< NMNHVERSION(1) .OR. &
- (IMNHVERSION(1)==NMNHVERSION(1) .AND. IMNHVERSION(2)< NMNHVERSION(2)) .OR. &
- (IMNHVERSION(1)==NMNHVERSION(1) .AND. IMNHVERSION(2)==NMNHVERSION(2) .AND. IMNHVERSION(3)<NMNHVERSION(3)) ) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILE_OPEN_ll','file '//TRIM(TPFILE%CNAME)//&
- ' was written with an older version of MesoNH ('//TRIM(YMNHVERSION_FILE)//&
- ' instead of '//TRIM(YMNHVERSION_CURR)//')')
- ELSE IF ( IMNHVERSION(1)> NMNHVERSION(1) .OR. &
- (IMNHVERSION(1)==NMNHVERSION(1) .AND. IMNHVERSION(2)> NMNHVERSION(2)) .OR. &
- (IMNHVERSION(1)==NMNHVERSION(1) .AND. IMNHVERSION(2)==NMNHVERSION(2) .AND. IMNHVERSION(3)>NMNHVERSION(3)) ) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILE_OPEN_ll','file '//TRIM(TPFILE%CNAME)//&
- ' was written with a more recent version of MesoNH ('//TRIM(YMNHVERSION_FILE)//&
- ' instead of '//TRIM(YMNHVERSION_CURR)//')')
- ELSE
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_FILE_OPEN_ll','file '//TRIM(TPFILE%CNAME)//&
- ' was written with the same version of MesoNH ('//TRIM(YMNHVERSION_CURR)//')')
- END IF
- END IF
-ELSE
- !OUTPUTLISTING files
- CALL OPEN_ll(UNIT=TPFILE%NLU,FILE=TPFILE%CNAME,IOSTAT=IRESP,FORM='FORMATTED', &
- ACTION=TPFILE%CMODE,MODE='GLOBAL')
-END IF
+END SELECT
!
TPFILE%LOPENED = .TRUE.
TPFILE%NOPEN = TPFILE%NOPEN + 1
@@ -306,15 +343,12 @@ LOGICAL :: GPARALLELIO
#if defined(MNH_IOCDF4)
INTEGER(KIND=IDCDF_KIND) :: INCERR
#endif
-CHARACTER(LEN=13) :: YTYPE
YACTION = TPFILE%CMODE
YFILEM = TPFILE%CNAME
CALL PRINT_MSG(NVERB_DEBUG,'IO','FMOPEN_ll','opening '//TRIM(YFILEM)//' for '//TRIM(YACTION))
-YTYPE = TPFILE%CTYPE
-
IF ( PRESENT(OPARALLELIO) ) THEN
GPARALLELIO = OPARALLELIO
ELSE !par defaut on active les IO paralleles en Z si possible
@@ -357,17 +391,6 @@ ELSEIF (IROWF.GT.IFMFNL) THEN
GOTO 1000
ENDIF
-!Do not open '.des' file if OUTPUT
-IF(YTYPE/='OUTPUT') THEN
- CALL PRINT_MSG(NVERB_DEBUG,'IO','FMOPEN_ll','OPEN_ll for '//TRIM(YFILEM)//'.des')
- YFNDES=ADJUSTL(TRIM(YFILEM)//'.des')
- CALL OPEN_ll(UNIT=INUMBR,FILE=YFNDES,FORM='FORMATTED',ACTION=YACTION,DELIM&
- & ='QUOTE',IOSTAT=IRESP,RECL=1024*8,OPARALLELIO=GPARALLELIO)
-ENDIF
-
-IF (IRESP /= 0) GOTO 1000
-
-
YFNLFI=ADJUSTL(TRIM(YFILEM)//'.lfi')
ALLOCATE(TZPARA)
TZPARA%FITYP = TPFILE%NLFITYPE
@@ -493,6 +516,7 @@ LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO
INTEGER :: INB_PROCIO, IRESP, IRESP2, JI
CHARACTER (LEN=3) :: YNUMBER ! Character string for Z-level
TYPE(FD_ll), POINTER :: TZFDLFI
+TYPE(TFILEDATA),POINTER :: TZFILE_DES
TYPE(TFILEDATA),POINTER :: TZFILE_IOZ
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_FILE_CLOSE_ll','closing '//TRIM(TPFILE%CNAME))
@@ -510,36 +534,68 @@ IF (TPFILE%NOPEN_CURRENT>1) THEN
RETURN
END IF
!
-IF (TRIM(TPFILE%CTYPE)/='OUTPUTLISTING') THEN
- !Next lines done before the close to be sure the FD_ll still exists
- TZFDLFI=>GETFD(ADJUSTL(TRIM(TPFILE%CNAME)//'.lfi'))
- INB_PROCIO=TZFDLFI%NB_PROCIO
- !
- CALL FMCLOS_ll(TPFILE,'KEEP',KRESP=IRESP,OPARALLELIO=OPARALLELIO)
- !
- TPFILE%NLFIFLU = -1
- TPFILE%NNCID = -1
- !
- IF (INB_PROCIO>1) THEN
- DO JI = 1,TZFDLFI%NB_PROCIO
- WRITE (YNUMBER,FMT="(I3.3)") JI
- CALL IO_FILE_FIND_BYNAME(TRIM(TPFILE%CNAME)//'.Z'//YNUMBER,TZFILE_IOZ,IRESP2)
- IF (IRESP2/=0) &
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_CLOSE_ll','file '//TRIM(TRIM(TPFILE%CNAME)//'.Z'//YNUMBER)//' not found in list')
- IF (TZFILE_IOZ%LOPENED) THEN
- TZFILE_IOZ%LOPENED = .FALSE.
- TZFILE_IOZ%NCLOSE = TZFILE_IOZ%NCLOSE + 1
- TZFILE_IOZ%NLFIFLU = -1
- TZFILE_IOZ%NNCID = -1
- END IF
- END DO
- END IF
-ELSE
+SELECT CASE(TPFILE%CTYPE)
+ !Namelist files
+ CASE('NML')
+ CALL CLOSE_ll(TPFILE%CNAME,IOSTAT=IRESP)
+ !
+ TPFILE%NLU = -1
+
+
!OUTPUTLISTING files
- CALL CLOSE_ll(TPFILE%CNAME,IOSTAT=IRESP,OPARALLELIO=.FALSE.)
- !
- TPFILE%NLU = -1
-END IF
+ CASE('OUTPUTLISTING')
+ CALL CLOSE_ll(TPFILE%CNAME,IOSTAT=IRESP,OPARALLELIO=.FALSE.)
+ !
+ TPFILE%NLU = -1
+
+
+ !SURFACE_DATA files
+ CASE('SURFACE_DATA')
+ CALL CLOSE_ll(TPFILE%CNAME,IOSTAT=IRESP)
+ !
+ TPFILE%NLU = -1
+
+
+ CASE DEFAULT
+ !Do not close (non-existing) '.des' file if OUTPUT
+ IF(TPFILE%CTYPE/='OUTPUT') THEN
+ CALL IO_FILE_FIND_BYNAME(TRIM(TPFILE%CNAME)//'.des',TZFILE_DES,IRESP)
+ IF (IRESP/=0) CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_CLOSE_ll','file '//TRIM(TPFILE%CNAME)//'.des not in filelist')
+ !
+ TZFILE_DES%NOPEN_CURRENT = TZFILE_DES%NOPEN_CURRENT - 1
+ TZFILE_DES%NCLOSE = TZFILE_DES%NCLOSE + 1
+ !
+ IF (TZFILE_DES%NOPEN_CURRENT==0) THEN
+ CALL CLOSE_ll(TRIM(TPFILE%CNAME)//'.des',IOSTAT=IRESP,STATUS='KEEP')
+ TZFILE_DES%LOPENED = .FALSE.
+ TZFILE_DES%NLU = -1
+ END IF
+ ENDIF
+ !
+ !Next lines done before the close to be sure the FD_ll still exists
+ TZFDLFI=>GETFD(ADJUSTL(TRIM(TPFILE%CNAME)//'.lfi'))
+ INB_PROCIO=TZFDLFI%NB_PROCIO
+ !
+ CALL FMCLOS_ll(TPFILE,'KEEP',KRESP=IRESP,OPARALLELIO=OPARALLELIO)
+ !
+ TPFILE%NLFIFLU = -1
+ TPFILE%NNCID = -1
+ !
+ IF (INB_PROCIO>1) THEN
+ DO JI = 1,TZFDLFI%NB_PROCIO
+ WRITE (YNUMBER,FMT="(I3.3)") JI
+ CALL IO_FILE_FIND_BYNAME(TRIM(TPFILE%CNAME)//'.Z'//YNUMBER,TZFILE_IOZ,IRESP2)
+ IF (IRESP2/=0) &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_CLOSE_ll','file '//TRIM(TRIM(TPFILE%CNAME)//'.Z'//YNUMBER)//' not found in list')
+ IF (TZFILE_IOZ%LOPENED) THEN
+ TZFILE_IOZ%LOPENED = .FALSE.
+ TZFILE_IOZ%NCLOSE = TZFILE_IOZ%NCLOSE + 1
+ TZFILE_IOZ%NLFIFLU = -1
+ TZFILE_IOZ%NNCID = -1
+ END IF
+ END DO
+ END IF
+END SELECT
!
TPFILE%LOPENED = .FALSE.
TPFILE%NOPEN_CURRENT = 0
@@ -584,17 +640,14 @@ INTEGER :: IERR, IFITYP
INTEGER, SAVE :: ICPT=0
TYPE(FD_ll), POINTER :: TZFDLFI
!JUAN
-INTEGER(KIND=LFI_INT) :: IRESP8,INUM8
+INTEGER(KIND=LFI_INT) :: IRESP8
!JUAN
LOGICAL :: GPARALLELIO
-CHARACTER(LEN=13) :: YTYPE
YFILEM = TPFILE%CNAME
CALL PRINT_MSG(NVERB_DEBUG,'IO','FMCLOS_ll','closing '//TRIM(YFILEM))
-YTYPE = TPFILE%CTYPE
-
IF ( PRESENT(OPARALLELIO) ) THEN
GPARALLELIO = OPARALLELIO
ELSE
@@ -628,22 +681,13 @@ ELSE
ENDIF
ENDIF
-!Do not close (non-existing) '.des' file if OUTPUT
-IF(YTYPE/='OUTPUT') THEN
- YFNDES=ADJUSTL(TRIM(YFILEM)//'.des')
- CALL CLOSE_ll(YFNDES,IOSTAT=IRESP,STATUS=YSTATU)
-ENDIF
-
-IF (IRESP /= 0) GOTO 1000
-
YFNLFI=ADJUSTL(TRIM(YFILEM)//'.lfi')
TZFDLFI=>GETFD(YFNLFI)
IF (ISP == TZFDLFI%OWNER) THEN
- IF (TZFDLFI%FLU > 0) THEN
- INUM8=TZFDLFI%FLU
- CALL LFIFER(IRESP8,INUM8,YSTATU)
+ IF (TPFILE%NLFIFLU > 0) THEN
+ CALL LFIFER(IRESP8,TPFILE%NLFIFLU,YSTATU)
IRESP = IRESP8
END IF
IF (ASSOCIATED(TZFDLFI%CDF)) CALL CLEANIOCDF(TZFDLFI%CDF)
diff --git a/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90 b/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90
index 43d788f44..117a55998 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90
@@ -572,7 +572,7 @@ END SUBROUTINE POPULATE_STRUCT
!
END SUBROUTINE IO_PREPARE_BAKOUT_STRUCT
!
-SUBROUTINE IO_FILE_ADD2LIST(TPFILE,HNAME,HTYPE,HMODE,KLFINPRAR,KLFITYPE,KLFIVERB,TPDADFILE,OOLD)
+SUBROUTINE IO_FILE_ADD2LIST(TPFILE,HNAME,HTYPE,HMODE,HFORM,HACCESS,KLFINPRAR,KLFITYPE,KLFIVERB,KRECL,TPDADFILE,OOLD)
!
USE MODD_BAKOUT, ONLY : LOUT_COMPRESS,LOUT_REDUCE_FLOAT_PRECISION,NOUT_COMPRESS_LEVEL
USE MODE_MODELN_HANDLER, ONLY : GET_CURRENT_MODEL_INDEX
@@ -581,9 +581,12 @@ TYPE(TFILEDATA),POINTER, INTENT(INOUT) :: TPFILE !File structure to r
CHARACTER(LEN=*), INTENT(IN) :: HNAME !Filename
CHARACTER(LEN=*), INTENT(IN) :: HTYPE !Filetype (backup, output, prepidealcase...)
CHARACTER(LEN=*), INTENT(IN) :: HMODE !Opening mode (read, write...)
+CHARACTER(LEN=*), OPTIONAL,INTENT(IN) :: HFORM !Formatted/unformatted
+CHARACTER(LEN=*), OPTIONAL,INTENT(IN) :: HACCESS !Direct/sequential
INTEGER(KIND=LFI_INT), OPTIONAL,INTENT(IN) :: KLFINPRAR !Number of predicted articles of the LFI file (non crucial)
INTEGER, OPTIONAL,INTENT(IN) :: KLFITYPE !Type of the file (used to generate list of files to transfers)
INTEGER, OPTIONAL,INTENT(IN) :: KLFIVERB !LFI verbosity level
+INTEGER, OPTIONAL,INTENT(IN) :: KRECL !Record length
TYPE(TFILEDATA),POINTER,OPTIONAL,INTENT(IN) :: TPDADFILE !Corresponding dad file
LOGICAL, OPTIONAL,INTENT(IN) :: OOLD !FALSE if new file (should not be found)
!TRUE if the file could already be in the list
@@ -624,6 +627,24 @@ END IF
!
IMI = GET_CURRENT_MODEL_INDEX()
!
+IF( PRESENT(HFORM) .AND. TRIM(HTYPE)/='SURFACE_DATA') &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILE_ADD2LIST','optional argument HFORM is not used by '//TRIM(HTYPE)//' files')
+IF(.NOT.PRESENT(HFORM) .AND. TRIM(HTYPE)=='SURFACE_DATA') &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_ADD2LIST','optional argument HFORM is necessary for '//TRIM(HTYPE)//' files')
+IF(PRESENT(HFORM)) THEN
+ IF(HFORM/='FORMATTED' .AND. HFORM/='UNFORMATTED') &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_ADD2LIST','HFORM should be FORMATTED or UNFORMATTED and not '//TRIM(HFORM))
+END IF
+!
+IF( PRESENT(HACCESS) .AND. TRIM(HTYPE)/='SURFACE_DATA') &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILE_ADD2LIST','optional argument HACCESS is not used by '//TRIM(HTYPE)//' files')
+IF(.NOT.PRESENT(HACCESS) .AND. TRIM(HTYPE)=='SURFACE_DATA') &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_ADD2LIST','optional argument HACCESS is necessary for '//TRIM(HTYPE)//' files')
+IF(PRESENT(HACCESS)) THEN
+ IF(HACCESS/='DIRECT' .AND. HACCESS/='SEQUENTIAL') &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_ADD2LIST','HACCESS should be DIRECT or SEQUENTIAL and not '//TRIM(HACCESS))
+END IF
+!
IF(PRESENT(KLFINPRAR)) THEN
ILFINPRAR = KLFINPRAR
ELSE
@@ -642,6 +663,14 @@ ELSE
ILFIVERB = -1
END IF
!
+IF( PRESENT(KRECL) .AND. TRIM(HTYPE)/='SURFACE_DATA') &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILE_ADD2LIST','optional argument KRECL is not used by '//TRIM(HTYPE)//' files')
+IF(.NOT.PRESENT(KRECL) .AND. TRIM(HTYPE)=='SURFACE_DATA') THEN
+ IF(TRIM(HACCESS)=='DIRECT') &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_ADD2LIST','optional argument KRECL is necessary for '//TRIM(HTYPE)// &
+ ' files in DIRECT access')
+END IF
+!
IF (.NOT.ASSOCIATED(TFILE_LAST)) THEN
ALLOCATE(TFILE_LAST)
TFILE_FIRST => TFILE_LAST
@@ -662,52 +691,71 @@ END IF
!
TPFILE%CMODE = HMODE
!
-IF (TRIM(HTYPE)/='OUTPUTLISTING') THEN
- IF (TRIM(HMODE)=='READ') THEN
- IF (LLFIREAD) THEN
- TPFILE%CFORMAT = 'LFI'
- TPFILE%NLFINPRAR = ILFINPRAR
- ELSE IF (LIOCDF4) THEN
- TPFILE%CFORMAT = 'NETCDF4'
- ELSE
- CALL PRINT_MSG(NVERB_FATAL,'IO','IO_FILE_ADD2LIST','invalid format for file '//TRIM(HNAME))
+SELECT CASE(TPFILE%CTYPE)
+ !Namelist files
+ CASE('NML')
+ IF (TRIM(HMODE)/='READ') &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_ADD2LIST','invalid mode '//TRIM(HMODE)//' for file '//TRIM(HNAME))
+ TPFILE%CFORMAT = 'TEXT'
+
+
+ !OUTPUTLISTING files
+ CASE('OUTPUTLISTING')
+ IF (TRIM(HMODE)/='WRITE') &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_ADD2LIST','invalid mode '//TRIM(HMODE)//' for file '//TRIM(HNAME))
+ TPFILE%CFORMAT = 'TEXT'
+
+
+ !SURFACE_DATA files
+ CASE('SURFACE_DATA')
+ IF (TRIM(HMODE)/='READ') &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_ADD2LIST','invalid mode '//TRIM(HMODE)//' for file '//TRIM(HNAME))
+ TPFILE%CFORMAT = 'SURFACE_DATA'
+ TPFILE%CFORM = HFORM
+ TPFILE%CACCESS = HACCESS
+ IF(TRIM(HACCESS)=='DIRECT') TPFILE%NRECL = KRECL
+
+
+ CASE DEFAULT
+ IF (TRIM(HMODE)=='READ') THEN
+ IF (LLFIREAD) THEN
+ TPFILE%CFORMAT = 'LFI'
+ TPFILE%NLFINPRAR = ILFINPRAR
+ ELSE IF (LIOCDF4) THEN
+ TPFILE%CFORMAT = 'NETCDF4'
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_FILE_ADD2LIST','invalid format for file '//TRIM(HNAME))
+ END IF
+ ELSE IF (TRIM(HMODE)=='WRITE') THEN
+ IF (LLFIOUT .AND. LIOCDF4) THEN
+ TPFILE%CFORMAT = 'LFICDF4'
+ TPFILE%NLFINPRAR = ILFINPRAR
+ ELSE IF (LIOCDF4) THEN
+ TPFILE%CFORMAT = 'NETCDF4'
+ ELSE IF (LLFIOUT) THEN
+ TPFILE%CFORMAT = 'LFI'
+ TPFILE%NLFINPRAR = ILFINPRAR
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_FILE_ADD2LIST','invalid format for file '//TRIM(HNAME))
+ END IF
END IF
- ELSE IF (TRIM(HMODE)=='WRITE') THEN
- IF (LLFIOUT .AND. LIOCDF4) THEN
- TPFILE%CFORMAT = 'LFICDF4'
- TPFILE%NLFINPRAR = ILFINPRAR
- ELSE IF (LIOCDF4) THEN
- TPFILE%CFORMAT = 'NETCDF4'
- ELSE IF (LLFIOUT) THEN
- TPFILE%CFORMAT = 'LFI'
- TPFILE%NLFINPRAR = ILFINPRAR
+ !
+ TPFILE%NLFITYPE = ILFITYPE
+ TPFILE%NLFIVERB = ILFIVERB
+ !
+ IF (TRIM(HTYPE)=='OUTPUT') THEN
+ TPFILE%LNCREDUCE_FLOAT_PRECISION = LOUT_REDUCE_FLOAT_PRECISION(IMI)
+ TPFILE%LNCCOMPRESS = LOUT_COMPRESS(IMI)
+ TPFILE%NNCCOMPRESS_LEVEL = NOUT_COMPRESS_LEVEL(IMI)
+ END IF
+ !
+ IF(PRESENT(TPDADFILE)) THEN
+ IF (.NOT.ASSOCIATED(TPDADFILE)) CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILE_ADD2LIST','TPDADFILE provided but not associated')
+ TPFILE%TDADFILE => TPDADFILE
ELSE
- CALL PRINT_MSG(NVERB_FATAL,'IO','IO_FILE_ADD2LIST','invalid format for file '//TRIM(HNAME))
+ TPFILE%TDADFILE => NULL()
END IF
- END IF
- !
- TPFILE%NLFITYPE = ILFITYPE
- TPFILE%NLFIVERB = ILFIVERB
- !
- IF (TRIM(HTYPE)=='OUTPUT') THEN
- TPFILE%LNCREDUCE_FLOAT_PRECISION = LOUT_REDUCE_FLOAT_PRECISION(IMI)
- TPFILE%LNCCOMPRESS = LOUT_COMPRESS(IMI)
- TPFILE%NNCCOMPRESS_LEVEL = NOUT_COMPRESS_LEVEL(IMI)
- END IF
- !
- IF(PRESENT(TPDADFILE)) THEN
- IF (.NOT.ASSOCIATED(TPDADFILE)) CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILE_ADD2LIST','TPDADFILE provided but not associated')
- TPFILE%TDADFILE => TPDADFILE
- ELSE
- TPFILE%TDADFILE => NULL()
- END IF
- !
-ELSE
- !OUTPUTLISTING files
- IF (TRIM(HMODE)/='WRITE') &
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_ADD2LIST','invalid mode '//TRIM(HMODE)//' for file '//TRIM(HNAME))
- TPFILE%CFORMAT = 'OUTPUTLISTING'
-END IF
+END SELECT
!
TPFILE%LOPENED = .FALSE.
TPFILE%NOPEN = 0
--
GitLab