Actual source code: ivec.c


  2: /**********************************ivec.c**************************************

  4: Author: Henry M. Tufo III

  6: e-mail: hmt@cs.brown.edu

  8: snail-mail:
  9: Division of Applied Mathematics
 10: Brown University
 11: Providence, RI 02912

 13: Last Modification:
 14: 6.21.97
 15: ***********************************ivec.c*************************************/

 17: #include <../src/ksp/pc/impls/tfs/tfs.h>

 19: /* sorting args ivec.c ivec.c ... */
 20: #define SORT_OPT   6
 21: #define SORT_STACK 50000

 23: /* allocate an address and size stack for sorter(s) */
 24: static void    *offset_stack[2 * SORT_STACK];
 25: static PetscInt size_stack[SORT_STACK];

 27: /***********************************ivec.c*************************************/
 28: PetscInt *PCTFS_ivec_copy(PetscInt *arg1, PetscInt *arg2, PetscInt n)
 29: {
 30:   while (n--) *arg1++ = *arg2++;
 31:   return (arg1);
 32: }

 34: /***********************************ivec.c*************************************/
 35: PetscErrorCode PCTFS_ivec_zero(PetscInt *arg1, PetscInt n)
 36: {
 37:   PetscFunctionBegin;
 38:   while (n--) *arg1++ = 0;
 39:   PetscFunctionReturn(PETSC_SUCCESS);
 40: }

 42: /***********************************ivec.c*************************************/
 43: PetscErrorCode PCTFS_ivec_set(PetscInt *arg1, PetscInt arg2, PetscInt n)
 44: {
 45:   PetscFunctionBegin;
 46:   while (n--) *arg1++ = arg2;
 47:   PetscFunctionReturn(PETSC_SUCCESS);
 48: }

 50: /***********************************ivec.c*************************************/
 51: PetscErrorCode PCTFS_ivec_max(PetscInt *arg1, PetscInt *arg2, PetscInt n)
 52: {
 53:   PetscFunctionBegin;
 54:   while (n--) {
 55:     *arg1 = PetscMax(*arg1, *arg2);
 56:     arg1++;
 57:     arg2++;
 58:   }
 59:   PetscFunctionReturn(PETSC_SUCCESS);
 60: }

 62: /***********************************ivec.c*************************************/
 63: PetscErrorCode PCTFS_ivec_min(PetscInt *arg1, PetscInt *arg2, PetscInt n)
 64: {
 65:   PetscFunctionBegin;
 66:   while (n--) {
 67:     *(arg1) = PetscMin(*arg1, *arg2);
 68:     arg1++;
 69:     arg2++;
 70:   }
 71:   PetscFunctionReturn(PETSC_SUCCESS);
 72: }

 74: /***********************************ivec.c*************************************/
 75: PetscErrorCode PCTFS_ivec_mult(PetscInt *arg1, PetscInt *arg2, PetscInt n)
 76: {
 77:   PetscFunctionBegin;
 78:   while (n--) *arg1++ *= *arg2++;
 79:   PetscFunctionReturn(PETSC_SUCCESS);
 80: }

 82: /***********************************ivec.c*************************************/
 83: PetscErrorCode PCTFS_ivec_add(PetscInt *arg1, PetscInt *arg2, PetscInt n)
 84: {
 85:   PetscFunctionBegin;
 86:   while (n--) *arg1++ += *arg2++;
 87:   PetscFunctionReturn(PETSC_SUCCESS);
 88: }

 90: /***********************************ivec.c*************************************/
 91: PetscErrorCode PCTFS_ivec_lxor(PetscInt *arg1, PetscInt *arg2, PetscInt n)
 92: {
 93:   PetscFunctionBegin;
 94:   while (n--) {
 95:     *arg1 = ((*arg1 || *arg2) && !(*arg1 && *arg2));
 96:     arg1++;
 97:     arg2++;
 98:   }
 99:   PetscFunctionReturn(PETSC_SUCCESS);
100: }

