Actual source code: err.c
1: #define PETSC_DLL
2: /*
3: Code that allows one to set the error handlers
4: */
5: #include petsc.h
6: #include petscsys.h
7: #include <stdarg.h>
8: #if defined(PETSC_HAVE_STDLIB_H)
9: #include <stdlib.h>
10: #endif
12: typedef struct _EH *EH;
13: struct _EH {
14: int cookie;
15: PetscErrorCode (*handler)(int,const char*,const char*,const char *,PetscErrorCode,int,const char*,void *);
16: void *ctx;
17: EH previous;
18: };
20: static EH eh = 0;
24: /*@C
25: PetscEmacsClientErrorHandler - Error handler that uses the emacsclient program to
26: load the file where the error occured. Then calls the "previous" error handler.
28: Not Collective
30: Input Parameters:
31: + line - the line number of the error (indicated by __LINE__)
32: . func - the function where error is detected (indicated by __FUNCT__)
33: . file - the file in which the error was detected (indicated by __FILE__)
34: . dir - the directory of the file (indicated by __SDIR__)
35: . mess - an error text string, usually just printed to the screen
36: . n - the generic error number
37: . p - specific error number
38: - ctx - error handler context
40: Options Database Key:
41: . -on_error_emacs <machinename>
43: Level: developer
45: Notes:
46: You must put (server-start) in your .emacs file for the emacsclient software to work
48: Most users need not directly employ this routine and the other error
49: handlers, but can instead use the simplified interface SETERRQ, which has
50: the calling sequence
51: $ SETERRQ(number,p,mess)
53: Notes for experienced users:
54: Use PetscPushErrorHandler() to set the desired error handler.
56: Concepts: emacs^going to on error
57: Concepts: error handler^going to line in emacs
59: .seealso: PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(),
60: PetscAbortErrorHandler()
61: @*/
62: PetscErrorCode PetscEmacsClientErrorHandler(int line,const char *fun,const char* file,const char *dir,PetscErrorCode n,int p,const char *mess,void *ctx)
63: {
65: char command[PETSC_MAX_PATH_LEN];
66: const char *pdir;
67: FILE *fp;
70: /* Note: don't check error codes since this an error handler :-) */
71: PetscGetPetscDir(&pdir);
72: sprintf(command,"emacsclient +%d %s/%s%s\n",line,pdir,dir,file);
73: #if defined(PETSC_HAVE_POPEN)
74: PetscPOpen(MPI_COMM_WORLD,(char*)ctx,command,"r",&fp);
75: PetscPClose(MPI_COMM_WORLD,fp);
76: #else
77: SETERRQ(PETSC_ERR_SUP_SYS,"Cannot run external programs on this machine");
78: #endif
79: PetscPopErrorHandler(); /* remove this handler from the stack of handlers */
80: if (!eh) PetscTraceBackErrorHandler(line,fun,file,dir,n,p,mess,0);
81: else (*eh->handler)(line,fun,file,dir,n,p,mess,eh->ctx);
82: PetscFunctionReturn(ierr);
83: }
87: /*@C
88: PetscPushErrorHandler - Sets a routine to be called on detection of errors.
90: Not Collective
92: Input Parameters:
93: + handler - error handler routine
94: - ctx - optional handler context that contains information needed by the handler (for
95: example file pointers for error messages etc.)
97: Calling sequence of handler:
98: $ int handler(int line,char *func,char *file,char *dir,PetscErrorCode n,int p,char *mess,void *ctx);
100: + func - the function where the error occured (indicated by __FUNCT__)
101: . line - the line number of the error (indicated by __LINE__)
102: . file - the file in which the error was detected (indicated by __FILE__)
103: . dir - the directory of the file (indicated by __SDIR__)
104: . n - the generic error number (see list defined in include/petscerror.h)
105: . p - the specific error number
106: . mess - an error text string, usually just printed to the screen
107: - ctx - the error handler context
109: Options Database Keys:
110: + -on_error_attach_debugger <noxterm,gdb or dbx>
111: - -on_error_abort
113: Level: intermediate
115: Notes:
116: The
117: currently available PETSc error handlers include PetscTraceBackErrorHandler(),
118: PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscMPIAbortErrorHandler(), PetscReturnErrorHandler().
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"};
253: /*@C
254: PetscErrorMessage - returns the text string associated with a PETSc error code.
256: Not Collective
258: Input Parameter:
259: . errnum - the error code
261: Output Parameter:
262: + text - the error message (PETSC_NULL if not desired)
263: - specific - the specific error message that was set with SETERRxxx() or PetscError(). (PETSC_NULL if not desired)
265: Level: developer
267: Concepts: error handler^messages
269: .seealso: PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(),
270: PetscAbortErrorHandler(), PetscTraceBackErrorHandler()
271: @*/
272: PetscErrorCode PetscErrorMessage(int errnum,const char *text[],char **specific)
273: {
275: if (text && errnum > PETSC_ERR_MIN_VALUE && errnum < PETSC_ERR_MAX_VALUE) {
276: *text = PetscErrorStrings[errnum-PETSC_ERR_MIN_VALUE-1];
277: } else if (text) *text = 0;
279: if (specific) {
280: *specific = PetscErrorBaseMessage;
281: }
282: return(0);
283: }
285: #if defined(PETSC_USE_ERRORCHECKING)
286: PetscErrorCode PetscErrorUncatchable[PETSC_EXCEPTIONS_MAX] = {0};
287: PetscInt PetscErrorUncatchableCount = 0;
288: PetscErrorCode PetscExceptions[PETSC_EXCEPTIONS_MAX] = {0};
289: PetscInt PetscExceptionsCount = 0;
290: PetscErrorCode PetscExceptionTmp = 0;
291: PetscErrorCode PetscExceptionTmp1 = 0;
295: /*@C
296: PetscErrorIsCatchable - Returns if a PetscErrorCode can be caught with a PetscExceptionTry1() or
297: PetscExceptionPush()
299: Input Parameters:
300: . err - error code
302: Level: advanced
304: Notes:
305: PETSc must not be configured using the option --with-errorchecking=0 for this to work
307: .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop(), PetscErrorSetCatchable()
308: @*/
309: PetscTruth PetscErrorIsCatchable(PetscErrorCode err)
310: {
311: PetscInt i;
312: for (i=0; i<PetscErrorUncatchableCount; i++) {
313: if (err == PetscErrorUncatchable[i]) return PETSC_FALSE;
314: }
315: return PETSC_TRUE;
316: }
320: /*@
321: PetscErrorSetCatchable - Sets if a PetscErrorCode can be caught with a PetscExceptionTry1()
322: PetscExceptionCaught() pair, or PetscExceptionPush(). By default all errors are catchable.
324: Input Parameters:
325: + err - error code
326: - flg - PETSC_TRUE means allow to be caught, PETSC_FALSE means do not allow to be caught
328: Level: advanced
330: Notes:
331: PETSc must not be configured using the option --with-errorchecking=0 for this to work
333: .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop(), PetscErrorIsCatchable()
334: @*/
335: PetscErrorCode PetscErrorSetCatchable(PetscErrorCode err,PetscTruth flg)
336: {
338: if (!flg && PetscErrorIsCatchable(err)) {
339: /* add to list of uncatchable */
340: 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");
341: PetscErrorUncatchable[PetscErrorUncatchableCount++] = err;
342: } else if (flg && !PetscErrorIsCatchable(err)) {
343: /* remove from list of uncatchable */
344: PetscInt i;
345: for (i=0; i<PetscErrorUncatchableCount; i++) {
346: if (PetscErrorUncatchable[i] == err) break;
347: }
348: for (;i<PetscErrorUncatchableCount; i++) {
349: PetscErrorUncatchable[i] = PetscErrorUncatchable[i+1];
350: }
351: PetscErrorUncatchableCount--;
352: }
353: return(0);
354: }
358: /*@
359: PetscExceptionPush - Adds the exception as one to be caught and passed up. If passed up
360: can be checked with PetscExceptionCaught() or PetscExceptionValue()
362: Input Parameters:
363: . err - the exception to catch
365: Level: advanced
367: Notes:
368: PETSc must not be configured using the option --with-errorchecking=0 for this to work
370: Use PetscExceptionPop() to remove this as a value to be caught
372: This is not usually needed in C/C++ rather use PetscExceptionTry1()
374: .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop()
375: @*/
376: PetscErrorCode PetscExceptionPush(PetscErrorCode err)
377: {
379: 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");
380: if (PetscErrorIsCatchable(err)) PetscExceptions[PetscExceptionsCount++] = err;
381: return(0);
382: }
386: /*@
387: PetscExceptionPop - Removes the most recent exception asked to be caught with PetscExceptionPush()
389: Input Parameters:
390: . err - the exception that was pushed
392: Level: advanced
394: Notes:
395: PETSc must not be configured using the option --with-errorchecking=0 for this to work
397: This is not usually needed in C/C++ rather use PetscExceptionTry1()
399: .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop()
400: @*/
401: PetscErrorCode PetscExceptionPop(PetscErrorCode err)
402: {
404: if (PetscExceptionsCount <= 0)SETERRQ(PETSC_ERR_PLIB,"Stack for PetscExceptions is empty");
405: if (PetscErrorIsCatchable(err)) PetscExceptionsCount--;
406: return(0);
407: }
408: #endif
412: /*@C
413: PetscError - Routine that is called when an error has been detected,
414: usually called through the macro SETERRQ().
416: Not Collective
418: Input Parameters:
419: + line - the line number of the error (indicated by __LINE__)
420: . func - the function where the error occured (indicated by __FUNCT__)
421: . dir - the directory of file (indicated by __SDIR__)
422: . file - the file in which the error was detected (indicated by __FILE__)
423: . mess - an error text string, usually just printed to the screen
424: . n - the generic error number
425: . p - 1 indicates the error was initially detected, 0 indicates this is a traceback from a
426: previously detected error
427: - mess - formatted message string - aka printf
429: Level: intermediate
431: Notes:
432: Most users need not directly use this routine and the error handlers, but
433: can instead use the simplified interface SETERRQ, which has the calling
434: sequence
435: $ SETERRQ(n,mess)
437: Experienced users can set the error handler with PetscPushErrorHandler().
439: Concepts: error^setting condition
441: .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2()
442: @*/
443: PetscErrorCode PetscError(int line,const char *func,const char* file,const char *dir,PetscErrorCode n,int p,const char *mess,...)
444: {
445: va_list Argp;
447: char buf[2048],*lbuf = 0;
448: PetscTruth ismain,isunknown;
449: #if defined(PETSC_USE_ERRORCHECKING)
450: PetscInt i;
451: #endif
453: if (!func) func = "User provided function";
454: if (!file) file = "User file";
455: if (!dir) dir = " ";
458: /* Compose the message evaluating the print format */
459: if (mess) {
460: va_start(Argp,mess);
461: PetscVSNPrintf(buf,2048,mess,Argp);
462: va_end(Argp);
463: lbuf = buf;
464: if (p == 1) {
465: PetscStrncpy(PetscErrorBaseMessage,lbuf,1023);
466: }
467: }
469: #if defined(PETSC_USE_ERRORCHECKING)
470: /* check if user is catching this exception */
471: for (i=0; i<PetscExceptionsCount; i++) {
472: if (n == PetscExceptions[i]) PetscFunctionReturn(n);
473: }
474: #endif
476: if (!eh) PetscTraceBackErrorHandler(line,func,file,dir,n,p,lbuf,0);
477: else (*eh->handler)(line,func,file,dir,n,p,lbuf,eh->ctx);
479: /*
480: If this is called from the main() routine we call MPI_Abort() instead of
481: return to allow the parallel program to be properly shutdown.
483: Since this is in the error handler we don't check the errors below. Of course,
484: PetscStrncmp() does its own error checking which is problamatic
485: */
486: PetscStrncmp(func,"main",4,&ismain);
487: PetscStrncmp(func,"unknown",7,&isunknown);
488: if (ismain || isunknown) {
489: MPI_Abort(PETSC_COMM_WORLD,(int)ierr);
490: }
491: PetscFunctionReturn(ierr);
492: }
494: #ifdef PETSC_CLANGUAGE_CXX
497: /*@C
498: PetscErrorCxx - Routine that is called when an error has been detected,
499: usually called through the macro SETERROR().
501: Not Collective
503: Input Parameters:
504: + line - the line number of the error (indicated by __LINE__)
505: . func - the function where the error occured (indicated by __FUNCT__)
506: . dir - the directory of file (indicated by __SDIR__)
507: . file - the file in which the error was detected (indicated by __FILE__)
508: . n - the generic error number
509: . p - 1 indicates the error was initially detected, 0 indicates this is a traceback from a
510: previously detected error
512: Level: intermediate
514: Notes:
515: Most users need not directly use this routine and the error handlers, but
516: can instead use the simplified interface SETERRQ, which has the calling
517: sequence
518: $ SETERRQ(n,mess)
520: Experienced users can set the error handler with PetscPushErrorHandler().
522: Concepts: error^setting condition
524: .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2()
525: @*/
526: void PetscErrorCxx(int line,const char *func,const char* file,const char *dir,PetscErrorCode n,int p)
527: {
528: PetscTruth ismain, isunknown;
529: #if 0
530: #if defined(PETSC_USE_ERRORCHECKING)
531: PetscInt i;
532: #endif
533: #endif
535: if (!func) func = "User provided function";
536: if (!file) file = "User file";
537: if (!dir) dir = " ";
539: #if 0
540: #if defined(PETSC_USE_ERRORCHECKING)
541: /* check if user is catching this exception */
542: for (i=0; i<PetscExceptionsCount; i++) {
543: if (n == PetscExceptions[i]) PetscFunctionReturn(n);
544: }
545: #endif
546: #endif
548: std::ostringstream msg;
550: PetscTraceBackErrorHandlerCxx(line, func, file, dir, n, p, msg);
552: /*
553: If this is called from the main() routine we call MPI_Abort() instead of
554: return to allow the parallel program to be properly shutdown.
556: Since this is in the error handler we don't check the errors below. Of course,
557: PetscStrncmp() does its own error checking which is problamatic
558: */
559: PetscStrncmp(func,"main",4,&ismain);
560: PetscStrncmp(func,"unknown",7,&isunknown);
561: if (ismain || isunknown) {
562: MPI_Abort(PETSC_COMM_WORLD, (int) n);
563: }
564: throw PETSc::Exception(msg.str().c_str());
565: }
566: #endif
568: /* -------------------------------------------------------------------------*/
572: /*@C
573: PetscIntView - Prints an array of integers; useful for debugging.
575: Collective on PetscViewer
577: Input Parameters:
578: + N - number of integers in array
579: . idx - array of integers
580: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
582: Level: intermediate
584: .seealso: PetscRealView()
585: @*/
586: PetscErrorCode PetscIntView(PetscInt N,PetscInt idx[],PetscViewer viewer)
587: {
589: PetscInt j,i,n = N/20,p = N % 20;
590: PetscTruth iascii,isbinary;
591: MPI_Comm comm;
594: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
597: PetscObjectGetComm((PetscObject)viewer,&comm);
599: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);
600: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);
601: if (iascii) {
602: for (i=0; i<n; i++) {
603: PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*i);
604: for (j=0; j<20; j++) {
605: PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[i*20+j]);
606: }
607: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
608: }
609: if (p) {
610: PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*n);
611: for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[20*n+i]);}
612: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
613: }
614: PetscViewerFlush(viewer);
615: } else if (isbinary) {
616: PetscMPIInt rank,size,*sizes,Ntotal,*displs, NN = (PetscMPIInt)N;
617: PetscInt *array;
618: MPI_Comm_rank(comm,&rank);
619: MPI_Comm_size(comm,&size);
621: if (size > 1) {
622: if (rank) {
623: MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
624: MPI_Gatherv(idx,NN,MPIU_INT,0,0,0,MPIU_INT,0,comm);
625: } else {
626: PetscMalloc(size*sizeof(PetscMPIInt),&sizes);
627: MPI_Gather(&NN,1,MPI_INT,sizes,1,MPIU_INT,0,comm);
628: Ntotal = sizes[0];
629: PetscMalloc(size*sizeof(PetscMPIInt),&displs);
630: displs[0] = 0;
631: for (i=1; i<size; i++) {
632: Ntotal += sizes[i];
633: displs[i] = displs[i-1] + sizes[i-1];
634: }
635: PetscMalloc(Ntotal*sizeof(PetscInt),&array);
636: MPI_Gatherv(idx,NN,MPIU_INT,array,sizes,displs,MPIU_INT,0,comm);
637: PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_INT,PETSC_TRUE);
638: PetscFree(sizes);
639: PetscFree(displs);
640: PetscFree(array);
641: }
642: } else {
643: PetscViewerBinaryWrite(viewer,idx,N,PETSC_INT,PETSC_FALSE);
644: }
645: } else {
646: const char *tname;
647: PetscObjectGetName((PetscObject)viewer,&tname);
648: SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
649: }
650: return(0);
651: }
655: /*@C
656: PetscRealView - Prints an array of doubles; useful for debugging.
658: Collective on PetscViewer
660: Input Parameters:
661: + N - number of doubles in array
662: . idx - array of doubles
663: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
665: Level: intermediate
667: .seealso: PetscIntView()
668: @*/
669: PetscErrorCode PetscRealView(PetscInt N,PetscReal idx[],PetscViewer viewer)
670: {
672: PetscInt j,i,n = N/5,p = N % 5;
673: PetscTruth iascii,isbinary;
674: MPI_Comm comm;
677: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
680: PetscObjectGetComm((PetscObject)viewer,&comm);
682: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);
683: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);
684: if (iascii) {
685: for (i=0; i<n; i++) {
686: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*i);
687: for (j=0; j<5; j++) {
688: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*5+j]);
689: }
690: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
691: }
692: if (p) {
693: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*n);
694: for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[5*n+i]);}
695: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
696: }
697: PetscViewerFlush(viewer);
698: } else if (isbinary) {
699: PetscMPIInt rank,size,*sizes,*displs, Ntotal,NN = (PetscMPIInt)N;
700: PetscReal *array;
702: MPI_Comm_rank(comm,&rank);
703: MPI_Comm_size(comm,&size);
705: if (size > 1) {
706: if (rank) {
707: MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
708: MPI_Gatherv(idx,NN,MPI_DOUBLE,0,0,0,MPI_DOUBLE,0,comm);
709: } else {
710: PetscMalloc(size*sizeof(PetscMPIInt),&sizes);
711: MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
712: Ntotal = sizes[0];
713: PetscMalloc(size*sizeof(PetscMPIInt),&displs);
714: displs[0] = 0;
715: for (i=1; i<size; i++) {
716: Ntotal += sizes[i];
717: displs[i] = displs[i-1] + sizes[i-1];
718: }
719: PetscMalloc(Ntotal*sizeof(PetscReal),&array);
720: MPI_Gatherv(idx,NN,MPI_DOUBLE,array,sizes,displs,MPI_DOUBLE,0,comm);
721: PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_REAL,PETSC_TRUE);
722: PetscFree(sizes);
723: PetscFree(displs);
724: PetscFree(array);
725: }
726: } else {
727: PetscViewerBinaryWrite(viewer,idx,N,PETSC_REAL,PETSC_FALSE);
728: }
729: } else {
730: const char *tname;
731: PetscObjectGetName((PetscObject)viewer,&tname);
732: SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
733: }
734: return(0);
735: }
739: /*@C
740: PetscScalarView - Prints an array of scalars; useful for debugging.
742: Collective on PetscViewer
744: Input Parameters:
745: + N - number of scalars in array
746: . idx - array of scalars
747: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
749: Level: intermediate
751: .seealso: PetscIntView(), PetscRealView()
752: @*/
753: PetscErrorCode PetscScalarView(PetscInt N,PetscScalar idx[],PetscViewer viewer)
754: {
756: PetscInt j,i,n = N/3,p = N % 3;
757: PetscTruth iascii,isbinary;
758: MPI_Comm comm;
761: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
764: PetscObjectGetComm((PetscObject)viewer,&comm);
766: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);
767: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);
768: if (iascii) {
769: for (i=0; i<n; i++) {
770: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);
771: for (j=0; j<3; j++) {
772: #if defined (PETSC_USE_COMPLEX)
773: PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
774: PetscRealPart(idx[i*3+j]),PetscImaginaryPart(idx[i*3+j]));
775: #else
776: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*3+j]);
777: #endif
778: }
779: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
780: }
781: if (p) {
782: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);
783: for (i=0; i<p; i++) {
784: #if defined (PETSC_USE_COMPLEX)
785: PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
786: PetscRealPart(idx[n*3+i]),PetscImaginaryPart(idx[n*3+i]));
787: #else
788: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[3*n+i]);
789: #endif
790: }
791: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
792: }
793: PetscViewerFlush(viewer);
794: } else if (isbinary) {
795: PetscMPIInt size,rank,*sizes,Ntotal,*displs,NN = (PetscMPIInt)N;
796: PetscScalar *array;
798: MPI_Comm_rank(comm,&rank);
799: MPI_Comm_size(comm,&size);
801: if (size > 1) {
802: if (rank) {
803: MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
804: MPI_Gatherv(idx,NN,MPIU_SCALAR,0,0,0,MPIU_SCALAR,0,comm);
805: } else {
806: PetscMalloc(size*sizeof(PetscMPIInt),&sizes);
807: MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
808: Ntotal = sizes[0];
809: PetscMalloc(size*sizeof(PetscMPIInt),&displs);
810: displs[0] = 0;
811: for (i=1; i<size; i++) {
812: Ntotal += sizes[i];
813: displs[i] = displs[i-1] + sizes[i-1];
814: }
815: PetscMalloc(Ntotal*sizeof(PetscScalar),&array);
816: MPI_Gatherv(idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);
817: PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR,PETSC_TRUE);
818: PetscFree(sizes);
819: PetscFree(displs);
820: PetscFree(array);
821: }
822: } else {
823: PetscViewerBinaryWrite(viewer,idx,N,PETSC_SCALAR,PETSC_FALSE);
824: }
825: } else {
826: const char *tname;
827: PetscObjectGetName((PetscObject)viewer,&tname);
828: SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
829: }
830: return(0);
831: }