diff --git a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90 b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
index 7d331e1ad4a47116e339dfb611ef57e80183acac..5ef1a7625a830172de7d93b60fd1d0b9925622da 100644
--- a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
+++ b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
@@ -176,6 +176,10 @@ MODULE MODE_FMWRIT
PRIVATE
+ INTERFACE IO_WRITE_FIELD
+ MODULE PROCEDURE IO_WRITE_FIELD_X3
+ END INTERFACE
+
INTERFACE FMWRIT
MODULE PROCEDURE FMWRITX0_ll,FMWRITX1_ll,FMWRITX2_ll,FMWRITX3_ll,&
& FMWRITX4_ll,FMWRITX5_ll,FMWRITX6_ll,&
@@ -193,6 +197,7 @@ MODULE MODE_FMWRIT
& FMWRITX4_ll,FMWRITX5_ll,FMWRITX6_ll,FMWRITN0_ll,FMWRITN1_ll,FMWRITN2_ll,&
& FMWRITL0_ll,FMWRITL1_ll,FMWRITC0_ll,FMWRITC1_ll,FMWRITT0_ll,FMWRITBOXX2_ll,&
& FMWRITBOXX3_ll,FMWRITBOXX4_ll,FMWRITBOXX5_ll,FMWRITBOXX6_ll
+ PUBLIC IO_WRITE_FIELD
!INCLUDE 'mpif.h'
@@ -937,6 +942,374 @@ CONTAINS
TIMEZ%T_WRIT3D_ALL=TIMEZ%T_WRIT3D_ALL + T22 - T11
END SUBROUTINE FMWRITX3_ll
+ SUBROUTINE IO_WRITE_FIELD_X3(TPFILE,TPFIELD,HFIPRI,KRESP)
+ USE MODD_IO_ll
+ USE MODD_PARAMETERS_ll,ONLY : JPHEXT
+ USE MODD_FM
+ USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+ USE MODE_ALLOCBUFFER_ll
+ USE MODE_GATHER_ll
+ !JUANZ
+ USE MODD_IO_ll, ONLY : ISNPROC
+ USE MODE_IO_ll, ONLY : io_file,io_rank
+ USE MODD_TIMEZ, ONLY : TIMEZ
+ USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
+ !JUANZ
+#ifdef MNH_GA
+ USE MODE_GA
+#endif
+ USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
+ !
+ !
+ !* 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
+ !
+ !* 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
+ 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
+ INTEGER :: IRESP
+ REAL,DIMENSION(:,:,:),POINTER :: ZFIELDP
+ TYPE(FMHEADER) :: TZFMH
+ LOGICAL :: GALLOC
+ !JUAN
+ INTEGER :: JK,JKK
+ CHARACTER(LEN=LEN(YRECFM)) :: YK,YRECZSLIDE
+ REAL,DIMENSION(:,:),POINTER :: ZSLIDE_ll,ZSLIDE
+ INTEGER :: IK_FILE,IK_rank,inb_proc_real,JK_MAX
+ CHARACTER(len=5) :: YK_FILE
+ CHARACTER(len=128) :: YFILE_IOZ
+ TYPE(FD_ll), POINTER :: TZFD_IOZ
+ INTEGER :: JI,IXO,IXE,IYO,IYE
+ REAL,DIMENSION(:,:),POINTER :: TX2DP
+ INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
+ INTEGER, ALLOCATABLE,DIMENSION(:,:) :: STATUSES
+ LOGICAL :: GALLOC_ll
+ !JUANZIO
+ !INTEGER,SAVE,DIMENSION(100000) :: REQ_TAB
+ INTEGER,ALLOCATABLE,DIMENSION(:) :: REQ_TAB
+ INTEGER :: NB_REQ
+ TYPE TX_2DP
+ REAL,DIMENSION(:,:), POINTER :: X
+ END TYPE TX_2DP
+ TYPE(TX_2DP),ALLOCATABLE,DIMENSION(:) :: T_TX2DP
+ REAL*8,DIMENSION(2) :: T0,T1,T2
+ REAL*8,DIMENSION(2) :: T11,T22
+ !JUANZIO
+ !JUAN
+#ifdef MNH_GA
+ REAL,DIMENSION(:,:,:),POINTER :: ZFIELD_GA
+#endif
+ INTEGER :: IHEXTOT
+ !
+ YFILEM = TPFILE%CNAME
+ YRECFM = TPFIELD%CMNHNAME
+ YDIR = TPFIELD%CDIR
+ YCOMMENT = TPFIELD%CCOMMENT
+ ZFIELD => TPFIELD%XFIELDDATA3D
+ IGRID = TPFIELD%NGRID
+ !
+ !* 1.1 THE NAME OF LFIFM
+ !
+ CALL SECOND_MNH2(T11)
+ IRESP = 0
+ GALLOC = .FALSE.
+ GALLOC_ll = .FALSE.
+ YFNLFI=TRIM(ADJUSTL(YFILEM))//'.lfi'
+!
+ !------------------------------------------------------------------
+ IHEXTOT = 2*JPHEXT+1
+ TZFD=>GETFD(YFNLFI)
+ IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC .AND. (TZFD%nb_procio.eq.1) ) THEN ! sequential execution
+ TZFMH%GRID=IGRID
+ 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 (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,:)
+ 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)
+ 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)
+ 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)
+ ELSEIF (YDIR == 'XY') THEN
+ IF (LPACK .AND. L2D) THEN
+ CALL GATHER_XXFIELD('XX',ZFIELD(:,JPHEXT+1,:),ZFIELDP(:,1,:),TZFD%OWNER,TZFD%COMM)
+ ELSE
+ CALL GATHER_XYFIELD(ZFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
+ END IF
+ END IF
+ !
+ IF (ISP == TZFD%OWNER) THEN
+ TZFMH%GRID=IGRID
+ TZFMH%COMLEN=LEN(YCOMMENT)
+ TZFMH%COMMENT=YCOMMENT
+ 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)
+ END IF
+ !
+ CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD&
+ & %COMM,IERR)
+ !
+ ELSE ! multiprocessor execution & // IO
+ !
+ !JUAN BG Z SLIDE
+ !
+ !
+#ifdef MNH_GA
+ !
+ ! init/create the ga
+ !
+ CALL SECOND_MNH2(T0)
+ CALL MNH_INIT_GA(SIZE(ZFIELD,1),SIZE(ZFIELD,2),SIZE(ZFIELD,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
+ 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) &
+!!$ ," ld_col=",ld_col
+ call ga_sync
+ CALL SECOND_MNH2(T1)
+ TIMEZ%T_WRIT3D_SEND=TIMEZ%T_WRIT3D_SEND + T1 - T0
+ !
+ ! write the data
+ !
+ ALLOCATE(ZSLIDE_ll(0,0)) ! to avoid bug on test of size
+ GALLOC_ll = .TRUE.
+ !
+ DO JKK=1,IKU_ll
+ !
+ IK_FILE = io_file(JKK,TZFD%nb_procio)
+ write(YK_FILE ,'(".Z",i3.3)') IK_FILE+1
+ YFILE_IOZ = TRIM(YFILEM)//YK_FILE//".lfi"
+ TZFD_IOZ => GETFD(YFILE_IOZ)
+ !
+ IK_RANK = TZFD_IOZ%OWNER
+ !IK_RANK = 1 + io_rank(IK_FILE,ISNPROC,TZFD%nb_procio)
+ !
+ IF (ISP == IK_RANK ) THEN
+ CALL SECOND_MNH2(T0)
+ TZFMH%GRID=IGRID
+ TZFMH%COMLEN=LEN(YCOMMENT)
+ TZFMH%COMMENT=YCOMMENT
+ WRITE(YK,'(I4.4)') JKK
+ YRECZSLIDE = TRIM(YRECFM)//YK
+ !
+ IF ( SIZE(ZSLIDE_ll) .EQ. 0 ) THEN
+ DEALLOCATE(ZSLIDE_ll)
+ CALL ALLOCBUFFER_ll(ZSLIDE_ll,ZSLIDE,YDIR,GALLOC_ll)
+ END IF
+ !
+ ! this proc get this JKK slide
+ !
+ lo_zplan(JPIZ) = JKK
+ hi_zplan(JPIZ) = JKK
+ call nga_get(g_a, lo_zplan, hi_zplan,ZSLIDE_ll, ld_zplan)
+ CALL SECOND_MNH2(T1)
+ TIMEZ%T_WRIT3D_RECV=TIMEZ%T_WRIT3D_RECV + T1 - T0
+ !
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD_IOZ%FLU,YRECZSLIDE,.TRUE.,SIZE(ZSLIDE_ll),&
+ &ZSLIDE_ll,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD_IOZ%CDF,YRECZSLIDE,YDIR,ZSLIDE_ll,TZFMH,IRESP)
+ CALL SECOND_MNH2(T2)
+ TIMEZ%T_WRIT3D_WRIT=TIMEZ%T_WRIT3D_WRIT + T2 - T1
+ END IF
+ END DO
+ !call ga_sync
+ !
+ ! destroy the global array
+ !
+!!$ IF (ISP .EQ. 1 ) THEN
+!!$ call ga_print_stats()
+!!$ call ga_summarize(1)
+!!$ ENDIF
+ CALL SECOND_MNH2(T0)
+ call ga_sync
+!!$ gstatus_ga = ga_destroy(g_a)
+ CALL SECOND_MNH2(T1)
+ TIMEZ%T_WRIT3D_WAIT=TIMEZ%T_WRIT3D_WAIT + T1 - T0
+#else
+ !
+ 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
+ !
+ ! collecte the data
+ !
+ JK_MAX=min(SIZE(ZFIELD,3),JK+inb_proc_real-1)
+ !
+ NB_REQ=0
+ ALLOCATE(REQ_TAB(inb_proc_real))
+ ALLOCATE(T_TX2DP(inb_proc_real))
+ DO JKK=JK,JK_MAX
+ !
+ ! get the file & rank to write this level
+ !
+ IF (TZFD%NB_PROCIO .GT. 1 ) THEN
+ IK_FILE = io_file(JKK,TZFD%nb_procio)
+ write(YK_FILE ,'(".Z",i3.3)') IK_FILE+1
+ YFILE_IOZ = TRIM(YFILEM)//YK_FILE//".lfi"
+ TZFD_IOZ => GETFD(YFILE_IOZ)
+ ELSE
+ TZFD_IOZ => TZFD
+ END IF
+ !
+ !IK_RANK = 1 + io_rank(IK_FILE,ISNPROC,TZFD%nb_procio)
+ IK_RANK = TZFD_IOZ%OWNER
+ !
+ 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)
+ 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)
+ ELSE
+ !CALL GATHER_XYFIELD(ZSLIDE,ZSLIDE_ll,TZFD_IOZ%OWNER,TZFD_IOZ%COMM)
+ !JUANIOZ
+ CALL SECOND_MNH2(T0)
+ IF ( ISP /= IK_RANK ) THEN
+ ! Other processors
+ CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE)
+ 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)
+ 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 &
+ & ,TZFD_IOZ%COMM,REQ_TAB(NB_REQ),IERR)
+ !CALL MPI_BSEND(TX2DP,SIZE(TX2DP),MPI_FLOAT,IK_RANK-1,99+IK_RANK,TZFD_IOZ%COMM,IERR)
+ END IF
+ END IF
+ CALL SECOND_MNH2(T1)
+ TIMEZ%T_WRIT3D_SEND=TIMEZ%T_WRIT3D_SEND + T1 - T0
+ !JUANIOZ
+ END IF
+ END IF
+ END DO
+ !
+ ! write the data
+ !
+ DO JKK=JK,JK_MAX
+ IF (TZFD%NB_PROCIO .GT. 1 ) THEN
+ IK_FILE = io_file(JKK,TZFD%nb_procio)
+ write(YK_FILE ,'(".Z",i3.3)') IK_FILE+1
+ YFILE_IOZ = TRIM(YFILEM)//YK_FILE//".lfi"
+ TZFD_IOZ => GETFD(YFILE_IOZ)
+ ELSE
+ TZFD_IOZ => TZFD
+ ENDIF
+ IK_RANK = TZFD_IOZ%OWNER
+ !IK_RANK = 1 + io_rank(IK_FILE,ISNPROC,TZFD%nb_procio)
+ !
+ IF (ISP == IK_RANK ) THEN
+ !JUANIOZ
+ CALL SECOND_MNH2(T0)
+ ! I/O proc case
+ IF ( SIZE(ZSLIDE_ll) .EQ. 0 ) THEN
+ DEALLOCATE(ZSLIDE_ll)
+ CALL ALLOCBUFFER_ll(ZSLIDE_ll,ZSLIDE,YDIR,GALLOC_ll)
+ END IF
+ DO JI=1,ISNPROC
+ CALL GET_DOMWRITE_ll(JI,'global',IXO,IXE,IYO,IYE)
+ IF (IXO /= 0) THEN ! intersection is not empty
+ TX2DP=>ZSLIDE_ll(IXO:IXE,IYO:IYE)
+ IF (ISP == JI) THEN
+ CALL GET_DOMWRITE_ll(JI,'local',IXO,IXE,IYO,IYE)
+ ZSLIDE => ZFIELD(:,:,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)
+ END IF
+ END IF
+ END DO
+ CALL SECOND_MNH2(T1)
+ TIMEZ%T_WRIT3D_RECV=TIMEZ%T_WRIT3D_RECV + T1 - T0
+ !JUANIOZ
+ TZFMH%GRID=IGRID
+ TZFMH%COMLEN=LEN(YCOMMENT)
+ TZFMH%COMMENT=YCOMMENT
+ WRITE(YK,'(I4.4)') JKK
+ YRECZSLIDE = TRIM(YRECFM)//YK
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD_IOZ%FLU,YRECZSLIDE,.TRUE.,SIZE(ZSLIDE_ll),ZSLIDE_ll,TZFMH&
+ & ,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD_IOZ%CDF,YRECZSLIDE,YDIR,ZSLIDE_ll,TZFMH,IRESP)
+ CALL SECOND_MNH2(T2)
+ TIMEZ%T_WRIT3D_WRIT=TIMEZ%T_WRIT3D_WRIT + T2 - T1
+ END IF
+!!$ CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD_IOZ%OWNER-1,TZFD_IOZ%COMM,IERR)
+ END DO
+ !CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD_IOZ%OWNER-1,TZFD_IOZ%COMM,IERR)
+ !CALL MPI_BARRIER(TZFD_IOZ%COMM,IERR)
+ !
+ CALL SECOND_MNH2(T0)
+ IF (NB_REQ .GT.0 ) THEN
+ !ALLOCATE(STATUSES(MPI_STATUS_SIZE,NB_REQ))
+ CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
+ !CALL MPI_WAITALL(NB_REQ,REQ_TAB,STATUSES,IERR)
+ !DEALLOCATE(STATUSES)
+ DO JI=1,NB_REQ ; DEALLOCATE(T_TX2DP(JI)%X) ; ENDDO
+ END IF
+ DEALLOCATE(T_TX2DP)
+ DEALLOCATE(REQ_TAB)
+ CALL SECOND_MNH2(T1)
+ TIMEZ%T_WRIT3D_WAIT=TIMEZ%T_WRIT3D_WAIT + T1 - T0
+ END DO Z_SLIDE
+ !JUAN BG Z SLIDE
+! end of MNH_GA
+#endif
+ END IF ! multiprocessor execution
+ ELSE
+ IRESP = -61
+ END IF
+ !----------------------------------------------------------------
+ IF (IRESP.NE.0) THEN
+ CALL FM_WRIT_ERR("IO_WRITE_FIELD_X3",YFILEM,HFIPRI,YRECFM,YDIR,IGRID,LEN(YCOMMENT),IRESP)
+ END IF
+ IF (GALLOC) DEALLOCATE(ZFIELDP)
+ IF (GALLOC_ll) DEALLOCATE(ZSLIDE_ll)
+ !IF (Associated(ZSLIDE_ll)) DEALLOCATE(ZSLIDE_ll)
+ KRESP = IRESP
+ 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
+
SUBROUTINE FMWRITX4_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/modd_io.f90 b/src/LIB/SURCOUCHE/src/modd_io.f90
index 0d04fa9bccdeb40bde9a680e248dd25a536aa348..f371738b7a845ca65ca019c24a57575e697d8ec7 100644
--- a/src/LIB/SURCOUCHE/src/modd_io.f90
+++ b/src/LIB/SURCOUCHE/src/modd_io.f90
@@ -65,6 +65,17 @@ TYPE TFILEDATA
TYPE(TFILEDATA),POINTER :: TFILE_NEXT => NULL()
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
+END TYPE TFIELDDATA
+
TYPE(TFILEDATA),POINTER,SAVE :: TFILE_BAK_FIRST => NULL()
TYPE(TFILEDATA),POINTER,SAVE :: TFILE_OUT_FIRST => NULL()
TYPE(TFILEDATA),POINTER,SAVE :: TFILE_BAK_LAST => NULL()
diff --git a/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90 b/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90
index 978c32b84d29dd5aff15ecf99fd4017e0f5dbbd1..5f8a70bdd7d68f853a4c9141bb02ce45c54a52a1 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90
@@ -461,9 +461,10 @@ SUBROUTINE POPULATE_STRUCT(TPFILE_FIRST,TPFILE_LAST,KSTEPS,HFILETYPE,TPBAKOUTN)
!PW: TODO: set NLFIVERB only when useful (only if LFI file...)
TPBAKOUTN(IPOS)%TFILE%NLFIVERB=NVERB
IF (LIOCDF4) THEN
- TPBAKOUTN(IPOS)%TFILE%CFORMAT='NETCDF4'
- IF (LLFIOUT) THEN
- PRINT *,'Warning: LLFIOUT + LIOCDF4 = .TRUE. not yet implemented with new IO data structures'
+ IF (.NOT.LLFIOUT) THEN
+ TPBAKOUTN(IPOS)%TFILE%CFORMAT='NETCDF4'
+ ELSE
+ TPBAKOUTN(IPOS)%TFILE%CFORMAT='LFICDF4'
TPBAKOUTN(IPOS)%TFILE%NLFINPRAR= 22+2*(4+NRR+NSV)
END IF
ELSE IF (LLFIOUT) THEN
diff --git a/src/LIB/SURCOUCHE/src/mode_netcdf.f90 b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
index 3dd23621ff0038058ee87baf0ea8b2601c931e71..40bf084a8fb1b112b305111ab1e9ca0c1789f986 100644
--- a/src/LIB/SURCOUCHE/src/mode_netcdf.f90
+++ b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
@@ -16,6 +16,10 @@ IMPLICIT NONE
PRIVATE
+INTERFACE IO_WRITE_FIELD_NC4
+ MODULE PROCEDURE IO_WRITE_FIELD_NC4_X3
+END INTERFACE IO_WRITE_FIELD_NC4
+
INTERFACE NCWRIT
MODULE PROCEDURE NCWRITX0, NCWRITX1, NCWRITX2, NCWRITX3, &
& NCWRITX4, NCWRITX5, NCWRITX6, &
@@ -33,7 +37,7 @@ END INTERFACE NCREAD
! Public from module netcdf
PUBLIC NF90_OPEN,NF90_CREATE,NF90_NOWRITE,NF90_CLOBBER,NF90_NETCDF4,NF90_NOERR,NF90_STRERROR
! Public from this module :
-PUBLIC NEWIOCDF,CLEANIOCDF,NCWRIT,NCREAD
+PUBLIC NEWIOCDF,CLEANIOCDF,NCWRIT,NCREAD,IO_WRITE_FIELD_NC4,IO_WRITE_HEADER_NC4
CONTAINS
@@ -133,6 +137,39 @@ END IF
END FUNCTION str_replace
+SUBROUTINE IO_WRITE_HEADER_NC4(TPFILE,HFIPRI)
+!
+USE MODD_IO_ll, ONLY: TFILEDATA
+!
+USE MODE_FD_ll
+!
+TYPE(TFILEDATA),POINTER,INTENT(IN) :: TPFILE ! File structure
+CHARACTER(LEN=*), INTENT(IN) :: HFIPRI ! File for prints in FM
+!
+INTEGER(KIND=IDCDF_KIND) :: ISTATUS
+TYPE(FD_ll), POINTER :: TZFD
+!
+IF (TRIM(TPFILE%CFORMAT)/='NETCDF4' .AND. TRIM(TPFILE%CFORMAT)/='LFICDF4') RETURN
+!
+TZFD=>GETFD(TRIM(ADJUSTL(TPFILE%CNAME))//'.lfi')
+!
+ISTATUS = NF90_PUT_ATT(TZFD%CDF%NCID, NF90_GLOBAL, 'Conventions', 'CF-1.6')
+IF (ISTATUS /= NF90_NOERR) CALL HANDLE_ERR(ISTATUS,__LINE__,'IO_FILE_WRITE_HEADER[NF90_PUT_ATT]')
+
+!title
+
+!history
+
+!institution
+
+!source
+
+!comment
+
+!references
+
+END SUBROUTINE IO_WRITE_HEADER_NC4
+
SUBROUTINE WRITATTR(KNCID, KVARID, TPFMH)
USE MODD_FM, ONLY : FMHEADER
INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
@@ -151,6 +188,46 @@ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITATTR [NF90_PUT_AT
END SUBROUTINE WRITATTR
+SUBROUTINE IO_WRITE_ATTR_NC4(TPFIELD,KNCID,KVARID)
+!
+USE MODD_IO_ll, ONLY : TFIELDDATA
+!
+TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
+INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KVARID
+!
+INTEGER(KIND=IDCDF_KIND) :: STATUS
+!
+! GRID attribute definition
+IF(TPFIELD%NGRID<0) THEN
+ PRINT *,'WARNING: IO_WRITE_ATTR_NC4: TPFIELD%NGRID not set'
+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'
+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'
+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'
+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
+
FUNCTION GETDIMCDF(PIOCDF, KLEN, HDIMNAME)
TYPE(IOCDF), POINTER :: PIOCDF
INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KLEN
@@ -495,6 +572,51 @@ 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)
+!
+USE MODD_FM, ONLY : FMHEADER
+USE MODD_IO_ll, ONLY : TFIELDDATA
+!
+TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+TYPE(IOCDF), POINTER :: PZCDF
+INTEGER, INTENT(OUT):: KRESP
+!
+INTEGER(KIND=IDCDF_KIND) :: STATUS
+INTEGER(KIND=IDCDF_KIND) :: INCID
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER(KIND=IDCDF_KIND) :: IVARID
+INTEGER(KIND=IDCDF_KIND), DIMENSION(3) :: IVDIMS
+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
+ ! Get the netcdf dimensions
+ CALL FILLVDIMS(PZCDF, INT(SHAPE(TPFIELD%XFIELDDATA3D),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)
+ELSE
+ PRINT *,'IO_WRITE_FIELD_NC4_X3 : ', TRIM(YVARNAME), ' already defined !'
+END IF
+
+! Write the data
+STATUS = NF90_PUT_VAR(INCID, IVARID, TPFIELD%XFIELDDATA3D)
+IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_X3[NF90_PUT_VAR] '//TRIM(TPFIELD%CMNHNAME),IRESP)
+
+KRESP = IRESP
+END SUBROUTINE IO_WRITE_FIELD_NC4_X3
+
SUBROUTINE NCWRITX4(PZCDF, HVARNAME, HDIR, PFIELD, TPFMH, KRESP)
USE MODD_FM, ONLY : FMHEADER
TYPE(IOCDF), POINTER :: PZCDF
@@ -1642,6 +1764,16 @@ END MODULE MODE_NETCDF
!
! External dummy subroutines
!
+SUBROUTINE IO_WRITE_FIELD_NC4(A,B,C)
+INTEGER :: A,B,C
+PRINT *, 'IO_WRITE_FIELD_NC4 empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF4 I/Os.'
+END SUBROUTINE IO_WRITE_FIELD_NC4
+
+SUBROUTINE IO_WRITE_HEADER_NC4(A,B)
+INTEGER :: A,B
+PRINT *, 'IO_WRITE_HEADER_NC4 empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF4 I/Os.'
+END SUBROUTINE IO_WRITE_HEADER_NC4
+
SUBROUTINE NCWRIT(A,B,C,D,E,F)
INTEGER :: A,B,C,D,E,F
PRINT *, 'NCWRIT empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF4 I/Os.'
diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index 0eb2f34c7a51e857ee5c7cbafffe8fa9bbe09bcb..24404e27bd7e8acf9bd8f4b56ac3f88bfe1b4d24 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -254,6 +254,7 @@ END MODULE MODI_MODEL_n
USE MODE_ll
USE MODE_IO_ll
USE MODE_ELEC_ll
+USE MODE_NETCDF
!
USE MODE_FM
!
@@ -954,6 +955,7 @@ IF (IOUT < NOUT_NUMB ) THEN
!
CALL IO_FILE_OPEN_ll(TZOUTFILE,CLUOUT,IRESP)
!
+ CALL IO_WRITE_HEADER_NC4(TZOUTFILE,CLUOUT)
CALL IO_FILE_CLOSE_ll(TZOUTFILE,CLUOUT,IRESP)
!
END IF
diff --git a/src/MNH/write_lfin.f90 b/src/MNH/write_lfin.f90
index 67cec64602eaf44a0391a8b629dafdee85d89eee..1202d2e7a2d346c024f750cdf3de2ecf7de55f81 100644
--- a/src/MNH/write_lfin.f90
+++ b/src/MNH/write_lfin.f90
@@ -239,7 +239,7 @@ USE MODD_LIMA_PRECIP_SCAVENGING_n
!
USE MODE_FMWRIT
USE MODE_ll
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO_ll, ONLY: TFIELDDATA, TFILEDATA
USE MODE_IO_ll, ONLY: UPCASE,CLOSE_ll
USE MODE_GRIDPROJ
USE MODE_MODELN_HANDLER
@@ -319,6 +319,7 @@ INTEGER :: IIU,IJU,IKU,IIB,IJB,IKB,IIE,IJE,IKE ! Arrays bounds
CHARACTER(LEN=2) :: INDICE
INTEGER :: I
!-------------------------------------------------------------------------------
+TYPE(TFIELDDATA) :: TZFIELD
!
!* 0. Initialization
!
@@ -654,16 +655,21 @@ YDIR='XY'
! CALL EXTRAPOL('E',XUT)
! CALL EXTRAPOL('N',XUT)
! CALL EXTRAPOL('S',XUT)
-
-
-
-CALL MPPDB_CHECK3D(XUT,"write_lfifmn before FMWRIT::XUT",PRECISION)
-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 MPPDB_CHECK3D(XUT,"write_lfifmn after FMWRIT::XUT",PRECISION)
+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 MPPDB_CHECK3D(XUT,"write_lfifmn after IO_WRITE_FIELD::XUT",PRECISION)
!
!20131128 check XVT-> X_Y_W_V wind component for PRC
CALL MPPDB_CHECK3D(XVT,"write_lfifmn::XVT",PRECISION)