quadMesh_mod.f90

Go to the documentation of this file.

!! \li Composite integration domain:

module quadmesh_mod

  use choral_constants
  use choral_variables
  use abstract_interfaces, only: r3tor
  use basic_tools
  use cell_mod
  use quad_mod
  use mesh_mod

  implicit none
  private


  !       %----------------------------------------%
  !       |                                        |
  !       |          PUBLIC DATA                   |
  !       |                                        |
  !       %----------------------------------------%
  public :: quadmesh

  public :: clear
  public :: set
  public :: assemble
  public :: print
  public :: valid

  !       %----------------------------------------%
  !       |                                        |
  !       |          DERIVED TYPE                  |
  !       |                                        |
  !       %----------------------------------------%
  type quadmesh

     type(mesh), pointer :: mesh=>null()

     integer, dimension(:), allocatable :: quadtype

     integer, dimension(0:QUAD_TOT_NB) :: quad_count = 0

   contains

     final :: quadmesh_clear

  end type quadmesh


  !       %----------------------------------------%
  !       |                                        |
  !       |       GENERIc SUBROUTINES              |
  !       |                                        |
  !       %----------------------------------------%
  interface clear
     module procedure quadmesh_clear
  end interface clear

  interface quadmesh
     module procedure quadmesh_create
  end interface quadmesh

  interface set
     module procedure quadmesh_set
  end interface set

  interface assemble
     module procedure quadmesh_assemble
  end interface assemble

  interface print
     module procedure quadmesh_print
  end interface print

  interface valid
     module procedure quadmesh_valid
  end interface valid

contains

  subroutine quadmesh_clear(qdm)
    type(quadmesh), intent(inout) :: qdm

    qdm%mesh => null()
    call freemem(qdm%quadType)

    qdm%quad_count = 0
    
  end subroutine quadmesh_clear

  function quadmesh_create(m) result(qdm)
    type(quadmesh)         :: qdm
    type(mesh)    , target :: m

    if (choral_verb>0) write(*,*) &
         &'quadMesh_mod    : create' 

    if(.NOT.valid(m)) call quit("quadMesh_mod:&
         & quadMesh_create: mesh 'm' not valid" )

    call clear(qdm)
    qdm%mesh => m
    call allocmem(qdm%quadType, m%nbCl)
    qdm%quadType = quad_none
    if (choral_verb>1) write(*,*) &
         &'  Number of cells                =', qdm%mesh%nbCl 

  end function quadmesh_create



  subroutine quadmesh_set(qdm, quadType, f)
    type(quadmesh), intent(inout)        :: qdm
    integer       , intent(in)           :: quadType
    procedure(r3tor)          , optional :: f

    logical, dimension(:), allocatable :: flag
    integer  :: cpt

    if (choral_verb>0) write(*,*) 'quadMesh_mod    : quadMesh_set'

    if ( (quadtype<0) .OR. ( quadtype > quad_tot_nb) ) &
         & call quit('quadMesh_mod: quadMesh_set:&
         & wrong quadrature type')

    call flag_mesh_cells(flag, qdm%mesh, quad_dim(quadtype), f)

    call set_flagged_cells(qdm, cpt, quadtype, flag)

    if (choral_verb>0) write(*,*) '  ', quad_name(quadtype),&
         & '                  =',&
         & cpt, ' cells'

  end subroutine quadmesh_set



  subroutine set_flagged_cells(qdm, cpt, quadType, flag)
    type(quadmesh)       , intent(inout) :: qdm
    integer              , intent(out)   :: cpt  
    integer              , intent(in)    :: quadType
    logical, dimension(:), intent(in)    :: flag

    integer :: ii, jj, geo, cl_geo

    if(size(flag,1)/=qdm%mesh%nbCl) call quit("quadMesh_mod:&
         & set_flagged cells: argument 'flag' incorrect" )

    geo = quad_geo(quadtype)
    cpt = 0
    
    do ii=1, qdm%mesh%nbCl
       
       if (.NOT.flag(ii)) cycle

       jj = qdm%mesh%clType(ii)
       cl_geo = cell_geo(jj)

       if (geo==cl_geo) then

          cpt = cpt + 1          
          qdm%quadType(ii) = quadtype
         
       end if
    end do

  end subroutine set_flagged_cells



  subroutine quadmesh_assemble(qdm)
    type(quadmesh), intent(inout) :: qdm

    integer :: cl, qt

    if (choral_verb>0) write(*,*)&
         &"quadMesh_mod    : assemble"
    

    !! Set m%cell_count and m%dim
    !!
    qdm%quad_count = 0
    do cl=1, qdm%mesh%nbCl

       qt = qdm%quadType(cl)
       qdm%quad_count(qt) = qdm%quad_count(qt) + 1

    end do

    if (.NOT.valid(qdm)) call quit(&
         & 'quadMesh_mod: mesh_ass_boundaryemble: assembling not valid')

  end subroutine quadmesh_assemble


  
  subroutine quadmesh_print(qdm)
    type(quadmesh), intent(in) :: qdm

    integer :: ii

    write(*,*)"quadMesh_mod    : print"
    write(*,*) '  Number of cells per quad method'
    do ii=0, quad_tot_nb
       if ( qdm%quad_count(ii)>0) then

          write(*,*)"                   "&
               &//quad_name(ii)&
               &//" =", qdm%quad_count(ii)

       end if
    end do

  end subroutine quadmesh_print

  function quadmesh_valid(qdm) result(b)
    type(quadmesh), intent(in) :: qdm
    logical :: b

    b = .false.
    if (.NOT. ( associated(qdm%mesh) )) return
    if (.NOT. valid(qdm%mesh))          return
    if (.NOT. ( allocated(qdm%quadType) )) return

    b = ( size(qdm%quadType,1) == qdm%mesh%nbCl )
    b = b .AND. ( size(qdm%quadType,1) == sum(qdm%quad_count) )
    
  end function quadmesh_valid


end module quadmesh_mod