apply_crs_dirichlet_base Subroutine

subroutine apply_crs_dirichlet_base(A, b, is_uniform, edge, value_dirichlet)

Arguments

Type IntentOptional Attributes Name
type(type_crs), intent(inout), optional :: A
real(kind=real64), intent(inout) :: b(:)
logical, intent(in) :: is_uniform
integer(kind=int32), intent(in) :: edge(2)
real(kind=real64), intent(in) :: value_dirichlet

Calls

proc~~apply_crs_dirichlet_base~~CallsGraph proc~apply_crs_dirichlet_base apply_crs_dirichlet_base proc~find_crs type_crs%find_crs proc~apply_crs_dirichlet_base->proc~find_crs

Called by

proc~~apply_crs_dirichlet_base~~CalledByGraph proc~apply_crs_dirichlet_base apply_crs_dirichlet_base proc~apply_crs_thermal_dirichlet apply_crs_thermal_dirichlet proc~apply_crs_thermal_dirichlet->proc~apply_crs_dirichlet_base interface~apply_crs_thermal_dirichlet type_bc_thermal_dirichlet%apply_crs_thermal_dirichlet interface~apply_crs_thermal_dirichlet->proc~apply_crs_thermal_dirichlet

Source Code

    subroutine apply_crs_dirichlet_base(A, b, is_uniform, edge, value_dirichlet)
        implicit none
        type(type_crs), intent(inout), optional :: A
        real(real64), intent(inout) :: b(:)
        logical, intent(in) :: is_uniform
        integer(int32), intent(in) :: edge(2)
        real(real64), intent(in) :: value_dirichlet

        integer(int32) :: i, j, k, p, N
        integer(int32) :: p_idx
        integer(int32) :: ps, pe
        real(real64) :: Aij
        logical, allocatable :: is_dirichlet_node(:)
        integer(int32) :: ind, p1, p2

        if (.not. is_uniform) return

        if (present(A)) then
            N = size(b)

            p1 = Edge(1)
            p2 = Edge(2)

            if (present(A)) then
                call A%find(p1, p1, ind)
                ps = A%ptr(p1)
                pe = A%ptr(p1 + 1) - 1
                A%val(ps:pe) = 0.0d0
                A%val(ind) = 1.0d0

                call A%find(p2, p2, ind)
                ps = A%ptr(p2)
                pe = A%ptr(p2 + 1) - 1
                A%val(ps:pe) = 0.0d0
                A%val(ind) = 1.0d0
            end if

            b(p1) = value_dirichlet
            b(p2) = value_dirichlet
        else
            ! 行列 A がない場合は、b のみを変更
            b(edge(1)) = value_dirichlet
            b(edge(2)) = value_dirichlet
        end if

    end subroutine apply_crs_dirichlet_base