 SUBROUTINE MESH2D  (bl,msh,ib,nb_dom,blv,interdom)
!=========================== DOCUMENTATION ============================= 
!DOCDEBh*    GEO/MESH2D  *
!
!    NOM
! mesh2d(bl,msh,ib,nb_dom,blv,interdom)
!    DESCRIPTION  
!*
!      Maillage regulier d un bloc hexaedrique en 2D
!
!      Regular mesh of a hexahedral block in 2D
!*
! 
!  
!    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
      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.d0))                        :: vv
       integer                                      :: nx,ny,nz,i,j,k,is,ia,idebv,idebf,blcl1
       integer                                      :: ii,idebc,nui,nue,ipos_send,ipos_recv
       integer                                      :: ie,je,ke,nxv,nyv,nzv
!=========================== DEBUT DU CODE EXECUTABLE ==================
!
       nx=bl%nx*2**(bl%nrb)
       ny=bl%ny*2**(bl%nrb)
       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+(nx+1)*(j-1)+(nx+1)*(ny+1)*(k-1)+bl%first_vertex
              msh%list_vertex(is)=pni(bl,i*1.d0,j*1.d0,k*1.d0,1)
            end do
          end do
       end do

! construction de la liste des cellules

       do i=1,nx
          do j=1,ny
            do k=1,nz
               is=i+(j-1)*nx+nx*ny*(k-1)+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,j*1.d0+0.5d0,k*1.d0+0.5d0,1)  !!!!!!!!!$$$$$!!!!!!!$$$$$
               msh%list_cell(is)%vol=volcel(bl,i*1.d0,j*1.d0,k*1.d0,1)                    !!!!!!!!!$$$$$!!!!!!!$$$$$
             end do
          end do
       end do
       
     msh%list_face(:)%nbvertex=4

ia=bl%first_face

! construction de la liste des faces interieures paralleles au plan x z
     do j=2,ny
       do i=1,nx
          do k=1,nz
             ia=ia+1 
             msh%list_face(ia)%vertex(1)=(i+0)+(j+0-1)*(nx+1) + (nx+1)*(ny+1)*(k+0-1) +bl%first_vertex
             msh%list_face(ia)%vertex(2)=(i+1)+(j+0-1)*(nx+1) + (nx+1)*(ny+1)*(k+0-1) +bl%first_vertex
             msh%list_face(ia)%vertex(3)=(i+1)+(j+0-1)*(nx+1) + (nx+1)*(ny+1)*(k+1-1) +bl%first_vertex
             msh%list_face(ia)%vertex(4)=(i+0)+(j+0-1)*(nx+1) + (nx+1)*(ny+1)*(k+1-1) +bl%first_vertex
             msh%list_face(ia)%ic1=i+(j-2)*nx+(k-1)*nx*ny +bl%first_cell
             msh%list_face(ia)%ic2=i+(j-1)*nx+(k-1)*nx*ny +bl%first_cell
          end do
       end do
     end do

! construction de la liste des faces interieures paralleles au plan y z
     do i=2,nx
       do j=1,ny
          do k=1,nz
             ia=ia+1 
             msh%list_face(ia)%vertex(1)=(i+0)+(j+0-1)*(nx+1) + (nx+1)*(ny+1)*(k+0-1) +bl%first_vertex
             msh%list_face(ia)%vertex(2)=(i+0)+(j+0-1)*(nx+1) + (nx+1)*(ny+1)*(k+1-1) +bl%first_vertex
             msh%list_face(ia)%vertex(3)=(i+0)+(j+1-1)*(nx+1) + (nx+1)*(ny+1)*(k+1-1) +bl%first_vertex
             msh%list_face(ia)%vertex(4)=(i+0)+(j+1-1)*(nx+1) + (nx+1)*(ny+1)*(k+0-1) +bl%first_vertex
             msh%list_face(ia)%ic1=i-1+(j-1)*nx+(k-1)*nx*ny +bl%first_cell
             msh%list_face(ia)%ic2=i-0+(j-1)*nx+(k-1)*nx*ny +bl%first_cell
          end do
       end do
     end do


idebv=(nx+1)*(ny+1)*2 +bl%first_vertex
idebf=(nx-1)*ny+nx*(ny-1) +bl%first_face
idebc=nx*ny +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
blcl1=bl%cl(1)
if(blcl1.lt.-100000)blcl1=-blcl1-100000
if(blv(1)%idom.eq.0)then
   nxv=nx
   nyv=ny
   nzv=1
