From 43b84a289c9e6c460111934d6cec209fdbc0ff79 Mon Sep 17 00:00:00 2001
From: Gaelle Tanguy <gaelle.tanguy@meteo.fr>
Date: Tue, 3 May 2016 13:20:06 +0000
Subject: [PATCH] Gaelle + Didier 3/5/2016 : bug dimensions 2D cases
---
src/LIB/SURCOUCHE/src/fmread_ll.f90 | 4081 ++++++++---------
src/LIB/SURCOUCHE/src/fmwrit_ll.f90 | 6466 ++++++++++++++-------------
2 files changed, 5283 insertions(+), 5264 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/fmread_ll.f90 b/src/LIB/SURCOUCHE/src/fmread_ll.f90
index b4edb578e..e980fb9db 100644
--- a/src/LIB/SURCOUCHE/src/fmread_ll.f90
+++ b/src/LIB/SURCOUCHE/src/fmread_ll.f90
@@ -1,2035 +1,2046 @@
-!MNH_LIC Copyright 1994-2014 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.
-!-----------------------------------------------------------------
-!--------------- special set of characters for CVS information
-!-----------------------------------------------------------------
-! $Source$
-! $Name$
-! $Revision$
-! $Date$
-!-----------------------------------------------------------------
-!-----------------------------------------------------------------
-
-#ifdef MNH_MPI_DOUBLE_PRECISION
-#define MPI_FLOAT MPI_DOUBLE_PRECISION
-#else
-#define MPI_FLOAT MPI_REAL
-#endif
-
-MODULE MODE_FMREAD
-!
-!Correction :
-! J.Escobar : 22/08/2005 : BUG : manque un "GOTO 1000" si champs
-! lue non trouvé !!!
-! J.Escobar : 13/01/2015 : remove comment on BCAST(IRESP in FMREADX2_ll
-! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-! D.Gazen : avril 2016 bug dimensions 2D cases in netcdf
-!
-USE MODD_MPIF
-#if defined(MNH_IOCDF4)
-USE MODE_NETCDF
-#endif
-IMPLICIT NONE
-
-PRIVATE
-
-INTERFACE FMREAD
- MODULE PROCEDURE FMREADX0_ll,FMREADX1_ll,FMREADX2_ll,FMREADX3_ll,&
- & FMREADX4_ll,FMREADX5_ll,FMREADX6_ll,&
- & FMREADN0_ll,FMREADN1_ll,FMREADN2_ll,&
- & FMREADL0_ll,FMREADL1_ll,FMREADC0_ll,FMREADT0_ll
-END INTERFACE
-!
-
-PUBLIC FMREAD_LB,FMREAD,FMREADX0_ll,FMREADX1_ll,FMREADX2_ll,FMREADX3_ll,&
- & FMREADX4_ll,FMREADX5_ll,FMREADX6_ll,&
- & FMREADN0_ll,FMREADN1_ll,FMREADN2_ll,&
- & FMREADL0_ll,FMREADL1_ll,FMREADC0_ll,FMREADT0_ll
-
-!INCLUDE 'mpif.h'
-
-CONTAINS
-SUBROUTINE FM_READ_ERR(HFUNC,HFILEM,HFIPRI,HRECFM,HDIR,KRESP)
-USE MODE_FM, ONLY : FMLOOK_ll
-
-CHARACTER(LEN=*) :: HFUNC
-CHARACTER(LEN=*) :: HFILEM
-CHARACTER(LEN=*) :: HFIPRI
-CHARACTER(LEN=*) :: HRECFM
-CHARACTER(LEN=*) :: HDIR
-INTEGER :: KRESP
-
-INTEGER :: ILUPRI
-INTEGER :: IRESP
-
-CALL FMLOOK_ll(HFIPRI,HFIPRI,ILUPRI,IRESP)
-WRITE (ILUPRI,*) ' exit from ',HFUNC, ' with RESP:',KRESP
-!STOP "fmread_ll.f90:: FM_READ_ERR"
-
-WRITE (ILUPRI,*) ' | HFILEM = ',HFILEM
-WRITE (ILUPRI,*) ' | HRECFM = ',HRECFM
-WRITE (ILUPRI,*) ' | HDIR = ',HDIR
-
-END SUBROUTINE FM_READ_ERR
-
-
-SUBROUTINE BCAST_HEADER(TPFD,TPFMH)
-USE MODE_FD_ll, ONLY : FD_ll
-USE MODD_FM
-TYPE(FD_ll), POINTER :: TPFD
-TYPE(FMHEADER), INTENT(IN) :: TPFMH
-
-INTEGER :: ierr
-
-CALL MPI_BCAST(TPFMH%GRID,1,MPI_INTEGER,TPFD%OWNER-1,TPFD%COMM,IERR)
-CALL MPI_BCAST(TPFMH%COMLEN,1,MPI_INTEGER,TPFD%OWNER-1,TPFD%COMM,IERR)
-CALL MPI_BCAST(TPFMH%COMMENT,TPFMH%COMLEN,MPI_CHARACTER,TPFD%OWNER-1,TPFD%COMM,IERR)
-
-END SUBROUTINE BCAST_HEADER
-
-SUBROUTINE FMREADX0_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!* 0.1 Declarations of arguments
-!
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-REAL, INTENT(INOUT)::PFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
-!
-!* 0.2 Declarations of local variables
-!
-!----------------------------------------------------------------
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-TYPE(FMHEADER) :: TZFMH
-!
-!* 1.1 THE NAME OF LFIFM
-!
-IRESP = 0
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-!------------------------------------------------------------------
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE ! multiprocessor execution
- IF (ISP == TZFD%OWNER) THEN
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
- END IF
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- CALL MPI_BCAST(PFIELD,1,MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADX0_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-KRESP = IRESP
-RETURN
-
-END SUBROUTINE FMREADX0_ll
-
-SUBROUTINE FMREADX1_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP, KIMAX_ll, KJMAX_ll, TPSPLITTING)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC, ISNPROC
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-USE MODE_SCATTER_ll
-USE MODE_ALLOCBUFFER_ll
-USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!* 0.1 Declarations of arguments
-!
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
-REAL,DIMENSION(:),TARGET,INTENT(INOUT)::PFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
-INTEGER, OPTIONAL, INTENT(IN) ::KIMAX_ll
-INTEGER, OPTIONAL, INTENT(IN) ::KJMAX_ll
-TYPE(ZONE_ll), DIMENSION(ISNPROC), OPTIONAL :: TPSPLITTING ! splitting of the domain
-!
-!* 0.2 Declarations of local variables
-!
-!----------------------------------------------------------------
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-REAL,DIMENSION(:),POINTER :: ZFIELDP
-LOGICAL :: GALLOC
-TYPE(FMHEADER) :: TZFMH
-!
-!* 1.1 THE NAME OF LFIFM
-!
-GALLOC = .FALSE.
-IRESP = 0
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-!------------------------------------------------------------------
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE ! multiprocessor execution
- IF (ISP == TZFD%OWNER) THEN
- IF( PRESENT(KIMAX_ll) .AND. PRESENT(KJMAX_ll) ) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC, KIMAX_ll, KJMAX_ll)
- ELSE
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
- ENDIF
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- END IF
- ELSE
- ALLOCATE(ZFIELDP(0))
- GALLOC = .TRUE.
- END IF
-
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- IF (HDIR /= 'XX' .AND. HDIR /='YY') THEN
- ! Broadcast Field
- CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
- ELSE
- !Scatter Field
- IF( PRESENT(TPSPLITTING) ) THEN
- CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM,TPSPLITTING)
- ELSE
- CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
- ENDIF
- END IF
- END IF !(GSMONOPROC)
-
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADX1_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-
-IF (GALLOC) DEALLOCATE (ZFIELDP)
-KRESP = IRESP
-RETURN
-!------------------------------------------------------------------
-END SUBROUTINE FMREADX1_ll
-
-SUBROUTINE FMREADX2_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP, KIMAX_ll, KJMAX_ll, TPSPLITTING)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LPACK,L1D,L2D , ISNPROC
-USE MODD_PARAMETERS_ll,ONLY : JPHEXT
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-USE MODE_SCATTER_ll
-USE MODE_ALLOCBUFFER_ll
-!JUANZ
-USE MODD_TIMEZ, ONLY : TIMEZ
-USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
-!JUANZ
-USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
-#ifdef MNH_GA
- USE MODE_GA
-#endif
-
-IMPLICIT NONE
-
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-REAL,DIMENSION(:,:),TARGET, INTENT(INOUT)::PFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
-INTEGER, OPTIONAL, INTENT(IN) ::KIMAX_ll
-INTEGER, OPTIONAL, INTENT(IN) ::KJMAX_ll
-TYPE(ZONE_ll), DIMENSION(ISNPROC), OPTIONAL :: TPSPLITTING ! splitting of the domain
-!
-!
-!* 0.2 Declarations of local variables
-!
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-REAL,DIMENSION(:,:), POINTER :: ZFIELDP
-LOGICAL :: GALLOC
-TYPE(FMHEADER) :: TZFMH
-!JUANZ
-REAL*8,DIMENSION(2) :: T0,T1,T2
-REAL*8,DIMENSION(2) :: T11,T22
-!JUANZ
-#ifdef MNH_GA
-REAL,DIMENSION(:,:),POINTER :: ZFIELD_GA
-#endif
-!
-!* 1.1 THE NAME OF LFIFM
-!
-CALL SECOND_MNH2(T11)
-GALLOC = .FALSE.
-IRESP = 0
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-
-!------------------------------------------------------------------
-
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
-! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==2*JPHEXT+1 .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
- ZFIELDP=>PFIELD(2:2,2:2)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
- PFIELD(:,:)=SPREAD(SPREAD(PFIELD(2,2),DIM=1,NCOPIES=3),DIM=2,NCOPIES=3)
-! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
- ELSE IF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
- ZFIELDP=>PFIELD(:,2:2)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
- PFIELD(:,:)=SPREAD(PFIELD(:,2),DIM=2,NCOPIES=3)
- ELSE
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- END IF
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE ! multiprocessor execution
- CALL SECOND_MNH2(T0)
- IF (ISP == TZFD%OWNER) THEN
- ! I/O processor case
- IF( PRESENT(KIMAX_ll) .AND. PRESENT(KJMAX_ll) ) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC, KIMAX_ll, KJMAX_ll)
- ELSE
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
- ENDIF
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- END IF
- ELSE
- ALLOCATE(ZFIELDP(0,0))
- GALLOC = .TRUE.
- END IF
- CALL SECOND_MNH2(T1)
- TIMEZ%T_READ2D_READ=TIMEZ%T_READ2D_READ + T1 - T0
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- ! XX or YY Scatter Field
- IF( PRESENT(TPSPLITTING) ) THEN
- CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM,TPSPLITTING)
- ELSE
- CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
- ENDIF
- ELSE IF (HDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- ! 2D compact case
- IF( PRESENT(TPSPLITTING) ) THEN
- CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1),PFIELD(:,2),TZFD%OWNER,TZFD%COMM,TPSPLITTING)
- ELSE
- CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1),PFIELD(:,2),TZFD%OWNER,TZFD%COMM)
- ENDIF
- PFIELD(:,:) = SPREAD(PFIELD(:,2),DIM=2,NCOPIES=3)
- ELSE
-#ifdef MNH_GA
- !
- ! init/create the ga , dim3 = 1
- !
- CALL MNH_INIT_GA(SIZE(PFIELD,1),SIZE(PFIELD,2),1,HRECFM,"READ")
- IF (ISP == TZFD%OWNER) THEN
- !
- ! put the data in the g_a , this proc get this 1 slide
- !
- lo_zplan(JPIZ) = 1
- hi_zplan(JPIZ) = 1
- call nga_put(g_a, lo_zplan, hi_zplan,ZFIELDP, ld_zplan)
- END IF
- call ga_sync
- !
- ! get the columun data in this proc
- !
- ! temp buf to avoid problem with none stride PFIELDS buffer with HALO
- ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2)))
- call nga_get(g_a, lo_col, hi_col,ZFIELD_GA(1,1) , ld_col)
- PFIELD = ZFIELD_GA
- DEALLOCATE(ZFIELD_GA)
-#else
- ! XY Scatter Field
- CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
-#endif
- END IF
- ELSE
- CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- CALL SECOND_MNH2(T2)
- TIMEZ%T_READ2D_SCAT=TIMEZ%T_READ2D_SCAT + T2 - T1
- END IF !(GSMONOPROC)
-
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADX2_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-IF (GALLOC) DEALLOCATE (ZFIELDP)
-KRESP = IRESP
-!------------------------------------------------------------------
-
-CALL SECOND_MNH2(T22)
-TIMEZ%T_READ2D_ALL=TIMEZ%T_READ2D_ALL + T22 - T11
-
-END SUBROUTINE FMREADX2_ll
-
-SUBROUTINE FMREADX3_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LPACK,L1D,L2D
-USE MODD_PARAMETERS_ll,ONLY : JPHEXT
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-USE MODE_SCATTER_ll
-USE MODE_ALLOCBUFFER_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
-
-IMPLICIT NONE
-
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-REAL, DIMENSION(:,:,:),TARGET,INTENT(INOUT)::PFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
-!
-#ifdef MNH_GA
-REAL,DIMENSION(:,:,:),POINTER :: ZFIELD_GA
-#endif
-!
-!
-!* 0.2 Declarations of local variables
-!
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-REAL,DIMENSION(:,:,:),POINTER :: ZFIELDP
-LOGICAL :: GALLOC
-TYPE(FMHEADER) :: TZFMH
-!JUAN
-INTEGER :: JK,JKK
-CHARACTER(LEN=LEN(HRECFM)) :: 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
-LOGICAL :: GALLOC_ll
-
-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
-!JUAN
-!
-!* 1.1 THE NAME OF LFIFM
-!
-CALL SECOND_MNH2(T11)
-GALLOC = .FALSE.
-GALLOC_ll = .FALSE.
-IRESP = 0
-YFNLFI = TRIM(ADJUSTL(HFILEM))//'.lfi'
-!------------------------------------------------------------------
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC .AND. (TZFD%nb_procio.eq.1) ) THEN ! sequential execution
-! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==2*JPHEXT+1 .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
- ZFIELDP=>PFIELD(2:2,2:2,:)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
- PFIELD(:,:,:)=SPREAD(SPREAD(PFIELD(2,2,:),DIM=1,NCOPIES=3),DIM=2,NCOPIES=3)
-! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
- ELSE IF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
- ALLOCATE (ZFIELDP(SIZE(PFIELD,1),1,SIZE(PFIELD,3)))
- GALLOC = .TRUE.
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
- PFIELD(:,:,:)=SPREAD(ZFIELDP(:,1,:),DIM=2,NCOPIES=3)
- ELSE
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- END IF
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSEIF ( (TZFD%nb_procio .eq. 1 ) .OR. ( HDIR == '--' ) ) THEN ! multiprocessor execution & 1 IO proc
- ! read 3D field for graphique
- IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- END IF
- ELSE
- ALLOCATE(ZFIELDP(0,0,0))
- GALLOC = .TRUE.
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- ! XX or YY Scatter Field
- CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
- ELSE IF (HDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- ! 2D compact case
- CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1,:),PFIELD(:,2,:),TZFD%OWNER,TZFD%COMM)
- PFIELD(:,:,:) = SPREAD(PFIELD(:,2,:),DIM=2,NCOPIES=3)
- ELSE
- ! XY Scatter Field
- CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
- END IF
- ELSE
- ! Broadcast Field
- CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- ELSE ! multiprocessor execution & // IO
-!
-!JUAN BG Z SLIDE
-!
-#ifdef MNH_GA
- !
- ! init/create the ga
- !
- CALL SECOND_MNH2(T0)
- CALL MNH_INIT_GA(SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3),HRECFM,"READ")
- !
- ! read 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(HFILEM)//YK_FILE//".lfi"
- TZFD_IOZ => GETFD(YFILE_IOZ)
- !
- IK_RANK = TZFD_IOZ%OWNER
- !
- IF (ISP == IK_RANK ) THEN
- IF ( SIZE(ZSLIDE_ll) .EQ. 0 ) THEN
- DEALLOCATE(ZSLIDE_ll)
- CALL ALLOCBUFFER_ll(ZSLIDE_ll,ZSLIDE,HDIR,GALLOC_ll)
- END IF
- !
- CALL SECOND_MNH2(T0)
- WRITE(YK,'(I4.4)') JKK
- YRECZSLIDE = TRIM(HRECFM)//YK
- IF (ASSOCIATED(TZFD_IOZ%CDF)) THEN
- CALL NCREAD(TZFD_IOZ%CDF%NCID,YRECZSLIDE,ZSLIDE_ll,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD_IOZ%FLU,YRECZSLIDE,.TRUE.,SIZE(ZSLIDE_ll),ZSLIDE_ll,TZFMH&
- & ,IRESP)
- END IF
- CALL SECOND_MNH2(T1)
- TIMEZ%T_READ3D_READ=TIMEZ%T_READ3D_READ + T1 - T0
- !
- ! put the data in the g_a , this proc get this JKK slide
- !
- lo_zplan(JPIZ) = JKK
- hi_zplan(JPIZ) = JKK
- call nga_put(g_a, lo_zplan, hi_zplan,ZSLIDE_ll, ld_zplan)
- END IF
- END DO
- call ga_sync
- !
- ! get the columun data in this proc
- !
- ! temp buf to avoid problem with none stride PFIELDS buffer with HALO
- ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3)))
- call nga_get(g_a, lo_col, hi_col,ZFIELD_GA(1,1,1) , ld_col)
- PFIELD = ZFIELD_GA
- DEALLOCATE(ZFIELD_GA)
-#else
- ALLOCATE(ZSLIDE_ll(0,0))
- GALLOC_ll = .TRUE.
- inb_proc_real = min(TZFD%nb_procio,ISNPROC)
- Z_SLIDE: DO JK=1,SIZE(PFIELD,3),inb_proc_real
- !
- ! read the data
- !
- JK_MAX=min(SIZE(PFIELD,3),JK+inb_proc_real-1)
- !
- NB_REQ=0
- ALLOCATE(REQ_TAB(ISNPROC-1))
- ALLOCATE(T_TX2DP(ISNPROC-1))
- 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(HFILEM)//YK_FILE//".lfi"
- TZFD_IOZ => GETFD(YFILE_IOZ)
- ELSE
- TZFD_IOZ => TZFD
- ENDIF
- IK_RANK = TZFD_IOZ%OWNER
- IF (ISP == IK_RANK ) THEN
- IF ( SIZE(ZSLIDE_ll) .EQ. 0 ) THEN
- DEALLOCATE(ZSLIDE_ll)
- CALL ALLOCBUFFER_ll(ZSLIDE_ll,ZSLIDE,HDIR,GALLOC_ll)
- END IF
- !JUAN
- CALL SECOND_MNH2(T0)
- WRITE(YK,'(I4.4)') JKK
- YRECZSLIDE = TRIM(HRECFM)//YK
- IF (ASSOCIATED(TZFD_IOZ%CDF)) THEN
- CALL NCREAD(TZFD_IOZ%CDF%NCID,YRECZSLIDE,ZSLIDE_ll,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD_IOZ%FLU,YRECZSLIDE,.TRUE.,SIZE(ZSLIDE_ll),ZSLIDE_ll,TZFMH&
- & ,IRESP)
- END IF
- !JUANIOZ
- CALL SECOND_MNH2(T1)
- TIMEZ%T_READ3D_READ=TIMEZ%T_READ3D_READ + T1 - T0
- DO JI = 1,ISNPROC
- CALL GET_DOMREAD_ll(JI,IXO,IXE,IYO,IYE)
- TX2DP=>ZSLIDE_ll(IXO:IXE,IYO:IYE)
- IF (ISP /= JI) THEN
- NB_REQ = NB_REQ + 1
- ALLOCATE(T_TX2DP(NB_REQ)%X(IXO:IXE,IYO:IYE))
- T_TX2DP(NB_REQ)%X=TX2DP
- CALL MPI_ISEND(T_TX2DP(NB_REQ)%X,SIZE(TX2DP),MPI_FLOAT,JI-1,199+IK_RANK &
- & ,TZFD_IOZ%COMM,REQ_TAB(NB_REQ),IERR)
- !CALL MPI_BSEND(TX2DP,SIZE(TX2DP),MPI_FLOAT,JI-1,199+IK_RANK,TZFD_IOZ%COMM,IERR)
- ELSE
- PFIELD(:,:,JKK) = TX2DP(:,:)
- END IF
- END DO
- CALL SECOND_MNH2(T2)
- TIMEZ%T_READ3D_SEND=TIMEZ%T_READ3D_SEND + T2 - T1
- !JUANIOZ
- END IF
- END DO
- !
- ! brodcast the data
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- ! XX or YY Scatter Field
- STOP " XX ou YY NON PREVU SUR BG POUR LE MOMENT "
- CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
- ELSE IF (HDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- ! 2D compact case
- STOP " L2D NON PREVU SUR BG POUR LE MOMENT "
- CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1,:),PFIELD(:,2,:),TZFD%OWNER,TZFD%COMM)
- PFIELD(:,:,:) = SPREAD(PFIELD(:,2,:),DIM=2,NCOPIES=3)
- ELSE
- !
- ! XY Scatter Field
- !
- CALL SECOND_MNH2(T0)
- DO JKK=JK,JK_MAX
- !
- ! get the file & rank
- !
- 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(HFILEM)//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
- !
- ZSLIDE => PFIELD(:,:,JKK)
-!JUANIOZ
- !CALL SCATTER_XYFIELD(ZSLIDE_ll,ZSLIDE,TZFD_IOZ%OWNER,TZFD_IOZ%COMM)
- IF (ISP .NE. IK_RANK) THEN
- CALL MPI_RECV(ZSLIDE,SIZE(ZSLIDE),MPI_FLOAT,IK_RANK-1,199+IK_RANK,TZFD_IOZ%COMM&
- & ,STATUS,IERR)
- END IF
-!JUAN IOZ
- END DO
- CALL SECOND_MNH2(T1)
- TIMEZ%T_READ3D_RECV=TIMEZ%T_READ3D_RECV + T1 - T0
- END IF
- ELSE
- ! Broadcast Field
- STOP " Broadcast Field NON PREVU SUR BG POUR LE MOMENT "
- CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- CALL SECOND_MNH2(T0)
- IF (NB_REQ .GT.0 ) THEN
- CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
- 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_READ3D_WAIT=TIMEZ%T_READ3D_WAIT + T1 - T0
- END DO Z_SLIDE
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
-#endif
-!JUAN BG Z SLIDE
- END IF !(GSMONOPROC)
-
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADX3_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-IF (GALLOC) DEALLOCATE (ZFIELDP)
-IF (GALLOC_ll) DEALLOCATE (ZSLIDE_ll)
-!IF (ASSOCIATED(ZSLIDE_ll)) DEALLOCATE (ZSLIDE_ll)
-KRESP = IRESP
-CALL MPI_BARRIER(TZFD%COMM,IERR)
-CALL SECOND_MNH2(T22)
-TIMEZ%T_READ3D_ALL=TIMEZ%T_READ3D_ALL + T22 - T11
-
-!------------------------------------------------------------------
-END SUBROUTINE FMREADX3_ll
-
-SUBROUTINE FMREADX4_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LPACK,L1D,L2D
-USE MODD_PARAMETERS_ll,ONLY : JPHEXT
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-USE MODE_SCATTER_ll
-USE MODE_ALLOCBUFFER_ll
-
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-REAL,DIMENSION(:,:,:,:),TARGET,INTENT(INOUT)::PFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code if
-!
-!
-!* 0.2 Declarations of local variables
-!
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-REAL,DIMENSION(:,:,:,:),POINTER :: ZFIELDP
-LOGICAL :: GALLOC
-TYPE(FMHEADER) :: TZFMH
-!
-!* 1.1 THE NAME OF LFIFM
-!
-GALLOC = .FALSE.
-IRESP = 0
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-!------------------------------------------------------------------
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
-! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==2*JPHEXT+1 .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
- ZFIELDP=>PFIELD(2:2,2:2,:,:)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
- PFIELD(:,:,:,:)=SPREAD(SPREAD(PFIELD(2,2,:,:),DIM=1,NCOPIES=3),DIM=2,NCOPIES=3)
-! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
- ELSE IF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
- ZFIELDP=>PFIELD(:,2:2,:,:)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
- PFIELD(:,:,:,:)=SPREAD(PFIELD(:,2,:,:),DIM=2,NCOPIES=3)
- ELSE
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- END IF
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- END IF
- ELSE
- ALLOCATE(ZFIELDP(0,0,0,0))
- GALLOC = .TRUE.
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- ! XX or YY Scatter Field
- CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
- ELSE IF (HDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- ! 2D compact case
- CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1,:,:),PFIELD(:,2,:,:),TZFD%OWNER,TZFD%COMM)
- PFIELD(:,:,:,:) = SPREAD(PFIELD(:,2,:,:),DIM=2,NCOPIES=3)
- ELSE
- ! XY Scatter Field
- CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
- END IF
- ELSE
- ! Broadcast Field
- CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- END IF
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADX4_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-
-IF (GALLOC) DEALLOCATE (ZFIELDP)
-KRESP = IRESP
-RETURN
-!------------------------------------------------------------------
-END SUBROUTINE FMREADX4_ll
-
-SUBROUTINE FMREADX5_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LPACK,L1D,L2D
-USE MODD_PARAMETERS_ll,ONLY : JPHEXT
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-USE MODE_SCATTER_ll
-USE MODE_ALLOCBUFFER_ll
-
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(INOUT)::PFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
-!
-!
-!* 0.2 Declarations of local variables
-!
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-REAL,DIMENSION(:,:,:,:,:),POINTER :: ZFIELDP
-LOGICAL :: GALLOC
-TYPE(FMHEADER) :: TZFMH
-!
-!* 1.1 THE NAME OF LFIFM
-!
-GALLOC = .FALSE.
-IRESP = 0
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-!------------------------------------------------------------------
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
-! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==2*JPHEXT+1 .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
- ZFIELDP=>PFIELD(2:2,2:2,:,:,:)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
- PFIELD(:,:,:,:,:)=SPREAD(SPREAD(PFIELD(2,2,:,:,:),DIM=1,NCOPIES=3),DIM=2,NCOPIES=3)
-! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
- ELSE IF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
- ZFIELDP=>PFIELD(:,2:2,:,:,:)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
- PFIELD(:,:,:,:,:)=SPREAD(PFIELD(:,2,:,:,:),DIM=2,NCOPIES=3)
- ELSE
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- END IF
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE ! multiprocessor execution
- IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- END IF
- ELSE
- ALLOCATE(ZFIELDP(0,0,0,0,0))
- GALLOC = .TRUE.
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- ! XX or YY Scatter Field
- CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
- ELSE IF (HDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- ! 2D compact case
- CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1,:,:,:),PFIELD(:,2,:,:,:),&
- & TZFD%OWNER,TZFD%COMM)
- PFIELD(:,:,:,:,:) = SPREAD(PFIELD(:,2,:,:,:),DIM=2,NCOPIES=3)
- ELSE
- ! XY Scatter Field
- CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
- END IF
- ELSE
- ! Broadcast Field
- CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- END IF
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADX5_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-IF (GALLOC) DEALLOCATE (ZFIELDP)
-KRESP = IRESP
-RETURN
-!------------------------------------------------------------------
-END SUBROUTINE FMREADX5_ll
-
-SUBROUTINE FMREADX6_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-USE MODE_SCATTER_ll
-USE MODE_ALLOCBUFFER_ll
-
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-REAL,DIMENSION(:,:,:,:,:,:),TARGET,INTENT(INOUT)::PFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
-!
-!
-!* 0.2 Declarations of local variables
-!
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-REAL,DIMENSION(:,:,:,:,:,:),POINTER :: ZFIELDP
-LOGICAL :: GALLOC
-TYPE(FMHEADER) :: TZFMH
-!
-!* 1.1 THE NAME OF LFIFM
-!
-GALLOC = .FALSE.
-IRESP = 0
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-!------------------------------------------------------------------
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE ! multiprocessor execution
- IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- END IF
- ELSE
- ALLOCATE(ZFIELDP(0,0,0,0,0,0))
- GALLOC = .TRUE.
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- ! XX or YY Scatter Field
- CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
- ELSE IF (HDIR == 'XY') THEN
- ! XY Scatter Field
- CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
- ELSE
- ! Broadcast Field
- CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- END IF
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADX6_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-IF (GALLOC) DEALLOCATE (ZFIELDP)
-KRESP = IRESP
-RETURN
-!------------------------------------------------------------------
-END SUBROUTINE FMREADX6_ll
-
-SUBROUTINE FMREADN0_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!* 0.1 Declarations of arguments
-!
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
-INTEGER, INTENT(INOUT)::KFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
-!
-!* 0.2 Declarations of local variables
-!
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-TYPE(FMHEADER) :: TZFMH
-
-!
-!* 1.1 THE NAME OF LFIFM
-!
-IRESP = 0
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-!
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,KFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,KFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
- END IF
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- CALL MPI_BCAST(KFIELD,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADN0_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-KRESP = IRESP
-RETURN
-
-END SUBROUTINE FMREADN0_ll
-
-SUBROUTINE FMREADN1_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-USE MODE_SCATTER_ll
-USE MODE_ALLOCBUFFER_ll
-
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!* 0.1 Declarations of arguments
-!
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
-INTEGER,DIMENSION(:),TARGET,INTENT(INOUT)::KFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
-!
-!* 0.2 Declarations of local variables
-!
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-INTEGER,DIMENSION(:),POINTER :: IFIELDP
-LOGICAL :: GALLOC
-TYPE(FMHEADER) :: TZFMH
-!
-!* 1.1 THE NAME OF LFIFM
-!
-GALLOC = .FALSE.
-IRESP = 0
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-!------------------------------------------------------------------
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,KFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(KFIELD),KFIELD,TZFMH,IRESP)
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,HDIR,GALLOC)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH&
- & ,IRESP)
- END IF
- ELSE
- ALLOCATE(IFIELDP(0))
- GALLOC = .TRUE.
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- IF (HDIR /= 'XX' .AND. HDIR /='YY') THEN
- ! Broadcast Field
- CALL MPI_BCAST(KFIELD,SIZE(KFIELD),MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- ELSE
- !Scatter Field
- CALL SCATTER_XXFIELD(HDIR,IFIELDP,KFIELD,TZFD%OWNER,TZFD%COMM)
- END IF
- END IF
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADN1_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-IF (GALLOC) DEALLOCATE (IFIELDP)
-KRESP = IRESP
-RETURN
-
-END SUBROUTINE FMREADN1_ll
-
-SUBROUTINE FMREADN2_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LPACK,L1D,L2D
-USE MODD_PARAMETERS_ll,ONLY : JPHEXT
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-USE MODE_SCATTER_ll
-USE MODE_ALLOCBUFFER_ll
-
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-INTEGER, DIMENSION(:,:),TARGET,INTENT(INOUT)::KFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
-!
-!
-!* 0.2 Declarations of local variables
-!
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-INTEGER,DIMENSION(:,:),POINTER :: IFIELDP
-LOGICAL :: GALLOC
-TYPE(FMHEADER) :: TZFMH
-!
-!* 1.1 THE NAME OF LFIFM
-!
-GALLOC = .FALSE.
-IRESP = 0
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-!------------------------------------------------------------------
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
-! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
- IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==2*JPHEXT+1 .AND. SIZE(KFIELD,2)==2*JPHEXT+1) THEN
- IFIELDP=>KFIELD(2:2,2:2)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH,IRESP)
- END IF
- KFIELD(:,:)=SPREAD(SPREAD(KFIELD(2,2),DIM=1,NCOPIES=3),DIM=2,NCOPIES=3)
-! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
- ELSE IF (LPACK .AND. L2D .AND. SIZE(KFIELD,2)==2*JPHEXT+1) THEN
- IFIELDP=>KFIELD(:,2:2)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH,IRESP)
- END IF
- KFIELD(:,:)=SPREAD(KFIELD(:,2),DIM=2,NCOPIES=3)
- ELSE
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,KFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(KFIELD),KFIELD,TZFMH,IRESP)
- END IF
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,HDIR,GALLOC)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP&
- & ,TZFMH,IRESP)
- END IF
- ELSE
- ALLOCATE(IFIELDP(0,0))
- GALLOC = .TRUE.
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- ! XX or YY Scatter Field
- CALL SCATTER_XXFIELD(HDIR,IFIELDP,KFIELD,TZFD%OWNER,TZFD&
- & %COMM)
- ELSE IF (HDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- ! 2D compact case
- CALL SCATTER_XXFIELD('XX',IFIELDP(:,1),KFIELD(:,2),TZFD%OWNER,TZFD%COMM)
- KFIELD(:,:) = SPREAD(KFIELD(:,2),DIM=2,NCOPIES=3)
- ELSE
- ! XY Scatter Field
- CALL SCATTER_XYFIELD(IFIELDP,KFIELD,TZFD%OWNER,TZFD%COMM)
- END IF
- ELSE
- ! Broadcast Field
- IF (ISP == TZFD%OWNER) KFIELD = IFIELDP
- CALL MPI_BCAST(KFIELD,SIZE(KFIELD),MPI_INTEGER,TZFD%OWNER-1&
- & ,TZFD%COMM,IERR)
- END IF
- END IF
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADN2_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-!
-IF (GALLOC) DEALLOCATE (IFIELDP)
-KRESP = IRESP
-RETURN
-!------------------------------------------------------------------
-END SUBROUTINE FMREADN2_ll
-
-
-SUBROUTINE FMREADL0_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!* 0.1 Declarations of arguments
-!
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-LOGICAL, INTENT(INOUT)::OFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
-!
-!* 0.2 Declarations of local variables
-!
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-INTEGER :: IFIELD
-TYPE(FMHEADER) :: TZFMH
-
-!
-!* 1.1 THE NAME OF LFIFM
-!
-IRESP = 0
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-!------------------------------------------------------------------
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,1,IFIELD,TZFMH,IRESP)
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,1,IFIELD,TZFMH,IRESP)
- END IF
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- CALL MPI_BCAST(IFIELD,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,&
- & IERR)
- END IF
- IF (IFIELD==1) THEN
- OFIELD=.TRUE.
- ELSE
- OFIELD=.FALSE.
- END IF
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADL0_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-KRESP = IRESP
-RETURN
-
-END SUBROUTINE FMREADL0_ll
-
-SUBROUTINE FMREADL1_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-!
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
-LOGICAL, DIMENSION(:), INTENT(INOUT)::OFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
-!
-!* 0.2 Declarations of local variables
-!
-
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-INTEGER, DIMENSION(SIZE(OFIELD)) :: IFIELD
-TYPE(FMHEADER) :: TZFMH
-
-!
-!* 1.1 THE NAME OF LFIFM
-!
-IRESP = 0
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-!
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELD),IFIELD,TZFMH&
- & ,IRESP)
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELD),IFIELD,TZFMH&
- & ,IRESP)
- END IF
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- CALL MPI_BCAST(IFIELD,SIZE(IFIELD),MPI_INTEGER,TZFD%OWNER-1,TZFD&
- & %COMM,IERR)
- END IF
- WHERE (IFIELD==1)
- OFIELD=.TRUE.
- ELSEWHERE
- OFIELD=.FALSE.
- END WHERE
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADL1_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-KRESP = IRESP
-RETURN
-
-END SUBROUTINE FMREADL1_ll
-
-SUBROUTINE FMREADC0_ll(HFILEM,HRECFM,HFIPRI,HDIR,HFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIREAD
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!* 0.1 Declarations of arguments
-!
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
-CHARACTER(LEN=*), INTENT(INOUT)::HFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
-!
-!* 0.2 Declarations of local variables
-!
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-INTEGER :: JLOOP
-INTEGER, DIMENSION(LEN(HFIELD)) :: IFIELD
-CHARACTER(LEN(HFIELD)) :: YFIELD
-INTEGER :: ILENG
-TYPE(FMHEADER) :: TZFMH
-
-!
-!* 1.1 THE NAME OF LFIFM
-!
-IRESP = 0
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-ILENG=LEN(HFIELD)
-!
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,YFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,IRESP)
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE ! parallel execution
- IF (ISP == TZFD%OWNER) THEN
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,YFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,IRESP)
- END IF
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- IF (LIOCDF4 .AND. .NOT. LLFIREAD) THEN
- ! NetCDF
- CALL MPI_BCAST(YFIELD,ILENG,MPI_CHARACTER,TZFD%OWNER-1,TZFD%COMM,&
- &IERR)
- ELSE
- ! LFI
- CALL MPI_BCAST(IFIELD,ILENG,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,&
- & IERR)
- END IF
- END IF ! parallel execution
- !
- IF (LIOCDF4 .AND. .NOT. LLFIREAD) THEN
- ! NetCDF
- HFIELD = YFIELD
- ELSE
- ! LFI Case
- DO JLOOP=1,ILENG
- HFIELD(JLOOP:JLOOP)=ACHAR(IFIELD(JLOOP))
- END DO
- END IF
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADC0_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-KRESP = IRESP
-RETURN
-
-END SUBROUTINE FMREADC0_ll
-
-SUBROUTINE FMREADT0_ll(HFILEM,HRECFM,HFIPRI,HDIR,TFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
-USE MODD_TYPE_DATE
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-!
-!* 0.1 Declarations of arguments
-!
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
-TYPE (DATE_TIME), INTENT(INOUT)::TFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
-!
-!
-!* 0.2 Declarations of local variables
-!
-!-------------------------------------------------------------------------------
-
-
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-INTEGER,DIMENSION(3) :: ITDATE
-REAL :: ZTIME
-TYPE(FMHEADER) :: TZFMH
-
-!
-!* 1.1 THE NAME OF LFIFM
-!
-IRESP = 0
-
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,TRIM(HRECFM)//'%TDATE',ITDATE,TZFMH,IRESP)
- CALL NCREAD(TZFD%CDF%NCID,TRIM(HRECFM)//'%TIME',ZTIME,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,TRIM(HRECFM)//'%TDATE',.FALSE.,3,ITDATE&
- & ,TZFMH,IRESP)
- CALL FM_READ_ll(TZFD%FLU,TRIM(HRECFM)//'%TIME',.TRUE.,1,ZTIME&
- & ,TZFMH,IRESP)
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,TRIM(HRECFM)//'%TDATE',ITDATE,TZFMH,IRESP)
- CALL NCREAD(TZFD%CDF%NCID,TRIM(HRECFM)//'%TIME',ZTIME,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,TRIM(HRECFM)//'%TDATE',.FALSE.,3,ITDATE&
- & ,TZFMH,IRESP)
- CALL FM_READ_ll(TZFD%FLU,TRIM(HRECFM)//'%TIME',.TRUE.,1,ZTIME&
- & ,TZFMH,IRESP)
-
- END IF
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- ! Last header is significant
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- CALL MPI_BCAST(ITDATE,3,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- CALL MPI_BCAST(ZTIME,1,MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- TFIELD%TDATE = DATE(ITDATE(1),ITDATE(2),ITDATE(3))
- TFIELD%TIME = ZTIME
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADT0_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-KRESP = IRESP
-RETURN
-
-END SUBROUTINE FMREADT0_ll
-
-SUBROUTINE FMREAD_LB(HFILEM,HRECFM,HFIPRI,HLBTYPE,PLB,KRIM,KL3D,&
- & KGRID,KLENCH,HCOMMENT,KRESP)
-USE MODD_FM
-USE MODD_IO_ll, ONLY : ISP,ISNPROC,GSMONOPROC,LPACK,L2D
-USE MODD_PARAMETERS_ll,ONLY : JPHEXT
-USE MODE_DISTRIB_LB
-USE MODE_TOOLS_ll, ONLY : GET_GLOBALDIMS_ll
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-!JUANZ
-USE MODD_TIMEZ, ONLY : TIMEZ
-USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
-!JUANZ
-USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
-
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to be written
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! file for prints
-CHARACTER(LEN=*), INTENT(IN) ::HLBTYPE ! 'LBX','LBXU','LBY' or 'LBYV'
-REAL, DIMENSION(:,:,:),TARGET, INTENT(INOUT)::PLB ! array containing the LB field
-INTEGER, INTENT(IN) :: KRIM ! size of the LB area
-INTEGER, INTENT(IN) :: KL3D ! size of the LB array in FM
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
-!
-!* 0.2 Declarations of local variables
-!
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-REAL,DIMENSION(:,:,:),ALLOCATABLE,TARGET :: Z3D
-REAL,DIMENSION(:,:,:), POINTER :: TX3DP
-TYPE(FMHEADER) :: TZFMH
-INTEGER :: IIMAX_ll,IJMAX_ll
-INTEGER :: IIB,IIE,IJB,IJE
-INTEGER :: JI
-INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
-INTEGER, ALLOCATABLE,DIMENSION(:,:) :: STATUSES
-!JUANZIO
-!JUAN INTEGER,SAVE,DIMENSION(100000) :: REQ_TAB
-INTEGER,ALLOCATABLE,DIMENSION(:) :: REQ_TAB
-INTEGER :: NB_REQ,IKU
-TYPE TX_3DP
-REAL,DIMENSION(:,:,:), POINTER :: X
-END TYPE
-TYPE(TX_3DP),ALLOCATABLE,DIMENSION(:) :: T_TX3DP
-REAL*8,DIMENSION(2) :: T0,T1,T2,T3
-REAL*8,DIMENSION(2) :: T11,T22
-!JUANZIO
-
-!
-!* 1.1 THE NAME OF LFIFM
-!
-CALL SECOND_MNH2(T11)
-IRESP = 0
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-!------------------------------------------------------------------
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (HLBTYPE == 'LBX' .OR. HLBTYPE == 'LBXU') THEN
- ALLOCATE(Z3D(KL3D,SIZE(PLB,2),SIZE(PLB,3)))
- Z3D = 0.0
- IF (LPACK .AND. L2D) THEN
- TX3DP=>Z3D(:,JPHEXT+1:JPHEXT+1,:)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,TX3DP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(TX3DP),TX3DP,TZFMH,IRESP)
- END IF
- Z3D(:,:,:) = SPREAD(Z3D(:,JPHEXT+1,:),DIM=2,NCOPIES=2*JPHEXT+1)
- ELSE
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,Z3D,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(Z3D),Z3D,TZFMH,IRESP)
- END IF
- END IF
- PLB(1:KRIM+JPHEXT,:,:) = Z3D(1:KRIM+JPHEXT,:,:)
- PLB(KRIM+JPHEXT+1:2*(KRIM+JPHEXT),:,:) = Z3D(KL3D-KRIM-JPHEXT+1:KL3D,:,:)
- ELSE !(HLBTYPE == 'LBY' .OR. HLBTYPE == 'LBYV')
- ALLOCATE(Z3D(SIZE(PLB,1),KL3D,SIZE(PLB,3)))
- Z3D = 0.0
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,Z3D,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(Z3D),Z3D,TZFMH,IRESP)
- END IF
- PLB(:,1:KRIM+JPHEXT,:) = Z3D(:,1:KRIM+JPHEXT,:)
- PLB(:,KRIM+JPHEXT+1:2*(KRIM+JPHEXT),:) = Z3D(:,KL3D-KRIM-JPHEXT+1:KL3D,:)
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE ! multiprocessor execution
- IF (ISP == TZFD%OWNER) THEN
- CALL SECOND_MNH2(T0)
- CALL GET_GLOBALDIMS_ll(IIMAX_ll,IJMAX_ll)
- IF (HLBTYPE == 'LBX' .OR. HLBTYPE == 'LBXU') THEN
- ALLOCATE(Z3D(KL3D,IJMAX_ll+2*JPHEXT,SIZE(PLB,3)))
- Z3D = 0.0
- IF (LPACK .AND. L2D) THEN
- TX3DP=>Z3D(:,JPHEXT+1:JPHEXT+1,:)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,TX3DP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(TX3DP),TX3DP,TZFMH,IRESP)
- END IF
- Z3D(:,:,:) = SPREAD(Z3D(:,JPHEXT+1,:),DIM=2,NCOPIES=2*JPHEXT+1)
- ELSE
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,Z3D,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(Z3D),Z3D,TZFMH,IRESP)
- END IF
- END IF
- ! erase gap in LB field
- Z3D(KRIM+JPHEXT+1:2*(KRIM+JPHEXT),:,:) = Z3D(KL3D-KRIM-JPHEXT+1:KL3D,:,:)
- ELSE !(HLBTYPE == 'LBY' .OR. HLBTYPE == 'LBYV')
- ALLOCATE(Z3D(IIMAX_ll+2*JPHEXT,KL3D,SIZE(PLB,3)))
- Z3D = 0.0
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,Z3D,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(Z3D),Z3D,TZFMH,IRESP)
- END IF
- ! erase gap in LB field
- Z3D(:,KRIM+JPHEXT+1:2*(KRIM+JPHEXT),:) = Z3D(:,KL3D-KRIM-JPHEXT+1:KL3D,:)
- END IF
- CALL SECOND_MNH2(T1)
- TIMEZ%T_READLB_READ=TIMEZ%T_READLB_READ + T1 - T0
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- NB_REQ=0
- ALLOCATE(REQ_TAB(ISNPROC-1))
- !REQ_TAB=MPI_REQUEST_NULL
- IF (ISP == TZFD%OWNER) THEN
- CALL SECOND_MNH2(T1)
- !ALLOCATE(REQ_TAB(ISNPROC-1))
- !REQ_TAB=MPI_REQUEST_NULL
- ALLOCATE(T_TX3DP(ISNPROC-1))
- IKU = SIZE(Z3D,3)
- DO JI = 1,ISNPROC
- CALL GET_DISTRIB_LB(HLBTYPE,JI,'FM','READ',KRIM,IIB,IIE,IJB,IJE)
- IF (IIB /= 0) THEN
- TX3DP=>Z3D(IIB:IIE,IJB:IJE,:)
- IF (ISP /= JI) THEN
- NB_REQ = NB_REQ + 1
- ALLOCATE(T_TX3DP(NB_REQ)%X(IIB:IIE,IJB:IJE,IKU))
- T_TX3DP(NB_REQ)%X=Z3D(IIB:IIE,IJB:IJE,:)
- CALL MPI_ISEND(T_TX3DP(NB_REQ)%X,SIZE(TX3DP),MPI_FLOAT,JI-1,99,TZFD%COMM,REQ_TAB(NB_REQ),IERR)
- !CALL MPI_BSEND(T_TX3DP(NB_REQ)%X,SIZE(TX3DP),MPI_FLOAT,JI-1,99,TZFD%COMM,IERR)
- ELSE
- CALL GET_DISTRIB_LB(HLBTYPE,JI,'LOC','READ',KRIM,IIB,IIE,IJB,IJE)
- PLB(IIB:IIE,IJB:IJE,:) = TX3DP(:,:,:)
- END IF
- END IF
- END DO
- CALL SECOND_MNH2(T2)
- TIMEZ%T_READLB_SEND=TIMEZ%T_READLB_SEND + T2 - T1
- IF (NB_REQ .GT.0 ) THEN
- !ALLOCATE(STATUSES(MPI_STATUS_SIZE,NB_REQ))
- !CALL MPI_WAITALL(NB_REQ,REQ_TAB,STATUSES,IERR)
- CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
- !DEALLOCATE(STATUSES)
- DO JI=1,NB_REQ ; DEALLOCATE(T_TX3DP(JI)%X) ; ENDDO
- END IF
- DEALLOCATE(T_TX3DP)
- !DEALLOCATE(REQ_TAB)
- CALL SECOND_MNH2(T3)
- TIMEZ%T_READLB_WAIT=TIMEZ%T_READLB_WAIT + T3 - T2
- ELSE
- CALL SECOND_MNH2(T0)
- !ALLOCATE(REQ_TAB(1))
- !REQ_TAB=MPI_REQUEST_NULL
- CALL GET_DISTRIB_LB(HLBTYPE,ISP,'LOC','READ',KRIM,IIB,IIE,IJB,IJE)
- IF (IIB /= 0) THEN
- TX3DP=>PLB(IIB:IIE,IJB:IJE,:)
- CALL MPI_RECV(TX3DP,SIZE(TX3DP),MPI_FLOAT,TZFD%OWNER-1,99,TZFD%COMM,STATUS,IERR)
- !NB_REQ = NB_REQ + 1
- !CALL MPI_IRECV(TX3DP,SIZE(TX3DP),MPI_FLOAT,TZFD%OWNER-1,99,TZFD%COMM,REQ_TAB(NB_REQ),IERR)
- !IF (NB_REQ .GT.0 ) CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
- END IF
- CALL SECOND_MNH2(T1)
- TIMEZ%T_READLB_RECV=TIMEZ%T_READLB_RECV + T1 - T0
- END IF
- DEALLOCATE(REQ_TAB)
- END IF !(GSMONOPROC)
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREAD_LB",HFILEM,HFIPRI,HRECFM,HLBTYPE,IRESP)
-ENDIF
-!
-IF (ALLOCATED(Z3D)) DEALLOCATE (Z3D)
-KRESP = IRESP
-!
-!CALL MPI_BARRIER(TZFD%COMM,IERR)
-CALL SECOND_MNH2(T22)
-TIMEZ%T_READLB_ALL=TIMEZ%T_READLB_ALL + T22 - T11
-END SUBROUTINE FMREAD_LB
-
-END MODULE MODE_FMREAD
-
-
-!
+!MNH_LIC Copyright 1994-2014 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.
+!-----------------------------------------------------------------
+!--------------- special set of characters for CVS information
+!-----------------------------------------------------------------
+! $Source$
+! $Name$
+! $Revision$
+! $Date$
+!-----------------------------------------------------------------
+!-----------------------------------------------------------------
+
+#ifdef MNH_MPI_DOUBLE_PRECISION
+#define MPI_FLOAT MPI_DOUBLE_PRECISION
+#else
+#define MPI_FLOAT MPI_REAL
+#endif
+
+MODULE MODE_FMREAD
+!
+!Correction :
+! J.Escobar : 22/08/2005 : BUG : manque un "GOTO 1000" si champs
+! lue non trouvé !!!
+! J.Escobar : 13/01/2015 : remove comment on BCAST(IRESP in FMREADX2_ll
+! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!
+USE MODD_MPIF
+#if defined(MNH_IOCDF4)
+USE MODE_NETCDF
+#endif
+IMPLICIT NONE
+
+PRIVATE
+
+INTERFACE FMREAD
+ MODULE PROCEDURE FMREADX0_ll,FMREADX1_ll,FMREADX2_ll,FMREADX3_ll,&
+ & FMREADX4_ll,FMREADX5_ll,FMREADX6_ll,&
+ & FMREADN0_ll,FMREADN1_ll,FMREADN2_ll,&
+ & FMREADL0_ll,FMREADL1_ll,FMREADC0_ll,FMREADT0_ll
+END INTERFACE
+!
+
+PUBLIC FMREAD_LB,FMREAD,FMREADX0_ll,FMREADX1_ll,FMREADX2_ll,FMREADX3_ll,&
+ & FMREADX4_ll,FMREADX5_ll,FMREADX6_ll,&
+ & FMREADN0_ll,FMREADN1_ll,FMREADN2_ll,&
+ & FMREADL0_ll,FMREADL1_ll,FMREADC0_ll,FMREADT0_ll
+
+!INCLUDE 'mpif.h'
+
+CONTAINS
+SUBROUTINE FM_READ_ERR(HFUNC,HFILEM,HFIPRI,HRECFM,HDIR,KRESP)
+USE MODE_FM, ONLY : FMLOOK_ll
+
+CHARACTER(LEN=*) :: HFUNC
+CHARACTER(LEN=*) :: HFILEM
+CHARACTER(LEN=*) :: HFIPRI
+CHARACTER(LEN=*) :: HRECFM
+CHARACTER(LEN=*) :: HDIR
+INTEGER :: KRESP
+
+INTEGER :: ILUPRI
+INTEGER :: IRESP
+
+CALL FMLOOK_ll(HFIPRI,HFIPRI,ILUPRI,IRESP)
+WRITE (ILUPRI,*) ' exit from ',HFUNC, ' with RESP:',KRESP
+!STOP "fmread_ll.f90:: FM_READ_ERR"
+
+WRITE (ILUPRI,*) ' | HFILEM = ',HFILEM
+WRITE (ILUPRI,*) ' | HRECFM = ',HRECFM
+WRITE (ILUPRI,*) ' | HDIR = ',HDIR
+
+END SUBROUTINE FM_READ_ERR
+
+
+SUBROUTINE BCAST_HEADER(TPFD,TPFMH)
+USE MODE_FD_ll, ONLY : FD_ll
+USE MODD_FM
+TYPE(FD_ll), POINTER :: TPFD
+TYPE(FMHEADER), INTENT(IN) :: TPFMH
+
+INTEGER :: ierr
+
+CALL MPI_BCAST(TPFMH%GRID,1,MPI_INTEGER,TPFD%OWNER-1,TPFD%COMM,IERR)
+CALL MPI_BCAST(TPFMH%COMLEN,1,MPI_INTEGER,TPFD%OWNER-1,TPFD%COMM,IERR)
+CALL MPI_BCAST(TPFMH%COMMENT,TPFMH%COMLEN,MPI_CHARACTER,TPFD%OWNER-1,TPFD%COMM,IERR)
+
+END SUBROUTINE BCAST_HEADER
+
+SUBROUTINE FMREADX0_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
+USE MODD_FM
+USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+!* 0.1 Declarations of arguments
+!
+CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
+CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
+REAL, INTENT(INOUT)::PFIELD ! array containing the data field
+INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
+INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
+CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
+INTEGER, INTENT(INOUT)::KRESP ! return-code
+!
+!* 0.2 Declarations of local variables
+!
+!----------------------------------------------------------------
+CHARACTER(LEN=JPFINL) :: YFNLFI
+INTEGER :: IERR
+TYPE(FD_ll), POINTER :: TZFD
+INTEGER :: IRESP
+TYPE(FMHEADER) :: TZFMH
+!
+!* 1.1 THE NAME OF LFIFM
+!
+IRESP = 0
+YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+!------------------------------------------------------------------
+TZFD=>GETFD(YFNLFI)
+IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
+ END IF
+ IF (IRESP /= 0) GOTO 1000
+ ELSE ! multiprocessor execution
+ IF (ISP == TZFD%OWNER) THEN
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
+ END IF
+ END IF
+ !
+ CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
+ IF (IRESP /= 0) GOTO 1000
+ !
+ CALL BCAST_HEADER(TZFD,TZFMH)
+ !
+ CALL MPI_BCAST(PFIELD,1,MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
+ END IF
+ KGRID = TZFMH%GRID
+ KLENCH = TZFMH%COMLEN
+ HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
+ELSE
+ IRESP = -61
+END IF
+!----------------------------------------------------------------
+1000 CONTINUE
+!! Error handler
+IF (IRESP.NE.0) THEN
+ CALL FM_READ_ERR("FMREADX0_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
+ENDIF
+KRESP = IRESP
+RETURN
+
+END SUBROUTINE FMREADX0_ll
+
+SUBROUTINE FMREADX1_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP, KIMAX_ll, KJMAX_ll, TPSPLITTING)
+USE MODD_IO_ll, ONLY : ISP,GSMONOPROC, ISNPROC
+USE MODD_FM
+USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+USE MODE_SCATTER_ll
+USE MODE_ALLOCBUFFER_ll
+USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+!* 0.1 Declarations of arguments
+!
+CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
+CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
+REAL,DIMENSION(:),TARGET,INTENT(INOUT)::PFIELD ! array containing the data field
+INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
+INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
+CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
+INTEGER, INTENT(INOUT)::KRESP ! return-code
+INTEGER, OPTIONAL, INTENT(IN) ::KIMAX_ll
+INTEGER, OPTIONAL, INTENT(IN) ::KJMAX_ll
+TYPE(ZONE_ll), DIMENSION(ISNPROC), OPTIONAL :: TPSPLITTING ! splitting of the domain
+!
+!* 0.2 Declarations of local variables
+!
+!----------------------------------------------------------------
+CHARACTER(LEN=JPFINL) :: YFNLFI
+INTEGER :: IERR
+TYPE(FD_ll), POINTER :: TZFD
+INTEGER :: IRESP
+REAL,DIMENSION(:),POINTER :: ZFIELDP
+LOGICAL :: GALLOC
+TYPE(FMHEADER) :: TZFMH
+!
+!* 1.1 THE NAME OF LFIFM
+!
+GALLOC = .FALSE.
+IRESP = 0
+YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+!------------------------------------------------------------------
+TZFD=>GETFD(YFNLFI)
+IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
+ END IF
+ IF (IRESP /= 0) GOTO 1000
+ ELSE ! multiprocessor execution
+ IF (ISP == TZFD%OWNER) THEN
+ IF( PRESENT(KIMAX_ll) .AND. PRESENT(KJMAX_ll) ) THEN
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC, KIMAX_ll, KJMAX_ll)
+ ELSE
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
+ ENDIF
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ END IF
+ ELSE
+ ALLOCATE(ZFIELDP(0))
+ GALLOC = .TRUE.
+ END IF
+
+ !
+ CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
+ IF (IRESP /= 0) GOTO 1000
+ !
+ CALL BCAST_HEADER(TZFD,TZFMH)
+ !
+ IF (HDIR /= 'XX' .AND. HDIR /='YY') THEN
+ ! Broadcast Field
+ CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
+ ELSE
+ !Scatter Field
+ IF( PRESENT(TPSPLITTING) ) THEN
+ CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM,TPSPLITTING)
+ ELSE
+ CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
+ ENDIF
+ END IF
+ END IF !(GSMONOPROC)
+
+ KGRID = TZFMH%GRID
+ KLENCH = TZFMH%COMLEN
+ HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
+ELSE
+ IRESP = -61
+END IF
+!----------------------------------------------------------------
+1000 CONTINUE
+!! Error handler
+IF (IRESP.NE.0) THEN
+ CALL FM_READ_ERR("FMREADX1_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
+ENDIF
+
+IF (GALLOC) DEALLOCATE (ZFIELDP)
+KRESP = IRESP
+RETURN
+!------------------------------------------------------------------
+END SUBROUTINE FMREADX1_ll
+
+SUBROUTINE FMREADX2_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP, KIMAX_ll, KJMAX_ll, TPSPLITTING)
+USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LPACK,L1D,L2D , ISNPROC
+USE MODD_PARAMETERS_ll,ONLY : JPHEXT
+USE MODD_FM
+USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+USE MODE_SCATTER_ll
+USE MODE_ALLOCBUFFER_ll
+!JUANZ
+USE MODD_TIMEZ, ONLY : TIMEZ
+USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
+!JUANZ
+USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
+#ifdef MNH_GA
+ USE MODE_GA
+#endif
+
+IMPLICIT NONE
+
+CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
+CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
+REAL,DIMENSION(:,:),TARGET, INTENT(INOUT)::PFIELD ! array containing the data field
+INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
+INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
+CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
+INTEGER, INTENT(INOUT)::KRESP ! return-code
+INTEGER, OPTIONAL, INTENT(IN) ::KIMAX_ll
+INTEGER, OPTIONAL, INTENT(IN) ::KJMAX_ll
+TYPE(ZONE_ll), DIMENSION(ISNPROC), OPTIONAL :: TPSPLITTING ! splitting of the domain
+!
+!
+!* 0.2 Declarations of local variables
+!
+CHARACTER(LEN=JPFINL) :: YFNLFI
+
+INTEGER :: IERR
+TYPE(FD_ll), POINTER :: TZFD
+INTEGER :: IRESP
+REAL,DIMENSION(:,:), POINTER :: ZFIELDP
+LOGICAL :: GALLOC
+TYPE(FMHEADER) :: TZFMH
+!JUANZ
+REAL*8,DIMENSION(2) :: T0,T1,T2
+REAL*8,DIMENSION(2) :: T11,T22
+!JUANZ
+#ifdef MNH_GA
+REAL,DIMENSION(:,:),POINTER :: ZFIELD_GA
+#endif
+INTEGER :: IHEXTOT
+!
+!* 1.1 THE NAME OF LFIFM
+!
+CALL SECOND_MNH2(T11)
+GALLOC = .FALSE.
+IRESP = 0
+YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+
+!------------------------------------------------------------------
+IHEXTOT = 2*JPHEXT+1
+TZFD=>GETFD(YFNLFI)
+IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
+ 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 (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ END IF
+ PFIELD(:,:)=SPREAD(SPREAD(PFIELD(JPHEXT+1,JPHEXT+1),DIM=1,NCOPIES=IHEXTOT),DIM=2,NCOPIES=IHEXTOT)
+! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
+ ELSE IF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
+ ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1)
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ END IF
+ PFIELD(:,:)=SPREAD(PFIELD(:,JPHEXT+1),DIM=2,NCOPIES=IHEXTOT)
+ ELSE
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
+ END IF
+ END IF
+ IF (IRESP /= 0) GOTO 1000
+ ELSE ! multiprocessor execution
+ CALL SECOND_MNH2(T0)
+ IF (ISP == TZFD%OWNER) THEN
+ ! I/O processor case
+ IF( PRESENT(KIMAX_ll) .AND. PRESENT(KJMAX_ll) ) THEN
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC, KIMAX_ll, KJMAX_ll)
+ ELSE
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
+ ENDIF
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ END IF
+ ELSE
+ ALLOCATE(ZFIELDP(0,0))
+ GALLOC = .TRUE.
+ END IF
+ CALL SECOND_MNH2(T1)
+ TIMEZ%T_READ2D_READ=TIMEZ%T_READ2D_READ + T1 - T0
+ !
+ CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
+ IF (IRESP /= 0) GOTO 1000
+ !
+ CALL BCAST_HEADER(TZFD,TZFMH)
+ !
+ IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
+ ! XX or YY Scatter Field
+ IF( PRESENT(TPSPLITTING) ) THEN
+ CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM,TPSPLITTING)
+ ELSE
+ CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
+ ENDIF
+ ELSE IF (HDIR == 'XY') THEN
+ IF (LPACK .AND. L2D) THEN
+ ! 2D compact case
+ IF( PRESENT(TPSPLITTING) ) THEN
+ CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1),PFIELD(:,JPHEXT+1),TZFD%OWNER,TZFD%COMM,TPSPLITTING)
+ ELSE
+ CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1),PFIELD(:,JPHEXT+1),TZFD%OWNER,TZFD%COMM)
+ ENDIF
+ PFIELD(:,:) = SPREAD(PFIELD(:,JPHEXT+1),DIM=2,NCOPIES=IHEXTOT)
+ ELSE
+#ifdef MNH_GA
+ !
+ ! init/create the ga , dim3 = 1
+ !
+ CALL MNH_INIT_GA(SIZE(PFIELD,1),SIZE(PFIELD,2),1,HRECFM,"READ")
+ IF (ISP == TZFD%OWNER) THEN
+ !
+ ! put the data in the g_a , this proc get this 1 slide
+ !
+ lo_zplan(JPIZ) = 1
+ hi_zplan(JPIZ) = 1
+ call nga_put(g_a, lo_zplan, hi_zplan,ZFIELDP, ld_zplan)
+ END IF
+ call ga_sync
+ !
+ ! get the columun data in this proc
+ !
+ ! temp buf to avoid problem with none stride PFIELDS buffer with HALO
+ ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2)))
+ call nga_get(g_a, lo_col, hi_col,ZFIELD_GA(1,1) , ld_col)
+ PFIELD = ZFIELD_GA
+ DEALLOCATE(ZFIELD_GA)
+#else
+ ! XY Scatter Field
+ CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
+#endif
+ END IF
+ ELSE
+ CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
+ END IF
+ CALL SECOND_MNH2(T2)
+ TIMEZ%T_READ2D_SCAT=TIMEZ%T_READ2D_SCAT + T2 - T1
+ END IF !(GSMONOPROC)
+
+ KGRID = TZFMH%GRID
+ KLENCH = TZFMH%COMLEN
+ HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
+ELSE
+ IRESP = -61
+END IF
+!----------------------------------------------------------------
+1000 CONTINUE
+!! Error handler
+IF (IRESP.NE.0) THEN
+ CALL FM_READ_ERR("FMREADX2_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
+ENDIF
+IF (GALLOC) DEALLOCATE (ZFIELDP)
+KRESP = IRESP
+!------------------------------------------------------------------
+
+CALL SECOND_MNH2(T22)
+TIMEZ%T_READ2D_ALL=TIMEZ%T_READ2D_ALL + T22 - T11
+
+END SUBROUTINE FMREADX2_ll
+
+SUBROUTINE FMREADX3_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LPACK,L1D,L2D
+USE MODD_PARAMETERS_ll,ONLY : JPHEXT
+USE MODD_FM
+USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+USE MODE_SCATTER_ll
+USE MODE_ALLOCBUFFER_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
+
+IMPLICIT NONE
+
+CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
+CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
+REAL, DIMENSION(:,:,:),TARGET,INTENT(INOUT)::PFIELD ! array containing the data field
+INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
+INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
+CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
+INTEGER, INTENT(INOUT)::KRESP ! return-code
+!
+#ifdef MNH_GA
+REAL,DIMENSION(:,:,:),POINTER :: ZFIELD_GA
+#endif
+!
+!
+!* 0.2 Declarations of local variables
+!
+CHARACTER(LEN=JPFINL) :: YFNLFI
+INTEGER :: IERR
+TYPE(FD_ll), POINTER :: TZFD
+INTEGER :: IRESP
+REAL,DIMENSION(:,:,:),POINTER :: ZFIELDP
+LOGICAL :: GALLOC
+TYPE(FMHEADER) :: TZFMH
+!JUAN
+INTEGER :: JK,JKK
+CHARACTER(LEN=LEN(HRECFM)) :: 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
+LOGICAL :: GALLOC_ll
+
+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
+INTEGER :: IHEXTOT
+!JUAN
+!
+!* 1.1 THE NAME OF LFIFM
+!
+CALL SECOND_MNH2(T11)
+GALLOC = .FALSE.
+GALLOC_ll = .FALSE.
+IRESP = 0
+YFNLFI = TRIM(ADJUSTL(HFILEM))//'.lfi'
+!------------------------------------------------------------------
+IHEXTOT = 2*JPHEXT+1
+TZFD=>GETFD(YFNLFI)
+IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC .AND. (TZFD%nb_procio.eq.1) ) THEN ! sequential execution
+! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
+ 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 (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ END IF
+ PFIELD(:,:,:)=SPREAD(SPREAD(PFIELD(JPHEXT+1,JPHEXT+1,:),DIM=1,NCOPIES=IHEXTOT),DIM=2,NCOPIES=IHEXTOT)
+! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
+ ELSE IF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
+ ALLOCATE (ZFIELDP(SIZE(PFIELD,1),1,SIZE(PFIELD,3)))
+ GALLOC = .TRUE.
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ END IF
+ PFIELD(:,:,:)=SPREAD(ZFIELDP(:,1,:),DIM=2,NCOPIES=IHEXTOT)
+ ELSE
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
+ END IF
+ END IF
+ IF (IRESP /= 0) GOTO 1000
+ ELSEIF ( (TZFD%nb_procio .eq. 1 ) .OR. ( HDIR == '--' ) ) THEN ! multiprocessor execution & 1 IO proc
+ ! read 3D field for graphique
+ IF (ISP == TZFD%OWNER) THEN
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ END IF
+ ELSE
+ ALLOCATE(ZFIELDP(0,0,0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
+ IF (IRESP /= 0) GOTO 1000
+ !
+ CALL BCAST_HEADER(TZFD,TZFMH)
+ !
+ IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
+ ! XX or YY Scatter Field
+ CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
+ ELSE IF (HDIR == 'XY') THEN
+ IF (LPACK .AND. L2D) THEN
+ ! 2D compact case
+ CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1,:),PFIELD(:,JPHEXT+1,:),TZFD%OWNER,TZFD%COMM)
+ PFIELD(:,:,:) = SPREAD(PFIELD(:,JPHEXT+1,:),DIM=2,NCOPIES=IHEXTOT)
+ ELSE
+ ! XY Scatter Field
+ CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
+ END IF
+ ELSE
+ ! Broadcast Field
+ CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
+ END IF
+ ELSE ! multiprocessor execution & // IO
+!
+!JUAN BG Z SLIDE
+!
+#ifdef MNH_GA
+ !
+ ! init/create the ga
+ !
+ CALL SECOND_MNH2(T0)
+ CALL MNH_INIT_GA(SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3),HRECFM,"READ")
+ !
+ ! read 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(HFILEM)//YK_FILE//".lfi"
+ TZFD_IOZ => GETFD(YFILE_IOZ)
+ !
+ IK_RANK = TZFD_IOZ%OWNER
+ !
+ IF (ISP == IK_RANK ) THEN
+ IF ( SIZE(ZSLIDE_ll) .EQ. 0 ) THEN
+ DEALLOCATE(ZSLIDE_ll)
+ CALL ALLOCBUFFER_ll(ZSLIDE_ll,ZSLIDE,HDIR,GALLOC_ll)
+ END IF
+ !
+ CALL SECOND_MNH2(T0)
+ WRITE(YK,'(I4.4)') JKK
+ YRECZSLIDE = TRIM(HRECFM)//YK
+ IF (ASSOCIATED(TZFD_IOZ%CDF)) THEN
+ CALL NCREAD(TZFD_IOZ%CDF%NCID,YRECZSLIDE,ZSLIDE_ll,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD_IOZ%FLU,YRECZSLIDE,.TRUE.,SIZE(ZSLIDE_ll),ZSLIDE_ll,TZFMH&
+ & ,IRESP)
+ END IF
+ CALL SECOND_MNH2(T1)
+ TIMEZ%T_READ3D_READ=TIMEZ%T_READ3D_READ + T1 - T0
+ !
+ ! put the data in the g_a , this proc get this JKK slide
+ !
+ lo_zplan(JPIZ) = JKK
+ hi_zplan(JPIZ) = JKK
+ call nga_put(g_a, lo_zplan, hi_zplan,ZSLIDE_ll, ld_zplan)
+ END IF
+ END DO
+ call ga_sync
+ !
+ ! get the columun data in this proc
+ !
+ ! temp buf to avoid problem with none stride PFIELDS buffer with HALO
+ ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3)))
+ call nga_get(g_a, lo_col, hi_col,ZFIELD_GA(1,1,1) , ld_col)
+ PFIELD = ZFIELD_GA
+ DEALLOCATE(ZFIELD_GA)
+#else
+ ALLOCATE(ZSLIDE_ll(0,0))
+ GALLOC_ll = .TRUE.
+ inb_proc_real = min(TZFD%nb_procio,ISNPROC)
+ Z_SLIDE: DO JK=1,SIZE(PFIELD,3),inb_proc_real
+ !
+ ! read the data
+ !
+ JK_MAX=min(SIZE(PFIELD,3),JK+inb_proc_real-1)
+ !
+ NB_REQ=0
+ ALLOCATE(REQ_TAB(ISNPROC-1))
+ ALLOCATE(T_TX2DP(ISNPROC-1))
+ 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(HFILEM)//YK_FILE//".lfi"
+ TZFD_IOZ => GETFD(YFILE_IOZ)
+ ELSE
+ TZFD_IOZ => TZFD
+ ENDIF
+ IK_RANK = TZFD_IOZ%OWNER
+ IF (ISP == IK_RANK ) THEN
+ IF ( SIZE(ZSLIDE_ll) .EQ. 0 ) THEN
+ DEALLOCATE(ZSLIDE_ll)
+ CALL ALLOCBUFFER_ll(ZSLIDE_ll,ZSLIDE,HDIR,GALLOC_ll)
+ END IF
+ !JUAN
+ CALL SECOND_MNH2(T0)
+ WRITE(YK,'(I4.4)') JKK
+ YRECZSLIDE = TRIM(HRECFM)//YK
+ IF (ASSOCIATED(TZFD_IOZ%CDF)) THEN
+ CALL NCREAD(TZFD_IOZ%CDF%NCID,YRECZSLIDE,ZSLIDE_ll,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD_IOZ%FLU,YRECZSLIDE,.TRUE.,SIZE(ZSLIDE_ll),ZSLIDE_ll,TZFMH&
+ & ,IRESP)
+ END IF
+ !JUANIOZ
+ CALL SECOND_MNH2(T1)
+ TIMEZ%T_READ3D_READ=TIMEZ%T_READ3D_READ + T1 - T0
+ DO JI = 1,ISNPROC
+ CALL GET_DOMREAD_ll(JI,IXO,IXE,IYO,IYE)
+ TX2DP=>ZSLIDE_ll(IXO:IXE,IYO:IYE)
+ IF (ISP /= JI) THEN
+ NB_REQ = NB_REQ + 1
+ ALLOCATE(T_TX2DP(NB_REQ)%X(IXO:IXE,IYO:IYE))
+ T_TX2DP(NB_REQ)%X=TX2DP
+ CALL MPI_ISEND(T_TX2DP(NB_REQ)%X,SIZE(TX2DP),MPI_FLOAT,JI-1,199+IK_RANK &
+ & ,TZFD_IOZ%COMM,REQ_TAB(NB_REQ),IERR)
+ !CALL MPI_BSEND(TX2DP,SIZE(TX2DP),MPI_FLOAT,JI-1,199+IK_RANK,TZFD_IOZ%COMM,IERR)
+ ELSE
+ PFIELD(:,:,JKK) = TX2DP(:,:)
+ END IF
+ END DO
+ CALL SECOND_MNH2(T2)
+ TIMEZ%T_READ3D_SEND=TIMEZ%T_READ3D_SEND + T2 - T1
+ !JUANIOZ
+ END IF
+ END DO
+ !
+ ! brodcast the data
+ !
+ IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
+ ! XX or YY Scatter Field
+ STOP " XX ou YY NON PREVU SUR BG POUR LE MOMENT "
+ CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
+ ELSE IF (HDIR == 'XY') THEN
+ IF (LPACK .AND. L2D) THEN
+ ! 2D compact case
+ STOP " L2D NON PREVU SUR BG POUR LE MOMENT "
+ CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1,:),PFIELD(:,JPHEXT+1,:),TZFD%OWNER,TZFD%COMM)
+ PFIELD(:,:,:) = SPREAD(PFIELD(:,JPHEXT+1,:),DIM=2,NCOPIES=IHEXTOT)
+ ELSE
+ !
+ ! XY Scatter Field
+ !
+ CALL SECOND_MNH2(T0)
+ DO JKK=JK,JK_MAX
+ !
+ ! get the file & rank
+ !
+ 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(HFILEM)//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
+ !
+ ZSLIDE => PFIELD(:,:,JKK)
+!JUANIOZ
+ !CALL SCATTER_XYFIELD(ZSLIDE_ll,ZSLIDE,TZFD_IOZ%OWNER,TZFD_IOZ%COMM)
+ IF (ISP .NE. IK_RANK) THEN
+ CALL MPI_RECV(ZSLIDE,SIZE(ZSLIDE),MPI_FLOAT,IK_RANK-1,199+IK_RANK,TZFD_IOZ%COMM&
+ & ,STATUS,IERR)
+ END IF
+!JUAN IOZ
+ END DO
+ CALL SECOND_MNH2(T1)
+ TIMEZ%T_READ3D_RECV=TIMEZ%T_READ3D_RECV + T1 - T0
+ END IF
+ ELSE
+ ! Broadcast Field
+ STOP " Broadcast Field NON PREVU SUR BG POUR LE MOMENT "
+ CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
+ END IF
+ CALL SECOND_MNH2(T0)
+ IF (NB_REQ .GT.0 ) THEN
+ CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
+ 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_READ3D_WAIT=TIMEZ%T_READ3D_WAIT + T1 - T0
+ END DO Z_SLIDE
+ !
+ CALL BCAST_HEADER(TZFD,TZFMH)
+ !
+#endif
+!JUAN BG Z SLIDE
+ END IF !(GSMONOPROC)
+
+ KGRID = TZFMH%GRID
+ KLENCH = TZFMH%COMLEN
+ HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
+ELSE
+ IRESP = -61
+END IF
+!----------------------------------------------------------------
+1000 CONTINUE
+!! Error handler
+IF (IRESP.NE.0) THEN
+ CALL FM_READ_ERR("FMREADX3_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
+ENDIF
+IF (GALLOC) DEALLOCATE (ZFIELDP)
+IF (GALLOC_ll) DEALLOCATE (ZSLIDE_ll)
+!IF (ASSOCIATED(ZSLIDE_ll)) DEALLOCATE (ZSLIDE_ll)
+KRESP = IRESP
+CALL MPI_BARRIER(TZFD%COMM,IERR)
+CALL SECOND_MNH2(T22)
+TIMEZ%T_READ3D_ALL=TIMEZ%T_READ3D_ALL + T22 - T11
+
+!------------------------------------------------------------------
+END SUBROUTINE FMREADX3_ll
+
+SUBROUTINE FMREADX4_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LPACK,L1D,L2D
+USE MODD_PARAMETERS_ll,ONLY : JPHEXT
+USE MODD_FM
+USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+USE MODE_SCATTER_ll
+USE MODE_ALLOCBUFFER_ll
+
+CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
+CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
+REAL,DIMENSION(:,:,:,:),TARGET,INTENT(INOUT)::PFIELD ! array containing the data field
+INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
+INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
+CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
+INTEGER, INTENT(INOUT)::KRESP ! return-code if
+!
+!
+!* 0.2 Declarations of local variables
+!
+CHARACTER(LEN=JPFINL) :: YFNLFI
+INTEGER :: IERR
+TYPE(FD_ll), POINTER :: TZFD
+INTEGER :: IRESP
+REAL,DIMENSION(:,:,:,:),POINTER :: ZFIELDP
+LOGICAL :: GALLOC
+TYPE(FMHEADER) :: TZFMH
+INTEGER :: IHEXTOT
+!
+!* 1.1 THE NAME OF LFIFM
+!
+GALLOC = .FALSE.
+IRESP = 0
+YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+!------------------------------------------------------------------
+IHEXTOT = 2*JPHEXT+1
+TZFD=>GETFD(YFNLFI)
+IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
+ 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 (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ END IF
+ PFIELD(:,:,:,:)=SPREAD(SPREAD(PFIELD(JPHEXT+1,JPHEXT+1,:,:),DIM=1,NCOPIES=IHEXTOT),DIM=2,NCOPIES=IHEXTOT)
+! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
+ ELSE IF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
+ ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1,:,:)
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ END IF
+ PFIELD(:,:,:,:)=SPREAD(PFIELD(:,JPHEXT+1,:,:),DIM=2,NCOPIES=IHEXTOT)
+ ELSE
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
+ END IF
+ END IF
+ IF (IRESP /= 0) GOTO 1000
+ ELSE
+ IF (ISP == TZFD%OWNER) THEN
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ END IF
+ ELSE
+ ALLOCATE(ZFIELDP(0,0,0,0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
+ IF (IRESP /= 0) GOTO 1000
+ !
+ CALL BCAST_HEADER(TZFD,TZFMH)
+ !
+ IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
+ ! XX or YY Scatter Field
+ CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
+ ELSE IF (HDIR == 'XY') THEN
+ IF (LPACK .AND. L2D) THEN
+ ! 2D compact case
+ CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1,:,:),PFIELD(:,JPHEXT+1,:,:),TZFD%OWNER,TZFD%COMM)
+ PFIELD(:,:,:,:) = SPREAD(PFIELD(:,JPHEXT+1,:,:),DIM=2,NCOPIES=IHEXTOT)
+ ELSE
+ ! XY Scatter Field
+ CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
+ END IF
+ ELSE
+ ! Broadcast Field
+ CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
+ END IF
+ END IF
+ KGRID = TZFMH%GRID
+ KLENCH = TZFMH%COMLEN
+ HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
+ELSE
+ IRESP = -61
+END IF
+!----------------------------------------------------------------
+1000 CONTINUE
+!! Error handler
+IF (IRESP.NE.0) THEN
+ CALL FM_READ_ERR("FMREADX4_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
+ENDIF
+
+IF (GALLOC) DEALLOCATE (ZFIELDP)
+KRESP = IRESP
+RETURN
+!------------------------------------------------------------------
+END SUBROUTINE FMREADX4_ll
+
+SUBROUTINE FMREADX5_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LPACK,L1D,L2D
+USE MODD_PARAMETERS_ll,ONLY : JPHEXT
+USE MODD_FM
+USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+USE MODE_SCATTER_ll
+USE MODE_ALLOCBUFFER_ll
+
+CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
+CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
+REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(INOUT)::PFIELD ! array containing the data field
+INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
+INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
+CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
+INTEGER, INTENT(INOUT)::KRESP ! return-code
+!
+!
+!* 0.2 Declarations of local variables
+!
+CHARACTER(LEN=JPFINL) :: YFNLFI
+INTEGER :: IERR
+TYPE(FD_ll), POINTER :: TZFD
+INTEGER :: IRESP
+REAL,DIMENSION(:,:,:,:,:),POINTER :: ZFIELDP
+LOGICAL :: GALLOC
+TYPE(FMHEADER) :: TZFMH
+INTEGER :: IHEXTOT
+!
+!* 1.1 THE NAME OF LFIFM
+!
+GALLOC = .FALSE.
+IRESP = 0
+YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+!------------------------------------------------------------------
+IHEXTOT = 2*JPHEXT+1
+TZFD=>GETFD(YFNLFI)
+IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
+ 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 (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ END IF
+ PFIELD(:,:,:,:,:)=SPREAD(SPREAD(PFIELD(JPHEXT+1,JPHEXT+1,:,:,:),DIM=1,NCOPIES=IHEXTOT),DIM=2,NCOPIES=IHEXTOT)
+! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
+ ELSE IF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
+ ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1,:,:,:)
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ END IF
+ PFIELD(:,:,:,:,:)=SPREAD(PFIELD(:,JPHEXT+1,:,:,:),DIM=2,NCOPIES=IHEXTOT)
+ ELSE
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
+ END IF
+ END IF
+ IF (IRESP /= 0) GOTO 1000
+ ELSE ! multiprocessor execution
+ IF (ISP == TZFD%OWNER) THEN
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ END IF
+ ELSE
+ ALLOCATE(ZFIELDP(0,0,0,0,0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
+ IF (IRESP /= 0) GOTO 1000
+ !
+ CALL BCAST_HEADER(TZFD,TZFMH)
+ !
+ IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
+ ! XX or YY Scatter Field
+ CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
+ ELSE IF (HDIR == 'XY') THEN
+ IF (LPACK .AND. L2D) THEN
+ ! 2D compact case
+ CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1,:,:,:),PFIELD(:,JPHEXT+1,:,:,:),&
+ & TZFD%OWNER,TZFD%COMM)
+ PFIELD(:,:,:,:,:) = SPREAD(PFIELD(:,JPHEXT+1,:,:,:),DIM=2,NCOPIES=IHEXTOT)
+ ELSE
+ ! XY Scatter Field
+ CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
+ END IF
+ ELSE
+ ! Broadcast Field
+ CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
+ END IF
+ END IF
+ KGRID = TZFMH%GRID
+ KLENCH = TZFMH%COMLEN
+ HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
+ELSE
+ IRESP = -61
+END IF
+!----------------------------------------------------------------
+1000 CONTINUE
+!! Error handler
+IF (IRESP.NE.0) THEN
+ CALL FM_READ_ERR("FMREADX5_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
+ENDIF
+IF (GALLOC) DEALLOCATE (ZFIELDP)
+KRESP = IRESP
+RETURN
+!------------------------------------------------------------------
+END SUBROUTINE FMREADX5_ll
+
+SUBROUTINE FMREADX6_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
+USE MODD_FM
+USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+USE MODE_SCATTER_ll
+USE MODE_ALLOCBUFFER_ll
+
+CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
+CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
+REAL,DIMENSION(:,:,:,:,:,:),TARGET,INTENT(INOUT)::PFIELD ! array containing the data field
+INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
+INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
+CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
+INTEGER, INTENT(INOUT)::KRESP ! return-code
+!
+!
+!* 0.2 Declarations of local variables
+!
+CHARACTER(LEN=JPFINL) :: YFNLFI
+INTEGER :: IERR
+TYPE(FD_ll), POINTER :: TZFD
+INTEGER :: IRESP
+REAL,DIMENSION(:,:,:,:,:,:),POINTER :: ZFIELDP
+LOGICAL :: GALLOC
+TYPE(FMHEADER) :: TZFMH
+!
+!* 1.1 THE NAME OF LFIFM
+!
+GALLOC = .FALSE.
+IRESP = 0
+YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+!------------------------------------------------------------------
+TZFD=>GETFD(YFNLFI)
+IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
+ END IF
+ IF (IRESP /= 0) GOTO 1000
+ ELSE ! multiprocessor execution
+ IF (ISP == TZFD%OWNER) THEN
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ END IF
+ ELSE
+ ALLOCATE(ZFIELDP(0,0,0,0,0,0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
+ IF (IRESP /= 0) GOTO 1000
+ !
+ CALL BCAST_HEADER(TZFD,TZFMH)
+ !
+ IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
+ ! XX or YY Scatter Field
+ CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
+ ELSE IF (HDIR == 'XY') THEN
+ ! XY Scatter Field
+ CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
+ ELSE
+ ! Broadcast Field
+ CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
+ END IF
+ END IF
+ KGRID = TZFMH%GRID
+ KLENCH = TZFMH%COMLEN
+ HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
+ELSE
+ IRESP = -61
+END IF
+!----------------------------------------------------------------
+1000 CONTINUE
+!! Error handler
+IF (IRESP.NE.0) THEN
+ CALL FM_READ_ERR("FMREADX6_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
+ENDIF
+IF (GALLOC) DEALLOCATE (ZFIELDP)
+KRESP = IRESP
+RETURN
+!------------------------------------------------------------------
+END SUBROUTINE FMREADX6_ll
+
+SUBROUTINE FMREADN0_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
+USE MODD_FM
+USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+!* 0.1 Declarations of arguments
+!
+CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
+CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
+INTEGER, INTENT(INOUT)::KFIELD ! array containing the data field
+INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
+INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
+CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
+INTEGER, INTENT(INOUT)::KRESP ! return-code
+!
+!* 0.2 Declarations of local variables
+!
+CHARACTER(LEN=JPFINL) :: YFNLFI
+INTEGER :: IERR
+TYPE(FD_ll), POINTER :: TZFD
+INTEGER :: IRESP
+TYPE(FMHEADER) :: TZFMH
+
+!
+!* 1.1 THE NAME OF LFIFM
+!
+IRESP = 0
+YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+!
+TZFD=>GETFD(YFNLFI)
+IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,KFIELD,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
+ END IF
+ IF (IRESP /= 0) GOTO 1000
+ ELSE
+ IF (ISP == TZFD%OWNER) THEN
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,KFIELD,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
+ END IF
+ END IF
+ !
+ CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
+ IF (IRESP /= 0) GOTO 1000
+ !
+ CALL BCAST_HEADER(TZFD,TZFMH)
+ !
+ CALL MPI_BCAST(KFIELD,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
+ END IF
+ KGRID = TZFMH%GRID
+ KLENCH = TZFMH%COMLEN
+ HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
+ELSE
+ IRESP = -61
+END IF
+!----------------------------------------------------------------
+1000 CONTINUE
+!! Error handler
+IF (IRESP.NE.0) THEN
+ CALL FM_READ_ERR("FMREADN0_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
+ENDIF
+KRESP = IRESP
+RETURN
+
+END SUBROUTINE FMREADN0_ll
+
+SUBROUTINE FMREADN1_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
+USE MODD_FM
+USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+USE MODE_SCATTER_ll
+USE MODE_ALLOCBUFFER_ll
+
+!* 0. DECLARATIONS
+! ------------
+!
+!
+!* 0.1 Declarations of arguments
+!
+CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
+CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
+INTEGER,DIMENSION(:),TARGET,INTENT(INOUT)::KFIELD ! array containing the data field
+INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
+INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
+CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
+INTEGER, INTENT(INOUT)::KRESP ! return-code
+!
+!* 0.2 Declarations of local variables
+!
+CHARACTER(LEN=JPFINL) :: YFNLFI
+INTEGER :: IERR
+TYPE(FD_ll), POINTER :: TZFD
+INTEGER :: IRESP
+INTEGER,DIMENSION(:),POINTER :: IFIELDP
+LOGICAL :: GALLOC
+TYPE(FMHEADER) :: TZFMH
+!
+!* 1.1 THE NAME OF LFIFM
+!
+GALLOC = .FALSE.
+IRESP = 0
+YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+!------------------------------------------------------------------
+TZFD=>GETFD(YFNLFI)
+IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,KFIELD,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(KFIELD),KFIELD,TZFMH,IRESP)
+ END IF
+ IF (IRESP /= 0) GOTO 1000
+ ELSE
+ IF (ISP == TZFD%OWNER) THEN
+ CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,HDIR,GALLOC)
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELDP,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH&
+ & ,IRESP)
+ END IF
+ ELSE
+ ALLOCATE(IFIELDP(0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
+ IF (IRESP /= 0) GOTO 1000
+ !
+ CALL BCAST_HEADER(TZFD,TZFMH)
+ !
+ IF (HDIR /= 'XX' .AND. HDIR /='YY') THEN
+ ! Broadcast Field
+ CALL MPI_BCAST(KFIELD,SIZE(KFIELD),MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
+ ELSE
+ !Scatter Field
+ CALL SCATTER_XXFIELD(HDIR,IFIELDP,KFIELD,TZFD%OWNER,TZFD%COMM)
+ END IF
+ END IF
+ KGRID = TZFMH%GRID
+ KLENCH = TZFMH%COMLEN
+ HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
+ELSE
+ IRESP = -61
+END IF
+!----------------------------------------------------------------
+1000 CONTINUE
+!! Error handler
+IF (IRESP.NE.0) THEN
+ CALL FM_READ_ERR("FMREADN1_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
+ENDIF
+IF (GALLOC) DEALLOCATE (IFIELDP)
+KRESP = IRESP
+RETURN
+
+END SUBROUTINE FMREADN1_ll
+
+SUBROUTINE FMREADN2_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LPACK,L1D,L2D
+USE MODD_PARAMETERS_ll,ONLY : JPHEXT
+USE MODD_FM
+USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+USE MODE_SCATTER_ll
+USE MODE_ALLOCBUFFER_ll
+
+CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
+CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
+INTEGER, DIMENSION(:,:),TARGET,INTENT(INOUT)::KFIELD ! array containing the data field
+INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
+INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
+CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
+INTEGER, INTENT(INOUT)::KRESP ! return-code
+!
+!
+!* 0.2 Declarations of local variables
+!
+CHARACTER(LEN=JPFINL) :: YFNLFI
+INTEGER :: IERR
+TYPE(FD_ll), POINTER :: TZFD
+INTEGER :: IRESP
+INTEGER,DIMENSION(:,:),POINTER :: IFIELDP
+LOGICAL :: GALLOC
+TYPE(FMHEADER) :: TZFMH
+INTEGER :: IHEXTOT
+!
+!* 1.1 THE NAME OF LFIFM
+!
+GALLOC = .FALSE.
+IRESP = 0
+YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+!------------------------------------------------------------------
+IHEXTOT = 2*JPHEXT+1
+TZFD=>GETFD(YFNLFI)
+IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
+ IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==IHEXTOT .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
+ IFIELDP=>KFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1)
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELDP,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH,IRESP)
+ END IF
+ KFIELD(:,:)=SPREAD(SPREAD(KFIELD(JPHEXT+1,JPHEXT+1),DIM=1,NCOPIES=IHEXTOT),DIM=2,NCOPIES=IHEXTOT)
+! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
+ ELSE IF (LPACK .AND. L2D .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
+ IFIELDP=>KFIELD(:,JPHEXT+1:JPHEXT+1)
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELDP,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH,IRESP)
+ END IF
+ KFIELD(:,:)=SPREAD(KFIELD(:,JPHEXT+1),DIM=2,NCOPIES=IHEXTOT)
+ ELSE
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,KFIELD,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(KFIELD),KFIELD,TZFMH,IRESP)
+ END IF
+ END IF
+ IF (IRESP /= 0) GOTO 1000
+ ELSE
+ IF (ISP == TZFD%OWNER) THEN
+ CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,HDIR,GALLOC)
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELDP,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP&
+ & ,TZFMH,IRESP)
+ END IF
+ ELSE
+ ALLOCATE(IFIELDP(0,0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
+ IF (IRESP /= 0) GOTO 1000
+ !
+ CALL BCAST_HEADER(TZFD,TZFMH)
+ !
+ IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
+ ! XX or YY Scatter Field
+ CALL SCATTER_XXFIELD(HDIR,IFIELDP,KFIELD,TZFD%OWNER,TZFD&
+ & %COMM)
+ ELSE IF (HDIR == 'XY') THEN
+ IF (LPACK .AND. L2D) THEN
+ ! 2D compact case
+ CALL SCATTER_XXFIELD('XX',IFIELDP(:,1),KFIELD(:,JPHEXT+1),TZFD%OWNER,TZFD%COMM)
+ KFIELD(:,:) = SPREAD(KFIELD(:,JPHEXT+1),DIM=2,NCOPIES=IHEXTOT)
+ ELSE
+ ! XY Scatter Field
+ CALL SCATTER_XYFIELD(IFIELDP,KFIELD,TZFD%OWNER,TZFD%COMM)
+ END IF
+ ELSE
+ ! Broadcast Field
+ IF (ISP == TZFD%OWNER) KFIELD = IFIELDP
+ CALL MPI_BCAST(KFIELD,SIZE(KFIELD),MPI_INTEGER,TZFD%OWNER-1&
+ & ,TZFD%COMM,IERR)
+ END IF
+ END IF
+ KGRID = TZFMH%GRID
+ KLENCH = TZFMH%COMLEN
+ HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
+ELSE
+ IRESP = -61
+END IF
+!----------------------------------------------------------------
+1000 CONTINUE
+!! Error handler
+IF (IRESP.NE.0) THEN
+ CALL FM_READ_ERR("FMREADN2_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
+ENDIF
+!
+IF (GALLOC) DEALLOCATE (IFIELDP)
+KRESP = IRESP
+RETURN
+!------------------------------------------------------------------
+END SUBROUTINE FMREADN2_ll
+
+
+SUBROUTINE FMREADL0_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
+USE MODD_FM
+USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+
+!* 0. DECLARATIONS
+! ------------
+!
+!
+!* 0.1 Declarations of arguments
+!
+CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
+CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
+LOGICAL, INTENT(INOUT)::OFIELD ! array containing the data field
+INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
+INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
+CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
+INTEGER, INTENT(INOUT)::KRESP ! return-code
+!
+!* 0.2 Declarations of local variables
+!
+CHARACTER(LEN=JPFINL) :: YFNLFI
+INTEGER :: IERR
+TYPE(FD_ll), POINTER :: TZFD
+INTEGER :: IRESP
+INTEGER :: IFIELD
+TYPE(FMHEADER) :: TZFMH
+
+!
+!* 1.1 THE NAME OF LFIFM
+!
+IRESP = 0
+YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+!------------------------------------------------------------------
+TZFD=>GETFD(YFNLFI)
+IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELD,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,1,IFIELD,TZFMH,IRESP)
+ END IF
+ IF (IRESP /= 0) GOTO 1000
+ ELSE
+ IF (ISP == TZFD%OWNER) THEN
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELD,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,1,IFIELD,TZFMH,IRESP)
+ END IF
+ END IF
+ !
+ CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
+ IF (IRESP /= 0) GOTO 1000
+ !
+ CALL BCAST_HEADER(TZFD,TZFMH)
+ !
+ CALL MPI_BCAST(IFIELD,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,&
+ & IERR)
+ END IF
+ IF (IFIELD==1) THEN
+ OFIELD=.TRUE.
+ ELSE
+ OFIELD=.FALSE.
+ END IF
+ KGRID = TZFMH%GRID
+ KLENCH = TZFMH%COMLEN
+ HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
+ELSE
+ IRESP = -61
+END IF
+!----------------------------------------------------------------
+1000 CONTINUE
+!! Error handler
+IF (IRESP.NE.0) THEN
+ CALL FM_READ_ERR("FMREADL0_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
+ENDIF
+KRESP = IRESP
+RETURN
+
+END SUBROUTINE FMREADL0_ll
+
+SUBROUTINE FMREADL1_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
+USE MODD_FM
+USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+!
+CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
+CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
+LOGICAL, DIMENSION(:), INTENT(INOUT)::OFIELD ! array containing the data field
+INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
+INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
+CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
+INTEGER, INTENT(INOUT)::KRESP ! return-code
+!
+!* 0.2 Declarations of local variables
+!
+
+CHARACTER(LEN=JPFINL) :: YFNLFI
+INTEGER :: IERR
+TYPE(FD_ll), POINTER :: TZFD
+INTEGER :: IRESP
+INTEGER, DIMENSION(SIZE(OFIELD)) :: IFIELD
+TYPE(FMHEADER) :: TZFMH
+
+!
+!* 1.1 THE NAME OF LFIFM
+!
+IRESP = 0
+YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+!
+TZFD=>GETFD(YFNLFI)
+IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELD,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELD),IFIELD,TZFMH&
+ & ,IRESP)
+ END IF
+ IF (IRESP /= 0) GOTO 1000
+ ELSE
+ IF (ISP == TZFD%OWNER) THEN
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELD,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELD),IFIELD,TZFMH&
+ & ,IRESP)
+ END IF
+ END IF
+ !
+ CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
+ IF (IRESP /= 0) GOTO 1000
+ !
+ CALL BCAST_HEADER(TZFD,TZFMH)
+ !
+ CALL MPI_BCAST(IFIELD,SIZE(IFIELD),MPI_INTEGER,TZFD%OWNER-1,TZFD&
+ & %COMM,IERR)
+ END IF
+ WHERE (IFIELD==1)
+ OFIELD=.TRUE.
+ ELSEWHERE
+ OFIELD=.FALSE.
+ END WHERE
+ KGRID = TZFMH%GRID
+ KLENCH = TZFMH%COMLEN
+ HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
+ELSE
+ IRESP = -61
+END IF
+!----------------------------------------------------------------
+1000 CONTINUE
+!! Error handler
+IF (IRESP.NE.0) THEN
+ CALL FM_READ_ERR("FMREADL1_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
+ENDIF
+KRESP = IRESP
+RETURN
+
+END SUBROUTINE FMREADL1_ll
+
+SUBROUTINE FMREADC0_ll(HFILEM,HRECFM,HFIPRI,HDIR,HFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIREAD
+USE MODD_FM
+USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+!* 0.1 Declarations of arguments
+!
+CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
+CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
+CHARACTER(LEN=*), INTENT(INOUT)::HFIELD ! array containing the data field
+INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
+INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
+CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
+INTEGER, INTENT(INOUT)::KRESP ! return-code
+!
+!* 0.2 Declarations of local variables
+!
+CHARACTER(LEN=JPFINL) :: YFNLFI
+INTEGER :: IERR
+TYPE(FD_ll), POINTER :: TZFD
+INTEGER :: IRESP
+INTEGER :: JLOOP
+INTEGER, DIMENSION(LEN(HFIELD)) :: IFIELD
+CHARACTER(LEN(HFIELD)) :: YFIELD
+INTEGER :: ILENG
+TYPE(FMHEADER) :: TZFMH
+
+!
+!* 1.1 THE NAME OF LFIFM
+!
+IRESP = 0
+YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+ILENG=LEN(HFIELD)
+!
+TZFD=>GETFD(YFNLFI)
+IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,YFIELD,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,IRESP)
+ END IF
+ IF (IRESP /= 0) GOTO 1000
+ ELSE ! parallel execution
+ IF (ISP == TZFD%OWNER) THEN
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,YFIELD,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,IRESP)
+ END IF
+ END IF
+ !
+ CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
+ IF (IRESP /= 0) GOTO 1000
+ !
+ CALL BCAST_HEADER(TZFD,TZFMH)
+ !
+ IF (LIOCDF4 .AND. .NOT. LLFIREAD) THEN
+ ! NetCDF
+ CALL MPI_BCAST(YFIELD,ILENG,MPI_CHARACTER,TZFD%OWNER-1,TZFD%COMM,&
+ &IERR)
+ ELSE
+ ! LFI
+ CALL MPI_BCAST(IFIELD,ILENG,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,&
+ & IERR)
+ END IF
+ END IF ! parallel execution
+ !
+ IF (LIOCDF4 .AND. .NOT. LLFIREAD) THEN
+ ! NetCDF
+ HFIELD = YFIELD
+ ELSE
+ ! LFI Case
+ DO JLOOP=1,ILENG
+ HFIELD(JLOOP:JLOOP)=ACHAR(IFIELD(JLOOP))
+ END DO
+ END IF
+ KGRID = TZFMH%GRID
+ KLENCH = TZFMH%COMLEN
+ HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
+ELSE
+ IRESP = -61
+END IF
+!----------------------------------------------------------------
+1000 CONTINUE
+!! Error handler
+IF (IRESP.NE.0) THEN
+ CALL FM_READ_ERR("FMREADC0_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
+ENDIF
+KRESP = IRESP
+RETURN
+
+END SUBROUTINE FMREADC0_ll
+
+SUBROUTINE FMREADT0_ll(HFILEM,HRECFM,HFIPRI,HDIR,TFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
+USE MODD_TYPE_DATE
+USE MODD_FM
+USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+!
+!* 0.1 Declarations of arguments
+!
+CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
+CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
+TYPE (DATE_TIME), INTENT(INOUT)::TFIELD ! array containing the data field
+INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
+INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
+CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
+INTEGER, INTENT(INOUT)::KRESP ! return-code
+!
+!
+!* 0.2 Declarations of local variables
+!
+!-------------------------------------------------------------------------------
+
+
+CHARACTER(LEN=JPFINL) :: YFNLFI
+INTEGER :: IERR
+TYPE(FD_ll), POINTER :: TZFD
+INTEGER :: IRESP
+INTEGER,DIMENSION(3) :: ITDATE
+REAL :: ZTIME
+TYPE(FMHEADER) :: TZFMH
+
+!
+!* 1.1 THE NAME OF LFIFM
+!
+IRESP = 0
+
+YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+
+TZFD=>GETFD(YFNLFI)
+IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,TRIM(HRECFM)//'%TDATE',ITDATE,TZFMH,IRESP)
+ CALL NCREAD(TZFD%CDF%NCID,TRIM(HRECFM)//'%TIME',ZTIME,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,TRIM(HRECFM)//'%TDATE',.FALSE.,3,ITDATE&
+ & ,TZFMH,IRESP)
+ CALL FM_READ_ll(TZFD%FLU,TRIM(HRECFM)//'%TIME',.TRUE.,1,ZTIME&
+ & ,TZFMH,IRESP)
+ END IF
+ IF (IRESP /= 0) GOTO 1000
+ ELSE
+ IF (ISP == TZFD%OWNER) THEN
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,TRIM(HRECFM)//'%TDATE',ITDATE,TZFMH,IRESP)
+ CALL NCREAD(TZFD%CDF%NCID,TRIM(HRECFM)//'%TIME',ZTIME,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,TRIM(HRECFM)//'%TDATE',.FALSE.,3,ITDATE&
+ & ,TZFMH,IRESP)
+ CALL FM_READ_ll(TZFD%FLU,TRIM(HRECFM)//'%TIME',.TRUE.,1,ZTIME&
+ & ,TZFMH,IRESP)
+
+ END IF
+ END IF
+ !
+ CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
+ IF (IRESP /= 0) GOTO 1000
+ ! Last header is significant
+ CALL BCAST_HEADER(TZFD,TZFMH)
+ !
+ CALL MPI_BCAST(ITDATE,3,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
+ CALL MPI_BCAST(ZTIME,1,MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
+ END IF
+ TFIELD%TDATE = DATE(ITDATE(1),ITDATE(2),ITDATE(3))
+ TFIELD%TIME = ZTIME
+ KGRID = TZFMH%GRID
+ KLENCH = TZFMH%COMLEN
+ HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
+ELSE
+ IRESP = -61
+END IF
+!----------------------------------------------------------------
+1000 CONTINUE
+!! Error handler
+IF (IRESP.NE.0) THEN
+ CALL FM_READ_ERR("FMREADT0_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
+ENDIF
+KRESP = IRESP
+RETURN
+
+END SUBROUTINE FMREADT0_ll
+
+SUBROUTINE FMREAD_LB(HFILEM,HRECFM,HFIPRI,HLBTYPE,PLB,KRIM,KL3D,&
+ & KGRID,KLENCH,HCOMMENT,KRESP)
+USE MODD_FM
+USE MODD_IO_ll, ONLY : ISP,ISNPROC,GSMONOPROC,LPACK,L2D
+USE MODD_PARAMETERS_ll,ONLY : JPHEXT
+USE MODE_DISTRIB_LB
+USE MODE_TOOLS_ll, ONLY : GET_GLOBALDIMS_ll
+USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+!JUANZ
+USE MODD_TIMEZ, ONLY : TIMEZ
+USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
+!JUANZ
+USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
+
+CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! file name
+CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to be written
+CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! file for prints
+CHARACTER(LEN=*), INTENT(IN) ::HLBTYPE ! 'LBX','LBXU','LBY' or 'LBYV'
+REAL, DIMENSION(:,:,:),TARGET, INTENT(INOUT)::PLB ! array containing the LB field
+INTEGER, INTENT(IN) :: KRIM ! size of the LB area
+INTEGER, INTENT(IN) :: KL3D ! size of the LB array in FM
+INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
+INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
+CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
+INTEGER, INTENT(INOUT)::KRESP ! return-code
+!
+!* 0.2 Declarations of local variables
+!
+CHARACTER(LEN=JPFINL) :: YFNLFI
+INTEGER :: IERR
+TYPE(FD_ll), POINTER :: TZFD
+INTEGER :: IRESP
+REAL,DIMENSION(:,:,:),ALLOCATABLE,TARGET :: Z3D
+REAL,DIMENSION(:,:,:), POINTER :: TX3DP
+TYPE(FMHEADER) :: TZFMH
+INTEGER :: IIMAX_ll,IJMAX_ll
+INTEGER :: IIB,IIE,IJB,IJE
+INTEGER :: JI
+INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
+INTEGER, ALLOCATABLE,DIMENSION(:,:) :: STATUSES
+!JUANZIO
+!JUAN INTEGER,SAVE,DIMENSION(100000) :: REQ_TAB
+INTEGER,ALLOCATABLE,DIMENSION(:) :: REQ_TAB
+INTEGER :: NB_REQ,IKU
+TYPE TX_3DP
+REAL,DIMENSION(:,:,:), POINTER :: X
+END TYPE
+TYPE(TX_3DP),ALLOCATABLE,DIMENSION(:) :: T_TX3DP
+REAL*8,DIMENSION(2) :: T0,T1,T2,T3
+REAL*8,DIMENSION(2) :: T11,T22
+!JUANZIO
+INTEGER :: IHEXTOT
+
+!
+!* 1.1 THE NAME OF LFIFM
+!
+CALL SECOND_MNH2(T11)
+IRESP = 0
+YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+!------------------------------------------------------------------
+IHEXTOT = 2*JPHEXT+1
+TZFD=>GETFD(YFNLFI)
+IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ IF (HLBTYPE == 'LBX' .OR. HLBTYPE == 'LBXU') THEN
+ ALLOCATE(Z3D(KL3D,SIZE(PLB,2),SIZE(PLB,3)))
+ Z3D = 0.0
+ IF (LPACK .AND. L2D) THEN
+ TX3DP=>Z3D(:,JPHEXT+1:JPHEXT+1,:)
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,TX3DP,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(TX3DP),TX3DP,TZFMH,IRESP)
+ END IF
+ Z3D(:,:,:) = SPREAD(Z3D(:,JPHEXT+1,:),DIM=2,NCOPIES=IHEXTOT)
+ ELSE
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,Z3D,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(Z3D),Z3D,TZFMH,IRESP)
+ END IF
+ END IF
+ PLB(1:KRIM+JPHEXT,:,:) = Z3D(1:KRIM+JPHEXT,:,:)
+ PLB(KRIM+JPHEXT+1:2*(KRIM+JPHEXT),:,:) = Z3D(KL3D-KRIM-JPHEXT+1:KL3D,:,:)
+ ELSE !(HLBTYPE == 'LBY' .OR. HLBTYPE == 'LBYV')
+ ALLOCATE(Z3D(SIZE(PLB,1),KL3D,SIZE(PLB,3)))
+ Z3D = 0.0
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,Z3D,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(Z3D),Z3D,TZFMH,IRESP)
+ END IF
+ PLB(:,1:KRIM+JPHEXT,:) = Z3D(:,1:KRIM+JPHEXT,:)
+ PLB(:,KRIM+JPHEXT+1:2*(KRIM+JPHEXT),:) = Z3D(:,KL3D-KRIM-JPHEXT+1:KL3D,:)
+ END IF
+ IF (IRESP /= 0) GOTO 1000
+ ELSE ! multiprocessor execution
+ IF (ISP == TZFD%OWNER) THEN
+ CALL SECOND_MNH2(T0)
+ CALL GET_GLOBALDIMS_ll(IIMAX_ll,IJMAX_ll)
+ IF (HLBTYPE == 'LBX' .OR. HLBTYPE == 'LBXU') THEN
+ ALLOCATE(Z3D(KL3D,IJMAX_ll+2*JPHEXT,SIZE(PLB,3)))
+ Z3D = 0.0
+ IF (LPACK .AND. L2D) THEN
+ TX3DP=>Z3D(:,JPHEXT+1:JPHEXT+1,:)
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,TX3DP,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(TX3DP),TX3DP,TZFMH,IRESP)
+ END IF
+ Z3D(:,:,:) = SPREAD(Z3D(:,JPHEXT+1,:),DIM=2,NCOPIES=IHEXTOT)
+ ELSE
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,Z3D,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(Z3D),Z3D,TZFMH,IRESP)
+ END IF
+ END IF
+ ! erase gap in LB field
+ Z3D(KRIM+JPHEXT+1:2*(KRIM+JPHEXT),:,:) = Z3D(KL3D-KRIM-JPHEXT+1:KL3D,:,:)
+ ELSE !(HLBTYPE == 'LBY' .OR. HLBTYPE == 'LBYV')
+ ALLOCATE(Z3D(IIMAX_ll+2*JPHEXT,KL3D,SIZE(PLB,3)))
+ Z3D = 0.0
+ IF (ASSOCIATED(TZFD%CDF)) THEN
+ CALL NCREAD(TZFD%CDF%NCID,HRECFM,Z3D,TZFMH,IRESP)
+ ELSE
+ CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(Z3D),Z3D,TZFMH,IRESP)
+ END IF
+ ! erase gap in LB field
+ Z3D(:,KRIM+JPHEXT+1:2*(KRIM+JPHEXT),:) = Z3D(:,KL3D-KRIM-JPHEXT+1:KL3D,:)
+ END IF
+ CALL SECOND_MNH2(T1)
+ TIMEZ%T_READLB_READ=TIMEZ%T_READLB_READ + T1 - T0
+ END IF
+ !
+ CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
+ IF (IRESP /= 0) GOTO 1000
+ !
+ CALL BCAST_HEADER(TZFD,TZFMH)
+ !
+ NB_REQ=0
+ ALLOCATE(REQ_TAB(ISNPROC-1))
+ !REQ_TAB=MPI_REQUEST_NULL
+ IF (ISP == TZFD%OWNER) THEN
+ CALL SECOND_MNH2(T1)
+ !ALLOCATE(REQ_TAB(ISNPROC-1))
+ !REQ_TAB=MPI_REQUEST_NULL
+ ALLOCATE(T_TX3DP(ISNPROC-1))
+ IKU = SIZE(Z3D,3)
+ DO JI = 1,ISNPROC
+ CALL GET_DISTRIB_LB(HLBTYPE,JI,'FM','READ',KRIM,IIB,IIE,IJB,IJE)
+ IF (IIB /= 0) THEN
+ TX3DP=>Z3D(IIB:IIE,IJB:IJE,:)
+ IF (ISP /= JI) THEN
+ NB_REQ = NB_REQ + 1
+ ALLOCATE(T_TX3DP(NB_REQ)%X(IIB:IIE,IJB:IJE,IKU))
+ T_TX3DP(NB_REQ)%X=Z3D(IIB:IIE,IJB:IJE,:)
+ CALL MPI_ISEND(T_TX3DP(NB_REQ)%X,SIZE(TX3DP),MPI_FLOAT,JI-1,99,TZFD%COMM,REQ_TAB(NB_REQ),IERR)
+ !CALL MPI_BSEND(T_TX3DP(NB_REQ)%X,SIZE(TX3DP),MPI_FLOAT,JI-1,99,TZFD%COMM,IERR)
+ ELSE
+ CALL GET_DISTRIB_LB(HLBTYPE,JI,'LOC','READ',KRIM,IIB,IIE,IJB,IJE)
+ PLB(IIB:IIE,IJB:IJE,:) = TX3DP(:,:,:)
+ END IF
+ END IF
+ END DO
+ CALL SECOND_MNH2(T2)
+ TIMEZ%T_READLB_SEND=TIMEZ%T_READLB_SEND + T2 - T1
+ IF (NB_REQ .GT.0 ) THEN
+ !ALLOCATE(STATUSES(MPI_STATUS_SIZE,NB_REQ))
+ !CALL MPI_WAITALL(NB_REQ,REQ_TAB,STATUSES,IERR)
+ CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
+ !DEALLOCATE(STATUSES)
+ DO JI=1,NB_REQ ; DEALLOCATE(T_TX3DP(JI)%X) ; ENDDO
+ END IF
+ DEALLOCATE(T_TX3DP)
+ !DEALLOCATE(REQ_TAB)
+ CALL SECOND_MNH2(T3)
+ TIMEZ%T_READLB_WAIT=TIMEZ%T_READLB_WAIT + T3 - T2
+ ELSE
+ CALL SECOND_MNH2(T0)
+ !ALLOCATE(REQ_TAB(1))
+ !REQ_TAB=MPI_REQUEST_NULL
+ CALL GET_DISTRIB_LB(HLBTYPE,ISP,'LOC','READ',KRIM,IIB,IIE,IJB,IJE)
+ IF (IIB /= 0) THEN
+ TX3DP=>PLB(IIB:IIE,IJB:IJE,:)
+ CALL MPI_RECV(TX3DP,SIZE(TX3DP),MPI_FLOAT,TZFD%OWNER-1,99,TZFD%COMM,STATUS,IERR)
+ !NB_REQ = NB_REQ + 1
+ !CALL MPI_IRECV(TX3DP,SIZE(TX3DP),MPI_FLOAT,TZFD%OWNER-1,99,TZFD%COMM,REQ_TAB(NB_REQ),IERR)
+ !IF (NB_REQ .GT.0 ) CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
+ END IF
+ CALL SECOND_MNH2(T1)
+ TIMEZ%T_READLB_RECV=TIMEZ%T_READLB_RECV + T1 - T0
+ END IF
+ DEALLOCATE(REQ_TAB)
+ END IF !(GSMONOPROC)
+ KGRID = TZFMH%GRID
+ KLENCH = TZFMH%COMLEN
+ HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
+ELSE
+ IRESP = -61
+END IF
+!----------------------------------------------------------------
+1000 CONTINUE
+!! Error handler
+IF (IRESP.NE.0) THEN
+ CALL FM_READ_ERR("FMREAD_LB",HFILEM,HFIPRI,HRECFM,HLBTYPE,IRESP)
+ENDIF
+!
+IF (ALLOCATED(Z3D)) DEALLOCATE (Z3D)
+KRESP = IRESP
+!
+!CALL MPI_BARRIER(TZFD%COMM,IERR)
+CALL SECOND_MNH2(T22)
+TIMEZ%T_READLB_ALL=TIMEZ%T_READLB_ALL + T22 - T11
+END SUBROUTINE FMREAD_LB
+
+END MODULE MODE_FMREAD
+
+
+!
diff --git a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90 b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
index 6e2feec89..70025f66f 100644
--- a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
+++ b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
@@ -1,3229 +1,3237 @@
-!MNH_LIC Copyright 1994-2014 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.
-!-----------------------------------------------------------------
-!--------------- special set of characters for CVS information
-!-----------------------------------------------------------------
-! $Source$
-! $Name$
-! $Revision$
-! $Date$
-!-----------------------------------------------------------------
-!Correction :
-! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-! D.Gazen : avril 2016 bug dimensions 2D cases
-!-----------------------------------------------------------------
-
-#ifdef MNH_MPI_DOUBLE_PRECISION
-#define MPI_FLOAT MPI_DOUBLE_PRECISION
-#else
-#define MPI_FLOAT MPI_REAL
-#endif
-
-#ifdef MNH_GA
-MODULE MODE_GA
-#include "mafdecls.fh"
-#include "global.fh"
- !
- ! Global Array Variables
- !
- INTEGER, PARAMETER :: jpix=1 , jpiy = 2 , jpiz = 3
- !
- INTEGER :: NIMAX_ll,NJMAX_ll, IIU_ll,IJU_ll,IKU_ll
- integer :: heap=5*10**6, stack
- logical :: gstatus_ga
- INTEGER, PARAMETER :: ndim_GA = 3
- INTEGER, DIMENSION(ndim_GA) :: dims_GA , chunk_GA
- INTEGER,PARAMETER :: CI=1 ,CJ=-1 ,CK=-1
- INTEGER :: g_a
- integer, DIMENSION(ndim_GA) :: lo_col, hi_col , ld_col
- integer, DIMENSION(ndim_GA) :: lo_zplan , hi_zplan , ld_zplan
- INTEGER :: NIXO_L,NIXE_L,NIYO_L,NIYE_L
- INTEGER :: NIXO_G,NIXE_G,NIYO_G,NIYE_G
-
- LOGICAL,SAVE :: GFIRST_GA = .TRUE.
- INTEGER :: IIU_ll_MAX = -1, IJU_ll_MAX = -1, IKU_ll_MAX = -1
-
- CONTAINS
-
- SUBROUTINE MNH_INIT_GA(MY_NI,MY_NJ,MY_NK,HRECFM,HRW_MODE)
-
-!
-! Modification
-! J.Escobar 5/02/2015 : use JPHEXT from MODD_PARAMETERS_ll
-
- USE MODE_TOOLS_ll, ONLY : GET_GLOBALDIMS_ll
- USE MODD_PARAMETERS_ll, ONLY : JPHEXT
- USE MODD_IO_ll, ONLY : ISP
- USE MODE_GATHER_ll, ONLY : GET_DOMWRITE_ll
- USE MODE_SCATTER_ll, ONLY : GET_DOMREAD_ll
-
- IMPLICIT NONE
-
- INTEGER, INTENT(IN) :: MY_NI,MY_NJ,MY_NK
- CHARACTER(LEN=*), INTENT(IN) :: HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) :: HRW_MODE
-
- IF ( GFIRST_GA ) THEN
- GFIRST_GA = .FALSE.
- !
- ! Allocate memory for GA library
- !
- stack = heap
- !gstatus_ga = ma_init(MT_F_DBL, stack/ISNPROC, heap/ISNPROC)
- gstatus_ga = ma_init(MT_F_DBL, stack, heap)
- if ( .not. gstatus_ga ) STOP " MA_INIT FAILED "
- !
- ! Initialize GA library
- !
- !call ga_initialize_ltd(100000000)
- call ga_initialize()
- END IF
-
- CALL GET_GLOBALDIMS_ll (NIMAX_ll,NJMAX_ll)
- IIU_ll = NIMAX_ll + 2*JPHEXT
- IJU_ll = NJMAX_ll + 2*JPHEXT
- IKU_ll = MY_NK
- !
- ! configure Global array dimensions
- !
- dims_GA(JPIX) = IIU_ll
- dims_GA(JPIY) = IJU_ll
- dims_GA(JPIZ) = IKU_ll
- chunk_GA(JPIX) = CI
- chunk_GA(JPIY) = CJ
- chunk_GA(JPIZ) = CK
- IF ( CI .EQ. 1 ) chunk_GA(JPIX) = dims_GA(JPIX) ! 1 block in X direction
- IF ( CJ .EQ. 1 ) chunk_GA(JPIY) = dims_GA(JPIY) ! 1 block in Y direction
- IF ( CK .EQ. 1 ) chunk_GA(JPIZ) = dims_GA(JPIZ) ! 1 block in Z direction
- !
- ! (re)create global array g_a ( if to small create it ... )
- !
- IF ( ( IIU_ll .GT. IIU_ll_MAX ) .OR. ( IJU_ll .GT. IJU_ll_MAX ) .OR. ( IKU_ll .GT. IKU_ll_MAX ) ) THEN
- !
- ! reallocate the g_a , if need with bigger Z size
- !
- IF ( IKU_ll_MAX .NE. -1 ) gstatus_ga = ga_destroy(g_a)
- IIU_ll_MAX = IIU_ll
- IJU_ll_MAX = IJU_ll
- IKU_ll_MAX = IKU_ll
- gstatus_ga = nga_create(MT_F_DBL, ndim_GA, dims_GA, HRECFM ,chunk_GA, g_a)
- call ga_sync()
- END IF
- !----------------------------------------------------------------------!
- ! !
- ! Define/describe local column data owned by this processor to write !
- ! !
- !----------------------------------------------------------------------!
- IF ( HRW_MODE .EQ. "WRITE" ) THEN
- CALL GET_DOMWRITE_ll(ISP,'local',NIXO_L,NIXE_L,NIYO_L,NIYE_L)
- CALL GET_DOMWRITE_ll(ISP,'global',NIXO_G,NIXE_G,NIYO_G,NIYE_G)
- ELSE
- CALL GET_DOMREAD_ll(ISP,NIXO_L,NIXE_L,NIYO_L,NIYE_L)
- CALL GET_DOMREAD_ll(ISP,NIXO_G,NIXE_G,NIYO_G,NIYE_G)
- END IF
- !
- ! portion of data to write/put | read/get by this proc
- !
- lo_col(JPIX) = NIXO_G
- hi_col(JPIX) = NIXE_G
-
- lo_col(JPIY) = NIYO_G
- hi_col(JPIY) = NIYE_G
-
- lo_col(JPIZ) = 1
- hi_col(JPIZ) = IKU_ll
- !
- ! declaration size of this local input column array
- !
- ld_col(JPIX) = MY_NI
- ld_col(JPIY) = MY_NJ
- ld_col(JPIZ) = MY_NK
- !
- !-----------------------------------------------------!
- ! !
- ! Size of local ZSLIDE_ll Write buffer on I/O proc !
- ! !
- !-----------------------------------------------------!
- !
- ! declared dimension
- !
- ld_zplan(JPIX) = IIU_ll
- ld_zplan(JPIY) = IJU_ll
- ld_zplan(JPIZ) = 1
- !
- ! write data by Z slide by I/O proc
- !
- lo_zplan(JPIX:JPIY) = 1
- hi_zplan(JPIX) = IIU_ll
- hi_zplan(JPIY) = IJU_ll
- !call ga_sync()
- !
- END SUBROUTINE MNH_INIT_GA
-
-END MODULE MODE_GA
-
-#endif
-
-MODULE MODE_FMWRIT
-
- USE MODD_MPIF
-#if defined(MNH_IOCDF4)
- USE MODE_NETCDF
-#endif
-
- IMPLICIT NONE
-
- PRIVATE
-
- INTERFACE FMWRIT
- MODULE PROCEDURE FMWRITX0_ll,FMWRITX1_ll,FMWRITX2_ll,FMWRITX3_ll,&
- & FMWRITX4_ll,FMWRITX5_ll,FMWRITX6_ll,&
- & FMWRITN0_ll,FMWRITN1_ll,FMWRITN2_ll,&
- & FMWRITL0_ll,FMWRITL1_ll,FMWRITC0_ll,&
- & FMWRITC1_ll,FMWRITT0_ll
- END INTERFACE
-
- INTERFACE FMWRITBOX
- MODULE PROCEDURE FMWRITBOXX2_ll,FMWRITBOXX3_ll,FMWRITBOXX4_ll,&
- & FMWRITBOXX5_ll,FMWRITBOXX6_ll
- END INTERFACE
-
- PUBLIC FMWRIT_LB,FMWRITBOX,FMWRIT,FMWRITX0_ll,FMWRITX1_ll,FMWRITX2_ll,FMWRITX3_ll,&
- & 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
-
- !INCLUDE 'mpif.h'
-
-CONTAINS
-
- SUBROUTINE FM_WRIT_ERR(HFUNC,HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
- & ,KRESP)
- USE MODE_FM, ONLY : FMLOOK_ll
-
- CHARACTER(LEN=*) :: HFUNC
- CHARACTER(LEN=*) :: HFILEM
- CHARACTER(LEN=*) :: HFIPRI
- CHARACTER(LEN=*) :: HRECFM
- CHARACTER(LEN=*) :: HDIR
- INTEGER :: KGRID
- INTEGER :: KLENCH
- INTEGER :: KRESP
-
- INTEGER :: ILUPRI
- INTEGER :: IRESP
-
- CALL FMLOOK_ll(HFIPRI,HFIPRI,ILUPRI,IRESP)
- WRITE (ILUPRI,*) ' exit from ',HFUNC,' with RESP:',KRESP
- WRITE (ILUPRI,*) ' | HFILEM = ',HFILEM
- WRITE (ILUPRI,*) ' | HRECFM = ',HRECFM
- WRITE (ILUPRI,*) ' | HDIR = ',HDIR
- WRITE (ILUPRI,*) ' | KGRID = ',KGRID
- WRITE (ILUPRI,*) ' | KLENCH = ',KLENCH
-
- END SUBROUTINE FM_WRIT_ERR
-
-
-
- SUBROUTINE FMWRITX0_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-!
-! Modification
-! J.Escobar 15/04/2014 : add write to all Z files for all FMWRITX0_ll variables
-! J.Escobar 23/06/2014 : bug , replace .FALSE. to .TRUE. = OREAL type transmetted to FM_WRIT_ll
-!
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-#ifdef MNH_NCWRIT
- USE MODD_GRID
- USE MODD_DIM_n, ONLY: NIMAX
- USE MODD_NCOUT
- USE MODE_UTIL
-#endif
- !
- !* 0. DECLARATIONS
- ! ------------
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL, INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- !----------------------------------------------------------------
- CHARACTER(LEN=JPFINL) :: YFNLFI
- 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
- !JUANZIO
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article 0 ' , HRECFM
- !
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
- END IF
- IF ( LNETCDF .AND. NIMAX == 0 ) THEN
-! PRINT * , ' SAVE MAP PARAMETER IF PGD '
- IF ( trim(hrecfm) == "RPK" ) THEN
- XRPK=PFIELD
- ELSEIF ( trim(hrecfm) == "BETA" ) THEN
- XBETA=PFIELD
- ELSEIF (trim(hrecfm) == "LATORI" ) THEN
- XLATORI=PFIELD
- ELSEIF (trim(hrecfm) == "LONORI" ) THEN
- XLONORI=PFIELD
- ELSEIF (trim(hrecfm) == "LAT0" ) THEN
- XLAT0=PFIELD
- ELSEIF (trim(hrecfm) == "LON0" ) THEN
- XLON0=PFIELD
- END IF
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
-#endif
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
- END IF
- IF ( LNETCDF .AND. NIMAX == 0 ) THEN
-! print * , ' SAVE MAP PARAMETER IF PGD '
- IF ( trim(hrecfm) == "RPK" ) THEN
- XRPK=PFIELD
- ELSEIF ( trim(hrecfm) == "BETA" ) THEN
- XBETA=PFIELD
- ELSEIF (trim(hrecfm) == "LATORI" ) THEN
- XLATORI=PFIELD
- ELSEIF (trim(hrecfm) == "LONORI" ) THEN
- XLONORI=PFIELD
- ELSEIF (trim(hrecfm) == "LAT0" ) THEN
- XLAT0=PFIELD
- ELSEIF (trim(hrecfm) == "LON0" ) THEN
- XLON0=PFIELD
- END IF
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
-#endif
- 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(HFILEM)//YK_FILE//".lfi"
- TZFD_IOZ => GETFD(YFILE_IOZ)
- IK_RANK = TZFD_IOZ%OWNER
- IF ( ISP == IK_RANK ) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD_IOZ%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD_IOZ%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD_IOZ%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
-#endif
- END IF
- END DO
- ENDIF
- ELSE
- IRESP = -61
- END IF
- !----------------------------------------------------------------
- IF (IRESP.NE.0) THEN
- CALL FM_WRIT_ERR("FMWRITX0_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
- END IF
- KRESP = IRESP
- END SUBROUTINE FMWRITX0_ll
-
- SUBROUTINE FMWRITX1_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- USE MODE_ALLOCBUFFER_ll
- USE MODE_GATHER_ll
-#ifdef MNH_NCWRIT
- USE MODE_UTIL
- USE MODE_DIMLIST
- USE MODD_DIM_n, ONLY: NIMAX
- USE MODD_NCOUT
-#endif
- !
- !* 0. DECLARATIONS
- ! ------------
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL,DIMENSION(:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- !----------------------------------------------------------------
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- TYPE(FMHEADER) :: TZFMH
- REAL,DIMENSION(:),POINTER :: ZFIELDP
- LOGICAL :: GALLOC
-#ifdef MNH_NCWRIT
- TYPE(workfield), DIMENSION(:), POINTER :: TZRECLIST
- INTEGER,DIMENSION(6) :: TABDIM
-#endif
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-#ifdef MNH_NCWRIT
- TABDIM(:)=1
- TABDIM(1)=SIZE(PFIELD,1)
- !print * , ' Writing Article 1 ' , HRECFM
-#endif
- !------------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- END IF
- ! ------- WRITE NETCDF
- IF ( LNETCDF .AND. NC_WRITE ) THEN
- CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,PFIELD,.TRUE.,TZRECLIST, &
-! CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,PFIELD, &
- & KLENCH,HCOMMENT)
- IF ( NC_FILE == 'phy' ) THEN
-!!!!! CAS WRITE_PHYS_PARAM ... l'ecriture lfi ne peut pas se faire en meme temps
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE., &
- SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- END IF
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
-#endif
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
- ELSE
- ALLOCATE(ZFIELDP(0))
- GALLOC = .TRUE.
- END IF
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
- END IF
- !
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- END IF
- IF ( LNETCDF .AND. NC_WRITE ) THEN
- TABDIM(1)=SIZE(ZFIELDP,1)
- CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST, &
- & KLENCH,HCOMMENT)
- IF ( NC_FILE == 'phy' ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- END IF
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
-#endif
- 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("FMWRITX1_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
- END IF
- IF (GALLOC) DEALLOCATE(ZFIELDP)
- KRESP = IRESP
- END SUBROUTINE FMWRITX1_ll
-
- SUBROUTINE FMWRITX2_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT,LPACK,L1D,L2D
- 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_TIMEZ, ONLY : TIMEZ
- USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
- !JUANZ
-#ifdef MNH_NCWRIT
- USE MODE_UTIL
- USE MODE_DIMLIST
- USE MODD_DIM_n, ONLY: NIMAX
- USE MODD_NCOUT
-#endif
-#ifdef MNH_GA
- !JUAN_IOGA
- USE MODE_GA
-#endif
- !
- IMPLICIT NONE
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL,DIMENSION(:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- REAL,DIMENSION(:,:),POINTER :: ZFIELDP
- TYPE(FMHEADER) :: TZFMH
- LOGICAL :: GALLOC
-#ifdef MNH_NCWRIT
- TYPE(workfield), DIMENSION(:), POINTER :: TZRECLIST
- INTEGER,DIMENSION(6) :: TABDIM
- LOGICAL :: NCWR
- INTEGER :: LHREC_BEG,LHRECFM
-#endif
- !
- !JUANZ
- REAL*8,DIMENSION(2) :: T0,T1,T2
- REAL*8,DIMENSION(2) :: T11,T22
- !JUANZ
-#ifdef MNH_GA
- REAL,DIMENSION(:,:),POINTER :: ZFIELDP_GA , ZFIELD_GA
- REAL :: ERROR
- INTEGER :: JI
-#endif
- !
- !* 1.1 THE NAME OF LFIFM
- !
- CALL SECOND_MNH2(T11)
- IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-#ifdef MNH_NCWRIT
- NCWR=.TRUE.
- TABDIM(:)=1
- TABDIM(1)=SIZE(PFIELD,1)
- TABDIM(2)=SIZE(PFIELD,2)
- !print * , ' Writing Article 2 ' , HRECFM
-#endif
- !------------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- ! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==2*JPHEXT+1 .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
- ZFIELDP=>PFIELD(2:2,2:2)
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
- IF ( LNETCDF .AND. NC_WRITE ) THEN
- TABDIM(1)=1
- TABDIM(2)=1
- CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST,&
- & KLENCH,HCOMMENT)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
-#endif
- ! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
- ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
- ZFIELDP=>PFIELD(:,2:2)
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
- LHRECFM = LEN_TRIM(ADJUSTL(HRECFM))
- IF ( LHRECFM > 5 ) THEN
- LHREC_BEG =LHRECFM-4
- IF ( ADJUSTL(HRECFM(LHREC_BEG:LHRECFM)) == 'DATIM') THEN
- NCWR = .FALSE.
- END IF
- END IF
- IF ( LNETCDF .AND. NC_WRITE .AND. NCWR ) THEN
- TABDIM(2)=1
- IF ( NC_FILE == 'phy' ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE., &
- SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
- CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST,&
- & KLENCH,HCOMMENT)
- END IF
- NCWR = .TRUE.
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
-#endif
- ELSE
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- END IF
- LHRECFM = LEN_TRIM(ADJUSTL(HRECFM))
- IF ( LHRECFM > 5 ) THEN
- LHREC_BEG =LHRECFM-4
- IF ( ADJUSTL(HRECFM(LHREC_BEG:LHRECFM)) == 'DATIM') THEN
- NCWR = .FALSE.
- END IF
- END IF
-! IF ( NIMAX /= 0 ) THEN
- IF ( LNETCDF .AND. NC_WRITE .AND. NCWR ) THEN
- IF ( NC_FILE == 'phy' ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE., &
- SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- END IF
- CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,PFIELD,.TRUE.,TZRECLIST, &
- & KLENCH,HCOMMENT)
- END IF
- NCWR = .TRUE.
-! END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
-#endif
- END IF
- ELSE ! multiprocessor execution
- CALL SECOND_MNH2(T0)
- IF (ISP == TZFD%OWNER) THEN
- ! I/O processor case
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
- ELSE
- ALLOCATE(ZFIELDP(0,0))
- GALLOC = .TRUE.
- END IF
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
- ELSEIF (HDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- CALL GATHER_XXFIELD('XX',PFIELD(:,2),ZFIELDP(:,1),TZFD%OWNER,TZFD%COMM)
- ELSE
-#ifdef MNH_GA
- !
- ! init/create the ga , dim3 = 1
- !
- CALL MNH_INIT_GA(SIZE(PFIELD,1),SIZE(PFIELD,2),1,HRECFM,"WRITE")
- !
- ! copy columun data to global arrays g_a
- !
- ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2)))
- ZFIELD_GA = PFIELD
- call nga_put(g_a, lo_col, hi_col,ZFIELD_GA(NIXO_L,NIYO_L) , ld_col)
-!!$ print*," nga_put =",HRECFM,g_a," lo_col=",lo_col," hi_col=",hi_col,ZFIELD_GA(NIXO_L,NIYO_L), &
-!!$ " NIXO_L=",NIXO_L,"NIYO_L=",NIYO_L," ld_col=",ld_col," ISP=",ISP
- call ga_sync
- DEALLOCATE (ZFIELD_GA)
- IF (ISP == TZFD%OWNER) THEN
- !
- ! this proc get the Z slide to write
- !
- lo_zplan(JPIZ) = 1
- hi_zplan(JPIZ) = 1
-!!$ ALLOCATE (ZFIELDP_GA(IIU_ll,IJU_ll))
- call nga_get(g_a, lo_zplan, hi_zplan,ZFIELDP, ld_zplan)
-!!$ print*,"nga_get=",HRECFM,g_a," lo_zplan=",lo_zplan," hi_zplan=",hi_zplan &
-!!$ ,ZFIELDP(1,1)," ld_zplan=",ld_zplan
- END IF
-!!$ call ga_sync
-#else
- CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
-!!$ IF (ISP == TZFD%OWNER) THEN
-!!$ print*,HRECFM, "ERR=", MAXVAL (ZFIELDP_GA - ZFIELDP)
-!!$ DO JI=1,IJU_ll
-!!$ !print*,HRECFM, "ERR=", ZFIELDP_GA(:,JI) - ZFIELDP(:,JI)
-!!$ print*,HRECFM, "WX2::GA =", ZFIELDP_GA(:,JI)
-!!$ print*,HRECFM, "WX2::MNH=", ZFIELDP(:,JI)
-!!$ END DO
-!!$ END IF
-#endif
- END IF
- END IF
- CALL SECOND_MNH2(T1)
- TIMEZ%T_WRIT2D_GATH=TIMEZ%T_WRIT2D_GATH + T1 - T0
- !
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- END IF
- LHRECFM = LEN_TRIM(ADJUSTL(HRECFM))
- IF ( LHRECFM > 5 ) THEN
- LHREC_BEG =LHRECFM-4
- IF ( ADJUSTL(HRECFM(LHREC_BEG:LHRECFM)) == 'DATIM') THEN
- NCWR = .FALSE.
- END IF
- END IF
- IF ( LNETCDF .AND. NC_WRITE .AND. NCWR ) THEN
- TABDIM(1)=SIZE(ZFIELDP,1)
- TABDIM(2)=SIZE(ZFIELDP,2)
- CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST, &
-! CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP, &
- & KLENCH,HCOMMENT)
- END IF
- NCWR=.TRUE.
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
-#endif
- END IF
-#ifdef MNH_GA
-!!$ IF (ISP .EQ. 1 ) THEN
-!!$ call ga_print_stats()
-!!$ call ga_summarize(1)
-!!$ ENDIF
- call ga_sync
-!!$ gstatus_ga = ga_destroy(g_a)
-#endif
- CALL SECOND_MNH2(T2)
- TIMEZ%T_WRIT2D_WRIT=TIMEZ%T_WRIT2D_WRIT + T2 - T1
- !
- 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("FMWRITX2_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
- END IF
- IF (GALLOC) DEALLOCATE(ZFIELDP)
- KRESP = IRESP
- IF (ASSOCIATED(TZFD)) CALL MPI_BARRIER(TZFD%COMM,IERR)
- CALL SECOND_MNH2(T22)
- TIMEZ%T_WRIT2D_ALL=TIMEZ%T_WRIT2D_ALL + T22 - T11
- END SUBROUTINE FMWRITX2_ll
-
- SUBROUTINE FMWRITX3_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT,LPACK,L1D,L2D
- 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_NCWRIT
- USE MODE_UTIL
- USE MODD_DIM_n, ONLY: NIMAX
- USE MODD_NCOUT
-#endif
-#ifdef MNH_GA
- USE MODE_GA
-#endif
- USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
- !
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=JPFINL) :: YFNLFI
- 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(HRECFM)) :: 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_NCWRIT
- TYPE(workfield), DIMENSION(:), POINTER :: TZRECLIST
- INTEGER,DIMENSION(6) :: TABDIM
- CHARACTER(LEN=LEN(HRECFM)) :: HRECT
- INTEGER :: LHRECT
-#endif
-#ifdef MNH_GA
- REAL,DIMENSION(:,:,:),POINTER :: ZFIELD_GA
-#endif
- !
- !* 1.1 THE NAME OF LFIFM
- !
- CALL SECOND_MNH2(T11)
- IRESP = 0
- GALLOC = .FALSE.
- GALLOC_ll = .FALSE.
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article 3 ' , HRECFM
-!
-#ifdef MNH_NCWRIT
- HRECT=TRIM(HRECFM)
- LHRECT=LEN(TRIM(HRECT))
- TABDIM(:)=1
- TABDIM(1)=SIZE(PFIELD,1)
- TABDIM(2)=SIZE(PFIELD,2)
- TABDIM(3)=SIZE(PFIELD,3)
- IF ( LHRECT .gt. 4 ) THEN
- IF ( HRECT(LHRECT-4:LHRECT) == 'TRAJZ' ) THEN
- TABDIM(3)=SIZE(PFIELD,1)
- TABDIM(1)=1
- END IF
- END IF
- IF ( TRIM(HRECFM) == 'AVION.TRAJX' ) THEN
- TABDIM(1)=SIZE(PFIELD,2)
- TABDIM(2)=1
- ELSEIF ( TRIM(HRECFM) == 'AVION.TRAJY' ) THEN
- TABDIM(1)=SIZE(PFIELD,2)
- TABDIM(2)=1
- ELSEIF ( TRIM(HRECFM) == 'AVION.TRAJZ' ) THEN
- TABDIM(1)=SIZE(PFIELD,2)
- TABDIM(2)=1
- END IF
-#endif
- !------------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC .AND. (TZFD%nb_procio.eq.1) ) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- ! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==2*JPHEXT+1 .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
- ZFIELDP=>PFIELD(2:2,2:2,:)
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
- IF ( LNETCDF .AND. NC_WRITE ) THEN
- TABDIM(1)=1
- TABDIM(2)=1
- CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST, &
- & KLENCH,HCOMMENT)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
-#endif
- ! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
- ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
- ZFIELDP=>PFIELD(:,2:2,:)
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
- IF ( LNETCDF .AND. NC_WRITE ) THEN
- TABDIM(2)=1
- IF ( NC_FILE == 'phy' ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
- CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST, &
-! CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP, &
- & KLENCH,HCOMMENT)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
-#endif
- ELSE
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- END IF
- IF ( LNETCDF .AND. NC_WRITE ) THEN
- IF ( NC_FILE == 'phy' ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- END IF
- CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,PFIELD,.TRUE.,TZRECLIST, &
-! CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,PFIELD, &
- & KLENCH,HCOMMENT)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
-#endif
- END IF
- ELSEIF ( (TZFD%nb_procio .eq. 1 ) .OR. ( HDIR == '--' ) ) THEN ! multiprocessor execution & 1 proc IO
- ! write 3D field in 1 time = output for graphique
- IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
- ELSE
- ALLOCATE(ZFIELDP(0,0,0))
- GALLOC = .TRUE.
- END IF
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
- ELSEIF (HDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- CALL GATHER_XXFIELD('XX',PFIELD(:,2,:),ZFIELDP(:,1,:),TZFD%OWNER,TZFD%COMM)
- ELSE
- CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
- END IF
- END IF
- !
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- END IF
- IF ( LNETCDF .AND. NC_WRITE ) THEN
- TABDIM(1)=SIZE(ZFIELDP,1)
- TABDIM(2)=SIZE(ZFIELDP,2)
- TABDIM(3)=SIZE(ZFIELDP,3)
- IF ( NC_FILE == ' phy' ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- END IF
- CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST, &
-! CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP, &
- & KLENCH,HCOMMENT)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
-#endif
- 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(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3),HRECFM,"WRITE")
- !
- ! copy columun data to global arrays g_a
- !
- 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 =",HRECFM,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)
- 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(HFILEM)//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=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- WRITE(YK,'(I4.4)') JKK
- YRECZSLIDE = TRIM(HRECFM)//YK
- !
- IF ( SIZE(ZSLIDE_ll) .EQ. 0 ) THEN
- DEALLOCATE(ZSLIDE_ll)
- CALL ALLOCBUFFER_ll(ZSLIDE_ll,ZSLIDE,HDIR,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,HDIR,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(PFIELD,3),inb_proc_real
- !
- ! collecte the data
- !
- JK_MAX=min(SIZE(PFIELD,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(HFILEM)//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 (HDIR == 'XX' .OR. HDIR =='YY') THEN
- STOP " XX NON PREVU SUR BG POUR LE MOMENT "
- CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
- ELSEIF (HDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- STOP " L2D NON PREVU SUR BG POUR LE MOMENT "
- CALL GATHER_XXFIELD('XX',PFIELD(:,2,:),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 => 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 &
- & ,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(HFILEM)//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,HDIR,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 => 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)
- END IF
- END IF
- END DO
- CALL SECOND_MNH2(T1)
- TIMEZ%T_WRIT3D_RECV=TIMEZ%T_WRIT3D_RECV + T1 - T0
- !JUANIOZ
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- WRITE(YK,'(I4.4)') JKK
- YRECZSLIDE = TRIM(HRECFM)//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,HDIR,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("FMWRITX3_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,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 FMWRITX3_ll
-
- SUBROUTINE FMWRITX4_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT,LPACK,L1D,L2D
- 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
-!!!!! MOD SB
-#ifdef MNH_NCWRIT
- USE MODD_NCOUT
- USE MODE_UTIL
-#endif
-!!!!! MOD SB
- !
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL,DIMENSION(:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- REAL,DIMENSION(:,:,:,:),POINTER :: ZFIELDP
- TYPE(FMHEADER) :: TZFMH
- LOGICAL :: GALLOC
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article 4 ' , HRECFM
- !------------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- ! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==2*JPHEXT+1 .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
- ZFIELDP=>PFIELD(2:2,2:2,:,:)
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
-#endif
- ! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
- ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
- ZFIELDP=>PFIELD(:,2:2,:,:)
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
-#endif
- ELSE
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
-#endif
- END IF
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
- ELSE
- ALLOCATE(ZFIELDP(0,0,0,0))
- GALLOC = .TRUE.
- END IF
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
- ELSEIF (HDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- CALL GATHER_XXFIELD('XX',PFIELD(:,2,:,:),ZFIELDP(:,1,:,:),TZFD%OWNER,TZFD%COMM)
- ELSE
- CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
- END IF
- END IF
- !
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
-#endif
- 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("FMWRITX4_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
- END IF
- IF (GALLOC) DEALLOCATE(ZFIELDP)
- KRESP = IRESP
- END SUBROUTINE FMWRITX4_ll
-
- SUBROUTINE FMWRITX5_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT,LPACK,L1D,L2D
- 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
-#ifdef MNH_NCWRIT
- USE MODE_UTIL
- USE MODD_DIM_n
- USE MODD_NCOUT
-#endif
- !
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- REAL,DIMENSION(:,:,:,:,:),POINTER :: ZFIELDP
- TYPE(FMHEADER) :: TZFMH
- LOGICAL :: GALLOC
-#ifdef MNH_NCWRIT
- TYPE(workfield), DIMENSION(:), POINTER :: TZRECLIST
- INTEGER,DIMENSION(6) :: TABDIM
-#endif
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-#ifdef MNH_NCWRIT
- TABDIM(:)=1
- TABDIM(1)=SIZE(PFIELD,1)
- TABDIM(2)=SIZE(PFIELD,2)
- TABDIM(3)=SIZE(PFIELD,3)
- TABDIM(4)=SIZE(PFIELD,4)
- TABDIM(5)=SIZE(PFIELD,5)
- !print * , ' Writing Article 5 ' , HRECFM
-#endif
- !------------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- ! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==2*JPHEXT+1 .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
- ZFIELDP=>PFIELD(2:2,2:2,:,:,:)
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
-#endif
- ! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
- ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
- ZFIELDP=>PFIELD(:,2:2,:,:,:)
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
- IF ( LNETCDF .AND. NC_WRITE ) THEN
- TABDIM(2)=1
- IF ( NC_FILE == 'phy' ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP), &
- ZFIELDP,TZFMH,IRESP)
- END IF
- CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST, &
-! CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP, &
- & KLENCH,HCOMMENT)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
-#endif
- ELSE
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- END IF
- IF ( LNETCDF .AND. NC_WRITE ) THEN
- IF ( NC_FILE == 'phy' ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD), &
- PFIELD,TZFMH,IRESP)
- END IF
- CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,PFIELD,.TRUE.,TZRECLIST, &
-! CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,PFIELD, &
- & KLENCH,HCOMMENT)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
-#endif
- END IF
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
- ELSE
- ALLOCATE(ZFIELDP(0,0,0,0,0))
- GALLOC = .TRUE.
- END IF
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
- ELSEIF (HDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- CALL GATHER_XXFIELD('XX',PFIELD(:,2,:,:,:),ZFIELDP(:,1,:,:,:),&
- & TZFD%OWNER,TZFD%COMM)
- ELSE
- CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
- END IF
- END IF
- !
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- END IF
- IF ( LNETCDF .AND. NC_WRITE ) THEN
- IF ( NC_FILE == 'phy' ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- END IF
- CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST, &
-! CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP, &
- & KLENCH,HCOMMENT)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
-#endif
- 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("FMWRITX5_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
- END IF
- IF (GALLOC) DEALLOCATE(ZFIELDP)
- KRESP = IRESP
- END SUBROUTINE FMWRITX5_ll
-
- SUBROUTINE FMWRITX6_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- USE MODE_ALLOCBUFFER_ll
- USE MODE_GATHER_ll
- !
-!!!! MOD SB
-#ifdef MNH_NCWRIT
- USE MODD_NCOUT
- USE MODE_UTIL
-#endif
-!!!! MOD SB
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL,DIMENSION(:,:,:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- REAL,DIMENSION(:,:,:,:,:,:),POINTER :: ZFIELDP
- TYPE(FMHEADER) :: TZFMH
- LOGICAL :: GALLOC
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article 6 ' , HRECFM
- !------------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
-#endif
- ELSE ! multiprocessor execution
- IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
- ELSE
- ALLOCATE(ZFIELDP(0,0,0,0,0,0))
- GALLOC = .TRUE.
- END IF
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
- ELSEIF (HDIR == 'XY') THEN
- CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
- END IF
- !
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
-#endif
- 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("FMWRITX6_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
- END IF
- IF (GALLOC) DEALLOCATE(ZFIELDP)
- KRESP = IRESP
- END SUBROUTINE FMWRITX6_ll
-
- SUBROUTINE FMWRITN0_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- !* 0. DECLARATIONS
- ! ------------
-!!!! MOD SB
-#ifdef MNH_NCWRIT
- USE MODD_NCOUT
- USE MODE_UTIL
-#endif
-!!!! MOD SB
- !
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- INTEGER, INTENT(IN) ::KFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=JPFINL) :: YFNLFI
- 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
- !JUANZIO
- !----------------------------------------------------------------
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article N0 ' , HRECFM
- !------------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,KFIELD,TZFMH,IRESP)
-#endif
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,KFIELD,TZFMH,IRESP)
-#endif
- 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(HFILEM)//YK_FILE//".lfi"
- TZFD_IOZ => GETFD(YFILE_IOZ)
- IK_RANK = TZFD_IOZ%OWNER
- IF ( ISP == IK_RANK ) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD_IOZ%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD_IOZ%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD_IOZ%CDF,HRECFM,HDIR,KFIELD,TZFMH,IRESP)
-#endif
- END IF
- END DO
- ENDIF
- ELSE
- IRESP = -61
- END IF
- !----------------------------------------------------------------
- IF (IRESP.NE.0) THEN
- CALL FM_WRIT_ERR("FMWRITN0_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
- & ,IRESP)
- END IF
- KRESP = IRESP
- END SUBROUTINE FMWRITN0_ll
-
- SUBROUTINE FMWRITN1_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- USE MODE_ALLOCBUFFER_ll
- USE MODE_GATHER_ll
- !* 0. DECLARATIONS
- ! ------------
-!!!! MOD SB
-#ifdef MNH_NCWRIT
- USE MODD_NCOUT
- USE MODE_UTIL
-#endif
-!!!! MOD SB
- !
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- INTEGER,DIMENSION(:),TARGET,INTENT(IN) ::KFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- TYPE(FMHEADER) :: TZFMH
- INTEGER,DIMENSION(:),POINTER :: IFIELDP
- LOGICAL :: GALLOC
-#ifdef MNH_NCWRIT
- REAL,DIMENSION(SIZE(KFIELD)) ::WFIELD
- TYPE(workfield), DIMENSION(:), POINTER :: TZRECLIST
- INTEGER,DIMENSION(6) :: TABDIM
-#endif
- !----------------------------------------------------------------
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article N1 ' , HRECFM
-#ifdef MNH_NCWRIT
- WFIELD = KFIELD
- TABDIM(:)=1
-#endif
- !------------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(KFIELD),KFIELD,TZFMH,IRESP)
- END IF
- IF ( LNETCDF .AND. NC_WRITE ) THEN
- CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,WFIELD, &
- & .TRUE.,TZRECLIST,KLENCH,HCOMMENT)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(KFIELD),KFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,KFIELD,TZFMH,IRESP)
-#endif
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,HDIR,GALLOC)
- ELSE
- ALLOCATE(IFIELDP(0))
- GALLOC = .TRUE.
- END IF
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- CALL GATHER_XXFIELD(HDIR,KFIELD,IFIELDP,TZFD%OWNER,TZFD%COMM)
- END IF
- !
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH&
- & ,IRESP)
- END IF
- IF ( LNETCDF .AND. NC_WRITE ) THEN
- CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,WFIELD, &
- .TRUE.,TZRECLIST,&
- & KLENCH,HCOMMENT)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH&
- & ,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELDP,TZFMH,IRESP)
-#endif
- 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("FMWRITN1_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
- & ,IRESP)
- END IF
- IF (GALLOC) DEALLOCATE(IFIELDP)
- KRESP = IRESP
- END SUBROUTINE FMWRITN1_ll
-
- SUBROUTINE FMWRITN2_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT,LPACK,L1D,L2D
- 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
- !
-!!!! MOD SB
-#ifdef MNH_NCWRIT
- USE MODD_NCOUT
- USE MODE_UTIL
-#endif
-!!!! MOD SB
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- INTEGER,DIMENSION(:,:),TARGET,INTENT(IN) ::KFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- INTEGER,DIMENSION(:,:),POINTER :: IFIELDP
- TYPE(FMHEADER) :: TZFMH
- LOGICAL :: GALLOC
-
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article N2 ' , HRECFM
- !
- TZFD=>GETFD(YFNLFI)
-! IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- ! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
- IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==2*JPHEXT+1 .AND. SIZE(KFIELD,2)==2*JPHEXT+1) THEN
- IFIELDP=>KFIELD(2:2,2:2)
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELDP,TZFMH,IRESP)
-#endif
- ! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
- ELSEIF (LPACK .AND. L2D .AND. SIZE(KFIELD,2)==2*JPHEXT+1) THEN
- IFIELDP=>KFIELD(:,2:2)
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELDP,TZFMH,IRESP)
-#endif
- ELSE
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(KFIELD),KFIELD,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(KFIELD),KFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,KFIELD,TZFMH,IRESP)
-#endif
- END IF
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,HDIR,GALLOC)
- ELSE
- ALLOCATE(IFIELDP(0,0))
- GALLOC = .TRUE.
- END IF
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- CALL GATHER_XXFIELD(HDIR,KFIELD,IFIELDP,TZFD%OWNER,TZFD%COMM)
- ELSEIF (HDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- CALL GATHER_XXFIELD('XX',KFIELD(:,2),IFIELDP(:,1),TZFD%OWNER,TZFD%COMM)
- ELSE
- CALL GATHER_XYFIELD(KFIELD,IFIELDP,TZFD%OWNER,TZFD%COMM)
- END IF
- END IF
- !
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH&
- & ,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH&
- & ,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELDP,TZFMH,IRESP)
-#endif
- 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("FMWRITN2_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
- END IF
- IF (GALLOC) DEALLOCATE(IFIELDP)
- KRESP = IRESP
- END SUBROUTINE FMWRITN2_ll
-
-
- SUBROUTINE FMWRITL0_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-
-!!!! MOD SB
-#ifdef MNH_NCWRIT
- USE MODD_NCOUT
- USE MODE_UTIL
-#endif
-!!!! MOD SB
- !
- !* 0. DECLARATIONS
- ! ------------
- !
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- LOGICAL, INTENT(IN) ::OFIELD ! array containing the data field
- INTEGER, INTENT(IN)::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN)::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN)::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- INTEGER :: IFIELD
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- TYPE(FMHEADER) :: TZFMH
-
- !----------------------------------------------------------------
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article L0 ' , HRECFM
- IF (OFIELD) THEN
- IFIELD=1
- ELSE
- IFIELD=0
- END IF
- !----------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
-! IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,IFIELD,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,IFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELD,TZFMH,IRESP)
-#endif
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,IFIELD,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,IFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELD,TZFMH,IRESP)
-#endif
- 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("FMWRITL0_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
- & ,IRESP)
- END IF
- KRESP = IRESP
- END SUBROUTINE FMWRITL0_ll
-
- SUBROUTINE FMWRITL1_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-
- !* 0. DECLARATIONS
- ! ------------
-!!!! MOD SB
-#ifdef MNH_NCWRIT
- USE MODD_NCOUT
- USE MODE_UTIL
-#endif
-!!!! MOD SB
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- LOGICAL,DIMENSION(:),INTENT(IN) ::OFIELD ! array containing the data field
- INTEGER, INTENT(IN)::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN)::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN)::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- INTEGER, DIMENSION(SIZE(OFIELD)) :: IFIELD
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- TYPE(FMHEADER) :: TZFMH
-
- !----------------------------------------------------------------
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article L1 ' , HRECFM
- WHERE (OFIELD)
- IFIELD=1
- ELSEWHERE
- IFIELD=0
- END WHERE
- !----------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
-! IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELD),IFIELD,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELD),IFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELD,TZFMH,IRESP)
-#endif
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELD),IFIELD,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELD),IFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELD,TZFMH,IRESP)
-#endif
- 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("FMWRITL1_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
- & ,IRESP)
- END IF
- KRESP = IRESP
- END SUBROUTINE FMWRITL1_ll
-
- SUBROUTINE FMWRITC0_ll(HFILEM,HRECFM,HFIPRI,HDIR,HFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- !
- !* 0. DECLARATIONS
- ! ------------
- !
-!!!! MOD SB
-#ifdef MNH_NCWRIT
- USE MODD_NCOUT
- USE MODE_UTIL
-#endif
-!!! MOD SB
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- CHARACTER(LEN=*), INTENT(IN) ::HFIELD ! array containing the data field
- INTEGER, INTENT(IN)::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN)::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN)::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- INTEGER :: JLOOP
- INTEGER,DIMENSION(:),ALLOCATABLE :: IFIELD
- INTEGER :: ILENG
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- TYPE(FMHEADER) :: TZFMH
-#ifdef MNH_NCWRIT
- TYPE(workfield), DIMENSION(:), POINTER :: TZRECLIST
- INTEGER,DIMENSION(6) :: TABDIM
-#endif
-
- !----------------------------------------------------------------
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article C0 ' , HRECFM
- ILENG=LEN(HFIELD)
-#ifdef MNH_NCWRIT
- TABDIM(:)=1
- TABDIM(1)=ILENG
-#endif
- !
- IF (ILENG==0) THEN
- ILENG=1
- ALLOCATE(IFIELD(1))
- IFIELD(1)=IACHAR(' ')
- ELSE
- ALLOCATE(IFIELD(ILENG))
- DO JLOOP=1,ILENG
- IFIELD(JLOOP)=IACHAR(HFIELD(JLOOP:JLOOP))
- END DO
- END IF
- !----------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,KRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,HFIELD,TZFMH,IRESP)
-#endif
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,KRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,HFIELD,TZFMH,IRESP)
-#endif
- 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("FMWRITC0_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
- & ,IRESP)
- END IF
- IF (ALLOCATED(IFIELD)) DEALLOCATE(IFIELD)
- KRESP = IRESP
- END SUBROUTINE FMWRITC0_ll
-
- SUBROUTINE FMWRITC1_ll(HFILEM,HRECFM,HFIPRI,HDIR,HFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- !
- !* 0. DECLARATIONS
- ! ------------
- !
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- CHARACTER(LEN=*),DIMENSION(:),INTENT(IN) ::HFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- INTEGER :: J,JJ
- INTEGER :: ILE, IP
- INTEGER,DIMENSION(:),ALLOCATABLE :: IFIELD
- INTEGER :: ILENG
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- TYPE(FMHEADER) :: TZFMH
- !----------------------------------------------------------------
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article C1 ' , HRECFM
- 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
- !----------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,HFIELD,TZFMH,IRESP)
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,HFIELD,TZFMH,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("FMWRITC1_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
- & ,IRESP)
- END IF
- IF (ALLOCATED(IFIELD)) DEALLOCATE(IFIELD)
- KRESP = IRESP
- END SUBROUTINE FMWRITC1_ll
-
- SUBROUTINE FMWRITT0_ll(HFILEM,HRECFM,HFIPRI,HDIR,TFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_TYPE_DATE
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- !
-!!!! MOD SB
-#ifdef MNH_NCWRIT
- USE MODD_NCOUT
- USE MODE_UTIL
-#endif
-!!!! MOD SB
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- TYPE (DATE_TIME), INTENT(IN) ::TFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !--------------------------------------------------------------------
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- TYPE(FMHEADER) :: TZFMH
- INTEGER, DIMENSION(3) :: ITDATE ! date array
- !
- !-------------------------------------------------------------------------------
- IRESP = 0
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article T0 ' , HRECFM
- ITDATE(1)=TFIELD%TDATE%YEAR
- ITDATE(2)=TFIELD%TDATE%MONTH
- ITDATE(3)=TFIELD%TDATE%DAY
- !-------------------------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
-! IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMMENT='YYYYMMDD'
- TZFMH%COMLEN=LEN_TRIM(TZFMH%COMMENT)
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TDATE',.FALSE.,3,ITDATE&
- & ,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TDATE',.FALSE.,3,ITDATE&
- & ,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,TRIM(HRECFM)//'%TDATE',HDIR,ITDATE,TZFMH,IRESP)
-#endif
- TZFMH%COMMENT='SECONDS'
- TZFMH%COMLEN=LEN_TRIM(TZFMH%COMMENT)
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TIME',.TRUE.,1,TFIELD%TIME&
- & ,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TIME',.TRUE.,1,TFIELD%TIME&
- & ,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,TRIM(HRECFM)//'%TIME',HDIR,TFIELD%TIME,TZFMH,IRESP)
-#endif
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMMENT='YYYYMMDD'
- TZFMH%COMLEN=LEN_TRIM(TZFMH%COMMENT)
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TDATE',.FALSE.,3,ITDATE&
- & ,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TDATE',.FALSE.,3,ITDATE&
- & ,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,TRIM(HRECFM)//'%TDATE',HDIR,ITDATE,TZFMH,IRESP)
-#endif
- TZFMH%COMMENT='SECONDS'
- TZFMH%COMLEN=LEN_TRIM(TZFMH%COMMENT)
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TIME',.TRUE.,1,TFIELD%TIME&
- & ,TZFMH,IRESP)
- END IF
-#else
-
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TIME',.TRUE.,1,TFIELD%TIME&
- & ,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,TRIM(HRECFM)//'%TIME',HDIR,TFIELD%TIME,TZFMH,IRESP)
-#endif
- 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("FMWRITT0_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
- & ,IRESP)
- END IF
- KRESP = IRESP
- END SUBROUTINE FMWRITT0_ll
-
- SUBROUTINE FMWRIT_LB(HFILEM,HRECFM,HFIPRI,HLBTYPE,PLB,KRIM,KL3D,&
- & KGRID,KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,ISNPROC,GSMONOPROC,LIOCDF4,LLFIOUT,LPACK,L2D
- USE MODD_PARAMETERS_ll,ONLY : JPHEXT
- USE MODD_FM
- USE MODE_DISTRIB_LB
- USE MODE_TOOLS_ll, ONLY : GET_GLOBALDIMS_ll
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- !
-!!!! MOD SB
-#ifdef MNH_NCWRIT
- USE MODD_NCOUT
- USE MODE_UTIL
-#endif
-!!!! MOD SB
- USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to be written
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! file for prints in FM
- CHARACTER(LEN=*), INTENT(IN) ::HLBTYPE! 'LBX','LBXU','LBY' or 'LBYV'
- REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) ::PLB ! array containing the LB field
- INTEGER, INTENT(IN) ::KRIM ! size of the LB area
- INTEGER, INTENT(IN) ::KL3D ! size of the LB array in FM
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- REAL,DIMENSION(:,:,:),ALLOCATABLE,TARGET :: Z3D
- REAL,DIMENSION(:,:,:), POINTER :: TX3DP
- TYPE(FMHEADER) :: TZFMH
- INTEGER :: IIMAX_ll,IJMAX_ll
- INTEGER :: JI
- INTEGER :: IIB,IIE,IJB,IJE
- INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
- INTEGER,ALLOCATABLE,DIMENSION(:) :: REQ_TAB
- INTEGER :: NB_REQ,IKU
- TYPE TX_3DP
- REAL,DIMENSION(:,:,:), POINTER :: X
- END TYPE TX_3DP
- TYPE(TX_3DP),ALLOCATABLE,DIMENSION(:) :: T_TX3DP
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article LB ' , HRECFM
- IF (KL3D /= 2*(KRIM+JPHEXT)) THEN
- IRESP = -30
- GOTO 1000
- END IF
- !
- TZFD=>GETFD(YFNLFI)
-! IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LPACK .AND. L2D) THEN
- TX3DP=>PLB(:,JPHEXT+1:JPHEXT+1,:)
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(TX3DP),TX3DP,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(TX3DP),TX3DP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',TX3DP,TZFMH,IRESP)
-#endif
- ELSE
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PLB),PLB,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PLB),PLB,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',PLB,TZFMH,IRESP)
-#endif
- END IF
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- ! I/O proc case
- CALL GET_GLOBALDIMS_ll(IIMAX_ll,IJMAX_ll)
- IF (HLBTYPE == 'LBX' .OR. HLBTYPE == 'LBXU') THEN
- ALLOCATE(Z3D((KRIM+JPHEXT)*2,IJMAX_ll+2*JPHEXT,SIZE(PLB,3)))
- ELSE ! HLBTYPE == 'LBY' .OR. HLBTYPE == 'LBYV'
- ALLOCATE(Z3D(IIMAX_ll+2*JPHEXT,(KRIM+JPHEXT)*2,SIZE(PLB,3)))
- END IF
- DO JI = 1,ISNPROC
- CALL GET_DISTRIB_LB(HLBTYPE,JI,'FM','WRITE',KRIM,IIB,IIE,IJB,IJE)
- IF (IIB /= 0) THEN
- TX3DP=>Z3D(IIB:IIE,IJB:IJE,:)
- IF (ISP /= JI) THEN
- CALL MPI_RECV(TX3DP,SIZE(TX3DP),MPI_FLOAT,JI-1,99,TZFD%COMM,STATUS,IERR)
- ELSE
- CALL GET_DISTRIB_LB(HLBTYPE,JI,'LOC','WRITE',KRIM,IIB,IIE,IJB,IJE)
- TX3DP = PLB(IIB:IIE,IJB:IJE,:)
- END IF
- END IF
- END DO
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LPACK .AND. L2D) THEN
- TX3DP=>Z3D(:,2:2,:)
- ELSE
- TX3DP=>Z3D
- END IF
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(TX3DP),TX3DP,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(TX3DP),TX3DP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',TX3DP,TZFMH,IRESP)
-#endif
- ELSE
- NB_REQ=0
- ALLOCATE(REQ_TAB(1))
- ALLOCATE(T_TX3DP(1))
- IKU = SIZE(PLB,3)
- ! Other processors
- CALL GET_DISTRIB_LB(HLBTYPE,ISP,'LOC','WRITE',KRIM,IIB,IIE,IJB,IJE)
- IF (IIB /= 0) THEN
- TX3DP=>PLB(IIB:IIE,IJB:IJE,:)
- NB_REQ = NB_REQ + 1
- ALLOCATE(T_TX3DP(NB_REQ)%X(IIB:IIE,IJB:IJE,IKU))
- T_TX3DP(NB_REQ)%X=PLB(IIB:IIE,IJB:IJE,:)
- CALL MPI_ISEND(T_TX3DP(NB_REQ)%X,SIZE(TX3DP),MPI_FLOAT,TZFD%OWNER-1,99,TZFD%COMM,REQ_TAB(NB_REQ),IERR)
- !CALL MPI_BSEND(TX3DP,SIZE(TX3DP),MPI_FLOAT,TZFD%OWNER-1,99,TZFD%COMM,IERR)
- END IF
- IF (NB_REQ .GT.0 ) THEN
- CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
- DEALLOCATE(T_TX3DP(1)%X)
- END IF
- DEALLOCATE(T_TX3DP,REQ_TAB)
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD&
- & %COMM,IERR)
- END IF !(GSMONOPROC)
- ELSE
- IRESP = -61
- END IF
- !----------------------------------------------------------------
-1000 CONTINUE
- IF (IRESP.NE.0) THEN
- CALL FM_WRIT_ERR("FMWRIT_LB",HFILEM,HFIPRI,HRECFM,HLBTYPE,KGRID,KLENCH,IRESP)
- END IF
- !
- IF (ALLOCATED(Z3D)) DEALLOCATE(Z3D)
- KRESP = IRESP
- END SUBROUTINE FMWRIT_LB
-
- SUBROUTINE FMWRITBOXX2_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
- HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- USE MODE_GATHER_ll
- !
-!!!! MOD SB
-#ifdef MNH_NCWRIT
- USE MODD_NCOUT
- USE MODE_UTIL
-#endif
-!!!! MOD SB
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
- REAL,DIMENSION(:,:),TARGET, INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(IN) ::KXOBOX !
- INTEGER, INTENT(IN) ::KXEBOX ! Global coordinates of the box
- INTEGER, INTENT(IN) ::KYOBOX !
- INTEGER, INTENT(IN) ::KYEBOX !
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- REAL,DIMENSION(:,:),POINTER :: ZFIELDP
- TYPE(FMHEADER) :: TZFMH
- LOGICAL :: GALLOC
-
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article BOXX2 ' , HRECFM
- !------------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
-! IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID = KGRID
- TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
- TZFMH%COMMENT = HCOMMENT
- IF (HBUDGET /= 'BUDGET') THEN
- ! take the sub-section of PFIELD defined by the box
- ZFIELDP=>PFIELD(KXOBOX:KXEBOX,KYOBOX:KYEBOX)
- ELSE
- ! take the field as a budget
- ZFIELDP=>PFIELD
- END IF
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
-#endif
- ELSE ! multiprocessor execution
- IF (ISP == TZFD%OWNER) THEN
- ! Allocate the box
- ALLOCATE(ZFIELDP(KXEBOX-KXOBOX+1,KYEBOX-KYOBOX+1))
- GALLOC = .TRUE.
- ELSE
- ALLOCATE(ZFIELDP(0,0))
- GALLOC = .TRUE.
- END IF
- !
- CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM,&
- & KXOBOX,KXEBOX,KYOBOX,KYEBOX,HBUDGET)
- !
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID = KGRID
- TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
- TZFMH%COMMENT = HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
-#endif
- 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("FMWRITBOXX2_ll",HFILEM,HFIPRI,HRECFM,'XY',KGRID,LEN(HCOMMENT),IRESP)
- END IF
- IF (GALLOC) DEALLOCATE(ZFIELDP)
- KRESP = IRESP
- END SUBROUTINE FMWRITBOXX2_ll
-
- SUBROUTINE FMWRITBOXX3_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
- HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- USE MODE_GATHER_ll
- !
-!!!! MOD SB
-#ifdef MNH_NCWRIT
- USE MODD_NCOUT
- USE MODE_UTIL
-#endif
-!!!! MOD SB
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
- REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(IN) ::KXOBOX !
- INTEGER, INTENT(IN) ::KXEBOX ! Global coordinates of the box
- INTEGER, INTENT(IN) ::KYOBOX !
- INTEGER, INTENT(IN) ::KYEBOX !
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- REAL,DIMENSION(:,:,:),POINTER :: ZFIELDP
- TYPE(FMHEADER) :: TZFMH
- LOGICAL :: GALLOC
-
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article BOXX3 ' , HRECFM
- !------------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
-! IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID = KGRID
- TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
- TZFMH%COMMENT = HCOMMENT
- IF (HBUDGET /= 'BUDGET') THEN
- ! take the sub-section of PFIELD defined by the box
- ZFIELDP=>PFIELD(KXOBOX:KXEBOX,KYOBOX:KYEBOX,:)
- ELSE
- ! take the field as a budget
- ZFIELDP=>PFIELD
- END IF
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
-#endif
- ELSE ! multiprocessor execution
- IF (ISP == TZFD%OWNER) THEN
- ! Allocate the box
- ALLOCATE(ZFIELDP(KXEBOX-KXOBOX+1,KYEBOX-KYOBOX+1,SIZE(PFIELD,3)))
- GALLOC = .TRUE.
- ELSE
- ALLOCATE(ZFIELDP(0,0,0))
- GALLOC = .TRUE.
- END IF
- !
- CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM,&
- & KXOBOX,KXEBOX,KYOBOX,KYEBOX,HBUDGET)
- !
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID = KGRID
- TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
- TZFMH%COMMENT = HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
-#endif
- 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("FMWRITBOXX3_ll",HFILEM,HFIPRI,HRECFM,'XY',KGRID,LEN(HCOMMENT),IRESP)
- END IF
- IF (GALLOC) DEALLOCATE(ZFIELDP)
- KRESP = IRESP
- END SUBROUTINE FMWRITBOXX3_ll
-
- SUBROUTINE FMWRITBOXX4_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
- HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- USE MODE_GATHER_ll
- !
-!!!! MOD SB
-#ifdef MNH_NCWRIT
- USE MODD_NCOUT
- USE MODE_UTIL
-#endif
-!!!! MOD SB
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
- REAL,DIMENSION(:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(IN) ::KXOBOX !
- INTEGER, INTENT(IN) ::KXEBOX ! Global coordinates of the box
- INTEGER, INTENT(IN) ::KYOBOX !
- INTEGER, INTENT(IN) ::KYEBOX !
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- REAL,DIMENSION(:,:,:,:),POINTER :: ZFIELDP
- TYPE(FMHEADER) :: TZFMH
- LOGICAL :: GALLOC
-
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article BOXX4 ' , HRECFM
- !------------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
-! IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID = KGRID
- TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
- TZFMH%COMMENT = HCOMMENT
- IF (HBUDGET /= 'BUDGET') THEN
- ! take the sub-section of PFIELD defined by the box
- ZFIELDP=>PFIELD(KXOBOX:KXEBOX,KYOBOX:KYEBOX,:,:)
- ELSE
- ! take the field as a budget
- ZFIELDP=>PFIELD
- END IF
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
-#endif
- ELSE ! multiprocessor execution
- IF (ISP == TZFD%OWNER) THEN
- ! Allocate the box
- ALLOCATE(ZFIELDP(KXEBOX-KXOBOX+1,KYEBOX-KYOBOX+1,SIZE(PFIELD,3),SIZE(PFIELD,4)))
- GALLOC = .TRUE.
- ELSE
- ALLOCATE(ZFIELDP(0,0,0,0))
- GALLOC = .TRUE.
- END IF
- !
- CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM,&
- & KXOBOX,KXEBOX,KYOBOX,KYEBOX,HBUDGET)
- !
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID = KGRID
- TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
- TZFMH%COMMENT = HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
-#endif
- 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("FMWRITBOXX4_ll",HFILEM,HFIPRI,HRECFM,'XY',KGRID,LEN(HCOMMENT),IRESP)
- END IF
- IF (GALLOC) DEALLOCATE(ZFIELDP)
- KRESP = IRESP
- END SUBROUTINE FMWRITBOXX4_ll
-
- SUBROUTINE FMWRITBOXX5_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
- HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- USE MODE_GATHER_ll
- !
-!!!! MOD SB
-#ifdef MNH_NCWRIT
- USE MODD_NCOUT
- USE MODE_UTIL
-#endif
-!!!! MOD SB
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
- REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(IN) ::KXOBOX !
- INTEGER, INTENT(IN) ::KXEBOX ! Global coordinates of the box
- INTEGER, INTENT(IN) ::KYOBOX !
- INTEGER, INTENT(IN) ::KYEBOX !
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- REAL,DIMENSION(:,:,:,:,:),POINTER :: ZFIELDP
- TYPE(FMHEADER) :: TZFMH
- LOGICAL :: GALLOC
-
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article BOXX5 ' , HRECFM
- !------------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
-! IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID = KGRID
- TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
- TZFMH%COMMENT = HCOMMENT
- IF (HBUDGET /= 'BUDGET') THEN
- ! take the sub-section of PFIELD defined by the box
- ZFIELDP=>PFIELD(KXOBOX:KXEBOX,KYOBOX:KYEBOX,:,:,:)
- ELSE
- ! take the field as a budget
- ZFIELDP=>PFIELD
- END IF
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
-#endif
- ELSE ! multiprocessor execution
- IF (ISP == TZFD%OWNER) THEN
- ! Allocate the box
- ALLOCATE(ZFIELDP(KXEBOX-KXOBOX+1,KYEBOX-KYOBOX+1,SIZE(PFIELD,3),&
- & SIZE(PFIELD,4),SIZE(PFIELD,5)))
- GALLOC = .TRUE.
- ELSE
- ALLOCATE(ZFIELDP(0,0,0,0,0))
- GALLOC = .TRUE.
- END IF
- !
- CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM,&
- & KXOBOX,KXEBOX,KYOBOX,KYEBOX,HBUDGET)
- !
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID = KGRID
- TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
- TZFMH%COMMENT = HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
-#endif
- 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("FMWRITBOXX5_ll",HFILEM,HFIPRI,HRECFM,'XY',KGRID,LEN(HCOMMENT),IRESP)
- END IF
- IF (GALLOC) DEALLOCATE(ZFIELDP)
- KRESP = IRESP
- END SUBROUTINE FMWRITBOXX5_ll
-
- SUBROUTINE FMWRITBOXX6_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
- HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- USE MODE_GATHER_ll
- !
-!!!! MOD SB
-#ifdef MNH_NCWRIT
- USE MODD_NCOUT
- USE MODE_UTIL
-#endif
-!!!! MOD SB
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
- REAL,DIMENSION(:,:,:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(IN) ::KXOBOX !
- INTEGER, INTENT(IN) ::KXEBOX ! Global coordinates of the box
- INTEGER, INTENT(IN) ::KYOBOX !
- INTEGER, INTENT(IN) ::KYEBOX !
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- REAL,DIMENSION(:,:,:,:,:,:),POINTER :: ZFIELDP
- TYPE(FMHEADER) :: TZFMH
- LOGICAL :: GALLOC
-
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article BOXX6 ' , HRECFM
- !------------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
-! IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID = KGRID
- TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
- TZFMH%COMMENT = HCOMMENT
- IF (HBUDGET /= 'BUDGET') THEN
- ! take the sub-section of PFIELD defined by the box
- ZFIELDP=>PFIELD(KXOBOX:KXEBOX,KYOBOX:KYEBOX,:,:,:,:)
- ELSE
- ! take the field as a budget
- ZFIELDP=>PFIELD
- END IF
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
-#endif
- ELSE ! multiprocessor execution
- IF (ISP == TZFD%OWNER) THEN
- ! Allocate the box
- ALLOCATE(ZFIELDP(KXEBOX-KXOBOX+1,KYEBOX-KYOBOX+1,SIZE(PFIELD,3),&
- & SIZE(PFIELD,4),SIZE(PFIELD,5),SIZE(PFIELD,6)))
- GALLOC = .TRUE.
- ELSE
- ALLOCATE(ZFIELDP(0,0,0,0,0,0))
- GALLOC = .TRUE.
- END IF
- !
- CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM,&
- & KXOBOX,KXEBOX,KYOBOX,KYEBOX,HBUDGET)
- !
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID = KGRID
- TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
- TZFMH%COMMENT = HCOMMENT
-#ifdef MNH_NCWRIT
- IF ( DEF_NC .AND. LLFIFM ) THEN
- CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- END IF
-#else
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
-#endif
- 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("FMWRITBOXX6_ll",HFILEM,HFIPRI,HRECFM,'XY',KGRID,LEN(HCOMMENT),IRESP)
- END IF
- IF (GALLOC) DEALLOCATE(ZFIELDP)
- KRESP = IRESP
- END SUBROUTINE FMWRITBOXX6_ll
-
-END MODULE MODE_FMWRIT
-
-
+!MNH_LIC Copyright 1994-2014 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.
+!-----------------------------------------------------------------
+!--------------- special set of characters for CVS information
+!-----------------------------------------------------------------
+! $Source$
+! $Name$
+! $Revision$
+! $Date$
+!-----------------------------------------------------------------
+!Correction :
+! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!-----------------------------------------------------------------
+
+#ifdef MNH_MPI_DOUBLE_PRECISION
+#define MPI_FLOAT MPI_DOUBLE_PRECISION
+#else
+#define MPI_FLOAT MPI_REAL
+#endif
+
+#ifdef MNH_GA
+MODULE MODE_GA
+#include "mafdecls.fh"
+#include "global.fh"
+ !
+ ! Global Array Variables
+ !
+ INTEGER, PARAMETER :: jpix=1 , jpiy = 2 , jpiz = 3
+ !
+ INTEGER :: NIMAX_ll,NJMAX_ll, IIU_ll,IJU_ll,IKU_ll
+ integer :: heap=5*10**6, stack
+ logical :: gstatus_ga
+ INTEGER, PARAMETER :: ndim_GA = 3
+ INTEGER, DIMENSION(ndim_GA) :: dims_GA , chunk_GA
+ INTEGER,PARAMETER :: CI=1 ,CJ=-1 ,CK=-1
+ INTEGER :: g_a
+ integer, DIMENSION(ndim_GA) :: lo_col, hi_col , ld_col
+ integer, DIMENSION(ndim_GA) :: lo_zplan , hi_zplan , ld_zplan
+ INTEGER :: NIXO_L,NIXE_L,NIYO_L,NIYE_L
+ INTEGER :: NIXO_G,NIXE_G,NIYO_G,NIYE_G
+
+ LOGICAL,SAVE :: GFIRST_GA = .TRUE.
+ INTEGER :: IIU_ll_MAX = -1, IJU_ll_MAX = -1, IKU_ll_MAX = -1
+
+ CONTAINS
+
+ SUBROUTINE MNH_INIT_GA(MY_NI,MY_NJ,MY_NK,HRECFM,HRW_MODE)
+
+!
+! Modification
+! J.Escobar 5/02/2015 : use JPHEXT from MODD_PARAMETERS_ll
+
+ USE MODE_TOOLS_ll, ONLY : GET_GLOBALDIMS_ll
+ USE MODD_PARAMETERS_ll, ONLY : JPHEXT
+ USE MODD_IO_ll, ONLY : ISP
+ USE MODE_GATHER_ll, ONLY : GET_DOMWRITE_ll
+ USE MODE_SCATTER_ll, ONLY : GET_DOMREAD_ll
+
+ IMPLICIT NONE
+
+ INTEGER, INTENT(IN) :: MY_NI,MY_NJ,MY_NK
+ CHARACTER(LEN=*), INTENT(IN) :: HRECFM ! name of the article to write
+ CHARACTER(LEN=*), INTENT(IN) :: HRW_MODE
+
+ IF ( GFIRST_GA ) THEN
+ GFIRST_GA = .FALSE.
+ !
+ ! Allocate memory for GA library
+ !
+ stack = heap
+ !gstatus_ga = ma_init(MT_F_DBL, stack/ISNPROC, heap/ISNPROC)
+ gstatus_ga = ma_init(MT_F_DBL, stack, heap)
+ if ( .not. gstatus_ga ) STOP " MA_INIT FAILED "
+ !
+ ! Initialize GA library
+ !
+ !call ga_initialize_ltd(100000000)
+ call ga_initialize()
+ END IF
+
+ CALL GET_GLOBALDIMS_ll (NIMAX_ll,NJMAX_ll)
+ IIU_ll = NIMAX_ll + 2*JPHEXT
+ IJU_ll = NJMAX_ll + 2*JPHEXT
+ IKU_ll = MY_NK
+ !
+ ! configure Global array dimensions
+ !
+ dims_GA(JPIX) = IIU_ll
+ dims_GA(JPIY) = IJU_ll
+ dims_GA(JPIZ) = IKU_ll
+ chunk_GA(JPIX) = CI
+ chunk_GA(JPIY) = CJ
+ chunk_GA(JPIZ) = CK
+ IF ( CI .EQ. 1 ) chunk_GA(JPIX) = dims_GA(JPIX) ! 1 block in X direction
+ IF ( CJ .EQ. 1 ) chunk_GA(JPIY) = dims_GA(JPIY) ! 1 block in Y direction
+ IF ( CK .EQ. 1 ) chunk_GA(JPIZ) = dims_GA(JPIZ) ! 1 block in Z direction
+ !
+ ! (re)create global array g_a ( if to small create it ... )
+ !
+ IF ( ( IIU_ll .GT. IIU_ll_MAX ) .OR. ( IJU_ll .GT. IJU_ll_MAX ) .OR. ( IKU_ll .GT. IKU_ll_MAX ) ) THEN
+ !
+ ! reallocate the g_a , if need with bigger Z size
+ !
+ IF ( IKU_ll_MAX .NE. -1 ) gstatus_ga = ga_destroy(g_a)
+ IIU_ll_MAX = IIU_ll
+ IJU_ll_MAX = IJU_ll
+ IKU_ll_MAX = IKU_ll
+ gstatus_ga = nga_create(MT_F_DBL, ndim_GA, dims_GA, HRECFM ,chunk_GA, g_a)
+ call ga_sync()
+ END IF
+ !----------------------------------------------------------------------!
+ ! !
+ ! Define/describe local column data owned by this processor to write !
+ ! !
+ !----------------------------------------------------------------------!
+ IF ( HRW_MODE .EQ. "WRITE" ) THEN
+ CALL GET_DOMWRITE_ll(ISP,'local',NIXO_L,NIXE_L,NIYO_L,NIYE_L)
+ CALL GET_DOMWRITE_ll(ISP,'global',NIXO_G,NIXE_G,NIYO_G,NIYE_G)
+ ELSE
+ CALL GET_DOMREAD_ll(ISP,NIXO_L,NIXE_L,NIYO_L,NIYE_L)
+ CALL GET_DOMREAD_ll(ISP,NIXO_G,NIXE_G,NIYO_G,NIYE_G)
+ END IF
+ !
+ ! portion of data to write/put | read/get by this proc
+ !
+ lo_col(JPIX) = NIXO_G
+ hi_col(JPIX) = NIXE_G
+
+ lo_col(JPIY) = NIYO_G
+ hi_col(JPIY) = NIYE_G
+
+ lo_col(JPIZ) = 1
+ hi_col(JPIZ) = IKU_ll
+ !
+ ! declaration size of this local input column array
+ !
+ ld_col(JPIX) = MY_NI
+ ld_col(JPIY) = MY_NJ
+ ld_col(JPIZ) = MY_NK
+ !
+ !-----------------------------------------------------!
+ ! !
+ ! Size of local ZSLIDE_ll Write buffer on I/O proc !
+ ! !
+ !-----------------------------------------------------!
+ !
+ ! declared dimension
+ !
+ ld_zplan(JPIX) = IIU_ll
+ ld_zplan(JPIY) = IJU_ll
+ ld_zplan(JPIZ) = 1
+ !
+ ! write data by Z slide by I/O proc
+ !
+ lo_zplan(JPIX:JPIY) = 1
+ hi_zplan(JPIX) = IIU_ll
+ hi_zplan(JPIY) = IJU_ll
+ !call ga_sync()
+ !
+ END SUBROUTINE MNH_INIT_GA
+
+END MODULE MODE_GA
+
+#endif
+
+MODULE MODE_FMWRIT
+
+ USE MODD_MPIF
+#if defined(MNH_IOCDF4)
+ USE MODE_NETCDF
+#endif
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ INTERFACE FMWRIT
+ MODULE PROCEDURE FMWRITX0_ll,FMWRITX1_ll,FMWRITX2_ll,FMWRITX3_ll,&
+ & FMWRITX4_ll,FMWRITX5_ll,FMWRITX6_ll,&
+ & FMWRITN0_ll,FMWRITN1_ll,FMWRITN2_ll,&
+ & FMWRITL0_ll,FMWRITL1_ll,FMWRITC0_ll,&
+ & FMWRITC1_ll,FMWRITT0_ll
+ END INTERFACE
+
+ INTERFACE FMWRITBOX
+ MODULE PROCEDURE FMWRITBOXX2_ll,FMWRITBOXX3_ll,FMWRITBOXX4_ll,&
+ & FMWRITBOXX5_ll,FMWRITBOXX6_ll
+ END INTERFACE
+
+ PUBLIC FMWRIT_LB,FMWRITBOX,FMWRIT,FMWRITX0_ll,FMWRITX1_ll,FMWRITX2_ll,FMWRITX3_ll,&
+ & 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
+
+ !INCLUDE 'mpif.h'
+
+CONTAINS
+
+ SUBROUTINE FM_WRIT_ERR(HFUNC,HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
+ & ,KRESP)
+ USE MODE_FM, ONLY : FMLOOK_ll
+
+ CHARACTER(LEN=*) :: HFUNC
+ CHARACTER(LEN=*) :: HFILEM
+ CHARACTER(LEN=*) :: HFIPRI
+ CHARACTER(LEN=*) :: HRECFM
+ CHARACTER(LEN=*) :: HDIR
+ INTEGER :: KGRID
+ INTEGER :: KLENCH
+ INTEGER :: KRESP
+
+ INTEGER :: ILUPRI
+ INTEGER :: IRESP
+
+ CALL FMLOOK_ll(HFIPRI,HFIPRI,ILUPRI,IRESP)
+ WRITE (ILUPRI,*) ' exit from ',HFUNC,' with RESP:',KRESP
+ WRITE (ILUPRI,*) ' | HFILEM = ',HFILEM
+ WRITE (ILUPRI,*) ' | HRECFM = ',HRECFM
+ WRITE (ILUPRI,*) ' | HDIR = ',HDIR
+ WRITE (ILUPRI,*) ' | KGRID = ',KGRID
+ WRITE (ILUPRI,*) ' | KLENCH = ',KLENCH
+
+ END SUBROUTINE FM_WRIT_ERR
+
+
+
+ SUBROUTINE FMWRITX0_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+!
+! Modification
+! J.Escobar 15/04/2014 : add write to all Z files for all FMWRITX0_ll variables
+! J.Escobar 23/06/2014 : bug , replace .FALSE. to .TRUE. = OREAL type transmetted to FM_WRIT_ll
+!
+ USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
+ USE MODD_FM
+ USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+#ifdef MNH_NCWRIT
+ USE MODD_GRID
+ USE MODD_DIM_n, ONLY: NIMAX
+ USE MODD_NCOUT
+ USE MODE_UTIL
+#endif
+ !
+ !* 0. DECLARATIONS
+ ! ------------
+ !
+ !* 0.1 Declarations of arguments
+ !
+ CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+ CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
+ CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+ CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
+ REAL, INTENT(IN) ::PFIELD ! array containing the data field
+ INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
+ INTEGER, INTENT(IN) ::KLENCH ! length of comment string
+ CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT! comment string
+ INTEGER, INTENT(OUT)::KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ !----------------------------------------------------------------
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ 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
+ !JUANZIO
+ !
+ !* 1.1 THE NAME OF LFIFM
+ !
+ IRESP = 0
+ YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+ !print * , ' Writing Article 0 ' , HRECFM
+ !
+ TZFD=>GETFD(YFNLFI)
+ IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
+ END IF
+ IF ( LNETCDF .AND. NIMAX == 0 ) THEN
+! PRINT * , ' SAVE MAP PARAMETER IF PGD '
+ IF ( trim(hrecfm) == "RPK" ) THEN
+ XRPK=PFIELD
+ ELSEIF ( trim(hrecfm) == "BETA" ) THEN
+ XBETA=PFIELD
+ ELSEIF (trim(hrecfm) == "LATORI" ) THEN
+ XLATORI=PFIELD
+ ELSEIF (trim(hrecfm) == "LONORI" ) THEN
+ XLONORI=PFIELD
+ ELSEIF (trim(hrecfm) == "LAT0" ) THEN
+ XLAT0=PFIELD
+ ELSEIF (trim(hrecfm) == "LON0" ) THEN
+ XLON0=PFIELD
+ END IF
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
+#endif
+ ELSE
+ IF (ISP == TZFD%OWNER) THEN
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
+ END IF
+ IF ( LNETCDF .AND. NIMAX == 0 ) THEN
+! print * , ' SAVE MAP PARAMETER IF PGD '
+ IF ( trim(hrecfm) == "RPK" ) THEN
+ XRPK=PFIELD
+ ELSEIF ( trim(hrecfm) == "BETA" ) THEN
+ XBETA=PFIELD
+ ELSEIF (trim(hrecfm) == "LATORI" ) THEN
+ XLATORI=PFIELD
+ ELSEIF (trim(hrecfm) == "LONORI" ) THEN
+ XLONORI=PFIELD
+ ELSEIF (trim(hrecfm) == "LAT0" ) THEN
+ XLAT0=PFIELD
+ ELSEIF (trim(hrecfm) == "LON0" ) THEN
+ XLON0=PFIELD
+ END IF
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
+#endif
+ 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(HFILEM)//YK_FILE//".lfi"
+ TZFD_IOZ => GETFD(YFILE_IOZ)
+ IK_RANK = TZFD_IOZ%OWNER
+ IF ( ISP == IK_RANK ) THEN
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD_IOZ%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD_IOZ%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD_IOZ%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
+#endif
+ END IF
+ END DO
+ ENDIF
+ ELSE
+ IRESP = -61
+ END IF
+ !----------------------------------------------------------------
+ IF (IRESP.NE.0) THEN
+ CALL FM_WRIT_ERR("FMWRITX0_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
+ END IF
+ KRESP = IRESP
+ END SUBROUTINE FMWRITX0_ll
+
+ SUBROUTINE FMWRITX1_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+ USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
+ USE MODD_FM
+ USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+ USE MODE_ALLOCBUFFER_ll
+ USE MODE_GATHER_ll
+#ifdef MNH_NCWRIT
+ USE MODE_UTIL
+ USE MODE_DIMLIST
+ USE MODD_DIM_n, ONLY: NIMAX
+ USE MODD_NCOUT
+#endif
+ !
+ !* 0. DECLARATIONS
+ ! ------------
+ !
+ !* 0.1 Declarations of arguments
+ !
+ CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+ CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
+ CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+ CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
+ REAL,DIMENSION(:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
+ INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
+ INTEGER, INTENT(IN) ::KLENCH ! length of comment string
+ CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
+ INTEGER, INTENT(OUT)::KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ !----------------------------------------------------------------
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ INTEGER :: IERR
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ TYPE(FMHEADER) :: TZFMH
+ REAL,DIMENSION(:),POINTER :: ZFIELDP
+ LOGICAL :: GALLOC
+#ifdef MNH_NCWRIT
+ TYPE(workfield), DIMENSION(:), POINTER :: TZRECLIST
+ INTEGER,DIMENSION(6) :: TABDIM
+#endif
+ !
+ !* 1.1 THE NAME OF LFIFM
+ !
+ IRESP = 0
+ GALLOC = .FALSE.
+ YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+#ifdef MNH_NCWRIT
+ TABDIM(:)=1
+ TABDIM(1)=SIZE(PFIELD,1)
+ !print * , ' Writing Article 1 ' , HRECFM
+#endif
+ !------------------------------------------------------------------
+ TZFD=>GETFD(YFNLFI)
+ IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
+ END IF
+ ! ------- WRITE NETCDF
+ IF ( LNETCDF .AND. NC_WRITE ) THEN
+ CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,PFIELD,.TRUE.,TZRECLIST, &
+! CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,PFIELD, &
+ & KLENCH,HCOMMENT)
+ IF ( NC_FILE == 'phy' ) THEN
+!!!!! CAS WRITE_PHYS_PARAM ... l'ecriture lfi ne peut pas se faire en meme temps
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE., &
+ SIZE(PFIELD),PFIELD,TZFMH,IRESP)
+ END IF
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
+#endif
+ ELSE
+ IF (ISP == TZFD%OWNER) THEN
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
+ ELSE
+ ALLOCATE(ZFIELDP(0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
+ CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
+ END IF
+ !
+ IF (ISP == TZFD%OWNER) THEN
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ END IF
+ IF ( LNETCDF .AND. NC_WRITE ) THEN
+ TABDIM(1)=SIZE(ZFIELDP,1)
+ CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST, &
+ & KLENCH,HCOMMENT)
+ IF ( NC_FILE == 'phy' ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ END IF
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
+#endif
+ 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("FMWRITX1_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
+ END IF
+ IF (GALLOC) DEALLOCATE(ZFIELDP)
+ KRESP = IRESP
+ END SUBROUTINE FMWRITX1_ll
+
+ SUBROUTINE FMWRITX2_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+ USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT,LPACK,L1D,L2D
+ 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_TIMEZ, ONLY : TIMEZ
+ USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
+ !JUANZ
+#ifdef MNH_NCWRIT
+ USE MODE_UTIL
+ USE MODE_DIMLIST
+ USE MODD_DIM_n, ONLY: NIMAX
+ USE MODD_NCOUT
+#endif
+#ifdef MNH_GA
+ !JUAN_IOGA
+ USE MODE_GA
+#endif
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !
+ CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+ CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
+ CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+ CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
+ REAL,DIMENSION(:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
+ INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
+ INTEGER, INTENT(IN) ::KLENCH ! length of comment string
+ CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
+ INTEGER, INTENT(OUT)::KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ INTEGER :: IERR
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ REAL,DIMENSION(:,:),POINTER :: ZFIELDP
+ TYPE(FMHEADER) :: TZFMH
+ LOGICAL :: GALLOC
+#ifdef MNH_NCWRIT
+ TYPE(workfield), DIMENSION(:), POINTER :: TZRECLIST
+ INTEGER,DIMENSION(6) :: TABDIM
+ LOGICAL :: NCWR
+ INTEGER :: LHREC_BEG,LHRECFM
+#endif
+ !
+ !JUANZ
+ REAL*8,DIMENSION(2) :: T0,T1,T2
+ REAL*8,DIMENSION(2) :: T11,T22
+ !JUANZ
+#ifdef MNH_GA
+ REAL,DIMENSION(:,:),POINTER :: ZFIELDP_GA , ZFIELD_GA
+ REAL :: ERROR
+ INTEGER :: JI
+#endif
+ INTEGER :: IHEXTOT
+ !
+ !* 1.1 THE NAME OF LFIFM
+ !
+ CALL SECOND_MNH2(T11)
+ IRESP = 0
+ GALLOC = .FALSE.
+ YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+#ifdef MNH_NCWRIT
+ NCWR=.TRUE.
+ TABDIM(:)=1
+ TABDIM(1)=SIZE(PFIELD,1)
+ TABDIM(2)=SIZE(PFIELD,2)
+ !print * , ' Writing Article 2 ' , HRECFM
+#endif
+ !------------------------------------------------------------------
+ IHEXTOT = 2*JPHEXT+1
+ TZFD=>GETFD(YFNLFI)
+ IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+ ! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
+ 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)
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ END IF
+ IF ( LNETCDF .AND. NC_WRITE ) THEN
+ TABDIM(1)=1
+ TABDIM(2)=1
+ CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST,&
+ & KLENCH,HCOMMENT)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
+#endif
+ ! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
+ ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
+ ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1)
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ END IF
+ LHRECFM = LEN_TRIM(ADJUSTL(HRECFM))
+ IF ( LHRECFM > 5 ) THEN
+ LHREC_BEG =LHRECFM-4
+ IF ( ADJUSTL(HRECFM(LHREC_BEG:LHRECFM)) == 'DATIM') THEN
+ NCWR = .FALSE.
+ END IF
+ END IF
+ IF ( LNETCDF .AND. NC_WRITE .AND. NCWR ) THEN
+ TABDIM(2)=1
+ IF ( NC_FILE == 'phy' ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE., &
+ SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ END IF
+ CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST,&
+ & KLENCH,HCOMMENT)
+ END IF
+ NCWR = .TRUE.
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
+#endif
+ ELSE
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
+ END IF
+ LHRECFM = LEN_TRIM(ADJUSTL(HRECFM))
+ IF ( LHRECFM > 5 ) THEN
+ LHREC_BEG =LHRECFM-4
+ IF ( ADJUSTL(HRECFM(LHREC_BEG:LHRECFM)) == 'DATIM') THEN
+ NCWR = .FALSE.
+ END IF
+ END IF
+! IF ( NIMAX /= 0 ) THEN
+ IF ( LNETCDF .AND. NC_WRITE .AND. NCWR ) THEN
+ IF ( NC_FILE == 'phy' ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE., &
+ SIZE(PFIELD),PFIELD,TZFMH,IRESP)
+ END IF
+ CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,PFIELD,.TRUE.,TZRECLIST, &
+ & KLENCH,HCOMMENT)
+ END IF
+ NCWR = .TRUE.
+! END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
+#endif
+ END IF
+ ELSE ! multiprocessor execution
+ CALL SECOND_MNH2(T0)
+ IF (ISP == TZFD%OWNER) THEN
+ ! I/O processor case
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
+ ELSE
+ ALLOCATE(ZFIELDP(0,0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
+ CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
+ ELSEIF (HDIR == 'XY') THEN
+ IF (LPACK .AND. L2D) THEN
+ CALL GATHER_XXFIELD('XX',PFIELD(:,JPHEXT+1),ZFIELDP(:,1),TZFD%OWNER,TZFD%COMM)
+ ELSE
+#ifdef MNH_GA
+ !
+ ! init/create the ga , dim3 = 1
+ !
+ CALL MNH_INIT_GA(SIZE(PFIELD,1),SIZE(PFIELD,2),1,HRECFM,"WRITE")
+ !
+ ! copy columun data to global arrays g_a
+ !
+ ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2)))
+ ZFIELD_GA = PFIELD
+ call nga_put(g_a, lo_col, hi_col,ZFIELD_GA(NIXO_L,NIYO_L) , ld_col)
+!!$ print*," nga_put =",HRECFM,g_a," lo_col=",lo_col," hi_col=",hi_col,ZFIELD_GA(NIXO_L,NIYO_L), &
+!!$ " NIXO_L=",NIXO_L,"NIYO_L=",NIYO_L," ld_col=",ld_col," ISP=",ISP
+ call ga_sync
+ DEALLOCATE (ZFIELD_GA)
+ IF (ISP == TZFD%OWNER) THEN
+ !
+ ! this proc get the Z slide to write
+ !
+ lo_zplan(JPIZ) = 1
+ hi_zplan(JPIZ) = 1
+!!$ ALLOCATE (ZFIELDP_GA(IIU_ll,IJU_ll))
+ call nga_get(g_a, lo_zplan, hi_zplan,ZFIELDP, ld_zplan)
+!!$ print*,"nga_get=",HRECFM,g_a," lo_zplan=",lo_zplan," hi_zplan=",hi_zplan &
+!!$ ,ZFIELDP(1,1)," ld_zplan=",ld_zplan
+ END IF
+!!$ call ga_sync
+#else
+ CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
+!!$ IF (ISP == TZFD%OWNER) THEN
+!!$ print*,HRECFM, "ERR=", MAXVAL (ZFIELDP_GA - ZFIELDP)
+!!$ DO JI=1,IJU_ll
+!!$ !print*,HRECFM, "ERR=", ZFIELDP_GA(:,JI) - ZFIELDP(:,JI)
+!!$ print*,HRECFM, "WX2::GA =", ZFIELDP_GA(:,JI)
+!!$ print*,HRECFM, "WX2::MNH=", ZFIELDP(:,JI)
+!!$ END DO
+!!$ END IF
+#endif
+ END IF
+ END IF
+ CALL SECOND_MNH2(T1)
+ TIMEZ%T_WRIT2D_GATH=TIMEZ%T_WRIT2D_GATH + T1 - T0
+ !
+ IF (ISP == TZFD%OWNER) THEN
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ END IF
+ LHRECFM = LEN_TRIM(ADJUSTL(HRECFM))
+ IF ( LHRECFM > 5 ) THEN
+ LHREC_BEG =LHRECFM-4
+ IF ( ADJUSTL(HRECFM(LHREC_BEG:LHRECFM)) == 'DATIM') THEN
+ NCWR = .FALSE.
+ END IF
+ END IF
+ IF ( LNETCDF .AND. NC_WRITE .AND. NCWR ) THEN
+ TABDIM(1)=SIZE(ZFIELDP,1)
+ TABDIM(2)=SIZE(ZFIELDP,2)
+ CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST, &
+! CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP, &
+ & KLENCH,HCOMMENT)
+ END IF
+ NCWR=.TRUE.
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
+#endif
+ END IF
+#ifdef MNH_GA
+!!$ IF (ISP .EQ. 1 ) THEN
+!!$ call ga_print_stats()
+!!$ call ga_summarize(1)
+!!$ ENDIF
+ call ga_sync
+!!$ gstatus_ga = ga_destroy(g_a)
+#endif
+ CALL SECOND_MNH2(T2)
+ TIMEZ%T_WRIT2D_WRIT=TIMEZ%T_WRIT2D_WRIT + T2 - T1
+ !
+ 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("FMWRITX2_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
+ END IF
+ IF (GALLOC) DEALLOCATE(ZFIELDP)
+ KRESP = IRESP
+ IF (ASSOCIATED(TZFD)) CALL MPI_BARRIER(TZFD%COMM,IERR)
+ CALL SECOND_MNH2(T22)
+ TIMEZ%T_WRIT2D_ALL=TIMEZ%T_WRIT2D_ALL + T22 - T11
+ END SUBROUTINE FMWRITX2_ll
+
+ SUBROUTINE FMWRITX3_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+ USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT,LPACK,L1D,L2D
+ 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_NCWRIT
+ USE MODE_UTIL
+ USE MODD_DIM_n, ONLY: NIMAX
+ USE MODD_NCOUT
+#endif
+#ifdef MNH_GA
+ USE MODE_GA
+#endif
+ USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
+ !
+ !
+ !* 0.1 Declarations of arguments
+ !
+ CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+ CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
+ CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+ CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
+ REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
+ INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
+ INTEGER, INTENT(IN) ::KLENCH ! length of comment string
+ CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
+ INTEGER, INTENT(OUT)::KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ 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(HRECFM)) :: 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_NCWRIT
+ TYPE(workfield), DIMENSION(:), POINTER :: TZRECLIST
+ INTEGER,DIMENSION(6) :: TABDIM
+ CHARACTER(LEN=LEN(HRECFM)) :: HRECT
+ INTEGER :: LHRECT
+#endif
+#ifdef MNH_GA
+ REAL,DIMENSION(:,:,:),POINTER :: ZFIELD_GA
+#endif
+ INTEGER :: IHEXTOT
+ !
+ !* 1.1 THE NAME OF LFIFM
+ !
+ CALL SECOND_MNH2(T11)
+ IRESP = 0
+ GALLOC = .FALSE.
+ GALLOC_ll = .FALSE.
+ YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+ !print * , ' Writing Article 3 ' , HRECFM
+!
+#ifdef MNH_NCWRIT
+ HRECT=TRIM(HRECFM)
+ LHRECT=LEN(TRIM(HRECT))
+ TABDIM(:)=1
+ TABDIM(1)=SIZE(PFIELD,1)
+ TABDIM(2)=SIZE(PFIELD,2)
+ TABDIM(3)=SIZE(PFIELD,3)
+ IF ( LHRECT .gt. 4 ) THEN
+ IF ( HRECT(LHRECT-4:LHRECT) == 'TRAJZ' ) THEN
+ TABDIM(3)=SIZE(PFIELD,1)
+ TABDIM(1)=1
+ END IF
+ END IF
+ IF ( TRIM(HRECFM) == 'AVION.TRAJX' ) THEN
+ TABDIM(1)=SIZE(PFIELD,2)
+ TABDIM(2)=1
+ ELSEIF ( TRIM(HRECFM) == 'AVION.TRAJY' ) THEN
+ TABDIM(1)=SIZE(PFIELD,2)
+ TABDIM(2)=1
+ ELSEIF ( TRIM(HRECFM) == 'AVION.TRAJZ' ) THEN
+ TABDIM(1)=SIZE(PFIELD,2)
+ TABDIM(2)=1
+ END IF
+#endif
+ !------------------------------------------------------------------
+ IHEXTOT = 2*JPHEXT+1
+ TZFD=>GETFD(YFNLFI)
+ IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC .AND. (TZFD%nb_procio.eq.1) ) THEN ! sequential execution
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+ ! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
+ 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,:)
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ END IF
+ IF ( LNETCDF .AND. NC_WRITE ) THEN
+ TABDIM(1)=1
+ TABDIM(2)=1
+ CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST, &
+ & KLENCH,HCOMMENT)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
+#endif
+ ! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
+ ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
+ ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1,:)
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ END IF
+ IF ( LNETCDF .AND. NC_WRITE ) THEN
+ TABDIM(2)=1
+ IF ( NC_FILE == 'phy' ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ END IF
+ CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST, &
+! CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP, &
+ & KLENCH,HCOMMENT)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
+#endif
+ ELSE
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
+ END IF
+ IF ( LNETCDF .AND. NC_WRITE ) THEN
+ IF ( NC_FILE == 'phy' ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
+ END IF
+ CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,PFIELD,.TRUE.,TZRECLIST, &
+! CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,PFIELD, &
+ & KLENCH,HCOMMENT)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
+#endif
+ END IF
+ ELSEIF ( (TZFD%nb_procio .eq. 1 ) .OR. ( HDIR == '--' ) ) THEN ! multiprocessor execution & 1 proc IO
+ ! write 3D field in 1 time = output for graphique
+ IF (ISP == TZFD%OWNER) THEN
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
+ ELSE
+ ALLOCATE(ZFIELDP(0,0,0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
+ CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
+ ELSEIF (HDIR == 'XY') THEN
+ IF (LPACK .AND. L2D) THEN
+ CALL GATHER_XXFIELD('XX',PFIELD(:,JPHEXT+1,:),ZFIELDP(:,1,:),TZFD%OWNER,TZFD%COMM)
+ ELSE
+ CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
+ END IF
+ END IF
+ !
+ IF (ISP == TZFD%OWNER) THEN
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ END IF
+ IF ( LNETCDF .AND. NC_WRITE ) THEN
+ TABDIM(1)=SIZE(ZFIELDP,1)
+ TABDIM(2)=SIZE(ZFIELDP,2)
+ TABDIM(3)=SIZE(ZFIELDP,3)
+ IF ( NC_FILE == ' phy' ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ END IF
+ CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST, &
+! CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP, &
+ & KLENCH,HCOMMENT)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
+#endif
+ 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(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3),HRECFM,"WRITE")
+ !
+ ! copy columun data to global arrays g_a
+ !
+ 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 =",HRECFM,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)
+ 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(HFILEM)//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=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+ WRITE(YK,'(I4.4)') JKK
+ YRECZSLIDE = TRIM(HRECFM)//YK
+ !
+ IF ( SIZE(ZSLIDE_ll) .EQ. 0 ) THEN
+ DEALLOCATE(ZSLIDE_ll)
+ CALL ALLOCBUFFER_ll(ZSLIDE_ll,ZSLIDE,HDIR,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,HDIR,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(PFIELD,3),inb_proc_real
+ !
+ ! collecte the data
+ !
+ JK_MAX=min(SIZE(PFIELD,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(HFILEM)//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 (HDIR == 'XX' .OR. HDIR =='YY') THEN
+ STOP " XX NON PREVU SUR BG POUR LE MOMENT "
+ CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
+ ELSEIF (HDIR == 'XY') THEN
+ IF (LPACK .AND. L2D) THEN
+ STOP " L2D NON PREVU SUR BG POUR LE MOMENT "
+ 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
+ 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 => 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 &
+ & ,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(HFILEM)//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,HDIR,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 => 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)
+ END IF
+ END IF
+ END DO
+ CALL SECOND_MNH2(T1)
+ TIMEZ%T_WRIT3D_RECV=TIMEZ%T_WRIT3D_RECV + T1 - T0
+ !JUANIOZ
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+ WRITE(YK,'(I4.4)') JKK
+ YRECZSLIDE = TRIM(HRECFM)//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,HDIR,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("FMWRITX3_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,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 FMWRITX3_ll
+
+ SUBROUTINE FMWRITX4_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+ USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT,LPACK,L1D,L2D
+ 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
+!!!!! MOD SB
+#ifdef MNH_NCWRIT
+ USE MODD_NCOUT
+ USE MODE_UTIL
+#endif
+!!!!! MOD SB
+ !
+ !
+ !* 0.1 Declarations of arguments
+ !
+ CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+ CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
+ CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+ CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
+ REAL,DIMENSION(:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
+ INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
+ INTEGER, INTENT(IN) ::KLENCH ! length of comment string
+ CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
+ INTEGER, INTENT(OUT)::KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ INTEGER :: IERR
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ REAL,DIMENSION(:,:,:,:),POINTER :: ZFIELDP
+ TYPE(FMHEADER) :: TZFMH
+ LOGICAL :: GALLOC
+ INTEGER :: IHEXTOT
+ !
+ !* 1.1 THE NAME OF LFIFM
+ !
+ IRESP = 0
+ GALLOC = .FALSE.
+ YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+ !print * , ' Writing Article 4 ' , HRECFM
+ !------------------------------------------------------------------
+ IHEXTOT = 2*JPHEXT+1
+ TZFD=>GETFD(YFNLFI)
+ IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+ ! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
+ 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,:,:)
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
+#endif
+ ! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
+ ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
+ ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1,:,:)
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
+#endif
+ ELSE
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
+#endif
+ END IF
+ ELSE
+ IF (ISP == TZFD%OWNER) THEN
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
+ ELSE
+ ALLOCATE(ZFIELDP(0,0,0,0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
+ CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
+ ELSEIF (HDIR == 'XY') THEN
+ IF (LPACK .AND. L2D) THEN
+ CALL GATHER_XXFIELD('XX',PFIELD(:,JPHEXT+1,:,:),ZFIELDP(:,1,:,:),TZFD%OWNER,TZFD%COMM)
+ ELSE
+ CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
+ END IF
+ END IF
+ !
+ IF (ISP == TZFD%OWNER) THEN
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
+#endif
+ 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("FMWRITX4_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
+ END IF
+ IF (GALLOC) DEALLOCATE(ZFIELDP)
+ KRESP = IRESP
+ END SUBROUTINE FMWRITX4_ll
+
+ SUBROUTINE FMWRITX5_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+ USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT,LPACK,L1D,L2D
+ 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
+#ifdef MNH_NCWRIT
+ USE MODE_UTIL
+ USE MODD_DIM_n
+ USE MODD_NCOUT
+#endif
+ !
+ !
+ !* 0.1 Declarations of arguments
+ !
+ CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+ CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
+ CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+ CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
+ REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
+ INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
+ INTEGER, INTENT(IN) ::KLENCH ! length of comment string
+ CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
+ INTEGER, INTENT(OUT)::KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ INTEGER :: IERR
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ REAL,DIMENSION(:,:,:,:,:),POINTER :: ZFIELDP
+ TYPE(FMHEADER) :: TZFMH
+ LOGICAL :: GALLOC
+#ifdef MNH_NCWRIT
+ TYPE(workfield), DIMENSION(:), POINTER :: TZRECLIST
+ INTEGER,DIMENSION(6) :: TABDIM
+#endif
+ INTEGER :: IHEXTOT
+ !
+ !* 1.1 THE NAME OF LFIFM
+ !
+ IRESP = 0
+ GALLOC = .FALSE.
+ YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+#ifdef MNH_NCWRIT
+ TABDIM(:)=1
+ TABDIM(1)=SIZE(PFIELD,1)
+ TABDIM(2)=SIZE(PFIELD,2)
+ TABDIM(3)=SIZE(PFIELD,3)
+ TABDIM(4)=SIZE(PFIELD,4)
+ TABDIM(5)=SIZE(PFIELD,5)
+ !print * , ' Writing Article 5 ' , HRECFM
+#endif
+ !------------------------------------------------------------------
+ IHEXTOT = 2*JPHEXT+1
+ TZFD=>GETFD(YFNLFI)
+ IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+ ! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
+ 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,:,:,:)
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
+#endif
+ ! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
+ ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
+ ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1,:,:,:)
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ END IF
+ IF ( LNETCDF .AND. NC_WRITE ) THEN
+ TABDIM(2)=1
+ IF ( NC_FILE == 'phy' ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP), &
+ ZFIELDP,TZFMH,IRESP)
+ END IF
+ CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST, &
+! CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP, &
+ & KLENCH,HCOMMENT)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
+#endif
+ ELSE
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
+ END IF
+ IF ( LNETCDF .AND. NC_WRITE ) THEN
+ IF ( NC_FILE == 'phy' ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD), &
+ PFIELD,TZFMH,IRESP)
+ END IF
+ CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,PFIELD,.TRUE.,TZRECLIST, &
+! CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,PFIELD, &
+ & KLENCH,HCOMMENT)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
+#endif
+ END IF
+ ELSE
+ IF (ISP == TZFD%OWNER) THEN
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
+ ELSE
+ ALLOCATE(ZFIELDP(0,0,0,0,0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
+ CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
+ ELSEIF (HDIR == 'XY') THEN
+ IF (LPACK .AND. L2D) THEN
+ CALL GATHER_XXFIELD('XX',PFIELD(:,JPHEXT+1,:,:,:),ZFIELDP(:,1,:,:,:),&
+ & TZFD%OWNER,TZFD%COMM)
+ ELSE
+ CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
+ END IF
+ END IF
+ !
+ IF (ISP == TZFD%OWNER) THEN
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ END IF
+ IF ( LNETCDF .AND. NC_WRITE ) THEN
+ IF ( NC_FILE == 'phy' ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ END IF
+ CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST, &
+! CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP, &
+ & KLENCH,HCOMMENT)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
+#endif
+ 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("FMWRITX5_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
+ END IF
+ IF (GALLOC) DEALLOCATE(ZFIELDP)
+ KRESP = IRESP
+ END SUBROUTINE FMWRITX5_ll
+
+ SUBROUTINE FMWRITX6_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+ USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
+ USE MODD_FM
+ USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+ USE MODE_ALLOCBUFFER_ll
+ USE MODE_GATHER_ll
+ !
+!!!! MOD SB
+#ifdef MNH_NCWRIT
+ USE MODD_NCOUT
+ USE MODE_UTIL
+#endif
+!!!! MOD SB
+ !
+ !* 0.1 Declarations of arguments
+ !
+ CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+ CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
+ CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+ CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
+ REAL,DIMENSION(:,:,:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
+ INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
+ INTEGER, INTENT(IN) ::KLENCH ! length of comment string
+ CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
+ INTEGER, INTENT(OUT)::KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ INTEGER :: IERR
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ REAL,DIMENSION(:,:,:,:,:,:),POINTER :: ZFIELDP
+ TYPE(FMHEADER) :: TZFMH
+ LOGICAL :: GALLOC
+ !
+ !* 1.1 THE NAME OF LFIFM
+ !
+ IRESP = 0
+ GALLOC = .FALSE.
+ YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+ !print * , ' Writing Article 6 ' , HRECFM
+ !------------------------------------------------------------------
+ TZFD=>GETFD(YFNLFI)
+ IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
+#endif
+ ELSE ! multiprocessor execution
+ IF (ISP == TZFD%OWNER) THEN
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
+ ELSE
+ ALLOCATE(ZFIELDP(0,0,0,0,0,0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
+ CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
+ ELSEIF (HDIR == 'XY') THEN
+ CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
+ END IF
+ !
+ IF (ISP == TZFD%OWNER) THEN
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
+#endif
+ 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("FMWRITX6_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
+ END IF
+ IF (GALLOC) DEALLOCATE(ZFIELDP)
+ KRESP = IRESP
+ END SUBROUTINE FMWRITX6_ll
+
+ SUBROUTINE FMWRITN0_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+ USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
+ USE MODD_FM
+ USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+ !* 0. DECLARATIONS
+ ! ------------
+!!!! MOD SB
+#ifdef MNH_NCWRIT
+ USE MODD_NCOUT
+ USE MODE_UTIL
+#endif
+!!!! MOD SB
+ !
+ !
+ !* 0.1 Declarations of arguments
+ !
+ CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+ CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
+ CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+ CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
+ INTEGER, INTENT(IN) ::KFIELD ! array containing the data field
+ INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
+ INTEGER, INTENT(IN) ::KLENCH ! length of comment string
+ CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT! comment string
+ INTEGER, INTENT(OUT)::KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ 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
+ !JUANZIO
+ !----------------------------------------------------------------
+ !
+ !* 1.1 THE NAME OF LFIFM
+ !
+ IRESP = 0
+ YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+ !print * , ' Writing Article N0 ' , HRECFM
+ !------------------------------------------------------------------
+ TZFD=>GETFD(YFNLFI)
+ IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,KFIELD,TZFMH,IRESP)
+#endif
+ ELSE
+ IF (ISP == TZFD%OWNER) THEN
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,KFIELD,TZFMH,IRESP)
+#endif
+ 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(HFILEM)//YK_FILE//".lfi"
+ TZFD_IOZ => GETFD(YFILE_IOZ)
+ IK_RANK = TZFD_IOZ%OWNER
+ IF ( ISP == IK_RANK ) THEN
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD_IOZ%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD_IOZ%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD_IOZ%CDF,HRECFM,HDIR,KFIELD,TZFMH,IRESP)
+#endif
+ END IF
+ END DO
+ ENDIF
+ ELSE
+ IRESP = -61
+ END IF
+ !----------------------------------------------------------------
+ IF (IRESP.NE.0) THEN
+ CALL FM_WRIT_ERR("FMWRITN0_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
+ & ,IRESP)
+ END IF
+ KRESP = IRESP
+ END SUBROUTINE FMWRITN0_ll
+
+ SUBROUTINE FMWRITN1_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+ USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
+ USE MODD_FM
+ USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+ USE MODE_ALLOCBUFFER_ll
+ USE MODE_GATHER_ll
+ !* 0. DECLARATIONS
+ ! ------------
+!!!! MOD SB
+#ifdef MNH_NCWRIT
+ USE MODD_NCOUT
+ USE MODE_UTIL
+#endif
+!!!! MOD SB
+ !
+ !
+ !* 0.1 Declarations of arguments
+ !
+ CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+ CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
+ CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+ CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
+ INTEGER,DIMENSION(:),TARGET,INTENT(IN) ::KFIELD ! array containing the data field
+ INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
+ INTEGER, INTENT(IN) ::KLENCH ! length of comment string
+ CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
+ INTEGER, INTENT(OUT)::KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ INTEGER :: IERR
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ TYPE(FMHEADER) :: TZFMH
+ INTEGER,DIMENSION(:),POINTER :: IFIELDP
+ LOGICAL :: GALLOC
+#ifdef MNH_NCWRIT
+ REAL,DIMENSION(SIZE(KFIELD)) ::WFIELD
+ TYPE(workfield), DIMENSION(:), POINTER :: TZRECLIST
+ INTEGER,DIMENSION(6) :: TABDIM
+#endif
+ !----------------------------------------------------------------
+ !
+ !* 1.1 THE NAME OF LFIFM
+ !
+ IRESP = 0
+ GALLOC = .FALSE.
+ YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+ !print * , ' Writing Article N1 ' , HRECFM
+#ifdef MNH_NCWRIT
+ WFIELD = KFIELD
+ TABDIM(:)=1
+#endif
+ !------------------------------------------------------------------
+ TZFD=>GETFD(YFNLFI)
+ IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(KFIELD),KFIELD,TZFMH,IRESP)
+ END IF
+ IF ( LNETCDF .AND. NC_WRITE ) THEN
+ CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,WFIELD, &
+ & .TRUE.,TZRECLIST,KLENCH,HCOMMENT)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(KFIELD),KFIELD,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,KFIELD,TZFMH,IRESP)
+#endif
+ ELSE
+ IF (ISP == TZFD%OWNER) THEN
+ CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,HDIR,GALLOC)
+ ELSE
+ ALLOCATE(IFIELDP(0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
+ CALL GATHER_XXFIELD(HDIR,KFIELD,IFIELDP,TZFD%OWNER,TZFD%COMM)
+ END IF
+ !
+ IF (ISP == TZFD%OWNER) THEN
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH&
+ & ,IRESP)
+ END IF
+ IF ( LNETCDF .AND. NC_WRITE ) THEN
+ CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,WFIELD, &
+ .TRUE.,TZRECLIST,&
+ & KLENCH,HCOMMENT)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH&
+ & ,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELDP,TZFMH,IRESP)
+#endif
+ 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("FMWRITN1_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
+ & ,IRESP)
+ END IF
+ IF (GALLOC) DEALLOCATE(IFIELDP)
+ KRESP = IRESP
+ END SUBROUTINE FMWRITN1_ll
+
+ SUBROUTINE FMWRITN2_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+ USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT,LPACK,L1D,L2D
+ 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
+ !
+!!!! MOD SB
+#ifdef MNH_NCWRIT
+ USE MODD_NCOUT
+ USE MODE_UTIL
+#endif
+!!!! MOD SB
+ !
+ !* 0.1 Declarations of arguments
+ !
+ CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+ CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
+ CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+ CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
+ INTEGER,DIMENSION(:,:),TARGET,INTENT(IN) ::KFIELD ! array containing the data field
+ INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
+ INTEGER, INTENT(IN) ::KLENCH ! length of comment string
+ CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
+ INTEGER, INTENT(OUT)::KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ INTEGER :: IERR
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ INTEGER,DIMENSION(:,:),POINTER :: IFIELDP
+ TYPE(FMHEADER) :: TZFMH
+ LOGICAL :: GALLOC
+ INTEGER :: IHEXTOT
+ !
+ !* 1.1 THE NAME OF LFIFM
+ !
+ IRESP = 0
+ GALLOC = .FALSE.
+ YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+ !print * , ' Writing Article N2 ' , HRECFM
+ !
+ IHEXTOT = 2*JPHEXT+1
+ TZFD=>GETFD(YFNLFI)
+! IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
+ IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+ ! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
+ IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==IHEXTOT .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
+ IFIELDP=>KFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1)
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELDP,TZFMH,IRESP)
+#endif
+ ! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
+ ELSEIF (LPACK .AND. L2D .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
+ IFIELDP=>KFIELD(:,JPHEXT+1:JPHEXT+1)
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELDP,TZFMH,IRESP)
+#endif
+ ELSE
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(KFIELD),KFIELD,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(KFIELD),KFIELD,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,KFIELD,TZFMH,IRESP)
+#endif
+ END IF
+ ELSE
+ IF (ISP == TZFD%OWNER) THEN
+ CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,HDIR,GALLOC)
+ ELSE
+ ALLOCATE(IFIELDP(0,0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
+ CALL GATHER_XXFIELD(HDIR,KFIELD,IFIELDP,TZFD%OWNER,TZFD%COMM)
+ ELSEIF (HDIR == 'XY') THEN
+ IF (LPACK .AND. L2D) THEN
+ CALL GATHER_XXFIELD('XX',KFIELD(:,JPHEXT+1),IFIELDP(:,1),TZFD%OWNER,TZFD%COMM)
+ ELSE
+ CALL GATHER_XYFIELD(KFIELD,IFIELDP,TZFD%OWNER,TZFD%COMM)
+ END IF
+ END IF
+ !
+ IF (ISP == TZFD%OWNER) THEN
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH&
+ & ,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH&
+ & ,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELDP,TZFMH,IRESP)
+#endif
+ 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("FMWRITN2_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
+ END IF
+ IF (GALLOC) DEALLOCATE(IFIELDP)
+ KRESP = IRESP
+ END SUBROUTINE FMWRITN2_ll
+
+
+ SUBROUTINE FMWRITL0_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+ USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
+ USE MODD_FM
+ USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+
+!!!! MOD SB
+#ifdef MNH_NCWRIT
+ USE MODD_NCOUT
+ USE MODE_UTIL
+#endif
+!!!! MOD SB
+ !
+ !* 0. DECLARATIONS
+ ! ------------
+ !
+ !
+ !* 0.1 Declarations of arguments
+ !
+ CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+ CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
+ CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+ CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
+ LOGICAL, INTENT(IN) ::OFIELD ! array containing the data field
+ INTEGER, INTENT(IN)::KGRID ! C-grid indicator (u,v,w,T)
+ INTEGER, INTENT(IN)::KLENCH ! length of comment string
+ CHARACTER(LEN=*), INTENT(IN)::HCOMMENT ! comment string
+ INTEGER, INTENT(OUT)::KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ INTEGER :: IFIELD
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ INTEGER :: IERR
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ TYPE(FMHEADER) :: TZFMH
+
+ !----------------------------------------------------------------
+ !
+ !* 1.1 THE NAME OF LFIFM
+ !
+ IRESP = 0
+ YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+ !print * , ' Writing Article L0 ' , HRECFM
+ IF (OFIELD) THEN
+ IFIELD=1
+ ELSE
+ IFIELD=0
+ END IF
+ !----------------------------------------------------------------
+ TZFD=>GETFD(YFNLFI)
+! IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
+ IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,IFIELD,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,IFIELD,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELD,TZFMH,IRESP)
+#endif
+ ELSE
+ IF (ISP == TZFD%OWNER) THEN
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,IFIELD,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,IFIELD,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELD,TZFMH,IRESP)
+#endif
+ 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("FMWRITL0_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
+ & ,IRESP)
+ END IF
+ KRESP = IRESP
+ END SUBROUTINE FMWRITL0_ll
+
+ SUBROUTINE FMWRITL1_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+ USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
+ USE MODD_FM
+ USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+
+ !* 0. DECLARATIONS
+ ! ------------
+!!!! MOD SB
+#ifdef MNH_NCWRIT
+ USE MODD_NCOUT
+ USE MODE_UTIL
+#endif
+!!!! MOD SB
+ !
+ !* 0.1 Declarations of arguments
+ !
+ CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+ CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
+ CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+ CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
+ LOGICAL,DIMENSION(:),INTENT(IN) ::OFIELD ! array containing the data field
+ INTEGER, INTENT(IN)::KGRID ! C-grid indicator (u,v,w,T)
+ INTEGER, INTENT(IN)::KLENCH ! length of comment string
+ CHARACTER(LEN=*), INTENT(IN)::HCOMMENT ! comment string
+ INTEGER, INTENT(OUT)::KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ INTEGER, DIMENSION(SIZE(OFIELD)) :: IFIELD
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ INTEGER :: IERR
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ TYPE(FMHEADER) :: TZFMH
+
+ !----------------------------------------------------------------
+ !
+ !* 1.1 THE NAME OF LFIFM
+ !
+ IRESP = 0
+ YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+ !print * , ' Writing Article L1 ' , HRECFM
+ WHERE (OFIELD)
+ IFIELD=1
+ ELSEWHERE
+ IFIELD=0
+ END WHERE
+ !----------------------------------------------------------------
+ TZFD=>GETFD(YFNLFI)
+! IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
+ IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELD),IFIELD,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELD),IFIELD,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELD,TZFMH,IRESP)
+#endif
+ ELSE
+ IF (ISP == TZFD%OWNER) THEN
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELD),IFIELD,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELD),IFIELD,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELD,TZFMH,IRESP)
+#endif
+ 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("FMWRITL1_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
+ & ,IRESP)
+ END IF
+ KRESP = IRESP
+ END SUBROUTINE FMWRITL1_ll
+
+ SUBROUTINE FMWRITC0_ll(HFILEM,HRECFM,HFIPRI,HDIR,HFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+ USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
+ USE MODD_FM
+ USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+ !
+ !* 0. DECLARATIONS
+ ! ------------
+ !
+!!!! MOD SB
+#ifdef MNH_NCWRIT
+ USE MODD_NCOUT
+ USE MODE_UTIL
+#endif
+!!! MOD SB
+ !
+ !* 0.1 Declarations of arguments
+ !
+ CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+ CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
+ CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+ CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
+ CHARACTER(LEN=*), INTENT(IN) ::HFIELD ! array containing the data field
+ INTEGER, INTENT(IN)::KGRID ! C-grid indicator (u,v,w,T)
+ INTEGER, INTENT(IN)::KLENCH ! length of comment string
+ CHARACTER(LEN=*), INTENT(IN)::HCOMMENT ! comment string
+ INTEGER, INTENT(OUT)::KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ INTEGER :: JLOOP
+ INTEGER,DIMENSION(:),ALLOCATABLE :: IFIELD
+ INTEGER :: ILENG
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ INTEGER :: IERR
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ TYPE(FMHEADER) :: TZFMH
+#ifdef MNH_NCWRIT
+ TYPE(workfield), DIMENSION(:), POINTER :: TZRECLIST
+ INTEGER,DIMENSION(6) :: TABDIM
+#endif
+
+ !----------------------------------------------------------------
+ !* 1.1 THE NAME OF LFIFM
+ !
+ IRESP = 0
+ YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+ !print * , ' Writing Article C0 ' , HRECFM
+ ILENG=LEN(HFIELD)
+#ifdef MNH_NCWRIT
+ TABDIM(:)=1
+ TABDIM(1)=ILENG
+#endif
+ !
+ IF (ILENG==0) THEN
+ ILENG=1
+ ALLOCATE(IFIELD(1))
+ IFIELD(1)=IACHAR(' ')
+ ELSE
+ ALLOCATE(IFIELD(ILENG))
+ DO JLOOP=1,ILENG
+ IFIELD(JLOOP)=IACHAR(HFIELD(JLOOP:JLOOP))
+ END DO
+ END IF
+ !----------------------------------------------------------------
+ TZFD=>GETFD(YFNLFI)
+ IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,KRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,HFIELD,TZFMH,IRESP)
+#endif
+ ELSE
+ IF (ISP == TZFD%OWNER) THEN
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,KRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,HFIELD,TZFMH,IRESP)
+#endif
+ 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("FMWRITC0_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
+ & ,IRESP)
+ END IF
+ IF (ALLOCATED(IFIELD)) DEALLOCATE(IFIELD)
+ KRESP = IRESP
+ END SUBROUTINE FMWRITC0_ll
+
+ SUBROUTINE FMWRITC1_ll(HFILEM,HRECFM,HFIPRI,HDIR,HFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+ USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
+ USE MODD_FM
+ USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+ !
+ !* 0. DECLARATIONS
+ ! ------------
+ !
+ !
+ !* 0.1 Declarations of arguments
+ !
+ CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+ CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
+ CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+ CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
+ CHARACTER(LEN=*),DIMENSION(:),INTENT(IN) ::HFIELD ! array containing the data field
+ INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
+ INTEGER, INTENT(IN) ::KLENCH ! length of comment string
+ CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
+ INTEGER, INTENT(OUT)::KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ INTEGER :: J,JJ
+ INTEGER :: ILE, IP
+ INTEGER,DIMENSION(:),ALLOCATABLE :: IFIELD
+ INTEGER :: ILENG
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ INTEGER :: IERR
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ TYPE(FMHEADER) :: TZFMH
+ !----------------------------------------------------------------
+ !* 1.1 THE NAME OF LFIFM
+ !
+ IRESP = 0
+ YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+ !print * , ' Writing Article C1 ' , HRECFM
+ 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
+ !----------------------------------------------------------------
+ TZFD=>GETFD(YFNLFI)
+ IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,HFIELD,TZFMH,IRESP)
+ ELSE
+ IF (ISP == TZFD%OWNER) THEN
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,HFIELD,TZFMH,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("FMWRITC1_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
+ & ,IRESP)
+ END IF
+ IF (ALLOCATED(IFIELD)) DEALLOCATE(IFIELD)
+ KRESP = IRESP
+ END SUBROUTINE FMWRITC1_ll
+
+ SUBROUTINE FMWRITT0_ll(HFILEM,HRECFM,HFIPRI,HDIR,TFIELD,KGRID,&
+ KLENCH,HCOMMENT,KRESP)
+ USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
+ USE MODD_TYPE_DATE
+ USE MODD_FM
+ USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+ !
+!!!! MOD SB
+#ifdef MNH_NCWRIT
+ USE MODD_NCOUT
+ USE MODE_UTIL
+#endif
+!!!! MOD SB
+ !* 0.1 Declarations of arguments
+ !
+ CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+ CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
+ CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+ CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
+ TYPE (DATE_TIME), INTENT(IN) ::TFIELD ! array containing the data field
+ INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
+ INTEGER, INTENT(IN) ::KLENCH ! length of comment string
+ CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
+ INTEGER, INTENT(OUT)::KRESP ! return-code
+ !--------------------------------------------------------------------
+ !
+ !* 0.2 Declarations of local variables
+ !
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ INTEGER :: IERR
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ TYPE(FMHEADER) :: TZFMH
+ INTEGER, DIMENSION(3) :: ITDATE ! date array
+ !
+ !-------------------------------------------------------------------------------
+ IRESP = 0
+ YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+ !print * , ' Writing Article T0 ' , HRECFM
+ ITDATE(1)=TFIELD%TDATE%YEAR
+ ITDATE(2)=TFIELD%TDATE%MONTH
+ ITDATE(3)=TFIELD%TDATE%DAY
+ !-------------------------------------------------------------------------------
+ TZFD=>GETFD(YFNLFI)
+! IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
+ IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ TZFMH%GRID=KGRID
+ TZFMH%COMMENT='YYYYMMDD'
+ TZFMH%COMLEN=LEN_TRIM(TZFMH%COMMENT)
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TDATE',.FALSE.,3,ITDATE&
+ & ,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TDATE',.FALSE.,3,ITDATE&
+ & ,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,TRIM(HRECFM)//'%TDATE',HDIR,ITDATE,TZFMH,IRESP)
+#endif
+ TZFMH%COMMENT='SECONDS'
+ TZFMH%COMLEN=LEN_TRIM(TZFMH%COMMENT)
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TIME',.TRUE.,1,TFIELD%TIME&
+ & ,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TIME',.TRUE.,1,TFIELD%TIME&
+ & ,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,TRIM(HRECFM)//'%TIME',HDIR,TFIELD%TIME,TZFMH,IRESP)
+#endif
+ ELSE
+ IF (ISP == TZFD%OWNER) THEN
+ TZFMH%GRID=KGRID
+ TZFMH%COMMENT='YYYYMMDD'
+ TZFMH%COMLEN=LEN_TRIM(TZFMH%COMMENT)
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TDATE',.FALSE.,3,ITDATE&
+ & ,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TDATE',.FALSE.,3,ITDATE&
+ & ,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,TRIM(HRECFM)//'%TDATE',HDIR,ITDATE,TZFMH,IRESP)
+#endif
+ TZFMH%COMMENT='SECONDS'
+ TZFMH%COMLEN=LEN_TRIM(TZFMH%COMMENT)
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TIME',.TRUE.,1,TFIELD%TIME&
+ & ,TZFMH,IRESP)
+ END IF
+#else
+
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TIME',.TRUE.,1,TFIELD%TIME&
+ & ,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,TRIM(HRECFM)//'%TIME',HDIR,TFIELD%TIME,TZFMH,IRESP)
+#endif
+ 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("FMWRITT0_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
+ & ,IRESP)
+ END IF
+ KRESP = IRESP
+ END SUBROUTINE FMWRITT0_ll
+
+ SUBROUTINE FMWRIT_LB(HFILEM,HRECFM,HFIPRI,HLBTYPE,PLB,KRIM,KL3D,&
+ & KGRID,KLENCH,HCOMMENT,KRESP)
+ USE MODD_IO_ll, ONLY : ISP,ISNPROC,GSMONOPROC,LIOCDF4,LLFIOUT,LPACK,L2D
+ USE MODD_PARAMETERS_ll,ONLY : JPHEXT
+ USE MODD_FM
+ USE MODE_DISTRIB_LB
+ USE MODE_TOOLS_ll, ONLY : GET_GLOBALDIMS_ll
+ USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+ !
+!!!! MOD SB
+#ifdef MNH_NCWRIT
+ USE MODD_NCOUT
+ USE MODE_UTIL
+#endif
+!!!! MOD SB
+ USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
+ !
+ !* 0.1 Declarations of arguments
+ !
+ CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! file name
+ CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to be written
+ CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! file for prints in FM
+ CHARACTER(LEN=*), INTENT(IN) ::HLBTYPE! 'LBX','LBXU','LBY' or 'LBYV'
+ REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) ::PLB ! array containing the LB field
+ INTEGER, INTENT(IN) ::KRIM ! size of the LB area
+ INTEGER, INTENT(IN) ::KL3D ! size of the LB array in FM
+ INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
+ INTEGER, INTENT(IN) ::KLENCH ! length of comment string
+ CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
+ INTEGER, INTENT(OUT)::KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ INTEGER :: IERR
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ REAL,DIMENSION(:,:,:),ALLOCATABLE,TARGET :: Z3D
+ REAL,DIMENSION(:,:,:), POINTER :: TX3DP
+ TYPE(FMHEADER) :: TZFMH
+ INTEGER :: IIMAX_ll,IJMAX_ll
+ INTEGER :: JI
+ INTEGER :: IIB,IIE,IJB,IJE
+ INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
+ INTEGER,ALLOCATABLE,DIMENSION(:) :: REQ_TAB
+ INTEGER :: NB_REQ,IKU
+ TYPE TX_3DP
+ REAL,DIMENSION(:,:,:), POINTER :: X
+ END TYPE TX_3DP
+ TYPE(TX_3DP),ALLOCATABLE,DIMENSION(:) :: T_TX3DP
+ !
+ !* 1.1 THE NAME OF LFIFM
+ !
+ IRESP = 0
+ YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+ !print * , ' Writing Article LB ' , HRECFM
+ IF (KL3D /= 2*(KRIM+JPHEXT)) THEN
+ IRESP = -30
+ GOTO 1000
+ END IF
+ !
+ TZFD=>GETFD(YFNLFI)
+! IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
+ IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+ IF (LPACK .AND. L2D) THEN
+ TX3DP=>PLB(:,JPHEXT+1:JPHEXT+1,:)
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(TX3DP),TX3DP,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(TX3DP),TX3DP,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',TX3DP,TZFMH,IRESP)
+#endif
+ ELSE
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PLB),PLB,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PLB),PLB,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',PLB,TZFMH,IRESP)
+#endif
+ END IF
+ ELSE
+ IF (ISP == TZFD%OWNER) THEN
+ ! I/O proc case
+ CALL GET_GLOBALDIMS_ll(IIMAX_ll,IJMAX_ll)
+ IF (HLBTYPE == 'LBX' .OR. HLBTYPE == 'LBXU') THEN
+ ALLOCATE(Z3D((KRIM+JPHEXT)*2,IJMAX_ll+2*JPHEXT,SIZE(PLB,3)))
+ ELSE ! HLBTYPE == 'LBY' .OR. HLBTYPE == 'LBYV'
+ ALLOCATE(Z3D(IIMAX_ll+2*JPHEXT,(KRIM+JPHEXT)*2,SIZE(PLB,3)))
+ END IF
+ DO JI = 1,ISNPROC
+ CALL GET_DISTRIB_LB(HLBTYPE,JI,'FM','WRITE',KRIM,IIB,IIE,IJB,IJE)
+ IF (IIB /= 0) THEN
+ TX3DP=>Z3D(IIB:IIE,IJB:IJE,:)
+ IF (ISP /= JI) THEN
+ CALL MPI_RECV(TX3DP,SIZE(TX3DP),MPI_FLOAT,JI-1,99,TZFD%COMM,STATUS,IERR)
+ ELSE
+ CALL GET_DISTRIB_LB(HLBTYPE,JI,'LOC','WRITE',KRIM,IIB,IIE,IJB,IJE)
+ TX3DP = PLB(IIB:IIE,IJB:IJE,:)
+ END IF
+ END IF
+ END DO
+ TZFMH%GRID=KGRID
+ TZFMH%COMLEN=KLENCH
+ TZFMH%COMMENT=HCOMMENT
+ IF (LPACK .AND. L2D) THEN
+ TX3DP=>Z3D(:,JPHEXT+1:JPHEXT+1,:)
+ ELSE
+ TX3DP=>Z3D
+ END IF
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(TX3DP),TX3DP,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(TX3DP),TX3DP,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',TX3DP,TZFMH,IRESP)
+#endif
+ ELSE
+ NB_REQ=0
+ ALLOCATE(REQ_TAB(1))
+ ALLOCATE(T_TX3DP(1))
+ IKU = SIZE(PLB,3)
+ ! Other processors
+ CALL GET_DISTRIB_LB(HLBTYPE,ISP,'LOC','WRITE',KRIM,IIB,IIE,IJB,IJE)
+ IF (IIB /= 0) THEN
+ TX3DP=>PLB(IIB:IIE,IJB:IJE,:)
+ NB_REQ = NB_REQ + 1
+ ALLOCATE(T_TX3DP(NB_REQ)%X(IIB:IIE,IJB:IJE,IKU))
+ T_TX3DP(NB_REQ)%X=PLB(IIB:IIE,IJB:IJE,:)
+ CALL MPI_ISEND(T_TX3DP(NB_REQ)%X,SIZE(TX3DP),MPI_FLOAT,TZFD%OWNER-1,99,TZFD%COMM,REQ_TAB(NB_REQ),IERR)
+ !CALL MPI_BSEND(TX3DP,SIZE(TX3DP),MPI_FLOAT,TZFD%OWNER-1,99,TZFD%COMM,IERR)
+ END IF
+ IF (NB_REQ .GT.0 ) THEN
+ CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
+ DEALLOCATE(T_TX3DP(1)%X)
+ END IF
+ DEALLOCATE(T_TX3DP,REQ_TAB)
+ END IF
+ !
+ CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD&
+ & %COMM,IERR)
+ END IF !(GSMONOPROC)
+ ELSE
+ IRESP = -61
+ END IF
+ !----------------------------------------------------------------
+1000 CONTINUE
+ IF (IRESP.NE.0) THEN
+ CALL FM_WRIT_ERR("FMWRIT_LB",HFILEM,HFIPRI,HRECFM,HLBTYPE,KGRID,KLENCH,IRESP)
+ END IF
+ !
+ IF (ALLOCATED(Z3D)) DEALLOCATE(Z3D)
+ KRESP = IRESP
+ END SUBROUTINE FMWRIT_LB
+
+ SUBROUTINE FMWRITBOXX2_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
+ HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
+ USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
+ USE MODD_FM
+ USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+ USE MODE_GATHER_ll
+ !
+!!!! MOD SB
+#ifdef MNH_NCWRIT
+ USE MODD_NCOUT
+ USE MODE_UTIL
+#endif
+!!!! MOD SB
+ !
+ !* 0.1 Declarations of arguments
+ !
+ CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+ CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
+ CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+ CHARACTER(LEN=*), INTENT(IN) ::HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
+ REAL,DIMENSION(:,:),TARGET, INTENT(IN) ::PFIELD ! array containing the data field
+ INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
+ CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
+ INTEGER, INTENT(IN) ::KXOBOX !
+ INTEGER, INTENT(IN) ::KXEBOX ! Global coordinates of the box
+ INTEGER, INTENT(IN) ::KYOBOX !
+ INTEGER, INTENT(IN) ::KYEBOX !
+ INTEGER, INTENT(OUT)::KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ INTEGER :: IERR
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ REAL,DIMENSION(:,:),POINTER :: ZFIELDP
+ TYPE(FMHEADER) :: TZFMH
+ LOGICAL :: GALLOC
+
+ !
+ !* 1.1 THE NAME OF LFIFM
+ !
+ IRESP = 0
+ GALLOC = .FALSE.
+ YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+ !print * , ' Writing Article BOXX2 ' , HRECFM
+ !------------------------------------------------------------------
+ TZFD=>GETFD(YFNLFI)
+! IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
+ IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ TZFMH%GRID = KGRID
+ TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
+ TZFMH%COMMENT = HCOMMENT
+ IF (HBUDGET /= 'BUDGET') THEN
+ ! take the sub-section of PFIELD defined by the box
+ ZFIELDP=>PFIELD(KXOBOX:KXEBOX,KYOBOX:KYEBOX)
+ ELSE
+ ! take the field as a budget
+ ZFIELDP=>PFIELD
+ END IF
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
+#endif
+ ELSE ! multiprocessor execution
+ IF (ISP == TZFD%OWNER) THEN
+ ! Allocate the box
+ ALLOCATE(ZFIELDP(KXEBOX-KXOBOX+1,KYEBOX-KYOBOX+1))
+ GALLOC = .TRUE.
+ ELSE
+ ALLOCATE(ZFIELDP(0,0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM,&
+ & KXOBOX,KXEBOX,KYOBOX,KYEBOX,HBUDGET)
+ !
+ IF (ISP == TZFD%OWNER) THEN
+ TZFMH%GRID = KGRID
+ TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
+ TZFMH%COMMENT = HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
+#endif
+ 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("FMWRITBOXX2_ll",HFILEM,HFIPRI,HRECFM,'XY',KGRID,LEN(HCOMMENT),IRESP)
+ END IF
+ IF (GALLOC) DEALLOCATE(ZFIELDP)
+ KRESP = IRESP
+ END SUBROUTINE FMWRITBOXX2_ll
+
+ SUBROUTINE FMWRITBOXX3_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
+ HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
+ USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
+ USE MODD_FM
+ USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+ USE MODE_GATHER_ll
+ !
+!!!! MOD SB
+#ifdef MNH_NCWRIT
+ USE MODD_NCOUT
+ USE MODE_UTIL
+#endif
+!!!! MOD SB
+ !
+ !* 0.1 Declarations of arguments
+ !
+ CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+ CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
+ CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+ CHARACTER(LEN=*), INTENT(IN) ::HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
+ REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
+ INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
+ CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
+ INTEGER, INTENT(IN) ::KXOBOX !
+ INTEGER, INTENT(IN) ::KXEBOX ! Global coordinates of the box
+ INTEGER, INTENT(IN) ::KYOBOX !
+ INTEGER, INTENT(IN) ::KYEBOX !
+ INTEGER, INTENT(OUT)::KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ INTEGER :: IERR
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ REAL,DIMENSION(:,:,:),POINTER :: ZFIELDP
+ TYPE(FMHEADER) :: TZFMH
+ LOGICAL :: GALLOC
+
+ !
+ !* 1.1 THE NAME OF LFIFM
+ !
+ IRESP = 0
+ GALLOC = .FALSE.
+ YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+ !print * , ' Writing Article BOXX3 ' , HRECFM
+ !------------------------------------------------------------------
+ TZFD=>GETFD(YFNLFI)
+! IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
+ IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ TZFMH%GRID = KGRID
+ TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
+ TZFMH%COMMENT = HCOMMENT
+ IF (HBUDGET /= 'BUDGET') THEN
+ ! take the sub-section of PFIELD defined by the box
+ ZFIELDP=>PFIELD(KXOBOX:KXEBOX,KYOBOX:KYEBOX,:)
+ ELSE
+ ! take the field as a budget
+ ZFIELDP=>PFIELD
+ END IF
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
+#endif
+ ELSE ! multiprocessor execution
+ IF (ISP == TZFD%OWNER) THEN
+ ! Allocate the box
+ ALLOCATE(ZFIELDP(KXEBOX-KXOBOX+1,KYEBOX-KYOBOX+1,SIZE(PFIELD,3)))
+ GALLOC = .TRUE.
+ ELSE
+ ALLOCATE(ZFIELDP(0,0,0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM,&
+ & KXOBOX,KXEBOX,KYOBOX,KYEBOX,HBUDGET)
+ !
+ IF (ISP == TZFD%OWNER) THEN
+ TZFMH%GRID = KGRID
+ TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
+ TZFMH%COMMENT = HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
+#endif
+ 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("FMWRITBOXX3_ll",HFILEM,HFIPRI,HRECFM,'XY',KGRID,LEN(HCOMMENT),IRESP)
+ END IF
+ IF (GALLOC) DEALLOCATE(ZFIELDP)
+ KRESP = IRESP
+ END SUBROUTINE FMWRITBOXX3_ll
+
+ SUBROUTINE FMWRITBOXX4_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
+ HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
+ USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
+ USE MODD_FM
+ USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+ USE MODE_GATHER_ll
+ !
+!!!! MOD SB
+#ifdef MNH_NCWRIT
+ USE MODD_NCOUT
+ USE MODE_UTIL
+#endif
+!!!! MOD SB
+ !
+ !* 0.1 Declarations of arguments
+ !
+ CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+ CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
+ CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+ CHARACTER(LEN=*), INTENT(IN) ::HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
+ REAL,DIMENSION(:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
+ INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
+ CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
+ INTEGER, INTENT(IN) ::KXOBOX !
+ INTEGER, INTENT(IN) ::KXEBOX ! Global coordinates of the box
+ INTEGER, INTENT(IN) ::KYOBOX !
+ INTEGER, INTENT(IN) ::KYEBOX !
+ INTEGER, INTENT(OUT)::KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ INTEGER :: IERR
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ REAL,DIMENSION(:,:,:,:),POINTER :: ZFIELDP
+ TYPE(FMHEADER) :: TZFMH
+ LOGICAL :: GALLOC
+
+ !
+ !* 1.1 THE NAME OF LFIFM
+ !
+ IRESP = 0
+ GALLOC = .FALSE.
+ YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+ !print * , ' Writing Article BOXX4 ' , HRECFM
+ !------------------------------------------------------------------
+ TZFD=>GETFD(YFNLFI)
+! IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
+ IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ TZFMH%GRID = KGRID
+ TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
+ TZFMH%COMMENT = HCOMMENT
+ IF (HBUDGET /= 'BUDGET') THEN
+ ! take the sub-section of PFIELD defined by the box
+ ZFIELDP=>PFIELD(KXOBOX:KXEBOX,KYOBOX:KYEBOX,:,:)
+ ELSE
+ ! take the field as a budget
+ ZFIELDP=>PFIELD
+ END IF
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
+#endif
+ ELSE ! multiprocessor execution
+ IF (ISP == TZFD%OWNER) THEN
+ ! Allocate the box
+ ALLOCATE(ZFIELDP(KXEBOX-KXOBOX+1,KYEBOX-KYOBOX+1,SIZE(PFIELD,3),SIZE(PFIELD,4)))
+ GALLOC = .TRUE.
+ ELSE
+ ALLOCATE(ZFIELDP(0,0,0,0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM,&
+ & KXOBOX,KXEBOX,KYOBOX,KYEBOX,HBUDGET)
+ !
+ IF (ISP == TZFD%OWNER) THEN
+ TZFMH%GRID = KGRID
+ TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
+ TZFMH%COMMENT = HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
+#endif
+ 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("FMWRITBOXX4_ll",HFILEM,HFIPRI,HRECFM,'XY',KGRID,LEN(HCOMMENT),IRESP)
+ END IF
+ IF (GALLOC) DEALLOCATE(ZFIELDP)
+ KRESP = IRESP
+ END SUBROUTINE FMWRITBOXX4_ll
+
+ SUBROUTINE FMWRITBOXX5_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
+ HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
+ USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
+ USE MODD_FM
+ USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+ USE MODE_GATHER_ll
+ !
+!!!! MOD SB
+#ifdef MNH_NCWRIT
+ USE MODD_NCOUT
+ USE MODE_UTIL
+#endif
+!!!! MOD SB
+ !
+ !* 0.1 Declarations of arguments
+ !
+ CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+ CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
+ CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+ CHARACTER(LEN=*), INTENT(IN) ::HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
+ REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
+ INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
+ CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
+ INTEGER, INTENT(IN) ::KXOBOX !
+ INTEGER, INTENT(IN) ::KXEBOX ! Global coordinates of the box
+ INTEGER, INTENT(IN) ::KYOBOX !
+ INTEGER, INTENT(IN) ::KYEBOX !
+ INTEGER, INTENT(OUT)::KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ INTEGER :: IERR
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ REAL,DIMENSION(:,:,:,:,:),POINTER :: ZFIELDP
+ TYPE(FMHEADER) :: TZFMH
+ LOGICAL :: GALLOC
+
+ !
+ !* 1.1 THE NAME OF LFIFM
+ !
+ IRESP = 0
+ GALLOC = .FALSE.
+ YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+ !print * , ' Writing Article BOXX5 ' , HRECFM
+ !------------------------------------------------------------------
+ TZFD=>GETFD(YFNLFI)
+! IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
+ IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ TZFMH%GRID = KGRID
+ TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
+ TZFMH%COMMENT = HCOMMENT
+ IF (HBUDGET /= 'BUDGET') THEN
+ ! take the sub-section of PFIELD defined by the box
+ ZFIELDP=>PFIELD(KXOBOX:KXEBOX,KYOBOX:KYEBOX,:,:,:)
+ ELSE
+ ! take the field as a budget
+ ZFIELDP=>PFIELD
+ END IF
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
+#endif
+ ELSE ! multiprocessor execution
+ IF (ISP == TZFD%OWNER) THEN
+ ! Allocate the box
+ ALLOCATE(ZFIELDP(KXEBOX-KXOBOX+1,KYEBOX-KYOBOX+1,SIZE(PFIELD,3),&
+ & SIZE(PFIELD,4),SIZE(PFIELD,5)))
+ GALLOC = .TRUE.
+ ELSE
+ ALLOCATE(ZFIELDP(0,0,0,0,0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM,&
+ & KXOBOX,KXEBOX,KYOBOX,KYEBOX,HBUDGET)
+ !
+ IF (ISP == TZFD%OWNER) THEN
+ TZFMH%GRID = KGRID
+ TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
+ TZFMH%COMMENT = HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
+#endif
+ 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("FMWRITBOXX5_ll",HFILEM,HFIPRI,HRECFM,'XY',KGRID,LEN(HCOMMENT),IRESP)
+ END IF
+ IF (GALLOC) DEALLOCATE(ZFIELDP)
+ KRESP = IRESP
+ END SUBROUTINE FMWRITBOXX5_ll
+
+ SUBROUTINE FMWRITBOXX6_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
+ HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
+ USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
+ USE MODD_FM
+ USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+ USE MODE_GATHER_ll
+ !
+!!!! MOD SB
+#ifdef MNH_NCWRIT
+ USE MODD_NCOUT
+ USE MODE_UTIL
+#endif
+!!!! MOD SB
+ !
+ !* 0.1 Declarations of arguments
+ !
+ CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
+ CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
+ CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
+ CHARACTER(LEN=*), INTENT(IN) ::HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
+ REAL,DIMENSION(:,:,:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
+ INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
+ CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
+ INTEGER, INTENT(IN) ::KXOBOX !
+ INTEGER, INTENT(IN) ::KXEBOX ! Global coordinates of the box
+ INTEGER, INTENT(IN) ::KYOBOX !
+ INTEGER, INTENT(IN) ::KYEBOX !
+ INTEGER, INTENT(OUT)::KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ INTEGER :: IERR
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ REAL,DIMENSION(:,:,:,:,:,:),POINTER :: ZFIELDP
+ TYPE(FMHEADER) :: TZFMH
+ LOGICAL :: GALLOC
+
+ !
+ !* 1.1 THE NAME OF LFIFM
+ !
+ IRESP = 0
+ GALLOC = .FALSE.
+ YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
+ !print * , ' Writing Article BOXX6 ' , HRECFM
+ !------------------------------------------------------------------
+ TZFD=>GETFD(YFNLFI)
+! IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
+ IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ TZFMH%GRID = KGRID
+ TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
+ TZFMH%COMMENT = HCOMMENT
+ IF (HBUDGET /= 'BUDGET') THEN
+ ! take the sub-section of PFIELD defined by the box
+ ZFIELDP=>PFIELD(KXOBOX:KXEBOX,KYOBOX:KYEBOX,:,:,:,:)
+ ELSE
+ ! take the field as a budget
+ ZFIELDP=>PFIELD
+ END IF
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
+#endif
+ ELSE ! multiprocessor execution
+ IF (ISP == TZFD%OWNER) THEN
+ ! Allocate the box
+ ALLOCATE(ZFIELDP(KXEBOX-KXOBOX+1,KYEBOX-KYOBOX+1,SIZE(PFIELD,3),&
+ & SIZE(PFIELD,4),SIZE(PFIELD,5),SIZE(PFIELD,6)))
+ GALLOC = .TRUE.
+ ELSE
+ ALLOCATE(ZFIELDP(0,0,0,0,0,0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM,&
+ & KXOBOX,KXEBOX,KYOBOX,KYEBOX,HBUDGET)
+ !
+ IF (ISP == TZFD%OWNER) THEN
+ TZFMH%GRID = KGRID
+ TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
+ TZFMH%COMMENT = HCOMMENT
+#ifdef MNH_NCWRIT
+ IF ( DEF_NC .AND. LLFIFM ) THEN
+ CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ END IF
+#else
+ IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
+ & ,IRESP)
+ IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
+#endif
+ 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("FMWRITBOXX6_ll",HFILEM,HFIPRI,HRECFM,'XY',KGRID,LEN(HCOMMENT),IRESP)
+ END IF
+ IF (GALLOC) DEALLOCATE(ZFIELDP)
+ KRESP = IRESP
+ END SUBROUTINE FMWRITBOXX6_ll
+
+END MODULE MODE_FMWRIT
+
+
--
GitLab