m_boundary_conditions.fpp.f90

Go to the documentation of this file.

# 1 "/home/runner/work/MFC/MFC/src/pre_process/m_boundary_conditions.fpp"
!>
!! @file
!! @brief Contains module m_boundary_conditions
 
!> @brief Applies spatially varying boundary condition patches along domain edges and faces
module m_boundary_conditions
 
    use m_derived_types
    use m_global_parameters
#ifdef MFC_MPI
    use mpi
#endif
    use m_delay_file_access
    use m_compile_specific
    use m_boundary_common
 
    implicit none
 
    real(wp)          :: x_centroid, y_centroid, z_centroid
    real(wp)          :: length_x, length_y, length_z
    real(wp)          :: radius
    type(bounds_info) :: x_boundary, y_boundary, z_boundary
    private; public :: s_apply_boundary_patches
 
contains
    !> Apply a line-segment boundary condition patch along a domain edge in 2D.
    impure subroutine s_line_segment_bc(patch_id, bc_type)
 
        type(integer_field), dimension(1:num_dims,1:2), intent(inout) :: bc_type
        integer, intent(in)                                           :: patch_id
        integer                                                       :: j
 
        ! Patch is a line segment along y on the x-boundary face
 
        if (patch_bc(patch_id)%dir == 1) then
            y_centroid = patch_bc(patch_id)%centroid(2)
            length_y = patch_bc(patch_id)%length(2)
 
            y_boundary%beg = y_centroid - 0.5_wp*length_y
            y_boundary%end = y_centroid + 0.5_wp*length_y
 
            ! Apply patch if x boundary is a domain boundary
# 44 "/home/runner/work/MFC/MFC/src/pre_process/m_boundary_conditions.fpp"
                if (patch_bc(patch_id)%loc == -1 .and. bc_x%beg < 0) then
                    do j = 0, n
                        if (y_cc(j) > y_boundary%beg .and. y_cc(j) < y_boundary%end) then
                            bc_type(1, 1)%sf(0, j, 0) = patch_bc(patch_id)%type
                        end if
                    end do
                end if
# 44 "/home/runner/work/MFC/MFC/src/pre_process/m_boundary_conditions.fpp"
                if (patch_bc(patch_id)%loc == 1 .and. bc_x%end < 0) then
                    do j = 0, n
                        if (y_cc(j) > y_boundary%beg .and. y_cc(j) < y_boundary%end) then
                            bc_type(1, 2)%sf(0, j, 0) = patch_bc(patch_id)%type
                        end if
                    end do
                end if
# 52 "/home/runner/work/MFC/MFC/src/pre_process/m_boundary_conditions.fpp"
        end if
 
        ! Patch is a line segment along x on the y-boundary face
        if (patch_bc(patch_id)%dir == 2) then
            x_centroid = patch_bc(patch_id)%centroid(1)
            length_x = patch_bc(patch_id)%length(1)
 
            x_boundary%beg = x_centroid - 0.5_wp*length_x
            x_boundary%end = x_centroid + 0.5_wp*length_x
 
            ! Apply patch if y boundary is a domain boundary
# 64 "/home/runner/work/MFC/MFC/src/pre_process/m_boundary_conditions.fpp"
                if (patch_bc(patch_id)%loc == -1 .and. bc_y%beg < 0) then
                    do j = 0, m
                        if (x_cc(j) > x_boundary%beg .and. x_cc(j) < x_boundary%end) then
                            bc_type(2, 1)%sf(j, 0, 0) = patch_bc(patch_id)%type
                        end if
                    end do
                end if
# 64 "/home/runner/work/MFC/MFC/src/pre_process/m_boundary_conditions.fpp"
                if (patch_bc(patch_id)%loc == 1 .and. bc_y%end < 0) then
                    do j = 0, m
                        if (x_cc(j) > x_boundary%beg .and. x_cc(j) < x_boundary%end) then
                            bc_type(2, 2)%sf(j, 0, 0) = patch_bc(patch_id)%type
                        end if
                    end do
                end if
