Actual source code: err.c

petsc-master 2019-09-17
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.


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

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

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

 83:    Not Collective

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

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

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

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

105:    Level: intermediate

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

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

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

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

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

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

136:    Not Collective

138:    Level: intermediate

140: .seealso: PetscPushErrorHandler()
141: @*/
142: PetscErrorCode  PetscPopErrorHandler(void)
143: {
144:   EH             tmp;

148:   if (!eh) return(0);
149:   tmp  = eh;
150:   eh   = eh->previous;
151:   PetscFree(tmp);
152:   return(0);
153: }

155: /*@C
156:   PetscReturnErrorHandler - Error handler that causes a return to the current
157:   level.

159:    Not Collective

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

170:    Level: developer

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

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

183:    Use PetscPushErrorHandler() to set the desired error handler.  The
184:    currently available PETSc error handlers include PetscTraceBackErrorHandler(),
185:    PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscAbortErrorHandler()

187: .seealso:  PetscPushErrorHandler(), PetscPopErrorHandler().
188:  @*/

190: PetscErrorCode  PetscReturnErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx)
191: {
193:   PetscFunctionReturn(n);
194: }

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

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

246:    Not Collective

248:    Input Parameter:
249: .   errnum - the error code

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

255:    Level: developer

257: .seealso:  PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscError(), SETERRQ(), CHKERRQ() 
258:           PetscAbortErrorHandler(), PetscTraceBackErrorHandler()
259:  @*/
260: PetscErrorCode  PetscErrorMessage(int errnum,const char *text[],char **specific)
261: {
263:   if (text && errnum > PETSC_ERR_MIN_VALUE && errnum < PETSC_ERR_MAX_VALUE) *text = PetscErrorStrings[errnum-PETSC_ERR_MIN_VALUE-1];
264:   else if (text) *text = 0;

266:   if (specific) *specific = PetscErrorBaseMessage;
267:   return(0);
268: }

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

293:   throw std::runtime_error(str);
294: }
295: #endif

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

301:    Not Collective

303:    Input Parameters:
304: +  comm - communicator over which error occurred.  ALL ranks of this communicator MUST call this routine
305: .  line - the line number of the error (indicated by __LINE__)
306: .  func - the function name in which the error was detected
307: .  file - the file in which the error was detected (indicated by __FILE__)
308: .  n - the generic error number
309: .  p - PETSC_ERROR_INITIAL indicates the error was initially detected, PETSC_ERROR_REPEAT indicates this is a traceback from a previously detected error
310: -  mess - formatted message string - aka printf

312:   Level: intermediate

314:    Notes:
315:    Most users need not directly use this routine and the error handlers, but
316:    can instead use the simplified interface SETERRQ, which has the calling
317:    sequence
318: $     SETERRQ(comm,n,mess)

320:    Fortran Note:
321:    This routine is used differently from Fortran
322: $    PetscError(MPI_Comm comm,PetscErrorCode n,PetscErrorType p,char *message)

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

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

330: .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2(), PetscErrorMessage()
331: @*/
332: PetscErrorCode PetscError(MPI_Comm comm,int line,const char *func,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,...)
333: {
334:   va_list        Argp;
335:   size_t         fullLength;
336:   char           buf[2048],*lbuf = 0;
337:   PetscBool      ismain;

341:   if (!func) func = "User provided function";
342:   if (!file) file = "User file";
343:   if (comm == MPI_COMM_NULL) comm = PETSC_COMM_SELF;

345:   /* Compose the message evaluating the print format */
346:   if (mess) {
347:     va_start(Argp,mess);
348:     PetscVSNPrintf(buf,2048,mess,&fullLength,Argp);
349:     va_end(Argp);
350:     lbuf = buf;
351:     if (p == PETSC_ERROR_INITIAL) PetscStrncpy(PetscErrorBaseMessage,lbuf,1023);
352:   }

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

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

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

367: #if defined(PETSC_CLANGUAGE_CXX)
368:   if (p == PETSC_ERROR_IN_CXX) {
369:     PetscCxxErrorThrow();
370:   }
371: #endif
372:   PetscFunctionReturn(ierr);
373: }

375: /* -------------------------------------------------------------------------*/

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

380:     Collective on PetscViewer

382:     Input Parameters:
383: +   N - number of integers in array
384: .   idx - array of integers
385: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

387:   Level: intermediate

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

