--- /dev/null
+c
+c
+c ###################################################
+c ## COPYRIGHT (C) 1990 by Jay William Ponder ##
+c ## All Rights Reserved ##
+c ###################################################
+c
+c #########################################################
+c ## ##
+c ## subroutine sort -- heapsort of an integer array ##
+c ## ##
+c #########################################################
+c
+c
+c "sort" takes an input list of integers and sorts it
+c into ascending order using the Heapsort algorithm
+c
+c
+ subroutine sort (n,list)
+ implicit none
+ integer i,j,k,n
+ integer index,lists
+ integer list(*)
+c
+c
+c perform the heapsort of the input list
+c
+ k = n/2 + 1
+ index = n
+ dowhile (n .gt. 1)
+ if (k .gt. 1) then
+ k = k - 1
+ lists = list(k)
+ else
+ lists = list(index)
+ list(index) = list(1)
+ index = index - 1
+ if (index .le. 1) then
+ list(1) = lists
+ return
+ end if
+ end if
+ i = k
+ j = k + k
+ dowhile (j .le. index)
+ if (j .lt. index) then
+ if (list(j) .lt. list(j+1)) j = j + 1
+ end if
+ if (lists .lt. list(j)) then
+ list(i) = list(j)
+ i = j
+ j = j + j
+ else
+ j = index + 1
+ end if
+ end do
+ list(i) = lists
+ end do
+ return
+ end
+c
+c
+c ##############################################################
+c ## ##
+c ## subroutine sort2 -- heapsort of real array with keys ##
+c ## ##
+c ##############################################################
+c
+c
+c "sort2" takes an input list of reals and sorts it
+c into ascending order using the Heapsort algorithm;
+c it also returns a key into the original ordering
+c
+c
+ subroutine sort2 (n,list,key)
+ implicit none
+ integer i,j,k,n
+ integer index,keys
+ integer key(*)
+ real*8 lists
+ real*8 list(*)
+c
+c
+c initialize index into the original ordering
+c
+ do i = 1, n
+ key(i) = i
+ end do
+c
+c perform the heapsort of the input list
+c
+ k = n/2 + 1
+ index = n
+ dowhile (n .gt. 1)
+ if (k .gt. 1) then
+ k = k - 1
+ lists = list(k)
+ keys = key(k)
+ else
+ lists = list(index)
+ keys = key(index)
+ list(index) = list(1)
+ key(index) = key(1)
+ index = index - 1
+ if (index .le. 1) then
+ list(1) = lists
+ key(1) = keys
+ return
+ end if
+ end if
+ i = k
+ j = k + k
+ dowhile (j .le. index)
+ if (j .lt. index) then
+ if (list(j) .lt. list(j+1)) j = j + 1
+ end if
+ if (lists .lt. list(j)) then
+ list(i) = list(j)
+ key(i) = key(j)
+ i = j
+ j = j + j
+ else
+ j = index + 1
+ end if
+ end do
+ list(i) = lists
+ key(i) = keys
+ end do
+ return
+ end
+c
+c
+c #################################################################
+c ## ##
+c ## subroutine sort3 -- heapsort of integer array with keys ##
+c ## ##
+c #################################################################
+c
+c
+c "sort3" takes an input list of integers and sorts it
+c into ascending order using the Heapsort algorithm;
+c it also returns a key into the original ordering
+c
+c
+ subroutine sort3 (n,list,key)
+ implicit none
+ integer i,j,k,n
+ integer index
+ integer lists
+ integer keys
+ integer list(*)
+ integer key(*)
+c
+c
+c initialize index into the original ordering
+c
+ do i = 1, n
+ key(i) = i
+ end do
+c
+c perform the heapsort of the input list
+c
+ k = n/2 + 1
+ index = n
+ dowhile (n .gt. 1)
+ if (k .gt. 1) then
+ k = k - 1
+ lists = list(k)
+ keys = key(k)
+ else
+ lists = list(index)
+ keys = key(index)
+ list(index) = list(1)
+ key(index) = key(1)
+ index = index - 1
+ if (index .le. 1) then
+ list(1) = lists
+ key(1) = keys
+ return
+ end if
+ end if
+ i = k
+ j = k + k
+ dowhile (j .le. index)
+ if (j .lt. index) then
+ if (list(j) .lt. list(j+1)) j = j + 1
+ end if
+ if (lists .lt. list(j)) then
+ list(i) = list(j)
+ key(i) = key(j)
+ i = j
+ j = j + j
+ else
+ j = index + 1
+ end if
+ end do
+ list(i) = lists
+ key(i) = keys
+ end do
+ return
+ end
+c
+c
+c #################################################################
+c ## ##
+c ## subroutine sort4 -- heapsort of integer absolute values ##
+c ## ##
+c #################################################################
+c
+c
+c "sort4" takes an input list of integers and sorts it into
+c ascending absolute value using the Heapsort algorithm
+c
+c
+ subroutine sort4 (n,list)
+ implicit none
+ integer i,j,k,n
+ integer index
+ integer lists
+ integer list(*)
+c
+c
+c perform the heapsort of the input list
+c
+ k = n/2 + 1
+ index = n
+ dowhile (n .gt. 1)
+ if (k .gt. 1) then
+ k = k - 1
+ lists = list(k)
+ else
+ lists = list(index)
+ list(index) = list(1)
+ index = index - 1
+ if (index .le. 1) then
+ list(1) = lists
+ return
+ end if
+ end if
+ i = k
+ j = k + k
+ dowhile (j .le. index)
+ if (j .lt. index) then
+ if (abs(list(j)) .lt. abs(list(j+1))) j = j + 1
+ end if
+ if (abs(lists) .lt. abs(list(j))) then
+ list(i) = list(j)
+ i = j
+ j = j + j
+ else
+ j = index + 1
+ end if
+ end do
+ list(i) = lists
+ end do
+ return
+ end
+c
+c
+c ################################################################
+c ## ##
+c ## subroutine sort5 -- heapsort of integer array modulo m ##
+c ## ##
+c ################################################################
+c
+c
+c "sort5" takes an input list of integers and sorts it
+c into ascending order based on each value modulo "m"
+c
+c
+ subroutine sort5 (n,list,m)
+ implicit none
+ integer i,j,k,m,n
+ integer index,smod
+ integer jmod,j1mod
+ integer lists
+ integer list(*)
+c
+c
+c perform the heapsort of the input list
+c
+ k = n/2 + 1
+ index = n
+ dowhile (n .gt. 1)
+ if (k .gt. 1) then
+ k = k - 1
+ lists = list(k)
+ else
+ lists = list(index)
+ list(index) = list(1)
+ index = index - 1
+ if (index .le. 1) then
+ list(1) = lists
+ return
+ end if
+ end if
+ i = k
+ j = k + k
+ dowhile (j .le. index)
+ if (j .lt. index) then
+ jmod = mod(list(j),m)
+ j1mod = mod(list(j+1),m)
+ if (jmod .lt. j1mod) then
+ j = j + 1
+ else if (jmod.eq.j1mod .and. list(j).lt.list(j+1)) then
+ j = j + 1
+ end if
+ end if
+ smod = mod(lists,m)
+ jmod = mod(list(j),m)
+ if (smod .lt. jmod) then
+ list(i) = list(j)
+ i = j
+ j = j + j
+ else if (smod.eq.jmod .and. lists.lt.list(j)) then
+ list(i) = list(j)
+ i = j
+ j = j + j
+ else
+ j = index + 1
+ end if
+ end do
+ list(i) = lists
+ end do
+ return
+ end
+c
+c
+c #############################################################
+c ## ##
+c ## subroutine sort6 -- heapsort of a text string array ##
+c ## ##
+c #############################################################
+c
+c
+c "sort6" takes an input list of character strings and sorts
+c it into alphabetical order using the Heapsort algorithm
+c
+c
+ subroutine sort6 (n,list)
+ implicit none
+ integer i,j,k,n
+ integer index
+ character*256 lists
+ character*(*) list(*)
+c
+c
+c perform the heapsort of the input list
+c
+ k = n/2 + 1
+ index = n
+ dowhile (n .gt. 1)
+ if (k .gt. 1) then
+ k = k - 1
+ lists = list(k)
+ else
+ lists = list(index)
+ list(index) = list(1)
+ index = index - 1
+ if (index .le. 1) then
+ list(1) = lists
+ return
+ end if
+ end if
+ i = k
+ j = k + k
+ dowhile (j .le. index)
+ if (j .lt. index) then
+ if (list(j) .lt. list(j+1)) j = j + 1
+ end if
+ if (lists .lt. list(j)) then
+ list(i) = list(j)
+ i = j
+ j = j + j
+ else
+ j = index + 1
+ end if
+ end do
+ list(i) = lists
+ end do
+ return
+ end
+c
+c
+c ################################################################
+c ## ##
+c ## subroutine sort7 -- heapsort of text strings with keys ##
+c ## ##
+c ################################################################
+c
+c
+c "sort7" takes an input list of character strings and sorts it
+c into alphabetical order using the Heapsort algorithm; it also
+c returns a key into the original ordering
+c
+c
+ subroutine sort7 (n,list,key)
+ implicit none
+ integer i,j,k,n
+ integer index
+ integer keys
+ integer key(*)
+ character*256 lists
+ character*(*) list(*)
+c
+c
+c initialize index into the original ordering
+c
+ do i = 1, n
+ key(i) = i
+ end do
+c
+c perform the heapsort of the input list
+c
+ k = n/2 + 1
+ index = n
+ dowhile (n .gt. 1)
+ if (k .gt. 1) then
+ k = k - 1
+ lists = list(k)
+ keys = key(k)
+ else
+ lists = list(index)
+ keys = key(index)
+ list(index) = list(1)
+ key(index) = key(1)
+ index = index - 1
+ if (index .le. 1) then
+ list(1) = lists
+ key(1) = keys
+ return
+ end if
+ end if
+ i = k
+ j = k + k
+ dowhile (j .le. index)
+ if (j .lt. index) then
+ if (list(j) .lt. list(j+1)) j = j + 1
+ end if
+ if (lists .lt. list(j)) then
+ list(i) = list(j)
+ key(i) = key(j)
+ i = j
+ j = j + j
+ else
+ j = index + 1
+ end if
+ end do
+ list(i) = lists
+ key(i) = keys
+ end do
+ return
+ end
+c
+c
+c #########################################################
+c ## ##
+c ## subroutine sort8 -- heapsort to unique integers ##
+c ## ##
+c #########################################################
+c
+c
+c "sort8" takes an input list of integers and sorts it into
+c ascending order using the Heapsort algorithm, duplicate
+c values are removed from the final sorted list
+c
+c
+ subroutine sort8 (n,list)
+ implicit none
+ integer i,j,k,n
+ integer index
+ integer lists
+ integer list(*)
+c
+c
+c perform the heapsort of the input list
+c
+ k = n/2 + 1
+ index = n
+ dowhile (n .gt. 1)
+ if (k .gt. 1) then
+ k = k - 1
+ lists = list(k)
+ else
+ lists = list(index)
+ list(index) = list(1)
+ index = index - 1
+ if (index .le. 1) then
+ list(1) = lists
+c
+c remove duplicate values from final list
+c
+ j = 1
+ do i = 2, n
+ if (list(i-1) .ne. list(i)) then
+ j = j + 1
+ list(j) = list(i)
+ end if
+ end do
+ if (j .lt. n) n = j
+ return
+ end if
+ end if
+ i = k
+ j = k + k
+ dowhile (j .le. index)
+ if (j .lt. index) then
+ if (list(j) .lt. list(j+1)) j = j + 1
+ end if
+ if (lists .lt. list(j)) then
+ list(i) = list(j)
+ i = j
+ j = j + j
+ else
+ j = index + 1
+ end if
+ end do
+ list(i) = lists
+ end do
+ return
+ end
+c
+c
+c #############################################################
+c ## ##
+c ## subroutine sort9 -- heapsort to unique text strings ##
+c ## ##
+c #############################################################
+c
+c
+c "sort9" takes an input list of character strings and sorts
+c it into alphabetical order using the Heapsort algorithm,
+c duplicate values are removed from the final sorted list
+c
+c
+ subroutine sort9 (n,list)
+ implicit none
+ integer i,j,k,n
+ integer index
+ character*256 lists
+ character*(*) list(*)
+c
+c
+c perform the heapsort of the input list
+c
+ k = n/2 + 1
+ index = n
+ dowhile (n .gt. 1)
+ if (k .gt. 1) then
+ k = k - 1
+ lists = list(k)
+ else
+ lists = list(index)
+ list(index) = list(1)
+ index = index - 1
+ if (index .le. 1) then
+ list(1) = lists
+c
+c remove duplicate values from final list
+c
+ j = 1
+ do i = 2, n
+ if (list(i-1) .ne. list(i)) then
+ j = j + 1
+ list(j) = list(i)
+ end if
+ end do
+ if (j .lt. n) n = j
+ return
+ end if
+ end if
+ i = k
+ j = k + k
+ dowhile (j .le. index)
+ if (j .lt. index) then
+ if (list(j) .lt. list(j+1)) j = j + 1
+ end if
+ if (lists .lt. list(j)) then
+ list(i) = list(j)
+ i = j
+ j = j + j
+ else
+ j = index + 1
+ end if
+ end do
+ list(i) = lists
+ end do
+ return
+ end
projects / unres.git / blobdiff