scale_file_monitor_meshfield.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scaleFElib.h"
module scale_file_monitor_meshfield
  !-----------------------------------------------------------------------------
  !
  !++ Used modules
  !
  use scale_precision
  use scale_io
  use scale_prof
  use scale_monitor, only: monitor_set_dim
  use scale_monitor, only: monitor_put
 
  use scale_mesh_base2d, only: meshbase2d
  use scale_mesh_base3d, only: meshbase3d
  use scale_meshfield_base, only: meshfield2d
  use scale_meshfield_base, only: meshfield3d
 
  use scale_monitor, only: &
    file_monitor_meshfield_setup => monitor_setup,   &
    file_monitor_meshfield_reg   => monitor_reg,     &
    file_monitor_meshfield_write => monitor_write,   &
    file_monitor_meshfield_final => monitor_finalize
 
 
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public type & procedures
  !
  !-----------------------------------------------------------------------------
 
  public :: file_monitor_meshfield_setup
 
  interface file_monitor_meshfield_set_dim
    module procedure file_monitor_meshfield_set_dim2d
    module procedure file_monitor_meshfield_set_dim3d
  end interface
  public :: file_monitor_meshfield_set_dim
 
  public :: file_monitor_meshfield_reg
 
  interface file_monitor_meshfield_put
    module procedure file_monitor_meshfield_put2d
    module procedure file_monitor_meshfield_put3d
  end interface
  public :: file_monitor_meshfield_put
  
  public :: file_monitor_meshfield_write
  public :: file_monitor_meshfield_final
 
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedures
  !
 
contains
 
!OCL SERIAL
  subroutine file_monitor_meshfield_set_dim2d( mesh2D, dim_type )
    implicit none
 
    class(meshbase2d), intent(in) :: mesh2D
    character(*), intent(in) :: dim_type
    
    real(RP) :: area(1,1)
    real(RP) :: total_area, total_area_lc
 
    integer :: n
    integer :: ke
    !---------------------------------------------------------------------------
 
    total_area = 0.0_rp
    do n=1, mesh2d%LOCAL_MESH_NUM
      total_area = total_area + cal_total_lc( mesh2d%lcmesh_list(n) )
    end do
    area(1,1) = 1.0_rp
 
    call monitor_set_dim( 1, 1, 1, 1, 1, 1, 1, 1, 1,     &
      dim_type, 2, area=area(:,:), total_area=total_area )
    
    return
  end subroutine file_monitor_meshfield_set_dim2d
 
!OCL SERIAL
  subroutine file_monitor_meshfield_set_dim3d( mesh3D, dim_type )
    implicit none
 
    class(meshbase3d), intent(in) :: mesh3D
    character(*), intent(in) :: dim_type
    
    real(RP) :: area(1,1)
    real(RP) :: total_area, total_area_lc
 
    integer :: n
    integer :: ke
    !---------------------------------------------------------------------------
 
    total_area = 0.0_rp
    do n=1, mesh3d%LOCAL_MESH_NUM
      total_area = total_area + cal_total_lc( mesh3d%lcmesh_list(n) )
    end do
    area(1,1) = 1.0_rp
 
    call monitor_set_dim( 1, 1, 1, 1, 1, 1, 1, 1, 1,     &
      dim_type, 2, area=area(:,:), total_area=total_area )
    
    return
  end subroutine file_monitor_meshfield_set_dim3d
 
!OCL SERIAL
  subroutine file_monitor_meshfield_put2d( itemid, field )
    implicit none
 
    class(meshfield2d), intent(in) :: field
    integer, intent(in) :: itemid
 
    real(RP) :: total_lc(1,1)
    integer :: n
    !---------------------------------------------------------------------------
 
    if ( itemid <= 0 ) return
 
    total_lc(1,1) = 0.0_rp
    do n=1, field%mesh%LOCAL_MESH_NUM
      total_lc(1,1) = total_lc(1,1) &
                    + cal_total_lc( field%mesh%lcmesh_list(n), field%local(n)%val )
    end do
    call monitor_put( itemid, total_lc(:,:) )
 
    return
  end subroutine file_monitor_meshfield_put2d
 
!OCL SERIAL
  subroutine file_monitor_meshfield_put3d( itemid, field )
    implicit none
 
    class(meshfield3d), intent(in) :: field
    integer, intent(in) :: itemid
 
    real(RP) :: total_lc(1,1)
    integer :: n
    !---------------------------------------------------------------------------
 
    if ( itemid <= 0 ) return
 
    total_lc(1,1) = 0.0_rp
    do n=1, field%mesh%LOCAL_MESH_NUM
      total_lc(1,1) = total_lc(1,1) &
                    + cal_total_lc( field%mesh%lcmesh_list(n), field%local(n)%val )
    end do
    call monitor_put( itemid, total_lc(:,:) )
 
    return
  end subroutine file_monitor_meshfield_put3d
 
!-- private----------------------
 
!OCL SERIAL
  function cal_total_lc( lcmesh, field_val ) result(total)
    use scale_localmesh_base, only: localmeshbase
    use scale_element_base, only: elementbase
    implicit none
 
    class(localmeshbase), intent(in) :: lcmesh
    real(RP), intent(in), optional :: field_val(lcmesh%refElem%Np,lcmesh%NeA)
    real(RP) :: total
 
    class(elementbase), pointer :: elem
    integer :: ke
    !---------------------------------------------------------------------------
 
    total = 0.0_rp
    elem => lcmesh%refElem
 
    if ( present(field_val) ) then
      !$omp parallel do reduction(+:total)
      do ke=lcmesh%NeS, lcmesh%NeE
        total = total &
              + sum( elem%IntWeight_lgl(:) * lcmesh%J(:,ke) * lcmesh%Gsqrt(:,ke) * field_val(:,ke) )
      end do
    else
      !$omp parallel do reduction(+:total)
      do ke=lcmesh%NeS, lcmesh%NeE
        total = total + sum( elem%IntWeight_lgl(:) * lcmesh%J(:,ke) * lcmesh%Gsqrt(:,ke) )
      end do
    end if
 
    return
  end function cal_total_lc
 
end module scale_file_monitor_meshfield