Actual source code: err.c

petsc-3.7.7 2017-09-25
Report Typos and Errors
  2: /*
  3:       Code that allows one to set the error handlers
  4: */
  5: #include <petsc/private/petscimpl.h>           /*I "petscsys.h" I*/
  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;

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

 23:    Not Collective

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

 35:    Options Database Key:
 36: .   -on_error_emacs <machinename>

 38:    Level: developer

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

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

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

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

 53:    Concepts: emacs^going to on error
 54:    Concepts: error handler^going to line in emacs

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

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

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

 90:    Not Collective

 92:    Input Parameters:
 93: +  handler - error handler routine
 94: -  ctx - optional handler context that contains information needed by the handler (for
 95:          example file pointers for error messages etc.)

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

100: +  comm - communicator over which error occured
101: .  line - the line number of the error (indicated by __LINE__)
102: .  func - the function where the error occured (indicated by __FUNCT__)
103: .  file - the file in which the error was detected (indicated by __FILE__)
104: .  n - the generic error number (see list defined in include/petscerror.h)
105: .  p - PETSC_ERROR_INITIAL if error just detected, otherwise PETSC_ERROR_REPEAT
106: .  mess - an error text string, usually just printed to the screen
107: -  ctx - the error handler context

109:    Options Database Keys:
110: +   -on_error_attach_debugger <noxterm,gdb or dbx>
111: -   -on_error_abort

113:    Level: intermediate

115:    Notes:
116:    The currently available PETSc error handlers include PetscTraceBackErrorHandler(),
117:    PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscMPIAbortErrorHandler(), PetscReturnErrorHandler().

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

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

123: @*/
124: PetscErrorCode  PetscPushErrorHandler(PetscErrorCode (*handler)(MPI_Comm comm,int,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*),void *ctx)
125: {
126:   EH             neweh;

130:   PetscNew(&neweh);
131:   if (eh) neweh->previous = eh;
132:   else    neweh->previous = 0;
133:   neweh->handler = handler;
134:   neweh->ctx     = ctx;
135:   eh             = neweh;
136:   return(0);
137: }

141: /*@
142:    PetscPopErrorHandler - Removes the latest error handler that was
143:    pushed with PetscPushErrorHandler().

145:    Not Collective

147:    Level: intermediate

149:    Concepts: error handler^setting

151: .seealso: PetscPushErrorHandler()
152: @*/
153: PetscErrorCode  PetscPopErrorHandler(void)
154: {
155:   EH             tmp;

159:   if (!eh) return(0);
160:   tmp  = eh;
161:   eh   = eh->previous;
162:   PetscFree(tmp);
163:   return(0);
164: }

168: /*@C
169:   PetscReturnErrorHandler - Error handler that causes a return to the current
170:   level.

172:    Not Collective

174:    Input Parameters:
175: +  comm - communicator over which error occurred
176: .  line - the line number of the error (indicated by __LINE__)
177: .  func - the function where error is detected (indicated by __FUNCT__)
178: .  file - the file in which the error was detected (indicated by __FILE__)
179: .  mess - an error text string, usually just printed to the screen
180: .  n - the generic error number
181: .  p - specific error number
182: -  ctx - error handler context

184:    Level: developer

186:    Notes:
187:    Most users need not directly employ this routine and the other error
188:    handlers, but can instead use the simplified interface SETERRQ, which has
189:    the calling sequence
190: $     SETERRQ(comm,number,mess)

192:    Notes for experienced users:
193:    This routine is good for catching errors such as zero pivots in preconditioners
194:    or breakdown of iterative methods. It is not appropriate for memory violations
195:    and similar errors.

197:    Use PetscPushErrorHandler() to set the desired error handler.  The
198:    currently available PETSc error handlers include PetscTraceBackErrorHandler(),
199:    PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscAbortErrorHandler()

201:    Concepts: error handler

203: .seealso:  PetscPushErrorHandler(), PetscPopErrorHandler().
204:  @*/

206: PetscErrorCode  PetscReturnErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx)
207: {
209:   PetscFunctionReturn(n);
210: }

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

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

267:    Not Collective

