From 75613d6c61cb584214e94f86aa8e5aa62de76c50 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Thu, 1 Dec 2016 09:52:34 +0100
Subject: [PATCH] Philippe 01/12/2016: IO: * created TFIELDLIST to contains the
characteristics of all the fields * it is now possible to write scalar
integer with the new IO subroutines * added field CLONGNAME to TFILEDATA type
* removed pointer to data in TFILEDATA type
---
src/LIB/SURCOUCHE/src/fmwrit_ll.f90 | 197 ++++++++++++++++++++++----
src/LIB/SURCOUCHE/src/modd_io.f90 | 14 +-
src/LIB/SURCOUCHE/src/mode_field.f90 | 76 ++++++++++
src/LIB/SURCOUCHE/src/mode_io.f90 | 3 +
src/LIB/SURCOUCHE/src/mode_netcdf.f90 | 133 +++++++++++++----
src/MNH/modeln.f90 | 1 +
src/MNH/write_lfin.f90 | 21 +--
7 files changed, 370 insertions(+), 75 deletions(-)
create mode 100644 src/LIB/SURCOUCHE/src/mode_field.f90
diff --git a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90 b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
index 5ef1a7625..82aadc18a 100644
--- a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
+++ b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
@@ -177,7 +177,8 @@ MODULE MODE_FMWRIT
PRIVATE
INTERFACE IO_WRITE_FIELD
- MODULE PROCEDURE IO_WRITE_FIELD_X3
+ MODULE PROCEDURE IO_WRITE_FIELD_BYNAME_N0, IO_WRITE_FIELD_BYNAME_X3, &
+ IO_WRITE_FIELD_BYFIELD_N0,IO_WRITE_FIELD_BYFIELD_X3
END INTERFACE
INTERFACE FMWRIT
@@ -942,7 +943,30 @@ CONTAINS
TIMEZ%T_WRIT3D_ALL=TIMEZ%T_WRIT3D_ALL + T22 - T11
END SUBROUTINE FMWRITX3_ll
- SUBROUTINE IO_WRITE_FIELD_X3(TPFILE,TPFIELD,HFIPRI,KRESP)
+ SUBROUTINE IO_WRITE_FIELD_BYNAME_X3(TPFILE,HNAME,HFIPRI,KRESP,PFIELD)
+ !
+ USE MODD_IO_ll, ONLY : TFILEDATA
+ USE MODE_FIELD
+ !
+ !* 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_X3
+
+ SUBROUTINE IO_WRITE_FIELD_BYFIELD_X3(TPFILE,TPFIELD,HFIPRI,KRESP,PFIELD)
USE MODD_IO_ll
USE MODD_PARAMETERS_ll,ONLY : JPHEXT
USE MODD_FM
@@ -967,6 +991,7 @@ CONTAINS
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
!
@@ -975,7 +1000,6 @@ CONTAINS
CHARACTER(LEN=2) :: YDIR ! field form
CHARACTER(LEN=JPFINL) :: YFNLFI
CHARACTER(LEN=100) :: YCOMMENT ! comment string
- REAL,DIMENSION(:,:,:),POINTER :: ZFIELD ! array containing the data field
INTEGER :: IGRID ! C-grid indicator (u,v,w,T)
INTEGER :: IERR
TYPE(FD_ll), POINTER :: TZFD
@@ -1017,7 +1041,6 @@ CONTAINS
YRECFM = TPFIELD%CMNHNAME
YDIR = TPFIELD%CDIR
YCOMMENT = TPFIELD%CCOMMENT
- ZFIELD => TPFIELD%XFIELDDATA3D
IGRID = TPFIELD%NGRID
!
!* 1.1 THE NAME OF LFIFM
@@ -1037,35 +1060,35 @@ CONTAINS
TZFMH%COMLEN=LEN(YCOMMENT)
TZFMH%COMMENT=YCOMMENT
! IF (LPACK .AND. L1D .AND. YDIR=='XY') THEN
- IF (LPACK .AND. L1D .AND. SIZE(ZFIELD,1)==IHEXTOT .AND. SIZE(ZFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>ZFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1,:)
+ IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
+ ZFIELDP=>PFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1,:)
IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,YRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,YRECFM,YDIR,ZFIELDP,TZFMH,IRESP)
! ELSE IF (LPACK .AND. L2D .AND. YDIR=='XY') THEN
- ELSEIF (LPACK .AND. L2D .AND. SIZE(ZFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>ZFIELD(:,JPHEXT+1:JPHEXT+1,:)
+ ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
+ ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1,:)
IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,YRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,YRECFM,YDIR,ZFIELDP,TZFMH,IRESP)
ELSE
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,YRECFM,.TRUE.,SIZE(ZFIELD),ZFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFIELD,TZFD%CDF,IRESP)
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,YRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFIELD,TZFD%CDF,IRESP,PFIELD)
END IF
ELSEIF ( (TZFD%nb_procio .eq. 1 ) .OR. ( YDIR == '--' ) ) THEN ! multiprocessor execution & 1 proc IO
! write 3D field in 1 time = output for graphique
IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,ZFIELD,YDIR,GALLOC)
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,YDIR,GALLOC)
ELSE
ALLOCATE(ZFIELDP(0,0,0))
GALLOC = .TRUE.
END IF
!
IF (YDIR == 'XX' .OR. YDIR =='YY') THEN
- CALL GATHER_XXFIELD(YDIR,ZFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
+ CALL GATHER_XXFIELD(YDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
ELSEIF (YDIR == 'XY') THEN
IF (LPACK .AND. L2D) THEN
- CALL GATHER_XXFIELD('XX',ZFIELD(:,JPHEXT+1,:),ZFIELDP(:,1,:),TZFD%OWNER,TZFD%COMM)
+ CALL GATHER_XXFIELD('XX',PFIELD(:,JPHEXT+1,:),ZFIELDP(:,1,:),TZFD%OWNER,TZFD%COMM)
ELSE
- CALL GATHER_XYFIELD(ZFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
+ CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
END IF
END IF
!
@@ -1091,15 +1114,15 @@ CONTAINS
! init/create the ga
!
CALL SECOND_MNH2(T0)
- CALL MNH_INIT_GA(SIZE(ZFIELD,1),SIZE(ZFIELD,2),SIZE(ZFIELD,3),YRECFM,"WRITE")
+ CALL MNH_INIT_GA(SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3),YRECFM,"WRITE")
!
! copy columun data to global arrays g_a
!
- ALLOCATE (ZFIELD_GA (SIZE(ZFIELD,1),SIZE(ZFIELD,2),SIZE(ZFIELD,3)))
- ZFIELD_GA = ZFIELD
+ ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3)))
+ ZFIELD_GA = PFIELD
call nga_put(g_a, lo_col, hi_col,ZFIELD_GA(NIXO_L,NIYO_L,1) , ld_col)
DEALLOCATE(ZFIELD_GA)
-!!$ print*," nga_put =",YRECFM,g_a," lo_col=",lo_col," hi_col=",hi_col,ZFIELD(NIXO_L,NIYO_L,1) &
+!!$ print*," nga_put =",YRECFM,g_a," lo_col=",lo_col," hi_col=",hi_col,PFIELD(NIXO_L,NIYO_L,1) &
!!$ ," ld_col=",ld_col
call ga_sync
CALL SECOND_MNH2(T1)
@@ -1166,11 +1189,11 @@ CONTAINS
ALLOCATE(ZSLIDE_ll(0,0))
GALLOC_ll = .TRUE.
inb_proc_real = min(TZFD%nb_procio,ISNPROC)
- Z_SLIDE: DO JK=1,SIZE(ZFIELD,3),inb_proc_real
+ Z_SLIDE: DO JK=1,SIZE(PFIELD,3),inb_proc_real
!
! collecte the data
!
- JK_MAX=min(SIZE(ZFIELD,3),JK+inb_proc_real-1)
+ JK_MAX=min(SIZE(PFIELD,3),JK+inb_proc_real-1)
!
NB_REQ=0
ALLOCATE(REQ_TAB(inb_proc_real))
@@ -1193,11 +1216,11 @@ CONTAINS
!
IF (YDIR == 'XX' .OR. YDIR =='YY') THEN
STOP " XX NON PREVU SUR BG POUR LE MOMENT "
- CALL GATHER_XXFIELD(YDIR,ZFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
+ CALL GATHER_XXFIELD(YDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
ELSEIF (YDIR == 'XY') THEN
IF (LPACK .AND. L2D) THEN
STOP " L2D NON PREVU SUR BG POUR LE MOMENT "
- CALL GATHER_XXFIELD('XX',ZFIELD(:,JPHEXT+1,:),ZFIELDP(:,1,:),TZFD%OWNER,TZFD%COMM)
+ CALL GATHER_XXFIELD('XX',PFIELD(:,JPHEXT+1,:),ZFIELDP(:,1,:),TZFD%OWNER,TZFD%COMM)
ELSE
!CALL GATHER_XYFIELD(ZSLIDE,ZSLIDE_ll,TZFD_IOZ%OWNER,TZFD_IOZ%COMM)
!JUANIOZ
@@ -1208,7 +1231,7 @@ CONTAINS
IF (IXO /= 0) THEN ! intersection is not empty
NB_REQ = NB_REQ + 1
ALLOCATE(T_TX2DP(NB_REQ)%X(IXO:IXE,IYO:IYE))
- ZSLIDE => ZFIELD(:,:,JKK)
+ ZSLIDE => PFIELD(:,:,JKK)
TX2DP=>ZSLIDE(IXO:IXE,IYO:IYE)
T_TX2DP(NB_REQ)%X=ZSLIDE(IXO:IXE,IYO:IYE)
CALL MPI_ISEND(T_TX2DP(NB_REQ)%X,SIZE(TX2DP),MPI_FLOAT,IK_RANK-1,99+IK_RANK &
@@ -1251,7 +1274,7 @@ CONTAINS
TX2DP=>ZSLIDE_ll(IXO:IXE,IYO:IYE)
IF (ISP == JI) THEN
CALL GET_DOMWRITE_ll(JI,'local',IXO,IXE,IYO,IYE)
- ZSLIDE => ZFIELD(:,:,JKK)
+ ZSLIDE => PFIELD(:,:,JKK)
TX2DP = ZSLIDE(IXO:IXE,IYO:IYE)
ELSE
CALL MPI_RECV(TX2DP,SIZE(TX2DP),MPI_FLOAT,JI-1,99+IK_RANK,TZFD_IOZ%COMM,STATUS,IERR)
@@ -1299,7 +1322,7 @@ CONTAINS
END IF
!----------------------------------------------------------------
IF (IRESP.NE.0) THEN
- CALL FM_WRIT_ERR("IO_WRITE_FIELD_X3",YFILEM,HFIPRI,YRECFM,YDIR,IGRID,LEN(YCOMMENT),IRESP)
+ CALL FM_WRIT_ERR("IO_WRITE_FIELD_BYFIELD_X3",YFILEM,HFIPRI,YRECFM,YDIR,IGRID,LEN(YCOMMENT),IRESP)
END IF
IF (GALLOC) DEALLOCATE(ZFIELDP)
IF (GALLOC_ll) DEALLOCATE(ZSLIDE_ll)
@@ -1308,7 +1331,7 @@ CONTAINS
IF (ASSOCIATED(TZFD)) CALL MPI_BARRIER(TZFD%COMM,IERR)
CALL SECOND_MNH2(T22)
TIMEZ%T_WRIT3D_ALL=TIMEZ%T_WRIT3D_ALL + T22 - T11
- END SUBROUTINE IO_WRITE_FIELD_X3
+ END SUBROUTINE IO_WRITE_FIELD_BYFIELD_X3
SUBROUTINE FMWRITX4_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
KLENCH,HCOMMENT,KRESP)
@@ -1683,6 +1706,128 @@ CONTAINS
KRESP = IRESP
END SUBROUTINE FMWRITN0_ll
+ SUBROUTINE IO_WRITE_FIELD_BYNAME_N0(TPFILE,HNAME,HFIPRI,KRESP,KFIELD)
+ !
+ USE MODD_IO_ll, ONLY : TFILEDATA
+ USE MODE_FIELD
+ !
+ !* 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, INTENT(IN) :: KFIELD ! 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,KFIELD)
+ !
+ END SUBROUTINE IO_WRITE_FIELD_BYNAME_N0
+
+ SUBROUTINE IO_WRITE_FIELD_BYFIELD_N0(TPFILE,TPFIELD,HFIPRI,KRESP,KFIELD)
+ 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
+ INTEGER, INTENT(IN) :: KFIELD ! array containing the data field
+ !
+ !* 0.2 Declarations of local variables
+ !
+ CHARACTER(LEN=28) :: YFILEM ! FM-file name
+ CHARACTER(LEN=16) :: YRECFM ! name of the article to write
+ CHARACTER(LEN=2) :: YDIR ! field form
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ CHARACTER(LEN=100) :: YCOMMENT ! comment string
+ INTEGER :: IGRID ! C-grid indicator (u,v,w,T)
+ INTEGER :: IERR
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ TYPE(FMHEADER) :: TZFMH
+ !JUANZIO
+ INTEGER :: IK_FILE,IK_rank
+ CHARACTER(len=5) :: YK_FILE
+ CHARACTER(len=128) :: YFILE_IOZ
+ TYPE(FD_ll), POINTER :: TZFD_IOZ
+ INTEGER,DIMENSION(1) :: IDIMS
+ !
+ YFILEM = TPFILE%CNAME
+ YRECFM = TPFIELD%CMNHNAME
+ YDIR = TPFIELD%CDIR
+ YCOMMENT = TPFIELD%CCOMMENT
+ IGRID = TPFIELD%NGRID
+ !
+ IDIMS(1) = 0
+ !
+ !JUANZIO
+ !----------------------------------------------------------------
+ !
+ !* 1.1 THE NAME OF LFIFM
+ !
+ IRESP = 0
+ YFNLFI=TRIM(ADJUSTL(YFILEM))//'.lfi'
+ !print * , ' Writing Article N0 ' , YRECFM
+ !------------------------------------------------------------------
+ TZFD=>GETFD(YFNLFI)
+ IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ TZFMH%GRID=IGRID
+ TZFMH%COMLEN=LEN(YCOMMENT)
+ TZFMH%COMMENT=YCOMMENT
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,YRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFIELD,TZFD%CDF,IRESP,KFIELD)
+ ELSE
+ IF (ISP == TZFD%OWNER) THEN
+ TZFMH%GRID=IGRID
+ TZFMH%COMLEN=LEN(YCOMMENT)
+ TZFMH%COMMENT=YCOMMENT
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,YRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,YRECFM,YDIR,KFIELD,TZFMH,IRESP)
+ END IF
+ !
+ CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
+
+ END IF ! multiprocessor execution
+ IF (TZFD%nb_procio.gt.1) THEN
+ ! write the data in all Z files
+ DO IK_FILE=1,TZFD%nb_procio
+ write(YK_FILE ,'(".Z",i3.3)') IK_FILE
+ YFILE_IOZ = TRIM(YFILEM)//YK_FILE//".lfi"
+ TZFD_IOZ => GETFD(YFILE_IOZ)
+ IK_RANK = TZFD_IOZ%OWNER
+ IF ( ISP == IK_RANK ) THEN
+ TZFMH%GRID=IGRID
+ TZFMH%COMLEN=LEN(YCOMMENT)
+ TZFMH%COMMENT=YCOMMENT
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD_IOZ%FLU,YRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD_IOZ%CDF,YRECFM,YDIR,KFIELD,TZFMH,IRESP)
+ END IF
+ END DO
+ ENDIF
+ ELSE
+ IRESP = -61
+ END IF
+ !----------------------------------------------------------------
+ IF (IRESP.NE.0) THEN
+ CALL FM_WRIT_ERR("IO_WRITE_FIELD_BYFIELD_N0",YFILEM,HFIPRI,YRECFM,YDIR,IGRID,LEN(YCOMMENT)&
+ & ,IRESP)
+ END IF
+ KRESP = IRESP
+ END SUBROUTINE IO_WRITE_FIELD_BYFIELD_N0
+
SUBROUTINE FMWRITN1_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
KLENCH,HCOMMENT,KRESP)
USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
diff --git a/src/LIB/SURCOUCHE/src/modd_io.f90 b/src/LIB/SURCOUCHE/src/modd_io.f90
index f371738b7..928a0e14d 100644
--- a/src/LIB/SURCOUCHE/src/modd_io.f90
+++ b/src/LIB/SURCOUCHE/src/modd_io.f90
@@ -67,13 +67,13 @@ END TYPE TFILEDATA
!Structure describing the characteristics of a field
TYPE TFIELDDATA
- CHARACTER(LEN=16) :: CMNHNAME = '' !Name of the field (for MesoNH, non CF convention)
- CHARACTER(LEN=32) :: CSTDNAME = '' !Standard name (CF convention)
- CHARACTER(LEN=32) :: CUNITS = '' !Canonical units (CF convention)
- CHARACTER(LEN=2) :: CDIR = '' !Type of the data field (XX,XY,--...)
- CHARACTER(LEN=100) :: CCOMMENT = '' !Comment (for MesoNH, non CF convention)
- INTEGER :: NGRID = -1 !Localization on the model grid
- REAL,DIMENSION(:,:,:),POINTER :: XFIELDDATA3D => NULL() !Pointer to the field data
+ CHARACTER(LEN=16) :: CMNHNAME = '' !Name of the field (for MesoNH, non CF convention)
+ CHARACTER(LEN=32) :: CSTDNAME = '' !Standard name (CF convention)
+ CHARACTER(LEN=32) :: CLONGNAME = '' !Long name (CF convention)
+ CHARACTER(LEN=32) :: CUNITS = '' !Canonical units (CF convention)
+ CHARACTER(LEN=2) :: CDIR = '' !Type of the data field (XX,XY,--...)
+ CHARACTER(LEN=100) :: CCOMMENT = '' !Comment (for MesoNH, non CF convention)
+ INTEGER :: NGRID = -1 !Localization on the model grid
END TYPE TFIELDDATA
TYPE(TFILEDATA),POINTER,SAVE :: TFILE_BAK_FIRST => NULL()
diff --git a/src/LIB/SURCOUCHE/src/mode_field.f90 b/src/LIB/SURCOUCHE/src/mode_field.f90
new file mode 100644
index 000000000..16be02272
--- /dev/null
+++ b/src/LIB/SURCOUCHE/src/mode_field.f90
@@ -0,0 +1,76 @@
+!MNH_LIC Copyright 2016 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+MODULE MODE_FIELD
+!
+USE MODD_IO_ll, ONLY: TFIELDDATA
+!
+IMPLICIT NONE
+!
+INTEGER,PRIVATE,PARAMETER :: MAXFIELDS = 2
+!
+LOGICAL :: LFIELDLIST_ISINIT = .FALSE.
+TYPE(TFIELDDATA),DIMENSION(MAXFIELDS) :: TFIELDLIST
+!
+CONTAINS
+!
+SUBROUTINE INI_FIELD_LIST()
+!
+INTEGER :: IDX
+!
+!F90/95: TFIELDLIST(1) = TFIELDDATA('UT','x_wind','m s-1','XY','X_Y_Z_U component of wind (m/s)',2)
+!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)
+IDX = 1
+!
+TFIELDLIST(IDX)%CMNHNAME = 'MASDEV'
+TFIELDLIST(IDX)%CSTDNAME = ''
+TFIELDLIST(IDX)%CLONGNAME = 'MesoNH version (without bugfix)'
+TFIELDLIST(IDX)%CUNITS = ''
+TFIELDLIST(IDX)%CDIR = '--'
+TFIELDLIST(IDX)%CCOMMENT = ''
+TFIELDLIST(IDX)%NGRID = 0
+IDX = IDX+1
+!
+TFIELDLIST(IDX)%CMNHNAME = 'UT'
+TFIELDLIST(IDX)%CSTDNAME = 'x_wind'
+TFIELDLIST(IDX)%CLONGNAME = ''
+TFIELDLIST(IDX)%CUNITS = 'm s-1'
+TFIELDLIST(IDX)%CDIR = 'XY'
+TFIELDLIST(IDX)%CCOMMENT = 'X_Y_Z_U component of wind (m/s)'
+TFIELDLIST(IDX)%NGRID = 2
+IDX = IDX+1
+!
+LFIELDLIST_ISINIT = .TRUE.
+!
+END SUBROUTINE INI_FIELD_LIST
+!
+SUBROUTINE FIND_FIELD_ID_FROM_MNHNAME(HMNHNAME,KID,KRESP)
+!
+CHARACTER(LEN=*), INTENT(IN) :: HMNHNAME !Name of the field to find
+INTEGER, INTENT(OUT):: KID !Index of the field
+INTEGER, INTENT(OUT):: KRESP !Return-code
+!
+INTEGER :: JI
+!
+KID = 0
+KRESP = 0
+!
+DO JI = 1,MAXFIELDS
+ IF (TRIM(TFIELDLIST(JI)%CMNHNAME)==TRIM(HMNHNAME)) THEN
+ KID = JI
+ EXIT
+ END IF
+END DO
+!
+IF (KID==0) THEN
+ !Field not found
+ KRESP = -1
+ PRINT *,'WARNING: FIND_FIELD_ID_FROM_MNHNAME: field ',TRIM(HMNHNAME),' not known'
+END IF
+!
+END SUBROUTINE FIND_FIELD_ID_FROM_MNHNAME
+!
+END MODULE MODE_FIELD
diff --git a/src/LIB/SURCOUCHE/src/mode_io.f90 b/src/LIB/SURCOUCHE/src/mode_io.f90
index 3667364c5..3063554d4 100644
--- a/src/LIB/SURCOUCHE/src/mode_io.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io.f90
@@ -158,6 +158,7 @@ CONTAINS
SUBROUTINE INITIO_ll()
USE MODE_MNH_WORLD , ONLY : INIT_NMNH_COMM_WORLD
USE MODD_IO_ll
+ USE MODE_FIELD
IMPLICIT NONE
INTEGER :: IERR, IOS
@@ -175,6 +176,8 @@ CONTAINS
CALL INITFD()
+ CALL INI_FIELD_LIST()
+
!! Default number for Processor I/O
ISIOP = 1
diff --git a/src/LIB/SURCOUCHE/src/mode_netcdf.f90 b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
index 40bf084a8..8b175f8de 100644
--- a/src/LIB/SURCOUCHE/src/mode_netcdf.f90
+++ b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
@@ -17,7 +17,7 @@ IMPLICIT NONE
PRIVATE
INTERFACE IO_WRITE_FIELD_NC4
- MODULE PROCEDURE IO_WRITE_FIELD_NC4_X3
+ MODULE PROCEDURE IO_WRITE_FIELD_NC4_X3, IO_WRITE_FIELD_NC4_N0
END INTERFACE IO_WRITE_FIELD_NC4
INTERFACE NCWRIT
@@ -188,7 +188,7 @@ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITATTR [NF90_PUT_AT
END SUBROUTINE WRITATTR
-SUBROUTINE IO_WRITE_ATTR_NC4(TPFIELD,KNCID,KVARID)
+SUBROUTINE IO_WRITE_FIELD_ATTR_NC4(TPFIELD,KNCID,KVARID)
!
USE MODD_IO_ll, ONLY : TFIELDDATA
!
@@ -198,35 +198,52 @@ INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KVARID
!
INTEGER(KIND=IDCDF_KIND) :: STATUS
!
+IF(LEN_TRIM(TPFIELD%CSTDNAME)==0 .AND. LEN_TRIM(TPFIELD%CLONGNAME)==0) THEN
+ PRINT *,'ERROR: IO_WRITE_ATTR_NC4: at least long_name or standard_name must be provided &
+ &to respect CF-convention for variable ',TRIM(TPFIELD%CMNHNAME)
+ENDIF
+!
! GRID attribute definition
IF(TPFIELD%NGRID<0) THEN
- PRINT *,'WARNING: IO_WRITE_ATTR_NC4: TPFIELD%NGRID not set'
+ PRINT *,'WARNING: IO_WRITE_ATTR_NC4: TPFIELD%NGRID not set for variable ',TRIM(TPFIELD%CMNHNAME)
+ELSE
+ STATUS = NF90_PUT_ATT(KNCID, KVARID, 'GRID', TPFIELD%NGRID)
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_ATTR_NC4 [NF90_PUT_ATT]')
ENDIF
-STATUS = NF90_PUT_ATT(KNCID, KVARID, 'GRID', TPFIELD%NGRID)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_ATTR_NC4 [NF90_PUT_ATT]')
!
! COMMENT attribute definition
IF(LEN_TRIM(TPFIELD%CCOMMENT)==0) THEN
- PRINT *,'WARNING: IO_WRITE_ATTR_NC4: TPFIELD%CCOMMENT not set'
+ PRINT *,'WARNING: IO_WRITE_ATTR_NC4: TPFIELD%CCOMMENT not set for variable ',TRIM(TPFIELD%CMNHNAME)
+ELSE
+ STATUS = NF90_PUT_ATT(KNCID, KVARID,'COMMENT', TRIM(TPFIELD%CCOMMENT))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_ATTR_NC4 [NF90_PUT_ATT]')
ENDIF
-STATUS = NF90_PUT_ATT(KNCID, KVARID,'COMMENT', TRIM(TPFIELD%CCOMMENT))
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_ATTR_NC4 [NF90_PUT_ATT]')
!
! Standard_name attribute definition (CF convention)
IF(LEN_TRIM(TPFIELD%CSTDNAME)==0) THEN
- PRINT *,'WARNING: IO_WRITE_ATTR_NC4: TPFIELD%CSTDNAME not set'
+ PRINT *,'WARNING: IO_WRITE_ATTR_NC4: TPFIELD%CSTDNAME not set for variable ',TRIM(TPFIELD%CMNHNAME)
+ELSE
+ STATUS = NF90_PUT_ATT(KNCID, KVARID,'standard_name', TRIM(TPFIELD%CSTDNAME))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_ATTR_NC4 [NF90_PUT_ATT]')
+ENDIF
+!
+! Long_name attribute definition (CF convention)
+IF(LEN_TRIM(TPFIELD%CLONGNAME)==0) THEN
+ PRINT *,'WARNING: IO_WRITE_ATTR_NC4: TPFIELD%CLONGNAME not set for variable ',TRIM(TPFIELD%CMNHNAME)
+ELSE
+ STATUS = NF90_PUT_ATT(KNCID, KVARID,'long_name', TRIM(TPFIELD%CLONGNAME))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_ATTR_NC4 [NF90_PUT_ATT]')
ENDIF
-STATUS = NF90_PUT_ATT(KNCID, KVARID,'standard_name', TRIM(TPFIELD%CSTDNAME))
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_ATTR_NC4 [NF90_PUT_ATT]')
!
! Canonical units attribute definition (CF convention)
IF(LEN_TRIM(TPFIELD%CUNITS)==0) THEN
- PRINT *,'WARNING: IO_WRITE_ATTR_NC4: TPFIELD%CUNITS not set'
+ PRINT *,'WARNING: IO_WRITE_ATTR_NC4: TPFIELD%CUNITS not set for variable ',TRIM(TPFIELD%CMNHNAME)
+ELSE
+ STATUS = NF90_PUT_ATT(KNCID, KVARID,'units', TRIM(TPFIELD%CUNITS))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_ATTR_NC4 [NF90_PUT_ATT]')
ENDIF
-STATUS = NF90_PUT_ATT(KNCID, KVARID,'units', TRIM(TPFIELD%CUNITS))
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_ATTR_NC4 [NF90_PUT_ATT]')
!
-END SUBROUTINE IO_WRITE_ATTR_NC4
+END SUBROUTINE IO_WRITE_FIELD_ATTR_NC4
FUNCTION GETDIMCDF(PIOCDF, KLEN, HDIMNAME)
TYPE(IOCDF), POINTER :: PIOCDF
@@ -572,7 +589,7 @@ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX3[NF90_PUT_VAR
KRESP = IRESP
END SUBROUTINE NCWRITX3
-SUBROUTINE IO_WRITE_FIELD_NC4_X3(TPFIELD,PZCDF,KRESP)
+SUBROUTINE IO_WRITE_FIELD_NC4_X3(TPFIELD,PZCDF,KRESP,PFIELD)
!
USE MODD_FM, ONLY : FMHEADER
USE MODD_IO_ll, ONLY : TFIELDDATA
@@ -580,13 +597,14 @@ USE MODD_IO_ll, ONLY : TFIELDDATA
TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
TYPE(IOCDF), POINTER :: PZCDF
INTEGER, INTENT(OUT):: KRESP
+REAL,DIMENSION(:,:,:), INTENT(IN) :: PFIELD ! array containing the data field
!
INTEGER(KIND=IDCDF_KIND) :: STATUS
INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=30) :: YVARNAME
+CHARACTER(LEN=30) :: YVARNAME
INTEGER(KIND=IDCDF_KIND) :: IVARID
INTEGER(KIND=IDCDF_KIND), DIMENSION(3) :: IVDIMS
-INTEGER :: IRESP
+INTEGER :: IRESP
!
IRESP = 0
! Get the Netcdf file ID
@@ -600,18 +618,18 @@ YVARNAME = str_replace(YVARNAME, '.', '--')
STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
IF (STATUS /= NF90_NOERR) THEN
! Get the netcdf dimensions
- CALL FILLVDIMS(PZCDF, INT(SHAPE(TPFIELD%XFIELDDATA3D),KIND=IDCDF_KIND), TPFIELD%CDIR, IVDIMS)
+ CALL FILLVDIMS(PZCDF, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), TPFIELD%CDIR, IVDIMS)
! Define the variable
STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVDIMS, IVARID)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_X3[NF90_DEF_VAR]')
- CALL IO_WRITE_ATTR_NC4(TPFIELD,INCID,IVARID)
+ CALL IO_WRITE_FIELD_ATTR_NC4(TPFIELD,INCID,IVARID)
ELSE
- PRINT *,'IO_WRITE_FIELD_NC4_X3 : ', TRIM(YVARNAME), ' already defined !'
+ PRINT *,'IO_WRITE_FIELD_NC4_X3: ', TRIM(YVARNAME), ' already defined !'
END IF
! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, TPFIELD%XFIELDDATA3D)
+STATUS = NF90_PUT_VAR(INCID, IVARID, PFIELD)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_X3[NF90_PUT_VAR] '//TRIM(TPFIELD%CMNHNAME),IRESP)
KRESP = IRESP
@@ -814,6 +832,73 @@ IF (YVARNAME == 'KMAX' .AND. .NOT. ASSOCIATED(PZCDF%DIMZ)) PZCDF%DIMZ=>GETDIMCDF
KRESP = IRESP
END SUBROUTINE NCWRITN0
+SUBROUTINE IO_WRITE_FIELD_NC4_N0(TPFIELD,PZCDF,KRESP,KFIELD)
+!
+USE MODD_FM, ONLY : FMHEADER
+USE MODD_IO_ll, ONLY : TFIELDDATA
+USE MODD_PARAMETERS_ll, ONLY : JPVEXT
+#if 0
+USE MODD_PARAMETERS_ll, ONLY : JPHEXT, JPVEXT
+USE MODD_IO_ll, ONLY : LPACK,L1D,L2D
+#endif
+!
+TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+TYPE(IOCDF), POINTER :: PZCDF
+INTEGER, INTENT(OUT):: KRESP
+INTEGER, INTENT(IN) :: KFIELD
+!
+INTEGER(KIND=IDCDF_KIND) :: STATUS
+INTEGER(KIND=IDCDF_KIND) :: INCID
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER(KIND=IDCDF_KIND) :: IVARID
+INTEGER :: IRESP
+!
+IRESP = 0
+! 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
+ ! Define the scalar variable
+#ifndef MNH_INT8
+ STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT, IVARID)
+#else
+ STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT64, IVARID)
+#endif
+ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_N0[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, KFIELD)
+IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_N0[NF90_PUT_VAR] '//TRIM(TPFIELD%CMNHNAME),IRESP)
+
+!
+! Use IMAX, JMAX, KMAX to define DIMX, DIMY, DIMZ
+! /!\ Can only work if IMAX, JMAX or KMAX are written before any array
+!
+#if 0
+IF (YVARNAME == 'IMAX' .AND. .NOT. ASSOCIATED(PZCDF%DIMX)) PZCDF%DIMX=>GETDIMCDF(PZCDF,KFIELD+2*JPHEXT,'X')
+IF (YVARNAME == 'JMAX' .AND. .NOT. ASSOCIATED(PZCDF%DIMY)) THEN
+ IF (LPACK .AND. L2D) THEN
+ PZCDF%DIMY=>GETDIMCDF(PZCDF, 1,'Y')
+ ELSE
+ PZCDF%DIMY=>GETDIMCDF(PZCDF, KFIELD+2*JPHEXT, 'Y')
+ END IF
+END IF
+#endif
+IF (YVARNAME == 'KMAX' .AND. .NOT. ASSOCIATED(PZCDF%DIMZ)) PZCDF%DIMZ=>GETDIMCDF(PZCDF,INT(KFIELD+2*JPVEXT,KIND=IDCDF_KIND),'Z')
+
+KRESP = IRESP
+END SUBROUTINE IO_WRITE_FIELD_NC4_N0
+
SUBROUTINE NCWRITN1(PZCDF, HVARNAME, HDIR, KFIELD, TPFMH, KRESP)
USE MODD_FM, ONLY : FMHEADER
TYPE(IOCDF), POINTER :: PZCDF
@@ -1764,8 +1849,8 @@ END MODULE MODE_NETCDF
!
! External dummy subroutines
!
-SUBROUTINE IO_WRITE_FIELD_NC4(A,B,C)
-INTEGER :: A,B,C
+SUBROUTINE IO_WRITE_FIELD_NC4(A,B,C,D)
+INTEGER :: A,B,C,D
PRINT *, 'IO_WRITE_FIELD_NC4 empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF4 I/Os.'
END SUBROUTINE IO_WRITE_FIELD_NC4
diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index 24404e27b..4c5a4c9b2 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -922,6 +922,7 @@ IF (IBAK < NBAK_NUMB ) THEN
YDESFM=ADJUSTL(ADJUSTR(YFMFILE)//'.des')
!
CALL WRITE_DESFM_n(IMI,YDESFM,CLUOUT)
+ CALL IO_WRITE_HEADER_NC4(TBACKUPN(IBAK)%TFILE,CLUOUT)
CALL WRITE_LFIFM_n(TBACKUPN(IBAK)%TFILE,YDADFILE)
COUTFMFILE = YFMFILE
CALL MNHWRITE_ZS_DUMMY_n(CPROGRAM)
diff --git a/src/MNH/write_lfin.f90 b/src/MNH/write_lfin.f90
index 1202d2e7a..e66313d3a 100644
--- a/src/MNH/write_lfin.f90
+++ b/src/MNH/write_lfin.f90
@@ -241,6 +241,7 @@ USE MODE_FMWRIT
USE MODE_ll
USE MODD_IO_ll, ONLY: TFIELDDATA, TFILEDATA
USE MODE_IO_ll, ONLY: UPCASE,CLOSE_ll
+USE MODE_FIELD
USE MODE_GRIDPROJ
USE MODE_MODELN_HANDLER
!
@@ -348,11 +349,7 @@ IKE=IKU-JPVEXT
!
YDIR='--'
!
-YRECFM='MASDEV'
-YCOMMENT=' '
-IGRID=0
-ILENCH=LEN(YCOMMENT)
-CALL FMWRIT(YFMFILE,YRECFM,CLUOUT,YDIR,NMASDEV,IGRID,ILENCH,YCOMMENT,IRESP)
+CALL IO_WRITE_FIELD(TPFILE,'MASDEV',CLUOUT,IRESP,NMASDEV)
!
YRECFM='BUGFIX'
YCOMMENT=' '
@@ -656,19 +653,7 @@ YDIR='XY'
! CALL EXTRAPOL('N',XUT)
! CALL EXTRAPOL('S',XUT)
CALL MPPDB_CHECK3D(XUT,"write_lfifmn before IO_WRITE_FIELD::XUT",PRECISION)
-TZFIELD%CMNHNAME='UT'
-TZFIELD%CSTDNAME='x_wind'
-TZFIELD%CUNITS='m s-1'
-TZFIELD%CDIR='XY'
-TZFIELD%CCOMMENT='X_Y_Z_U component of wind (m/s)'
-TZFIELD%NGRID=2
-TZFIELD%XFIELDDATA3D => XUT
-! YRECFM='UT'
-! YCOMMENT='X_Y_Z_U component of wind (m/s)'
-! IGRID=2
-! ILENCH=LEN(YCOMMENT)
-! CALL FMWRIT(YFMFILE,YRECFM,CLUOUT,YDIR,XUT,IGRID,ILENCH,YCOMMENT,IRESP)
-CALL IO_WRITE_FIELD(TPFILE,TZFIELD,CLUOUT,IRESP)
+CALL IO_WRITE_FIELD(TPFILE,'UT',CLUOUT,IRESP,XUT)
CALL MPPDB_CHECK3D(XUT,"write_lfifmn after IO_WRITE_FIELD::XUT",PRECISION)
!
!20131128 check XVT-> X_Y_W_V wind component for PRC
--
GitLab