Actual source code: err.c

petsc-3.8.3 2017-12-09
Report Typos and Errors

  2: /*
  3:       Code that allows one to set the error handlers
  4: */
  5:  #include <petsc/private/petscimpl.h>
  6:  #include <petscviewer.h>

  8: typedef struct _EH *EH;
  9: struct _EH {
 10:   PetscErrorCode (*handler)(MPI_Comm,int,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*);
 11:   void           *ctx;
 12:   EH             previous;
 13: };

 15: static EH eh = 0;

 17: /*@C
 18:    PetscEmacsClientErrorHandler - Error handler that uses the emacsclient program to
 19:     load the file where the error occured. Then calls the "previous" error handler.

 21:    Not Collective

 23:    Input Parameters:
 24: +  comm - communicator over which error occured
 25: .  line - the line number of the error (indicated by __LINE__)
 26: .  file - the file in which the error was detected (indicated by __FILE__)
 27: .  mess - an error text string, usually just printed to the screen
 28: .  n - the generic error number
 29: .  p - specific error number
 30: -  ctx - error handler context

 32:    Options Database Key:
 33: .   -on_error_emacs <machinename>

 35:    Level: developer

 37:    Notes:
 38:    You must put (server-start) in your .emacs file for the emacsclient software to work

 40:    Most users need not directly employ this routine and the other error
 41:    handlers, but can instead use the simplified interface SETERRQ, which has
 42:    the calling sequence
 43: $     SETERRQ(PETSC_COMM_SELF,number,p,mess)

 45:    Notes for experienced users:
 46:    Use PetscPushErrorHandler() to set the desired error handler.

 48:    Developer Note: Since this is an error handler it cannot call CHKERRQ(); thus we just return if an error is detected.

 50:    Concepts: emacs^going to on error
 51:    Concepts: error handler^going to line in emacs

 53: .seealso:  PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(),
 54:           PetscAbortErrorHandler()
 55:  @*/
 56: PetscErrorCode  PetscEmacsClientErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx)
 57: {
 59:   char           command[PETSC_MAX_PATH_LEN];
 60:   const char     *pdir;
 61:   FILE           *fp;
 62:   int            rval;

 65:   PetscGetPetscDir(&pdir);if (ierr) PetscFunctionReturn(ierr);
 66:   sprintf(command,"cd %s; emacsclient --no-wait +%d %s\n",pdir,line,file);
 67: #if defined(PETSC_HAVE_POPEN)
 68:   PetscPOpen(MPI_COMM_WORLD,(char*)ctx,command,"r",&fp);if (ierr) PetscFunctionReturn(ierr);
 69:   PetscPClose(MPI_COMM_WORLD,fp,&rval);if (ierr) PetscFunctionReturn(ierr);
 70: #else
 71:   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP_SYS,"Cannot run external programs on this machine");
 72: #endif
 73:   PetscPopErrorHandler();if (ierr) PetscFunctionReturn(ierr); /* remove this handler from the stack of handlers */
 74:   if (!eh) {
 75:     PetscTraceBackErrorHandler(comm,line,fun,file,n,p,mess,0);if (ierr) PetscFunctionReturn(ierr);
 76:   } else {
 77:     (*eh->handler)(comm,line,fun,file,n,p,mess,eh->ctx);if (ierr) PetscFunctionReturn(ierr);
 78:   }
 79:   PetscFunctionReturn(ierr);
 80: }

 82: /*@C
 83:    PetscPushErrorHandler - Sets a routine to be called on detection of errors.

 85:    Not Collective

 87:    Input Parameters:
 88: +  handler - error handler routine
 89: -  ctx - optional handler context that contains information needed by the handler (for
 90:          example file pointers for error messages etc.)

 92:    Calling sequence of handler:
 93: $    int handler(MPI_Comm comm,int line,char *func,char *file,PetscErrorCode n,int p,char *mess,void *ctx);

 95: +  comm - communicator over which error occured
 96: .  line - the line number of the error (indicated by __LINE__)
 97: .  file - the file in which the error was detected (indicated by __FILE__)
 98: .  n - the generic error number (see list defined in include/petscerror.h)
 99: .  p - PETSC_ERROR_INITIAL if error just detected, otherwise PETSC_ERROR_REPEAT
100: .  mess - an error text string, usually just printed to the screen
101: -  ctx - the error handler context

103:    Options Database Keys:
104: +   -on_error_attach_debugger <noxterm,gdb or dbx>
105: -   -on_error_abort

107:    Level: intermediate

109:    Notes:
110:    The currently available PETSc error handlers include PetscTraceBackErrorHandler(),
111:    PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscMPIAbortErrorHandler(), PetscReturnErrorHandler().

113:    Fortran Notes: You can only push one error handler from Fortran before poping it.

115: .seealso: PetscPopErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), PetscTraceBackErrorHandler(), PetscPushSignalHandler()

117: @*/
118: PetscErrorCode  PetscPushErrorHandler(PetscErrorCode (*handler)(MPI_Comm comm,int,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*),void *ctx)
119: {
120:   EH             neweh;

124:   PetscNew(&neweh);
125:   if (eh) neweh->previous = eh;
126:   else    neweh->previous = 0;
127:   neweh->handler = handler;
128:   neweh->ctx     = ctx;
129:   eh             = neweh;
130:   return(0);
131: }