269:    Input Parameter:
270: .   errnum - the error code

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

276:    Level: developer

278:    Concepts: error handler^messages

280: .seealso:  PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscError(), SETERRQ(), CHKERRQ() 
281:           PetscAbortErrorHandler(), PetscTraceBackErrorHandler()
282:  @*/
283: PetscErrorCode  PetscErrorMessage(int errnum,const char *text[],char **specific)
284: {
286:   if (text && errnum > PETSC_ERR_MIN_VALUE && errnum < PETSC_ERR_MAX_VALUE) *text = PetscErrorStrings[errnum-PETSC_ERR_MIN_VALUE-1];
287:   else if (text) *text = 0;

289:   if (specific) *specific = PetscErrorBaseMessage;
290:   return(0);
291: }

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

316:   throw std::runtime_error(str);
317: }
318: #endif

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

326:    Not Collective

328:    Input Parameters:
329: +  comm - communicator over which error occurred.  ALL ranks of this communicator MUST call this routine
330: .  line - the line number of the error (indicated by __LINE__)
331: .  func - the function where the error occured (indicated by __FUNCT__)
332: .  file - the file in which the error was detected (indicated by __FILE__)
333: .  mess - an error text string, usually just printed to the screen
334: .  n - the generic error number
335: .  p - PETSC_ERROR_INITIAL indicates the error was initially detected, PETSC_ERROR_REPEAT indicates this is a traceback from a previously detected error
336: -  mess - formatted message string - aka printf

338:   Level: intermediate

340:    Notes:
341:    Most users need not directly use this routine and the error handlers, but
342:    can instead use the simplified interface SETERRQ, which has the calling
343:    sequence
344: $     SETERRQ(comm,n,mess)

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

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

352:    Concepts: error^setting condition

354: .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2(), PetscErrorMessage()
355: @*/
356: PetscErrorCode  PetscError(MPI_Comm comm,int line,const char *func,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,...)
357: {
358:   va_list        Argp;
359:   size_t         fullLength;
360:   char           buf[2048],*lbuf = 0;
361:   PetscBool      ismain,isunknown;

365:   if (!func) func = "User provided function";
366:   if (!file) file = "User file";
367:   if (comm == MPI_COMM_NULL) comm = PETSC_COMM_SELF;

369:   /* Compose the message evaluating the print format */
370:   if (mess) {
371:     va_start(Argp,mess);
372:     PetscVSNPrintf(buf,2048,mess,&fullLength,Argp);
373:     va_end(Argp);
374:     lbuf = buf;
375:     if (p == PETSC_ERROR_INITIAL) PetscStrncpy(PetscErrorBaseMessage,lbuf,1023);
376:   }

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

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

385:     Since this is in the error handler we don't check the errors below. Of course,
386:     PetscStrncmp() does its own error checking which is problamatic
387:   */
388:   PetscStrncmp(func,"main",4,&ismain);
389:   PetscStrncmp(func,"unknown",7,&isunknown);
390:   if (ismain || isunknown) MPI_Abort(PETSC_COMM_WORLD,(int)ierr);

392: #if defined(PETSC_CLANGUAGE_CXX)
393:   if (p == PETSC_ERROR_IN_CXX) {
394:     PetscCxxErrorThrow();
395:   }
396: #endif
397:   PetscFunctionReturn(ierr);
398: }

400: /* -------------------------------------------------------------------------*/

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

407:     Collective on PetscViewer

409:     Input Parameters:
410: +   N - number of integers in array
411: .   idx - array of integers
412: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

414:   Level: intermediate

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

