Actual source code: err.c
1: #define PETSC_DLL
2: /*
3: Code that allows one to set the error handlers
4: */
5: #include petscsys.h
6: #include <stdarg.h>
7: #if defined(PETSC_HAVE_STDLIB_H)
8: #include <stdlib.h>
9: #endif
11: typedef struct _EH *EH;
12: struct _EH {
13: int cookie;
14: PetscErrorCode (*handler)(int,const char*,const char*,const char *,PetscErrorCode,int,const char*,void *);
15: void *ctx;
16: EH previous;
17: };
19: static EH eh = 0;
23: /*@C
24: PetscEmacsClientErrorHandler - Error handler that uses the emacsclient program to
25: load the file where the error occured. Then calls the "previous" error handler.
27: Not Collective
29: Input Parameters:
30: + line - the line number of the error (indicated by __LINE__)
31: . func - the function where error is detected (indicated by __FUNCT__)
32: . file - the file in which the error was detected (indicated by __FILE__)
33: . dir - the directory of the file (indicated by __SDIR__)
34: . mess - an error text string, usually just printed to the screen
35: . n - the generic error number
36: . p - specific error number
37: - ctx - error handler context
39: Options Database Key:
40: . -on_error_emacs <machinename>
42: Level: developer
44: Notes:
45: You must put (server-start) in your .emacs file for the emacsclient software to work
47: Most users need not directly employ this routine and the other error
48: handlers, but can instead use the simplified interface SETERRQ, which has
49: the calling sequence
50: $ SETERRQ(number,p,mess)
52: Notes for experienced users:
53: Use PetscPushErrorHandler() to set the desired error handler.
55: Concepts: emacs^going to on error
56: Concepts: error handler^going to line in emacs
58: .seealso: PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(),
59: PetscAbortErrorHandler()
60: @*/
61: PetscErrorCode PetscEmacsClientErrorHandler(int line,const char *fun,const char* file,const char *dir,PetscErrorCode n,int p,const char *mess,void *ctx)
62: {
64: char command[PETSC_MAX_PATH_LEN];
65: const char *pdir;
66: FILE *fp;
69: /* Note: don't check error codes since this an error handler :-) */
70: PetscGetPetscDir(&pdir);
71: sprintf(command,"emacsclient +%d %s/%s%s\n",line,pdir,dir,file);
72: #if defined(PETSC_HAVE_POPEN)
73: PetscPOpen(MPI_COMM_WORLD,(char*)ctx,command,"r",&fp);
74: PetscPClose(MPI_COMM_WORLD,fp);
75: #else
76: SETERRQ(PETSC_ERR_SUP_SYS,"Cannot run external programs on this machine");
77: #endif
78: PetscPopErrorHandler(); /* remove this handler from the stack of handlers */
79: if (!eh) PetscTraceBackErrorHandler(line,fun,file,dir,n,p,mess,0);
80: else (*eh->handler)(line,fun,file,dir,n,p,mess,eh->ctx);
81: PetscFunctionReturn(ierr);
82: }
86: /*@C
87: PetscPushErrorHandler - Sets a routine to be called on detection of errors.
89: Not Collective
91: Input Parameters:
92: + handler - error handler routine
93: - ctx - optional handler context that contains information needed by the handler (for
94: example file pointers for error messages etc.)
96: Calling sequence of handler:
97: $ int handler(int line,char *func,char *file,char *dir,PetscErrorCode n,int p,char *mess,void *ctx);
99: + func - the function where the error occured (indicated by __FUNCT__)
100: . line - the line number of the error (indicated by __LINE__)
101: . file - the file in which the error was detected (indicated by __FILE__)
102: . dir - the directory of the file (indicated by __SDIR__)
103: . n - the generic error number (see list defined in include/petscerror.h)
104: . p - the specific error number
105: . mess - an error text string, usually just printed to the screen
106: - ctx - the error handler context
108: Options Database Keys:
109: + -on_error_attach_debugger <noxterm,gdb or dbx>
110: - -on_error_abort
112: Level: intermediate
114: Notes:
115: The currently available PETSc error handlers include PetscTraceBackErrorHandler(),
116: PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscMPIAbortErrorHandler(), PetscReturnErrorHandler().
118: Fortran Notes: You can only push one error handler from Fortran before poping it.
120: .seealso: PetscPopErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), PetscTraceBackErrorHandler()
122: @*/
123: PetscErrorCode PetscPushErrorHandler(PetscErrorCode (*handler)(int,const char *,const char*,const char*,PetscErrorCode,int,const char*,void*),void *ctx)
124: {
125: EH neweh;
129: PetscNew(struct _EH,&neweh);
130: if (eh) {neweh->previous = eh;}
131: else {neweh->previous = 0;}
132: neweh->handler = handler;
133: neweh->ctx = ctx;
134: eh = neweh;
135: return(0);
136: }
140: /*@
141: PetscPopErrorHandler - Removes the latest error handler that was
142: pushed with PetscPushErrorHandler().
144: Not Collective
146: Level: intermediate
148: Concepts: error handler^setting
150: .seealso: PetscPushErrorHandler()
151: @*/
152: PetscErrorCode PetscPopErrorHandler(void)
153: {
154: EH tmp;
158: if (!eh) return(0);
159: tmp = eh;
160: eh = eh->previous;
161: PetscFree(tmp);
163: return(0);
164: }
165:
168: /*@C
169: PetscReturnErrorHandler - Error handler that causes a return to the current
170: level.
172: Not Collective
174: Input Parameters:
175: + line - the line number of the error (indicated by __LINE__)
176: . func - the function where error is detected (indicated by __FUNCT__)
177: . file - the file in which the error was detected (indicated by __FILE__)
178: . dir - the directory of the file (indicated by __SDIR__)
179: . mess - an error text string, usually just printed to the screen
180: . n - the generic error number
181: . p - specific error number
182: - ctx - error handler context
184: Level: developer
186: Notes:
187: Most users need not directly employ this routine and the other error
188: handlers, but can instead use the simplified interface SETERRQ, which has
189: the calling sequence
190: $ SETERRQ(number,p,mess)
192: Notes for experienced users:
193: This routine is good for catching errors such as zero pivots in preconditioners
194: or breakdown of iterative methods. It is not appropriate for memory violations
195: and similar errors.
197: Use PetscPushErrorHandler() to set the desired error handler. The
198: currently available PETSc error handlers include PetscTraceBackErrorHandler(),
199: PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscAbortErrorHandler()
201: Concepts: error handler
203: .seealso: PetscPushErrorHandler(), PetscPopErrorHandler().
204: @*/
206: PetscErrorCode PetscReturnErrorHandler(int line,const char *fun,const char* file,const char *dir,PetscErrorCode n,int p,const char *mess,void *ctx)
207: {
209: PetscFunctionReturn(n);
210: }
212: static char PetscErrorBaseMessage[1024];
213: /*
214: The numerical values for these are defined in include/petscerror.h; any changes
215: there must also be made here
216: */
217: static const char *PetscErrorStrings[] = {
218: /*55 */ "Out of memory",
219: "No support for this operation for this object type",
220: "No support for this operation on this system",
221: /*58 */ "Operation done in wrong order",
222: /*59 */ "Signal received",
223: /*60 */ "Nonconforming object sizes",
224: "Argument aliasing not permitted",
225: "Invalid argument",
226: /*63 */ "Argument out of range",
227: "Corrupt argument: see http://www.mcs.anl.gov/petsc/petsc-as/documentation/troubleshooting.html#Corrupt",
228: "Unable to open file",
229: "Read from file failed",
230: "Write to file failed",
231: "Invalid pointer",
232: /*69 */ "Arguments must have same type",
233: "",
234: /*71 */ "Detected zero pivot in LU factorization\nsee http://www.mcs.anl.gov/petsc/petsc-as/documentation/troubleshooting.html#ZeroPivot",
235: /*72 */ "Floating point exception",
236: /*73 */ "Object is in wrong state",
237: "Corrupted Petsc object",
238: "Arguments are incompatible",
239: "Error in external library",
240: /*77 */ "Petsc has generated inconsistent data",
241: "Memory corruption",
242: "Unexpected data in file",
243: /*80 */ "Arguments must have same communicators",
244: /*81 */ "Detected zero pivot in Cholesky factorization\nsee http://www.mcs.anl.gov/petsc/petsc-as/documentation/troubleshooting.html#ZeroPivot",
245: " ",
246: " ",
247: " ",
248: /*85 */ "Null argument, when expecting valid pointer",
249: /*86 */ "Unknown type. Check for miss-spelling or missing external package needed for type\n seehttp://www.mcs.anl.gov/petsc/petsc-as/documentation/installation.html#external",
250: /*87 */ "Not used",
251: /*88 */ "Error in system call",
252: /*89 */ "Object Type not set: see http://www.mcs.anl.gov/petsc/petsc-as/documentation/troubleshooting.html#typenotset"};
256: /*@C
257: PetscErrorMessage - returns the text string associated with a PETSc error code.
259: Not Collective
261: Input Parameter:
262: . errnum - the error code
264: Output Parameter:
265: + text - the error message (PETSC_NULL if not desired)
266: - specific - the specific error message that was set with SETERRxxx() or PetscError(). (PETSC_NULL if not desired)
268: Level: developer
270: Concepts: error handler^messages
272: .seealso: PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(),
273: PetscAbortErrorHandler(), PetscTraceBackErrorHandler()
274: @*/
275: PetscErrorCode PetscErrorMessage(int errnum,const char *text[],char **specific)
276: {
278: if (text && errnum > PETSC_ERR_MIN_VALUE && errnum < PETSC_ERR_MAX_VALUE) {
279: *text = PetscErrorStrings[errnum-PETSC_ERR_MIN_VALUE-1];
280: } else if (text) *text = 0;
282: if (specific) {
283: *specific = PetscErrorBaseMessage;
284: }
285: return(0);
286: }
288: #if defined(PETSC_USE_ERRORCHECKING)
289: PetscErrorCode PetscErrorUncatchable[PETSC_EXCEPTIONS_MAX] = {0};
290: PetscInt PetscErrorUncatchableCount = 0;
291: PetscErrorCode PetscExceptions[PETSC_EXCEPTIONS_MAX] = {0};
292: PetscInt PetscExceptionsCount = 0;
293: PetscErrorCode PetscExceptionTmp = 0;
294: PetscErrorCode PetscExceptionTmp1 = 0;
298: /*@C
299: PetscErrorIsCatchable - Returns if a PetscErrorCode can be caught with a PetscExceptionTry1() or
300: PetscExceptionPush()
302: Input Parameters:
303: . err - error code
305: Level: advanced
307: Notes:
308: PETSc must not be configured using the option --with-errorchecking=0 for this to work
310: .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop(), PetscErrorSetCatchable()
311: @*/
312: PetscTruth PetscErrorIsCatchable(PetscErrorCode err)
313: {
314: PetscInt i;
315: for (i=0; i<PetscErrorUncatchableCount; i++) {
316: if (err == PetscErrorUncatchable[i]) return PETSC_FALSE;
317: }
318: return PETSC_TRUE;
319: }
323: /*@
324: PetscErrorSetCatchable - Sets if a PetscErrorCode can be caught with a PetscExceptionTry1()
325: PetscExceptionCaught() pair, or PetscExceptionPush(). By default all errors are catchable.
327: Input Parameters:
328: + err - error code
329: - flg - PETSC_TRUE means allow to be caught, PETSC_FALSE means do not allow to be caught
331: Level: advanced
333: Notes:
334: PETSc must not be configured using the option --with-errorchecking=0 for this to work
336: .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop(), PetscErrorIsCatchable()
337: @*/
338: PetscErrorCode PetscErrorSetCatchable(PetscErrorCode err,PetscTruth flg)
339: {
341: if (!flg && PetscErrorIsCatchable(err)) {
342: /* add to list of uncatchable */
343: if (PetscErrorUncatchableCount >= PETSC_EXCEPTIONS_MAX) SETERRQ(PETSC_ERR_PLIB,"Stack for PetscErrorUncatchable is overflowed, recompile \nsrc/sysd/error/err.c with a larger value for PETSC_EXCEPTIONS_MAX");
344: PetscErrorUncatchable[PetscErrorUncatchableCount++] = err;
345: } else if (flg && !PetscErrorIsCatchable(err)) {
346: /* remove from list of uncatchable */
347: PetscInt i;
348: for (i=0; i<PetscErrorUncatchableCount; i++) {
349: if (PetscErrorUncatchable[i] == err) break;
350: }
351: for (;i<PetscErrorUncatchableCount; i++) {
352: PetscErrorUncatchable[i] = PetscErrorUncatchable[i+1];
353: }
354: PetscErrorUncatchableCount--;
355: }
356: return(0);
357: }
361: /*@
362: PetscExceptionPush - Adds the exception as one to be caught and passed up. If passed up
363: can be checked with PetscExceptionCaught() or PetscExceptionValue()
365: Input Parameters:
366: . err - the exception to catch
368: Level: advanced
370: Notes:
371: PETSc must not be configured using the option --with-errorchecking=0 for this to work
373: Use PetscExceptionPop() to remove this as a value to be caught
375: This is not usually needed in C/C++ rather use PetscExceptionTry1()
377: .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop()
378: @*/
379: PetscErrorCode PetscExceptionPush(PetscErrorCode err)
380: {
382: if (PetscExceptionsCount >= PETSC_EXCEPTIONS_MAX) SETERRQ(PETSC_ERR_PLIB,"Stack for PetscExceptions is overflowed, recompile \nsrc/sysd/error/err.c with a larger value for PETSC_EXCEPTIONS_MAX");
383: if (PetscErrorIsCatchable(err)) PetscExceptions[PetscExceptionsCount++] = err;
384: return(0);
385: }
389: /*@
390: PetscExceptionPop - Removes the most recent exception asked to be caught with PetscExceptionPush()
392: Input Parameters:
393: . err - the exception that was pushed
395: Level: advanced
397: Notes:
398: PETSc must not be configured using the option --with-errorchecking=0 for this to work
400: This is not usually needed in C/C++ rather use PetscExceptionTry1()
402: .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop()
403: @*/
404: PetscErrorCode PetscExceptionPop(PetscErrorCode err)
405: {
407: if (PetscExceptionsCount <= 0)SETERRQ(PETSC_ERR_PLIB,"Stack for PetscExceptions is empty");
408: if (PetscErrorIsCatchable(err)) PetscExceptionsCount--;
409: return(0);
410: }
411: #endif
415: /*@C
416: PetscError - Routine that is called when an error has been detected,
417: usually called through the macro SETERRQ().
419: Not Collective
421: Input Parameters:
422: + line - the line number of the error (indicated by __LINE__)
423: . func - the function where the error occured (indicated by __FUNCT__)
424: . dir - the directory of file (indicated by __SDIR__)
425: . file - the file in which the error was detected (indicated by __FILE__)
426: . mess - an error text string, usually just printed to the screen
427: . n - the generic error number
428: . p - 1 indicates the error was initially detected, 0 indicates this is a traceback from a
429: previously detected error
430: - mess - formatted message string - aka printf
432: Level: intermediate
434: Notes:
435: Most users need not directly use this routine and the error handlers, but
436: can instead use the simplified interface SETERRQ, which has the calling
437: sequence
438: $ SETERRQ(n,mess)
440: Experienced users can set the error handler with PetscPushErrorHandler().
442: Concepts: error^setting condition
444: .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2()
445: @*/
446: PetscErrorCode PetscError(int line,const char *func,const char* file,const char *dir,PetscErrorCode n,int p,const char *mess,...)
447: {
448: va_list Argp;
449: int fullLength;
451: char buf[2048],*lbuf = 0;
452: PetscTruth ismain,isunknown;
453: #if defined(PETSC_USE_ERRORCHECKING)
454: PetscInt i;
455: #endif
457: if (!func) func = "User provided function";
458: if (!file) file = "User file";
459: if (!dir) dir = " ";
462: /* Compose the message evaluating the print format */
463: if (mess) {
464: va_start(Argp,mess);
465: PetscVSNPrintf(buf,2048,mess,&fullLength,Argp);
466: va_end(Argp);
467: lbuf = buf;
468: if (p == 1) {
469: PetscStrncpy(PetscErrorBaseMessage,lbuf,1023);
470: }
471: }
473: #if defined(PETSC_USE_ERRORCHECKING)
474: /* check if user is catching this exception */
475: for (i=0; i<PetscExceptionsCount; i++) {
476: if (n == PetscExceptions[i]) PetscFunctionReturn(n);
477: }
478: #endif
480: if (!eh) PetscTraceBackErrorHandler(line,func,file,dir,n,p,lbuf,0);
481: else (*eh->handler)(line,func,file,dir,n,p,lbuf,eh->ctx);
483: /*
484: If this is called from the main() routine we call MPI_Abort() instead of
485: return to allow the parallel program to be properly shutdown.
487: Since this is in the error handler we don't check the errors below. Of course,
488: PetscStrncmp() does its own error checking which is problamatic
489: */
490: PetscStrncmp(func,"main",4,&ismain);
491: PetscStrncmp(func,"unknown",7,&isunknown);
492: if (ismain || isunknown) {
493: MPI_Abort(PETSC_COMM_WORLD,(int)ierr);
494: }
495: PetscFunctionReturn(ierr);
496: }
501: /*@C
502: PetscErrorCxx - Routine that is called when an error has been detected,
503: usually called through the macro SETERROR().
505: Not Collective
507: Input Parameters:
508: + line - the line number of the error (indicated by __LINE__)
509: . func - the function where the error occured (indicated by __FUNCT__)
510: . dir - the directory of file (indicated by __SDIR__)
511: . file - the file in which the error was detected (indicated by __FILE__)
512: . n - the generic error number
513: . p - 1 indicates the error was initially detected, 0 indicates this is a traceback from a
514: previously detected error
516: Level: intermediate
518: Notes:
519: Most users need not directly use this routine and the error handlers, but
520: can instead use the simplified interface SETERRQ, which has the calling
521: sequence
522: $ SETERRQ(n,mess)
524: Experienced users can set the error handler with PetscPushErrorHandler().
526: Concepts: error^setting condition
528: .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2()
529: @*/
530: void PetscErrorCxx(int line,const char *func,const char* file,const char *dir,PetscErrorCode n,int p)
531: {
532: PetscTruth ismain, isunknown;
533: #if 0
534: #if defined(PETSC_USE_ERRORCHECKING)
535: PetscInt i;
536: #endif
537: #endif
539: if (!func) func = "User provided function";
540: if (!file) file = "User file";
541: if (!dir) dir = " ";
543: #if 0
544: #if defined(PETSC_USE_ERRORCHECKING)
545: /* check if user is catching this exception */
546: for (i=0; i<PetscExceptionsCount; i++) {
547: if (n == PetscExceptions[i]) PetscFunctionReturn(n);
548: }
549: #endif
550: #endif
552: std::ostringstream msg;
554: PetscTraceBackErrorHandlerCxx(line, func, file, dir, n, p, msg);
556: /*
557: If this is called from the main() routine we call MPI_Abort() instead of
558: return to allow the parallel program to be properly shutdown.
560: Since this is in the error handler we don't check the errors below. Of course,
561: PetscStrncmp() does its own error checking which is problamatic
562: */
563: PetscStrncmp(func,"main",4,&ismain);
564: PetscStrncmp(func,"unknown",7,&isunknown);
565: if (ismain || isunknown) {
566: MPI_Abort(PETSC_COMM_WORLD, (int) n);
567: }
568: throw PETSc::Exception(msg.str().c_str());
569: }
570: #endif
572: /* -------------------------------------------------------------------------*/
576: /*@C
577: PetscIntView - Prints an array of integers; useful for debugging.
579: Collective on PetscViewer
581: Input Parameters:
582: + N - number of integers in array
583: . idx - array of integers
584: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
586: Level: intermediate
588: Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done
590: .seealso: PetscRealView()
591: @*/
592: PetscErrorCode PetscIntView(PetscInt N,const PetscInt idx[],PetscViewer viewer)
593: {
595: PetscInt j,i,n = N/20,p = N % 20;
596: PetscTruth iascii,isbinary;
597: MPI_Comm comm;
600: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
603: PetscObjectGetComm((PetscObject)viewer,&comm);
605: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);
606: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);
607: if (iascii) {
608: for (i=0; i<n; i++) {
609: PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*i);
610: for (j=0; j<20; j++) {
611: PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[i*20+j]);
612: }
613: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
614: }
615: if (p) {
616: PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*n);
617: for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[20*n+i]);}
618: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
619: }
620: PetscViewerFlush(viewer);
621: } else if (isbinary) {
622: PetscMPIInt rank,size,*sizes,Ntotal,*displs, NN = PetscMPIIntCast(N);
623: PetscInt *array;
624: MPI_Comm_rank(comm,&rank);
625: MPI_Comm_size(comm,&size);
627: if (size > 1) {
628: if (rank) {
629: MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
630: MPI_Gatherv((void*)idx,NN,MPIU_INT,0,0,0,MPIU_INT,0,comm);
631: } else {
632: PetscMalloc(size*sizeof(PetscMPIInt),&sizes);
633: MPI_Gather(&NN,1,MPI_INT,sizes,1,MPIU_INT,0,comm);
634: Ntotal = sizes[0];
635: PetscMalloc(size*sizeof(PetscMPIInt),&displs);
636: displs[0] = 0;
637: for (i=1; i<size; i++) {
638: Ntotal += sizes[i];
639: displs[i] = displs[i-1] + sizes[i-1];
640: }
641: PetscMalloc(Ntotal*sizeof(PetscInt),&array);
642: MPI_Gatherv((void*)idx,NN,MPIU_INT,array,sizes,displs,MPIU_INT,0,comm);
643: PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_INT,PETSC_TRUE);
644: PetscFree(sizes);
645: PetscFree(displs);
646: PetscFree(array);
647: }
648: } else {
649: PetscViewerBinaryWrite(viewer,(void *) idx,N,PETSC_INT,PETSC_FALSE);
650: }
651: } else {
652: const char *tname;
653: PetscObjectGetName((PetscObject)viewer,&tname);
654: SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
655: }
656: return(0);
657: }
661: /*@C
662: PetscRealView - Prints an array of doubles; useful for debugging.
664: Collective on PetscViewer
666: Input Parameters:
667: + N - number of doubles in array
668: . idx - array of doubles
669: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
671: Level: intermediate
673: Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done
675: .seealso: PetscIntView()
676: @*/
677: PetscErrorCode PetscRealView(PetscInt N,const PetscReal idx[],PetscViewer viewer)
678: {
680: PetscInt j,i,n = N/5,p = N % 5;
681: PetscTruth iascii,isbinary;
682: MPI_Comm comm;
685: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
688: PetscObjectGetComm((PetscObject)viewer,&comm);
690: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);
691: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);
692: if (iascii) {
693: for (i=0; i<n; i++) {
694: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*i);
695: for (j=0; j<5; j++) {
696: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*5+j]);
697: }
698: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
699: }
700: if (p) {
701: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*n);
702: for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[5*n+i]);}
703: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
704: }
705: PetscViewerFlush(viewer);
706: } else if (isbinary) {
707: PetscMPIInt rank,size,*sizes,*displs, Ntotal,NN = PetscMPIIntCast(N);
708: PetscReal *array;
710: MPI_Comm_rank(comm,&rank);
711: MPI_Comm_size(comm,&size);
713: if (size > 1) {
714: if (rank) {
715: MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
716: MPI_Gatherv((void*)idx,NN,MPI_DOUBLE,0,0,0,MPI_DOUBLE,0,comm);
717: } else {
718: PetscMalloc(size*sizeof(PetscMPIInt),&sizes);
719: MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
720: Ntotal = sizes[0];
721: PetscMalloc(size*sizeof(PetscMPIInt),&displs);
722: displs[0] = 0;
723: for (i=1; i<size; i++) {
724: Ntotal += sizes[i];
725: displs[i] = displs[i-1] + sizes[i-1];
726: }
727: PetscMalloc(Ntotal*sizeof(PetscReal),&array);
728: MPI_Gatherv((void*)idx,NN,MPI_DOUBLE,array,sizes,displs,MPI_DOUBLE,0,comm);
729: PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_REAL,PETSC_TRUE);
730: PetscFree(sizes);
731: PetscFree(displs);
732: PetscFree(array);
733: }
734: } else {
735: PetscViewerBinaryWrite(viewer,(void *) idx,N,PETSC_REAL,PETSC_FALSE);
736: }
737: } else {
738: const char *tname;
739: PetscObjectGetName((PetscObject)viewer,&tname);
740: SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
741: }
742: return(0);
743: }
747: /*@C
748: PetscScalarView - Prints an array of scalars; useful for debugging.
750: Collective on PetscViewer
752: Input Parameters:
753: + N - number of scalars in array
754: . idx - array of scalars
755: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
757: Level: intermediate
759: Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done
761: .seealso: PetscIntView(), PetscRealView()
762: @*/
763: PetscErrorCode PetscScalarView(PetscInt N,const PetscScalar idx[],PetscViewer viewer)
764: {
766: PetscInt j,i,n = N/3,p = N % 3;
767: PetscTruth iascii,isbinary;
768: MPI_Comm comm;
771: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
774: PetscObjectGetComm((PetscObject)viewer,&comm);
776: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);
777: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);
778: if (iascii) {
779: for (i=0; i<n; i++) {
780: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);
781: for (j=0; j<3; j++) {
782: #if defined (PETSC_USE_COMPLEX)
783: PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
784: PetscRealPart(idx[i*3+j]),PetscImaginaryPart(idx[i*3+j]));
785: #else
786: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*3+j]);
787: #endif
788: }
789: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
790: }
791: if (p) {
792: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);
793: for (i=0; i<p; i++) {
794: #if defined (PETSC_USE_COMPLEX)
795: PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
796: PetscRealPart(idx[n*3+i]),PetscImaginaryPart(idx[n*3+i]));
797: #else
798: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[3*n+i]);
799: #endif
800: }
801: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
802: }
803: PetscViewerFlush(viewer);
804: } else if (isbinary) {
805: PetscMPIInt size,rank,*sizes,Ntotal,*displs,NN = PetscMPIIntCast(N);
806: PetscScalar *array;
808: MPI_Comm_rank(comm,&rank);
809: MPI_Comm_size(comm,&size);
811: if (size > 1) {
812: if (rank) {
813: MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
814: MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,0,0,0,MPIU_SCALAR,0,comm);
815: } else {
816: PetscMalloc(size*sizeof(PetscMPIInt),&sizes);
817: MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
818: Ntotal = sizes[0];
819: PetscMalloc(size*sizeof(PetscMPIInt),&displs);
820: displs[0] = 0;
821: for (i=1; i<size; i++) {
822: Ntotal += sizes[i];
823: displs[i] = displs[i-1] + sizes[i-1];
824: }
825: PetscMalloc(Ntotal*sizeof(PetscScalar),&array);
826: MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);
827: PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR,PETSC_TRUE);
828: PetscFree(sizes);
829: PetscFree(displs);
830: PetscFree(array);
831: }
832: } else {
833: PetscViewerBinaryWrite(viewer,(void *) idx,N,PETSC_SCALAR,PETSC_FALSE);
834: }
835: } else {
836: const char *tname;
837: PetscObjectGetName((PetscObject)viewer,&tname);
838: SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
839: }
840: return(0);
841: }