dbnfac Subroutine

private subroutine dbnfac(w, nroww, nrow, nbandl, nbandu, iflag)

Arguments

Type IntentOptional AttributesName
real(kind=wp), intent(inout), dimension(nroww,nrow):: w

work array. See header for details.

integer, intent(in) :: nroww

row dimension of the work array w. must be >= nbandl + 1 + nbandu.

integer, intent(in) :: nrow

matrix order

integer, intent(in) :: nbandl

number of bands of a below the main diagonal

integer, intent(in) :: nbandu

number of bands of a above the main diagonal

integer, intent(out) :: iflag

indicating success(=1) or failure (=2)


Called by

proc~~dbnfac~~CalledByGraph proc~dbnfac dbnfac proc~dbintk dbintk proc~dbintk->proc~dbnfac

Contents

Source Code


Source Code

    subroutine dbnfac(w,nroww,nrow,nbandl,nbandu,iflag)

    integer,intent(in) :: nroww   !! row dimension of the work array w. must be >= nbandl + 1 + nbandu.
    integer,intent(in) :: nrow    !! matrix order
    integer,intent(in) :: nbandl  !! number of bands of a below the main diagonal
    integer,intent(in) :: nbandu  !! number of bands of a above the main diagonal
    integer,intent(out) :: iflag  !! indicating success(=1) or failure (=2)
    real(wp),dimension(nroww,nrow),intent(inout) :: w  !! work array. See header for details.

    integer :: i, ipk, j, jmax, k, kmax, middle, midmk, nrowm1
    real(wp) :: factor, pivot

    iflag = 1
    middle = nbandu + 1   ! w(middle,.) contains the main diagonal of a.
    nrowm1 = nrow - 1

    if (nrowm1 < 0) then
        iflag = 2
        return
    elseif (nrowm1 == 0) then
        if (w(middle,nrow)==0.0_wp) iflag = 2
        return
    endif

    if (nbandl<=0) then
        ! a is upper triangular. check that diagonal is nonzero .
        do i=1,nrowm1
            if (w(middle,i)==0.0_wp) then
                iflag = 2
                return
            endif
        enddo
        if (w(middle,nrow)==0.0_wp) iflag = 2
        return
    endif

    if (nbandu<=0) then
        ! a is lower triangular. check that diagonal is nonzero and
        ! divide each column by its diagonal.
        do i=1,nrowm1
            pivot = w(middle,i)
            if (pivot==0.0_wp) then
                iflag = 2
                return
            endif
            jmax = min(nbandl,nrow-i)
            do j=1,jmax
                w(middle+j,i) = w(middle+j,i)/pivot
            enddo
        enddo
        return
    endif

    ! a is not just a triangular matrix. construct lu factorization
    do i=1,nrowm1
        ! w(middle,i)  is pivot for i-th step .
        pivot = w(middle,i)
        if (pivot==0.0_wp) then
            iflag = 2
            return
        endif
        ! jmax is the number of (nonzero) entries in column i
        ! below the diagonal.
        jmax = min(nbandl,nrow-i)
        ! divide each entry in column i below diagonal by pivot.
        do j=1,jmax
            w(middle+j,i) = w(middle+j,i)/pivot
        enddo
        ! kmax is the number of (nonzero) entries in row i to
        ! the right of the diagonal.
        kmax = min(nbandu,nrow-i)
        ! subtract a(i,i+k)*(i-th column) from (i+k)-th column
        ! (below row i).
        do k=1,kmax
            ipk = i + k
            midmk = middle - k
            factor = w(midmk,ipk)
            do j=1,jmax
                w(midmk+j,ipk) = w(midmk+j,ipk) - w(middle+j,i)*factor
            enddo
        enddo
    enddo

    ! check the last diagonal entry.
    if (w(middle,nrow)==0.0_wp) iflag = 2

    endsubroutine dbnfac