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