Added src_Eshel (decoy processing for threading)
[unres.git] / source / unres / src_Eshel / SRC-SURPLUS / sort.f
1 c
2 c
3 c     ###################################################
4 c     ##  COPYRIGHT (C)  1990  by  Jay William Ponder  ##
5 c     ##              All Rights Reserved              ##
6 c     ###################################################
7 c
8 c     #########################################################
9 c     ##                                                     ##
10 c     ##  subroutine sort  --  heapsort of an integer array  ##
11 c     ##                                                     ##
12 c     #########################################################
13 c
14 c
15 c     "sort" takes an input list of integers and sorts it
16 c     into ascending order using the Heapsort algorithm
17 c
18 c
19       subroutine sort (n,list)
20       implicit none
21       integer i,j,k,n
22       integer index,lists
23       integer list(*)
24 c
25 c
26 c     perform the heapsort of the input list
27 c
28       k = n/2 + 1
29       index = n
30       dowhile (n .gt. 1)
31          if (k .gt. 1) then
32             k = k - 1
33             lists = list(k)
34          else
35             lists = list(index)
36             list(index) = list(1)
37             index = index - 1
38             if (index .le. 1) then
39                list(1) = lists
40                return
41             end if
42          end if
43          i = k
44          j = k + k
45          dowhile (j .le. index)
46             if (j .lt. index) then
47                if (list(j) .lt. list(j+1))  j = j + 1
48             end if
49             if (lists .lt. list(j)) then
50                list(i) = list(j)
51                i = j
52                j = j + j
53             else
54                j = index + 1
55             end if
56          end do
57          list(i) = lists
58       end do
59       return
60       end
61 c
62 c
63 c     ##############################################################
64 c     ##                                                          ##
65 c     ##  subroutine sort2  --  heapsort of real array with keys  ##
66 c     ##                                                          ##
67 c     ##############################################################
68 c
69 c
70 c     "sort2" takes an input list of reals and sorts it
71 c     into ascending order using the Heapsort algorithm;
72 c     it also returns a key into the original ordering
73 c
74 c
75       subroutine sort2 (n,list,key)
76       implicit none
77       integer i,j,k,n
78       integer index,keys
79       integer key(*)
80       real*8 lists
81       real*8 list(*)
82 c
83 c
84 c     initialize index into the original ordering
85 c
86       do i = 1, n
87          key(i) = i
88       end do
89 c
90 c     perform the heapsort of the input list
91 c
92       k = n/2 + 1
93       index = n
94       dowhile (n .gt. 1)
95          if (k .gt. 1) then
96             k = k - 1
97             lists = list(k)
98             keys = key(k)
99          else
100             lists = list(index)
101             keys = key(index)
102             list(index) = list(1)
103             key(index) = key(1)
104             index = index - 1
105             if (index .le. 1) then
106                list(1) = lists
107                key(1) = keys
108                return
109             end if
110          end if
111          i = k
112          j = k + k
113          dowhile (j .le. index)
114             if (j .lt. index) then
115                if (list(j) .lt. list(j+1))  j = j + 1
116             end if
117             if (lists .lt. list(j)) then
118                list(i) = list(j)
119                key(i) = key(j)
120                i = j
121                j = j + j
122             else
123                j = index + 1
124             end if
125          end do
126          list(i) = lists
127          key(i) = keys
128       end do
129       return
130       end
131 c
132 c
133 c     #################################################################
134 c     ##                                                             ##
135 c     ##  subroutine sort3  --  heapsort of integer array with keys  ##
136 c     ##                                                             ##
137 c     #################################################################
138 c
139 c
140 c     "sort3" takes an input list of integers and sorts it
141 c     into ascending order using the Heapsort algorithm;
142 c     it also returns a key into the original ordering
143 c
144 c
145       subroutine sort3 (n,list,key)
146       implicit none
147       integer i,j,k,n
148       integer index
149       integer lists
150       integer keys
151       integer list(*)
152       integer key(*)
153 c
154 c
155 c     initialize index into the original ordering
156 c
157       do i = 1, n
158          key(i) = i
159       end do
160 c
161 c     perform the heapsort of the input list
162 c
163       k = n/2 + 1
164       index = n
165       dowhile (n .gt. 1)
166          if (k .gt. 1) then
167             k = k - 1
168             lists = list(k)
169             keys = key(k)
170          else
171             lists = list(index)
172             keys = key(index)
173             list(index) = list(1)
174             key(index) = key(1)
175             index = index - 1
176             if (index .le. 1) then
177                list(1) = lists
178                key(1) = keys
179                return
180             end if
181          end if
182          i = k
183          j = k + k
184          dowhile (j .le. index)
185             if (j .lt. index) then
186                if (list(j) .lt. list(j+1))  j = j + 1
187             end if
188             if (lists .lt. list(j)) then
189                list(i) = list(j)
190                key(i) = key(j)
191                i = j
192                j = j + j
193             else
194                j = index + 1
195             end if
196          end do
197          list(i) = lists
198          key(i) = keys
199       end do
200       return
201       end
202 c
203 c
204 c     #################################################################
205 c     ##                                                             ##
206 c     ##  subroutine sort4  --  heapsort of integer absolute values  ##
207 c     ##                                                             ##
208 c     #################################################################
209 c
210 c
211 c     "sort4" takes an input list of integers and sorts it into
212 c     ascending absolute value using the Heapsort algorithm
213 c
214 c
215       subroutine sort4 (n,list)
216       implicit none
217       integer i,j,k,n
218       integer index
219       integer lists
220       integer list(*)
221 c
222 c
223 c     perform the heapsort of the input list
224 c
225       k = n/2 + 1
226       index = n
227       dowhile (n .gt. 1)
228          if (k .gt. 1) then
229             k = k - 1
230             lists = list(k)
231          else
232             lists = list(index)
233             list(index) = list(1)
234             index = index - 1
235             if (index .le. 1) then
236                list(1) = lists
237                return
238             end if
239          end if
240          i = k
241          j = k + k
242          dowhile (j .le. index)
243             if (j .lt. index) then
244                if (abs(list(j)) .lt. abs(list(j+1)))  j = j + 1
245             end if
246             if (abs(lists) .lt. abs(list(j))) then
247                list(i) = list(j)
248                i = j
249                j = j + j
250             else
251                j = index + 1
252             end if
253          end do
254          list(i) = lists
255       end do
256       return
257       end
258 c
259 c
260 c     ################################################################
261 c     ##                                                            ##
262 c     ##  subroutine sort5  --  heapsort of integer array modulo m  ##
263 c     ##                                                            ##
264 c     ################################################################
265 c
266 c
267 c     "sort5" takes an input list of integers and sorts it
268 c     into ascending order based on each value modulo "m"
269 c
270 c
271       subroutine sort5 (n,list,m)
272       implicit none
273       integer i,j,k,m,n
274       integer index,smod
275       integer jmod,j1mod
276       integer lists
277       integer list(*)
278 c
279 c
280 c     perform the heapsort of the input list
281 c
282       k = n/2 + 1
283       index = n
284       dowhile (n .gt. 1)
285          if (k .gt. 1) then
286             k = k - 1
287             lists = list(k)
288          else
289             lists = list(index)
290             list(index) = list(1)
291             index = index - 1
292             if (index .le. 1) then
293                list(1) = lists
294                return
295             end if
296          end if
297          i = k
298          j = k + k
299          dowhile (j .le. index)
300             if (j .lt. index) then
301                jmod = mod(list(j),m)
302                j1mod = mod(list(j+1),m)
303                if (jmod .lt. j1mod) then
304                   j = j + 1
305                else if (jmod.eq.j1mod .and. list(j).lt.list(j+1)) then
306                   j = j + 1
307                end if
308             end if
309             smod = mod(lists,m)
310             jmod = mod(list(j),m)
311             if (smod .lt. jmod) then
312                list(i) = list(j)
313                i = j
314                j = j + j
315             else if (smod.eq.jmod .and. lists.lt.list(j)) then
316                list(i) = list(j)
317                i = j
318                j = j + j
319             else
320                j = index + 1
321             end if
322          end do
323          list(i) = lists
324       end do
325       return
326       end
327 c
328 c
329 c     #############################################################
330 c     ##                                                         ##
331 c     ##  subroutine sort6  --  heapsort of a text string array  ##
332 c     ##                                                         ##
333 c     #############################################################
334 c
335 c
336 c     "sort6" takes an input list of character strings and sorts
337 c     it into alphabetical order using the Heapsort algorithm
338 c
339 c
340       subroutine sort6 (n,list)
341       implicit none
342       integer i,j,k,n
343       integer index
344       character*256 lists
345       character*(*) list(*)
346 c
347 c
348 c     perform the heapsort of the input list
349 c
350       k = n/2 + 1
351       index = n
352       dowhile (n .gt. 1)
353          if (k .gt. 1) then
354             k = k - 1
355             lists = list(k)
356          else
357             lists = list(index)
358             list(index) = list(1)
359             index = index - 1
360             if (index .le. 1) then
361                list(1) = lists
362                return
363             end if
364          end if
365          i = k
366          j = k + k
367          dowhile (j .le. index)
368             if (j .lt. index) then
369                if (list(j) .lt. list(j+1))  j = j + 1
370             end if
371             if (lists .lt. list(j)) then
372                list(i) = list(j)
373                i = j
374                j = j + j
375             else
376                j = index + 1
377             end if
378          end do
379          list(i) = lists
380       end do
381       return
382       end
383 c
384 c
385 c     ################################################################
386 c     ##                                                            ##
387 c     ##  subroutine sort7  --  heapsort of text strings with keys  ##
388 c     ##                                                            ##
389 c     ################################################################
390 c
391 c
392 c     "sort7" takes an input list of character strings and sorts it
393 c     into alphabetical order using the Heapsort algorithm; it also
394 c     returns a key into the original ordering
395 c
396 c
397       subroutine sort7 (n,list,key)
398       implicit none
399       integer i,j,k,n
400       integer index
401       integer keys
402       integer key(*)
403       character*256 lists
404       character*(*) list(*)
405 c
406 c
407 c     initialize index into the original ordering
408 c
409       do i = 1, n
410          key(i) = i
411       end do
412 c
413 c     perform the heapsort of the input list
414 c
415       k = n/2 + 1
416       index = n
417       dowhile (n .gt. 1)
418          if (k .gt. 1) then
419             k = k - 1
420             lists = list(k)
421             keys = key(k)
422          else
423             lists = list(index)
424             keys = key(index)
425             list(index) = list(1)
426             key(index) = key(1)
427             index = index - 1
428             if (index .le. 1) then
429                list(1) = lists
430                key(1) = keys
431                return
432             end if
433          end if
434          i = k
435          j = k + k
436          dowhile (j .le. index)
437             if (j .lt. index) then
438                if (list(j) .lt. list(j+1))  j = j + 1
439             end if
440             if (lists .lt. list(j)) then
441                list(i) = list(j)
442                key(i) = key(j)
443                i = j
444                j = j + j
445             else
446                j = index + 1
447             end if
448          end do
449          list(i) = lists
450          key(i) = keys
451       end do
452       return
453       end
454 c
455 c
456 c     #########################################################
457 c     ##                                                     ##
458 c     ##  subroutine sort8  --  heapsort to unique integers  ##
459 c     ##                                                     ##
460 c     #########################################################
461 c
462 c
463 c     "sort8" takes an input list of integers and sorts it into
464 c     ascending order using the Heapsort algorithm, duplicate
465 c     values are removed from the final sorted list
466 c
467 c
468       subroutine sort8 (n,list)
469       implicit none
470       integer i,j,k,n
471       integer index
472       integer lists
473       integer list(*)
474 c
475 c
476 c     perform the heapsort of the input list
477 c
478       k = n/2 + 1
479       index = n
480       dowhile (n .gt. 1)
481          if (k .gt. 1) then
482             k = k - 1
483             lists = list(k)
484          else
485             lists = list(index)
486             list(index) = list(1)
487             index = index - 1
488             if (index .le. 1) then
489                list(1) = lists
490 c
491 c     remove duplicate values from final list
492 c
493                j = 1
494                do i = 2, n
495                   if (list(i-1) .ne. list(i)) then
496                      j = j + 1
497                      list(j) = list(i)
498                   end if
499                end do
500                if (j .lt. n)  n = j
501                return
502             end if
503          end if
504          i = k
505          j = k + k
506          dowhile (j .le. index)
507             if (j .lt. index) then
508                if (list(j) .lt. list(j+1))  j = j + 1
509             end if
510             if (lists .lt. list(j)) then
511                list(i) = list(j)
512                i = j
513                j = j + j
514             else
515                j = index + 1
516             end if
517          end do
518          list(i) = lists
519       end do
520       return
521       end
522 c
523 c
524 c     #############################################################
525 c     ##                                                         ##
526 c     ##  subroutine sort9  --  heapsort to unique text strings  ##
527 c     ##                                                         ##
528 c     #############################################################
529 c
530 c
531 c     "sort9" takes an input list of character strings and sorts
532 c     it into alphabetical order using the Heapsort algorithm,
533 c     duplicate values are removed from the final sorted list
534 c
535 c
536       subroutine sort9 (n,list)
537       implicit none
538       integer i,j,k,n
539       integer index
540       character*256 lists
541       character*(*) list(*)
542 c
543 c
544 c     perform the heapsort of the input list
545 c
546       k = n/2 + 1
547       index = n
548       dowhile (n .gt. 1)
549          if (k .gt. 1) then
550             k = k - 1
551             lists = list(k)
552          else
553             lists = list(index)
554             list(index) = list(1)
555             index = index - 1
556             if (index .le. 1) then
557                list(1) = lists
558 c
559 c     remove duplicate values from final list
560 c
561                j = 1
562                do i = 2, n
563                   if (list(i-1) .ne. list(i)) then
564                      j = j + 1
565                      list(j) = list(i)
566                   end if
567                end do
568                if (j .lt. n)  n = j
569                return
570             end if
571          end if
572          i = k
573          j = k + k
574          dowhile (j .le. index)
575             if (j .lt. index) then
576                if (list(j) .lt. list(j+1))  j = j + 1
577             end if
578             if (lists .lt. list(j)) then
579                list(i) = list(j)
580                i = j
581                j = j + j
582             else
583                j = index + 1
584             end if
585          end do
586          list(i) = lists
587       end do
588       return
589       end