102: /***********************************ivec.c*************************************/
103: PetscErrorCode PCTFS_ivec_xor(PetscInt *arg1, PetscInt *arg2, PetscInt n)
104: {
105:   PetscFunctionBegin;
106:   while (n--) *arg1++ ^= *arg2++;
107:   PetscFunctionReturn(PETSC_SUCCESS);
108: }

110: /***********************************ivec.c*************************************/
111: PetscErrorCode PCTFS_ivec_or(PetscInt *arg1, PetscInt *arg2, PetscInt n)
112: {
113:   PetscFunctionBegin;
114:   while (n--) *arg1++ |= *arg2++;
115:   PetscFunctionReturn(PETSC_SUCCESS);
116: }

118: /***********************************ivec.c*************************************/
119: PetscErrorCode PCTFS_ivec_lor(PetscInt *arg1, PetscInt *arg2, PetscInt n)
120: {
121:   PetscFunctionBegin;
122:   while (n--) {
123:     *arg1 = (*arg1 || *arg2);
124:     arg1++;
125:     arg2++;
126:   }
127:   PetscFunctionReturn(PETSC_SUCCESS);
128: }

130: /***********************************ivec.c*************************************/
131: PetscErrorCode PCTFS_ivec_and(PetscInt *arg1, PetscInt *arg2, PetscInt n)
132: {
133:   PetscFunctionBegin;
134:   while (n--) *arg1++ &= *arg2++;
135:   PetscFunctionReturn(PETSC_SUCCESS);
136: }

138: /***********************************ivec.c*************************************/
139: PetscErrorCode PCTFS_ivec_land(PetscInt *arg1, PetscInt *arg2, PetscInt n)
140: {
141:   PetscFunctionBegin;
142:   while (n--) {
143:     *arg1 = (*arg1 && *arg2);
144:     arg1++;
145:     arg2++;
146:   }
147:   PetscFunctionReturn(PETSC_SUCCESS);
148: }

150: /***********************************ivec.c*************************************/
151: PetscErrorCode PCTFS_ivec_and3(PetscInt *arg1, PetscInt *arg2, PetscInt *arg3, PetscInt n)
152: {
153:   PetscFunctionBegin;
154:   while (n--) *arg1++ = (*arg2++ & *arg3++);
155:   PetscFunctionReturn(PETSC_SUCCESS);
156: }

158: /***********************************ivec.c*************************************/
159: PetscInt PCTFS_ivec_sum(PetscInt *arg1, PetscInt n)
160: {
161:   PetscInt tmp = 0;
162:   while (n--) tmp += *arg1++;
163:   return (tmp);
164: }

166: /***********************************ivec.c*************************************/
167: PetscErrorCode PCTFS_ivec_non_uniform(PetscInt *arg1, PetscInt *arg2, PetscInt n, ...)
168: {
169:   PetscInt  i, j, type;
170:   PetscInt *arg3;
171:   va_list   ap;

173:   PetscFunctionBegin;
174:   va_start(ap, n);
175:   arg3 = va_arg(ap, PetscInt *);
176:   va_end(ap);

178:   /* LATER: if we're really motivated we can sort and then unsort */
179:   for (i = 0; i < n;) {
180:     /* clump 'em for now */
181:     j    = i + 1;
182:     type = arg3[i];
183:     while ((j < n) && (arg3[j] == type)) j++;

185:     /* how many together */
186:     j -= i;

188:     /* call appropriate ivec function */
189:     if (type == GL_MAX) PetscCall(PCTFS_ivec_max(arg1, arg2, j));
190:     else if (type == GL_MIN) PetscCall(PCTFS_ivec_min(arg1, arg2, j));
191:     else if (type == GL_MULT) PetscCall(PCTFS_ivec_mult(arg1, arg2, j));
192:     else if (type == GL_ADD) PetscCall(PCTFS_ivec_add(arg1, arg2, j));
193:     else if (type == GL_B_XOR) PetscCall(PCTFS_ivec_xor(arg1, arg2, j));
194:     else if (type == GL_B_OR) PetscCall(PCTFS_ivec_or(arg1, arg2, j));
195:     else if (type == GL_B_AND) PetscCall(PCTFS_ivec_and(arg1, arg2, j));
196:     else if (type == GL_L_XOR) PetscCall(PCTFS_ivec_lxor(arg1, arg2, j));
197:     else if (type == GL_L_OR) PetscCall(PCTFS_ivec_lor(arg1, arg2, j));
198:     else if (type == GL_L_AND) PetscCall(PCTFS_ivec_land(arg1, arg2, j));
199:     else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "unrecognized type passed to PCTFS_ivec_non_uniform()!");

201:     arg1 += j;
202:     arg2 += j;
203:     i += j;
204:   }
205:   PetscFunctionReturn(PETSC_SUCCESS);
206: }

