mesh3d.f90

### TABLE OF CONTENTS

- 1. GEO/MESH3D

## GEO/MESH3D [ Modules ]

[ Top ] [ Modules ]

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