From 170d0ea0091a39343c1fd11c3fbbe3810a1f1d70 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Thu, 13 Dec 2018 17:11:15 +0100
Subject: [PATCH] Philippe 13/12/2018: split mode_netcdf module into multiple
modules + add new subroutines to check if a file has been closed correctly
This is done: *to reduce circular dependencies problems *to have cleaner code
*to compile faster *to detect problems with not correctly closed netCDF files
---
LIBTOOLS/tools/lfi2cdf/src/mode_util.f90 | 8 +-
src/LIB/SURCOUCHE/src/fmread_ll.f90 | 4 +-
src/LIB/SURCOUCHE/src/fmwrit_ll.f90 | 10 +-
src/LIB/SURCOUCHE/src/mode_fm.f90 | 165 +-
src/LIB/SURCOUCHE/src/mode_io.f90 | 132 +-
src/LIB/SURCOUCHE/src/mode_io_file_nc4.f90 | 223 ++
src/LIB/SURCOUCHE/src/mode_io_read_nc4.f90 | 1272 +++++++
src/LIB/SURCOUCHE/src/mode_io_tools.f90 | 167 +
src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90 | 679 ++++
...{mode_netcdf.f90 => mode_io_write_nc4.f90} | 3186 ++++-------------
src/MNH/modeln.f90 | 1 -
11 files changed, 3115 insertions(+), 2732 deletions(-)
create mode 100644 src/LIB/SURCOUCHE/src/mode_io_file_nc4.f90
create mode 100644 src/LIB/SURCOUCHE/src/mode_io_read_nc4.f90
create mode 100644 src/LIB/SURCOUCHE/src/mode_io_tools.f90
create mode 100644 src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90
rename src/LIB/SURCOUCHE/src/{mode_netcdf.f90 => mode_io_write_nc4.f90} (50%)
diff --git a/LIBTOOLS/tools/lfi2cdf/src/mode_util.f90 b/LIBTOOLS/tools/lfi2cdf/src/mode_util.f90
index e30ba71e1..0f55191e7 100644
--- a/LIBTOOLS/tools/lfi2cdf/src/mode_util.f90
+++ b/LIBTOOLS/tools/lfi2cdf/src/mode_util.f90
@@ -56,7 +56,7 @@ CONTAINS
USE MODD_DIM_n, ONLY: NIMAX_ll, NJMAX_ll, NKMAX
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT, NGRIDUNKNOWN
- USE MODE_NETCDF, ONLY: IO_GUESS_DIMIDS_NC4
+ use mode_io_tools_nc4, only: io_guess_dimids_nc4
TYPE(TFILE_ELT),DIMENSION(:), INTENT(IN) :: infiles
TYPE(TFILE_ELT),DIMENSION(:), INTENT(IN) :: outfiles
@@ -620,7 +620,7 @@ END DO
SUBROUTINE def_ncdf(infiles,outfiles,KNFILES_OUT)
USE MODD_CONF, ONLY: NMNHVERSION
- USE MODE_NETCDF, ONLY: IO_WRITE_HEADER_NC4
+ use mode_io_write_nc4, only: io_write_header_nc4
TYPE(TFILE_ELT),DIMENSION(:),INTENT(IN) :: infiles
TYPE(TFILE_ELT),DIMENSION(:),INTENT(IN) :: outfiles
@@ -1263,8 +1263,8 @@ END DO
SUBROUTINE IO_FILL_DIMS_NC4(TPFILE,TPREC,KRESP)
- USE MODD_IO_ll, ONLY: TFILEDATA
- USE MODE_NETCDF, ONLY: GETDIMCDF, IO_FIND_DIM_BYNAME_NC4
+ USE MODD_IO_ll, ONLY: TFILEDATA
+ use mode_io_tools_nc4, only: getdimcdf, io_find_dim_byname_nc4
TYPE(TFILEDATA),INTENT(IN) :: TPFILE
TYPE(workfield),INTENT(INOUT) :: TPREC
diff --git a/src/LIB/SURCOUCHE/src/fmread_ll.f90 b/src/LIB/SURCOUCHE/src/fmread_ll.f90
index 9a9a10420..047a96080 100644
--- a/src/LIB/SURCOUCHE/src/fmread_ll.f90
+++ b/src/LIB/SURCOUCHE/src/fmread_ll.f90
@@ -25,7 +25,7 @@ USE MODD_MPIF
!
USE MODE_FIELD
#if defined(MNH_IOCDF4)
-USE MODE_NETCDF
+USE MODE_IO_READ_NC4
#endif
USE MODE_MSG
USE MODE_READWRITE_LFI
@@ -499,7 +499,7 @@ USE MODE_ALLOCBUFFER_ll
#ifdef MNH_GA
USE MODE_GA
#endif
-USE MODE_IO_ll, ONLY : IO_FILE
+USE MODE_IO_TOOLS, ONLY : IO_FILE
USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_FIND_BYNAME
USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
USE MODE_SCATTER_ll
diff --git a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90 b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
index 3c96575e5..d679b4915 100644
--- a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
+++ b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
@@ -166,7 +166,7 @@ MODULE MODE_FMWRIT
USE MODE_FIELD
#if defined(MNH_IOCDF4)
- USE MODE_NETCDF
+ USE MODE_IO_WRITE_NC4
#endif
USE MODE_READWRITE_LFI
@@ -795,7 +795,7 @@ CONTAINS
!
USE MODE_ALLOCBUFFER_ll
USE MODE_GATHER_ll
- USE MODE_IO_ll, ONLY : IO_FILE
+ USE MODE_IO_TOOLS, ONLY : IO_FILE
USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_FIND_BYNAME
USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
#ifdef MNH_GA
@@ -1150,7 +1150,7 @@ CONTAINS
!
USE MODE_ALLOCBUFFER_ll
USE MODE_GATHER_ll
- USE MODE_IO_ll, ONLY : IO_FILE,IO_RANK
+ USE MODE_IO_TOOLS, ONLY : IO_FILE,IO_RANK
USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
!
@@ -1288,7 +1288,7 @@ CONTAINS
!
USE MODE_ALLOCBUFFER_ll
USE MODE_GATHER_ll
- USE MODE_IO_ll, ONLY : IO_FILE,IO_RANK
+ USE MODE_IO_TOOLS, ONLY : IO_FILE,IO_RANK
USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
!
@@ -1426,7 +1426,7 @@ CONTAINS
!
USE MODE_ALLOCBUFFER_ll
USE MODE_GATHER_ll
- USE MODE_IO_ll, ONLY : IO_FILE,IO_RANK
+ USE MODE_IO_TOOLS, ONLY : IO_FILE,IO_RANK
USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
!
diff --git a/src/LIB/SURCOUCHE/src/mode_fm.f90 b/src/LIB/SURCOUCHE/src/mode_fm.f90
index 1c1a1813d..3f65f8482 100644
--- a/src/LIB/SURCOUCHE/src/mode_fm.f90
+++ b/src/LIB/SURCOUCHE/src/mode_fm.f90
@@ -8,6 +8,7 @@
! 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
!-----------------------------------------------------------------
MODULE MODE_FM
@@ -45,9 +46,8 @@ END SUBROUTINE SET_FMPACK_ll
SUBROUTINE IO_FILE_OPEN_ll(TPFILE,KRESP,OPARALLELIO,HPOSITION,HSTATUS,HPROGRAM_ORIG)
!
-USE MODD_CONF, ONLY: CPROGRAM, NMNHVERSION
+USE MODD_CONF, ONLY: CPROGRAM
USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEINT
USE MODE_FMREAD
USE MODE_IO_ll, ONLY : OPEN_ll
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST,IO_FILE_FIND_BYNAME
@@ -59,11 +59,7 @@ 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,IRESP2
-INTEGER :: IMASDEV,IBUGFIX
-INTEGER,DIMENSION(3) :: IMNHVERSION
-CHARACTER(LEN=12) :: YMNHVERSION_FILE,YMNHVERSION_CURR
-TYPE(TFIELDDATA) :: TZFIELD
+INTEGER :: IRESP
TYPE(TFILEDATA),POINTER :: TZFILE_DES
TYPE(TFILEDATA),POINTER :: TZFILE_DUMMY
!
@@ -152,91 +148,23 @@ SELECT CASE(TPFILE%CTYPE)
ENDIF
!
CALL FMOPEN_ll(TPFILE,IRESP,OPARALLELIO=OPARALLELIO,HPROGRAM_ORIG=HPROGRAM_ORIG)
- !
- !Compare MNHVERSION of file with current version and store it in file metadata
- 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
- TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPFILE,TZFIELD,IMNHVERSION,IRESP2)
- IF (IRESP2/=0) THEN
- TZFIELD%CMNHNAME = 'MASDEV'
- TZFIELD%CLONGNAME = 'MesoNH version (without bugfix)'
- TZFIELD%NDIMS = 0
- 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
- IF (IMASDEV<100) THEN
- IMNHVERSION(1)=IMASDEV/10
- IMNHVERSION(2)=MOD(IMASDEV,10)
- ELSE !for example for MNH 4.10
- IMNHVERSION(1)=IMASDEV/100
- IMNHVERSION(2)=MOD(IMASDEV,100)
- 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))
- ELSE
- IMNHVERSION(3)=IBUGFIX
- 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
- !
- TPFILE%NMNHVERSION(:) = IMNHVERSION(:)
- END IF
+
END SELECT
!
-IF (TRIM(TPFILE%CMODE) == 'WRITE') TPFILE%NMNHVERSION(:) = NMNHVERSION(:)
-!
IF (PRESENT(KRESP)) KRESP = IRESP
!
END SUBROUTINE IO_FILE_OPEN_ll
SUBROUTINE FMOPEN_ll(TPFILE,KRESP,OPARALLELIO,HPROGRAM_ORIG)
-USE MODD_IO_ll, ONLY : ISTDOUT,TFILEDATA
-USE MODE_IO_ll, ONLY : OPEN_ll,GCONFIO,IOFREEFLU,IONEWFLU
+USE MODD_IO_ll, ONLY: ISTDOUT,TFILEDATA
+USE MODE_IO_ll, ONLY: OPEN_ll,GCONFIO,IOFREEFLU,IONEWFLU
+use mode_io_tools, only: io_get_mnhversion,io_set_mnhversion
!JUANZ
USE MODD_CONFZ,ONLY : NB_PROCIO_R,NB_PROCIO_W
!JUANZ
#if defined(MNH_IOCDF4)
USE MODD_NETCDF, ONLY:IDCDF_KIND
-USE MODE_NETCDF
+use mode_io_file_nc4, only: io_create_file_nc4, io_open_file_nc4
#endif
TYPE(TFILEDATA), INTENT(INOUT) :: TPFILE ! File structure
INTEGER, INTENT(OUT) :: KRESP ! return-code
@@ -263,9 +191,6 @@ INTEGER :: INB_PROCIO
!JUAN
LOGICAL :: GPARALLELIO
LOGICAL :: GEXIST_LFI, GEXIST_NC4
-#if defined(MNH_IOCDF4)
-INTEGER(KIND=IDCDF_KIND) :: INCERR
-#endif
YACTION = TPFILE%CMODE
@@ -382,37 +307,22 @@ IF (TPFILE%LMASTER) THEN
END IF
END SELECT
END IF
+END IF
#if defined(MNH_IOCDF4)
- IF (TPFILE%CFORMAT=='NETCDF4' .OR. TPFILE%CFORMAT=='LFICDF4') THEN
- IF (YACTION == 'READ') THEN
- !! Open NetCDF File for reading
- TPFILE%TNCDIMS => NEWIOCDF()
- CALL PRINT_MSG(NVERB_DEBUG,'IO','FMOPEN_ll','NF90_OPEN for '//TRIM(YFILEM)//'.nc')
- INCERR = NF90_OPEN(ADJUSTL(TRIM(YFILEM))//".nc", NF90_NOWRITE, TPFILE%NNCID)
- IF (INCERR /= NF90_NOERR) THEN
- CALL PRINT_MSG(NVERB_FATAL,'IO','FMOPEN_ll','NF90_OPEN for '//TRIM(YFILEM)//'.nc: '//NF90_STRERROR(INCERR))
- END IF
- INCERR = NF90_INQUIRE(TPFILE%NNCID,NVARIABLES=TPFILE%NNCNAR)
- IF (INCERR /= NF90_NOERR) THEN
- CALL PRINT_MSG(NVERB_FATAL,'IO','FMOPEN_ll','NF90_INQUIRE for '//TRIM(YFILEM)//'.nc: '//NF90_STRERROR(INCERR))
- END IF
- END IF
-
- IF (YACTION == 'WRITE') THEN
- TPFILE%TNCDIMS => NEWIOCDF()
- CALL PRINT_MSG(NVERB_DEBUG,'IO','FMOPEN_ll','NF90_CREATE for '//TRIM(YFILEM)//'.nc')
- INCERR = NF90_CREATE(ADJUSTL(TRIM(YFILEM))//".nc", &
- &IOR(NF90_CLOBBER,NF90_NETCDF4), TPFILE%NNCID)
- IF (INCERR /= NF90_NOERR) THEN
- CALL PRINT_MSG(NVERB_FATAL,'IO','FMOPEN_ll','NF90_CREATE for '//TRIM(YFILEM)//'.nc: '//NF90_STRERROR(INCERR))
- END IF
- CALL IO_SET_KNOWNDIMS_NC4(TPFILE,HPROGRAM_ORIG=HPROGRAM_ORIG)
- END IF
- END IF
+IF (TPFILE%CFORMAT=='NETCDF4' .OR. TPFILE%CFORMAT=='LFICDF4') THEN
+ IF (YACTION == 'READ') THEN
+ call io_open_file_nc4(tpfile)
+ END IF
+
+ IF (YACTION == 'WRITE') THEN
+ call io_create_file_nc4(TPFILE, hprogram_orig=HPROGRAM_ORIG)
+ END IF
+END IF
#endif
-
- IF (TPFILE%CFORMAT=='LFI' .OR. TPFILE%CFORMAT=='LFICDF4') THEN
+
+IF (TPFILE%CFORMAT=='LFI' .OR. TPFILE%CFORMAT=='LFICDF4') THEN
+ IF (TPFILE%LMASTER) THEN
! LFI Case
IRESOU = 0
GNAMFI = .TRUE.
@@ -441,19 +351,23 @@ IF (TPFILE%LMASTER) THEN
INPRAR, &
ININAR)
TPFILE%NLFININAR = ININAR
- IF (IRESOU /= 0 ) THEN
+ IF (IRESOU /= 0 ) THEN
IRESP = IRESOU
ENDIF
+ !
+ !* 6. TEST IF FILE IS NEWLY DEFINED
+ !
+ GNEWFI=(ININAR==0).OR.(IMELEV<2)
+ IF (.NOT.GNEWFI) THEN
+ WRITE (ISTDOUT,*) ' file ',TRIM(YFILEM)//'.lfi',' previously created with LFI'
+ ENDIF
END IF
-
- !
- !* 6. TEST IF FILE IS NEWLY DEFINED
- !
-
- GNEWFI=(ININAR==0).OR.(IMELEV<2)
- IF (.NOT.GNEWFI) THEN
- WRITE (ISTDOUT,*) ' file ',TRIM(YFILEM)//'.lfi',' previously created with LFI'
- ENDIF
+ SELECT CASE (YACTION)
+ CASE('READ')
+ call io_get_mnhversion(tpfile)
+ CASE('WRITE')
+ call io_set_mnhversion(tpfile)
+ END SELECT
END IF
! Broadcast ERROR
@@ -625,7 +539,8 @@ USE MODE_IO_ll, ONLY : CLOSE_ll,UPCASE
USE MODI_SYSTEM_MNH
#endif
#if defined(MNH_IOCDF4)
-USE MODE_NETCDF
+ 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 ! File structure
CHARACTER(LEN=*), INTENT(IN) :: HSTATU ! status for the closed file
@@ -693,11 +608,7 @@ IF (TPFILE%LMASTER) THEN
#if defined(MNH_IOCDF4)
IF (TPFILE%NNCID/=-1) THEN
! Close Netcdf File
- IRESP = NF90_CLOSE(TPFILE%NNCID)
- IF (IRESP /= NF90_NOERR) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','FMCLOS_ll','NF90_CLOSE error: '//TRIM(NF90_STRERROR(IRESP)))
- END IF
- IF (ASSOCIATED(TPFILE%TNCDIMS)) CALL CLEANIOCDF(TPFILE%TNCDIMS)
+ call io_close_file_nc4(tpfile,iresp)
END IF
#endif
IF (IRESP == 0 .AND. CPROGRAM/='LFICDF') THEN
diff --git a/src/LIB/SURCOUCHE/src/mode_io.f90 b/src/LIB/SURCOUCHE/src/mode_io.f90
index 8c2277c3c..94a226353 100644
--- a/src/LIB/SURCOUCHE/src/mode_io.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io.f90
@@ -1,6 +1,6 @@
!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
!! Authors
@@ -13,10 +13,11 @@
! 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 : 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
!
MODULE MODE_IO_ll
@@ -42,7 +43,6 @@ MODULE MODE_IO_ll
PUBLIC IOFREEFLU,IONEWFLU,UPCASE,INITIO_ll,OPEN_ll,CLOSE_ll
PUBLIC SET_CONFIO_ll,GCONFIO
- PUBLIC io_file,IO_RANK
CONTAINS
@@ -72,9 +72,9 @@ CONTAINS
END FUNCTION IONEWFLU
SUBROUTINE IOFREEFLU(KOFLU)
-
+
INTEGER :: KOFLU
-
+
IF ((KOFLU .GE. JPRESERVED_UNIT) .AND. (KOFLU .LE. JPMAX_UNIT_NUMBER )) THEN
GALLOC(KOFLU) = .FALSE.
ELSE
@@ -204,11 +204,13 @@ CONTAINS
HPROGRAM_ORIG)
#if defined(MNH_IOCDF4)
- USE MODD_NETCDF, ONLY:IDCDF_KIND
- USE MODE_NETCDF
+ USE MODD_NETCDF, ONLY:IDCDF_KIND
+ use mode_io_file_nc4, only: io_create_file_nc4, io_open_file_nc4
#endif
USE MODD_IO_ll
+
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST, IO_FILE_FIND_BYNAME
+ use mode_io_tools, only: io_rank, io_get_mnhversion,io_set_mnhversion
TYPE(TFILEDATA), INTENT(INOUT) :: TPFILE
CHARACTER(len=*),INTENT(IN), OPTIONAL :: MODE
@@ -253,7 +255,6 @@ CONTAINS
CHARACTER(len=20) :: YMODE
CHARACTER(LEN=256) :: YIOERRMSG
INTEGER :: IOS,IERR,IRESP
- INTEGER(KIND=IDCDF_KIND) :: IOSCDF
INTEGER :: ICOMM
INTEGER :: ICMPRES
! didier
@@ -638,7 +639,7 @@ CONTAINS
#endif
TPFILE%NLFIFLU = IONEWFLU()
ELSE
- !! NON I/O processors OR NetCDF read case
+ !! NON I/O processors OR netCDF read case
IOS = 0
TPFILE%NLFIFLU = -1
END IF
@@ -686,45 +687,23 @@ CONTAINS
TZSPLITFILE%LMULTIMASTERS = .FALSE.
TZSPLITFILE%NSUBFILES_IOZ = 0
- IF ( TZSPLITFILE%LMASTER ) THEN
-#if defined(MNH_IOCDF4)
- IF (TZSPLITFILE%CFORMAT=='NETCDF4' .OR. TZSPLITFILE%CFORMAT=='LFICDF4') THEN
- IF (YACTION == 'READ') THEN
- ! Open NetCDF File for reading
- TZSPLITFILE%TNCDIMS => NEWIOCDF()
- CALL PRINT_MSG(NVERB_DEBUG,'IO','OPEN_ll','NF90_OPEN(IO_ZSPLIT) for '//TRIM(TZSPLITFILE%CNAME)//'.nc')
- IOSCDF = NF90_OPEN(TRIM(YPREFILENAME)//".nc", NF90_NOWRITE, TZSPLITFILE%NNCID)
- IF (IOSCDF /= NF90_NOERR) THEN
- CALL PRINT_MSG(NVERB_FATAL,'IO','OPEN_ll','NF90_OPEN for '//TRIM(TZSPLITFILE%CNAME)//'.nc: '// &
- NF90_STRERROR(IOSCDF))
- ELSE
- IOS = 0
- END IF
- IOSCDF = NF90_INQUIRE(TZSPLITFILE%NNCID,NVARIABLES=TZSPLITFILE%NNCNAR)
- IF (IOSCDF /= NF90_NOERR) THEN
- CALL PRINT_MSG(NVERB_FATAL,'IO','OPEN_ll','NF90_INQUIRE for '//TRIM(TZSPLITFILE%CNAME)//'.nc: ' &
- //NF90_STRERROR(IOSCDF))
- END IF
- END IF
-
- IF (YACTION == 'WRITE') THEN
- ! YACTION == 'WRITE'
- ! Create NetCDF File for writing
- TZSPLITFILE%TNCDIMS => NEWIOCDF()
- CALL PRINT_MSG(NVERB_DEBUG,'IO','OPEN_ll','NF90_CREATE(IO_ZSPLIT) for '//TRIM(TZSPLITFILE%CNAME)//'.nc')
- IOSCDF = NF90_CREATE(TRIM(YPREFILENAME)//".nc", &
- &IOR(NF90_CLOBBER,NF90_NETCDF4), TZSPLITFILE%NNCID)
- IF (IOSCDF /= NF90_NOERR) THEN
- CALL PRINT_MSG(NVERB_FATAL,'IO','OPEN_ll','NF90_CREATE for '//TRIM(TZSPLITFILE%CNAME)//'.nc: '// &
- NF90_STRERROR(IOSCDF))
- ELSE
- IOS = 0
- END IF
- CALL IO_SET_KNOWNDIMS_NC4(TZSPLITFILE,HPROGRAM_ORIG=HPROGRAM_ORIG)
- END IF
+#if defined(MNH_IOCDF4)
+ IF (TZSPLITFILE%CFORMAT=='NETCDF4' .OR. TZSPLITFILE%CFORMAT=='LFICDF4') THEN
+ IF (YACTION == 'READ') THEN
+ ! Open netCDF File for reading
+ call io_open_file_nc4(tzsplitfile)
+ IOS = 0
+ END IF
+
+ IF (YACTION == 'WRITE') THEN
+ ! Create netCDF File for writing
+ call io_create_file_nc4(TZSPLITFILE, hprogram_orig=HPROGRAM_ORIG)
+ IOS = 0
END IF
+ END IF
#endif
- IF (TZSPLITFILE%CFORMAT=='LFI' .OR. TZSPLITFILE%CFORMAT=='LFICDF4') THEN
+ IF (TZSPLITFILE%CFORMAT=='LFI' .OR. TZSPLITFILE%CFORMAT=='LFICDF4') THEN
+ IF ( TZSPLITFILE%LMASTER ) THEN
! LFI case
! Open LFI File for reading
!this proc must write on this file open it ...
@@ -762,6 +741,13 @@ CONTAINS
ININAR8)
TZSPLITFILE%NLFININAR = ININAR8
END IF
+ !
+ SELECT CASE (YACTION)
+ CASE('READ')
+ call io_get_mnhversion(tpfile)
+ CASE('WRITE')
+ call io_set_mnhversion(tpfile)
+ END SELECT
ENDIF
!
TZSPLITFILE%LOPENED = .TRUE.
@@ -794,7 +780,8 @@ CONTAINS
USE MODD_IO_ll
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_FIND_BYNAME
#if defined(MNH_IOCDF4)
- USE MODE_NETCDF
+ 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
@@ -841,7 +828,7 @@ CONTAINS
DO IFILE=1,TPFILE%NSUBFILES_IOZ
TZFILE => TPFILE%TFILES_IOZ(IFILE)%TFILE
#if defined(MNH_IOCDF4)
- !Write coordinates variables in NetCDF file
+ !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
@@ -855,11 +842,7 @@ CONTAINS
#if defined(MNH_IOCDF4)
IF (TZFILE%NNCID/=-1) THEN
! Close Netcdf File
- IRESP = NF90_CLOSE(TZFILE%NNCID)
- IF (IRESP /= NF90_NOERR) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','CLOSE_ll','NF90_CLOSE error: '//TRIM(NF90_STRERROR(IRESP)))
- END IF
- IF (ASSOCIATED(TZFILE%TNCDIMS)) CALL CLEANIOCDF(TZFILE%TNCDIMS)
+ call io_close_file_nc4(tzfile)
END IF
#endif
END IF
@@ -879,49 +862,6 @@ CONTAINS
END IF
END SUBROUTINE CLOSE_ll
-
- FUNCTION io_file(k,nb_proc_io)
- !
- ! return the file number where to write the K level of data
- !
- IMPLICIT NONE
- INTEGER(kind=MNH_MPI_RANK_KIND) :: k,nb_proc_io
- INTEGER(kind=MNH_MPI_RANK_KIND) :: io_file
-
- io_file = MOD ((k-1) , nb_proc_io )
-
- END FUNCTION io_file
-
- FUNCTION IO_RANK(IFILE,nb_proc,nb_proc_io,offset_rank)
- !
- ! return the proc number which must write the 'IFILE' file
- !
- IMPLICIT NONE
- INTEGER(kind=MNH_MPI_RANK_KIND) :: IFILE,nb_proc,nb_proc_io
- INTEGER(kind=MNH_MPI_RANK_KIND),OPTIONAL :: offset_rank
-
- INTEGER(kind=MNH_MPI_RANK_KIND) :: IO_RANK
-
- INTEGER(kind=MNH_MPI_RANK_KIND) :: ipas,irest
-
- ipas = nb_proc / nb_proc_io
- irest = MOD ( nb_proc , nb_proc_io )
-
- IF (ipas /= 0 ) THEN
- IO_RANK=ipas * IFILE + MIN(IFILE , irest )
- ELSE
- IO_RANK=MOD(IFILE , nb_proc )
- ENDIF
-
- !
- ! optional rank to shift for read test
- !
- IF (PRESENT(offset_rank)) THEN
- IF ( offset_rank .GT.0 ) IO_RANK=MOD(IO_RANK+offset_rank,nb_proc)
- IF ( offset_rank .LT.0 ) IO_RANK=MOD(nb_proc-IO_RANK+offset_rank,nb_proc)
- ENDIF
-
- END FUNCTION IO_RANK
!
!
END MODULE MODE_IO_ll
diff --git a/src/LIB/SURCOUCHE/src/mode_io_file_nc4.f90 b/src/LIB/SURCOUCHE/src/mode_io_file_nc4.f90
new file mode 100644
index 000000000..f12b09bbf
--- /dev/null
+++ b/src/LIB/SURCOUCHE/src/mode_io_file_nc4.f90
@@ -0,0 +1,223 @@
+!MNH_LIC Copyright 2018-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Author: P. Wautelet 13/12/2018
+!
+! Remarks: some of the code comes from mode_fm.f90 and mode_io.f90
+! (was duplicated in the 2 files)
+!
+! Modifications:
+!
+!-----------------------------------------------------------------
+#if defined(MNH_IOCDF4)
+module mode_io_file_nc4
+
+use modd_io_ll, only: tfiledata
+use modd_netcdf, only: idcdf_kind
+
+use mode_io_tools_nc4, only: handle_err, io_set_knowndims_nc4, newiocdf
+use mode_msg
+
+use NETCDF, only: NF90_CLOBBER, NF90_GLOBAL, NF90_NETCDF4, NF90_NOERR, NF90_NOWRITE, &
+ NF90_CLOSE, NF90_CREATE, NF90_GET_ATT, NF90_INQUIRE, NF90_INQUIRE_ATTRIBUTE, &
+ NF90_OPEN, NF90_PUT_ATT, NF90_STRERROR
+
+implicit none
+
+private
+
+public :: io_create_file_nc4, io_close_file_nc4, io_open_file_nc4
+
+contains
+
+subroutine io_create_file_nc4(tpfile,hprogram_orig)
+ use mode_io_tools, only: io_set_mnhversion
+
+ type(tfiledata), intent(inout) :: tpfile
+ character(len=*),optional, intent(in) :: hprogram_orig !to emulate a file coming from this program
+
+ character(len=:),allocatable :: yfilem ! name of the file
+ integer(kind=idcdf_kind) :: istatus
+
+ if (tpfile%lmaster) then
+ if (allocated(tpfile%cdirname)) then
+ if(len_trim(tpfile%cdirname)>0) then
+ yfilem = trim(tpfile%cdirname)//'/'//trim(tpfile%cname)
+ else
+ yfilem = trim(tpfile%cname)
+ end if
+ else
+ yfilem = trim(tpfile%cname)
+ end if
+
+ tpfile%tncdims => newiocdf()
+ call print_msg(NVERB_DEBUG, 'IO', 'io_create_file_nc4', 'NF90_CREATE for '//trim(yfilem)//'.nc')
+ istatus = NF90_CREATE(adjustl(trim(yfilem))//".nc", ior(NF90_CLOBBER,NF90_NETCDF4), tpfile%nncid)
+ if (istatus /= NF90_NOERR) then
+ call print_msg(NVERB_FATAL,'IO','io_create_file_nc4','NF90_CREATE for '//trim(yfilem)//'.nc: '//NF90_STRERROR(istatus))
+ end if
+ call io_set_not_cleanly_closed_nc4(tpfile)
+ call io_set_mnhversion(tpfile)
+ call io_set_knowndims_nc4(tpfile, hprogram_orig=hprogram_orig)
+ end if
+end subroutine io_create_file_nc4
+
+
+subroutine io_close_file_nc4(tpfile,kstatus)
+ use mode_io_tools_nc4, only: cleaniocdf
+
+ type(tfiledata), intent(in) :: tpfile
+ integer(kind=idcdf_kind), optional, intent(out) :: kstatus
+
+ integer(kind=idcdf_kind) :: istatus
+
+ call print_msg(NVERB_DEBUG,'IO','io_close_file_nc4','called for '//trim(tpfile%cname))
+
+ istatus = 0
+
+ if (tpfile%lmaster) then
+ if (trim(tpfile%cmode) == 'WRITE') call io_set_cleanly_closed_nc4(tpfile)
+ istatus = NF90_CLOSE(tpfile%nncid)
+ if (istatus /= NF90_NOERR) then
+ call print_msg(NVERB_WARNING, 'IO', 'io_close_file_nc4', 'NF90_CLOSE error: '//trim(NF90_STRERROR(istatus)))
+ end if
+ if (associated(tpfile%tncdims)) call cleaniocdf(tpfile%tncdims)
+ end if
+
+ if (present(kstatus)) kstatus = istatus
+end subroutine io_close_file_nc4
+
+
+subroutine io_open_file_nc4(tpfile)
+ use mode_io_tools, only: io_get_mnhversion
+
+ type(tfiledata), intent(inout) :: tpfile
+
+ character(len=:),allocatable :: yfilem ! name of the file
+ integer(kind=idcdf_kind) :: istatus
+
+ if (tpfile%lmaster) then
+ if (allocated(tpfile%cdirname)) then
+ if(len_trim(tpfile%cdirname)>0) then
+ yfilem = trim(tpfile%cdirname)//'/'//trim(tpfile%cname)
+ else
+ yfilem = trim(tpfile%cname)
+ end if
+ else
+ yfilem = trim(tpfile%cname)
+ end if
+
+ tpfile%tncdims => newiocdf()
+ call print_msg(NVERB_DEBUG,'IO','io_open_file_nc4','NF90_OPEN for '//trim(yfilem)//'.nc')
+ istatus = NF90_OPEN(adjustl(trim(yfilem))//".nc", NF90_NOWRITE, tpfile%nncid)
+ if (istatus /= NF90_NOERR) then
+ call print_msg(NVERB_FATAL, 'IO', 'io_open_file_nc4', 'NF90_OPEN for '//trim(yfilem)//'.nc: '//NF90_STRERROR(istatus))
+ end if
+
+ istatus = NF90_INQUIRE(tpfile%nncid, nvariables=tpfile%nncnar)
+ if (istatus /= NF90_NOERR) then
+ call print_msg(NVERB_FATAL,'IO','io_open_file_nc4','NF90_INQUIRE for '//trim(yfilem)//'.nc: '//NF90_STRERROR(istatus))
+ end if
+ end if
+
+ if (trim(tpfile%cmode) == 'READ') then
+ call io_get_mnhversion(tpfile)
+ if (tpfile%lmaster) call io_check_cleanly_closed_nc4(tpfile)
+ end if
+
+end subroutine io_open_file_nc4
+
+
+subroutine io_check_cleanly_closed_nc4(tpfile)
+ type(tfiledata), intent(in) :: tpfile
+
+ character(len=:), allocatable :: yclean
+ integer(kind=IDCDF_KIND) :: ilen, istatus
+ integer, dimension(3) :: imnhversion
+
+ call print_msg(NVERB_DEBUG,'IO','io_check_cleanly_closed_nc4','called for '//trim(tpfile%cname))
+
+ imnhversion = tpfile%nmnhversion
+ if ( imnhversion(1)<5 .OR. &
+ (imnhversion(1)==5 .AND. imnhversion(2)<4) .OR. &
+ (imnhversion(1)==5 .AND. imnhversion(2)==4 .AND. imnhversion(3)<2) ) then
+ call print_msg(NVERB_DEBUG,'IO','io_check_cleanly_closed_nc4', &
+ 'file '//trim(tpfile%cname)//' is too old (before MNH 5.4.2) to check if cleanly closed')
+ return
+ end if
+
+ istatus = NF90_INQUIRE_ATTRIBUTE(tpfile%nncid, NF90_GLOBAL, 'MNH_cleanly_closed', len = ilen)
+ if (istatus /= NF90_NOERR) then
+ call print_msg(NVERB_ERROR,'IO','io_check_cleanly_closed_nc4', &
+ 'MNH_cleanly_closed attribute not found in file '//trim(tpfile%cname))
+ else
+ allocate( character(len=ilen) :: yclean )
+ istatus = NF90_GET_ATT(tpfile%nncid, NF90_GLOBAL, 'MNH_cleanly_closed', yclean)
+ if (istatus /= NF90_NOERR) then
+ call print_msg(NVERB_WARNING,'IO','io_check_cleanly_closed_nc4', &
+ 'MNH_cleanly_closed attribute not found in file '//trim(tpfile%cname))
+ else
+ if (yclean == 'yes') then
+ call print_msg(NVERB_DEBUG,'IO','io_check_cleanly_closed_nc4', &
+ 'file '//trim(tpfile%cname)//' was cleanly closed before opening')
+ else if (yclean == 'no') then
+ call print_msg(NVERB_ERROR,'IO','io_check_cleanly_closed_nc4', &
+ 'file '//trim(tpfile%cname)//' was not cleanly closed before opening')
+ else
+ call print_msg(NVERB_ERROR,'IO','io_check_cleanly_closed_nc4', &
+ 'invalid MNH_cleanly_closed attribute for file '//trim(tpfile%cname))
+ end if
+ end if
+ end if
+end subroutine io_check_cleanly_closed_nc4
+
+
+subroutine io_set_cleanly_closed_nc4(tpfile)
+ type(tfiledata), intent(in) :: tpfile
+
+ integer(kind=IDCDF_KIND) :: istatus
+
+ call print_msg(NVERB_DEBUG,'IO','io_set_cleanly_closed_nc4','called for '//trim(tpfile%cname))
+
+ istatus = NF90_PUT_ATT(tpfile%nncid, NF90_GLOBAL, 'MNH_cleanly_closed', 'yes')
+ if (istatus /= NF90_NOERR) call handle_err(istatus,__LINE__,'io_set_cleanly_closed_nc4[NF90_PUT_ATT]')
+end subroutine io_set_cleanly_closed_nc4
+
+
+subroutine io_set_not_cleanly_closed_nc4(tpfile)
+ type(tfiledata), intent(in) :: tpfile
+
+ integer(kind=IDCDF_KIND) :: istatus
+
+ call print_msg(NVERB_DEBUG,'IO','io_set_not_cleanly_closed_nc4','called for '//trim(tpfile%cname))
+
+ istatus = NF90_PUT_ATT(tpfile%nncid, NF90_GLOBAL, 'MNH_cleanly_closed', 'no')
+ if (istatus /= NF90_NOERR) call handle_err(istatus,__LINE__,'io_set_not_cleanly_closed_nc4[NF90_PUT_ATT]')
+end subroutine io_set_not_cleanly_closed_nc4
+
+end module mode_io_file_nc4
+#else
+!
+! External dummy subroutines
+!
+subroutine io_create_file_nc4(a, b)
+use mode_msg
+integer :: a, b
+CALL PRINT_MSG(NVERB_ERROR,'IO','io_create_file_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine io_create_file_nc4
+!
+subroutine io_close_file_nc4(a)
+use mode_msg
+integer :: a
+CALL PRINT_MSG(NVERB_ERROR,'IO','io_close_file_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine io_close_file_nc4
+!
+subroutine io_open_file_nc4(a)
+use mode_msg
+integer :: a
+CALL PRINT_MSG(NVERB_ERROR,'IO','io_open_file_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine io_open_file_nc4
+!
+#endif
diff --git a/src/LIB/SURCOUCHE/src/mode_io_read_nc4.f90 b/src/LIB/SURCOUCHE/src/mode_io_read_nc4.f90
new file mode 100644
index 000000000..8176017be
--- /dev/null
+++ b/src/LIB/SURCOUCHE/src/mode_io_read_nc4.f90
@@ -0,0 +1,1272 @@
+!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet : may 2016 : use NetCDF Fortran module
+! J.Escobar : 14/12/2017 : Correction for MNH_INT=8
+! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet : 13/12/2018 : split of mode_netcdf into multiple modules/files
+!-----------------------------------------------------------------
+#if defined(MNH_IOCDF4)
+module mode_io_read_nc4
+
+use modd_io_ll, only: tfiledata
+use modd_netcdf, only: idcdf_kind
+
+use mode_field, only: tfielddata
+use mode_io_tools_nc4, only: cleanmnhname, handle_err
+use mode_msg
+
+use NETCDF, only: NF90_CHAR, NF90_DOUBLE, NF90_FLOAT, NF90_INT, NF90_INT1, NF90_INT64, &
+ NF90_MAX_VAR_DIMS, NF90_NOERR, &
+ NF90_GET_ATT, NF90_GET_VAR, NF90_INQ_VARID, &
+ NF90_INQUIRE_ATTRIBUTE, NF90_INQUIRE_DIMENSION, NF90_INQUIRE_VARIABLE
+
+implicit none
+
+private
+
+public :: io_read_field_nc4
+
+INTERFACE IO_READ_FIELD_NC4
+ MODULE PROCEDURE IO_READ_FIELD_NC4_X0,IO_READ_FIELD_NC4_X1, &
+ IO_READ_FIELD_NC4_X2,IO_READ_FIELD_NC4_X3, &
+ IO_READ_FIELD_NC4_X4,IO_READ_FIELD_NC4_X5, &
+ IO_READ_FIELD_NC4_X6, &
+ IO_READ_FIELD_NC4_N0,IO_READ_FIELD_NC4_N1, &
+ IO_READ_FIELD_NC4_N2, &
+ IO_READ_FIELD_NC4_L0,IO_READ_FIELD_NC4_L1, &
+ IO_READ_FIELD_NC4_C0, &
+ IO_READ_FIELD_NC4_T0
+END INTERFACE IO_READ_FIELD_NC4
+
+contains
+
+SUBROUTINE IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,KVARID,KRESP,HCALENDAR)
+!
+USE MODD_PARAMETERS, ONLY: NGRIDUNKNOWN
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+INTEGER(KIND=IDCDF_KIND), INTENT(IN) :: KVARID
+INTEGER, INTENT(OUT) :: KRESP ! return-code
+CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: HCALENDAR
+!
+INTEGER :: IERRLEVEL
+INTEGER :: ILEN
+INTEGER :: IGRID
+INTEGER(KIND=IDCDF_KIND) :: INCID
+INTEGER(KIND=IDCDF_KIND) :: STATUS
+CHARACTER(LEN=12) :: YVAL_FILE, YVAL_MEM
+CHARACTER(LEN=:),ALLOCATABLE :: YVALUE
+LOGICAL :: GOLDMNH !if old version of MesoNH (<5.4, old files without complete and correct metadata)
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)//': called for field '//TRIM(TPFIELD%CMNHNAME))
+!
+KRESP = 0
+INCID = TPFILE%NNCID
+!
+GOLDMNH = TPFILE%NMNHVERSION(1)<5 .OR. (TPFILE%NMNHVERSION(1)==5 .AND. TPFILE%NMNHVERSION(2)<4)
+!
+IF (GOLDMNH) THEN !Set a lower level of error if file comes from an old MesoNH version
+ IERRLEVEL = NVERB_WARNING
+ELSE
+ IERRLEVEL = NVERB_ERROR
+END IF
+!
+! GRID
+!
+STATUS = NF90_GET_ATT(INCID,KVARID,'grid',IGRID)
+IF (STATUS /= NF90_NOERR) STATUS = NF90_GET_ATT(INCID,KVARID,'GRID',IGRID)
+IF (STATUS == NF90_NOERR) THEN
+ IF (IGRID/=TPFIELD%NGRID) THEN
+ WRITE(YVAL_FILE,'(I12)') IGRID
+ WRITE(YVAL_MEM, '(I12)') TPFIELD%NGRID
+ CALL PRINT_MSG(IERRLEVEL,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ ': expected GRID value ('//TRIM(ADJUSTL(YVAL_MEM))// &
+ ') is different than found in file ('//TRIM(ADJUSTL(YVAL_FILE))//') for variable '//TRIM(TPFIELD%CMNHNAME))
+ IF (.NOT.GOLDMNH) THEN !Do not modify probably incorrect grid number (to prevent problems later with other correct files)
+ TPFIELD%NGRID = IGRID
+ KRESP = -111 !Used later to broadcast modified metadata
+ END IF
+ ELSE
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ ': expected GRID found in file for field '//TRIM(TPFIELD%CMNHNAME))
+ ENDIF
+ELSE !no GRID
+ IF (TPFIELD%NGRID==0 .OR. TPFIELD%NGRID==NGRIDUNKNOWN) THEN
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ ': no GRID (as expected) in file for field '//TRIM(TPFIELD%CMNHNAME))
+ ELSE
+ CALL PRINT_MSG(IERRLEVEL,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ ': expected GRID but not found in file for field '//TRIM(TPFIELD%CMNHNAME))
+ END IF
+ENDIF
+!
+! COMMENT
+!
+STATUS = NF90_INQUIRE_ATTRIBUTE(INCID, KVARID, 'comment', LEN=ILEN)
+IF (STATUS == NF90_NOERR) THEN
+ ALLOCATE(CHARACTER(LEN=ILEN) :: YVALUE)
+ STATUS = NF90_GET_ATT(INCID, KVARID, 'comment', YVALUE)
+ IF (LEN_TRIM(TPFIELD%CCOMMENT)==0 .AND. LEN_TRIM(YVALUE)>0) THEN
+ !Expected comment is empty, read comment is not
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ ': COMMENT found (unexpected) in file for field '//TRIM(TPFIELD%CMNHNAME))
+ TPFIELD%CCOMMENT=TRIM(YVALUE)
+ ELSE IF (TRIM(YVALUE)/=TRIM(TPFIELD%CCOMMENT)) THEN
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ ': expected COMMENT ('//TRIM(TPFIELD%CCOMMENT)// &
+ ') is different than found ('//TRIM(YVALUE)//') in file for field '//TRIM(TPFIELD%CMNHNAME))
+ TPFIELD%CCOMMENT=TRIM(YVALUE)
+ KRESP = -111 !Used later to broadcast modified metadata
+ ELSE
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ ': expected COMMENT found in file for field '//TRIM(TPFIELD%CMNHNAME))
+ END IF
+ DEALLOCATE(YVALUE)
+ELSE !no COMMENT
+ IF (LEN_TRIM(TPFIELD%CCOMMENT)==0) THEN
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ ': no COMMENT (as expected) in file for field '//TRIM(TPFIELD%CMNHNAME))
+ ELSE
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ ': expected COMMENT but not found in file for field '//TRIM(TPFIELD%CMNHNAME))
+ END IF
+END IF
+!
+! STDNAME
+!
+STATUS = NF90_INQUIRE_ATTRIBUTE(INCID, KVARID, 'standard_name', LEN=ILEN)
+IF (STATUS == NF90_NOERR) THEN
+ ALLOCATE(CHARACTER(LEN=ILEN) :: YVALUE)
+ STATUS = NF90_GET_ATT(INCID, KVARID, 'standard_name', YVALUE)
+ IF (TRIM(YVALUE)/=TRIM(TPFIELD%CSTDNAME)) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ ': expected STDNAME ('//TRIM(TPFIELD%CSTDNAME)// &
+ ') is different than found ('//TRIM(YVALUE)//') in file for field '//TRIM(TPFIELD%CMNHNAME))
+ TPFIELD%CSTDNAME=TRIM(YVALUE)
+ KRESP = -111 !Used later to broadcast modified metadata
+ ELSE
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ ': expected STDNAME found in file for field '//TRIM(TPFIELD%CMNHNAME))
+ END IF
+ DEALLOCATE(YVALUE)
+ELSE !no STDNAME
+ IF (LEN_TRIM(TPFIELD%CSTDNAME)==0) THEN
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ ': no STDNAME (as expected) in file for field '//TRIM(TPFIELD%CMNHNAME))
+ ELSE
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ ': expected STDNAME but not found in file for field '//TRIM(TPFIELD%CMNHNAME))
+ END IF
+END IF
+!
+! LONGNAME
+!
+STATUS = NF90_INQUIRE_ATTRIBUTE(INCID, KVARID, 'long_name', LEN=ILEN)
+IF (STATUS == NF90_NOERR) THEN
+ ALLOCATE(CHARACTER(LEN=ILEN) :: YVALUE)
+ STATUS = NF90_GET_ATT(INCID, KVARID, 'long_name', YVALUE)
+ IF (TRIM(YVALUE)/=TRIM(TPFIELD%CLONGNAME)) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ ': expected LONGNAME ('//TRIM(TPFIELD%CLONGNAME)// &
+ ') is different than found ('//TRIM(YVALUE)//') in file for field '//TRIM(TPFIELD%CMNHNAME))
+ TPFIELD%CLONGNAME=TRIM(YVALUE)
+ KRESP = -111 !Used later to broadcast modified metadata
+ ELSE
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ ': expected LONGNAME found in file for field '//TRIM(TPFIELD%CMNHNAME))
+ END IF
+ DEALLOCATE(YVALUE)
+ELSE !no LONGNAME
+ IF (LEN_TRIM(TPFIELD%CLONGNAME)==0) THEN
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ ': no LONGNAME (as expected) in file for field '//TRIM(TPFIELD%CMNHNAME))
+ ELSE
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ ': expected LONGNAME but not found in file for field '//TRIM(TPFIELD%CMNHNAME))
+ END IF
+END IF
+!
+! UNITS
+!
+STATUS = NF90_INQUIRE_ATTRIBUTE(INCID, KVARID, 'units', LEN=ILEN)
+IF (STATUS == NF90_NOERR) THEN
+ ALLOCATE(CHARACTER(LEN=ILEN) :: YVALUE)
+ STATUS = NF90_GET_ATT(INCID, KVARID, 'units', YVALUE)
+ IF (TRIM(YVALUE)/=TRIM(TPFIELD%CUNITS)) THEN
+ IF(.NOT.PRESENT(HCALENDAR)) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ ': expected UNITS ('//TRIM(TPFIELD%CUNITS)// &
+ ') is different than found ('//TRIM(YVALUE)//') in file for field '//TRIM(TPFIELD%CMNHNAME))
+ KRESP = -111 !Used later to broadcast modified metadata
+ ELSE
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ ': UNITS found in file for field '//TRIM(TPFIELD%CMNHNAME)//' (will be analysed later)')
+ END IF
+ TPFIELD%CUNITS=TRIM(YVALUE)
+ ELSE
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ ': expected UNITS found in file for field '//TRIM(TPFIELD%CMNHNAME))
+ END IF
+ DEALLOCATE(YVALUE)
+ELSE !no UNITS
+ IF (LEN_TRIM(TPFIELD%CUNITS)==0) THEN
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ ': no UNITS (as expected) in file for field '//TRIM(TPFIELD%CMNHNAME))
+ ELSE
+ IF(.NOT.PRESENT(HCALENDAR)) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ ': expected UNITS but not found in file for field '//TRIM(TPFIELD%CMNHNAME))
+ ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ ': expected UNITS but not found in file for field '//TRIM(TPFIELD%CMNHNAME))
+ KRESP = -3
+ END IF
+ END IF
+END IF
+!
+! CALENDAR
+!
+IF(PRESENT(HCALENDAR)) THEN
+STATUS = NF90_INQUIRE_ATTRIBUTE(INCID, KVARID, 'calendar', LEN=ILEN)
+IF (STATUS == NF90_NOERR) THEN
+ ALLOCATE(CHARACTER(LEN=ILEN) :: YVALUE)
+ STATUS = NF90_GET_ATT(INCID, KVARID, 'calendar', YVALUE)
+ IF (TRIM(YVALUE)/=TRIM(HCALENDAR)) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ ': expected CALENDAR ('//TRIM(HCALENDAR)// &
+ ') is different than found ('//TRIM(YVALUE)//') in file for field '//TRIM(TPFIELD%CMNHNAME))
+ ELSE
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ ': expected CALENDAR found in file for field '//TRIM(TPFIELD%CMNHNAME))
+ END IF
+ DEALLOCATE(YVALUE)
+ELSE !no CALENDAR
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ ': expected CALENDAR but not found in file for field '//TRIM(TPFIELD%CMNHNAME))
+END IF
+ENDIF
+!
+END SUBROUTINE IO_READ_CHECK_FIELD_ATTR_NC4
+
+
+SUBROUTINE IO_READ_FIELD_NC4_X0(TPFILE, TPFIELD, PFIELD, KRESP)
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+REAL, INTENT(OUT) :: PFIELD
+INTEGER, INTENT(OUT) :: KRESP ! return-code
+
+INTEGER(KIND=IDCDF_KIND) :: STATUS
+INTEGER(KIND=IDCDF_KIND) :: INCID
+INTEGER(KIND=IDCDF_KIND) :: IVARID
+INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
+INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER :: IRESP
+
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_X0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+
+IRESP = 0
+! Get the Netcdf file ID
+INCID = TPFILE%NNCID
+
+CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+
+! Get variable ID, NDIMS and TYPE
+STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X0[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+END IF
+STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS)
+IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_X0[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
+
+!Neglect the time dimension (of size 1)
+IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
+
+IF (IDIMS == 0 .AND. (ITYPE == NF90_FLOAT .OR. ITYPE == NF90_DOUBLE) ) THEN
+ ! Read variable
+ STATUS = NF90_GET_VAR(INCID, IVARID, PFIELD)
+ IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X0[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+ END IF
+ ! Read and check attributes of variable
+ CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong size or type)')
+ IRESP = -3
+END IF
+
+1000 CONTINUE
+KRESP = IRESP
+
+END SUBROUTINE IO_READ_FIELD_NC4_X0
+
+
+SUBROUTINE IO_READ_FIELD_NC4_X1(TPFILE, TPFIELD, PFIELD, KRESP)
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+REAL,DIMENSION(:),INTENT(OUT) :: PFIELD
+INTEGER, INTENT(OUT) :: KRESP ! return-code
+
+INTEGER(KIND=IDCDF_KIND) :: STATUS
+INTEGER(KIND=IDCDF_KIND) :: INCID
+INTEGER(KIND=IDCDF_KIND) :: IVARID
+INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
+INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
+INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
+INTEGER :: IRESP
+
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_X1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+
+IRESP = 0
+! Get the Netcdf file ID
+INCID = TPFILE%NNCID
+
+CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+
+! Get variable ID, NDIMS and TYPE
+STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X1[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+END IF
+STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
+IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_X1[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
+
+!Neglect the time dimension (of size 1)
+IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
+
+IF (IDIMS == 1 .AND. (ITYPE == NF90_FLOAT .OR. ITYPE == NF90_DOUBLE) ) THEN
+ ! Check size of variable before reading
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN)
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X1[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+
+ IF (IDIMLEN == SIZE(PFIELD)) THEN
+ ! Read variable
+ STATUS = NF90_GET_VAR(INCID, IVARID, PFIELD)
+ IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X1[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+ END IF
+ ! Read and check attributes of variable
+ CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong size)')
+ IRESP = -3
+ END IF
+ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong number of dimensions or wrong type)')
+ IRESP = -3
+END IF
+
+1000 CONTINUE
+KRESP = IRESP
+
+END SUBROUTINE IO_READ_FIELD_NC4_X1
+
+
+SUBROUTINE IO_READ_FIELD_NC4_X2(TPFILE, TPFIELD, PFIELD, KRESP)
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+REAL,DIMENSION(:,:),INTENT(OUT) :: PFIELD
+INTEGER, INTENT(OUT) :: KRESP ! return-code
+
+INTEGER(KIND=IDCDF_KIND) :: STATUS
+INTEGER(KIND=IDCDF_KIND) :: INCID
+INTEGER(KIND=IDCDF_KIND) :: IVARID
+INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
+INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
+INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER(KIND=IDCDF_KIND),DIMENSION(3) :: IDIMLEN
+INTEGER :: IRESP
+
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_X2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+
+IRESP = 0
+! Get the Netcdf file ID
+INCID = TPFILE%NNCID
+
+CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+
+! Get variable ID, NDIMS and TYPE
+STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X2[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+END IF
+STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
+IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_X2[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
+
+!Neglect the time dimension (of size 1)
+IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
+
+!Treat special case of a degenerated 3D array (3rd dimension size is 1)
+IF (IDIMS==3) THEN
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X2[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+ IF (IDIMLEN(3)==1) THEN
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_FIELD_NC4_X2',TRIM(TPFILE%CNAME)// &
+ ': reading 3D array with degenerated third dimension in 2D array for '//TRIM(YVARNAME))
+ IDIMS = 2
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_READ_FIELD_NC4_X2',TRIM(TPFILE%CNAME)//': wrong number of dimensions for '//TRIM(YVARNAME))
+ END IF
+END IF
+
+IF (IDIMS == 2 .AND. (ITYPE == NF90_FLOAT .OR. ITYPE == NF90_DOUBLE) ) THEN
+ ! Check size of variable before reading
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X2[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X2[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+
+ IF (IDIMLEN(1) == SIZE(PFIELD,1) .AND. IDIMLEN(2) == SIZE(PFIELD,2)) THEN
+ ! Read variable
+ STATUS = NF90_GET_VAR(INCID, IVARID, PFIELD)
+ IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X2[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+ END IF
+ ! Read and check attributes of variable
+ CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X2',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong size)')
+ IRESP = -3
+ END IF
+ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X2',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong number of dimensions or wrong type)')
+ IRESP = -3
+END IF
+
+1000 CONTINUE
+KRESP = IRESP
+
+END SUBROUTINE IO_READ_FIELD_NC4_X2
+
+
+SUBROUTINE IO_READ_FIELD_NC4_X3(TPFILE, TPFIELD, PFIELD, KRESP)
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+REAL,DIMENSION(:,:,:),INTENT(OUT) :: PFIELD
+INTEGER, INTENT(OUT) :: KRESP ! return-code
+
+INTEGER(KIND=IDCDF_KIND) :: STATUS
+INTEGER(KIND=IDCDF_KIND) :: INCID
+INTEGER(KIND=IDCDF_KIND) :: IVARID
+INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
+INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
+INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
+INTEGER(KIND=IDCDF_KIND),DIMENSION(3) :: IDIMLEN
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER :: IRESP
+
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_X3',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+
+IRESP = 0
+! Get the Netcdf file ID
+INCID = TPFILE%NNCID
+
+CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+
+! Get variable ID, NDIMS and TYPE
+STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X3[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+END IF
+STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
+IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_X3[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
+
+!Neglect the time dimension (of size 1)
+IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
+
+IF (IDIMS == 3 .AND. (ITYPE == NF90_FLOAT .OR. ITYPE == NF90_DOUBLE) ) THEN
+ ! Check size of variable before reading
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X3[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X3[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X3[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+
+ IF (IDIMLEN(1) == SIZE(PFIELD,1) .AND. IDIMLEN(2) == SIZE(PFIELD,2) .AND. IDIMLEN(3) == SIZE(PFIELD,3)) THEN
+ ! Read variable
+ STATUS = NF90_GET_VAR(INCID, IVARID, PFIELD)
+ IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X3[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+ END IF
+ ! Read and check attributes of variable
+ CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X3',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong size)')
+ IRESP = -3
+ END IF
+ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X3',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong number of dimensions or wrong type)')
+ IRESP = -3
+END IF
+
+1000 CONTINUE
+KRESP = IRESP
+
+END SUBROUTINE IO_READ_FIELD_NC4_X3
+
+
+SUBROUTINE IO_READ_FIELD_NC4_X4(TPFILE, TPFIELD, PFIELD, KRESP)
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+REAL,DIMENSION(:,:,:,:),INTENT(OUT) :: PFIELD
+INTEGER, INTENT(OUT) :: KRESP ! return-code
+
+INTEGER(KIND=IDCDF_KIND) :: STATUS
+INTEGER(KIND=IDCDF_KIND) :: INCID
+INTEGER(KIND=IDCDF_KIND) :: IVARID
+INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
+INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
+INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
+INTEGER(KIND=IDCDF_KIND),DIMENSION(4) :: IDIMLEN
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER :: IRESP
+
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_X4',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+
+IRESP = 0
+! Get the Netcdf file ID
+INCID = TPFILE%NNCID
+
+CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+
+! Get variable ID, NDIMS and TYPE
+STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X4[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+END IF
+STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
+IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_X4[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
+
+!Neglect the time dimension (of size 1)
+IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
+
+IF (IDIMS == 4 .AND. (ITYPE == NF90_FLOAT .OR. ITYPE == NF90_DOUBLE) ) THEN
+ ! Check size of variable before reading
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X4[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X4[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X4[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(4), LEN=IDIMLEN(4))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X4[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+
+ IF ( IDIMLEN(1) == SIZE(PFIELD,1) .AND. IDIMLEN(2) == SIZE(PFIELD,2) .AND. &
+ IDIMLEN(3) == SIZE(PFIELD,3) .AND. IDIMLEN(4) == SIZE(PFIELD,4)) THEN
+ ! Read variable
+ STATUS = NF90_GET_VAR(INCID, IVARID, PFIELD)
+ IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X4[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+ END IF
+ ! Read and check attributes of variable
+ CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X4',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong size)')
+ IRESP = -3
+ END IF
+ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X4',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong number of dimensions or wrong type)')
+ IRESP = -3
+END IF
+
+1000 CONTINUE
+KRESP = IRESP
+
+END SUBROUTINE IO_READ_FIELD_NC4_X4
+
+
+SUBROUTINE IO_READ_FIELD_NC4_X5(TPFILE, TPFIELD, PFIELD, KRESP)
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+REAL,DIMENSION(:,:,:,:,:),INTENT(OUT) :: PFIELD
+INTEGER, INTENT(OUT) :: KRESP ! return-code
+
+INTEGER(KIND=IDCDF_KIND) :: STATUS
+INTEGER(KIND=IDCDF_KIND) :: INCID
+INTEGER(KIND=IDCDF_KIND) :: IVARID
+INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
+INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
+INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
+INTEGER(KIND=IDCDF_KIND),DIMENSION(5) :: IDIMLEN
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER :: IRESP
+
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_X5',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+
+IRESP = 0
+! Get the Netcdf file ID
+INCID = TPFILE%NNCID
+
+CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+
+! Get variable ID, NDIMS and TYPE
+STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X5[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+END IF
+STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
+IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_X5[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
+
+!Neglect the time dimension (of size 1)
+IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
+
+IF (IDIMS == 5 .AND. (ITYPE == NF90_FLOAT .OR. ITYPE == NF90_DOUBLE) ) THEN
+ ! Check size of variable before reading
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X5[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X5[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X5[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(4), LEN=IDIMLEN(4))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X5[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(5), LEN=IDIMLEN(5))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X5[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+
+ IF ( IDIMLEN(1) == SIZE(PFIELD,1) .AND. IDIMLEN(2) == SIZE(PFIELD,2) .AND. &
+ IDIMLEN(3) == SIZE(PFIELD,3) .AND. IDIMLEN(4) == SIZE(PFIELD,4) .AND. &
+ IDIMLEN(5) == SIZE(PFIELD,5) ) THEN
+ ! Read variable
+ STATUS = NF90_GET_VAR(INCID, IVARID, PFIELD)
+ IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X5[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+ END IF
+ ! Read and check attributes of variable
+ CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X5',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong size)')
+ IRESP = -3
+ END IF
+ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X5',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong number of dimensions or wrong type)')
+ IRESP = -3
+END IF
+
+1000 CONTINUE
+KRESP = IRESP
+
+END SUBROUTINE IO_READ_FIELD_NC4_X5
+
+
+SUBROUTINE IO_READ_FIELD_NC4_X6(TPFILE, TPFIELD, PFIELD, KRESP)
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+REAL,DIMENSION(:,:,:,:,:,:),INTENT(OUT) :: PFIELD
+INTEGER, INTENT(OUT) :: KRESP ! return-code
+
+INTEGER(KIND=IDCDF_KIND) :: STATUS
+INTEGER(KIND=IDCDF_KIND) :: INCID
+INTEGER(KIND=IDCDF_KIND) :: IVARID
+INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
+INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
+INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
+INTEGER(KIND=IDCDF_KIND),DIMENSION(6) :: IDIMLEN
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER :: IRESP
+
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_X6',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+
+IRESP = 0
+! Get the Netcdf file ID
+INCID = TPFILE%NNCID
+
+CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+
+! Get variable ID, NDIMS and TYPE
+STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X6[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+END IF
+STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
+IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_X6[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
+
+!Neglect the time dimension (of size 1)
+IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
+
+IF (IDIMS == 6 .AND. (ITYPE == NF90_FLOAT .OR. ITYPE == NF90_DOUBLE) ) THEN
+ ! Check size of variable before reading
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X6[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X6[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X6[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(4), LEN=IDIMLEN(4))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X6[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(5), LEN=IDIMLEN(5))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X6[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(6), LEN=IDIMLEN(6))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X6[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+
+ IF ( IDIMLEN(1) == SIZE(PFIELD,1) .AND. IDIMLEN(2) == SIZE(PFIELD,2) .AND. &
+ IDIMLEN(3) == SIZE(PFIELD,3) .AND. IDIMLEN(4) == SIZE(PFIELD,4) .AND. &
+ IDIMLEN(5) == SIZE(PFIELD,5) .AND. IDIMLEN(6) == SIZE(PFIELD,6) ) THEN
+ ! Read variable
+ STATUS = NF90_GET_VAR(INCID, IVARID, PFIELD)
+ IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X6[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+ END IF
+ ! Read and check attributes of variable
+ CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X6',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong size)')
+ IRESP = -3
+ END IF
+ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X6',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong number of dimensions or wrong type)')
+ IRESP = -3
+END IF
+
+1000 CONTINUE
+KRESP = IRESP
+
+END SUBROUTINE IO_READ_FIELD_NC4_X6
+
+
+SUBROUTINE IO_READ_FIELD_NC4_N0(TPFILE, TPFIELD, KFIELD, KRESP)
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+INTEGER, INTENT(OUT) :: KFIELD
+INTEGER, INTENT(OUT) :: KRESP ! return-code
+
+INTEGER(KIND=IDCDF_KIND) :: STATUS
+INTEGER(KIND=IDCDF_KIND) :: INCID
+INTEGER(KIND=IDCDF_KIND) :: IVARID
+INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
+INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER :: IRESP
+
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_N0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+
+IRESP = 0
+! Get the Netcdf file ID
+INCID = TPFILE%NNCID
+
+CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+
+! Get variable ID, NDIMS and TYPE
+STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_N0[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+END IF
+STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS)
+IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_N0[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
+
+!Neglect the time dimension (of size 1)
+IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
+
+!Can read either 4 or 8 byte integers
+IF (IDIMS == 0 .AND. (ITYPE == NF90_INT .OR. ITYPE == NF90_INT64) ) THEN
+ ! Read variable
+ STATUS = NF90_GET_VAR(INCID, IVARID, KFIELD)
+ IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_N0[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+ END IF
+ ! Read and check attributes of variable
+ CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_N0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong size or type)')
+ IRESP = -3
+END IF
+
+1000 CONTINUE
+KRESP = IRESP
+
+END SUBROUTINE IO_READ_FIELD_NC4_N0
+
+
+SUBROUTINE IO_READ_FIELD_NC4_N1(TPFILE, TPFIELD, KFIELD, KRESP)
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+INTEGER, DIMENSION(:), INTENT(OUT) :: KFIELD
+INTEGER, INTENT(OUT) :: KRESP ! return-code
+
+INTEGER(KIND=IDCDF_KIND) :: STATUS
+INTEGER(KIND=IDCDF_KIND) :: INCID
+INTEGER(KIND=IDCDF_KIND) :: IVARID
+INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
+INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
+INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
+INTEGER :: IRESP
+
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_N1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+
+IRESP = 0
+! Get the Netcdf file ID
+INCID = TPFILE%NNCID
+
+CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+
+! Get variable ID, NDIMS and TYPE
+STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_N1[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+END IF
+STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
+IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_N1[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
+
+!Neglect the time dimension (of size 1)
+IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
+
+!NF90_INT1 is for the case a boolean was written
+IF (IDIMS == 1 .AND. (ITYPE == NF90_INT .OR. ITYPE == NF90_INT64 .OR. ITYPE == NF90_INT1) ) THEN
+ ! Check size of variable before reading
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN)
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_N1[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+
+ IF (IDIMLEN == SIZE(KFIELD)) THEN
+ ! Read variable
+ STATUS = NF90_GET_VAR(INCID, IVARID, KFIELD)
+ IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_N1[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+ END IF
+ ! Read and check attributes of variable
+ CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_N1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong size)')
+ IRESP = -3
+ END IF
+ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_N1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong number of dimensions or wrong type)')
+ IRESP = -3
+END IF
+
+1000 CONTINUE
+KRESP = IRESP
+
+END SUBROUTINE IO_READ_FIELD_NC4_N1
+
+
+SUBROUTINE IO_READ_FIELD_NC4_N2(TPFILE, TPFIELD, KFIELD, KRESP)
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+INTEGER, DIMENSION(:,:), INTENT(OUT) :: KFIELD
+INTEGER, INTENT(OUT) :: KRESP ! return-code
+
+INTEGER(KIND=IDCDF_KIND) :: STATUS
+INTEGER(KIND=IDCDF_KIND) :: INCID
+INTEGER(KIND=IDCDF_KIND) :: IVARID
+INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
+INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
+INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER(KIND=IDCDF_KIND),DIMENSION(3) :: IDIMLEN
+INTEGER :: IRESP
+
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_N2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+
+IRESP = 0
+! Get the Netcdf file ID
+INCID = TPFILE%NNCID
+
+CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+
+! Get variable ID, NDIMS and TYPE
+STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_N2[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+END IF
+STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
+IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_N2[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
+
+!Neglect the time dimension (of size 1)
+IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
+
+!Treat special case of a degenerated 3D array (3rd dimension size is 1)
+IF (IDIMS==3) THEN
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_N2[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+ IF (IDIMLEN(3)==1) THEN
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_FIELD_NC4_N2',TRIM(TPFILE%CNAME)// &
+ ': reading 3D array with degenerated third dimension in 2D array for '//TRIM(YVARNAME))
+ IDIMS = 2
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_READ_FIELD_NC4_N2',TRIM(TPFILE%CNAME)//': wrong number of dimensions for '//TRIM(YVARNAME))
+ END IF
+END IF
+
+!NF90_INT1 is for the case a boolean was written
+IF (IDIMS == SIZE(SHAPE(KFIELD)) .AND. (ITYPE == NF90_INT .OR. ITYPE == NF90_INT64 .OR. ITYPE == NF90_INT1) ) THEN
+ ! Check size of variable before reading
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_N2[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_N2[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+
+ IF (IDIMLEN(1) == SIZE(KFIELD,1) .AND. IDIMLEN(2) == SIZE(KFIELD,2)) THEN
+ ! Read variable
+ STATUS = NF90_GET_VAR(INCID, IVARID, KFIELD)
+ IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_N2[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+ END IF
+ ! Read and check attributes of variable
+ CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_N2',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong size)')
+ IRESP = -3
+ END IF
+ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_N2',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong number of dimensions or wrong type)')
+ IRESP = -3
+END IF
+
+1000 CONTINUE
+KRESP = IRESP
+
+END SUBROUTINE IO_READ_FIELD_NC4_N2
+
+SUBROUTINE IO_READ_FIELD_NC4_L0(TPFILE, TPFIELD, OFIELD, KRESP)
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+LOGICAL, INTENT(OUT) :: OFIELD
+INTEGER, INTENT(OUT) :: KRESP ! return-code
+
+INTEGER(KIND=IDCDF_KIND) :: STATUS
+INTEGER(KIND=IDCDF_KIND) :: INCID
+INTEGER(KIND=IDCDF_KIND) :: IVARID
+INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
+INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER :: IRESP
+INTEGER :: IFIELD
+
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_L0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+
+IRESP = 0
+! Get the Netcdf file ID
+INCID = TPFILE%NNCID
+
+CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+
+! Get variable ID, NDIMS and TYPE
+STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_L0[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+END IF
+STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS)
+IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_L0[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
+
+!Neglect the time dimension (of size 1)
+IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
+
+!NF90_INT1 is for the case a boolean was written
+!Accept also INT and INT64 (for backward compatibility)
+IF (IDIMS == 0 .AND. (ITYPE == NF90_INT1 .OR. ITYPE == NF90_INT .OR. ITYPE == NF90_INT64) ) THEN
+ ! Read variable
+ STATUS = NF90_GET_VAR(INCID, IVARID, IFIELD)
+ IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_L0[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+ END IF
+
+ IF (IFIELD==0) THEN
+ OFIELD = .FALSE.
+ ELSE IF (IFIELD==1) THEN
+ OFIELD = .TRUE.
+ ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_LFI_L0',TRIM(TPFILE%CNAME)//': invalid value in file for ' &
+ //TRIM(TPFIELD%CMNHNAME))
+ OFIELD = .TRUE.
+ IRESP = -112
+ END IF
+
+ ! Read and check attributes of variable
+ CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_L0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong size or type)')
+ IRESP = -3
+END IF
+
+1000 CONTINUE
+KRESP = IRESP
+
+END SUBROUTINE IO_READ_FIELD_NC4_L0
+
+
+SUBROUTINE IO_READ_FIELD_NC4_L1(TPFILE, TPFIELD, OFIELD, KRESP)
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+LOGICAL,DIMENSION(:),INTENT(OUT) :: OFIELD
+INTEGER, INTENT(OUT) :: KRESP ! return-code
+
+INTEGER(KIND=IDCDF_KIND) :: STATUS
+INTEGER(KIND=IDCDF_KIND) :: INCID
+INTEGER(KIND=IDCDF_KIND) :: IVARID
+INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
+INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
+INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
+INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER :: IRESP
+INTEGER :: JI
+INTEGER,DIMENSION(SIZE(OFIELD)) :: IFIELD
+
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_L1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+
+IRESP = 0
+! Get the Netcdf file ID
+INCID = TPFILE%NNCID
+
+CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+
+! Get variable ID, NDIMS and TYPE
+STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_L1[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+END IF
+STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
+IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_L1[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
+
+!Neglect the time dimension (of size 1)
+IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
+
+!NF90_INT1 is for the case a boolean was written
+!Accept also INT and INT64 (for backward compatibility)
+IF (IDIMS == 1 .AND. (ITYPE == NF90_INT1 .OR. ITYPE == NF90_INT .OR. ITYPE == NF90_INT64) ) THEN
+ ! Check size of variable before reading
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN)
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_L1[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+
+ IF (IDIMLEN == SIZE(OFIELD)) THEN
+ ! Read variable
+ STATUS = NF90_GET_VAR(INCID, IVARID, IFIELD)
+ IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_L1[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+ END IF
+
+ DO JI=1,IDIMLEN
+ IF (IFIELD(JI)==0) THEN
+ OFIELD(JI) = .FALSE.
+ ELSE IF (IFIELD(JI)==1) THEN
+ OFIELD(JI) = .TRUE.
+ ELSE
+ OFIELD(JI) = .TRUE.
+ IRESP = -112
+ END IF
+ END DO
+ IF (IRESP==-112) THEN
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_LFI_L1',TRIM(TPFILE%CNAME)//': invalid value(s) in file for ' &
+ //TRIM(TPFIELD%CMNHNAME))
+ END IF
+
+ ! Read and check attributes of variable
+ CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_L1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong size)')
+ IRESP = -3
+ END IF
+ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_L1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong number of dimensions or wrong type)')
+ IRESP = -3
+END IF
+
+1000 CONTINUE
+KRESP = IRESP
+
+END SUBROUTINE IO_READ_FIELD_NC4_L1
+
+
+SUBROUTINE IO_READ_FIELD_NC4_C0(TPFILE, TPFIELD, HFIELD, KRESP)
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+CHARACTER(LEN=*), INTENT(OUT) :: HFIELD
+INTEGER, INTENT(OUT) :: KRESP ! return-code
+
+INTEGER(KIND=IDCDF_KIND) :: STATUS
+INTEGER(KIND=IDCDF_KIND) :: INCID
+INTEGER(KIND=IDCDF_KIND) :: IVARID
+INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
+INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
+INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
+CHARACTER(LEN=30) :: YVARNAME
+CHARACTER(LEN=:),ALLOCATABLE :: YSTR
+INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
+INTEGER :: IRESP
+
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_C0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+
+IRESP = 0
+! Get the Netcdf file ID
+INCID = TPFILE%NNCID
+
+CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+
+! Get variable ID, NDIMS and TYPE
+STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_C0[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+END IF
+STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
+IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_C0[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
+
+IF (IDIMS == 1 .AND. (ITYPE == NF90_CHAR) ) THEN
+ ! Check size of variable before reading
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN)
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_C0[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+ !
+ ALLOCATE(CHARACTER(LEN=IDIMLEN)::YSTR)
+ ! Read variable
+ STATUS = NF90_GET_VAR(INCID, IVARID, YSTR)
+ IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_C0[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+ END IF
+ IF (LEN_TRIM(YSTR) > LEN(HFIELD)) &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_C0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' truncated')
+ HFIELD = TRIM(YSTR)
+ DEALLOCATE(YSTR)
+
+ ! Read and check attributes of variable
+ CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_C0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong size or type)')
+ IRESP = -3
+END IF
+
+1000 CONTINUE
+KRESP = IRESP
+
+END SUBROUTINE IO_READ_FIELD_NC4_C0
+
+SUBROUTINE IO_READ_FIELD_NC4_T0(TPFILE, TPFIELD, TPDATA, KRESP)
+!
+USE MODD_TYPE_DATE
+!
+USE MODE_DATETIME
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+TYPE (DATE_TIME), INTENT(OUT) :: TPDATA
+INTEGER, INTENT(OUT) :: KRESP ! return-code
+
+INTEGER(KIND=IDCDF_KIND) :: STATUS
+INTEGER(KIND=IDCDF_KIND) :: INCID
+INTEGER(KIND=IDCDF_KIND) :: IVARID
+INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
+INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
+CHARACTER(LEN=30) :: YVARNAME
+CHARACTER(LEN=:),ALLOCATABLE :: YSTR
+INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
+INTEGER :: IDX,IRESP
+
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_T0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+
+IRESP = 0
+! Get the Netcdf file ID
+INCID = TPFILE%NNCID
+
+CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+
+! Get variable ID, NDIMS and TYPE
+STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_T0[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+END IF
+STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS)
+IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_T0[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
+
+IF (IDIMS == 0 .AND. (ITYPE == NF90_FLOAT .OR. ITYPE == NF90_DOUBLE) ) THEN
+ ! Read time
+ STATUS = NF90_GET_VAR(INCID, IVARID, TPDATA%TIME)
+ IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X0[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+ END IF
+ ! Read and check attributes of variable
+ CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP,HCALENDAR='standard')
+ ! Extract date from UNITS
+ IDX = INDEX(TPFIELD%CUNITS,'since ')
+ READ(TPFIELD%CUNITS(IDX+6 :IDX+9), '( I4.4 )') TPDATA%TDATE%YEAR
+ READ(TPFIELD%CUNITS(IDX+11:IDX+12),'( I2.2 )') TPDATA%TDATE%MONTH
+ READ(TPFIELD%CUNITS(IDX+14:IDX+15),'( I2.2 )') TPDATA%TDATE%DAY
+ ! Simple check (should catch most errors)
+ IF ( TPDATA%TDATE%DAY<1 .OR. TPDATA%TDATE%DAY>31 .OR. TPDATA%TDATE%MONTH<1 .OR. TPDATA%TDATE%MONTH>12 ) THEN
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_T0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' read date is invalid')
+ IRESP = -3
+ END IF
+ ! Correct date and time (necessary for example if time is bigger than 86400 s)
+ CALL DATETIME_CORRECTDATE(TPDATA)
+ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_T0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong size or type)')
+ IRESP = -3
+END IF
+
+1000 CONTINUE
+KRESP = IRESP
+
+END SUBROUTINE IO_READ_FIELD_NC4_T0
+
+
+end module mode_io_read_nc4
+#else
+!
+! External dummy subroutines
+!
+subroutine io_read_field_nc4(a, b, c, d, e, f, g)
+use mode_msg
+integer :: a, b, c, d, e, f, g
+CALL PRINT_MSG(NVERB_ERROR,'IO','io_read_field_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine io_read_field_nc4
+!
+#endif
diff --git a/src/LIB/SURCOUCHE/src/mode_io_tools.f90 b/src/LIB/SURCOUCHE/src/mode_io_tools.f90
new file mode 100644
index 000000000..ed80dcbe6
--- /dev/null
+++ b/src/LIB/SURCOUCHE/src/mode_io_tools.f90
@@ -0,0 +1,167 @@
+!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet : 13/12/2018 : extracted from mode_io.f90
+!-----------------------------------------------------------------
+module mode_io_tools
+
+use mode_msg
+
+implicit none
+
+private
+
+public :: io_file, io_rank
+public :: io_get_mnhversion, io_set_mnhversion
+
+contains
+
+ FUNCTION io_file(k,nb_proc_io)
+ !
+ ! return the file number where to write the K level of data
+ !
+ IMPLICIT NONE
+ INTEGER(kind=MNH_MPI_RANK_KIND) :: k,nb_proc_io
+ INTEGER(kind=MNH_MPI_RANK_KIND) :: io_file
+
+ io_file = MOD ((k-1) , nb_proc_io )
+
+ END FUNCTION io_file
+
+ FUNCTION IO_RANK(IFILE,nb_proc,nb_proc_io,offset_rank)
+ !
+ ! return the proc number which must write the 'IFILE' file
+ !
+ IMPLICIT NONE
+ INTEGER(kind=MNH_MPI_RANK_KIND) :: IFILE,nb_proc,nb_proc_io
+ INTEGER(kind=MNH_MPI_RANK_KIND),OPTIONAL :: offset_rank
+
+ INTEGER(kind=MNH_MPI_RANK_KIND) :: IO_RANK
+
+ INTEGER(kind=MNH_MPI_RANK_KIND) :: ipas,irest
+
+ ipas = nb_proc / nb_proc_io
+ irest = MOD ( nb_proc , nb_proc_io )
+
+ IF (ipas /= 0 ) THEN
+ IO_RANK=ipas * IFILE + MIN(IFILE , irest )
+ ELSE
+ IO_RANK=MOD(IFILE , nb_proc )
+ ENDIF
+
+ !
+ ! optional rank to shift for read test
+ !
+ IF (PRESENT(offset_rank)) THEN
+ IF ( offset_rank .GT.0 ) IO_RANK=MOD(IO_RANK+offset_rank,nb_proc)
+ IF ( offset_rank .LT.0 ) IO_RANK=MOD(nb_proc-IO_RANK+offset_rank,nb_proc)
+ ENDIF
+
+ END FUNCTION IO_RANK
+
+
+ subroutine io_get_mnhversion(tpfile)
+ !Compare MNHVERSION of file with current version and store it in file metadata
+ use modd_conf, only: nmnhversion
+ use modd_io_ll, only: tfiledata
+ use mode_field, only: tfielddata,typeint
+ use mode_fmread, only: io_read_field
+
+ type(tfiledata), intent(inout) :: tpfile
+
+ character(len=12) :: ymnhversion_file,ymnhversion_curr
+ integer :: imasdev,ibugfix
+ integer :: iresp
+ integer,dimension(3) :: imnhversion
+ type(tfielddata) :: tzfield
+
+ call print_msg(NVERB_DEBUG,'IO','io_get_mnhversion','called for '//trim(tpfile%cname))
+
+ if ( trim(tpfile%cmode) /= 'READ' ) &
+ call print_msg(NVERB_FATAL,'IO','io_get_mnhversion',trim(tpfile%cname)// 'not opened in read mode')
+
+ 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
+ tzfield%ltimedep = .false.
+ call io_read_field(tpfile,tzfield,imnhversion,iresp)
+ if (iresp/=0) then
+ tzfield%cmnhname = 'MASDEV'
+ tzfield%clongname = 'MesoNH version (without bugfix)'
+ tzfield%ndims = 0
+ call io_read_field(tpfile,tzfield,imasdev,iresp)
+ if (iresp/=0) then
+ call print_msg(NVERB_WARNING,'IO','io_get_mnhversion','unknown MASDEV version for '//trim(tpfile%cname))
+ else
+ if (imasdev<100) then
+ imnhversion(1)=imasdev/10
+ imnhversion(2)=mod(imasdev,10)
+ else !for example for mnh 4.10
+ imnhversion(1)=imasdev/100
+ imnhversion(2)=mod(imasdev,100)
+ end if
+ end if
+ !
+ tzfield%cmnhname = 'BUGFIX'
+ tzfield%clongname = 'MesoNH bugfix number'
+ call io_read_field(tpfile,tzfield,ibugfix,iresp)
+ if (iresp/=0) then
+ call print_msg(NVERB_WARNING,'IO','io_get_mnhversion','unknown BUGFIX version for '//trim(tpfile%cname))
+ else
+ imnhversion(3)=ibugfix
+ 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_get_mnhversion','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_get_mnhversion','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_get_mnhversion','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_get_mnhversion','file '//trim(tpfile%cname)//&
+ ' was written with the same version of MesoNH ('//trim(ymnhversion_curr)//')')
+ end if
+ !
+ tpfile%nmnhversion(:) = imnhversion(:)
+ end subroutine io_get_mnhversion
+
+
+ subroutine io_set_mnhversion(tpfile)
+ use modd_conf, only: nmnhversion
+ use modd_io_ll, only: tfiledata
+
+ type(tfiledata), intent(inout) :: tpfile
+
+ call print_msg(NVERB_DEBUG,'IO','io_set_mnhversion','called for '//trim(tpfile%cname))
+
+ if ( trim(tpfile%cmode) /= 'WRITE' ) &
+ call print_msg(NVERB_FATAL,'IO','io_set_mnhversion',trim(tpfile%cname)// 'not opened in write mode')
+
+ tpfile%nmnhversion(:) = nmnhversion(:)
+ end subroutine io_set_mnhversion
+
+end module mode_io_tools
diff --git a/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90 b/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90
new file mode 100644
index 000000000..4628accc3
--- /dev/null
+++ b/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90
@@ -0,0 +1,679 @@
+!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet : may 2016 : use NetCDF Fortran module
+! J.Escobar : 14/12/2017 : Correction for MNH_INT=8
+! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet : 13/12/2018 : split of mode_netcdf into multiple modules/files
+!-----------------------------------------------------------------
+#if defined(MNH_IOCDF4)
+module mode_io_tools_nc4
+
+use modd_io_ll, only: tfiledata
+use modd_netcdf, only: dimcdf, idcdf_kind, iocdf, tdim_dummy
+
+use mode_field, only: tfielddata
+use mode_msg
+
+use NETCDF, only: NF90_NOERR, NF90_UNLIMITED, &
+ NF90_DEF_DIM, NF90_STRERROR
+
+implicit none
+
+private
+
+public :: io_find_dim_byname_nc4, io_guess_dimids_nc4, io_set_knowndims_nc4
+public :: cleaniocdf, cleanmnhname, fillvdims, getdimcdf, getstrdimid, handle_err, newiocdf
+
+contains
+
+SUBROUTINE IO_FIND_DIM_BYNAME_NC4(TPFILE, HDIMNAME, TPDIM, KRESP)
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+CHARACTER(LEN=*), INTENT(IN) :: HDIMNAME
+TYPE(DIMCDF), INTENT(OUT) :: TPDIM
+INTEGER, INTENT(OUT) :: KRESP
+!
+TYPE(DIMCDF), POINTER :: TMP
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_FIND_DIM_BYNAME_NC4','called for dimension name '//TRIM(HDIMNAME))
+!
+KRESP = -2
+!
+IF(.NOT.ASSOCIATED(TPFILE%TNCDIMS%DIMLIST)) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FIND_DIM_BYNAME_NC4','DIMLIST not associated for file '//TRIM(TPFILE%CNAME))
+ KRESP = -1
+ RETURN
+END IF
+!
+TMP => TPFILE%TNCDIMS%DIMLIST
+!
+DO WHILE(ASSOCIATED(TMP))
+ IF (TRIM(TMP%NAME)==TRIM(HDIMNAME)) THEN
+ TPDIM = TMP
+ KRESP = 0
+ EXIT
+ END IF
+ TMP => TMP%NEXT
+END DO
+!
+END SUBROUTINE IO_FIND_DIM_BYNAME_NC4
+
+
+SUBROUTINE IO_GUESS_DIMIDS_NC4(TPFILE, TPFIELD, KLEN, TPDIMS, KRESP)
+!
+USE MODE_FIELD, ONLY: TYPECHAR
+!
+!Used by LFI2CDF
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+INTEGER, INTENT(IN) :: KLEN
+TYPE(DIMCDF),DIMENSION(:), INTENT(OUT) :: TPDIMS
+INTEGER, INTENT(OUT) :: KRESP
+!
+INTEGER :: IGRID
+INTEGER :: ILEN, ISIZE
+INTEGER :: JI
+CHARACTER(LEN=32) :: YINT
+CHARACTER(LEN=2) :: YDIR
+TYPE(DIMCDF), POINTER :: PTDIM
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_GUESS_DIMIDS_NC4','called for '//TRIM(TPFIELD%CMNHNAME))
+!
+IGRID = TPFIELD%NGRID
+YDIR = TPFIELD%CDIR
+!
+KRESP = 0
+ILEN = 0
+PTDIM => NULL()
+!
+IF(IGRID<0 .OR. IGRID>8) THEN
+ WRITE(YINT,'( I0 )') IGRID
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_GUESS_DIMIDS_NC4','invalid NGRID ('//TRIM(YINT)//') for field '//TRIM(TPFIELD%CMNHNAME))
+END IF
+!
+IF(IGRID==0 .AND. YDIR/='--' .AND. YDIR/='' ) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4','invalid YDIR ('//TRIM(YDIR)//') with NGRID=0 for field '&
+ //TRIM(TPFIELD%CMNHNAME))
+END IF
+!
+IF (IGRID==0) THEN
+ SELECT CASE(TPFIELD%NDIMS)
+ CASE (0)
+ IF (TPFIELD%NTYPE == TYPECHAR) THEN
+ ILEN = KLEN
+ ELSE
+ ILEN = 1
+ END IF
+ CASE (1)
+ PTDIM => GETDIMCDF(TPFILE,KLEN)
+ TPDIMS(1) = PTDIM
+ ILEN = PTDIM%LEN
+ CASE DEFAULT
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4','NGRID=0 and NDIMS>1 not yet supported (field '&
+ //TRIM(TPFIELD%CMNHNAME)//')')
+ END SELECT
+ELSE IF (TPFIELD%CLBTYPE/='NONE') THEN
+ IF (TPFIELD%NDIMS/=3) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4','CLBTYPE/=NONE and NDIMS/=3 not supported (field '&
+ //TRIM(TPFIELD%CMNHNAME)//')')
+ END IF
+ !
+ IF (TPFIELD%CLBTYPE=='LBX' .OR. TPFIELD%CLBTYPE=='LBXU') THEN
+ PTDIM => TPFILE%TNCCOORDS(2,IGRID)%TDIM
+ TPDIMS(2) = PTDIM
+ PTDIM => TPFILE%TNCCOORDS(3,IGRID)%TDIM
+ TPDIMS(3) = PTDIM
+ ILEN = TPDIMS(2)%LEN * TPDIMS(3)%LEN
+ ISIZE = KLEN/ILEN
+ IF (MOD(KLEN,ILEN)/=0) CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4', &
+ 'can not guess 1st dimension for field '//TRIM(TPFIELD%CMNHNAME))
+ PTDIM => GETDIMCDF(TPFILE, ISIZE)
+ TPDIMS(1) = PTDIM
+ ILEN = ILEN * PTDIM%LEN
+ ELSE IF (TPFIELD%CLBTYPE=='LBY' .OR. TPFIELD%CLBTYPE=='LBYV') THEN
+ PTDIM => TPFILE%TNCCOORDS(1,IGRID)%TDIM
+ TPDIMS(1) = PTDIM
+ PTDIM => TPFILE%TNCCOORDS(3,IGRID)%TDIM
+ TPDIMS(3) = PTDIM
+ ILEN = TPDIMS(1)%LEN * TPDIMS(3)%LEN
+ ISIZE = KLEN/ILEN
+ IF (MOD(KLEN,ILEN)/=0) CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4', &
+ 'can not guess 2nd dimension for field '//TRIM(TPFIELD%CMNHNAME))
+ PTDIM => GETDIMCDF(TPFILE, ISIZE)
+ TPDIMS(2) = PTDIM
+ ILEN = ILEN * PTDIM%LEN
+ ELSE
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4','invalid CLBTYPE ('//TPFIELD%CLBTYPE//') for field '&
+ //TRIM(TPFIELD%CMNHNAME))
+ END IF
+ELSE
+ IF (TPFIELD%NDIMS==0) ILEN = 1
+ !
+ DO JI=1,TPFIELD%NDIMS
+ IF (JI == 1) THEN
+ IF ( (YDIR == 'XX' .OR. YDIR == 'XY') ) THEN
+ PTDIM => TPFILE%TNCCOORDS(1,IGRID)%TDIM
+ ELSE IF ( YDIR == 'YY' ) THEN
+ PTDIM => TPFILE%TNCCOORDS(2,IGRID)%TDIM
+ ELSE IF ( YDIR == 'ZZ' ) THEN
+ PTDIM => TPFILE%TNCCOORDS(3,IGRID)%TDIM
+ ELSE IF (JI==TPFIELD%NDIMS) THEN !Guess last dimension
+ PTDIM => GETDIMCDF(TPFILE, KLEN)
+ END IF
+ ILEN = PTDIM%LEN
+ TPDIMS(JI) = PTDIM
+ ELSE IF (JI == 2) THEN
+ IF ( YDIR == 'XY') THEN
+ PTDIM => TPFILE%TNCCOORDS(2,IGRID)%TDIM
+ ELSE IF (JI==TPFIELD%NDIMS) THEN !Guess last dimension
+ ISIZE = KLEN/ILEN
+ IF (MOD(KLEN,ILEN)/=0) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4', &
+ 'can not guess 2nd and last dimension for field '//TRIM(TPFIELD%CMNHNAME))
+ EXIT
+ END IF
+ PTDIM => GETDIMCDF(TPFILE, ISIZE)
+ ELSE
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4','can not guess 2nd dimension for field '//TRIM(TPFIELD%CMNHNAME))
+ EXIT
+ END IF
+ ILEN = ILEN * PTDIM%LEN
+ TPDIMS(JI) = PTDIM
+ ELSE IF (JI == 3) THEN
+ IF ( YDIR == 'XY' ) THEN
+ IF (JI==TPFIELD%NDIMS .AND. KLEN/ILEN==1 .AND. MOD(KLEN,ILEN)==0) THEN
+ !The last dimension is of size 1 => probably time dimension
+ ISIZE = 1
+ PTDIM => GETDIMCDF(TPFILE,ISIZE)
+ ELSE
+ PTDIM => TPFILE%TNCCOORDS(3,IGRID)%TDIM
+ END IF
+ ELSE IF (JI==TPFIELD%NDIMS) THEN !Guess last dimension
+ ISIZE = KLEN/ILEN
+ IF (MOD(KLEN,ILEN)/=0) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4', &
+ 'can not guess 3rd and last dimension for field '//TRIM(TPFIELD%CMNHNAME))
+ EXIT
+ END IF
+ PTDIM => GETDIMCDF(TPFILE, ISIZE)
+ ELSE
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4','can not guess 3rd dimension for field '//TRIM(TPFIELD%CMNHNAME))
+ EXIT
+ END IF
+ ILEN = ILEN * PTDIM%LEN
+ TPDIMS(JI) = PTDIM
+ ELSE IF (JI==4 .AND. JI==TPFIELD%NDIMS) THEN !Guess last dimension
+ ISIZE = KLEN/ILEN
+ IF (MOD(KLEN,ILEN)/=0) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4', &
+ 'can not guess 4th and last dimension for field '//TRIM(TPFIELD%CMNHNAME))
+ EXIT
+ END IF
+ PTDIM => GETDIMCDF(TPFILE, ISIZE)
+ ILEN = ILEN * PTDIM%LEN
+ TPDIMS(JI) = PTDIM
+ ELSE
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4','can not guess dimension above 4 for field '&
+ //TRIM(TPFIELD%CMNHNAME))
+ END IF
+ END DO
+END IF
+!
+IF (KLEN /= ILEN) THEN
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_GUESS_DIMIDS_NC4','can not guess dimensions of field '&
+ //TRIM(TPFIELD%CMNHNAME))
+ KRESP = 1
+END IF
+!
+END SUBROUTINE IO_GUESS_DIMIDS_NC4
+
+
+SUBROUTINE IO_SET_KNOWNDIMS_NC4(TPFILE,HPROGRAM_ORIG)
+
+USE MODD_CONF, ONLY: CPROGRAM
+USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
+USE MODD_DIM_n, ONLY: NIMAX_ll, NJMAX_ll, NKMAX
+USE MODD_PARAMETERS_ll, ONLY: JPHEXT, JPVEXT
+
+TYPE(TFILEDATA),INTENT(INOUT) :: TPFILE
+CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: HPROGRAM_ORIG !To emulate a file coming from this program
+
+CHARACTER(LEN=:),ALLOCATABLE :: YPROGRAM
+INTEGER :: IIU_ll, IJU_ll, IKU
+TYPE(IOCDF), POINTER :: PIOCDF
+
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_SET_KNOWNDIMS_NC4','called for '//TRIM(TPFILE%CNAME))
+
+PIOCDF => TPFILE%TNCDIMS
+
+IF (PRESENT(HPROGRAM_ORIG)) THEN
+ YPROGRAM = HPROGRAM_ORIG
+ELSE
+ YPROGRAM = CPROGRAM
+ENDIF
+
+IIU_ll = NIMAX_ll + 2*JPHEXT
+IJU_ll = NJMAX_ll + 2*JPHEXT
+IKU = NKMAX + 2*JPVEXT
+
+IF (.NOT. ASSOCIATED(PIOCDF%DIM_NI)) PIOCDF%DIM_NI => GETDIMCDF(TPFILE, IIU_ll, 'ni')
+IF (.NOT. ASSOCIATED(PIOCDF%DIM_NJ)) PIOCDF%DIM_NJ => GETDIMCDF(TPFILE, IJU_ll, 'nj')
+IF (.NOT. ASSOCIATED(PIOCDF%DIM_NI_U)) PIOCDF%DIM_NI_U => GETDIMCDF(TPFILE, IIU_ll, 'ni_u')
+IF (.NOT. ASSOCIATED(PIOCDF%DIM_NJ_U)) PIOCDF%DIM_NJ_U => GETDIMCDF(TPFILE, IJU_ll, 'nj_u')
+IF (.NOT. ASSOCIATED(PIOCDF%DIM_NI_V)) PIOCDF%DIM_NI_V => GETDIMCDF(TPFILE, IIU_ll, 'ni_v')
+IF (.NOT. ASSOCIATED(PIOCDF%DIM_NJ_V)) PIOCDF%DIM_NJ_V => GETDIMCDF(TPFILE, IJU_ll, 'nj_v')
+IF (TRIM(YPROGRAM)/='PGD' .AND. TRIM(YPROGRAM)/='NESPGD' .AND. TRIM(YPROGRAM)/='ZOOMPG' &
+ .AND. .NOT.(TRIM(YPROGRAM)=='REAL' .AND. CSTORAGE_TYPE=='SU') ) THEN !condition to detect PREP_SURFEX
+ IF (.NOT. ASSOCIATED(PIOCDF%DIM_LEVEL)) PIOCDF%DIM_LEVEL => GETDIMCDF(TPFILE, IKU , 'level')
+ IF (.NOT. ASSOCIATED(PIOCDF%DIM_LEVEL_W)) PIOCDF%DIM_LEVEL_W => GETDIMCDF(TPFILE, IKU , 'level_w')
+ IF (.NOT. ASSOCIATED(PIOCDF%DIMTIME)) PIOCDF%DIMTIME => GETDIMCDF(TPFILE, NF90_UNLIMITED, 'time')
+ELSE
+ !PGD and SURFEX files for MesoNH have no vertical levels or time scale
+ !These dimensions are allocated to default values
+ !(they need to be allocated when looking for dimensions of variables)
+ IF (.NOT. ASSOCIATED(PIOCDF%DIM_LEVEL)) ALLOCATE(PIOCDF%DIM_LEVEL)
+ IF (.NOT. ASSOCIATED(PIOCDF%DIM_LEVEL_W)) ALLOCATE(PIOCDF%DIM_LEVEL_W)
+ IF (.NOT. ASSOCIATED(PIOCDF%DIMTIME)) ALLOCATE(PIOCDF%DIMTIME)
+END IF
+
+!Store X,Y,Z coordinates for the Arakawa points
+!0 2nd-dimension is to treat NGRID=0 case without crash
+IF (.NOT.ALLOCATED(TPFILE%TNCCOORDS)) ALLOCATE(TPFILE%TNCCOORDS(3,0:8))
+!Dummy point
+TPFILE%TNCCOORDS(1,0)%TDIM => TDIM_DUMMY
+TPFILE%TNCCOORDS(2,0)%TDIM => TDIM_DUMMY
+TPFILE%TNCCOORDS(3,0)%TDIM => TDIM_DUMMY
+! Mass point
+TPFILE%TNCCOORDS(1,1)%TDIM => PIOCDF%DIM_NI
+TPFILE%TNCCOORDS(2,1)%TDIM => PIOCDF%DIM_NJ
+TPFILE%TNCCOORDS(3,1)%TDIM => PIOCDF%DIM_LEVEL
+! u point
+TPFILE%TNCCOORDS(1,2)%TDIM => PIOCDF%DIM_NI_U
+TPFILE%TNCCOORDS(2,2)%TDIM => PIOCDF%DIM_NJ_U
+TPFILE%TNCCOORDS(3,2)%TDIM => PIOCDF%DIM_LEVEL
+! v point
+TPFILE%TNCCOORDS(1,3)%TDIM => PIOCDF%DIM_NI_V
+TPFILE%TNCCOORDS(2,3)%TDIM => PIOCDF%DIM_NJ_V
+TPFILE%TNCCOORDS(3,3)%TDIM => PIOCDF%DIM_LEVEL
+! w point
+TPFILE%TNCCOORDS(1,4)%TDIM => PIOCDF%DIM_NI
+TPFILE%TNCCOORDS(2,4)%TDIM => PIOCDF%DIM_NJ
+TPFILE%TNCCOORDS(3,4)%TDIM => PIOCDF%DIM_LEVEL_W
+! xi vorticity point (=f point =uv point)
+TPFILE%TNCCOORDS(1,5)%TDIM => PIOCDF%DIM_NI_U
+TPFILE%TNCCOORDS(2,5)%TDIM => PIOCDF%DIM_NJ_V
+TPFILE%TNCCOORDS(3,5)%TDIM => PIOCDF%DIM_LEVEL
+! eta vorticity point (=uw point)
+TPFILE%TNCCOORDS(1,6)%TDIM => PIOCDF%DIM_NI_U
+TPFILE%TNCCOORDS(2,6)%TDIM => PIOCDF%DIM_NJ_U
+TPFILE%TNCCOORDS(3,6)%TDIM => PIOCDF%DIM_LEVEL_W
+! zeta vorticity point (=vw point)
+TPFILE%TNCCOORDS(1,7)%TDIM => PIOCDF%DIM_NI_V
+TPFILE%TNCCOORDS(2,7)%TDIM => PIOCDF%DIM_NJ_V
+TPFILE%TNCCOORDS(3,7)%TDIM => PIOCDF%DIM_LEVEL_W
+! fw point (=uvw point)
+TPFILE%TNCCOORDS(1,8)%TDIM => PIOCDF%DIM_NI_U
+TPFILE%TNCCOORDS(2,8)%TDIM => PIOCDF%DIM_NJ_V
+TPFILE%TNCCOORDS(3,8)%TDIM => PIOCDF%DIM_LEVEL_W
+
+
+END SUBROUTINE IO_SET_KNOWNDIMS_NC4
+
+
+SUBROUTINE CLEANIOCDF(PIOCDF)
+TYPE(IOCDF), POINTER :: PIOCDF
+
+INTEGER(KIND=IDCDF_KIND) :: IRESP
+
+CALL PRINT_MSG(NVERB_DEBUG,'IO','CLEANIOCDF','called')
+
+! Clean DIMLIST and DIMSTR
+CALL CLEANLIST(PIOCDF%DIMLIST)
+CALL CLEANLIST(PIOCDF%DIMSTR)
+! Then free iocdf
+DEALLOCATE(PIOCDF)
+
+CONTAINS
+
+SUBROUTINE CLEANLIST(PLIST)
+TYPE(DIMCDF), POINTER :: PLIST,TZDIMCUR, TZDIMNEXT
+
+TZDIMCUR => PLIST
+DO WHILE(ASSOCIATED(TZDIMCUR))
+ TZDIMNEXT => TZDIMCUR%NEXT
+ DEALLOCATE(TZDIMCUR)
+ TZDIMCUR => TZDIMNEXT
+END DO
+
+END SUBROUTINE CLEANLIST
+
+END SUBROUTINE CLEANIOCDF
+
+
+SUBROUTINE FILLVDIMS(TPFILE, TPFIELD, KSHAPE, KVDIMS)
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+INTEGER(KIND=IDCDF_KIND),DIMENSION(:),INTENT(IN) :: KSHAPE
+INTEGER(KIND=IDCDF_KIND),DIMENSION(:),ALLOCATABLE,INTENT(OUT) :: KVDIMS
+!
+INTEGER :: IGRID
+INTEGER :: JI
+CHARACTER(LEN=32) :: YINT
+CHARACTER(LEN=2) :: YDIR
+TYPE(DIMCDF), POINTER :: PTDIM
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','FILLVDIMS','called for '//TRIM(TPFIELD%CMNHNAME))
+!
+IF (SIZE(KSHAPE) < 1 .AND. .NOT.TPFIELD%LTIMEDEP) CALL PRINT_MSG(NVERB_FATAL,'IO','FILLVDIMS','empty KSHAPE')
+!
+IGRID = TPFIELD%NGRID
+YDIR = TPFIELD%CDIR
+!
+IF(SIZE(KSHAPE)/=TPFIELD%NDIMS) THEN
+ WRITE(YINT,'( I0,"/",I0 )') SIZE(KSHAPE),TPFIELD%NDIMS
+ CALL PRINT_MSG(NVERB_FATAL,'IO','FILLVDIMS','SIZE(KSHAPE)/=TPFIELD%NDIMS ('//TRIM(YINT)//') for field ' &
+ //TRIM(TPFIELD%CMNHNAME))
+END IF
+!
+IF (TPFIELD%LTIMEDEP) THEN
+ !Add time dimension
+ ALLOCATE(KVDIMS(TPFIELD%NDIMS+1))
+ KVDIMS(TPFIELD%NDIMS+1) = TPFILE%TNCDIMS%DIMTIME%ID
+ELSE
+ ALLOCATE(KVDIMS(TPFIELD%NDIMS))
+END IF
+!
+IF(IGRID<0 .OR. IGRID>8) THEN
+ WRITE(YINT,'( I0 )') IGRID
+ CALL PRINT_MSG(NVERB_FATAL,'IO','FILLVDIMS','invalid NGRID ('//TRIM(YINT)//') for field '//TRIM(TPFIELD%CMNHNAME))
+END IF
+!
+IF(IGRID==0 .AND. YDIR/='--' .AND. YDIR/='' ) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'IO','FILLVDIMS','invalid YDIR ('//TRIM(YDIR)//') with NGRID=0 for field '//TRIM(TPFIELD%CMNHNAME))
+END IF
+!
+DO JI=1,SIZE(KSHAPE)
+ IF (JI == 1) THEN
+ IF ( (YDIR == 'XX' .OR. YDIR == 'XY') .AND. KSHAPE(1)==TPFILE%TNCCOORDS(1,IGRID)%TDIM%LEN) THEN
+ KVDIMS(1) = TPFILE%TNCCOORDS(1,IGRID)%TDIM%ID
+ ELSE IF ( YDIR == 'YY' .AND. KSHAPE(1)==TPFILE%TNCCOORDS(2,IGRID)%TDIM%LEN) THEN
+ KVDIMS(1) = TPFILE%TNCCOORDS(2,IGRID)%TDIM%ID
+ ELSE IF ( YDIR == 'ZZ' .AND. KSHAPE(1)==TPFILE%TNCCOORDS(3,IGRID)%TDIM%LEN) THEN
+ KVDIMS(1) = TPFILE%TNCCOORDS(3,IGRID)%TDIM%ID
+ ELSE
+ PTDIM => GETDIMCDF(TPFILE, KSHAPE(1)); KVDIMS(1) = PTDIM%ID
+ END IF
+ ELSE IF (JI == 2) THEN
+ IF ( YDIR == 'XY' .AND. KSHAPE(2)==TPFILE%TNCCOORDS(2,IGRID)%TDIM%LEN) THEN
+ KVDIMS(2) = TPFILE%TNCCOORDS(2,IGRID)%TDIM%ID
+ ELSE
+ PTDIM => GETDIMCDF(TPFILE, KSHAPE(2)); KVDIMS(2) = PTDIM%ID
+ END IF
+ ELSE IF (JI == 3) THEN
+ IF ( YDIR == 'XY' .AND. KSHAPE(3)==TPFILE%TNCCOORDS(3,IGRID)%TDIM%LEN) THEN
+ KVDIMS(3) = TPFILE%TNCCOORDS(3,IGRID)%TDIM%ID
+ ELSE
+ PTDIM => GETDIMCDF(TPFILE, KSHAPE(3)); KVDIMS(3) = PTDIM%ID
+ END IF
+ ELSE
+ PTDIM => GETDIMCDF(TPFILE, KSHAPE(JI)); KVDIMS(JI) = PTDIM%ID
+ END IF
+END DO
+!
+END SUBROUTINE FILLVDIMS
+
+
+FUNCTION GETDIMCDF(TPFILE, KLEN, HDIMNAME)
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KLEN
+CHARACTER(LEN=*), OPTIONAL :: HDIMNAME ! When provided don't search but
+ ! simply create with name HDIMNAME
+TYPE(DIMCDF), POINTER :: GETDIMCDF
+
+TYPE(DIMCDF), POINTER :: TMP
+INTEGER :: COUNT
+CHARACTER(LEN=16) :: YSUFFIX
+CHARACTER(LEN=20) :: YDIMNAME
+INTEGER(KIND=IDCDF_KIND) :: STATUS
+LOGICAL :: GCHKLEN !Check if KLEN is valid
+TYPE(IOCDF), POINTER :: PIOCDF
+
+CALL PRINT_MSG(NVERB_DEBUG,'IO','GETDIMCDF','called')
+
+PIOCDF => TPFILE%TNCDIMS
+
+GCHKLEN = .TRUE.
+!Do not check KLEN if 'time' (because NF90_UNLIMITED = 0)
+IF (PRESENT(HDIMNAME)) THEN
+ IF (TRIM(HDIMNAME)=='time') THEN
+ GCHKLEN = .FALSE.
+ END IF
+END IF
+
+WRITE(YSUFFIX,'(I0)') KLEN
+
+IF (GCHKLEN .AND. KLEN < 1) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'IO','GETDIMCDF','KLEN='//TRIM(YSUFFIX))
+END IF
+
+IF (PRESENT(HDIMNAME)) THEN
+ NULLIFY(TMP)
+ YDIMNAME = TRIM(HDIMNAME)
+ELSE
+ ! Search dimension with KLEN length
+ COUNT = 1
+ TMP => PIOCDF%DIMLIST
+ DO WHILE(ASSOCIATED(TMP))
+ IF (TMP%LEN == KLEN .AND. TMP%NAME(1:4) /= 'char') EXIT
+ TMP=>TMP%NEXT
+ COUNT = COUNT+1
+ END DO
+ YDIMNAME = 'size'//TRIM(YSUFFIX)
+END IF
+
+IF (.NOT. ASSOCIATED(TMP)) THEN
+ ! Not found then define new dimension
+ ALLOCATE(TMP)
+ TMP%NAME = YDIMNAME
+ TMP%LEN = KLEN
+ STATUS = NF90_DEF_DIM(TPFILE%NNCID, TMP%NAME, KLEN, TMP%ID)
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'GETDIMCDF[NF90_DEF_DIM]')
+ NULLIFY(TMP%NEXT)
+ TMP%NEXT => PIOCDF%DIMLIST
+ PIOCDF%DIMLIST => TMP
+CALL PRINT_MSG(NVERB_DEBUG,'IO','GETDIMCDF','new dimension: '//TRIM(TMP%NAME))
+END IF
+
+GETDIMCDF => TMP
+
+END FUNCTION GETDIMCDF
+
+
+FUNCTION GETSTRDIMID(TPFILE,KLEN)
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KLEN
+INTEGER(KIND=IDCDF_KIND) :: GETSTRDIMID
+
+TYPE(DIMCDF), POINTER :: TMP
+TYPE(IOCDF), POINTER :: TZIOCDF
+CHARACTER(LEN=16) :: YSUFFIX
+INTEGER(KIND=IDCDF_KIND) :: STATUS
+
+CALL PRINT_MSG(NVERB_DEBUG,'IO','GETSTRDIMID','called')
+
+WRITE(YSUFFIX,'(I0)') KLEN
+
+IF (KLEN < 1) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'IO','GETSTRDIMID','KLEN='//TRIM(YSUFFIX))
+END IF
+
+! Search string dimension with KLEN length
+TMP => TPFILE%TNCDIMS%DIMSTR
+DO WHILE(ASSOCIATED(TMP))
+ IF (TMP%LEN == KLEN) EXIT
+ TMP=>TMP%NEXT
+END DO
+
+IF (.NOT. ASSOCIATED(TMP)) THEN
+ ! Not found then define new dimension
+ ALLOCATE(TMP)
+ TMP%NAME = 'char'//TRIM(YSUFFIX)
+ TMP%LEN = KLEN
+ STATUS = NF90_DEF_DIM(TPFILE%NNCID, TMP%NAME, KLEN, TMP%ID)
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'GETSTRDIMID[NF90_DEF_DIM]')
+ NULLIFY(TMP%NEXT)
+ TMP%NEXT => TPFILE%TNCDIMS%DIMSTR
+ TZIOCDF => TPFILE%TNCDIMS
+ TZIOCDF%DIMSTR => TMP
+END IF
+
+GETSTRDIMID = TMP%ID
+
+END FUNCTION GETSTRDIMID
+
+
+FUNCTION NEWIOCDF()
+TYPE(IOCDF), POINTER :: NEWIOCDF
+TYPE(IOCDF), POINTER :: TZIOCDF
+INTEGER :: IRESP
+
+CALL PRINT_MSG(NVERB_DEBUG,'IO','NEWIOCDF','called')
+
+ALLOCATE(TZIOCDF, STAT=IRESP)
+IF (IRESP > 0) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'IO','NEWIOCDF','memory allocation error')
+ STOP
+END IF
+
+NEWIOCDF=>TZIOCDF
+
+END FUNCTION NEWIOCDF
+
+
+SUBROUTINE HANDLE_ERR(STATUS,LINE,TEXT,KRESP)
+INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: STATUS
+INTEGER, INTENT(IN) :: LINE
+CHARACTER(LEN=*), INTENT(IN) :: TEXT
+INTEGER, OPTIONAL, INTENT(OUT) :: KRESP
+
+CHARACTER(LEN=6) :: YLINE
+
+WRITE(YLINE,'( I6 )') LINE
+
+! Don't stop (by default) the code when KRESP is present
+! and ensure KRESP is a negative integer
+IF (STATUS /= NF90_NOERR) THEN
+ IF (PRESENT(KRESP)) THEN
+ IF (STATUS < 0) THEN
+ KRESP = STATUS
+ ELSE IF (STATUS == 0) THEN
+ KRESP = -1
+ ELSE
+ KRESP = -STATUS
+ END IF
+ CALL PRINT_MSG(NVERB_WARNING,'IO',TRIM(TEXT),'netCDF error at line '//TRIM(YLINE)//': '//TRIM(NF90_STRERROR(STATUS)))
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO',TRIM(TEXT),'netCDF error at line '//TRIM(YLINE)//': '//TRIM(NF90_STRERROR(STATUS)))
+ END IF
+END IF
+END SUBROUTINE HANDLE_ERR
+
+
+SUBROUTINE CLEANMNHNAME(HINNAME,HOUTNAME)
+ CHARACTER(LEN=*),INTENT(IN) :: HINNAME
+ CHARACTER(LEN=*),INTENT(OUT) :: HOUTNAME
+
+ ! NetCDF var names can't contain '%' nor '.'
+ ! CF convention allows only letters, digits and underscores
+ HOUTNAME = str_replace(HINNAME, '%', '__')
+ HOUTNAME = str_replace(HOUTNAME, '.', '___')
+END SUBROUTINE
+
+
+FUNCTION str_replace(hstr, hold, hnew)
+CHARACTER(LEN=*) :: hstr, hold, hnew
+CHARACTER(LEN=LEN_TRIM(hstr)+MAX(0,LEN(hnew)-LEN(hold))) :: str_replace
+
+INTEGER :: pos
+
+pos = INDEX(hstr,hold)
+IF (pos /= 0) THEN
+ str_replace = hstr(1:pos-1)//hnew//hstr(pos+LEN(hold):)
+ELSE
+ str_replace = hstr
+END IF
+
+END FUNCTION str_replace
+
+
+end module mode_io_tools_nc4
+#else
+!
+! External dummy subroutines
+!
+subroutine io_find_dim_byname_nc4(a, b, c, d)
+use mode_msg
+integer :: a, b, c, d
+CALL PRINT_MSG(NVERB_ERROR,'IO','io_find_dim_byname_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine io_find_dim_byname_nc4
+!
+subroutine io_guess_dimids_nc4(a, b, c, d)
+use mode_msg
+integer :: a, b, c, d
+CALL PRINT_MSG(NVERB_ERROR,'IO','io_guess_dimids_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine io_guess_dimids_nc4
+!
+subroutine io_set_knowndims_nc4(a, b)
+use mode_msg
+integer :: a, b,
+CALL PRINT_MSG(NVERB_ERROR,'IO','io_set_knowndims_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine io_set_knowndims_nc4
+!
+subroutine cleaniocdf(a)
+use mode_msg
+integer :: a
+CALL PRINT_MSG(NVERB_ERROR,'IO','cleaniocdf','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine cleaniocdf
+!
+subroutine cleanmnhname(a, b)
+use mode_msg
+integer :: a, b
+CALL PRINT_MSG(NVERB_ERROR,'IO','cleanmnhname','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine cleanmnhname
+!
+subroutine fillvdims(a, b, c, d)
+use mode_msg
+integer :: a, b, c, d
+CALL PRINT_MSG(NVERB_ERROR,'IO','fillvdims','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine fillvdims
+!
+function getdimcdf(a, b, c)
+use mode_msg
+integer :: getdimcdf
+integer :: a, b, c
+CALL PRINT_MSG(NVERB_ERROR,'IO','getdimcdf','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end function getdimcdf
+!
+function getstrdimid(a, b)
+use mode_msg
+integer :: getstrdimid
+integer :: a, b
+CALL PRINT_MSG(NVERB_ERROR,'IO','getstrdimid','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end function getstrdimid
+!
+subroutine handle_err(a, b, c, d)
+use mode_msg
+integer :: a, b, c, d
+CALL PRINT_MSG(NVERB_ERROR,'IO','handle_err','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine handle_err
+!
+function newiocdf()
+use mode_msg
+integer :: newiocdf
+CALL PRINT_MSG(NVERB_ERROR,'IO','newiocdf','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end function newiocdf()
+!
+#endif
diff --git a/src/LIB/SURCOUCHE/src/mode_netcdf.f90 b/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90
similarity index 50%
rename from src/LIB/SURCOUCHE/src/mode_netcdf.f90
rename to src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90
index 9f5aa1ba5..ba49180c4 100644
--- a/src/LIB/SURCOUCHE/src/mode_netcdf.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90
@@ -1,30 +1,34 @@
!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! Modifications:
! P. Wautelet : may 2016 : use NetCDF Fortran module
! J.Escobar : 14/12/2017 : Correction for MNH_INT=8
! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet : 13/12/2018 : split of mode_netcdf into multiple modules/files
!-----------------------------------------------------------------
#if defined(MNH_IOCDF4)
-MODULE MODE_NETCDF
-USE MODD_NETCDF
-USE NETCDF
-USE MODD_IO_ll
-USE MODE_FIELD, ONLY : TFIELDDATA
-USE MODE_MSG
+module mode_io_write_nc4
-IMPLICIT NONE
+use modd_io_ll, only: gsmonoproc, tfiledata
+use modd_netcdf, only: dimcdf, idcdf_kind, iocdf
-PRIVATE
+use mode_field, only: tfielddata
+use mode_io_tools_nc4, only: cleanmnhname, fillvdims, getdimcdf, getstrdimid, handle_err
+use mode_msg
-INTEGER(KIND=IDCDF_KIND),PARAMETER :: SHUFFLE = 1 !Set to 1 for (usually) better compression
-INTEGER(KIND=IDCDF_KIND),PARAMETER :: DEFLATE = 1
+use NETCDF, only: NF90_CHAR, NF90_DOUBLE, NF90_FLOAT, NF90_INT, NF90_INT1, NF90_INT64, &
+ NF90_GLOBAL, NF90_NOERR, &
+ NF90_DEF_VAR, NF90_DEF_VAR_DEFLATE, NF90_GET_ATT, NF90_INQ_VARID, &
+ NF90_INQUIRE_ATTRIBUTE, NF90_PUT_ATT, NF90_PUT_VAR
-INTEGER,PARAMETER :: NSTRINGCHUNKSIZE = 16 !Dimension of the chunks of strings
- !(to limit the number of dimensions for strings)
+implicit none
+
+private
+
+public :: io_write_coordvar_nc4, io_write_field_nc4, io_write_header_nc4
INTERFACE IO_WRITE_FIELD_NC4
MODULE PROCEDURE IO_WRITE_FIELD_NC4_X0,IO_WRITE_FIELD_NC4_X1, &
@@ -38,847 +42,99 @@ INTERFACE IO_WRITE_FIELD_NC4
IO_WRITE_FIELD_NC4_T0
END INTERFACE IO_WRITE_FIELD_NC4
-INTERFACE IO_READ_FIELD_NC4
- MODULE PROCEDURE IO_READ_FIELD_NC4_X0,IO_READ_FIELD_NC4_X1, &
- IO_READ_FIELD_NC4_X2,IO_READ_FIELD_NC4_X3, &
- IO_READ_FIELD_NC4_X4,IO_READ_FIELD_NC4_X5, &
- IO_READ_FIELD_NC4_X6, &
- IO_READ_FIELD_NC4_N0,IO_READ_FIELD_NC4_N1, &
- IO_READ_FIELD_NC4_N2, &
- IO_READ_FIELD_NC4_L0,IO_READ_FIELD_NC4_L1, &
- IO_READ_FIELD_NC4_C0, &
- IO_READ_FIELD_NC4_T0
-END INTERFACE IO_READ_FIELD_NC4
-
-! Public from module netcdf
-PUBLIC NF90_CLOSE,NF90_OPEN,NF90_CREATE, &
- NF90_NOWRITE,NF90_CLOBBER,NF90_NETCDF4,NF90_NOERR,NF90_STRERROR, &
- NF90_FILL_REAL,NF90_INQUIRE
-! Public from this module :
-PUBLIC GETDIMCDF,NEWIOCDF,CLEANIOCDF, &
- IO_GUESS_DIMIDS_NC4,IO_FIND_DIM_BYNAME_NC4, &
- IO_SET_KNOWNDIMS_NC4,IO_WRITE_COORDVAR_NC4, &
- IO_WRITE_FIELD_NC4,IO_READ_FIELD_NC4,IO_WRITE_HEADER_NC4
-
-CONTAINS
-
-SUBROUTINE CLEANMNHNAME(HINNAME,HOUTNAME)
- CHARACTER(LEN=*),INTENT(IN) :: HINNAME
- CHARACTER(LEN=*),INTENT(OUT) :: HOUTNAME
-
- ! NetCDF var names can't contain '%' nor '.'
- ! CF convention allows only letters, digits and underscores
- HOUTNAME = str_replace(HINNAME, '%', '__')
- HOUTNAME = str_replace(HOUTNAME, '.', '___')
-END SUBROUTINE
-
-FUNCTION NEWIOCDF()
-TYPE(IOCDF), POINTER :: NEWIOCDF
-TYPE(IOCDF), POINTER :: TZIOCDF
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','NEWIOCDF','called')
-
-ALLOCATE(TZIOCDF, STAT=IRESP)
-IF (IRESP > 0) THEN
- CALL PRINT_MSG(NVERB_FATAL,'IO','NEWIOCDF','memory allocation error')
- STOP
-END IF
-
-NEWIOCDF=>TZIOCDF
-
-END FUNCTION NEWIOCDF
-
-SUBROUTINE CLEANIOCDF(PIOCDF)
-TYPE(IOCDF), POINTER :: PIOCDF
-
-INTEGER(KIND=IDCDF_KIND) :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','CLEANIOCDF','called')
-
-! Clean DIMLIST and DIMSTR
-CALL CLEANLIST(PIOCDF%DIMLIST)
-CALL CLEANLIST(PIOCDF%DIMSTR)
-! Then free iocdf
-DEALLOCATE(PIOCDF)
-
-CONTAINS
-
-SUBROUTINE CLEANLIST(PLIST)
-TYPE(DIMCDF), POINTER :: PLIST,TZDIMCUR, TZDIMNEXT
-
-TZDIMCUR => PLIST
-DO WHILE(ASSOCIATED(TZDIMCUR))
- TZDIMNEXT => TZDIMCUR%NEXT
- DEALLOCATE(TZDIMCUR)
- TZDIMCUR => TZDIMNEXT
-END DO
-
-END SUBROUTINE CLEANLIST
-
-END SUBROUTINE CLEANIOCDF
-
-
-SUBROUTINE IO_SET_KNOWNDIMS_NC4(TPFILE,HPROGRAM_ORIG)
-
-USE MODD_CONF, ONLY: CPROGRAM
-USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
-USE MODD_DIM_n, ONLY: NIMAX_ll, NJMAX_ll, NKMAX
-USE MODD_PARAMETERS_ll, ONLY: JPHEXT, JPVEXT
-
-TYPE(TFILEDATA),INTENT(INOUT) :: TPFILE
-CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: HPROGRAM_ORIG !To emulate a file coming from this program
-
-CHARACTER(LEN=:),ALLOCATABLE :: YPROGRAM
-INTEGER :: IIU_ll, IJU_ll, IKU
-TYPE(IOCDF), POINTER :: PIOCDF
+integer,parameter :: NSTRINGCHUNKSIZE = 16 !Dimension of the chunks of strings
+ !(to limit the number of dimensions for strings)
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_SET_KNOWNDIMS_NC4','called for '//TRIM(TPFILE%CNAME))
+integer(kind=idcdf_kind),parameter :: SHUFFLE = 1 !Set to 1 for (usually) better compression
+integer(kind=idcdf_kind),parameter :: DEFLATE = 1
-PIOCDF => TPFILE%TNCDIMS
+contains
-IF (PRESENT(HPROGRAM_ORIG)) THEN
- YPROGRAM = HPROGRAM_ORIG
-ELSE
- YPROGRAM = CPROGRAM
+SUBROUTINE IO_WRITE_FIELD_ATTR_NC4(TPFILE,TPFIELD,KVARID,OEXISTED,KSHAPE,HCALENDAR,OISCOORD)
+!
+USE MODD_CONF, ONLY: CPROGRAM, LCARTESIAN
+USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
+!
+USE MODE_FIELD, ONLY: TYPEINT, TYPEREAL
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+INTEGER(KIND=IDCDF_KIND), INTENT(IN) :: KVARID
+LOGICAL, INTENT(IN) :: OEXISTED !True if variable was already defined
+INTEGER(KIND=IDCDF_KIND),DIMENSION(:),OPTIONAL,INTENT(IN) :: KSHAPE
+CHARACTER(LEN=*), OPTIONAL,INTENT(IN) :: HCALENDAR
+LOGICAL, OPTIONAL,INTENT(IN) :: OISCOORD ! Is a coordinate variable (->do not write coordinates attribute)
+!
+INTEGER(KIND=IDCDF_KIND) :: INCID
+INTEGER(KIND=IDCDF_KIND) :: STATUS
+CHARACTER(LEN=:),ALLOCATABLE :: YCOORDS
+LOGICAL :: GISCOORD
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_ATTR_NC4','called for field '//TRIM(TPFIELD%CMNHNAME))
+!
+IF(LEN_TRIM(TPFIELD%CSTDNAME)==0 .AND. LEN_TRIM(TPFIELD%CLONGNAME)==0) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_ATTR_NC4','at least long_name or standard_name must be provided &
+ &to respect CF-convention for variable '//TRIM(TPFIELD%CMNHNAME))
ENDIF
-
-IIU_ll = NIMAX_ll + 2*JPHEXT
-IJU_ll = NJMAX_ll + 2*JPHEXT
-IKU = NKMAX + 2*JPVEXT
-
-IF (.NOT. ASSOCIATED(PIOCDF%DIM_NI)) PIOCDF%DIM_NI => GETDIMCDF(TPFILE, IIU_ll, 'ni')
-IF (.NOT. ASSOCIATED(PIOCDF%DIM_NJ)) PIOCDF%DIM_NJ => GETDIMCDF(TPFILE, IJU_ll, 'nj')
-IF (.NOT. ASSOCIATED(PIOCDF%DIM_NI_U)) PIOCDF%DIM_NI_U => GETDIMCDF(TPFILE, IIU_ll, 'ni_u')
-IF (.NOT. ASSOCIATED(PIOCDF%DIM_NJ_U)) PIOCDF%DIM_NJ_U => GETDIMCDF(TPFILE, IJU_ll, 'nj_u')
-IF (.NOT. ASSOCIATED(PIOCDF%DIM_NI_V)) PIOCDF%DIM_NI_V => GETDIMCDF(TPFILE, IIU_ll, 'ni_v')
-IF (.NOT. ASSOCIATED(PIOCDF%DIM_NJ_V)) PIOCDF%DIM_NJ_V => GETDIMCDF(TPFILE, IJU_ll, 'nj_v')
-IF (TRIM(YPROGRAM)/='PGD' .AND. TRIM(YPROGRAM)/='NESPGD' .AND. TRIM(YPROGRAM)/='ZOOMPG' &
- .AND. .NOT.(TRIM(YPROGRAM)=='REAL' .AND. CSTORAGE_TYPE=='SU') ) THEN !condition to detect PREP_SURFEX
- IF (.NOT. ASSOCIATED(PIOCDF%DIM_LEVEL)) PIOCDF%DIM_LEVEL => GETDIMCDF(TPFILE, IKU , 'level')
- IF (.NOT. ASSOCIATED(PIOCDF%DIM_LEVEL_W)) PIOCDF%DIM_LEVEL_W => GETDIMCDF(TPFILE, IKU , 'level_w')
- IF (.NOT. ASSOCIATED(PIOCDF%DIMTIME)) PIOCDF%DIMTIME => GETDIMCDF(TPFILE, NF90_UNLIMITED, 'time')
+!
+IF (TPFIELD%NDIMS>1 .AND. .NOT.PRESENT(KSHAPE)) &
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_WRITE_FIELD_ATTR_NC4','KSHAPE not provided for '//TRIM(TPFIELD%CMNHNAME))
+!
+IF (PRESENT(OISCOORD)) THEN
+ GISCOORD = OISCOORD
ELSE
- !PGD and SURFEX files for MesoNH have no vertical levels or time scale
- !These dimensions are allocated to default values
- !(they need to be allocated when looking for dimensions of variables)
- IF (.NOT. ASSOCIATED(PIOCDF%DIM_LEVEL)) ALLOCATE(PIOCDF%DIM_LEVEL)
- IF (.NOT. ASSOCIATED(PIOCDF%DIM_LEVEL_W)) ALLOCATE(PIOCDF%DIM_LEVEL_W)
- IF (.NOT. ASSOCIATED(PIOCDF%DIMTIME)) ALLOCATE(PIOCDF%DIMTIME)
+ GISCOORD = .FALSE.
END IF
-
-!Store X,Y,Z coordinates for the Arakawa points
-!0 2nd-dimension is to treat NGRID=0 case without crash
-IF (.NOT.ALLOCATED(TPFILE%TNCCOORDS)) ALLOCATE(TPFILE%TNCCOORDS(3,0:8))
-!Dummy point
-TPFILE%TNCCOORDS(1,0)%TDIM => TDIM_DUMMY
-TPFILE%TNCCOORDS(2,0)%TDIM => TDIM_DUMMY
-TPFILE%TNCCOORDS(3,0)%TDIM => TDIM_DUMMY
-! Mass point
-TPFILE%TNCCOORDS(1,1)%TDIM => PIOCDF%DIM_NI
-TPFILE%TNCCOORDS(2,1)%TDIM => PIOCDF%DIM_NJ
-TPFILE%TNCCOORDS(3,1)%TDIM => PIOCDF%DIM_LEVEL
-! u point
-TPFILE%TNCCOORDS(1,2)%TDIM => PIOCDF%DIM_NI_U
-TPFILE%TNCCOORDS(2,2)%TDIM => PIOCDF%DIM_NJ_U
-TPFILE%TNCCOORDS(3,2)%TDIM => PIOCDF%DIM_LEVEL
-! v point
-TPFILE%TNCCOORDS(1,3)%TDIM => PIOCDF%DIM_NI_V
-TPFILE%TNCCOORDS(2,3)%TDIM => PIOCDF%DIM_NJ_V
-TPFILE%TNCCOORDS(3,3)%TDIM => PIOCDF%DIM_LEVEL
-! w point
-TPFILE%TNCCOORDS(1,4)%TDIM => PIOCDF%DIM_NI
-TPFILE%TNCCOORDS(2,4)%TDIM => PIOCDF%DIM_NJ
-TPFILE%TNCCOORDS(3,4)%TDIM => PIOCDF%DIM_LEVEL_W
-! xi vorticity point (=f point =uv point)
-TPFILE%TNCCOORDS(1,5)%TDIM => PIOCDF%DIM_NI_U
-TPFILE%TNCCOORDS(2,5)%TDIM => PIOCDF%DIM_NJ_V
-TPFILE%TNCCOORDS(3,5)%TDIM => PIOCDF%DIM_LEVEL
-! eta vorticity point (=uw point)
-TPFILE%TNCCOORDS(1,6)%TDIM => PIOCDF%DIM_NI_U
-TPFILE%TNCCOORDS(2,6)%TDIM => PIOCDF%DIM_NJ_U
-TPFILE%TNCCOORDS(3,6)%TDIM => PIOCDF%DIM_LEVEL_W
-! zeta vorticity point (=vw point)
-TPFILE%TNCCOORDS(1,7)%TDIM => PIOCDF%DIM_NI_V
-TPFILE%TNCCOORDS(2,7)%TDIM => PIOCDF%DIM_NJ_V
-TPFILE%TNCCOORDS(3,7)%TDIM => PIOCDF%DIM_LEVEL_W
-! fw point (=uvw point)
-TPFILE%TNCCOORDS(1,8)%TDIM => PIOCDF%DIM_NI_U
-TPFILE%TNCCOORDS(2,8)%TDIM => PIOCDF%DIM_NJ_V
-TPFILE%TNCCOORDS(3,8)%TDIM => PIOCDF%DIM_LEVEL_W
-
-
-END SUBROUTINE IO_SET_KNOWNDIMS_NC4
-
-
-SUBROUTINE IO_WRITE_COORDVAR_NC4(TPFILE,HPROGRAM_ORIG)
-USE MODD_CONF, ONLY: CPROGRAM, LCARTESIAN
-USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
-USE MODD_GRID, ONLY: XLATORI, XLONORI
-USE MODD_GRID_n, ONLY: LSLEVE, XXHAT, XYHAT, XZHAT
-USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
-
-USE MODE_FIELD, ONLY: TFIELDLIST,FIND_FIELD_ID_FROM_MNHNAME
-USE MODE_GRIDPROJ
-USE MODE_NEST_ll, ONLY: GET_MODEL_NUMBER_ll, GO_TOMODEL_ll
-
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: HPROGRAM_ORIG !To emulate a file coming from this program
-
-CHARACTER(LEN=:),ALLOCATABLE :: YSTDNAMEPREFIX
-CHARACTER(LEN=:),ALLOCATABLE :: YPROGRAM
-INTEGER :: IIU, IJU, IKU
-INTEGER :: ID, IID, IRESP
-INTEGER :: IMI
-INTEGER(KIND=IDCDF_KIND) :: INCID
-LOGICAL :: GCHANGEMODEL
-LOGICAL,POINTER :: GSLEVE
-REAL,DIMENSION(:),POINTER :: ZXHAT, ZYHAT, ZZHAT
-REAL,DIMENSION(:),ALLOCATABLE :: ZXHATM, ZYHATM,ZZHATM !Coordinates at mass points in the transformed space
-REAL,DIMENSION(:,:),POINTER :: ZLAT, ZLON
-TYPE(IOCDF), POINTER :: PIOCDF
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_COORDVAR_NC4','called for '//TRIM(TPFILE%CNAME))
-
-ZXHAT => NULL()
-ZYHAT => NULL()
-ZZHAT => NULL()
-
-PIOCDF => TPFILE%TNCDIMS
-
-GCHANGEMODEL = .FALSE.
-
-IF (PRESENT(HPROGRAM_ORIG)) THEN
- YPROGRAM = HPROGRAM_ORIG
+!
+INCID = TPFILE%NNCID
+!
+! Standard_name attribute definition (CF convention)
+IF(LEN_TRIM(TPFIELD%CSTDNAME)==0) THEN
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_ATTR_NC4','TPFIELD%CSTDNAME not set for variable '//TRIM(TPFIELD%CMNHNAME))
ELSE
- YPROGRAM = CPROGRAM
+ STATUS = NF90_PUT_ATT(INCID, KVARID,'standard_name', TRIM(TPFIELD%CSTDNAME))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_ATTR_NC4 [NF90_PUT_ATT]')
ENDIF
-
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
-
-IF (TPFILE%NMODEL>0) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('XHAT',IID,IRESP)
- ZXHAT => TFIELDLIST(IID)%TFIELD_X1D(TPFILE%NMODEL)%DATA
- CALL FIND_FIELD_ID_FROM_MNHNAME('YHAT',IID,IRESP)
- ZYHAT => TFIELDLIST(IID)%TFIELD_X1D(TPFILE%NMODEL)%DATA
- CALL FIND_FIELD_ID_FROM_MNHNAME('ZHAT',IID,IRESP)
- ZZHAT => TFIELDLIST(IID)%TFIELD_X1D(TPFILE%NMODEL)%DATA
- CALL FIND_FIELD_ID_FROM_MNHNAME('SLEVE',IID,IRESP)
- GSLEVE => TFIELDLIST(IID)%TFIELD_L0D(TPFILE%NMODEL)%DATA
- !
- CALL GET_MODEL_NUMBER_ll(IMI)
- IF (IMI/=TPFILE%NMODEL) THEN
- !This is necessary to have correct domain sizes (used by GATHER_XXFIELD)
- CALL GO_TOMODEL_ll(TPFILE%NMODEL,IRESP)
- GCHANGEMODEL = .TRUE.
- END IF
+!
+! Long_name attribute definition (CF convention)
+IF(LEN_TRIM(TPFIELD%CLONGNAME)==0) THEN
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_ATTR_NC4','TPFIELD%CLONGNAME not set for variable '//TRIM(TPFIELD%CMNHNAME))
ELSE
- ZXHAT => XXHAT
- ZYHAT => XYHAT
- ZZHAT => XZHAT
- GSLEVE => LSLEVE
-END IF
-
-IIU = SIZE(ZXHAT)
-IJU = SIZE(ZYHAT)
-ALLOCATE(ZXHATM(IIU),ZYHATM(IJU))
-!ZXHATM(IIU) and ZYHATM(IJU) are correct only on some processes
-!but it is OK due to the way GATHER_XXFIELD is done
-ZXHATM(1:IIU-1) = 0.5*(ZXHAT(1:IIU-1)+ZXHAT(2:IIU))
-ZXHATM(IIU) = 2.*ZXHAT(IIU)-ZXHATM(IIU-1)
-ZYHATM(1:IJU-1) = 0.5*(ZYHAT(1:IJU-1)+ZYHAT(2:IJU))
-ZYHATM(IJU) = 2.*ZYHAT(IJU)-ZYHATM(IJU-1)
+ STATUS = NF90_PUT_ATT(INCID, KVARID,'long_name', TRIM(TPFIELD%CLONGNAME))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_ATTR_NC4 [NF90_PUT_ATT]')
+ENDIF
!
-IF (LCARTESIAN) THEN
- YSTDNAMEPREFIX = 'plane'
+! Canonical units attribute definition (CF convention)
+IF(LEN_TRIM(TPFIELD%CUNITS)==0) THEN
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_ATTR_NC4','TPFIELD%CUNITS not set for variable '//TRIM(TPFIELD%CMNHNAME))
ELSE
- YSTDNAMEPREFIX = 'projection'
+ STATUS = NF90_PUT_ATT(INCID, KVARID,'units', TRIM(TPFIELD%CUNITS))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_ATTR_NC4 [NF90_PUT_ATT]')
ENDIF
-CALL WRITE_HOR_COORD(PIOCDF%DIM_NI,'x-dimension of the grid',TRIM(YSTDNAMEPREFIX)//'_x_coordinate','X',0.,JPHEXT,JPHEXT,ZXHATM)
-CALL WRITE_HOR_COORD(PIOCDF%DIM_NJ,'y-dimension of the grid',TRIM(YSTDNAMEPREFIX)//'_y_coordinate','Y',0.,JPHEXT,JPHEXT,ZYHATM)
-CALL WRITE_HOR_COORD(PIOCDF%DIM_NI_U,'x-dimension of the grid at u location', &
- TRIM(YSTDNAMEPREFIX)//'_x_coordinate_at_u_location','X',-0.5,JPHEXT,0, ZXHAT)
-CALL WRITE_HOR_COORD(PIOCDF%DIM_NJ_U,'y-dimension of the grid at u location', &
- TRIM(YSTDNAMEPREFIX)//'_y_coordinate_at_u_location','Y', 0., JPHEXT,JPHEXT,ZYHATM)
-CALL WRITE_HOR_COORD(PIOCDF%DIM_NI_V,'x-dimension of the grid at v location', &
- TRIM(YSTDNAMEPREFIX)//'_x_coordinate_at_v_location','X', 0., JPHEXT,JPHEXT,ZXHATM)
-CALL WRITE_HOR_COORD(PIOCDF%DIM_NJ_V,'y-dimension of the grid at v location', &
- TRIM(YSTDNAMEPREFIX)//'_y_coordinate_at_v_location','Y',-0.5,JPHEXT,0, ZYHAT)
!
-IF (.NOT.LCARTESIAN) THEN
- ALLOCATE(ZLAT(IIU,IJU),ZLON(IIU,IJU))
- !
- !Compute latitude/longitude for the Arakawa points
- !
- ! Mass point
- CALL WRITE_HOR_2DCOORD(ZXHATM,ZYHATM,'latitude', 'longitude')
- ! u point
- CALL WRITE_HOR_2DCOORD(ZXHAT, ZYHATM,'latitude_u','longitude_u')
- ! v point
- CALL WRITE_HOR_2DCOORD(ZXHATM,ZYHAT, 'latitude_v','longitude_v')
- ! xi vorticity point (=f point =uv point)
- CALL WRITE_HOR_2DCOORD(ZXHAT, ZYHAT, 'latitude_f','longitude_f')
- !
- DEALLOCATE(ZLAT,ZLON)
-END IF
+! GRID attribute definition
+IF(TPFIELD%NGRID<0) THEN
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_ATTR_NC4','TPFIELD%NGRID not set for variable '//TRIM(TPFIELD%CMNHNAME))
+!Do not write GRID attribute if NGRID=0
+ELSE IF (TPFIELD%NGRID>0) THEN
+ STATUS = NF90_PUT_ATT(INCID, KVARID, 'grid', TPFIELD%NGRID)
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_ATTR_NC4 [NF90_PUT_ATT]')
+ENDIF
!
-DEALLOCATE(ZXHATM,ZYHATM)
+! COMMENT attribute definition
+IF(LEN_TRIM(TPFIELD%CCOMMENT)==0) THEN
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_ATTR_NC4','TPFIELD%CCOMMENT not set for variable '//TRIM(TPFIELD%CMNHNAME))
+ELSE
+ STATUS = NF90_PUT_ATT(INCID, KVARID,'comment', TRIM(TPFIELD%CCOMMENT))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_ATTR_NC4 [NF90_PUT_ATT]')
+ENDIF
!
-IF (TPFILE%LMASTER) THEN !vertical coordinates in the transformed space are the same on all processes
- IF (TRIM(YPROGRAM)/='PGD' .AND. TRIM(YPROGRAM)/='NESPGD' .AND. TRIM(YPROGRAM)/='ZOOMPG' &
- .AND. .NOT.(TRIM(YPROGRAM)=='REAL' .AND. CSTORAGE_TYPE=='SU') ) THEN !condition to detect PREP_SURFEX
- !
- IKU = SIZE(ZZHAT)
- ALLOCATE(ZZHATM(IKU))
- ZZHATM(1:IKU-1) = 0.5 * (ZZHAT(2:IKU)+ZZHAT(1:IKU-1))
- ZZHATM(IKU) = 2.* ZZHAT(IKU) - ZZHATM(IKU-1)
- !
- CALL WRITE_VER_COORD(PIOCDF%DIM_LEVEL, 'position z in the transformed space', '', &
- 'altitude', 0., JPVEXT,JPVEXT,ZZHATM)
- !
- CALL WRITE_VER_COORD(PIOCDF%DIM_LEVEL_W,'position z in the transformed space at w location','', &
- 'altitude_at_w_location',-0.5,JPVEXT,0, ZZHAT)
- !
- DEALLOCATE(ZZHATM)
- END IF
-END IF
-!
-!Write time scale
-IF (TPFILE%LMASTER) THEN !Time scale is the same on all processes
- IF (TRIM(YPROGRAM)/='PGD' .AND. TRIM(YPROGRAM)/='NESPGD' .AND. TRIM(YPROGRAM)/='ZOOMPG' &
- .AND. .NOT.(TRIM(YPROGRAM)=='REAL' .AND. CSTORAGE_TYPE=='SU') ) THEN !condition to detect PREP_SURFEX
- CALL WRITE_TIME_COORD(PIOCDF%DIMTIME)
- END IF
-END IF
-
-IF (GCHANGEMODEL) CALL GO_TOMODEL_ll(IMI,IRESP)
-
-CONTAINS
-SUBROUTINE WRITE_HOR_COORD(TDIM,HLONGNAME,HSTDNAME,HAXIS,PSHIFT,KBOUNDLOW,KBOUNDHIGH,PCOORDS)
- USE MODE_ALLOCBUFFER_ll, ONLY: ALLOCBUFFER_ll
- USE MODE_GATHER_ll, ONLY: GATHER_XXFIELD
-
- TYPE(DIMCDF), POINTER, INTENT(IN) :: TDIM
- CHARACTER(LEN=*), INTENT(IN) :: HLONGNAME
- CHARACTER(LEN=*), INTENT(IN) :: HSTDNAME
- CHARACTER(LEN=*), INTENT(IN) :: HAXIS
- REAL, INTENT(IN) :: PSHIFT
- INTEGER, INTENT(IN) :: KBOUNDLOW
- INTEGER, INTENT(IN) :: KBOUNDHIGH
- REAL,DIMENSION(:),TARGET,OPTIONAL,INTENT(IN) :: PCOORDS
-
- CHARACTER(LEN=2) :: YDIR
- CHARACTER(LEN=64) :: YRANGE
- CHARACTER(LEN=:),ALLOCATABLE :: YVARNAME
- INTEGER :: IRESP
- INTEGER :: ISIZE
- INTEGER :: JI
- INTEGER(KIND=IDCDF_KIND) :: IVARID
- INTEGER(KIND=IDCDF_KIND) :: IVDIM
- INTEGER(KIND=IDCDF_KIND) :: STATUS
- LOGICAL :: GALLOC
- REAL,DIMENSION(:),POINTER :: ZTAB
-
- GALLOC = .FALSE.
- ZTAB => NULL()
-
- IF (HAXIS=='X') THEN
- YDIR = 'XX'
- ELSE IF (HAXIS=='Y') THEN
- YDIR = 'YY'
- ELSE
- CALL PRINT_MSG(NVERB_FATAL,'IO','WRITE_HOR_COORD','invalid HAXIS ('//TRIM(HAXIS)//')')
- END IF
-
- IF (.NOT.TPFILE%LMASTER) THEN
- IF (PRESENT(PCOORDS)) THEN
- ALLOCATE(ZTAB(0)) !To prevent false positive with valgrind
- GALLOC = .TRUE.
- CALL GATHER_XXFIELD(YDIR,PCOORDS,ZTAB,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
- END IF
- ELSE !TPFILE%LMASTER
- ISIZE = TDIM%LEN
- YVARNAME = TRIM(TDIM%NAME)
- IVDIM = TDIM%ID
-
- IF (.NOT.PRESENT(PCOORDS)) THEN
- ALLOCATE(ZTAB(ISIZE))
- GALLOC = .TRUE.
- DO JI=1,ISIZE
- ZTAB(JI) = REAL(JI,KIND=KIND(ZTAB(1)))+PSHIFT
- END DO
- ELSE
- IF (GSMONOPROC) THEN ! sequential execution
- ZTAB => PCOORDS
- ELSE ! multiprocesses execution
- CALL ALLOCBUFFER_ll(ZTAB,PCOORDS,YDIR,GALLOC)
- CALL GATHER_XXFIELD(YDIR,PCOORDS,ZTAB,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
- ENDIF
- END IF
-
- STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
- IF (STATUS /= NF90_NOERR) THEN
- ! Define the coordinate variable
-#if (MNH_REAL == 8)
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVDIM, IVARID)
-#else
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIM, IVARID)
-#endif
- IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_DEF_VAR]')
- ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','WRITE_NC_COORDS_VAR',TRIM(YVARNAME)//' already defined')
- END IF
-
- ! Write metadata
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'long_name',HLONGNAME)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'standard_name',HSTDNAME)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
- IF (PRESENT(PCOORDS)) THEN
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'units','m')
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
- END IF
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'axis',HAXIS)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'c_grid_axis_shift',PSHIFT)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
- WRITE(YRANGE,'( I0,":",I0 )') 1+KBOUNDLOW,ISIZE-KBOUNDHIGH
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'c_grid_dynamic_range',TRIM(YRANGE))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
-
- ! Write the data
- STATUS = NF90_PUT_VAR(INCID, IVARID, ZTAB)
- IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
- END IF
-
- IF (GALLOC) DEALLOCATE(ZTAB)
-END SUBROUTINE WRITE_HOR_COORD
-
-SUBROUTINE WRITE_HOR_2DCOORD(PX,PY,HLAT,HLON)
- USE MODE_ALLOCBUFFER_ll, ONLY: ALLOCBUFFER_ll
- USE MODE_GATHER_ll, ONLY: GATHER_XYFIELD
-
- REAL,DIMENSION(:), INTENT(IN) :: PX
- REAL,DIMENSION(:), INTENT(IN) :: PY
- CHARACTER(LEN=*), INTENT(IN) :: HLAT
- CHARACTER(LEN=*), INTENT(IN) :: HLON
-
- LOGICAL :: GALLOC1, GALLOC2
- REAL,DIMENSION(:,:),POINTER :: ZTAB1, ZTAB2
-
- GALLOC1 = .FALSE.
- GALLOC2 = .FALSE.
- ZTAB1 => NULL()
- ZTAB2 => NULL()
-
- CALL SM_LATLON(XLATORI,XLONORI, &
- SPREAD(SOURCE=PX,DIM=2,NCOPIES=IJU), &
- SPREAD(SOURCE=PY,DIM=1,NCOPIES=IIU), &
- ZLAT,ZLON)
-
- IF (.NOT.TPFILE%LMASTER) THEN
- ALLOCATE(ZTAB1(0,0),ZTAB2(0,0)) !To prevent false positive with valgrind
- GALLOC1 = .TRUE. ; GALLOC2 = .TRUE.
- CALL GATHER_XYFIELD(ZLAT,ZTAB1,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
- CALL GATHER_XYFIELD(ZLON,ZTAB2,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
- ELSE !TPFILE%LMASTER
- IF (GSMONOPROC) THEN ! sequential execution
- ZTAB1 => ZLAT
- ZTAB2 => ZLON
- ELSE ! multiprocesses execution
- CALL ALLOCBUFFER_ll(ZTAB1,ZLAT,'XY',GALLOC1)
- CALL ALLOCBUFFER_ll(ZTAB2,ZLON,'XY',GALLOC2)
- CALL GATHER_XYFIELD(ZLAT,ZTAB1,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
- CALL GATHER_XYFIELD(ZLON,ZTAB2,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
- ENDIF
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME(HLAT,ID,IRESP)
- CALL IO_WRITE_FIELD_NC4_X2(TPFILE,TFIELDLIST(ID),ZTAB1,IRESP,OISCOORD=.TRUE.)
- CALL FIND_FIELD_ID_FROM_MNHNAME(HLON,ID,IRESP)
- CALL IO_WRITE_FIELD_NC4_X2(TPFILE,TFIELDLIST(ID),ZTAB2,IRESP,OISCOORD=.TRUE.)
- END IF
-
- IF (GALLOC1) DEALLOCATE(ZTAB1)
- IF (GALLOC2) DEALLOCATE(ZTAB2)
-END SUBROUTINE WRITE_HOR_2DCOORD
-
-SUBROUTINE WRITE_VER_COORD(TDIM,HLONGNAME,HSTDNAME,HCOMPNAME,PSHIFT,KBOUNDLOW,KBOUNDHIGH,PCOORDS)
- TYPE(DIMCDF), POINTER, INTENT(IN) :: TDIM
- CHARACTER(LEN=*), INTENT(IN) :: HLONGNAME
- CHARACTER(LEN=*), INTENT(IN) :: HSTDNAME
- CHARACTER(LEN=*), INTENT(IN) :: HCOMPNAME
- REAL, INTENT(IN) :: PSHIFT
- INTEGER, INTENT(IN) :: KBOUNDLOW
- INTEGER, INTENT(IN) :: KBOUNDHIGH
- REAL,DIMENSION(:), INTENT(IN) :: PCOORDS
-
- CHARACTER(LEN=64) :: YRANGE
- CHARACTER(LEN=:),ALLOCATABLE :: YVARNAME
- INTEGER :: IRESP
- INTEGER :: ISIZE
- INTEGER :: JI
- INTEGER(KIND=IDCDF_KIND) :: IVARID
- INTEGER(KIND=IDCDF_KIND) :: IVDIM
- INTEGER(KIND=IDCDF_KIND) :: STATUS
-
- ISIZE = TDIM%LEN
- YVARNAME = TRIM(TDIM%NAME)
- IVDIM = TDIM%ID
-
- STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
- IF (STATUS /= NF90_NOERR) THEN
- ! Define the coordinate variable
-#if (MNH_REAL == 8)
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVDIM, IVARID)
-#else
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIM, IVARID)
-#endif
- IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_DEF_VAR]')
- ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','WRITE_NC_COORDS_VAR',TRIM(YVARNAME)//' already defined')
- END IF
-
- ! Write metadata
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'long_name',HLONGNAME)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'standard_name',HSTDNAME)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'units','m')
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'axis','Z')
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'positive','up')
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'c_grid_axis_shift',PSHIFT)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
- WRITE(YRANGE,'( I0,":",I0 )') 1+KBOUNDLOW,ISIZE-KBOUNDHIGH
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'c_grid_dynamic_range',TRIM(YRANGE))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
- !
- IF (GSLEVE) THEN
- !Remark: ZS, ZSMT and ZTOP in the formula are the same for mass point or flux point
- STATUS = NF90_PUT_ATT(INCID, IVARID,'formula_terms','s: '//TRIM(YVARNAME)// &
- ' height: ZTOP oro_ls: ZSMT oro: ZS len1: LEN1 len2: LEN2')
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'formula_definition','z(n,k,j,i)=s(k)'// &
- '+ oro_ls(j,i)*sinh((height/len1)**1.35-(s(k)/len1)**1.35)/sinh((s(k)/len1)**1.35)'// &
- '+(oro(j,i)-oro_ls(j,i))*sinh((height/len2)**1.35-(s(k)/len2)**1.35)/sinh((s(k)/len2)**1.35)')
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
- ELSE
- !Remark: ZS and ZTOP in the formula are the same for mass point or flux point
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'formula_terms','s: '//TRIM(YVARNAME)//' height: ZTOP orog: ZS')
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'formula_definition','z(n,k,j,i)=s(k)*(height-orog(j,i))/height+orog(j,i)')
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
- ENDIF
- !
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'computed_standard_name',HCOMPNAME)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
-
- ! Write the data
- STATUS = NF90_PUT_VAR(INCID, IVARID, PCOORDS)
- IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
-
-END SUBROUTINE WRITE_VER_COORD
-
-SUBROUTINE WRITE_TIME_COORD(TDIM)
- USE MODD_TIME_n, ONLY: TDTMOD, TDTCUR
- USE MODD_TYPE_DATE
-
- USE MODE_DATETIME
- USE MODE_FIELD, ONLY: TFIELDLIST,FIND_FIELD_ID_FROM_MNHNAME
- USE MODE_GRIDPROJ
-
- TYPE(DIMCDF), POINTER, INTENT(IN) :: TDIM
-
- REAL :: ZDELTATIME
- CHARACTER(LEN=40) :: YUNITS
- CHARACTER(LEN=:),ALLOCATABLE :: YVARNAME
- INTEGER(KIND=IDCDF_KIND) :: IVARID
- INTEGER(KIND=IDCDF_KIND) :: IVDIM
- INTEGER(KIND=IDCDF_KIND) :: STATUS
- TYPE(DATE_TIME) :: TZREF
-
-
- IF (ASSOCIATED(TDTCUR) .AND. ASSOCIATED(TDTMOD)) THEN
- YVARNAME = TRIM(TDIM%NAME)
- IVDIM = TDIM%ID
-
- STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
- IF (STATUS /= NF90_NOERR) THEN
- ! Define the coordinate variable
-#if (MNH_REAL == 8)
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVDIM, IVARID)
-#else
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIM, IVARID)
-#endif
- IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_TIME_COORD[NF90_DEF_VAR]')
- ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','WRITE_TIME_COORD',TRIM(YVARNAME)//' already defined')
- END IF
-
- ! Write metadata
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'long_name','time axis')
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'standard_name','time')
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
- WRITE(YUNITS,'( "seconds since ",I4.4,"-",I2.2,"-",I2.2," 00:00:00 +0:00" )') &
- TDTMOD%TDATE%YEAR,TDTMOD%TDATE%MONTH,TDTMOD%TDATE%DAY
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'units',YUNITS)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'axis','T')
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
- STATUS = NF90_PUT_ATT(INCID, IVARID,'calendar','standard')
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_ATT]')
-
- ! Model beginning date (TDTMOD%TDATE) is used as the reference date
- ! Reference time is set to 0.
- TZREF = TDTMOD
- TZREF%TIME = 0.
- ! Compute the temporal distance from reference
- CALL DATETIME_DISTANCE(TZREF,TDTCUR,ZDELTATIME)
- ! Write the data
- STATUS = NF90_PUT_VAR(INCID, IVARID, ZDELTATIME)
- IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
- END IF
-
-END SUBROUTINE WRITE_TIME_COORD
-
-END SUBROUTINE IO_WRITE_COORDVAR_NC4
-
-
-SUBROUTINE HANDLE_ERR(STATUS,LINE,TEXT,KRESP)
-INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: STATUS
-INTEGER, INTENT(IN) :: LINE
-CHARACTER(LEN=*), INTENT(IN) :: TEXT
-INTEGER, OPTIONAL, INTENT(OUT) :: KRESP
-
-CHARACTER(LEN=6) :: YLINE
-
-WRITE(YLINE,'( I6 )') LINE
-
-! Don't stop (by default) the code when KRESP is present
-! and ensure KRESP is a negative integer
-IF (STATUS /= NF90_NOERR) THEN
- IF (PRESENT(KRESP)) THEN
- IF (STATUS < 0) THEN
- KRESP = STATUS
- ELSE IF (STATUS == 0) THEN
- KRESP = -1
- ELSE
- KRESP = -STATUS
- END IF
- CALL PRINT_MSG(NVERB_WARNING,'IO',TRIM(TEXT),'NetCDF error at line '//TRIM(YLINE)//': '//TRIM(NF90_STRERROR(STATUS)))
- ELSE
- CALL PRINT_MSG(NVERB_FATAL,'IO',TRIM(TEXT),'NetCDF error at line '//TRIM(YLINE)//': '//TRIM(NF90_STRERROR(STATUS)))
- END IF
-END IF
-END SUBROUTINE HANDLE_ERR
-
-FUNCTION str_replace(hstr, hold, hnew)
-CHARACTER(LEN=*) :: hstr, hold, hnew
-CHARACTER(LEN=LEN_TRIM(hstr)+MAX(0,LEN(hnew)-LEN(hold))) :: str_replace
-
-INTEGER :: pos
-
-pos = INDEX(hstr,hold)
-IF (pos /= 0) THEN
- str_replace = hstr(1:pos-1)//hnew//hstr(pos+LEN(hold):)
-ELSE
- str_replace = hstr
-END IF
-
-END FUNCTION str_replace
-
-SUBROUTINE IO_WRITE_HEADER_NC4(TPFILE)
-!
-USE MODD_IO_ll, ONLY: TFILEDATA
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File structure
-!
-INTEGER(KIND=IDCDF_KIND) :: ISTATUS
-!
-IF (TRIM(TPFILE%CFORMAT)/='NETCDF4' .AND. TRIM(TPFILE%CFORMAT)/='LFICDF4') RETURN
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_HEADER_NC4','called for file '//TRIM(TPFILE%CNAME))
-!
-IF (TPFILE%LMASTER) THEN
- ISTATUS = NF90_PUT_ATT(TPFILE%NNCID, NF90_GLOBAL, 'Conventions', 'CF-1.7 COMODO-1.4')
- IF (ISTATUS /= NF90_NOERR) CALL HANDLE_ERR(ISTATUS,__LINE__,'IO_FILE_WRITE_HEADER[NF90_PUT_ATT]')
-
-#if (MNH_REAL == 8)
- ISTATUS = NF90_PUT_ATT(TPFILE%NNCID, NF90_GLOBAL, 'MNH_REAL', '8')
-#else
- ISTATUS = NF90_PUT_ATT(TPFILE%NNCID, NF90_GLOBAL, 'MNH_REAL', '4')
-#endif
- IF (ISTATUS /= NF90_NOERR) CALL HANDLE_ERR(ISTATUS,__LINE__,'IO_FILE_WRITE_HEADER[NF90_PUT_ATT]')
-
-#if (MNH_INT == 4)
- ISTATUS = NF90_PUT_ATT(TPFILE%NNCID, NF90_GLOBAL, 'MNH_INT', '4')
-#else
- ISTATUS = NF90_PUT_ATT(TPFILE%NNCID, NF90_GLOBAL, 'MNH_INT', '8')
-#endif
- IF (ISTATUS /= NF90_NOERR) CALL HANDLE_ERR(ISTATUS,__LINE__,'IO_FILE_WRITE_HEADER[NF90_PUT_ATT]')
-
-!title
-
- !history
- CALL IO_APPEND_HISTORY_NC4(TPFILE)
-
-!institution
-
-!source
-
-!comment
-
-!references
-END IF
-!
-END SUBROUTINE IO_WRITE_HEADER_NC4
-
-
-SUBROUTINE IO_APPEND_HISTORY_NC4(TPFILE)
-!
-USE MODD_IO_ll, ONLY: TFILEDATA
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File structure
-!
-INTEGER,PARAMETER :: YEAR=1, MONTH=2, DAY=3, HH=5, MM=6, SS=7
-!
-CHARACTER(len=5) :: YZONE
-CHARACTER(LEN=:),ALLOCATABLE :: YCMD, YHISTORY, YHISTORY_NEW, YHISTORY_PREV
-INTEGER :: ILEN_CMD, ILEN_PREV
-INTEGER(KIND=IDCDF_KIND) :: ISTATUS
-INTEGER,DIMENSION(8) :: IDATETIME
-!
-IF (TRIM(TPFILE%CFORMAT)/='NETCDF4' .AND. TRIM(TPFILE%CFORMAT)/='LFICDF4') RETURN
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_APPEND_HISTORY_NC4','called for file '//TRIM(TPFILE%CNAME))
-!
-IF (TPFILE%LMASTER) THEN
- !Check if history attribute already exists in file and read it
- ISTATUS = NF90_INQUIRE_ATTRIBUTE(TPFILE%NNCID, NF90_GLOBAL, 'history', LEN=ILEN_PREV)
- IF (ISTATUS == NF90_NOERR) THEN
- ALLOCATE(CHARACTER(LEN=ILEN_PREV) :: YHISTORY_PREV)
- ISTATUS = NF90_GET_ATT(TPFILE%NNCID, NF90_GLOBAL, 'history', YHISTORY_PREV)
- IF (ISTATUS /= NF90_NOERR) CALL HANDLE_ERR(ISTATUS,__LINE__,'IO_APPEND_HISTORY_NC4[NF90_GET_ATT]')
- YHISTORY_PREV = YHISTORY_PREV
- ELSE
- ILEN_PREV = 0
- END IF
-
- !Get date and time
- call DATE_AND_TIME( VALUES=IDATETIME, ZONE=YZONE )
- call GET_COMMAND(lENGTH=ILEN_CMD)
- IF (ILEN_CMD>0) THEN
- ALLOCATE(CHARACTER(ILEN_CMD) :: YCMD)
- CALL GET_COMMAND(COMMAND=YCMD)
- END IF
-
- !Prepare new history entry
- ALLOCATE(CHARACTER(26+ILEN_CMD) :: YHISTORY_NEW)
- WRITE(YHISTORY_NEW, '( I4.4,"-",I2.2,"-",I2.2,"T",I2.2,":",I2.2,":",I2.2,A5,": ", A )') &
- IDATETIME(YEAR),IDATETIME(MONTH),IDATETIME(DAY),IDATETIME(HH),IDATETIME(MM),IDATETIME(SS),YZONE, YCMD
-
- !Write full history
- IF (ILEN_PREV == 0) THEN
- YHISTORY = YHISTORY_NEW
- ELSE
- YHISTORY = YHISTORY_NEW//NEW_LINE('A')//YHISTORY_PREV
- END IF
- ISTATUS = NF90_PUT_ATT(TPFILE%NNCID, NF90_GLOBAL, 'history', YHISTORY )
- IF (ISTATUS /= NF90_NOERR) CALL HANDLE_ERR(ISTATUS,__LINE__,'IO_APPEND_HISTORY_NC4[NF90_PUT_ATT]')
-END IF
-
-END SUBROUTINE IO_APPEND_HISTORY_NC4
-
-
-SUBROUTINE IO_WRITE_FIELD_ATTR_NC4(TPFILE,TPFIELD,KVARID,OEXISTED,KSHAPE,HCALENDAR,OISCOORD)
-!
-USE MODD_CONF, ONLY: CPROGRAM, LCARTESIAN
-USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
-!
-USE MODE_FIELD, ONLY: TYPEINT, TYPEREAL
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
-INTEGER(KIND=IDCDF_KIND), INTENT(IN) :: KVARID
-LOGICAL, INTENT(IN) :: OEXISTED !True if variable was already defined
-INTEGER(KIND=IDCDF_KIND),DIMENSION(:),OPTIONAL,INTENT(IN) :: KSHAPE
-CHARACTER(LEN=*), OPTIONAL,INTENT(IN) :: HCALENDAR
-LOGICAL, OPTIONAL,INTENT(IN) :: OISCOORD ! Is a coordinate variable (->do not write coordinates attribute)
-!
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-CHARACTER(LEN=:),ALLOCATABLE :: YCOORDS
-LOGICAL :: GISCOORD
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_ATTR_NC4','called for field '//TRIM(TPFIELD%CMNHNAME))
-!
-IF(LEN_TRIM(TPFIELD%CSTDNAME)==0 .AND. LEN_TRIM(TPFIELD%CLONGNAME)==0) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_ATTR_NC4','at least long_name or standard_name must be provided &
- &to respect CF-convention for variable '//TRIM(TPFIELD%CMNHNAME))
-ENDIF
-!
-IF (TPFIELD%NDIMS>1 .AND. .NOT.PRESENT(KSHAPE)) &
- CALL PRINT_MSG(NVERB_FATAL,'IO','IO_WRITE_FIELD_ATTR_NC4','KSHAPE not provided for '//TRIM(TPFIELD%CMNHNAME))
-!
-IF (PRESENT(OISCOORD)) THEN
- GISCOORD = OISCOORD
-ELSE
- GISCOORD = .FALSE.
-END IF
-!
-INCID = TPFILE%NNCID
-!
-! Standard_name attribute definition (CF convention)
-IF(LEN_TRIM(TPFIELD%CSTDNAME)==0) THEN
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_ATTR_NC4','TPFIELD%CSTDNAME not set for variable '//TRIM(TPFIELD%CMNHNAME))
-ELSE
- STATUS = NF90_PUT_ATT(INCID, KVARID,'standard_name', TRIM(TPFIELD%CSTDNAME))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_ATTR_NC4 [NF90_PUT_ATT]')
-ENDIF
-!
-! Long_name attribute definition (CF convention)
-IF(LEN_TRIM(TPFIELD%CLONGNAME)==0) THEN
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_ATTR_NC4','TPFIELD%CLONGNAME not set for variable '//TRIM(TPFIELD%CMNHNAME))
-ELSE
- STATUS = NF90_PUT_ATT(INCID, KVARID,'long_name', TRIM(TPFIELD%CLONGNAME))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_ATTR_NC4 [NF90_PUT_ATT]')
-ENDIF
-!
-! Canonical units attribute definition (CF convention)
-IF(LEN_TRIM(TPFIELD%CUNITS)==0) THEN
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_ATTR_NC4','TPFIELD%CUNITS not set for variable '//TRIM(TPFIELD%CMNHNAME))
-ELSE
- STATUS = NF90_PUT_ATT(INCID, KVARID,'units', TRIM(TPFIELD%CUNITS))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_ATTR_NC4 [NF90_PUT_ATT]')
-ENDIF
-!
-! GRID attribute definition
-IF(TPFIELD%NGRID<0) THEN
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_ATTR_NC4','TPFIELD%NGRID not set for variable '//TRIM(TPFIELD%CMNHNAME))
-!Do not write GRID attribute if NGRID=0
-ELSE IF (TPFIELD%NGRID>0) THEN
- STATUS = NF90_PUT_ATT(INCID, KVARID, 'grid', TPFIELD%NGRID)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_ATTR_NC4 [NF90_PUT_ATT]')
-ENDIF
-!
-! COMMENT attribute definition
-IF(LEN_TRIM(TPFIELD%CCOMMENT)==0) THEN
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_ATTR_NC4','TPFIELD%CCOMMENT not set for variable '//TRIM(TPFIELD%CMNHNAME))
-ELSE
- STATUS = NF90_PUT_ATT(INCID, KVARID,'comment', TRIM(TPFIELD%CCOMMENT))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_ATTR_NC4 [NF90_PUT_ATT]')
-ENDIF
-!
-! Calendar (CF convention)
-IF(PRESENT(HCALENDAR)) THEN
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_ATTR_NC4','CALENDAR provided for variable '//TRIM(TPFIELD%CMNHNAME))
- STATUS = NF90_PUT_ATT(INCID, KVARID,'calendar', TRIM(HCALENDAR))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_ATTR_NC4 [NF90_PUT_ATT]')
-ENDIF
+! Calendar (CF convention)
+IF(PRESENT(HCALENDAR)) THEN
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_ATTR_NC4','CALENDAR provided for variable '//TRIM(TPFIELD%CMNHNAME))
+ STATUS = NF90_PUT_ATT(INCID, KVARID,'calendar', TRIM(HCALENDAR))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_ATTR_NC4 [NF90_PUT_ATT]')
+ENDIF
!
! Coordinates (CF convention)
IF (.NOT.GISCOORD) THEN
@@ -943,425 +199,43 @@ IF(TPFIELD%NTYPE==TYPEINT .AND. TPFIELD%NDIMS>0) THEN
!
STATUS = NF90_PUT_ATT(INCID, KVARID,'valid_max',TPFIELD%NVALIDMAX)
IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_ATTR_NC4 [NF90_PUT_ATT]')
-ENDIF
-!
-IF(TPFIELD%NTYPE==TYPEREAL .AND. TPFIELD%NDIMS>0) THEN
- IF (TPFIELD%XFILLVALUE>=TPFIELD%XVALIDMIN .AND. TPFIELD%XFILLVALUE<=TPFIELD%XVALIDMAX) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_ATTR_NC4','_FillValue is not outside of valid_min - valid_max'// &
- 'interval for variable '//TRIM(TPFIELD%CMNHNAME))
- !
- ! Fillvalue (CF/COMODO convention)
- ! Remarks: * the attribute '_FillValue' is also recognized by the netCDF library
- ! and is used when pre-filling a variable
- ! * it cannot be modified if some data has already been written (->check OEXISTED)
- IF(.NOT.OEXISTED) THEN
- IF (TPFILE%LNCREDUCE_FLOAT_PRECISION) THEN
- STATUS = NF90_PUT_ATT(INCID, KVARID,'_FillValue', REAL(TPFIELD%XFILLVALUE,KIND=4))
- ELSE
- STATUS = NF90_PUT_ATT(INCID, KVARID,'_FillValue', TPFIELD%XFILLVALUE)
- END IF
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_ATTR_NC4 [NF90_PUT_ATT]')
- END IF
- !
- ! Valid_min/max (CF/COMODO convention)
- IF (TPFILE%LNCREDUCE_FLOAT_PRECISION) THEN
- STATUS = NF90_PUT_ATT(INCID, KVARID,'valid_min', REAL(TPFIELD%XVALIDMIN,KIND=4))
- ELSE
- STATUS = NF90_PUT_ATT(INCID, KVARID,'valid_min', TPFIELD%XVALIDMIN)
- END IF
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_ATTR_NC4 [NF90_PUT_ATT]')
- !
- IF (TPFILE%LNCREDUCE_FLOAT_PRECISION) THEN
- STATUS = NF90_PUT_ATT(INCID, KVARID,'valid_max', REAL(TPFIELD%XVALIDMAX,KIND=4))
- ELSE
- STATUS = NF90_PUT_ATT(INCID, KVARID,'valid_max',TPFIELD%XVALIDMAX)
- END IF
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_ATTR_NC4 [NF90_PUT_ATT]')
-ENDIF
-!
-END SUBROUTINE IO_WRITE_FIELD_ATTR_NC4
-
-FUNCTION GETDIMCDF(TPFILE, KLEN, HDIMNAME)
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KLEN
-CHARACTER(LEN=*), OPTIONAL :: HDIMNAME ! When provided don't search but
- ! simply create with name HDIMNAME
-TYPE(DIMCDF), POINTER :: GETDIMCDF
-
-TYPE(DIMCDF), POINTER :: TMP
-INTEGER :: COUNT
-CHARACTER(LEN=16) :: YSUFFIX
-CHARACTER(LEN=20) :: YDIMNAME
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-LOGICAL :: GCHKLEN !Check if KLEN is valid
-TYPE(IOCDF), POINTER :: PIOCDF
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','GETDIMCDF','called')
-
-PIOCDF => TPFILE%TNCDIMS
-
-GCHKLEN = .TRUE.
-!Do not check KLEN if 'time' (because NF90_UNLIMITED = 0)
-IF (PRESENT(HDIMNAME)) THEN
- IF (TRIM(HDIMNAME)=='time') THEN
- GCHKLEN = .FALSE.
- END IF
-END IF
-
-WRITE(YSUFFIX,'(I0)') KLEN
-
-IF (GCHKLEN .AND. KLEN < 1) THEN
- CALL PRINT_MSG(NVERB_FATAL,'IO','GETDIMCDF','KLEN='//TRIM(YSUFFIX))
-END IF
-
-IF (PRESENT(HDIMNAME)) THEN
- NULLIFY(TMP)
- YDIMNAME = TRIM(HDIMNAME)
-ELSE
- ! Search dimension with KLEN length
- COUNT = 1
- TMP => PIOCDF%DIMLIST
- DO WHILE(ASSOCIATED(TMP))
- IF (TMP%LEN == KLEN .AND. TMP%NAME(1:4) /= 'char') EXIT
- TMP=>TMP%NEXT
- COUNT = COUNT+1
- END DO
- YDIMNAME = 'size'//TRIM(YSUFFIX)
-END IF
-
-IF (.NOT. ASSOCIATED(TMP)) THEN
- ! Not found then define new dimension
- ALLOCATE(TMP)
- TMP%NAME = YDIMNAME
- TMP%LEN = KLEN
- STATUS = NF90_DEF_DIM(TPFILE%NNCID, TMP%NAME, KLEN, TMP%ID)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'GETDIMCDF[NF90_DEF_DIM]')
- NULLIFY(TMP%NEXT)
- TMP%NEXT => PIOCDF%DIMLIST
- PIOCDF%DIMLIST => TMP
-CALL PRINT_MSG(NVERB_DEBUG,'IO','GETDIMCDF','new dimension: '//TRIM(TMP%NAME))
-END IF
-
-GETDIMCDF => TMP
-
-END FUNCTION GETDIMCDF
-
-
-FUNCTION GETSTRDIMID(TPFILE,KLEN)
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KLEN
-INTEGER(KIND=IDCDF_KIND) :: GETSTRDIMID
-
-TYPE(DIMCDF), POINTER :: TMP
-TYPE(IOCDF), POINTER :: TZIOCDF
-CHARACTER(LEN=16) :: YSUFFIX
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','GETSTRDIMID','called')
-
-WRITE(YSUFFIX,'(I0)') KLEN
-
-IF (KLEN < 1) THEN
- CALL PRINT_MSG(NVERB_FATAL,'IO','GETSTRDIMID','KLEN='//TRIM(YSUFFIX))
-END IF
-
-! Search string dimension with KLEN length
-TMP => TPFILE%TNCDIMS%DIMSTR
-DO WHILE(ASSOCIATED(TMP))
- IF (TMP%LEN == KLEN) EXIT
- TMP=>TMP%NEXT
-END DO
-
-IF (.NOT. ASSOCIATED(TMP)) THEN
- ! Not found then define new dimension
- ALLOCATE(TMP)
- TMP%NAME = 'char'//TRIM(YSUFFIX)
- TMP%LEN = KLEN
- STATUS = NF90_DEF_DIM(TPFILE%NNCID, TMP%NAME, KLEN, TMP%ID)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'GETSTRDIMID[NF90_DEF_DIM]')
- NULLIFY(TMP%NEXT)
- TMP%NEXT => TPFILE%TNCDIMS%DIMSTR
- TZIOCDF => TPFILE%TNCDIMS
- TZIOCDF%DIMSTR => TMP
-END IF
-
-GETSTRDIMID = TMP%ID
-
-END FUNCTION GETSTRDIMID
-
-
-SUBROUTINE IO_FIND_DIM_BYNAME_NC4(TPFILE, HDIMNAME, TPDIM, KRESP)
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-CHARACTER(LEN=*), INTENT(IN) :: HDIMNAME
-TYPE(DIMCDF), INTENT(OUT) :: TPDIM
-INTEGER, INTENT(OUT) :: KRESP
-!
-TYPE(DIMCDF), POINTER :: TMP
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_FIND_DIM_BYNAME_NC4','called for dimension name '//TRIM(HDIMNAME))
-!
-KRESP = -2
-!
-IF(.NOT.ASSOCIATED(TPFILE%TNCDIMS%DIMLIST)) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FIND_DIM_BYNAME_NC4','DIMLIST not associated for file '//TRIM(TPFILE%CNAME))
- KRESP = -1
- RETURN
-END IF
-!
-TMP => TPFILE%TNCDIMS%DIMLIST
-!
-DO WHILE(ASSOCIATED(TMP))
- IF (TRIM(TMP%NAME)==TRIM(HDIMNAME)) THEN
- TPDIM = TMP
- KRESP = 0
- EXIT
- END IF
- TMP => TMP%NEXT
-END DO
-!
-END SUBROUTINE IO_FIND_DIM_BYNAME_NC4
-
-
-SUBROUTINE FILLVDIMS(TPFILE, TPFIELD, KSHAPE, KVDIMS)
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
-INTEGER(KIND=IDCDF_KIND),DIMENSION(:),INTENT(IN) :: KSHAPE
-INTEGER(KIND=IDCDF_KIND),DIMENSION(:),ALLOCATABLE,INTENT(OUT) :: KVDIMS
-!
-INTEGER :: IGRID
-INTEGER :: JI
-CHARACTER(LEN=32) :: YINT
-CHARACTER(LEN=2) :: YDIR
-TYPE(DIMCDF), POINTER :: PTDIM
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','FILLVDIMS','called for '//TRIM(TPFIELD%CMNHNAME))
-!
-IF (SIZE(KSHAPE) < 1 .AND. .NOT.TPFIELD%LTIMEDEP) CALL PRINT_MSG(NVERB_FATAL,'IO','FILLVDIMS','empty KSHAPE')
-!
-IGRID = TPFIELD%NGRID
-YDIR = TPFIELD%CDIR
-!
-IF(SIZE(KSHAPE)/=TPFIELD%NDIMS) THEN
- WRITE(YINT,'( I0,"/",I0 )') SIZE(KSHAPE),TPFIELD%NDIMS
- CALL PRINT_MSG(NVERB_FATAL,'IO','FILLVDIMS','SIZE(KSHAPE)/=TPFIELD%NDIMS ('//TRIM(YINT)//') for field ' &
- //TRIM(TPFIELD%CMNHNAME))
-END IF
-!
-IF (TPFIELD%LTIMEDEP) THEN
- !Add time dimension
- ALLOCATE(KVDIMS(TPFIELD%NDIMS+1))
- KVDIMS(TPFIELD%NDIMS+1) = TPFILE%TNCDIMS%DIMTIME%ID
-ELSE
- ALLOCATE(KVDIMS(TPFIELD%NDIMS))
-END IF
-!
-IF(IGRID<0 .OR. IGRID>8) THEN
- WRITE(YINT,'( I0 )') IGRID
- CALL PRINT_MSG(NVERB_FATAL,'IO','FILLVDIMS','invalid NGRID ('//TRIM(YINT)//') for field '//TRIM(TPFIELD%CMNHNAME))
-END IF
-!
-IF(IGRID==0 .AND. YDIR/='--' .AND. YDIR/='' ) THEN
- CALL PRINT_MSG(NVERB_FATAL,'IO','FILLVDIMS','invalid YDIR ('//TRIM(YDIR)//') with NGRID=0 for field '//TRIM(TPFIELD%CMNHNAME))
-END IF
-!
-DO JI=1,SIZE(KSHAPE)
- IF (JI == 1) THEN
- IF ( (YDIR == 'XX' .OR. YDIR == 'XY') .AND. KSHAPE(1)==TPFILE%TNCCOORDS(1,IGRID)%TDIM%LEN) THEN
- KVDIMS(1) = TPFILE%TNCCOORDS(1,IGRID)%TDIM%ID
- ELSE IF ( YDIR == 'YY' .AND. KSHAPE(1)==TPFILE%TNCCOORDS(2,IGRID)%TDIM%LEN) THEN
- KVDIMS(1) = TPFILE%TNCCOORDS(2,IGRID)%TDIM%ID
- ELSE IF ( YDIR == 'ZZ' .AND. KSHAPE(1)==TPFILE%TNCCOORDS(3,IGRID)%TDIM%LEN) THEN
- KVDIMS(1) = TPFILE%TNCCOORDS(3,IGRID)%TDIM%ID
- ELSE
- PTDIM => GETDIMCDF(TPFILE, KSHAPE(1)); KVDIMS(1) = PTDIM%ID
- END IF
- ELSE IF (JI == 2) THEN
- IF ( YDIR == 'XY' .AND. KSHAPE(2)==TPFILE%TNCCOORDS(2,IGRID)%TDIM%LEN) THEN
- KVDIMS(2) = TPFILE%TNCCOORDS(2,IGRID)%TDIM%ID
- ELSE
- PTDIM => GETDIMCDF(TPFILE, KSHAPE(2)); KVDIMS(2) = PTDIM%ID
- END IF
- ELSE IF (JI == 3) THEN
- IF ( YDIR == 'XY' .AND. KSHAPE(3)==TPFILE%TNCCOORDS(3,IGRID)%TDIM%LEN) THEN
- KVDIMS(3) = TPFILE%TNCCOORDS(3,IGRID)%TDIM%ID
+ENDIF
+!
+IF(TPFIELD%NTYPE==TYPEREAL .AND. TPFIELD%NDIMS>0) THEN
+ IF (TPFIELD%XFILLVALUE>=TPFIELD%XVALIDMIN .AND. TPFIELD%XFILLVALUE<=TPFIELD%XVALIDMAX) &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_ATTR_NC4','_FillValue is not outside of valid_min - valid_max'// &
+ 'interval for variable '//TRIM(TPFIELD%CMNHNAME))
+ !
+ ! Fillvalue (CF/COMODO convention)
+ ! Remarks: * the attribute '_FillValue' is also recognized by the netCDF library
+ ! and is used when pre-filling a variable
+ ! * it cannot be modified if some data has already been written (->check OEXISTED)
+ IF(.NOT.OEXISTED) THEN
+ IF (TPFILE%LNCREDUCE_FLOAT_PRECISION) THEN
+ STATUS = NF90_PUT_ATT(INCID, KVARID,'_FillValue', REAL(TPFIELD%XFILLVALUE,KIND=4))
ELSE
- PTDIM => GETDIMCDF(TPFILE, KSHAPE(3)); KVDIMS(3) = PTDIM%ID
+ STATUS = NF90_PUT_ATT(INCID, KVARID,'_FillValue', TPFIELD%XFILLVALUE)
END IF
- ELSE
- PTDIM => GETDIMCDF(TPFILE, KSHAPE(JI)); KVDIMS(JI) = PTDIM%ID
- END IF
-END DO
-!
-END SUBROUTINE FILLVDIMS
-
-
-SUBROUTINE IO_GUESS_DIMIDS_NC4(TPFILE, TPFIELD, KLEN, TPDIMS, KRESP)
-!
-USE MODE_FIELD, ONLY: TYPECHAR
-!
-!Used by LFI2CDF
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
-INTEGER, INTENT(IN) :: KLEN
-TYPE(DIMCDF),DIMENSION(:), INTENT(OUT) :: TPDIMS
-INTEGER, INTENT(OUT) :: KRESP
-!
-INTEGER :: IGRID
-INTEGER :: ILEN, ISIZE
-INTEGER :: JI
-CHARACTER(LEN=32) :: YINT
-CHARACTER(LEN=2) :: YDIR
-TYPE(DIMCDF), POINTER :: PTDIM
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_GUESS_DIMIDS_NC4','called for '//TRIM(TPFIELD%CMNHNAME))
-!
-IGRID = TPFIELD%NGRID
-YDIR = TPFIELD%CDIR
-!
-KRESP = 0
-ILEN = 0
-PTDIM => NULL()
-!
-IF(IGRID<0 .OR. IGRID>8) THEN
- WRITE(YINT,'( I0 )') IGRID
- CALL PRINT_MSG(NVERB_FATAL,'IO','IO_GUESS_DIMIDS_NC4','invalid NGRID ('//TRIM(YINT)//') for field '//TRIM(TPFIELD%CMNHNAME))
-END IF
-!
-IF(IGRID==0 .AND. YDIR/='--' .AND. YDIR/='' ) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4','invalid YDIR ('//TRIM(YDIR)//') with NGRID=0 for field '&
- //TRIM(TPFIELD%CMNHNAME))
-END IF
-!
-IF (IGRID==0) THEN
- SELECT CASE(TPFIELD%NDIMS)
- CASE (0)
- IF (TPFIELD%NTYPE == TYPECHAR) THEN
- ILEN = KLEN
- ELSE
- ILEN = 1
- END IF
- CASE (1)
- PTDIM => GETDIMCDF(TPFILE,KLEN)
- TPDIMS(1) = PTDIM
- ILEN = PTDIM%LEN
- CASE DEFAULT
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4','NGRID=0 and NDIMS>1 not yet supported (field '&
- //TRIM(TPFIELD%CMNHNAME)//')')
- END SELECT
-ELSE IF (TPFIELD%CLBTYPE/='NONE') THEN
- IF (TPFIELD%NDIMS/=3) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4','CLBTYPE/=NONE and NDIMS/=3 not supported (field '&
- //TRIM(TPFIELD%CMNHNAME)//')')
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_ATTR_NC4 [NF90_PUT_ATT]')
END IF
!
- IF (TPFIELD%CLBTYPE=='LBX' .OR. TPFIELD%CLBTYPE=='LBXU') THEN
- PTDIM => TPFILE%TNCCOORDS(2,IGRID)%TDIM
- TPDIMS(2) = PTDIM
- PTDIM => TPFILE%TNCCOORDS(3,IGRID)%TDIM
- TPDIMS(3) = PTDIM
- ILEN = TPDIMS(2)%LEN * TPDIMS(3)%LEN
- ISIZE = KLEN/ILEN
- IF (MOD(KLEN,ILEN)/=0) CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4', &
- 'can not guess 1st dimension for field '//TRIM(TPFIELD%CMNHNAME))
- PTDIM => GETDIMCDF(TPFILE, ISIZE)
- TPDIMS(1) = PTDIM
- ILEN = ILEN * PTDIM%LEN
- ELSE IF (TPFIELD%CLBTYPE=='LBY' .OR. TPFIELD%CLBTYPE=='LBYV') THEN
- PTDIM => TPFILE%TNCCOORDS(1,IGRID)%TDIM
- TPDIMS(1) = PTDIM
- PTDIM => TPFILE%TNCCOORDS(3,IGRID)%TDIM
- TPDIMS(3) = PTDIM
- ILEN = TPDIMS(1)%LEN * TPDIMS(3)%LEN
- ISIZE = KLEN/ILEN
- IF (MOD(KLEN,ILEN)/=0) CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4', &
- 'can not guess 2nd dimension for field '//TRIM(TPFIELD%CMNHNAME))
- PTDIM => GETDIMCDF(TPFILE, ISIZE)
- TPDIMS(2) = PTDIM
- ILEN = ILEN * PTDIM%LEN
+ ! Valid_min/max (CF/COMODO convention)
+ IF (TPFILE%LNCREDUCE_FLOAT_PRECISION) THEN
+ STATUS = NF90_PUT_ATT(INCID, KVARID,'valid_min', REAL(TPFIELD%XVALIDMIN,KIND=4))
ELSE
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4','invalid CLBTYPE ('//TPFIELD%CLBTYPE//') for field '&
- //TRIM(TPFIELD%CMNHNAME))
+ STATUS = NF90_PUT_ATT(INCID, KVARID,'valid_min', TPFIELD%XVALIDMIN)
END IF
-ELSE
- IF (TPFIELD%NDIMS==0) ILEN = 1
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_ATTR_NC4 [NF90_PUT_ATT]')
!
- DO JI=1,TPFIELD%NDIMS
- IF (JI == 1) THEN
- IF ( (YDIR == 'XX' .OR. YDIR == 'XY') ) THEN
- PTDIM => TPFILE%TNCCOORDS(1,IGRID)%TDIM
- ELSE IF ( YDIR == 'YY' ) THEN
- PTDIM => TPFILE%TNCCOORDS(2,IGRID)%TDIM
- ELSE IF ( YDIR == 'ZZ' ) THEN
- PTDIM => TPFILE%TNCCOORDS(3,IGRID)%TDIM
- ELSE IF (JI==TPFIELD%NDIMS) THEN !Guess last dimension
- PTDIM => GETDIMCDF(TPFILE, KLEN)
- END IF
- ILEN = PTDIM%LEN
- TPDIMS(JI) = PTDIM
- ELSE IF (JI == 2) THEN
- IF ( YDIR == 'XY') THEN
- PTDIM => TPFILE%TNCCOORDS(2,IGRID)%TDIM
- ELSE IF (JI==TPFIELD%NDIMS) THEN !Guess last dimension
- ISIZE = KLEN/ILEN
- IF (MOD(KLEN,ILEN)/=0) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4', &
- 'can not guess 2nd and last dimension for field '//TRIM(TPFIELD%CMNHNAME))
- EXIT
- END IF
- PTDIM => GETDIMCDF(TPFILE, ISIZE)
- ELSE
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4','can not guess 2nd dimension for field '//TRIM(TPFIELD%CMNHNAME))
- EXIT
- END IF
- ILEN = ILEN * PTDIM%LEN
- TPDIMS(JI) = PTDIM
- ELSE IF (JI == 3) THEN
- IF ( YDIR == 'XY' ) THEN
- IF (JI==TPFIELD%NDIMS .AND. KLEN/ILEN==1 .AND. MOD(KLEN,ILEN)==0) THEN
- !The last dimension is of size 1 => probably time dimension
- ISIZE = 1
- PTDIM => GETDIMCDF(TPFILE,ISIZE)
- ELSE
- PTDIM => TPFILE%TNCCOORDS(3,IGRID)%TDIM
- END IF
- ELSE IF (JI==TPFIELD%NDIMS) THEN !Guess last dimension
- ISIZE = KLEN/ILEN
- IF (MOD(KLEN,ILEN)/=0) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4', &
- 'can not guess 3rd and last dimension for field '//TRIM(TPFIELD%CMNHNAME))
- EXIT
- END IF
- PTDIM => GETDIMCDF(TPFILE, ISIZE)
- ELSE
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4','can not guess 3rd dimension for field '//TRIM(TPFIELD%CMNHNAME))
- EXIT
- END IF
- ILEN = ILEN * PTDIM%LEN
- TPDIMS(JI) = PTDIM
- ELSE IF (JI==4 .AND. JI==TPFIELD%NDIMS) THEN !Guess last dimension
- ISIZE = KLEN/ILEN
- IF (MOD(KLEN,ILEN)/=0) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4', &
- 'can not guess 4th and last dimension for field '//TRIM(TPFIELD%CMNHNAME))
- EXIT
- END IF
- PTDIM => GETDIMCDF(TPFILE, ISIZE)
- ILEN = ILEN * PTDIM%LEN
- TPDIMS(JI) = PTDIM
- ELSE
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4','can not guess dimension above 4 for field '&
- //TRIM(TPFIELD%CMNHNAME))
- END IF
- END DO
-END IF
-!
-IF (KLEN /= ILEN) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_GUESS_DIMIDS_NC4','can not guess dimensions of field '&
- //TRIM(TPFIELD%CMNHNAME))
- KRESP = 1
-END IF
+ IF (TPFILE%LNCREDUCE_FLOAT_PRECISION) THEN
+ STATUS = NF90_PUT_ATT(INCID, KVARID,'valid_max', REAL(TPFIELD%XVALIDMAX,KIND=4))
+ ELSE
+ STATUS = NF90_PUT_ATT(INCID, KVARID,'valid_max',TPFIELD%XVALIDMAX)
+ END IF
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_ATTR_NC4 [NF90_PUT_ATT]')
+ENDIF
!
-END SUBROUTINE IO_GUESS_DIMIDS_NC4
+END SUBROUTINE IO_WRITE_FIELD_ATTR_NC4
SUBROUTINE IO_WRITE_FIELD_NC4_X0(TPFILE,TPFIELD,PFIELD,KRESP)
@@ -1422,7 +296,7 @@ CALL IO_WRITE_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,GEXISTED)
! Write the data
STATUS = NF90_PUT_VAR(INCID, IVARID, PFIELD)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_X0[NF90_PUT_VAR] '//TRIM(TPFIELD%CMNHNAME),IRESP)
-
+
KRESP = IRESP
END SUBROUTINE IO_WRITE_FIELD_NC4_X0
@@ -1464,7 +338,7 @@ IF (STATUS /= NF90_NOERR) THEN
! Get the netcdf dimensions
CALL FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), IVDIMS)
- ! Define the variable
+ ! Define the variable
IF (TPFILE%LNCREDUCE_FLOAT_PRECISION) THEN
STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIMS, IVARID)
ELSE
@@ -1559,7 +433,7 @@ IF (STATUS /= NF90_NOERR) THEN
! Get the netcdf dimensions
CALL FILLVDIMS(TZFILE, TZFIELD, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), IVDIMS)
- ! Define the variable
+ ! Define the variable
IF (TZFILE%LNCREDUCE_FLOAT_PRECISION) THEN
STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIMS, IVARID)
ELSE
@@ -1585,7 +459,7 @@ CALL IO_WRITE_FIELD_ATTR_NC4(TZFILE,TZFIELD,IVARID,GEXISTED,KSHAPE=INT(SHAPE(PFI
! Write the data
STATUS = NF90_PUT_VAR(INCID, IVARID, PFIELD)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_X2[NF90_PUT_VAR] '//TRIM(TZFIELD%CMNHNAME),IRESP)
-
+
IF(ALLOCATED(IVDIMS)) DEALLOCATE(IVDIMS)
KRESP = IRESP
@@ -1630,7 +504,7 @@ IF (STATUS /= NF90_NOERR) THEN
! Get the netcdf dimensions
CALL FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), IVDIMS)
- ! Define the variable
+ ! Define the variable
IF (TPFILE%LNCREDUCE_FLOAT_PRECISION) THEN
STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIMS, IVARID)
ELSE
@@ -1701,7 +575,7 @@ IF (STATUS /= NF90_NOERR) THEN
! Get the netcdf dimensions
CALL FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), IVDIMS)
- ! Define the variable
+ ! Define the variable
IF (TPFILE%LNCREDUCE_FLOAT_PRECISION) THEN
STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIMS, IVARID)
ELSE
@@ -1772,7 +646,7 @@ IF (STATUS /= NF90_NOERR) THEN
! Get the netcdf dimensions
CALL FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), IVDIMS)
- ! Define the variable
+ ! Define the variable
IF (TPFILE%LNCREDUCE_FLOAT_PRECISION) THEN
STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIMS, IVARID)
ELSE
@@ -1843,7 +717,7 @@ IF (STATUS /= NF90_NOERR) THEN
! Get the netcdf dimensions
CALL FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), IVDIMS)
- ! Define the variable
+ ! Define the variable
IF (TPFILE%LNCREDUCE_FLOAT_PRECISION) THEN
STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIMS, IVARID)
ELSE
@@ -1960,7 +834,7 @@ IF (YVARNAME == 'KMAX' .AND. .NOT. ASSOCIATED(TPFILE%TNCDIMS%DIM_LEVEL)) THEN
TZIOCDF => TPFILE%TNCDIMS
TZIOCDF%DIM_LEVEL=>GETDIMCDF(TPFILE,INT(KFIELD+2*JPVEXT,KIND=IDCDF_KIND),'Z')
END IF
-
+
KRESP = IRESP
END SUBROUTINE IO_WRITE_FIELD_NC4_N0
@@ -2008,7 +882,7 @@ IF (STATUS /= NF90_NOERR) THEN
! Get the netcdf dimensions
CALL FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(KFIELD),KIND=IDCDF_KIND), IVDIMS)
- ! Define the variable
+ ! Define the variable
#if ( MNH_INT == 4 )
STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT, IVDIMS, IVARID)
#else
@@ -2070,7 +944,7 @@ IF (STATUS /= NF90_NOERR) THEN
! Get the netcdf dimensions
CALL FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(KFIELD),KIND=IDCDF_KIND), IVDIMS)
- ! Define the variable
+ ! Define the variable
#if ( MNH_INT == 4 )
STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT, IVDIMS, IVARID)
#else
@@ -2136,7 +1010,7 @@ IF (STATUS /= NF90_NOERR) THEN
! Get the netcdf dimensions
CALL FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(KFIELD),KIND=IDCDF_KIND), IVDIMS)
- ! Define the variable
+ ! Define the variable
#if ( MNH_INT == 4 )
STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT, IVDIMS, IVARID)
#else
@@ -2270,7 +1144,7 @@ IF (STATUS /= NF90_NOERR) THEN
! Get the netcdf dimensions
CALL FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(OFIELD),KIND=IDCDF_KIND), IVDIMS)
- ! Define the variable
+ ! Define the variable
! Use of NF90_INT1 datatype (=NF90_BYTE) that is enough to store a boolean
STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT1, IVDIMS, IVARID)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_L1[NF90_DEF_VAR]')
@@ -2337,9 +1211,9 @@ IF (TPFIELD%LTIMEDEP) &
! The variable should not already exist but who knows ?
STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
IF (STATUS /= NF90_NOERR) THEN
- ! Get the netcdf string dimensions id
+ ! Get the netcdf string dimensions id
IVDIMS(1) = GETSTRDIMID(TPFILE,INT(ILEN,KIND=IDCDF_KIND))
- ! Define the variable
+ ! Define the variable
STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_CHAR, IVDIMS, IVARID)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_C0[NF90_DEF_VAR]')
ELSE
@@ -2405,11 +1279,11 @@ END IF
! The variable should not already exist but who knows ?
STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
IF (STATUS /= NF90_NOERR) THEN
- ! Get the netcdf string dimensions id
+ ! Get the netcdf string dimensions id
IVDIMS(1) = GETSTRDIMID(TPFILE,ILEN)
CALL FILLVDIMS(TPFILE, TPFIELD, (/ISIZE/), IVDIMSTMP)
IVDIMS(2) = IVDIMSTMP(1)
- ! Define the variable
+ ! Define the variable
STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_CHAR, IVDIMS, IVARID)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_C1[NF90_DEF_VAR]')
ELSE
@@ -2486,1345 +1360,663 @@ WRITE(YUNITS,'( "seconds since ",I4.4,"-",I2.2,"-",I2.2," 00:00:00 +0:00" )') &
TZFIELD%CUNITS = TRIM(YUNITS)
!
IF (TPFIELD%LTIMEDEP) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_NC4_T0',TRIM(TPFILE%CNAME)// &
- ': time dependent variable not (yet) possible for 0D variable '//TRIM(TPFIELD%CMNHNAME))
-!
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- ! Define the scalar variable
-#if (MNH_REAL == 8)
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVARID)
-#else
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVARID)
-#endif
- IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_T0[NF90_DEF_VAR]')
-ELSE
- GEXISTED = .TRUE.
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_NC4_T0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
-END IF
-
-! Write metadata
-CALL IO_WRITE_FIELD_ATTR_NC4(TPFILE,TZFIELD,IVARID,GEXISTED,HCALENDAR='standard')
-!
-! Compute the temporal distance from reference
-CALL DATETIME_DISTANCE(TZREF,TPDATA,ZDELTATIME)
-
-! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, ZDELTATIME)
-IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_X0[NF90_PUT_VAR] '//TRIM(TPFIELD%CMNHNAME),IRESP)
-
-IF (IRESP/=0) THEN
- KRESP = IRESP
- RETURN
-END IF
-
-#if 0
-!This part is to keep backward compatibility with MesoNH files
-!but date/time is not conform to CF convention
-!
-! Write date
-!
-TZFIELD%CMNHNAME = TRIM(YVARNAME)//'__TDATE'
-TZFIELD%CLONGNAME = TRIM(TPFIELD%CLONGNAME)//'%TDATE'
-TZFIELD%CUNITS = ''
-TZFIELD%CCOMMENT = 'YYYYMMDD'
-
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, TZFIELD%CMNHNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- ! Get the netcdf dimensions
- CALL FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(ITDATE),KIND=IDCDF_KIND), IVDIMS)
-
- ! Define the variable
- STATUS = NF90_DEF_VAR(INCID, TZFIELD%CMNHNAME, NF90_INT, IVDIMS, IVARID)
- IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_T0[NF90_DEF_VAR]')
- CALL IO_WRITE_FIELD_ATTR_NC4(TPFILE,TZFIELD,IVARID,GEXISTED)
-ELSE
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_NC4_T0',TRIM(TPFILE%CNAME)//': '//TRIM(TZFIELD%CMNHNAME)//' already defined')
-END IF
-
-! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, ITDATE)
-IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_T0[NF90_PUT_VAR] '//TRIM(TZFIELD%CMNHNAME),IRESP)
-
-IF (IRESP/=0) THEN
- KRESP = IRESP
- RETURN
-END IF
-!
-! Write time
-!
-TZFIELD%CMNHNAME = TRIM(YVARNAME)//'__TIME'
-TZFIELD%CLONGNAME = TRIM(TPFIELD%CLONGNAME)//'%TIME'
-TZFIELD%CUNITS = 's'
-TZFIELD%CCOMMENT = 'SECONDS'
-
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, TZFIELD%CMNHNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- ! Define the scalar variable
-#if (MNH_REAL == 8)
- STATUS = NF90_DEF_VAR(INCID, TZFIELD%CMNHNAME, NF90_DOUBLE, IVARID)
-#else
- STATUS = NF90_DEF_VAR(INCID, TZFIELD%CMNHNAME, NF90_FLOAT, IVARID)
-#endif
- IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_T0[NF90_DEF_VAR]')
- CALL IO_WRITE_FIELD_ATTR_NC4(TPFILE,TZFIELD,IVARID,GEXISTED)
-ELSE
- GEXISTED = .TRUE.
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_NC4_T0',TRIM(TPFILE%CNAME)//': '//TRIM(TZFIELD%CMNHNAME)//' already defined')
-END IF
-
-! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, TPDATA%TIME)
-IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_T0[NF90_PUT_VAR] '//TRIM(TZFIELD%CMNHNAME),IRESP)
-#endif
-
-KRESP = IRESP
-END SUBROUTINE IO_WRITE_FIELD_NC4_T0
-!
-!
-! Here come the NetCDF READ routines
-!
-!
-SUBROUTINE IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,KVARID,KRESP,HCALENDAR)
-!
-USE MODD_PARAMETERS, ONLY: NGRIDUNKNOWN
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-INTEGER(KIND=IDCDF_KIND), INTENT(IN) :: KVARID
-INTEGER, INTENT(OUT) :: KRESP ! return-code
-CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: HCALENDAR
-!
-INTEGER :: IERRLEVEL
-INTEGER :: ILEN
-INTEGER :: IGRID
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-CHARACTER(LEN=12) :: YVAL_FILE, YVAL_MEM
-CHARACTER(LEN=:),ALLOCATABLE :: YVALUE
-LOGICAL :: GOLDMNH !if old version of MesoNH (<5.4, old files without complete and correct metadata)
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)//': called for field '//TRIM(TPFIELD%CMNHNAME))
-!
-KRESP = 0
-INCID = TPFILE%NNCID
-!
-GOLDMNH = TPFILE%NMNHVERSION(1)<5 .OR. (TPFILE%NMNHVERSION(1)==5 .AND. TPFILE%NMNHVERSION(2)<4)
-!
-IF (GOLDMNH) THEN !Set a lower level of error if file comes from an old MesoNH version
- IERRLEVEL = NVERB_WARNING
-ELSE
- IERRLEVEL = NVERB_ERROR
-END IF
-!
-! GRID
-!
-STATUS = NF90_GET_ATT(INCID,KVARID,'grid',IGRID)
-IF (STATUS /= NF90_NOERR) STATUS = NF90_GET_ATT(INCID,KVARID,'GRID',IGRID)
-IF (STATUS == NF90_NOERR) THEN
- IF (IGRID/=TPFIELD%NGRID) THEN
- WRITE(YVAL_FILE,'(I12)') IGRID
- WRITE(YVAL_MEM, '(I12)') TPFIELD%NGRID
- CALL PRINT_MSG(IERRLEVEL,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
- ': expected GRID value ('//TRIM(ADJUSTL(YVAL_MEM))// &
- ') is different than found in file ('//TRIM(ADJUSTL(YVAL_FILE))//') for variable '//TRIM(TPFIELD%CMNHNAME))
- IF (.NOT.GOLDMNH) THEN !Do not modify probably incorrect grid number (to prevent problems later with other correct files)
- TPFIELD%NGRID = IGRID
- KRESP = -111 !Used later to broadcast modified metadata
- END IF
- ELSE
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
- ': expected GRID found in file for field '//TRIM(TPFIELD%CMNHNAME))
- ENDIF
-ELSE !no GRID
- IF (TPFIELD%NGRID==0 .OR. TPFIELD%NGRID==NGRIDUNKNOWN) THEN
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
- ': no GRID (as expected) in file for field '//TRIM(TPFIELD%CMNHNAME))
- ELSE
- CALL PRINT_MSG(IERRLEVEL,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
- ': expected GRID but not found in file for field '//TRIM(TPFIELD%CMNHNAME))
- END IF
-ENDIF
-!
-! COMMENT
-!
-STATUS = NF90_INQUIRE_ATTRIBUTE(INCID, KVARID, 'comment', LEN=ILEN)
-IF (STATUS == NF90_NOERR) THEN
- ALLOCATE(CHARACTER(LEN=ILEN) :: YVALUE)
- STATUS = NF90_GET_ATT(INCID, KVARID, 'comment', YVALUE)
- IF (LEN_TRIM(TPFIELD%CCOMMENT)==0 .AND. LEN_TRIM(YVALUE)>0) THEN
- !Expected comment is empty, read comment is not
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
- ': COMMENT found (unexpected) in file for field '//TRIM(TPFIELD%CMNHNAME))
- TPFIELD%CCOMMENT=TRIM(YVALUE)
- ELSE IF (TRIM(YVALUE)/=TRIM(TPFIELD%CCOMMENT)) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
- ': expected COMMENT ('//TRIM(TPFIELD%CCOMMENT)// &
- ') is different than found ('//TRIM(YVALUE)//') in file for field '//TRIM(TPFIELD%CMNHNAME))
- TPFIELD%CCOMMENT=TRIM(YVALUE)
- KRESP = -111 !Used later to broadcast modified metadata
- ELSE
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
- ': expected COMMENT found in file for field '//TRIM(TPFIELD%CMNHNAME))
- END IF
- DEALLOCATE(YVALUE)
-ELSE !no COMMENT
- IF (LEN_TRIM(TPFIELD%CCOMMENT)==0) THEN
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
- ': no COMMENT (as expected) in file for field '//TRIM(TPFIELD%CMNHNAME))
- ELSE
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
- ': expected COMMENT but not found in file for field '//TRIM(TPFIELD%CMNHNAME))
- END IF
-END IF
-!
-! STDNAME
-!
-STATUS = NF90_INQUIRE_ATTRIBUTE(INCID, KVARID, 'standard_name', LEN=ILEN)
-IF (STATUS == NF90_NOERR) THEN
- ALLOCATE(CHARACTER(LEN=ILEN) :: YVALUE)
- STATUS = NF90_GET_ATT(INCID, KVARID, 'standard_name', YVALUE)
- IF (TRIM(YVALUE)/=TRIM(TPFIELD%CSTDNAME)) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
- ': expected STDNAME ('//TRIM(TPFIELD%CSTDNAME)// &
- ') is different than found ('//TRIM(YVALUE)//') in file for field '//TRIM(TPFIELD%CMNHNAME))
- TPFIELD%CSTDNAME=TRIM(YVALUE)
- KRESP = -111 !Used later to broadcast modified metadata
- ELSE
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
- ': expected STDNAME found in file for field '//TRIM(TPFIELD%CMNHNAME))
- END IF
- DEALLOCATE(YVALUE)
-ELSE !no STDNAME
- IF (LEN_TRIM(TPFIELD%CSTDNAME)==0) THEN
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
- ': no STDNAME (as expected) in file for field '//TRIM(TPFIELD%CMNHNAME))
- ELSE
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
- ': expected STDNAME but not found in file for field '//TRIM(TPFIELD%CMNHNAME))
- END IF
-END IF
-!
-! LONGNAME
-!
-STATUS = NF90_INQUIRE_ATTRIBUTE(INCID, KVARID, 'long_name', LEN=ILEN)
-IF (STATUS == NF90_NOERR) THEN
- ALLOCATE(CHARACTER(LEN=ILEN) :: YVALUE)
- STATUS = NF90_GET_ATT(INCID, KVARID, 'long_name', YVALUE)
- IF (TRIM(YVALUE)/=TRIM(TPFIELD%CLONGNAME)) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
- ': expected LONGNAME ('//TRIM(TPFIELD%CLONGNAME)// &
- ') is different than found ('//TRIM(YVALUE)//') in file for field '//TRIM(TPFIELD%CMNHNAME))
- TPFIELD%CLONGNAME=TRIM(YVALUE)
- KRESP = -111 !Used later to broadcast modified metadata
- ELSE
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
- ': expected LONGNAME found in file for field '//TRIM(TPFIELD%CMNHNAME))
- END IF
- DEALLOCATE(YVALUE)
-ELSE !no LONGNAME
- IF (LEN_TRIM(TPFIELD%CLONGNAME)==0) THEN
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
- ': no LONGNAME (as expected) in file for field '//TRIM(TPFIELD%CMNHNAME))
- ELSE
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
- ': expected LONGNAME but not found in file for field '//TRIM(TPFIELD%CMNHNAME))
- END IF
-END IF
-!
-! UNITS
-!
-STATUS = NF90_INQUIRE_ATTRIBUTE(INCID, KVARID, 'units', LEN=ILEN)
-IF (STATUS == NF90_NOERR) THEN
- ALLOCATE(CHARACTER(LEN=ILEN) :: YVALUE)
- STATUS = NF90_GET_ATT(INCID, KVARID, 'units', YVALUE)
- IF (TRIM(YVALUE)/=TRIM(TPFIELD%CUNITS)) THEN
- IF(.NOT.PRESENT(HCALENDAR)) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
- ': expected UNITS ('//TRIM(TPFIELD%CUNITS)// &
- ') is different than found ('//TRIM(YVALUE)//') in file for field '//TRIM(TPFIELD%CMNHNAME))
- KRESP = -111 !Used later to broadcast modified metadata
- ELSE
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
- ': UNITS found in file for field '//TRIM(TPFIELD%CMNHNAME)//' (will be analysed later)')
- END IF
- TPFIELD%CUNITS=TRIM(YVALUE)
- ELSE
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
- ': expected UNITS found in file for field '//TRIM(TPFIELD%CMNHNAME))
- END IF
- DEALLOCATE(YVALUE)
-ELSE !no UNITS
- IF (LEN_TRIM(TPFIELD%CUNITS)==0) THEN
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
- ': no UNITS (as expected) in file for field '//TRIM(TPFIELD%CMNHNAME))
- ELSE
- IF(.NOT.PRESENT(HCALENDAR)) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
- ': expected UNITS but not found in file for field '//TRIM(TPFIELD%CMNHNAME))
- ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
- ': expected UNITS but not found in file for field '//TRIM(TPFIELD%CMNHNAME))
- KRESP = -3
- END IF
- END IF
-END IF
-!
-! CALENDAR
-!
-IF(PRESENT(HCALENDAR)) THEN
-STATUS = NF90_INQUIRE_ATTRIBUTE(INCID, KVARID, 'calendar', LEN=ILEN)
-IF (STATUS == NF90_NOERR) THEN
- ALLOCATE(CHARACTER(LEN=ILEN) :: YVALUE)
- STATUS = NF90_GET_ATT(INCID, KVARID, 'calendar', YVALUE)
- IF (TRIM(YVALUE)/=TRIM(HCALENDAR)) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
- ': expected CALENDAR ('//TRIM(HCALENDAR)// &
- ') is different than found ('//TRIM(YVALUE)//') in file for field '//TRIM(TPFIELD%CMNHNAME))
- ELSE
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
- ': expected CALENDAR found in file for field '//TRIM(TPFIELD%CMNHNAME))
- END IF
- DEALLOCATE(YVALUE)
-ELSE !no CALENDAR
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
- ': expected CALENDAR but not found in file for field '//TRIM(TPFIELD%CMNHNAME))
-END IF
-ENDIF
-!
-END SUBROUTINE IO_READ_CHECK_FIELD_ATTR_NC4
-
-
-SUBROUTINE IO_READ_FIELD_NC4_X0(TPFILE, TPFIELD, PFIELD, KRESP)
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-REAL, INTENT(OUT) :: PFIELD
-INTEGER, INTENT(OUT) :: KRESP ! return-code
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_X0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
-
-IRESP = 0
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
-
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
-
-! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X0[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
-END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_X0[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
-
-!Neglect the time dimension (of size 1)
-IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
-
-IF (IDIMS == 0 .AND. (ITYPE == NF90_FLOAT .OR. ITYPE == NF90_DOUBLE) ) THEN
- ! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, PFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X0[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
- END IF
- ! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
-ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
- ' not read (wrong size or type)')
- IRESP = -3
-END IF
-
-1000 CONTINUE
-KRESP = IRESP
-
-END SUBROUTINE IO_READ_FIELD_NC4_X0
-
-
-SUBROUTINE IO_READ_FIELD_NC4_X1(TPFILE, TPFIELD, PFIELD, KRESP)
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-REAL,DIMENSION(:),INTENT(OUT) :: PFIELD
-INTEGER, INTENT(OUT) :: KRESP ! return-code
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_X1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
-
-IRESP = 0
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
-
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
-
-! Get variable ID, NDIMS and TYPE
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_NC4_T0',TRIM(TPFILE%CNAME)// &
+ ': time dependent variable not (yet) possible for 0D variable '//TRIM(TPFIELD%CMNHNAME))
+!
+! The variable should not already exist but who knows ?
STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X1[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
-END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_X1[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
-
-!Neglect the time dimension (of size 1)
-IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
-
-IF (IDIMS == 1 .AND. (ITYPE == NF90_FLOAT .OR. ITYPE == NF90_DOUBLE) ) THEN
- ! Check size of variable before reading
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X1[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
-
- IF (IDIMLEN == SIZE(PFIELD)) THEN
- ! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, PFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X1[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
- END IF
- ! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
- ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
- ' not read (wrong size)')
- IRESP = -3
- END IF
+ ! Define the scalar variable
+#if (MNH_REAL == 8)
+ STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVARID)
+#else
+ STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVARID)
+#endif
+ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_T0[NF90_DEF_VAR]')
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
- ' not read (wrong number of dimensions or wrong type)')
- IRESP = -3
+ GEXISTED = .TRUE.
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_NC4_T0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
END IF
-1000 CONTINUE
-KRESP = IRESP
-
-END SUBROUTINE IO_READ_FIELD_NC4_X1
-
-
-SUBROUTINE IO_READ_FIELD_NC4_X2(TPFILE, TPFIELD, PFIELD, KRESP)
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-REAL,DIMENSION(:,:),INTENT(OUT) :: PFIELD
-INTEGER, INTENT(OUT) :: KRESP ! return-code
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND),DIMENSION(3) :: IDIMLEN
-INTEGER :: IRESP
+! Write metadata
+CALL IO_WRITE_FIELD_ATTR_NC4(TPFILE,TZFIELD,IVARID,GEXISTED,HCALENDAR='standard')
+!
+! Compute the temporal distance from reference
+CALL DATETIME_DISTANCE(TZREF,TPDATA,ZDELTATIME)
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_X2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+! Write the data
+STATUS = NF90_PUT_VAR(INCID, IVARID, ZDELTATIME)
+IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_X0[NF90_PUT_VAR] '//TRIM(TPFIELD%CMNHNAME),IRESP)
-IRESP = 0
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
+IF (IRESP/=0) THEN
+ KRESP = IRESP
+ RETURN
+END IF
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+#if 0
+!This part is to keep backward compatibility with MesoNH files
+!but date/time is not conform to CF convention
+!
+! Write date
+!
+TZFIELD%CMNHNAME = TRIM(YVARNAME)//'__TDATE'
+TZFIELD%CLONGNAME = TRIM(TPFIELD%CLONGNAME)//'%TDATE'
+TZFIELD%CUNITS = ''
+TZFIELD%CCOMMENT = 'YYYYMMDD'
-! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+! The variable should not already exist but who knows ?
+STATUS = NF90_INQ_VARID(INCID, TZFIELD%CMNHNAME, IVARID)
IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X2[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
-END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_X2[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
-
-!Neglect the time dimension (of size 1)
-IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
-
-!Treat special case of a degenerated 3D array (3rd dimension size is 1)
-IF (IDIMS==3) THEN
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X2[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- IF (IDIMLEN(3)==1) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_FIELD_NC4_X2',TRIM(TPFILE%CNAME)// &
- ': reading 3D array with degenerated third dimension in 2D array for '//TRIM(YVARNAME))
- IDIMS = 2
- ELSE
- CALL PRINT_MSG(NVERB_FATAL,'IO','IO_READ_FIELD_NC4_X2',TRIM(TPFILE%CNAME)//': wrong number of dimensions for '//TRIM(YVARNAME))
- END IF
-END IF
-
-IF (IDIMS == 2 .AND. (ITYPE == NF90_FLOAT .OR. ITYPE == NF90_DOUBLE) ) THEN
- ! Check size of variable before reading
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X2[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X2[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+ ! Get the netcdf dimensions
+ CALL FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(ITDATE),KIND=IDCDF_KIND), IVDIMS)
- IF (IDIMLEN(1) == SIZE(PFIELD,1) .AND. IDIMLEN(2) == SIZE(PFIELD,2)) THEN
- ! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, PFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X2[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
- END IF
- ! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
- ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X2',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
- ' not read (wrong size)')
- IRESP = -3
- END IF
+ ! Define the variable
+ STATUS = NF90_DEF_VAR(INCID, TZFIELD%CMNHNAME, NF90_INT, IVDIMS, IVARID)
+ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_T0[NF90_DEF_VAR]')
+ CALL IO_WRITE_FIELD_ATTR_NC4(TPFILE,TZFIELD,IVARID,GEXISTED)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X2',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
- ' not read (wrong number of dimensions or wrong type)')
- IRESP = -3
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_NC4_T0',TRIM(TPFILE%CNAME)//': '//TRIM(TZFIELD%CMNHNAME)//' already defined')
END IF
-1000 CONTINUE
-KRESP = IRESP
-
-END SUBROUTINE IO_READ_FIELD_NC4_X2
-
-
-SUBROUTINE IO_READ_FIELD_NC4_X3(TPFILE, TPFIELD, PFIELD, KRESP)
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-REAL,DIMENSION(:,:,:),INTENT(OUT) :: PFIELD
-INTEGER, INTENT(OUT) :: KRESP ! return-code
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
-INTEGER(KIND=IDCDF_KIND),DIMENSION(3) :: IDIMLEN
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_X3',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
-
-IRESP = 0
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
+! Write the data
+STATUS = NF90_PUT_VAR(INCID, IVARID, ITDATE)
+IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_T0[NF90_PUT_VAR] '//TRIM(TZFIELD%CMNHNAME),IRESP)
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+IF (IRESP/=0) THEN
+ KRESP = IRESP
+ RETURN
+END IF
+!
+! Write time
+!
+TZFIELD%CMNHNAME = TRIM(YVARNAME)//'__TIME'
+TZFIELD%CLONGNAME = TRIM(TPFIELD%CLONGNAME)//'%TIME'
+TZFIELD%CUNITS = 's'
+TZFIELD%CCOMMENT = 'SECONDS'
-! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+! The variable should not already exist but who knows ?
+STATUS = NF90_INQ_VARID(INCID, TZFIELD%CMNHNAME, IVARID)
IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X3[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
-END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_X3[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
-
-!Neglect the time dimension (of size 1)
-IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
-
-IF (IDIMS == 3 .AND. (ITYPE == NF90_FLOAT .OR. ITYPE == NF90_DOUBLE) ) THEN
- ! Check size of variable before reading
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X3[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X3[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X3[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
-
- IF (IDIMLEN(1) == SIZE(PFIELD,1) .AND. IDIMLEN(2) == SIZE(PFIELD,2) .AND. IDIMLEN(3) == SIZE(PFIELD,3)) THEN
- ! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, PFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X3[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
- END IF
- ! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
- ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X3',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
- ' not read (wrong size)')
- IRESP = -3
- END IF
+ ! Define the scalar variable
+#if (MNH_REAL == 8)
+ STATUS = NF90_DEF_VAR(INCID, TZFIELD%CMNHNAME, NF90_DOUBLE, IVARID)
+#else
+ STATUS = NF90_DEF_VAR(INCID, TZFIELD%CMNHNAME, NF90_FLOAT, IVARID)
+#endif
+ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_T0[NF90_DEF_VAR]')
+ CALL IO_WRITE_FIELD_ATTR_NC4(TPFILE,TZFIELD,IVARID,GEXISTED)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X3',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
- ' not read (wrong number of dimensions or wrong type)')
- IRESP = -3
+ GEXISTED = .TRUE.
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_NC4_T0',TRIM(TPFILE%CNAME)//': '//TRIM(TZFIELD%CMNHNAME)//' already defined')
END IF
-1000 CONTINUE
-KRESP = IRESP
-
-END SUBROUTINE IO_READ_FIELD_NC4_X3
-
-
-SUBROUTINE IO_READ_FIELD_NC4_X4(TPFILE, TPFIELD, PFIELD, KRESP)
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-REAL,DIMENSION(:,:,:,:),INTENT(OUT) :: PFIELD
-INTEGER, INTENT(OUT) :: KRESP ! return-code
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
-INTEGER(KIND=IDCDF_KIND),DIMENSION(4) :: IDIMLEN
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER :: IRESP
+! Write the data
+STATUS = NF90_PUT_VAR(INCID, IVARID, TPDATA%TIME)
+IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_T0[NF90_PUT_VAR] '//TRIM(TZFIELD%CMNHNAME),IRESP)
+#endif
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_X4',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+KRESP = IRESP
+END SUBROUTINE IO_WRITE_FIELD_NC4_T0
-IRESP = 0
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
+SUBROUTINE IO_WRITE_COORDVAR_NC4(TPFILE,HPROGRAM_ORIG)
+USE MODD_CONF, ONLY: CPROGRAM, LCARTESIAN
+USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
+USE MODD_GRID, ONLY: XLATORI, XLONORI
+USE MODD_GRID_n, ONLY: LSLEVE, XXHAT, XYHAT, XZHAT
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+USE MODE_FIELD, ONLY: TFIELDLIST,FIND_FIELD_ID_FROM_MNHNAME
+USE MODE_GRIDPROJ
+USE MODE_NEST_ll, ONLY: GET_MODEL_NUMBER_ll, GO_TOMODEL_ll
-! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X4[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
-END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_X4[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
-
-!Neglect the time dimension (of size 1)
-IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
-
-IF (IDIMS == 4 .AND. (ITYPE == NF90_FLOAT .OR. ITYPE == NF90_DOUBLE) ) THEN
- ! Check size of variable before reading
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X4[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X4[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X4[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(4), LEN=IDIMLEN(4))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X4[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
-
- IF ( IDIMLEN(1) == SIZE(PFIELD,1) .AND. IDIMLEN(2) == SIZE(PFIELD,2) .AND. &
- IDIMLEN(3) == SIZE(PFIELD,3) .AND. IDIMLEN(4) == SIZE(PFIELD,4)) THEN
- ! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, PFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X4[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
- END IF
- ! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
- ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X4',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
- ' not read (wrong size)')
- IRESP = -3
- END IF
-ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X4',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
- ' not read (wrong number of dimensions or wrong type)')
- IRESP = -3
-END IF
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: HPROGRAM_ORIG !To emulate a file coming from this program
-1000 CONTINUE
-KRESP = IRESP
+CHARACTER(LEN=:),ALLOCATABLE :: YSTDNAMEPREFIX
+CHARACTER(LEN=:),ALLOCATABLE :: YPROGRAM
+INTEGER :: IIU, IJU, IKU
+INTEGER :: ID, IID, IRESP
+INTEGER :: IMI
+INTEGER(KIND=IDCDF_KIND) :: INCID
+LOGICAL :: GCHANGEMODEL
+LOGICAL,POINTER :: GSLEVE
+REAL,DIMENSION(:),POINTER :: ZXHAT, ZYHAT, ZZHAT
+REAL,DIMENSION(:),ALLOCATABLE :: ZXHATM, ZYHATM,ZZHATM !Coordinates at mass points in the transformed space
+REAL,DIMENSION(:,:),POINTER :: ZLAT, ZLON
+TYPE(IOCDF), POINTER :: PIOCDF
-END SUBROUTINE IO_READ_FIELD_NC4_X4
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_COORDVAR_NC4','called for '//TRIM(TPFILE%CNAME))
+ZXHAT => NULL()
+ZYHAT => NULL()
+ZZHAT => NULL()
-SUBROUTINE IO_READ_FIELD_NC4_X5(TPFILE, TPFIELD, PFIELD, KRESP)
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-REAL,DIMENSION(:,:,:,:,:),INTENT(OUT) :: PFIELD
-INTEGER, INTENT(OUT) :: KRESP ! return-code
+PIOCDF => TPFILE%TNCDIMS
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
-INTEGER(KIND=IDCDF_KIND),DIMENSION(5) :: IDIMLEN
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER :: IRESP
+GCHANGEMODEL = .FALSE.
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_X5',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+IF (PRESENT(HPROGRAM_ORIG)) THEN
+ YPROGRAM = HPROGRAM_ORIG
+ELSE
+ YPROGRAM = CPROGRAM
+ENDIF
-IRESP = 0
! Get the Netcdf file ID
INCID = TPFILE%NNCID
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+IF (TPFILE%NMODEL>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('XHAT',IID,IRESP)
+ ZXHAT => TFIELDLIST(IID)%TFIELD_X1D(TPFILE%NMODEL)%DATA
+ CALL FIND_FIELD_ID_FROM_MNHNAME('YHAT',IID,IRESP)
+ ZYHAT => TFIELDLIST(IID)%TFIELD_X1D(TPFILE%NMODEL)%DATA
+ CALL FIND_FIELD_ID_FROM_MNHNAME('ZHAT',IID,IRESP)
+ ZZHAT => TFIELDLIST(IID)%TFIELD_X1D(TPFILE%NMODEL)%DATA
+ CALL FIND_FIELD_ID_FROM_MNHNAME('SLEVE',IID,IRESP)
+ GSLEVE => TFIELDLIST(IID)%TFIELD_L0D(TPFILE%NMODEL)%DATA
+ !
+ CALL GET_MODEL_NUMBER_ll(IMI)
+ IF (IMI/=TPFILE%NMODEL) THEN
+ !This is necessary to have correct domain sizes (used by GATHER_XXFIELD)
+ CALL GO_TOMODEL_ll(TPFILE%NMODEL,IRESP)
+ GCHANGEMODEL = .TRUE.
+ END IF
+ELSE
+ ZXHAT => XXHAT
+ ZYHAT => XYHAT
+ ZZHAT => XZHAT
+ GSLEVE => LSLEVE
+END IF
-! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X5[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
+IIU = SIZE(ZXHAT)
+IJU = SIZE(ZYHAT)
+ALLOCATE(ZXHATM(IIU),ZYHATM(IJU))
+!ZXHATM(IIU) and ZYHATM(IJU) are correct only on some processes
+!but it is OK due to the way GATHER_XXFIELD is done
+ZXHATM(1:IIU-1) = 0.5*(ZXHAT(1:IIU-1)+ZXHAT(2:IIU))
+ZXHATM(IIU) = 2.*ZXHAT(IIU)-ZXHATM(IIU-1)
+ZYHATM(1:IJU-1) = 0.5*(ZYHAT(1:IJU-1)+ZYHAT(2:IJU))
+ZYHATM(IJU) = 2.*ZYHAT(IJU)-ZYHATM(IJU-1)
+!
+IF (LCARTESIAN) THEN
+ YSTDNAMEPREFIX = 'plane'
+ELSE
+ YSTDNAMEPREFIX = 'projection'
+ENDIF
+CALL WRITE_HOR_COORD(PIOCDF%DIM_NI,'x-dimension of the grid',TRIM(YSTDNAMEPREFIX)//'_x_coordinate','X',0.,JPHEXT,JPHEXT,ZXHATM)
+CALL WRITE_HOR_COORD(PIOCDF%DIM_NJ,'y-dimension of the grid',TRIM(YSTDNAMEPREFIX)//'_y_coordinate','Y',0.,JPHEXT,JPHEXT,ZYHATM)
+CALL WRITE_HOR_COORD(PIOCDF%DIM_NI_U,'x-dimension of the grid at u location', &
+ TRIM(YSTDNAMEPREFIX)//'_x_coordinate_at_u_location','X',-0.5,JPHEXT,0, ZXHAT)
+CALL WRITE_HOR_COORD(PIOCDF%DIM_NJ_U,'y-dimension of the grid at u location', &
+ TRIM(YSTDNAMEPREFIX)//'_y_coordinate_at_u_location','Y', 0., JPHEXT,JPHEXT,ZYHATM)
+CALL WRITE_HOR_COORD(PIOCDF%DIM_NI_V,'x-dimension of the grid at v location', &
+ TRIM(YSTDNAMEPREFIX)//'_x_coordinate_at_v_location','X', 0., JPHEXT,JPHEXT,ZXHATM)
+CALL WRITE_HOR_COORD(PIOCDF%DIM_NJ_V,'y-dimension of the grid at v location', &
+ TRIM(YSTDNAMEPREFIX)//'_y_coordinate_at_v_location','Y',-0.5,JPHEXT,0, ZYHAT)
+!
+IF (.NOT.LCARTESIAN) THEN
+ ALLOCATE(ZLAT(IIU,IJU),ZLON(IIU,IJU))
+ !
+ !Compute latitude/longitude for the Arakawa points
+ !
+ ! Mass point
+ CALL WRITE_HOR_2DCOORD(ZXHATM,ZYHATM,'latitude', 'longitude')
+ ! u point
+ CALL WRITE_HOR_2DCOORD(ZXHAT, ZYHATM,'latitude_u','longitude_u')
+ ! v point
+ CALL WRITE_HOR_2DCOORD(ZXHATM,ZYHAT, 'latitude_v','longitude_v')
+ ! xi vorticity point (=f point =uv point)
+ CALL WRITE_HOR_2DCOORD(ZXHAT, ZYHAT, 'latitude_f','longitude_f')
+ !
+ DEALLOCATE(ZLAT,ZLON)
+END IF
+!
+DEALLOCATE(ZXHATM,ZYHATM)
+!
+IF (TPFILE%LMASTER) THEN !vertical coordinates in the transformed space are the same on all processes
+ IF (TRIM(YPROGRAM)/='PGD' .AND. TRIM(YPROGRAM)/='NESPGD' .AND. TRIM(YPROGRAM)/='ZOOMPG' &
+ .AND. .NOT.(TRIM(YPROGRAM)=='REAL' .AND. CSTORAGE_TYPE=='SU') ) THEN !condition to detect PREP_SURFEX
+ !
+ IKU = SIZE(ZZHAT)
+ ALLOCATE(ZZHATM(IKU))
+ ZZHATM(1:IKU-1) = 0.5 * (ZZHAT(2:IKU)+ZZHAT(1:IKU-1))
+ ZZHATM(IKU) = 2.* ZZHAT(IKU) - ZZHATM(IKU-1)
+ !
+ CALL WRITE_VER_COORD(PIOCDF%DIM_LEVEL, 'position z in the transformed space', '', &
+ 'altitude', 0., JPVEXT,JPVEXT,ZZHATM)
+ !
+ CALL WRITE_VER_COORD(PIOCDF%DIM_LEVEL_W,'position z in the transformed space at w location','', &
+ 'altitude_at_w_location',-0.5,JPVEXT,0, ZZHAT)
+ !
+ DEALLOCATE(ZZHATM)
+ END IF
END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_X5[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
-
-!Neglect the time dimension (of size 1)
-IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
-
-IF (IDIMS == 5 .AND. (ITYPE == NF90_FLOAT .OR. ITYPE == NF90_DOUBLE) ) THEN
- ! Check size of variable before reading
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X5[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X5[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X5[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(4), LEN=IDIMLEN(4))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X5[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(5), LEN=IDIMLEN(5))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X5[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
-
- IF ( IDIMLEN(1) == SIZE(PFIELD,1) .AND. IDIMLEN(2) == SIZE(PFIELD,2) .AND. &
- IDIMLEN(3) == SIZE(PFIELD,3) .AND. IDIMLEN(4) == SIZE(PFIELD,4) .AND. &
- IDIMLEN(5) == SIZE(PFIELD,5) ) THEN
- ! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, PFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X5[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
- END IF
- ! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
- ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X5',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
- ' not read (wrong size)')
- IRESP = -3
+!
+!Write time scale
+IF (TPFILE%LMASTER) THEN !Time scale is the same on all processes
+ IF (TRIM(YPROGRAM)/='PGD' .AND. TRIM(YPROGRAM)/='NESPGD' .AND. TRIM(YPROGRAM)/='ZOOMPG' &
+ .AND. .NOT.(TRIM(YPROGRAM)=='REAL' .AND. CSTORAGE_TYPE=='SU') ) THEN !condition to detect PREP_SURFEX
+ CALL WRITE_TIME_COORD(PIOCDF%DIMTIME)
END IF
-ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X5',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
- ' not read (wrong number of dimensions or wrong type)')
- IRESP = -3
END IF
-1000 CONTINUE
-KRESP = IRESP
-
-END SUBROUTINE IO_READ_FIELD_NC4_X5
-
-
-SUBROUTINE IO_READ_FIELD_NC4_X6(TPFILE, TPFIELD, PFIELD, KRESP)
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-REAL,DIMENSION(:,:,:,:,:,:),INTENT(OUT) :: PFIELD
-INTEGER, INTENT(OUT) :: KRESP ! return-code
+IF (GCHANGEMODEL) CALL GO_TOMODEL_ll(IMI,IRESP)
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
-INTEGER(KIND=IDCDF_KIND),DIMENSION(6) :: IDIMLEN
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER :: IRESP
+CONTAINS
+SUBROUTINE WRITE_HOR_COORD(TDIM,HLONGNAME,HSTDNAME,HAXIS,PSHIFT,KBOUNDLOW,KBOUNDHIGH,PCOORDS)
+ USE MODE_ALLOCBUFFER_ll, ONLY: ALLOCBUFFER_ll
+ USE MODE_GATHER_ll, ONLY: GATHER_XXFIELD
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_X6',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+ TYPE(DIMCDF), POINTER, INTENT(IN) :: TDIM
+ CHARACTER(LEN=*), INTENT(IN) :: HLONGNAME
+ CHARACTER(LEN=*), INTENT(IN) :: HSTDNAME
+ CHARACTER(LEN=*), INTENT(IN) :: HAXIS
+ REAL, INTENT(IN) :: PSHIFT
+ INTEGER, INTENT(IN) :: KBOUNDLOW
+ INTEGER, INTENT(IN) :: KBOUNDHIGH
+ REAL,DIMENSION(:),TARGET,OPTIONAL,INTENT(IN) :: PCOORDS
-IRESP = 0
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
+ CHARACTER(LEN=2) :: YDIR
+ CHARACTER(LEN=64) :: YRANGE
+ CHARACTER(LEN=:),ALLOCATABLE :: YVARNAME
+ INTEGER :: IRESP
+ INTEGER :: ISIZE
+ INTEGER :: JI
+ INTEGER(KIND=IDCDF_KIND) :: IVARID
+ INTEGER(KIND=IDCDF_KIND) :: IVDIM
+ INTEGER(KIND=IDCDF_KIND) :: STATUS
+ LOGICAL :: GALLOC
+ REAL,DIMENSION(:),POINTER :: ZTAB
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+ GALLOC = .FALSE.
+ ZTAB => NULL()
-! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X6[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
-END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_X6[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
-
-!Neglect the time dimension (of size 1)
-IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
-
-IF (IDIMS == 6 .AND. (ITYPE == NF90_FLOAT .OR. ITYPE == NF90_DOUBLE) ) THEN
- ! Check size of variable before reading
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X6[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X6[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X6[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(4), LEN=IDIMLEN(4))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X6[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(5), LEN=IDIMLEN(5))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X6[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(6), LEN=IDIMLEN(6))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X6[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
-
- IF ( IDIMLEN(1) == SIZE(PFIELD,1) .AND. IDIMLEN(2) == SIZE(PFIELD,2) .AND. &
- IDIMLEN(3) == SIZE(PFIELD,3) .AND. IDIMLEN(4) == SIZE(PFIELD,4) .AND. &
- IDIMLEN(5) == SIZE(PFIELD,5) .AND. IDIMLEN(6) == SIZE(PFIELD,6) ) THEN
- ! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, PFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X6[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
- END IF
- ! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ IF (HAXIS=='X') THEN
+ YDIR = 'XX'
+ ELSE IF (HAXIS=='Y') THEN
+ YDIR = 'YY'
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X6',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
- ' not read (wrong size)')
- IRESP = -3
+ CALL PRINT_MSG(NVERB_FATAL,'IO','WRITE_HOR_COORD','invalid HAXIS ('//TRIM(HAXIS)//')')
END IF
-ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X6',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
- ' not read (wrong number of dimensions or wrong type)')
- IRESP = -3
-END IF
-
-1000 CONTINUE
-KRESP = IRESP
-END SUBROUTINE IO_READ_FIELD_NC4_X6
-
-
-SUBROUTINE IO_READ_FIELD_NC4_N0(TPFILE, TPFIELD, KFIELD, KRESP)
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-INTEGER, INTENT(OUT) :: KFIELD
-INTEGER, INTENT(OUT) :: KRESP ! return-code
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_N0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
-
-IRESP = 0
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
-
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
-
-! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_N0[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
-END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_N0[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
-
-!Neglect the time dimension (of size 1)
-IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
-
-!Can read either 4 or 8 byte integers
-IF (IDIMS == 0 .AND. (ITYPE == NF90_INT .OR. ITYPE == NF90_INT64) ) THEN
- ! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, KFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_N0[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
- END IF
- ! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
-ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_N0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
- ' not read (wrong size or type)')
- IRESP = -3
-END IF
-
-1000 CONTINUE
-KRESP = IRESP
-
-END SUBROUTINE IO_READ_FIELD_NC4_N0
-
-
-SUBROUTINE IO_READ_FIELD_NC4_N1(TPFILE, TPFIELD, KFIELD, KRESP)
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-INTEGER, DIMENSION(:), INTENT(OUT) :: KFIELD
-INTEGER, INTENT(OUT) :: KRESP ! return-code
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_N1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
-
-IRESP = 0
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
-
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
-
-! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_N1[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
-END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_N1[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
-
-!Neglect the time dimension (of size 1)
-IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
+ IF (.NOT.TPFILE%LMASTER) THEN
+ IF (PRESENT(PCOORDS)) THEN
+ ALLOCATE(ZTAB(0)) !To prevent false positive with valgrind
+ GALLOC = .TRUE.
+ CALL GATHER_XXFIELD(YDIR,PCOORDS,ZTAB,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
+ END IF
+ ELSE !TPFILE%LMASTER
+ ISIZE = TDIM%LEN
+ YVARNAME = TRIM(TDIM%NAME)
+ IVDIM = TDIM%ID
-!NF90_INT1 is for the case a boolean was written
-IF (IDIMS == 1 .AND. (ITYPE == NF90_INT .OR. ITYPE == NF90_INT64 .OR. ITYPE == NF90_INT1) ) THEN
- ! Check size of variable before reading
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_N1[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+ IF (.NOT.PRESENT(PCOORDS)) THEN
+ ALLOCATE(ZTAB(ISIZE))
+ GALLOC = .TRUE.
+ DO JI=1,ISIZE
+ ZTAB(JI) = REAL(JI,KIND=KIND(ZTAB(1)))+PSHIFT
+ END DO
+ ELSE
+ IF (GSMONOPROC) THEN ! sequential execution
+ ZTAB => PCOORDS
+ ELSE ! multiprocesses execution
+ CALL ALLOCBUFFER_ll(ZTAB,PCOORDS,YDIR,GALLOC)
+ CALL GATHER_XXFIELD(YDIR,PCOORDS,ZTAB,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
+ ENDIF
+ END IF
- IF (IDIMLEN == SIZE(KFIELD)) THEN
- ! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, KFIELD)
+ STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_N1[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
+ ! Define the coordinate variable
+#if (MNH_REAL == 8)
+ STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVDIM, IVARID)
+#else
+ STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIM, IVARID)
+#endif
+ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_DEF_VAR]')
+ ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','WRITE_NC_COORDS_VAR',TRIM(YVARNAME)//' already defined')
END IF
- ! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
- ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_N1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
- ' not read (wrong size)')
- IRESP = -3
- END IF
-ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_N1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
- ' not read (wrong number of dimensions or wrong type)')
- IRESP = -3
-END IF
-
-1000 CONTINUE
-KRESP = IRESP
-
-END SUBROUTINE IO_READ_FIELD_NC4_N1
-
-
-SUBROUTINE IO_READ_FIELD_NC4_N2(TPFILE, TPFIELD, KFIELD, KRESP)
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-INTEGER, DIMENSION(:,:), INTENT(OUT) :: KFIELD
-INTEGER, INTENT(OUT) :: KRESP ! return-code
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND),DIMENSION(3) :: IDIMLEN
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_N2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
-
-IRESP = 0
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+ ! Write metadata
+ STATUS = NF90_PUT_ATT(INCID, IVARID, 'long_name',HLONGNAME)
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
+ STATUS = NF90_PUT_ATT(INCID, IVARID, 'standard_name',HSTDNAME)
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
+ IF (PRESENT(PCOORDS)) THEN
+ STATUS = NF90_PUT_ATT(INCID, IVARID, 'units','m')
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
+ END IF
+ STATUS = NF90_PUT_ATT(INCID, IVARID, 'axis',HAXIS)
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
+ STATUS = NF90_PUT_ATT(INCID, IVARID, 'c_grid_axis_shift',PSHIFT)
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
+ WRITE(YRANGE,'( I0,":",I0 )') 1+KBOUNDLOW,ISIZE-KBOUNDHIGH
+ STATUS = NF90_PUT_ATT(INCID, IVARID, 'c_grid_dynamic_range',TRIM(YRANGE))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
-! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_N2[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
-END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_N2[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
-
-!Neglect the time dimension (of size 1)
-IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
-
-!Treat special case of a degenerated 3D array (3rd dimension size is 1)
-IF (IDIMS==3) THEN
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_N2[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- IF (IDIMLEN(3)==1) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_FIELD_NC4_N2',TRIM(TPFILE%CNAME)// &
- ': reading 3D array with degenerated third dimension in 2D array for '//TRIM(YVARNAME))
- IDIMS = 2
- ELSE
- CALL PRINT_MSG(NVERB_FATAL,'IO','IO_READ_FIELD_NC4_N2',TRIM(TPFILE%CNAME)//': wrong number of dimensions for '//TRIM(YVARNAME))
+ ! Write the data
+ STATUS = NF90_PUT_VAR(INCID, IVARID, ZTAB)
+ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
END IF
-END IF
-!NF90_INT1 is for the case a boolean was written
-IF (IDIMS == SIZE(SHAPE(KFIELD)) .AND. (ITYPE == NF90_INT .OR. ITYPE == NF90_INT64 .OR. ITYPE == NF90_INT1) ) THEN
- ! Check size of variable before reading
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_N2[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_N2[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
-
- IF (IDIMLEN(1) == SIZE(KFIELD,1) .AND. IDIMLEN(2) == SIZE(KFIELD,2)) THEN
- ! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, KFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_N2[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
- END IF
- ! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
- ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_N2',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
- ' not read (wrong size)')
- IRESP = -3
- END IF
-ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_N2',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
- ' not read (wrong number of dimensions or wrong type)')
- IRESP = -3
-END IF
+ IF (GALLOC) DEALLOCATE(ZTAB)
+END SUBROUTINE WRITE_HOR_COORD
-1000 CONTINUE
-KRESP = IRESP
+SUBROUTINE WRITE_HOR_2DCOORD(PX,PY,HLAT,HLON)
+ USE MODE_ALLOCBUFFER_ll, ONLY: ALLOCBUFFER_ll
+ USE MODE_GATHER_ll, ONLY: GATHER_XYFIELD
-END SUBROUTINE IO_READ_FIELD_NC4_N2
+ REAL,DIMENSION(:), INTENT(IN) :: PX
+ REAL,DIMENSION(:), INTENT(IN) :: PY
+ CHARACTER(LEN=*), INTENT(IN) :: HLAT
+ CHARACTER(LEN=*), INTENT(IN) :: HLON
-SUBROUTINE IO_READ_FIELD_NC4_L0(TPFILE, TPFIELD, OFIELD, KRESP)
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-LOGICAL, INTENT(OUT) :: OFIELD
-INTEGER, INTENT(OUT) :: KRESP ! return-code
+ LOGICAL :: GALLOC1, GALLOC2
+ REAL,DIMENSION(:,:),POINTER :: ZTAB1, ZTAB2
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER :: IRESP
-INTEGER :: IFIELD
+ GALLOC1 = .FALSE.
+ GALLOC2 = .FALSE.
+ ZTAB1 => NULL()
+ ZTAB2 => NULL()
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_L0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+ CALL SM_LATLON(XLATORI,XLONORI, &
+ SPREAD(SOURCE=PX,DIM=2,NCOPIES=IJU), &
+ SPREAD(SOURCE=PY,DIM=1,NCOPIES=IIU), &
+ ZLAT,ZLON)
-IRESP = 0
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
+ IF (.NOT.TPFILE%LMASTER) THEN
+ ALLOCATE(ZTAB1(0,0),ZTAB2(0,0)) !To prevent false positive with valgrind
+ GALLOC1 = .TRUE. ; GALLOC2 = .TRUE.
+ CALL GATHER_XYFIELD(ZLAT,ZTAB1,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
+ CALL GATHER_XYFIELD(ZLON,ZTAB2,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
+ ELSE !TPFILE%LMASTER
+ IF (GSMONOPROC) THEN ! sequential execution
+ ZTAB1 => ZLAT
+ ZTAB2 => ZLON
+ ELSE ! multiprocesses execution
+ CALL ALLOCBUFFER_ll(ZTAB1,ZLAT,'XY',GALLOC1)
+ CALL ALLOCBUFFER_ll(ZTAB2,ZLON,'XY',GALLOC2)
+ CALL GATHER_XYFIELD(ZLAT,ZTAB1,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
+ CALL GATHER_XYFIELD(ZLON,ZTAB2,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
+ ENDIF
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME(HLAT,ID,IRESP)
+ CALL IO_WRITE_FIELD_NC4_X2(TPFILE,TFIELDLIST(ID),ZTAB1,IRESP,OISCOORD=.TRUE.)
+ CALL FIND_FIELD_ID_FROM_MNHNAME(HLON,ID,IRESP)
+ CALL IO_WRITE_FIELD_NC4_X2(TPFILE,TFIELDLIST(ID),ZTAB2,IRESP,OISCOORD=.TRUE.)
+ END IF
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+ IF (GALLOC1) DEALLOCATE(ZTAB1)
+ IF (GALLOC2) DEALLOCATE(ZTAB2)
+END SUBROUTINE WRITE_HOR_2DCOORD
-! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_L0[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
-END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_L0[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
+SUBROUTINE WRITE_VER_COORD(TDIM,HLONGNAME,HSTDNAME,HCOMPNAME,PSHIFT,KBOUNDLOW,KBOUNDHIGH,PCOORDS)
+ TYPE(DIMCDF), POINTER, INTENT(IN) :: TDIM
+ CHARACTER(LEN=*), INTENT(IN) :: HLONGNAME
+ CHARACTER(LEN=*), INTENT(IN) :: HSTDNAME
+ CHARACTER(LEN=*), INTENT(IN) :: HCOMPNAME
+ REAL, INTENT(IN) :: PSHIFT
+ INTEGER, INTENT(IN) :: KBOUNDLOW
+ INTEGER, INTENT(IN) :: KBOUNDHIGH
+ REAL,DIMENSION(:), INTENT(IN) :: PCOORDS
-!Neglect the time dimension (of size 1)
-IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
+ CHARACTER(LEN=64) :: YRANGE
+ CHARACTER(LEN=:),ALLOCATABLE :: YVARNAME
+ INTEGER :: IRESP
+ INTEGER :: ISIZE
+ INTEGER :: JI
+ INTEGER(KIND=IDCDF_KIND) :: IVARID
+ INTEGER(KIND=IDCDF_KIND) :: IVDIM
+ INTEGER(KIND=IDCDF_KIND) :: STATUS
-!NF90_INT1 is for the case a boolean was written
-!Accept also INT and INT64 (for backward compatibility)
-IF (IDIMS == 0 .AND. (ITYPE == NF90_INT1 .OR. ITYPE == NF90_INT .OR. ITYPE == NF90_INT64) ) THEN
- ! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, IFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_L0[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
- END IF
+ ISIZE = TDIM%LEN
+ YVARNAME = TRIM(TDIM%NAME)
+ IVDIM = TDIM%ID
- IF (IFIELD==0) THEN
- OFIELD = .FALSE.
- ELSE IF (IFIELD==1) THEN
- OFIELD = .TRUE.
+ STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+ IF (STATUS /= NF90_NOERR) THEN
+ ! Define the coordinate variable
+#if (MNH_REAL == 8)
+ STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVDIM, IVARID)
+#else
+ STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIM, IVARID)
+#endif
+ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_DEF_VAR]')
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_LFI_L0',TRIM(TPFILE%CNAME)//': invalid value in file for ' &
- //TRIM(TPFIELD%CMNHNAME))
- OFIELD = .TRUE.
- IRESP = -112
+ CALL PRINT_MSG(NVERB_ERROR,'IO','WRITE_NC_COORDS_VAR',TRIM(YVARNAME)//' already defined')
END IF
- ! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
-ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_L0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
- ' not read (wrong size or type)')
- IRESP = -3
-END IF
+ ! Write metadata
+ STATUS = NF90_PUT_ATT(INCID, IVARID, 'long_name',HLONGNAME)
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
+ STATUS = NF90_PUT_ATT(INCID, IVARID, 'standard_name',HSTDNAME)
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
+ STATUS = NF90_PUT_ATT(INCID, IVARID, 'units','m')
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
+ STATUS = NF90_PUT_ATT(INCID, IVARID, 'axis','Z')
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
+ STATUS = NF90_PUT_ATT(INCID, IVARID, 'positive','up')
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
+ STATUS = NF90_PUT_ATT(INCID, IVARID, 'c_grid_axis_shift',PSHIFT)
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
+ WRITE(YRANGE,'( I0,":",I0 )') 1+KBOUNDLOW,ISIZE-KBOUNDHIGH
+ STATUS = NF90_PUT_ATT(INCID, IVARID, 'c_grid_dynamic_range',TRIM(YRANGE))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
+ !
+ IF (GSLEVE) THEN
+ !Remark: ZS, ZSMT and ZTOP in the formula are the same for mass point or flux point
+ STATUS = NF90_PUT_ATT(INCID, IVARID,'formula_terms','s: '//TRIM(YVARNAME)// &
+ ' height: ZTOP oro_ls: ZSMT oro: ZS len1: LEN1 len2: LEN2')
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
+ STATUS = NF90_PUT_ATT(INCID, IVARID, 'formula_definition','z(n,k,j,i)=s(k)'// &
+ '+ oro_ls(j,i)*sinh((height/len1)**1.35-(s(k)/len1)**1.35)/sinh((s(k)/len1)**1.35)'// &
+ '+(oro(j,i)-oro_ls(j,i))*sinh((height/len2)**1.35-(s(k)/len2)**1.35)/sinh((s(k)/len2)**1.35)')
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
+ ELSE
+ !Remark: ZS and ZTOP in the formula are the same for mass point or flux point
+ STATUS = NF90_PUT_ATT(INCID, IVARID, 'formula_terms','s: '//TRIM(YVARNAME)//' height: ZTOP orog: ZS')
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
+ STATUS = NF90_PUT_ATT(INCID, IVARID, 'formula_definition','z(n,k,j,i)=s(k)*(height-orog(j,i))/height+orog(j,i)')
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
+ ENDIF
+ !
+ STATUS = NF90_PUT_ATT(INCID, IVARID, 'computed_standard_name',HCOMPNAME)
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
-1000 CONTINUE
-KRESP = IRESP
+ ! Write the data
+ STATUS = NF90_PUT_VAR(INCID, IVARID, PCOORDS)
+ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
-END SUBROUTINE IO_READ_FIELD_NC4_L0
+END SUBROUTINE WRITE_VER_COORD
+SUBROUTINE WRITE_TIME_COORD(TDIM)
+ USE MODD_TIME_n, ONLY: TDTMOD, TDTCUR
+ USE MODD_TYPE_DATE
-SUBROUTINE IO_READ_FIELD_NC4_L1(TPFILE, TPFIELD, OFIELD, KRESP)
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-LOGICAL,DIMENSION(:),INTENT(OUT) :: OFIELD
-INTEGER, INTENT(OUT) :: KRESP ! return-code
+ USE MODE_DATETIME
+ USE MODE_FIELD, ONLY: TFIELDLIST,FIND_FIELD_ID_FROM_MNHNAME
+ USE MODE_GRIDPROJ
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
-INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER :: IRESP
-INTEGER :: JI
-INTEGER,DIMENSION(SIZE(OFIELD)) :: IFIELD
+ TYPE(DIMCDF), POINTER, INTENT(IN) :: TDIM
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_L1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+ REAL :: ZDELTATIME
+ CHARACTER(LEN=40) :: YUNITS
+ CHARACTER(LEN=:),ALLOCATABLE :: YVARNAME
+ INTEGER(KIND=IDCDF_KIND) :: IVARID
+ INTEGER(KIND=IDCDF_KIND) :: IVDIM
+ INTEGER(KIND=IDCDF_KIND) :: STATUS
+ TYPE(DATE_TIME) :: TZREF
-IRESP = 0
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+ IF (ASSOCIATED(TDTCUR) .AND. ASSOCIATED(TDTMOD)) THEN
+ YVARNAME = TRIM(TDIM%NAME)
+ IVDIM = TDIM%ID
-! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_L1[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
-END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_L1[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
-
-!Neglect the time dimension (of size 1)
-IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
-
-!NF90_INT1 is for the case a boolean was written
-!Accept also INT and INT64 (for backward compatibility)
-IF (IDIMS == 1 .AND. (ITYPE == NF90_INT1 .OR. ITYPE == NF90_INT .OR. ITYPE == NF90_INT64) ) THEN
- ! Check size of variable before reading
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_L1[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
-
- IF (IDIMLEN == SIZE(OFIELD)) THEN
- ! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, IFIELD)
+ STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_L1[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
+ ! Define the coordinate variable
+#if (MNH_REAL == 8)
+ STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVDIM, IVARID)
+#else
+ STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIM, IVARID)
+#endif
+ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_TIME_COORD[NF90_DEF_VAR]')
+ ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','WRITE_TIME_COORD',TRIM(YVARNAME)//' already defined')
END IF
- DO JI=1,IDIMLEN
- IF (IFIELD(JI)==0) THEN
- OFIELD(JI) = .FALSE.
- ELSE IF (IFIELD(JI)==1) THEN
- OFIELD(JI) = .TRUE.
- ELSE
- OFIELD(JI) = .TRUE.
- IRESP = -112
- END IF
- END DO
- IF (IRESP==-112) THEN
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_LFI_L1',TRIM(TPFILE%CNAME)//': invalid value(s) in file for ' &
- //TRIM(TPFIELD%CMNHNAME))
- END IF
+ ! Write metadata
+ STATUS = NF90_PUT_ATT(INCID, IVARID, 'long_name','time axis')
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
+ STATUS = NF90_PUT_ATT(INCID, IVARID, 'standard_name','time')
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
+ WRITE(YUNITS,'( "seconds since ",I4.4,"-",I2.2,"-",I2.2," 00:00:00 +0:00" )') &
+ TDTMOD%TDATE%YEAR,TDTMOD%TDATE%MONTH,TDTMOD%TDATE%DAY
+ STATUS = NF90_PUT_ATT(INCID, IVARID, 'units',YUNITS)
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
+ STATUS = NF90_PUT_ATT(INCID, IVARID, 'axis','T')
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
+ STATUS = NF90_PUT_ATT(INCID, IVARID,'calendar','standard')
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_ATT]')
- ! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
- ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_L1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
- ' not read (wrong size)')
- IRESP = -3
+ ! Model beginning date (TDTMOD%TDATE) is used as the reference date
+ ! Reference time is set to 0.
+ TZREF = TDTMOD
+ TZREF%TIME = 0.
+ ! Compute the temporal distance from reference
+ CALL DATETIME_DISTANCE(TZREF,TDTCUR,ZDELTATIME)
+ ! Write the data
+ STATUS = NF90_PUT_VAR(INCID, IVARID, ZDELTATIME)
+ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITE_NC_COORDS_VAR[NF90_PUT_VAR] '//TRIM(YVARNAME))
END IF
-ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_L1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
- ' not read (wrong number of dimensions or wrong type)')
- IRESP = -3
-END IF
-1000 CONTINUE
-KRESP = IRESP
+END SUBROUTINE WRITE_TIME_COORD
+
+END SUBROUTINE IO_WRITE_COORDVAR_NC4
-END SUBROUTINE IO_READ_FIELD_NC4_L1
+SUBROUTINE IO_WRITE_HEADER_NC4(TPFILE)
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File structure
+!
+INTEGER(KIND=IDCDF_KIND) :: ISTATUS
+!
+IF (TRIM(TPFILE%CFORMAT)/='NETCDF4' .AND. TRIM(TPFILE%CFORMAT)/='LFICDF4') RETURN
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_HEADER_NC4','called for file '//TRIM(TPFILE%CNAME))
+!
+IF (TPFILE%LMASTER) THEN
+ ISTATUS = NF90_PUT_ATT(TPFILE%NNCID, NF90_GLOBAL, 'Conventions', 'CF-1.7 COMODO-1.4')
+ IF (ISTATUS /= NF90_NOERR) CALL HANDLE_ERR(ISTATUS,__LINE__,'IO_FILE_WRITE_HEADER[NF90_PUT_ATT]')
-SUBROUTINE IO_READ_FIELD_NC4_C0(TPFILE, TPFIELD, HFIELD, KRESP)
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-CHARACTER(LEN=*), INTENT(OUT) :: HFIELD
-INTEGER, INTENT(OUT) :: KRESP ! return-code
+#if (MNH_REAL == 8)
+ ISTATUS = NF90_PUT_ATT(TPFILE%NNCID, NF90_GLOBAL, 'MNH_REAL', '8')
+#else
+ ISTATUS = NF90_PUT_ATT(TPFILE%NNCID, NF90_GLOBAL, 'MNH_REAL', '4')
+#endif
+ IF (ISTATUS /= NF90_NOERR) CALL HANDLE_ERR(ISTATUS,__LINE__,'IO_FILE_WRITE_HEADER[NF90_PUT_ATT]')
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
-CHARACTER(LEN=30) :: YVARNAME
-CHARACTER(LEN=:),ALLOCATABLE :: YSTR
-INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
-INTEGER :: IRESP
+#if (MNH_INT == 4)
+ ISTATUS = NF90_PUT_ATT(TPFILE%NNCID, NF90_GLOBAL, 'MNH_INT', '4')
+#else
+ ISTATUS = NF90_PUT_ATT(TPFILE%NNCID, NF90_GLOBAL, 'MNH_INT', '8')
+#endif
+ IF (ISTATUS /= NF90_NOERR) CALL HANDLE_ERR(ISTATUS,__LINE__,'IO_FILE_WRITE_HEADER[NF90_PUT_ATT]')
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_C0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+!title
-IRESP = 0
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
+ !history
+ CALL IO_APPEND_HISTORY_NC4(TPFILE)
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+!institution
-! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_C0[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
-END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_C0[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
-
-IF (IDIMS == 1 .AND. (ITYPE == NF90_CHAR) ) THEN
- ! Check size of variable before reading
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_C0[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- !
- ALLOCATE(CHARACTER(LEN=IDIMLEN)::YSTR)
- ! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, YSTR)
- IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_C0[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
- END IF
- IF (LEN_TRIM(YSTR) > LEN(HFIELD)) &
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_C0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' truncated')
- HFIELD = TRIM(YSTR)
- DEALLOCATE(YSTR)
+!source
- ! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
-ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_C0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
- ' not read (wrong size or type)')
- IRESP = -3
-END IF
+!comment
-1000 CONTINUE
-KRESP = IRESP
+!references
+END IF
+!
+END SUBROUTINE IO_WRITE_HEADER_NC4
-END SUBROUTINE IO_READ_FIELD_NC4_C0
-SUBROUTINE IO_READ_FIELD_NC4_T0(TPFILE, TPFIELD, TPDATA, KRESP)
+SUBROUTINE IO_APPEND_HISTORY_NC4(TPFILE)
!
-USE MODD_TYPE_DATE
+USE MODD_IO_ll, ONLY: TFILEDATA
!
-USE MODE_DATETIME
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File structure
!
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-TYPE (DATE_TIME), INTENT(OUT) :: TPDATA
-INTEGER, INTENT(OUT) :: KRESP ! return-code
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-CHARACTER(LEN=30) :: YVARNAME
-CHARACTER(LEN=:),ALLOCATABLE :: YSTR
-INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
-INTEGER :: IDX,IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_T0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
-
-IRESP = 0
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
+INTEGER,PARAMETER :: YEAR=1, MONTH=2, DAY=3, HH=5, MM=6, SS=7
+!
+CHARACTER(len=5) :: YZONE
+CHARACTER(LEN=:),ALLOCATABLE :: YCMD, YHISTORY, YHISTORY_NEW, YHISTORY_PREV
+INTEGER :: ILEN_CMD, ILEN_PREV
+INTEGER(KIND=IDCDF_KIND) :: ISTATUS
+INTEGER,DIMENSION(8) :: IDATETIME
+!
+IF (TRIM(TPFILE%CFORMAT)/='NETCDF4' .AND. TRIM(TPFILE%CFORMAT)/='LFICDF4') RETURN
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_APPEND_HISTORY_NC4','called for file '//TRIM(TPFILE%CNAME))
+!
+IF (TPFILE%LMASTER) THEN
+ !Check if history attribute already exists in file and read it
+ ISTATUS = NF90_INQUIRE_ATTRIBUTE(TPFILE%NNCID, NF90_GLOBAL, 'history', LEN=ILEN_PREV)
+ IF (ISTATUS == NF90_NOERR) THEN
+ ALLOCATE(CHARACTER(LEN=ILEN_PREV) :: YHISTORY_PREV)
+ ISTATUS = NF90_GET_ATT(TPFILE%NNCID, NF90_GLOBAL, 'history', YHISTORY_PREV)
+ IF (ISTATUS /= NF90_NOERR) CALL HANDLE_ERR(ISTATUS,__LINE__,'IO_APPEND_HISTORY_NC4[NF90_GET_ATT]')
+ YHISTORY_PREV = YHISTORY_PREV
+ ELSE
+ ILEN_PREV = 0
+ END IF
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+ !Get date and time
+ call DATE_AND_TIME( VALUES=IDATETIME, ZONE=YZONE )
+ call GET_COMMAND(lENGTH=ILEN_CMD)
+ IF (ILEN_CMD>0) THEN
+ ALLOCATE(CHARACTER(ILEN_CMD) :: YCMD)
+ CALL GET_COMMAND(COMMAND=YCMD)
+ END IF
-! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_T0[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
-END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_T0[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
+ !Prepare new history entry
+ ALLOCATE(CHARACTER(26+ILEN_CMD) :: YHISTORY_NEW)
+ WRITE(YHISTORY_NEW, '( I4.4,"-",I2.2,"-",I2.2,"T",I2.2,":",I2.2,":",I2.2,A5,": ", A )') &
+ IDATETIME(YEAR),IDATETIME(MONTH),IDATETIME(DAY),IDATETIME(HH),IDATETIME(MM),IDATETIME(SS),YZONE, YCMD
-IF (IDIMS == 0 .AND. (ITYPE == NF90_FLOAT .OR. ITYPE == NF90_DOUBLE) ) THEN
- ! Read time
- STATUS = NF90_GET_VAR(INCID, IVARID, TPDATA%TIME)
- IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X0[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
- END IF
- ! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP,HCALENDAR='standard')
- ! Extract date from UNITS
- IDX = INDEX(TPFIELD%CUNITS,'since ')
- READ(TPFIELD%CUNITS(IDX+6 :IDX+9), '( I4.4 )') TPDATA%TDATE%YEAR
- READ(TPFIELD%CUNITS(IDX+11:IDX+12),'( I2.2 )') TPDATA%TDATE%MONTH
- READ(TPFIELD%CUNITS(IDX+14:IDX+15),'( I2.2 )') TPDATA%TDATE%DAY
- ! Simple check (should catch most errors)
- IF ( TPDATA%TDATE%DAY<1 .OR. TPDATA%TDATE%DAY>31 .OR. TPDATA%TDATE%MONTH<1 .OR. TPDATA%TDATE%MONTH>12 ) THEN
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_T0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
- ' read date is invalid')
- IRESP = -3
+ !Write full history
+ IF (ILEN_PREV == 0) THEN
+ YHISTORY = YHISTORY_NEW
+ ELSE
+ YHISTORY = YHISTORY_NEW//NEW_LINE('A')//YHISTORY_PREV
END IF
- ! Correct date and time (necessary for example if time is bigger than 86400 s)
- CALL DATETIME_CORRECTDATE(TPDATA)
-ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_T0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
- ' not read (wrong size or type)')
- IRESP = -3
+ ISTATUS = NF90_PUT_ATT(TPFILE%NNCID, NF90_GLOBAL, 'history', YHISTORY )
+ IF (ISTATUS /= NF90_NOERR) CALL HANDLE_ERR(ISTATUS,__LINE__,'IO_APPEND_HISTORY_NC4[NF90_PUT_ATT]')
END IF
-1000 CONTINUE
-KRESP = IRESP
-
-END SUBROUTINE IO_READ_FIELD_NC4_T0
+END SUBROUTINE IO_APPEND_HISTORY_NC4
-END MODULE MODE_NETCDF
+end module mode_io_write_nc4
#else
!
! External dummy subroutines
!
-SUBROUTINE IO_WRITE_FIELD_NC4(A,B,C,D)
-INTEGER :: A,B,C,D
-PRINT *, 'IO_WRITE_FIELD_NC4 empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF4 I/Os.'
-END SUBROUTINE IO_WRITE_FIELD_NC4
-
-SUBROUTINE IO_READ_FIELD_NC4(A,B,C,D)
-INTEGER :: A,B,C,D
-PRINT *, 'IO_READ_FIELD_NC4 empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF4 I/Os.'
-END SUBROUTINE IO_READ_FIELD_NC4
-
-SUBROUTINE IO_WRITE_HEADER_NC4(A,B)
-INTEGER :: A,B
-PRINT *, 'IO_WRITE_HEADER_NC4 empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF4 I/Os.'
-END SUBROUTINE IO_WRITE_HEADER_NC4
-
-SUBROUTINE CLEANIOCDF(A)
-INTEGER :: A
-PRINT *, 'CLEANIOCDF empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF4 I/Os.'
-END SUBROUTINE CLEANIOCDF
-
+subroutine io_write_coordvar_nc4(a, b)
+use mode_msg
+integer :: a, b
+CALL PRINT_MSG(NVERB_ERROR,'IO','io_write_coordvar_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine io_write_coordvar_nc4
+!
+subroutine io_write_field_nc4(a, b, c, d, e, f, g)
+use mode_msg
+integer :: a, b, c, d, e, f, g
+CALL PRINT_MSG(NVERB_ERROR,'IO','io_write_field_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine io_write_field_nc4
+!
+subroutine io_write_header_nc4(a)
+use mode_msg
+integer :: a
+CALL PRINT_MSG(NVERB_ERROR,'IO','io_write_header_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine io_write_header_nc4
+!
#endif
diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index 6836f74fa..f2c335258 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -345,7 +345,6 @@ USE MODE_ll
USE MODE_MNH_TIMING
USE MODE_MODELN_HANDLER
USE MODE_MPPDB
-USE MODE_NETCDF
!
USE MODI_ADVECTION_METSV
USE MODI_ADVECTION_UVW
--
GitLab