208: /***********************************ivec.c*************************************/
209: vfp PCTFS_ivec_fct_addr(PetscInt type)
210: {
211:   if (type == NON_UNIFORM) return ((PetscErrorCode(*)(void *, void *, PetscInt, ...)) & PCTFS_ivec_non_uniform);
212:   else if (type == GL_MAX) return ((PetscErrorCode(*)(void *, void *, PetscInt, ...)) & PCTFS_ivec_max);
213:   else if (type == GL_MIN) return ((PetscErrorCode(*)(void *, void *, PetscInt, ...)) & PCTFS_ivec_min);
214:   else if (type == GL_MULT) return ((PetscErrorCode(*)(void *, void *, PetscInt, ...)) & PCTFS_ivec_mult);
215:   else if (type == GL_ADD) return ((PetscErrorCode(*)(void *, void *, PetscInt, ...)) & PCTFS_ivec_add);
216:   else if (type == GL_B_XOR) return ((PetscErrorCode(*)(void *, void *, PetscInt, ...)) & PCTFS_ivec_xor);
217:   else if (type == GL_B_OR) return ((PetscErrorCode(*)(void *, void *, PetscInt, ...)) & PCTFS_ivec_or);
218:   else if (type == GL_B_AND) return ((PetscErrorCode(*)(void *, void *, PetscInt, ...)) & PCTFS_ivec_and);
219:   else if (type == GL_L_XOR) return ((PetscErrorCode(*)(void *, void *, PetscInt, ...)) & PCTFS_ivec_lxor);
220:   else if (type == GL_L_OR) return ((PetscErrorCode(*)(void *, void *, PetscInt, ...)) & PCTFS_ivec_lor);
221:   else if (type == GL_L_AND) return ((PetscErrorCode(*)(void *, void *, PetscInt, ...)) & PCTFS_ivec_land);

223:   /* catch all ... not good if we get here */
224:   return (NULL);
225: }

