Actual source code: err.c
petsc-3.15.0 2021-03-30
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 + line*1000 + ierr);
418: if (petscwaitonerrorflg) {PetscSleep(1000);}
419: MPI_Abort(comm,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: #endif
763: #if defined(PETSC_HAVE_HIP)
764: #include <petschipblas.h>
765: PETSC_EXTERN const char* PetscHIPBLASGetErrorName(hipblasStatus_t status)
766: {
767: switch(status) {
768: case HIPBLAS_STATUS_SUCCESS: return "HIPBLAS_STATUS_SUCCESS";
769: case HIPBLAS_STATUS_NOT_INITIALIZED: return "HIPBLAS_STATUS_NOT_INITIALIZED";
770: case HIPBLAS_STATUS_ALLOC_FAILED: return "HIPBLAS_STATUS_ALLOC_FAILED";
771: case HIPBLAS_STATUS_INVALID_VALUE: return "HIPBLAS_STATUS_INVALID_VALUE";
772: case HIPBLAS_STATUS_ARCH_MISMATCH: return "HIPBLAS_STATUS_ARCH_MISMATCH";
773: case HIPBLAS_STATUS_MAPPING_ERROR: return "HIPBLAS_STATUS_MAPPING_ERROR";
774: case HIPBLAS_STATUS_EXECUTION_FAILED: return "HIPBLAS_STATUS_EXECUTION_FAILED";
775: case HIPBLAS_STATUS_INTERNAL_ERROR: return "HIPBLAS_STATUS_INTERNAL_ERROR";
776: case HIPBLAS_STATUS_NOT_SUPPORTED: return "HIPBLAS_STATUS_NOT_SUPPORTED";
777: default: return "unknown error";
778: }
779: }
780: #endif