From a1a2771e2c1e377b9c1395740740ebef85925ca4 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Fri, 2 Dec 2016 15:57:40 +0100
Subject: [PATCH] Philippe 02/12/2016: IO: * added IO_WRITE_FIELD_BYNAME_C0 and
IO_WRITE_FIELD_BYFIELD_C0 subroutines to IO_WRITE_FIELD interface * added
IO_WRITE_FIELD_LFI_C0 subroutine to IO_WRITE_FIELD_LFI interface * added
IO_WRITE_FIELD_NC4_C0 subroutine to IO_WRITE_FIELD_NC4 interface * added 4
new fields to TFIELDLIST * added check at beginning of INI_FIELD_LIST
---
src/LIB/SURCOUCHE/src/fmreadwrit.f90 | 42 +++++++++++++-
src/LIB/SURCOUCHE/src/fmwrit_ll.f90 | 82 +++++++++++++++++++++++++--
src/LIB/SURCOUCHE/src/mode_field.f90 | 62 +++++++++++++++++++-
src/LIB/SURCOUCHE/src/mode_netcdf.f90 | 57 ++++++++++++++++++-
src/MNH/write_lfin.f90 | 30 ++--------
5 files changed, 238 insertions(+), 35 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/fmreadwrit.f90 b/src/LIB/SURCOUCHE/src/fmreadwrit.f90
index 3fa283b5b..8c8976f74 100644
--- a/src/LIB/SURCOUCHE/src/fmreadwrit.f90
+++ b/src/LIB/SURCOUCHE/src/fmreadwrit.f90
@@ -264,7 +264,8 @@ PRIVATE
!
INTERFACE IO_WRITE_FIELD_LFI
MODULE PROCEDURE IO_WRITE_FIELD_LFI_X2,IO_WRITE_FIELD_LFI_X3, &
- IO_WRITE_FIELD_LFI_N0
+ IO_WRITE_FIELD_LFI_N0, &
+ IO_WRITE_FIELD_LFI_C0
END INTERFACE IO_WRITE_FIELD_LFI
!
PUBLIC IO_WRITE_FIELD_LFI
@@ -376,6 +377,45 @@ IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
END SUBROUTINE IO_WRITE_FIELD_LFI_N0
!
+SUBROUTINE IO_WRITE_FIELD_LFI_C0(TPFIELD,KFLU,HFIELD,KRESP)
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+!
+TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+INTEGER, INTENT(IN) :: KFLU ! Fortran Logical Unit
+CHARACTER(LEN=*), INTENT(IN) :: HFIELD ! array containing the data field
+INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
+!
+!* 0.2 Declarations of local variables
+!
+INTEGER :: ILENG, JLOOP
+INTEGER(kind=LFI_INT) :: IRESP, ITOTAL
+INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
+!
+ILENG=LEN_TRIM(HFIELD)
+IF (ILENG==0) ILENG=1
+!
+CALL WRITE_PREPARE(TPFIELD,ILENG,IWORK,ITOTAL,IRESP)
+!
+IF (IRESP==0) THEN
+ IF (ILENG==0) THEN
+ IWORK(LEN_TRIM(TPFIELD%CCOMMENT)+3)=IACHAR(' ')
+ ELSE
+ DO JLOOP=1,ILENG
+ IWORK(LEN_TRIM(TPFIELD%CCOMMENT)+2+JLOOP)=IACHAR(HFIELD(JLOOP:JLOOP))
+ END DO
+ END IF
+ CALL LFIECR(IRESP,KFLU,TPFIELD%CMNHNAME,IWORK,ITOTAL)
+ENDIF
+!
+KRESP=IRESP
+!
+IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
+!
+END SUBROUTINE IO_WRITE_FIELD_LFI_C0
+!
SUBROUTINE WRITE_PREPARE(TPFIELD,KLENG,KWORK,KTOTAL,KRESP)
!
TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
diff --git a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90 b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
index c3c9af212..6c3bf2145 100644
--- a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
+++ b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
@@ -179,8 +179,10 @@ MODULE MODE_FMWRIT
PRIVATE
INTERFACE IO_WRITE_FIELD
- MODULE PROCEDURE IO_WRITE_FIELD_BYNAME_N0, IO_WRITE_FIELD_BYNAME_X3, &
- IO_WRITE_FIELD_BYFIELD_N0,IO_WRITE_FIELD_BYFIELD_X3
+ MODULE PROCEDURE IO_WRITE_FIELD_BYNAME_N0, IO_WRITE_FIELD_BYNAME_X3, &
+ IO_WRITE_FIELD_BYNAME_C0, &
+ IO_WRITE_FIELD_BYFIELD_N0,IO_WRITE_FIELD_BYFIELD_X3, &
+ IO_WRITE_FIELD_BYFIELD_C0
END INTERFACE
INTERFACE FMWRIT
@@ -1733,10 +1735,6 @@ CONTAINS
!
IDIMS(1) = 0
!
- !JUANZIO
- !----------------------------------------------------------------
- !
- !* 1.1 THE NAME OF LFIFM
!
IRESP = 0
!------------------------------------------------------------------
@@ -2194,6 +2192,78 @@ CONTAINS
KRESP = IRESP
END SUBROUTINE FMWRITC0_ll
+ SUBROUTINE IO_WRITE_FIELD_BYNAME_C0(TPFILE,HNAME,HFIPRI,KRESP,HFIELD)
+ !
+ 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
+ CHARACTER(LEN=*), INTENT(IN) :: HFIELD ! 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,HFIELD)
+ !
+ END SUBROUTINE IO_WRITE_FIELD_BYNAME_C0
+
+ SUBROUTINE IO_WRITE_FIELD_BYFIELD_C0(TPFILE,TPFIELD,HFIPRI,KRESP,HFIELD)
+ USE MODD_IO_ll
+ USE MODD_FM
+ USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+ !* 0. DECLARATIONS
+ ! ------------
+ !
+ !
+ !* 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
+ CHARACTER(LEN=*), INTENT(IN) :: HFIELD ! array containing the data field
+ !
+ !* 0.2 Declarations of local variables
+ !
+ INTEGER :: IERR
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ INTEGER,DIMENSION(1) :: IDIMS
+ !
+ IRESP = 0
+ !
+ !------------------------------------------------------------------
+ TZFD=>GETFD(TRIM(ADJUSTL(TPFILE%CNAME))//'.lfi')
+ IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,HFIELD,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFIELD,TZFD%CDF,HFIELD,IRESP)
+ ELSE
+ IF (ISP == TZFD%OWNER) THEN
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,HFIELD,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFIELD,TZFD%CDF,HFIELD,IRESP)
+ END IF
+ !
+ 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_C0",TPFILE%CNAME,HFIPRI,TPFIELD%CMNHNAME,TPFIELD%CDIR,TPFIELD%NGRID,&
+ LEN(TPFIELD%CCOMMENT) ,IRESP)
+ END IF
+ KRESP = IRESP
+ END SUBROUTINE IO_WRITE_FIELD_BYFIELD_C0
+
SUBROUTINE FMWRITC1_ll(HFILEM,HRECFM,HFIPRI,HDIR,HFIELD,KGRID,&
KLENCH,HCOMMENT,KRESP)
USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
diff --git a/src/LIB/SURCOUCHE/src/mode_field.f90 b/src/LIB/SURCOUCHE/src/mode_field.f90
index 4711e14b5..766e989c8 100644
--- a/src/LIB/SURCOUCHE/src/mode_field.f90
+++ b/src/LIB/SURCOUCHE/src/mode_field.f90
@@ -6,7 +6,7 @@ MODULE MODE_FIELD
!
IMPLICIT NONE
!
-INTEGER,PRIVATE,PARAMETER :: MAXFIELDS = 2
+INTEGER,PRIVATE,PARAMETER :: MAXFIELDS = 6
INTEGER,PARAMETER :: TYPEUNDEF = -1, TYPEINT = 1, TYPELOG = 2, TYPEREAL = 3, TYPECHAR = 4
!
!Structure describing the characteristics of a field
@@ -34,8 +34,45 @@ INTEGER :: IDX
!F2003:
!TFIELDLIST(1) = TFIELDDATA(CMNHNAME='UT',CSTDNAME='x_wind',CUNITS='m s-1',CDIR='XY',&
! CCOMMENT='X_Y_Z_U component of wind (m/s)',NGRID=2)
+!
+IF (LFIELDLIST_ISINIT) THEN
+ PRINT *,'ERROR: INI_FIELD_LIST already called'
+ RETURN
+END IF
+LFIELDLIST_ISINIT = .TRUE.
+!
IDX = 1
!
+TFIELDLIST(IDX)%CMNHNAME = 'BIBUSER'
+TFIELDLIST(IDX)%CSTDNAME = ''
+TFIELDLIST(IDX)%CLONGNAME = 'MesoNH: user binary library'
+TFIELDLIST(IDX)%CUNITS = ''
+TFIELDLIST(IDX)%CDIR = ''
+TFIELDLIST(IDX)%CCOMMENT = ''
+TFIELDLIST(IDX)%NGRID = 0
+TFIELDLIST(IDX)%NTYPE = TYPECHAR
+IDX = IDX+1
+!
+TFIELDLIST(IDX)%CMNHNAME = 'BUGFIX'
+TFIELDLIST(IDX)%CSTDNAME = ''
+TFIELDLIST(IDX)%CLONGNAME = 'MesoNH bugfix number'
+TFIELDLIST(IDX)%CUNITS = ''
+TFIELDLIST(IDX)%CDIR = ''
+TFIELDLIST(IDX)%CCOMMENT = ''
+TFIELDLIST(IDX)%NGRID = 0
+TFIELDLIST(IDX)%NTYPE = TYPEINT
+IDX = IDX+1
+!
+TFIELDLIST(IDX)%CMNHNAME = 'FILETYPE'
+TFIELDLIST(IDX)%CSTDNAME = ''
+TFIELDLIST(IDX)%CLONGNAME = 'Type of this file for MesoNH'
+TFIELDLIST(IDX)%CUNITS = ''
+TFIELDLIST(IDX)%CDIR = ''
+TFIELDLIST(IDX)%CCOMMENT = ''
+TFIELDLIST(IDX)%NGRID = 0
+TFIELDLIST(IDX)%NTYPE = TYPECHAR
+IDX = IDX+1
+!
TFIELDLIST(IDX)%CMNHNAME = 'MASDEV'
TFIELDLIST(IDX)%CSTDNAME = ''
TFIELDLIST(IDX)%CLONGNAME = 'MesoNH version (without bugfix)'
@@ -56,8 +93,29 @@ TFIELDLIST(IDX)%NGRID = 2
TFIELDLIST(IDX)%NTYPE = TYPEREAL
IDX = IDX+1
!
-LFIELDLIST_ISINIT = .TRUE.
+TFIELDLIST(IDX)%CMNHNAME = 'PROGRAM'
+TFIELDLIST(IDX)%CSTDNAME = ''
+TFIELDLIST(IDX)%CLONGNAME = 'MesoNH family: used program'
+TFIELDLIST(IDX)%CUNITS = ''
+TFIELDLIST(IDX)%CDIR = ''
+TFIELDLIST(IDX)%CCOMMENT = ''
+TFIELDLIST(IDX)%NGRID = 0
+TFIELDLIST(IDX)%NTYPE = TYPECHAR
+IDX = IDX+1
!
+#if 0
+!
+TFIELDLIST(IDX)%CMNHNAME = ''
+TFIELDLIST(IDX)%CSTDNAME = ''
+TFIELDLIST(IDX)%CLONGNAME = ''
+TFIELDLIST(IDX)%CUNITS = ''
+TFIELDLIST(IDX)%CDIR = ''
+TFIELDLIST(IDX)%CCOMMENT = ''
+TFIELDLIST(IDX)%NGRID =
+TFIELDLIST(IDX)%NTYPE =
+IDX = IDX+1
+#endif
+
END SUBROUTINE INI_FIELD_LIST
!
SUBROUTINE FIND_FIELD_ID_FROM_MNHNAME(HMNHNAME,KID,KRESP)
diff --git a/src/LIB/SURCOUCHE/src/mode_netcdf.f90 b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
index 7a6635dab..942889451 100644
--- a/src/LIB/SURCOUCHE/src/mode_netcdf.f90
+++ b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
@@ -19,7 +19,8 @@ PRIVATE
INTERFACE IO_WRITE_FIELD_NC4
MODULE PROCEDURE IO_WRITE_FIELD_NC4_X2,IO_WRITE_FIELD_NC4_X3, &
- IO_WRITE_FIELD_NC4_N0
+ IO_WRITE_FIELD_NC4_N0, &
+ IO_WRITE_FIELD_NC4_C0
END INTERFACE IO_WRITE_FIELD_NC4
INTERFACE NCWRIT
@@ -1102,6 +1103,60 @@ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITC0[NF90_PUT_VAR
KRESP = IRESP
END SUBROUTINE NCWRITC0
+SUBROUTINE IO_WRITE_FIELD_NC4_C0(TPFIELD,PZCDF,HFIELD,KRESP)
+!
+USE MODD_FM, ONLY : FMHEADER
+!
+TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+TYPE(IOCDF), POINTER :: PZCDF
+CHARACTER(LEN=*), INTENT(IN) :: HFIELD
+INTEGER, INTENT(OUT):: KRESP
+!
+INTEGER,PARAMETER :: IMULT = 16
+!
+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(1) :: IVDIMS
+INTEGER :: IRESP, ILEN
+!
+IRESP = 0
+
+!Store the character string in a string of a size multiple of IMULT
+!This is done to limit the number of dimensions in the netCDF file
+ILEN = ((LEN_TRIM(HFIELD)+IMULT-1)/IMULT)*IMULT
+IF (MOD(ILEN,IMULT)/=0) PRINT *,'ERROR: IO_WRITE_FIELD_NC4_C0: ILEN is not a multiple of IMULT'
+!If the string is empty, create it anyway with a non-zero size (to prevent problems later)
+IF (ILEN==0) ILEN = IMULT
+
+! Get the Netcdf file ID
+INCID = PZCDF%NCID
+
+! NetCDF var names can't contain '%' nor '.'
+YVARNAME = str_replace(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
+ ! Get the netcdf string dimensions id
+ IVDIMS(1) = GETSTRDIMID(PZCDF,INT(ILEN,KIND=IDCDF_KIND))
+ ! Define the variable
+ STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_CHAR, IVDIMS, IVARID)
+ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_C0[NF90_DEF_VAR]')
+ CALL IO_WRITE_FIELD_ATTR_NC4(TPFIELD,INCID,IVARID)
+ELSE
+ PRINT *,'IO_WRITE_FIELD_NC4_N0: ', TRIM(YVARNAME), ' already defined !'
+END IF
+
+! Write the data
+STATUS = NF90_PUT_VAR(INCID, IVARID, HFIELD)
+IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_C0[NF90_PUT_VAR] '//TRIM(TPFIELD%CMNHNAME),IRESP)
+
+KRESP = IRESP
+END SUBROUTINE IO_WRITE_FIELD_NC4_C0
+
SUBROUTINE NCWRITC1(PZCDF, HVARNAME, HDIR, HFIELD, TPFMH, KRESP)
USE MODD_FM, ONLY : FMHEADER
TYPE(IOCDF), POINTER :: PZCDF
diff --git a/src/MNH/write_lfin.f90 b/src/MNH/write_lfin.f90
index 6cb46c59d..67f406f17 100644
--- a/src/MNH/write_lfin.f90
+++ b/src/MNH/write_lfin.f90
@@ -350,31 +350,11 @@ IKE=IKU-JPVEXT
!
YDIR='--'
!
-CALL IO_WRITE_FIELD(TPFILE,'MASDEV',CLUOUT,IRESP,NMASDEV)
-!
-YRECFM='BUGFIX'
-YCOMMENT=' '
-IGRID=0
-ILENCH=LEN(YCOMMENT)
-CALL FMWRIT(YFMFILE,YRECFM,CLUOUT,YDIR,NBUGFIX,IGRID,ILENCH,YCOMMENT,IRESP)
-!
-YRECFM='BIBUSER'
-YCOMMENT=' '
-IGRID=0
-ILENCH=LEN(YCOMMENT)
-CALL FMWRIT(YFMFILE,YRECFM,CLUOUT,YDIR,CBIBUSER,IGRID,ILENCH,YCOMMENT,IRESP)
-!
-YRECFM='PROGRAM'
-YCOMMENT=' '
-IGRID=0
-ILENCH=LEN(YCOMMENT)
-CALL FMWRIT(YFMFILE,YRECFM,CLUOUT,YDIR,CPROGRAM,IGRID,ILENCH,YCOMMENT,IRESP)
-!
-YRECFM='FILETYPE'
-YCOMMENT=' '
-IGRID=0
-ILENCH=LEN(YCOMMENT)
-CALL FMWRIT(YFMFILE,YRECFM,CLUOUT,YDIR,TPFILE%CTYPE,IGRID,ILENCH,YCOMMENT,IRESP)
+CALL IO_WRITE_FIELD(TPFILE,'MASDEV', CLUOUT,IRESP,NMASDEV)
+CALL IO_WRITE_FIELD(TPFILE,'BUGFIX', CLUOUT,IRESP,NBUGFIX)
+CALL IO_WRITE_FIELD(TPFILE,'BIBUSER', CLUOUT,IRESP,CBIBUSER)
+CALL IO_WRITE_FIELD(TPFILE,'PROGRAM', CLUOUT,IRESP,CPROGRAM)
+CALL IO_WRITE_FIELD(TPFILE,'FILETYPE',CLUOUT,IRESP,TPFILE%CTYPE)
!
YRECFM='MY_NAME'
YCOMMENT=' '
--
GitLab