subroutine lu1mxr( mark, k1, k2, m, n, lena, inform, &
a, indc, lenc, locc, indr, lenr, locr, &
p, markc, markr, Amaxr )
integer(ip), intent(in) :: mark, k1, k2, m, n, lena
integer(ip), intent(out) :: inform
integer(ip), intent(in) :: indc(lena), lenc(n), locc(n), &
indr(lena), lenr(m), locr(m), p(k2)
real(rp), intent(in) :: a(lena)
integer(ip), intent(inout) :: markc(n), markr(m)
real(rp), intent(inout) :: Amaxr(m)
!------------------------------------------------------------------
! lu1mxr finds the largest element in each of rows i = p(k1:k2)
! and stores it in each Amaxr(i).
! The nonzeros are stored column-wise in (a,indc,lenc,locc)
! and their structure is row-wise in ( indr,lenr,locr).
!
! 11 Jun 2002: First version of lu1mxr.
! Allow for empty columns.
! 10 Jan 2010: First f90 version.
! 12 Dec 2011: Declare intent.
! 03 Apr 2013: Recoded to improve efficiency. Need new arrays
! markc(n), markr(m) and local array cols(n).
!
! First call: mark = 0, k1 = 1, k2 = m.
! Initialize all of markc(n), markr(m), Amaxr(m).
! Columns are searched only once.
! cols(n) is not used.
!
! Later: mark := mark + 1 (greater than for previous call).
! Cols involved in rows p(k1:k2) are searched only once.
! cols(n) is local storage.
! markc(:), markr(:) are marked (= mark) in some places.
! For next call with new mark,
! all of markc, markr will initially appear unmarked.
! 28 Sep 2015: inform is now an output to mean i is invalid.
!------------------------------------------------------------------
integer(ip) :: cols(n)
integer(ip) :: i, j, k, lc, lc1, lc2, lr, lr1, lr2, ncol
inform = 0
if (mark == 0) then ! First call: Find Amaxr(1:m) for original A.
markr(1:m) = 0
markc(1:n) = 0
Amaxr(1:m) = zero
do j = 1, n
lc1 = locc(j)
lc2 = lc1 + lenc(j) - 1
do lc = lc1, lc2
i = indc(lc)
Amaxr(i) = max( Amaxr(i), abs(a(lc)) )
end do
end do
else ! Later calls: Find Amaxr(i) for rows i = p(k1:k2).
ncol = 0
do k = k1, k2 ! Search rows to find which cols are involved.
i = p(k)
markr(i) = mark ! Mark this row
Amaxr(i) = zero
lr1 = locr(i)
lr2 = lr1 + lenr(i) - 1
do lr = lr1, lr2 ! Mark all unmarked cols in this row.
j = indr(lr) ! Build up a list of which ones they are.
if (markc(j) /= mark) then
markc(j) = mark
ncol = ncol + 1
cols(ncol)= j
end if
end do
end do
do k = 1, ncol ! Search involved columns.
j = cols(k)
lc1 = locc(j)
lc2 = lc1 + lenc(j) - 1
do lc = lc1, lc2
i = indc(lc)
! 25 Sep 2015: Check for invalid i that would cause a crash.
! if (i > m) then
! write(*,*) 'lu1mxr fatal error: i =', i
! inform = 10
! return
! end if
if (markr(i) == mark) then
Amaxr(i) = max( Amaxr(i), abs(a(lc)) )
end if
end do
end do
end if
end subroutine lu1mxr