227: /******************************************************************************/
228: PetscErrorCode PCTFS_ivec_sort(PetscInt *ar, PetscInt size)
229: {
230:   PetscInt  *pi, *pj, temp;
231:   PetscInt **top_a = (PetscInt **)offset_stack;
232:   PetscInt  *top_s = size_stack, *bottom_s = size_stack;

234:   PetscFunctionBegin;
235:   /* we're really interested in the offset of the last element */
236:   /* ==> length of the list is now size + 1                    */
237:   size--;

239:   /* do until we're done ... return when stack is exhausted */
240:   for (;;) {
241:     /* if list is large enough use quicksort partition exchange code */
242:     if (size > SORT_OPT) {
243:       /* start up pointer at element 1 and down at size     */
244:       pi = ar + 1;
245:       pj = ar + size;

247:       /* find middle element in list and swap w/ element 1 */
248:       SWAP(*(ar + (size >> 1)), *pi)

250:       /* order element 0,1,size-1 st {M,L,...,U} w/L<=M<=U */
251:       /* note ==> pivot_value in index 0                   */
252:       if (*pi > *pj) { SWAP(*pi, *pj) }
253:       if (*ar > *pj) {
254:         SWAP(*ar, *pj)
255:       } else if (*pi > *ar) {
256:         SWAP(*(ar), *(ar + 1))
257:       }

259:       /* partition about pivot_value ...                              */
260:       /* note lists of length 2 are not guaranteed to be sorted */
261:       for (;;) {
262:         /* walk up ... and down ... swap if equal to pivot! */
263:         do pi++;
264:         while (*pi < *ar);
265:         do pj--;
266:         while (*pj > *ar);

268:         /* if we've crossed we're done */
269:         if (pj < pi) break;

271:         /* else swap */
272:         SWAP(*pi, *pj)
273:       }

275:       /* place pivot_value in it's correct location */
276:       SWAP(*ar, *pj)

278:       /* test stack_size to see if we've exhausted our stack */
279:       PetscCheck(top_s - bottom_s < SORT_STACK, PETSC_COMM_SELF, PETSC_ERR_PLIB, "PCTFS_ivec_sort() :: STACK EXHAUSTED!!!");

281:       /* push right hand child iff length > 1 */
282:       if ((*top_s = size - ((PetscInt)(pi - ar)))) {
283:         *(top_a++) = pi;
284:         size -= *top_s + 2;
285:         top_s++;
286:       } else if (size -= *top_s + 2)
287:         ; /* set up for next loop iff there is something to do */
288:       else { /* might as well pop - note NR_OPT >=2 ==> we're ok! */ ar = *(--top_a);
289:         size                                                            = *(--top_s);
290:       }
291:     } else { /* else sort small list directly then pop another off stack */

293:       /* insertion sort for bottom */
294:       for (pj = ar + 1; pj <= ar + size; pj++) {
295:         temp = *pj;
296:         for (pi = pj - 1; pi >= ar; pi--) {
297:           if (*pi <= temp) break;
298:           *(pi + 1) = *pi;
299:         }
300:         *(pi + 1) = temp;
301:       }

303:       /* check to see if stack is exhausted ==> DONE */
304:       if (top_s == bottom_s) PetscFunctionReturn(PETSC_SUCCESS);

306:       /* else pop another list from the stack */
307:       ar   = *(--top_a);
308:       size = *(--top_s);
309:     }
310:   }
311: }

313: /******************************************************************************/
314: PetscErrorCode PCTFS_ivec_sort_companion(PetscInt *ar, PetscInt *ar2, PetscInt size)
315: {
316:   PetscInt  *pi, *pj, temp, temp2;
317:   PetscInt **top_a = (PetscInt **)offset_stack;
318:   PetscInt  *top_s = size_stack, *bottom_s = size_stack;
319:   PetscInt  *pi2, *pj2;
320:   PetscInt   mid;

322:   PetscFunctionBegin;
323:   /* we're really interested in the offset of the last element */
324:   /* ==> length of the list is now size + 1                    */
325:   size--;

327:   /* do until we're done ... return when stack is exhausted */
328:   for (;;) {
329:     /* if list is large enough use quicksort partition exchange code */
330:     if (size > SORT_OPT) {
331:       /* start up pointer at element 1 and down at size     */
332:       mid = size >> 1;
333:       pi  = ar + 1;
334:       pj  = ar + mid;
335:       pi2 = ar2 + 1;
336:       pj2 = ar2 + mid;

338:       /* find middle element in list and swap w/ element 1 */
339:       SWAP(*pi, *pj)
340:       SWAP(*pi2, *pj2)

342:       /* order element 0,1,size-1 st {M,L,...,U} w/L<=M<=U */
343:       /* note ==> pivot_value in index 0                   */
344:       pj  = ar + size;
345:       pj2 = ar2 + size;
346:       if (*pi > *pj) { SWAP(*pi, *pj) SWAP(*pi2, *pj2) }
347:       if (*ar > *pj) {
348:         SWAP(*ar, *pj) SWAP(*ar2, *pj2)
349:       } else if (*pi > *ar) {
350:         SWAP(*(ar), *(ar + 1)) SWAP(*(ar2), *(ar2 + 1))
351:       }

353:       /* partition about pivot_value ...                              */
354:       /* note lists of length 2 are not guaranteed to be sorted */
355:       for (;;) {
356:         /* walk up ... and down ... swap if equal to pivot! */
357:         do {
358:           pi++;
359:           pi2++;
360:         } while (*pi < *ar);
361:         do {
362:           pj--;
363:           pj2--;
364:         } while (*pj > *ar);

366:         /* if we've crossed we're done */
367:         if (pj < pi) break;

369:         /* else swap */
370:         SWAP(*pi, *pj)
371:         SWAP(*pi2, *pj2)
372:       }

374:       /* place pivot_value in it's correct location */
375:       SWAP(*ar, *pj)
376:       SWAP(*ar2, *pj2)

378:       /* test stack_size to see if we've exhausted our stack */
379:       PetscCheck(top_s - bottom_s < SORT_STACK, PETSC_COMM_SELF, PETSC_ERR_PLIB, "PCTFS_ivec_sort_companion() :: STACK EXHAUSTED!!!");

381:       /* push right hand child iff length > 1 */
382:       if ((*top_s = size - ((PetscInt)(pi - ar)))) {
383:         *(top_a++) = pi;
384:         *(top_a++) = pi2;
385:         size -= *top_s + 2;
386:         top_s++;
387:       } else if (size -= *top_s + 2)
388:         ; /* set up for next loop iff there is something to do */
389:       else { /* might as well pop - note NR_OPT >=2 ==> we're ok! */ ar2 = *(--top_a);
390:         ar                                                               = *(--top_a);
391:         size                                                             = *(--top_s);
392:       }
393:     } else { /* else sort small list directly then pop another off stack */

395:       /* insertion sort for bottom */
396:       for (pj = ar + 1, pj2 = ar2 + 1; pj <= ar + size; pj++, pj2++) {
397:         temp  = *pj;
398:         temp2 = *pj2;
399:         for (pi = pj - 1, pi2 = pj2 - 1; pi >= ar; pi--, pi2--) {
400:           if (*pi <= temp) break;
401:           *(pi + 1)  = *pi;
402:           *(pi2 + 1) = *pi2;
403:         }
404:         *(pi + 1)  = temp;
405:         *(pi2 + 1) = temp2;
406:       }

408:       /* check to see if stack is exhausted ==> DONE */
409:       if (top_s == bottom_s) PetscFunctionReturn(PETSC_SUCCESS);

411:       /* else pop another list from the stack */
412:       ar2  = *(--top_a);
413:       ar   = *(--top_a);
414:       size = *(--top_s);
415:     }
416:   }
417: }

