Heapsort Algorithm

[gjw1684]

Good evening,

I'm currently writing a program that uses the heapsort algorithm to sort a very large two-dimensional array. However, I'm having problems with the program.

What I'm attempting to do is to sort the second column of a two dimensional array. So for instance, suppose that I sort this 2D array:

123 48
32 203
134 94
294 49
... ..

The end result would be

123 48
294 49
134 94
32 203
... ...

Here is my code:

Program heapsort

Implicit None

integer, parameter:: column = 2
integer, parameter:: n = 10000
integer :: i, ir, j, l
integer :: status
real, dimension(n,column) :: ra, temp

open (unit=9,file='test.txt',status='old',iostat=status )
open (unit=10, file='result.txt',status='replace')

if (status == 0) then
read(9,*,iostat=status) ((temp(i,j),j=1,column),i=1,n)

ra = temp

l = (n/2)+1
ir = n
10 continue
if (l.gt.1) then
l = l-1
temp(l,2) = ra(l,2)
else
temp(ir,2)= ra(ir,2)
ra(ir,2) = ra(1,2)
ir = ir-1
if (ir.eq.1) then
ra(1,2) = temp(1,2)
continue
end if
end if
i=l
j=l+1
20 if (j.le.ir) then
if (j.lt.ir) then
if(ra(j,2).lt.ra(j+1,2)) j=j+1
end if
if (temp(j,2).lt.ra(j,2)) then
ra(i,2) = ra(j,2)
i=j
j=j+j
else
j=ir+1
end if
go to 20
end if
ra(i,2) = temp(i,2)
go to 10

end if

write(10,*) ra
end program heapsort


When I run this program, I get an error that the array subscript was out-of-bounds. Any suggestions?

 

[CJason]

Step 1: Get rid of GOTO's ;-)

Step 2: How do you ever get out of this loop? In other words, how do you ever get to 'write(10,*) ra'? If you figure that out, you'll probably fix the "out of bounds" issue.

 

[ArkM]

See

http://www.nr.com/forum/showthread.php?t=902

Check your code (from NR?) - j=l+1 must be j=l+l.
Moral: NEVER use small letter l as a name...

 

[gjw1684]

Good evening,

Well I've looked through the program and I've fixed the array subscript issue, but I have another issue. Here's how my code looks now

Program heapsort

Implicit None

integer, parameter:: column = 2
integer, parameter:: n = 6
integer :: i, j, status, error, m
real, dimension(n,column) :: array, temp
m = 2

open (unit=9, file='test.txt',status='old',iostat=status )
open (unit=10, file='result.txt',status='replace')

if (status == 0) then
read(9,*, iostat=status) ((temp(i,j),j=1,column),i=1,n)
array = temp

CALL heapsort_real_sgl ( array, n, m, error )

write(10,*) array

end if
end program heapsort

SUBROUTINE heapsort_real_sgl ( array, n, m, error )

IMPLICIT NONE

! Declare local parameters
INTEGER, PARAMETER :: kind = SELECTED_REAL_KIND(p=6) ! Precision

! Declare calling arguments
INTEGER, INTENT(IN) :: n, m ! Size of array to sort
REAL(KIND=kind), DIMENSION(n,m), INTENT(INOUT) :: array
REAL(KIND=kind),DIMENSION(n,m)::temp
INTEGER, INTENT(OUT) :: error ! Error flag:
! 0 = success
! 1 = n <= 0

! List of local variables:
INTEGER :: i ! Index variable
INTEGER :: ir ! Retirement phase pointer
INTEGER :: j ! Index variable
INTEGER :: L ! Hiring phase pointer

! Check for error.
IF ( n <= 0 ) THEN

! Set error code and get out.
error = 1

ELSE IF ( n == 1 ) THEN

! no sort required, but no error either. With only one
! value, it's already sorted!
error = 0

ELSE

L = n / 2 + 1
ir = n
10 CONTINUE
IF ( L > 1 ) THEN
L = L - 1
temp(L,2) = array(L,2)
ELSE
temp(L,2) = array(ir,2)
array(ir,2) = array(1,2)
ir = ir - 1
IF ( ir == 1 ) THEN
!
! All done. Store final value.
!
array(1,2) = temp(1,2)
!
! Clear error code and exit.
!
error = 0
GO TO 9999
!
END IF
END IF
I = L
J = L + L
!
! Sift down TEMP to its proper level.
!
20 IF ( J <= ir ) THEN
IF ( J < ir ) THEN
IF ( array(J,2) < array(J+1,2) ) J = J + 1
END IF
IF ( temp(J,2) < array(J,2) ) THEN
array(I,2) = array(J,2)
I = J
J = J + J
ELSE
J = ir + 1
END IF
GO TO 20
END IF
array(I,2) = temp(I,2)
GO TO 10
END IF
!
9999 CONTINUE
END SUBROUTINE heapsort_real_sgl

When I run this program, I get an error that says an array is undefined and it points to this line:

IF ( temp(J,2) < array(J,2) ) THEN

Does anyone know why this is undefined in the above loop?

 

[ArkM]

Alas, your rewriting (retyping?) of Numerical Recipes heapsort source is wrong. No need in temp array: you need temporary pair of number variables to save a row of Nx2 matrix (rra var in NR source). You must move these pairs, not only 2nd column values.

Please, compare your code with NR source and adopt 1D array sort more carefully.

Please, use CODE tag to present your snippets (see Process TGML link on the form).