 SUBROUTINE MESH3D(bl,msh,ib,nb_dom,blv,interdom)
!=========================== DOCUMENTATION ============================= 
!DOCDEBh*    GEO/MESH3D  *
!
!    NOM
! MESH3D(bl,msh,ib,nb_dom,blv,interdom)
!    DESCRIPTION  
!*
!      Maillage regulier d un bloc hexaedrique en 3D
!
!      Regular mesh of a hexahedral block in 3D
!*
! 
!    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,volcel,pni
  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
  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=bl%nz*2**(bl%nrb)


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

! construction de la liste des faces interieures paralleles au plan x y
     do k=2,nz
       do i=1,nx
          do j=1,ny
             ia=ia+1 
             msh%list_face(ia)%vertex(1)=(i+0)+(j+0-1)*(nx+1) + (nx+1)*(ny+1)*(k-1) +bl%first_vertex
             msh%list_face(ia)%vertex(4)=(i+1)+(j+0-1)*(nx+1) + (nx+1)*(ny+1)*(k-1) +bl%first_vertex
             msh%list_face(ia)%vertex(3)=(i+1)+(j+1-1)*(nx+1) + (nx+1)*(ny+1)*(k-1) +bl%first_vertex
             msh%list_face(ia)%vertex(2)=(i+0)+(j+1-1)*(nx+1) + (nx+1)*(ny+1)*(k-1) +bl%first_vertex
             msh%list_face(ia)%ic1=i+(j-1)*nx+(k-2)*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 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)*(nz+1) +bl%first_vertex
idebf=(nx-1)*ny*nz+nx*(ny-1)*nz+nx*ny*(nz-1) +bl%first_face
idebc=nx*ny*nz +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=ny
   nzv=nz
else
   nxv=blv(1)%nx*2**(blv(1)%nrb)
   nyv=blv(1)%ny*2**(blv(1)%nrb)
   nzv=blv(1)%nz*2**(blv(1)%nrb)
endif
if(bl%nrf(1).le.0)then ! Dans le cas ou le bloc voisin est - fin ou identique 
    ii=1
    if(bl%nrf(1).eq.-1)ii=2
    do k=1,nz
       do j=1,ny
           
          ie=nxv
          je=1+int((j-1)/ii)
          ke=1+int((k-1)/ii)
          nue=je+(ke-1)*nyv ! Numerotation exterieure
          nui=j +(k-1)*ny   ! Numerotation interieure au bloc
          ia=idebf+nui
          msh%list_face(ia)%vertex(1)=(1+0)+(j+0-1)*(nx+1) + (nx+1)*(ny+1)*(k+0-1) +bl%first_vertex
          msh%list_face(ia)%vertex(2)=(1+0)+(j+1-1)*(nx+1) + (nx+1)*(ny+1)*(k+0-1) +bl%first_vertex
          msh%list_face(ia)%vertex(3)=(1+0)+(j+1-1)*(nx+1) + (nx+1)*(ny+1)*(k+1-1) +bl%first_vertex
          msh%list_face(ia)%vertex(4)=(1+0)+(j+0-1)*(nx+1) + (nx+1)*(ny+1)*(k+1-1) +bl%first_vertex
          msh%list_face(ia)%ic1=1+(j-1)*nx+(k-1)*nx*ny +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+(j-1)*nx+(k-1)*nx*ny+ 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,0)
               msh%list_cell(idebc+nue)%vol = vv
               !msh%list_cell(idebc+nue)%h =1.d0/(2.d0*hy*hz*ii*ii/vv+2.d0/hy/ii+2.d0/hz/ii)    
               msh%list_cell(idebc+nue)%center = pni(blv(1),1.d0*ie+0.5d0,1.d0*je+0.5d0,1.d0*ke+0.5d0,0)
             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
    end do
    idebf=idebf+ny*nz
    if(bl%cl(1).gt.0)then
      if(blv(1)%idom.ne.bl%idom)idebc=idebc+ny*nz/ii/ii
    endif
    
