| Type | Intent | Optional | 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 |
subroutine Hdown ( 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 !================================================================== ! Hdown updates heap by moving down 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 Hdown. ! 12 Dec 2011: First f90 version. !================================================================== integer(ip) :: j, jj, jv, k, N2 real(rp) :: v k = kk hops = 0 v = Ha(k) jv = Hj(k) N2 = N/2 do if (k > N2) exit hops = hops + 1 j = k+k if (j < N) then if (Ha(j) < Ha(j+1)) j = j+1 end if if (v >= Ha(j)) exit Ha(k) = Ha(j) jj = Hj(j) Hj(k) = jj Hk(jj) = k k = j end do Ha(k) = v Hj(k) = jv Hk(jv) = k end subroutine Hdown