mesh2d.f90

### TABLE OF CONTENTS

- 1. GEO/MESH2D

## GEO/MESH2D [ Modules ]

[ Top ] [ Modules ]

NOM

     MESH2D(bl,msh,ib,nb_dom,blv,interdom)

DESCRIPTION

          Maillage regulier d un bloc hexaedrique en 2D

          Regular mesh of a hexahedral block in 2D

        ENTREES / INPUT
          bl       : Bloc a mailler et a ajouter au maillage msh / Block to be meshed and added to the msh mesh
          blv      : Blocs voisins (1 a 6) a modifier / Neighbouring blocks to be modified
          ib       : Numero du bloc a ajouter / number of the block to be added
          nb_dom   : nombre de domaines / number of domains
          msh      : maillage / mesh
          interdom : Table de localisation de l interface des domaines / Domain interface location table

        SORTIES / OUTPUT
          msh      : maillage / mesh

SOURCE

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

           real(kind=kind(0.d0))                        :: vv
           integer                                      :: nx,ny,nz,i,j,k,is,ia,idebv,idebf,blcl1
           integer                                      :: ii,idebc,nui,nue,ipos_send,ipos_recv
           integer                                      :: ie,je,ke,nxv,nyv,nzv
    !=========================== DEBUT DU CODE EXECUTABLE ==================
    !
           nx=bl%nx*2**(bl%nrb)
           ny=bl%ny*2**(bl%nrb)
           nz=1

    ! construction de la liste des sommets
           do i=1,nx+1
              do j=1,ny+1
                do k=1,nz+1
                  is=i+(nx+1)*(j-1)+(nx+1)*(ny+1)*(k-1)+bl%first_vertex
                  msh%list_vertex(is)=pni(bl,i*1.d0,j*1.d0,k*1.d0,1)
                end do
              end do
           end do

    ! construction de la liste des cellules

           do i=1,nx
              do j=1,ny
                do k=1,nz
                   is=i+(j-1)*nx+nx*ny*(k-1)+bl%first_cell
                   msh%list_cell(is)%num = is
                   msh%list_cell(is)%idom= bl%idom
                   msh%list_cell(is)%center=pni(bl,i*1.d0+0.5d0,j*1.d0+0.5d0,k*1.d0+0.5d0,1)  !!!!!!!!!$$$$$!!!!!!!$$$$$
                   msh%list_cell(is)%vol=volcel(bl,i*1.d0,j*1.d0,k*1.d0,1)                    !!!!!!!!!$$$$$!!!!!!!$$$$$
                 end do
              end do
           end do

         msh%list_face(:)%nbvertex=4

    ia=bl%first_face

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

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

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

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

    if(bl%idom.eq.blv(1)%idom.and.ib.lt.bl%cl(1))goto 101
    blcl1=bl%cl(1)
    if(blcl1.lt.-100000)blcl1=-blcl1-100000
    if(blv(1)%idom.eq.0)then
       nxv=nx
       nyv=ny
       nzv=1
    else
       nxv=blv(1)%nx*2**(blv(1)%nrb)
       nyv=blv(1)%ny*2**(blv(1)%nrb)
       nzv=1
    endif
    if(bl%nrf(1).le.0)then ! Dans le cas ou le bloc voisin est + grossier ou identique
           ii=1
           if(bl%nrf(1).eq.-1)ii=2
              do j=1,ny
                 ie=nxv
                 je=1+int((j-1)/ii)
                 ke=1
                 nue=je+(ke-1)*nyv ! Numerotation exterieure
                 nui=j             ! Numerotation interieure au bloc
                 ia=idebf+nui
                 msh%list_face(ia)%vertex(1)=(1+0)+(j+0-1)*(nx+1) +bl%first_vertex
                 msh%list_face(ia)%vertex(2)=(1+0)+(j+1-1)*(nx+1) +bl%first_vertex
                 msh%list_face(ia)%vertex(3)=(1+0)+(j+1-1)*(nx+1) + (nx+1)*(ny+1) +bl%first_vertex
                 msh%list_face(ia)%vertex(4)=(1+0)+(j+0-1)*(nx+1) + (nx+1)*(ny+1) +bl%first_vertex
                 msh%list_face(ia)%ic1=1+(j-1)*nx +bl%first_cell
                 if(blcl1.le.0)then
                   msh%list_face(ia)%ic2=blcl1
                 else
                    if(blv(1)%idom.ne.bl%idom)then
                      msh%list_face(ia)%ic2=idebc+nue
                      call psr(interdom,nb_dom,bl%idom,blv(1)%idom,ib,blcl1,ipos_send,ipos_recv)
                      msh%list_send(blv(1)%idom)%L(nui+ipos_send)=1+(j-1)*nx +bl%first_cell
                      msh%list_recv(blv(1)%idom)%L(nue+ipos_recv)=idebc+nue
                      msh%list_cell(idebc+nue)%num =idebc+nue
                      msh%list_cell(idebc+nue)%idom=blv(1)%idom

                      vv= volcel(blv(1),1.d0*ie,1.d0*je,1.d0*ke,1)
                      msh%list_cell(idebc+nue)%vol = vv
                      msh%list_cell(idebc+nue)%center = pni(blv(1),1.d0*ie+0.5d0,1.d0*je+0.5d0,1.d0*ke+0.5d0,1)
                    else
                      msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(1)%first_cell         !!!!! A VERIFIER PARTOUT
                    endif
                 endif
              end do

           idebf=idebf+ny
           if(blcl1.gt.0)then
               if(blv(1)%idom.ne.bl%idom)idebc=idebc+ny/ii
           endif

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

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

            end do
           idebf=idebf+ny*2
           idebv=idebv+2*ny
           if(blcl1.gt.0)then
               if(blv(1)%idom.ne.bl%idom)idebc=idebc+ny*2
           endif
    endif

    101 continue
    !
    ! Construction de la liste des faces pour x=xmax
    ! et des cellules du domaine voisin
    !===========================================================================================
    if(bl%idom.eq.blv(2)%idom.and.ib.lt.bl%cl(2))goto 102
    if(blv(2)%idom.eq.0)then
       nxv=nx
       nyv=ny
       nzv=1
    else
       nxv=blv(2)%nx*2**(blv(2)%nrb)
       nyv=blv(2)%ny*2**(blv(2)%nrb)
       nzv=1
    endif
    if(bl%nrf(2).le.0)then ! Dans le cas ou le bloc voisin est - fin ou identique
           ii=1
           if(bl%nrf(2).eq.-1)ii=2
              do j=1,ny
                         ie=1
                       je=1+int((j-1)/ii)
                       ke=1
                 nue=je+(ke-1)*nyv ! Numerotation exterieure
                 nui=j                    ! Numerotation interieure au bloc
                 ia=idebf+nui
                 msh%list_face(ia)%vertex(1)=(nx+1+0)+(j+0-1)*(nx+1) +bl%first_vertex
                 msh%list_face(ia)%vertex(2)=(nx+1+0)+(j+0-1)*(nx+1) + (nx+1)*(ny+1)+bl%first_vertex
                 msh%list_face(ia)%vertex(3)=(nx+1+0)+(j+1-1)*(nx+1) + (nx+1)*(ny+1)+bl%first_vertex
                 msh%list_face(ia)%vertex(4)=(nx+1+0)+(j+1-1)*(nx+1) +bl%first_vertex
                 msh%list_face(ia)%ic1=nx+(j-1)*nx +bl%first_cell
                 if(bl%cl(2).le.0)then
                   msh%list_face(ia)%ic2=bl%cl(2)
                 else
                          if(blv(2)%idom.ne.bl%idom)then
                      msh%list_face(ia)%ic2=idebc+nue
                              call psr(interdom,nb_dom,bl%idom,blv(2)%idom,ib,bl%cl(2),ipos_send,ipos_recv)
                      msh%list_send(blv(2)%idom)%L(nui+ipos_send)=nx+(j-1)*nx +bl%first_cell
                      msh%list_recv(blv(2)%idom)%L(nue+ipos_recv)=idebc+nue
                      msh%list_cell(idebc+nue)%num = idebc+nue
                      msh%list_cell(idebc+nue)%idom= blv(2)%idom
                      vv= volcel(blv(2),1.d0*ie,1.d0*je,1.d0*ke,1)
                      msh%list_cell(idebc+nue)%vol = vv
                      msh%list_cell(idebc+nue)%center = pni(blv(2),1.d0*ie+0.5d0,1.d0*je+0.5d0,1.d0*ke+0.5d0,1)
                            else
                      msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(2)%first_cell
                            endif
                 endif
              end do

           idebf=idebf+ny
           if(bl%cl(2).gt.0)then
               if(blv(2)%idom.ne.bl%idom)idebc=idebc+ny/ii
             endif

    else ! Dans le cas ou le bloc voisin est + fin
              is=idebv
    ! creation des noeuds aux milieux des aretes
              do j=1,ny
                do k=1,nz+1
                  is=is+1
                  msh%list_vertex(is)=pni(bl,1.d0*(nx+1),1.d0*j+0.5d0,1.d0*k,1)
                end do
              end do

    ! creation des faces
       do j=1,ny
                     ie=1
                       je=2*j-1
                       ke=1
                 nue=je+(ke-1)*nyv ! Numerotation exterieure
                 nui=j         ! Numerotation interieure au bloc
                 nue=2*j-1     ! Numerotation exterieure
                 ia=idebf+nue
                 msh%list_face(ia)%vertex(1)=(nx+1+0)+(j+0-1)*(nx+1) +bl%first_vertex
                 msh%list_face(ia)%vertex(2)=(nx+1+0)+(j+0-1)*(nx+1) + (nx+1)*(ny+1) +bl%first_vertex
                 msh%list_face(ia)%vertex(3)=idebv+2*j
                 msh%list_face(ia)%vertex(4)=idebv+2*j-1
                 msh%list_face(ia)%ic1=nx+(j-1)*nx +bl%first_cell
                 if(bl%cl(2).le.0)then
                   msh%list_face(ia)%ic2=bl%cl(2)
                 else
                          if(blv(2)%idom.ne.bl%idom)then
                              call psr(interdom,nb_dom,bl%idom,blv(2)%idom,ib,bl%cl(2),ipos_send,ipos_recv)
                      msh%list_send(blv(2)%idom)%L(nui+ipos_send)    = nx+(j-1)*nx +bl%first_cell
                      msh%list_recv(blv(2)%idom)%L(nue+ipos_recv)    = idebc+nue
                      msh%list_face(ia)%ic2             = idebc+nue
                      msh%list_cell(idebc+nue)%num      = idebc+nue
                      msh%list_cell(idebc+nue)%idom     = blv(2)%idom
                      vv= volcel(blv(2),1.d0*ie,1.d0*je,1.d0*ke,1)
                      msh%list_cell(idebc+nue)%vol = vv
                      msh%list_cell(idebc+nue)%center = pni(blv(2),1.d0*ie+0.5d0,1.d0*je+0.5d0,1.d0*ke+0.5d0,1)
                            else
                      msh%list_face(ia)%ic2=ie+(je-1)*nxv+(ke-1)*nxv*nyv+blv(2)%first_cell
                            endif
                 endif

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

           idebf=idebf+ny*2
           idebv=idebv+2*ny
           if(bl%cl(2).gt.0)then
               if(blv(2)%idom.ne.bl%idom)idebc=idebc+ny*2
             endif
    endif
    102 continue

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

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

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

           idebf=idebf+nx*2
           idebv=idebv+nx*2
           if(bl%cl(3).gt.0)then
               if(blv(3)%idom.ne.bl%idom)idebc=idebc+nx*2
             endif
    endif

    103  continue

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

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

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

           idebf=idebf+nx*2
           idebv=idebv+2*nx
           if(bl%cl(4).gt.0)then
               if(blv(4)%idom.ne.bl%idom)idebc=idebc+nx*nz*2
             endif
    endif

    104 continue

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

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

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