133: /*@
134:    PetscPopErrorHandler - Removes the latest error handler that was
135:    pushed with PetscPushErrorHandler().

137:    Not Collective

139:    Level: intermediate

141:    Concepts: error handler^setting

143: .seealso: PetscPushErrorHandler()
144: @*/
145: PetscErrorCode  PetscPopErrorHandler(void)
146: {
147:   EH             tmp;

151:   if (!eh) return(0);
152:   tmp  = eh;
153:   eh   = eh->previous;
154:   PetscFree(tmp);
155:   return(0);
156: }

158: /*@C
159:   PetscReturnErrorHandler - Error handler that causes a return to the current
160:   level.

162:    Not Collective

164:    Input Parameters:
165: +  comm - communicator over which error occurred
166: .  line - the line number of the error (indicated by __LINE__)
167: .  file - the file in which the error was detected (indicated by __FILE__)
168: .  mess - an error text string, usually just printed to the screen
169: .  n - the generic error number
170: .  p - specific error number
171: -  ctx - error handler context

173:    Level: developer

175:    Notes:
176:    Most users need not directly employ this routine and the other error
177:    handlers, but can instead use the simplified interface SETERRQ, which has
178:    the calling sequence
179: $     SETERRQ(comm,number,mess)

181:    Notes for experienced users:
182:    This routine is good for catching errors such as zero pivots in preconditioners
183:    or breakdown of iterative methods. It is not appropriate for memory violations
184:    and similar errors.

186:    Use PetscPushErrorHandler() to set the desired error handler.  The
187:    currently available PETSc error handlers include PetscTraceBackErrorHandler(),
188:    PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscAbortErrorHandler()

190:    Concepts: error handler

192: .seealso:  PetscPushErrorHandler(), PetscPopErrorHandler().
193:  @*/

195: PetscErrorCode  PetscReturnErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx)
196: {
198:   PetscFunctionReturn(n);
199: }

