Actual source code: err.c
petsc-3.3-p7 2013-05-11
2: /*
3: Code that allows one to set the error handlers
4: */
5: #include <petscsys.h> /*I "petscsys.h" I*/
6: #include <stdarg.h>
7: #if defined(PETSC_HAVE_STDLIB_H)
8: #include <stdlib.h>
9: #endif
11: typedef struct _EH *EH;
12: struct _EH {
13: int classid;
14: PetscErrorCode (*handler)(MPI_Comm,int,const char*,const char*,const char *,PetscErrorCode,PetscErrorType,const char*,void *);
15: void *ctx;
16: EH previous;
17: };
19: static EH eh = 0;
23: /*@C
24: PetscEmacsClientErrorHandler - Error handler that uses the emacsclient program to
25: load the file where the error occured. Then calls the "previous" error handler.
27: Not Collective
29: Input Parameters:
30: + comm - communicator over which error occured
31: . line - the line number of the error (indicated by __LINE__)
32: . func - the function where error is detected (indicated by __FUNCT__)
33: . file - the file in which the error was detected (indicated by __FILE__)
34: . dir - the directory of the file (indicated by __SDIR__)
35: . mess - an error text string, usually just printed to the screen
36: . n - the generic error number
37: . p - specific error number
38: - ctx - error handler context
40: Options Database Key:
41: . -on_error_emacs <machinename>
43: Level: developer
45: Notes:
46: You must put (server-start) in your .emacs file for the emacsclient software to work
48: Most users need not directly employ this routine and the other error
49: handlers, but can instead use the simplified interface SETERRQ, which has
50: the calling sequence
51: $ SETERRQ(PETSC_COMM_SELF,number,p,mess)
53: Notes for experienced users:
54: Use PetscPushErrorHandler() to set the desired error handler.
56: Concepts: emacs^going to on error
57: Concepts: error handler^going to line in emacs
59: .seealso: PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(),
60: PetscAbortErrorHandler()
61: @*/
62: 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)
63: {
65: char command[PETSC_MAX_PATH_LEN];
66: const char *pdir;
67: FILE *fp;
70: /* Note: don't check error codes since this an error handler :-) */
71: PetscGetPetscDir(&pdir);
72: sprintf(command,"cd %s; emacsclient --no-wait +%d %s%s\n",pdir,line,dir,file);
73: #if defined(PETSC_HAVE_POPEN)
74: PetscPOpen(MPI_COMM_WORLD,(char*)ctx,command,"r",&fp);
75: PetscPClose(MPI_COMM_WORLD,fp);
76: #else
77: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP_SYS,"Cannot run external programs on this machine");
78: #endif
79: PetscPopErrorHandler(); /* remove this handler from the stack of handlers */
80: if (!eh) PetscTraceBackErrorHandler(comm,line,fun,file,dir,n,p,mess,0);
81: else (*eh->handler)(comm,line,fun,file,dir,n,p,mess,eh->ctx);
82: PetscFunctionReturn(ierr);
83: }
87: /*@C
88: PetscPushErrorHandler - Sets a routine to be called on detection of errors.
90: Not Collective
92: Input Parameters:
93: + handler - error handler routine
94: - ctx - optional handler context that contains information needed by the handler (for
95: example file pointers for error messages etc.)
97: Calling sequence of handler:
98: $ int handler(MPI_Comm comm,int line,char *func,char *file,char *dir,PetscErrorCode n,int p,char *mess,void *ctx);
100: + comm - communicator over which error occured
101: . func - the function where the error occured (indicated by __FUNCT__)
102: . line - the line number of the error (indicated by __LINE__)
103: . file - the file in which the error was detected (indicated by __FILE__)
104: . dir - the directory of the file (indicated by __SDIR__)
105: . n - the generic error number (see list defined in include/petscerror.h)
106: . p - PETSC_ERROR_INITIAL if error just detected, otherwise PETSC_ERROR_REPEAT
107: . mess - an error text string, usually just printed to the screen
108: - ctx - the error handler context
110: Options Database Keys:
111: + -on_error_attach_debugger <noxterm,gdb or dbx>
112: - -on_error_abort
114: Level: intermediate
116: Notes:
117: The currently available PETSc error handlers include PetscTraceBackErrorHandler(),
118: PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscMPIAbortErrorHandler(), PetscReturnErrorHandler().
120: Fortran Notes: You can only push one error handler from Fortran before poping it.
122: .seealso: PetscPopErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), PetscTraceBackErrorHandler()
124: @*/
125: PetscErrorCode PetscPushErrorHandler(PetscErrorCode (*handler)(MPI_Comm comm,int,const char *,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*),void *ctx)
126: {
127: EH neweh;
131: PetscNew(struct _EH,&neweh);
132: if (eh) {neweh->previous = eh;}
133: else {neweh->previous = 0;}
134: neweh->handler = handler;
135: neweh->ctx = ctx;
136: eh = neweh;
137: return(0);
138: }
142: /*@
143: PetscPopErrorHandler - Removes the latest error handler that was
144: pushed with PetscPushErrorHandler().
146: Not Collective
148: Level: intermediate
150: Concepts: error handler^setting
152: .seealso: PetscPushErrorHandler()
153: @*/
154: PetscErrorCode PetscPopErrorHandler(void)
155: {
156: EH tmp;
160: if (!eh) return(0);
161: tmp = eh;
162: eh = eh->previous;
163: PetscFree(tmp);
165: return(0);
166: }
167:
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: "",
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 (PETSC_NULL if not desired)
276: - specific - the specific error message that was set with SETERRxxx() or PetscError(). (PETSC_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) {
289: *text = PetscErrorStrings[errnum-PETSC_ERR_MIN_VALUE-1];
290: } else if (text) *text = 0;
292: if (specific) {
293: *specific = PetscErrorBaseMessage;
294: }
295: return(0);
296: }
300: /*@C
301: PetscError - Routine that is called when an error has been detected,
302: usually called through the macro SETERRQ(PETSC_COMM_SELF,).
304: Not Collective
306: Input Parameters:
307: + comm - communicator over which error occurred. ALL ranks of this communicator MUST call this routine
308: . line - the line number of the error (indicated by __LINE__)
309: . func - the function where the error occured (indicated by __FUNCT__)
310: . dir - the directory of file (indicated by __SDIR__)
311: . file - the file in which the error was detected (indicated by __FILE__)
312: . mess - an error text string, usually just printed to the screen
313: . n - the generic error number
314: . p - PETSC_ERROR_INITIAL indicates the error was initially detected, PETSC_ERROR_REPEAT indicates this is a traceback from a previously detected error
315: - mess - formatted message string - aka printf
317: Level: intermediate
319: Notes:
320: Most users need not directly use this routine and the error handlers, but
321: can instead use the simplified interface SETERRQ, which has the calling
322: sequence
323: $ SETERRQ(comm,n,mess)
325: Experienced users can set the error handler with PetscPushErrorHandler().
327: Concepts: error^setting condition
329: .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2()
330: @*/
331: PetscErrorCode PetscError(MPI_Comm comm,int line,const char *func,const char* file,const char *dir,PetscErrorCode n,PetscErrorType p,const char *mess,...)
332: {
333: va_list Argp;
334: size_t fullLength;
336: char buf[2048],*lbuf = 0;
337: PetscBool ismain,isunknown;
339: if (!func) func = "User provided function";
340: if (!file) file = "User file";
341: if (!dir) dir = " ";
344: /* Compose the message evaluating the print format */
345: if (mess) {
346: va_start(Argp,mess);
347: PetscVSNPrintf(buf,2048,mess,&fullLength,Argp);
348: va_end(Argp);
349: lbuf = buf;
350: if (p == 1) {
351: PetscStrncpy(PetscErrorBaseMessage,lbuf,1023);
352: }
353: }
355: if (!eh) PetscTraceBackErrorHandler(comm,line,func,file,dir,n,p,lbuf,0);
356: else (*eh->handler)(comm,line,func,file,dir,n,p,lbuf,eh->ctx);
358: /*
359: If this is called from the main() routine we call MPI_Abort() instead of
360: return to allow the parallel program to be properly shutdown.
362: Since this is in the error handler we don't check the errors below. Of course,
363: PetscStrncmp() does its own error checking which is problamatic
364: */
365: PetscStrncmp(func,"main",4,&ismain);
366: PetscStrncmp(func,"unknown",7,&isunknown);
367: if (ismain || isunknown) {
368: MPI_Abort(PETSC_COMM_WORLD,(int)ierr);
369: }
370: #if defined(PETSC_CLANGUAGE_CXX) && !defined(PETSC_USE_EXTERN_CXX)
371: if (p == PETSC_ERROR_IN_CXX) {
372: const char *str;
373: if (eh && eh->ctx) {
374: std::ostringstream *msg;
375: msg = (std::ostringstream*) eh->ctx;
376: str = msg->str().c_str();
377: } else {
378: str = "Error detected in C PETSc";
379: }
380: throw PETSc::Exception(str);
381: }
382: #endif
383: PetscFunctionReturn(ierr);
384: }
386: /* -------------------------------------------------------------------------*/
390: /*@C
391: PetscIntView - Prints an array of integers; useful for debugging.
393: Collective on PetscViewer
395: Input Parameters:
396: + N - number of integers in array
397: . idx - array of integers
398: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
400: Level: intermediate
402: Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping 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: PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);
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: PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);
437: } else if (isbinary) {
438: PetscMPIInt rank,size,*sizes,Ntotal,*displs,NN;
439: PetscInt *array;
441: NN = PetscMPIIntCast(N);
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: PetscMalloc(size*sizeof(PetscMPIInt),&sizes);
451: MPI_Gather(&NN,1,MPI_INT,sizes,1,MPIU_INT,0,comm);
452: Ntotal = sizes[0];
453: PetscMalloc(size*sizeof(PetscMPIInt),&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: PetscMalloc(Ntotal*sizeof(PetscInt),&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: }
479: /*@C
480: PetscRealView - Prints an array of doubles; useful for debugging.
482: Collective on PetscViewer
484: Input Parameters:
485: + N - number of doubles in array
486: . idx - array of doubles
487: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
489: Level: intermediate
491: Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done
493: .seealso: PetscIntView()
494: @*/
495: PetscErrorCode PetscRealView(PetscInt N,const PetscReal idx[],PetscViewer viewer)
496: {
498: PetscInt j,i,n = N/5,p = N % 5;
499: PetscBool iascii,isbinary;
500: MPI_Comm comm;
503: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
506: PetscObjectGetComm((PetscObject)viewer,&comm);
508: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
509: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
510: if (iascii) {
511: PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);
512: for (i=0; i<n; i++) {
513: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*i);
514: for (j=0; j<5; j++) {
515: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*5+j]);
516: }
517: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
518: }
519: if (p) {
520: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*n);
521: for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[5*n+i]);}
522: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
523: }
524: PetscViewerFlush(viewer);
525: PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);
526: } else if (isbinary) {
527: PetscMPIInt rank,size,*sizes,*displs, Ntotal,NN;
528: PetscReal *array;
530: NN = PetscMPIIntCast(N);
531: MPI_Comm_rank(comm,&rank);
532: MPI_Comm_size(comm,&size);
534: if (size > 1) {
535: if (rank) {
536: MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
537: MPI_Gatherv((void*)idx,NN,MPI_DOUBLE,0,0,0,MPI_DOUBLE,0,comm);
538: } else {
539: PetscMalloc(size*sizeof(PetscMPIInt),&sizes);
540: MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
541: Ntotal = sizes[0];
542: PetscMalloc(size*sizeof(PetscMPIInt),&displs);
543: displs[0] = 0;
544: for (i=1; i<size; i++) {
545: Ntotal += sizes[i];
546: displs[i] = displs[i-1] + sizes[i-1];
547: }
548: PetscMalloc(Ntotal*sizeof(PetscReal),&array);
549: MPI_Gatherv((void*)idx,NN,MPI_DOUBLE,array,sizes,displs,MPI_DOUBLE,0,comm);
550: PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_REAL,PETSC_TRUE);
551: PetscFree(sizes);
552: PetscFree(displs);
553: PetscFree(array);
554: }
555: } else {
556: PetscViewerBinaryWrite(viewer,(void *) idx,N,PETSC_REAL,PETSC_FALSE);
557: }
558: } else {
559: const char *tname;
560: PetscObjectGetName((PetscObject)viewer,&tname);
561: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
562: }
563: return(0);
564: }
568: /*@C
569: PetscScalarView - Prints an array of scalars; useful for debugging.
571: Collective on PetscViewer
573: Input Parameters:
574: + N - number of scalars in array
575: . idx - array of scalars
576: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
578: Level: intermediate
580: Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done
582: .seealso: PetscIntView(), PetscRealView()
583: @*/
584: PetscErrorCode PetscScalarView(PetscInt N,const PetscScalar idx[],PetscViewer viewer)
585: {
587: PetscInt j,i,n = N/3,p = N % 3;
588: PetscBool iascii,isbinary;
589: MPI_Comm comm;
592: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
595: PetscObjectGetComm((PetscObject)viewer,&comm);
597: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
598: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
599: if (iascii) {
600: PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);
601: for (i=0; i<n; i++) {
602: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);
603: for (j=0; j<3; j++) {
604: #if defined (PETSC_USE_COMPLEX)
605: PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
606: PetscRealPart(idx[i*3+j]),PetscImaginaryPart(idx[i*3+j]));
607: #else
608: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*3+j]);
609: #endif
610: }
611: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
612: }
613: if (p) {
614: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);
615: for (i=0; i<p; i++) {
616: #if defined (PETSC_USE_COMPLEX)
617: PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
618: PetscRealPart(idx[n*3+i]),PetscImaginaryPart(idx[n*3+i]));
619: #else
620: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[3*n+i]);
621: #endif
622: }
623: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
624: }
625: PetscViewerFlush(viewer);
626: PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);
627: } else if (isbinary) {
628: PetscMPIInt size,rank,*sizes,Ntotal,*displs,NN;
629: PetscScalar *array;
631: NN = PetscMPIIntCast(N);
632: MPI_Comm_rank(comm,&rank);
633: MPI_Comm_size(comm,&size);
635: if (size > 1) {
636: if (rank) {
637: MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
638: MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,0,0,0,MPIU_SCALAR,0,comm);
639: } else {
640: PetscMalloc(size*sizeof(PetscMPIInt),&sizes);
641: MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
642: Ntotal = sizes[0];
643: PetscMalloc(size*sizeof(PetscMPIInt),&displs);
644: displs[0] = 0;
645: for (i=1; i<size; i++) {
646: Ntotal += sizes[i];
647: displs[i] = displs[i-1] + sizes[i-1];
648: }
649: PetscMalloc(Ntotal*sizeof(PetscScalar),&array);
650: MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);
651: PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR,PETSC_TRUE);
652: PetscFree(sizes);
653: PetscFree(displs);
654: PetscFree(array);
655: }
656: } else {
657: PetscViewerBinaryWrite(viewer,(void *) idx,N,PETSC_SCALAR,PETSC_FALSE);
658: }
659: } else {
660: const char *tname;
661: PetscObjectGetName((PetscObject)viewer,&tname);
662: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
663: }
664: return(0);
665: }