From 6e670f136db11c54294f2ac60c3d30d8b95fc407 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Mon, 25 Sep 2017 13:20:41 +0200
Subject: [PATCH] Philippe 25/09/2017: IO: * added
IO_READ_FIELD_BYNAME_X4/X5/X6 and IO_READ_FIELD_BYFIELD_X4/X5/X6
subroutines to IO_READ_FIELD procedure * added IO_READ_FIELD_LFI_X4/X5/X6
subroutines to IO_READ_FIELD_LFI procedure * added IO_READ_FIELD_NC4_X4/X5/X6
subroutines to IO_READ_FIELD_NC4 procedure
---
src/LIB/SURCOUCHE/src/fmread_ll.f90 | 408 +++++++++++++++++++++++++-
src/LIB/SURCOUCHE/src/fmreadwrit.f90 | 113 ++++++-
src/LIB/SURCOUCHE/src/mode_netcdf.f90 | 224 +++++++++++++-
3 files changed, 730 insertions(+), 15 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/fmread_ll.f90 b/src/LIB/SURCOUCHE/src/fmread_ll.f90
index 89bda55a5..81b46b2aa 100644
--- a/src/LIB/SURCOUCHE/src/fmread_ll.f90
+++ b/src/LIB/SURCOUCHE/src/fmread_ll.f90
@@ -43,6 +43,8 @@ PRIVATE
INTERFACE IO_READ_FIELD
MODULE PROCEDURE 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, &
+ IO_READ_FIELD_BYNAME_X6, &
IO_READ_FIELD_BYNAME_N0, IO_READ_FIELD_BYNAME_N1, &
IO_READ_FIELD_BYNAME_N2, &
IO_READ_FIELD_BYNAME_L0, IO_READ_FIELD_BYNAME_L1, &
@@ -50,19 +52,13 @@ INTERFACE IO_READ_FIELD
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, &
+ IO_READ_FIELD_BYFIELD_X4,IO_READ_FIELD_BYFIELD_X5, &
+ IO_READ_FIELD_BYFIELD_X6, &
IO_READ_FIELD_BYFIELD_N0,IO_READ_FIELD_BYFIELD_N1, &
IO_READ_FIELD_BYFIELD_N2, &
IO_READ_FIELD_BYFIELD_L0,IO_READ_FIELD_BYFIELD_L1, &
IO_READ_FIELD_BYFIELD_C0, &
IO_READ_FIELD_BYFIELD_T0
-! IO_READ_FIELD_BYNAME_X4, IO_READ_FIELD_BYNAME_X5, &
-! IO_READ_FIELD_BYNAME_X6, &
-! IO_READ_FIELD_BYNAME_N3, &
-! IO_READ_FIELD_BYNAME_C1, &
-! IO_READ_FIELD_BYFIELD_X4,IO_READ_FIELD_BYFIELD_X5, &
-! IO_READ_FIELD_BYFIELD_X6, &
-! IO_READ_FIELD_BYFIELD_N3, &
-! IO_READ_FIELD_BYFIELD_C1, &
END INTERFACE
INTERFACE IO_READ_FIELD_LB
@@ -1765,6 +1761,144 @@ RETURN
!------------------------------------------------------------------
END SUBROUTINE FMREADX4_ll
+SUBROUTINE IO_READ_FIELD_BYNAME_X4(TPFILE,HNAME,PFIELD,KRESP)
+!
+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 :: ID ! Index of the field
+INTEGER :: IRESP ! return_code
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYNAME_X4',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_X4
+
+SUBROUTINE IO_READ_FIELD_BYFIELD_X4(TPFILE,TPFIELD,PFIELD,KRESP)
+!
+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 :: IERR
+TYPE(FD_ll), POINTER :: TZFD
+REAL,DIMENSION(:,:,:,:),POINTER :: ZFIELDP
+LOGICAL :: GALLOC
+INTEGER :: IRESP
+INTEGER :: IHEXTOT
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYFIELD_X4',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+!
+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 IF (TPFILE%CFORMAT=='LFICDF4') THEN
+ !Only detected if CFORMAT='LFICDF4'
+ !This seems to be allowed for netCDF4 but it is not clean
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_FIELD_BYFIELD_X4',&
+ TRIM(TPFILE%CNAME)//': reading in a file opened in WRITE mode')
+ CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_READ_FIELD_BYFIELD_X4',&
+ 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
+ IF (ISP == TZFD%OWNER) THEN
+ ! I/O processor case
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,TPFIELD%CDIR,GALLOC)
+ 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 IF (TPFILE%CFORMAT=='LFICDF4') THEN
+ !Only detected if CFORMAT='LFICDF4'
+ !This seems to be allowed for netCDF4 but it is not clean
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_FIELD_BYFIELD_X4',&
+ TRIM(TPFILE%CNAME)//': reading in a file opened in WRITE mode')
+ CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_READ_FIELD_BYFIELD_X4',&
+ 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)
+ !
+ 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)
+ 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)
+ PFIELD(:,:,:,:) = SPREAD(PFIELD(:,JPHEXT+1,:,:),DIM=2,NCOPIES=IHEXTOT)
+ ELSE
+ ! XY Scatter Field
+ CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
+ END IF
+ ELSE
+ CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
+ END IF
+ END IF
+ELSE
+ IRESP = -61
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_BYFIELD_X4','file '//TRIM(TPFILE%CNAME)//' not found')
+END IF
+!
+IF (GALLOC) DEALLOCATE (ZFIELDP)
+!
+IF (IRESP==-111) IRESP = 0 !-111 is not really an error (metadata has changed)
+!
+IF (PRESENT(KRESP)) KRESP = IRESP
+!
+END SUBROUTINE IO_READ_FIELD_BYFIELD_X4
+
+
SUBROUTINE FMREADX5_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
KLENCH,HCOMMENT,KRESP)
USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LPACK,L1D,L2D
@@ -1889,6 +2023,144 @@ RETURN
!------------------------------------------------------------------
END SUBROUTINE FMREADX5_ll
+SUBROUTINE IO_READ_FIELD_BYNAME_X5(TPFILE,HNAME,PFIELD,KRESP)
+!
+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 :: ID ! Index of the field
+INTEGER :: IRESP ! return_code
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYNAME_X5',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_X5
+
+SUBROUTINE IO_READ_FIELD_BYFIELD_X5(TPFILE,TPFIELD,PFIELD,KRESP)
+!
+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 :: IERR
+TYPE(FD_ll), POINTER :: TZFD
+REAL,DIMENSION(:,:,:,:,:),POINTER :: ZFIELDP
+LOGICAL :: GALLOC
+INTEGER :: IRESP
+INTEGER :: IHEXTOT
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYFIELD_X5',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+!
+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 IF (TPFILE%CFORMAT=='LFICDF4') THEN
+ !Only detected if CFORMAT='LFICDF4'
+ !This seems to be allowed for netCDF4 but it is not clean
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_FIELD_BYFIELD_X5',&
+ TRIM(TPFILE%CNAME)//': reading in a file opened in WRITE mode')
+ CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_READ_FIELD_BYFIELD_X5',&
+ 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
+ IF (ISP == TZFD%OWNER) THEN
+ ! I/O processor case
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,TPFIELD%CDIR,GALLOC)
+ 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 IF (TPFILE%CFORMAT=='LFICDF4') THEN
+ !Only detected if CFORMAT='LFICDF4'
+ !This seems to be allowed for netCDF4 but it is not clean
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_FIELD_BYFIELD_X5',&
+ TRIM(TPFILE%CNAME)//': reading in a file opened in WRITE mode')
+ CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_READ_FIELD_BYFIELD_X5',&
+ 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)
+ !
+ 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)
+ 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)
+ PFIELD(:,:,:,:,:) = SPREAD(PFIELD(:,JPHEXT+1,:,:,:),DIM=2,NCOPIES=IHEXTOT)
+ ELSE
+ ! XY Scatter Field
+ CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
+ END IF
+ ELSE
+ CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
+ END IF
+ END IF
+ELSE
+ IRESP = -61
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_BYFIELD_X5','file '//TRIM(TPFILE%CNAME)//' not found')
+END IF
+!
+IF (GALLOC) DEALLOCATE (ZFIELDP)
+!
+IF (IRESP==-111) IRESP = 0 !-111 is not really an error (metadata has changed)
+!
+IF (PRESENT(KRESP)) KRESP = IRESP
+!
+END SUBROUTINE IO_READ_FIELD_BYFIELD_X5
+
+
SUBROUTINE FMREADX6_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
KLENCH,HCOMMENT,KRESP)
USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
@@ -1983,6 +2255,126 @@ RETURN
!------------------------------------------------------------------
END SUBROUTINE FMREADX6_ll
+SUBROUTINE IO_READ_FIELD_BYNAME_X6(TPFILE,HNAME,PFIELD,KRESP)
+!
+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 :: ID ! Index of the field
+INTEGER :: IRESP ! return_code
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYNAME_X6',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_X6
+
+SUBROUTINE IO_READ_FIELD_BYFIELD_X6(TPFILE,TPFIELD,PFIELD,KRESP)
+!
+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 :: IERR
+TYPE(FD_ll), POINTER :: TZFD
+REAL,DIMENSION(:,:,:,:,:,:),POINTER :: ZFIELDP
+LOGICAL :: GALLOC
+INTEGER :: IRESP
+INTEGER :: IHEXTOT
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYFIELD_X6',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+!
+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 (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 IF (TPFILE%CFORMAT=='LFICDF4') THEN
+ !Only detected if CFORMAT='LFICDF4'
+ !This seems to be allowed for netCDF4 but it is not clean
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_FIELD_BYFIELD_X6',&
+ TRIM(TPFILE%CNAME)//': reading in a file opened in WRITE mode')
+ CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,PFIELD,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_READ_FIELD_BYFIELD_X6',&
+ TRIM(TPFILE%CNAME)//': invalid fileformat ('//TRIM(TPFILE%CFORMAT)//')')
+ END IF
+ ELSE
+ IF (ISP == TZFD%OWNER) THEN
+ ! I/O processor case
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,TPFIELD%CDIR,GALLOC)
+ 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 IF (TPFILE%CFORMAT=='LFICDF4') THEN
+ !Only detected if CFORMAT='LFICDF4'
+ !This seems to be allowed for netCDF4 but it is not clean
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_FIELD_BYFIELD_X6',&
+ TRIM(TPFILE%CNAME)//': reading in a file opened in WRITE mode')
+ CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_READ_FIELD_BYFIELD_X6',&
+ 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)
+ !
+ 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)
+ ELSE IF (TPFIELD%CDIR == 'XY') THEN
+ ! XY Scatter Field
+ CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
+ ELSE
+ CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
+ END IF
+ END IF
+ELSE
+ IRESP = -61
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_BYFIELD_X6','file '//TRIM(TPFILE%CNAME)//' not found')
+END IF
+!
+IF (GALLOC) DEALLOCATE (ZFIELDP)
+!
+IF (IRESP==-111) IRESP = 0 !-111 is not really an error (metadata has changed)
+!
+IF (PRESENT(KRESP)) KRESP = IRESP
+!
+END SUBROUTINE IO_READ_FIELD_BYFIELD_X6
+
+
SUBROUTINE FMREADN0_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
KLENCH,HCOMMENT,KRESP)
USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
diff --git a/src/LIB/SURCOUCHE/src/fmreadwrit.f90 b/src/LIB/SURCOUCHE/src/fmreadwrit.f90
index c60370511..e66b259cd 100644
--- a/src/LIB/SURCOUCHE/src/fmreadwrit.f90
+++ b/src/LIB/SURCOUCHE/src/fmreadwrit.f90
@@ -274,14 +274,13 @@ PRIVATE
INTERFACE IO_READ_FIELD_LFI
MODULE PROCEDURE 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, &
+ IO_READ_FIELD_LFI_X6, &
IO_READ_FIELD_LFI_N0, IO_READ_FIELD_LFI_N1, &
IO_READ_FIELD_LFI_N2, &
IO_READ_FIELD_LFI_L0, IO_READ_FIELD_LFI_L1, &
IO_READ_FIELD_LFI_C0, &
IO_READ_FIELD_LFI_T0
-! IO_READ_FIELD_LFI_X4,IO_READ_FIELD_LFI_X5, &
-! IO_READ_FIELD_LFI_X6, &
-! IO_READ_FIELD_LFI_N3, &
END INTERFACE IO_READ_FIELD_LFI
!
INTERFACE IO_WRITE_FIELD_LFI
@@ -444,6 +443,114 @@ IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
END SUBROUTINE IO_READ_FIELD_LFI_X3
!
!
+SUBROUTINE IO_READ_FIELD_LFI_X4(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_X4',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_X4
+!
+!
+SUBROUTINE IO_READ_FIELD_LFI_X5(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_X5',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_X5
+!
+!
+SUBROUTINE IO_READ_FIELD_LFI_X6(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_X6',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_X6
+!
+!
SUBROUTINE IO_READ_FIELD_LFI_N0(TPFILE,TPFIELD,KFIELD,KRESP)
USE MODD_FM
USE MODD_CONFZ, ONLY : NZ_VERB
diff --git a/src/LIB/SURCOUCHE/src/mode_netcdf.f90 b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
index db19a7a8e..9064e152b 100644
--- a/src/LIB/SURCOUCHE/src/mode_netcdf.f90
+++ b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
@@ -37,15 +37,13 @@ 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
-! IO_READ_FIELD_NC4_X4,IO_READ_FIELD_NC4_X5, &
-! IO_READ_FIELD_NC4_X6, &
-! IO_READ_FIELD_NC4_N3, &
-! IO_READ_FIELD_NC4_C1, &
END INTERFACE IO_READ_FIELD_NC4
INTERFACE NCWRIT
@@ -2857,6 +2855,76 @@ KRESP = IRESP
END SUBROUTINE NCREADX4
+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))
+
+IF (IDIMS == 4 .AND. 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(TPFIELD,INCID,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 NCREADX5(KNCID, HVARNAME, PFIELD, TPFMH, KRESP)
USE MODD_FM, ONLY : FMHEADER, JPXKRK
INTEGER(KIND=IDCDF_KIND), INTENT(IN) :: KNCID
@@ -2924,6 +2992,79 @@ KRESP = IRESP
END SUBROUTINE NCREADX5
+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))
+
+IF (IDIMS == 5 .AND. 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(TPFIELD,INCID,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 NCREADX6(KNCID, HVARNAME, PFIELD, TPFMH, KRESP)
USE MODD_FM, ONLY : FMHEADER, JPXKRK
INTEGER(KIND=IDCDF_KIND), INTENT(IN) :: KNCID
@@ -2991,6 +3132,81 @@ KRESP = IRESP
END SUBROUTINE NCREADX6
+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))
+
+IF (IDIMS == 6 .AND. 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(TPFIELD,INCID,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 NCREADN0(KNCID, HVARNAME, KFIELD, TPFMH, KRESP)
USE MODD_FM, ONLY : FMHEADER, JPXKRK
INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
--
GitLab