201: static char PetscErrorBaseMessage[1024];
202: /*
203:        The numerical values for these are defined in include/petscerror.h; any changes
204:    there must also be made here
205: */
206: static const char *PetscErrorStrings[] = {
207:   /*55 */ "Out of memory",
208:           "No support for this operation for this object type",
209:           "No support for this operation on this system",
210:   /*58 */ "Operation done in wrong order",
211:   /*59 */ "Signal received",
212:   /*60 */ "Nonconforming object sizes",
213:           "Argument aliasing not permitted",
214:           "Invalid argument",
215:   /*63 */ "Argument out of range",
216:           "Corrupt argument: http://www.mcs.anl.gov/petsc/documentation/faq.html#valgrind",
217:           "Unable to open file",
218:           "Read from file failed",
219:           "Write to file failed",
220:           "Invalid pointer",
221:   /*69 */ "Arguments must have same type",
222:   /*70 */ "Attempt to use a pointer that does not point to a valid accessible location",
223:   /*71 */ "Zero pivot in LU factorization: http://www.mcs.anl.gov/petsc/documentation/faq.html#zeropivot",
224:   /*72 */ "Floating point exception",
225:   /*73 */ "Object is in wrong state",
226:           "Corrupted Petsc object",
227:           "Arguments are incompatible",
228:           "Error in external library",
229:   /*77 */ "Petsc has generated inconsistent data",
230:           "Memory corruption: http://www.mcs.anl.gov/petsc/documentation/installation.html#valgrind",
231:           "Unexpected data in file",
232:   /*80 */ "Arguments must have same communicators",
233:   /*81 */ "Zero pivot in Cholesky factorization: http://www.mcs.anl.gov/petsc/documentation/faq.html#zeropivot",
234:           "  ",
235:           "  ",
236:           "Overflow in integer operation: http://www.mcs.anl.gov/petsc/documentation/faq.html#64-bit-indices",
237:   /*85 */ "Null argument, when expecting valid pointer",
238:   /*86 */ "Unknown type. Check for miss-spelling or missing package: http://www.mcs.anl.gov/petsc/documentation/installation.html#external",
239:   /*87 */ "MPI library at runtime is not compatible with MPI used at compile time",
240:   /*88 */ "Error in system call",
241:   /*89 */ "Object Type not set: http://www.mcs.anl.gov/petsc/documentation/faq.html#objecttypenotset"
242:   /*90 */ "  ",
243:   /*   */ "  ",
244:   /*   */ "  ",
245:   /*93 */ "See http://www.mcs.anl.gov/petsc/documentation/linearsolvertable.html for possible LU and Cholesky solvers",
246:   /*   */ "You cannot overwrite this option since that will conflict with other previously set options",
247:   /*   */ "  ",
248:   /*96 */ "  ",
249: };

251: /*@C
252:    PetscErrorMessage - returns the text string associated with a PETSc error code.

254:    Not Collective

256:    Input Parameter:
257: .   errnum - the error code

259:    Output Parameter:
260: +  text - the error message (NULL if not desired)
261: -  specific - the specific error message that was set with SETERRxxx() or PetscError().  (NULL if not desired)

263:    Level: developer

265:    Concepts: error handler^messages

267: .seealso:  PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscError(), SETERRQ(), CHKERRQ() 
268:           PetscAbortErrorHandler(), PetscTraceBackErrorHandler()
269:  @*/
270: PetscErrorCode  PetscErrorMessage(int errnum,const char *text[],char **specific)
271: {
273:   if (text && errnum > PETSC_ERR_MIN_VALUE && errnum < PETSC_ERR_MAX_VALUE) *text = PetscErrorStrings[errnum-PETSC_ERR_MIN_VALUE-1];
274:   else if (text) *text = 0;

276:   if (specific) *specific = PetscErrorBaseMessage;
277:   return(0);
278: }

280: #if defined(PETSC_CLANGUAGE_CXX)
281: /* C++ exceptions are formally not allowed to propagate through extern "C" code. In practice, far too much software
282:  * would be broken if implementations did not handle it it some common cases. However, keep in mind
283:  *
284:  *   Rule 62. Don't allow exceptions to propagate across module boundaries
285:  *
286:  * in "C++ Coding Standards" by Sutter and Alexandrescu. (This accounts for part of the ongoing C++ binary interface
287:  * instability.) Having PETSc raise errors as C++ exceptions was probably misguided and should eventually be removed.
288:  *
289:  * Here is the problem: You have a C++ function call a PETSc function, and you would like to maintain the error message
290:  * and stack information from the PETSc error. You could make everyone write exactly this code in their C++, but that
291:  * seems crazy to me.
292:  */
293: #include <sstream>
294: #include <stdexcept>
295: static void PetscCxxErrorThrow() {
296:   const char *str;
297:   if (eh && eh->ctx) {
298:     std::ostringstream *msg;
299:     msg = (std::ostringstream*) eh->ctx;
300:     str = msg->str().c_str();
301:   } else str = "Error detected in C PETSc";

303:   throw std::runtime_error(str);
304: }
305: #endif