else  ! Dans le cas ou le bloc voisin est + fin 
! creation des noeuds centre des "grosses faces"
    is=idebv
    do j=1,ny
      do k=1,nz
        is=is+1
        msh%list_vertex(is)=pni(bl,1.d0,1.d0*j+0.5d0,1.d0*k+0.5d0,0)
      end do
    end do
! 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,0)
      end do
    end do
    do k=1,nz
      do j=1,ny+1
        is=is+1
        msh%list_vertex(is)=pni(bl,1.d0,1.d0*j,1.d0*k+0.5d0,0)
      end do
    end do
! creation des faces
    do j=1,ny
      do k=1,nz
        ie=nxv
        je=2*j-1
        ke=2*k-1
        nui=j +(k-1) *ny  ! Numerotation interieure au bloc
        nue=je+(ke-1)*nyv ! Numerotation exterieure
        ia=idebf+nue 
        msh%list_face(ia)%vertex(1)=(1+0)+(j+0-1)*(nx+1) + (nx+1)*(ny+1)*(k+0-1) +bl%first_vertex
        msh%list_face(ia)%vertex(2)=idebv+ny*nz+(j-1)*(nz+1)+k 
        msh%list_face(ia)%vertex(3)=idebv+(j-1)*nz+k 
        msh%list_face(ia)%vertex(4)=idebv+ny*nz+ny*(nz+1)+(k-1)*(ny+1)+j 
        msh%list_face(ia)%ic1=1+(j-1)*nx+(k-1)*nx*ny +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
             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+(j-1)*nx+(k-1)*nx*ny +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,0)
             msh%list_cell(idebc+nue)%vol      = vv    
             !msh%list_cell(idebc+nue)%h        = 2.d0/(hy*hz/4./blv(1)%volc+2.d0/hy+2.d0/hz)    
             msh%list_cell(idebc+nue)%center = pni(blv(1),1.d0*ie+0.5d0,1.d0*je+0.5d0,1.d0*ke+0.5d0,0)
          else
             msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(1)%first_cell         !!!!! A VERIFIER PARTOUT
          endif
        endif
             
        ie=nxv
        je=2*j-1+1
        ke=2*k-1
        nue=je+(ke-1)*nyv ! Numerotation exterieure
        ia=idebf+nue 
        msh%list_face(ia)%vertex(1)=idebv+ny*nz+(j-1)*(nz+1)+k
        msh%list_face(ia)%vertex(2)=(1+0)+(j+1-1)*(nx+1) + (nx+1)*(ny+1)*(k+0-1)+ bl%first_vertex
        msh%list_face(ia)%vertex(3)=idebv+ny*nz+ny*(nz+1)+(k-1)*(ny+1)+j+1
        msh%list_face(ia)%vertex(4)=idebv+(j-1)*nz+k
        msh%list_face(ia)%ic1=1+(j-1)*nx+(k-1)*nx*ny +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
             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+(j-1)*nx+(k-1)*nx*ny+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,0)
             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,0)
          else
             msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(1)%first_cell         !!!!! A VERIFIER PARTOUT
          endif
        endif
       
        ie=nxv
        je=2*j-1
        ke=2*k-1+1
        nue=je+(ke-1)*nyv ! Numerotation exterieure
        ia=idebf+nue 
        msh%list_face(ia)%vertex(1)=idebv+ny*nz+ny*(nz+1)+(k-1)*(ny+1)+j
        msh%list_face(ia)%vertex(2)=idebv+(j-1)*nz+k
        msh%list_face(ia)%vertex(3)=idebv+ny*nz+(j-1)*(nz+1)+k+1
        msh%list_face(ia)%vertex(4)=(1+0)+(j+0-1)*(nx+1) + (nx+1)*(ny+1)*(k+1-1) +bl%first_vertex
        msh%list_face(ia)%ic1=1+(j-1)*nx+(k-1)*nx*ny +bl%first_cell
        msh%list_face(ia)%ic2=bl%cl(1)
        if(bl%cl(1).le.0)then
          msh%list_face(ia)%ic2=bl%cl(1)
        else
          if(blv(1)%idom.ne.bl%idom)then
            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+(j-1)*nx+(k-1)*nx*ny +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,0)
            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,0)
          else
            msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(1)%first_cell         !!!!! A VERIFIER PARTOUT
          endif
        endif
       
        ie=nxv
        je=2*j-1+1
        ke=2*k-1+1
        nue=je+(ke-1)*nyv ! Numerotation exterieure
        ia=idebf+nue 
        msh%list_face(ia)%vertex(1)=idebv+(j-1)*nz+k
        msh%list_face(ia)%vertex(2)=idebv+ny*nz+ny*(nz+1)+(k-1)*(ny+1)+j+1
        msh%list_face(ia)%vertex(3)=(1+0)+(j+1-1)*(nx+1) + (nx+1)*(ny+1)*(k+1-1) +bl%first_vertex
        msh%list_face(ia)%vertex(4)=idebv+ny*nz+(j-1)*(nz+1)+k+1
        msh%list_face(ia)%ic1=1+(j-1)*nx+(k-1)*nx*ny +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
            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+(j-1)*nx+(k-1)*nx*ny +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,0)
            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,0)
          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
  end do
  idebf=idebf+ny*nz*4
  idebv=idebv+ny*(nz+1)+(ny+1)*nz+ny*nz
  if(bl%cl(1).gt.0)then
    if(blv(1)%idom.ne.bl%idom)idebc=idebc+ny*nz*4
  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=nz
