From 2e4b4288ba6541406e838f1f6af40a724cd605ad Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Tue, 19 Feb 2019 10:49:23 +0100
Subject: [PATCH] Philippe 19/02/2019: IO:
simplification/restructuration/cleaning of open/close subroutines (to be
continued)
---
src/LIB/SURCOUCHE/src/mode_fm.f90 | 339 +++++++++++-------------------
src/LIB/SURCOUCHE/src/mode_io.f90 | 196 +++++++----------
2 files changed, 197 insertions(+), 338 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/mode_fm.f90 b/src/LIB/SURCOUCHE/src/mode_fm.f90
index 760c8710d..53c1fe8ea 100644
--- a/src/LIB/SURCOUCHE/src/mode_fm.f90
+++ b/src/LIB/SURCOUCHE/src/mode_fm.f90
@@ -3,25 +3,26 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
+! Author(s):
+!
! Modifications:
-! D.Gazen : avril 2016 change error message
-! P. Wautelet : may 2016: use NetCDF Fortran module
-! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! Philippe Wautelet: 29/10/2018: better detection of older MNH version numbers
-! Philippe Wautelet: 13/12/2018: moved some operations to new mode_io_*_nc4 modules
-! Philippe Wautelet: 10/01/2019: use NEWUNIT argument of OPEN + move management
-! of NNCID and NLFIFLU to the nc4 and lfi subroutines
-! Philippe Wautelet: 21/01/2019: add LIO_ALLOW_NO_BACKUP and LIO_NO_WRITE to modd_io_ll
-! to allow to disable writes (for bench purposes)
+! D. Gazen April 2016: change error message
+! P. Wautelet May 2016 : use NetCDF Fortran module
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 29/10/2018: better detection of older MNH version numbers
+! P. Wautelet 13/12/2018: moved some operations to new mode_io_*_nc4 modules
+! P. Wautelet 10/01/2019: use NEWUNIT argument of OPEN + move management
+! of NNCID and NLFIFLU to the nc4 and lfi subroutines
+! P. Wautelet 21/01/2019: add LIO_ALLOW_NO_BACKUP and LIO_NO_WRITE to modd_io_ll
+! to allow to disable writes (for bench purposes)
! P. Wautelet 06/02/2019: simplify OPEN_ll and do somme assignments at a more logical place
! P. Wautelet 07/02/2019: force TYPE to a known value for IO_FILE_ADD2LIST
! P. Wautelet 07/02/2019: remove OPARALLELIO argument from open and close files subroutines
! (nsubfiles_ioz is now determined in IO_FILE_ADD2LIST)
+! P. Wautelet 19/02/2019: simplification/restructuration/cleaning of open/close subroutines (TBCto be continued)
!-----------------------------------------------------------------
MODULE MODE_FM
-USE MODD_MPIF
-
USE MODE_MSG
IMPLICIT NONE
@@ -34,10 +35,8 @@ PUBLIC IO_FILE_OPEN_ll, IO_FILE_CLOSE_ll
CONTAINS
SUBROUTINE SET_FMPACK_ll(O1D,O2D,OPACK)
-USE MODD_IO_ll, ONLY : LPACK,L1D,L2D
-!JUAN
-USE MODD_VAR_ll, ONLY : IP
-!JUAN
+USE MODD_IO_ll, ONLY: LPACK, L1D, L2D
+USE MODD_VAR_ll, ONLY: IP
IMPLICIT NONE
@@ -47,27 +46,27 @@ LPACK = OPACK
L1D = O1D
L2D = O2D
-IF ( IP .EQ. 1 ) PRINT *,'INIT L1D,L2D,LPACK = ',L1D,L2D,LPACK
+IF ( IP == 1 ) PRINT *,'INIT L1D,L2D,LPACK = ',L1D,L2D,LPACK
END SUBROUTINE SET_FMPACK_ll
SUBROUTINE IO_FILE_OPEN_ll(TPFILE,KRESP,HPOSITION,HSTATUS,HPROGRAM_ORIG)
!
-USE MODD_CONF, ONLY: CPROGRAM
-USE MODD_IO_ll, ONLY: LIO_NO_WRITE, TFILEDATA
-USE MODE_FMREAD
-USE MODE_IO_ll, ONLY : OPEN_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST,IO_FILE_FIND_BYNAME
+USE MODD_CONF, ONLY: CPROGRAM
+USE MODD_IO_ll, ONLY: LIO_NO_WRITE, TFILEDATA
!
-TYPE(TFILEDATA),POINTER,INTENT(INOUT) :: TPFILE ! File structure
-INTEGER, INTENT(OUT), OPTIONAL :: KRESP ! Return code
-CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HPOSITION
-CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HSTATUS
-CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HPROGRAM_ORIG !To emulate a file coming from this program
+USE MODE_IO_ll, ONLY: OPEN_ll
+USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST, IO_FILE_FIND_BYNAME
!
-INTEGER :: IRESP
-TYPE(TFILEDATA),POINTER :: TZFILE_DES
-TYPE(TFILEDATA),POINTER :: TZFILE_DUMMY
+TYPE(TFILEDATA), POINTER, INTENT(INOUT) :: TPFILE ! File structure
+INTEGER, INTENT(OUT), OPTIONAL :: KRESP ! Return code
+CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HPOSITION
+CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HSTATUS
+CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HPROGRAM_ORIG !To emulate a file coming from this program
+!
+INTEGER :: IRESP
+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)// &
' (filetype='//TRIM(TPFILE%CTYPE)//')')
@@ -98,42 +97,42 @@ IF (IRESP/=0) CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_OPEN_ll','file '//TRIM(TP
SELECT CASE(TPFILE%CTYPE)
!Chemistry input files
CASE('CHEMINPUT')
- CALL OPEN_ll(TPFILE,IOSTAT=IRESP,POSITION='REWIND',STATUS='OLD',MODE='GLOBAL')
+ CALL OPEN_ll(TPFILE,IRESP,HPOSITION='REWIND',HSTATUS='OLD',HMODE='GLOBAL')
!Chemistry tabulation files
CASE('CHEMTAB')
- CALL OPEN_ll(TPFILE,IOSTAT=IRESP,MODE='GLOBAL')
+ CALL OPEN_ll(TPFILE,IRESP,HMODE='GLOBAL')
!GPS files
CASE('GPS')
- CALL OPEN_ll(TPFILE,IOSTAT=IRESP,MODE='SPECIFIC')
+ CALL OPEN_ll(TPFILE,IRESP,HMODE='SPECIFIC')
!Meteo files
CASE('METEO')
- CALL OPEN_ll(TPFILE,IOSTAT=IRESP,MODE='GLOBAL')
+ CALL OPEN_ll(TPFILE,IRESP,HMODE='GLOBAL')
!Namelist files
CASE('NML')
- CALL OPEN_ll(TPFILE,IOSTAT=IRESP,DELIM='QUOTE',MODE='GLOBAL')
+ CALL OPEN_ll(TPFILE,IRESP,HDELIM='QUOTE',HMODE='GLOBAL')
!OUTPUTLISTING files
CASE('OUTPUTLISTING')
- CALL OPEN_ll(TPFILE,IOSTAT=IRESP,MODE='GLOBAL')
+ CALL OPEN_ll(TPFILE,IRESP,HMODE='GLOBAL')
!SURFACE_DATA files
CASE('SURFACE_DATA')
- CALL OPEN_ll(TPFILE,IOSTAT=IRESP,MODE='GLOBAL')
+ CALL OPEN_ll(TPFILE,IRESP,HMODE='GLOBAL')
!Text files
CASE('TXT')
- CALL OPEN_ll(TPFILE,IOSTAT=IRESP,POSITION=HPOSITION,STATUS=HSTATUS,MODE='GLOBAL')
+ CALL OPEN_ll(TPFILE,IRESP,HPOSITION=HPOSITION,HSTATUS=HSTATUS,HMODE='GLOBAL')
CASE DEFAULT
@@ -141,7 +140,7 @@ SELECT CASE(TPFILE%CTYPE)
IF(TPFILE%CTYPE/='MNHOUTPUT' .AND. CPROGRAM/='LFICDF') THEN
CALL IO_FILE_ADD2LIST(TZFILE_DES,TRIM(TPFILE%CNAME)//'.des','DES',TPFILE%CMODE,TPDATAFILE=TPFILE,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(TZFILE_DES,IOSTAT=IRESP,DELIM='QUOTE')
+ CALL OPEN_ll(TZFILE_DES,IRESP,HDELIM='QUOTE')
TZFILE_DES%LOPENED = .TRUE.
TZFILE_DES%NOPEN_CURRENT = TZFILE_DES%NOPEN_CURRENT + 1
TZFILE_DES%NOPEN = TZFILE_DES%NOPEN + 1
@@ -155,29 +154,26 @@ IF (PRESENT(KRESP)) KRESP = IRESP
!
END SUBROUTINE IO_FILE_OPEN_ll
+
SUBROUTINE FMOPEN_ll(TPFILE,KRESP,HPROGRAM_ORIG)
-USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODE_IO_ll, ONLY: OPEN_ll,GCONFIO
-!JUANZ
-USE MODD_CONFZ,ONLY : NB_PROCIO_R,NB_PROCIO_W
-!JUANZ
+
+USE MODD_IO_ll, ONLY: TFILEDATA
+
#if defined(MNH_IOCDF4)
-USE MODD_NETCDF, ONLY:IDCDF_KIND
use mode_io_file_nc4, only: io_create_file_nc4, io_open_file_nc4
#endif
use mode_io_file_lfi, only: io_create_file_lfi, io_open_file_lfi
+USE MODE_IO_ll, ONLY: OPEN_ll, GCONFIO
-TYPE(TFILEDATA), INTENT(INOUT) :: TPFILE ! File structure
-INTEGER, INTENT(OUT) :: KRESP ! return-code
-CHARACTER(LEN=*),INTENT(IN), OPTIONAL :: HPROGRAM_ORIG !To emulate a file coming from this program
+TYPE(TFILEDATA), INTENT(INOUT) :: TPFILE ! File structure
+INTEGER, INTENT(OUT) :: KRESP ! return-code
+CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HPROGRAM_ORIG !To emulate a file coming from this program
!
! Local variables
!
-INTEGER :: IROWF, IRESP
+INTEGER :: IRESP
CHARACTER(LEN=7) :: YACTION ! Action upon the file ('READ' or 'WRITE')
CHARACTER(LEN=8) :: YRESP
-INTEGER :: IERR
-INTEGER :: INB_PROCIO
LOGICAL :: GEXIST_LFI, GEXIST_NC4
YACTION = TPFILE%CMODE
@@ -190,26 +186,9 @@ IF (.NOT. GCONFIO) THEN
STOP
END IF
-IROWF = 0
IRESP = 0
-IROWF=LEN_TRIM(TPFILE%CNAME)
-
-IF (IROWF.EQ.0) THEN
- IRESP=-45
- GOTO 1000
-ENDIF
-
- SELECT CASE (YACTION)
- CASE('READ')
- INB_PROCIO = NB_PROCIO_R
- CASE('WRITE')
- INB_PROCIO = NB_PROCIO_W
- END SELECT
-
-CALL OPEN_ll(TPFILE,IOSTAT=IRESP,MODE='IO_ZSPLIT',HPROGRAM_ORIG=HPROGRAM_ORIG)
-
-IF (IRESP /= 0) GOTO 1000
+CALL OPEN_ll(TPFILE,IRESP,HMODE='IO_ZSPLIT',HPROGRAM_ORIG=HPROGRAM_ORIG)
IF (TPFILE%LMASTER) THEN
! Proc I/O case
@@ -277,14 +256,7 @@ IF (TPFILE%CFORMAT=='LFI' .OR. TPFILE%CFORMAT=='LFICDF4') THEN
END SELECT
END IF
-! Broadcast ERROR
-CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
-IF (IRESP /= 0) GOTO 1000
-
-
-1000 CONTINUE
-
-IF (IRESP.NE.0) THEN
+IF ( IRESP /= 0 ) THEN
WRITE(YRESP,"( I0 )") IRESP
CALL PRINT_MSG(NVERB_ERROR,'IO','FMOPEN_ll',TRIM(TPFILE%CNAME)//': exit with IRESP='//TRIM(YRESP))
END IF
@@ -293,16 +265,23 @@ KRESP=IRESP
END SUBROUTINE FMOPEN_ll
+
SUBROUTINE IO_FILE_CLOSE_ll(TPFILE,KRESP,HPROGRAM_ORIG)
!
-USE MODD_CONF, ONLY: CPROGRAM
-USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODE_IO_ll, ONLY : CLOSE_ll
+USE MODD_CONF, ONLY: CPROGRAM
+USE MODD_IO_ll, ONLY: TFILEDATA
+
+use mode_io_file_lfi, only: io_close_file_lfi
+#if defined(MNH_IOCDF4)
+use mode_io_file_nc4, only: io_close_file_nc4
+use mode_io_write_nc4, only: io_write_coordvar_nc4
+#endif
+USE MODE_IO_ll, ONLY: CLOSE_ll
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_FIND_BYNAME
!
-TYPE(TFILEDATA), INTENT(INOUT) :: TPFILE ! File structure
-INTEGER, INTENT(OUT), OPTIONAL :: KRESP ! Return code
-CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HPROGRAM_ORIG !To emulate a file coming from this program
+TYPE(TFILEDATA), INTENT(INOUT) :: TPFILE ! File structure
+INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! Return code
+CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HPROGRAM_ORIG !To emulate a file coming from this program
!
INTEGER :: IRESP, JI
TYPE(TFILEDATA),POINTER :: TZFILE_DES
@@ -331,62 +310,11 @@ IF (TPFILE%NOPEN_CURRENT>1) THEN
END IF
!
SELECT CASE(TPFILE%CTYPE)
- !Chemistry input files
- CASE('CHEMINPUT')
- CALL CLOSE_ll(TPFILE,IOSTAT=IRESP)
- !
- TPFILE%NLU = -1
-
-
- !Chemistry tabulation files
- CASE('CHEMTAB')
- CALL CLOSE_ll(TPFILE,IOSTAT=IRESP)
+ CASE('CHEMINPUT','CHEMTAB','GPS','METEO','NML','OUTPUTLISTING','SURFACE_DATA','TXT')
+ CALL CLOSE_ll(TPFILE,IRESP)
!
TPFILE%NLU = -1
-
- !GPS files
- CASE('GPS')
- CALL CLOSE_ll(TPFILE,IOSTAT=IRESP)
- !
- TPFILE%NLU = -1
-
-
- !Meteo files
- CASE('METEO')
- CALL CLOSE_ll(TPFILE,IOSTAT=IRESP)
- !
- TPFILE%NLU = -1
-
-
- !Namelist files
- CASE('NML')
- CALL CLOSE_ll(TPFILE,IOSTAT=IRESP)
- !
- TPFILE%NLU = -1
-
-
- !OUTPUTLISTING files
- CASE('OUTPUTLISTING')
- CALL CLOSE_ll(TPFILE,IOSTAT=IRESP)
- !
- TPFILE%NLU = -1
-
-
- !SURFACE_DATA files
- CASE('SURFACE_DATA')
- CALL CLOSE_ll(TPFILE,IOSTAT=IRESP)
- !
- TPFILE%NLU = -1
-
-
- !Text files
- CASE('TXT')
- CALL CLOSE_ll(TPFILE,IOSTAT=IRESP)
- !
- TPFILE%NLU = -1
-
-
CASE DEFAULT
!Do not close (non-existing) '.des' file if OUTPUT
IF(TPFILE%CTYPE/='OUTPUT' .AND. CPROGRAM/='LFICDF') THEN
@@ -397,15 +325,29 @@ SELECT CASE(TPFILE%CTYPE)
TZFILE_DES%NCLOSE = TZFILE_DES%NCLOSE + 1
!
IF (TZFILE_DES%NOPEN_CURRENT==0) THEN
- CALL CLOSE_ll(TZFILE_DES,IOSTAT=IRESP)
+ CALL CLOSE_ll(TZFILE_DES,IRESP)
TZFILE_DES%LOPENED = .FALSE.
TZFILE_DES%NLU = -1
END IF
ENDIF
!
- CALL FMCLOS_ll(TPFILE,KRESP=IRESP,HPROGRAM_ORIG=HPROGRAM_ORIG)
+#if defined(MNH_IOCDF4)
+ !Write coordinates variables in NetCDF file
+ IF (TPFILE%CMODE == 'WRITE' .AND. (TPFILE%CFORMAT=='NETCDF4' .OR. TPFILE%CFORMAT=='LFICDF4')) THEN
+ CALL IO_WRITE_COORDVAR_NC4(TPFILE,HPROGRAM_ORIG=HPROGRAM_ORIG)
+ END IF
+#endif
+
+ if (tpfile%lmaster) then
+ if (tpfile%cformat == 'LFI' .or. tpfile%cformat == 'LFICDF4') call io_close_file_lfi(tpfile,iresp)
+#if defined(MNH_IOCDF4)
+ if (tpfile%cformat == 'NETCDF4' .or. tpfile%cformat == 'LFICDF4') call io_close_file_nc4(tpfile,iresp)
+#endif
+ end if
+ !
+ CALL IO_ADD2TRANSFER_LIST(TPFILE)
!
- DO JI = 1,TPFILE%NSUBFILES_IOZ
+ SUBFILES: DO JI = 1,TPFILE%NSUBFILES_IOZ
TZFILE_IOZ => TPFILE%TFILES_IOZ(JI)%TFILE
IF (.NOT.TZFILE_IOZ%LOPENED) &
CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_CLOSE_ll','file '//TRIM(TZFILE_IOZ%CNAME)//' is not opened')
@@ -415,7 +357,19 @@ SELECT CASE(TPFILE%CTYPE)
TZFILE_IOZ%LOPENED = .FALSE.
TZFILE_IOZ%NOPEN_CURRENT = 0
TZFILE_IOZ%NCLOSE = TZFILE_IOZ%NCLOSE + 1
- END DO
+#if defined(MNH_IOCDF4)
+ !Write coordinates variables in netCDF file
+ IF (TZFILE_IOZ%CMODE == 'WRITE' .AND. (TZFILE_IOZ%CFORMAT=='NETCDF4' .OR. TZFILE_IOZ%CFORMAT=='LFICDF4')) THEN
+ CALL IO_WRITE_COORDVAR_NC4(TZFILE_IOZ,HPROGRAM_ORIG=HPROGRAM_ORIG)
+ END IF
+#endif
+ IF (TZFILE_IOZ%LMASTER) THEN
+ if (tzfile_ioz%cformat == 'LFI' .or. tzfile_ioz%cformat == 'LFICDF4') call io_close_file_lfi(tzfile_ioz,iresp)
+#if defined(MNH_IOCDF4)
+ if (tzfile_ioz%cformat == 'NETCDF4' .or. tzfile_ioz%cformat == 'LFICDF4') call io_close_file_nc4(tzfile_ioz,iresp)
+#endif
+ END IF
+ END DO SUBFILES
END SELECT
!
TPFILE%LOPENED = .FALSE.
@@ -426,106 +380,53 @@ IF (PRESENT(KRESP)) KRESP=IRESP
!
END SUBROUTINE IO_FILE_CLOSE_ll
-SUBROUTINE FMCLOS_ll(TPFILE,KRESP,HPROGRAM_ORIG)
-!
-!! MODIFICATIONS
-!! -------------
-!
-!! J.Escobar 18/10/10 bug with PGI compiler on ADJUSTL
-!-------------------------------------------------------------------------------
+
+subroutine IO_ADD2TRANSFER_LIST(TPFILE)
+
USE MODD_CONF, ONLY : CPROGRAM
USE MODD_IO_ll, ONLY : TFILEDATA
-USE MODE_IO_ll, ONLY : CLOSE_ll,UPCASE
-USE MODI_SYSTEM_MNH
- use mode_io_file_lfi, only: io_close_file_lfi
-#if defined(MNH_IOCDF4)
- use mode_io_file_nc4, only: io_close_file_nc4
- use mode_io_write_nc4, only: io_write_coordvar_nc4
-#endif
-TYPE(TFILEDATA), INTENT(INOUT) :: TPFILE ! File structure
-INTEGER, INTENT(OUT) :: KRESP ! return-code if problems araised
-CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HPROGRAM_ORIG !To emulate a file coming from this program
-
-INTEGER :: IRESP,IROWF
-CHARACTER(LEN=28) :: YFILEM ! name of the file
-CHARACTER(LEN=8) :: YRESP
-CHARACTER(LEN=10) :: YCPIO
-CHARACTER(LEN=14) :: YTRANS
-CHARACTER(LEN=100) :: YCOMMAND
-INTEGER :: IERR, IFITYP
-INTEGER, SAVE :: ICPT=0
-
-YFILEM = TPFILE%CNAME
-CALL PRINT_MSG(NVERB_DEBUG,'IO','FMCLOS_ll','closing '//TRIM(YFILEM))
+USE MODI_SYSTEM_MNH
-IRESP = 0
-IROWF = 0
+TYPE(TFILEDATA), INTENT(INOUT) :: TPFILE ! File structure
-IROWF=LEN_TRIM(YFILEM)
+CHARACTER(len=:),allocatable :: YFILEM ! name of the file
+CHARACTER(len=:),allocatable :: YCPIO
+CHARACTER(len=:),allocatable :: YTRANS
+CHARACTER(LEN=100) :: YCOMMAND
+INTEGER, SAVE :: ICPT = 0
-IF (IROWF.EQ.0) THEN
- IRESP=-59
- GOTO 1000
-ENDIF
+YFILEM = TPFILE%CNAME
-#if defined(MNH_IOCDF4)
-!Write coordinates variables in NetCDF file
-IF (TPFILE%CMODE == 'WRITE' .AND. (TPFILE%CFORMAT=='NETCDF4' .OR. TPFILE%CFORMAT=='LFICDF4')) THEN
- CALL IO_WRITE_COORDVAR_NC4(TPFILE,HPROGRAM_ORIG=HPROGRAM_ORIG)
-END IF
-#endif
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_ADD2TRANSFER_LIST','called for '//TRIM(YFILEM))
-IF (TPFILE%LMASTER) THEN
- if (tpfile%cformat == 'LFI' .or. tpfile%cformat == 'LFICDF4') call io_close_file_lfi(tpfile,iresp)
-#if defined(MNH_IOCDF4)
- if (tpfile%cformat == 'NETCDF4' .or. tpfile%cformat == 'LFICDF4') call io_close_file_nc4(tpfile,iresp)
-#endif
- IF (IRESP == 0 .AND. CPROGRAM/='LFICDF') THEN
- !! Write in pipe
+IF (TPFILE%LMASTER .AND. CPROGRAM/='LFICDF') THEN
+ !! Write in pipe
#if defined(MNH_SX5)
- YTRANS='nectransfer.x'
+ YTRANS='nectransfer.x'
#else
- YTRANS='xtransfer.x'
+ YTRANS='xtransfer.x'
#endif
- IFITYP = TPFILE%NLFITYPE
- SELECT CASE (IFITYP)
- CASE(:-1)
- IRESP=-66
- GOTO 500
+ SELECT CASE (TPFILE%NLFITYPE)
+ CASE(:-1,3:)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_ADD2TRANSFER_LIST',TRIM(YFILEM)//': incorrect NLFITYPE')
CASE(0)
YCPIO='NIL'
CASE(1)
YCPIO='MESONH'
CASE(2)
- CALL PRINT_MSG(NVERB_INFO,'IO','FMCLOS_ll','file '//TRIM(YFILEM)//' not transferred')
- GOTO 500
- CASE(3:)
- IRESP=-66
- GOTO 500
- END SELECT
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_ADD2TRANSFER_LIST','file '//TRIM(YFILEM)//' not transferred')
+ END SELECT
+
+ if (TPFILE%NLFITYPE==0 .or. TPFILE%NLFITYPE==1) then
ICPT=ICPT+1
- WRITE (YCOMMAND,'(A," ",A," ",A," >> OUTPUT_TRANSFER",I3.3," 2>&1 &")') TRIM(YTRANS),TRIM(YCPIO),TRIM(YFILEM),ICPT
- CALL PRINT_MSG(NVERB_INFO,'IO','FMCLOS_ll','YCOMMAND='//TRIM(YCOMMAND))
+ WRITE (YCOMMAND,'(A," ",A," ",A," >> OUTPUT_TRANSFER",I3.3," 2>&1 &")') YTRANS,YCPIO,TRIM(YFILEM),ICPT
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_ADD2TRANSFER_LIST','YCOMMAND='//TRIM(YCOMMAND))
CALL SYSTEM_MNH(YCOMMAND)
- END IF
+ end if
END IF
-500 CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
-IF (IRESP /= 0) GOTO 1000
-
-CALL CLOSE_ll(TPFILE,IOSTAT=IRESP)
-
-1000 CONTINUE
-
-IF (IRESP.NE.0) THEN
- WRITE(YRESP,"( I0 )") IRESP
- CALL PRINT_MSG(NVERB_ERROR,'IO','FMCLOS_ll',TRIM(YFILEM)//': exit with IRESP='//TRIM(YRESP))
-END IF
-
-KRESP=IRESP
-
-END SUBROUTINE FMCLOS_ll
+end subroutine IO_ADD2TRANSFER_LIST
END MODULE MODE_FM
diff --git a/src/LIB/SURCOUCHE/src/mode_io.f90 b/src/LIB/SURCOUCHE/src/mode_io.f90
index b4f6ba125..1f86e1553 100644
--- a/src/LIB/SURCOUCHE/src/mode_io.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io.f90
@@ -3,32 +3,32 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!! Authors
-!! -------
-!
-! D. Gazen
-! Juan 19/08/2005: bug argument optinonel ACCESS --> YACCESS
-! Juan 22/05/2008: bug mode SPECIFIC in OPEN_ll
-! Juan 05/11/2009: allow JPMAX_UNIT=48 open files
-! J.Escobar 18/10/10 bug with PGI compiler on ADJUSTL
-! P. Wautelet 04/02/2016: bug with DELIM='NONE' and GCC 5.2/5.3
-! D.Gazen : avril 2016 change error message
-! P. Wautelet : may 2016: use netCDF Fortran module
-! P. Wautelet : July 2016: added type OUTBAK
-! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! J. Pianezze 01/08/2016 add LOASIS flag
-! Philippe Wautelet: 13/12/2018: moved some operations to new mode_io_*_nc4 modules
-! Philippe Wautelet: 10/01/2019: bug correction: close correctly Z-split files
-! Philippe Wautelet: 10/01/2019: use NEWUNIT argument of OPEN
-! + move IOFREEFLU and IONEWFLU to mode_io_file_lfi.f90
-! + move management of NNCID and NLFIFLU to the nc4 and lfi subroutines
-! Philippe Wautelet: 10/01/2019: bug: modify some metadata before open calls
-! Philippe Wautelet: 21/01/2019: add LIO_ALLOW_NO_BACKUP and LIO_NO_WRITE to modd_io_ll to allow
-! to disable writes (for bench purposes)
+! Author(s)
+! D. Gazen
+! Modifications:
+! J. Escobar 19/08/2005: bug argument optinonel ACCESS --> YACCESS
+! J. Escobar 22/05/2008: bug mode SPECIFIC in OPEN_ll
+! J. Escobar 05/11/2009: allow JPMAX_UNIT=48 open files
+! J. Escobar 18/10/2010: bug with PGI compiler on ADJUSTL
+! P. Wautelet 04/02/2016: bug with DELIM='NONE' and GCC 5.2/5.3
+! D.Gazen April 2016: change error message
+! P. Wautelet May 2016 : use netCDF Fortran module
+! P. Wautelet July 2016 : added type OUTBAK
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! J. Pianezze 01/08/2016: add LOASIS flag
+! P. Wautelet 13/12/2018: moved some operations to new mode_io_*_nc4 modules
+! P. Wautelet 10/01/2019: bug correction: close correctly Z-split files
+! P. Wautelet 10/01/2019: use NEWUNIT argument of OPEN
+! + move IOFREEFLU and IONEWFLU to mode_io_file_lfi.f90
+! + move management of NNCID and NLFIFLU to the nc4 and lfi subroutines
+! P. Wautelet 10/01/2019: bug: modify some metadata before open calls
+! P. Wautelet 21/01/2019: add LIO_ALLOW_NO_BACKUP and LIO_NO_WRITE to modd_io_ll to allow
+! to disable writes (for bench purposes)
! P. Wautelet 06/02/2019: simplify OPEN_ll and do somme assignments at a more logical place
! P. Wautelet 07/02/2019: remove OPARALLELIO argument from open and close files subroutines
! (nsubfiles_ioz is now determined in IO_FILE_ADD2LIST)
! P. Wautelet 14/02/2019: move UPCASE function to tools.f90
+! P. Wautelet 19/02/2019: simplification/restructuration/cleaning of open/close subroutines (TBCto be continued)
!
!-----------------------------------------------------------------
MODULE MODE_IO_ll
@@ -50,7 +50,7 @@ MODULE MODE_IO_ll
CONTAINS
SUBROUTINE SET_CONFIO_ll()
- USE MODN_CONFIO
+ USE MODN_CONFIO, only: LCDF4, LLFIOUT, LLFIREAD
!Use MODN_CONFIO namelist variables
CALL SET_CONFIO_INTERN_ll(LCDF4, LLFIOUT, LLFIREAD)
@@ -58,6 +58,7 @@ CONTAINS
SUBROUTINE SET_CONFIO_INTERN_ll(OIOCDF4, OLFIOUT, OLFIREAD)
USE MODD_IO_ll, ONLY : LIOCDF4, LLFIOUT, LLFIREAD, LIO_ALLOW_NO_BACKUP, LIO_NO_WRITE
+
LOGICAL, INTENT(IN) :: OIOCDF4, OLFIOUT, OLFIREAD
CALL PRINT_MSG(NVERB_DEBUG,'IO','SET_CONFIO_ll','called')
@@ -91,12 +92,14 @@ CONTAINS
END SUBROUTINE SET_CONFIO_INTERN_ll
SUBROUTINE INITIO_ll()
+ USE MODD_IO_ll, only: CNULLFILE, GSMONOPROC, ISIOP, ISNPROC, ISP, NNULLUNIT
+
USE MODE_MNH_WORLD, ONLY: INIT_NMNH_COMM_WORLD
- USE MODD_IO_ll
- USE MODE_FIELD
+
IMPLICIT NONE
INTEGER :: IERR, IOS
+ character(len=256) :: yioerrmsg
CALL PRINT_MSG(NVERB_DEBUG,'IO','INITIO_ll','called')
@@ -118,27 +121,20 @@ CONTAINS
!! Open /dev/null for GLOBAL mode
#if defined(DEV_NULL)
- OPEN(NEWUNIT=NNULLUNIT,FILE=CNULLFILE ,ACTION='WRITE',IOSTAT=IOS)
+ OPEN(NEWUNIT=NNULLUNIT,FILE=CNULLFILE ,ACTION='WRITE',IOSTAT=IOS, IOMSG=yioerrmsg)
#else
- OPEN(NEWUNIT=NNULLUNIT,STATUS='SCRATCH',ACTION='WRITE',IOSTAT=IOS)
+ OPEN(NEWUNIT=NNULLUNIT,STATUS='SCRATCH',ACTION='WRITE',IOSTAT=IOS, IOMSG=yioerrmsg)
#endif
- IF (IOS > 0) THEN
- CALL PRINT_MSG(NVERB_FATAL,'IO','INITIO_ll','error opening /dev/null')
+ IF (IOS /= 0) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'IO','INITIO_ll','problem opening /dev/null :'//trim(yioerrmsg))
END IF
END SUBROUTINE INITIO_ll
- SUBROUTINE OPEN_ll(&
- TPFILE, &
- IOSTAT, &
- MODE, &
- STATUS, &
- POSITION,&
- DELIM, &
- HPROGRAM_ORIG)
+
+ SUBROUTINE OPEN_ll(TPFILE, KRESP, HMODE, HSTATUS, HPOSITION, HDELIM, HPROGRAM_ORIG)
USE MODD_IO_ll
#if defined(MNH_IOCDF4)
- USE MODD_NETCDF, ONLY:IDCDF_KIND
use mode_io_file_nc4, only: io_create_file_nc4, io_open_file_nc4
#endif
use mode_io_file_lfi, only: io_create_file_lfi, io_open_file_lfi
@@ -146,37 +142,37 @@ CONTAINS
use mode_io_tools, only: io_rank
use mode_tools, only: upcase
- TYPE(TFILEDATA), INTENT(INOUT) :: TPFILE
- INTEGER, INTENT(OUT) :: IOSTAT
- CHARACTER(len=*),INTENT(IN), OPTIONAL :: MODE
- CHARACTER(len=*),INTENT(IN), OPTIONAL :: STATUS
- CHARACTER(len=*),INTENT(IN), OPTIONAL :: POSITION
- CHARACTER(len=*),INTENT(IN), OPTIONAL :: DELIM
- CHARACTER(LEN=*),INTENT(IN), OPTIONAL :: HPROGRAM_ORIG !To emulate a file coming from this program
+ TYPE(TFILEDATA), INTENT(INOUT) :: TPFILE
+ INTEGER, INTENT(OUT) :: KRESP
+ CHARACTER(len=*), OPTIONAL, INTENT(IN) :: HMODE
+ CHARACTER(len=*), OPTIONAL, INTENT(IN) :: HSTATUS
+ CHARACTER(len=*), OPTIONAL, INTENT(IN) :: HPOSITION
+ CHARACTER(len=*), OPTIONAL, INTENT(IN) :: HDELIM
+ CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HPROGRAM_ORIG !To emulate a file coming from this program
!
! local var
!
- CHARACTER(len=5) :: CFILE
- INTEGER :: IFILE, IRANK_PROCIO
- CHARACTER(len=20) :: YSTATUS
- INTEGER :: YRECL
- INTEGER ,PARAMETER :: RECL_DEF = 10000
- CHARACTER(len=20) :: YPOSITION
- CHARACTER(len=20) :: YDELIM
- CHARACTER(len=20) :: YACTION
- CHARACTER(len=20) :: YMODE
- CHARACTER(LEN=256) :: YIOERRMSG
- INTEGER :: IOS,IRESP
- TYPE(TFILEDATA),POINTER :: TZSPLITFILE
+ INTEGER, PARAMETER :: RECL_DEF = 10000
+ !
+ CHARACTER(len=5) :: YFILE
+ CHARACTER(len=20) :: YSTATUS
+ CHARACTER(len=20) :: YPOSITION
+ CHARACTER(len=20) :: YDELIM
+ CHARACTER(len=20) :: YACTION
+ CHARACTER(len=20) :: YMODE
+ CHARACTER(LEN=256) :: YIOERRMSG
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')
+ INTEGER :: IFILE, IRANK_PROCIO
+ INTEGER :: YRECL
+ INTEGER :: IOS, IRESP
+ TYPE(TFILEDATA),POINTER :: TZSPLITFILE
CALL PRINT_MSG(NVERB_DEBUG,'IO','OPEN_ll','opening '//TRIM(TPFILE%CNAME)//' for '//TRIM(TPFILE%CMODE))
IOS = 0
- IF (PRESENT(MODE)) THEN
- YMODE = MODE
+ IF (PRESENT(HMODE)) THEN
+ YMODE = HMODE
YMODE = UPCASE(TRIM(ADJUSTL(YMODE)))
ELSE
YMODE = 'GLOBAL' ! Default Mode
@@ -185,21 +181,21 @@ CONTAINS
YACTION = TPFILE%CMODE
YACTION = UPCASE(TRIM(ADJUSTL(YACTION)))
IF (YACTION /= "READ" .AND. YACTION /= "WRITE") THEN
- IOSTAT = 99
+ KRESP = 99
TPFILE%NLU = -1
CALL PRINT_MSG(NVERB_ERROR,'IO','OPEN_ll','action='//TRIM(YACTION)//' not supported')
RETURN
END IF
IF (.NOT. ANY(YMODE == (/'GLOBAL ','SPECIFIC ', 'IO_ZSPLIT '/))) THEN
- IOSTAT = 99
+ KRESP = 99
TPFILE%NLU = -1
CALL PRINT_MSG(NVERB_ERROR,'IO','OPEN_ll','ymode='//TRIM(YMODE)//' not supported')
RETURN
END IF
- IF (PRESENT(STATUS)) THEN
- YSTATUS=STATUS
+ IF (PRESENT(HSTATUS)) THEN
+ YSTATUS=HSTATUS
ELSE
YSTATUS='UNKNOWN'
ENDIF
@@ -210,13 +206,13 @@ CONTAINS
YRECL = TPFILE%NRECL
END IF
- IF (PRESENT(POSITION)) THEN
- YPOSITION=POSITION
+ IF (PRESENT(HPOSITION)) THEN
+ YPOSITION=HPOSITION
ELSE
YPOSITION='ASIS'
ENDIF
- IF (PRESENT(DELIM)) THEN
- YDELIM=DELIM
+ IF (PRESENT(HDELIM)) THEN
+ YDELIM=HDELIM
ELSE
YDELIM='NONE'
ENDIF
@@ -399,18 +395,18 @@ CONTAINS
END IF
DO IFILE=1,TPFILE%NSUBFILES_IOZ
IRANK_PROCIO = 1 + IO_RANK(IFILE-1,ISNPROC,TPFILE%NSUBFILES_IOZ)
- WRITE(CFILE ,'(".Z",i3.3)') IFILE
+ WRITE(YFILE ,'(".Z",i3.3)') IFILE
- CALL IO_FILE_FIND_BYNAME(TRIM(TPFILE%CNAME)//TRIM(CFILE),TZSPLITFILE,IRESP)
+ CALL IO_FILE_FIND_BYNAME(TRIM(TPFILE%CNAME)//TRIM(YFILE),TZSPLITFILE,IRESP)
IF (IRESP/=0) THEN !File not yet in filelist => add it (nothing to do if already in list)
IF (ALLOCATED(TPFILE%CDIRNAME)) THEN
- CALL IO_FILE_ADD2LIST(TZSPLITFILE,TRIM(TPFILE%CNAME)//TRIM(CFILE),TPFILE%CTYPE,TPFILE%CMODE, &
+ CALL IO_FILE_ADD2LIST(TZSPLITFILE,TRIM(TPFILE%CNAME)//TRIM(YFILE),TPFILE%CTYPE,TPFILE%CMODE, &
HDIRNAME=TPFILE%CDIRNAME, &
KLFINPRAR=TPFILE%NLFINPRAR,KLFITYPE=TPFILE%NLFITYPE,KLFIVERB=TPFILE%NLFIVERB, &
HFORMAT=TPFILE%CFORMAT)
ELSE
- CALL IO_FILE_ADD2LIST(TZSPLITFILE,TRIM(TPFILE%CNAME)//TRIM(CFILE),TPFILE%CTYPE,TPFILE%CMODE, &
+ CALL IO_FILE_ADD2LIST(TZSPLITFILE,TRIM(TPFILE%CNAME)//TRIM(YFILE),TPFILE%CTYPE,TPFILE%CMODE, &
KLFINPRAR=TPFILE%NLFINPRAR,KLFITYPE=TPFILE%NLFITYPE,KLFIVERB=TPFILE%NLFIVERB, &
HFORMAT=TPFILE%CFORMAT)
END IF
@@ -471,7 +467,7 @@ CONTAINS
TPFILE%NMPICOMM = NMNH_COMM_WORLD
- IOSTAT = IOS
+ KRESP = IOS
CONTAINS
FUNCTION SUFFIX(HEXT)
@@ -485,30 +481,19 @@ CONTAINS
END SUBROUTINE OPEN_ll
- SUBROUTINE CLOSE_ll(TPFILE,IOSTAT,HPROGRAM_ORIG)
- USE MODD_IO_ll
- USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_FIND_BYNAME
- use mode_io_file_lfi, only: io_close_file_lfi
-#if defined(MNH_IOCDF4)
- use mode_io_file_nc4, only: io_close_file_nc4
- use mode_io_write_nc4, only: io_write_coordvar_nc4
-#endif
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- INTEGER, INTENT(OUT), OPTIONAL :: IOSTAT
- CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HPROGRAM_ORIG !To emulate a file coming from this program
+ SUBROUTINE CLOSE_ll(TPFILE,KRESP)
+ USE MODD_IO_ll
+
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ INTEGER, INTENT(OUT) :: KRESP
character(len=256) :: yioerrmsg
- INTEGER :: IERR, IGLOBALERR, IGLOBALERR2, IRESP, IRESP2
- INTEGER :: IFILE
- TYPE(TFILEDATA),POINTER :: TZFILE
+ INTEGER :: IRESP
CALL PRINT_MSG(NVERB_DEBUG,'IO','CLOSE_ll','closing '//TRIM(TPFILE%CNAME))
IRESP = 0
- IRESP2 = 0
- IGLOBALERR = 0
- IGLOBALERR2 = 0
IF (TPFILE%LMASTER) THEN
IF (TPFILE%NLU/=-1 .AND. TPFILE%NLU/=NNULLUNIT) THEN
@@ -519,37 +504,10 @@ CONTAINS
!Warning and not error or fatal if close fails to allow continuation of execution
IF (IRESP/=0) CALL PRINT_MSG(NVERB_WARNING,'IO','CLOSE_ll','Problem when closing '//TRIM(TPFILE%CNAME)//': '//TRIM(YIOERRMSG))
- DO IFILE=1,TPFILE%NSUBFILES_IOZ
- TZFILE => TPFILE%TFILES_IOZ(IFILE)%TFILE
-#if defined(MNH_IOCDF4)
- !Write coordinates variables in netCDF file
- IF (TZFILE%CMODE == 'WRITE' .AND. (TZFILE%CFORMAT=='NETCDF4' .OR. TZFILE%CFORMAT=='LFICDF4')) THEN
- CALL IO_WRITE_COORDVAR_NC4(TZFILE,HPROGRAM_ORIG=HPROGRAM_ORIG)
- END IF
-#endif
- IF (TZFILE%LMASTER) THEN
- if (tzfile%cformat == 'LFI' .or. tzfile%cformat == 'LFICDF4') call io_close_file_lfi(tzfile,iresp2)
-#if defined(MNH_IOCDF4)
- if (tzfile%cformat == 'NETCDF4' .or. tzfile%cformat == 'LFICDF4') call io_close_file_nc4(tzfile,iresp2)
-#endif
- END IF
- END DO
- !
- IF (TPFILE%NSUBFILES_IOZ>0) CALL MPI_ALLREDUCE(IRESP2,IGLOBALERR2,1,MPI_INTEGER,MPI_BOR,TPFILE%NMPICOMM,IERR)
- !
- CALL MPI_ALLREDUCE(IRESP, IGLOBALERR, 1,MPI_INTEGER,MPI_BOR,TPFILE%NMPICOMM,IERR)
-
- IF (PRESENT(IOSTAT)) THEN
- IF (IGLOBALERR/=0) THEN
- IOSTAT = IGLOBALERR
- ELSE
- IOSTAT = IGLOBALERR2
- END IF
- END IF
+ KRESP = IRESP
END SUBROUTINE CLOSE_ll
- !
- !
+
END MODULE MODE_IO_ll
--
GitLab