307: /*@C
308:    PetscError - Routine that is called when an error has been detected,
309:    usually called through the macro SETERRQ(PETSC_COMM_SELF,).

311:    Not Collective

313:    Input Parameters:
314: +  comm - communicator over which error occurred.  ALL ranks of this communicator MUST call this routine
315: .  line - the line number of the error (indicated by __LINE__)
316: .  func - the function name in which the error was detected
317: .  file - the file in which the error was detected (indicated by __FILE__)
318: .  n - the generic error number
319: .  p - PETSC_ERROR_INITIAL indicates the error was initially detected, PETSC_ERROR_REPEAT indicates this is a traceback from a previously detected error
320: -  mess - formatted message string - aka printf

322:   Level: intermediate

324:    Notes:
325:    Most users need not directly use this routine and the error handlers, but
326:    can instead use the simplified interface SETERRQ, which has the calling
327:    sequence
328: $     SETERRQ(comm,n,mess)

330:    Fortran Note:
331:    This routine is used differently from Fortran
332: $    PetscError(MPI_Comm comm,PetscErrorCode n,PetscErrorType p,char *message)

334:    Experienced users can set the error handler with PetscPushErrorHandler().

336:    Developer Note: Since this is called after an error condition it should not be calling any error handlers (currently it ignores any error codes)
337:    BUT this routine does call regular PETSc functions that may call error handlers, this is problematic and could be fixed by never calling other PETSc routines
338:    but this annoying.

340:    Concepts: error^setting condition

342: .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2(), PetscErrorMessage()
343: @*/
344: PetscErrorCode PetscError(MPI_Comm comm,int line,const char *func,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,...)
345: {
346:   va_list        Argp;
347:   size_t         fullLength;
348:   char           buf[2048],*lbuf = 0;
349:   PetscBool      ismain;

353:   if (!func) func = "User provided function";
354:   if (!file) file = "User file";
355:   if (comm == MPI_COMM_NULL) comm = PETSC_COMM_SELF;

357:   /* Compose the message evaluating the print format */
358:   if (mess) {
359:     va_start(Argp,mess);
360:     PetscVSNPrintf(buf,2048,mess,&fullLength,Argp);
361:     va_end(Argp);
362:     lbuf = buf;
363:     if (p == PETSC_ERROR_INITIAL) PetscStrncpy(PetscErrorBaseMessage,lbuf,1023);
364:   }

366:   if (!eh) PetscTraceBackErrorHandler(comm,line,func,file,n,p,lbuf,0);
367:   else     (*eh->handler)(comm,line,func,file,n,p,lbuf,eh->ctx);

369:   /*
370:       If this is called from the main() routine we call MPI_Abort() instead of
371:     return to allow the parallel program to be properly shutdown.

373:     Since this is in the error handler we don't check the errors below. Of course,
374:     PetscStrncmp() does its own error checking which is problamatic
375:   */
376:   PetscStrncmp(func,"main",4,&ismain);
377:   if (ismain) MPI_Abort(PETSC_COMM_WORLD,(int)ierr);

379: #if defined(PETSC_CLANGUAGE_CXX)
380:   if (p == PETSC_ERROR_IN_CXX) {
381:     PetscCxxErrorThrow();
382:   }
383: #endif
384:   PetscFunctionReturn(ierr);
385: }

387: /* -------------------------------------------------------------------------*/

