Philippe 06/01/2017: IO:

* added IO_WRITE_FIELD_BYNAME_X1 and IO_WRITE_FIELD_BYFIELD_X1
  to the IO_WRITE_FIELD interface
* added IO_WRITE_FIELD_LFI_X1 subroutine to the IO_WRITE_FIELD_LFI interface
* added IO_WRITE_FIELD_NC4_X1 subroutine to the IO_WRITE_FIELD_NC4 interface

src/LIB/SURCOUCHE/src/fmreadwrit.f90

@@ -263,7 +263,7 @@ IMPLICIT NONE
 PRIVATE
 !
 INTERFACE IO_WRITE_FIELD_LFI
-   MODULE PROCEDURE IO_WRITE_FIELD_LFI_X0,                       &
+   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_C0
@@ -305,6 +305,38 @@ IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
 !
 END SUBROUTINE IO_WRITE_FIELD_LFI_X0
 !
+SUBROUTINE IO_WRITE_FIELD_LFI_X1(TPFIELD,KFLU,PFIELD,KRESP)
+!
+IMPLICIT NONE
+!
+!*      0.1   Declarations of arguments
+!
+TYPE(TFIELDDATA),      INTENT(IN) :: TPFIELD
+INTEGER,               INTENT(IN) :: KFLU   ! Fortran Logical Unit
+REAL,DIMENSION(:),     INTENT(IN) :: PFIELD ! 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
+!
+ILENG = SIZE(PFIELD)
+!
+CALL WRITE_PREPARE(TPFIELD,ILENG,IWORK,ITOTAL,IRESP)
+!
+IF (IRESP==0) THEN
+  CALL TRANSFW(IWORK(LEN_TRIM(TPFIELD%CCOMMENT)+3),PFIELD,ILENG)
+  CALL LFIECR(IRESP,KFLU,TRIM(TPFIELD%CMNHNAME),IWORK,ITOTAL)
+ENDIF
+!
+KRESP=IRESP
+!
+IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
+!
+END SUBROUTINE IO_WRITE_FIELD_LFI_X1
+!
 SUBROUTINE IO_WRITE_FIELD_LFI_X2(TPFIELD,KFLU,PFIELD,KRESP,KVERTLEVEL)
 !
 IMPLICIT NONE

src/LIB/SURCOUCHE/src/fmwrit_ll.f90

@@ -179,12 +179,12 @@ MODULE MODE_FMWRIT
   PRIVATE
 
   INTERFACE IO_WRITE_FIELD
-     MODULE PROCEDURE IO_WRITE_FIELD_BYNAME_X0,                            &
+     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_L0,                            &
                       IO_WRITE_FIELD_BYNAME_C0,                            &
-                      IO_WRITE_FIELD_BYFIELD_X0,                           &
+                      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_L0,                           &
@@ -522,6 +522,108 @@ CONTAINS
     KRESP = IRESP
   END SUBROUTINE FMWRITX1_ll
 
+  SUBROUTINE IO_WRITE_FIELD_BYNAME_X1(TPFILE,HNAME,HFIPRI,KRESP,PFIELD)
+    !
+    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 
+    REAL,DIMENSION(:),         INTENT(IN) :: PFIELD   ! array containing the data field
+    !
+    !*      0.2   Declarations of local variables
+    !
+    INTEGER :: ID ! Index of the field
+    !
+    CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,KRESP)
+    !
+    IF(KRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),HFIPRI,KRESP,PFIELD)
+    !
+  END SUBROUTINE IO_WRITE_FIELD_BYNAME_X1
+
+  SUBROUTINE IO_WRITE_FIELD_BYFIELD_X1(TPFILE,TPFIELD,HFIPRI,KRESP,PFIELD)
+    USE MODD_IO_ll
+    USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+    USE MODE_ALLOCBUFFER_ll
+    USE MODE_GATHER_ll
+    USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_FIND_BYNAME
+    !
+    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 
+    REAL,DIMENSION(:),TARGET,    INTENT(IN) :: PFIELD   ! 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
+    REAL,DIMENSION(:),POINTER                :: ZFIELDP
+    LOGICAL                                  :: GALLOC
+    !
+    INTEGER                                  :: IK_FILE,IK_RANK
+    CHARACTER(len=5)                         :: YK_FILE  
+    CHARACTER(len=128)                       :: YFILE_IOZ  
+    TYPE(FD_ll), POINTER                     :: TZFD_IOZ 
+    TYPE(TFILEDATA),POINTER                  :: TZFILE
+    !
+    YFILEM   = TPFILE%CNAME
+    YRECFM   = TPFIELD%CMNHNAME
+    YDIR     = TPFIELD%CDIR
+    !
+    !*      1.1   THE NAME OF LFIFM
+    !
+    IRESP = 0
+    GALLOC = .FALSE.
+    YFNLFI=TRIM(ADJUSTL(YFILEM))//'.lfi'
+    !------------------------------------------------------------------
+    TZFD=>GETFD(YFNLFI)
+    IF (ASSOCIATED(TZFD)) THEN
+       IF (GSMONOPROC) THEN ! sequential execution
+          IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,PFIELD,IRESP)
+          IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,PFIELD,IRESP)
+       ELSE ! multiprocessor execution
+          IF (ISP == TZFD%OWNER)  THEN
+             CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,YDIR,GALLOC)
+          ELSE
+             ALLOCATE(ZFIELDP(0))
+             GALLOC = .TRUE.
+          END IF
+          !
+          IF (YDIR == 'XX' .OR. YDIR =='YY') THEN
+             CALL GATHER_XXFIELD(YDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
+          END IF
+          !
+          IF (ISP == TZFD%OWNER)  THEN
+             IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,ZFIELDP,IRESP)
+             IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,ZFIELDP,IRESP)
+          END IF
+          !
+          CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
+       END IF ! multiprocessor execution
+    ELSE
+       IRESP = -61
+    END IF
+    !----------------------------------------------------------------
+    IF (IRESP.NE.0) THEN
+       CALL FM_WRIT_ERR("IO_WRITE_FIELD_BYFIELD_X1",YFILEM,HFIPRI,YRECFM,YDIR,TPFIELD%NGRID,LEN(TPFIELD%CCOMMENT),IRESP)
+    END IF
+    IF (GALLOC) DEALLOCATE(ZFIELDP)
+    KRESP = IRESP
+  END SUBROUTINE IO_WRITE_FIELD_BYFIELD_X1
+
   SUBROUTINE FMWRITX2_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
        KLENCH,HCOMMENT,KRESP)
     USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT,LPACK,L1D,L2D

