 SUBROUTINE mesh1d (bl,msh,ib,nb_dom,blv,interdom) 
! =============================== DOCUMENTATION =======================
! DOCDEBh*      GEO/mesh1d *                                           
!                                                                      
! NOM :                                                                
!      mesh1d (bl,msh,ib,nb_dom,blv,interdom)                          
!                                                                      
! DESCRIPTION:                                                         
!*
!      Maillage regulier d un bloc hexaedrique en 1D
!
!      Regular mesh of a hexahedral block in 1D
!*                                                   
!                                                                      
!    ENTREES / INPUT
!      bl       : Bloc a mailler et a ajouter au maillage msh / Block to be meshed and added to the msh mesh
!      blv      : Blocs voisins (1 a 6) a modifier / Neighbouring blocks to be modified
!      ib       : Numero du bloc a ajouter / number of the block to be added
!      nb_dom   : nombre de domaines / number of domains                
!      msh      : maillage / mesh
!      interdom : Table de localisation de l interface des domaines / Domain interface location table
! 
!    SORTIES / OUTPUT
!      msh      : maillage / mesh
!                                
!    SOURCE
! Ce logiciel est regi par la licence [CeCILL-B]
! This software is governed by the [CeCILL-B] license
! =====================================================================

! ================================== DEBUT DES DECLARATIONS =================================== ! 
!.1 --- Implicit, Use 
      use geo_typ
      use geo, ONLY: psr,pni,volcel,display
      IMPLICIT NONE
!.2---- Declaration 
      TYPE(bloc), INTENT(in)                        :: bl       
!! Bloc a mailler et a ajouter au maillage msh / Block to be meshed and added to the msh mesh
      TYPE(bloc), INTENT(in)                        :: blv(6)
!! Blocs voisins a modifier / Neighbouring blocks to be modified
      INTEGER, INTENT(in)                           :: ib !! numero du bloc a ajouter / number of the block to be added
      INTEGER, INTENT(in)                           :: nb_dom  !! nombre de domaines / number of domains
      TYPE(mesh), INTENT(inout)                     :: msh !! Maillage / Mesh
      TYPE(list_int), DIMENSION(:), INTENT(inout)   :: interdom
!! Table de localisation de l interface des domaines /Domain interface location table

      REAL(KIND=KIND(0.0d0))                        :: vv
      INTEGER                                       :: nx, ny, nz, i, j, k, is, ia, idebv, idebf
      INTEGER                                       :: ii, idebc, nui, nue, ipos_send, ipos_recv
      INTEGER                                       :: ie,je,ke,nxv,nyv,nzv

! ================================= DEBUT DU CODE EXECUTABLE ================================= !
!
!CALL display (bl)

      nx = bl%nx*2**(bl%nrb)
      ny = 1
      nz = 1

! Construction de la liste des sommets 
      DO i=1,nx+1 
         DO j=1,ny+1
            DO k=1,nz+1
               is = i + (j-1)*(nx+1) + (k-1)*(nx+1)*2 + bl%first_vertex
               msh%list_vertex(is) = pni(bl,i*1.0d0,j*1.0d0,k*1.0d0,-1)
            ENDDO
         ENDDO
      ENDDO      

! Construction de la liste des cellules 

         DO i=1,nx
            is = i +bl%first_cell
            msh%list_cell(is)%num  = is
            msh%list_cell(is)%idom = bl%idom
            msh%list_cell(is)%center=pni(bl,i*1.d0+0.5d0,1.d0+0.5d0,1.d0+0.5d0,-1)  !!!!!!!!!$$$$$!!!!!!!$$$$$
            msh%list_cell(is)%vol=volcel(bl,i*1.d0,1.d0,1.d0,-1)                    !!!!!!!!!$$$$$!!!!!!!$$$$$
         ENDDO

      msh%list_face(:)%nbvertex = 4

ia = bl%first_face     
! Construction de la liste des faces interieures paralleles au plan y z 

!      IF(nx.NE.1)THEN
         DO i=2,nx
            ia = ia+1
            msh%list_face(ia)%vertex(1)= (i+0)+(1+0-1)*(nx+1) + (nx+1)*(1+1)*(1+0-1) + bl%first_vertex
            msh%list_face(ia)%vertex(2)= (i+0)+(1+0-1)*(nx+1) + (nx+1)*(1+1)*(1+1-1) + bl%first_vertex
            msh%list_face(ia)%vertex(3)= (i+0)+(1+1-1)*(nx+1) + (nx+1)*(1+1)*(1+1-1) + bl%first_vertex
            msh%list_face(ia)%vertex(4)= (i+0)+(1+1-1)*(nx+1) + (nx+1)*(1+1)*(1+0-1) + bl%first_vertex
            msh%list_face(ia)%ic1      = (i-1)+bl%first_cell
            msh%list_face(ia)%ic2      = (i-0)+bl%first_cell
         ENDDO
!      ENDIF   

idebv = (nx+1)*2*2 + bl%first_vertex
idebf = nx-1 + bl%first_face
idebc = nx   + bl%first_cell

