Actual source code: err.c

petsc-main 2021-04-20
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: /* A table of Petsc source files containing calls to PETSCABORT. We assume this table will
  9:    stay stable for a while. When things changed, we just need to add new files to the table.
 10:  */
 11: static const char* PetscAbortSourceFiles[] = {
 12:   "Souce code of main",          /* 0 */
 13:   "Not Found",                  /* 1, not found in petsc, but may be in users' code if they called PETSCABORT. */
 14:   "sys/error/adebug.c",
 15:   "src/sys/error/errstop.c",
 16:   "sys/error/fp.c",
 17:   "sys/error/signal.c",           /* 5 */
 18:   "sys/ftn-custom/zutils.c",
 19:   "sys/logging/utils/stagelog.c",
 20:   "sys/mpiuni/mpitime.c",
 21:   "sys/objects/init.c",
 22:   "sys/objects/pinit.c",            /* 10 */
 23:   "vec/vec/interface/dlregisvec.c",
 24:   "vec/vec/utils/comb.c"
 25: };

 27: /* Find index of the soure file where a PETSCABORT was called. */
 28: PetscErrorCode PetscAbortFindSourceFile_Private(const char* filepath, PetscInt *idx)
 29: {
 30:   PetscErrorCode  ierr;
 31:   PetscInt        i,n = sizeof(PetscAbortSourceFiles)/sizeof(PetscAbortSourceFiles[0]);
 32:   PetscBool       match;
 33:   char            subpath[256];

 37:   *idx = 1;
 38:   for (i=2; i<n; i++) {
 39:     PetscFixFilename(PetscAbortSourceFiles[i],subpath);
 40:     PetscStrendswith(filepath,subpath,&match);
 41:     if (match) {*idx = i; break;}
 42:   }
 43:   return(0);
 44: }

 46: typedef struct _EH *EH;
 47: struct _EH {
 48:   PetscErrorCode (*handler)(MPI_Comm,int,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*);
 49:   void           *ctx;
 50:   EH             previous;
 51: };

 53: static EH eh = NULL;

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

 59:    Not Collective

 61:    Input Parameters:
 62: +  comm - communicator over which error occured
 63: .  line - the line number of the error (indicated by __LINE__)
 64: .  file - the file in which the error was detected (indicated by __FILE__)
 65: .  mess - an error text string, usually just printed to the screen
 66: .  n - the generic error number
 67: .  p - specific error number
 68: -  ctx - error handler context

 70:    Options Database Key:
 71: .   -on_error_emacs <machinename>

 73:    Level: developer

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

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

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

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


 90: .seealso: PetscError(), PetscPushErrorHandler(), PetscPopErrorHandler(), PetscAttachDebuggerErrorHandler(),
 91:           PetscAbortErrorHandler(), PetscMPIAbortErrorHandler(), PetscTraceBackErrorHandler(), PetscReturnErrorHandler()
 92:  @*/
 93: PetscErrorCode  PetscEmacsClientErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx)
 94: {
 96:   char           command[PETSC_MAX_PATH_LEN];
 97:   const char     *pdir;
 98:   FILE           *fp;

101:   PetscGetPetscDir(&pdir);if (ierr) PetscFunctionReturn(ierr);
102:   sprintf(command,"cd %s; emacsclient --no-wait +%d %s\n",pdir,line,file);
103: #if defined(PETSC_HAVE_POPEN)
104:   PetscPOpen(MPI_COMM_WORLD,(char*)ctx,command,"r",&fp);if (ierr) PetscFunctionReturn(ierr);
105:   PetscPClose(MPI_COMM_WORLD,fp);if (ierr) PetscFunctionReturn(ierr);
106: #else
107:   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP_SYS,"Cannot run external programs on this machine");
108: #endif
109:   PetscPopErrorHandler();if (ierr) PetscFunctionReturn(ierr); /* remove this handler from the stack of handlers */
110:   if (!eh) {
111:     PetscTraceBackErrorHandler(comm,line,fun,file,n,p,mess,NULL);if (ierr) PetscFunctionReturn(ierr);
112:   } else {
113:     (*eh->handler)(comm,line,fun,file,n,p,mess,eh->ctx);if (ierr) PetscFunctionReturn(ierr);
114:   }
115:   PetscFunctionReturn(ierr);
116: }

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

