Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
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) |
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