Actual source code: err.c
petsc-3.10.5 2019-03-28
2: /*
3: Code that allows one to set the error handlers
4: */
5: #include <petsc/private/petscimpl.h>
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;
17: /*@C
18: PetscEmacsClientErrorHandler - Error handler that uses the emacsclient program to
19: load the file where the error occured. Then calls the "previous" error handler.
21: Not Collective
23: Input Parameters:
24: + comm - communicator over which error occured
25: . line - the line number of the error (indicated by __LINE__)
26: . file - the file in which the error was detected (indicated by __FILE__)
27: . mess - an error text string, usually just printed to the screen
28: . n - the generic error number
29: . p - specific error number
30: - ctx - error handler context
32: Options Database Key:
33: . -on_error_emacs <machinename>
35: Level: developer
37: Notes:
38: You must put (server-start) in your .emacs file for the emacsclient software to work
40: Most users need not directly employ this routine and the other error
41: handlers, but can instead use the simplified interface SETERRQ, which has
42: the calling sequence
43: $ SETERRQ(PETSC_COMM_SELF,number,p,mess)
45: Notes for experienced users:
46: Use PetscPushErrorHandler() to set the desired error handler.
48: Developer Note: Since this is an error handler it cannot call CHKERRQ(); thus we just return if an error is detected.
50: Concepts: emacs^going to on error
51: Concepts: error handler^going to line in emacs
53: .seealso: PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(),
54: PetscAbortErrorHandler()
55: @*/
56: PetscErrorCode PetscEmacsClientErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx)
57: {
59: char command[PETSC_MAX_PATH_LEN];
60: const char *pdir;
61: FILE *fp;
64: PetscGetPetscDir(&pdir);if (ierr) PetscFunctionReturn(ierr);
65: sprintf(command,"cd %s; emacsclient --no-wait +%d %s\n",pdir,line,file);
66: #if defined(PETSC_HAVE_POPEN)
67: PetscPOpen(MPI_COMM_WORLD,(char*)ctx,command,"r",&fp);if (ierr) PetscFunctionReturn(ierr);
68: PetscPClose(MPI_COMM_WORLD,fp);if (ierr) PetscFunctionReturn(ierr);
69: #else
70: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP_SYS,"Cannot run external programs on this machine");
71: #endif
72: PetscPopErrorHandler();if (ierr) PetscFunctionReturn(ierr); /* remove this handler from the stack of handlers */
73: if (!eh) {
74: PetscTraceBackErrorHandler(comm,line,fun,file,n,p,mess,0);if (ierr) PetscFunctionReturn(ierr);
75: } else {
76: (*eh->handler)(comm,line,fun,file,n,p,mess,eh->ctx);if (ierr) PetscFunctionReturn(ierr);
77: }
78: PetscFunctionReturn(ierr);
79: }
81: /*@C
82: PetscPushErrorHandler - Sets a routine to be called on detection of errors.
84: Not Collective
86: Input Parameters:
87: + handler - error handler routine
88: - ctx - optional handler context that contains information needed by the handler (for
89: example file pointers for error messages etc.)
91: Calling sequence of handler:
92: $ int handler(MPI_Comm comm,int line,char *func,char *file,PetscErrorCode n,int p,char *mess,void *ctx);
94: + comm - communicator over which error occured
95: . line - the line number of the error (indicated by __LINE__)
96: . file - the file in which the error was detected (indicated by __FILE__)
97: . n - the generic error number (see list defined in include/petscerror.h)
98: . p - PETSC_ERROR_INITIAL if error just detected, otherwise PETSC_ERROR_REPEAT
99: . mess - an error text string, usually just printed to the screen
100: - ctx - the error handler context
102: Options Database Keys:
103: + -on_error_attach_debugger <noxterm,gdb or dbx>
104: - -on_error_abort
106: Level: intermediate
108: Notes:
109: The currently available PETSc error handlers include PetscTraceBackErrorHandler(),
110: PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscMPIAbortErrorHandler(), PetscReturnErrorHandler().
112: Fortran Notes:
113: You can only push one error handler from Fortran before poping it.
115: .seealso: PetscPopErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), PetscTraceBackErrorHandler(), PetscPushSignalHandler()
117: @*/
118: PetscErrorCode PetscPushErrorHandler(PetscErrorCode (*handler)(MPI_Comm comm,int,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*),void *ctx)
119: {
120: EH neweh;
124: PetscNew(&neweh);
125: if (eh) neweh->previous = eh;
126: else neweh->previous = 0;
127: neweh->handler = handler;
128: neweh->ctx = ctx;
129: eh = neweh;
130: return(0);
131: }
133: /*@
134: PetscPopErrorHandler - Removes the latest error handler that was
135: pushed with PetscPushErrorHandler().
137: Not Collective
139: Level: intermediate
141: Concepts: error handler^setting
143: .seealso: PetscPushErrorHandler()
144: @*/
145: PetscErrorCode PetscPopErrorHandler(void)
146: {
147: EH tmp;
151: if (!eh) return(0);
152: tmp = eh;
153: eh = eh->previous;
154: PetscFree(tmp);
155: return(0);
156: }
158: /*@C
159: PetscReturnErrorHandler - Error handler that causes a return to the current
160: level.
162: Not Collective
164: Input Parameters:
165: + comm - communicator over which error occurred
166: . line - the line number of the error (indicated by __LINE__)
167: . file - the file in which the error was detected (indicated by __FILE__)
168: . mess - an error text string, usually just printed to the screen
169: . n - the generic error number
170: . p - specific error number
171: - ctx - error handler context
173: Level: developer
175: Notes:
176: Most users need not directly employ this routine and the other error
177: handlers, but can instead use the simplified interface SETERRQ, which has
178: the calling sequence
179: $ SETERRQ(comm,number,mess)
181: Notes for experienced users:
182: This routine is good for catching errors such as zero pivots in preconditioners
183: or breakdown of iterative methods. It is not appropriate for memory violations
184: and similar errors.
186: Use PetscPushErrorHandler() to set the desired error handler. The
187: currently available PETSc error handlers include PetscTraceBackErrorHandler(),
188: PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscAbortErrorHandler()
190: Concepts: error handler
192: .seealso: PetscPushErrorHandler(), PetscPopErrorHandler().
193: @*/
195: PetscErrorCode PetscReturnErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx)
196: {
198: PetscFunctionReturn(n);
199: }
201: static char PetscErrorBaseMessage[1024];
202: /*
203: The numerical values for these are defined in include/petscerror.h; any changes
204: there must also be made here
205: */
206: static const char *PetscErrorStrings[] = {
207: /*55 */ "Out of memory",
208: "No support for this operation for this object type",
209: "No support for this operation on this system",
210: /*58 */ "Operation done in wrong order",
211: /*59 */ "Signal received",
212: /*60 */ "Nonconforming object sizes",
213: "Argument aliasing not permitted",
214: "Invalid argument",
215: /*63 */ "Argument out of range",
216: "Corrupt argument: http://www.mcs.anl.gov/petsc/documentation/faq.html#valgrind",
217: "Unable to open file",
218: "Read from file failed",
219: "Write to file failed",
220: "Invalid pointer",
221: /*69 */ "Arguments must have same type",
222: /*70 */ "Attempt to use a pointer that does not point to a valid accessible location",
223: /*71 */ "Zero pivot in LU factorization: http://www.mcs.anl.gov/petsc/documentation/faq.html#zeropivot",
224: /*72 */ "Floating point exception",
225: /*73 */ "Object is in wrong state",
226: "Corrupted Petsc object",
227: "Arguments are incompatible",
228: "Error in external library",
229: /*77 */ "Petsc has generated inconsistent data",
230: "Memory corruption: http://www.mcs.anl.gov/petsc/documentation/installation.html#valgrind",
231: "Unexpected data in file",
232: /*80 */ "Arguments must have same communicators",
233: /*81 */ "Zero pivot in Cholesky factorization: http://www.mcs.anl.gov/petsc/documentation/faq.html#zeropivot",
234: " ",
235: " ",
236: "Overflow in integer operation: http://www.mcs.anl.gov/petsc/documentation/faq.html#64-bit-indices",
237: /*85 */ "Null argument, when expecting valid pointer",
238: /*86 */ "Unknown type. Check for miss-spelling or missing package: http://www.mcs.anl.gov/petsc/documentation/installation.html#external",
239: /*87 */ "MPI library at runtime is not compatible with MPI used at compile time",
240: /*88 */ "Error in system call",
241: /*89 */ "Object Type not set: http://www.mcs.anl.gov/petsc/documentation/faq.html#objecttypenotset"
242: /*90 */ " ",
243: /* */ " ",
244: /* */ " ",
245: /*93 */ "See http://www.mcs.anl.gov/petsc/documentation/linearsolvertable.html for possible LU and Cholesky solvers",
246: /* */ "You cannot overwrite this option since that will conflict with other previously set options",
247: /* */ " ",
248: /*96 */ " ",
249: };
251: /*@C
252: PetscErrorMessage - returns the text string associated with a PETSc error code.
254: Not Collective
256: Input Parameter:
257: . errnum - the error code
259: Output Parameter:
260: + text - the error message (NULL if not desired)
261: - specific - the specific error message that was set with SETERRxxx() or PetscError(). (NULL if not desired)
263: Level: developer
265: Concepts: error handler^messages
267: .seealso: PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscError(), SETERRQ(), CHKERRQ()
268: PetscAbortErrorHandler(), PetscTraceBackErrorHandler()
269: @*/
270: PetscErrorCode PetscErrorMessage(int errnum,const char *text[],char **specific)
271: {
273: if (text && errnum > PETSC_ERR_MIN_VALUE && errnum < PETSC_ERR_MAX_VALUE) *text = PetscErrorStrings[errnum-PETSC_ERR_MIN_VALUE-1];
274: else if (text) *text = 0;
276: if (specific) *specific = PetscErrorBaseMessage;
277: return(0);
278: }
280: #if defined(PETSC_CLANGUAGE_CXX)
281: /* C++ exceptions are formally not allowed to propagate through extern "C" code. In practice, far too much software
282: * would be broken if implementations did not handle it it some common cases. However, keep in mind
283: *
284: * Rule 62. Don't allow exceptions to propagate across module boundaries
285: *
286: * in "C++ Coding Standards" by Sutter and Alexandrescu. (This accounts for part of the ongoing C++ binary interface
287: * instability.) Having PETSc raise errors as C++ exceptions was probably misguided and should eventually be removed.
288: *
289: * Here is the problem: You have a C++ function call a PETSc function, and you would like to maintain the error message
290: * and stack information from the PETSc error. You could make everyone write exactly this code in their C++, but that
291: * seems crazy to me.
292: */
293: #include <sstream>
294: #include <stdexcept>
295: static void PetscCxxErrorThrow() {
296: const char *str;
297: if (eh && eh->ctx) {
298: std::ostringstream *msg;
299: msg = (std::ostringstream*) eh->ctx;
300: str = msg->str().c_str();
301: } else str = "Error detected in C PETSc";
303: throw std::runtime_error(str);
304: }
305: #endif
307: /*@C
308: PetscError - Routine that is called when an error has been detected,
309: usually called through the macro SETERRQ(PETSC_COMM_SELF,).
311: Not Collective
313: Input Parameters:
314: + comm - communicator over which error occurred. ALL ranks of this communicator MUST call this routine
315: . line - the line number of the error (indicated by __LINE__)
316: . func - the function name in which the error was detected
317: . file - the file in which the error was detected (indicated by __FILE__)
318: . n - the generic error number
319: . p - PETSC_ERROR_INITIAL indicates the error was initially detected, PETSC_ERROR_REPEAT indicates this is a traceback from a previously detected error
320: - mess - formatted message string - aka printf
322: Level: intermediate
324: Notes:
325: Most users need not directly use this routine and the error handlers, but
326: can instead use the simplified interface SETERRQ, which has the calling
327: sequence
328: $ SETERRQ(comm,n,mess)
330: Fortran Note:
331: This routine is used differently from Fortran
332: $ PetscError(MPI_Comm comm,PetscErrorCode n,PetscErrorType p,char *message)
334: Experienced users can set the error handler with PetscPushErrorHandler().
336: Developer Note: Since this is called after an error condition it should not be calling any error handlers (currently it ignores any error codes)
337: 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
338: but this annoying.
340: Concepts: error^setting condition
342: .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2(), PetscErrorMessage()
343: @*/
344: PetscErrorCode PetscError(MPI_Comm comm,int line,const char *func,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,...)
345: {
346: va_list Argp;
347: size_t fullLength;
348: char buf[2048],*lbuf = 0;
349: PetscBool ismain;
353: if (!func) func = "User provided function";
354: if (!file) file = "User file";
355: if (comm == MPI_COMM_NULL) comm = PETSC_COMM_SELF;
357: /* Compose the message evaluating the print format */
358: if (mess) {
359: va_start(Argp,mess);
360: PetscVSNPrintf(buf,2048,mess,&fullLength,Argp);
361: va_end(Argp);
362: lbuf = buf;
363: if (p == PETSC_ERROR_INITIAL) PetscStrncpy(PetscErrorBaseMessage,lbuf,1023);
364: }
366: if (!eh) PetscTraceBackErrorHandler(comm,line,func,file,n,p,lbuf,0);
367: else (*eh->handler)(comm,line,func,file,n,p,lbuf,eh->ctx);
369: /*
370: If this is called from the main() routine we call MPI_Abort() instead of
371: return to allow the parallel program to be properly shutdown.
373: Since this is in the error handler we don't check the errors below. Of course,
374: PetscStrncmp() does its own error checking which is problamatic
375: */
376: PetscStrncmp(func,"main",4,&ismain);
377: if (ismain) MPI_Abort(PETSC_COMM_WORLD,(int)ierr);
379: #if defined(PETSC_CLANGUAGE_CXX)
380: if (p == PETSC_ERROR_IN_CXX) {
381: PetscCxxErrorThrow();
382: }
383: #endif
384: PetscFunctionReturn(ierr);
385: }
387: /* -------------------------------------------------------------------------*/
389: /*@C
390: PetscIntView - Prints an array of integers; useful for debugging.
392: Collective on PetscViewer
394: Input Parameters:
395: + N - number of integers in array
396: . idx - array of integers
397: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
399: Level: intermediate
401: Developer Notes:
402: idx cannot be const because may be passed to binary viewer where byte swapping is done
404: .seealso: PetscRealView()
405: @*/
406: PetscErrorCode PetscIntView(PetscInt N,const PetscInt idx[],PetscViewer viewer)
407: {
409: PetscInt j,i,n = N/20,p = N % 20;
410: PetscBool iascii,isbinary;
411: MPI_Comm comm;
414: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
417: PetscObjectGetComm((PetscObject)viewer,&comm);
419: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
420: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
421: if (iascii) {
422: PetscViewerASCIIPushSynchronized(viewer);
423: for (i=0; i<n; i++) {
424: PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*i);
425: for (j=0; j<20; j++) {
426: PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[i*20+j]);
427: }
428: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
429: }
430: if (p) {
431: PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*n);
432: for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[20*n+i]);}
433: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
434: }
435: PetscViewerFlush(viewer);
436: PetscViewerASCIIPopSynchronized(viewer);
437: } else if (isbinary) {
438: PetscMPIInt rank,size,*sizes,Ntotal,*displs,NN;
439: PetscInt *array;
441: PetscMPIIntCast(N,&NN);
442: MPI_Comm_rank(comm,&rank);
443: MPI_Comm_size(comm,&size);
445: if (size > 1) {
446: if (rank) {
447: MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
448: MPI_Gatherv((void*)idx,NN,MPIU_INT,0,0,0,MPIU_INT,0,comm);
449: } else {
450: PetscMalloc1(size,&sizes);
451: MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
452: Ntotal = sizes[0];
453: PetscMalloc1(size,&displs);
454: displs[0] = 0;
455: for (i=1; i<size; i++) {
456: Ntotal += sizes[i];
457: displs[i] = displs[i-1] + sizes[i-1];
458: }
459: PetscMalloc1(Ntotal,&array);
460: MPI_Gatherv((void*)idx,NN,MPIU_INT,array,sizes,displs,MPIU_INT,0,comm);
461: PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_INT,PETSC_TRUE);
462: PetscFree(sizes);
463: PetscFree(displs);
464: PetscFree(array);
465: }
466: } else {
467: PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_INT,PETSC_FALSE);
468: }
469: } else {
470: const char *tname;
471: PetscObjectGetName((PetscObject)viewer,&tname);
472: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
473: }
474: return(0);
475: }
477: /*@C
478: PetscRealView - Prints an array of doubles; useful for debugging.
480: Collective on PetscViewer
482: Input Parameters:
483: + N - number of PetscReal in array
484: . idx - array of PetscReal
485: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
487: Level: intermediate
489: Developer Notes:
490: idx cannot be const because may be passed to binary viewer where byte swapping is done
492: .seealso: PetscIntView()
493: @*/
494: PetscErrorCode PetscRealView(PetscInt N,const PetscReal idx[],PetscViewer viewer)
495: {
497: PetscInt j,i,n = N/5,p = N % 5;
498: PetscBool iascii,isbinary;
499: MPI_Comm comm;
502: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
505: PetscObjectGetComm((PetscObject)viewer,&comm);
507: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
508: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
509: if (iascii) {
510: PetscViewerASCIIPushSynchronized(viewer);
511: for (i=0; i<n; i++) {
512: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",(int)5*i);
513: for (j=0; j<5; j++) {
514: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*5+j]);
515: }
516: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
517: }
518: if (p) {
519: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",(int)5*n);
520: for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[5*n+i]);}
521: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
522: }
523: PetscViewerFlush(viewer);
524: PetscViewerASCIIPopSynchronized(viewer);
525: } else if (isbinary) {
526: PetscMPIInt rank,size,*sizes,*displs, Ntotal,NN;
527: PetscReal *array;
529: PetscMPIIntCast(N,&NN);
530: MPI_Comm_rank(comm,&rank);
531: MPI_Comm_size(comm,&size);
533: if (size > 1) {
534: if (rank) {
535: MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
536: MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,0,0,0,MPIU_REAL,0,comm);
537: } else {
538: PetscMalloc1(size,&sizes);
539: MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
540: Ntotal = sizes[0];
541: PetscMalloc1(size,&displs);
542: displs[0] = 0;
543: for (i=1; i<size; i++) {
544: Ntotal += sizes[i];
545: displs[i] = displs[i-1] + sizes[i-1];
546: }
547: PetscMalloc1(Ntotal,&array);
548: MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,array,sizes,displs,MPIU_REAL,0,comm);
549: PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_REAL,PETSC_TRUE);
550: PetscFree(sizes);
551: PetscFree(displs);
552: PetscFree(array);
553: }
554: } else {
555: PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_REAL,PETSC_FALSE);
556: }
557: } else {
558: const char *tname;
559: PetscObjectGetName((PetscObject)viewer,&tname);
560: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
561: }
562: return(0);
563: }
565: /*@C
566: PetscScalarView - Prints an array of scalars; useful for debugging.
568: Collective on PetscViewer
570: Input Parameters:
571: + N - number of scalars in array
572: . idx - array of scalars
573: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
575: Level: intermediate
577: Developer Notes:
578: idx cannot be const because may be passed to binary viewer where byte swapping is done
580: .seealso: PetscIntView(), PetscRealView()
581: @*/
582: PetscErrorCode PetscScalarView(PetscInt N,const PetscScalar idx[],PetscViewer viewer)
583: {
585: PetscInt j,i,n = N/3,p = N % 3;
586: PetscBool iascii,isbinary;
587: MPI_Comm comm;
590: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
593: PetscObjectGetComm((PetscObject)viewer,&comm);
595: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
596: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
597: if (iascii) {
598: PetscViewerASCIIPushSynchronized(viewer);
599: for (i=0; i<n; i++) {
600: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);
601: for (j=0; j<3; j++) {
602: #if defined(PETSC_USE_COMPLEX)
603: PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[i*3+j]),(double)PetscImaginaryPart(idx[i*3+j]));
604: #else
605: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*3+j]);
606: #endif
607: }
608: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
609: }
610: if (p) {
611: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);
612: for (i=0; i<p; i++) {
613: #if defined(PETSC_USE_COMPLEX)
614: PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[n*3+i]),(double)PetscImaginaryPart(idx[n*3+i]));
615: #else
616: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[3*n+i]);
617: #endif
618: }
619: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
620: }
621: PetscViewerFlush(viewer);
622: PetscViewerASCIIPopSynchronized(viewer);
623: } else if (isbinary) {
624: PetscMPIInt size,rank,*sizes,Ntotal,*displs,NN;
625: PetscScalar *array;
627: PetscMPIIntCast(N,&NN);
628: MPI_Comm_rank(comm,&rank);
629: MPI_Comm_size(comm,&size);
631: if (size > 1) {
632: if (rank) {
633: MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
634: MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,0,0,0,MPIU_SCALAR,0,comm);
635: } else {
636: PetscMalloc1(size,&sizes);
637: MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
638: Ntotal = sizes[0];
639: PetscMalloc1(size,&displs);
640: displs[0] = 0;
641: for (i=1; i<size; i++) {
642: Ntotal += sizes[i];
643: displs[i] = displs[i-1] + sizes[i-1];
644: }
645: PetscMalloc1(Ntotal,&array);
646: MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);
647: PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR,PETSC_TRUE);
648: PetscFree(sizes);
649: PetscFree(displs);
650: PetscFree(array);
651: }
652: } else {
653: PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_SCALAR,PETSC_FALSE);
654: }
655: } else {
656: const char *tname;
657: PetscObjectGetName((PetscObject)viewer,&tname);
658: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
659: }
660: return(0);
661: }