121:    Not Collective

123:    Input Parameters:
124: +  handler - error handler routine
125: -  ctx - optional handler context that contains information needed by the handler (for
126:          example file pointers for error messages etc.)

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

131: +  comm - communicator over which error occured
132: .  line - the line number of the error (indicated by __LINE__)
133: .  file - the file in which the error was detected (indicated by __FILE__)
134: .  n - the generic error number (see list defined in include/petscerror.h)
135: .  p - PETSC_ERROR_INITIAL if error just detected, otherwise PETSC_ERROR_REPEAT
136: .  mess - an error text string, usually just printed to the screen
137: -  ctx - the error handler context

139:    Options Database Keys:
140: +   -on_error_attach_debugger <noxterm,gdb or dbx>
141: -   -on_error_abort

143:    Level: intermediate

145:    Notes:
146:    The currently available PETSc error handlers include PetscTraceBackErrorHandler(),
147:    PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscMPIAbortErrorHandler(), PetscReturnErrorHandler().

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

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

154: @*/
155: PetscErrorCode  PetscPushErrorHandler(PetscErrorCode (*handler)(MPI_Comm comm,int,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*),void *ctx)
156: {
157:   EH             neweh;

161:   PetscNew(&neweh);
162:   if (eh) neweh->previous = eh;
163:   else    neweh->previous = NULL;
164:   neweh->handler = handler;
165:   neweh->ctx     = ctx;
166:   eh             = neweh;
167:   return(0);
168: }

170: /*@
171:    PetscPopErrorHandler - Removes the latest error handler that was
172:    pushed with PetscPushErrorHandler().

174:    Not Collective

176:    Level: intermediate

178: .seealso: PetscPushErrorHandler()
179: @*/
180: PetscErrorCode  PetscPopErrorHandler(void)
181: {
182:   EH             tmp;

186:   if (!eh) return(0);
187:   tmp  = eh;
188:   eh   = eh->previous;
189:   PetscFree(tmp);
190:   return(0);
191: }

193: /*@C
194:   PetscReturnErrorHandler - Error handler that causes a return without printing an error message.

196:    Not Collective

198:    Input Parameters:
199: +  comm - communicator over which error occurred
200: .  line - the line number of the error (indicated by __LINE__)
201: .  file - the file in which the error was detected (indicated by __FILE__)
202: .  mess - an error text string, usually just printed to the screen
203: .  n - the generic error number
204: .  p - specific error number
205: -  ctx - error handler context

207:    Level: developer

209:    Notes:
210:    Most users need not directly employ this routine and the other error
211:    handlers, but can instead use the simplified interface SETERRQ, which has
212:    the calling sequence
213: $     SETERRQ(comm,number,mess)

215:    PetscIgnoreErrorHandler() does the same thing as this function, but is deprecated, you should use this function.

217:    Use PetscPushErrorHandler() to set the desired error handler.

219: .seealso:  PetscPushErrorHandler(), PetscPopErrorHandler(), PetscError(), PetscAbortErrorHandler(), PetscMPIAbortErrorHandler(), PetscTraceBackErrorHandler(),
220:            PetscAttachDebuggerErrorHandler(), PetscEmacsClientErrorHandler()
221:  @*/
222: PetscErrorCode  PetscReturnErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx)
223: {
225:   PetscFunctionReturn(n);
226: }