else
   nxv=blv(2)%nx*2**(blv(2)%nrb)
   nyv=blv(2)%ny*2**(blv(2)%nrb)
   nzv=blv(2)%nz*2**(blv(2)%nrb)
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 k=1,nz
    do j=1,ny
        ie=1
        je=1+int((j-1)/ii)
        ke=1+int((k-1)/ii)
        nue=je+(ke-1)*nyv ! Numerotation exterieure
        nui=j+(k-1)*ny                          ! Numerotation interieure au bloc
        ia=idebf+nui
        msh%list_face(ia)%vertex(1)=(nx+1+0)+(j+0-1)*(nx+1) + (nx+1)*(ny+1)*(k+0-1) +bl%first_vertex
        msh%list_face(ia)%vertex(4)=(nx+1+0)+(j+1-1)*(nx+1) + (nx+1)*(ny+1)*(k+0-1) +bl%first_vertex
        msh%list_face(ia)%vertex(3)=(nx+1+0)+(j+1-1)*(nx+1) + (nx+1)*(ny+1)*(k+1-1) +bl%first_vertex
        msh%list_face(ia)%vertex(2)=(nx+1+0)+(j+0-1)*(nx+1) + (nx+1)*(ny+1)*(k+1-1) +bl%first_vertex
        msh%list_face(ia)%ic1=nx+(j-1)*nx+(k-1)*nx*ny +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_face(ia)%ic2=idebc+nue
            msh%list_send(blv(2)%idom)%L(nui+ipos_send)=nx+(j-1)*nx+(k-1)*nx*ny +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,0)
            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,0)
          else
             msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(2)%first_cell         !!!!! A VERIFIER PARTOUT
          endif
        endif
    end do
  end do
  idebf=idebf+ny*nz
  if(bl%cl(2).gt.0)then
      if(blv(2)%idom.ne.bl%idom)idebc=idebc+ny*nz/ii/ii
    endif
else ! Dans le cas ou le bloc voisin est + fin 
! creation des noeuds centre des "grosses faces"
  is=idebv
  do j=1,ny
    do k=1,nz
      is=is+1
      msh%list_vertex(is)=pni(bl,1.d0*(nx+1),1.d0*j+0.5d0,1.d0*k+0.5d0,0)
    end do
  end do
