From 6a0c11cce7537b4608881728f8fb895d74f7c941 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Thu, 16 Mar 2017 16:51:18 +0100
Subject: [PATCH] Philippe 16/03/2017: IO: added writing of 1D array of
character strings * added IO_WRITE_FIELD_BYNAME_C1 and
IO_WRITE_FIELD_BYFIELD_C1 subroutines to IO_WRITE_FIELD procedure * added
IO_WRITE_FIELD_NC4_C1 subroutine to IO_WRITE_FIELD_NC4 procedure
---
src/LIB/SURCOUCHE/src/fmwrit_ll.f90 | 104 +++++++++++++++++++++++++-
src/LIB/SURCOUCHE/src/mode_netcdf.f90 | 53 ++++++++++++-
2 files changed, 154 insertions(+), 3 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90 b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
index a6006a90f..5ce0e5111 100644
--- a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
+++ b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
@@ -184,14 +184,14 @@ MODULE MODE_FMWRIT
IO_WRITE_FIELD_BYNAME_N0, IO_WRITE_FIELD_BYNAME_N1, &
IO_WRITE_FIELD_BYNAME_N2, &
IO_WRITE_FIELD_BYNAME_L0, IO_WRITE_FIELD_BYNAME_L1, &
- IO_WRITE_FIELD_BYNAME_C0, &
+ IO_WRITE_FIELD_BYNAME_C0, IO_WRITE_FIELD_BYNAME_C1, &
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_N1, &
IO_WRITE_FIELD_BYFIELD_N2, &
IO_WRITE_FIELD_BYFIELD_L0,IO_WRITE_FIELD_BYFIELD_L1, &
- IO_WRITE_FIELD_BYFIELD_C0, &
+ IO_WRITE_FIELD_BYFIELD_C0,IO_WRITE_FIELD_BYFIELD_C1, &
IO_WRITE_FIELD_BYFIELD_T0
END INTERFACE
@@ -3120,6 +3120,7 @@ CONTAINS
TYPE(FMHEADER) :: TZFMH
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','FMWRITC1_ll','writing '//TRIM(HRECFM))
+ !
!----------------------------------------------------------------
!* 1.1 THE NAME OF LFIFM
!
@@ -3176,6 +3177,105 @@ CONTAINS
KRESP = IRESP
END SUBROUTINE FMWRITC1_ll
+ SUBROUTINE IO_WRITE_FIELD_BYNAME_C1(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=*),DIMENSION(:),INTENT(IN) :: HFIELD ! 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_C1','writing '//TRIM(HNAME))
+ !
+ 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_C1
+
+ SUBROUTINE IO_WRITE_FIELD_BYFIELD_C1(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=*),DIMENSION(:),INTENT(IN) :: HFIELD ! array containing the data field
+ !
+ !* 0.2 Declarations of local variables
+ !
+ INTEGER :: IERR
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ INTEGER :: J,JJ
+ INTEGER :: ILE, IP
+ INTEGER,DIMENSION(:),ALLOCATABLE :: IFIELD
+ INTEGER :: ILENG
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_C1','writing '//TRIM(TPFIELD%CMNHNAME))
+ !
+ IRESP = 0
+ !
+ IF(LLFIOUT) THEN
+ ILE=LEN(HFIELD)
+ IP=SIZE(HFIELD)
+ ILENG=ILE*IP
+ !
+ IF (ILENG==0) THEN
+ IP=1
+ ILE=1
+ ILENG=1
+ ALLOCATE(IFIELD(1))
+ IFIELD(1)=IACHAR(' ')
+ ELSE
+ ALLOCATE(IFIELD(ILENG))
+ DO JJ=1,IP
+ DO J=1,ILE
+ IFIELD(ILE*(JJ-1)+J)=IACHAR(HFIELD(JJ)(J:J))
+ END DO
+ END DO
+ END IF
+ END IF
+ !------------------------------------------------------------------
+ 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,IFIELD,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,HFIELD,IRESP)
+ ELSE
+ IF (ISP == TZFD%OWNER) THEN
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,IFIELD,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,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_C1",TPFILE%CNAME,HFIPRI,TPFIELD%CMNHNAME,TPFIELD%CDIR,TPFIELD%NGRID,&
+ LEN(TPFIELD%CCOMMENT) ,IRESP)
+ END IF
+ IF (ALLOCATED(IFIELD)) DEALLOCATE(IFIELD)
+ KRESP = IRESP
+ END SUBROUTINE IO_WRITE_FIELD_BYFIELD_C1
+
SUBROUTINE FMWRITT0_ll(HFILEM,HRECFM,HFIPRI,HDIR,TFIELD,KGRID,&
KLENCH,HCOMMENT,KRESP)
USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
diff --git a/src/LIB/SURCOUCHE/src/mode_netcdf.f90 b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
index 80a995125..301f0fd01 100644
--- a/src/LIB/SURCOUCHE/src/mode_netcdf.f90
+++ b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
@@ -27,7 +27,7 @@ INTERFACE IO_WRITE_FIELD_NC4
IO_WRITE_FIELD_NC4_X2,IO_WRITE_FIELD_NC4_X3, &
IO_WRITE_FIELD_NC4_N0,IO_WRITE_FIELD_NC4_N1, &
IO_WRITE_FIELD_NC4_N2, &
- IO_WRITE_FIELD_NC4_C0, &
+ IO_WRITE_FIELD_NC4_C0,IO_WRITE_FIELD_NC4_C1, &
IO_WRITE_FIELD_NC4_T0
END INTERFACE IO_WRITE_FIELD_NC4
@@ -1468,6 +1468,57 @@ DEALLOCATE(YFIELD)
KRESP = IRESP
END SUBROUTINE IO_WRITE_FIELD_NC4_C0
+SUBROUTINE IO_WRITE_FIELD_NC4_C1(TPFILE,TPFIELD,PZCDF,HFIELD,KRESP)
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+TYPE(IOCDF), POINTER :: PZCDF
+CHARACTER(LEN=*),DIMENSION(:),INTENT(IN) :: HFIELD
+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(2) :: IVDIMS
+INTEGER(KIND=IDCDF_KIND) :: ILEN, ISIZE
+INTEGER :: IRESP
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_NC4_C1','writing '//TRIM(TPFIELD%CMNHNAME))
+!
+IRESP = 0
+
+ILEN = LEN(HFIELD)
+ISIZE = SIZE(HFIELD)
+
+! Get the Netcdf file ID
+INCID = TPFILE%NNCID
+
+! 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,ILEN)
+ CALL FILLVDIMS(PZCDF, (/ISIZE/), TPFIELD%CDIR, IVDIMS(2:2))
+ ! 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_C1[NF90_DEF_VAR]')
+ CALL IO_WRITE_FIELD_ATTR_NC4(TPFIELD,INCID,IVARID)
+ELSE
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_NC4_C1',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_C1[NF90_PUT_VAR] '//TRIM(TPFIELD%CMNHNAME),IRESP)
+
+KRESP = IRESP
+END SUBROUTINE IO_WRITE_FIELD_NC4_C1
+
SUBROUTINE NCWRITC1(PZCDF, HVARNAME, HDIR, HFIELD, TPFMH, KRESP)
USE MODD_FM, ONLY : FMHEADER
TYPE(IOCDF), POINTER :: PZCDF
--
GitLab