228: static char PetscErrorBaseMessage[1024];
229: /*
230:        The numerical values for these are defined in include/petscerror.h; any changes
231:    there must also be made here
232: */
233: static const char *PetscErrorStrings[] = {
234:   /*55 */ "Out of memory",
235:           "No support for this operation for this object type",
236:           "No support for this operation on this system",
237:   /*58 */ "Operation done in wrong order",
238:   /*59 */ "Signal received",
239:   /*60 */ "Nonconforming object sizes",
240:           "Argument aliasing not permitted",
241:           "Invalid argument",
242:   /*63 */ "Argument out of range",
243:           "Corrupt argument: https://www.mcs.anl.gov/petsc/documentation/faq.html#valgrind",
244:           "Unable to open file",
245:           "Read from file failed",
246:           "Write to file failed",
247:           "Invalid pointer",
248:   /*69 */ "Arguments must have same type",
249:   /*70 */ "Attempt to use a pointer that does not point to a valid accessible location",
250:   /*71 */ "Zero pivot in LU factorization: https://www.mcs.anl.gov/petsc/documentation/faq.html#zeropivot",
251:   /*72 */ "Floating point exception",
252:   /*73 */ "Object is in wrong state",
253:           "Corrupted Petsc object",
254:           "Arguments are incompatible",
255:           "Error in external library",
256:   /*77 */ "Petsc has generated inconsistent data",
257:           "Memory corruption: https://www.mcs.anl.gov/petsc/documentation/installation.html#valgrind",
258:           "Unexpected data in file",
259:   /*80 */ "Arguments must have same communicators",
260:   /*81 */ "Zero pivot in Cholesky factorization: https://www.mcs.anl.gov/petsc/documentation/faq.html#zeropivot",
261:           "  ",
262:           "  ",
263:           "Overflow in integer operation: https://www.mcs.anl.gov/petsc/documentation/faq.html#64-bit-indices",
264:   /*85 */ "Null argument, when expecting valid pointer",
265:   /*86 */ "Unknown type. Check for miss-spelling or missing package: https://www.mcs.anl.gov/petsc/documentation/installation.html#external",
266:   /*87 */ "MPI library at runtime is not compatible with MPI used at compile time",
267:   /*88 */ "Error in system call",
268:   /*89 */ "Object Type not set: https://www.mcs.anl.gov/petsc/documentation/faq.html#objecttypenotset",
269:   /*90 */ "  ",
270:   /*   */ "  ",
271:   /*92 */ "See https://www.mcs.anl.gov/petsc/documentation/linearsolvertable.html for possible LU and Cholesky solvers",
272:   /*93 */ "You cannot overwrite this option since that will conflict with other previously set options",
273:   /*94 */ "Example/application run with number of MPI ranks it does not support",
274:   /*95 */ "Missing or incorrect user input ",
275:   /*96 */ "GPU resources unavailable ",
276:   /*97 */ "GPU error ",
277:   /*98 */ "General MPI error "
278: };

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

283:    Not Collective

285:    Input Parameter:
286: .   errnum - the error code

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

292:    Level: developer

294: .seealso:  PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscError(), SETERRQ(), CHKERRQ()
295:           PetscAbortErrorHandler(), PetscTraceBackErrorHandler()
296:  @*/
297: PetscErrorCode  PetscErrorMessage(int errnum,const char *text[],char **specific)
298: {
300:   if (text && errnum > PETSC_ERR_MIN_VALUE && errnum < PETSC_ERR_MAX_VALUE) *text = PetscErrorStrings[errnum-PETSC_ERR_MIN_VALUE-1];
301:   else if (text) *text = NULL;

303:   if (specific) *specific = PetscErrorBaseMessage;
304:   return(0);
305: }

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

330:   throw std::runtime_error(str);
331: }
332: #endif

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

337:   Collective on comm

339:    Input Parameters:
340: +  comm - communicator over which error occurred.  ALL ranks of this communicator MUST call this routine
341: .  line - the line number of the error (indicated by __LINE__)
342: .  func - the function name in which the error was detected
343: .  file - the file in which the error was detected (indicated by __FILE__)
344: .  n - the generic error number
345: .  p - PETSC_ERROR_INITIAL indicates the error was initially detected, PETSC_ERROR_REPEAT indicates this is a traceback from a previously detected error
346: -  mess - formatted message string - aka printf

348:   Options Database:
349: +  -error_output_stdout - output the error messages to stdout instead of the default stderr
350: -  -error_output_none - do not output the error messages

352:   Level: intermediate

354:    Notes:
355:    PETSc error handling is done with error return codes. A non-zero return indicates an error was detected. Errors are generally not something that the code
356:    can recover from. Note that numerical errors (potential divide by zero, for example) are not managed by the error return codes; they are managed via, for example,
357:    KSPGetConvergedReason() that indicates if the solve was successful or not. The option -ksp_error_if_not_converged, for example, turns numerical failures into
358:    hard errors managed via PetscError().

