Hup Subroutine

private subroutine Hup(Ha, Hj, Hk, N, Nk, kk, hops)

Arguments

Type IntentOptional Attributes Name
real(kind=rp), intent(inout) :: Ha(N)
integer(kind=ip), intent(inout) :: Hj(N)
integer(kind=ip), intent(inout) :: Hk(Nk)
integer(kind=ip), intent(in) :: N
integer(kind=ip), intent(in) :: Nk
integer(kind=ip), intent(in) :: kk
integer(kind=ip), intent(out) :: hops

Called by

proc~~hup~~CalledByGraph proc~hup lusol::Hup proc~hchange lusol::Hchange proc~hchange->proc~hup proc~hinsert lusol::Hinsert proc~hinsert->proc~hup proc~hbuild lusol::Hbuild proc~hbuild->proc~hinsert proc~hdelete lusol::Hdelete proc~hdelete->proc~hchange proc~lu1fad lusol::lu1fad proc~lu1fad->proc~hchange proc~lu1fad->proc~hbuild proc~lu1fad->proc~hdelete 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 Hup   ( Ha, Hj, Hk, N, Nk, kk, hops )

    integer(ip),   intent(in)    :: N, Nk, kk
    integer(ip),   intent(inout) :: Hj(N), Hk(Nk)
    real(rp),      intent(inout) :: Ha(N)
    integer(ip),   intent(out)   :: hops

    !==================================================================
    ! Hup updates heap by moving up tree from node k.
    !
    ! 01 May 2002: Need Nk for length of Hk.
    ! 05 May 2002: Change input parameter k to kk to stop k being output.
    ! 05 May 2002: Current version of Hup.
    ! 13 Dec 2011: First f90 version.
    !==================================================================

    integer(ip) :: j, jv, k, k2
    real(rp)    :: v

    k     = kk
    hops  = 0
    v     = Ha(k)
    jv    = Hj(k)

    do
       if (k <  2) exit
       k2    = k/2
       if (v < Ha(k2)) exit
       hops  = hops + 1
       Ha(k) = Ha(k2)
       j     = Hj(k2)
       Hj(k) =  j
       Hk(j) =  k
       k     = k2
    end do

    Ha(k)  =  v
    Hj(k)  = jv
    Hk(jv) =  k

  end subroutine Hup