Actual source code: err.c

petsc-3.11.4 2019-09-28
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:
 49:    Since this is an error handler it cannot call CHKERRQ(); thus we just return if an error is detected.

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

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

 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);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:
114:     You can only push one error handler from Fortran before poping it.

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

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

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

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

138:    Not Collective

140:    Level: intermediate

142:    Concepts: error handler^setting

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

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

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

163:    Not Collective

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

174:    Level: developer

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

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

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

191:    Concepts: error handler

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

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

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

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

252:    Not Collective

254:    Input Parameter:
255: .   errnum - the error code

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

261:    Level: developer

263:    Concepts: error handler^messages

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

274:   if (specific) *specific = PetscErrorBaseMessage;
275:   return(0);
276: }

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

301:   throw std::runtime_error(str);
302: }
303: #endif

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

309:    Not Collective

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

320:   Level: intermediate

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

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

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

334:    Developer Note: Since this is called after an error condition it should not be calling any error handlers (currently it ignores any error codes)
335:    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
336:    but this annoying.

338:    Concepts: error^setting condition

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

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

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

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

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

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

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

385: /* -------------------------------------------------------------------------*/

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

390:     Collective on PetscViewer

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

397:   Level: intermediate

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

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

412:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
415:   PetscObjectGetComm((PetscObject)viewer,&comm);

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

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

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

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

478:     Collective on PetscViewer

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

485:   Level: intermediate

487:     Developer Notes:
488:     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:
576:     idx cannot be const because may be passed to binary viewer where byte swapping is done

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

588:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
591:   PetscObjectGetComm((PetscObject)viewer,&comm);

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

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

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