Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
class(type_vtk), | intent(in) | :: | self |
VTK data |
||
integer(kind=int32), | intent(inout), | allocatable | :: | unique_ids(:) | ||
integer(kind=int32), | intent(out) | :: | ierr |
subroutine get_active_region_info(self, unique_ids, ierr) ! --- 引数 --- implicit none class(Type_VTK), intent(in) :: self !! VTK data integer(int32), allocatable, intent(inout) :: unique_ids(:) integer(int32), intent(out) :: ierr ! --- ローカル変数 --- integer(int32) :: max_dim integer(int32), allocatable :: collected_ids(:) integer(int32) :: i_cell, count logical(4) :: is_max_dim_element max_dim = 0 ierr = 0 ! --- ステップ1: メッシュ内の最大次元を判定 --- do i_cell = 1, self%num_total_cells select case (self%CELLS(i_cell)%cell_type) case (VTK_TETRA, VTK_HEXAHEDRON, & VTK_WEDGE, VTK_PYRAMID, & VTK_QUADRATIC_TETRA, VTK_QUADRATIC_HEXAHEDRON) max_dim = 3 exit ! 3Dが見つかったら、それ以上探す必要はない case (VTK_TRIANGLE, VTK_PIXEL, & VTK_QUAD, VTK_QUADRATIC_TRIANGLE, & VTK_QUADRATIC_QUAD) max_dim = max(max_dim, 2) case (VTK_LINE, VTK_QUADRATIC_EDGE) max_dim = max(max_dim, 1) end select end do if (max_dim == 0) then ierr = -1 return ! アクティブな要素がない end if ! --- ステップ2: 最大次元を持つ要素から、すべてのCellEntityIdを収集 --- allocate (collected_ids(self%num_total_cells)) count = 0 do i_cell = 1, self%num_total_cells is_max_dim_element = .false. select case (self%CELLS(i_cell)%cell_type) case (VTK_TETRA, VTK_HEXAHEDRON, & VTK_WEDGE, VTK_PYRAMID, & VTK_QUADRATIC_TETRA, VTK_QUADRATIC_HEXAHEDRON) if (max_dim == 3) is_max_dim_element = .true. case (VTK_TRIANGLE, VTK_PIXEL, & VTK_QUAD, VTK_QUADRATIC_TRIANGLE, & VTK_QUADRATIC_QUAD) if (max_dim == 2) is_max_dim_element = .true. case (VTK_LINE, VTK_QUADRATIC_EDGE) if (max_dim == 1) is_max_dim_element = .true. end select if (is_max_dim_element) then count = count + 1 collected_ids(count) = self%CELLS(i_cell)%cell_entity_id end if end do ! --- ステップ3: 収集したIDリストから、ユニークなものだけを抽出 --- ! (これはFortranの標準的なユニーク化のアルゴリズム) if (count > 0) then call unique(collected_ids(1:count), unique_ids) else allocate (unique_ids(0)) end if end subroutine get_active_region_info