418: .seealso: PetscRealView()
419: @*/
420: PetscErrorCode  PetscIntView(PetscInt N,const PetscInt idx[],PetscViewer viewer)
421: {
423:   PetscInt       j,i,n = N/20,p = N % 20;
424:   PetscBool      iascii,isbinary;
425:   MPI_Comm       comm;

428:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
431:   PetscObjectGetComm((PetscObject)viewer,&comm);

433:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
434:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
435:   if (iascii) {
436:     PetscViewerASCIIPushSynchronized(viewer);
437:     for (i=0; i<n; i++) {
438:       PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*i);
439:       for (j=0; j<20; j++) {
440:         PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[i*20+j]);
441:       }
442:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
443:     }
444:     if (p) {
445:       PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*n);
446:       for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[20*n+i]);}
447:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
448:     }
449:     PetscViewerFlush(viewer);
450:     PetscViewerASCIIPopSynchronized(viewer);
451:   } else if (isbinary) {
452:     PetscMPIInt rank,size,*sizes,Ntotal,*displs,NN;
453:     PetscInt    *array;

455:     PetscMPIIntCast(N,&NN);
456:     MPI_Comm_rank(comm,&rank);
457:     MPI_Comm_size(comm,&size);

459:     if (size > 1) {
460:       if (rank) {
461:         MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
462:         MPI_Gatherv((void*)idx,NN,MPIU_INT,0,0,0,MPIU_INT,0,comm);
463:       } else {
464:         PetscMalloc1(size,&sizes);
465:         MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
466:         Ntotal    = sizes[0];
467:         PetscMalloc1(size,&displs);
468:         displs[0] = 0;
469:         for (i=1; i<size; i++) {
470:           Ntotal   += sizes[i];
471:           displs[i] =  displs[i-1] + sizes[i-1];
472:         }
473:         PetscMalloc1(Ntotal,&array);
474:         MPI_Gatherv((void*)idx,NN,MPIU_INT,array,sizes,displs,MPIU_INT,0,comm);
475:         PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_INT,PETSC_TRUE);
476:         PetscFree(sizes);
477:         PetscFree(displs);
478:         PetscFree(array);
479:       }
480:     } else {
481:       PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_INT,PETSC_FALSE);
482:     }
483:   } else {
484:     const char *tname;
485:     PetscObjectGetName((PetscObject)viewer,&tname);
486:     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
487:   }
488:   return(0);
489: }

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

496:     Collective on PetscViewer

498:     Input Parameters:
499: +   N - number of PetscReal in array
500: .   idx - array of PetscReal
501: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

503:   Level: intermediate

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

507: .seealso: PetscIntView()
508: @*/
509: PetscErrorCode  PetscRealView(PetscInt N,const PetscReal idx[],PetscViewer viewer)
510: {
512:   PetscInt       j,i,n = N/5,p = N % 5;
513:   PetscBool      iascii,isbinary;
514:   MPI_Comm       comm;

517:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
520:   PetscObjectGetComm((PetscObject)viewer,&comm);

522:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
523:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
524:   if (iascii) {
525:     PetscViewerASCIIPushSynchronized(viewer);
526:     for (i=0; i<n; i++) {
527:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",(int)5*i);
528:       for (j=0; j<5; j++) {
529:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*5+j]);
530:       }
531:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
532:     }
533:     if (p) {
534:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",(int)5*n);
535:       for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[5*n+i]);}
536:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
537:     }
538:     PetscViewerFlush(viewer);
539:     PetscViewerASCIIPopSynchronized(viewer);
540:   } else if (isbinary) {
541:     PetscMPIInt rank,size,*sizes,*displs, Ntotal,NN;
542:     PetscReal   *array;

544:     PetscMPIIntCast(N,&NN);
545:     MPI_Comm_rank(comm,&rank);
546:     MPI_Comm_size(comm,&size);

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

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

585:     Collective on PetscViewer

587:     Input Parameters:
588: +   N - number of scalars in array
589: .   idx - array of scalars
590: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

592:   Level: intermediate

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

596: .seealso: PetscIntView(), PetscRealView()
597: @*/
598: PetscErrorCode  PetscScalarView(PetscInt N,const PetscScalar idx[],PetscViewer viewer)
599: {
601:   PetscInt       j,i,n = N/3,p = N % 3;
602:   PetscBool      iascii,isbinary;
603:   MPI_Comm       comm;

606:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
609:   PetscObjectGetComm((PetscObject)viewer,&comm);

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

643:     PetscMPIIntCast(N,&NN);
644:     MPI_Comm_rank(comm,&rank);
645:     MPI_Comm_size(comm,&size);

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