Actual source code: err.c
petsc-3.4.5 2014-06-29
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*,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: . dir - the directory of the file (indicated by __SDIR__)
31: . mess - an error text string, usually just printed to the screen
32: . n - the generic error number
33: . p - specific error number
34: - ctx - error handler context
36: Options Database Key:
37: . -on_error_emacs <machinename>
39: Level: developer
41: Notes:
42: You must put (server-start) in your .emacs file for the emacsclient software to work
44: Most users need not directly employ this routine and the other error
45: handlers, but can instead use the simplified interface SETERRQ, which has
46: the calling sequence
47: $ SETERRQ(PETSC_COMM_SELF,number,p,mess)
49: Notes for experienced users:
50: Use PetscPushErrorHandler() to set the desired error handler.
52: Developer Note: Since this is an error handler it cannot call CHKERRQ(); thus we just return if an error is detected.
54: Concepts: emacs^going to on error
55: Concepts: error handler^going to line in emacs
57: .seealso: PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(),
58: PetscAbortErrorHandler()
59: @*/
60: PetscErrorCode PetscEmacsClientErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,const char *dir,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx)
61: {
63: char command[PETSC_MAX_PATH_LEN];
64: const char *pdir;
65: FILE *fp;
66: PetscInt rval;
69: PetscGetPetscDir(&pdir);if (ierr) PetscFunctionReturn(ierr);
70: sprintf(command,"cd %s; emacsclient --no-wait +%d %s%s\n",pdir,line,dir,file);
71: #if defined(PETSC_HAVE_POPEN)
72: PetscPOpen(MPI_COMM_WORLD,(char*)ctx,command,"r",&fp);if (ierr) PetscFunctionReturn(ierr);
73: PetscPClose(MPI_COMM_WORLD,fp,&rval);if (ierr) PetscFunctionReturn(ierr);
74: #else
75: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP_SYS,"Cannot run external programs on this machine");
76: #endif
77: PetscPopErrorHandler();if (ierr) PetscFunctionReturn(ierr); /* remove this handler from the stack of handlers */
78: if (!eh) {
79: PetscTraceBackErrorHandler(comm,line,fun,file,dir,n,p,mess,0);if (ierr) PetscFunctionReturn(ierr);
80: } else {
81: (*eh->handler)(comm,line,fun,file,dir,n,p,mess,eh->ctx);if (ierr) PetscFunctionReturn(ierr);
82: }
83: PetscFunctionReturn(ierr);
84: }
88: /*@C
89: PetscPushErrorHandler - Sets a routine to be called on detection of errors.
91: Not Collective
93: Input Parameters:
94: + handler - error handler routine
95: - ctx - optional handler context that contains information needed by the handler (for
96: example file pointers for error messages etc.)
98: Calling sequence of handler:
99: $ int handler(MPI_Comm comm,int line,char *func,char *file,char *dir,PetscErrorCode n,int p,char *mess,void *ctx);
101: + comm - communicator over which error occured
102: . func - the function where the error occured (indicated by __FUNCT__)
103: . line - the line number of the error (indicated by __LINE__)
104: . file - the file in which the error was detected (indicated by __FILE__)
105: . dir - the directory of the file (indicated by __SDIR__)
106: . n - the generic error number (see list defined in include/petscerror.h)
107: . p - PETSC_ERROR_INITIAL if error just detected, otherwise PETSC_ERROR_REPEAT
108: . mess - an error text string, usually just printed to the screen
109: - ctx - the error handler context
111: Options Database Keys:
112: + -on_error_attach_debugger <noxterm,gdb or dbx>
113: - -on_error_abort
115: Level: intermediate
117: Notes:
118: The currently available PETSc error handlers include PetscTraceBackErrorHandler(),
119: PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscMPIAbortErrorHandler(), PetscReturnErrorHandler().
121: Fortran Notes: You can only push one error handler from Fortran before poping it.
123: .seealso: PetscPopErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), PetscTraceBackErrorHandler(), PetscPushSignalHandler()
125: @*/
126: PetscErrorCode PetscPushErrorHandler(PetscErrorCode (*handler)(MPI_Comm comm,int,const char*,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*),void *ctx)
127: {
128: EH neweh;
132: PetscNew(struct _EH,&neweh);
133: if (eh) neweh->previous = eh;
134: else neweh->previous = 0;
135: neweh->handler = handler;
136: neweh->ctx = ctx;
137: eh = neweh;
138: return(0);
139: }
143: /*@
144: PetscPopErrorHandler - Removes the latest error handler that was
145: pushed with PetscPushErrorHandler().
147: Not Collective
149: Level: intermediate
151: Concepts: error handler^setting
153: .seealso: PetscPushErrorHandler()
154: @*/
155: PetscErrorCode PetscPopErrorHandler(void)
156: {
157: EH tmp;
161: if (!eh) return(0);
162: tmp = eh;
163: eh = eh->previous;
164: PetscFree(tmp);
165: return(0);
166: }
170: /*@C
171: PetscReturnErrorHandler - Error handler that causes a return to the current
172: level.
174: Not Collective
176: Input Parameters:
177: + comm - communicator over which error occurred
178: . line - the line number of the error (indicated by __LINE__)
179: . func - the function where error is detected (indicated by __FUNCT__)
180: . file - the file in which the error was detected (indicated by __FILE__)
181: . dir - the directory of the file (indicated by __SDIR__)
182: . mess - an error text string, usually just printed to the screen
183: . n - the generic error number
184: . p - specific error number
185: - ctx - error handler context
187: Level: developer
189: Notes:
190: Most users need not directly employ this routine and the other error
191: handlers, but can instead use the simplified interface SETERRQ, which has
192: the calling sequence
193: $ SETERRQ(comm,number,mess)
195: Notes for experienced users:
196: This routine is good for catching errors such as zero pivots in preconditioners
197: or breakdown of iterative methods. It is not appropriate for memory violations
198: and similar errors.
200: Use PetscPushErrorHandler() to set the desired error handler. The
201: currently available PETSc error handlers include PetscTraceBackErrorHandler(),
202: PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscAbortErrorHandler()
204: Concepts: error handler
206: .seealso: PetscPushErrorHandler(), PetscPopErrorHandler().
207: @*/
209: PetscErrorCode PetscReturnErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,const char *dir,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx)
210: {
212: PetscFunctionReturn(n);
213: }
215: static char PetscErrorBaseMessage[1024];
216: /*
217: The numerical values for these are defined in include/petscerror.h; any changes
218: there must also be made here
219: */
220: static const char *PetscErrorStrings[] = {
221: /*55 */ "Out of memory",
222: "No support for this operation for this object type",
223: "No support for this operation on this system",
224: /*58 */ "Operation done in wrong order",
225: /*59 */ "Signal received",
226: /*60 */ "Nonconforming object sizes",
227: "Argument aliasing not permitted",
228: "Invalid argument",
229: /*63 */ "Argument out of range",
230: "Corrupt argument:\nsee http://www.mcs.anl.gov/petsc/documentation/faq.html#valgrind",
231: "Unable to open file",
232: "Read from file failed",
233: "Write to file failed",
234: "Invalid pointer",
235: /*69 */ "Arguments must have same type",
236: /*70 */ "Attempt to use a pointer that does not point to a valid accessible location",
237: /*71 */ "Detected zero pivot in LU factorization:\nsee http://www.mcs.anl.gov/petsc/documentation/faq.html#ZeroPivot",
238: /*72 */ "Floating point exception",
239: /*73 */ "Object is in wrong state",
240: "Corrupted Petsc object",
241: "Arguments are incompatible",
242: "Error in external library",
243: /*77 */ "Petsc has generated inconsistent data",
244: "Memory corruption",
245: "Unexpected data in file",
246: /*80 */ "Arguments must have same communicators",
247: /*81 */ "Detected zero pivot in Cholesky factorization:\nsee http://www.mcs.anl.gov/petsc/documentation/faq.html#ZeroPivot",
248: " ",
249: " ",
250: "Overflow in integer operation:\nsee http://www.mcs.anl.gov/petsc/documentation/faq.html#64-bit-indices",
251: /*85 */ "Null argument, when expecting valid pointer",
252: /*86 */ "Unknown type. Check for miss-spelling or missing external package needed for type:\nsee http://www.mcs.anl.gov/petsc/documentation/installation.html#external",
253: /*87 */ "Not used",
254: /*88 */ "Error in system call",
255: /*89 */ "Object Type not set:\nsee http://www.mcs.anl.gov/petsc/documentation/faq.html#objecttypenotset"
256: /*90 */ " ",
257: /* */ " ",
258: /* */ " ",
259: /* */ " ",
260: /* */ " ",
261: /*95 */ " ",
262: };
266: /*@C
267: PetscErrorMessage - returns the text string associated with a PETSc error code.
269: Not Collective
271: Input Parameter:
272: . errnum - the error code
274: Output Parameter:
275: + text - the error message (NULL if not desired)
276: - specific - the specific error message that was set with SETERRxxx() or PetscError(). (NULL if not desired)
278: Level: developer
280: Concepts: error handler^messages
282: .seealso: PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(),
283: PetscAbortErrorHandler(), PetscTraceBackErrorHandler()
284: @*/
285: PetscErrorCode PetscErrorMessage(int errnum,const char *text[],char **specific)
286: {
288: if (text && errnum > PETSC_ERR_MIN_VALUE && errnum < PETSC_ERR_MAX_VALUE) *text = PetscErrorStrings[errnum-PETSC_ERR_MIN_VALUE-1];
289: else if (text) *text = 0;
291: if (specific) *specific = PetscErrorBaseMessage;
292: return(0);
293: }
295: #if defined(PETSC_CLANGUAGE_CXX)
296: /* C++ exceptions are formally not allowed to propagate through extern "C" code. In practice, far too much software
297: * would be broken if implementations did not handle it it some common cases. However, keep in mind
298: *
299: * Rule 62. Don't allow exceptions to propagate across module boundaries
300: *
301: * in "C++ Coding Standards" by Sutter and Alexandrescu. (This accounts for part of the ongoing C++ binary interface
302: * instability.) Having PETSc raise errors as C++ exceptions was probably misguided and should eventually be removed.
303: */
304: static void PetscCxxErrorThrow() {
305: const char *str;
306: if (eh && eh->ctx) {
307: std::ostringstream *msg;
308: msg = (std::ostringstream*) eh->ctx;
309: str = msg->str().c_str();
310: } else str = "Error detected in C PETSc";
312: throw PETSc::Exception(str);
313: }
314: #endif
318: /*@C
319: PetscError - Routine that is called when an error has been detected,
320: usually called through the macro SETERRQ(PETSC_COMM_SELF,).
322: Not Collective
324: Input Parameters:
325: + comm - communicator over which error occurred. ALL ranks of this communicator MUST call this routine
326: . line - the line number of the error (indicated by __LINE__)
327: . func - the function where the error occured (indicated by __FUNCT__)
328: . dir - the directory of file (indicated by __SDIR__)
329: . file - the file in which the error was detected (indicated by __FILE__)
330: . mess - an error text string, usually just printed to the screen
331: . n - the generic error number
332: . p - PETSC_ERROR_INITIAL indicates the error was initially detected, PETSC_ERROR_REPEAT indicates this is a traceback from a previously detected error
333: - mess - formatted message string - aka printf
335: Level: intermediate
337: Notes:
338: Most users need not directly use this routine and the error handlers, but
339: can instead use the simplified interface SETERRQ, which has the calling
340: sequence
341: $ SETERRQ(comm,n,mess)
343: Experienced users can set the error handler with PetscPushErrorHandler().
345: Developer Note: Since this is called after an error condition it should not be calling any error handlers (currently it ignores any error codes)
346: 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
347: but this annoying.
349: Concepts: error^setting condition
351: .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2()
352: @*/
353: PetscErrorCode PetscError(MPI_Comm comm,int line,const char *func,const char *file,const char *dir,PetscErrorCode n,PetscErrorType p,const char *mess,...)
354: {
355: va_list Argp;
356: size_t fullLength;
357: char buf[2048],*lbuf = 0;
358: PetscBool ismain,isunknown;
362: if (!func) func = "User provided function";
363: if (!file) file = "User file";
364: if (!dir) dir = " ";
365: if (comm == MPI_COMM_NULL) comm = PETSC_COMM_SELF;
367: /* Compose the message evaluating the print format */
368: if (mess) {
369: va_start(Argp,mess);
370: PetscVSNPrintf(buf,2048,mess,&fullLength,Argp);
371: va_end(Argp);
372: lbuf = buf;
373: if (p == 1) PetscStrncpy(PetscErrorBaseMessage,lbuf,1023);
374: }
376: if (!eh) PetscTraceBackErrorHandler(comm,line,func,file,dir,n,p,lbuf,0);
377: else (*eh->handler)(comm,line,func,file,dir,n,p,lbuf,eh->ctx);
379: /*
380: If this is called from the main() routine we call MPI_Abort() instead of
381: return to allow the parallel program to be properly shutdown.
383: Since this is in the error handler we don't check the errors below. Of course,
384: PetscStrncmp() does its own error checking which is problamatic
385: */
386: PetscStrncmp(func,"main",4,&ismain);
387: PetscStrncmp(func,"unknown",7,&isunknown);
388: if (ismain || isunknown) MPI_Abort(PETSC_COMM_WORLD,(int)ierr);
390: #if defined(PETSC_CLANGUAGE_CXX)
391: if (p == PETSC_ERROR_IN_CXX) {
392: PetscCxxErrorThrow();
393: }
394: #endif
395: PetscFunctionReturn(ierr);
396: }
398: /* -------------------------------------------------------------------------*/
402: /*@C
403: PetscIntView - Prints an array of integers; useful for debugging.
405: Collective on PetscViewer
407: Input Parameters:
408: + N - number of integers in array
409: . idx - array of integers
410: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
412: Level: intermediate
414: Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done
416: .seealso: PetscRealView()
417: @*/
418: PetscErrorCode PetscIntView(PetscInt N,const PetscInt idx[],PetscViewer viewer)
419: {
421: PetscInt j,i,n = N/20,p = N % 20;
422: PetscBool iascii,isbinary;
423: MPI_Comm comm;
426: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
429: PetscObjectGetComm((PetscObject)viewer,&comm);
431: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
432: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
433: if (iascii) {
434: PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);
435: for (i=0; i<n; i++) {
436: PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*i);
437: for (j=0; j<20; j++) {
438: PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[i*20+j]);
439: }
440: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
441: }
442: if (p) {
443: PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*n);
444: for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[20*n+i]);}
445: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
446: }
447: PetscViewerFlush(viewer);
448: PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);
449: } else if (isbinary) {
450: PetscMPIInt rank,size,*sizes,Ntotal,*displs,NN;
451: PetscInt *array;
453: PetscMPIIntCast(N,&NN);
454: MPI_Comm_rank(comm,&rank);
455: MPI_Comm_size(comm,&size);
457: if (size > 1) {
458: if (rank) {
459: MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
460: MPI_Gatherv((void*)idx,NN,MPIU_INT,0,0,0,MPIU_INT,0,comm);
461: } else {
462: PetscMalloc(size*sizeof(PetscMPIInt),&sizes);
463: MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
464: Ntotal = sizes[0];
465: PetscMalloc(size*sizeof(PetscMPIInt),&displs);
466: displs[0] = 0;
467: for (i=1; i<size; i++) {
468: Ntotal += sizes[i];
469: displs[i] = displs[i-1] + sizes[i-1];
470: }
471: PetscMalloc(Ntotal*sizeof(PetscInt),&array);
472: MPI_Gatherv((void*)idx,NN,MPIU_INT,array,sizes,displs,MPIU_INT,0,comm);
473: PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_INT,PETSC_TRUE);
474: PetscFree(sizes);
475: PetscFree(displs);
476: PetscFree(array);
477: }
478: } else {
479: PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_INT,PETSC_FALSE);
480: }
481: } else {
482: const char *tname;
483: PetscObjectGetName((PetscObject)viewer,&tname);
484: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
485: }
486: return(0);
487: }
491: /*@C
492: PetscRealView - Prints an array of doubles; useful for debugging.
494: Collective on PetscViewer
496: Input Parameters:
497: + N - number of doubles in array
498: . idx - array of doubles
499: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
501: Level: intermediate
503: Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done
505: .seealso: PetscIntView()
506: @*/
507: PetscErrorCode PetscRealView(PetscInt N,const PetscReal idx[],PetscViewer viewer)
508: {
510: PetscInt j,i,n = N/5,p = N % 5;
511: PetscBool iascii,isbinary;
512: MPI_Comm comm;
515: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
518: PetscObjectGetComm((PetscObject)viewer,&comm);
520: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
521: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
522: if (iascii) {
523: PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);
524: for (i=0; i<n; i++) {
525: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*i);
526: for (j=0; j<5; j++) {
527: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*5+j]);
528: }
529: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
530: }
531: if (p) {
532: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*n);
533: for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[5*n+i]);}
534: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
535: }
536: PetscViewerFlush(viewer);
537: PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);
538: } else if (isbinary) {
539: PetscMPIInt rank,size,*sizes,*displs, Ntotal,NN;
540: PetscReal *array;
542: PetscMPIIntCast(N,&NN);
543: MPI_Comm_rank(comm,&rank);
544: MPI_Comm_size(comm,&size);
546: if (size > 1) {
547: if (rank) {
548: MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
549: MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,0,0,0,MPIU_REAL,0,comm);
550: } else {
551: PetscMalloc(size*sizeof(PetscMPIInt),&sizes);
552: MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
553: Ntotal = sizes[0];
554: PetscMalloc(size*sizeof(PetscMPIInt),&displs);
555: displs[0] = 0;
556: for (i=1; i<size; i++) {
557: Ntotal += sizes[i];
558: displs[i] = displs[i-1] + sizes[i-1];
559: }
560: PetscMalloc(Ntotal*sizeof(PetscReal),&array);
561: MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,array,sizes,displs,MPIU_REAL,0,comm);
562: PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_REAL,PETSC_TRUE);
563: PetscFree(sizes);
564: PetscFree(displs);
565: PetscFree(array);
566: }
567: } else {
568: PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_REAL,PETSC_FALSE);
569: }
570: } else {
571: const char *tname;
572: PetscObjectGetName((PetscObject)viewer,&tname);
573: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
574: }
575: return(0);
576: }
580: /*@C
581: PetscScalarView - Prints an array of scalars; useful for debugging.
583: Collective on PetscViewer
585: Input Parameters:
586: + N - number of scalars in array
587: . idx - array of scalars
588: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
590: Level: intermediate
592: Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done
594: .seealso: PetscIntView(), PetscRealView()
595: @*/
596: PetscErrorCode PetscScalarView(PetscInt N,const PetscScalar idx[],PetscViewer viewer)
597: {
599: PetscInt j,i,n = N/3,p = N % 3;
600: PetscBool iascii,isbinary;
601: MPI_Comm comm;
604: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
607: PetscObjectGetComm((PetscObject)viewer,&comm);
609: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
610: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
611: if (iascii) {
612: PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);
613: for (i=0; i<n; i++) {
614: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);
615: for (j=0; j<3; j++) {
616: #if defined(PETSC_USE_COMPLEX)
617: PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", PetscRealPart(idx[i*3+j]),PetscImaginaryPart(idx[i*3+j]));
618: #else
619: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*3+j]);
620: #endif
621: }
622: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
623: }
624: if (p) {
625: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);
626: for (i=0; i<p; i++) {
627: #if defined(PETSC_USE_COMPLEX)
628: PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", PetscRealPart(idx[n*3+i]),PetscImaginaryPart(idx[n*3+i]));
629: #else
630: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[3*n+i]);
631: #endif
632: }
633: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
634: }
635: PetscViewerFlush(viewer);
636: PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);
637: } else if (isbinary) {
638: PetscMPIInt size,rank,*sizes,Ntotal,*displs,NN;
639: PetscScalar *array;
641: PetscMPIIntCast(N,&NN);
642: MPI_Comm_rank(comm,&rank);
643: MPI_Comm_size(comm,&size);
645: if (size > 1) {
646: if (rank) {
647: MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
648: MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,0,0,0,MPIU_SCALAR,0,comm);
649: } else {
650: PetscMalloc(size*sizeof(PetscMPIInt),&sizes);
651: MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
652: Ntotal = sizes[0];
653: PetscMalloc(size*sizeof(PetscMPIInt),&displs);
654: displs[0] = 0;
655: for (i=1; i<size; i++) {
656: Ntotal += sizes[i];
657: displs[i] = displs[i-1] + sizes[i-1];
658: }
659: PetscMalloc(Ntotal*sizeof(PetscScalar),&array);
660: MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);
661: PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR,PETSC_TRUE);
662: PetscFree(sizes);
663: PetscFree(displs);
664: PetscFree(array);
665: }
666: } else {
667: PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_SCALAR,PETSC_FALSE);
668: }
669: } else {
670: const char *tname;
671: PetscObjectGetName((PetscObject)viewer,&tname);
672: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
673: }
674: return(0);
675: }