1
2 /*
3 Code that allows one to set the error handlers
4 */
5 #include <petsc/private/petscimpl.h> /*I "petscsys.h" I*/
6 #include <petscviewer.h>
7
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 };
26
27 /* Find index of the soure file where a PETSCABORT was called. */
PetscAbortFindSourceFile_Private(const char * filepath,PetscInt * idx)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];
34
35 PetscFunctionBegin;
36 PetscValidIntPointer(idx,2);
37 *idx = 1;
38 for (i=2; i<n; i++) {
39 ierr = PetscFixFilename(PetscAbortSourceFiles[i],subpath);CHKERRQ(ierr);
40 ierr = PetscStrendswith(filepath,subpath,&match);CHKERRQ(ierr);
41 if (match) {*idx = i; break;}
42 }
43 PetscFunctionReturn(0);
44 }
45
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 };
52
53 static EH eh = NULL;
54
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.
58
59 Not Collective
60
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
69
70 Options Database Key:
71 . -on_error_emacs <machinename>
72
73 Level: developer
74
75 Notes:
76 You must put (server-start) in your .emacs file for the emacsclient software to work
77
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)
82
83 Notes for experienced users:
84 Use PetscPushErrorHandler() to set the desired error handler.
85
86 Developer Note:
87 Since this is an error handler it cannot call CHKERRQ(); thus we just return if an error is detected.
88
89
90 .seealso: PetscError(), PetscPushErrorHandler(), PetscPopErrorHandler(), PetscAttachDebuggerErrorHandler(),
91 PetscAbortErrorHandler(), PetscMPIAbortErrorHandler(), PetscTraceBackErrorHandler(), PetscReturnErrorHandler()
92 @*/
PetscEmacsClientErrorHandler(MPI_Comm comm,int line,const char * fun,const char * file,PetscErrorCode n,PetscErrorType p,const char * mess,void * ctx)93 PetscErrorCode PetscEmacsClientErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx)
94 {
95 PetscErrorCode ierr;
96 char command[PETSC_MAX_PATH_LEN];
97 const char *pdir;
98 FILE *fp;
99
100 PetscFunctionBegin;
101 ierr = 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 ierr = PetscPOpen(MPI_COMM_WORLD,(char*)ctx,command,"r",&fp);if (ierr) PetscFunctionReturn(ierr);
105 ierr = 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 ierr = PetscPopErrorHandler();if (ierr) PetscFunctionReturn(ierr); /* remove this handler from the stack of handlers */
110 if (!eh) {
111 ierr = PetscTraceBackErrorHandler(comm,line,fun,file,n,p,mess,NULL);if (ierr) PetscFunctionReturn(ierr);
112 } else {
113 ierr = (*eh->handler)(comm,line,fun,file,n,p,mess,eh->ctx);if (ierr) PetscFunctionReturn(ierr);
114 }
115 PetscFunctionReturn(ierr);
116 }
117
118 /*@C
119 PetscPushErrorHandler - Sets a routine to be called on detection of errors.
120
121 Not Collective
122
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.)
127
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);
130
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
138
139 Options Database Keys:
140 + -on_error_attach_debugger <noxterm,gdb or dbx>
141 - -on_error_abort
142
143 Level: intermediate
144
145 Notes:
146 The currently available PETSc error handlers include PetscTraceBackErrorHandler(),
147 PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscMPIAbortErrorHandler(), PetscReturnErrorHandler().
148
149 Fortran Notes:
150 You can only push one error handler from Fortran before poping it.
151
152 .seealso: PetscPopErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), PetscTraceBackErrorHandler(), PetscPushSignalHandler()
153
154 @*/
PetscPushErrorHandler(PetscErrorCode (* handler)(MPI_Comm comm,int,const char *,const char *,PetscErrorCode,PetscErrorType,const char *,void *),void * ctx)155 PetscErrorCode PetscPushErrorHandler(PetscErrorCode (*handler)(MPI_Comm comm,int,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*),void *ctx)
156 {
157 EH neweh;
158 PetscErrorCode ierr;
159
160 PetscFunctionBegin;
161 ierr = PetscNew(&neweh);CHKERRQ(ierr);
162 if (eh) neweh->previous = eh;
163 else neweh->previous = NULL;
164 neweh->handler = handler;
165 neweh->ctx = ctx;
166 eh = neweh;
167 PetscFunctionReturn(0);
168 }
169
170 /*@
171 PetscPopErrorHandler - Removes the latest error handler that was
172 pushed with PetscPushErrorHandler().
173
174 Not Collective
175
176 Level: intermediate
177
178 .seealso: PetscPushErrorHandler()
179 @*/
PetscPopErrorHandler(void)180 PetscErrorCode PetscPopErrorHandler(void)
181 {
182 EH tmp;
183 PetscErrorCode ierr;
184
185 PetscFunctionBegin;
186 if (!eh) PetscFunctionReturn(0);
187 tmp = eh;
188 eh = eh->previous;
189 ierr = PetscFree(tmp);CHKERRQ(ierr);
190 PetscFunctionReturn(0);
191 }
192
193 /*@C
194 PetscReturnErrorHandler - Error handler that causes a return without printing an error message.
195
196 Not Collective
197
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
206
207 Level: developer
208
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)
214
215 PetscIgnoreErrorHandler() does the same thing as this function, but is deprecated, you should use this function.
216
217 Use PetscPushErrorHandler() to set the desired error handler.
218
219 .seealso: PetscPushErrorHandler(), PetscPopErrorHandler(), PetscError(), PetscAbortErrorHandler(), PetscMPIAbortErrorHandler(), PetscTraceBackErrorHandler(),
220 PetscAttachDebuggerErrorHandler(), PetscEmacsClientErrorHandler()
221 @*/
PetscReturnErrorHandler(MPI_Comm comm,int line,const char * fun,const char * file,PetscErrorCode n,PetscErrorType p,const char * mess,void * ctx)222 PetscErrorCode PetscReturnErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx)
223 {
224 PetscFunctionBegin;
225 PetscFunctionReturn(n);
226 }
227
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 };
277
278 /*@C
279 PetscErrorMessage - returns the text string associated with a PETSc error code.
280
281 Not Collective
282
283 Input Parameter:
284 . errnum - the error code
285
286 Output Parameter:
287 + text - the error message (NULL if not desired)
288 - specific - the specific error message that was set with SETERRxxx() or PetscError(). (NULL if not desired)
289
290 Level: developer
291
292 .seealso: PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscError(), SETERRQ(), CHKERRQ()
293 PetscAbortErrorHandler(), PetscTraceBackErrorHandler()
294 @*/
PetscErrorMessage(int errnum,const char * text[],char ** specific)295 PetscErrorCode PetscErrorMessage(int errnum,const char *text[],char **specific)
296 {
297 PetscFunctionBegin;
298 if (text && errnum > PETSC_ERR_MIN_VALUE && errnum < PETSC_ERR_MAX_VALUE) *text = PetscErrorStrings[errnum-PETSC_ERR_MIN_VALUE-1];
299 else if (text) *text = NULL;
300
301 if (specific) *specific = PetscErrorBaseMessage;
302 PetscFunctionReturn(0);
303 }
304
305 #if defined(PETSC_CLANGUAGE_CXX)
306 /* C++ exceptions are formally not allowed to propagate through extern "C" code. In practice, far too much software
307 * would be broken if implementations did not handle it it some common cases. However, keep in mind
308 *
309 * Rule 62. Don't allow exceptions to propagate across module boundaries
310 *
311 * in "C++ Coding Standards" by Sutter and Alexandrescu. (This accounts for part of the ongoing C++ binary interface
312 * instability.) Having PETSc raise errors as C++ exceptions was probably misguided and should eventually be removed.
313 *
314 * Here is the problem: You have a C++ function call a PETSc function, and you would like to maintain the error message
315 * and stack information from the PETSc error. You could make everyone write exactly this code in their C++, but that
316 * seems crazy to me.
317 */
318 #include <sstream>
319 #include <stdexcept>
PetscCxxErrorThrow()320 static void PetscCxxErrorThrow() {
321 const char *str;
322 if (eh && eh->ctx) {
323 std::ostringstream *msg;
324 msg = (std::ostringstream*) eh->ctx;
325 str = msg->str().c_str();
326 } else str = "Error detected in C PETSc";
327
328 throw std::runtime_error(str);
329 }
330 #endif
331
332 /*@C
333 PetscError - Routine that is called when an error has been detected, usually called through the macro SETERRQ(PETSC_COMM_SELF,).
334
335 Collective on comm
336
337 Input Parameters:
338 + comm - communicator over which error occurred. ALL ranks of this communicator MUST call this routine
339 . line - the line number of the error (indicated by __LINE__)
340 . func - the function name in which the error was detected
341 . file - the file in which the error was detected (indicated by __FILE__)
342 . n - the generic error number
343 . p - PETSC_ERROR_INITIAL indicates the error was initially detected, PETSC_ERROR_REPEAT indicates this is a traceback from a previously detected error
344 - mess - formatted message string - aka printf
345
346 Options Database:
347 + -error_output_stdout - output the error messages to stdout instead of the default stderr
348 - -error_output_none - do not output the error messages
349
350 Level: intermediate
351
352 Notes:
353 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
354 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,
355 KSPGetConvergedReason() that indicates if the solve was successful or not. The option -ksp_error_if_not_converged, for example, turns numerical failures into
356 hard errors managed via PetscError().
357
358 PETSc provides a rich supply of error handlers, see the list below, and users can also provide their own error handlers.
359
360 Most users need not directly use this routine and the error handlers, but
361 can instead use the simplified interface SETERRQ, which has the calling
362 sequence
363 $ SETERRQ(comm,n,mess)
364
365 Fortran Note:
366 This routine is used differently from Fortran
367 $ PetscError(MPI_Comm comm,PetscErrorCode n,PetscErrorType p,char *message)
368
369 Set the error handler with PetscPushErrorHandler().
370
371 Developer Note: Since this is called after an error condition it should not be calling any error handlers (currently it ignores any error codes)
372 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
373 but this annoying.
374
375 .seealso: PetscErrorCode, PetscPushErrorHandler(), PetscPopErrorHandler(), PetscTraceBackErrorHandler(), PetscAbortErrorHandler(), PetscMPIAbortErrorHandler(),
376 PetscReturnErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscEmacsClientErrorHandler(),
377 SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2(), PetscErrorMessage(), PETSCABORT()
378 @*/
PetscError(MPI_Comm comm,int line,const char * func,const char * file,PetscErrorCode n,PetscErrorType p,const char * mess,...)379 PetscErrorCode PetscError(MPI_Comm comm,int line,const char *func,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,...)
380 {
381 va_list Argp;
382 size_t fullLength;
383 char buf[2048],*lbuf = NULL;
384 PetscBool ismain;
385 PetscErrorCode ierr;
386
387 PetscFunctionBegin;
388 if (!func) func = "User provided function";
389 if (!file) file = "User file";
390 if (comm == MPI_COMM_NULL) comm = PETSC_COMM_SELF;
391
392 /* Compose the message evaluating the print format */
393 if (mess) {
394 va_start(Argp,mess);
395 PetscVSNPrintf(buf,2048,mess,&fullLength,Argp);
396 va_end(Argp);
397 lbuf = buf;
398 if (p == PETSC_ERROR_INITIAL) PetscStrncpy(PetscErrorBaseMessage,lbuf,1023);
399 }
400
401 if (p == PETSC_ERROR_INITIAL && n != PETSC_ERR_MEMC) PetscMallocValidate(__LINE__,PETSC_FUNCTION_NAME,__FILE__);
402
403 if (!eh) ierr = PetscTraceBackErrorHandler(comm,line,func,file,n,p,lbuf,NULL);
404 else ierr = (*eh->handler)(comm,line,func,file,n,p,lbuf,eh->ctx);
405
406 /*
407 If this is called from the main() routine we call MPI_Abort() instead of
408 return to allow the parallel program to be properly shutdown.
409
410 Does not call PETSCABORT() since that would provide the wrong source file and line number information
411 */
412 PetscStrncmp(func,"main",4,&ismain);
413 if (ismain) {
414 PetscMPIInt errcode;
415 errcode = (PetscMPIInt)(0 + line*1000 + ierr);
416 if (petscwaitonerror) {PetscSleep(1000);}
417 MPI_Abort(comm,errcode);
418 }
419
420 #if defined(PETSC_CLANGUAGE_CXX)
421 if (p == PETSC_ERROR_IN_CXX) {
422 PetscCxxErrorThrow();
423 }
424 #endif
425 PetscFunctionReturn(ierr);
426 }
427
428 /* -------------------------------------------------------------------------*/
429
430 /*@C
431 PetscIntView - Prints an array of integers; useful for debugging.
432
433 Collective on PetscViewer
434
435 Input Parameters:
436 + N - number of integers in array
437 . idx - array of integers
438 - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
439
440 Level: intermediate
441
442 Developer Notes:
443 idx cannot be const because may be passed to binary viewer where byte swapping is done
444
445 .seealso: PetscRealView()
446 @*/
PetscIntView(PetscInt N,const PetscInt idx[],PetscViewer viewer)447 PetscErrorCode PetscIntView(PetscInt N,const PetscInt idx[],PetscViewer viewer)
448 {
449 PetscErrorCode ierr;
450 PetscMPIInt rank,size;
451 PetscInt j,i,n = N/20,p = N % 20;
452 PetscBool iascii,isbinary;
453 MPI_Comm comm;
454
455 PetscFunctionBegin;
456 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
457 PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,3);
458 if (N) PetscValidIntPointer(idx,2);
459 ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr);
460 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
461 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
462
463 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr);
464 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);CHKERRQ(ierr);
465 if (iascii) {
466 ierr = PetscViewerASCIIPushSynchronized(viewer);CHKERRQ(ierr);
467 for (i=0; i<n; i++) {
468 if (size > 1) {
469 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %D:", rank, 20*i);CHKERRQ(ierr);
470 } else {
471 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*i);CHKERRQ(ierr);
472 }
473 for (j=0; j<20; j++) {
474 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[i*20+j]);CHKERRQ(ierr);
475 }
476 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
477 }
478 if (p) {
479 if (size > 1) {
480 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %D:",rank ,20*n);CHKERRQ(ierr);
481 } else {
482 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*n);CHKERRQ(ierr);
483 }
484 for (i=0; i<p; i++) { ierr = PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[20*n+i]);CHKERRQ(ierr);}
485 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
486 }
487 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
488 ierr = PetscViewerASCIIPopSynchronized(viewer);CHKERRQ(ierr);
489 } else if (isbinary) {
490 PetscMPIInt *sizes,Ntotal,*displs,NN;
491 PetscInt *array;
492
493 ierr = PetscMPIIntCast(N,&NN);CHKERRQ(ierr);
494
495 if (size > 1) {
496 if (rank) {
497 ierr = MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm);CHKERRQ(ierr);
498 ierr = MPI_Gatherv((void*)idx,NN,MPIU_INT,NULL,NULL,NULL,MPIU_INT,0,comm);CHKERRQ(ierr);
499 } else {
500 ierr = PetscMalloc1(size,&sizes);CHKERRQ(ierr);
501 ierr = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);CHKERRQ(ierr);
502 Ntotal = sizes[0];
503 ierr = PetscMalloc1(size,&displs);CHKERRQ(ierr);
504 displs[0] = 0;
505 for (i=1; i<size; i++) {
506 Ntotal += sizes[i];
507 displs[i] = displs[i-1] + sizes[i-1];
508 }
509 ierr = PetscMalloc1(Ntotal,&array);CHKERRQ(ierr);
510 ierr = MPI_Gatherv((void*)idx,NN,MPIU_INT,array,sizes,displs,MPIU_INT,0,comm);CHKERRQ(ierr);
511 ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_INT);CHKERRQ(ierr);
512 ierr = PetscFree(sizes);CHKERRQ(ierr);
513 ierr = PetscFree(displs);CHKERRQ(ierr);
514 ierr = PetscFree(array);CHKERRQ(ierr);
515 }
516 } else {
517 ierr = PetscViewerBinaryWrite(viewer,idx,N,PETSC_INT);CHKERRQ(ierr);
518 }
519 } else {
520 const char *tname;
521 ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr);
522 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
523 }
524 PetscFunctionReturn(0);
525 }
526
527 /*@C
528 PetscRealView - Prints an array of doubles; useful for debugging.
529
530 Collective on PetscViewer
531
532 Input Parameters:
533 + N - number of PetscReal in array
534 . idx - array of PetscReal
535 - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
536
537 Level: intermediate
538
539 Developer Notes:
540 idx cannot be const because may be passed to binary viewer where byte swapping is done
541
542 .seealso: PetscIntView()
543 @*/
PetscRealView(PetscInt N,const PetscReal idx[],PetscViewer viewer)544 PetscErrorCode PetscRealView(PetscInt N,const PetscReal idx[],PetscViewer viewer)
545 {
546 PetscErrorCode ierr;
547 PetscMPIInt rank,size;
548 PetscInt j,i,n = N/5,p = N % 5;
549 PetscBool iascii,isbinary;
550 MPI_Comm comm;
551
552 PetscFunctionBegin;
553 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
554 PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,3);
555 PetscValidScalarPointer(idx,2);
556 ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr);
557 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
558 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
559
560 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr);
561 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);CHKERRQ(ierr);
562 if (iascii) {
563 PetscInt tab;
564
565 ierr = PetscViewerASCIIPushSynchronized(viewer);CHKERRQ(ierr);
566 ierr = PetscViewerASCIIGetTab(viewer, &tab);CHKERRQ(ierr);
567 for (i=0; i<n; i++) {
568 ierr = PetscViewerASCIISetTab(viewer, tab);CHKERRQ(ierr);
569 if (size > 1) {
570 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2d:",rank ,(int)5*i);CHKERRQ(ierr);
571 } else {
572 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",(int)5*i);CHKERRQ(ierr);
573 }
574 ierr = PetscViewerASCIISetTab(viewer, 0);CHKERRQ(ierr);
575 for (j=0; j<5; j++) {
576 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*5+j]);CHKERRQ(ierr);
577 }
578 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
579 }
580 if (p) {
581 ierr = PetscViewerASCIISetTab(viewer, tab);CHKERRQ(ierr);
582 if (size > 1) {
583 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2d:",rank ,(int)5*n);CHKERRQ(ierr);
584 } else {
585 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",(int)5*n);CHKERRQ(ierr);
586 }
587 ierr = PetscViewerASCIISetTab(viewer, 0);CHKERRQ(ierr);
588 for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[5*n+i]);CHKERRQ(ierr);}
589 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
590 }
591 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
592 ierr = PetscViewerASCIISetTab(viewer, tab);CHKERRQ(ierr);
593 ierr = PetscViewerASCIIPopSynchronized(viewer);CHKERRQ(ierr);
594 } else if (isbinary) {
595 PetscMPIInt *sizes,*displs, Ntotal,NN;
596 PetscReal *array;
597
598 ierr = PetscMPIIntCast(N,&NN);CHKERRQ(ierr);
599
600 if (size > 1) {
601 if (rank) {
602 ierr = MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm);CHKERRQ(ierr);
603 ierr = MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,NULL,NULL,NULL,MPIU_REAL,0,comm);CHKERRQ(ierr);
604 } else {
605 ierr = PetscMalloc1(size,&sizes);CHKERRQ(ierr);
606 ierr = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);CHKERRQ(ierr);
607 Ntotal = sizes[0];
608 ierr = PetscMalloc1(size,&displs);CHKERRQ(ierr);
609 displs[0] = 0;
610 for (i=1; i<size; i++) {
611 Ntotal += sizes[i];
612 displs[i] = displs[i-1] + sizes[i-1];
613 }
614 ierr = PetscMalloc1(Ntotal,&array);CHKERRQ(ierr);
615 ierr = MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,array,sizes,displs,MPIU_REAL,0,comm);CHKERRQ(ierr);
616 ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_REAL);CHKERRQ(ierr);
617 ierr = PetscFree(sizes);CHKERRQ(ierr);
618 ierr = PetscFree(displs);CHKERRQ(ierr);
619 ierr = PetscFree(array);CHKERRQ(ierr);
620 }
621 } else {
622 ierr = PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_REAL);CHKERRQ(ierr);
623 }
624 } else {
625 const char *tname;
626 ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr);
627 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
628 }
629 PetscFunctionReturn(0);
630 }
631
632 /*@C
633 PetscScalarView - Prints an array of scalars; useful for debugging.
634
635 Collective on PetscViewer
636
637 Input Parameters:
638 + N - number of scalars in array
639 . idx - array of scalars
640 - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
641
642 Level: intermediate
643
644 Developer Notes:
645 idx cannot be const because may be passed to binary viewer where byte swapping is done
646
647 .seealso: PetscIntView(), PetscRealView()
648 @*/
PetscScalarView(PetscInt N,const PetscScalar idx[],PetscViewer viewer)649 PetscErrorCode PetscScalarView(PetscInt N,const PetscScalar idx[],PetscViewer viewer)
650 {
651 PetscErrorCode ierr;
652 PetscMPIInt rank,size;
653 PetscInt j,i,n = N/3,p = N % 3;
654 PetscBool iascii,isbinary;
655 MPI_Comm comm;
656
657 PetscFunctionBegin;
658 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
659 PetscValidHeader(viewer,3);
660 if (N) PetscValidScalarPointer(idx,2);
661 ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr);
662 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
663 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
664
665 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr);
666 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);CHKERRQ(ierr);
667 if (iascii) {
668 ierr = PetscViewerASCIIPushSynchronized(viewer);CHKERRQ(ierr);
669 for (i=0; i<n; i++) {
670 if (size > 1) {
671 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2d:",rank ,3*i);CHKERRQ(ierr);
672 } else {
673 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);CHKERRQ(ierr);
674 }
675 for (j=0; j<3; j++) {
676 #if defined(PETSC_USE_COMPLEX)
677 ierr = PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[i*3+j]),(double)PetscImaginaryPart(idx[i*3+j]));CHKERRQ(ierr);
678 #else
679 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*3+j]);CHKERRQ(ierr);
680 #endif
681 }
682 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
683 }
684 if (p) {
685 if (size > 1) {
686 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2d:",rank ,3*n);CHKERRQ(ierr);
687 } else {
688 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);CHKERRQ(ierr);
689 }
690 for (i=0; i<p; i++) {
691 #if defined(PETSC_USE_COMPLEX)
692 ierr = PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[n*3+i]),(double)PetscImaginaryPart(idx[n*3+i]));CHKERRQ(ierr);
693 #else
694 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[3*n+i]);CHKERRQ(ierr);
695 #endif
696 }
697 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
698 }
699 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
700 ierr = PetscViewerASCIIPopSynchronized(viewer);CHKERRQ(ierr);
701 } else if (isbinary) {
702 PetscMPIInt *sizes,Ntotal,*displs,NN;
703 PetscScalar *array;
704
705 ierr = PetscMPIIntCast(N,&NN);CHKERRQ(ierr);
706
707 if (size > 1) {
708 if (rank) {
709 ierr = MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm);CHKERRQ(ierr);
710 ierr = MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,NULL,NULL,NULL,MPIU_SCALAR,0,comm);CHKERRQ(ierr);
711 } else {
712 ierr = PetscMalloc1(size,&sizes);CHKERRQ(ierr);
713 ierr = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);CHKERRQ(ierr);
714 Ntotal = sizes[0];
715 ierr = PetscMalloc1(size,&displs);CHKERRQ(ierr);
716 displs[0] = 0;
717 for (i=1; i<size; i++) {
718 Ntotal += sizes[i];
719 displs[i] = displs[i-1] + sizes[i-1];
720 }
721 ierr = PetscMalloc1(Ntotal,&array);CHKERRQ(ierr);
722 ierr = MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);CHKERRQ(ierr);
723 ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR);CHKERRQ(ierr);
724 ierr = PetscFree(sizes);CHKERRQ(ierr);
725 ierr = PetscFree(displs);CHKERRQ(ierr);
726 ierr = PetscFree(array);CHKERRQ(ierr);
727 }
728 } else {
729 ierr = PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_SCALAR);CHKERRQ(ierr);
730 }
731 } else {
732 const char *tname;
733 ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr);
734 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
735 }
736 PetscFunctionReturn(0);
737 }
738
739 #if defined(PETSC_HAVE_CUDA)
740 #include <petsccublas.h>
PetscCUBLASGetErrorName(cublasStatus_t status)741 PETSC_EXTERN const char* PetscCUBLASGetErrorName(cublasStatus_t status)
742 {
743 switch(status) {
744 #if (CUDART_VERSION >= 8000) /* At least CUDA 8.0 of Sep. 2016 had these */
745 case CUBLAS_STATUS_SUCCESS: return "CUBLAS_STATUS_SUCCESS";
746 case CUBLAS_STATUS_NOT_INITIALIZED: return "CUBLAS_STATUS_NOT_INITIALIZED";
747 case CUBLAS_STATUS_ALLOC_FAILED: return "CUBLAS_STATUS_ALLOC_FAILED";
748 case CUBLAS_STATUS_INVALID_VALUE: return "CUBLAS_STATUS_INVALID_VALUE";
749 case CUBLAS_STATUS_ARCH_MISMATCH: return "CUBLAS_STATUS_ARCH_MISMATCH";
750 case CUBLAS_STATUS_MAPPING_ERROR: return "CUBLAS_STATUS_MAPPING_ERROR";
751 case CUBLAS_STATUS_EXECUTION_FAILED: return "CUBLAS_STATUS_EXECUTION_FAILED";
752 case CUBLAS_STATUS_INTERNAL_ERROR: return "CUBLAS_STATUS_INTERNAL_ERROR";
753 case CUBLAS_STATUS_NOT_SUPPORTED: return "CUBLAS_STATUS_NOT_SUPPORTED";
754 case CUBLAS_STATUS_LICENSE_ERROR: return "CUBLAS_STATUS_LICENSE_ERROR";
755 #endif
756 default: return "unknown error";
757 }
758 }
759 #endif
760