TABLE OF CONTENTS
- 1. GEO/MESH2D
GEO/MESH2D [ 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