mod_msh.f90

### TABLE OF CONTENTS

- 1. UTI/msh

## UTI/msh [ Methods ]

[ Top ] [ Methods ]

NOM

     msh

DESCRIPTION

     Ensemble de routines necessaires au maillage
     Set of routines required for meshing

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
      IMPLICIT NONE
    !=========================== DEBUT DU CODE EXECUTABLE ==================

    !----- Debut type ------------------------------------------------------
     TYPE vertex
        real(kind=kind(0.d0))      :: x, y, z
        integer(kind=16) :: morton ! code morton du vertex
        integer  :: num    ! numero du vertex
     END TYPE vertex
    !----- Fin type --------------------------------------------------------
    !----- Debut type ------------------------------------------------------
     TYPE mface
        integer(kind=16), dimension(4)  :: mv       ! codes morton des 2/3/4 vertex composant la face
        integer(kind=16)                :: morton   ! code morton de la face
        integer                         :: num      ! numero de la face
        integer                         :: qe1,qe2  ! codes quadtree/Octree des deux elements voisins si qe2 <= 0 ---> condition aux limites
        integer                         :: be1,be2  ! numero de bloc des deux elements voisins si be2 <= 0 ---> condition aux limites
        integer                         :: nr1,nr2  ! niveau de raffinement des deux elements voisins
        integer         , dimension(2)  :: fac_loc  ! numeros locaux des deux elements connectes
        real(kind=kind(0.d0)), dimension(3)      :: vn       ! normale
     END TYPE mface
    !----- Fin type --------------------------------------------------------
    !----- Debut type ------------------------------------------------------
     TYPE chaine_MF
        type(mface)              :: f
        type(chaine_MF), pointer :: prec,suiv
     END TYPE chaine_MF
    !----- Fin type --------------------------------------------------------

    !----- Debut type ------------------------------------------------------
     TYPE noe
        type(point)       :: coord  ! Barycentre
        integer(kind=16) :: morton ! Code morton du noeud
        integer(kind=16)  :: num    ! Numero du noeud
     END TYPE noe
    !----- Fin type --------------------------------------------------------

     CONTAINS

    ! Routines necessaires a read_gmsh
     subroutine ini_mface(f)
         type(mface)   :: f
         f%mv=0
         f%morton=0
         f%num   =0
         f%qe1=0 ; f%qe2=0
         f%be1=0 ; f%be2=0
         f%nr1=0 ; f%nr2=0
         f%fac_loc=0
     end subroutine ini_mface
    !-------------------------------------------------------
       subroutine range_mface(f,lcf,ier)
        implicit none
        Type(chaine_MF), Pointer        :: lcf
        Type(mface)                     :: f
        integer                         :: ier
        logical                         :: droite
        Type(chaine_MF), Pointer        :: chloc,temp

        ! interdit de rentrer dans cette routine si la chaine pointe sur null
        droite=.false.
        if (f%morton>lcf%f%morton) droite=.true.
        do while (associated(lcf))
              temp=>lcf
              if (f%morton>lcf%f%morton) then
                 if (droite) then
                    lcf=>lcf%suiv
                 else
                    call insertdroite_MF(f,lcf,ier)
                    return
                 end if
              else
                 if (f%morton==lcf%f%morton) then
                    ier=1
    !---- on actualise la face qui existe deja
                    if(lcf%f%be1.le.0)then
                      lcf%f%qe1=f%qe1
                      lcf%f%be1=f%be1
                      lcf%f%nr1=f%nr1
                      lcf%f%mv =f%mv
                      lcf%f%vn =f%vn
                      lcf%f%fac_loc(1) =f%fac_loc(1)
                    else
                      lcf%f%qe2=lcf%f%qe1
                      lcf%f%be2=lcf%f%be1
                      lcf%f%nr2=lcf%f%nr1
                      lcf%f%fac_loc(2) =lcf%f%fac_loc(1)
                      lcf%f%qe1=f%qe1
                      lcf%f%be1=f%be1
                      lcf%f%nr1=f%nr1
                      lcf%f%mv =f%mv
                      lcf%f%vn =f%vn
                      lcf%f%fac_loc(1) =f%fac_loc(1)
                    endif
    !----
                    return
                 else
                    if (droite) then
                       call insertgauche_MF(f,lcf,ier)
                       return
                    else
                       lcf=>lcf%prec
                    end if
                 end if
              end if
           end do
    !cas du bout de liste droite ou gauche
           allocate(chloc)
           chloc%f=f
           if (droite) then
    !ajout a droite de temp
              chloc%prec=>temp
              nullify(chloc%suiv)
              temp%suiv=>chloc
           else
    !ajout a gauche  de temp
              chloc%suiv=>temp
              nullify(chloc%prec)
              temp%prec=>chloc
           end if
           lcf=>chloc!temp
           ier=0
           return
      end subroutine range_mface
    !-------------------------------------------------------

     subroutine mortonface(f,lnf,nn,ndim)
      use geo_typ
      use zorder
      implicit none
      integer        :: nn,ndim,i,mortonx,mortony,mortonz
      type(mface)             :: f
      type(noe), dimension(8) :: lnf
      real(kind=kind(0.d0))   :: x,y,z
      integer(kind=16)       :: nmorton

      x= 0.d0 ; y= 0.d0 ; z= 0.d0
      do i=1,nn
        f%mv(i)=lnf(i)%morton
        x=x+lnf(i)%coord%x
        y=y+lnf(i)%coord%y
        z=z+lnf(i)%coord%z
      enddo
      x=x/nn ; y=y/nn ;z=z/nn
      mortonx=coord_real2int(x,x_min_morton,petit_morton)
      mortony=coord_real2int(y,y_min_morton,petit_morton)
      if (ndim == 2) then
        call zordercurve2d(mortonx,mortony,nmorton)
      else
        mortonz=coord_real2int(z,z_min_morton,petit_morton)
        call zordercurve3d(mortonx,mortony,mortonz,nmorton)
      endif
      f%morton=nmorton
      select case (nn)
          case(2) ! L2
            f%vn(1) = -(lnf(2)%coord%y-lnf(1)%coord%y)
            f%vn(2) =  (lnf(2)%coord%x-lnf(1)%coord%x)
            f%vn(3) = 0.d0
          case(3) ! T3
            f%vn(1) = ((lnf(2)%coord%y-lnf(1)%coord%y)*(lnf(3)%coord%z-lnf(1)%coord%z)-&
            (lnf(2)%coord%z-lnf(1)%coord%z)*(lnf(3)%coord%y-lnf(1)%coord%y))*0.5d0
            f%vn(2) = ((lnf(2)%coord%z-lnf(1)%coord%z)*(lnf(3)%coord%x-lnf(1)%coord%x)-&
            (lnf(2)%coord%x-lnf(1)%coord%x)*(lnf(3)%coord%z-lnf(1)%coord%z))*0.5d0
            f%vn(3) = ((lnf(2)%coord%x-lnf(1)%coord%x)*(lnf(3)%coord%y-lnf(1)%coord%y)-&
            (lnf(2)%coord%y-lnf(1)%coord%y)*(lnf(3)%coord%x-lnf(1)%coord%x))*0.5d0
          case(4) ! Q4
            f%vn(1) = ((lnf(2)%coord%y-lnf(1)%coord%y)*(lnf(4)%coord%z-lnf(1)%coord%z)-&
            (lnf(2)%coord%z-lnf(1)%coord%z)*(lnf(4)%coord%y-lnf(1)%coord%y))
            f%vn(2) = ((lnf(2)%coord%z-lnf(1)%coord%z)*(lnf(4)%coord%x-lnf(1)%coord%x)-&
            (lnf(2)%coord%x-lnf(1)%coord%x)*(lnf(4)%coord%z-lnf(1)%coord%z))
            f%vn(3) = ((lnf(2)%coord%x-lnf(1)%coord%x)*(lnf(4)%coord%y-lnf(1)%coord%y)-&
            (lnf(2)%coord%y-lnf(1)%coord%y)*(lnf(4)%coord%x-lnf(1)%coord%x))
     end select

     end subroutine mortonface
    !-------------------------------------------------------
     subroutine permnoe(ln,n)
      use geo_typ
      type(noe), dimension(8)  :: ln,temp
      integer(kind=16)        :: imin
      integer                  :: i,j,n
      imin=huge(imin)
      temp=ln
      j = 1
      do i=1,n
          if (ln(i)%morton <= imin) then
              imin=ln(i)%morton
              j=i
          endif
      enddo
      ln(:)%coord%x= 0.d0 ;   ln(:)%coord%y= 0.d0 ;   ln(:)%coord%z= 0.d0
      ln(:)%morton= 0
      ln(:)%num   = 0

      do i=1,n
        if (j+i-1 <= n) then
          ln(i)=temp(j+i-1)
        else
          ln(i)=temp(j+i-n-1)
        endif
      enddo
     end subroutine permnoe

    !-------------------------------------------------------
     subroutine perm4(array,n)
      integer(kind=16), dimension(4) :: array,temp
      integer(kind=16)               :: imin
      integer                         :: i,j,n
      imin=huge(imin)
      temp=array
      if (n==2)return
      do i=1,n
          if (array(i) <= imin) then
              imin=array(i)
              j=i
          endif
      enddo
      array= 0
      do i=1,n
        if (j+i-1 <= n) then
          array(i)=temp(j+i-1)
        else
          array(i)=temp(j+i-n-1)
        endif
      enddo
     end subroutine perm4
    !-------------------------------------------------------

     subroutine noe2bloc(ln,b,ns,ndim,nmorton)
      use geo_typ
      use zorder
      implicit none
      integer        :: ns,ndim,i,mortonx,mortony,mortonz
      type(bloc)              :: b
      type(noe), dimension(8) :: ln
      real(kind=kind(0.d0))   :: x,y,z
      integer(kind=16)       :: nmorton
          x=0.d0 ; y=0.d0 ;z=0.d0

        do i=1,ns
            b%s(i)%x=ln(i)%coord%x
            b%s(i)%y=ln(i)%coord%y
            b%s(i)%z=ln(i)%coord%z
            x=x+ln(i)%coord%x
            y=y+ln(i)%coord%y
            z=y+ln(i)%coord%z
        enddo
        x=x/ns ; y=y/ns ;z=z/ns
        mortonx=coord_real2int(x,x_min_morton,petit_morton)
        mortony=coord_real2int(y,y_min_morton,petit_morton)
        if (ndim == 2) then
          call zordercurve2d(mortonx,mortony,nmorton)
        else
          mortonz=coord_real2int(z,z_min_morton,petit_morton)
          call zordercurve3d(mortonx,mortony,mortonz,nmorton)
        endif
        !b%morton  = nmorton
      end subroutine noe2bloc
    !-------------------------------------------------------
     subroutine insertdroite_MF(f,lcf,ier)
        implicit none
        integer                 :: ier
        Type(chaine_MF), Pointer     :: lcf
        Type(mface)                  :: f
        Type(chaine_MF), Pointer     :: temp, locch

    !cas du bout de liste droite ou gauche
          temp=>lcf%suiv
           allocate (locch)
           locch%f=f
           locch%suiv=>temp
           temp%prec=>locch
           locch%prec=>lcf
           lcf%suiv=>locch
    !modif
           lcf=>locch
           ier=0
           return
      end subroutine insertdroite_MF
    !-------------------------------------------------------
     subroutine insertgauche_MF(f,lcf,ier)
        implicit none
        integer                 :: ier
        Type(chaine_MF), Pointer     :: lcf
        Type(mface)                  :: f
        Type(chaine_MF), Pointer     :: temp, locch
    !cas du bout de liste droite ou gauche
        temp=>lcf%prec
           allocate (locch)
           locch%f=f
           locch%suiv=>lcf
           lcf%prec=>locch
           locch%prec=>temp
           temp%suiv=>locch
    !modif
           lcf=>locch
           ier=0
           return
      end subroutine insertgauche_MF
    !===========================   FIN DU MODULE   =========================
     END MODULE msh