! Construction de la liste des faces pour x=xmin
! et des cellules du domaine voisin
! =============================================================================================

IF(bl%idom.eq.blv(1)%idom.AND.ib.LT.bl%cl(1)) GOTO 101

IF(blv(1)%idom.EQ.0) THEN
   nxv=nx
   nyv=1
   nzv=1
ELSE
   nxv=blv(1)%nx*2**(blv(1)%nrb)
   nyv=1
   nzv=1
ENDIF
            ie=nxv
            je=1
            ke=1
            nue=je                  ! Numerotation exterieure
            nui=1                   ! Numerotation interieure au bloc 
            ia=idebf+nui
            msh%list_face(ia)%vertex(1)=(1+0)+(1+0-1)*(nx+1) + bl%first_vertex
            msh%list_face(ia)%vertex(2)=(1+0)+(1+1-1)*(nx+1) + bl%first_vertex
            msh%list_face(ia)%vertex(3)=(1+0)+(1+1-1)*(nx+1) + 2*(nx+1) + bl%first_vertex
            msh%list_face(ia)%vertex(4)=(1+0)+(1+0-1)*(nx+1) + 2*(nx+1) + bl%first_vertex
            msh%list_face(ia)%ic1= 1 +bl%first_cell            
            IF(bl%cl(1).LE.0) THEN
               msh%list_face(ia)%ic2=bl%cl(1)
            ELSE
               IF(blv(1)%idom.NE.bl%idom) THEN
                  msh%list_face(ia)%ic2=idebc+nue
                  CALL psr(interdom,nb_dom,bl%idom,blv(1)%idom,ib,bl%cl(1),ipos_send,ipos_recv)
                  msh%list_send(blv(1)%idom)%L(nui+ipos_send) = 1 + bl%first_cell
                  msh%list_recv(blv(1)%idom)%L(nue+ipos_recv) = idebc+nue
                  msh%list_face(ia)%ic2               = idebc+nue
                  msh%list_cell(idebc+nue)%num    = idebc+nue
                  msh%list_cell(idebc+nue)%idom   =blv(1)%idom
                  vv=volcel(blv(1),1.d0*ie,1.d0*je,1.d0*ke,1)
                  msh%list_cell(idebc+nue)%vol    = vv
                  msh%list_cell(idebc+nue)%center = pni(blv(1),1.d0*ie+0.5d0,1.d0*je+0.5d0,1.0*ke+0.5d0,-1)
               ELSE
                  msh%list_face(ia)%ic2 = ie + blv(1)%first_cell      !!!!! A VERIFIER PARTOUT
               ENDIF
            ENDIF
        idebf=idebf+1
!        idebv=idebv+2
        IF(bl%cl(1).GT.0)THEN
        IF(blv(1)%idom.NE.bl%idom)      idebc=idebc+1
      ENDIF

101 CONTINUE         

!
! Construction de la liste des faces pour x=xmax 
! et des cellules du domaine voisin
!===========================================================================================

IF(bl%idom.eq.blv(2)%idom.AND.ib.LT.bl%cl(2)) GOTO 102

IF(blv(2)%idom.EQ.0) THEN
   nxv=nx
   nyv=1
   nzv=1
ELSE
   nxv=blv(2)%nx*2**(blv(2)%nrb)
   nyv=1
   nzv=1
ENDIF
            ie=1
            je=1
            ke=1
            nue=je                  ! Numérotation exterieure
            nui=1                   ! Numérotation interieure au bloc 
            ia=idebf+nui
            msh%list_face(ia)%vertex(1)=(nx+1+0)+(1+0-1)*(nx+1) + bl%first_vertex
            msh%list_face(ia)%vertex(4)=(nx+1+0)+(1+1-1)*(nx+1) + bl%first_vertex
            msh%list_face(ia)%vertex(3)=(nx+1+0)+(1+1-1)*(nx+1) + 2*(nx+1) + bl%first_vertex
            msh%list_face(ia)%vertex(2)=(nx+1+0)+(1+0-1)*(nx+1) + 2*(nx+1) + bl%first_vertex
            msh%list_face(ia)%ic1= nx +bl%first_cell            
            IF(bl%cl(2).LE.0) THEN
               msh%list_face(ia)%ic2=bl%cl(2)
            ELSE
               IF(blv(2)%idom.NE.bl%idom) THEN
                  msh%list_face(ia)%ic2=idebc+nue
                    CALL psr(interdom,nb_dom,bl%idom,blv(2)%idom,ib,bl%cl(2),ipos_send,ipos_recv)
                  msh%list_send(blv(2)%idom)%L(nui+ipos_send) = nx + bl%first_cell
                  msh%list_recv(blv(2)%idom)%L(nue+ipos_recv) = idebc+nue
                  msh%list_cell(idebc+nue)%num        = idebc+nue
                  msh%list_cell(idebc+nue)%idom       =blv(2)%idom
                  vv=volcel(blv(2),1.d0*ie,1.d0*je,1.d0*ke,1)
                  msh%list_cell(idebc+nue)%vol    = vv
                  msh%list_cell(idebc+nue)%center = pni(blv(2),1.d0*ie+0.5d0,1.d0*je+0.5d0,1.0*ke+0.5d0,-1)
               ELSE
                  msh%list_face(ia)%ic2 = ie + blv(2)%first_cell      !!!!! A VERIFIER PARTOUT
               ENDIF
            ENDIF

      idebf=idebf+1