! 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,0)
    end do
  end do
  do k=1,nz
    do j=1,ny+1
      is=is+1
      msh%list_vertex(is)=pni(bl,1.d0*(nx+1),1.d0*j,1.d0*k+0.5d0,0)
    end do
  end do
! creation des faces
  do j=1,ny
    do k=1,nz
              
      ie=1
      je=2*j-1
      ke=2*k-1
      nui=j +(k-1) *ny  ! Numerotation interieure au bloc
      nue=je+(ke-1)*nyv ! Numerotation exterieure
      ia=idebf+nue 
      msh%list_face(ia)%vertex(1)=(nx+1+0)+(j+0-1)*(nx+1) + (nx+1)*(ny+1)*(k+0-1) +bl%first_vertex
      msh%list_face(ia)%vertex(4)=idebv+ny*nz+(j-1)*(nz+1)+k
      msh%list_face(ia)%vertex(3)=idebv+(j-1)*nz+k
      msh%list_face(ia)%vertex(2)=idebv+ny*nz+ny*(nz+1)+(k-1)*(ny+1)+j
      msh%list_face(ia)%ic1=nx+(j-1)*nx+(k-1)*nx*ny +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+(k-1)*nx*ny +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,0)
           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,0)
        else
           msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(2)%first_cell         !!!!! A VERIFIER PARTOUT
        endif
      endif

      ie=1
      je=2*j-1+1
      ke=2*k-1
      nue=je+(ke-1)*nyv ! Numerotation exterieure
      ia=idebf+nue 
      msh%list_face(ia)%vertex(1)=idebv+ny*nz+(j-1)*(nz+1)+k
      msh%list_face(ia)%vertex(4)=(nx+1+0)+(j+1-1)*(nx+1) + (nx+1)*(ny+1)*(k+0-1) +bl%first_vertex
      msh%list_face(ia)%vertex(3)=idebv+ny*nz+ny*(nz+1)+(k-1)*(ny+1)+j+1
      msh%list_face(ia)%vertex(2)=idebv+(j-1)*nz+k
      msh%list_face(ia)%ic1=nx+(j-1)*nx+(k-1)*nx*ny +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+(k-1)*nx*ny +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,0)
           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,0)
        else
           msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(2)%first_cell         !!!!! A VERIFIER PARTOUT
        endif
      endif

      ie=1
      je=2*j-1
      ke=2*k-1+1
      nue=je+(ke-1)*nyv ! Numerotation exterieure
      ia=idebf+nue 
      msh%list_face(ia)%vertex(1)=idebv+ny*nz+ny*(nz+1)+(k-1)*(ny+1)+j
      msh%list_face(ia)%vertex(4)=idebv+(j-1)*nz+k
      msh%list_face(ia)%vertex(3)=idebv+ny*nz+(j-1)*(nz+1)+k+1
      msh%list_face(ia)%vertex(2)=(nx+1+0)+(j+0-1)*(nx+1) + (nx+1)*(ny+1)*(k+1-1) +bl%first_vertex
      msh%list_face(ia)%ic1=nx+(j-1)*nx+(k-1)*nx*ny +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+(k-1)*nx*ny +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,0)
           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,0)
        else
           msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(2)%first_cell         !!!!! A VERIFIER PARTOUT
        endif
      endif

      ie=1
      je=2*j-1+1
      ke=2*k-1+1
      nue=je+(ke-1)*nyv ! Numerotation exterieure
      ia=idebf+nue 
      msh%list_face(ia)%vertex(1)=idebv+(j-1)*nz+k
      msh%list_face(ia)%vertex(4)=idebv+ny*nz+ny*(nz+1)+(k-1)*(ny+1)+j+1
      msh%list_face(ia)%vertex(3)=(nx+1+0)+(j+1-1)*(nx+1) + (nx+1)*(ny+1)*(k+1-1) +bl%first_vertex
      msh%list_face(ia)%vertex(2)=idebv+ny*nz+(j-1)*(nz+1)+k+1
      msh%list_face(ia)%ic1=nx+(j-1)*nx+(k-1)*nx*ny +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+(k-1)*nx*ny +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,0)
           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,0)
        else
           msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(2)%first_cell         !!!!! A VERIFIER PARTOUT
        endif
      endif
    end do
  end do
  idebf=idebf+ny*nz*4
  idebv=idebv+ny*(nz+1)+(ny+1)*nz+ny*nz
  if(bl%cl(2).gt.0)then
    if(blv(2)%idom.ne.bl%idom)idebc=idebc+ny*nz*4
  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=nz
