| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| integer(kind=ip), | intent(in) | :: | nzpiv | |||
| integer(kind=ip), | intent(out) | :: | nzchng | |||
| integer(kind=ip), | intent(inout) | :: | indr(nzpiv) | |||
| integer(kind=ip), | intent(in) | :: | lenold(nzpiv) | |||
| integer(kind=ip), | intent(in) | :: | lennew(*) | |||
| integer(kind=ip), | intent(inout) | :: | iqloc(*) | |||
| integer(kind=ip), | intent(inout) | :: | q(*) | |||
| integer(kind=ip), | intent(inout) | :: | iqinv(*) |
subroutine lu1pq2( nzpiv, nzchng, indr, lenold, lennew, iqloc, q, iqinv ) integer(ip), intent(in) :: nzpiv integer(ip), intent(in) :: lenold(nzpiv), lennew(*) integer(ip), intent(inout) :: indr(nzpiv), iqloc(*), q(*), iqinv(*) integer(ip), intent(out) :: nzchng !=============================================================== ! lu1pq2 frees the space occupied by the pivot row, ! and updates the column permutation q. ! ! Also used to free the pivot column and update the row perm p. ! ! nzpiv (input) is the length of the pivot row (or column). ! nzchng (output) is the net change in total nonzeros. ! ! 14 Apr 1989: First version. ! ! 10 Jan 2010: First f90 version. ! 12 Dec 2011: Declare intent and local variables. !=============================================================== integer(ip) :: j, jnew, l, lnew, lr, next, nz, nznew nzchng = 0 do lr = 1, nzpiv j = indr(lr) indr(lr) = 0 nz = lenold(lr) nznew = lennew(j) if (nz /= nznew) then l = iqinv(j) nzchng = nzchng + (nznew - nz) ! l above is the position of column j in q (so j = q(l)). if (nz < nznew) then ! Column j has to move toward the end of q. 110 next = nz + 1 lnew = iqloc(next) - 1 if (lnew /= l) then jnew = q(lnew) q(l) = jnew iqinv(jnew) = l end if l = lnew iqloc(next) = lnew nz = next if (nz < nznew) go to 110 else ! Column j has to move toward the front of q. 120 lnew = iqloc(nz) if (lnew /= l) then jnew = q(lnew) q(l) = jnew iqinv(jnew) = l end if l = lnew iqloc(nz) = lnew + 1 nz = nz - 1 if (nz > nznew) go to 120 end if q(lnew) = j iqinv(j) = lnew end if end do end subroutine lu1pq2