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