else
   nxv=blv(1)%nx*2**(blv(1)%nrb)
   nyv=blv(1)%ny*2**(blv(1)%nrb)
   nzv=1
endif
if(bl%nrf(1).le.0)then ! Dans le cas ou le bloc voisin est + grossier ou identique 
       ii=1
       if(bl%nrf(1).eq.-1)ii=2
          do j=1,ny
             ie=nxv
             je=1+int((j-1)/ii)
             ke=1
             nue=je+(ke-1)*nyv ! Numerotation exterieure
             nui=j             ! Numerotation interieure au bloc
             ia=idebf+nui
             msh%list_face(ia)%vertex(1)=(1+0)+(j+0-1)*(nx+1) +bl%first_vertex
             msh%list_face(ia)%vertex(2)=(1+0)+(j+1-1)*(nx+1) +bl%first_vertex
             msh%list_face(ia)%vertex(3)=(1+0)+(j+1-1)*(nx+1) + (nx+1)*(ny+1) +bl%first_vertex
             msh%list_face(ia)%vertex(4)=(1+0)+(j+0-1)*(nx+1) + (nx+1)*(ny+1) +bl%first_vertex
             msh%list_face(ia)%ic1=1+(j-1)*nx +bl%first_cell
             if(blcl1.le.0)then
               msh%list_face(ia)%ic2=blcl1
             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,blcl1,ipos_send,ipos_recv)
                  msh%list_send(blv(1)%idom)%L(nui+ipos_send)=1+(j-1)*nx +bl%first_cell 
                  msh%list_recv(blv(1)%idom)%L(nue+ipos_recv)=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.d0*ke+0.5d0,1)
                else
                  msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(1)%first_cell         !!!!! A VERIFIER PARTOUT
                endif
             endif
          end do

       idebf=idebf+ny
       if(blcl1.gt.0)then
           if(blv(1)%idom.ne.bl%idom)idebc=idebc+ny/ii 
       endif
         
       
else  ! Dans le cas ou le bloc voisin est + fin 
          is=idebv
 ! creation des noeuds aux milieux des aretes
          do j=1,ny
            do k=1,nz+1
              is=is+1
              msh%list_vertex(is)=pni(bl,1.d0,1.d0*j+0.5d0,1.d0*k,1)
            end do
          end do
! creation des faces    
   do j=1,ny
             ie=nxv
             je=2*j-1
             ke=1
             nue=je+(ke-1)*nyv ! Numerotation exterieure
             nui=j         ! Numerotation interieure au bloc
             ia=idebf+nue 
             msh%list_face(ia)%vertex(1)=(1+0)+(j+0-1)*(nx+1) +bl%first_vertex
             msh%list_face(ia)%vertex(4)=(1+0)+(j+0-1)*(nx+1) + (nx+1)*(ny+1) +bl%first_vertex
             msh%list_face(ia)%vertex(3)=idebv+2*j 
             msh%list_face(ia)%vertex(2)=idebv+2*j-1
             msh%list_face(ia)%ic1=1+(j-1)*nx +bl%first_cell
             if(blcl1.le.0)then
               msh%list_face(ia)%ic2=blcl1
             else
                if(blv(1)%idom.ne.bl%idom)then
                  call psr(interdom,nb_dom,bl%idom,blv(1)%idom,ib,blcl1,ipos_send,ipos_recv)
                  msh%list_send(blv(1)%idom)%L(nui+ipos_send)    = 1+(j-1)*nx +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.d0*ke+0.5d0,1)
                else
                   msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(1)%first_cell         
                endif
             endif
             
                 ie=nxv
                   je=2*j
                   ke=1
             nue=je+(ke-1)*nyv ! Numerotation exterieure
             ia=idebf+nue 
             msh%list_face(ia)%vertex(1)=idebv+2*j-1
             msh%list_face(ia)%vertex(4)=idebv+2*j
             msh%list_face(ia)%vertex(3)=(1+0)+(j+1-1)*(nx+1) + (nx+1)*(ny+1) +bl%first_vertex
             msh%list_face(ia)%vertex(2)=(1+0)+(j+1-1)*(nx+1) +bl%first_vertex
             msh%list_face(ia)%ic1=1+(j-1)*nx +bl%first_cell
             if(blcl1.le.0)then
               msh%list_face(ia)%ic2=blcl1
             else
                if(blv(1)%idom.ne.bl%idom)then
                  call psr(interdom,nb_dom,bl%idom,blv(1)%idom,ib,blcl1,ipos_send,ipos_recv)
                  msh%list_send(blv(1)%idom)%L(nui+ipos_send)    = 1+(j-1)*nx +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.d0*ke+0.5d0,1)
                else
                  msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(1)%first_cell         
                endif
             endif
             
        end do
       idebf=idebf+ny*2
       idebv=idebv+2*ny
       if(blcl1.gt.0)then
           if(blv(1)%idom.ne.bl%idom)idebc=idebc+ny*2  
       endif
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=ny
   nzv=1