else
   nxv=blv(3)%nx*2**(blv(3)%nrb)
   nyv=blv(3)%ny*2**(blv(3)%nrb)
   nzv=blv(3)%nz*2**(blv(3)%nrb)
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
    do k=1,nz
       ie=1+int((i-1)/ii)
       je=nyv
       ke=1+int((k-1)/ii)
       nue=ie+(ke-1)*nxv ! Numerotation exterieure
       nui=i+(k-1)*nx                          ! Numerotation interieure au bloc
       ia=idebf+nui                   
       msh%list_face(ia)%vertex(1)=(i+0)+(1+0-1)*(nx+1) + (nx+1)*(ny+1)*(k+0-1) +bl%first_vertex
       msh%list_face(ia)%vertex(4)=(i+1)+(1+0-1)*(nx+1) + (nx+1)*(ny+1)*(k+0-1) +bl%first_vertex
       msh%list_face(ia)%vertex(3)=(i+1)+(1+0-1)*(nx+1) + (nx+1)*(ny+1)*(k+1-1) +bl%first_vertex
       msh%list_face(ia)%vertex(2)=(i+0)+(1+0-1)*(nx+1) + (nx+1)*(ny+1)*(k+1-1) +bl%first_vertex
       msh%list_face(ia)%ic1=i+(1-1)*nx+(k-1)*nx*ny +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_face(ia)%ic2=idebc+nue
             msh%list_send(blv(3)%idom)%L(nui+ipos_send)=i+(1-1)*nx+(k-1)*nx*ny +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,0)
             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,0)
          else
             msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(3)%first_cell         
          endif
       endif
    end do
  end do
  idebf=idebf+nz*nx
  if(bl%cl(3).gt.0)then
      if(blv(3)%idom.ne.bl%idom)idebc=idebc+nx*nz/ii/ii
  endif

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

     else ! Dans le cas ou le bloc voisin est + fin 
! creation des noeuds centre des "grosses faces"
          is=idebv
          do i=1,nx
            do k=1,nz
              is=is+1
              msh%list_vertex(is)=pni(bl,1.d0*i+0.5d0,1.d0*(ny+1),1.d0*k+0.5d0,0)
            end do
          end do
! 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,0)
            end do
          end do
          do k=1,nz
            do i=1,nx+1
              is=is+1
              msh%list_vertex(is)=pni(bl,1.d0*i,1.d0*(ny+1),1.d0*k+0.5d0,0)
            end do
          end do
