lu1pen Subroutine

private subroutine lu1pen(m, melim, ncold, nspare, ilast, lpivc1, lpivc2, lpivr1, lpivr2, lrow, lenc, lenr, locc, locr, indc, indr, ifill, jfill)

Arguments

Type IntentOptional Attributes Name
integer(kind=ip), intent(in) :: m
integer(kind=ip), intent(in) :: melim
integer(kind=ip), intent(in) :: ncold
integer(kind=ip), intent(in) :: nspare
integer(kind=ip), intent(out) :: ilast
integer(kind=ip), intent(in) :: lpivc1
integer(kind=ip), intent(in) :: lpivc2
integer(kind=ip), intent(in) :: lpivr1
integer(kind=ip), intent(in) :: lpivr2
integer(kind=ip), intent(inout) :: lrow
integer(kind=ip), intent(inout) :: lenc(*)
integer(kind=ip), intent(inout) :: lenr(*)
integer(kind=ip), intent(in) :: locc(*)
integer(kind=ip), intent(inout) :: locr(*)
integer(kind=ip), intent(inout) :: indc(*)
integer(kind=ip), intent(inout) :: indr(*)
integer(kind=ip), intent(in) :: ifill(melim)
integer(kind=ip), intent(in) :: jfill(ncold)

Called by

proc~~lu1pen~~CalledByGraph proc~lu1pen lusol::lu1pen proc~lu1fad lusol::lu1fad proc~lu1fad->proc~lu1pen proc~lu1fac lusol::lu1fac proc~lu1fac->proc~lu1fad proc~solve lusol_ez_module::solve proc~solve->proc~lu1fac proc~test_1 main::test_1 proc~test_1->proc~solve proc~test_2 main::test_2 proc~test_2->proc~solve program~main~2 main program~main~2->proc~test_1 program~main~2->proc~test_2

Source Code

  subroutine lu1pen( m     , melim , ncold , nspare, ilast, &
                     lpivc1, lpivc2, lpivr1, lpivr2, lrow , &
                     lenc  , lenr  , locc  , locr  ,        &
                     indc  , indr  , ifill , jfill )

    integer(ip),   intent(in)    :: m, melim, ncold, nspare, &
                                    lpivc1, lpivc2, lpivr1, lpivr2
    integer(ip),   intent(in)    :: locc(*), ifill(melim), jfill(ncold)
    integer(ip),   intent(inout) :: lrow
    integer(ip),   intent(inout) :: indc(*), indr(*), lenc(*), lenr(*)
    integer(ip),   intent(inout) :: locr(*)
    integer(ip),   intent(out)   :: ilast

    !------------------------------------------------------------------
    ! lu1pen deals with pending fill-in in the row file.
    ! ifill(ll) says if a row involved in the new column of L
    ! has to be updated.  If positive, it is the total
    ! length of the final updated row.
    ! jfill(lu) says if a column involved in the new row of U
    ! contains any pending fill-ins.  If positive, it points
    ! to the first fill-in in the column that has yet to be
    ! added to the row file.
    !
    ! 16 Apr 1989: First version of lu1pen.
    ! 23 Mar 2001: ilast used and updated.
    !
    ! 10 Jan 2010: First f90 version.
    ! 12 Dec 2011: Declare intent.
    ! 14 Jul 2015: (William Gandler) Fix deceptive loop 
    !              do l = lrow + 1, lrow + nspare
    !                 lrow    = l
    !------------------------------------------------------------------

    integer(ip)       :: i, j, l, l1, l2, last, lc, lc1, lc2, ll, lr, lr1, lr2, lu

    ll     = 0

    do lc = lpivc1, lpivc2
       ll = ll + 1
       if (ifill(ll) == 0) cycle

       ! Another row has pending fill.
       ! First, add some spare space at the end
       ! of the current last row.
       ! 14 Jul 2015: (William Gandler) Fix deceptive loop
       !              (same as fix in previous comment)

       l1     = lrow + 1
       l2     = lrow + nspare
       do l = l1, l2
       !  lrow    = l
          indr(l) = 0
       end do
       lrow   = l2

       ! Now move row i to the end of the row file.

       i       = indc(lc)
       ilast   = i
       lr1     = locr(i)
       lr2     = lr1 + lenr(i) - 1
       locr(i) = lrow + 1

       do lr = lr1, lr2
          lrow       = lrow + 1
          indr(lrow) = indr(lr)
          indr(lr)   = 0
       end do

       lrow    = lrow + ifill(ll)
    end do

    ! Scan all columns of  D  and insert the pending fill-in
    ! into the row file.

    lu     = 1

    do lr = lpivr1, lpivr2
       lu     = lu + 1
       if (jfill(lu) == 0) cycle
       j      = indr(lr)
       lc1    = locc(j) + jfill(lu) - 1
       lc2    = locc(j) + lenc(j)   - 1

       do lc = lc1, lc2
          i      = indc(lc) - m
          if (i > 0) then
             indc(lc)   = i
             last       = locr(i) + lenr(i)
             indr(last) = j
             lenr(i)    = lenr(i) + 1
          end if
       end do
    end do

  end subroutine lu1pen