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];
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> - will contact machinename to open the Emacs client there
73: Level: developer
75: Notes:
76: You must put (server-start) in your .emacs file for the emacsclient software to work
78: Developer Note:
79: Since this is an error handler it cannot call CHKERRQ(); thus we just return if an error is detected.
82: .seealso: PetscError(), PetscPushErrorHandler(), PetscPopErrorHandler(), PetscAttachDebuggerErrorHandler(),
83: PetscAbortErrorHandler(), PetscMPIAbortErrorHandler(), PetscTraceBackErrorHandler(), PetscReturnErrorHandler()
84: @*/
85: PetscErrorCode PetscEmacsClientErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx)
86: {
88: char command[PETSC_MAX_PATH_LEN];
89: const char *pdir;
90: FILE *fp;
93: PetscGetPetscDir(&pdir);if (ierr) PetscFunctionReturn(ierr);
94: sprintf(command,"cd %s; emacsclient --no-wait +%d %s\n",pdir,line,file);
95: #if defined(PETSC_HAVE_POPEN)
96: PetscPOpen(MPI_COMM_WORLD,(char*)ctx,command,"r",&fp);if (ierr) PetscFunctionReturn(ierr);
97: PetscPClose(MPI_COMM_WORLD,fp);if (ierr) PetscFunctionReturn(ierr);
98: #else
99: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP_SYS,"Cannot run external programs on this machine");
100: #endif
101: PetscPopErrorHandler();if (ierr) PetscFunctionReturn(ierr); /* remove this handler from the stack of handlers */
102: if (!eh) {
103: PetscTraceBackErrorHandler(comm,line,fun,file,n,p,mess,NULL);if (ierr) PetscFunctionReturn(ierr);
104: } else {
105: (*eh->handler)(comm,line,fun,file,n,p,mess,eh->ctx);if (ierr) PetscFunctionReturn(ierr);
106: }
107: PetscFunctionReturn(ierr);
108: }
110: /*@C
111: PetscPushErrorHandler - Sets a routine to be called on detection of errors.
113: Not Collective
115: Input Parameters:
116: + handler - error handler routine
117: - ctx - optional handler context that contains information needed by the handler (for
118: example file pointers for error messages etc.)
120: Calling sequence of handler:
121: $ int handler(MPI_Comm comm,int line,char *func,char *file,PetscErrorCode n,int p,char *mess,void *ctx);
123: + comm - communicator over which error occured
124: . line - the line number of the error (indicated by __LINE__)
125: . file - the file in which the error was detected (indicated by __FILE__)
126: . n - the generic error number (see list defined in include/petscerror.h)
127: . p - PETSC_ERROR_INITIAL if error just detected, otherwise PETSC_ERROR_REPEAT
128: . mess - an error text string, usually just printed to the screen
129: - ctx - the error handler context
131: Options Database Keys:
132: + -on_error_attach_debugger <noxterm,gdb or dbx> - starts up the debugger if an error occurs
133: - -on_error_abort - aborts the program if an error occurs
135: Level: intermediate
137: Notes:
138: The currently available PETSc error handlers include PetscTraceBackErrorHandler(),
139: PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscMPIAbortErrorHandler(), PetscReturnErrorHandler().
141: Fortran Notes:
142: You can only push one error handler from Fortran before poping it.
144: .seealso: PetscPopErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), PetscTraceBackErrorHandler(), PetscPushSignalHandler()
146: @*/
147: PetscErrorCode PetscPushErrorHandler(PetscErrorCode (*handler)(MPI_Comm comm,int,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*),void *ctx)
148: {
149: EH neweh;
153: PetscNew(&neweh);
154: if (eh) neweh->previous = eh;
155: else neweh->previous = NULL;
156: neweh->handler = handler;
157: neweh->ctx = ctx;
158: eh = neweh;
159: return(0);
160: }
162: /*@
163: PetscPopErrorHandler - Removes the latest error handler that was
164: pushed with PetscPushErrorHandler().
166: Not Collective
168: Level: intermediate
170: .seealso: PetscPushErrorHandler()
171: @*/
172: PetscErrorCode PetscPopErrorHandler(void)
173: {
174: EH tmp;
178: if (!eh) return(0);
179: tmp = eh;
180: eh = eh->previous;
181: PetscFree(tmp);
182: return(0);
183: }
185: /*@C
186: PetscReturnErrorHandler - Error handler that causes a return without printing an error message.
188: Not Collective
190: Input Parameters:
191: + comm - communicator over which error occurred
192: . line - the line number of the error (indicated by __LINE__)
193: . file - the file in which the error was detected (indicated by __FILE__)
194: . mess - an error text string, usually just printed to the screen
195: . n - the generic error number
196: . p - specific error number
197: - ctx - error handler context
199: Level: developer
201: Notes:
202: Most users need not directly employ this routine and the other error
203: handlers, but can instead use the simplified interface SETERRQ, which has
204: the calling sequence
205: $ SETERRQ(comm,number,mess)
207: PetscIgnoreErrorHandler() does the same thing as this function, but is deprecated, you should use this function.
209: Use PetscPushErrorHandler() to set the desired error handler.
211: .seealso: PetscPushErrorHandler(), PetscPopErrorHandler(), PetscError(), PetscAbortErrorHandler(), PetscMPIAbortErrorHandler(), PetscTraceBackErrorHandler(),
212: PetscAttachDebuggerErrorHandler(), PetscEmacsClientErrorHandler()
213: @*/
214: PetscErrorCode PetscReturnErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx)
215: {
217: PetscFunctionReturn(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 Parameter:
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: const char *str;
316: if (eh && eh->ctx) {
317: std::ostringstream *msg;
318: msg = (std::ostringstream*) eh->ctx;
319: str = msg->str().c_str();
320: } else str = "Error detected in C PETSc";
322: throw std::runtime_error(str);
323: }
324: #endif
326: /*@C
327: PetscError - Routine that is called when an error has been detected, usually called through the macro SETERRQ(PETSC_COMM_SELF,).
329: Collective on comm
331: Input Parameters:
332: + comm - communicator over which error occurred. ALL ranks of this communicator MUST call this routine
333: . line - the line number of the error (indicated by __LINE__)
334: . func - the function name in which the error was detected
335: . file - the file in which the error was detected (indicated by __FILE__)
336: . n - the generic error number
337: . p - PETSC_ERROR_INITIAL indicates the error was initially detected, PETSC_ERROR_REPEAT indicates this is a traceback from a previously detected error
338: - mess - formatted message string - aka printf
340: Options Database:
341: + -error_output_stdout - output the error messages to stdout instead of the default stderr
342: - -error_output_none - do not output the error messages
344: Level: intermediate
346: Notes:
347: 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
348: 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,
349: KSPGetConvergedReason() that indicates if the solve was successful or not. The option -ksp_error_if_not_converged, for example, turns numerical failures into
350: hard errors managed via PetscError().
352: PETSc provides a rich supply of error handlers, see the list below, and users can also provide their own error handlers.
354: Most users need not directly use this routine and the error handlers, but
355: can instead use the simplified interface SETERRQ, which has the calling
356: sequence
357: $ SETERRQ(comm,n,mess)
359: Fortran Note:
360: This routine is used differently from Fortran
361: $ PetscError(MPI_Comm comm,PetscErrorCode n,PetscErrorType p,char *message)
363: Set the error handler with PetscPushErrorHandler().
365: Developer Note: Since this is called after an error condition it should not be calling any error handlers (currently it ignores any error codes)
366: 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
367: but this annoying.
369: .seealso: PetscErrorCode, PetscPushErrorHandler(), PetscPopErrorHandler(), PetscTraceBackErrorHandler(), PetscAbortErrorHandler(), PetscMPIAbortErrorHandler(),
370: PetscReturnErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscEmacsClientErrorHandler(),
371: SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2(), PetscErrorMessage(), PETSCABORT()
372: @*/
373: PetscErrorCode PetscError(MPI_Comm comm,int line,const char *func,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,...)
374: {
375: va_list Argp;
376: size_t fullLength;
377: char buf[2048],*lbuf = NULL;
378: 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);
400: /*
401: If this is called from the main() routine we call MPI_Abort() instead of
402: return to allow the parallel program to be properly shutdown.
404: Does not call PETSCABORT() since that would provide the wrong source file and line number information
405: */
406: PetscStrncmp(func,"main",4,&ismain);
407: if (ismain) {
408: PetscMPIInt errcode;
409: errcode = (PetscMPIInt)(0 + 0*line*1000 + ierr);
410: if (petscwaitonerrorflg) {PetscSleep(1000);}
411: MPI_Abort(MPI_COMM_WORLD,errcode);
412: }
414: #if defined(PETSC_CLANGUAGE_CXX)
415: if (p == PETSC_ERROR_IN_CXX) {
416: PetscCxxErrorThrow();
417: }
418: #endif
419: PetscFunctionReturn(ierr);
420: }
422: /* -------------------------------------------------------------------------*/
424: /*@C
425: PetscIntView - Prints an array of integers; useful for debugging.
427: Collective on PetscViewer
429: Input Parameters:
430: + N - number of integers in array
431: . idx - array of integers
432: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
434: Level: intermediate
436: Developer Notes:
437: idx cannot be const because may be passed to binary viewer where byte swapping is done
439: .seealso: PetscRealView()
440: @*/
441: PetscErrorCode PetscIntView(PetscInt N,const PetscInt idx[],PetscViewer viewer)
442: {
444: PetscMPIInt rank,size;
445: PetscInt j,i,n = N/20,p = N % 20;
446: PetscBool iascii,isbinary;
447: MPI_Comm comm;
450: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
453: PetscObjectGetComm((PetscObject)viewer,&comm);
454: MPI_Comm_size(comm,&size);
455: MPI_Comm_rank(comm,&rank);
457: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
458: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
459: if (iascii) {
460: PetscViewerASCIIPushSynchronized(viewer);
461: for (i=0; i<n; i++) {
462: if (size > 1) {
463: PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %D:", rank, 20*i);
464: } else {
465: PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*i);
466: }
467: for (j=0; j<20; j++) {
468: PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[i*20+j]);
469: }
470: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
471: }
472: if (p) {
473: if (size > 1) {
474: PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %D:",rank ,20*n);
475: } else {
476: PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*n);
477: }
478: for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[20*n+i]);}
479: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
480: }
481: PetscViewerFlush(viewer);
482: PetscViewerASCIIPopSynchronized(viewer);
483: } else if (isbinary) {
484: PetscMPIInt *sizes,Ntotal,*displs,NN;
485: PetscInt *array;
487: PetscMPIIntCast(N,&NN);
489: if (size > 1) {
490: if (rank) {
491: MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm);
492: MPI_Gatherv((void*)idx,NN,MPIU_INT,NULL,NULL,NULL,MPIU_INT,0,comm);
493: } else {
494: PetscMalloc1(size,&sizes);
495: MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
496: Ntotal = sizes[0];
497: PetscMalloc1(size,&displs);
498: displs[0] = 0;
499: for (i=1; i<size; i++) {
500: Ntotal += sizes[i];
501: displs[i] = displs[i-1] + sizes[i-1];
502: }
503: PetscMalloc1(Ntotal,&array);
504: MPI_Gatherv((void*)idx,NN,MPIU_INT,array,sizes,displs,MPIU_INT,0,comm);
505: PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_INT);
506: PetscFree(sizes);
507: PetscFree(displs);
508: PetscFree(array);
509: }
510: } else {
511: PetscViewerBinaryWrite(viewer,idx,N,PETSC_INT);
512: }
513: } else {
514: const char *tname;
515: PetscObjectGetName((PetscObject)viewer,&tname);
516: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
517: }
518: return(0);
519: }
521: /*@C
522: PetscRealView - Prints an array of doubles; useful for debugging.
524: Collective on PetscViewer
526: Input Parameters:
527: + N - number of PetscReal in array
528: . idx - array of PetscReal
529: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
531: Level: intermediate
533: Developer Notes:
534: idx cannot be const because may be passed to binary viewer where byte swapping is done
536: .seealso: PetscIntView()
537: @*/
538: PetscErrorCode PetscRealView(PetscInt N,const PetscReal idx[],PetscViewer viewer)
539: {
541: PetscMPIInt rank,size;
542: PetscInt j,i,n = N/5,p = N % 5;
543: PetscBool iascii,isbinary;
544: MPI_Comm comm;
547: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
550: PetscObjectGetComm((PetscObject)viewer,&comm);
551: MPI_Comm_size(comm,&size);
552: MPI_Comm_rank(comm,&rank);
554: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
555: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
556: if (iascii) {
557: PetscInt tab;
559: PetscViewerASCIIPushSynchronized(viewer);
560: PetscViewerASCIIGetTab(viewer, &tab);
561: for (i=0; i<n; i++) {
562: PetscViewerASCIISetTab(viewer, tab);
563: if (size > 1) {
564: PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2d:",rank ,(int)5*i);
565: } else {
566: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",(int)5*i);
567: }
568: PetscViewerASCIISetTab(viewer, 0);
569: for (j=0; j<5; j++) {
570: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*5+j]);
571: }
572: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
573: }
574: if (p) {
575: PetscViewerASCIISetTab(viewer, tab);
576: if (size > 1) {
577: PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2d:",rank ,(int)5*n);
578: } else {
579: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",(int)5*n);
580: }
581: PetscViewerASCIISetTab(viewer, 0);
582: for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[5*n+i]);}
583: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
584: }
585: PetscViewerFlush(viewer);
586: PetscViewerASCIISetTab(viewer, tab);
587: PetscViewerASCIIPopSynchronized(viewer);
588: } else if (isbinary) {
589: PetscMPIInt *sizes,*displs, Ntotal,NN;
590: PetscReal *array;
592: PetscMPIIntCast(N,&NN);
594: if (size > 1) {
595: if (rank) {
596: MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm);
597: MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,NULL,NULL,NULL,MPIU_REAL,0,comm);
598: } else {
599: PetscMalloc1(size,&sizes);
600: MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
601: Ntotal = sizes[0];
602: PetscMalloc1(size,&displs);
603: displs[0] = 0;
604: for (i=1; i<size; i++) {
605: Ntotal += sizes[i];
606: displs[i] = displs[i-1] + sizes[i-1];
607: }
608: PetscMalloc1(Ntotal,&array);
609: MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,array,sizes,displs,MPIU_REAL,0,comm);
610: PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_REAL);
611: PetscFree(sizes);
612: PetscFree(displs);
613: PetscFree(array);
614: }
615: } else {
616: PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_REAL);
617: }
618: } else {
619: const char *tname;
620: PetscObjectGetName((PetscObject)viewer,&tname);
621: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
622: }
623: return(0);
624: }
626: /*@C
627: PetscScalarView - Prints an array of scalars; useful for debugging.
629: Collective on PetscViewer
631: Input Parameters:
632: + N - number of scalars in array
633: . idx - array of scalars
634: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
636: Level: intermediate
638: Developer Notes:
639: idx cannot be const because may be passed to binary viewer where byte swapping is done
641: .seealso: PetscIntView(), PetscRealView()
642: @*/
643: PetscErrorCode PetscScalarView(PetscInt N,const PetscScalar idx[],PetscViewer viewer)
644: {
646: PetscMPIInt rank,size;
647: PetscInt j,i,n = N/3,p = N % 3;
648: PetscBool iascii,isbinary;
649: MPI_Comm comm;
652: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
655: PetscObjectGetComm((PetscObject)viewer,&comm);
656: MPI_Comm_size(comm,&size);
657: MPI_Comm_rank(comm,&rank);
659: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
660: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
661: if (iascii) {
662: PetscViewerASCIIPushSynchronized(viewer);
663: for (i=0; i<n; i++) {
664: if (size > 1) {
665: PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2d:",rank ,3*i);
666: } else {
667: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);
668: }
669: for (j=0; j<3; j++) {
670: #if defined(PETSC_USE_COMPLEX)
671: PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[i*3+j]),(double)PetscImaginaryPart(idx[i*3+j]));
672: #else
673: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*3+j]);
674: #endif
675: }
676: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
677: }
678: if (p) {
679: if (size > 1) {
680: PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2d:",rank ,3*n);
681: } else {
682: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);
683: }
684: for (i=0; i<p; i++) {
685: #if defined(PETSC_USE_COMPLEX)
686: PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[n*3+i]),(double)PetscImaginaryPart(idx[n*3+i]));
687: #else
688: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[3*n+i]);
689: #endif
690: }
691: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
692: }
693: PetscViewerFlush(viewer);
694: PetscViewerASCIIPopSynchronized(viewer);
695: } else if (isbinary) {
696: PetscMPIInt *sizes,Ntotal,*displs,NN;
697: PetscScalar *array;
699: PetscMPIIntCast(N,&NN);
701: if (size > 1) {
702: if (rank) {
703: MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm);
704: MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,NULL,NULL,NULL,MPIU_SCALAR,0,comm);
705: } else {
706: PetscMalloc1(size,&sizes);
707: MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
708: Ntotal = sizes[0];
709: PetscMalloc1(size,&displs);
710: displs[0] = 0;
711: for (i=1; i<size; i++) {
712: Ntotal += sizes[i];
713: displs[i] = displs[i-1] + sizes[i-1];
714: }
715: PetscMalloc1(Ntotal,&array);
716: MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);
717: PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR);
718: PetscFree(sizes);
719: PetscFree(displs);
720: PetscFree(array);
721: }
722: } else {
723: PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_SCALAR);
724: }
725: } else {
726: const char *tname;
727: PetscObjectGetName((PetscObject)viewer,&tname);
728: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
729: }
730: return(0);
731: }
733: #if defined(PETSC_HAVE_CUDA)
734: #include <petsccublas.h>
735: PETSC_EXTERN const char* PetscCUBLASGetErrorName(cublasStatus_t status)
736: {
737: switch(status) {
738: #if (CUDART_VERSION >= 8000) /* At least CUDA 8.0 of Sep. 2016 had these */
739: case CUBLAS_STATUS_SUCCESS: return "CUBLAS_STATUS_SUCCESS";
740: case CUBLAS_STATUS_NOT_INITIALIZED: return "CUBLAS_STATUS_NOT_INITIALIZED";
741: case CUBLAS_STATUS_ALLOC_FAILED: return "CUBLAS_STATUS_ALLOC_FAILED";
742: case CUBLAS_STATUS_INVALID_VALUE: return "CUBLAS_STATUS_INVALID_VALUE";
743: case CUBLAS_STATUS_ARCH_MISMATCH: return "CUBLAS_STATUS_ARCH_MISMATCH";
744: case CUBLAS_STATUS_MAPPING_ERROR: return "CUBLAS_STATUS_MAPPING_ERROR";
745: case CUBLAS_STATUS_EXECUTION_FAILED: return "CUBLAS_STATUS_EXECUTION_FAILED";
746: case CUBLAS_STATUS_INTERNAL_ERROR: return "CUBLAS_STATUS_INTERNAL_ERROR";
747: case CUBLAS_STATUS_NOT_SUPPORTED: return "CUBLAS_STATUS_NOT_SUPPORTED";
748: case CUBLAS_STATUS_LICENSE_ERROR: return "CUBLAS_STATUS_LICENSE_ERROR";
749: #endif
750: default: return "unknown error";
751: }
752: }
753: PETSC_EXTERN const char* PetscCUSolverGetErrorName(cusolverStatus_t status)
754: {
755: switch(status) {
756: #if (CUDART_VERSION >= 8000) /* At least CUDA 8.0 of Sep. 2016 had these */
757: case CUSOLVER_STATUS_SUCCESS: return "CUSOLVER_STATUS_SUCCESS";
758: case CUSOLVER_STATUS_NOT_INITIALIZED: return "CUSOLVER_STATUS_NOT_INITIALIZED";
759: case CUSOLVER_STATUS_INVALID_VALUE: return "CUSOLVER_STATUS_INVALID_VALUE";
760: case CUSOLVER_STATUS_ARCH_MISMATCH: return "CUSOLVER_STATUS_ARCH_MISMATCH";
761: case CUSOLVER_STATUS_INTERNAL_ERROR: return "CUSOLVER_STATUS_INTERNAL_ERROR";
762: #endif
763: default: return "unknown error";
764: }
765: }
766: #endif
768: #if defined(PETSC_HAVE_HIP)
769: #include <petschipblas.h>
770: PETSC_EXTERN const char* PetscHIPBLASGetErrorName(hipblasStatus_t status)
771: {
772: switch(status) {
773: case HIPBLAS_STATUS_SUCCESS: return "HIPBLAS_STATUS_SUCCESS";
774: case HIPBLAS_STATUS_NOT_INITIALIZED: return "HIPBLAS_STATUS_NOT_INITIALIZED";
775: case HIPBLAS_STATUS_ALLOC_FAILED: return "HIPBLAS_STATUS_ALLOC_FAILED";
776: case HIPBLAS_STATUS_INVALID_VALUE: return "HIPBLAS_STATUS_INVALID_VALUE";
777: case HIPBLAS_STATUS_ARCH_MISMATCH: return "HIPBLAS_STATUS_ARCH_MISMATCH";
778: case HIPBLAS_STATUS_MAPPING_ERROR: return "HIPBLAS_STATUS_MAPPING_ERROR";
779: case HIPBLAS_STATUS_EXECUTION_FAILED: return "HIPBLAS_STATUS_EXECUTION_FAILED";
780: case HIPBLAS_STATUS_INTERNAL_ERROR: return "HIPBLAS_STATUS_INTERNAL_ERROR";
781: case HIPBLAS_STATUS_NOT_SUPPORTED: return "HIPBLAS_STATUS_NOT_SUPPORTED";
782: default: return "unknown error";
783: }
784: }
785: #endif