subroutine lu7zap( m, n, jzap, kzap, lena, lenU, lrow, nrank, &
a, indr, p, q, lenr, locr )
integer(ip), intent(in) :: m, n, jzap, lena, nrank, &
p(m)
integer(ip), intent(inout) :: lenU, lrow, &
indr(lena), q(n), lenr(m), locr(m)
real(rp), intent(inout) :: a(lena)
integer(ip), intent(out) :: kzap
!------------------------------------------------------------------
! lu7zap eliminates all nonzeros in column jzap of U.
! It also sets kzap to the position of jzap in pivotal order.
! Thus, on exit we have q(kzap) = jzap.
!
! -- Jul 1987: nrank added.
! 10 May 1988: First f77 version.
! 13 Dec 2011: First f90 version.
!------------------------------------------------------------------
integer(ip) :: i, k, leni, l, lr1, lr2
do k = 1, nrank
i = p(k)
leni = lenr(i)
if (leni == 0) go to 90
lr1 = locr(i)
lr2 = lr1 + leni - 1
do l = lr1, lr2
if (indr(l) == jzap) go to 60
end do
go to 90
! Delete the old element.
60 a(l) = a(lr2)
indr(l) = indr(lr2)
indr(lr2) = 0
lenr(i) = leni - 1
lenU = lenU - 1
! Stop if we know there are no more rows containing jzap.
90 kzap = k
if (q(k) == jzap) go to 800
end do
! nrank must be smaller than n because we haven't found kzap yet.
do k = nrank+1, n
kzap = k
if (q(k) == jzap) exit
end do
! See if we zapped the last element in the file.
800 if (lrow > 0) then
if (indr(lrow) == 0) lrow = lrow - 1
end if
end subroutine lu7zap