From ddaac8a567d0799c195e2aef36d59ae3bcb18dec Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Tue, 27 Jun 2017 16:50:17 +0200
Subject: [PATCH] Philippe 27/06/2017: IO: * added IO_BCAST_FIELD_METADATA
subroutine * added IO_READ_CHECK_FIELD_ATTR_NC4 subroutine * do not use
FMHEADER anymore for IO_READ_FIELD and its subroutines * treat error messages
as soon as possible
---
src/LIB/SURCOUCHE/src/fmread_ll.f90 | 53 ++++---
src/LIB/SURCOUCHE/src/fmreadwrit.f90 | 93 ++++++++-----
src/LIB/SURCOUCHE/src/mode_io.f90 | 4 +-
src/LIB/SURCOUCHE/src/mode_netcdf.f90 | 192 ++++++++++++++++++++++++--
4 files changed, 278 insertions(+), 64 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/fmread_ll.f90 b/src/LIB/SURCOUCHE/src/fmread_ll.f90
index cae9e5e85..f7b6a1d87 100644
--- a/src/LIB/SURCOUCHE/src/fmread_ll.f90
+++ b/src/LIB/SURCOUCHE/src/fmread_ll.f90
@@ -34,6 +34,7 @@ USE MODE_FIELD
USE MODE_NETCDF
#endif
USE MODE_MSG
+USE MODE_READWRITE_LFI
IMPLICIT NONE
@@ -104,8 +105,8 @@ END SUBROUTINE FM_READ_ERR
SUBROUTINE BCAST_HEADER(TPFD,TPFMH)
USE MODE_FD_ll, ONLY : FD_ll
USE MODD_FM
-TYPE(FD_ll), POINTER :: TPFD
-TYPE(FMHEADER), INTENT(IN) :: TPFMH
+TYPE(FD_ll), POINTER :: TPFD
+TYPE(FMHEADER), INTENT(INOUT) :: TPFMH
INTEGER :: ierr
@@ -115,6 +116,28 @@ CALL MPI_BCAST(TPFMH%COMMENT,TPFMH%COMLEN,MPI_CHARACTER,TPFD%OWNER-1,TPFD%COMM,I
END SUBROUTINE BCAST_HEADER
+SUBROUTINE IO_BCAST_FIELD_METADATA(TPFD,TPFIELD)
+USE MODE_FD_ll, ONLY : FD_ll
+TYPE(FD_ll), POINTER, INTENT(IN) :: TPFD
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+!
+INTEGER :: IERR
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_BCAST_FIELD_METADATA','called for '//TRIM(TPFIELD%CMNHNAME))
+!
+CALL MPI_BCAST(TPFIELD%CMNHNAME, LEN(TPFIELD%CMNHNAME), MPI_CHARACTER,TPFD%OWNER-1,TPFD%COMM,IERR)
+CALL MPI_BCAST(TPFIELD%CSTDNAME, LEN(TPFIELD%CSTDNAME), MPI_CHARACTER,TPFD%OWNER-1,TPFD%COMM,IERR)
+CALL MPI_BCAST(TPFIELD%CLONGNAME,LEN(TPFIELD%CLONGNAME),MPI_CHARACTER,TPFD%OWNER-1,TPFD%COMM,IERR)
+CALL MPI_BCAST(TPFIELD%CUNITS, LEN(TPFIELD%CUNITS), MPI_CHARACTER,TPFD%OWNER-1,TPFD%COMM,IERR)
+CALL MPI_BCAST(TPFIELD%CDIR, LEN(TPFIELD%CDIR), MPI_CHARACTER,TPFD%OWNER-1,TPFD%COMM,IERR)
+CALL MPI_BCAST(TPFIELD%CLBTYPE, LEN(TPFIELD%CLBTYPE), MPI_CHARACTER,TPFD%OWNER-1,TPFD%COMM,IERR)
+CALL MPI_BCAST(TPFIELD%CCOMMENT, LEN(TPFIELD%CCOMMENT), MPI_CHARACTER,TPFD%OWNER-1,TPFD%COMM,IERR)
+CALL MPI_BCAST(TPFIELD%NGRID, 1, MPI_INTEGER, TPFD%OWNER-1,TPFD%COMM,IERR)
+CALL MPI_BCAST(TPFIELD%NTYPE, 1, MPI_INTEGER, TPFD%OWNER-1,TPFD%COMM,IERR)
+CALL MPI_BCAST(TPFIELD%NDIMS, 1, MPI_INTEGER, TPFD%OWNER-1,TPFD%COMM,IERR)
+!
+END SUBROUTINE IO_BCAST_FIELD_METADATA
+
SUBROUTINE FMREADX0_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
KLENCH,HCOMMENT,KRESP)
USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
@@ -1297,20 +1320,16 @@ END SUBROUTINE IO_READ_FIELD_BYNAME_N0
SUBROUTINE IO_READ_FIELD_BYFIELD_N0(TPFILE,TPFIELD,KFIELD,KRESP)
!
USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
-USE MODD_FM
USE MODE_FD_ll, ONLY : GETFD,FD_LL
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
INTEGER, INTENT(INOUT) :: KFIELD ! array containing the data field
INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
!
INTEGER :: IERR
TYPE(FD_ll), POINTER :: TZFD
INTEGER :: IRESP
-TYPE(FMHEADER) :: TZFMH
-CHARACTER(LEN=:),ALLOCATABLE :: YMSG
-CHARACTER(LEN=6) :: YRESP
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYFIELD_N0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -1320,38 +1339,32 @@ TZFD=>GETFD(TRIM(ADJUSTL(TPFILE%CNAME))//'.lfi')
IF (ASSOCIATED(TZFD)) THEN
IF (GSMONOPROC) THEN ! sequential execution
IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,KFIELD,TZFMH,IRESP)
+ CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,KFIELD,IRESP)
ELSE
- CALL FM_READ_ll(TZFD%FLU,TPFIELD%CMNHNAME,.FALSE.,1,KFIELD,TZFMH,IRESP)
+ CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,KFIELD,IRESP)
END IF
ELSE
IF (ISP == TZFD%OWNER) THEN
IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,KFIELD,TZFMH,IRESP)
+ CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,KFIELD,IRESP)
ELSE
- CALL FM_READ_ll(TZFD%FLU,TPFIELD%CMNHNAME,.FALSE.,1,KFIELD,TZFMH,IRESP)
+ CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,KFIELD,IRESP)
END IF
END IF
!
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
!
- CALL BCAST_HEADER(TZFD,TZFMH)
+ !Broadcast header only if IRESP==-111
+ !because metadata of field has been modified in IO_READ_FIELD_xxx
+ IF (IRESP==-111) CALL IO_BCAST_FIELD_METADATA(TZFD,TPFIELD)
!
CALL MPI_BCAST(KFIELD,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
END IF
-! KGRID = TZFMH%GRID
-! HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
ELSE
IRESP = -61
CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_BYFIELD_N0','file '//TRIM(TPFILE%CNAME)//' not found')
END IF
!
-IF (IRESP.NE.0) THEN
- WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when reading '//TRIM(TPFIELD%CMNHNAME)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_BYFIELD_N0',YMSG)
-ENDIF
-!
IF (PRESENT(KRESP)) KRESP = IRESP
!
END SUBROUTINE IO_READ_FIELD_BYFIELD_N0
diff --git a/src/LIB/SURCOUCHE/src/fmreadwrit.f90 b/src/LIB/SURCOUCHE/src/fmreadwrit.f90
index a235ff73d..7786a519a 100644
--- a/src/LIB/SURCOUCHE/src/fmreadwrit.f90
+++ b/src/LIB/SURCOUCHE/src/fmreadwrit.f90
@@ -300,7 +300,7 @@ PUBLIC IO_READ_FIELD_LFI,IO_WRITE_FIELD_LFI
!
CONTAINS
!
-SUBROUTINE IO_READ_FIELD_LFI_N0(TPFILE,TPFIELD,KFIELD,TPFMH,KRESP)
+SUBROUTINE IO_READ_FIELD_LFI_N0(TPFILE,TPFIELD,KFIELD,KRESP)
USE MODD_FM
USE MODD_CONFZ, ONLY : NZ_VERB
USE MODE_MSG
@@ -309,11 +309,10 @@ IMPLICIT NONE
!
!* 0.1 Declarations of arguments
!
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-TYPE(TFIELDDATA),INTENT(IN) :: TPFIELD
-INTEGER, INTENT(OUT) :: KFIELD ! array containing the data field
-TYPE(FMHEADER), INTENT(OUT) :: TPFMH ! FM-File Header
-INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA),INTENT(INOUT) :: TPFIELD
+INTEGER, INTENT(OUT) :: KFIELD ! array containing the data field
+INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
!
!* 0.2 Declarations of local variables
!
@@ -325,9 +324,9 @@ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_N0',TRIM(TPFILE%CNAME)//': re
!
ILENG = 1
!
-CALL IO_READ_AND_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,TPFMH,IRESP)
+CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP)
!
-IF (IRESP==0) KFIELD = IWORK(TPFMH%COMLEN+3)
+IF (IRESP==0) KFIELD = IWORK(IWORK(2)+3)
!
KRESP=IRESP
!
@@ -336,20 +335,23 @@ IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
END SUBROUTINE IO_READ_FIELD_LFI_N0
!
!
-SUBROUTINE IO_READ_AND_CHECK_FIELD_LFI(TPFILE,TPFIELD,KLENG,KWORK,KTOTAL,TPFMH,KRESP)
+SUBROUTINE IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,KLENG,KWORK,KTOTAL,KRESP)
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
INTEGER, INTENT(IN) :: KLENG
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE,INTENT(OUT) :: KWORK
INTEGER(KIND=LFI_INT), INTENT(OUT) :: KTOTAL
-TYPE(FMHEADER), INTENT(OUT) :: TPFMH ! FM-File Header
INTEGER(KIND=LFI_INT), INTENT(OUT) :: KRESP
!
-INTEGER :: IROW,J
-INTEGER,DIMENSION(JPXKRK) :: ICOMMENT
-INTEGER(KIND=LFI_INT) :: INUMBR,IPOSEX
-CHARACTER(LEN=12) :: YRECLENGTH_FILE, YRECLENGTH_MEM
+INTEGER :: IROW,J
+INTEGER,DIMENSION(JPXKRK) :: ICOMMENT
+INTEGER(KIND=LFI_INT) :: ICOMLEN,INUMBR,IPOSEX
+CHARACTER(LEN=:),ALLOCATABLE :: YMSG
+CHARACTER(LEN=12) :: YRECLENGTH_FILE, YRECLENGTH_MEM
+CHARACTER(LEN=12) :: YVAL_FILE, YVAL_MEM
+CHARACTER(LEN=JPXKRK) :: YCOMMENT
+CHARACTER(LEN=12) :: YRESP
!
!* 2.a LET'S GET SOME INFORMATION ON THE DESIRED ARTICLE
!
@@ -357,14 +359,17 @@ INUMBR = TPFILE%NLFIFLU
CALL LFINFO(KRESP,INUMBR,TRIM(TPFIELD%CMNHNAME),KTOTAL,IPOSEX)
!
IF (KRESP.NE.0) THEN
+ WRITE(YRESP, '( I12 )') KRESP
+ YMSG = 'RESP='//TRIM(ADJUSTL(YRESP))//' in call to LFINFO when reading '//TRIM(TPFIELD%CMNHNAME)//' in '//TRIM(TPFILE%CNAME)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_CHECK_FIELD_LFI',YMSG)
RETURN
ELSEIF (KTOTAL.EQ.0) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_AND_CHECK_FIELD_LFI',TRIM(TPFILE%CNAME)//': record length is zero for ' &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_LFI',TRIM(TPFILE%CNAME)//': record length is zero for ' &
//TRIM(TPFIELD%CMNHNAME))
KRESP=-47
RETURN
ELSEIF (KTOTAL.GT.JPXFIE) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_AND_CHECK_FIELD_LFI',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_LFI',TRIM(TPFILE%CNAME)// &
': record length exceeds the maximum value in FM for '//TRIM(TPFIELD%CMNHNAME))
KRESP=-48
RETURN
@@ -375,46 +380,72 @@ ENDIF
ALLOCATE(KWORK(KTOTAL))
!
CALL LFILEC(KRESP,INUMBR,TRIM(TPFIELD%CMNHNAME),KWORK,KTOTAL)
-IF (KRESP.NE.0) RETURN
+IF (KRESP.NE.0) THEN
+ WRITE(YRESP, '( I12 )') KRESP
+ YMSG = 'RESP='//TRIM(ADJUSTL(YRESP))//' in call to LFILEC when reading '//TRIM(TPFIELD%CMNHNAME)//' in '//TRIM(TPFILE%CNAME)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_CHECK_FIELD_LFI',YMSG)
+ RETURN
+ENDIF
!
!* 2.c THE GRID INDICATOR AND THE COMMENT STRING
!* ARE SEPARATED FROM THE DATA
!
-TPFMH%GRID = KWORK(1)
-TPFMH%COMLEN = KWORK(2)
-!
-IROW=KLENG+TPFMH%COMLEN+2
+ICOMLEN = KWORK(2)
+IROW=KLENG+ICOMLEN+2
IF (KTOTAL.NE.IROW) THEN
- WRITE(YRECLENGTH_FILE,'(I12)') KTOTAL-2-TPFMH%COMLEN
+ WRITE(YRECLENGTH_FILE,'(I12)') KTOTAL-2-ICOMLEN
WRITE(YRECLENGTH_MEM, '(I12)') KLENG
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_AND_CHECK_FIELD_LFI','wrong field size for '//TRIM(TPFIELD%CMNHNAME) &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_CHECK_FIELD_LFI','wrong field size for '//TRIM(TPFIELD%CMNHNAME) &
//' (expected: '//TRIM(ADJUSTL(YRECLENGTH_MEM))// &
', in file: ' //TRIM(ADJUSTL(YRECLENGTH_FILE))//')')
KRESP=-63
RETURN
ENDIF
!
-SELECT CASE (TPFMH%COMLEN)
+IF (KWORK(1)/=TPFIELD%NGRID) THEN
+ WRITE(YVAL_FILE,'(I12)') KWORK(1)
+ WRITE(YVAL_MEM, '(I12)') TPFIELD%NGRID
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_CHECK_FIELD_LFI','expected GRID value ('//TRIM(ADJUSTL(YVAL_MEM))// &
+ ') is different than found in file ('//TRIM(ADJUSTL(YVAL_FILE))//') for variable '//TRIM(TPFIELD%CMNHNAME))
+ TPFIELD%NGRID = KWORK(1)
+ KRESP = -111 !Used later to broadcast modified metadata
+ELSE
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_LFI','expected GRID found in file for field ' &
+ //TRIM(TPFIELD%CMNHNAME))
+ENDIF
+!
+YCOMMENT=''
+SELECT CASE (ICOMLEN)
CASE(:-1)
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_AND_CHECK_FIELD_LFI',TRIM(TPFILE%CNAME)//': comment length is negative for ' &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_LFI',TRIM(TPFILE%CNAME)//': comment length is negative for ' &
//TRIM(TPFIELD%CMNHNAME))
KRESP=-58
RETURN
CASE(0)
KRESP = 0
CASE(1:JPXKRK)
- ICOMMENT(1:TPFMH%COMLEN)=KWORK(3:TPFMH%COMLEN+2)
- DO J=1,TPFMH%COMLEN
- TPFMH%COMMENT(J:J)=CHAR(ICOMMENT(J))
+ ICOMMENT(1:ICOMLEN)=KWORK(3:ICOMLEN+2)
+ DO J=1,ICOMLEN
+ YCOMMENT(J:J)=CHAR(ICOMMENT(J))
ENDDO
CASE(JPXKRK+1:)
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_AND_CHECK_FIELD_LFI',TRIM(TPFILE%CNAME)//': comment is too long in file for ' &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_LFI',TRIM(TPFILE%CNAME)//': comment is too long in file for ' &
//TRIM(TPFIELD%CMNHNAME))
KRESP=-56
RETURN
END SELECT
!
-END SUBROUTINE IO_READ_AND_CHECK_FIELD_LFI
+IF (TRIM(YCOMMENT)/=TRIM(TPFIELD%CCOMMENT)) THEN
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_CHECK_FIELD_LFI','expected COMMENT ('//TRIM(TPFIELD%CCOMMENT)// &
+ ') is different than found ('//TRIM(YCOMMENT)//')in file for field '//TRIM(TPFIELD%CMNHNAME))
+ TPFIELD%CCOMMENT=TRIM(YCOMMENT)
+ KRESP = -111 !Used later to broadcast modified metadata
+ELSE
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_LFI','expected COMMENT found in file for field ' &
+ //TRIM(TPFIELD%CMNHNAME))
+END IF
+!
+END SUBROUTINE IO_READ_CHECK_FIELD_LFI
!
!
SUBROUTINE IO_WRITE_FIELD_LFI_X0(TPFIELD,KFLU,PFIELD,KRESP)
diff --git a/src/LIB/SURCOUCHE/src/mode_io.f90 b/src/LIB/SURCOUCHE/src/mode_io.f90
index 79ea2978f..f5b365a1e 100644
--- a/src/LIB/SURCOUCHE/src/mode_io.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io.f90
@@ -983,7 +983,7 @@ CHARACTER(LEN=*),INTENT(IN) :: HMSG !Message
!
INTEGER :: IERR, IMAXVERB,IABORTLEVEL
CHARACTER(LEN=9) :: YPRE
-CHARACTER(LEN=28) :: YSUBR
+CHARACTER(LEN=30) :: YSUBR
!
SELECT CASE(HDOMAIN)
CASE('IO')
@@ -1015,7 +1015,7 @@ SELECT CASE(KVERB)
END SELECT
!
YSUBR=TRIM(HSUBR)//':'
-WRITE (*,"(A9,A28,A)") YPRE,YSUBR,HMSG
+WRITE (*,"(A9,A30,A)") YPRE,YSUBR,HMSG
!
IF (KVERB<=IABORTLEVEL) THEN
PRINT *,'ABORT asked by application'
diff --git a/src/LIB/SURCOUCHE/src/mode_netcdf.f90 b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
index 802eea843..17f13db75 100644
--- a/src/LIB/SURCOUCHE/src/mode_netcdf.f90
+++ b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
@@ -1727,7 +1727,7 @@ CALL PRINT_MSG(NVERB_DEBUG,'IO','NCWRITC0','writing '//TRIM(HVARNAME))
IRESP = 0
YSTR = HFIELD
IF (LEN_TRIM(HFIELD) > LEN(YSTR)) THEN
- PRINT *,'NCWRIT0 : ',TRIM(YVARNAME), ' string variable TRUNCATED.'
+ PRINT *,'NCWRITC0 : ',TRIM(YVARNAME), ' string variable TRUNCATED.'
END IF
! Get the Netcdf file ID
@@ -2067,6 +2067,177 @@ ELSE
END IF
END SUBROUTINE READATTR
+SUBROUTINE IO_READ_CHECK_FIELD_ATTR_NC4(TPFIELD,KNCID,KVARID,KRESP,HCALENDAR)
+!
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+INTEGER(KIND=IDCDF_KIND), INTENT(IN) :: KNCID
+INTEGER(KIND=IDCDF_KIND), INTENT(IN) :: KVARID
+INTEGER, INTENT(OUT) :: KRESP ! return-code
+CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: HCALENDAR
+!
+INTEGER :: ILEN
+INTEGER :: IGRID
+INTEGER(KIND=IDCDF_KIND) :: STATUS
+CHARACTER(LEN=12) :: YVAL_FILE, YVAL_MEM
+CHARACTER(LEN=:),ALLOCATABLE :: YVALUE
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4','called for field '//TRIM(TPFIELD%CMNHNAME))
+!
+KRESP = 0
+!
+! GRID
+!
+STATUS = NF90_GET_ATT(KNCID,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(NVERB_ERROR,'IO','IO_READ_CHECK_FIELD_ATTR_NC4','expected GRID value ('//TRIM(ADJUSTL(YVAL_MEM))// &
+ ') is different than found in file ('//TRIM(ADJUSTL(YVAL_FILE))//') for variable '//TRIM(TPFIELD%CMNHNAME))
+ TPFIELD%NGRID = IGRID
+ KRESP = -111 !Used later to broadcast modified metadata
+ ELSE
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4','expected GRID found in file for field ' &
+ //TRIM(TPFIELD%CMNHNAME))
+ ENDIF
+ELSE !no GRID
+ IF (TPFIELD%NGRID==0 .OR. TPFIELD%NGRID==-1) THEN
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4','no GRID (as expected) in file for field ' &
+ //TRIM(TPFIELD%CMNHNAME))
+ ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_CHECK_FIELD_ATTR_NC4','expected GRID but not found in file for field ' &
+ //TRIM(TPFIELD%CMNHNAME))
+ END IF
+ENDIF
+!
+! COMMENT
+!
+STATUS = NF90_INQUIRE_ATTRIBUTE(KNCID, KVARID, 'COMMENT', LEN=ILEN)
+IF (STATUS == NF90_NOERR) THEN
+ ALLOCATE(CHARACTER(LEN=ILEN) :: YVALUE)
+ STATUS = NF90_GET_ATT(KNCID, KVARID, 'COMMENT', YVALUE)
+ IF (TRIM(YVALUE)/=TRIM(TPFIELD%CCOMMENT)) THEN
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_CHECK_FIELD_ATTR_NC4','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','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','no COMMENT (as expected) in file for field ' &
+ //TRIM(TPFIELD%CMNHNAME))
+ ELSE
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_CHECK_FIELD_ATTR_NC4','expected COMMENT but not found in file for field ' &
+ //TRIM(TPFIELD%CMNHNAME))
+ END IF
+END IF
+!
+! STDNAME
+!
+STATUS = NF90_INQUIRE_ATTRIBUTE(KNCID, KVARID, 'STDNAME', LEN=ILEN)
+IF (STATUS == NF90_NOERR) THEN
+ ALLOCATE(CHARACTER(LEN=ILEN) :: YVALUE)
+ STATUS = NF90_GET_ATT(KNCID, KVARID, 'STDNAME', YVALUE)
+ IF (TRIM(YVALUE)/=TRIM(TPFIELD%CSTDNAME)) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_ATTR_NC4','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','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','no STDNAME (as expected) in file for field ' &
+ //TRIM(TPFIELD%CMNHNAME))
+ ELSE
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_CHECK_FIELD_ATTR_NC4','expected STDNAME but not found in file for field ' &
+ //TRIM(TPFIELD%CMNHNAME))
+ END IF
+END IF
+!
+! LONGNAME
+!
+STATUS = NF90_INQUIRE_ATTRIBUTE(KNCID, KVARID, 'LONGNAME', LEN=ILEN)
+IF (STATUS == NF90_NOERR) THEN
+ ALLOCATE(CHARACTER(LEN=ILEN) :: YVALUE)
+ STATUS = NF90_GET_ATT(KNCID, KVARID, 'LONGNAME', YVALUE)
+ IF (TRIM(YVALUE)/=TRIM(TPFIELD%CLONGNAME)) THEN
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_CHECK_FIELD_ATTR_NC4','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','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','no LONGNAME (as expected) in file for field ' &
+ //TRIM(TPFIELD%CMNHNAME))
+ ELSE
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_CHECK_FIELD_ATTR_NC4','expected LONGNAME but not found in file for field ' &
+ //TRIM(TPFIELD%CMNHNAME))
+ END IF
+END IF
+!
+! UNITS
+!
+STATUS = NF90_INQUIRE_ATTRIBUTE(KNCID, KVARID, 'UNITS', LEN=ILEN)
+IF (STATUS == NF90_NOERR) THEN
+ ALLOCATE(CHARACTER(LEN=ILEN) :: YVALUE)
+ STATUS = NF90_GET_ATT(KNCID, KVARID, 'UNITS', YVALUE)
+ IF (TRIM(YVALUE)/=TRIM(TPFIELD%CUNITS)) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_ATTR_NC4','expected UNITS ('//TRIM(TPFIELD%CUNITS)// &
+ ') is different than found ('//TRIM(YVALUE)//')in file for field '//TRIM(TPFIELD%CMNHNAME))
+ TPFIELD%CUNITS=TRIM(YVALUE)
+ KRESP = -111 !Used later to broadcast modified metadata
+ ELSE
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4','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','no UNITS (as expected) in file for field ' &
+ //TRIM(TPFIELD%CMNHNAME))
+ ELSE
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_ATTR_NC4','expected UNITS but not found in file for field ' &
+ //TRIM(TPFIELD%CMNHNAME))
+ END IF
+END IF
+!
+! CALENDAR
+!
+IF(PRESENT(HCALENDAR)) THEN
+STATUS = NF90_INQUIRE_ATTRIBUTE(KNCID, KVARID, 'CALENDAR', LEN=ILEN)
+IF (STATUS == NF90_NOERR) THEN
+ ALLOCATE(CHARACTER(LEN=ILEN) :: YVALUE)
+ STATUS = NF90_GET_ATT(KNCID, KVARID, 'CALENDAR', YVALUE)
+ IF (TRIM(YVALUE)/=TRIM(HCALENDAR)) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_ATTR_NC4','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','expected CALENDAR found in file for field ' &
+ //TRIM(TPFIELD%CMNHNAME))
+ END IF
+ DEALLOCATE(YVALUE)
+ELSE !no CALENDAR
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_CHECK_FIELD_ATTR_NC4','expected CALENDAR but not found in file for field ' &
+ //TRIM(TPFIELD%CMNHNAME))
+END IF
+ENDIF
+!
+END SUBROUTINE IO_READ_CHECK_FIELD_ATTR_NC4
+
+
SUBROUTINE NCREADX0(KNCID, HVARNAME, PFIELD, TPFMH, KRESP)
USE MODD_FM, ONLY : FMHEADER, JPXKRK
INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
@@ -2588,20 +2759,18 @@ KRESP = IRESP
END SUBROUTINE NCREADN0
-SUBROUTINE IO_READ_FIELD_NC4_N0(TPFILE, TPFIELD, KFIELD, TPFMH, KRESP)
+SUBROUTINE IO_READ_FIELD_NC4_N0(TPFILE, TPFIELD, KFIELD, KRESP)
USE MODD_FM, ONLY : FMHEADER, JPXKRK
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
-INTEGER, INTENT(OUT):: KFIELD
-TYPE(FMHEADER), INTENT(OUT):: TPFMH
-INTEGER, INTENT(OUT):: KRESP ! return-code
+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
-INTEGER(KIND=IDCDF_KIND) :: ICOMLEN ! comment length
CHARACTER(LEN=30) :: YVARNAME
INTEGER :: IRESP
@@ -2634,10 +2803,11 @@ IF (IDIMS == 0 .AND. (ITYPE == NF90_INT64 .OR. ITYPE == NF90_INT1) ) THEN
CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_N0[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
- ! Read variables attributes (GRID and COMMENT)
- CALL READATTR(INCID, IVARID, YVARNAME, TPFMH)
+ ! Read and check attributes of variable
+ CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFIELD,INCID,IVARID,IRESP)
ELSE
- PRINT *, 'IO_READ_FIELD_NC4_N0: '//TRIM(YVARNAME)//' not READ (wrong size or type).'
+ 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
--
GitLab