Actual source code: ivec.c
1: /**********************************ivec.c**************************************
3: Author: Henry M. Tufo III
5: e-mail: hmt@cs.brown.edu
7: snail-mail:
8: Division of Applied Mathematics
9: Brown University
10: Providence, RI 02912
12: Last Modification:
13: 6.21.97
14: ***********************************ivec.c*************************************/
16: #include <../src/ksp/pc/impls/tfs/tfs.h>
18: /* sorting args ivec.c ivec.c ... */
19: #define SORT_OPT 6
20: #define SORT_STACK 50000
22: /* allocate an address and size stack for sorter(s) */
23: static void *offset_stack[2 * SORT_STACK];
24: static PetscInt size_stack[SORT_STACK];
26: /***********************************ivec.c*************************************/
27: PetscInt *PCTFS_ivec_copy(PetscInt *arg1, PetscInt *arg2, PetscInt n)
28: {
29: while (n--) *arg1++ = *arg2++;
30: return arg1;
31: }
33: /***********************************ivec.c*************************************/
34: PetscErrorCode PCTFS_ivec_zero(PetscInt *arg1, PetscInt n)
35: {
36: PetscFunctionBegin;
37: while (n--) *arg1++ = 0;
38: PetscFunctionReturn(PETSC_SUCCESS);
39: }
41: /***********************************ivec.c*************************************/
42: PetscErrorCode PCTFS_ivec_set(PetscInt *arg1, PetscInt arg2, PetscInt n)
43: {
44: PetscFunctionBegin;
45: while (n--) *arg1++ = arg2;
46: PetscFunctionReturn(PETSC_SUCCESS);
47: }
49: /***********************************ivec.c*************************************/
50: PetscErrorCode PCTFS_ivec_max(PetscInt *arg1, PetscInt *arg2, PetscInt n)
51: {
52: PetscFunctionBegin;
53: while (n--) {
54: *arg1 = PetscMax(*arg1, *arg2);
55: arg1++;
56: arg2++;
57: }
58: PetscFunctionReturn(PETSC_SUCCESS);
59: }
61: /***********************************ivec.c*************************************/
62: PetscErrorCode PCTFS_ivec_min(PetscInt *arg1, PetscInt *arg2, PetscInt n)
63: {
64: PetscFunctionBegin;
65: while (n--) {
66: *(arg1) = PetscMin(*arg1, *arg2);
67: arg1++;
68: arg2++;
69: }
70: PetscFunctionReturn(PETSC_SUCCESS);
71: }
73: /***********************************ivec.c*************************************/
74: PetscErrorCode PCTFS_ivec_mult(PetscInt *arg1, PetscInt *arg2, PetscInt n)
75: {
76: PetscFunctionBegin;
77: while (n--) *arg1++ *= *arg2++;
78: PetscFunctionReturn(PETSC_SUCCESS);
79: }
81: /***********************************ivec.c*************************************/
82: PetscErrorCode PCTFS_ivec_add(PetscInt *arg1, PetscInt *arg2, PetscInt n)
83: {
84: PetscFunctionBegin;
85: while (n--) *arg1++ += *arg2++;
86: PetscFunctionReturn(PETSC_SUCCESS);
87: }
89: /***********************************ivec.c*************************************/
90: PetscErrorCode PCTFS_ivec_lxor(PetscInt *arg1, PetscInt *arg2, PetscInt n)
91: {
92: PetscFunctionBegin;
93: while (n--) {
94: *arg1 = (*arg1 || *arg2) && !(*arg1 && *arg2);
95: arg1++;
96: arg2++;
97: }
98: PetscFunctionReturn(PETSC_SUCCESS);
99: }
101: /***********************************ivec.c*************************************/
102: PetscErrorCode PCTFS_ivec_xor(PetscInt *arg1, PetscInt *arg2, PetscInt n)
103: {
104: PetscFunctionBegin;
105: while (n--) *arg1++ ^= *arg2++;
106: PetscFunctionReturn(PETSC_SUCCESS);
107: }
109: /***********************************ivec.c*************************************/
110: PetscErrorCode PCTFS_ivec_or(PetscInt *arg1, PetscInt *arg2, PetscInt n)
111: {
112: PetscFunctionBegin;
113: while (n--) *arg1++ |= *arg2++;
114: PetscFunctionReturn(PETSC_SUCCESS);
115: }
117: /***********************************ivec.c*************************************/
118: PetscErrorCode PCTFS_ivec_lor(PetscInt *arg1, PetscInt *arg2, PetscInt n)
119: {
120: PetscFunctionBegin;
121: while (n--) {
122: *arg1 = (*arg1 || *arg2);
123: arg1++;
124: arg2++;
125: }
126: PetscFunctionReturn(PETSC_SUCCESS);
127: }
129: /***********************************ivec.c*************************************/
130: PetscErrorCode PCTFS_ivec_and(PetscInt *arg1, PetscInt *arg2, PetscInt n)
131: {
132: PetscFunctionBegin;
133: while (n--) *arg1++ &= *arg2++;
134: PetscFunctionReturn(PETSC_SUCCESS);
135: }
137: /***********************************ivec.c*************************************/
138: PetscErrorCode PCTFS_ivec_land(PetscInt *arg1, PetscInt *arg2, PetscInt n)
139: {
140: PetscFunctionBegin;
141: while (n--) {
142: *arg1 = (*arg1 && *arg2);
143: arg1++;
144: arg2++;
145: }
146: PetscFunctionReturn(PETSC_SUCCESS);
147: }
149: /***********************************ivec.c*************************************/
150: PetscErrorCode PCTFS_ivec_and3(PetscInt *arg1, PetscInt *arg2, PetscInt *arg3, PetscInt n)
151: {
152: PetscFunctionBegin;
153: while (n--) *arg1++ = (*arg2++ & *arg3++);
154: PetscFunctionReturn(PETSC_SUCCESS);
155: }
157: /***********************************ivec.c*************************************/
158: PetscInt PCTFS_ivec_sum(PetscInt *arg1, PetscInt n)
159: {
160: PetscInt tmp = 0;
161: while (n--) tmp += *arg1++;
162: return tmp;
163: }
165: /***********************************ivec.c*************************************/
166: PetscErrorCode PCTFS_ivec_non_uniform(PetscInt *arg1, PetscInt *arg2, PetscInt n, ...)
167: {
168: PetscInt i, j, type;
169: PetscInt *arg3;
170: va_list ap;
172: PetscFunctionBegin;
173: va_start(ap, n);
174: arg3 = va_arg(ap, PetscInt *);
175: va_end(ap);
177: /* LATER: if we're really motivated we can sort and then unsort */
178: for (i = 0; i < n;) {
179: /* clump 'em for now */
180: j = i + 1;
181: type = arg3[i];
182: while ((j < n) && (arg3[j] == type)) j++;
184: /* how many together */
185: j -= i;
187: /* call appropriate ivec function */
188: if (type == GL_MAX) PetscCall(PCTFS_ivec_max(arg1, arg2, j));
189: else if (type == GL_MIN) PetscCall(PCTFS_ivec_min(arg1, arg2, j));
190: else if (type == GL_MULT) PetscCall(PCTFS_ivec_mult(arg1, arg2, j));
191: else if (type == GL_ADD) PetscCall(PCTFS_ivec_add(arg1, arg2, j));
192: else if (type == GL_B_XOR) PetscCall(PCTFS_ivec_xor(arg1, arg2, j));
193: else if (type == GL_B_OR) PetscCall(PCTFS_ivec_or(arg1, arg2, j));
194: else if (type == GL_B_AND) PetscCall(PCTFS_ivec_and(arg1, arg2, j));
195: else if (type == GL_L_XOR) PetscCall(PCTFS_ivec_lxor(arg1, arg2, j));
196: else if (type == GL_L_OR) PetscCall(PCTFS_ivec_lor(arg1, arg2, j));
197: else if (type == GL_L_AND) PetscCall(PCTFS_ivec_land(arg1, arg2, j));
198: else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "unrecognized type passed to PCTFS_ivec_non_uniform()!");
200: arg1 += j;
201: arg2 += j;
202: i += j;
203: }
204: PetscFunctionReturn(PETSC_SUCCESS);
205: }
207: /***********************************ivec.c*************************************/
208: vfp PCTFS_ivec_fct_addr(PetscInt type)
209: {
210: if (type == NON_UNIFORM) return (PetscErrorCode (*)(void *, void *, PetscInt, ...))&PCTFS_ivec_non_uniform;
211: else if (type == GL_MAX) return (PetscErrorCode (*)(void *, void *, PetscInt, ...))&PCTFS_ivec_max;
212: else if (type == GL_MIN) return (PetscErrorCode (*)(void *, void *, PetscInt, ...))&PCTFS_ivec_min;
213: else if (type == GL_MULT) return (PetscErrorCode (*)(void *, void *, PetscInt, ...))&PCTFS_ivec_mult;
214: else if (type == GL_ADD) return (PetscErrorCode (*)(void *, void *, PetscInt, ...))&PCTFS_ivec_add;
215: else if (type == GL_B_XOR) return (PetscErrorCode (*)(void *, void *, PetscInt, ...))&PCTFS_ivec_xor;
216: else if (type == GL_B_OR) return (PetscErrorCode (*)(void *, void *, PetscInt, ...))&PCTFS_ivec_or;
217: else if (type == GL_B_AND) return (PetscErrorCode (*)(void *, void *, PetscInt, ...))&PCTFS_ivec_and;
218: else if (type == GL_L_XOR) return (PetscErrorCode (*)(void *, void *, PetscInt, ...))&PCTFS_ivec_lxor;
219: else if (type == GL_L_OR) return (PetscErrorCode (*)(void *, void *, PetscInt, ...))&PCTFS_ivec_lor;
220: else if (type == GL_L_AND) return (PetscErrorCode (*)(void *, void *, PetscInt, ...))&PCTFS_ivec_land;
222: /* catch all ... not good if we get here */
223: return NULL;
224: }
226: /******************************************************************************/
227: PetscErrorCode PCTFS_ivec_sort(PetscInt *ar, PetscInt size)
228: {
229: PetscInt *pi, *pj, temp;
230: PetscInt **top_a = (PetscInt **)offset_stack;
231: PetscInt *top_s = size_stack, *bottom_s = size_stack;
233: PetscFunctionBegin;
234: /* we're really interested in the offset of the last element */
235: /* ==> length of the list is now size + 1 */
236: size--;
238: /* do until we're done ... return when stack is exhausted */
239: for (;;) {
240: /* if list is large enough use quicksort partition exchange code */
241: if (size > SORT_OPT) {
242: /* start up pointer at element 1 and down at size */
243: pi = ar + 1;
244: pj = ar + size;
246: /* find middle element in list and swap w/ element 1 */
247: SWAP(*(ar + (size >> 1)), *pi);
249: /* order element 0,1,size-1 st {M,L,...,U} w/L<=M<=U */
250: /* note ==> pivot_value in index 0 */
251: if (*pi > *pj) SWAP(*pi, *pj);
252: if (*ar > *pj) SWAP(*ar, *pj);
253: else if (*pi > *ar) SWAP(*(ar), *(ar + 1));
255: /* partition about pivot_value ... */
256: /* note lists of length 2 are not guaranteed to be sorted */
257: for (;;) {
258: /* walk up ... and down ... swap if equal to pivot! */
259: do pi++;
260: while (*pi < *ar);
261: do pj--;
262: while (*pj > *ar);
264: /* if we've crossed we're done */
265: if (pj < pi) break;
267: /* else swap */
268: SWAP(*pi, *pj);
269: }
271: /* place pivot_value in it's correct location */
272: SWAP(*ar, *pj);
274: /* test stack_size to see if we've exhausted our stack */
275: PetscCheck(top_s - bottom_s < SORT_STACK, PETSC_COMM_SELF, PETSC_ERR_PLIB, "PCTFS_ivec_sort() :: STACK EXHAUSTED!!!");
277: /* push right hand child iff length > 1 */
278: if ((*top_s = size - ((PetscInt)(pi - ar)))) {
279: *(top_a++) = pi;
280: size -= *top_s + 2;
281: top_s++;
282: } else if (size -= *top_s + 2)
283: ; /* set up for next loop iff there is something to do */
284: else { /* might as well pop - note NR_OPT >=2 ==> we're ok! */ ar = *(--top_a);
285: size = *(--top_s);
286: }
287: } else { /* else sort small list directly then pop another off stack */
289: /* insertion sort for bottom */
290: for (pj = ar + 1; pj <= ar + size; pj++) {
291: temp = *pj;
292: for (pi = pj - 1; pi >= ar; pi--) {
293: if (*pi <= temp) break;
294: *(pi + 1) = *pi;
295: }
296: *(pi + 1) = temp;
297: }
299: /* check to see if stack is exhausted ==> DONE */
300: if (top_s == bottom_s) PetscFunctionReturn(PETSC_SUCCESS);
302: /* else pop another list from the stack */
303: ar = *(--top_a);
304: size = *(--top_s);
305: }
306: }
307: }
309: /******************************************************************************/
310: PetscErrorCode PCTFS_ivec_sort_companion(PetscInt *ar, PetscInt *ar2, PetscInt size)
311: {
312: PetscInt *pi, *pj, temp, temp2;
313: PetscInt **top_a = (PetscInt **)offset_stack;
314: PetscInt *top_s = size_stack, *bottom_s = size_stack;
315: PetscInt *pi2, *pj2;
316: PetscInt mid;
318: PetscFunctionBegin;
319: /* we're really interested in the offset of the last element */
320: /* ==> length of the list is now size + 1 */
321: size--;
323: /* do until we're done ... return when stack is exhausted */
324: for (;;) {
325: /* if list is large enough use quicksort partition exchange code */
326: if (size > SORT_OPT) {
327: /* start up pointer at element 1 and down at size */
328: mid = size >> 1;
329: pi = ar + 1;
330: pj = ar + mid;
331: pi2 = ar2 + 1;
332: pj2 = ar2 + mid;
334: /* find middle element in list and swap w/ element 1 */
335: SWAP(*pi, *pj);
336: SWAP(*pi2, *pj2);
338: /* order element 0,1,size-1 st {M,L,...,U} w/L<=M<=U */
339: /* note ==> pivot_value in index 0 */
340: pj = ar + size;
341: pj2 = ar2 + size;
342: if (*pi > *pj) {
343: SWAP(*pi, *pj);
344: SWAP(*pi2, *pj2);
345: }
346: if (*ar > *pj) {
347: SWAP(*ar, *pj);
348: SWAP(*ar2, *pj2);
349: } else if (*pi > *ar) {
350: SWAP(*(ar), *(ar + 1));
351: SWAP(*(ar2), *(ar2 + 1));
352: }
354: /* partition about pivot_value ... */
355: /* note lists of length 2 are not guaranteed to be sorted */
356: for (;;) {
357: /* walk up ... and down ... swap if equal to pivot! */
358: do {
359: pi++;
360: pi2++;
361: } while (*pi < *ar);
362: do {
363: pj--;
364: pj2--;
365: } while (*pj > *ar);
367: /* if we've crossed we're done */
368: if (pj < pi) break;
370: /* else swap */
371: SWAP(*pi, *pj);
372: SWAP(*pi2, *pj2);
373: }
375: /* place pivot_value in it's correct location */
376: SWAP(*ar, *pj);
377: SWAP(*ar2, *pj2);
379: /* test stack_size to see if we've exhausted our stack */
380: PetscCheck(top_s - bottom_s < SORT_STACK, PETSC_COMM_SELF, PETSC_ERR_PLIB, "PCTFS_ivec_sort_companion() :: STACK EXHAUSTED!!!");
382: /* push right hand child iff length > 1 */
383: if ((*top_s = size - ((PetscInt)(pi - ar)))) {
384: *(top_a++) = pi;
385: *(top_a++) = pi2;
386: size -= *top_s + 2;
387: top_s++;
388: } else if (size -= *top_s + 2)
389: ; /* set up for next loop iff there is something to do */
390: else { /* might as well pop - note NR_OPT >=2 ==> we're ok! */ ar2 = *(--top_a);
391: ar = *(--top_a);
392: size = *(--top_s);
393: }
394: } else { /* else sort small list directly then pop another off stack */
396: /* insertion sort for bottom */
397: for (pj = ar + 1, pj2 = ar2 + 1; pj <= ar + size; pj++, pj2++) {
398: temp = *pj;
399: temp2 = *pj2;
400: for (pi = pj - 1, pi2 = pj2 - 1; pi >= ar; pi--, pi2--) {
401: if (*pi <= temp) break;
402: *(pi + 1) = *pi;
403: *(pi2 + 1) = *pi2;
404: }
405: *(pi + 1) = temp;
406: *(pi2 + 1) = temp2;
407: }
409: /* check to see if stack is exhausted ==> DONE */
410: if (top_s == bottom_s) PetscFunctionReturn(PETSC_SUCCESS);
412: /* else pop another list from the stack */
413: ar2 = *(--top_a);
414: ar = *(--top_a);
415: size = *(--top_s);
416: }
417: }
418: }
420: /******************************************************************************/
421: PetscErrorCode PCTFS_ivec_sort_companion_hack(PetscInt *ar, PetscInt **ar2, PetscInt size)
422: {
423: PetscInt *pi, *pj, temp, *ptr;
424: PetscInt **top_a = (PetscInt **)offset_stack;
425: PetscInt *top_s = size_stack, *bottom_s = size_stack;
426: PetscInt **pi2, **pj2;
427: PetscInt mid;
429: PetscFunctionBegin;
430: /* we're really interested in the offset of the last element */
431: /* ==> length of the list is now size + 1 */
432: size--;
434: /* do until we're done ... return when stack is exhausted */
435: for (;;) {
436: /* if list is large enough use quicksort partition exchange code */
437: if (size > SORT_OPT) {
438: /* start up pointer at element 1 and down at size */
439: mid = size >> 1;
440: pi = ar + 1;
441: pj = ar + mid;
442: pi2 = ar2 + 1;
443: pj2 = ar2 + mid;
445: /* find middle element in list and swap w/ element 1 */
446: SWAP(*pi, *pj);
447: P_SWAP(*pi2, *pj2);
449: /* order element 0,1,size-1 st {M,L,...,U} w/L<=M<=U */
450: /* note ==> pivot_value in index 0 */
451: pj = ar + size;
452: pj2 = ar2 + size;
453: if (*pi > *pj) {
454: SWAP(*pi, *pj);
455: P_SWAP(*pi2, *pj2);
456: }
457: if (*ar > *pj) {
458: SWAP(*ar, *pj);
459: P_SWAP(*ar2, *pj2);
460: } else if (*pi > *ar) {
461: SWAP(*(ar), *(ar + 1));
462: P_SWAP(*(ar2), *(ar2 + 1));
463: }
465: /* partition about pivot_value ... */
466: /* note lists of length 2 are not guaranteed to be sorted */
467: for (;;) {
468: /* walk up ... and down ... swap if equal to pivot! */
469: do {
470: pi++;
471: pi2++;
472: } while (*pi < *ar);
473: do {
474: pj--;
475: pj2--;
476: } while (*pj > *ar);
478: /* if we've crossed we're done */
479: if (pj < pi) break;
481: /* else swap */
482: SWAP(*pi, *pj);
483: P_SWAP(*pi2, *pj2);
484: }
486: /* place pivot_value in it's correct location */
487: SWAP(*ar, *pj);
488: P_SWAP(*ar2, *pj2);
490: /* test stack_size to see if we've exhausted our stack */
491: PetscCheck(top_s - bottom_s < SORT_STACK, PETSC_COMM_SELF, PETSC_ERR_PLIB, "PCTFS_ivec_sort_companion_hack() :: STACK EXHAUSTED!!!");
493: /* push right hand child iff length > 1 */
494: if ((*top_s = size - ((PetscInt)(pi - ar)))) {
495: *(top_a++) = pi;
496: *(top_a++) = (PetscInt *)pi2;
497: size -= *top_s + 2;
498: top_s++;
499: } else if (size -= *top_s + 2)
500: ; /* set up for next loop iff there is something to do */
501: else { /* might as well pop - note NR_OPT >=2 ==> we're ok! */ ar2 = (PetscInt **)*(--top_a);
502: ar = *(--top_a);
503: size = *(--top_s);
504: }
505: } else { /* else sort small list directly then pop another off stack */
506: /* insertion sort for bottom */
507: for (pj = ar + 1, pj2 = ar2 + 1; pj <= ar + size; pj++, pj2++) {
508: temp = *pj;
509: ptr = *pj2;
510: for (pi = pj - 1, pi2 = pj2 - 1; pi >= ar; pi--, pi2--) {
511: if (*pi <= temp) break;
512: *(pi + 1) = *pi;
513: *(pi2 + 1) = *pi2;
514: }
515: *(pi + 1) = temp;
516: *(pi2 + 1) = ptr;
517: }
519: /* check to see if stack is exhausted ==> DONE */
520: if (top_s == bottom_s) PetscFunctionReturn(PETSC_SUCCESS);
522: /* else pop another list from the stack */
523: ar2 = (PetscInt **)*(--top_a);
524: ar = *(--top_a);
525: size = *(--top_s);
526: }
527: }
528: }
530: /******************************************************************************/
531: PetscErrorCode PCTFS_SMI_sort(void *ar1, void *ar2, PetscInt size, PetscInt type)
532: {
533: PetscFunctionBegin;
534: if (type == SORT_INTEGER) {
535: if (ar2) PetscCall(PCTFS_ivec_sort_companion((PetscInt *)ar1, (PetscInt *)ar2, size));
536: else PetscCall(PCTFS_ivec_sort((PetscInt *)ar1, size));
537: } else if (type == SORT_INT_PTR) {
538: if (ar2) PetscCall(PCTFS_ivec_sort_companion_hack((PetscInt *)ar1, (PetscInt **)ar2, size));
539: else PetscCall(PCTFS_ivec_sort((PetscInt *)ar1, size));
540: } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "PCTFS_SMI_sort only does SORT_INTEGER!");
541: PetscFunctionReturn(PETSC_SUCCESS);
542: }
544: /***********************************ivec.c*************************************/
545: PetscInt PCTFS_ivec_linear_search(PetscInt item, PetscInt *list, PetscInt n)
546: {
547: PetscInt tmp = n - 1;
549: while (n--) {
550: if (*list++ == item) return tmp - n;
551: }
552: return -1;
553: }
555: /***********************************ivec.c*************************************/
556: PetscInt PCTFS_ivec_binary_search(PetscInt item, PetscInt *list, PetscInt rh)
557: {
558: PetscInt mid, lh = 0;
560: rh--;
561: while (lh <= rh) {
562: mid = (lh + rh) >> 1;
563: if (*(list + mid) == item) return mid;
564: if (*(list + mid) > item) rh = mid - 1;
565: else lh = mid + 1;
566: }
567: return -1;
568: }
570: /*********************************ivec.c*************************************/
571: PetscErrorCode PCTFS_rvec_copy(PetscScalar *arg1, PetscScalar *arg2, PetscInt n)
572: {
573: PetscFunctionBegin;
574: while (n--) *arg1++ = *arg2++;
575: PetscFunctionReturn(PETSC_SUCCESS);
576: }
578: /*********************************ivec.c*************************************/
579: PetscErrorCode PCTFS_rvec_zero(PetscScalar *arg1, PetscInt n)
580: {
581: PetscFunctionBegin;
582: while (n--) *arg1++ = 0.0;
583: PetscFunctionReturn(PETSC_SUCCESS);
584: }
586: /***********************************ivec.c*************************************/
587: PetscErrorCode PCTFS_rvec_one(PetscScalar *arg1, PetscInt n)
588: {
589: PetscFunctionBegin;
590: while (n--) *arg1++ = 1.0;
591: PetscFunctionReturn(PETSC_SUCCESS);
592: }
594: /***********************************ivec.c*************************************/
595: PetscErrorCode PCTFS_rvec_set(PetscScalar *arg1, PetscScalar arg2, PetscInt n)
596: {
597: PetscFunctionBegin;
598: while (n--) *arg1++ = arg2;
599: PetscFunctionReturn(PETSC_SUCCESS);
600: }
602: /***********************************ivec.c*************************************/
603: PetscErrorCode PCTFS_rvec_scale(PetscScalar *arg1, PetscScalar arg2, PetscInt n)
604: {
605: PetscFunctionBegin;
606: while (n--) *arg1++ *= arg2;
607: PetscFunctionReturn(PETSC_SUCCESS);
608: }
610: /*********************************ivec.c*************************************/
611: PetscErrorCode PCTFS_rvec_add(PetscScalar *arg1, PetscScalar *arg2, PetscInt n)
612: {
613: PetscFunctionBegin;
614: while (n--) *arg1++ += *arg2++;
615: PetscFunctionReturn(PETSC_SUCCESS);
616: }
618: /*********************************ivec.c*************************************/
619: PetscErrorCode PCTFS_rvec_mult(PetscScalar *arg1, PetscScalar *arg2, PetscInt n)
620: {
621: PetscFunctionBegin;
622: while (n--) *arg1++ *= *arg2++;
623: PetscFunctionReturn(PETSC_SUCCESS);
624: }
626: /*********************************ivec.c*************************************/
627: PetscErrorCode PCTFS_rvec_max(PetscScalar *arg1, PetscScalar *arg2, PetscInt n)
628: {
629: PetscFunctionBegin;
630: while (n--) {
631: *arg1 = PetscMax(*arg1, *arg2);
632: arg1++;
633: arg2++;
634: }
635: PetscFunctionReturn(PETSC_SUCCESS);
636: }
638: /*********************************ivec.c*************************************/
639: PetscErrorCode PCTFS_rvec_max_abs(PetscScalar *arg1, PetscScalar *arg2, PetscInt n)
640: {
641: PetscFunctionBegin;
642: while (n--) {
643: *arg1 = MAX_FABS(*arg1, *arg2);
644: arg1++;
645: arg2++;
646: }
647: PetscFunctionReturn(PETSC_SUCCESS);
648: }
650: /*********************************ivec.c*************************************/
651: PetscErrorCode PCTFS_rvec_min(PetscScalar *arg1, PetscScalar *arg2, PetscInt n)
652: {
653: PetscFunctionBegin;
654: while (n--) {
655: *arg1 = PetscMin(*arg1, *arg2);
656: arg1++;
657: arg2++;
658: }
659: PetscFunctionReturn(PETSC_SUCCESS);
660: }
662: /*********************************ivec.c*************************************/
663: PetscErrorCode PCTFS_rvec_min_abs(PetscScalar *arg1, PetscScalar *arg2, PetscInt n)
664: {
665: PetscFunctionBegin;
666: while (n--) {
667: *arg1 = MIN_FABS(*arg1, *arg2);
668: arg1++;
669: arg2++;
670: }
671: PetscFunctionReturn(PETSC_SUCCESS);
672: }
674: /*********************************ivec.c*************************************/
675: static PetscErrorCode PCTFS_rvec_exists(PetscScalar *arg1, PetscScalar *arg2, PetscInt n)
676: {
677: PetscFunctionBegin;
678: while (n--) {
679: *arg1 = EXISTS(*arg1, *arg2);
680: arg1++;
681: arg2++;
682: }
683: PetscFunctionReturn(PETSC_SUCCESS);
684: }
686: /***********************************ivec.c*************************************/
687: static PetscErrorCode PCTFS_rvec_non_uniform(PetscScalar *arg1, PetscScalar *arg2, PetscInt n, PetscInt *arg3)
688: {
689: PetscInt i, j, type;
691: PetscFunctionBegin;
692: /* LATER: if we're really motivated we can sort and then unsort */
693: for (i = 0; i < n;) {
694: /* clump 'em for now */
695: j = i + 1;
696: type = arg3[i];
697: while ((j < n) && (arg3[j] == type)) j++;
699: /* how many together */
700: j -= i;
702: /* call appropriate ivec function */
703: if (type == GL_MAX) PetscCall(PCTFS_rvec_max(arg1, arg2, j));
704: else if (type == GL_MIN) PetscCall(PCTFS_rvec_min(arg1, arg2, j));
705: else if (type == GL_MULT) PetscCall(PCTFS_rvec_mult(arg1, arg2, j));
706: else if (type == GL_ADD) PetscCall(PCTFS_rvec_add(arg1, arg2, j));
707: else if (type == GL_MAX_ABS) PetscCall(PCTFS_rvec_max_abs(arg1, arg2, j));
708: else if (type == GL_MIN_ABS) PetscCall(PCTFS_rvec_min_abs(arg1, arg2, j));
709: else if (type == GL_EXISTS) PetscCall(PCTFS_rvec_exists(arg1, arg2, j));
710: else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "unrecognized type passed to PCTFS_rvec_non_uniform()!");
712: arg1 += j;
713: arg2 += j;
714: i += j;
715: }
716: PetscFunctionReturn(PETSC_SUCCESS);
717: }
719: /***********************************ivec.c*************************************/
720: vfp PCTFS_rvec_fct_addr(PetscInt type)
721: {
722: if (type == NON_UNIFORM) return (PetscErrorCode (*)(void *, void *, PetscInt, ...))&PCTFS_rvec_non_uniform;
723: else if (type == GL_MAX) return (PetscErrorCode (*)(void *, void *, PetscInt, ...))&PCTFS_rvec_max;
724: else if (type == GL_MIN) return (PetscErrorCode (*)(void *, void *, PetscInt, ...))&PCTFS_rvec_min;
725: else if (type == GL_MULT) return (PetscErrorCode (*)(void *, void *, PetscInt, ...))&PCTFS_rvec_mult;
726: else if (type == GL_ADD) return (PetscErrorCode (*)(void *, void *, PetscInt, ...))&PCTFS_rvec_add;
727: else if (type == GL_MAX_ABS) return (PetscErrorCode (*)(void *, void *, PetscInt, ...))&PCTFS_rvec_max_abs;
728: else if (type == GL_MIN_ABS) return (PetscErrorCode (*)(void *, void *, PetscInt, ...))&PCTFS_rvec_min_abs;
729: else if (type == GL_EXISTS) return (PetscErrorCode (*)(void *, void *, PetscInt, ...))&PCTFS_rvec_exists;
731: /* catch all ... not good if we get here */
732: return NULL;
733: }