else
   nxv=blv(2)%nx*2**(blv(2)%nrb)
   nyv=blv(2)%ny*2**(blv(2)%nrb)
   nzv=1
endif
if(bl%nrf(2).le.0)then ! Dans le cas ou le bloc voisin est - fin ou identique 
       ii=1
       if(bl%nrf(2).eq.-1)ii=2
          do j=1,ny
                     ie=1
                   je=1+int((j-1)/ii)
                   ke=1
             nue=je+(ke-1)*nyv ! Numerotation exterieure
             nui=j                    ! Numerotation interieure au bloc
             ia=idebf+nui
             msh%list_face(ia)%vertex(1)=(nx+1+0)+(j+0-1)*(nx+1) +bl%first_vertex
             msh%list_face(ia)%vertex(2)=(nx+1+0)+(j+0-1)*(nx+1) + (nx+1)*(ny+1)+bl%first_vertex
             msh%list_face(ia)%vertex(3)=(nx+1+0)+(j+1-1)*(nx+1) + (nx+1)*(ny+1)+bl%first_vertex
             msh%list_face(ia)%vertex(4)=(nx+1+0)+(j+1-1)*(nx+1) +bl%first_vertex
             msh%list_face(ia)%ic1=nx+(j-1)*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+(j-1)*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.d0*ke+0.5d0,1)
                        else
                  msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(2)%first_cell         
                        endif
             endif
          end do

       idebf=idebf+ny
       if(bl%cl(2).gt.0)then
           if(blv(2)%idom.ne.bl%idom)idebc=idebc+ny/ii
         endif
         
else ! Dans le cas ou le bloc voisin est + fin 
          is=idebv
! creation des noeuds aux milieux des aretes
          do j=1,ny
            do k=1,nz+1
              is=is+1
              msh%list_vertex(is)=pni(bl,1.d0*(nx+1),1.d0*j+0.5d0,1.d0*k,1)
            end do
          end do