360:    PETSc provides a rich supply of error handlers, see the list below, and users can also provide their own error handlers.

362:    Most users need not directly use this routine and the error handlers, but
363:    can instead use the simplified interface SETERRQ, which has the calling
364:    sequence
365: $     SETERRQ(comm,n,mess)

367:    Fortran Note:
368:    This routine is used differently from Fortran
369: $    PetscError(MPI_Comm comm,PetscErrorCode n,PetscErrorType p,char *message)

371:    Set the error handler with PetscPushErrorHandler().

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

377: .seealso: PetscErrorCode, PetscPushErrorHandler(), PetscPopErrorHandler(), PetscTraceBackErrorHandler(),  PetscAbortErrorHandler(), PetscMPIAbortErrorHandler(),
378:           PetscReturnErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscEmacsClientErrorHandler(),
379:           SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2(), PetscErrorMessage(), PETSCABORT()
380: @*/
381: PetscErrorCode PetscError(MPI_Comm comm,int line,const char *func,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,...)
382: {
383:   va_list        Argp;
384:   size_t         fullLength;
385:   char           buf[2048],*lbuf = NULL;
386:   PetscBool      ismain;

390:   if (!func) func = "User provided function";
391:   if (!file) file = "User file";
392:   if (comm == MPI_COMM_NULL) comm = PETSC_COMM_SELF;

394:   /* Compose the message evaluating the print format */
395:   if (mess) {
396:     va_start(Argp,mess);
397:     PetscVSNPrintf(buf,2048,mess,&fullLength,Argp);
398:     va_end(Argp);
399:     lbuf = buf;
400:     if (p == PETSC_ERROR_INITIAL) PetscStrncpy(PetscErrorBaseMessage,lbuf,1023);
401:   }

403:   if (p == PETSC_ERROR_INITIAL && n != PETSC_ERR_MEMC) PetscMallocValidate(__LINE__,PETSC_FUNCTION_NAME,__FILE__);

405:   if (!eh) PetscTraceBackErrorHandler(comm,line,func,file,n,p,lbuf,NULL);
406:   else     (*eh->handler)(comm,line,func,file,n,p,lbuf,eh->ctx);

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

412:     Does not call PETSCABORT() since that would provide the wrong source file and line number information
413:   */
414:   PetscStrncmp(func,"main",4,&ismain);
415:   if (ismain) {
416:     PetscMPIInt errcode;
417:     errcode = (PetscMPIInt)(0 + 0*line*1000 + ierr);
418:     if (petscwaitonerrorflg) {PetscSleep(1000);}
419:     MPI_Abort(MPI_COMM_WORLD,errcode);
420:   }

422: #if defined(PETSC_CLANGUAGE_CXX)
423:   if (p == PETSC_ERROR_IN_CXX) {
424:     PetscCxxErrorThrow();
425:   }
426: #endif
427:   PetscFunctionReturn(ierr);
428: }

430: /* -------------------------------------------------------------------------*/

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

435:     Collective on PetscViewer

437:     Input Parameters:
438: +   N - number of integers in array
439: .   idx - array of integers
440: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

442:   Level: intermediate

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

