dgbsl Subroutine

private pure subroutine dgbsl(abd, n, ml, mu, ipvt, b)

Solves the banded system A*x = b using the factorization from dgbfa.

History

  • Based on the LINPACK routine DGBSL (Cleve Moler, 1978).

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(in), dimension(2_ip*ml+mu+1_ip,n) :: abd

the factorization from dgbfa
integer(kind=ip), intent(in) :: n

order of the matrix
integer(kind=ip), intent(in) :: ml

number of diagonals below the main diagonal
integer(kind=ip), intent(in) :: mu

number of diagonals above the main diagonal
integer(kind=ip), intent(in), dimension(n) :: ipvt

the pivot indices from dgbfa
real(kind=wp), intent(inout), dimension(n) :: b

IN: the right hand side. OUT: the solution.

Called by

proc~~dgbsl~~CalledByGraph proc~dgbsl dgbsl proc~dbint4 dbint4 proc~dbint4->proc~dgbsl proc~db1ink_alt db1ink_alt proc~db1ink_alt->proc~dbint4 proc~db1ink_alt_2 db1ink_alt_2 proc~db1ink_alt_2->proc~dbint4 interface~db1ink db1ink interface~db1ink->proc~db1ink_alt interface~db1ink->proc~db1ink_alt_2 proc~initialize_1d_auto_knots bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_auto_knots_multi bspline_1d%initialize_1d_auto_knots_multi proc~initialize_1d_auto_knots_multi->interface~db1ink proc~initialize_1d_specify_knots bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink proc~initialize_1d_specify_knots_multi bspline_1d%initialize_1d_specify_knots_multi proc~initialize_1d_specify_knots_multi->interface~db1ink proc~bspline_1d_constructor_auto_knots bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots

Source Code

    pure subroutine dgbsl(abd,n,ml,mu,ipvt,b)

    implicit none

    integer(ip),intent(in)               :: n     !! order of the matrix
    integer(ip),intent(in)               :: ml    !! number of diagonals below the main diagonal
    integer(ip),intent(in)               :: mu    !! number of diagonals above the main diagonal
    real(wp),dimension(2_ip*ml+mu+1_ip,n),intent(in) :: abd  !! the factorization from [[dgbfa]]
    integer(ip),dimension(n),intent(in)  :: ipvt  !! the pivot indices from [[dgbfa]]
    real(wp),dimension(n),intent(inout)  :: b     !! **IN:** the right hand side.
                                                  !! **OUT:** the solution.

    integer(ip) :: i, jk, l, la, lb, lm, m
    real(wp) :: tmp

    m = mu + ml + 1_ip

    ! solve L*y = b
    if (ml/=0_ip) then
        do jk = 1_ip, n-1_ip
            lm = min(ml,n-jk)
            l = ipvt(jk)
            tmp = b(l)
            if (l/=jk) then
                b(l) = b(jk)
                b(jk) = tmp
            end if
            do i = 1_ip, lm
                b(jk+i) = b(jk+i) + tmp*abd(m+i,jk)
            end do
        end do
    end if

    ! solve U*x = y
    do jk = n, 1_ip, -1_ip
        b(jk) = b(jk)/abd(m,jk)
        lm = min(jk,m) - 1_ip
        la = m - lm
        lb = jk - lm
        tmp = -b(jk)
        do i = 0_ip, lm-1_ip
            b(lb+i) = b(lb+i) + tmp*abd(la+i,jk)
        end do
    end do

    end subroutine dgbsl