! creation des faces
   do i=1,nx
          do k=1,nz
                 ie=2*i-1
                   je=1
                   ke=2*k-1
             nue=ie+(ke-1)*nxv ! Numerotation exterieure
             nui=i+(k-1)*nx         ! Numerotation interieure au bloc
             ia=idebf+nue 
             msh%list_face(ia)%vertex(1)=(i+0)+(ny+1+0-1)*(nx+1) + (nx+1)*(ny+1)*(k+0-1) +bl%first_vertex
             msh%list_face(ia)%vertex(4)=idebv+nx*nz+nx*(nz+1)+(k-1)*(nx+1)+i
             msh%list_face(ia)%vertex(3)=idebv+(i-1)*nz+k
             msh%list_face(ia)%vertex(2)=idebv+nx*nz+(i-1)*(nz+1)+k
             msh%list_face(ia)%ic1=i+(ny-1)*nx+(k-1)*nx*ny +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+(k-1)*nx*ny +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,0)
                  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,0)
                        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=2*k-1
             nue=ie+(ke-1)*nxv ! Numerotation exterieure
             ia=idebf+nue 
             msh%list_face(ia)%vertex(1)=idebv+nx*nz+(i-1)*(nz+1)+k
             msh%list_face(ia)%vertex(4)=idebv+(i-1)*nz+k
             msh%list_face(ia)%vertex(3)=idebv+nx*nz+nx*(nz+1)+(k-1)*(nx+1)+i+1
             msh%list_face(ia)%vertex(2)=(i+1)+(ny+1+0-1)*(nx+1) + (nx+1)*(ny+1)*(k+0-1) +bl%first_vertex
             msh%list_face(ia)%ic1=i+(ny-1)*nx+(k-1)*nx*ny +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+(k-1)*nx*ny +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,0)
                  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,0)
                        else
                  msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(4)%first_cell         
                        endif
             endif

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

! Construction de la liste des faces pour z=zmin 
!===========================================================================================

if(bl%idom.eq.blv(5)%idom.and.ib.lt.bl%cl(5))goto 105
if(blv(5)%idom.eq.0)then
   nxv=nx
   nyv=ny
   nzv=nz
else
   nxv=blv(5)%nx*2**(blv(5)%nrb)
   nyv=blv(5)%ny*2**(blv(5)%nrb)
   nzv=blv(5)%nz*2**(blv(5)%nrb)
endif

if(bl%nrf(5).le.0)then ! Dans le cas ou le bloc voisin est - fin ou identique 
       ii=1
       if(bl%nrf(5).eq.-1)ii=2
       do i=1,nx
          do j=1,ny
             ie=1+int((i-1)/ii)
                   je=1+int((j-1)/ii)
                   ke=nzv
             nue=ie+(je-1)*nxv ! 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
             if(bl%cl(5).le.0)then
               msh%list_face(ia)%ic2=bl%cl(5)
             else
                      if(blv(5)%idom.ne.bl%idom)then
                          call psr(interdom,nb_dom,bl%idom,blv(5)%idom,ib,bl%cl(5),ipos_send,ipos_recv)
                  msh%list_face(ia)%ic2=idebc+nue
                  msh%list_send(blv(5)%idom)%L(nui+ipos_send)=i+(j-1)*nx+(1-1)*nx*ny +bl%first_cell
                  msh%list_recv(blv(5)%idom)%L(nue+ipos_recv)=idebc+nue
                  msh%list_cell(idebc+nue)%num =idebc+nue
                  msh%list_cell(idebc+nue)%idom     = blv(5)%idom        
                  vv= volcel(blv(5),1.d0*ie,1.d0*je,1.d0*ke,0)
                  msh%list_cell(idebc+nue)%vol = vv
                  msh%list_cell(idebc+nue)%center = pni(blv(5),1.d0*ie+0.5d0,1.d0*je+0.5d0,1.d0*ke+0.5d0,0)
                        else
                  msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(5)%first_cell         
                        endif
             endif
          end do
       end do
       idebf=idebf+nx*ny
       if(bl%cl(5).gt.0)then
           if(blv(5)%idom.ne.bl%idom)idebc=idebc+nx*ny/ii/ii
         endif

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

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

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

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

! Construction de la liste des faces pour z=zmax 
!===========================================================================================
if(bl%idom.eq.blv(6)%idom.and.ib.lt.bl%cl(6))goto 106
if(blv(6)%idom.eq.0)then
   nxv=nx
   nyv=ny
   nzv=nz
else
   nxv=blv(6)%nx*2**(blv(6)%nrb)
   nyv=blv(6)%ny*2**(blv(6)%nrb)
   nzv=blv(6)%nz*2**(blv(6)%nrb)
