Actual source code: err.c
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[PETSC_MAX_PATH_LEN];
35: PetscStackView(stderr);if (ierr) return ierr;
36: *idx = 1;
37: for (i=2; i<n; i++) {
38: PetscFixFilename(PetscAbortSourceFiles[i],subpath);if (ierr) return ierr;
39: PetscStrendswith(filepath,subpath,&match);if (ierr) return ierr;
40: if (match) {*idx = i; break;}
41: }
42: return 0;
43: }
45: typedef struct _EH *EH;
46: struct _EH {
47: PetscErrorCode (*handler)(MPI_Comm,int,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*);
48: void *ctx;
49: EH previous;
50: };
52: static EH eh = NULL;
54: /*@C
55: PetscEmacsClientErrorHandler - Error handler that uses the emacsclient program to
56: load the file where the error occurred. Then calls the "previous" error handler.
58: Not Collective
60: Input Parameters:
61: + comm - communicator over which error occurred
62: . line - the line number of the error (indicated by __LINE__)
63: . file - the file in which the error was detected (indicated by __FILE__)
64: . mess - an error text string, usually just printed to the screen
65: . n - the generic error number
66: . p - specific error number
67: - ctx - error handler context
69: Options Database Key:
70: . -on_error_emacs <machinename> - will contact machinename to open the Emacs client there
72: Level: developer
74: Notes:
75: You must put (server-start) in your .emacs file for the emacsclient software to work
77: Developer Note:
78: Since this is an error handler it cannot call ; thus we just return if an error is detected.
80: .seealso: PetscError(), PetscPushErrorHandler(), PetscPopErrorHandler(), PetscAttachDebuggerErrorHandler(),
81: PetscAbortErrorHandler(), PetscMPIAbortErrorHandler(), PetscTraceBackErrorHandler(), PetscReturnErrorHandler()
82: @*/
83: PetscErrorCode PetscEmacsClientErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx)
84: {
86: char command[PETSC_MAX_PATH_LEN];
87: const char *pdir;
88: FILE *fp;
90: PetscGetPetscDir(&pdir);if (ierr) return ierr;
91: sprintf(command,"cd %s; emacsclient --no-wait +%d %s\n",pdir,line,file);
92: #if defined(PETSC_HAVE_POPEN)
93: PetscPOpen(MPI_COMM_WORLD,(char*)ctx,command,"r",&fp);if (ierr) return ierr;
94: PetscPClose(MPI_COMM_WORLD,fp);if (ierr) return ierr;
95: #else
96: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP_SYS,"Cannot run external programs on this machine");
97: #endif
98: PetscPopErrorHandler();if (ierr) return ierr; /* remove this handler from the stack of handlers */
99: if (!eh) {
100: PetscTraceBackErrorHandler(comm,line,fun,file,n,p,mess,NULL);if (ierr) return ierr;
101: } else {
102: (*eh->handler)(comm,line,fun,file,n,p,mess,eh->ctx);if (ierr) return ierr;
103: }
104: return ierr;
105: }
107: /*@C
108: PetscPushErrorHandler - Sets a routine to be called on detection of errors.
110: Not Collective
112: Input Parameters:
113: + handler - error handler routine
114: - ctx - optional handler context that contains information needed by the handler (for
115: example file pointers for error messages etc.)
117: Calling sequence of handler:
118: $ int handler(MPI_Comm comm,int line,char *func,char *file,PetscErrorCode n,int p,char *mess,void *ctx);
120: + comm - communicator over which error occurred
121: . line - the line number of the error (indicated by __LINE__)
122: . file - the file in which the error was detected (indicated by __FILE__)
123: . n - the generic error number (see list defined in include/petscerror.h)
124: . p - PETSC_ERROR_INITIAL if error just detected, otherwise PETSC_ERROR_REPEAT
125: . mess - an error text string, usually just printed to the screen
126: - ctx - the error handler context
128: Options Database Keys:
129: + -on_error_attach_debugger <noxterm,gdb or dbx> - starts up the debugger if an error occurs
130: - -on_error_abort - aborts the program if an error occurs
132: Level: intermediate
134: Notes:
135: The currently available PETSc error handlers include PetscTraceBackErrorHandler(),
136: PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscMPIAbortErrorHandler(), PetscReturnErrorHandler().
138: Fortran Notes:
139: You can only push one error handler from Fortran before poping it.
141: .seealso: PetscPopErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), PetscTraceBackErrorHandler(), PetscPushSignalHandler()
143: @*/
144: PetscErrorCode PetscPushErrorHandler(PetscErrorCode (*handler)(MPI_Comm comm,int,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*),void *ctx)
145: {
146: EH neweh;
148: PetscNew(&neweh);
149: if (eh) neweh->previous = eh;
150: else neweh->previous = NULL;
151: neweh->handler = handler;
152: neweh->ctx = ctx;
153: eh = neweh;
154: return 0;
155: }
157: /*@
158: PetscPopErrorHandler - Removes the latest error handler that was
159: pushed with PetscPushErrorHandler().
161: Not Collective
163: Level: intermediate
165: .seealso: PetscPushErrorHandler()
166: @*/
167: PetscErrorCode PetscPopErrorHandler(void)
168: {
169: EH tmp;
171: if (!eh) return 0;
172: tmp = eh;
173: eh = eh->previous;
174: PetscFree(tmp);
175: return 0;
176: }
178: /*@C
179: PetscReturnErrorHandler - Error handler that causes a return without printing an error message.
181: Not Collective
183: Input Parameters:
184: + comm - communicator over which error occurred
185: . line - the line number of the error (indicated by __LINE__)
186: . file - the file in which the error was detected (indicated by __FILE__)
187: . mess - an error text string, usually just printed to the screen
188: . n - the generic error number
189: . p - specific error number
190: - ctx - error handler context
192: Level: developer
194: Notes:
195: Most users need not directly employ this routine and the other error
196: handlers, but can instead use the simplified interface SETERRQ, which has
197: the calling sequence
198: $ SETERRQ(comm,number,mess)
200: PetscIgnoreErrorHandler() does the same thing as this function, but is deprecated, you should use this function.
202: Use PetscPushErrorHandler() to set the desired error handler.
204: .seealso: PetscPushErrorHandler(), PetscPopErrorHandler(), PetscError(), PetscAbortErrorHandler(), PetscMPIAbortErrorHandler(), PetscTraceBackErrorHandler(),
205: PetscAttachDebuggerErrorHandler(), PetscEmacsClientErrorHandler()
206: @*/
207: PetscErrorCode PetscReturnErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx)
208: {
209: return 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: https://petsc.org/release/faq/#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: https://petsc.org/release/faq/#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: https://petsc.org/release/faq/#valgrind",
242: "Unexpected data in file",
243: /*80 */ "Arguments must have same communicators",
244: /*81 */ "Zero pivot in Cholesky factorization: https://petsc.org/release/faq/#zeropivot",
245: " ",
246: " ",
247: "Overflow in integer operation: https://petsc.org/release/faq/#64-bit-indices",
248: /*85 */ "Null argument, when expecting valid pointer",
249: /*86 */ "Unknown type. Check for miss-spelling or missing package: https://petsc.org/release/install/install/#external-packages",
250: /*87 */ "MPI library at runtime is not compatible with MPI used at compile time",
251: /*88 */ "Error in system call",
252: /*89 */ "Object Type not set: https://petsc.org/release/faq/#object-type-not-set",
253: /*90 */ " ",
254: /* */ " ",
255: /*92 */ "See https://petsc.org/release/overview/linear_solve_table/ for possible LU and Cholesky solvers",
256: /*93 */ "You cannot overwrite this option since that will conflict with other previously set options",
257: /*94 */ "Example/application run with number of MPI ranks it does not support",
258: /*95 */ "Missing or incorrect user input ",
259: /*96 */ "GPU resources unavailable ",
260: /*97 */ "GPU error ",
261: /*98 */ "General MPI error "
262: };
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 Parameters:
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: .seealso: PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscError(), SETERRQ(), PetscCall()
279: PetscAbortErrorHandler(), PetscTraceBackErrorHandler()
280: @*/
281: PetscErrorCode PetscErrorMessage(int errnum,const char *text[],char **specific)
282: {
283: if (text && errnum > PETSC_ERR_MIN_VALUE && errnum < PETSC_ERR_MAX_VALUE) *text = PetscErrorStrings[errnum-PETSC_ERR_MIN_VALUE-1];
284: else if (text) *text = NULL;
286: if (specific) *specific = PetscErrorBaseMessage;
287: return 0;
288: }
290: #if defined(PETSC_CLANGUAGE_CXX)
291: /* C++ exceptions are formally not allowed to propagate through extern "C" code. In practice, far too much software
292: * would be broken if implementations did not handle it it some common cases. However, keep in mind
293: *
294: * Rule 62. Don't allow exceptions to propagate across module boundaries
295: *
296: * in "C++ Coding Standards" by Sutter and Alexandrescu. (This accounts for part of the ongoing C++ binary interface
297: * instability.) Having PETSc raise errors as C++ exceptions was probably misguided and should eventually be removed.
298: *
299: * Here is the problem: You have a C++ function call a PETSc function, and you would like to maintain the error message
300: * and stack information from the PETSc error. You could make everyone write exactly this code in their C++, but that
301: * seems crazy to me.
302: */
303: #include <sstream>
304: #include <stdexcept>
305: static void PetscCxxErrorThrow()
306: {
307: const char *str;
308: if (eh && eh->ctx) {
309: std::ostringstream *msg;
310: msg = (std::ostringstream*) eh->ctx;
311: str = msg->str().c_str();
312: } else str = "Error detected in C PETSc";
314: throw std::runtime_error(str);
315: }
316: #endif
318: /*@C
319: PetscError - Routine that is called when an error has been detected, usually called through the macro SETERRQ(PETSC_COMM_SELF,).
321: Collective on comm
323: Input Parameters:
324: + comm - communicator over which error occurred. ALL ranks of this communicator MUST call this routine
325: . line - the line number of the error (indicated by __LINE__)
326: . func - the function name in which the error was detected
327: . file - the file in which the error was detected (indicated by __FILE__)
328: . n - the generic error number
329: . p - PETSC_ERROR_INITIAL indicates the error was initially detected, PETSC_ERROR_REPEAT indicates this is a traceback from a previously detected error
330: - mess - formatted message string - aka printf
332: Options Database:
333: + -error_output_stdout - output the error messages to stdout instead of the default stderr
334: - -error_output_none - do not output the error messages
336: Level: intermediate
338: Notes:
339: 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
340: 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,
341: KSPGetConvergedReason() that indicates if the solve was successful or not. The option -ksp_error_if_not_converged, for example, turns numerical failures into
342: hard errors managed via PetscError().
344: PETSc provides a rich supply of error handlers, see the list below, and users can also provide their own error handlers.
346: Most users need not directly use this routine and the error handlers, but
347: can instead use the simplified interface SETERRQ, which has the calling
348: sequence
349: $ SETERRQ(comm,n,mess)
351: Fortran Note:
352: This routine is used differently from Fortran
353: $ PetscError(MPI_Comm comm,PetscErrorCode n,PetscErrorType p,char *message)
355: Set the error handler with PetscPushErrorHandler().
357: Developer Note: Since this is called after an error condition it should not be calling any error handlers (currently it ignores any error codes)
358: 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
359: but this annoying.
361: .seealso: PetscErrorCode, PetscPushErrorHandler(), PetscPopErrorHandler(), PetscTraceBackErrorHandler(), PetscAbortErrorHandler(), PetscMPIAbortErrorHandler(),
362: PetscReturnErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscEmacsClientErrorHandler(),
363: SETERRQ(), PetscCall(), CHKMEMQ, SETERRQ(), SETERRQ(), PetscErrorMessage(), PETSCABORT()
364: @*/
365: PetscErrorCode PetscError(MPI_Comm comm,int line,const char *func,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,...)
366: {
367: va_list Argp;
368: size_t fullLength;
369: char buf[2048],*lbuf = NULL;
370: PetscBool ismain;
373: if (!PetscErrorHandlingInitialized) return n;
374: if (!func) func = "User provided function";
375: if (!file) file = "User file";
376: if (comm == MPI_COMM_NULL) comm = PETSC_COMM_SELF;
378: /* Compose the message evaluating the print format */
379: if (mess) {
380: va_start(Argp,mess);
381: PetscVSNPrintf(buf,2048,mess,&fullLength,Argp);
382: va_end(Argp);
383: lbuf = buf;
384: if (p == PETSC_ERROR_INITIAL) PetscStrncpy(PetscErrorBaseMessage,lbuf,1023);
385: }
387: if (p == PETSC_ERROR_INITIAL && n != PETSC_ERR_MEMC) PetscMallocValidate(__LINE__,PETSC_FUNCTION_NAME,__FILE__);
389: if (!eh) PetscTraceBackErrorHandler(comm,line,func,file,n,p,lbuf,NULL);
390: else (*eh->handler)(comm,line,func,file,n,p,lbuf,eh->ctx);
391: PetscStackClearTop;
393: /*
394: If this is called from the main() routine we call MPI_Abort() instead of
395: return to allow the parallel program to be properly shutdown.
397: Does not call PETSCABORT() since that would provide the wrong source file and line number information
398: */
399: PetscStrncmp(func,"main",4,&ismain);
400: if (ismain) {
401: PetscMPIInt errcode;
402: errcode = (PetscMPIInt)(0 + 0*line*1000 + ierr);
403: if (petscwaitonerrorflg) { PetscSleep(1000); }
404: MPI_Abort(MPI_COMM_WORLD,errcode);
405: }
407: #if defined(PETSC_CLANGUAGE_CXX)
408: if (p == PETSC_ERROR_IN_CXX) {
409: PetscCxxErrorThrow();
410: }
411: #endif
412: return ierr;
413: }
415: /* -------------------------------------------------------------------------*/
417: /*@C
418: PetscIntView - Prints an array of integers; useful for debugging.
420: Collective on PetscViewer
422: Input Parameters:
423: + N - number of integers in array
424: . idx - array of integers
425: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
427: Level: intermediate
429: Developer Notes:
430: idx cannot be const because may be passed to binary viewer where byte swapping is done
432: .seealso: PetscRealView()
433: @*/
434: PetscErrorCode PetscIntView(PetscInt N,const PetscInt idx[],PetscViewer viewer)
435: {
436: PetscMPIInt rank,size;
437: PetscInt j,i,n = N/20,p = N % 20;
438: PetscBool iascii,isbinary;
439: MPI_Comm comm;
441: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
444: PetscObjectGetComm((PetscObject)viewer,&comm);
445: MPI_Comm_size(comm,&size);
446: MPI_Comm_rank(comm,&rank);
448: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
449: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
450: if (iascii) {
451: PetscViewerASCIIPushSynchronized(viewer);
452: for (i=0; i<n; i++) {
453: if (size > 1) {
454: PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %" PetscInt_FMT ":", rank, 20*i);
455: } else {
456: PetscViewerASCIISynchronizedPrintf(viewer,"%" PetscInt_FMT ":",20*i);
457: }
458: for (j=0; j<20; j++) {
459: PetscViewerASCIISynchronizedPrintf(viewer," %" PetscInt_FMT,idx[i*20+j]);
460: }
461: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
462: }
463: if (p) {
464: if (size > 1) {
465: PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %" PetscInt_FMT ":",rank ,20*n);
466: } else {
467: PetscViewerASCIISynchronizedPrintf(viewer,"%" PetscInt_FMT ":",20*n);
468: }
469: for (i=0; i<p; i++) PetscViewerASCIISynchronizedPrintf(viewer," %" PetscInt_FMT,idx[20*n+i]);
470: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
471: }
472: PetscViewerFlush(viewer);
473: PetscViewerASCIIPopSynchronized(viewer);
474: } else if (isbinary) {
475: PetscMPIInt *sizes,Ntotal,*displs,NN;
476: PetscInt *array;
478: PetscMPIIntCast(N,&NN);
480: if (size > 1) {
481: if (rank) {
482: MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm);
483: MPI_Gatherv((void*)idx,NN,MPIU_INT,NULL,NULL,NULL,MPIU_INT,0,comm);
484: } else {
485: PetscMalloc1(size,&sizes);
486: MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
487: Ntotal = sizes[0];
488: PetscMalloc1(size,&displs);
489: displs[0] = 0;
490: for (i=1; i<size; i++) {
491: Ntotal += sizes[i];
492: displs[i] = displs[i-1] + sizes[i-1];
493: }
494: PetscMalloc1(Ntotal,&array);
495: MPI_Gatherv((void*)idx,NN,MPIU_INT,array,sizes,displs,MPIU_INT,0,comm);
496: PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_INT);
497: PetscFree(sizes);
498: PetscFree(displs);
499: PetscFree(array);
500: }
501: } else {
502: PetscViewerBinaryWrite(viewer,idx,N,PETSC_INT);
503: }
504: } else {
505: const char *tname;
506: PetscObjectGetName((PetscObject)viewer,&tname);
507: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
508: }
509: return 0;
510: }
512: /*@C
513: PetscRealView - Prints an array of doubles; useful for debugging.
515: Collective on PetscViewer
517: Input Parameters:
518: + N - number of PetscReal in array
519: . idx - array of PetscReal
520: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
522: Level: intermediate
524: Developer Notes:
525: idx cannot be const because may be passed to binary viewer where byte swapping is done
527: .seealso: PetscIntView()
528: @*/
529: PetscErrorCode PetscRealView(PetscInt N,const PetscReal idx[],PetscViewer viewer)
530: {
531: PetscMPIInt rank,size;
532: PetscInt j,i,n = N/5,p = N % 5;
533: PetscBool iascii,isbinary;
534: MPI_Comm comm;
536: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
539: PetscObjectGetComm((PetscObject)viewer,&comm);
540: MPI_Comm_size(comm,&size);
541: MPI_Comm_rank(comm,&rank);
543: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
544: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
545: if (iascii) {
546: PetscInt tab;
548: PetscViewerASCIIPushSynchronized(viewer);
549: PetscViewerASCIIGetTab(viewer, &tab);
550: for (i=0; i<n; i++) {
551: PetscViewerASCIISetTab(viewer, tab);
552: if (size > 1) {
553: PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2" PetscInt_FMT ":",rank ,5*i);
554: } else {
555: PetscViewerASCIISynchronizedPrintf(viewer,"%2" PetscInt_FMT ":",5*i);
556: }
557: PetscViewerASCIISetTab(viewer, 0);
558: for (j=0; j<5; j++) {
559: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*5+j]);
560: }
561: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
562: }
563: if (p) {
564: PetscViewerASCIISetTab(viewer, tab);
565: if (size > 1) {
566: PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2" PetscInt_FMT ":",rank ,5*n);
567: } else {
568: PetscViewerASCIISynchronizedPrintf(viewer,"%2" PetscInt_FMT ":",5*n);
569: }
570: PetscViewerASCIISetTab(viewer, 0);
571: for (i=0; i<p; i++) PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[5*n+i]);
572: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
573: }
574: PetscViewerFlush(viewer);
575: PetscViewerASCIISetTab(viewer, tab);
576: PetscViewerASCIIPopSynchronized(viewer);
577: } else if (isbinary) {
578: PetscMPIInt *sizes,*displs, Ntotal,NN;
579: PetscReal *array;
581: PetscMPIIntCast(N,&NN);
583: if (size > 1) {
584: if (rank) {
585: MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm);
586: MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,NULL,NULL,NULL,MPIU_REAL,0,comm);
587: } else {
588: PetscMalloc1(size,&sizes);
589: MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
590: Ntotal = sizes[0];
591: PetscMalloc1(size,&displs);
592: displs[0] = 0;
593: for (i=1; i<size; i++) {
594: Ntotal += sizes[i];
595: displs[i] = displs[i-1] + sizes[i-1];
596: }
597: PetscMalloc1(Ntotal,&array);
598: MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,array,sizes,displs,MPIU_REAL,0,comm);
599: PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_REAL);
600: PetscFree(sizes);
601: PetscFree(displs);
602: PetscFree(array);
603: }
604: } else {
605: PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_REAL);
606: }
607: } else {
608: const char *tname;
609: PetscObjectGetName((PetscObject)viewer,&tname);
610: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
611: }
612: return 0;
613: }
615: /*@C
616: PetscScalarView - Prints an array of scalars; useful for debugging.
618: Collective on PetscViewer
620: Input Parameters:
621: + N - number of scalars in array
622: . idx - array of scalars
623: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
625: Level: intermediate
627: Developer Notes:
628: idx cannot be const because may be passed to binary viewer where byte swapping is done
630: .seealso: PetscIntView(), PetscRealView()
631: @*/
632: PetscErrorCode PetscScalarView(PetscInt N,const PetscScalar idx[],PetscViewer viewer)
633: {
634: PetscMPIInt rank,size;
635: PetscInt j,i,n = N/3,p = N % 3;
636: PetscBool iascii,isbinary;
637: MPI_Comm comm;
639: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
642: PetscObjectGetComm((PetscObject)viewer,&comm);
643: MPI_Comm_size(comm,&size);
644: MPI_Comm_rank(comm,&rank);
646: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
647: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
648: if (iascii) {
649: PetscViewerASCIIPushSynchronized(viewer);
650: for (i=0; i<n; i++) {
651: if (size > 1) {
652: PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2" PetscInt_FMT ":",rank ,3*i);
653: } else {
654: PetscViewerASCIISynchronizedPrintf(viewer,"%2" PetscInt_FMT ":",3*i);
655: }
656: for (j=0; j<3; j++) {
657: #if defined(PETSC_USE_COMPLEX)
658: PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[i*3+j]),(double)PetscImaginaryPart(idx[i*3+j]));
659: #else
660: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*3+j]);
661: #endif
662: }
663: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
664: }
665: if (p) {
666: if (size > 1) {
667: PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2" PetscInt_FMT ":",rank ,3*n);
668: } else {
669: PetscViewerASCIISynchronizedPrintf(viewer,"%2" PetscInt_FMT ":",3*n);
670: }
671: for (i=0; i<p; i++) {
672: #if defined(PETSC_USE_COMPLEX)
673: PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[n*3+i]),(double)PetscImaginaryPart(idx[n*3+i]));
674: #else
675: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[3*n+i]);
676: #endif
677: }
678: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
679: }
680: PetscViewerFlush(viewer);
681: PetscViewerASCIIPopSynchronized(viewer);
682: } else if (isbinary) {
683: PetscMPIInt *sizes,Ntotal,*displs,NN;
684: PetscScalar *array;
686: PetscMPIIntCast(N,&NN);
688: if (size > 1) {
689: if (rank) {
690: MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm);
691: MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,NULL,NULL,NULL,MPIU_SCALAR,0,comm);
692: } else {
693: PetscMalloc1(size,&sizes);
694: MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
695: Ntotal = sizes[0];
696: PetscMalloc1(size,&displs);
697: displs[0] = 0;
698: for (i=1; i<size; i++) {
699: Ntotal += sizes[i];
700: displs[i] = displs[i-1] + sizes[i-1];
701: }
702: PetscMalloc1(Ntotal,&array);
703: MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);
704: PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR);
705: PetscFree(sizes);
706: PetscFree(displs);
707: PetscFree(array);
708: }
709: } else {
710: PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_SCALAR);
711: }
712: } else {
713: const char *tname;
714: PetscObjectGetName((PetscObject)viewer,&tname);
715: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
716: }
717: return 0;
718: }
720: #if defined(PETSC_HAVE_CUDA)
721: #include <petscdevice.h>
722: PETSC_EXTERN const char* PetscCUBLASGetErrorName(cublasStatus_t status)
723: {
724: switch(status) {
725: #if (CUDART_VERSION >= 8000) /* At least CUDA 8.0 of Sep. 2016 had these */
726: case CUBLAS_STATUS_SUCCESS: return "CUBLAS_STATUS_SUCCESS";
727: case CUBLAS_STATUS_NOT_INITIALIZED: return "CUBLAS_STATUS_NOT_INITIALIZED";
728: case CUBLAS_STATUS_ALLOC_FAILED: return "CUBLAS_STATUS_ALLOC_FAILED";
729: case CUBLAS_STATUS_INVALID_VALUE: return "CUBLAS_STATUS_INVALID_VALUE";
730: case CUBLAS_STATUS_ARCH_MISMATCH: return "CUBLAS_STATUS_ARCH_MISMATCH";
731: case CUBLAS_STATUS_MAPPING_ERROR: return "CUBLAS_STATUS_MAPPING_ERROR";
732: case CUBLAS_STATUS_EXECUTION_FAILED: return "CUBLAS_STATUS_EXECUTION_FAILED";
733: case CUBLAS_STATUS_INTERNAL_ERROR: return "CUBLAS_STATUS_INTERNAL_ERROR";
734: case CUBLAS_STATUS_NOT_SUPPORTED: return "CUBLAS_STATUS_NOT_SUPPORTED";
735: case CUBLAS_STATUS_LICENSE_ERROR: return "CUBLAS_STATUS_LICENSE_ERROR";
736: #endif
737: default: return "unknown error";
738: }
739: }
740: PETSC_EXTERN const char* PetscCUSolverGetErrorName(cusolverStatus_t status)
741: {
742: switch(status) {
743: #if (CUDART_VERSION >= 8000) /* At least CUDA 8.0 of Sep. 2016 had these */
744: case CUSOLVER_STATUS_SUCCESS: return "CUSOLVER_STATUS_SUCCESS";
745: case CUSOLVER_STATUS_NOT_INITIALIZED: return "CUSOLVER_STATUS_NOT_INITIALIZED";
746: case CUSOLVER_STATUS_INVALID_VALUE: return "CUSOLVER_STATUS_INVALID_VALUE";
747: case CUSOLVER_STATUS_ARCH_MISMATCH: return "CUSOLVER_STATUS_ARCH_MISMATCH";
748: case CUSOLVER_STATUS_INTERNAL_ERROR: return "CUSOLVER_STATUS_INTERNAL_ERROR";
749: #if (CUDART_VERSION >= 9000) /* CUDA 9.0 had these defined on June 2021 */
750: case CUSOLVER_STATUS_ALLOC_FAILED: return "CUSOLVER_STATUS_ALLOC_FAILED";
751: case CUSOLVER_STATUS_MAPPING_ERROR: return "CUSOLVER_STATUS_MAPPING_ERROR";
752: case CUSOLVER_STATUS_EXECUTION_FAILED: return "CUSOLVER_STATUS_EXECUTION_FAILED";
753: case CUSOLVER_STATUS_MATRIX_TYPE_NOT_SUPPORTED: return "CUSOLVER_STATUS_MATRIX_TYPE_NOT_SUPPORTED";
754: case CUSOLVER_STATUS_NOT_SUPPORTED : return "CUSOLVER_STATUS_NOT_SUPPORTED ";
755: case CUSOLVER_STATUS_ZERO_PIVOT: return "CUSOLVER_STATUS_ZERO_PIVOT";
756: case CUSOLVER_STATUS_INVALID_LICENSE: return "CUSOLVER_STATUS_INVALID_LICENSE";
757: #endif
758: #endif
759: default: return "unknown error";
760: }
761: }
762: PETSC_EXTERN const char* PetscCUFFTGetErrorName(cufftResult result)
763: {
764: switch (result) {
765: case CUFFT_SUCCESS: return "CUFFT_SUCCESS";
766: case CUFFT_INVALID_PLAN: return "CUFFT_INVALID_PLAN";
767: case CUFFT_ALLOC_FAILED: return "CUFFT_ALLOC_FAILED";
768: case CUFFT_INVALID_TYPE: return "CUFFT_INVALID_TYPE";
769: case CUFFT_INVALID_VALUE: return "CUFFT_INVALID_VALUE";
770: case CUFFT_INTERNAL_ERROR: return "CUFFT_INTERNAL_ERROR";
771: case CUFFT_EXEC_FAILED: return "CUFFT_EXEC_FAILED";
772: case CUFFT_SETUP_FAILED: return "CUFFT_SETUP_FAILED";
773: case CUFFT_INVALID_SIZE: return "CUFFT_INVALID_SIZE";
774: case CUFFT_UNALIGNED_DATA: return "CUFFT_UNALIGNED_DATA";
775: case CUFFT_INCOMPLETE_PARAMETER_LIST: return "CUFFT_INCOMPLETE_PARAMETER_LIST";
776: case CUFFT_INVALID_DEVICE: return "CUFFT_INVALID_DEVICE";
777: case CUFFT_PARSE_ERROR: return "CUFFT_PARSE_ERROR";
778: case CUFFT_NO_WORKSPACE: return "CUFFT_NO_WORKSPACE";
779: case CUFFT_NOT_IMPLEMENTED: return "CUFFT_NOT_IMPLEMENTED";
780: case CUFFT_LICENSE_ERROR: return "CUFFT_LICENSE_ERROR";
781: case CUFFT_NOT_SUPPORTED: return "CUFFT_NOT_SUPPORTED";
782: default: return "unknown error";
783: }
784: }
785: #endif
787: #if defined(PETSC_HAVE_HIP)
788: #include <petscdevice.h>
789: PETSC_EXTERN const char* PetscHIPBLASGetErrorName(hipblasStatus_t status)
790: {
791: switch(status) {
792: case HIPBLAS_STATUS_SUCCESS: return "HIPBLAS_STATUS_SUCCESS";
793: case HIPBLAS_STATUS_NOT_INITIALIZED: return "HIPBLAS_STATUS_NOT_INITIALIZED";
794: case HIPBLAS_STATUS_ALLOC_FAILED: return "HIPBLAS_STATUS_ALLOC_FAILED";
795: case HIPBLAS_STATUS_INVALID_VALUE: return "HIPBLAS_STATUS_INVALID_VALUE";
796: case HIPBLAS_STATUS_ARCH_MISMATCH: return "HIPBLAS_STATUS_ARCH_MISMATCH";
797: case HIPBLAS_STATUS_MAPPING_ERROR: return "HIPBLAS_STATUS_MAPPING_ERROR";
798: case HIPBLAS_STATUS_EXECUTION_FAILED: return "HIPBLAS_STATUS_EXECUTION_FAILED";
799: case HIPBLAS_STATUS_INTERNAL_ERROR: return "HIPBLAS_STATUS_INTERNAL_ERROR";
800: case HIPBLAS_STATUS_NOT_SUPPORTED: return "HIPBLAS_STATUS_NOT_SUPPORTED";
801: default: return "unknown error";
802: }
803: }
804: #endif