Actual source code: err.c
petsc-3.7.5 2017-01-01
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>
8: typedef struct _EH *EH;
9: struct _EH {
10: PetscErrorCode (*handler)(MPI_Comm,int,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*);
11: void *ctx;
12: EH previous;
13: };
15: static EH eh = 0;
19: /*@C
20: PetscEmacsClientErrorHandler - Error handler that uses the emacsclient program to
21: load the file where the error occured. Then calls the "previous" error handler.
23: Not Collective
25: Input Parameters:
26: + comm - communicator over which error occured
27: . line - the line number of the error (indicated by __LINE__)
28: . func - the function where error is detected (indicated by __FUNCT__)
29: . file - the file in which the error was detected (indicated by __FILE__)
30: . mess - an error text string, usually just printed to the screen
31: . n - the generic error number
32: . p - specific error number
33: - ctx - error handler context
35: Options Database Key:
36: . -on_error_emacs <machinename>
38: Level: developer
40: Notes:
41: You must put (server-start) in your .emacs file for the emacsclient software to work
43: Most users need not directly employ this routine and the other error
44: handlers, but can instead use the simplified interface SETERRQ, which has
45: the calling sequence
46: $ SETERRQ(PETSC_COMM_SELF,number,p,mess)
48: Notes for experienced users:
49: Use PetscPushErrorHandler() to set the desired error handler.
51: Developer Note: Since this is an error handler it cannot call CHKERRQ(); thus we just return if an error is detected.
53: Concepts: emacs^going to on error
54: Concepts: error handler^going to line in emacs
56: .seealso: PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(),
57: PetscAbortErrorHandler()
58: @*/
59: PetscErrorCode PetscEmacsClientErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx)
60: {
62: char command[PETSC_MAX_PATH_LEN];
63: const char *pdir;
64: FILE *fp;
65: int rval;
68: PetscGetPetscDir(&pdir);if (ierr) PetscFunctionReturn(ierr);
69: sprintf(command,"cd %s; emacsclient --no-wait +%d %s\n",pdir,line,file);
70: #if defined(PETSC_HAVE_POPEN)
71: PetscPOpen(MPI_COMM_WORLD,(char*)ctx,command,"r",&fp);if (ierr) PetscFunctionReturn(ierr);
72: PetscPClose(MPI_COMM_WORLD,fp,&rval);if (ierr) PetscFunctionReturn(ierr);
73: #else
74: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP_SYS,"Cannot run external programs on this machine");
75: #endif
76: PetscPopErrorHandler();if (ierr) PetscFunctionReturn(ierr); /* remove this handler from the stack of handlers */
77: if (!eh) {
78: PetscTraceBackErrorHandler(comm,line,fun,file,n,p,mess,0);if (ierr) PetscFunctionReturn(ierr);
79: } else {
80: (*eh->handler)(comm,line,fun,file,n,p,mess,eh->ctx);if (ierr) PetscFunctionReturn(ierr);
81: }
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(MPI_Comm comm,int line,char *func,char *file,PetscErrorCode n,int p,char *mess,void *ctx);
100: + comm - communicator over which error occured
101: . line - the line number of the error (indicated by __LINE__)
102: . func - the function where the error occured (indicated by __FUNCT__)
103: . file - the file in which the error was detected (indicated by __FILE__)
104: . n - the generic error number (see list defined in include/petscerror.h)
105: . p - PETSC_ERROR_INITIAL if error just detected, otherwise PETSC_ERROR_REPEAT
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 currently available PETSc error handlers include PetscTraceBackErrorHandler(),
117: PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscMPIAbortErrorHandler(), PetscReturnErrorHandler().
119: Fortran Notes: You can only push one error handler from Fortran before poping it.
121: .seealso: PetscPopErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), PetscTraceBackErrorHandler(), PetscPushSignalHandler()
123: @*/
124: PetscErrorCode PetscPushErrorHandler(PetscErrorCode (*handler)(MPI_Comm comm,int,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*),void *ctx)
125: {
126: EH neweh;
130: PetscNew(&neweh);
131: if (eh) neweh->previous = eh;
132: else neweh->previous = 0;
133: neweh->handler = handler;
134: neweh->ctx = ctx;
135: eh = neweh;
136: return(0);
137: }
141: /*@
142: PetscPopErrorHandler - Removes the latest error handler that was
143: pushed with PetscPushErrorHandler().
145: Not Collective
147: Level: intermediate
149: Concepts: error handler^setting
151: .seealso: PetscPushErrorHandler()
152: @*/
153: PetscErrorCode PetscPopErrorHandler(void)
154: {
155: EH tmp;
159: if (!eh) return(0);
160: tmp = eh;
161: eh = eh->previous;
162: PetscFree(tmp);
163: return(0);
164: }
168: /*@C
169: PetscReturnErrorHandler - Error handler that causes a return to the current
170: level.
172: Not Collective
174: Input Parameters:
175: + comm - communicator over which error occurred
176: . line - the line number of the error (indicated by __LINE__)
177: . func - the function where error is detected (indicated by __FUNCT__)
178: . file - the file in which the error was detected (indicated by __FILE__)
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(comm,number,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(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType 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: http://www.mcs.anl.gov/petsc/documentation/faq.html#valgrind",
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: /*70 */ "Attempt to use a pointer that does not point to a valid accessible location",
234: /*71 */ "Zero pivot in LU factorization: http://www.mcs.anl.gov/petsc/documentation/faq.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: http://www.mcs.anl.gov/petsc/documentation/installation.html#valgrind",
242: "Unexpected data in file",
243: /*80 */ "Arguments must have same communicators",
244: /*81 */ "Zero pivot in Cholesky factorization: http://www.mcs.anl.gov/petsc/documentation/faq.html#zeropivot",
245: " ",
246: " ",
247: "Overflow in integer operation: http://www.mcs.anl.gov/petsc/documentation/faq.html#64-bit-indices",
248: /*85 */ "Null argument, when expecting valid pointer",
249: /*86 */ "Unknown type. Check for miss-spelling or missing package: http://www.mcs.anl.gov/petsc/documentation/installation.html#external",
250: /*87 */ "Not used",
251: /*88 */ "Error in system call",
252: /*89 */ "Object Type not set: http://www.mcs.anl.gov/petsc/documentation/faq.html#objecttypenotset"
253: /*90 */ " ",
254: /* */ " ",
255: /* */ " ",
256: /*93 */ "See http://www.mcs.anl.gov/petsc/documentation/linearsolvertable.html for possible LU and Cholesky solvers",
257: /* */ "You cannot overwrite this option since that will conflict with other previously set options",
258: /* */ " ",
259: /*96 */ " ",
260: };
264: /*@C
265: PetscErrorMessage - returns the text string associated with a PETSc error code.
267: Not Collective
269: Input Parameter:
270: . errnum - the error code
272: Output Parameter:
273: + text - the error message (NULL if not desired)
274: - specific - the specific error message that was set with SETERRxxx() or PetscError(). (NULL if not desired)
276: Level: developer
278: Concepts: error handler^messages
280: .seealso: PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(),
281: PetscAbortErrorHandler(), PetscTraceBackErrorHandler()
282: @*/
283: PetscErrorCode PetscErrorMessage(int errnum,const char *text[],char **specific)
284: {
286: if (text && errnum > PETSC_ERR_MIN_VALUE && errnum < PETSC_ERR_MAX_VALUE) *text = PetscErrorStrings[errnum-PETSC_ERR_MIN_VALUE-1];
287: else if (text) *text = 0;
289: if (specific) *specific = PetscErrorBaseMessage;
290: return(0);
291: }
293: #if defined(PETSC_CLANGUAGE_CXX)
294: /* C++ exceptions are formally not allowed to propagate through extern "C" code. In practice, far too much software
295: * would be broken if implementations did not handle it it some common cases. However, keep in mind
296: *
297: * Rule 62. Don't allow exceptions to propagate across module boundaries
298: *
299: * in "C++ Coding Standards" by Sutter and Alexandrescu. (This accounts for part of the ongoing C++ binary interface
300: * instability.) Having PETSc raise errors as C++ exceptions was probably misguided and should eventually be removed.
301: *
302: * Here is the problem: You have a C++ function call a PETSc function, and you would like to maintain the error message
303: * and stack information from the PETSc error. You could make everyone write exactly this code in their C++, but that
304: * seems crazy to me.
305: */
306: #include <sstream>
307: #include <stdexcept>
308: static void PetscCxxErrorThrow() {
309: const char *str;
310: if (eh && eh->ctx) {
311: std::ostringstream *msg;
312: msg = (std::ostringstream*) eh->ctx;
313: str = msg->str().c_str();
314: } else str = "Error detected in C PETSc";
316: throw std::runtime_error(str);
317: }
318: #endif
322: /*@C
323: PetscError - Routine that is called when an error has been detected,
324: usually called through the macro SETERRQ(PETSC_COMM_SELF,).
326: Not Collective
328: Input Parameters:
329: + comm - communicator over which error occurred. ALL ranks of this communicator MUST call this routine
330: . line - the line number of the error (indicated by __LINE__)
331: . func - the function where the error occured (indicated by __FUNCT__)
332: . file - the file in which the error was detected (indicated by __FILE__)
333: . mess - an error text string, usually just printed to the screen
334: . n - the generic error number
335: . p - PETSC_ERROR_INITIAL indicates the error was initially detected, PETSC_ERROR_REPEAT indicates this is a traceback from a previously detected error
336: - mess - formatted message string - aka printf
338: Level: intermediate
340: Notes:
341: Most users need not directly use this routine and the error handlers, but
342: can instead use the simplified interface SETERRQ, which has the calling
343: sequence
344: $ SETERRQ(comm,n,mess)
346: Experienced users can set the error handler with PetscPushErrorHandler().
348: Developer Note: Since this is called after an error condition it should not be calling any error handlers (currently it ignores any error codes)
349: 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
350: but this annoying.
352: Concepts: error^setting condition
354: .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2()
355: @*/
356: PetscErrorCode PetscError(MPI_Comm comm,int line,const char *func,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,...)
357: {
358: va_list Argp;
359: size_t fullLength;
360: char buf[2048],*lbuf = 0;
361: PetscBool ismain,isunknown;
365: if (!func) func = "User provided function";
366: if (!file) file = "User file";
367: if (comm == MPI_COMM_NULL) comm = PETSC_COMM_SELF;
369: /* Compose the message evaluating the print format */
370: if (mess) {
371: va_start(Argp,mess);
372: PetscVSNPrintf(buf,2048,mess,&fullLength,Argp);
373: va_end(Argp);
374: lbuf = buf;
375: if (p == 1) PetscStrncpy(PetscErrorBaseMessage,lbuf,1023);
376: }
378: if (!eh) PetscTraceBackErrorHandler(comm,line,func,file,n,p,lbuf,0);
379: else (*eh->handler)(comm,line,func,file,n,p,lbuf,eh->ctx);
381: /*
382: If this is called from the main() routine we call MPI_Abort() instead of
383: return to allow the parallel program to be properly shutdown.
385: Since this is in the error handler we don't check the errors below. Of course,
386: PetscStrncmp() does its own error checking which is problamatic
387: */
388: PetscStrncmp(func,"main",4,&ismain);
389: PetscStrncmp(func,"unknown",7,&isunknown);
390: if (ismain || isunknown) MPI_Abort(PETSC_COMM_WORLD,(int)ierr);
392: #if defined(PETSC_CLANGUAGE_CXX)
393: if (p == PETSC_ERROR_IN_CXX) {
394: PetscCxxErrorThrow();
395: }
396: #endif
397: PetscFunctionReturn(ierr);
398: }
400: /* -------------------------------------------------------------------------*/
404: /*@C
405: PetscIntView - Prints an array of integers; useful for debugging.
407: Collective on PetscViewer
409: Input Parameters:
410: + N - number of integers in array
411: . idx - array of integers
412: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
414: Level: intermediate
416: Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done
418: .seealso: PetscRealView()
419: @*/
420: PetscErrorCode PetscIntView(PetscInt N,const PetscInt idx[],PetscViewer viewer)
421: {
423: PetscInt j,i,n = N/20,p = N % 20;
424: PetscBool iascii,isbinary;
425: MPI_Comm comm;
428: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
431: PetscObjectGetComm((PetscObject)viewer,&comm);
433: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
434: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
435: if (iascii) {
436: PetscViewerASCIIPushSynchronized(viewer);
437: for (i=0; i<n; i++) {
438: PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*i);
439: for (j=0; j<20; j++) {
440: PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[i*20+j]);
441: }
442: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
443: }
444: if (p) {
445: PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*n);
446: for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[20*n+i]);}
447: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
448: }
449: PetscViewerFlush(viewer);
450: PetscViewerASCIIPopSynchronized(viewer);
451: } else if (isbinary) {
452: PetscMPIInt rank,size,*sizes,Ntotal,*displs,NN;
453: PetscInt *array;
455: PetscMPIIntCast(N,&NN);
456: MPI_Comm_rank(comm,&rank);
457: MPI_Comm_size(comm,&size);
459: if (size > 1) {
460: if (rank) {
461: MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
462: MPI_Gatherv((void*)idx,NN,MPIU_INT,0,0,0,MPIU_INT,0,comm);
463: } else {
464: PetscMalloc1(size,&sizes);
465: MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
466: Ntotal = sizes[0];
467: PetscMalloc1(size,&displs);
468: displs[0] = 0;
469: for (i=1; i<size; i++) {
470: Ntotal += sizes[i];
471: displs[i] = displs[i-1] + sizes[i-1];
472: }
473: PetscMalloc1(Ntotal,&array);
474: MPI_Gatherv((void*)idx,NN,MPIU_INT,array,sizes,displs,MPIU_INT,0,comm);
475: PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_INT,PETSC_TRUE);
476: PetscFree(sizes);
477: PetscFree(displs);
478: PetscFree(array);
479: }
480: } else {
481: PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_INT,PETSC_FALSE);
482: }
483: } else {
484: const char *tname;
485: PetscObjectGetName((PetscObject)viewer,&tname);
486: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
487: }
488: return(0);
489: }
493: /*@C
494: PetscRealView - Prints an array of doubles; useful for debugging.
496: Collective on PetscViewer
498: Input Parameters:
499: + N - number of PetscReal in array
500: . idx - array of PetscReal
501: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
503: Level: intermediate
505: Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done
507: .seealso: PetscIntView()
508: @*/
509: PetscErrorCode PetscRealView(PetscInt N,const PetscReal idx[],PetscViewer viewer)
510: {
512: PetscInt j,i,n = N/5,p = N % 5;
513: PetscBool iascii,isbinary;
514: MPI_Comm comm;
517: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
520: PetscObjectGetComm((PetscObject)viewer,&comm);
522: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
523: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
524: if (iascii) {
525: PetscViewerASCIIPushSynchronized(viewer);
526: for (i=0; i<n; i++) {
527: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",(int)5*i);
528: for (j=0; j<5; j++) {
529: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*5+j]);
530: }
531: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
532: }
533: if (p) {
534: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",(int)5*n);
535: for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[5*n+i]);}
536: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
537: }
538: PetscViewerFlush(viewer);
539: PetscViewerASCIIPopSynchronized(viewer);
540: } else if (isbinary) {
541: PetscMPIInt rank,size,*sizes,*displs, Ntotal,NN;
542: PetscReal *array;
544: PetscMPIIntCast(N,&NN);
545: MPI_Comm_rank(comm,&rank);
546: MPI_Comm_size(comm,&size);
548: if (size > 1) {
549: if (rank) {
550: MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
551: MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,0,0,0,MPIU_REAL,0,comm);
552: } else {
553: PetscMalloc1(size,&sizes);
554: MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
555: Ntotal = sizes[0];
556: PetscMalloc1(size,&displs);
557: displs[0] = 0;
558: for (i=1; i<size; i++) {
559: Ntotal += sizes[i];
560: displs[i] = displs[i-1] + sizes[i-1];
561: }
562: PetscMalloc1(Ntotal,&array);
563: MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,array,sizes,displs,MPIU_REAL,0,comm);
564: PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_REAL,PETSC_TRUE);
565: PetscFree(sizes);
566: PetscFree(displs);
567: PetscFree(array);
568: }
569: } else {
570: PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_REAL,PETSC_FALSE);
571: }
572: } else {
573: const char *tname;
574: PetscObjectGetName((PetscObject)viewer,&tname);
575: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
576: }
577: return(0);
578: }
582: /*@C
583: PetscScalarView - Prints an array of scalars; useful for debugging.
585: Collective on PetscViewer
587: Input Parameters:
588: + N - number of scalars in array
589: . idx - array of scalars
590: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
592: Level: intermediate
594: Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done
596: .seealso: PetscIntView(), PetscRealView()
597: @*/
598: PetscErrorCode PetscScalarView(PetscInt N,const PetscScalar idx[],PetscViewer viewer)
599: {
601: PetscInt j,i,n = N/3,p = N % 3;
602: PetscBool iascii,isbinary;
603: MPI_Comm comm;
606: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
609: PetscObjectGetComm((PetscObject)viewer,&comm);
611: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
612: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
613: if (iascii) {
614: PetscViewerASCIIPushSynchronized(viewer);
615: for (i=0; i<n; i++) {
616: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);
617: for (j=0; j<3; j++) {
618: #if defined(PETSC_USE_COMPLEX)
619: PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[i*3+j]),(double)PetscImaginaryPart(idx[i*3+j]));
620: #else
621: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*3+j]);
622: #endif
623: }
624: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
625: }
626: if (p) {
627: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);
628: for (i=0; i<p; i++) {
629: #if defined(PETSC_USE_COMPLEX)
630: PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[n*3+i]),(double)PetscImaginaryPart(idx[n*3+i]));
631: #else
632: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[3*n+i]);
633: #endif
634: }
635: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
636: }
637: PetscViewerFlush(viewer);
638: PetscViewerASCIIPopSynchronized(viewer);
639: } else if (isbinary) {
640: PetscMPIInt size,rank,*sizes,Ntotal,*displs,NN;
641: PetscScalar *array;
643: PetscMPIIntCast(N,&NN);
644: MPI_Comm_rank(comm,&rank);
645: MPI_Comm_size(comm,&size);
647: if (size > 1) {
648: if (rank) {
649: MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
650: MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,0,0,0,MPIU_SCALAR,0,comm);
651: } else {
652: PetscMalloc1(size,&sizes);
653: MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
654: Ntotal = sizes[0];
655: PetscMalloc1(size,&displs);
656: displs[0] = 0;
657: for (i=1; i<size; i++) {
658: Ntotal += sizes[i];
659: displs[i] = displs[i-1] + sizes[i-1];
660: }
661: PetscMalloc1(Ntotal,&array);
662: MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);
663: PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR,PETSC_TRUE);
664: PetscFree(sizes);
665: PetscFree(displs);
666: PetscFree(array);
667: }
668: } else {
669: PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_SCALAR,PETSC_FALSE);
670: }
671: } else {
672: const char *tname;
673: PetscObjectGetName((PetscObject)viewer,&tname);
674: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
675: }
676: return(0);
677: }