!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 RCS information
!-----------------------------------------------------------------
! $Source: /srv/cvsroot/MNH-VX-Y-Z/src/MNH/ini_cturb.f90,v $ $Revision: 1.2.4.1.2.2.2.1.2.2 $ $Date: 2014/01/09 15:01:55 $
!-----------------------------------------------------------------
!-----------------------------------------------------------------
!       #####################
        MODULE MODI_IBM_WRITE
!       #####################
!
INTERFACE
!
SUBROUTINE IBM_WRITE(PPTAB,HTAB,HPOS,KTCOUNT)

  CHARACTER(LEN=1)             ,INTENT(IN)    :: HPOS
  REAL, DIMENSION(:,:,:)       ,INTENT(IN)    :: PPTAB
  CHARACTER(LEN=*)             ,INTENT(IN)    :: HTAB
  INTEGER                      ,INTENT(IN)    :: KTCOUNT


END SUBROUTINE IBM_WRITE
!
END INTERFACE
!
END MODULE MODI_IBM_WRITE
!
!
!
!       ####################################
        SUBROUTINE IBM_WRITE(PPTAB,HTAB,HPOS,KTCOUNT)
!       ####################################
!
!!****     *IBM_WRITE*  - routine to write in ASCII file 
!!
!!      PURPOSE
!!      -------
!         The purpose of this routine is to write an ASCII file
!
!!      METHOD
!!      ------
!!!
!!      EXTERNAL
!!      --------
!!        NONE
!!
!!      IMPLICIT ARGUMENTS
!!      ------------------
!!
!!      REFERENCE
!!      ---------
!!
!!      AUTHOR
!!      ------
!!        Franck Auguste       * CERFACS(AE) *
!!
!!      MODIFICATIONS
!!      -------------
!!        Original          01/01/2015
!!
!------------------------------------------------------------------------------
!       
!**** 0. DECLARATIONS
!     ---------------
!
! module
USE MODE_POS
USE MODE_ll
USE MODE_IO_ll
!
! declaration
USE MODD_IBM_PARAM_n
USE MODD_GRID_n,          ONLY: XXHAT,XYHAT,XZZ
USE MODD_DIM_n,           ONLY: NIMAX,NJMAX,NKMAX
USE MODD_PARAMETERS,      ONLY: JPVEXT,JPHEXT
USE MODD_VAR_ll,          ONLY: IP
USE MODD_CONF,            ONLY: NHALO
!
! interface
USE MODI_SHUMAN
USE MODI_IBM_INTERPOS
USE MODI_GATHER_ll
!
IMPLICIT NONE
!
!------------------------------------------------------------------------------
!
!       0.1  declarations of arguments
CHARACTER(LEN=1)             ,INTENT(IN)      :: HPOS                                             ! location UVWP
REAL, DIMENSION(:,:,:)       ,INTENT(IN)      :: PPTAB                                             ! variable
CHARACTER(LEN=*)             ,INTENT(IN)      :: HTAB                                              ! Name
INTEGER                      ,INTENT(IN)      :: KTCOUNT
!
!------------------------------------------------------------------------------
!
!       0.2  declaration of local variables
INTEGER                                       :: IIU,IJU,IKU                                       ! domain size
INTEGER                                       :: IIB,IIE,IJB,IJE,IKB,IKE
INTEGER                                       :: JI,JJ,JK                                          ! loop index
INTEGER                                       :: JI_ll,JJ_ll,JK_ll
INTEGER                                       :: NIMAX_ll,NJMAX_ll
INTEGER                                       :: ILUIBMWRITE,IRESPIBMWRITE                         ! unit ASCII file 
REAL,DIMENSION(:,:,:)           ,ALLOCATABLE  :: ZXREF,ZYREF,ZZREF                                 ! location arrays                       
REAL,DIMENSION(:)               ,ALLOCATABLE  :: ZXREF_ll,ZYREF_ll,ZZREF_ll,ZPTAB_ll,ZXHAT_ll,ZYHAT_ll
INTEGER                                       :: JI_MAX,JJ_MAX,JK_MAX,JI_MIN,JJ_MIN,JK_MIN
INTEGER                                       :: JI_MAX2,JJ_MAX2,JK_MAX2,JI_MIN2,JJ_MIN2,JK_MIN2
INTEGER                                       :: NRESP,IINFO_ll
INTEGER                                       :: ITEST,JTEST
!
!------------------------------------------------------------------------------
!
!       0.3  Allocation
!
IIU = SIZE(PPTAB,1)
IJU = SIZE(PPTAB,2)
IKU = SIZE(PPTAB,3)
!
ALLOCATE(ZXREF(IIU,IJU,IKU))
ALLOCATE(ZYREF(IIU,IJU,IKU))
ALLOCATE(ZZREF(IIU,IJU,IKU))
!
CALL GET_GLOBALDIMS_ll(NIMAX_ll,NJMAX_ll)
!
ALLOCATE(ZXHAT_ll(NIMAX_ll+ 2 * JPHEXT))
ALLOCATE(ZYHAT_ll(NJMAX_ll+ 2 * JPHEXT))
!
CALL GATHERALL_FIELD_ll('XX',XXHAT,ZXHAT_ll,NRESP) !//
CALL GATHERALL_FIELD_ll('YY',XYHAT,ZYHAT_ll,NRESP) !//
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
JI_MIN = 1 + JPHEXT
JJ_MIN = 1 + JPHEXT
JK_MIN = 1 + JPVEXT
JI_MAX = size(ZXHAT_ll,1) - JPHEXT 
JJ_MAX = size(ZYHAT_ll,1) - JPHEXT
JK_MAX = IKU              - JPVEXT
!
ALLOCATE(ZXREF_ll(IKU))
ALLOCATE(ZYREF_ll(IKU))
ALLOCATE(ZZREF_ll(IKU))
ALLOCATE(ZPTAB_ll(IKU))

