mame2bloc.f90

### TABLE OF CONTENTS

- 1. UTI/PRE/mame2bloc

## UTI/PRE/mame2bloc [ Modules ]

[ Top ] [ 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