# 72 "/home/runner/work/MFC/MFC/src/pre_process/m_boundary_conditions.fpp"
        end if
 
    end subroutine s_line_segment_bc
 
    !> Apply a circular boundary condition patch on a domain face in 3D.
    impure subroutine s_circle_bc(patch_id, bc_type)
 
        type(integer_field), dimension(1:num_dims,1:2), intent(inout) :: bc_type
        integer, intent(in)                                           :: patch_id
        integer                                                       :: j, k
 
        if (patch_bc(patch_id)%dir == 1) then
            y_centroid = patch_bc(patch_id)%centroid(2)
            z_centroid = patch_bc(patch_id)%centroid(3)
            radius = patch_bc(patch_id)%radius
            ! Patch is a circle at x_beg and x_beg is a domain boundary
# 89 "/home/runner/work/MFC/MFC/src/pre_process/m_boundary_conditions.fpp"
                if (patch_bc(patch_id)%loc == -1 .and. bc_x%beg < 0) then
                    do k = 0, p
                        do j = 0, n
                            if ((z_cc(k) - z_centroid)**2._wp + (y_cc(j) - y_centroid)**2._wp <= radius**2._wp) then
                                bc_type(1, 1)%sf(0, j, k) = patch_bc(patch_id)%type
                            end if
                        end do
                    end do
                end if
# 89 "/home/runner/work/MFC/MFC/src/pre_process/m_boundary_conditions.fpp"
                if (patch_bc(patch_id)%loc == 1 .and. bc_x%end < 0) then
                    do k = 0, p
                        do j = 0, n
                            if ((z_cc(k) - z_centroid)**2._wp + (y_cc(j) - y_centroid)**2._wp <= radius**2._wp) then
                                bc_type(1, 2)%sf(0, j, k) = patch_bc(patch_id)%type
                            end if
                        end do
                    end do
                end if
# 99 "/home/runner/work/MFC/MFC/src/pre_process/m_boundary_conditions.fpp"
        end if
        if (patch_bc(patch_id)%dir == 2) then
            x_centroid = patch_bc(patch_id)%centroid(1)
            z_centroid = patch_bc(patch_id)%centroid(3)
            radius = patch_bc(patch_id)%radius
            ! Patch is a circle at y_beg and y_beg is a domain boundary
# 106 "/home/runner/work/MFC/MFC/src/pre_process/m_boundary_conditions.fpp"
                if (patch_bc(patch_id)%loc == -1 .and. bc_y%beg < 0) then
                    do k = 0, p
                        do j = 0, m
                            if ((z_cc(k) - z_centroid)**2._wp + (x_cc(j) - x_centroid)**2._wp <= radius**2._wp) then
                                bc_type(2, 1)%sf(j, 0, k) = patch_bc(patch_id)%type
                            end if
                        end do
                    end do
                end if
# 106 "/home/runner/work/MFC/MFC/src/pre_process/m_boundary_conditions.fpp"
                if (patch_bc(patch_id)%loc == 1 .and. bc_y%end < 0) then
                    do k = 0, p
                        do j = 0, m
                            if ((z_cc(k) - z_centroid)**2._wp + (x_cc(j) - x_centroid)**2._wp <= radius**2._wp) then
                                bc_type(2, 2)%sf(j, 0, k) = patch_bc(patch_id)%type
                            end if
                        end do
                    end do
                end if
# 116 "/home/runner/work/MFC/MFC/src/pre_process/m_boundary_conditions.fpp"
        end if
        if (patch_bc(patch_id)%dir == 3) then
            x_centroid = patch_bc(patch_id)%centroid(1)
            y_centroid = patch_bc(patch_id)%centroid(2)
            radius = patch_bc(patch_id)%radius
# 122 "/home/runner/work/MFC/MFC/src/pre_process/m_boundary_conditions.fpp"
                if (patch_bc(patch_id)%loc == -1 .and. bc_z%beg < 0) then
                    do k = 0, n
                        do j = 0, m
                            if ((y_cc(k) - y_centroid)**2._wp + (x_cc(j) - x_centroid)**2._wp <= radius**2._wp) then
                                bc_type(3, 1)%sf(j, k, 0) = patch_bc(patch_id)%type
                            end if
                        end do
                    end do
                end if
