subroutine lu7add( m, n, jadd, v, lena, luparm, parmlu, &
lenL, lenU, lrow, nrank, &
a, indr, p, lenr, locr, &
inform, klast, vnorm )
integer(ip), intent(in) :: m, n, jadd, lena, nrank, &
p(m)
integer(ip), intent(inout) :: luparm(30), lenL, lenU, lrow, &
indr(lena), lenr(m), locr(m)
real(rp), intent(inout) :: parmlu(30), a(lena), v(m)
integer(ip), intent(out) :: inform, klast
real(rp), intent(out) :: vnorm
!------------------------------------------------------------------
! lu7add inserts the first nrank elements of the vector v(*)
! as column jadd of U. We assume that U does not yet have any
! entries in this column.
! Elements no larger than parmlu(3) are treated as zero.
! klast will be set so that the last row to be affected
! (in pivotal order) is row p(klast).
!
! 09 May 1988: First f77 version.
! 13 Dec 2011: First f90 version.
! 20 Dec 2015: ilast is now output by lu1rec.
!------------------------------------------------------------------
integer(ip) :: i, ilast, j, k, leni, l, lr1, lr2, minfre, nfree
real(rp) :: small
small = parmlu(3)
vnorm = zero
klast = 0
do k = 1, nrank
i = p(k)
if (abs(v(i)) <= small) cycle
klast = k
vnorm = vnorm + abs(v(i))
leni = lenr(i)
! Compress row file if necessary.
minfre = leni + 1
nfree = lena - lenL - lrow
if (nfree < minfre) then
call lu1rec( m, .true., luparm, lrow, ilast, &
lena, a, indr, lenr, locr )
nfree = lena - lenL - lrow
if (nfree < minfre) go to 970
end if
! Move row i to the end of the row file,
! unless it is already there.
! No need to move if there is a gap already.
if (leni == 0) locr(i) = lrow + 1
lr1 = locr(i)
lr2 = lr1 + leni - 1
if (lr2 == lrow) go to 150
if (indr(lr2+1) == 0) go to 180
locr(i) = lrow + 1
do l = lr1, lr2
lrow = lrow + 1
a(lrow) = a(l)
j = indr(l)
indr(l) = 0
indr(lrow) = j
end do
150 lr2 = lrow
lrow = lrow + 1
! Add the element of v.
180 lr2 = lr2 + 1
a(lr2) = v(i)
indr(lr2) = jadd
lenr(i) = leni + 1
lenU = lenU + 1
end do
! Normal exit.
inform = 0
go to 990
! Not enough storage.
970 inform = 7
990 return
end subroutine lu7add