endif

if(bl%nrf(6).le.0)then ! Dans le cas ou le bloc voisin est - fin ou identique 

       ii=1
       if(bl%nrf(6).eq.-1)ii=2
       do i=1,nx
          do j=1,ny
             ie=1+int((i-1)/ii)
                   je=1+int((j-1)/ii)
                   ke=1
             nue=ie+(je-1)*nxv ! 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
             if(bl%cl(6).le.0)then
               msh%list_face(ia)%ic2=bl%cl(6)
             else
                      if(blv(6)%idom.ne.bl%idom)then
                          call psr(interdom,nb_dom,bl%idom,blv(6)%idom,ib,bl%cl(6),ipos_send,ipos_recv)
                  msh%list_face(ia)%ic2=idebc+nue
                  msh%list_send(blv(6)%idom)%L(nui+ipos_send)=i+(j-1)*nx+(nz-1)*nx*ny +bl%first_cell
                  msh%list_recv(blv(6)%idom)%L(nue+ipos_recv)=idebc+nue
                  msh%list_cell(idebc+nue)%num =idebc+nue
                  msh%list_cell(idebc+nue)%idom     = blv(6)%idom        
                  vv= volcel(blv(6),1.d0*ie,1.d0*je,1.d0*ke,0)
                  msh%list_cell(idebc+nue)%vol = vv
                  msh%list_cell(idebc+nue)%center = pni(blv(6),1.d0*ie+0.5d0,1.d0*je+0.5d0,1.d0*ke+0.5d0,0)
                        else
                  msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(6)%first_cell         
                        endif
             endif
          end do
       end do
       idebf=idebf+nx*ny
       if(bl%cl(6).gt.0)then
           if(blv(6)%idom.ne.bl%idom)idebc=idebc+nx*ny/ii/ii
         endif

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

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

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

             ie=2*i-1+1
                   je=2*j-1+1
                   ke=1
             nue=ie+(je-1)*nxv ! Numerotation exterieure
             ia=idebf+nue 
             msh%list_face(ia)%vertex(1)=idebv+(i-1)*ny+j
             msh%list_face(ia)%vertex(4)=idebv+nx*ny+nx*(ny+1)+(j-1)*(nx+1)+i+1
             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)=idebv+nx*ny+(i-1)*(ny+1)+j+1
             msh%list_face(ia)%ic1=i+(j-1)*nx+(nz-1)*nx*ny +bl%first_cell
             if(bl%cl(6).le.0)then
               msh%list_face(ia)%ic2=bl%cl(6)
             else
                      if(blv(6)%idom.ne.bl%idom)then
                          call psr(interdom,nb_dom,bl%idom,blv(6)%idom,ib,bl%cl(6),ipos_send,ipos_recv)
                  msh%list_send(blv(6)%idom)%L(nui+ipos_send)    = i+(j-1)*nx+(nz-1)*nx*ny +bl%first_cell
                  msh%list_recv(blv(6)%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(6)%idom
                  vv= volcel(blv(6),1.d0*ie,1.d0*je,1.d0*ke,0)
                  msh%list_cell(idebc+nue)%vol = vv
                  msh%list_cell(idebc+nue)%center = pni(blv(6),1.d0*ie+0.5d0,1.d0*je+0.5d0,1.d0*ke+0.5d0,0)
                        else
                  msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(6)%first_cell         
                        endif
             endif
          end do
       end do
       idebf=idebf+nx*ny*4
       idebv=idebv+nx*(ny+1)+(nx+1)*ny+nx*ny
       if(bl%cl(6).gt.0)then
           if(blv(6)%idom.ne.bl%idom)idebc=idebc+ny*nx*4
         endif
endif
106    continue
    
!
!===========================   FIN DE LA ROUTINE    ====================
END SUBROUTINE MESH3D
!DOCFIN