Actual source code: err.c

  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: see http://www.mcs.anl.gov/petsc/petsc-as/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/petsc-as/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/petsc-as/documentation/faq.html#ZeroPivot",
248:            "  ",
249:            "  ",
250:            "  ",
251:   /* 85 */ "Null argument, when expecting valid pointer",
252:   /* 86 */ "Unknown type. Check for miss-spelling or missing external package needed for type\n seehttp://www.mcs.anl.gov/petsc/petsc-as/documentation/installation.html#external",
253:   /* 87 */ "Not used",
254:   /* 88 */ "Error in system call",
255:   /* 89 */ "Object Type not set: see http://www.mcs.anl.gov/petsc/petsc-as/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:   }
371:   if (p == PETSC_ERROR_IN_CXX) {
372:     const char *str;
373:     if (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:   PetscTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
420:   PetscTypeCompare((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 = PetscMPIIntCast(N);
439:     PetscInt    *array;
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:         PetscMalloc(size*sizeof(PetscMPIInt),&sizes);
449:         MPI_Gather(&NN,1,MPI_INT,sizes,1,MPIU_INT,0,comm);
450:         Ntotal    = sizes[0];
451:         PetscMalloc(size*sizeof(PetscMPIInt),&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:         PetscMalloc(Ntotal*sizeof(PetscInt),&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: }

477: /*@C
478:     PetscRealView - Prints an array of doubles; useful for debugging.

480:     Collective on PetscViewer

482:     Input Parameters:
483: +   N - number of doubles in array
484: .   idx - array of doubles
485: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

487:   Level: intermediate

489:     Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done

491: .seealso: PetscIntView() 
492: @*/
493: PetscErrorCode  PetscRealView(PetscInt N,const PetscReal idx[],PetscViewer viewer)
494: {
496:   PetscInt       j,i,n = N/5,p = N % 5;
497:   PetscBool      iascii,isbinary;
498:   MPI_Comm       comm;

501:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
504:   PetscObjectGetComm((PetscObject)viewer,&comm);

506:   PetscTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
507:   PetscTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
508:   if (iascii) {
509:     PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);
510:     for (i=0; i<n; i++) {
511:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*i);
512:       for (j=0; j<5; j++) {
513:          PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*5+j]);
514:       }
515:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
516:     }
517:     if (p) {
518:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*n);
519:       for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[5*n+i]);}
520:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
521:     }
522:     PetscViewerFlush(viewer);
523:     PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);
524:   } else if (isbinary) {
525:     PetscMPIInt rank,size,*sizes,*displs, Ntotal,NN = PetscMPIIntCast(N);
526:     PetscReal   *array;

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((void*)idx,NN,MPI_DOUBLE,0,0,0,MPI_DOUBLE,0,comm);
535:       } else {
536:         PetscMalloc(size*sizeof(PetscMPIInt),&sizes);
537:         MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
538:         Ntotal = sizes[0];
539:         PetscMalloc(size*sizeof(PetscMPIInt),&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:         PetscMalloc(Ntotal*sizeof(PetscReal),&array);
546:         MPI_Gatherv((void*)idx,NN,MPI_DOUBLE,array,sizes,displs,MPI_DOUBLE,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: }

565: /*@C
566:     PetscScalarView - Prints an array of scalars; useful for debugging.

568:     Collective on PetscViewer

570:     Input Parameters:
571: +   N - number of scalars in array
572: .   idx - array of scalars
573: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

575:   Level: intermediate

577:     Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done

579: .seealso: PetscIntView(), PetscRealView()
580: @*/
581: PetscErrorCode  PetscScalarView(PetscInt N,const PetscScalar idx[],PetscViewer viewer)
582: {
584:   PetscInt       j,i,n = N/3,p = N % 3;
585:   PetscBool      iascii,isbinary;
586:   MPI_Comm       comm;

589:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
592:   PetscObjectGetComm((PetscObject)viewer,&comm);

594:   PetscTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
595:   PetscTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
596:   if (iascii) {
597:     PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);
598:     for (i=0; i<n; i++) {
599:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);
600:       for (j=0; j<3; j++) {
601: #if defined (PETSC_USE_COMPLEX)
602:         PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
603:                                  PetscRealPart(idx[i*3+j]),PetscImaginaryPart(idx[i*3+j]));
604: #else       
605:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*3+j]);
606: #endif
607:       }
608:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
609:     }
610:     if (p) {
611:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);
612:       for (i=0; i<p; i++) {
613: #if defined (PETSC_USE_COMPLEX)
614:         PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
615:                                  PetscRealPart(idx[n*3+i]),PetscImaginaryPart(idx[n*3+i]));
616: #else
617:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[3*n+i]);
618: #endif
619:       }
620:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
621:     }
622:     PetscViewerFlush(viewer);
623:     PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);
624:   } else if (isbinary) {
625:     PetscMPIInt size,rank,*sizes,Ntotal,*displs,NN = PetscMPIIntCast(N);
626:     PetscScalar *array;

628:     MPI_Comm_rank(comm,&rank);
629:     MPI_Comm_size(comm,&size);

631:     if (size > 1) {
632:       if (rank) {
633:         MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
634:         MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,0,0,0,MPIU_SCALAR,0,comm);
635:       } else {
636:         PetscMalloc(size*sizeof(PetscMPIInt),&sizes);
637:         MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
638:         Ntotal = sizes[0];
639:         PetscMalloc(size*sizeof(PetscMPIInt),&displs);
640:         displs[0] = 0;
641:         for (i=1; i<size; i++) {
642:           Ntotal    += sizes[i];
643:           displs[i] =  displs[i-1] + sizes[i-1];
644:         }
645:         PetscMalloc(Ntotal*sizeof(PetscScalar),&array);
646:         MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);
647:         PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR,PETSC_TRUE);
648:         PetscFree(sizes);
649:         PetscFree(displs);
650:         PetscFree(array);
651:       }
652:     } else {
653:       PetscViewerBinaryWrite(viewer,(void *) idx,N,PETSC_SCALAR,PETSC_FALSE);
654:     }
655:   } else {
656:     const char *tname;
657:     PetscObjectGetName((PetscObject)viewer,&tname);
658:     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
659:   }
660:   return(0);
661: }