src/LIB/SURCOUCHE/src/mode_netcdf.f90

@@ -22,7 +22,7 @@ INTEGER(KIND=IDCDF_KIND),PARAMETER :: SHUFFLE = 1 !Set to 1 for (usually) better
 INTEGER(KIND=IDCDF_KIND),PARAMETER :: DEFLATE = 1
 
 INTERFACE IO_WRITE_FIELD_NC4
-   MODULE PROCEDURE IO_WRITE_FIELD_NC4_X0,                       &
+   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_C0
@@ -540,6 +540,67 @@ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX1[NF90_PUT_VAR
 KRESP = IRESP
 END SUBROUTINE NCWRITX1
 
+SUBROUTINE IO_WRITE_FIELD_NC4_X1(TPFILE,TPFIELD,PZCDF,PFIELD,KRESP)
+!
+USE MODD_FM, ONLY : FMHEADER
+USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_FIND_BYNAME
+!
+TYPE(TFILEDATA),TARGET,INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA),      INTENT(IN) :: TPFIELD
+TYPE(IOCDF), POINTER              :: PZCDF
+REAL,DIMENSION(:),     INTENT(IN) :: PFIELD   ! array containing the data field
+INTEGER,               INTENT(OUT):: KRESP
+!
+INTEGER(KIND=IDCDF_KIND) :: STATUS
+INTEGER(KIND=IDCDF_KIND) :: INCID
+CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)+4) :: YVARNAME
+INTEGER(KIND=IDCDF_KIND) :: IVARID
+INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(PFIELD))) :: IVDIMS
+INTEGER                  :: IRESP
+!
+IRESP = 0
+! Get the Netcdf file ID
+INCID = TPFILE%NNCID
+
+! NetCDF var names can't contain '%' nor '.' 
+YVARNAME = str_replace(TRIM(TPFIELD%CMNHNAME), '%', '__')
+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(PFIELD)==0) THEN
+     PRINT *,'WARNING: IO_WRITE_FIELD_NC4_X1: ignoring variable with a zero size (',TRIM(YVARNAME),')'
+     RETURN
+   END IF
+
+   ! Get the netcdf dimensions
+   CALL FILLVDIMS(PZCDF, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), TPFIELD%CDIR, IVDIMS)
+
+   ! Define the variable 
+   IF (TPFILE%LNCREDUCE_FLOAT_PRECISION) THEN
+     STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT,  IVDIMS, IVARID)
+   ELSE
+     STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVDIMS, IVARID)
+   END IF
+   IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_X1[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_X1[NF90_DEF_VAR_DEFLATE]')
+   END IF
+   CALL IO_WRITE_FIELD_ATTR_NC4(TPFIELD,INCID,IVARID)
+ELSE
+   PRINT *,'IO_WRITE_FIELD_NC4_X1: ', TRIM(YVARNAME), ' already defined !'
+END IF
+
+! Write the data
+STATUS = NF90_PUT_VAR(INCID, IVARID, PFIELD)
+IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_X1[NF90_PUT_VAR] '//TRIM(TPFIELD%CMNHNAME),IRESP)
+ 
+KRESP = IRESP
+END SUBROUTINE IO_WRITE_FIELD_NC4_X1
+
 SUBROUTINE NCWRITX2(PZCDF, HVARNAME, HDIR, PFIELD, TPFMH, KRESP)
 USE MODD_FM, ONLY : FMHEADER
 TYPE(IOCDF), POINTER             :: PZCDF