diff --git a/src/LIB/SURCOUCHE/src/fmreadwrit.f90 b/src/LIB/SURCOUCHE/src/fmreadwrit.f90 index 559073125266aedff0a830ff751078db5f0e0899..3e2336426bb046115fa5a15b864e8928b90f0996 100644 --- a/src/LIB/SURCOUCHE/src/fmreadwrit.f90 +++ b/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 diff --git a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90 b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90 index 263f74c4e3a173374739a7100c23abbabf5ca42e..65ca9d642d2814e5470bdb502816d2d4d420042d 100644 --- a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90 +++ b/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 diff --git a/src/LIB/SURCOUCHE/src/mode_netcdf.f90 b/src/LIB/SURCOUCHE/src/mode_netcdf.f90 index 72b21af17624dccd2d9528e627655d99a87931eb..ef8ecc012fe78e69a89392fee328e1c867c5f9ea 100644 --- a/src/LIB/SURCOUCHE/src/mode_netcdf.f90 +++ b/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