From bab9c20496531ed05ad2bb6b7932381efa0d296b Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Tue, 4 Jul 2017 12:57:54 +0200
Subject: [PATCH] Philippe 30/06/2017: IO: * added
IO_READ_FIELD_BYNAME_X0/X2/T0 and IO_READ_FIELD_BYFIELD_X0/X2/T0 subroutines
to IO_READ_FIELD procedure * added IO_READ_FIELD_LFI_X0/X2/T0 subroutines to
IO_READ_FIELD_LFI procedure * added IO_READ_FIELD_NC4_X0/X2/T0 subroutines to
IO_READ_FIELD_NC4 procedure * use IO_READ_FIELD in SET_GRID
---
src/LIB/SURCOUCHE/src/fmread_ll.f90 | 378 ++++++++++++++++++++++++--
src/LIB/SURCOUCHE/src/fmreadwrit.f90 | 151 +++++++++-
src/LIB/SURCOUCHE/src/mode_netcdf.f90 | 237 +++++++++++++++-
src/MNH/ini_modeln.f90 | 2 +-
src/MNH/ini_spectren.f90 | 44 ++-
src/MNH/init_mnh.f90 | 2 +-
src/MNH/set_grid.f90 | 144 +++-------
7 files changed, 785 insertions(+), 173 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/fmread_ll.f90 b/src/LIB/SURCOUCHE/src/fmread_ll.f90
index 39546557b..a258b67eb 100644
--- a/src/LIB/SURCOUCHE/src/fmread_ll.f90
+++ b/src/LIB/SURCOUCHE/src/fmread_ll.f90
@@ -41,32 +41,32 @@ IMPLICIT NONE
PRIVATE
INTERFACE IO_READ_FIELD
- MODULE PROCEDURE IO_READ_FIELD_BYNAME_X1, &
- IO_READ_FIELD_BYNAME_N0, &
- IO_READ_FIELD_BYNAME_L0, &
- IO_READ_FIELD_BYNAME_C0, &
- IO_READ_FIELD_BYFIELD_X1, &
- IO_READ_FIELD_BYFIELD_N0, &
- IO_READ_FIELD_BYFIELD_L0, &
- IO_READ_FIELD_BYFIELD_C0
-! IO_READ_FIELD_BYNAME_X0, &
-! IO_READ_FIELD_BYNAME_X2, IO_READ_FIELD_BYNAME_X3, &
+ MODULE PROCEDURE IO_READ_FIELD_BYNAME_X0, IO_READ_FIELD_BYNAME_X1, &
+ IO_READ_FIELD_BYNAME_X2, &
+ IO_READ_FIELD_BYNAME_N0, &
+ IO_READ_FIELD_BYNAME_L0, &
+ IO_READ_FIELD_BYNAME_C0, &
+ IO_READ_FIELD_BYNAME_T0, &
+ IO_READ_FIELD_BYFIELD_X0,IO_READ_FIELD_BYFIELD_X1, &
+ IO_READ_FIELD_BYFIELD_X2, &
+ IO_READ_FIELD_BYFIELD_N0, &
+ IO_READ_FIELD_BYFIELD_L0, &
+ IO_READ_FIELD_BYFIELD_C0, &
+ IO_READ_FIELD_BYFIELD_T0
+! IO_READ_FIELD_BYNAME_X3, &
! IO_READ_FIELD_BYNAME_X4, IO_READ_FIELD_BYNAME_X5, &
! IO_READ_FIELD_BYNAME_X6, &
! IO_READ_FIELD_BYNAME_N1, &
! IO_READ_FIELD_BYNAME_N2, IO_READ_FIELD_BYNAME_N3, &
! IO_READ_FIELD_BYNAME_L1, &
! IO_READ_FIELD_BYNAME_C1, &
-! IO_READ_FIELD_BYNAME_T0, &
-! IO_READ_FIELD_BYFIELD_X0, &
-! IO_READ_FIELD_BYFIELD_X2,IO_READ_FIELD_BYFIELD_X3, &
+! IO_READ_FIELD_BYFIELD_X3, &
! IO_READ_FIELD_BYFIELD_X4,IO_READ_FIELD_BYFIELD_X5, &
! IO_READ_FIELD_BYFIELD_X6, &
! IO_READ_FIELD_BYFIELD_N1, &
! IO_READ_FIELD_BYFIELD_N2,IO_READ_FIELD_BYFIELD_N3, &
! IO_READ_FIELD_BYFIELD_L1, &
! IO_READ_FIELD_BYFIELD_C1, &
-! IO_READ_FIELD_BYFIELD_T0
END INTERFACE
INTERFACE FMREAD
@@ -224,6 +224,87 @@ RETURN
END SUBROUTINE FMREADX0_ll
+SUBROUTINE IO_READ_FIELD_BYNAME_X0(TPFILE,HNAME,PFIELD,KRESP)
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
+REAL, INTENT(INOUT) :: PFIELD ! 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_X0',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),PFIELD,IRESP)
+!
+IF (PRESENT(KRESP)) KRESP = IRESP
+!
+END SUBROUTINE IO_READ_FIELD_BYNAME_X0
+
+SUBROUTINE IO_READ_FIELD_BYFIELD_X0(TPFILE,TPFIELD,PFIELD,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
+REAL, INTENT(INOUT) :: PFIELD ! 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_X0',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,PFIELD,IRESP)
+ ELSE IF (TPFILE%CFORMAT=='LFI') THEN
+ CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,PFIELD,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_READ_FIELD_BYFIELD_X0',&
+ 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,PFIELD,IRESP)
+ ELSE IF (TPFILE%CFORMAT=='LFI') THEN
+ CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,PFIELD,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_READ_FIELD_BYFIELD_X0',&
+ 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)
+ !
+ ! Broadcast Field
+ CALL MPI_BCAST(PFIELD,1,MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
+ END IF
+ELSE
+ IRESP = -61
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_BYFIELD_X0','file '//TRIM(TPFILE%CNAME)//' not found')
+END IF
+!
+IF (PRESENT(KRESP)) KRESP = IRESP
+!
+END SUBROUTINE IO_READ_FIELD_BYFIELD_X0
+
+
SUBROUTINE FMREADX1_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
KLENCH,HCOMMENT,KRESP, KIMAX_ll, KJMAX_ll, TPSPLITTING)
USE MODD_IO_ll, ONLY : ISP,GSMONOPROC, ISNPROC
@@ -403,11 +484,7 @@ IF (ASSOCIATED(TZFD)) THEN
END IF
ELSE
IF (ISP == TZFD%OWNER) THEN
- IF( PRESENT(KIMAX_ll) .AND. PRESENT(KJMAX_ll) ) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,TPFIELD%CDIR,GALLOC, KIMAX_ll, KJMAX_ll)
- ELSE
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,TPFIELD%CDIR,GALLOC)
- ENDIF
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,TPFIELD%CDIR,GALLOC, KIMAX_ll, KJMAX_ll)
IF (TPFILE%CFORMAT=='NETCDF4') THEN
CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
@@ -416,9 +493,6 @@ IF (ASSOCIATED(TZFD)) THEN
CALL PRINT_MSG(NVERB_FATAL,'IO','IO_READ_FIELD_BYFIELD_X1',&
TRIM(TPFILE%CNAME)//': invalid fileformat ('//TRIM(TPFILE%CFORMAT)//')')
END IF
- ELSE
- ALLOCATE(ZFIELDP(0))
- GALLOC = .TRUE.
END IF
!
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
@@ -432,11 +506,7 @@ IF (ASSOCIATED(TZFD)) THEN
CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
ELSE
!Scatter Field
- IF( PRESENT(TPSPLITTING) ) THEN
- CALL SCATTER_XXFIELD(TPFIELD%CDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM,TPSPLITTING)
- ELSE
- CALL SCATTER_XXFIELD(TPFIELD%CDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
- ENDIF
+ CALL SCATTER_XXFIELD(TPFIELD%CDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM,TPSPLITTING)
END IF
END IF
ELSE
@@ -642,6 +712,173 @@ TIMEZ%T_READ2D_ALL=TIMEZ%T_READ2D_ALL + T22 - T11
END SUBROUTINE FMREADX2_ll
+SUBROUTINE IO_READ_FIELD_BYNAME_X2(TPFILE,HNAME,PFIELD,KRESP,KIMAX_ll,KJMAX_ll,TPSPLITTING)
+!
+USE MODD_IO_ll, ONLY : ISNPROC
+USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
+!
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
+REAL,DIMENSION(:,:),INTENT(INOUT) :: PFIELD ! array containing the data field
+INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+INTEGER,OPTIONAL, INTENT(IN) :: KIMAX_ll
+INTEGER,OPTIONAL, INTENT(IN) :: KJMAX_ll
+TYPE(ZONE_ll),DIMENSION(ISNPROC),OPTIONAL,INTENT(IN) :: TPSPLITTING ! splitting of the domain
+!
+INTEGER :: ID ! Index of the field
+INTEGER :: IRESP ! return_code
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYNAME_X2',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),PFIELD,IRESP,KIMAX_ll,KJMAX_ll,TPSPLITTING)
+!
+IF (PRESENT(KRESP)) KRESP = IRESP
+!
+END SUBROUTINE IO_READ_FIELD_BYNAME_X2
+
+SUBROUTINE IO_READ_FIELD_BYFIELD_X2(TPFILE,TPFIELD,PFIELD,KRESP,KIMAX_ll,KJMAX_ll,TPSPLITTING)
+!
+USE MODD_IO_ll, ONLY : GSMONOPROC,ISP,ISNPROC,LPACK,L1D,L2D
+USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
+USE MODD_TIMEZ, ONLY : TIMEZ
+!
+USE MODE_ALLOCBUFFER_ll
+USE MODE_FD_ll, ONLY : GETFD,FD_LL
+USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
+USE MODE_SCATTER_ll
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+REAL,DIMENSION(:,:),TARGET,INTENT(INOUT) :: PFIELD ! array containing the data field
+INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+INTEGER, OPTIONAL, INTENT(IN) :: KIMAX_ll
+INTEGER, OPTIONAL, INTENT(IN) :: KJMAX_ll
+TYPE(ZONE_ll),DIMENSION(ISNPROC),OPTIONAL,INTENT(IN) :: TPSPLITTING ! splitting of the domain
+!
+INTEGER :: IERR
+TYPE(FD_ll), POINTER :: TZFD
+REAL,DIMENSION(:,:),POINTER :: ZFIELDP
+LOGICAL :: GALLOC
+INTEGER :: IRESP
+INTEGER :: IHEXTOT
+REAL(KIND=8),DIMENSION(2) :: T0,T1,T2
+REAL(KIND=8),DIMENSION(2) :: T11,T22
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYFIELD_X2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+!
+CALL SECOND_MNH2(T11)
+GALLOC = .FALSE.
+IRESP = 0
+!
+IHEXTOT = 2*JPHEXT+1
+TZFD=>GETFD(TRIM(ADJUSTL(TPFILE%CNAME))//'.lfi')
+IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
+ ZFIELDP=>PFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1)
+ ELSE IF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
+ ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1)
+ ELSE
+ ZFIELDP=>PFIELD(:,:)
+ END IF
+ IF (TPFILE%CFORMAT=='NETCDF4') THEN
+ CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ ELSE IF (TPFILE%CFORMAT=='LFI') THEN
+ CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_READ_FIELD_BYFIELD_X2',&
+ TRIM(TPFILE%CNAME)//': invalid fileformat ('//TRIM(TPFILE%CFORMAT)//')')
+ END IF
+ IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
+ PFIELD(:,:)=SPREAD(SPREAD(PFIELD(JPHEXT+1,JPHEXT+1),DIM=1,NCOPIES=IHEXTOT),DIM=2,NCOPIES=IHEXTOT)
+ ELSE IF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
+ PFIELD(:,:)=SPREAD(PFIELD(:,JPHEXT+1),DIM=2,NCOPIES=IHEXTOT)
+ END IF
+ ELSE
+ CALL SECOND_MNH2(T0)
+ IF (ISP == TZFD%OWNER) THEN
+ ! I/O processor case
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,TPFIELD%CDIR,GALLOC, KIMAX_ll, KJMAX_ll)
+ IF (TPFILE%CFORMAT=='NETCDF4') THEN
+ CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ ELSE IF (TPFILE%CFORMAT=='LFI') THEN
+ CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_READ_FIELD_BYFIELD_X2',&
+ TRIM(TPFILE%CNAME)//': invalid fileformat ('//TRIM(TPFILE%CFORMAT)//')')
+ END IF
+ END IF
+ CALL SECOND_MNH2(T1)
+ TIMEZ%T_READ2D_READ=TIMEZ%T_READ2D_READ + T1 - T0
+ !
+ 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)
+ !
+ IF (TPFIELD%CDIR == 'XX' .OR. TPFIELD%CDIR == 'YY') THEN
+ ! XX or YY Scatter Field
+ CALL SCATTER_XXFIELD(TPFIELD%CDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM,TPSPLITTING)
+ ! Broadcast Field
+ CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
+ ELSE IF (TPFIELD%CDIR == 'XY') THEN
+ IF (LPACK .AND. L2D) THEN
+ ! 2D compact case
+ CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1),PFIELD(:,JPHEXT+1),TZFD%OWNER,TZFD%COMM,TPSPLITTING)
+ PFIELD(:,:) = SPREAD(PFIELD(:,JPHEXT+1),DIM=2,NCOPIES=IHEXTOT)
+ ELSE
+#ifdef MNH_GA
+ !
+ ! init/create the ga , dim3 = 1
+ !
+ CALL MNH_INIT_GA(SIZE(PFIELD,1),SIZE(PFIELD,2),1,HRECFM,"READ")
+ IF (ISP == TZFD%OWNER) THEN
+ !
+ ! put the data in the g_a , this proc get this 1 slide
+ !
+ lo_zplan(JPIZ) = 1
+ hi_zplan(JPIZ) = 1
+ call nga_put(g_a, lo_zplan, hi_zplan,ZFIELDP, ld_zplan)
+ END IF
+ call ga_sync
+ !
+ ! get the columun data in this proc
+ !
+ ! temp buf to avoid problem with none stride PFIELDS buffer with HALO
+ ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2)))
+ call nga_get(g_a, lo_col, hi_col,ZFIELD_GA(1,1) , ld_col)
+ PFIELD = ZFIELD_GA
+ DEALLOCATE(ZFIELD_GA)
+#else
+ ! XY Scatter Field
+ CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
+#endif
+ END IF
+ ELSE
+ CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
+ END IF
+ END IF
+ CALL SECOND_MNH2(T2)
+ TIMEZ%T_READ2D_SCAT=TIMEZ%T_READ2D_SCAT + T2 - T1
+ELSE
+ IRESP = -61
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_BYFIELD_X2','file '//TRIM(TPFILE%CNAME)//' not found')
+END IF
+!
+IF (GALLOC) DEALLOCATE (ZFIELDP)
+!
+IF (PRESENT(KRESP)) KRESP = IRESP
+!
+CALL SECOND_MNH2(T22)
+TIMEZ%T_READ2D_ALL=TIMEZ%T_READ2D_ALL + T22 - T11
+!
+END SUBROUTINE IO_READ_FIELD_BYFIELD_X2
+
+
SUBROUTINE FMREADX3_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
KLENCH,HCOMMENT,KRESP)
USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LPACK,L1D,L2D
@@ -2255,6 +2492,93 @@ RETURN
END SUBROUTINE FMREADT0_ll
+SUBROUTINE IO_READ_FIELD_BYNAME_T0(TPFILE,HNAME,TPDATA,KRESP)
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
+TYPE (DATE_TIME), INTENT(INOUT) :: TPDATA ! 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_T0',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),TPDATA,IRESP)
+!
+IF (PRESENT(KRESP)) KRESP = IRESP
+!
+END SUBROUTINE IO_READ_FIELD_BYNAME_T0
+
+SUBROUTINE IO_READ_FIELD_BYFIELD_T0(TPFILE,TPFIELD,TPDATA,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
+TYPE (DATE_TIME), INTENT(INOUT) :: TPDATA ! array containing the data field
+INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+!
+INTEGER :: IERR
+TYPE(FD_ll), POINTER :: TZFD
+INTEGER :: IRESP
+INTEGER,DIMENSION(3) :: ITDATE
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYFIELD_T0',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,TPDATA,IRESP)
+ ELSE IF (TPFILE%CFORMAT=='LFI') THEN
+ CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,TPDATA,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_READ_FIELD_BYFIELD_T0',&
+ 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,TPDATA,IRESP)
+ ELSE IF (TPFILE%CFORMAT=='LFI') THEN
+ CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,TPDATA,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_READ_FIELD_BYFIELD_T0',&
+ TRIM(TPFILE%CNAME)//': invalid fileformat ('//TRIM(TPFILE%CFORMAT)//')')
+ END IF
+ ITDATE(1) = TPDATA%TDATE%YEAR
+ ITDATE(2) = TPDATA%TDATE%MONTH
+ ITDATE(3) = TPDATA%TDATE%DAY
+ 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(ITDATE, 3,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
+ CALL MPI_BCAST(TPDATA%TIME,1,MPI_FLOAT, TZFD%OWNER-1,TZFD%COMM,IERR)
+ TPDATA%TDATE%YEAR = ITDATE(1)
+ TPDATA%TDATE%MONTH = ITDATE(2)
+ TPDATA%TDATE%DAY = ITDATE(3)
+ END IF
+ELSE
+ IRESP = -61
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_BYFIELD_T0','file '//TRIM(TPFILE%CNAME)//' not found')
+END IF
+!
+IF (PRESENT(KRESP)) KRESP = IRESP
+!
+END SUBROUTINE IO_READ_FIELD_BYFIELD_T0
+
+
SUBROUTINE FMREAD_LB(HFILEM,HRECFM,HFIPRI,HLBTYPE,PLB,KRIM,KL3D,&
& KGRID,KLENCH,HCOMMENT,KRESP)
USE MODD_FM
diff --git a/src/LIB/SURCOUCHE/src/fmreadwrit.f90 b/src/LIB/SURCOUCHE/src/fmreadwrit.f90
index e51eb98c9..9049ccfc9 100644
--- a/src/LIB/SURCOUCHE/src/fmreadwrit.f90
+++ b/src/LIB/SURCOUCHE/src/fmreadwrit.f90
@@ -272,18 +272,18 @@ IMPLICIT NONE
PRIVATE
!
INTERFACE IO_READ_FIELD_LFI
- MODULE PROCEDURE IO_READ_FIELD_LFI_X1, &
+ MODULE PROCEDURE IO_READ_FIELD_LFI_X0, IO_READ_FIELD_LFI_X1, &
+ IO_READ_FIELD_LFI_X2, &
IO_READ_FIELD_LFI_N0, &
IO_READ_FIELD_LFI_L0, &
- IO_READ_FIELD_LFI_C0
-! IO_READ_FIELD_LFI_X0, &
-! IO_READ_FIELD_LFI_X2,IO_READ_FIELD_LFI_X3, &
+ IO_READ_FIELD_LFI_C0, &
+ IO_READ_FIELD_LFI_T0
+! IO_READ_FIELD_LFI_X3, &
! IO_READ_FIELD_LFI_X4,IO_READ_FIELD_LFI_X5, &
! IO_READ_FIELD_LFI_X6, &
! IO_READ_FIELD_LFI_N1, &
! IO_READ_FIELD_LFI_N2,IO_READ_FIELD_LFI_N3, &
! IO_READ_FIELD_LFI_L1, &
-! IO_READ_FIELD_LFI_T0
END INTERFACE IO_READ_FIELD_LFI
!
INTERFACE IO_WRITE_FIELD_LFI
@@ -302,6 +302,42 @@ PUBLIC IO_READ_FIELD_LFI,IO_WRITE_FIELD_LFI
!
CONTAINS
!
+SUBROUTINE IO_READ_FIELD_LFI_X0(TPFILE,TPFIELD,PFIELD,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
+REAL, INTENT(OUT) :: PFIELD ! 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
+INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
+LOGICAL :: GGOOD
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_X0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+!
+ILENG = 1
+!
+CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
+!
+IF (GGOOD) CALL TRANSFR(PFIELD,IWORK(IWORK(2)+3),ILENG)
+!
+KRESP=IRESP
+!
+IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
+!
+END SUBROUTINE IO_READ_FIELD_LFI_X0
+!
+!
SUBROUTINE IO_READ_FIELD_LFI_X1(TPFILE,TPFIELD,PFIELD,KRESP)
USE MODD_FM
USE MODD_CONFZ, ONLY : NZ_VERB
@@ -338,6 +374,42 @@ IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
END SUBROUTINE IO_READ_FIELD_LFI_X1
!
!
+SUBROUTINE IO_READ_FIELD_LFI_X2(TPFILE,TPFIELD,PFIELD,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
+REAL,DIMENSION(:,:),INTENT(OUT) :: PFIELD ! 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
+INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
+LOGICAL :: GGOOD
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_X2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+!
+ILENG = SIZE(PFIELD)
+!
+CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
+!
+IF (GGOOD) CALL TRANSFR(PFIELD,IWORK(IWORK(2)+3),ILENG)
+!
+KRESP=IRESP
+!
+IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
+!
+END SUBROUTINE IO_READ_FIELD_LFI_X2
+!
+!
SUBROUTINE IO_READ_FIELD_LFI_N0(TPFILE,TPFIELD,KFIELD,KRESP)
USE MODD_FM
USE MODD_CONFZ, ONLY : NZ_VERB
@@ -463,6 +535,75 @@ IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
END SUBROUTINE IO_READ_FIELD_LFI_C0
!
!
+SUBROUTINE IO_READ_FIELD_LFI_T0(TPFILE,TPFIELD,TPDATA,KRESP)
+!
+USE MODD_CONFZ, ONLY : NZ_VERB
+USE MODD_FM
+USE MODE_MSG
+USE MODD_TYPE_DATE
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA),INTENT(INOUT) :: TPFIELD
+TYPE (DATE_TIME),INTENT(INOUT) :: TPDATA ! 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
+INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
+LOGICAL :: GGOOD
+TYPE(TFIELDDATA) :: TZFIELD
+INTEGER, DIMENSION(3) :: ITDATE ! date array
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_T0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+!
+TZFIELD = TPFIELD
+!
+! Read date
+!
+TZFIELD%CMNHNAME = TRIM(TPFIELD%CMNHNAME)//'%TDATE'
+TZFIELD%CCOMMENT = 'YYYYMMDD'
+!
+ILENG=SIZE(ITDATE)
+!
+CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TZFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
+!
+IF (GGOOD) THEN
+ TPDATA%TDATE%YEAR = IWORK(IWORK(2)+2+1)
+ TPDATA%TDATE%MONTH = IWORK(IWORK(2)+2+2)
+ TPDATA%TDATE%DAY = IWORK(IWORK(2)+2+3)
+END IF
+!
+IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
+!
+IF (.NOT.GGOOD) THEN
+ KRESP = IRESP
+ RETURN
+END IF
+!
+! Read time
+!
+TZFIELD%CMNHNAME = TRIM(TPFIELD%CMNHNAME)//'%TIME'
+TZFIELD%CCOMMENT = 'SECONDS'
+!
+ILENG=1
+!
+CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TZFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
+!
+IF (GGOOD) CALL TRANSFR(TPDATA%TIME,IWORK(IWORK(2)+3),ILENG)
+!
+IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
+!
+KRESP = IRESP
+!
+END SUBROUTINE IO_READ_FIELD_LFI_T0
+!
+!
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 cf0b1e65c..a34d3d780 100644
--- a/src/LIB/SURCOUCHE/src/mode_netcdf.f90
+++ b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
@@ -35,11 +35,12 @@ INTERFACE IO_WRITE_FIELD_NC4
END INTERFACE IO_WRITE_FIELD_NC4
INTERFACE IO_READ_FIELD_NC4
- MODULE PROCEDURE IO_READ_FIELD_NC4_X1, &
+ MODULE PROCEDURE IO_READ_FIELD_NC4_X0,IO_READ_FIELD_NC4_X1, &
+ IO_READ_FIELD_NC4_X2, &
IO_READ_FIELD_NC4_N0, &
IO_READ_FIELD_NC4_L0, &
- IO_READ_FIELD_NC4_C0
-! IO_READ_FIELD_NC4_X0, &
+ IO_READ_FIELD_NC4_C0, &
+ IO_READ_FIELD_NC4_T0
! 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, &
@@ -47,7 +48,6 @@ INTERFACE IO_READ_FIELD_NC4
! IO_READ_FIELD_NC4_L1, &
! IO_READ_FIELD_NC4_N2,IO_READ_FIELD_NC4_N3, &
! IO_READ_FIELD_NC4_C1, &
-! IO_READ_FIELD_NC4_T0
END INTERFACE IO_READ_FIELD_NC4
INTERFACE NCWRIT
@@ -2198,10 +2198,15 @@ 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))
+ IF(.NOT.PRESENT(HCALENDAR)) 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))
+ KRESP = -111 !Used later to broadcast modified metadata
+ ELSE
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4','UNITS found in file for field ' &
+ //TRIM(TPFIELD%CMNHNAME)//' (will be analysed later)')
+ END IF
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))
@@ -2212,8 +2217,14 @@ ELSE !no UNITS
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))
+ IF(.NOT.PRESENT(HCALENDAR)) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_ATTR_NC4','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','expected UNITS but not found in file for field ' &
+ //TRIM(TPFIELD%CMNHNAME))
+ KRESP = -3
+ END IF
END IF
END IF
!
@@ -2233,8 +2244,8 @@ IF (STATUS == NF90_NOERR) THEN
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))
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_ATTR_NC4','expected CALENDAR but not found in file for field ' &
+ //TRIM(TPFIELD%CMNHNAME))
END IF
ENDIF
!
@@ -2291,6 +2302,58 @@ KRESP = IRESP
END SUBROUTINE NCREADX0
+SUBROUTINE IO_READ_FIELD_NC4_X0(TPFILE, TPFIELD, PFIELD, KRESP)
+USE MODD_FM, ONLY : FMHEADER, JPXKRK
+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))
+
+IF (IDIMS == 0 .AND. 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(TPFIELD,INCID,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 NCREADX1(KNCID, HVARNAME, PFIELD, TPFMH, KRESP)
USE MODD_FM, ONLY : FMHEADER, JPXKRK
INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
@@ -2372,7 +2435,7 @@ 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
-INTEGER :: IDIMLEN
+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))
@@ -2503,6 +2566,88 @@ KRESP = IRESP
END SUBROUTINE NCREADX2
+SUBROUTINE IO_READ_FIELD_NC4_X2(TPFILE, TPFIELD, PFIELD, KRESP)
+USE MODD_FM, ONLY : FMHEADER, JPXKRK
+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(3) :: IVDIMS
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
+INTEGER :: IVARSIZE
+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))
+
+!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)
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X2[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+ IF (IDIMLEN==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_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_X2[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+ IVARSIZE = IDIMLEN
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN)
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X2[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+ IVARSIZE = IVARSIZE*IDIMLEN
+
+ IF (IVARSIZE == 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_X2[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+ END IF
+ ! 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_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 NCREADX3(KNCID, HVARNAME, PFIELD, TPFMH, KRESP)
USE MODD_FM, ONLY : FMHEADER, JPXKRK
INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
@@ -3221,6 +3366,74 @@ KRESP = IRESP
END SUBROUTINE IO_READ_FIELD_NC4_C0
+SUBROUTINE IO_READ_FIELD_NC4_T0(TPFILE, TPFIELD, TPDATA, KRESP)
+
+USE MODD_FM, ONLY : FMHEADER, JPXKRK
+USE MODD_TYPE_DATE
+
+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_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(TPFIELD,INCID,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
+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_NETCDF
#else
diff --git a/src/MNH/ini_modeln.f90 b/src/MNH/ini_modeln.f90
index 3d5c33b50..e5a52597c 100644
--- a/src/MNH/ini_modeln.f90
+++ b/src/MNH/ini_modeln.f90
@@ -1573,7 +1573,7 @@ END IF
!* 7. INITIALIZE GRIDS AND METRIC COEFFICIENTS
! ----------------------------------------
!
-CALL SET_GRID(KMI,TPINIFILE%CNAME,HLUOUT,IIU,IJU,IKU,NIMAX_ll,NJMAX_ll, &
+CALL SET_GRID(KMI,TPINIFILE,HLUOUT,IIU,IJU,IKU,NIMAX_ll,NJMAX_ll, &
XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
NXOR_ALL(KMI),NYOR_ALL(KMI),NXEND_ALL(KMI),NYEND_ALL(KMI), &
diff --git a/src/MNH/ini_spectren.f90 b/src/MNH/ini_spectren.f90
index a2f68bdbe..f35dd1bfe 100644
--- a/src/MNH/ini_spectren.f90
+++ b/src/MNH/ini_spectren.f90
@@ -11,12 +11,13 @@
!
INTERFACE
!
- SUBROUTINE INI_SPECTRE_n(KMI,HLUOUT,HINIFILE)
+ SUBROUTINE INI_SPECTRE_n(KMI,HLUOUT,TPINIFILE)
!
- INTEGER, INTENT(IN) :: KMI ! Model index
- CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name for output-listing
- ! of nested models
- CHARACTER (LEN=28), INTENT(IN) :: HINIFILE ! name of
+ USE MODD_IO_ll, ONLY: TFILEDATA
+!
+ INTEGER, INTENT(IN) :: KMI ! Model index
+ CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! Name for output-listing of nested models
+ TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
!
END SUBROUTINE INI_SPECTRE_n
!
@@ -24,7 +25,7 @@ END INTERFACE
!
END MODULE MODI_INI_SPECTRE_n
! ######################################################
- SUBROUTINE INI_SPECTRE_n(KMI,HLUOUT,HINIFILE)
+ SUBROUTINE INI_SPECTRE_n(KMI,HLUOUT,TPINIFILE)
! ######################################################
!
!!**** *INI_SPECTRE_n* - routine to initialize SPECTRE (based on ini_modeln.f90)
@@ -56,7 +57,7 @@ USE MODD_DUST
USE MODD_DYN
USE MODD_DYNZD
USE MODD_FRC
-USE MODD_IO_ll, ONLY : LIOCDF4,LLFIOUT
+USE MODD_IO_ll, ONLY : LIOCDF4,LLFIOUT,TFILEDATA
USE MODD_REF
USE MODD_SERIES, ONLY: LSERIES
USE MODD_TIME
@@ -141,12 +142,9 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-INTEGER, INTENT(IN) :: KMI ! Model Index
-
-CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name for output-listing
- ! of nested models
-CHARACTER (LEN=28), INTENT(IN) :: HINIFILE ! name of
- ! the initial file
+INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! Name for output-listing of nested models
+TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
!
!* 0.2 declarations of local variables
!
@@ -230,7 +228,7 @@ NULLIFY(TZINITHALO3D_ll)
!
CALL FMLOOK_ll(HLUOUT,HLUOUT,ILUOUT,IRESP)
CLUOUT = HLUOUT
-CINIFILE=HINIFILE
+CINIFILE=TPINIFILE%CNAME
!
!-------------------------------------------------------------------------------
!
@@ -245,7 +243,7 @@ IKU=NKMAX+2*JPVEXT
YRECFM = 'ZHAT'
ALLOCATE(XZHAT(IKU))
YDIR='--'
-CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XZHAT,IGRID,ILENCH,YCOMMENT,IRESP)
+CALL FMREAD(TPINIFILE%CNAME,YRECFM,HLUOUT,YDIR,XZHAT,IGRID,ILENCH,YCOMMENT,IRESP)
IF (XALZBOT>=XZHAT(IKU) .AND. LVE_RELAX) THEN
WRITE(ILUOUT,FMT=*) "INI_SPECTRE_n ERROR: you want to use vertical relaxation"
WRITE(ILUOUT,FMT=*) " but bottom of layer XALZBOT(",XALZBOT,")"
@@ -731,7 +729,7 @@ CALL INI_BIKHARDT_n (NDXRATIO_ALL(KMI),NDYRATIO_ALL(KMI),KMI)
!* 6. INITIALIZE GRIDS AND METRIC COEFFICIENTS
! ----------------------------------------
!
-CALL SET_GRID(KMI,HINIFILE,HLUOUT,IIU,IJU,IKU,NIMAX_ll,NJMAX_ll, &
+CALL SET_GRID(KMI,TPINIFILE,HLUOUT,IIU,IJU,IKU,NIMAX_ll,NJMAX_ll, &
XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
NXOR_ALL(KMI),NYOR_ALL(KMI),NXEND_ALL(KMI),NYEND_ALL(KMI), &
@@ -769,35 +767,35 @@ IF (LSPECTRE_U) THEN
ALLOCATE(XUT(IIU,IJU,IKU)) ; XUT = 0.0
YRECFM = 'UT'
YDIR='XY'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XUT,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(TPINIFILE%CNAME,YRECFM,HLUOUT,YDIR,XUT,IGRID,ILENCH,YCOMMENT,IRESP)
END IF
!
IF (LSPECTRE_V) THEN
ALLOCATE(XVT(IIU,IJU,IKU)) ; XVT = 0.0
YRECFM = 'VT'
YDIR='XY'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XVT,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(TPINIFILE%CNAME,YRECFM,HLUOUT,YDIR,XVT,IGRID,ILENCH,YCOMMENT,IRESP)
END IF
!
IF (LSPECTRE_W) THEN
ALLOCATE(XWT(IIU,IJU,IKU)) ; XWT = 0.0
YRECFM = 'WT'
YDIR='XY'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XWT,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(TPINIFILE%CNAME,YRECFM,HLUOUT,YDIR,XWT,IGRID,ILENCH,YCOMMENT,IRESP)
END IF
!
IF (LSPECTRE_TH) THEN
ALLOCATE(XTHT(IIU,IJU,IKU)) ; XTHT = 0.0
YRECFM = 'THT'
YDIR='XY'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XTHT,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(TPINIFILE%CNAME,YRECFM,HLUOUT,YDIR,XTHT,IGRID,ILENCH,YCOMMENT,IRESP)
END IF
!
IF (LSPECTRE_RV) THEN
ALLOCATE(XRT(IIU,IJU,IKU,NRR))
YRECFM = 'RVT'
YDIR='XY'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XRT(:,:,:,1),IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(TPINIFILE%CNAME,YRECFM,HLUOUT,YDIR,XRT(:,:,:,1),IGRID,ILENCH,YCOMMENT,IRESP)
END IF
!
!-------------------------------------------------------------------------------
@@ -807,9 +805,9 @@ END IF
! ---------------------------
!
!
-CALL SET_REF(KMI,HINIFILE,HLUOUT, &
+CALL SET_REF(KMI,TPINIFILE%CNAME,HLUOUT, &
XZZ,XZHAT,ZJ,XDXX,XDYY,CLBCX,CLBCY, &
- XREFMASS,XMASS_O_PHI0,XLINMASS, &
+ XREFMASS,XMASS_O_PHI0,XLINMASS, &
XRHODREF,XTHVREF,XRVREF,XEXNREF,XRHODJ )
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/init_mnh.f90 b/src/MNH/init_mnh.f90
index f7219dbb2..8f09d9f73 100644
--- a/src/MNH/init_mnh.f90
+++ b/src/MNH/init_mnh.f90
@@ -241,7 +241,7 @@ DO JMI=1,NMODEL
!Call necessary to update the TFIELDLIST pointers to the data
CALL FIELDLIST_GOTO_MODEL(JMI,JMI)
ELSE
- CALL INI_SPECTRE_n(JMI,YLUOUT(JMI),TZINIFILE(JMI)%CNAME)
+ CALL INI_SPECTRE_n(JMI,YLUOUT(JMI),TZINIFILE(JMI))
END IF
END DO
!
diff --git a/src/MNH/set_grid.f90 b/src/MNH/set_grid.f90
index 09476616c..93c40d04c 100644
--- a/src/MNH/set_grid.f90
+++ b/src/MNH/set_grid.f90
@@ -14,7 +14,7 @@
!
INTERFACE
!
- SUBROUTINE SET_GRID(KMI,HINIFILE,HLUOUT, &
+ SUBROUTINE SET_GRID(KMI,TPINIFILE,HLUOUT, &
KIU,KJU,KKU,KIMAX_ll,KJMAX_ll, &
PBMX1,PBMX2,PBMX3,PBMX4,PBMY1,PBMY2,PBMY3,PBMY4, &
PBFX1,PBFX2,PBFX3,PBFX4,PBFY1,PBFY2,PBFY3,PBFY4, &
@@ -29,10 +29,10 @@ INTERFACE
KBAK_NUMB,KOUT_NUMB,TPBACKUPN,TPOUTPUTN )
!
USE MODD_TYPE_DATE
-USE MODD_IO_ll, ONLY:TOUTBAK
+USE MODD_IO_ll, ONLY: TFILEDATA,TOUTBAK
!
INTEGER, INTENT(IN) :: KMI ! Model index
-CHARACTER (LEN=*), INTENT(IN) :: HINIFILE ! Name of the initial file
+TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE !Initial file
CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name for output-listing
! of nested models
INTEGER, INTENT(IN) :: KIU ! Upper dimension in x direction
@@ -41,9 +41,9 @@ INTEGER, INTENT(IN) :: KJU ! Upper dimension in y directio
! for sub-domain arrays
INTEGER, INTENT(IN) :: KKU ! Upper dimension in z direction
! for domain arrays
-INTEGER, INTENT(IN) :: KIMAX_ll ! Dimensions in x direction
+INTEGER, INTENT(IN) :: KIMAX_ll ! Dimensions in x direction
! of the physical domain,
-INTEGER, INTENT(IN) :: KJMAX_ll ! Dimensions in y direction
+INTEGER, INTENT(IN) :: KJMAX_ll ! Dimensions in y direction
! of the physical domain,
REAL, DIMENSION(:), INTENT(IN) :: PBMX1,PBMX2,PBMX3,PBMX4 ! Mass points in X-direc.
REAL, DIMENSION(:), INTENT(IN) :: PBMY1,PBMY2,PBMY3,PBMY4 ! Mass points in Y-direc.
@@ -105,7 +105,7 @@ END MODULE MODI_SET_GRID
!
!
! #########################################################################
- SUBROUTINE SET_GRID(KMI,HINIFILE,HLUOUT, &
+ SUBROUTINE SET_GRID(KMI,TPINIFILE,HLUOUT, &
KIU,KJU,KKU,KIMAX_ll,KJMAX_ll, &
PBMX1,PBMX2,PBMX3,PBMX4,PBMY1,PBMY2,PBMY3,PBMY4, &
PBFX1,PBFX2,PBFX3,PBFX4,PBFY1,PBFY2,PBFY3,PBFY4, &
@@ -243,7 +243,7 @@ USE MODD_PARAMETERS
USE MODD_CONF
USE MODD_CONF_n
USE MODD_GRID
-USE MODD_IO_ll, ONLY:TOUTBAK
+USE MODD_IO_ll, ONLY:TFILEDATA,TOUTBAK
USE MODD_BUDGET
USE MODD_DYN
USE MODD_NESTING
@@ -263,7 +263,7 @@ IMPLICIT NONE
!* 0.1 declarations of argument
!
INTEGER, INTENT(IN) :: KMI ! Model index
-CHARACTER (LEN=*), INTENT(IN) :: HINIFILE ! Name of the initial file
+TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE !Initial file
CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name for output-listing
! of nested models
INTEGER, INTENT(IN) :: KIU ! Upper dimension in x direction
@@ -333,11 +333,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZYHAT_ll ! Position y in the conformal
! plane (array on the complete domain)
REAL :: ZXHATM,ZYHATM ! coordinates of mass point
REAL :: ZLATORI, ZLONORI ! lat and lon of left-bottom point
-INTEGER :: IGRID,ILENCH,IRESP ! File
-CHARACTER (LEN=16) :: YRECFM ! management
-CHARACTER (LEN=100) :: YCOMMENT ! variables
-CHARACTER (LEN=2) :: YDIR !
-INTEGER, DIMENSION(3) :: ITDATE ! date array
+INTEGER :: IRESP
CHARACTER (LEN=40) :: YTITLE ! Title for date print
INTEGER :: ILUOUT ! Logical unit number for
! output-listing
@@ -348,59 +344,43 @@ INTEGER :: IIUP,IJUP ,ISUP=1 ! size of working
INTEGER :: IMASDEV ! masdev of the file
!-------------------------------------------------------------------------------
!
-YRECFM='MASDEV'
-YDIR='--'
-CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,IMASDEV,IGRID,ILENCH,YCOMMENT,IRESP)
+CALL IO_READ_FIELD(TPINIFILE,'MASDEV',IMASDEV)
!
!* 1. READ GRID VARIABLES IN INITIAL FILE
! ------------------------------------
!
!* 1.1 Spatial grid
!
- YRECFM='STORAGE_TYPE'
- YDIR='--'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,CSTORAGE_TYPE,IGRID,ILENCH,YCOMMENT,IRESP)
- IF (IRESP /= 0) CSTORAGE_TYPE='TT'
- !
+CALL IO_READ_FIELD(TPINIFILE,'STORAGE_TYPE',CSTORAGE_TYPE,IRESP)
+IF (IRESP /= 0) CSTORAGE_TYPE='TT'
+!
IF (KMI == 1) THEN
- YRECFM='LON0' ! this parameter is also useful in the cartesian to
- YDIR='--' ! compute the sun position for the radiation scheme
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XLON0,IGRID,ILENCH,YCOMMENT,IRESP)
+ ! this parameter is also useful in the cartesian to
+ ! compute the sun position for the radiation scheme
+ CALL IO_READ_FIELD(TPINIFILE,'LON0',XLON0)
!
- YRECFM='LAT0' ! this parameter is also useful in the cartesian to
- YDIR='--' ! compute the Coriolis parameter
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XLAT0,IGRID,ILENCH,YCOMMENT,IRESP)
+ ! this parameter is also useful in the cartesian to
+ ! compute the Coriolis parameter
+ CALL IO_READ_FIELD(TPINIFILE,'LAT0',XLAT0)
!
- YRECFM='BETA' ! this parameter is also useful in the cartesian to
- YDIR='--' ! rotate the simulatin domain
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XBETA,IGRID,ILENCH,YCOMMENT,IRESP)
+ ! this parameter is also useful in the cartesian to
+ ! rotate the simulatin domain
+ CALL IO_READ_FIELD(TPINIFILE,'BETA',XBETA)
END IF
!
-YRECFM='XHAT'
-YDIR='XX'
-CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PXHAT,IGRID,ILENCH,YCOMMENT,IRESP)
-!
-YRECFM='YHAT'
-YDIR='YY'
-CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PYHAT,IGRID,ILENCH,YCOMMENT,IRESP)
+CALL IO_READ_FIELD(TPINIFILE,'XHAT',PXHAT)
+CALL IO_READ_FIELD(TPINIFILE,'YHAT',PYHAT)
!
IF (.NOT.LCARTESIAN) THEN
- YRECFM='RPK'
- YDIR='--'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XRPK,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL IO_READ_FIELD(TPINIFILE,'RPK',XRPK)
!
IF (IMASDEV > 45) THEN
- YRECFM='LONORI'
- YDIR='--'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PLONORI,IGRID,ILENCH,YCOMMENT,IRESP)
- !
- YRECFM='LATORI'
- YDIR='--'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PLATORI,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL IO_READ_FIELD(TPINIFILE,'LONORI',PLONORI)
+ CALL IO_READ_FIELD(TPINIFILE,'LATORI',PLATORI)
!
ELSE
- CALL FMREAD(HINIFILE,'LONOR',HLUOUT,'--',PLONORI,IGRID,ILENCH,YCOMMENT,IRESP)
- CALL FMREAD(HINIFILE,'LATOR',HLUOUT,'--',PLATORI,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL IO_READ_FIELD(TPINIFILE,'LONOR',PLONORI)
+ CALL IO_READ_FIELD(TPINIFILE,'LATOR',PLATORI)
ALLOCATE(ZXHAT_ll(KIMAX_ll+ 2 * JPHEXT),ZYHAT_ll(KJMAX_ll+2 * JPHEXT))
CALL GATHERALL_FIELD_ll('XX',PXHAT,ZXHAT_ll,IRESP) !//
CALL GATHERALL_FIELD_ll('YY',PYHAT,ZYHAT_ll,IRESP) !//
@@ -414,13 +394,8 @@ IF (.NOT.LCARTESIAN) THEN
!
END IF
-YRECFM='ZS'
-YDIR='XY'
-CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PZS,IGRID,ILENCH,YCOMMENT,IRESP)
-!
-YRECFM='ZHAT'
-YDIR='--'
-CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PZHAT,IGRID,ILENCH,YCOMMENT,IRESP)
+CALL IO_READ_FIELD(TPINIFILE,'ZS',PZS)
+CALL IO_READ_FIELD(TPINIFILE,'ZHAT',PZHAT)
!
CALL DEFAULT_SLEVE(OSLEVE,PLEN1,PLEN2)
!
@@ -428,64 +403,25 @@ IF (IMASDEV<=46) THEN
PZSMT = PZS
OSLEVE = .FALSE.
ELSE
- YRECFM='SLEVE'
- YDIR='--'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,OSLEVE,IGRID,ILENCH,YCOMMENT,IRESP)
- !
- YRECFM='ZSMT'
- YDIR='XY'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PZSMT,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL IO_READ_FIELD(TPINIFILE,'ZSMT',PZSMT)
+ CALL IO_READ_FIELD(TPINIFILE,'SLEVE',OSLEVE)
END IF
!
IF (OSLEVE) THEN
- YRECFM='LEN1'
- YDIR='--'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PLEN1,IGRID,ILENCH,YCOMMENT,IRESP)
- !
- YRECFM='LEN2'
- YDIR='--'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PLEN2,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL IO_READ_FIELD(TPINIFILE,'LEN1',PLEN1)
+ CALL IO_READ_FIELD(TPINIFILE,'LEN2',PLEN2)
END IF
!
!* 1.2 Temporal grid
!
+CALL IO_READ_FIELD(TPINIFILE,'DTMOD',TPDTMOD)
+CALL IO_READ_FIELD(TPINIFILE,'DTCUR',TPDTCUR)
+!
IF (KMI == 1) THEN
- YRECFM='DTEXP%TDATE'
- YDIR='--'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,ITDATE,IGRID,ILENCH,YCOMMENT,IRESP)
- TDTEXP%TDATE=DATE(ITDATE(1),ITDATE(2),ITDATE(3))
- YRECFM='DTEXP%TIME'
- YDIR='--'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,TDTEXP%TIME,IGRID,ILENCH, &
- YCOMMENT,IRESP)
+CALL IO_READ_FIELD(TPINIFILE,'DTEXP',TDTEXP)
END IF
!
-YRECFM='DTCUR%TDATE'
-YDIR='--'
-CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,ITDATE,IGRID,ILENCH,YCOMMENT,IRESP)
-TPDTCUR%TDATE=DATE(ITDATE(1),ITDATE(2),ITDATE(3))
-YRECFM='DTCUR%TIME'
-YDIR='--'
-CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,TPDTCUR%TIME,IGRID,ILENCH, &
- YCOMMENT,IRESP)
-!
-YRECFM='DTMOD%TDATE'
-YDIR='--'
-CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,ITDATE,IGRID,ILENCH,YCOMMENT,IRESP)
-TPDTMOD%TDATE=DATE(ITDATE(1),ITDATE(2),ITDATE(3))
-YRECFM='DTMOD%TIME'
-YDIR='--'
-CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,TPDTMOD%TIME,IGRID,ILENCH, &
- YCOMMENT,IRESP)
-!
-YRECFM='DTSEG%TDATE'
-YDIR='--'
-CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,ITDATE,IGRID,ILENCH,YCOMMENT,IRESP)
-TDTSEG%TDATE=DATE(ITDATE(1),ITDATE(2),ITDATE(3))
-YRECFM='DTSEG%TIME'
-YDIR='--'
-CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,TDTSEG%TIME,IGRID,ILENCH, &
- YCOMMENT,IRESP)
+CALL IO_READ_FIELD(TPINIFILE,'DTSEG',TDTSEG)
!
!-------------------------------------------------------------------------------
!
--
GitLab