389: /*@C
390:     PetscIntView - Prints an array of integers; useful for debugging.

392:     Collective on PetscViewer

394:     Input Parameters:
395: +   N - number of integers in array
396: .   idx - array of integers
397: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

399:   Level: intermediate

401:     Developer Notes: idx cannot be const because may be passed to binary viewer where byte swapping is done

403: .seealso: PetscRealView()
404: @*/
405: PetscErrorCode  PetscIntView(PetscInt N,const PetscInt idx[],PetscViewer viewer)
406: {
408:   PetscInt       j,i,n = N/20,p = N % 20;
409:   PetscBool      iascii,isbinary;
410:   MPI_Comm       comm;

413:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
416:   PetscObjectGetComm((PetscObject)viewer,&comm);

418:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
419:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
420:   if (iascii) {
421:     PetscViewerASCIIPushSynchronized(viewer);
422:     for (i=0; i<n; i++) {
423:       PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*i);
424:       for (j=0; j<20; j++) {
425:         PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[i*20+j]);
426:       }
427:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
428:     }
429:     if (p) {
430:       PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*n);
431:       for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[20*n+i]);}
432:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
433:     }
434:     PetscViewerFlush(viewer);
435:     PetscViewerASCIIPopSynchronized(viewer);
436:   } else if (isbinary) {
437:     PetscMPIInt rank,size,*sizes,Ntotal,*displs,NN;
438:     PetscInt    *array;

440:     PetscMPIIntCast(N,&NN);
441:     MPI_Comm_rank(comm,&rank);
442:     MPI_Comm_size(comm,&size);

444:     if (size > 1) {
445:       if (rank) {
446:         MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
447:         MPI_Gatherv((void*)idx,NN,MPIU_INT,0,0,0,MPIU_INT,0,comm);
448:       } else {
449:         PetscMalloc1(size,&sizes);
450:         MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
451:         Ntotal    = sizes[0];
452:         PetscMalloc1(size,&displs);
453:         displs[0] = 0;
454:         for (i=1; i<size; i++) {
455:           Ntotal   += sizes[i];
456:           displs[i] =  displs[i-1] + sizes[i-1];
457:         }
458:         PetscMalloc1(Ntotal,&array);
459:         MPI_Gatherv((void*)idx,NN,MPIU_INT,array,sizes,displs,MPIU_INT,0,comm);
460:         PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_INT,PETSC_TRUE);
461:         PetscFree(sizes);
462:         PetscFree(displs);
463:         PetscFree(array);
464:       }
465:     } else {
466:       PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_INT,PETSC_FALSE);
467:     }
468:   } else {
469:     const char *tname;
470:     PetscObjectGetName((PetscObject)viewer,&tname);
471:     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
472:   }
473:   return(0);
474: }

476: /*@C
477:     PetscRealView - Prints an array of doubles; useful for debugging.

479:     Collective on PetscViewer

481:     Input Parameters:
482: +   N - number of PetscReal in array
483: .   idx - array of PetscReal
484: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

486:   Level: intermediate

488:     Developer Notes: idx cannot be const because may be passed to binary viewer where byte swapping is done

490: .seealso: PetscIntView()
491: @*/
492: PetscErrorCode  PetscRealView(PetscInt N,const PetscReal idx[],PetscViewer viewer)
493: {
495:   PetscInt       j,i,n = N/5,p = N % 5;
496:   PetscBool      iascii,isbinary;
497:   MPI_Comm       comm;

500:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
503:   PetscObjectGetComm((PetscObject)viewer,&comm);

505:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
506:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
507:   if (iascii) {
508:     PetscViewerASCIIPushSynchronized(viewer);
509:     for (i=0; i<n; i++) {
510:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",(int)5*i);
511:       for (j=0; j<5; j++) {
512:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*5+j]);
513:       }
514:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
515:     }
516:     if (p) {
517:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",(int)5*n);
518:       for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[5*n+i]);}
519:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
520:     }
521:     PetscViewerFlush(viewer);
522:     PetscViewerASCIIPopSynchronized(viewer);
523:   } else if (isbinary) {
524:     PetscMPIInt rank,size,*sizes,*displs, Ntotal,NN;
525:     PetscReal   *array;

527:     PetscMPIIntCast(N,&NN);
528:     MPI_Comm_rank(comm,&rank);
529:     MPI_Comm_size(comm,&size);

531:     if (size > 1) {
532:       if (rank) {
533:         MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
534:         MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,0,0,0,MPIU_REAL,0,comm);
535:       } else {
536:         PetscMalloc1(size,&sizes);
537:         MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
538:         Ntotal    = sizes[0];
539:         PetscMalloc1(size,&displs);
540:         displs[0] = 0;
541:         for (i=1; i<size; i++) {
542:           Ntotal   += sizes[i];
543:           displs[i] =  displs[i-1] + sizes[i-1];
544:         }
545:         PetscMalloc1(Ntotal,&array);
546:         MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,array,sizes,displs,MPIU_REAL,0,comm);
547:         PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_REAL,PETSC_TRUE);
548:         PetscFree(sizes);
549:         PetscFree(displs);
550:         PetscFree(array);
551:       }
552:     } else {
553:       PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_REAL,PETSC_FALSE);
554:     }
555:   } else {
556:     const char *tname;
557:     PetscObjectGetName((PetscObject)viewer,&tname);
558:     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
559:   }
560:   return(0);
561: }