392: .seealso: PetscRealView()
393: @*/
394: PetscErrorCode  PetscIntView(PetscInt N,const PetscInt idx[],PetscViewer viewer)
395: {
397:   PetscMPIInt         rank,size;
398:   PetscInt       j,i,n = N/20,p = N % 20;
399:   PetscBool      iascii,isbinary;
400:   MPI_Comm       comm;

403:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
406:   PetscObjectGetComm((PetscObject)viewer,&comm);
407:   MPI_Comm_size(comm,&size);
408:   MPI_Comm_rank(comm,&rank);

410:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
411:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
412:   if (iascii) {
413:     PetscViewerASCIIPushSynchronized(viewer);
414:     for (i=0; i<n; i++) {
415:       if (size > 1) {
416:         PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %D:", rank, 20*i);
417:       } else {
418:         PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*i);
419:       }
420:       for (j=0; j<20; j++) {
421:         PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[i*20+j]);
422:       }
423:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
424:     }
425:     if (p) {
426:       if (size > 1) {
427:         PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %D:",rank ,20*n);
428:       } else {
429:         PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*n);
430:       }
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 *sizes,Ntotal,*displs,NN;
438:     PetscInt    *array;

440:     PetscMPIIntCast(N,&NN);

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

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

477:     Collective on PetscViewer

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

484:   Level: intermediate

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

489: .seealso: PetscIntView()
490: @*/
491: PetscErrorCode  PetscRealView(PetscInt N,const PetscReal idx[],PetscViewer viewer)
492: {
494:   PetscMPIInt         rank,size;
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);
504:   MPI_Comm_size(comm,&size);
505:   MPI_Comm_rank(comm,&rank);

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

537:     PetscMPIIntCast(N,&NN);

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

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

574:     Collective on PetscViewer

576:     Input Parameters:
577: +   N - number of scalars in array
578: .   idx - array of scalars
579: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

581:   Level: intermediate

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

586: .seealso: PetscIntView(), PetscRealView()
587: @*/
588: PetscErrorCode  PetscScalarView(PetscInt N,const PetscScalar idx[],PetscViewer viewer)
589: {
591:   PetscMPIInt         rank,size;
592:   PetscInt       j,i,n = N/3,p = N % 3;
593:   PetscBool      iascii,isbinary;
594:   MPI_Comm       comm;

597:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
600:   PetscObjectGetComm((PetscObject)viewer,&comm);
601:   MPI_Comm_size(comm,&size);
602:   MPI_Comm_rank(comm,&rank);

604:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
605:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
606:   if (iascii) {
607:     PetscViewerASCIIPushSynchronized(viewer);
608:     for (i=0; i<n; i++) {
609:       if (size > 1) {
610:         PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2d:",rank ,3*i);
611:       } else {
612:         PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);
613:       }
614:       for (j=0; j<3; j++) {
615: #if defined(PETSC_USE_COMPLEX)
616:         PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[i*3+j]),(double)PetscImaginaryPart(idx[i*3+j]));
617: #else
618:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*3+j]);
619: #endif
620:       }
621:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
622:     }
623:     if (p) {
624:       if (size > 1) {
625:         PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2d:",rank ,3*n);
626:       } else {
627:         PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);
628:       }
629:       for (i=0; i<p; i++) {
630: #if defined(PETSC_USE_COMPLEX)
631:         PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[n*3+i]),(double)PetscImaginaryPart(idx[n*3+i]));
632: #else
633:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[3*n+i]);
634: #endif
635:       }
636:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
637:     }
638:     PetscViewerFlush(viewer);
639:     PetscViewerASCIIPopSynchronized(viewer);
640:   } else if (isbinary) {
641:     PetscMPIInt *sizes,Ntotal,*displs,NN;
642:     PetscScalar *array;

644:     PetscMPIIntCast(N,&NN);

646:     if (size > 1) {
647:       if (rank) {
648:         MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
649:         MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,0,0,0,MPIU_SCALAR,0,comm);
650:       } else {
651:         PetscMalloc1(size,&sizes);
652:         MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
653:         Ntotal    = sizes[0];
654:         PetscMalloc1(size,&displs);
655:         displs[0] = 0;
656:         for (i=1; i<size; i++) {
657:           Ntotal   += sizes[i];
658:           displs[i] =  displs[i-1] + sizes[i-1];
659:         }
660:         PetscMalloc1(Ntotal,&array);
661:         MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);
662:         PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR,PETSC_TRUE);
663:         PetscFree(sizes);
664:         PetscFree(displs);
665:         PetscFree(array);
666:       }
667:     } else {
668:       PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_SCALAR,PETSC_FALSE);
669:     }
670:   } else {
671:     const char *tname;
672:     PetscObjectGetName((PetscObject)viewer,&tname);
673:     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
674:   }
675:   return(0);
676: }