1! 2! SLATEC: public domain 3! 4*deck isort 5 subroutine isorti(ix,n,kflag) 6! 7! modified: auxiliary array was dropped 8! 9C***BEGIN PROLOGUE ISORT 10C***PURPOSE Sort an array and optionally make the same interchanges in 11C an auxiliary array. The array may be sorted in increasing 12C or decreasing order. A slightly modified QUICKSORT 13C algorithm is used. 14C***LIBRARY SLATEC 15C***CATEGORY N6A2A 16C***TYPE INTEGER (SSORT-S, DSORT-D, ISORT-I) 17C***KEYWORDS SINGLETON QUICKSORT, SORT, SORTING 18C***AUTHOR Jones, R. E., (SNLA) 19C Kahaner, D. K., (NBS) 20C Wisniewski, J. A., (SNLA) 21C***DESCRIPTION 22C 23C ISORT sorts array IX and optionally makes the same interchanges in 24C array IY. The array IX may be sorted in increasing order or 25C decreasing order. A slightly modified quicksort algorithm is used. 26C 27C Description of Parameters 28C IX(2,*) - integer array of values to be sorted 29C IX(1,*) - integer array to be (optionally) carried along 30C N - number of values in integer array IX to be sorted 31C KFLAG - control parameter 32C = 2 means sort IX(2,*) in increasing order and carry IX(1,*) 33C along. 34C = 1 means sort IX(2,*) in increasing order (ignoring IX(1,*)) 35C = -1 means sort IX(2,*) in decreasing order (ignoring IX(1,*)) 36C = -2 means sort IX(2,*) in decreasing order and carry IX(1,*) 37C along. 38C 39C***REFERENCES R. C. Singleton, Algorithm 347, An efficient algorithm 40C for sorting with minimal storage, Communications of 41C the ACM, 12, 3 (1969), pp. 185-187. 42C***ROUTINES CALLED XERMSG 43C***REVISION HISTORY (YYMMDD) 44C 761118 DATE WRITTEN 45C 810801 Modified by David K. Kahaner. 46C 890531 Changed all specific intrinsics to generic. (WRB) 47C 890831 Modified array declarations. (WRB) 48C 891009 Removed unreferenced statement labels. (WRB) 49C 891009 REVISION DATE from Version 3.2 50C 891214 Prologue converted to Version 4.0 format. (BAB) 51C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 52C 901012 Declared all variables; changed X,Y to IX,IY. (M. McClain) 53C 920501 Reformatted the REFERENCES section. (DWL, WRB) 54C 920519 Clarified error messages. (DWL) 55C 920801 Declarations section rebuilt and code restructured to use 56C IF-THEN-ELSE-ENDIF. (RWC, WRB) 57! 100411 changed the dimension of IL and IU from 21 to 31. 58! 59! field IL and IU have the dimension 31. This is log2 of the largest 60! array size to be sorted. If arrays larger than 2**31 in length have 61! to be sorted, this dimension has to be modified accordingly 62! 63C***END PROLOGUE ISORT 64! 65 implicit none 66C .. Scalar Arguments .. 67 integer kflag, n 68C .. Array Arguments .. 69 integer ix(2,*) 70C .. Local Scalars .. 71 real r 72 integer i, ij, j, k, kk, l, m, nn, t, tt, tty, ty 73C .. Local Arrays .. 74 integer il(31), iu(31) 75C .. External Subroutines .. 76! EXTERNAL XERMSG 77C .. Intrinsic Functions .. 78 intrinsic abs, int 79C***FIRST EXECUTABLE STATEMENT ISORT 80 nn = n 81 if (nn .lt. 1) then 82! CALL XERMSG ('SLATEC', 'ISORT', 83! + 'The number of values to be sorted is not positive.', 1, 1) 84 return 85 endif 86C 87 kk = abs(kflag) 88 if (kk.ne.1 .and. kk.ne.2) then 89! CALL XERMSG ('SLATEC', 'ISORT', 90! + 'The sort control parameter, K, is not 2, 1, -1, or -2.', 2, 91! + 1) 92 return 93 endif 94C 95C Alter array IX to get decreasing order if needed 96C 97 if (kflag .le. -1) then 98 do 10 i=1,nn 99 ix(2,i) = -ix(2,i) 100 10 continue 101 endif 102C 103 if (kk .eq. 2) go to 100 104C 105C Sort IX only 106C 107 m = 1 108 i = 1 109 j = nn 110 r = 0.375e0 111C 112 20 if (i .eq. j) go to 60 113 if (r .le. 0.5898437e0) then 114 r = r+3.90625e-2 115 else 116 r = r-0.21875e0 117 endif 118C 119 30 k = i 120C 121C Select a central element of the array and save it in location T 122C 123 ij = i + int((j-i)*r) 124 t = ix(2,ij) 125C 126C If first element of array is greater than T, interchange with T 127C 128 if (ix(2,i) .gt. t) then 129 ix(2,ij) = ix(2,i) 130 ix(2,i) = t 131 t = ix(2,ij) 132 endif 133 l = j 134C 135C If last element of array is less than than T, interchange with T 136C 137 if (ix(2,j) .lt. t) then 138 ix(2,ij) = ix(2,j) 139 ix(2,j) = t 140 t = ix(2,ij) 141C 142C If first element of array is greater than T, interchange with T 143C 144 if (ix(2,i) .gt. t) then 145 ix(2,ij) = ix(2,i) 146 ix(2,i) = t 147 t = ix(2,ij) 148 endif 149 endif 150C 151C Find an element in the second half of the array which is smaller 152C than T 153C 154 40 l = l-1 155 if (ix(2,l) .gt. t) go to 40 156C 157C Find an element in the first half of the array which is greater 158C than T 159C 160 50 k = k+1 161 if (ix(2,k) .lt. t) go to 50 162C 163C Interchange these elements 164C 165 if (k .le. l) then 166 tt = ix(2,l) 167 ix(2,l) = ix(2,k) 168 ix(2,k) = tt 169 go to 40 170 endif 171C 172C Save upper and lower subscripts of the array yet to be sorted 173C 174 if (l-i .gt. j-k) then 175 il(m) = i 176 iu(m) = l 177 i = k 178 m = m+1 179 else 180 il(m) = k 181 iu(m) = j 182 j = l 183 m = m+1 184 endif 185 go to 70 186C 187C Begin again on another portion of the unsorted array 188C 189 60 m = m-1 190 if (m .eq. 0) go to 190 191 i = il(m) 192 j = iu(m) 193C 194 70 if (j-i .ge. 1) go to 30 195 if (i .eq. 1) go to 20 196 i = i-1 197C 198 80 i = i+1 199 if (i .eq. j) go to 60 200 t = ix(2,i+1) 201 if (ix(2,i) .le. t) go to 80 202 k = i 203C 204 90 ix(2,k+1) = ix(2,k) 205 k = k-1 206 if (t .lt. ix(2,k)) go to 90 207 ix(2,k+1) = t 208 go to 80 209C 210C Sort IX and carry IY along 211C 212 100 m = 1 213 i = 1 214 j = nn 215 r = 0.375e0 216C 217 110 if (i .eq. j) go to 150 218 if (r .le. 0.5898437e0) then 219 r = r+3.90625e-2 220 else 221 r = r-0.21875e0 222 endif 223C 224 120 k = i 225C 226C Select a central element of the array and save it in location T 227C 228 ij = i + int((j-i)*r) 229 t = ix(2,ij) 230 ty = ix(1,ij) 231C 232C If first element of array is greater than T, interchange with T 233C 234 if (ix(2,i) .gt. t) then 235 ix(2,ij) = ix(2,i) 236 ix(2,i) = t 237 t = ix(2,ij) 238 ix(1,ij) = ix(1,i) 239 ix(1,i) = ty 240 ty = ix(1,ij) 241 endif 242 l = j 243C 244C If last element of array is less than T, interchange with T 245C 246 if (ix(2,j) .lt. t) then 247 ix(2,ij) = ix(2,j) 248 ix(2,j) = t 249 t = ix(2,ij) 250 ix(1,ij) = ix(1,j) 251 ix(1,j) = ty 252 ty = ix(1,ij) 253C 254C If first element of array is greater than T, interchange with T 255C 256 if (ix(2,i) .gt. t) then 257 ix(2,ij) = ix(2,i) 258 ix(2,i) = t 259 t = ix(2,ij) 260 ix(1,ij) = ix(1,i) 261 ix(1,i) = ty 262 ty = ix(1,ij) 263 endif 264 endif 265C 266C Find an element in the second half of the array which is smaller 267C than T 268C 269 130 l = l-1 270 if (ix(2,l) .gt. t) go to 130 271C 272C Find an element in the first half of the array which is greater 273C than T 274C 275 140 k = k+1 276 if (ix(2,k) .lt. t) go to 140 277C 278C Interchange these elements 279C 280 if (k .le. l) then 281 tt = ix(2,l) 282 ix(2,l) = ix(2,k) 283 ix(2,k) = tt 284 tty = ix(1,l) 285 ix(1,l) = ix(1,k) 286 ix(1,k) = tty 287 go to 130 288 endif 289C 290C Save upper and lower subscripts of the array yet to be sorted 291C 292 if (l-i .gt. j-k) then 293 il(m) = i 294 iu(m) = l 295 i = k 296 m = m+1 297 else 298 il(m) = k 299 iu(m) = j 300 j = l 301 m = m+1 302 endif 303 go to 160 304C 305C Begin again on another portion of the unsorted array 306C 307 150 m = m-1 308 if (m .eq. 0) go to 190 309 i = il(m) 310 j = iu(m) 311C 312 160 if (j-i .ge. 1) go to 120 313 if (i .eq. 1) go to 110 314 i = i-1 315C 316 170 i = i+1 317 if (i .eq. j) go to 150 318 t = ix(2,i+1) 319 ty = ix(1,i+1) 320 if (ix(2,i) .le. t) go to 170 321 k = i 322C 323 180 ix(2,k+1) = ix(2,k) 324 ix(1,k+1) = ix(1,k) 325 k = k-1 326 if (t .lt. ix(2,k)) go to 180 327 ix(2,k+1) = t 328 ix(1,k+1) = ty 329 go to 170 330C 331C Clean up 332C 333 190 if (kflag .le. -1) then 334 do 200 i=1,nn 335 ix(2,i) = -ix(2,i) 336 200 continue 337 endif 338 return 339 end 340