447: .seealso: PetscRealView()
448: @*/
449: PetscErrorCode  PetscIntView(PetscInt N,const PetscInt idx[],PetscViewer viewer)
450: {
452:   PetscMPIInt    rank,size;
453:   PetscInt       j,i,n = N/20,p = N % 20;
454:   PetscBool      iascii,isbinary;
455:   MPI_Comm       comm;

458:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
461:   PetscObjectGetComm((PetscObject)viewer,&comm);
462:   MPI_Comm_size(comm,&size);
463:   MPI_Comm_rank(comm,&rank);

465:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
466:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
467:   if (iascii) {
468:     PetscViewerASCIIPushSynchronized(viewer);
469:     for (i=0; i<n; i++) {
470:       if (size > 1) {
471:         PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %D:", rank, 20*i);
472:       } else {
473:         PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*i);
474:       }
475:       for (j=0; j<20; j++) {
476:         PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[i*20+j]);
477:       }
478:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
479:     }
480:     if (p) {
481:       if (size > 1) {
482:         PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %D:",rank ,20*n);
483:       } else {
484:         PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*n);
485:       }
486:       for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[20*n+i]);}
487:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
488:     }
489:     PetscViewerFlush(viewer);
490:     PetscViewerASCIIPopSynchronized(viewer);
491:   } else if (isbinary) {
492:     PetscMPIInt *sizes,Ntotal,*displs,NN;
493:     PetscInt    *array;

495:     PetscMPIIntCast(N,&NN);

497:     if (size > 1) {
498:       if (rank) {
499:         MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm);
500:         MPI_Gatherv((void*)idx,NN,MPIU_INT,NULL,NULL,NULL,MPIU_INT,0,comm);
501:       } else {
502:         PetscMalloc1(size,&sizes);
503:         MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
504:         Ntotal    = sizes[0];
505:         PetscMalloc1(size,&displs);
506:         displs[0] = 0;
507:         for (i=1; i<size; i++) {
508:           Ntotal   += sizes[i];
509:           displs[i] =  displs[i-1] + sizes[i-1];
510:         }
511:         PetscMalloc1(Ntotal,&array);
512:         MPI_Gatherv((void*)idx,NN,MPIU_INT,array,sizes,displs,MPIU_INT,0,comm);
513:         PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_INT);
514:         PetscFree(sizes);
515:         PetscFree(displs);
516:         PetscFree(array);
517:       }
518:     } else {
519:       PetscViewerBinaryWrite(viewer,idx,N,PETSC_INT);
520:     }
521:   } else {
522:     const char *tname;
523:     PetscObjectGetName((PetscObject)viewer,&tname);
524:     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
525:   }
526:   return(0);
527: }

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

532:     Collective on PetscViewer

534:     Input Parameters:
535: +   N - number of PetscReal in array
536: .   idx - array of PetscReal
537: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

539:   Level: intermediate

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

544: .seealso: PetscIntView()
545: @*/
546: PetscErrorCode  PetscRealView(PetscInt N,const PetscReal idx[],PetscViewer viewer)
547: {
549:   PetscMPIInt    rank,size;
550:   PetscInt       j,i,n = N/5,p = N % 5;
551:   PetscBool      iascii,isbinary;
552:   MPI_Comm       comm;

555:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
558:   PetscObjectGetComm((PetscObject)viewer,&comm);
559:   MPI_Comm_size(comm,&size);
560:   MPI_Comm_rank(comm,&rank);

562:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
563:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
564:   if (iascii) {
565:     PetscInt tab;

567:     PetscViewerASCIIPushSynchronized(viewer);
568:     PetscViewerASCIIGetTab(viewer, &tab);
569:     for (i=0; i<n; i++) {
570:       PetscViewerASCIISetTab(viewer, tab);
571:       if (size > 1) {
572:         PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2d:",rank ,(int)5*i);
573:       } else {
574:         PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",(int)5*i);
575:       }
576:       PetscViewerASCIISetTab(viewer, 0);
577:       for (j=0; j<5; j++) {
578:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*5+j]);
579:       }
580:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
581:     }
582:     if (p) {
583:       PetscViewerASCIISetTab(viewer, tab);
584:       if (size > 1) {
585:         PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2d:",rank ,(int)5*n);
586:       } else {
587:         PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",(int)5*n);
588:       }
589:       PetscViewerASCIISetTab(viewer, 0);
590:       for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[5*n+i]);}
591:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
592:     }
593:     PetscViewerFlush(viewer);
594:     PetscViewerASCIISetTab(viewer, tab);
595:     PetscViewerASCIIPopSynchronized(viewer);
596:   } else if (isbinary) {
597:     PetscMPIInt *sizes,*displs, Ntotal,NN;
598:     PetscReal   *array;

600:     PetscMPIIntCast(N,&NN);

602:     if (size > 1) {
603:       if (rank) {
604:         MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm);
605:         MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,NULL,NULL,NULL,MPIU_REAL,0,comm);
606:       } else {
607:         PetscMalloc1(size,&sizes);
608:         MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
609:         Ntotal    = sizes[0];
610:         PetscMalloc1(size,&displs);
611:         displs[0] = 0;
612:         for (i=1; i<size; i++) {
613:           Ntotal   += sizes[i];
614:           displs[i] =  displs[i-1] + sizes[i-1];
615:         }
616:         PetscMalloc1(Ntotal,&array);
617:         MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,array,sizes,displs,MPIU_REAL,0,comm);
618:         PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_REAL);
619:         PetscFree(sizes);
620:         PetscFree(displs);
621:         PetscFree(array);
622:       }
623:     } else {
624:       PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_REAL);
625:     }
626:   } else {
627:     const char *tname;
628:     PetscObjectGetName((PetscObject)viewer,&tname);
629:     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
630:   }
631:   return(0);
632: }

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

