xref: /petsc/src/ksp/pc/impls/tfs/ivec.c (revision 8bc8193efbc389280f83b3d41dffa9e2d23e2ace)
1 
2 /**********************************ivec.c**************************************
3 SPARSE GATHER-SCATTER PACKAGE: bss_malloc bss_malloc ivec error comm gs queue
4 
5 Author: Henry M. Tufo III
6 
7 e-mail: hmt@cs.brown.edu
8 
9 snail-mail:
10 Division of Applied Mathematics
11 Brown University
12 Providence, RI 02912
13 
14 Last Modification:
15 6.21.97
16 ***********************************ivec.c*************************************/
17 
18 /**********************************ivec.c**************************************
19 File Description:
20 -----------------
21 
22 ***********************************ivec.c*************************************/
23 #include "petsc.h"
24 #include <float.h>
25 #include <limits.h>
26 
27 
28 #include "const.h"
29 #include "types.h"
30 #include "ivec.h"
31 #include "error.h"
32 #include "comm.h"
33 
34 
35 /* sorting args ivec.c ivec.c ... */
36 #define   SORT_OPT	6
37 #define   SORT_STACK	50000
38 
39 
40 /* allocate an address and size stack for sorter(s) */
41 static void *offset_stack[2*SORT_STACK];
42 static int   size_stack[SORT_STACK];
43 static PTRINT psize_stack[SORT_STACK];
44 
45 
46 
47 /**********************************ivec.c**************************************
48 Function ivec_dump()
49 
50 Input :
51 Output:
52 Return:
53 Description:
54 ***********************************ivec.c*************************************/
55 void
56 ivec_dump(int *v, int n, int tag, int tag2, char * s)
57 {
58   int i;
59   printf("%2d %2d %s %2d :: ",tag,tag2,s,my_id);
60   for (i=0;i<n;i++)
61     {printf("%2d ",v[i]);}
62   printf("\n");
63   fflush(stdout);
64 }
65 
66 
67 
68 /**********************************ivec.c**************************************
69 Function ivec_lb_ub()
70 
71 Input :
72 Output:
73 Return:
74 Description:
75 ***********************************ivec.c*************************************/
76 void
77 ivec_lb_ub(register int *arg1, register int n, int *lb, int *ub)
78 {
79   register int min = INT_MAX;
80   register int max = INT_MIN;
81 
82   while (n--)
83     {
84      min = PetscMin(min,*arg1);
85      max = PetscMax(max,*arg1);
86      arg1++;
87     }
88 
89   *lb=min;
90   *ub=max;
91 }
92 
93 
94 
95 /**********************************ivec.c**************************************
96 Function ivec_copy()
97 
98 Input :
99 Output:
100 Return:
101 Description:
102 ***********************************ivec.c*************************************/
103 int *ivec_copy(register int *arg1, register int *arg2, register int n)
104 {
105   while (n--)  {*arg1++ = *arg2++;}
106   return(arg1);
107 }
108 
109 
110 
111 /**********************************ivec.c**************************************
112 Function ivec_zero()
113 
114 Input :
115 Output:
116 Return:
117 Description:
118 ***********************************ivec.c*************************************/
119 void
120 ivec_zero(register int *arg1, register int n)
121 {
122   while (n--)  {*arg1++ = 0;}
123 }
124 
125 
126 
127 /**********************************ivec.c**************************************
128 Function ivec_comp()
129 
130 Input :
131 Output:
132 Return:
133 Description:
134 ***********************************ivec.c*************************************/
135 void
136 ivec_comp(register int *arg1, register int n)
137 {
138   while (n--)  {*arg1 = ~*arg1; arg1++;}
139 }
140 
141 
142 
143 /**********************************ivec.c**************************************
144 Function ivec_neg_one()
145 
146 Input :
147 Output:
148 Return:
149 Description:
150 ***********************************ivec.c*************************************/
151 void
152 ivec_neg_one(register int *arg1, register int n)
153 {
154   while (n--)  {*arg1++ = -1;}
155 }
156 
157 
158 
159 /**********************************ivec.c**************************************
160 Function ivec_pos_one()
161 
162 Input :
163 Output:
164 Return:
165 Description:
166 ***********************************ivec.c*************************************/
167 void
168 ivec_pos_one(register int *arg1, register int n)
169 {
170   while (n--)  {*arg1++ = 1;}
171 }
172 
173 
174 
175 /**********************************ivec.c**************************************
176 Function ivec_c_index()
177 
178 Input :
179 Output:
180 Return:
181 Description:
182 ***********************************ivec.c*************************************/
183 void
184 ivec_c_index(register int *arg1, register int n)
185 {
186   register int i=0;
187 
188 
189   while (n--)  {*arg1++ = i++;}
190 }
191 
192 
193 
194 /**********************************ivec.c**************************************
195 Function ivec_fortran_index()
196 
197 Input :
198 Output:
199 Return:
200 Description:
201 ***********************************ivec.c*************************************/
202 void
203 ivec_fortran_index(register int *arg1, register int n)
204 {
205   register int i=0;
206 
207 
208   while (n--)  {*arg1++ = ++i;}
209 }
210 
211 
212 
213 /**********************************ivec.c**************************************
214 Function ivec_set()
215 
216 Input :
217 Output:
218 Return:
219 Description:
220 ***********************************ivec.c*************************************/
221 void
222 ivec_set(register int *arg1, register int arg2, register int n)
223 {
224   while (n--)  {*arg1++ = arg2;}
225 }
226 
227 
228 
229 /**********************************ivec.c**************************************
230 Function ivec_cmp()
231 
232 Input :
233 Output:
234 Return:
235 Description:
236 ***********************************ivec.c*************************************/
237 int
238 ivec_cmp(register int *arg1, register int *arg2, register int n)
239 {
240   while (n--)  {if (*arg1++ != *arg2++)  {return(FALSE);}}
241   return(TRUE);
242 }
243 
244 
245 
246 /**********************************ivec.c**************************************
247 Function ivec_max()
248 
249 Input :
250 Output:
251 Return:
252 Description:
253 ***********************************ivec.c*************************************/
254 void
255 ivec_max(register int *arg1, register int *arg2, register int n)
256 {
257   while (n--)  {*arg1 = PetscMax(*arg1,*arg2); arg1++; arg2++;}
258 }
259 
260 
261 
262 /**********************************ivec.c**************************************
263 Function ivec_min()
264 
265 Input :
266 Output:
267 Return:
268 Description:
269 ***********************************ivec.c*************************************/
270 void
271 ivec_min(register int *arg1, register int *arg2, register int n)
272 {
273   while (n--)  {*(arg1) = PetscMin(*arg1,*arg2); arg1++; arg2++;}
274 }
275 
276 
277 
278 /**********************************ivec.c**************************************
279 Function ivec_mult()
280 
281 Input :
282 Output:
283 Return:
284 Description:
285 ***********************************ivec.c*************************************/
286 void
287 ivec_mult(register int *arg1, register int *arg2, register int n)
288 {
289   while (n--)  {*arg1++ *= *arg2++;}
290 }
291 
292 
293 
294 /**********************************ivec.c**************************************
295 Function ivec_add()
296 
297 Input :
298 Output:
299 Return:
300 Description:
301 ***********************************ivec.c*************************************/
302 void
303 ivec_add(register int *arg1, register int *arg2, register int n)
304 {
305   while (n--)  {*arg1++ += *arg2++;}
306 }
307 
308 
309 
310 /**********************************ivec.c**************************************
311 Function ivec_lxor()
312 
313 Input :
314 Output:
315 Return:
316 Description:
317 ***********************************ivec.c*************************************/
318 void
319 ivec_lxor(register int *arg1, register int *arg2, register int n)
320 {
321   while (n--) {*arg1=((*arg1 || *arg2) && !(*arg1 && *arg2)); arg1++; arg2++;}
322 }
323 
324 
325 
326 /**********************************ivec.c**************************************
327 Function ivec_xor()
328 
329 Input :
330 Output:
331 Return:
332 Description:
333 ***********************************ivec.c*************************************/
334 void
335 ivec_xor(register int *arg1, register int *arg2, register int n)
336 {
337   while (n--)  {*arg1++ ^= *arg2++;}
338 }
339 
340 
341 
342 /**********************************ivec.c**************************************
343 Function ivec_or()
344 
345 Input :
346 Output:
347 Return:
348 Description:
349 ***********************************ivec.c*************************************/
350 void
351 ivec_or(register int *arg1, register int *arg2, register int n)
352 {
353   while (n--)  {*arg1++ |= *arg2++;}
354 }
355 
356 
357 
358 /**********************************ivec.c**************************************
359 Function ivec_lor()
360 
361 Input :
362 Output:
363 Return:
364 Description:
365 ***********************************ivec.c*************************************/
366 void
367 ivec_lor(register int *arg1, register int *arg2, register int n)
368 {
369   while (n--)  {*arg1 = (*arg1 || *arg2); arg1++; arg2++;}
370 }
371 
372 
373 
374 /**********************************ivec.c**************************************
375 Function ivec_or3()
376 
377 Input :
378 Output:
379 Return:
380 Description:
381 ***********************************ivec.c*************************************/
382 void
383 ivec_or3(register int *arg1, register int *arg2, register int *arg3,
384 	 register int n)
385 {
386   while (n--)  {*arg1++ = (*arg2++ | *arg3++);}
387 }
388 
389 
390 
391 /**********************************ivec.c**************************************
392 Function ivec_and()
393 
394 Input :
395 Output:
396 Return:
397 Description:
398 ***********************************ivec.c*************************************/
399 void
400 ivec_and(register int *arg1, register int *arg2, register int n)
401 {
402   while (n--)  {*arg1++ &= *arg2++;}
403 }
404 
405 
406 
407 /**********************************ivec.c**************************************
408 Function ivec_land()
409 
410 Input :
411 Output:
412 Return:
413 Description:
414 ***********************************ivec.c*************************************/
415 void
416 ivec_land(register int *arg1, register int *arg2, register int n)
417 {
418   while (n--) {*arg1 = (*arg1 && *arg2); arg1++; arg2++;}
419 }
420 
421 
422 
423 /**********************************ivec.c**************************************
424 Function ivec_and3()
425 
426 Input :
427 Output:
428 Return:
429 Description:
430 ***********************************ivec.c*************************************/
431 void
432 ivec_and3(register int *arg1, register int *arg2, register int *arg3,
433 	  register int n)
434 {
435   while (n--)  {*arg1++ = (*arg2++ & *arg3++);}
436 }
437 
438 
439 
440 /**********************************ivec.c**************************************
441 Function ivec_sum
442 
443 Input :
444 Output:
445 Return:
446 Description:
447 ***********************************ivec.c*************************************/
448 int ivec_sum(register int *arg1, register int n)
449 {
450   register int tmp = 0;
451 
452 
453   while (n--) {tmp += *arg1++;}
454   return(tmp);
455 }
456 
457 
458 
459 /**********************************ivec.c**************************************
460 Function ivec_reduce_and
461 
462 Input :
463 Output:
464 Return:
465 Description:
466 ***********************************ivec.c*************************************/
467 int ivec_reduce_and(register int *arg1, register int n)
468 {
469   register int tmp = ALL_ONES;
470 
471 
472   while (n--) {tmp &= *arg1++;}
473   return(tmp);
474 }
475 
476 
477 
478 /**********************************ivec.c**************************************
479 Function ivec_reduce_or
480 
481 Input :
482 Output:
483 Return:
484 Description:
485 ***********************************ivec.c*************************************/
486 int ivec_reduce_or(register int *arg1, register int n)
487 {
488   register int tmp = 0;
489 
490 
491   while (n--) {tmp |= *arg1++;}
492   return(tmp);
493 }
494 
495 
496 
497 /**********************************ivec.c**************************************
498 Function ivec_prod
499 
500 Input :
501 Output:
502 Return:
503 Description:
504 ***********************************ivec.c*************************************/
505 int ivec_prod(register int *arg1, register int n)
506 {
507   register int tmp = 1;
508 
509 
510   while (n--)  {tmp *= *arg1++;}
511   return(tmp);
512 }
513 
514 
515 
516 /**********************************ivec.c**************************************
517 Function ivec_u_sum
518 
519 Input :
520 Output:
521 Return:
522 Description:
523 ***********************************ivec.c*************************************/
524 int ivec_u_sum(register unsigned *arg1, register int n)
525 {
526   register unsigned tmp = 0;
527 
528 
529   while (n--)  {tmp += *arg1++;}
530   return(tmp);
531 }
532 
533 
534 
535 /**********************************ivec.c**************************************
536 Function ivec_lb()
537 
538 Input :
539 Output:
540 Return:
541 Description:
542 ***********************************ivec.c*************************************/
543 int
544 ivec_lb(register int *arg1, register int n)
545 {
546   register int min = INT_MAX;
547 
548 
549   while (n--)  {min = PetscMin(min,*arg1); arg1++;}
550   return(min);
551 }
552 
553 
554 
555 /**********************************ivec.c**************************************
556 Function ivec_ub()
557 
558 Input :
559 Output:
560 Return:
561 Description:
562 ***********************************ivec.c*************************************/
563 int
564 ivec_ub(register int *arg1, register int n)
565 {
566   register int max = INT_MIN;
567 
568 
569   while (n--)  {max = PetscMax(max,*arg1); arg1++;}
570   return(max);
571 }
572 
573 
574 
575 /**********************************ivec.c**************************************
576 Function split_buf()
577 
578 Input :
579 Output:
580 Return:
581 Description:
582 
583 assumes that sizeof(int) == 4bytes!!!
584 ***********************************ivec.c*************************************/
585 int
586 ivec_split_buf(int *buf1, int **buf2, register int size)
587 {
588   *buf2 = (buf1 + (size>>3));
589   return(size);
590 }
591 
592 
593 
594 /**********************************ivec.c**************************************
595 Function ivec_non_uniform()
596 
597 Input :
598 Output:
599 Return:
600 Description:
601 ***********************************ivec.c*************************************/
602 void
603 ivec_non_uniform(int *arg1, int *arg2, register int n, register int *arg3)
604 {
605   register int i, j, type;
606 
607 
608   /* LATER: if we're really motivated we can sort and then unsort */
609   for (i=0;i<n;)
610     {
611       /* clump 'em for now */
612       j=i+1;
613       type = arg3[i];
614       while ((j<n)&&(arg3[j]==type))
615 	{j++;}
616 
617       /* how many together */
618       j -= i;
619 
620       /* call appropriate ivec function */
621       if (type == GL_MAX)
622 	{ivec_max(arg1,arg2,j);}
623       else if (type == GL_MIN)
624 	{ivec_min(arg1,arg2,j);}
625       else if (type == GL_MULT)
626 	{ivec_mult(arg1,arg2,j);}
627       else if (type == GL_ADD)
628 	{ivec_add(arg1,arg2,j);}
629       else if (type == GL_B_XOR)
630 	{ivec_xor(arg1,arg2,j);}
631       else if (type == GL_B_OR)
632 	{ivec_or(arg1,arg2,j);}
633       else if (type == GL_B_AND)
634 	{ivec_and(arg1,arg2,j);}
635       else if (type == GL_L_XOR)
636 	{ivec_lxor(arg1,arg2,j);}
637       else if (type == GL_L_OR)
638 	{ivec_lor(arg1,arg2,j);}
639       else if (type == GL_L_AND)
640 	{ivec_land(arg1,arg2,j);}
641       else
642 	{error_msg_fatal("unrecognized type passed to ivec_non_uniform()!");}
643 
644       arg1+=j; arg2+=j; i+=j;
645     }
646 }
647 
648 
649 
650 /**********************************ivec.c**************************************
651 Function ivec_addr()
652 
653 Input :
654 Output:
655 Return:
656 Description:
657 ***********************************ivec.c*************************************/
658 vfp ivec_fct_addr(register int type)
659 {
660   if (type == NON_UNIFORM)
661     {return((void (*)(void*, void *, int, ...))&ivec_non_uniform);}
662   else if (type == GL_MAX)
663     {return((void (*)(void*, void *, int, ...))&ivec_max);}
664   else if (type == GL_MIN)
665     {return((void (*)(void*, void *, int, ...))&ivec_min);}
666   else if (type == GL_MULT)
667     {return((void (*)(void*, void *, int, ...))&ivec_mult);}
668   else if (type == GL_ADD)
669     {return((void (*)(void*, void *, int, ...))&ivec_add);}
670   else if (type == GL_B_XOR)
671     {return((void (*)(void*, void *, int, ...))&ivec_xor);}
672   else if (type == GL_B_OR)
673     {return((void (*)(void*, void *, int, ...))&ivec_or);}
674   else if (type == GL_B_AND)
675     {return((void (*)(void*, void *, int, ...))&ivec_and);}
676   else if (type == GL_L_XOR)
677     {return((void (*)(void*, void *, int, ...))&ivec_lxor);}
678   else if (type == GL_L_OR)
679     {return((void (*)(void*, void *, int, ...))&ivec_lor);}
680   else if (type == GL_L_AND)
681     {return((void (*)(void*, void *, int, ...))&ivec_land);}
682 
683   /* catch all ... not good if we get here */
684   return(NULL);
685 }
686 
687 
688 /**********************************ivec.c**************************************
689 Function ct_bits()
690 
691 Input :
692 Output:
693 Return:
694 Description: MUST FIX THIS!!!
695 ***********************************ivec.c*************************************/
696 #if defined(notusing)
697 static
698 int
699 ivec_ct_bits(register int *ptr, register int n)
700 {
701   register int tmp=0;
702 
703 
704   /* should expand to full 32 bit */
705   while (n--)
706     {
707       if (*ptr&128) {tmp++;}
708       if (*ptr&64)  {tmp++;}
709       if (*ptr&32)  {tmp++;}
710       if (*ptr&16)  {tmp++;}
711       if (*ptr&8)   {tmp++;}
712       if (*ptr&4)   {tmp++;}
713       if (*ptr&2)   {tmp++;}
714       if (*ptr&1)   {tmp++;}
715       ptr++;
716     }
717 
718   return(tmp);
719 }
720 #endif
721 
722 
723 /******************************************************************************
724 Function: ivec_sort().
725 
726 Input : offset of list to be sorted, number of elements to be sorted.
727 Output: sorted list (in ascending order).
728 Return: none.
729 Description: stack based (nonrecursive) quicksort w/brute-shell bottom.
730 ******************************************************************************/
731 void
732 ivec_sort(register int *ar, register int size)
733 {
734   register int *pi, *pj, temp;
735   register int **top_a = (int **) offset_stack;
736   register int *top_s = size_stack, *bottom_s = size_stack;
737 
738 
739   /* we're really interested in the offset of the last element */
740   /* ==> length of the list is now size + 1                    */
741   size--;
742 
743   /* do until we're done ... return when stack is exhausted */
744   for (;;)
745     {
746       /* if list is large enough use quicksort partition exchange code */
747       if (size > SORT_OPT)
748 	{
749 	  /* start up pointer at element 1 and down at size     */
750 	  pi = ar+1;
751 	  pj = ar+size;
752 
753 	  /* find middle element in list and swap w/ element 1 */
754 	  SWAP(*(ar+(size>>1)),*pi)
755 
756 	  /* order element 0,1,size-1 st {M,L,...,U} w/L<=M<=U */
757 	  /* note ==> pivot_value in index 0                   */
758 	  if (*pi > *pj)
759 	    {SWAP(*pi,*pj)}
760 	  if (*ar > *pj)
761 	    {SWAP(*ar,*pj)}
762 	  else if (*pi > *ar)
763 	    {SWAP(*(ar),*(ar+1))}
764 
765 	  /* partition about pivot_value ...  	                    */
766 	  /* note lists of length 2 are not guaranteed to be sorted */
767 	  for(;;)
768 	    {
769 	      /* walk up ... and down ... swap if equal to pivot! */
770 	      do pi++; while (*pi<*ar);
771 	      do pj--; while (*pj>*ar);
772 
773 	      /* if we've crossed we're done */
774 	      if (pj<pi) break;
775 
776 	      /* else swap */
777 	      SWAP(*pi,*pj)
778 	    }
779 
780 	  /* place pivot_value in it's correct location */
781 	  SWAP(*ar,*pj)
782 
783 	  /* test stack_size to see if we've exhausted our stack */
784 	  if (top_s-bottom_s >= SORT_STACK)
785 	    {error_msg_fatal("ivec_sort() :: STACK EXHAUSTED!!!");}
786 
787 	  /* push right hand child iff length > 1 */
788 	  if ((*top_s = size-((int) (pi-ar))))
789 	    {
790 	      *(top_a++) = pi;
791 	      size -= *top_s+2;
792 	      top_s++;
793 	    }
794 	  /* set up for next loop iff there is something to do */
795 	  else if (size -= *top_s+2)
796 	    {;}
797 	  /* might as well pop - note NR_OPT >=2 ==> we're ok! */
798 	  else
799 	    {
800 	      ar = *(--top_a);
801 	      size = *(--top_s);
802 	    }
803 	}
804 
805       /* else sort small list directly then pop another off stack */
806       else
807 	{
808 	  /* insertion sort for bottom */
809           for (pj=ar+1;pj<=ar+size;pj++)
810             {
811               temp = *pj;
812               for (pi=pj-1;pi>=ar;pi--)
813                 {
814                   if (*pi <= temp) break;
815                   *(pi+1)=*pi;
816                 }
817               *(pi+1)=temp;
818 	    }
819 
820 	  /* check to see if stack is exhausted ==> DONE */
821 	  if (top_s==bottom_s) return;
822 
823 	  /* else pop another list from the stack */
824 	  ar = *(--top_a);
825 	  size = *(--top_s);
826 	}
827     }
828 }
829 
830 
831 
832 /******************************************************************************
833 Function: ivec_sort_companion().
834 
835 Input : offset of list to be sorted, number of elements to be sorted.
836 Output: sorted list (in ascending order).
837 Return: none.
838 Description: stack based (nonrecursive) quicksort w/brute-shell bottom.
839 ******************************************************************************/
840 void
841 ivec_sort_companion(register int *ar, register int *ar2, register int size)
842 {
843   register int *pi, *pj, temp, temp2;
844   register int **top_a = (int **)offset_stack;
845   register int *top_s = size_stack, *bottom_s = size_stack;
846   register int *pi2, *pj2;
847   register int mid;
848 
849 
850   /* we're really interested in the offset of the last element */
851   /* ==> length of the list is now size + 1                    */
852   size--;
853 
854   /* do until we're done ... return when stack is exhausted */
855   for (;;)
856     {
857       /* if list is large enough use quicksort partition exchange code */
858       if (size > SORT_OPT)
859 	{
860 	  /* start up pointer at element 1 and down at size     */
861 	  mid = size>>1;
862 	  pi = ar+1;
863 	  pj = ar+mid;
864 	  pi2 = ar2+1;
865 	  pj2 = ar2+mid;
866 
867 	  /* find middle element in list and swap w/ element 1 */
868 	  SWAP(*pi,*pj)
869 	  SWAP(*pi2,*pj2)
870 
871 	  /* order element 0,1,size-1 st {M,L,...,U} w/L<=M<=U */
872 	  /* note ==> pivot_value in index 0                   */
873 	  pj = ar+size;
874 	  pj2 = ar2+size;
875 	  if (*pi > *pj)
876 	    {SWAP(*pi,*pj) SWAP(*pi2,*pj2)}
877 	  if (*ar > *pj)
878 	    {SWAP(*ar,*pj) SWAP(*ar2,*pj2)}
879 	  else if (*pi > *ar)
880 	    {SWAP(*(ar),*(ar+1)) SWAP(*(ar2),*(ar2+1))}
881 
882 	  /* partition about pivot_value ...  	                    */
883 	  /* note lists of length 2 are not guaranteed to be sorted */
884 	  for(;;)
885 	    {
886 	      /* walk up ... and down ... swap if equal to pivot! */
887 	      do {pi++; pi2++;} while (*pi<*ar);
888 	      do {pj--; pj2--;} while (*pj>*ar);
889 
890 	      /* if we've crossed we're done */
891 	      if (pj<pi) break;
892 
893 	      /* else swap */
894 	      SWAP(*pi,*pj)
895 	      SWAP(*pi2,*pj2)
896 	    }
897 
898 	  /* place pivot_value in it's correct location */
899 	  SWAP(*ar,*pj)
900 	  SWAP(*ar2,*pj2)
901 
902 	  /* test stack_size to see if we've exhausted our stack */
903 	  if (top_s-bottom_s >= SORT_STACK)
904 	    {error_msg_fatal("ivec_sort_companion() :: STACK EXHAUSTED!!!");}
905 
906 	  /* push right hand child iff length > 1 */
907 	  if ((*top_s = size-((int) (pi-ar))))
908 	    {
909 	      *(top_a++) = pi;
910 	      *(top_a++) = pi2;
911 	      size -= *top_s+2;
912 	      top_s++;
913 	    }
914 	  /* set up for next loop iff there is something to do */
915 	  else if (size -= *top_s+2)
916 	    {;}
917 	  /* might as well pop - note NR_OPT >=2 ==> we're ok! */
918 	  else
919 	    {
920 	      ar2 = *(--top_a);
921 	      ar  = *(--top_a);
922 	      size = *(--top_s);
923 	    }
924 	}
925 
926       /* else sort small list directly then pop another off stack */
927       else
928 	{
929 	  /* insertion sort for bottom */
930           for (pj=ar+1, pj2=ar2+1;pj<=ar+size;pj++,pj2++)
931             {
932               temp = *pj;
933               temp2 = *pj2;
934               for (pi=pj-1,pi2=pj2-1;pi>=ar;pi--,pi2--)
935                 {
936                   if (*pi <= temp) break;
937                   *(pi+1)=*pi;
938                   *(pi2+1)=*pi2;
939                 }
940               *(pi+1)=temp;
941               *(pi2+1)=temp2;
942 	    }
943 
944 	  /* check to see if stack is exhausted ==> DONE */
945 	  if (top_s==bottom_s) return;
946 
947 	  /* else pop another list from the stack */
948 	  ar2 = *(--top_a);
949 	  ar  = *(--top_a);
950 	  size = *(--top_s);
951 	}
952     }
953 }
954 
955 
956 
957 /******************************************************************************
958 Function: ivec_sort_companion_hack().
959 
960 Input : offset of list to be sorted, number of elements to be sorted.
961 Output: sorted list (in ascending order).
962 Return: none.
963 Description: stack based (nonrecursive) quicksort w/brute-shell bottom.
964 ******************************************************************************/
965 void
966 ivec_sort_companion_hack(register int *ar, register int **ar2,
967 			 register int size)
968 {
969   register int *pi, *pj, temp, *ptr;
970   register int **top_a = (int **)offset_stack;
971   register int *top_s = size_stack, *bottom_s = size_stack;
972   register int **pi2, **pj2;
973   register int mid;
974 
975 
976   /* we're really interested in the offset of the last element */
977   /* ==> length of the list is now size + 1                    */
978   size--;
979 
980   /* do until we're done ... return when stack is exhausted */
981   for (;;)
982     {
983       /* if list is large enough use quicksort partition exchange code */
984       if (size > SORT_OPT)
985 	{
986 	  /* start up pointer at element 1 and down at size     */
987 	  mid = size>>1;
988 	  pi = ar+1;
989 	  pj = ar+mid;
990 	  pi2 = ar2+1;
991 	  pj2 = ar2+mid;
992 
993 	  /* find middle element in list and swap w/ element 1 */
994 	  SWAP(*pi,*pj)
995 	  P_SWAP(*pi2,*pj2)
996 
997 	  /* order element 0,1,size-1 st {M,L,...,U} w/L<=M<=U */
998 	  /* note ==> pivot_value in index 0                   */
999 	  pj = ar+size;
1000 	  pj2 = ar2+size;
1001 	  if (*pi > *pj)
1002 	    {SWAP(*pi,*pj) P_SWAP(*pi2,*pj2)}
1003 	  if (*ar > *pj)
1004 	    {SWAP(*ar,*pj) P_SWAP(*ar2,*pj2)}
1005 	  else if (*pi > *ar)
1006 	    {SWAP(*(ar),*(ar+1)) P_SWAP(*(ar2),*(ar2+1))}
1007 
1008 	  /* partition about pivot_value ...  	                    */
1009 	  /* note lists of length 2 are not guaranteed to be sorted */
1010 	  for(;;)
1011 	    {
1012 	      /* walk up ... and down ... swap if equal to pivot! */
1013 	      do {pi++; pi2++;} while (*pi<*ar);
1014 	      do {pj--; pj2--;} while (*pj>*ar);
1015 
1016 	      /* if we've crossed we're done */
1017 	      if (pj<pi) break;
1018 
1019 	      /* else swap */
1020 	      SWAP(*pi,*pj)
1021 	      P_SWAP(*pi2,*pj2)
1022 	    }
1023 
1024 	  /* place pivot_value in it's correct location */
1025 	  SWAP(*ar,*pj)
1026 	  P_SWAP(*ar2,*pj2)
1027 
1028 	  /* test stack_size to see if we've exhausted our stack */
1029 	  if (top_s-bottom_s >= SORT_STACK)
1030          {error_msg_fatal("ivec_sort_companion_hack() :: STACK EXHAUSTED!!!");}
1031 
1032 	  /* push right hand child iff length > 1 */
1033 	  if ((*top_s = size-((int) (pi-ar))))
1034 	    {
1035 	      *(top_a++) = pi;
1036 	      *(top_a++) = (int*) pi2;
1037 	      size -= *top_s+2;
1038 	      top_s++;
1039 	    }
1040 	  /* set up for next loop iff there is something to do */
1041 	  else if (size -= *top_s+2)
1042 	    {;}
1043 	  /* might as well pop - note NR_OPT >=2 ==> we're ok! */
1044 	  else
1045 	    {
1046 	      ar2 = (int **) *(--top_a);
1047 	      ar  = *(--top_a);
1048 	      size = *(--top_s);
1049 	    }
1050 	}
1051 
1052       /* else sort small list directly then pop another off stack */
1053       else
1054 	{
1055 	  /* insertion sort for bottom */
1056           for (pj=ar+1, pj2=ar2+1;pj<=ar+size;pj++,pj2++)
1057             {
1058               temp = *pj;
1059               ptr = *pj2;
1060               for (pi=pj-1,pi2=pj2-1;pi>=ar;pi--,pi2--)
1061                 {
1062                   if (*pi <= temp) break;
1063                   *(pi+1)=*pi;
1064                   *(pi2+1)=*pi2;
1065                 }
1066               *(pi+1)=temp;
1067               *(pi2+1)=ptr;
1068 	    }
1069 
1070 	  /* check to see if stack is exhausted ==> DONE */
1071 	  if (top_s==bottom_s) return;
1072 
1073 	  /* else pop another list from the stack */
1074 	  ar2 = (int **)*(--top_a);
1075 	  ar  = *(--top_a);
1076 	  size = *(--top_s);
1077 	}
1078     }
1079 }
1080 
1081 
1082 
1083 /******************************************************************************
1084 Function: SMI_sort().
1085 Input : offset of list to be sorted, number of elements to be sorted.
1086 Output: sorted list (in ascending order).
1087 Return: none.
1088 Description: stack based (nonrecursive) quicksort w/brute-shell bottom.
1089 ******************************************************************************/
1090 void
1091 SMI_sort(void *ar1, void *ar2, int size, int type)
1092 {
1093   if (type == SORT_INTEGER)
1094     {
1095       if (ar2)
1096 	{ivec_sort_companion((int*)ar1,(int*)ar2,size);}
1097       else
1098 	{ivec_sort((int*)ar1,size);}
1099     }
1100   else if (type == SORT_INT_PTR)
1101     {
1102       if (ar2)
1103 	{ivec_sort_companion_hack((int*)ar1,(int **)ar2,size);}
1104       else
1105 	{ivec_sort((int*)ar1,size);}
1106     }
1107 
1108   else
1109     {
1110       error_msg_fatal("SMI_sort only does SORT_INTEGER!");
1111     }
1112 /*
1113   if (type == SORT_REAL)
1114     {
1115       if (ar2)
1116 	{rvec_sort_companion(ar2,ar1,size);}
1117       else
1118 	{rvec_sort(ar1,size);}
1119     }
1120 */
1121 }
1122 
1123 
1124 
1125 /**********************************ivec.c**************************************
1126 Function ivec_linear_search()
1127 
1128 Input :
1129 Output:
1130 Return:
1131 Description:
1132 ***********************************ivec.c*************************************/
1133 int
1134 ivec_linear_search(register int item, register int *list, register int n)
1135 {
1136   register int tmp = n-1;
1137 
1138   while (n--)  {if (*list++ == item) {return(tmp-n);}}
1139   return(-1);
1140 }
1141 
1142 
1143 
1144 /**********************************ivec.c**************************************
1145 Function ivec_binary_search()
1146 
1147 Input :
1148 Output:
1149 Return:
1150 Description:
1151 ***********************************ivec.c*************************************/
1152 int
1153 ivec_binary_search(register int item, register int *list, register int rh)
1154 {
1155   register int mid, lh=0;
1156 
1157   rh--;
1158   while (lh<=rh)
1159     {
1160       mid = (lh+rh)>>1;
1161       if (*(list+mid) == item)
1162 	{return(mid);}
1163       if (*(list+mid) > item)
1164 	{rh = mid-1;}
1165       else
1166 	{lh = mid+1;}
1167     }
1168   return(-1);
1169 }
1170 
1171 
1172 
1173 /**********************************ivec.c**************************************
1174 Function rvec_dump
1175 
1176 Input :
1177 Output:
1178 Return:
1179 Description:
1180 ***********************************ivec.c*************************************/
1181 void
1182 rvec_dump(REAL *v, int n, int tag, int tag2, char * s)
1183 {
1184   int i;
1185   printf("%2d %2d %s %2d :: ",tag,tag2,s,my_id);
1186   for (i=0;i<n;i++)
1187     {printf("%f ",v[i]);}
1188   printf("\n");
1189   fflush(stdout);
1190 }
1191 
1192 
1193 
1194 /**********************************ivec.c**************************************
1195 Function rvec_lb_ub()
1196 
1197 Input :
1198 Output:
1199 Return:
1200 Description:
1201 ***********************************ivec.c*************************************/
1202 void
1203 rvec_lb_ub(register REAL *arg1, register int n, REAL *lb, REAL *ub)
1204 {
1205   register REAL min =  REAL_MAX;
1206   register REAL max = -REAL_MAX;
1207 
1208   while (n--)
1209     {
1210      min = PetscMin(min,*arg1);
1211      max = PetscMax(max,*arg1);
1212      arg1++;
1213     }
1214 
1215   *lb=min;
1216   *ub=max;
1217 }
1218 
1219 
1220 
1221 /********************************ivec.c**************************************
1222 Function rvec_copy()
1223 
1224 Input :
1225 Output:
1226 Return:
1227 Description:
1228 *********************************ivec.c*************************************/
1229 void
1230 rvec_copy(register REAL *arg1, register REAL *arg2, register int n)
1231 {
1232   while (n--)  {*arg1++ = *arg2++;}
1233 }
1234 
1235 
1236 
1237 /********************************ivec.c**************************************
1238 Function rvec_zero()
1239 
1240 Input :
1241 Output:
1242 Return:
1243 Description:
1244 *********************************ivec.c*************************************/
1245 void
1246 rvec_zero(register REAL *arg1, register int n)
1247 {
1248   while (n--)  {*arg1++ = 0.0;}
1249 }
1250 
1251 
1252 
1253 /**********************************ivec.c**************************************
1254 Function rvec_one()
1255 
1256 Input :
1257 Output:
1258 Return:
1259 Description:
1260 ***********************************ivec.c*************************************/
1261 void
1262 rvec_one(register REAL *arg1, register int n)
1263 {
1264   while (n--)  {*arg1++ = 1.0;}
1265 }
1266 
1267 
1268 
1269 /**********************************ivec.c**************************************
1270 Function rvec_neg_one()
1271 
1272 Input :
1273 Output:
1274 Return:
1275 Description:
1276 ***********************************ivec.c*************************************/
1277 void
1278 rvec_neg_one(register REAL *arg1, register int n)
1279 {
1280   while (n--)  {*arg1++ = -1.0;}
1281 }
1282 
1283 
1284 
1285 /**********************************ivec.c**************************************
1286 Function rvec_set()
1287 
1288 Input :
1289 Output:
1290 Return:
1291 Description:
1292 ***********************************ivec.c*************************************/
1293 void
1294 rvec_set(register REAL *arg1, register REAL arg2, register int n)
1295 {
1296   while (n--)  {*arg1++ = arg2;}
1297 }
1298 
1299 
1300 
1301 /**********************************ivec.c**************************************
1302 Function rvec_scale()
1303 
1304 Input :
1305 Output:
1306 Return:
1307 Description:
1308 ***********************************ivec.c*************************************/
1309 void
1310 rvec_scale(register REAL *arg1, register REAL arg2, register int n)
1311 {
1312   while (n--)  {*arg1++ *= arg2;}
1313 }
1314 
1315 
1316 
1317 /********************************ivec.c**************************************
1318 Function rvec_add()
1319 
1320 Input :
1321 Output:
1322 Return:
1323 Description:
1324 *********************************ivec.c*************************************/
1325 void
1326 rvec_add(register REAL *arg1, register REAL *arg2, register int n)
1327 {
1328   while (n--)  {*arg1++ += *arg2++;}
1329 }
1330 
1331 
1332 
1333 /********************************ivec.c**************************************
1334 Function rvec_dot()
1335 
1336 Input :
1337 Output:
1338 Return:
1339 Description:
1340 *********************************ivec.c*************************************/
1341 REAL
1342 rvec_dot(register REAL *arg1, register REAL *arg2, register int n)
1343 {
1344   REAL dot=0.0;
1345 
1346   while (n--)  {dot+= *arg1++ * *arg2++;}
1347 
1348   return(dot);
1349 }
1350 
1351 
1352 
1353 /********************************ivec.c**************************************
1354 Function rvec_axpy()
1355 
1356 Input :
1357 Output:
1358 Return:
1359 Description:
1360 *********************************ivec.c*************************************/
1361 void
1362 rvec_axpy(register REAL *arg1, register REAL *arg2, register REAL scale,
1363 	  register int n)
1364 {
1365   while (n--)  {*arg1++ += scale * *arg2++;}
1366 }
1367 
1368 
1369 /********************************ivec.c**************************************
1370 Function rvec_mult()
1371 
1372 Input :
1373 Output:
1374 Return:
1375 Description:
1376 *********************************ivec.c*************************************/
1377 void
1378 rvec_mult(register REAL *arg1, register REAL *arg2, register int n)
1379 {
1380   while (n--)  {*arg1++ *= *arg2++;}
1381 }
1382 
1383 
1384 
1385 /********************************ivec.c**************************************
1386 Function rvec_max()
1387 
1388 Input :
1389 Output:
1390 Return:
1391 Description:
1392 *********************************ivec.c*************************************/
1393 void
1394 rvec_max(register REAL *arg1, register REAL *arg2, register int n)
1395 {
1396   while (n--)  {*arg1 = PetscMax(*arg1,*arg2); arg1++; arg2++;}
1397 }
1398 
1399 
1400 
1401 /********************************ivec.c**************************************
1402 Function rvec_max_abs()
1403 
1404 Input :
1405 Output:
1406 Return:
1407 Description:
1408 *********************************ivec.c*************************************/
1409 void
1410 rvec_max_abs(register REAL *arg1, register REAL *arg2, register int n)
1411 {
1412   while (n--)  {*arg1 = MAX_FABS(*arg1,*arg2); arg1++; arg2++;}
1413 }
1414 
1415 
1416 
1417 /********************************ivec.c**************************************
1418 Function rvec_min()
1419 
1420 Input :
1421 Output:
1422 Return:
1423 Description:
1424 *********************************ivec.c*************************************/
1425 void
1426 rvec_min(register REAL *arg1, register REAL *arg2, register int n)
1427 {
1428   while (n--)  {*arg1 = PetscMin(*arg1,*arg2); arg1++; arg2++;}
1429 }
1430 
1431 
1432 
1433 /********************************ivec.c**************************************
1434 Function rvec_min_abs()
1435 
1436 Input :
1437 Output:
1438 Return:
1439 Description:
1440 *********************************ivec.c*************************************/
1441 void
1442 rvec_min_abs(register REAL *arg1, register REAL *arg2, register int n)
1443 {
1444   while (n--)  {*arg1 = MIN_FABS(*arg1,*arg2); arg1++; arg2++;}
1445 }
1446 
1447 
1448 
1449 /********************************ivec.c**************************************
1450 Function rvec_exists()
1451 
1452 Input :
1453 Output:
1454 Return:
1455 Description:
1456 *********************************ivec.c*************************************/
1457 void
1458 rvec_exists(register REAL *arg1, register REAL *arg2, register int n)
1459 {
1460   while (n--)  {*arg1 = EXISTS(*arg1,*arg2); arg1++; arg2++;}
1461 }
1462 
1463 
1464 
1465 /**********************************ivec.c**************************************
1466 Function rvec_non_uniform()
1467 
1468 Input :
1469 Output:
1470 Return:
1471 Description:
1472 ***********************************ivec.c*************************************/
1473 void
1474 rvec_non_uniform(REAL *arg1, REAL *arg2, register int n, register int *arg3)
1475 {
1476   register int i, j, type;
1477 
1478 
1479   /* LATER: if we're really motivated we can sort and then unsort */
1480   for (i=0;i<n;)
1481     {
1482       /* clump 'em for now */
1483       j=i+1;
1484       type = arg3[i];
1485       while ((j<n)&&(arg3[j]==type))
1486 	{j++;}
1487 
1488       /* how many together */
1489       j -= i;
1490 
1491       /* call appropriate ivec function */
1492       if (type == GL_MAX)
1493 	{rvec_max(arg1,arg2,j);}
1494       else if (type == GL_MIN)
1495 	{rvec_min(arg1,arg2,j);}
1496       else if (type == GL_MULT)
1497 	{rvec_mult(arg1,arg2,j);}
1498       else if (type == GL_ADD)
1499 	{rvec_add(arg1,arg2,j);}
1500       else if (type == GL_MAX_ABS)
1501 	{rvec_max_abs(arg1,arg2,j);}
1502       else if (type == GL_MIN_ABS)
1503 	{rvec_min_abs(arg1,arg2,j);}
1504       else if (type == GL_EXISTS)
1505 	{rvec_exists(arg1,arg2,j);}
1506       else
1507 	{error_msg_fatal("unrecognized type passed to rvec_non_uniform()!");}
1508 
1509       arg1+=j; arg2+=j; i+=j;
1510     }
1511 }
1512 
1513 
1514 
1515 /**********************************ivec.c**************************************
1516 Function rvec_fct_addr()
1517 
1518 Input :
1519 Output:
1520 Return:
1521 Description:
1522 ***********************************ivec.c*************************************/
1523 vfp rvec_fct_addr(register int type)
1524 {
1525   if (type == NON_UNIFORM)
1526     {return((void (*)(void*, void *, int, ...))&rvec_non_uniform);}
1527   else if (type == GL_MAX)
1528     {return((void (*)(void*, void *, int, ...))&rvec_max);}
1529   else if (type == GL_MIN)
1530     {return((void (*)(void*, void *, int, ...))&rvec_min);}
1531   else if (type == GL_MULT)
1532     {return((void (*)(void*, void *, int, ...))&rvec_mult);}
1533   else if (type == GL_ADD)
1534     {return((void (*)(void*, void *, int, ...))&rvec_add);}
1535   else if (type == GL_MAX_ABS)
1536     {return((void (*)(void*, void *, int, ...))&rvec_max_abs);}
1537   else if (type == GL_MIN_ABS)
1538     {return((void (*)(void*, void *, int, ...))&rvec_min_abs);}
1539   else if (type == GL_EXISTS)
1540     {return((void (*)(void*, void *, int, ...))&rvec_exists);}
1541 
1542   /* catch all ... not good if we get here */
1543   return(NULL);
1544 }
1545 
1546 
1547 /******************************************************************************
1548 Function: my_sort().
1549 Input : offset of list to be sorted, number of elements to be sorted.
1550 Output: sorted list (in ascending order).
1551 Return: none.
1552 Description: stack based (nonrecursive) quicksort w/brute-shell bottom.
1553 ******************************************************************************/
1554 void
1555 rvec_sort(register REAL *ar, register int Size)
1556 {
1557   register REAL *pi, *pj, temp;
1558   register REAL **top_a = (REAL **)offset_stack;
1559   register PTRINT *top_s = psize_stack, *bottom_s = psize_stack;
1560   register PTRINT size = (PTRINT) Size;
1561 
1562   /* we're really interested in the offset of the last element */
1563   /* ==> length of the list is now size + 1                    */
1564   size--;
1565 
1566   /* do until we're done ... return when stack is exhausted */
1567   for (;;)
1568     {
1569       /* if list is large enough use quicksort partition exchange code */
1570       if (size > SORT_OPT)
1571 	{
1572 	  /* start up pointer at element 1 and down at size     */
1573 	  pi = ar+1;
1574 	  pj = ar+size;
1575 
1576 	  /* find middle element in list and swap w/ element 1 */
1577 	  SWAP(*(ar+(size>>1)),*pi)
1578 
1579 	  pj = ar+size;
1580 
1581 	  /* order element 0,1,size-1 st {M,L,...,U} w/L<=M<=U */
1582 	  /* note ==> pivot_value in index 0                   */
1583 	  if (*pi > *pj)
1584 	    {SWAP(*pi,*pj)}
1585 	  if (*ar > *pj)
1586 	    {SWAP(*ar,*pj)}
1587 	  else if (*pi > *ar)
1588 	    {SWAP(*(ar),*(ar+1))}
1589 
1590 	  /* partition about pivot_value ...  	                    */
1591 	  /* note lists of length 2 are not guaranteed to be sorted */
1592 	  for(;;)
1593 	    {
1594 	      /* walk up ... and down ... swap if equal to pivot! */
1595 	      do pi++; while (*pi<*ar);
1596 	      do pj--; while (*pj>*ar);
1597 
1598 	      /* if we've crossed we're done */
1599 	      if (pj<pi) break;
1600 
1601 	      /* else swap */
1602 	      SWAP(*pi,*pj)
1603 	    }
1604 
1605 	  /* place pivot_value in it's correct location */
1606 	  SWAP(*ar,*pj)
1607 
1608 	  /* test stack_size to see if we've exhausted our stack */
1609 	  if (top_s-bottom_s >= SORT_STACK)
1610 	    {error_msg_fatal("\nSTACK EXHAUSTED!!!\n");}
1611 
1612 	  /* push right hand child iff length > 1 */
1613 	  if ((*top_s = size-(pi-ar)))
1614 	    {
1615 	      *(top_a++) = pi;
1616 	      size -= *top_s+2;
1617 	      top_s++;
1618 	    }
1619 	  /* set up for next loop iff there is something to do */
1620 	  else if (size -= *top_s+2)
1621 	    {;}
1622 	  /* might as well pop - note NR_OPT >=2 ==> we're ok! */
1623 	  else
1624 	    {
1625 	      ar = *(--top_a);
1626 	      size = *(--top_s);
1627 	    }
1628 	}
1629 
1630       /* else sort small list directly then pop another off stack */
1631       else
1632 	{
1633 	  /* insertion sort for bottom */
1634           for (pj=ar+1;pj<=ar+size;pj++)
1635             {
1636               temp = *pj;
1637               for (pi=pj-1;pi>=ar;pi--)
1638                 {
1639                   if (*pi <= temp) break;
1640                   *(pi+1)=*pi;
1641                 }
1642               *(pi+1)=temp;
1643 	    }
1644 
1645 	  /* check to see if stack is exhausted ==> DONE */
1646 	  if (top_s==bottom_s) return;
1647 
1648 	  /* else pop another list from the stack */
1649 	  ar = *(--top_a);
1650 	  size = *(--top_s);
1651 	}
1652     }
1653 }
1654 
1655 
1656 
1657 /******************************************************************************
1658 Function: my_sort().
1659 Input : offset of list to be sorted, number of elements to be sorted.
1660 Output: sorted list (in ascending order).
1661 Return: none.
1662 Description: stack based (nonrecursive) quicksort w/brute-shell bottom.
1663 ******************************************************************************/
1664 void
1665 rvec_sort_companion(register REAL *ar, register int *ar2, register int Size)
1666 {
1667   register REAL *pi, *pj, temp;
1668   register REAL **top_a = (REAL **)offset_stack;
1669   register PTRINT *top_s = psize_stack, *bottom_s = psize_stack;
1670   register PTRINT size = (PTRINT) Size;
1671 
1672   register int *pi2, *pj2;
1673   register int ptr;
1674   register PTRINT mid;
1675 
1676 
1677   /* we're really interested in the offset of the last element */
1678   /* ==> length of the list is now size + 1                    */
1679   size--;
1680 
1681   /* do until we're done ... return when stack is exhausted */
1682   for (;;)
1683     {
1684       /* if list is large enough use quicksort partition exchange code */
1685       if (size > SORT_OPT)
1686 	{
1687 	  /* start up pointer at element 1 and down at size     */
1688 	  mid = size>>1;
1689 	  pi = ar+1;
1690 	  pj = ar+mid;
1691 	  pi2 = ar2+1;
1692 	  pj2 = ar2+mid;
1693 
1694 	  /* find middle element in list and swap w/ element 1 */
1695 	  SWAP(*pi,*pj)
1696 	  P_SWAP(*pi2,*pj2)
1697 
1698 	  /* order element 0,1,size-1 st {M,L,...,U} w/L<=M<=U */
1699 	  /* note ==> pivot_value in index 0                   */
1700 	  pj = ar+size;
1701 	  pj2 = ar2+size;
1702 	  if (*pi > *pj)
1703 	    {SWAP(*pi,*pj) P_SWAP(*pi2,*pj2)}
1704 	  if (*ar > *pj)
1705 	    {SWAP(*ar,*pj) P_SWAP(*ar2,*pj2)}
1706 	  else if (*pi > *ar)
1707 	    {SWAP(*(ar),*(ar+1)) P_SWAP(*(ar2),*(ar2+1))}
1708 
1709 	  /* partition about pivot_value ...  	                    */
1710 	  /* note lists of length 2 are not guaranteed to be sorted */
1711 	  for(;;)
1712 	    {
1713 	      /* walk up ... and down ... swap if equal to pivot! */
1714 	      do {pi++; pi2++;} while (*pi<*ar);
1715 	      do {pj--; pj2--;} while (*pj>*ar);
1716 
1717 	      /* if we've crossed we're done */
1718 	      if (pj<pi) break;
1719 
1720 	      /* else swap */
1721 	      SWAP(*pi,*pj)
1722 	      P_SWAP(*pi2,*pj2)
1723 	    }
1724 
1725 	  /* place pivot_value in it's correct location */
1726 	  SWAP(*ar,*pj)
1727 	  P_SWAP(*ar2,*pj2)
1728 
1729 	  /* test stack_size to see if we've exhausted our stack */
1730 	  if (top_s-bottom_s >= SORT_STACK)
1731 	    {error_msg_fatal("\nSTACK EXHAUSTED!!!\n");}
1732 
1733 	  /* push right hand child iff length > 1 */
1734 	  if ((*top_s = size-(pi-ar)))
1735 	    {
1736 	      *(top_a++) = pi;
1737 	      *(top_a++) = (REAL *) pi2;
1738 	      size -= *top_s+2;
1739 	      top_s++;
1740 	    }
1741 	  /* set up for next loop iff there is something to do */
1742 	  else if (size -= *top_s+2)
1743 	    {;}
1744 	  /* might as well pop - note NR_OPT >=2 ==> we're ok! */
1745 	  else
1746 	    {
1747 	      ar2 = (int*) *(--top_a);
1748 	      ar  = *(--top_a);
1749 	      size = *(--top_s);
1750 	    }
1751 	}
1752 
1753       /* else sort small list directly then pop another off stack */
1754       else
1755 	{
1756 	  /* insertion sort for bottom */
1757           for (pj=ar+1, pj2=ar2+1;pj<=ar+size;pj++,pj2++)
1758             {
1759               temp = *pj;
1760               ptr = *pj2;
1761               for (pi=pj-1,pi2=pj2-1;pi>=ar;pi--,pi2--)
1762                 {
1763                   if (*pi <= temp) break;
1764                   *(pi+1)=*pi;
1765                   *(pi2+1)=*pi2;
1766                 }
1767               *(pi+1)=temp;
1768               *(pi2+1)=ptr;
1769 	    }
1770 
1771 	  /* check to see if stack is exhausted ==> DONE */
1772 	  if (top_s==bottom_s) return;
1773 
1774 	  /* else pop another list from the stack */
1775 	  ar2 = (int*) *(--top_a);
1776 	  ar  = *(--top_a);
1777 	  size = *(--top_s);
1778 	}
1779     }
1780 }
1781 
1782 
1783 
1784 
1785 
1786 /**********************************ivec.c**************************************
1787 Function ivec_binary_search()
1788 
1789 Input :
1790 Output:
1791 Return:
1792 Description:
1793 ***********************************ivec.c*************************************/
1794 int
1795 rvec_binary_search(register REAL item, register REAL *list, register int rh)
1796 {
1797   register int mid, lh=0;
1798 
1799   rh--;
1800   while (lh<=rh)
1801     {
1802       mid = (lh+rh)>>1;
1803       if (*(list+mid) == item)
1804 	{return(mid);}
1805       if (*(list+mid) > item)
1806 	{rh = mid-1;}
1807       else
1808 	{lh = mid+1;}
1809     }
1810   return(-1);
1811 }
1812 
1813 
1814 
1815 
1816 
1817