lu1mxc Subroutine

private subroutine lu1mxc(k1, k2, q, a, indc, lenc, locc)

Arguments

Type IntentOptional Attributes Name
integer(kind=ip), intent(in) :: k1
integer(kind=ip), intent(in) :: k2
integer(kind=ip), intent(in) :: q(k2)
real(kind=rp), intent(inout) :: a(*)
integer(kind=ip), intent(inout) :: indc(*)
integer(kind=ip), intent(in) :: lenc(*)
integer(kind=ip), intent(in) :: locc(*)

Called by

proc~~lu1mxc~~CalledByGraph proc~lu1mxc lusol::lu1mxc proc~lu1fad lusol::lu1fad proc~lu1fad->proc~lu1mxc 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 lu1mxc( k1, k2, q, a, indc, lenc, locc )

    integer(ip),   intent(in)    :: k1, k2
    integer(ip),   intent(in)    :: q(k2), lenc(*), locc(*)
    integer(ip),   intent(inout) :: indc(*)
    real(rp),      intent(inout) :: a(*)

    !------------------------------------------------------------------
    ! lu1mxc  moves the largest element in each of columns q(k1:k2)
    ! to the top of its column.
    ! If k1 > k2, nothing happens.
    !
    ! 06 May 2002: (and earlier)
    !              All columns k1:k2 must have one or more elements.
    ! 07 May 2002: Allow for empty columns.  The heap routines need to
    !              find 0.0 as the "largest element".
    !
    ! 10 Jan 2010: First f90 version.
    ! 12 Dec 2011: Declare intent.
    ! 13 Dec 2015: BUG!  We can't set a(lc1) = zero for an empty col.
    !              We need to fix the heap routines another way.
    !              Here, fixed the case lenc(j) = 0.
    !------------------------------------------------------------------

    integer(ip)            :: i, j, k, l, lc, lc1, lc2
    real(rp)               :: amax

    do k = k1, k2
       j      = q(k)
       lc1    = locc(j)

       ! The next 10 lines are equivalent to
       ! l      = idamax( lenc(j), a(lc1), 1 )  +  lc1 - 1
       ! >>>>>>>>
       lc2    = lc1 + lenc(j) - 1
       amax   = zero
       l      = lc1

       do lc = lc1, lc2
          if (amax < abs( a(lc) )) then
             amax   =  abs( a(lc) )
             l      =  lc
          end if
       end do
       ! >>>>>>>>

       ! Note that empty columns do nothing (l = lc1).
       if (l > lc1) then
          amax      = a(l)
          a(l)      = a(lc1)
          a(lc1)    = amax
          i         = indc(l)
          indc(l)   = indc(lc1)
          indc(lc1) = i
       end if
    end do

  end subroutine lu1mxc