00001
00002 c
00003 c Copyright (c) 1986,1987,1988,1989,1990,1991,1992,1993,
00004 c by Steve McMillan, Drexel University, Philadelphia, PA.
00005 c
00006 c All rights reserved.
00007 c
00008 c Redistribution and use in source and binary forms are permitted
00009 c provided that the above copyright notice and this paragraph are
00010 c duplicated in all such forms and that any documentation,
00011 c advertising materials, and other materials related to such
00012 c distribution and use acknowledge that the software was developed
00013 c by the author named above.
00014 c
00015 c THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
00016 c IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
00017 c WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
00018 c
00019
00020 c------------------------------------------------------------------------
00021 c
00022 c Sort routines, from "Numerical Recipes."
00023 c
00024 c------------------------------------------------------------------------
00025
00026 subroutine sort(n,a)
00027 c
00028 c Sort the real array a.
00029 c
00030 implicit real (a-h,o-z)
00031 dimension a(n)
00032 c
00033 if (n.le.1) return
00034 c
00035 l=n/2+1
00036 ir=n
00037 10 continue
00038 if(l.gt.1)then
00039 l=l-1
00040 aa=a(l)
00041 else
00042 aa=a(ir)
00043 a(ir)=a(1)
00044 ir=ir-1
00045 if(ir.eq.1)then
00046 a(1)=aa
00047 return
00048 end if
00049 end if
00050 i=l
00051 j=l+l
00052 20 if(j.le.ir)then
00053 if(j.lt.ir)then
00054 if(a(j).lt.a(j+1))j=j+1
00055 end if
00056 if(aa.lt.a(j))then
00057 a(i)=a(j)
00058 i=j
00059 j=j+j
00060 else
00061 j=ir+1
00062 end if
00063 go to 20
00064 end if
00065 a(i)=aa
00066 go to 10
00067 c
00068 end
00069
00070
00071 subroutine sort2(n,a,b)
00072 c
00073 c Sort the real array a, carrying the real array b along
00074 c in the process.
00075 c
00076 implicit real (a-h,o-z)
00077 dimension a(n),b(n)
00078 c
00079 if (n.le.1) return
00080 c
00081 l=n/2+1
00082 ir=n
00083 10 continue
00084 if(l.gt.1)then
00085 l=l-1
00086 aa=a(l)
00087 bb = b(l)
00088 else
00089 aa=a(ir)
00090 bb = b(ir)
00091 a(ir)=a(1)
00092 b(ir) = b(1)
00093 ir=ir-1
00094 if(ir.eq.1)then
00095 a(1)=aa
00096 b(1) = bb
00097 return
00098 end if
00099 end if
00100 i=l
00101 j=l+l
00102 20 if(j.le.ir)then
00103 if(j.lt.ir)then
00104 if(a(j).lt.a(j+1))j=j+1
00105 end if
00106 if(aa.lt.a(j))then
00107 a(i)=a(j)
00108 b(i) = b(j)
00109 i=j
00110 j=j+j
00111 else
00112 j=ir+1
00113 end if
00114 go to 20
00115 end if
00116 a(i)=aa
00117 b(i) = bb
00118 go to 10
00119 c
00120 end
00121
00122
00123 subroutine sort3(n,a,b,c)
00124 c
00125 c Sort the real array a, carrying the real arrays b and c along
00126 c in the process.
00127 c
00128 implicit real (a-h,o-z)
00129 dimension a(n),b(n),c(n)
00130 c
00131 if (n.le.1) return
00132 c
00133 l=n/2+1
00134 ir=n
00135 10 continue
00136 if(l.gt.1)then
00137 l = l-1
00138 aa = a(l)
00139 bb = b(l)
00140 cc = c(l)
00141 else
00142 aa = a(ir)
00143 bb = b(ir)
00144 cc = c(ir)
00145 a(ir) = a(1)
00146 b(ir) = b(1)
00147 c(ir) = c(1)
00148 ir = ir-1
00149 if(ir.eq.1)then
00150 a(1)=aa
00151 b(1) = bb
00152 c(1) = cc
00153 return
00154 end if
00155 end if
00156 i=l
00157 j=l+l
00158 20 if(j.le.ir)then
00159 if(j.lt.ir)then
00160 if (a(j).lt.a(j+1)) j=j+1
00161 end if
00162 if(aa.lt.a(j))then
00163 a(i) = a(j)
00164 b(i) = b(j)
00165 c(i) = c(j)
00166 i=j
00167 j=j+j
00168 else
00169 j=ir+1
00170 end if
00171 go to 20
00172 end if
00173 a(i) = aa
00174 b(i) = bb
00175 c(i) = cc
00176 go to 10
00177 c
00178 end
