tem_prophead_module.f90 Source File


This file depends on

sourcefile~~tem_prophead_module.f90~~EfferentGraph sourcefile~tem_prophead_module.f90 tem_prophead_module.f90 sourcefile~env_module.f90 env_module.f90 sourcefile~tem_prophead_module.f90->sourcefile~env_module.f90

Files dependent on this one

sourcefile~~tem_prophead_module.f90~~AfferentGraph sourcefile~tem_prophead_module.f90 tem_prophead_module.f90 sourcefile~tem_vrtx_prop_module.f90 tem_vrtx_prop_module.f90 sourcefile~tem_vrtx_prop_module.f90->sourcefile~tem_prophead_module.f90 sourcefile~tem_subres_prop_module.f90 tem_subres_prop_module.f90 sourcefile~tem_subres_prop_module.f90->sourcefile~tem_prophead_module.f90 sourcefile~tem_color_prop_module.f90 tem_color_prop_module.f90 sourcefile~tem_color_prop_module.f90->sourcefile~tem_prophead_module.f90 sourcefile~tem_property_module.f90 tem_property_module.f90 sourcefile~tem_property_module.f90->sourcefile~tem_prophead_module.f90 sourcefile~tem_bc_prop_module.f90 tem_bc_prop_module.f90 sourcefile~tem_bc_prop_module.f90->sourcefile~tem_prophead_module.f90 sourcefile~tem_global_module.f90 tem_global_module.f90 sourcefile~tem_global_module.f90->sourcefile~tem_prophead_module.f90 sourcefile~tem_subtree_module.f90 tem_subTree_module.f90 sourcefile~tem_subtree_module.f90->sourcefile~tem_prophead_module.f90

Contents


Source Code

! Copyright (c) 2011-2013, 2017 Harald Klimach <harald.klimach@uni-siegen.de>
! Copyright (c) 2011-2012 Metin Cakircali <m.cakircali@grs-sim.de>
! Copyright (c) 2012-2013 Kannan Masilamani <kannan.masilamani@uni-siegen.de>
! Copyright (c) 2012 Jiaxing Qi <jiaxing.qi@uni-siegen.de>
! Copyright (c) 2012 Khaled Ibrahim <k.ibrahim@grs-sim.de>
! Copyright (c) 2013 Melven Zoellner <yameta@freenet.de>
! Copyright (c) 2013 Simon Zimny <s.zimny@grs-sim.de>
! Copyright (c) 2016 Tobias Schneider <tobias1.schneider@student.uni-siegen.de>
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice, this
! list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
! DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
! FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
! **************************************************************************** !
!> Declaration of the element property header data, which is globally defined
!! for all processes.
!!
!! Each property is described by a label, the bit position it is encoded in
!! in the `elempropertybits` of the mesh and the total number of elements with
!! this property found in the mesh.
module tem_prophead_module

  ! include treelm modules
  use mpi
  use env_module, only: long_k

  ! include aotus modules
  use aot_out_module,   only: aot_out_type, aot_out_val,                 &
    &                         aot_out_open_table, aot_out_close_table
  use aot_table_module, only: aot_table_open, aot_table_close, aot_get_val
  use aotus_module,     only: flu_State

  implicit none

  private

  public :: tem_prophead_type, tem_prop_countelems
  public :: load_tem_prophead, dump_tem_prophead

  type tem_prophead_type
    !> A label to describe this property
    character(len=64) :: label

    !> The position of the bit, which flags the presence
    !! of this property for an element.
    integer :: bitpos

    !> Total number of elements with this property
    integer(kind=long_k) :: nElems
  end type tem_prophead_type


