TABLE OF CONTENTS
UTI/PRE/mame2bloc [ Modules ]
NOM
mame2bloc(xmin,xmax,ymin,ymax,zmin,zmax,nx,ny,nz,lst_bloc,ndim)
DESCRIPTION
Maillage regulier de blocs d un cube 3d en hexaedres (xmin,ymin,xmax,ymax,zmin,zmax) nx, ny, nz sont les nombres de blocs suivant x, y, z Regular mesh of blocks of a 3d cube in hexaedres (xmin,ymin,xmax,ymax,zmin,zmax) nx, ny, nz are the number of blocks following x, y, z
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 num use zorder implicit none !.2----- Declaration real(kind=kind(0.d0)), intent(inout) :: xmin,xmax,ymin,ymax,zmin,zmax !! Definition du domaine a mailler / Definition of the area to be meshed integer, intent(in) :: nx,ny,nz !! Discretisation suivant x,y,z / Discretisation according to x,y,z integer, intent(in) :: ndim !! Dimension du probleme / Problem dimensionb type(bloc), pointer, dimension(:), intent(inout) :: lst_bloc !! Liste des blocs / Block list real(kind=kind(0.d0)) :: x,y,z,hx,hy,hz integer :: i,j,k,ia,mortonx,mortony,mortonz integer(kind=16) :: nmorton integer(kind=16) ,allocatable,dimension(:) :: lm !=========================== DEBUT DU CODE EXECUTABLE ================== !------- Initialisations ! Dimensions caracteristiques de morton hx=(xmax-xmin)/(nx) hy=(ymax-ymin)/(ny) hz=(zmax-zmin)/(nz) petit_morton=min(hx,hy,hz)*0.1d0 x_min_morton=xmin y_min_morton=ymin z_min_morton=zmin allocate (lm(nx*ny*nz)) ! Creation des blocs do i=1,nx do j=1,ny do k=1,nz ia=i+(j-1)*nx+nx*ny*(k-1) lst_bloc(ia)%numbl = ia lst_bloc(ia)%idom = 1 lst_bloc(ia)%nrb = 0 lst_bloc(ia)%nx = 1 lst_bloc(ia)%ny = 1 lst_bloc(ia)%nz = 1 lst_bloc(ia)%s(:)%x = 0.d0 lst_bloc(ia)%s(:)%y = 0.d0 lst_bloc(ia)%s(:)%z = 0.d0 lst_bloc(ia)%s(1)%x = xmin+(i-1)*hx ; lst_bloc(ia)%s(1)%y = ymin+(j-1)*hy ; lst_bloc(ia)%s(1)%z = zmin+(k-1)*hz lst_bloc(ia)%s(2)%x = xmin+(i-0)*hx ; lst_bloc(ia)%s(2)%y = ymin+(j-1)*hy ; lst_bloc(ia)%s(2)%z = zmin+(k-1)*hz lst_bloc(ia)%s(3)%x = xmin+(i-0)*hx ; lst_bloc(ia)%s(3)%y = ymin+(j-0)*hy ; lst_bloc(ia)%s(3)%z = zmin+(k-1)*hz lst_bloc(ia)%s(4)%x = xmin+(i-1)*hx ; lst_bloc(ia)%s(4)%y = ymin+(j-0)*hy ; lst_bloc(ia)%s(4)%z = zmin+(k-1)*hz lst_bloc(ia)%s(5)%x = xmin+(i-1)*hx ; lst_bloc(ia)%s(5)%y = ymin+(j-1)*hy ; lst_bloc(ia)%s(5)%z = zmin+(k-0)*hz lst_bloc(ia)%s(6)%x = xmin+(i-0)*hx ; lst_bloc(ia)%s(6)%y = ymin+(j-1)*hy ; lst_bloc(ia)%s(6)%z = zmin+(k-0)*hz lst_bloc(ia)%s(7)%x = xmin+(i-0)*hx ; lst_bloc(ia)%s(7)%y = ymin+(j-0)*hy ; lst_bloc(ia)%s(7)%z = zmin+(k-0)*hz lst_bloc(ia)%s(8)%x = xmin+(i-1)*hx ; lst_bloc(ia)%s(8)%y = ymin+(j-0)*hy ; lst_bloc(ia)%s(8)%z = zmin+(k-0)*hz lst_bloc(ia)%cl(:) = 0 lst_bloc(ia)%cl(1) = i-1+(j-1)*nx+nx*ny*(k-1) lst_bloc(ia)%cl(2) = i+1+(j-1)*nx+nx*ny*(k-1) lst_bloc(ia)%cl(3) = i+0+(j-2)*nx+nx*ny*(k-1) lst_bloc(ia)%cl(4) = i+0+(j-0)*nx+nx*ny*(k-1) lst_bloc(ia)%cl(5) = i+0+(j-1)*nx+nx*ny*(k-2) lst_bloc(ia)%cl(6) = i+0+(j-1)*nx+nx*ny*(k-0) lst_bloc(ia)%dom(:)= 1 if (i==1 )then lst_bloc(ia)%cl(1) = -111 endif if (j==1 )then lst_bloc(ia)%cl(3) = -333 if(ndim.eq.1)lst_bloc(ia)%cl(3) = -999 endif if (k==1 )then lst_bloc(ia)%cl(5) = -555 if(ndim.le.2)lst_bloc(ia)%cl(5) = -999 endif if (i==nx)then lst_bloc(ia)%cl(2) = -222 endif if (j==ny)then lst_bloc(ia)%cl(4) = -444 if(ndim.eq.1)lst_bloc(ia)%cl(4) = -999 endif if (k==nz)then lst_bloc(ia)%cl(6) = -666 if(ndim.le.2)lst_bloc(ia)%cl(6) = -999 endif lst_bloc(ia)%nrf(:) = 0 lst_bloc(ia)%first_cell = 0 lst_bloc(ia)%nb_cell = 0 lst_bloc(ia)%first_face = 0 lst_bloc(ia)%nb_face = 0 lst_bloc(ia)%first_vertex= 0 lst_bloc(ia)%nb_vertex = 0 lst_bloc(ia)%volc = volbloc(lst_bloc(ia)) x=xmin+(2*i-1)*hx*.5d0 y=ymin+(2*j-1)*hy*.5d0 z=zmin+(2*k-1)*hz*.5d0 mortonx=coord_real2int(x,x_min_morton,petit_morton) mortony=coord_real2int(y,y_min_morton,petit_morton) mortonz=coord_real2int(z,z_min_morton,petit_morton) call zordercurve3d(mortonx,mortony,mortonz,nmorton) !lst_bloc(ia)%morton = nmorton lm(ia) = nmorton enddo enddo enddo ! on ordonne les numeros (locaux) des blocs selon le code de morton (lm) k=0 do ia=1,nx*ny*nz j=int(minloc(lm,1,mask=lm.ne.0)) k=k+1 lst_bloc(ia)%morton = k lm(j)=0 enddo deallocate(lm) return !=========================== FIN DE LA ROUTINE ==================== END SUBROUTINE mame2bloc