419: /******************************************************************************/
420: PetscErrorCode PCTFS_ivec_sort_companion_hack(PetscInt *ar, PetscInt **ar2, PetscInt size)
421: {
422:   PetscInt  *pi, *pj, temp, *ptr;
423:   PetscInt **top_a = (PetscInt **)offset_stack;
424:   PetscInt  *top_s = size_stack, *bottom_s = size_stack;
425:   PetscInt **pi2, **pj2;
426:   PetscInt   mid;

428:   PetscFunctionBegin;
429:   /* we're really interested in the offset of the last element */
430:   /* ==> length of the list is now size + 1                    */
431:   size--;

433:   /* do until we're done ... return when stack is exhausted */
434:   for (;;) {
435:     /* if list is large enough use quicksort partition exchange code */
436:     if (size > SORT_OPT) {
437:       /* start up pointer at element 1 and down at size     */
438:       mid = size >> 1;
439:       pi  = ar + 1;
440:       pj  = ar + mid;
441:       pi2 = ar2 + 1;
442:       pj2 = ar2 + mid;

444:       /* find middle element in list and swap w/ element 1 */
445:       SWAP(*pi, *pj)
446:       P_SWAP(*pi2, *pj2)

448:       /* order element 0,1,size-1 st {M,L,...,U} w/L<=M<=U */
449:       /* note ==> pivot_value in index 0                   */
450:       pj  = ar + size;
451:       pj2 = ar2 + size;
452:       if (*pi > *pj) { SWAP(*pi, *pj) P_SWAP(*pi2, *pj2) }
453:       if (*ar > *pj) {
454:         SWAP(*ar, *pj) P_SWAP(*ar2, *pj2)
455:       } else if (*pi > *ar) {
456:         SWAP(*(ar), *(ar + 1)) P_SWAP(*(ar2), *(ar2 + 1))
457:       }

459:       /* partition about pivot_value ...                              */
460:       /* note lists of length 2 are not guaranteed to be sorted */
461:       for (;;) {
462:         /* walk up ... and down ... swap if equal to pivot! */
463:         do {
464:           pi++;
465:           pi2++;
466:         } while (*pi < *ar);
467:         do {
468:           pj--;
469:           pj2--;
470:         } while (*pj > *ar);

472:         /* if we've crossed we're done */
473:         if (pj < pi) break;

475:         /* else swap */
476:         SWAP(*pi, *pj)
477:         P_SWAP(*pi2, *pj2)
478:       }

480:       /* place pivot_value in it's correct location */
481:       SWAP(*ar, *pj)
482:       P_SWAP(*ar2, *pj2)

484:       /* test stack_size to see if we've exhausted our stack */
485:       PetscCheck(top_s - bottom_s < SORT_STACK, PETSC_COMM_SELF, PETSC_ERR_PLIB, "PCTFS_ivec_sort_companion_hack() :: STACK EXHAUSTED!!!");

487:       /* push right hand child iff length > 1 */
488:       if ((*top_s = size - ((PetscInt)(pi - ar)))) {
489:         *(top_a++) = pi;
490:         *(top_a++) = (PetscInt *)pi2;
491:         size -= *top_s + 2;
492:         top_s++;
493:       } else if (size -= *top_s + 2)
494:         ; /* set up for next loop iff there is something to do */
495:       else { /* might as well pop - note NR_OPT >=2 ==> we're ok! */ ar2 = (PetscInt **)*(--top_a);
496:         ar                                                               = *(--top_a);
497:         size                                                             = *(--top_s);
498:       }
499:     } else { /* else sort small list directly then pop another off stack */
500:       /* insertion sort for bottom */
501:       for (pj = ar + 1, pj2 = ar2 + 1; pj <= ar + size; pj++, pj2++) {
502:         temp = *pj;
503:         ptr  = *pj2;
504:         for (pi = pj - 1, pi2 = pj2 - 1; pi >= ar; pi--, pi2--) {
505:           if (*pi <= temp) break;
506:           *(pi + 1)  = *pi;
507:           *(pi2 + 1) = *pi2;
508:         }
509:         *(pi + 1)  = temp;
510:         *(pi2 + 1) = ptr;
511:       }

513:       /* check to see if stack is exhausted ==> DONE */
514:       if (top_s == bottom_s) PetscFunctionReturn(PETSC_SUCCESS);

516:       /* else pop another list from the stack */
517:       ar2  = (PetscInt **)*(--top_a);
518:       ar   = *(--top_a);
519:       size = *(--top_s);
520:     }
521:   }
522: }