563: /*@C
564:     PetscScalarView - Prints an array of scalars; useful for debugging.

566:     Collective on PetscViewer

568:     Input Parameters:
569: +   N - number of scalars in array
570: .   idx - array of scalars
571: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

573:   Level: intermediate

575:     Developer Notes: idx cannot be const because may be passed to binary viewer where byte swapping is done

577: .seealso: PetscIntView(), PetscRealView()
578: @*/
579: PetscErrorCode  PetscScalarView(PetscInt N,const PetscScalar idx[],PetscViewer viewer)
580: {
582:   PetscInt       j,i,n = N/3,p = N % 3;
583:   PetscBool      iascii,isbinary;
584:   MPI_Comm       comm;

587:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
590:   PetscObjectGetComm((PetscObject)viewer,&comm);

592:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
593:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
594:   if (iascii) {
595:     PetscViewerASCIIPushSynchronized(viewer);
596:     for (i=0; i<n; i++) {
597:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);
598:       for (j=0; j<3; j++) {
599: #if defined(PETSC_USE_COMPLEX)
600:         PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[i*3+j]),(double)PetscImaginaryPart(idx[i*3+j]));
601: #else
602:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*3+j]);
603: #endif
604:       }
605:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
606:     }
607:     if (p) {
608:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);
609:       for (i=0; i<p; i++) {
610: #if defined(PETSC_USE_COMPLEX)
611:         PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[n*3+i]),(double)PetscImaginaryPart(idx[n*3+i]));
612: #else
613:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[3*n+i]);
614: #endif
615:       }
616:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
617:     }
618:     PetscViewerFlush(viewer);
619:     PetscViewerASCIIPopSynchronized(viewer);
620:   } else if (isbinary) {
621:     PetscMPIInt size,rank,*sizes,Ntotal,*displs,NN;
622:     PetscScalar *array;

624:     PetscMPIIntCast(N,&NN);
625:     MPI_Comm_rank(comm,&rank);
626:     MPI_Comm_size(comm,&size);

628:     if (size > 1) {
629:       if (rank) {
630:         MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
631:         MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,0,0,0,MPIU_SCALAR,0,comm);
632:       } else {
633:         PetscMalloc1(size,&sizes);
634:         MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
635:         Ntotal    = sizes[0];
636:         PetscMalloc1(size,&displs);
637:         displs[0] = 0;
638:         for (i=1; i<size; i++) {
639:           Ntotal   += sizes[i];
640:           displs[i] =  displs[i-1] + sizes[i-1];
641:         }
642:         PetscMalloc1(Ntotal,&array);
643:         MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);
644:         PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR,PETSC_TRUE);
645:         PetscFree(sizes);
646:         PetscFree(displs);
647:         PetscFree(array);
648:       }
649:     } else {
650:       PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_SCALAR,PETSC_FALSE);
651:     }
652:   } else {
653:     const char *tname;
654:     PetscObjectGetName((PetscObject)viewer,&tname);
655:     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
656:   }
657:   return(0);
658: }