!      idebv=idebv+2  
      IF(bl%cl(2).GT.0)THEN
         IF(blv(2)%idom.NE.bl%idom)      idebc=idebc+1
      ENDIF


102 CONTINUE      

! Construction de la liste des faces pour y=ymin 
! et des cellules du domaine voisin
!===========================================================================================
      DO i=1,nx
           nue=1                    ! Numerotation exterieure
           nui=i                    ! Numerotation interieure au bloc
         ia=idebf+nui
             msh%list_face(ia)%vertex(1)=(i+0)+(1+0-1)*(nx+1) +bl%first_vertex
             msh%list_face(ia)%vertex(4)=(i+1)+(1+0-1)*(nx+1) +bl%first_vertex
             msh%list_face(ia)%vertex(3)=(i+1)+(2+1-1)*(nx+1) +bl%first_vertex
             msh%list_face(ia)%vertex(2)=(i+0)+(2+1-1)*(nx+1) +bl%first_vertex
             msh%list_face(ia)%ic1=i+bl%first_cell
             msh%list_face(ia)%ic2=bl%cl(3)
        ENDDO
       
             idebf=idebf+nx

! Construction de la liste des faces pour y=ymax
! et des cellules du domaine voisin
!===========================================================================================
      DO i=1,nx
           nue=i            ! Numerotation exterieure
           nui=i            ! Numerotation interieure au bloc
           ia=idebf+nui
             msh%list_face(ia)%vertex(1)=(i+0)+(1+0-1)*(nx+1) + (nx+1)*(0+1)*(2-1)+bl%first_vertex
             msh%list_face(ia)%vertex(2)=(i+1)+(1+0-1)*(nx+1) + (nx+1)*(0+1)*(2-1)+bl%first_vertex
             msh%list_face(ia)%vertex(3)=(i+1)+(2+1-1)*(nx+1) + (nx+1)*(0+1)*(2-1)+bl%first_vertex
             msh%list_face(ia)%vertex(4)=(i+0)+(2+1-1)*(nx+1) + (nx+1)*(0+1)*(2-1)+bl%first_vertex
             msh%list_face(ia)%ic1=i+bl%first_cell
             msh%list_face(ia)%ic2=bl%cl(4)
        ENDDO
       
        idebf=idebf+nx

! Construction de la liste des faces pour z=zmin 
!==========================================================================================
       ii=1
       DO i=1,nx
             nue=1+int((i-1)/ii)                 ! Numerotation exterieure
             nui=i                               ! Numerotation interieure au bloc
             ia=idebf+nui
             msh%list_face(ia)%vertex(1)=(i+0)+(1+0-1)*(nx+1) + (nx+1)*(1+1)*(1-1)+bl%first_vertex
             msh%list_face(ia)%vertex(2)=(i+1)+(1+0-1)*(nx+1) + (nx+1)*(1+1)*(1-1)+bl%first_vertex
             msh%list_face(ia)%vertex(3)=(i+1)+(1+1-1)*(nx+1) + (nx+1)*(1+1)*(1-1)+bl%first_vertex
             msh%list_face(ia)%vertex(4)=(i+0)+(1+1-1)*(nx+1) + (nx+1)*(1+1)*(1-1)+bl%first_vertex
             msh%list_face(ia)%ic1=i+bl%first_cell
             msh%list_face(ia)%ic2=bl%cl(5)
       ENDDO
       idebf=idebf+nx

! Construction de la liste des faces pour z=zmax 
!===========================================================================================
       DO i=1,nx
             nue=i       ! Numerotation exterieure
             nui=i       ! Numerotation interieure au bloc
             ia=idebf+nui
             msh%list_face(ia)%vertex(1)=(i+0)+(1+0-1)*(nx+1) + (nx+1)*(1+1)*(2-1)+bl%first_vertex
             msh%list_face(ia)%vertex(4)=(i+1)+(1+0-1)*(nx+1) + (nx+1)*(1+1)*(2-1)+bl%first_vertex
             msh%list_face(ia)%vertex(3)=(i+1)+(1+1-1)*(nx+1) + (nx+1)*(1+1)*(2-1)+bl%first_vertex
             msh%list_face(ia)%vertex(2)=(i+0)+(1+1-1)*(nx+1) + (nx+1)*(1+1)*(2-1)+bl%first_vertex
             msh%list_face(ia)%ic1=i+bl%first_cell
             msh%list_face(ia)%ic2=bl%cl(6)
       ENDDO
       idebf=idebf+nx

RETURN 
!
!===========================   FIN DE LA ROUTINE    =====================================

END SUBROUTINE mesh1d
!DOCFIN