# 122 "/home/runner/work/MFC/MFC/src/pre_process/m_boundary_conditions.fpp"
                if (patch_bc(patch_id)%loc == 1 .and. bc_z%end < 0) then
                    do k = 0, n
                        do j = 0, m
                            if ((y_cc(k) - y_centroid)**2._wp + (x_cc(j) - x_centroid)**2._wp <= radius**2._wp) then
                                bc_type(3, 2)%sf(j, k, 0) = patch_bc(patch_id)%type
                            end if
                        end do
                    end do
                end if
# 132 "/home/runner/work/MFC/MFC/src/pre_process/m_boundary_conditions.fpp"
        end if
 
    end subroutine s_circle_bc
 
    !> Apply a rectangular boundary condition patch on a domain face in 3D.
    impure subroutine s_rectangle_bc(patch_id, bc_type)
 
        type(integer_field), dimension(1:num_dims,1:2), intent(inout) :: bc_type
        integer, intent(in)                                           :: patch_id
        integer                                                       :: j, k
 
        if (patch_bc(patch_id)%dir == 1) then
            y_centroid = patch_bc(patch_id)%centroid(2)
            z_centroid = patch_bc(patch_id)%centroid(3)
            length_y = patch_bc(patch_id)%length(2)
            length_z = patch_bc(patch_id)%length(3)
 
            y_boundary%beg = y_centroid - 0.5_wp*length_y
            y_boundary%end = y_centroid + 0.5_wp*length_y
 
            z_boundary%beg = z_centroid - 0.5_wp*length_z
            z_boundary%end = z_centroid + 0.5_wp*length_z
            ! Patch is a rectangle on the x-boundary face
# 156 "/home/runner/work/MFC/MFC/src/pre_process/m_boundary_conditions.fpp"
                if (patch_bc(patch_id)%loc == -1 .and. bc_x%beg < 0) then
                    do k = 0, p
                        do j = 0, n
                            if (y_boundary%beg <= y_cc(j) .and. y_boundary%end >= y_cc(j) .and. z_boundary%beg <= z_cc(k) &
                                & .and. z_boundary%end >= z_cc(k)) then
                                bc_type(1, 1)%sf(0, j, k) = patch_bc(patch_id)%type
                            end if
                        end do
                    end do
                end if
# 156 "/home/runner/work/MFC/MFC/src/pre_process/m_boundary_conditions.fpp"
                if (patch_bc(patch_id)%loc == 1 .and. bc_x%end < 0) then
                    do k = 0, p
                        do j = 0, n
                            if (y_boundary%beg <= y_cc(j) .and. y_boundary%end >= y_cc(j) .and. z_boundary%beg <= z_cc(k) &
                                & .and. z_boundary%end >= z_cc(k)) then
                                bc_type(1, 2)%sf(0, j, k) = patch_bc(patch_id)%type
                            end if
                        end do
                    end do
                end if
# 167 "/home/runner/work/MFC/MFC/src/pre_process/m_boundary_conditions.fpp"
        end if
        if (patch_bc(patch_id)%dir == 2) then
            x_centroid = patch_bc(patch_id)%centroid(1)
            z_centroid = patch_bc(patch_id)%centroid(3)
            length_x = patch_bc(patch_id)%length(1)
            length_z = patch_bc(patch_id)%length(3)
 
            x_boundary%beg = x_centroid - 0.5_wp*length_x
            x_boundary%end = x_centroid + 0.5_wp*length_x
 
            z_boundary%beg = z_centroid - 0.5_wp*length_z
            z_boundary%end = z_centroid + 0.5_wp*length_z
            ! Patch is a rectangle on the y-boundary face
# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_boundary_conditions.fpp"
                if (patch_bc(patch_id)%loc == -1 .and. bc_y%beg < 0) then
                    do k = 0, p
                        do j = 0, m
                            if (x_boundary%beg <= x_cc(j) .and. x_boundary%end >= x_cc(j) .and. z_boundary%beg <= z_cc(k) &
                                & .and. z_boundary%end >= z_cc(k)) then
                                bc_type(2, 1)%sf(j, 0, k) = patch_bc(patch_id)%type
                            end if
                        end do
                    end do
                end if
# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_boundary_conditions.fpp"
                if (patch_bc(patch_id)%loc == 1 .and. bc_y%end < 0) then
                    do k = 0, p
                        do j = 0, m
                            if (x_boundary%beg <= x_cc(j) .and. x_boundary%end >= x_cc(j) .and. z_boundary%beg <= z_cc(k) &
                                & .and. z_boundary%end >= z_cc(k)) then
                                bc_type(2, 2)%sf(j, 0, k) = patch_bc(patch_id)%type
                            end if
                        end do
                    end do
                end if
# 192 "/home/runner/work/MFC/MFC/src/pre_process/m_boundary_conditions.fpp"
        end if
        if (patch_bc(patch_id)%dir == 3) then
            x_centroid = patch_bc(patch_id)%centroid(1)
            y_centroid = patch_bc(patch_id)%centroid(2)
            length_x = patch_bc(patch_id)%length(1)
            length_y = patch_bc(patch_id)%length(2)
 
            x_boundary%beg = x_centroid - 0.5_wp*length_x
            x_boundary%end = x_centroid + 0.5_wp*length_x
 
            y_boundary%beg = y_centroid - 0.5_wp*length_y
            y_boundary%end = y_centroid + 0.5_wp*length_y
# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_boundary_conditions.fpp"
                if (patch_bc(patch_id)%loc == -1 .and. bc_z%beg < 0) then
                    do k = 0, n
                        do j = 0, m
                            if (x_boundary%beg <= x_cc(j) .and. x_boundary%end >= x_cc(j) .and. y_boundary%beg <= y_cc(k) &
                                & .and. y_boundary%end >= y_cc(k)) then
                                bc_type(3, 1)%sf(j, k, 0) = patch_bc(patch_id)%type
                            end if
                        end do
                    end do
                end if
# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_boundary_conditions.fpp"
                if (patch_bc(patch_id)%loc == 1 .and. bc_z%end < 0) then
                    do k = 0, n
                        do j = 0, m
                            if (x_boundary%beg <= x_cc(j) .and. x_boundary%end >= x_cc(j) .and. y_boundary%beg <= y_cc(k) &
                                & .and. y_boundary%end >= y_cc(k)) then
                                bc_type(3, 2)%sf(j, k, 0) = patch_bc(patch_id)%type
                            end if
                        end do
                    end do
                end if
# 216 "/home/runner/work/MFC/MFC/src/pre_process/m_boundary_conditions.fpp"
        end if
 
    end subroutine s_rectangle_bc
 
    !> Iterate over all boundary condition patches and dispatch them by geometry type.
    impure subroutine s_apply_boundary_patches(q_prim_vf, bc_type)
 
        type(scalar_field), dimension(sys_size)        :: q_prim_vf
        type(integer_field), dimension(1:num_dims,1:2) :: bc_type
        integer                                        :: i
 
        !> Apply 2D patches to 3D domain
 
        if (p > 0) then
            do i = 1, num_bc_patches
                if (proc_rank == 0) then
                    print *, 'Processing boundary condition patch', i
                end if
 
                if (patch_bc(i)%geometry == 2) then
                    call s_circle_bc(i, bc_type)
                else if (patch_bc(i)%geometry == 3) then
                    call s_rectangle_bc(i, bc_type)
                end if
            end do
            !> Apply 1D patches to 2D domain
        else if (n > 0) then
            do i = 1, num_bc_patches
                if (proc_rank == 0) then
                    print *, 'Processing boundary condition patch', i
                end if
 
                if (patch_bc(i)%geometry == 1) then
                    call s_line_segment_bc(i, bc_type)
                end if
            end do
        end if
 
    end subroutine s_apply_boundary_patches
 
end module m_boundary_conditions