524: /******************************************************************************/
525: PetscErrorCode PCTFS_SMI_sort(void *ar1, void *ar2, PetscInt size, PetscInt type)
526: {
527:   PetscFunctionBegin;
528:   if (type == SORT_INTEGER) {
529:     if (ar2) PetscCall(PCTFS_ivec_sort_companion((PetscInt *)ar1, (PetscInt *)ar2, size));
530:     else PetscCall(PCTFS_ivec_sort((PetscInt *)ar1, size));
531:   } else if (type == SORT_INT_PTR) {
532:     if (ar2) PetscCall(PCTFS_ivec_sort_companion_hack((PetscInt *)ar1, (PetscInt **)ar2, size));
533:     else PetscCall(PCTFS_ivec_sort((PetscInt *)ar1, size));
534:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "PCTFS_SMI_sort only does SORT_INTEGER!");
535:   PetscFunctionReturn(PETSC_SUCCESS);
536: }

538: /***********************************ivec.c*************************************/
539: PetscInt PCTFS_ivec_linear_search(PetscInt item, PetscInt *list, PetscInt n)
540: {
541:   PetscInt tmp = n - 1;

543:   while (n--) {
544:     if (*list++ == item) return (tmp - n);
545:   }
546:   return (-1);
547: }

549: /***********************************ivec.c*************************************/
550: PetscInt PCTFS_ivec_binary_search(PetscInt item, PetscInt *list, PetscInt rh)
551: {
552:   PetscInt mid, lh = 0;

554:   rh--;
555:   while (lh <= rh) {
556:     mid = (lh + rh) >> 1;
557:     if (*(list + mid) == item) return (mid);
558:     if (*(list + mid) > item) rh = mid - 1;
559:     else lh = mid + 1;
560:   }
561:   return (-1);
562: }

