make_box Subroutine

public subroutine make_box(mesh, size, center, nx, ny, nz)

直方体6面を分割数に応じて三角形化し、外向き法線向きでメッシュを生成する。

Arguments

Type IntentOptional Attributes Name
type(mesh_type), intent(out) :: mesh

生成した直方体表面メッシュ。
real(kind=dp), intent(in), optional :: size(3)
real(kind=dp), intent(in), optional :: center(3)
integer(kind=i32), intent(in), optional :: nx

X方向分割数（省略時 1）。
integer(kind=i32), intent(in), optional :: ny

X方向分割数（省略時 1）。 Y方向分割数（省略時 1）。
integer(kind=i32), intent(in), optional :: nz

X方向分割数（省略時 1）。 Y方向分割数（省略時 1）。 Z方向分割数（省略時 1）。

Calls

proc~~make_box~~CallsGraph proc~make_box make_box proc~init_mesh init_mesh proc~make_box->proc~init_mesh proc~push_tri push_tri proc~make_box->proc~push_tri proc~update_mesh_geometry update_mesh_geometry proc~init_mesh->proc~update_mesh_geometry proc~build_collision_grid build_collision_grid proc~update_mesh_geometry->proc~build_collision_grid proc~cross~2 cross proc~update_mesh_geometry->proc~cross~2 proc~cell_id~2 cell_id proc~build_collision_grid->proc~cell_id~2 proc~coord_to_cell~2 coord_to_cell proc~build_collision_grid->proc~coord_to_cell~2

Called by

proc~~make_box~~CalledByGraph proc~make_box make_box proc~build_one_template build_one_template proc~build_one_template->proc~make_box proc~build_template_mesh build_template_mesh proc~build_template_mesh->proc~build_one_template proc~build_mesh_from_config build_mesh_from_config proc~build_mesh_from_config->proc~build_template_mesh proc~load_or_init_run_state load_or_init_run_state proc~load_or_init_run_state->proc~build_mesh_from_config program~main main program~main->proc~load_or_init_run_state

