mirror of https://github.com/sharkdp/bat
Add Fortran (Fixed Form) syntax test file
parent
702b5caf2d
commit
b02120cf66
@ -0,0 +1,25 @@
|
|||||||
|
The `quicksort_real_F77.F` file has been added from https://github.com/jasonanema/Quicksort_Fortran77 under the following license:
|
||||||
|
|
||||||
|
```text
|
||||||
|
MIT License
|
||||||
|
|
||||||
|
Copyright (c) 2019 Jason Anema
|
||||||
|
|
||||||
|
Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
|
of this software and associated documentation files (the "Software"), to deal
|
||||||
|
in the Software without restriction, including without limitation the rights
|
||||||
|
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
||||||
|
copies of the Software, and to permit persons to whom the Software is
|
||||||
|
furnished to do so, subject to the following conditions:
|
||||||
|
|
||||||
|
The above copyright notice and this permission notice shall be included in all
|
||||||
|
copies or substantial portions of the Software.
|
||||||
|
|
||||||
|
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||||
|
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||||
|
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||||
|
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||||
|
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||||
|
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
||||||
|
SOFTWARE.
|
||||||
|
```
|
@ -0,0 +1,323 @@
|
|||||||
|
C Fortran 77 implementation of a quicksort algorithm for arrays with
|
||||||
|
C real entries.
|
||||||
|
C ----------
|
||||||
|
C June 2019
|
||||||
|
C Jason Allen Anema, Ph.D.
|
||||||
|
C Division of Statistical Genomics
|
||||||
|
C Department of Genetics
|
||||||
|
C Washington University School of Medicine in St. Louis
|
||||||
|
C
|
||||||
|
C This work is partially supported NIH grant AG023746
|
||||||
|
C ----------
|
||||||
|
C Insertion sort is used for short arrays, as quicksort is slower on
|
||||||
|
C these.
|
||||||
|
C
|
||||||
|
C Hoare partition scheme is used (sweeping left and right), as it does
|
||||||
|
C three times fewer swaps on average that the Lamuto partition scheme.
|
||||||
|
C In conjunction with this, tripartite partition is performed
|
||||||
|
C concurrently (solving the "Dutch National Flag problem"). This avoids
|
||||||
|
C horrible runtimes on highly repetitive arrays. For example, without
|
||||||
|
C this, an array of random zeros and ones would have a runtime of
|
||||||
|
C O(N^2), but now has a runtime of O(N). The runtime for this algorthm
|
||||||
|
C on arrays with k highly repetitive entries is now O(kN).
|
||||||
|
C
|
||||||
|
C For medium length (sub)arrays, pivots are choosen using
|
||||||
|
C Median-of-Three, and those three items are sorted. For longer (sub)arrays
|
||||||
|
C the pseudomedian of nine (Median of medians). This avoids O(N^2) runtime on
|
||||||
|
C nonrandom inputs such as increasing and decreasing sequences.
|
||||||
|
C
|
||||||
|
C See Louis Bentley, Jon & McIlroy, Douglas. (1993). Engineering a Sort Function.
|
||||||
|
C Softw., Pract. Exper.. 23. 1249-1265. 10.1002/spe.4380231105 for details.
|
||||||
|
C
|
||||||
|
C The ordering on elements of the array are defined by a comparison
|
||||||
|
C function,compar, that is a user-supplied INTEGER*2 function of the form
|
||||||
|
C compar(a,b) which returns:
|
||||||
|
C -1 if a precedes b
|
||||||
|
C +1 if b precedes a
|
||||||
|
C 0 is a and b are considered equivalent
|
||||||
|
C and thus defines a total ordering.
|
||||||
|
C
|
||||||
|
C If one would like to use the standard order on integers, the
|
||||||
|
C compar function could be written in a file "compint.F" as:
|
||||||
|
C ----------------------------------------------------------------
|
||||||
|
C INTEGER*2 FUNCTION compint(a,b)
|
||||||
|
C INTEGER a, b
|
||||||
|
C if(a.lt.b)then
|
||||||
|
C compint = -1
|
||||||
|
C elseif(a.gt.b)then
|
||||||
|
C compint = +1
|
||||||
|
C else
|
||||||
|
C compint = 0
|
||||||
|
C endif
|
||||||
|
C END
|
||||||
|
C ----------------------------------------------------------------
|
||||||
|
C Then in your program, call quicksort with:
|
||||||
|
C call quicksort_real_F77(array, n, compint)
|
||||||
|
C
|
||||||
|
C The maximal length of an array in this implementation is (2^31-1),
|
||||||
|
C but can be changed to allow for length up to (2^63-1) by changing the
|
||||||
|
C data types of the relevant variables and constants. If you wish to
|
||||||
|
C sort longer arrays, of length N, you'll need to customize variable
|
||||||
|
C and constant types and set mstack to be at least (2*log_2(N)+2).
|
||||||
|
C
|
||||||
|
C ----------------------------------------------------------------
|
||||||
|
C Copyright 2019 Jason Allen Anema
|
||||||
|
C
|
||||||
|
C Permission is hereby granted, free of charge, to any person obtaining
|
||||||
|
C a copy of this software and associated documentation files (the "Software"),
|
||||||
|
C to deal in the Software without restriction, including without limitation the
|
||||||
|
C rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||||
|
C sell copies of the Software, and to permit persons to whom the Software is
|
||||||
|
C furnished to do so, subject to the following conditions:
|
||||||
|
C
|
||||||
|
C The above copyright notice and this permission notice shall be included
|
||||||
|
C in all copies or substantial portions of the Software.
|
||||||
|
C
|
||||||
|
C THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
|
||||||
|
C OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||||
|
C FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
|
||||||
|
C THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||||
|
C LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||||
|
C FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||||
|
C IN THE SOFTWARE.
|
||||||
|
C -------------------------------------------------------------------
|
||||||
|
C
|
||||||
|
SUBROUTINE quicksort_real_F77(array,n,compar)
|
||||||
|
INTEGER n, maxins, maxmid, mstack
|
||||||
|
REAL array(n)
|
||||||
|
PARAMETER (maxins = 7, maxmid = 40, mstack = 128)
|
||||||
|
C maxins: maximal size of (sub)arrays to be sorted with
|
||||||
|
C insertion sort.
|
||||||
|
C maxmid: maximal size of (sub)arrays that will be quicksorted with
|
||||||
|
C Median-of-Three pivots.
|
||||||
|
C mstack: maximal size of required auxiliary storage (a stack), plus 2
|
||||||
|
C extra spots, which tracks the starts and ends of yet unsorted
|
||||||
|
C subarrays. mstack = 130 is large enough to handle arrays up to
|
||||||
|
C length 2^63-1. This maximal size follows from
|
||||||
|
C processing smaller arrays first and pigeonhole principal.
|
||||||
|
C
|
||||||
|
INTEGER a, d, i, j, k, s, lo, mid, hi, tstack, bstack(mstack)
|
||||||
|
C a, d, i, j, k, s: indices
|
||||||
|
C lo, mid, and hi: their natural location in a (sub)array
|
||||||
|
C tstack: equal to twice the number of additional subarrays still
|
||||||
|
C needing to be sorted
|
||||||
|
C bstack: stack of the endpoints of unsorted subarrays
|
||||||
|
INTEGER pm1, pm2, pm3, pm4, pm5, pm6, pm7, pm8, pm9
|
||||||
|
C for pseudomedian of nine positions in (sub)arrays
|
||||||
|
REAL piv, temp
|
||||||
|
C piv is to store the pivot's value
|
||||||
|
C
|
||||||
|
EXTERNAL compar
|
||||||
|
INTEGER*2 compar
|
||||||
|
C compar is a user-supplied INTEGER*2 function of the form
|
||||||
|
C compar(a,b) which returns:
|
||||||
|
C -1 if a precedes b
|
||||||
|
C +1 if b precedes a
|
||||||
|
C 0 is a and b are considered equivalent
|
||||||
|
C and thus defines a total ordering.
|
||||||
|
tstack = 0
|
||||||
|
lo = 1
|
||||||
|
hi = n
|
||||||
|
C
|
||||||
|
C Insertion sort subarrays of size maxins or less
|
||||||
|
1 if(hi-lo+1.le.maxins)then
|
||||||
|
do 10, i = lo + 1, hi, 1
|
||||||
|
temp = array(i)
|
||||||
|
do 11 j = i - 1, lo, -1
|
||||||
|
if(compar(array(j), temp).le.0)goto 2
|
||||||
|
array(j+1)=array(j)
|
||||||
|
11 continue
|
||||||
|
j = lo - 1
|
||||||
|
2 array(j+1) = temp
|
||||||
|
10 continue
|
||||||
|
if(tstack.eq.0)return
|
||||||
|
C Pop the bstack, and start new partitioning
|
||||||
|
hi = bstack(tstack)
|
||||||
|
lo = bstack(tstack-1)
|
||||||
|
tstack = tstack - 2
|
||||||
|
else
|
||||||
|
C Use Median-of-Three as choice of pivot (median of lo, middle, hi)
|
||||||
|
C and reorder those elements appropriately when subarrays are medium
|
||||||
|
C length (between maxins and maxmid)
|
||||||
|
mid = lo + (hi-lo)/2
|
||||||
|
if(hi-lo.le.maxmid)then
|
||||||
|
if(compar(array(mid), array(lo)).eq.-1)then
|
||||||
|
temp = array(lo)
|
||||||
|
array(lo) = array(mid)
|
||||||
|
array(mid) = temp
|
||||||
|
endif
|
||||||
|
if(compar(array(hi), array(lo)).eq.-1)then
|
||||||
|
temp = array(hi)
|
||||||
|
array(hi) = array(lo)
|
||||||
|
array(lo) = temp
|
||||||
|
endif
|
||||||
|
if(compar(array(hi), array(mid)).eq.-1)then
|
||||||
|
temp = array(hi)
|
||||||
|
array(hi) = array(mid)
|
||||||
|
array(mid) = temp
|
||||||
|
endif
|
||||||
|
C Use pseudomedian of nine (Median of medians) as choice of pivot when
|
||||||
|
C subarrays are longer than maxmid. Note that doing it this way requires only 12
|
||||||
|
C comparisons for finding the pivot.
|
||||||
|
elseif(hi-lo+1.gt.maxmid)then
|
||||||
|
pm1 = lo
|
||||||
|
pm5 = lo + (hi-lo)/2
|
||||||
|
pm9 = hi
|
||||||
|
pm3 = lo + (pm5-lo)/2
|
||||||
|
pm7 = pm5 + (hi-pm5)/2
|
||||||
|
pm2 = lo + (pm3-lo)/2
|
||||||
|
pm4 = pm3 + (pm5-pm3)/2
|
||||||
|
pm6 = pm5 + (pm7-pm5)/2
|
||||||
|
pm8 = pm7 + (pm9-pm7)/2
|
||||||
|
C Median and sorting for pm1, pm2, pm3
|
||||||
|
if(compar(array(pm2), array(pm1)).eq.-1)then
|
||||||
|
temp = array(pm1)
|
||||||
|
array(pm1) = array(pm2)
|
||||||
|
array(pm2) = temp
|
||||||
|
endif
|
||||||
|
if(compar(array(pm3), array(pm1)).eq.-1)then
|
||||||
|
temp = array(pm3)
|
||||||
|
array(pm3) = array(pm1)
|
||||||
|
array(pm1) = temp
|
||||||
|
endif
|
||||||
|
if(compar(array(pm3), array(pm2)).eq.-1)then
|
||||||
|
temp = array(pm3)
|
||||||
|
array(pm3) = array(pm2)
|
||||||
|
array(pm2) = temp
|
||||||
|
endif
|
||||||
|
C Median and sorting for pm4, pm5, pm6
|
||||||
|
if(compar(array(pm5), array(pm4)).eq.-1)then
|
||||||
|
temp = array(pm4)
|
||||||
|
array(pm4) = array(pm5)
|
||||||
|
array(pm5) = temp
|
||||||
|
endif
|
||||||
|
if(compar(array(pm6), array(pm4)).eq.-1)then
|
||||||
|
temp = array(pm6)
|
||||||
|
array(pm6) = array(pm4)
|
||||||
|
array(pm4) = temp
|
||||||
|
endif
|
||||||
|
if(compar(array(pm6), array(pm5)).eq.-1)then
|
||||||
|
temp = array(pm6)
|
||||||
|
array(pm6) = array(pm5)
|
||||||
|
array(pm5) = temp
|
||||||
|
endif
|
||||||
|
C Median and sorting for pm7, pm8, pm9
|
||||||
|
if(compar(array(pm8), array(pm7)).eq.-1)then
|
||||||
|
temp = array(pm7)
|
||||||
|
array(pm7) = array(pm8)
|
||||||
|
array(pm8) = temp
|
||||||
|
endif
|
||||||
|
if(compar(array(pm9), array(pm7)).eq.-1)then
|
||||||
|
temp = array(pm9)
|
||||||
|
array(pm9) = array(pm7)
|
||||||
|
array(pm7) = temp
|
||||||
|
endif
|
||||||
|
if(compar(array(pm9), array(pm8)).eq.-1)then
|
||||||
|
temp = array(pm9)
|
||||||
|
array(pm9) = array(pm8)
|
||||||
|
array(pm8) = temp
|
||||||
|
endif
|
||||||
|
C Median of the medians (which are now pm2, pm5, pm8)
|
||||||
|
if(compar(array(pm5), array(pm2)).eq.-1)then
|
||||||
|
temp = array(pm2)
|
||||||
|
array(pm2) = array(pm5)
|
||||||
|
array(pm5) = temp
|
||||||
|
endif
|
||||||
|
if(compar(array(pm8), array(pm2)).eq.-1)then
|
||||||
|
temp = array(pm8)
|
||||||
|
array(pm8) = array(pm2)
|
||||||
|
array(pm2) = temp
|
||||||
|
endif
|
||||||
|
if(compar(array(pm8), array(pm5)).eq.-1)then
|
||||||
|
temp = array(pm8)
|
||||||
|
array(pm8) = array(pm5)
|
||||||
|
array(pm5) = temp
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
C Pivot assigned for medium and long length subarrays.
|
||||||
|
C Note that pm5 = mid
|
||||||
|
piv = array(mid)
|
||||||
|
C Initialize pointers for partitioning
|
||||||
|
i = lo-1
|
||||||
|
j = hi+1
|
||||||
|
C Initialize counts of repeat values of pivot.
|
||||||
|
a = 0
|
||||||
|
d = 0
|
||||||
|
C Beginning of outer loop for placing pivot.
|
||||||
|
3 continue
|
||||||
|
C Scan up to find an element > piv.
|
||||||
|
i = i + 1
|
||||||
|
C Check if pointers crossed.
|
||||||
|
if(j.lt.i)goto 5
|
||||||
|
C Check if i pointer hit hi boundary.
|
||||||
|
if(i.eq.hi)goto 4
|
||||||
|
C
|
||||||
|
if(compar(array(i), piv).eq.-1)goto 3
|
||||||
|
C Check for copies of pivot from scanning right.
|
||||||
|
if(compar(array(i), piv).eq.0)then
|
||||||
|
array(i) = array(lo+a)
|
||||||
|
array(lo+a) = piv
|
||||||
|
a = a + 1
|
||||||
|
goto 3
|
||||||
|
endif
|
||||||
|
C Beginning of innerloop for placing pivot.
|
||||||
|
4 continue
|
||||||
|
C Scan down to find an element < piv.
|
||||||
|
j = j - 1
|
||||||
|
C Check if pointers crossed.
|
||||||
|
if(j.lt.i)goto 5
|
||||||
|
if(compar(array(j), piv).eq.1)goto 4
|
||||||
|
C Check for copies of pivot from scanning left.
|
||||||
|
if(compar(array(j), piv).eq.0)then
|
||||||
|
array(j) = array(hi-d)
|
||||||
|
array(hi-d) = piv
|
||||||
|
d = d + 1
|
||||||
|
goto 4
|
||||||
|
endif
|
||||||
|
C Check if pointers crossed.
|
||||||
|
if(j.lt.i)goto 5
|
||||||
|
C Exchange elements
|
||||||
|
temp = array(i)
|
||||||
|
array(i) = array(j)
|
||||||
|
array(j) = temp
|
||||||
|
C End of outermost loop for placing pivot.
|
||||||
|
goto 3
|
||||||
|
C Insert all copies of pivot in appropriate place
|
||||||
|
5 s = MIN(a, j-lo-a+1)
|
||||||
|
DO 6 k = 1, s
|
||||||
|
array(lo-1+k) = array(i-k)
|
||||||
|
array(i-k) = piv
|
||||||
|
6 CONTINUE
|
||||||
|
s = MIN(d, hi-j-d)
|
||||||
|
DO 7 k = 1, s
|
||||||
|
array(hi+1-k) = array(j+k)
|
||||||
|
array(j+k) = piv
|
||||||
|
7 CONTINUE
|
||||||
|
C Increase effective stack size
|
||||||
|
tstack = tstack + 2
|
||||||
|
C Push pointers to larger subarray on stack for later processing,
|
||||||
|
C process smaller subarray immediately.
|
||||||
|
if(tstack.gt.mstack) THEN
|
||||||
|
WRITE(*,*)'Stack size is too small in quicksort fortran code quicksort_real_F77.F'
|
||||||
|
WRITE(*,*)'Are you sure you want to sort an array this long?'
|
||||||
|
WRITE(*,*)'Your array has more than 2^63-1 entries?'
|
||||||
|
WRITE(*,*)'If so, set mstack parameter to be at least:'
|
||||||
|
WRITE(*,*)'2*ceiling(log_2(N))+2, for N = length of array,'
|
||||||
|
WRITE(*,*)'and recompile this subroutine.'
|
||||||
|
RETURN
|
||||||
|
endif
|
||||||
|
if(hi-j-d-1.ge.j-a-lo)then
|
||||||
|
bstack(tstack) = hi
|
||||||
|
bstack(tstack-1) = MIN(j+d+1, hi)
|
||||||
|
hi=MAX(j-a,lo)
|
||||||
|
else
|
||||||
|
bstack(tstack)=MAX(j-a,lo)
|
||||||
|
bstack(tstack-1)=lo
|
||||||
|
lo=MIN(j+d+1,hi)
|
||||||
|
endif
|
||||||
|
C
|
||||||
|
C end of outermost if statement
|
||||||
|
endif
|
||||||
|
goto 1
|
||||||
|
C END of subroutine quicksort
|
||||||
|
END
|
Loading…
Reference in New Issue