! creation des faces
   do j=1,ny
                 ie=1
                   je=2*j-1
                   ke=1
             nue=je+(ke-1)*nyv ! Numerotation exterieure
             nui=j         ! Numerotation interieure au bloc
             nue=2*j-1     ! Numerotation exterieure
             ia=idebf+nue 
             msh%list_face(ia)%vertex(1)=(nx+1+0)+(j+0-1)*(nx+1) +bl%first_vertex
             msh%list_face(ia)%vertex(2)=(nx+1+0)+(j+0-1)*(nx+1) + (nx+1)*(ny+1) +bl%first_vertex
             msh%list_face(ia)%vertex(3)=idebv+2*j
             msh%list_face(ia)%vertex(4)=idebv+2*j-1
             msh%list_face(ia)%ic1=nx+(j-1)*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
                          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+(j-1)*nx +bl%first_cell
                  msh%list_recv(blv(2)%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(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.d0*ke+0.5d0,1)
                        else
                  msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(2)%first_cell         
                        endif
             endif

             ie=1
                   je=2*j-1+1
                   ke=1
             nue=je+(ke-1)*nyv ! Numerotation exterieure
             ia=idebf+nue 
             msh%list_face(ia)%vertex(1)=idebv+2*j-1
             msh%list_face(ia)%vertex(2)=idebv+2*j
             msh%list_face(ia)%vertex(3)=(nx+1+0)+(j+1-1)*(nx+1) + (nx+1)*(ny+1) +bl%first_vertex
             msh%list_face(ia)%vertex(4)=(nx+1+0)+(j+1-1)*(nx+1) +bl%first_vertex
             msh%list_face(ia)%ic1=nx+(j-1)*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
                          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+(j-1)*nx +bl%first_cell
                  msh%list_recv(blv(2)%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(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.d0*ke+0.5d0,1)
                        else
                  msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(2)%first_cell      
                        endif
             endif
       end do
         
       idebf=idebf+ny*2
       idebv=idebv+2*ny
       if(bl%cl(2).gt.0)then
           if(blv(2)%idom.ne.bl%idom)idebc=idebc+ny*2
         endif
endif
102 continue

! Construction de la liste des faces pour y=ymin 
! et des cellules du domaine voisin
!===========================================================================================
if(bl%idom.eq.blv(3)%idom.and.ib.lt.bl%cl(3))goto 103
if(blv(3)%idom.eq.0)then
   nxv=nx
   nyv=ny
   nzv=1
else
   nxv=blv(3)%nx*2**(blv(3)%nrb)
   nyv=blv(3)%ny*2**(blv(3)%nrb)
   nzv=1
endif
if(bl%nrf(3).le.0)then ! Dans le cas ou le bloc voisin est - fin ou identique 
       ii=1
       if(bl%nrf(3).eq.-1)ii=2
       do i=1,nx
                     ie=1+int((i-1)/ii)
                   je=nyv
                   ke=1
             nue=ie+(ke-1)*nxv ! 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(2)=(i+0)+(1+0-1)*(nx+1) + (nx+1)*(ny+1) +bl%first_vertex
             msh%list_face(ia)%vertex(3)=(i+1)+(1+0-1)*(nx+1) + (nx+1)*(ny+1) +bl%first_vertex
             msh%list_face(ia)%vertex(4)=(i+1)+(1+0-1)*(nx+1) +bl%first_vertex
             msh%list_face(ia)%ic1=i+(1-1)*nx +bl%first_cell
             if(bl%cl(3).le.0)then
               msh%list_face(ia)%ic2=bl%cl(3)
             else
                      if(blv(3)%idom.ne.bl%idom)then
                  msh%list_face(ia)%ic2=idebc+nue
                          call psr(interdom,nb_dom,bl%idom,blv(3)%idom,ib,bl%cl(3),ipos_send,ipos_recv)
                  msh%list_send(blv(3)%idom)%L(nui+ipos_send)=i+(1-1)*nx +bl%first_cell
                  msh%list_recv(blv(3)%idom)%L(nue+ipos_recv)=idebc+nue
                  msh%list_cell(idebc+nue)%num =idebc+nue
                  msh%list_cell(idebc+nue)%idom=blv(3)%idom        
                  vv= volcel(blv(3),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(3),1.d0*ie+0.5d0,1.d0*je+0.5d0,1.d0*ke+0.5d0,1)
                        else
                  msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(3)%first_cell         
                        endif
             endif
       end do
       idebf=idebf+nx
       if(bl%cl(3).gt.0)then
           if(blv(3)%idom.ne.bl%idom)idebc=idebc+nx/ii
         endif

else ! Dans le cas ou le bloc voisin est + fin 
          is=idebv
! creation des noeuds aux milieux des aretes
          do i=1,nx
            do k=1,nz+1
              is=is+1
               msh%list_vertex(is)=pni(bl,1.d0*i+0.5d0,1.d0,1.d0*k,1)
            end do
          end do
! creation des faces
   do i=1,nx
                 ie=2*i-1
                   je=nyv
                   ke=1
             nue=ie+(ke-1)*nxv ! Numerotation exterieure
             nui=i      ! Numerotation interieure au bloc
             ia=idebf+nue 
             msh%list_face(ia)%vertex(1)=(i+0)+(1+0-1)*(nx+1) +bl%first_vertex
             msh%list_face(ia)%vertex(2)=(i+0)+(1+0-1)*(nx+1) + (nx+1)*(ny+1) +bl%first_vertex
             msh%list_face(ia)%vertex(3)=idebv+2*i
             msh%list_face(ia)%vertex(4)=idebv+2*i-1
             msh%list_face(ia)%ic1=i+(1-1)*nx +bl%first_cell
             if(bl%cl(3).le.0)then
               msh%list_face(ia)%ic2=bl%cl(3)
             else
                      if(blv(3)%idom.ne.bl%idom)then
                          call psr(interdom,nb_dom,bl%idom,blv(3)%idom,ib,bl%cl(3),ipos_send,ipos_recv)
                  msh%list_send(blv(3)%idom)%L(nui+ipos_send)    = i+(1-1)*nx+bl%first_cell
                  msh%list_recv(blv(3)%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(3)%idom
                  vv= volcel(blv(3),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(3),1.d0*ie+0.5d0,1.d0*je+0.5d0,1.d0*ke+0.5d0,1)
                        else
                  msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(3)%first_cell         
                        endif
             endif

                 ie=2*i-1+1
                   je=nyv
                   ke=1
             nue=ie+(ke-1)*nxv ! Numerotation exterieure
             ia=idebf+nue 
             msh%list_face(ia)%vertex(1)=idebv+2*i-1
             msh%list_face(ia)%vertex(2)=idebv+2*i
             msh%list_face(ia)%vertex(3)=(i+1)+(1+0-1)*(nx+1) + (nx+1)*(ny+1) +bl%first_vertex
             msh%list_face(ia)%vertex(4)=(i+1)+(1+0-1)*(nx+1) +bl%first_vertex
             msh%list_face(ia)%ic1=i+(1-1)*nx +bl%first_cell
             if(bl%cl(3).le.0)then
               msh%list_face(ia)%ic2=bl%cl(3)
             else
                      if(blv(3)%idom.ne.bl%idom)then
                          call psr(interdom,nb_dom,bl%idom,blv(3)%idom,ib,bl%cl(3),ipos_send,ipos_recv)
                  msh%list_send(blv(3)%idom)%L(nui+ipos_send)    = i+(1-1)*nx+bl%first_cell
                  msh%list_recv(blv(3)%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(3)%idom
                 vv= volcel(blv(3),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(3),1.d0*ie+0.5d0,1.d0*je+0.5d0,1.d0*ke+0.5d0,1)
                        else
                  msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(3)%first_cell         
                        endif
             endif
       end do
         
       idebf=idebf+nx*2
       idebv=idebv+nx*2
       if(bl%cl(3).gt.0)then
           if(blv(3)%idom.ne.bl%idom)idebc=idebc+nx*2
         endif
endif

103  continue

!
! Construction de la liste des faces pour y=ymax 
!===========================================================================================
if(bl%idom.eq.blv(4)%idom.and.ib.lt.bl%cl(4))goto 104
if(blv(4)%idom.eq.0)then
   nxv=nx
   nyv=ny
   nzv=1
else
   nxv=blv(4)%nx*2**(blv(4)%nrb)
   nyv=blv(4)%ny*2**(blv(4)%nrb)
   nzv=1
endif
if(bl%nrf(4).le.0)then ! Dans le cas ou le bloc voisin est - fin ou identique 
       ii=1
       if(bl%nrf(4).eq.-1)ii=2
        do i=1,nx
                     ie=1+int((i-1)/ii)
                   je=1
                   ke=1
             nue=ie+(ke-1)*nxv ! Numerotation exterieure
             nui=i               ! Numerotation interieure au bloc
             ia=idebf+nui
             msh%list_face(ia)%vertex(1)=(i+0)+(ny+1-1)*(nx+1) +bl%first_vertex
             msh%list_face(ia)%vertex(2)=(i+1)+(ny+1-1)*(nx+1) +bl%first_vertex
             msh%list_face(ia)%vertex(3)=(i+1)+(ny+1-1)*(nx+1) + (nx+1)*(ny+1) +bl%first_vertex
             msh%list_face(ia)%vertex(4)=(i+0)+(ny+1-1)*(nx+1) + (nx+1)*(ny+1) +bl%first_vertex
             msh%list_face(ia)%ic1=i+(ny-1)*nx +bl%first_cell
             if(bl%cl(4).le.0)then
               msh%list_face(ia)%ic2=bl%cl(4)
             else
                      if(blv(4)%idom.ne.bl%idom)then
                  msh%list_face(ia)%ic2=idebc+nue
                          call psr(interdom,nb_dom,bl%idom,blv(4)%idom,ib,bl%cl(4),ipos_send,ipos_recv)
                  msh%list_send(blv(4)%idom)%L(nui+ipos_send)=i+(ny-1)*nx +bl%first_cell
                  msh%list_recv(blv(4)%idom)%L(nue+ipos_recv)=idebc+nue
                  msh%list_cell(idebc+nue)%num =idebc+nue
                  msh%list_cell(idebc+nue)%idom=blv(4)%idom        
                 vv= volcel(blv(4),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(4),1.d0*ie+0.5d0,1.d0*je+0.5d0,1.d0*ke+0.5d0,1)
                        else
                  msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(4)%first_cell         
                        endif
             endif
       end do
       idebf=idebf+nx
       if(bl%cl(4).gt.0)then
           if(blv(4)%idom.ne.bl%idom)idebc=idebc+nx/ii
         endif

     else ! Dans le cas ou le bloc voisin est + fin 
          is=idebv
! creation des noeuds aux milieux des aretes
          do i=1,nx
            do k=1,nz+1
              is=is+1
              msh%list_vertex(is)=pni(bl,1.d0*i+0.5d0,1.d0*(ny+1),1.d0*k,1)
            end do
          end do
! creation des faces
   do i=1,nx
                 ie=2*i-1
                   je=1
                   ke=1
             nue=ie+(ke-1)*nxv ! Numerotation exterieure
             nui=i         ! Numerotation interieure au bloc
             ia=idebf+nue 
             msh%list_face(ia)%vertex(1)=(i+0)+(ny+1+0-1)*(nx+1)  +bl%first_vertex
             msh%list_face(ia)%vertex(2)=idebv+2*i-1
             msh%list_face(ia)%vertex(3)=idebv+2*i
             msh%list_face(ia)%vertex(4)=(i+0)+(ny+1-1)*(nx+1) + (nx+1)*(ny+1)  +bl%first_vertex
             msh%list_face(ia)%ic1=i+(ny-1)*nx +bl%first_cell
             if(bl%cl(4).le.0)then
               msh%list_face(ia)%ic2=bl%cl(4)
             else
                      if(blv(4)%idom.ne.bl%idom)then
                          call psr(interdom,nb_dom,bl%idom,blv(4)%idom,ib,bl%cl(4),ipos_send,ipos_recv)
                  msh%list_send(blv(4)%idom)%L(nui+ipos_send)    = i+(ny-1)*nx +bl%first_cell
                  msh%list_recv(blv(4)%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(4)%idom
                  vv= volcel(blv(4),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(4),1.d0*ie+0.5d0,1.d0*je+0.5d0,1.d0*ke+0.5d0,1)
                        else
                  msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(4)%first_cell         
                        endif
             endif

                 ie=2*i-1+1
                   je=1
                   ke=1
             nue=ie+(ke-1)*nxv ! Numerotation exterieure
             ia=idebf+nue 
             msh%list_face(ia)%vertex(1)=idebv+2*i-1
             msh%list_face(ia)%vertex(2)=(i+1)+(ny+1+0-1)*(nx+1)  +bl%first_vertex
             msh%list_face(ia)%vertex(3)=(i+1)+(ny+1-1)*(nx+1) + (nx+1)*(ny+1)  +bl%first_vertex
             msh%list_face(ia)%vertex(4)=idebv+2*i
             msh%list_face(ia)%ic1=i+(ny-1)*nx +bl%first_cell
             if(bl%cl(4).le.0)then
               msh%list_face(ia)%ic2=bl%cl(4)
             else
                      if(blv(4)%idom.ne.bl%idom)then
                          call psr(interdom,nb_dom,bl%idom,blv(4)%idom,ib,bl%cl(4),ipos_send,ipos_recv)
                  msh%list_send(blv(4)%idom)%L(nui+ipos_send)    = i+(ny-1)*nx +bl%first_cell
                  msh%list_recv(blv(4)%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(4)%idom
                   vv= volcel(blv(4),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(4),1.d0*ie+0.5d0,1.d0*je+0.5d0,1.d0*ke+0.5d0,1)
                        else
                  msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(4)%first_cell         
                        endif
             endif
       end do
         
       idebf=idebf+nx*2
       idebv=idebv+2*nx
       if(bl%cl(4).gt.0)then
           if(blv(4)%idom.ne.bl%idom)idebc=idebc+nx*nz*2
         endif
endif

104 continue

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

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


return
!
!===========================   FIN DE LA ROUTINE    ====================
END SUBROUTINE MESH2D
!DOCFIN