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