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