637:     Collective on PetscViewer

639:     Input Parameters:
640: +   N - number of scalars in array
641: .   idx - array of scalars
642: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

644:   Level: intermediate

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

649: .seealso: PetscIntView(), PetscRealView()
650: @*/
651: PetscErrorCode  PetscScalarView(PetscInt N,const PetscScalar idx[],PetscViewer viewer)
652: {
654:   PetscMPIInt    rank,size;
655:   PetscInt       j,i,n = N/3,p = N % 3;
656:   PetscBool      iascii,isbinary;
657:   MPI_Comm       comm;

660:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
663:   PetscObjectGetComm((PetscObject)viewer,&comm);
664:   MPI_Comm_size(comm,&size);
665:   MPI_Comm_rank(comm,&rank);

667:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
668:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
669:   if (iascii) {
670:     PetscViewerASCIIPushSynchronized(viewer);
671:     for (i=0; i<n; i++) {
672:       if (size > 1) {
673:         PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2d:",rank ,3*i);
674:       } else {
675:         PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);
676:       }
677:       for (j=0; j<3; j++) {
678: #if defined(PETSC_USE_COMPLEX)
679:         PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[i*3+j]),(double)PetscImaginaryPart(idx[i*3+j]));
680: #else
681:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*3+j]);
682: #endif
683:       }
684:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
685:     }
686:     if (p) {
687:       if (size > 1) {
688:         PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2d:",rank ,3*n);
689:       } else {
690:         PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);
691:       }
692:       for (i=0; i<p; i++) {
693: #if defined(PETSC_USE_COMPLEX)
694:         PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[n*3+i]),(double)PetscImaginaryPart(idx[n*3+i]));
695: #else
696:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[3*n+i]);
697: #endif
698:       }
699:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
700:     }
701:     PetscViewerFlush(viewer);
702:     PetscViewerASCIIPopSynchronized(viewer);
703:   } else if (isbinary) {
704:     PetscMPIInt *sizes,Ntotal,*displs,NN;
705:     PetscScalar *array;

707:     PetscMPIIntCast(N,&NN);

709:     if (size > 1) {
710:       if (rank) {
711:         MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm);
712:         MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,NULL,NULL,NULL,MPIU_SCALAR,0,comm);
713:       } else {
714:         PetscMalloc1(size,&sizes);
715:         MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
716:         Ntotal    = sizes[0];
717:         PetscMalloc1(size,&displs);
718:         displs[0] = 0;
719:         for (i=1; i<size; i++) {
720:           Ntotal   += sizes[i];
721:           displs[i] =  displs[i-1] + sizes[i-1];
722:         }
723:         PetscMalloc1(Ntotal,&array);
724:         MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);
725:         PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR);
726:         PetscFree(sizes);
727:         PetscFree(displs);
728:         PetscFree(array);
729:       }
730:     } else {
731:       PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_SCALAR);
732:     }
733:   } else {
734:     const char *tname;
735:     PetscObjectGetName((PetscObject)viewer,&tname);
736:     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
737:   }
738:   return(0);
739: }