contains


  ! ------------------------------------------------------------------------ !
  !> Load the property header from the mesh file.
  !!
  subroutine load_tem_prophead(me, myPart, comm, conf, root)
    ! -------------------------------------------------------------------- !
    !> Property to load
    type(tem_prophead_type), intent(out) :: me(:)

    !> The process within comm, calling the routine
    integer, intent(in) :: myPart

    !> MPI Communicator within which the mesh is loaded.
    integer, intent(in) :: comm

    !> Lua state containing the mesh description.
    type( flu_State ) :: conf

    !> The root process doing the IO, defaults to 0.
    integer, optional, intent(in) :: root
    ! -------------------------------------------------------------------- !
    integer :: locroot, iprop, sub_handle
    integer :: iError
    integer :: thandle ! handle of property table
    ! -------------------------------------------------------------------- !

    if (present(root)) then
      locroot = root
    else
      locroot = 0
    end if

    if (myPart == locroot) then
      !open properties table
      call aot_table_open( L       = conf,      &
        &                  thandle = thandle,   &
        &                  key     = 'property' )
      do iprop = 1, size(me)
        call aot_table_open( L       = conf,       &
          &                  parent  = thandle,    &
          &                  thandle = sub_handle, &
          &                  pos     = iprop       )
        call aot_get_val( L       = conf,            &
          &               thandle = sub_handle,      &
          &               key     = 'label',         &
          &               val     = me(iprop)%label, &
          &               ErrCode = iError           )
        call aot_get_val( L       = conf,             &
          &               thandle = sub_handle,       &
          &               key     = 'bitpos',         &
          &               val     = me(iprop)%bitpos, &
          &               ErrCode = iError            )
        call aot_get_val( L       = conf,             &
          &               thandle = sub_handle,       &
          &               key     = 'nElems',         &
          &               val     = me(iprop)%nElems, &
          &               ErrCode = iError            )
        call aot_table_close( L = conf, thandle = sub_handle )
      end do
      call aot_table_close( L = conf, thandle = thandle )
    end if

    do iprop = 1, size(me)
      call MPI_Bcast( me(iprop)%nElems, 1, MPI_INTEGER8, locroot, comm, iError)
      call MPI_Bcast( me(iprop)%bitpos, 1, MPI_INTEGER, locroot, comm, iError)
      call MPI_Bcast( me(iprop)%label, 64, MPI_CHARACTER, locroot, comm, iError)
    end do

  end subroutine load_tem_prophead
  ! ------------------------------------------------------------------------ !
  ! ------------------------------------------------------------------------ !


  ! ------------------------------------------------------------------------ !
  !> Subroutine to dump property header informations into a Lua file.
  subroutine dump_tem_prophead(me, conf)
    ! -------------------------------------------------------------------- !
    !> Property to write
    type(tem_prophead_type), intent(in) :: me(:)
    !> aotus lua state to write output
    type(aot_out_type) :: conf
    ! -------------------------------------------------------------------- !
    integer :: iprop
    ! -------------------------------------------------------------------- !

    ! open property table
    call aot_out_open_table( conf, 'property' )
    do iprop=1, size(me)
      call aot_out_open_table( conf )
      call aot_out_val( put_conf = conf,                 &
        &               vname    = 'label',              &
        &               val      = trim(me(iprop)%label) )
      call aot_out_val( put_conf = conf,            &
        &               vname    = 'bitpos',        &
        &               val      = me(iprop)%bitpos )
      call aot_out_val( put_conf = conf,            &
        &               vname    = 'nElems',        &
        &               val      = me(iprop)%nElems )
      call aot_out_close_table(conf)
    end do
    call aot_out_close_table(conf)

  end subroutine dump_tem_prophead
  ! ------------------------------------------------------------------------ !
  ! ------------------------------------------------------------------------ !


  ! ------------------------------------------------------------------------ !
  !> Subroutine to (re-)count the global number of elements the property.
  !!
  !! All elements with the given property are counted across all elements and
  !! the nElems setting is updated accordingly.
  subroutine tem_prop_countelems(me, elempropertybits, comm)
    ! -------------------------------------------------------------------- !
    !> Property to count and set the number of elements for.
    type(tem_prophead_type), intent(inout) :: me

    !> Propertybits of all elements.
    integer(kind=long_k), intent(in) :: elempropertybits(:)

    !> MPI communicator within which the mesh is distributed.
    integer, intent(in) :: comm
    ! -------------------------------------------------------------------- !
    integer(kind=long_k) :: localElems
    integer :: iError
    ! -------------------------------------------------------------------- !

    localElems = count(btest(elempropertybits, me%BitPos))

    ! MPI_ALLREDUCE(SENDBUF, RECVBUF, COUNT, DATATYPE, OP, COMM, IERROR)
    call MPI_Allreduce( localElems, me%nElems, 1, MPI_INTEGER8, MPI_SUM, &
      &                 comm, iError                                     )

  end subroutine tem_prop_countelems
  ! ------------------------------------------------------------------------ !
  ! ------------------------------------------------------------------------ !

end module tem_prophead_module
! ---------------------------------------------------------------------------- !