From 7d50ca2295acc024e440576f1d67aa0488409006 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Mon, 13 Feb 2017 17:22:44 +0100
Subject: [PATCH] Philippe 13/02/2017: IO: added writing of 2D integer
variables * added IO_WRITE_FIELD_BYNAME_N2 and IO_WRITE_FIELD_BYFIELD_N2
subroutines to IO_WRITE_FIELD procedure * added IO_WRITE_FIELD_LFI_N2
subroutine to IO_WRITE_FIELD_LFI procedure * added IO_WRITE_FIELD_NC4_N2
subroutine to IO_WRITE_FIELD_NC4 procedure * possible to write 2D integer
values in output files
---
src/LIB/SURCOUCHE/src/fmreadwrit.f90 | 36 +++++-
src/LIB/SURCOUCHE/src/fmwrit_ll.f90 | 143 ++++++++++++++++++++++-
src/LIB/SURCOUCHE/src/io_write_field.f90 | 13 +++
src/LIB/SURCOUCHE/src/mode_netcdf.f90 | 64 +++++++++-
4 files changed, 252 insertions(+), 4 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/fmreadwrit.f90 b/src/LIB/SURCOUCHE/src/fmreadwrit.f90
index efe4e6f67..93a84a446 100644
--- a/src/LIB/SURCOUCHE/src/fmreadwrit.f90
+++ b/src/LIB/SURCOUCHE/src/fmreadwrit.f90
@@ -267,7 +267,7 @@ PRIVATE
INTERFACE IO_WRITE_FIELD_LFI
MODULE PROCEDURE IO_WRITE_FIELD_LFI_X0,IO_WRITE_FIELD_LFI_X1, &
IO_WRITE_FIELD_LFI_X2,IO_WRITE_FIELD_LFI_X3, &
- IO_WRITE_FIELD_LFI_N0, &
+ IO_WRITE_FIELD_LFI_N0,IO_WRITE_FIELD_LFI_N2, &
IO_WRITE_FIELD_LFI_C0, &
IO_WRITE_FIELD_LFI_T0
END INTERFACE IO_WRITE_FIELD_LFI
@@ -455,6 +455,40 @@ IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
END SUBROUTINE IO_WRITE_FIELD_LFI_N0
!
+SUBROUTINE IO_WRITE_FIELD_LFI_N2(TPFIELD,KFLU,KFIELD,KRESP)
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+!
+TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+INTEGER, INTENT(IN) :: KFLU ! Fortran Logical Unit
+INTEGER,DIMENSION(:,:),INTENT(IN) :: KFIELD ! array containing the data field
+INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
+!
+!* 0.2 Declarations of local variables
+!
+INTEGER :: ILENG
+INTEGER(kind=LFI_INT) :: IRESP, ITOTAL
+INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_LFI_N2','writing '//TRIM(TPFIELD%CMNHNAME))
+!
+ILENG = SIZE(KFIELD)
+!
+CALL WRITE_PREPARE(TPFIELD,ILENG,IWORK,ITOTAL,IRESP)
+!
+IF (IRESP==0) THEN
+ IWORK(LEN_TRIM(TPFIELD%CCOMMENT)+3:) = RESHAPE( KFIELD(:,:) , (/ SIZE(KFIELD) /) )
+ CALL LFIECR(IRESP,KFLU,TPFIELD%CMNHNAME,IWORK,ITOTAL)
+ENDIF
+!
+KRESP=IRESP
+!
+IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
+!
+END SUBROUTINE IO_WRITE_FIELD_LFI_N2
+!
SUBROUTINE IO_WRITE_FIELD_LFI_C0(TPFIELD,KFLU,HFIELD,KRESP)
!
IMPLICIT NONE
diff --git a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90 b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
index e66e745ee..811ac25c6 100644
--- a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
+++ b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
@@ -181,13 +181,13 @@ MODULE MODE_FMWRIT
INTERFACE IO_WRITE_FIELD
MODULE PROCEDURE IO_WRITE_FIELD_BYNAME_X0, IO_WRITE_FIELD_BYNAME_X1, &
IO_WRITE_FIELD_BYNAME_X2, IO_WRITE_FIELD_BYNAME_X3, &
- IO_WRITE_FIELD_BYNAME_N0, &
+ IO_WRITE_FIELD_BYNAME_N0, IO_WRITE_FIELD_BYNAME_N2, &
IO_WRITE_FIELD_BYNAME_L0, &
IO_WRITE_FIELD_BYNAME_C0, &
IO_WRITE_FIELD_BYNAME_T0, &
IO_WRITE_FIELD_BYFIELD_X0,IO_WRITE_FIELD_BYFIELD_X1, &
IO_WRITE_FIELD_BYFIELD_X2,IO_WRITE_FIELD_BYFIELD_X3, &
- IO_WRITE_FIELD_BYFIELD_N0, &
+ IO_WRITE_FIELD_BYFIELD_N0,IO_WRITE_FIELD_BYFIELD_N2, &
IO_WRITE_FIELD_BYFIELD_L0, &
IO_WRITE_FIELD_BYFIELD_C0, &
IO_WRITE_FIELD_BYFIELD_T0
@@ -2394,6 +2394,145 @@ CONTAINS
END SUBROUTINE FMWRITN2_ll
+ SUBROUTINE IO_WRITE_FIELD_BYNAME_N2(TPFILE,HNAME,HFIPRI,KRESP,KFIELD)
+ !
+ USE MODD_IO_ll, ONLY : TFILEDATA
+ !
+ !* 0.1 Declarations of arguments
+ !
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
+ CHARACTER(LEN=*), INTENT(IN) :: HFIPRI ! output file for error messages
+ INTEGER, INTENT(OUT):: KRESP ! return-code
+ INTEGER,DIMENSION(:,:), INTENT(IN) :: KFIELD ! array containing the data field
+ !
+ !* 0.2 Declarations of local variables
+ !
+ INTEGER :: ID ! Index of the field
+ !
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_N2','writing '//TRIM(HNAME))
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,KRESP)
+ !
+ IF(KRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),HFIPRI,KRESP,KFIELD)
+ !
+ END SUBROUTINE IO_WRITE_FIELD_BYNAME_N2
+
+
+ SUBROUTINE IO_WRITE_FIELD_BYFIELD_N2(TPFILE,TPFIELD,HFIPRI,KRESP,KFIELD)
+ USE MODD_IO_ll
+ USE MODD_PARAMETERS_ll,ONLY : JPHEXT
+ USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+ USE MODE_ALLOCBUFFER_ll
+ USE MODE_GATHER_ll
+ USE MODD_TIMEZ, ONLY : TIMEZ
+ USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+ CHARACTER(LEN=*), INTENT(IN) :: HFIPRI ! output file for error messages
+ INTEGER, INTENT(OUT):: KRESP ! return-code
+ INTEGER,DIMENSION(:,:),TARGET,INTENT(IN) :: KFIELD ! array containing the data field
+ !
+ !* 0.2 Declarations of local variables
+ !
+ CHARACTER(LEN=28) :: YFILEM ! FM-file name
+ CHARACTER(LEN=NMNHNAMELGTMAX) :: YRECFM ! name of the article to write
+ CHARACTER(LEN=2) :: YDIR ! field form
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ INTEGER :: IERR
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ INTEGER,DIMENSION(:,:),POINTER :: IFIELDP
+ LOGICAL :: GALLOC
+ !
+ !JUANZ
+ REAL*8,DIMENSION(2) :: T0,T1,T2
+ REAL*8,DIMENSION(2) :: T11,T22
+ !JUANZ
+ INTEGER :: IHEXTOT
+ !
+ YFILEM = TPFILE%CNAME
+ YRECFM = TPFIELD%CMNHNAME
+ YDIR = TPFIELD%CDIR
+ !
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_N2','writing '//TRIM(YRECFM))
+ !
+ !* 1.1 THE NAME OF LFIFM
+ !
+ CALL SECOND_MNH2(T11)
+ IRESP = 0
+ GALLOC = .FALSE.
+ YFNLFI=TRIM(ADJUSTL(YFILEM))//'.lfi'
+ !------------------------------------------------------------------
+ IHEXTOT = 2*JPHEXT+1
+ TZFD=>GETFD(YFNLFI)
+ IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==IHEXTOT .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
+ IFIELDP=>KFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1)
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,IFIELDP,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,IFIELDP,IRESP)
+ ! ELSE IF (LPACK .AND. L2D .AND. YDIR=='XY') THEN
+ ELSEIF (LPACK .AND. L2D .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
+ IFIELDP=>KFIELD(:,JPHEXT+1:JPHEXT+1)
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,IFIELDP,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,IFIELDP,IRESP)
+ ELSE
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,KFIELD,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,KFIELD,IRESP)
+ END IF
+ ELSE ! multiprocessor execution
+ CALL SECOND_MNH2(T0)
+ IF (ISP == TZFD%OWNER) THEN
+ ! I/O processor case
+ CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,YDIR,GALLOC)
+ ELSE
+ ALLOCATE(IFIELDP(0,0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ IF (YDIR == 'XX' .OR. YDIR =='YY') THEN
+ CALL GATHER_XXFIELD(YDIR,KFIELD,IFIELDP,TZFD%OWNER,TZFD%COMM)
+ ELSEIF (YDIR == 'XY') THEN
+ IF (LPACK .AND. L2D) THEN
+ CALL GATHER_XXFIELD('XX',KFIELD(:,JPHEXT+1),IFIELDP(:,1),TZFD%OWNER,TZFD%COMM)
+ ELSE
+ CALL GATHER_XYFIELD(KFIELD,IFIELDP,TZFD%OWNER,TZFD%COMM)
+ END IF
+ END IF
+ CALL SECOND_MNH2(T1)
+ TIMEZ%T_WRIT2D_GATH=TIMEZ%T_WRIT2D_GATH + T1 - T0
+ !
+ IF (ISP == TZFD%OWNER) THEN
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,IFIELDP,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,IFIELDP,IRESP)
+ END IF
+ CALL SECOND_MNH2(T2)
+ TIMEZ%T_WRIT2D_WRIT=TIMEZ%T_WRIT2D_WRIT + T2 - T1
+ !
+ CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
+ END IF
+ ELSE
+ IRESP = -61
+ END IF
+ !----------------------------------------------------------------
+ IF (IRESP.NE.0) THEN
+ CALL FM_WRIT_ERR("IO_WRITE_FIELD_BYFIELD_N2",YFILEM,HFIPRI,YRECFM,YDIR,TPFIELD%NGRID,LEN(TPFIELD%CCOMMENT),IRESP)
+ END IF
+ IF (GALLOC) DEALLOCATE(IFIELDP)
+ KRESP = IRESP
+ IF (ASSOCIATED(TZFD)) CALL MPI_BARRIER(TZFD%COMM,IERR)
+ CALL SECOND_MNH2(T22)
+ TIMEZ%T_WRIT2D_ALL=TIMEZ%T_WRIT2D_ALL + T22 - T11
+ !
+ END SUBROUTINE IO_WRITE_FIELD_BYFIELD_N2
+
+
SUBROUTINE FMWRITL0_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,&
KLENCH,HCOMMENT,KRESP)
USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
diff --git a/src/LIB/SURCOUCHE/src/io_write_field.f90 b/src/LIB/SURCOUCHE/src/io_write_field.f90
index 61f1cc9fb..c6a87e78c 100644
--- a/src/LIB/SURCOUCHE/src/io_write_field.f90
+++ b/src/LIB/SURCOUCHE/src/io_write_field.f90
@@ -135,6 +135,19 @@ DO JI = 1,SIZE(TPOUTPUT%NFIELDLIST)
END IF
CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TFIELDLIST(IDX),HFIPRI,IRESP,TFIELDLIST(IDX)%TFIELD_X2D(IMI)%DATA)
!
+ !2D integer
+ !
+ CASE (TYPEINT)
+ IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_N2D) ) THEN
+ PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_N2D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
+ STOP
+ END IF
+ IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_N2D(IMI)%DATA) ) THEN
+ PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_N2D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
+ STOP
+ END IF
+ CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TFIELDLIST(IDX),HFIPRI,IRESP,TFIELDLIST(IDX)%TFIELD_N2D(IMI)%DATA)
+ !
!2D other types
!
CASE DEFAULT
diff --git a/src/LIB/SURCOUCHE/src/mode_netcdf.f90 b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
index 81c3a1396..bc0736233 100644
--- a/src/LIB/SURCOUCHE/src/mode_netcdf.f90
+++ b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
@@ -25,7 +25,7 @@ INTEGER(KIND=IDCDF_KIND),PARAMETER :: DEFLATE = 1
INTERFACE IO_WRITE_FIELD_NC4
MODULE PROCEDURE IO_WRITE_FIELD_NC4_X0,IO_WRITE_FIELD_NC4_X1, &
IO_WRITE_FIELD_NC4_X2,IO_WRITE_FIELD_NC4_X3, &
- IO_WRITE_FIELD_NC4_N0, &
+ IO_WRITE_FIELD_NC4_N0,IO_WRITE_FIELD_NC4_N2, &
IO_WRITE_FIELD_NC4_C0, &
IO_WRITE_FIELD_NC4_T0
END INTERFACE IO_WRITE_FIELD_NC4
@@ -1213,6 +1213,68 @@ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITN2[NF90_PUT_VAR
KRESP = IRESP
END SUBROUTINE NCWRITN2
+SUBROUTINE IO_WRITE_FIELD_NC4_N2(TPFILE,TPFIELD,PZCDF,KFIELD,KRESP)
+!
+TYPE(TFILEDATA),TARGET,INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+TYPE(IOCDF), POINTER :: PZCDF
+INTEGER,DIMENSION(:,:),INTENT(IN) :: KFIELD ! array containing the data field
+INTEGER, INTENT(OUT):: KRESP
+!
+INTEGER(KIND=IDCDF_KIND) :: STATUS
+INTEGER(KIND=IDCDF_KIND) :: INCID
+CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
+INTEGER(KIND=IDCDF_KIND) :: IVARID
+INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(KFIELD))) :: IVDIMS
+INTEGER :: IRESP
+!
+IRESP = 0
+
+YVARNAME = TRIM(TPFIELD%CMNHNAME)
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_NC4_N2','writing '//TRIM(YVARNAME))
+!
+! Get the Netcdf file ID
+INCID = TPFILE%NNCID
+! NetCDF var names can't contain '%' nor '.'
+YVARNAME = str_replace(YVARNAME, '%', '__')
+YVARNAME = str_replace(YVARNAME, '.', '--')
+
+! The variable should not already exist but who knows ?
+STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (STATUS /= NF90_NOERR) THEN
+ IF (SIZE(KFIELD)==0) THEN
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_NC4_N2','ignoring variable with a zero size ('//TRIM(YVARNAME)//')')
+ RETURN
+ END IF
+
+ ! Get the netcdf dimensions
+ CALL FILLVDIMS(PZCDF, INT(SHAPE(KFIELD),KIND=IDCDF_KIND), TPFIELD%CDIR, IVDIMS)
+
+ ! Define the variable
+#ifndef MNH_INT8
+ STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT, IVDIMS, IVARID)
+#else
+ STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT64, IVDIMS, IVARID)
+#endif
+ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_N2[NF90_DEF_VAR]')
+ ! Add compression if asked for
+ IF (TPFILE%LNCCOMPRESS) THEN
+ STATUS = NF90_DEF_VAR_DEFLATE(INCID, IVARID, SHUFFLE, DEFLATE, TPFILE%NNCCOMPRESS_LEVEL)
+ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_N2[NF90_DEF_VAR_DEFLATE]')
+ END IF
+ CALL IO_WRITE_FIELD_ATTR_NC4(TPFIELD,INCID,IVARID)
+ELSE
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_NC4_N2',TRIM(YVARNAME)//' already defined')
+END IF
+
+! Write the data
+STATUS = NF90_PUT_VAR(INCID, IVARID, KFIELD)
+IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_N2[NF90_PUT_VAR] '//TRIM(TPFIELD%CMNHNAME),IRESP)
+
+KRESP = IRESP
+END SUBROUTINE IO_WRITE_FIELD_NC4_N2
+
SUBROUTINE NCWRITC0(PZCDF, HVARNAME, HDIR, HFIELD, TPFMH, KRESP)
USE MODD_FM, ONLY : FMHEADER
TYPE(IOCDF), POINTER :: PZCDF
--
GitLab