Source Code

  subroutine make_box(mesh, size, center, nx, ny, nz)
    type(mesh_type), intent(out) :: mesh
    real(dp), intent(in), optional :: size(3), center(3)
    integer(i32), intent(in), optional :: nx, ny, nz
    real(dp) :: s(3), c(3), hx, hy, hz, dx, dy, dz, x, y, z
    integer(i32) :: nx0, ny0, nz0, nelem, itri, ix, iy, iz
    real(dp), allocatable :: v0(:, :), v1(:, :), v2(:, :)

    s = [1.0d0, 1.0d0, 1.0d0]; c = 0.0d0; nx0 = 1; ny0 = 1; nz0 = 1
    if (present(size)) s = size
    if (present(center)) c = center
    if (present(nx)) nx0 = nx
    if (present(ny)) ny0 = ny
    if (present(nz)) nz0 = nz
    if (nx0 <= 0 .or. ny0 <= 0 .or. nz0 <= 0) error stop "nx, ny, nz must be positive"

    hx = 0.5d0*s(1); hy = 0.5d0*s(2); hz = 0.5d0*s(3)
    dx = s(1)/real(nx0, dp); dy = s(2)/real(ny0, dp); dz = s(3)/real(nz0, dp)
    nelem = 4*(nx0*ny0 + ny0*nz0 + nx0*nz0)
    allocate (v0(3, nelem), v1(3, nelem), v2(3, nelem)); itri = 0

    do iz = 1, 2
      z = merge(c(3) - hz, c(3) + hz, iz == 1)
      do ix = 0, nx0 - 1
        do iy = 0, ny0 - 1
          if (iz == 1) then
            call push_tri(v0, v1, v2, itri, &
                          [c(1) - hx + dx*ix, c(2) - hy + dy*iy, z], &
                          [c(1) - hx + dx*(ix + 1), c(2) - hy + dy*(iy + 1), z], &
                          [c(1) - hx + dx*(ix + 1), c(2) - hy + dy*iy, z])
            call push_tri(v0, v1, v2, itri, &
                          [c(1) - hx + dx*ix, c(2) - hy + dy*iy, z], &
                          [c(1) - hx + dx*ix, c(2) - hy + dy*(iy + 1), z], &
                          [c(1) - hx + dx*(ix + 1), c(2) - hy + dy*(iy + 1), z])
          else
            call push_tri(v0, v1, v2, itri, &
                          [c(1) - hx + dx*ix, c(2) - hy + dy*iy, z], &
                          [c(1) - hx + dx*(ix + 1), c(2) - hy + dy*iy, z], &
                          [c(1) - hx + dx*(ix + 1), c(2) - hy + dy*(iy + 1), z])
            call push_tri(v0, v1, v2, itri, &
                          [c(1) - hx + dx*ix, c(2) - hy + dy*iy, z], &
                          [c(1) - hx + dx*(ix + 1), c(2) - hy + dy*(iy + 1), z], &
                          [c(1) - hx + dx*ix, c(2) - hy + dy*(iy + 1), z])
          end if
        end do
      end do
    end do

    do ix = 1, 2
      x = merge(c(1) - hx, c(1) + hx, ix == 1)
      do iy = 0, ny0 - 1
        do iz = 0, nz0 - 1
          if (ix == 1) then
            call push_tri(v0, v1, v2, itri, &
                          [x, c(2) - hy + dy*iy, c(3) - hz + dz*iz], &
                          [x, c(2) - hy + dy*(iy + 1), c(3) - hz + dz*(iz + 1)], &
                          [x, c(2) - hy + dy*(iy + 1), c(3) - hz + dz*iz])
            call push_tri(v0, v1, v2, itri, &
                          [x, c(2) - hy + dy*iy, c(3) - hz + dz*iz], &
                          [x, c(2) - hy + dy*iy, c(3) - hz + dz*(iz + 1)], &
                          [x, c(2) - hy + dy*(iy + 1), c(3) - hz + dz*(iz + 1)])
          else
            call push_tri(v0, v1, v2, itri, &
                          [x, c(2) - hy + dy*iy, c(3) - hz + dz*iz], &
                          [x, c(2) - hy + dy*(iy + 1), c(3) - hz + dz*iz], &
                          [x, c(2) - hy + dy*(iy + 1), c(3) - hz + dz*(iz + 1)])
            call push_tri(v0, v1, v2, itri, &
                          [x, c(2) - hy + dy*iy, c(3) - hz + dz*iz], &
                          [x, c(2) - hy + dy*(iy + 1), c(3) - hz + dz*(iz + 1)], &
                          [x, c(2) - hy + dy*iy, c(3) - hz + dz*(iz + 1)])
          end if
        end do
      end do
    end do

    do iy = 1, 2
      y = merge(c(2) - hy, c(2) + hy, iy == 1)
      do ix = 0, nx0 - 1
        do iz = 0, nz0 - 1
          if (iy == 1) then
            call push_tri(v0, v1, v2, itri, &
                          [c(1) - hx + dx*ix, y, c(3) - hz + dz*iz], &
                          [c(1) - hx + dx*(ix + 1), y, c(3) - hz + dz*iz], &
                          [c(1) - hx + dx*(ix + 1), y, c(3) - hz + dz*(iz + 1)])
            call push_tri(v0, v1, v2, itri, &
                          [c(1) - hx + dx*ix, y, c(3) - hz + dz*iz], &
                          [c(1) - hx + dx*(ix + 1), y, c(3) - hz + dz*(iz + 1)], &
                          [c(1) - hx + dx*ix, y, c(3) - hz + dz*(iz + 1)])
          else
            call push_tri(v0, v1, v2, itri, &
                          [c(1) - hx + dx*ix, y, c(3) - hz + dz*iz], &
                          [c(1) - hx + dx*(ix + 1), y, c(3) - hz + dz*(iz + 1)], &
                          [c(1) - hx + dx*(ix + 1), y, c(3) - hz + dz*iz])
            call push_tri(v0, v1, v2, itri, &
                          [c(1) - hx + dx*ix, y, c(3) - hz + dz*iz], &
                          [c(1) - hx + dx*ix, y, c(3) - hz + dz*(iz + 1)], &
                          [c(1) - hx + dx*(ix + 1), y, c(3) - hz + dz*(iz + 1)])
          end if
        end do
      end do
    end do

    call init_mesh(mesh, v0, v1, v2)
  end subroutine make_box