Skip to content
Snippets Groups Projects
Commit 2e4b4288 authored by WAUTELET Philippe's avatar WAUTELET Philippe
Browse files

Philippe 19/02/2019: IO: simplification/restructuration/cleaning of open/close... 

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

Documentation | Mentions légales | CGU | Accessibilité : non conforme