564: /*********************************ivec.c*************************************/
565: PetscErrorCode PCTFS_rvec_copy(PetscScalar *arg1, PetscScalar *arg2, PetscInt n)
566: {
567:   PetscFunctionBegin;
568:   while (n--) *arg1++ = *arg2++;
569:   PetscFunctionReturn(PETSC_SUCCESS);
570: }

572: /*********************************ivec.c*************************************/
573: PetscErrorCode PCTFS_rvec_zero(PetscScalar *arg1, PetscInt n)
574: {
575:   PetscFunctionBegin;
576:   while (n--) *arg1++ = 0.0;
577:   PetscFunctionReturn(PETSC_SUCCESS);
578: }

580: /***********************************ivec.c*************************************/
581: PetscErrorCode PCTFS_rvec_one(PetscScalar *arg1, PetscInt n)
582: {
583:   PetscFunctionBegin;
584:   while (n--) *arg1++ = 1.0;
585:   PetscFunctionReturn(PETSC_SUCCESS);
586: }

588: /***********************************ivec.c*************************************/
589: PetscErrorCode PCTFS_rvec_set(PetscScalar *arg1, PetscScalar arg2, PetscInt n)
590: {
591:   PetscFunctionBegin;
592:   while (n--) *arg1++ = arg2;
593:   PetscFunctionReturn(PETSC_SUCCESS);
594: }

596: /***********************************ivec.c*************************************/
597: PetscErrorCode PCTFS_rvec_scale(PetscScalar *arg1, PetscScalar arg2, PetscInt n)
598: {
599:   PetscFunctionBegin;
600:   while (n--) *arg1++ *= arg2;
601:   PetscFunctionReturn(PETSC_SUCCESS);
602: }

604: /*********************************ivec.c*************************************/
605: PetscErrorCode PCTFS_rvec_add(PetscScalar *arg1, PetscScalar *arg2, PetscInt n)
606: {
607:   PetscFunctionBegin;
608:   while (n--) *arg1++ += *arg2++;
609:   PetscFunctionReturn(PETSC_SUCCESS);
610: }

612: /*********************************ivec.c*************************************/
613: PetscErrorCode PCTFS_rvec_mult(PetscScalar *arg1, PetscScalar *arg2, PetscInt n)
614: {
615:   PetscFunctionBegin;
616:   while (n--) *arg1++ *= *arg2++;
617:   PetscFunctionReturn(PETSC_SUCCESS);
618: }

620: /*********************************ivec.c*************************************/
621: PetscErrorCode PCTFS_rvec_max(PetscScalar *arg1, PetscScalar *arg2, PetscInt n)
622: {
623:   PetscFunctionBegin;
624:   while (n--) {
625:     *arg1 = PetscMax(*arg1, *arg2);
626:     arg1++;
627:     arg2++;
628:   }
629:   PetscFunctionReturn(PETSC_SUCCESS);
630: }

632: /*********************************ivec.c*************************************/
633: PetscErrorCode PCTFS_rvec_max_abs(PetscScalar *arg1, PetscScalar *arg2, PetscInt n)
634: {
635:   PetscFunctionBegin;
636:   while (n--) {
637:     *arg1 = MAX_FABS(*arg1, *arg2);
638:     arg1++;
639:     arg2++;
640:   }
641:   PetscFunctionReturn(PETSC_SUCCESS);
642: }

644: /*********************************ivec.c*************************************/
645: PetscErrorCode PCTFS_rvec_min(PetscScalar *arg1, PetscScalar *arg2, PetscInt n)
646: {
647:   PetscFunctionBegin;
648:   while (n--) {
649:     *arg1 = PetscMin(*arg1, *arg2);
650:     arg1++;
651:     arg2++;
652:   }
653:   PetscFunctionReturn(PETSC_SUCCESS);
654: }