!
!**** 1. PRELIMINARIES
!     ----------------
!
  CALL IBM_INTERPOS(ZXREF,ZYREF,ZZREF,HPOS)

  IF (IP==1) THEN
!  IF (KTCOUNT==1) THEN
   CALL OPEN_ll(UNIT=ILUIBMWRITE , FILE=HTAB//'_'//HPOS//'.asc', IOSTAT=IRESPIBMWRITE , FORM='FORMATTED' , &
          STATUS='NEW', POSITION='APPEND', ACCESS='SEQUENTIAL', ACTION='WRITE', MODE = GLOBAL )
!  ELSE
!    OPEN(UNIT=ILUIBMWRITE , FILE=HTAB//'_'//HPOS//'.asc', IOSTAT=IRESPIBMWRITE , FORM='FORMATTED' , &
!          STATUS='OLD', POSITION='APPEND', ACCESS='SEQUENTIAL', ACTION='WRITE')
!  ENDIF
  ENDIF

!  CALL OPEN_ll(UNIT=ILUIBMWRITE , FILE=HTAB//'_'//HPOS//'.asc', IOSTAT=IRESPIBMWRITE,FORM='FORMATTED' , &
!               STATUS='NEW'     , ACCESS='SEQUENTIAL'         , ACTION='WRITE'      , MODE = GLOBAL )

  IF (HPOS=='U') THEN
    JI_MAX = JI_MAX+1
  ENDIF
  IF (HPOS=='V') THEN
    JJ_MAX = JJ_MAX+1
  ENDIF
  IF (HPOS=='W') THEN
    JK_MAX = JK_MAX+1
  ENDIF
!
!------------------------------------------------------------------------------
!       
!**** 2. EXECUTIONS
!     -------------
!
  JI_MIN2=JI_MIN
  JI_MAX2=JI_MAX
  JJ_MIN2=JJ_MIN
  JJ_MAX2=JJ_MAX
  JK_MIN2=3!JK_MIN
  JK_MAX2=3!JK_MAX


  IF (IP==1) THEN
   WRITE(UNIT=ILUIBMWRITE,FMT='(A31)')'TITLE = "EXAMPLE: 3D GEOMETRIE"'
   WRITE(UNIT=ILUIBMWRITE,FMT='(A31)')'VARIABLES = "X", "Y", "Z", "P1"'
   WRITE(UNIT=ILUIBMWRITE,FMT='(A18,I4,A3,I4,A3,I4,A8)')'ZONE T="Floor", I=',JK_MAX2-JK_MIN2+1,&
                                                                       ',J=',JJ_MAX2-JJ_MIN2+1,&
                                                                       ',K=',JI_MAX2-JI_MIN2+1,&
                                                                       ',F=POINT'
  ENDIF

  DO JI_ll=1,size(ZXHAT_ll,1)
    DO JJ_ll=1,size(ZYHAT_ll,1)
!     JJ_ll = JJ_MIN+1

      ZXREF_ll = 0.
      ZYREF_ll = 0.
      ZZREF_ll = 0.
      ZPTAB_ll = 0.

      ITEST = 0
      JTEST = 0
 
      IF (LEAST_ll ().and.HPOS=='U') ITEST=1
      IF (LNORTH_ll().and.HPOS=='V') JTEST=1

      DO JI=IIB,IIE+ITEST
        DO JJ=IJB,IJE+JTEST
!         JJ=JJ_MIN+1

          IF (XXHAT(JI)==ZXHAT_ll(JI_ll).AND.&
              XYHAT(JJ)==ZYHAT_ll(JJ_ll)) THEN
          
            ZXREF_ll(:)=ZXREF(JI,JJ,:)
            ZYREF_ll(:)=ZYREF(JI,JJ,:)
            ZZREF_ll(:)=ZZREF(JI,JJ,:)
            ZPTAB_ll(:)=PPTAB(JI,JJ,:)

          ENDIF

        ENDDO
      ENDDO

      CALL REDUCESUM_ll(ZXREF_ll,IINFO_ll)
      CALL REDUCESUM_ll(ZYREF_ll,IINFO_ll)
      CALL REDUCESUM_ll(ZZREF_ll,IINFO_ll)
      CALL REDUCESUM_ll(ZPTAB_ll,IINFO_ll)

      IF ((IP==1).and.JI_ll>=JI_MIN2.and.JI_ll<=JI_MAX2 &
                 .and.JJ_ll>=JJ_MIN2.and.JJ_ll<=JJ_MAX2)  THEN

        DO JK_ll = JK_MIN2,JK_MAX2
!          IF (JK_ll==JK_MAX2) ZZREF_ll(JK_ll)=4000.
          WRITE(UNIT=ILUIBMWRITE,FMT='(4(1X,E16.8))')  ZXREF_ll(JK_ll),ZYREF_ll(JK_ll),ZZREF_ll(JK_ll),ZPTAB_ll(JK_ll)

        ENDDO

      ENDIF

    ENDDO
  ENDDO

! 
!------------------------------------------------------------------------------
!       
!**** X. DEALLOCATIONS/CLOSES
!     -----------------------
!
DEALLOCATE(ZXREF,ZYREF,ZZREF)
DEALLOCATE(ZPTAB_ll,ZXREF_ll,ZYREF_ll,ZZREF_ll)
DEALLOCATE(ZXHAT_ll,ZYHAT_ll)

IF (IP==1) CLOSE(UNIT=ILUIBMWRITE)
!
RETURN
!
END SUBROUTINE IBM_WRITE