From d21ec0a2cc0b99c47173596efcbb66e1b22944e8 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Thu, 29 Jun 2017 17:22:06 +0200
Subject: [PATCH] Philippe 29/06/2017: IO: * added IO_READ_FIELD_BYNAME_C0 and
IO_READ_FIELD_BYFIELD_C0 subroutines to IO_READ_FIELD procedure * added
IO_READ_FIELD_LFI_C0 subroutine to IO_READ_FIELD_LFI procedure * added
IO_READ_FIELD_NC4_C0 subroutine to IO_READ_FIELD_NC4 procedure
---
src/LIB/SURCOUCHE/src/fmread_ll.f90 | 87 ++++++++++++++++++++++++++-
src/LIB/SURCOUCHE/src/fmreadwrit.f90 | 44 +++++++++++++-
src/LIB/SURCOUCHE/src/mode_netcdf.f90 | 70 ++++++++++++++++++++-
src/MNH/ini_segn.f90 | 4 +-
4 files changed, 195 insertions(+), 10 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/fmread_ll.f90 b/src/LIB/SURCOUCHE/src/fmread_ll.f90
index 4e450c3d2..f0d01558e 100644
--- a/src/LIB/SURCOUCHE/src/fmread_ll.f90
+++ b/src/LIB/SURCOUCHE/src/fmread_ll.f90
@@ -43,8 +43,10 @@ PRIVATE
INTERFACE IO_READ_FIELD
MODULE PROCEDURE IO_READ_FIELD_BYNAME_N0, &
IO_READ_FIELD_BYNAME_L0, &
+ IO_READ_FIELD_BYNAME_C0, &
IO_READ_FIELD_BYFIELD_N0, &
- IO_READ_FIELD_BYFIELD_L0
+ IO_READ_FIELD_BYFIELD_L0, &
+ IO_READ_FIELD_BYFIELD_C0
! IO_READ_FIELD_BYNAME_X0, IO_READ_FIELD_BYNAME_X1, &
! IO_READ_FIELD_BYNAME_X2, IO_READ_FIELD_BYNAME_X3, &
! IO_READ_FIELD_BYNAME_X4, IO_READ_FIELD_BYNAME_X5, &
@@ -52,7 +54,7 @@ INTERFACE IO_READ_FIELD
! IO_READ_FIELD_BYNAME_N1, &
! IO_READ_FIELD_BYNAME_N2, IO_READ_FIELD_BYNAME_N3, &
! IO_READ_FIELD_BYNAME_L1, &
-! IO_READ_FIELD_BYNAME_C0, IO_READ_FIELD_BYNAME_C1, &
+! IO_READ_FIELD_BYNAME_C1, &
! IO_READ_FIELD_BYNAME_T0, &
! IO_READ_FIELD_BYFIELD_X0,IO_READ_FIELD_BYFIELD_X1, &
! IO_READ_FIELD_BYFIELD_X2,IO_READ_FIELD_BYFIELD_X3, &
@@ -61,7 +63,7 @@ INTERFACE IO_READ_FIELD
! IO_READ_FIELD_BYFIELD_N1, &
! IO_READ_FIELD_BYFIELD_N2,IO_READ_FIELD_BYFIELD_N3, &
! IO_READ_FIELD_BYFIELD_L1, &
-! IO_READ_FIELD_BYFIELD_C0,IO_READ_FIELD_BYFIELD_C1, &
+! IO_READ_FIELD_BYFIELD_C1, &
! IO_READ_FIELD_BYFIELD_T0
END INTERFACE
@@ -1959,6 +1961,85 @@ RETURN
END SUBROUTINE FMREADC0_ll
+SUBROUTINE IO_READ_FIELD_BYNAME_C0(TPFILE,HNAME,HFIELD,KRESP)
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
+CHARACTER(LEN=*), INTENT(INOUT) :: HFIELD ! array containing the data field
+INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+!
+INTEGER :: ID ! Index of the field
+INTEGER :: IRESP ! return_code
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYNAME_C0',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
+!
+CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
+!
+IF(IRESP==0) CALL IO_READ_FIELD(TPFILE,TFIELDLIST(ID),HFIELD,IRESP)
+!
+IF (PRESENT(KRESP)) KRESP = IRESP
+!
+END SUBROUTINE IO_READ_FIELD_BYNAME_C0
+
+SUBROUTINE IO_READ_FIELD_BYFIELD_C0(TPFILE,TPFIELD,HFIELD,KRESP)
+!
+USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
+USE MODE_FD_ll, ONLY : GETFD,FD_LL
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+CHARACTER(LEN=*), INTENT(INOUT) :: HFIELD ! array containing the data field
+INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+!
+INTEGER :: IERR
+TYPE(FD_ll), POINTER :: TZFD
+INTEGER :: IRESP
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYFIELD_C0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+!
+IRESP = 0
+!
+TZFD=>GETFD(TRIM(ADJUSTL(TPFILE%CNAME))//'.lfi')
+IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ IF (TPFILE%CFORMAT=='NETCDF4') THEN
+ CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,HFIELD,IRESP)
+ ELSE IF (TPFILE%CFORMAT=='LFI') THEN
+ CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,HFIELD,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_READ_FIELD_BYFIELD_C0',&
+ TRIM(TPFILE%CNAME)//': invalid fileformat ('//TRIM(TPFILE%CFORMAT)//')')
+ END IF
+ ELSE
+ IF (ISP == TZFD%OWNER) THEN
+ IF (TPFILE%CFORMAT=='NETCDF4') THEN
+ CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,HFIELD,IRESP)
+ ELSE IF (TPFILE%CFORMAT=='LFI') THEN
+ CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,HFIELD,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_READ_FIELD_BYFIELD_C0',&
+ TRIM(TPFILE%CNAME)//': invalid fileformat ('//TRIM(TPFILE%CFORMAT)//')')
+ END IF
+ END IF
+ !
+ CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
+ !
+ !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(HFIELD,LEN(HFIELD),MPI_CHARACTER,TZFD%OWNER-1,TZFD%COMM,IERR)
+ END IF
+ELSE
+ IRESP = -61
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_BYFIELD_C0','file '//TRIM(TPFILE%CNAME)//' not found')
+END IF
+!
+IF (PRESENT(KRESP)) KRESP = IRESP
+!
+END SUBROUTINE IO_READ_FIELD_BYFIELD_C0
+
+
SUBROUTINE FMREADT0_ll(HFILEM,HRECFM,HFIPRI,HDIR,TFIELD,KGRID,&
KLENCH,HCOMMENT,KRESP)
!* 0. DECLARATIONS
diff --git a/src/LIB/SURCOUCHE/src/fmreadwrit.f90 b/src/LIB/SURCOUCHE/src/fmreadwrit.f90
index 92b00afb8..44d49aee6 100644
--- a/src/LIB/SURCOUCHE/src/fmreadwrit.f90
+++ b/src/LIB/SURCOUCHE/src/fmreadwrit.f90
@@ -273,7 +273,8 @@ PRIVATE
!
INTERFACE IO_READ_FIELD_LFI
MODULE PROCEDURE IO_READ_FIELD_LFI_N0, &
- IO_READ_FIELD_LFI_L0
+ IO_READ_FIELD_LFI_L0, &
+ IO_READ_FIELD_LFI_C0
! IO_READ_FIELD_LFI_X0,IO_READ_FIELD_LFI_X1, &
! IO_READ_FIELD_LFI_X2,IO_READ_FIELD_LFI_X3, &
! IO_READ_FIELD_LFI_X4,IO_READ_FIELD_LFI_X5, &
@@ -281,7 +282,6 @@ INTERFACE IO_READ_FIELD_LFI
! IO_READ_FIELD_LFI_N1, &
! IO_READ_FIELD_LFI_N2,IO_READ_FIELD_LFI_N3, &
! IO_READ_FIELD_LFI_L1, &
-! IO_READ_FIELD_LFI_C0, &
! IO_READ_FIELD_LFI_T0
END INTERFACE IO_READ_FIELD_LFI
!
@@ -386,6 +386,46 @@ IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
END SUBROUTINE IO_READ_FIELD_LFI_L0
!
!
+SUBROUTINE IO_READ_FIELD_LFI_C0(TPFILE,TPFIELD,HFIELD,KRESP)
+USE MODD_FM
+USE MODD_CONFZ, ONLY : NZ_VERB
+USE MODE_MSG
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA),INTENT(INOUT) :: TPFIELD
+CHARACTER(LEN=*),INTENT(OUT) :: HFIELD ! array containing the data field
+INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
+!
+!* 0.2 Declarations of local variables
+!
+INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL
+INTEGER :: ILENG, JLOOP
+INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
+LOGICAL :: GGOOD
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_C0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+!
+ILENG = LEN(HFIELD)
+!
+CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
+!
+IF (GGOOD) THEN
+ DO JLOOP=1,ILENG
+ HFIELD(JLOOP:JLOOP)=ACHAR(IWORK(IWORK(2)+2+JLOOP))
+ END DO
+END IF
+!
+KRESP=IRESP
+!
+IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
+!
+END SUBROUTINE IO_READ_FIELD_LFI_C0
+!
+!
SUBROUTINE IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,KLENG,KWORK,KTOTAL,KRESP,OGOOD)
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
diff --git a/src/LIB/SURCOUCHE/src/mode_netcdf.f90 b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
index 293cb7bf5..c0c3fbbc0 100644
--- a/src/LIB/SURCOUCHE/src/mode_netcdf.f90
+++ b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
@@ -36,7 +36,8 @@ END INTERFACE IO_WRITE_FIELD_NC4
INTERFACE IO_READ_FIELD_NC4
MODULE PROCEDURE IO_READ_FIELD_NC4_N0, &
- IO_READ_FIELD_NC4_L0
+ IO_READ_FIELD_NC4_L0, &
+ IO_READ_FIELD_NC4_C0
! 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, &
@@ -44,7 +45,7 @@ INTERFACE IO_READ_FIELD_NC4
! IO_READ_FIELD_NC4_N1, &
! IO_READ_FIELD_NC4_L1, &
! IO_READ_FIELD_NC4_N2,IO_READ_FIELD_NC4_N3, &
-! IO_READ_FIELD_NC4_C0,IO_READ_FIELD_NC4_C1, &
+! IO_READ_FIELD_NC4_C1, &
! IO_READ_FIELD_NC4_T0
END INTERFACE IO_READ_FIELD_NC4
@@ -3090,6 +3091,71 @@ KRESP = IRESP
END SUBROUTINE NCREADC0
+SUBROUTINE IO_READ_FIELD_NC4_C0(TPFILE, TPFIELD, HFIELD, KRESP)
+USE MODD_FM, ONLY : FMHEADER, JPXKRK
+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(1) :: 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__,'NCREADC0[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__,'NCREADC0[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(TPFIELD,INCID,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
+
END MODULE MODE_NETCDF
#else
diff --git a/src/MNH/ini_segn.f90 b/src/MNH/ini_segn.f90
index ca1d28f6d..a6ec286e7 100644
--- a/src/MNH/ini_segn.f90
+++ b/src/MNH/ini_segn.f90
@@ -429,9 +429,7 @@ IF (CPROGRAM=='MESONH' .OR. CPROGRAM=='SPAWN ') THEN
END IF
!
! Read the storage type
- YRECFM = 'STORAGE_TYPE'
- YDIR='--'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,'--',CSTORAGE_TYPE,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL IO_READ_FIELD(TZFILE,'STORAGE_TYPE',CSTORAGE_TYPE)
IF (IRESP /= 0) THEN
WRITE(ILUOUT,FMT=9002) YRECFM,IRESP
!callabortstop
--
GitLab