741: #if defined(PETSC_HAVE_CUDA)
742: #include <petsccublas.h>
743: PETSC_EXTERN const char* PetscCUBLASGetErrorName(cublasStatus_t status)
744: {
745:   switch(status) {
746: #if (CUDART_VERSION >= 8000) /* At least CUDA 8.0 of Sep. 2016 had these */
747:     case CUBLAS_STATUS_SUCCESS:          return "CUBLAS_STATUS_SUCCESS";
748:     case CUBLAS_STATUS_NOT_INITIALIZED:  return "CUBLAS_STATUS_NOT_INITIALIZED";
749:     case CUBLAS_STATUS_ALLOC_FAILED:     return "CUBLAS_STATUS_ALLOC_FAILED";
750:     case CUBLAS_STATUS_INVALID_VALUE:    return "CUBLAS_STATUS_INVALID_VALUE";
751:     case CUBLAS_STATUS_ARCH_MISMATCH:    return "CUBLAS_STATUS_ARCH_MISMATCH";
752:     case CUBLAS_STATUS_MAPPING_ERROR:    return "CUBLAS_STATUS_MAPPING_ERROR";
753:     case CUBLAS_STATUS_EXECUTION_FAILED: return "CUBLAS_STATUS_EXECUTION_FAILED";
754:     case CUBLAS_STATUS_INTERNAL_ERROR:   return "CUBLAS_STATUS_INTERNAL_ERROR";
755:     case CUBLAS_STATUS_NOT_SUPPORTED:    return "CUBLAS_STATUS_NOT_SUPPORTED";
756:     case CUBLAS_STATUS_LICENSE_ERROR:    return "CUBLAS_STATUS_LICENSE_ERROR";
757: #endif
758:     default:                             return "unknown error";
759:   }
760: }
761: PETSC_EXTERN const char* PetscCUSolverGetErrorName(cusolverStatus_t status)
762: {
763:   switch(status) {
764: #if (CUDART_VERSION >= 8000) /* At least CUDA 8.0 of Sep. 2016 had these */
765:     case CUSOLVER_STATUS_SUCCESS:          return "CUSOLVER_STATUS_SUCCESS";
766:     case CUSOLVER_STATUS_NOT_INITIALIZED:  return "CUSOLVER_STATUS_NOT_INITIALIZED";
767:     case CUSOLVER_STATUS_INVALID_VALUE:    return "CUSOLVER_STATUS_INVALID_VALUE";
768:     case CUSOLVER_STATUS_ARCH_MISMATCH:    return "CUSOLVER_STATUS_ARCH_MISMATCH";
769:     case CUSOLVER_STATUS_INTERNAL_ERROR:   return "CUSOLVER_STATUS_INTERNAL_ERROR";
770: #endif
771:     default:                             return "unknown error";
772:   }
773: }
774: #endif

776: #if defined(PETSC_HAVE_HIP)
777: #include <petschipblas.h>
778: PETSC_EXTERN const char* PetscHIPBLASGetErrorName(hipblasStatus_t status)
779: {
780:   switch(status) {
781:     case HIPBLAS_STATUS_SUCCESS:          return "HIPBLAS_STATUS_SUCCESS";
782:     case HIPBLAS_STATUS_NOT_INITIALIZED:  return "HIPBLAS_STATUS_NOT_INITIALIZED";
783:     case HIPBLAS_STATUS_ALLOC_FAILED:     return "HIPBLAS_STATUS_ALLOC_FAILED";
784:     case HIPBLAS_STATUS_INVALID_VALUE:    return "HIPBLAS_STATUS_INVALID_VALUE";
785:     case HIPBLAS_STATUS_ARCH_MISMATCH:    return "HIPBLAS_STATUS_ARCH_MISMATCH";
786:     case HIPBLAS_STATUS_MAPPING_ERROR:    return "HIPBLAS_STATUS_MAPPING_ERROR";
787:     case HIPBLAS_STATUS_EXECUTION_FAILED: return "HIPBLAS_STATUS_EXECUTION_FAILED";
788:     case HIPBLAS_STATUS_INTERNAL_ERROR:   return "HIPBLAS_STATUS_INTERNAL_ERROR";
789:     case HIPBLAS_STATUS_NOT_SUPPORTED:    return "HIPBLAS_STATUS_NOT_SUPPORTED";
790:     default:                              return "unknown error";
791:   }
792: }
793: #endif