656: /*********************************ivec.c*************************************/
657: PetscErrorCode PCTFS_rvec_min_abs(PetscScalar *arg1, PetscScalar *arg2, PetscInt n)
658: {
659:   PetscFunctionBegin;
660:   while (n--) {
661:     *arg1 = MIN_FABS(*arg1, *arg2);
662:     arg1++;
663:     arg2++;
664:   }
665:   PetscFunctionReturn(PETSC_SUCCESS);
666: }

668: /*********************************ivec.c*************************************/
669: PetscErrorCode PCTFS_rvec_exists(PetscScalar *arg1, PetscScalar *arg2, PetscInt n)
670: {
671:   PetscFunctionBegin;
672:   while (n--) {
673:     *arg1 = EXISTS(*arg1, *arg2);
674:     arg1++;
675:     arg2++;
676:   }
677:   PetscFunctionReturn(PETSC_SUCCESS);
678: }

680: /***********************************ivec.c*************************************/
681: PetscErrorCode PCTFS_rvec_non_uniform(PetscScalar *arg1, PetscScalar *arg2, PetscInt n, PetscInt *arg3)
682: {
683:   PetscInt i, j, type;

685:   PetscFunctionBegin;
686:   /* LATER: if we're really motivated we can sort and then unsort */
687:   for (i = 0; i < n;) {
688:     /* clump 'em for now */
689:     j    = i + 1;
690:     type = arg3[i];
691:     while ((j < n) && (arg3[j] == type)) j++;

693:     /* how many together */
694:     j -= i;

696:     /* call appropriate ivec function */
697:     if (type == GL_MAX) PetscCall(PCTFS_rvec_max(arg1, arg2, j));
698:     else if (type == GL_MIN) PetscCall(PCTFS_rvec_min(arg1, arg2, j));
699:     else if (type == GL_MULT) PetscCall(PCTFS_rvec_mult(arg1, arg2, j));
700:     else if (type == GL_ADD) PetscCall(PCTFS_rvec_add(arg1, arg2, j));
701:     else if (type == GL_MAX_ABS) PetscCall(PCTFS_rvec_max_abs(arg1, arg2, j));
702:     else if (type == GL_MIN_ABS) PetscCall(PCTFS_rvec_min_abs(arg1, arg2, j));
703:     else if (type == GL_EXISTS) PetscCall(PCTFS_rvec_exists(arg1, arg2, j));
704:     else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "unrecognized type passed to PCTFS_rvec_non_uniform()!");

706:     arg1 += j;
707:     arg2 += j;
708:     i += j;
709:   }
710:   PetscFunctionReturn(PETSC_SUCCESS);
711: }

713: /***********************************ivec.c*************************************/
714: vfp PCTFS_rvec_fct_addr(PetscInt type)
715: {
716:   if (type == NON_UNIFORM) return ((PetscErrorCode(*)(void *, void *, PetscInt, ...)) & PCTFS_rvec_non_uniform);
717:   else if (type == GL_MAX) return ((PetscErrorCode(*)(void *, void *, PetscInt, ...)) & PCTFS_rvec_max);
718:   else if (type == GL_MIN) return ((PetscErrorCode(*)(void *, void *, PetscInt, ...)) & PCTFS_rvec_min);
719:   else if (type == GL_MULT) return ((PetscErrorCode(*)(void *, void *, PetscInt, ...)) & PCTFS_rvec_mult);
720:   else if (type == GL_ADD) return ((PetscErrorCode(*)(void *, void *, PetscInt, ...)) & PCTFS_rvec_add);
721:   else if (type == GL_MAX_ABS) return ((PetscErrorCode(*)(void *, void *, PetscInt, ...)) & PCTFS_rvec_max_abs);
722:   else if (type == GL_MIN_ABS) return ((PetscErrorCode(*)(void *, void *, PetscInt, ...)) & PCTFS_rvec_min_abs);
723:   else if (type == GL_EXISTS) return ((PetscErrorCode(*)(void *, void *, PetscInt, ...)) & PCTFS_rvec_exists);

725:   /* catch all ... not good if we get here */
726:   return (NULL);
727: }