Actual source code: err.c

  1: #define PETSC_DLL
  2: /*
  3:       Code that allows one to set the error handlers
  4: */
 5:  #include petsc.h
 6:  #include petscsys.h
  7: #include <stdarg.h>
  8: #if defined(PETSC_HAVE_STDLIB_H)
  9: #include <stdlib.h>
 10: #endif

 12: typedef struct _EH *EH;
 13: struct _EH {
 14:   int            cookie;
 15:   PetscErrorCode (*handler)(int,const char*,const char*,const char *,PetscErrorCode,int,const char*,void *);
 16:   void           *ctx;
 17:   EH             previous;
 18: };

 20: static EH eh = 0;

 24: /*@C
 25:    PetscEmacsClientErrorHandler - Error handler that uses the emacsclient program to 
 26:     load the file where the error occured. Then calls the "previous" error handler.

 28:    Not Collective

 30:    Input Parameters:
 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(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(int line,const char *fun,const char* file,const char *dir,PetscErrorCode n,int 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,"emacsclient +%d %s/%s%s\n",line,pdir,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_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(line,fun,file,dir,n,p,mess,0);
 81:   else         (*eh->handler)(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(int line,char *func,char *file,char *dir,PetscErrorCode n,int p,char *mess,void *ctx);

100: +  func - the function where the error occured (indicated by __FUNCT__)
101: .  line - the line number of the error (indicated by __LINE__)
102: .  file - the file in which the error was detected (indicated by __FILE__)
103: .  dir - the directory of the file (indicated by __SDIR__)
104: .  n - the generic error number (see list defined in include/petscerror.h)
105: .  p - the specific error number
106: .  mess - an error text string, usually just printed to the screen
107: -  ctx - the error handler context

109:    Options Database Keys:
110: +   -on_error_attach_debugger <noxterm,gdb or dbx>
111: -   -on_error_abort

113:    Level: intermediate

115:    Notes:
116:    The
117:    currently available PETSc error handlers include PetscTraceBackErrorHandler(),
118:    PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscMPIAbortErrorHandler(), PetscReturnErrorHandler().

120: .seealso: PetscPopErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), PetscTraceBackErrorHandler()

122: @*/
123: PetscErrorCode  PetscPushErrorHandler(PetscErrorCode (*handler)(int,const char *,const char*,const char*,PetscErrorCode,int,const char*,void*),void *ctx)
124: {
125:   EH  neweh;

129:   PetscNew(struct _EH,&neweh);
130:   if (eh) {neweh->previous = eh;}
131:   else    {neweh->previous = 0;}
132:   neweh->handler = handler;
133:   neweh->ctx     = ctx;
134:   eh             = neweh;
135:   return(0);
136: }

140: /*@
141:    PetscPopErrorHandler - Removes the latest error handler that was 
142:    pushed with PetscPushErrorHandler().

144:    Not Collective

146:    Level: intermediate

148:    Concepts: error handler^setting

150: .seealso: PetscPushErrorHandler()
151: @*/
152: PetscErrorCode  PetscPopErrorHandler(void)
153: {
154:   EH  tmp;

158:   if (!eh) return(0);
159:   tmp  = eh;
160:   eh   = eh->previous;
161:   PetscFree(tmp);

163:   return(0);
164: }
165: 
168: /*@C
169:   PetscReturnErrorHandler - Error handler that causes a return to the current
170:   level.

172:    Not Collective

174:    Input Parameters:
175: +  line - the line number of the error (indicated by __LINE__)
176: .  func - the function where error is detected (indicated by __FUNCT__)
177: .  file - the file in which the error was detected (indicated by __FILE__)
178: .  dir - the directory of the file (indicated by __SDIR__)
179: .  mess - an error text string, usually just printed to the screen
180: .  n - the generic error number
181: .  p - specific error number
182: -  ctx - error handler context

184:    Level: developer

186:    Notes:
187:    Most users need not directly employ this routine and the other error 
188:    handlers, but can instead use the simplified interface SETERRQ, which has 
189:    the calling sequence
190: $     SETERRQ(number,p,mess)

192:    Notes for experienced users:
193:    This routine is good for catching errors such as zero pivots in preconditioners
194:    or breakdown of iterative methods. It is not appropriate for memory violations
195:    and similar errors.

197:    Use PetscPushErrorHandler() to set the desired error handler.  The
198:    currently available PETSc error handlers include PetscTraceBackErrorHandler(),
199:    PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscAbortErrorHandler()

201:    Concepts: error handler

203: .seealso:  PetscPushErrorHandler(), PetscPopErrorHandler().
204:  @*/

206: PetscErrorCode  PetscReturnErrorHandler(int line,const char *fun,const char* file,const char *dir,PetscErrorCode n,int p,const char *mess,void *ctx)
207: {
209:   PetscFunctionReturn(n);
210: }

212: static char PetscErrorBaseMessage[1024];
213: /*
214:        The numerical values for these are defined in include/petscerror.h; any changes
215:    there must also be made here
216: */
217: static const char *PetscErrorStrings[] = {
218:   /*55 */ "Out of memory",
219:           "No support for this operation for this object type",
220:           "No support for this operation on this system",
221:   /*58 */ "Operation done in wrong order",
222:   /*59 */ "Signal received",
223:   /*60 */ "Nonconforming object sizes",
224:           "Argument aliasing not permitted",
225:           "Invalid argument",
226:   /*63 */ "Argument out of range",
227:           "Corrupt argument: see http://www.mcs.anl.gov/petsc/petsc-as/documentation/troubleshooting.html#Corrupt",
228:           "Unable to open file",
229:           "Read from file failed",
230:           "Write to file failed",
231:           "Invalid pointer",
232:   /*69 */ "Arguments must have same type",
233:           "",
234:   /*71 */ "Detected zero pivot in LU factorization\nsee http://www.mcs.anl.gov/petsc/petsc-as/documentation/troubleshooting.html#ZeroPivot",
235:   /*72 */ "Floating point exception",
236:   /*73 */ "Object is in wrong state",
237:           "Corrupted Petsc object",
238:           "Arguments are incompatible",
239:           "Error in external library",
240:   /*77 */ "Petsc has generated inconsistent data",
241:           "Memory corruption",
242:           "Unexpected data in file",
243:   /*80 */ "Arguments must have same communicators",
244:   /*81 */ "Detected zero pivot in Cholesky factorization\nsee http://www.mcs.anl.gov/petsc/petsc-as/documentation/troubleshooting.html#ZeroPivot",
245:           "  ",
246:           "  ",
247:           "  ",
248:   /*85 */ "Null argument, when expecting valid pointer",
249:   /*86 */ "Unknown type. Check for miss-spelling or missing external package needed for type"};

253: /*@C
254:    PetscErrorMessage - returns the text string associated with a PETSc error code.

256:    Not Collective

258:    Input Parameter:
259: .   errnum - the error code

261:    Output Parameter: 
262: +  text - the error message (PETSC_NULL if not desired) 
263: -  specific - the specific error message that was set with SETERRxxx() or PetscError().  (PETSC_NULL if not desired) 

265:    Level: developer

267:    Concepts: error handler^messages

269: .seealso:  PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(), 
270:           PetscAbortErrorHandler(), PetscTraceBackErrorHandler()
271:  @*/
272: PetscErrorCode  PetscErrorMessage(int errnum,const char *text[],char **specific)
273: {
275:   if (text && errnum > PETSC_ERR_MIN_VALUE && errnum < PETSC_ERR_MAX_VALUE) {
276:     *text = PetscErrorStrings[errnum-PETSC_ERR_MIN_VALUE-1];
277:   } else if (text) *text = 0;

279:   if (specific) {
280:     *specific = PetscErrorBaseMessage;
281:   }
282:   return(0);
283: }

285: #if defined(PETSC_USE_ERRORCHECKING)
286: PetscErrorCode  PetscErrorUncatchable[PETSC_EXCEPTIONS_MAX] = {0};
287: PetscInt        PetscErrorUncatchableCount                  = 0;
288: PetscErrorCode  PetscExceptions[PETSC_EXCEPTIONS_MAX]       = {0};
289: PetscInt        PetscExceptionsCount                        = 0;
290: PetscErrorCode  PetscExceptionTmp                           = 0;

294: /*@C
295:       PetscErrorIsCatchable - Returns if a PetscErrorCode can be caught with a PetscExceptionTry1() or
296:            PetscExceptionPush()

298:   Input Parameters:
299: .   err - error code 

301:   Level: advanced

303:    Notes:
304:     PETSc must not be configured using the option --with-errorchecking=0 for this to work

306: .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop(), PetscErrorSetCatchable()
307: @*/
308: PetscTruth  PetscErrorIsCatchable(PetscErrorCode err)
309: {
310:   PetscInt i;
311:   for (i=0; i<PetscErrorUncatchableCount; i++) {
312:     if (err == PetscErrorUncatchable[i]) return PETSC_FALSE;
313:   }
314:   return PETSC_TRUE;
315: }

319: /*@
320:       PetscErrorSetCatchable - Sets if a PetscErrorCode can be caught with a PetscExceptionTry1()
321:     PetscExceptionCaught() pair, or PetscExceptionPush(). By default all errors are catchable.

323:   Input Parameters:
324: +   err - error code 
325: -   flg - PETSC_TRUE means allow to be caught, PETSC_FALSE means do not allow to be caught

327:   Level: advanced

329:    Notes:
330:     PETSc must not be configured using the option --with-errorchecking=0 for this to work

332: .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop(), PetscErrorIsCatchable()
333: @*/
334: PetscErrorCode  PetscErrorSetCatchable(PetscErrorCode err,PetscTruth flg)
335: {
337:   if (!flg && PetscErrorIsCatchable(err)) {
338:     /* add to list of uncatchable */
339:     if (PetscErrorUncatchableCount >= PETSC_EXCEPTIONS_MAX) SETERRQ(PETSC_ERR_PLIB,"Stack for PetscErrorUncatchable is overflowed, recompile \nsrc/sysd/error/err.c with a larger value for PETSC_EXCEPTIONS_MAX");
340:     PetscErrorUncatchable[PetscErrorUncatchableCount++] = err;
341:   } else if (flg && !PetscErrorIsCatchable(err)) {
342:     /* remove from list of uncatchable */
343:     PetscInt i;
344:     for (i=0; i<PetscErrorUncatchableCount; i++) {
345:       if (PetscErrorUncatchable[i] == err) break;
346:     }
347:     for (;i<PetscErrorUncatchableCount; i++) {
348:       PetscErrorUncatchable[i] = PetscErrorUncatchable[i+1];
349:     }
350:     PetscErrorUncatchableCount--;
351:   }
352:   return(0);
353: }

357: /*@
358:       PetscExceptionPush - Adds the exception as one to be caught and passed up. If passed up
359:         can be checked with PetscExceptionCaught() or PetscExceptionValue()

361:   Input Parameters:
362: .   err - the exception to catch

364:   Level: advanced

366:    Notes:
367:     PETSc must not be configured using the option --with-errorchecking=0 for this to work

369:     Use PetscExceptionPop() to remove this as a value to be caught

371:     This is not usually needed in C/C++ rather use PetscExceptionTry1()

373: .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop()
374: @*/
375: PetscErrorCode  PetscExceptionPush(PetscErrorCode err)
376: {
378:   if (PetscExceptionsCount >= PETSC_EXCEPTIONS_MAX) SETERRQ(PETSC_ERR_PLIB,"Stack for PetscExceptions is overflowed, recompile \nsrc/sysd/error/err.c with a larger value for PETSC_EXCEPTIONS_MAX");
379:   if (PetscErrorIsCatchable(err)) PetscExceptions[PetscExceptionsCount++] = err;
380:   return(0);
381: }

385: /*@
386:       PetscExceptionPop - Removes  the most recent exception asked to be caught with PetscExceptionPush()

388:   Input Parameters:
389: .   err - the exception that was pushed

391:   Level: advanced

393:    Notes:
394:     PETSc must not be configured using the option --with-errorchecking=0 for this to work

396:     This is not usually needed in C/C++ rather use PetscExceptionTry1()

398: .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop()
399: @*/
400: PetscErrorCode  PetscExceptionPop(PetscErrorCode err)
401: {
403:   if (PetscExceptionsCount <= 0)SETERRQ(PETSC_ERR_PLIB,"Stack for PetscExceptions is empty");
404:   if (PetscErrorIsCatchable(err)) PetscExceptionsCount--;
405:   return(0);
406: }
407: #endif

411: /*@C
412:    PetscError - Routine that is called when an error has been detected, 
413:    usually called through the macro SETERRQ().

415:    Not Collective

417:    Input Parameters:
418: +  line - the line number of the error (indicated by __LINE__)
419: .  func - the function where the error occured (indicated by __FUNCT__)
420: .  dir - the directory of file (indicated by __SDIR__)
421: .  file - the file in which the error was detected (indicated by __FILE__)
422: .  mess - an error text string, usually just printed to the screen
423: .  n - the generic error number
424: .  p - 1 indicates the error was initially detected, 0 indicates this is a traceback from a 
425:    previously detected error
426: -  mess - formatted message string - aka printf

428:   Level: intermediate

430:    Notes:
431:    Most users need not directly use this routine and the error handlers, but
432:    can instead use the simplified interface SETERRQ, which has the calling 
433:    sequence
434: $     SETERRQ(n,mess)

436:    Experienced users can set the error handler with PetscPushErrorHandler().

438:    Concepts: error^setting condition

440: .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2()
441: @*/
442: PetscErrorCode  PetscError(int line,const char *func,const char* file,const char *dir,PetscErrorCode n,int p,const char *mess,...)
443: {
444:   va_list        Argp;
446:   char           buf[2048],*lbuf = 0;
447:   PetscTruth     ismain,isunknown;
448: #if defined(PETSC_USE_ERRORCHECKING)
449:   PetscInt       i;
450: #endif

452:   if (!func)  func = "User provided function";
453:   if (!file)  file = "User file";
454:   if (!dir)   dir = " ";

457:   /* Compose the message evaluating the print format */
458:   if (mess) {
459:     va_start(Argp,mess);
460:     PetscVSNPrintf(buf,2048,mess,Argp);
461:     va_end(Argp);
462:     lbuf = buf;
463:     if (p == 1) {
464:       PetscStrncpy(PetscErrorBaseMessage,lbuf,1023);
465:     }
466:   }

468: #if defined(PETSC_USE_ERRORCHECKING)
469:   /* check if user is catching this exception */
470:   for (i=0; i<PetscExceptionsCount; i++) {
471:     if (n == PetscExceptions[i])  PetscFunctionReturn(n);
472:   }
473: #endif

475:   if (!eh)     PetscTraceBackErrorHandler(line,func,file,dir,n,p,lbuf,0);
476:   else         (*eh->handler)(line,func,file,dir,n,p,lbuf,eh->ctx);

478:   /* 
479:       If this is called from the main() routine we call MPI_Abort() instead of 
480:     return to allow the parallel program to be properly shutdown.

482:     Since this is in the error handler we don't check the errors below. Of course,
483:     PetscStrncmp() does its own error checking which is problamatic
484:   */
485:   PetscStrncmp(func,"main",4,&ismain);
486:   PetscStrncmp(func,"unknown",7,&isunknown);
487:   if (ismain || isunknown) {
488:     MPI_Abort(PETSC_COMM_WORLD,(int)ierr);
489:   }
490:   PetscFunctionReturn(ierr);
491: }

493: /* -------------------------------------------------------------------------*/

497: /*@C
498:     PetscIntView - Prints an array of integers; useful for debugging.

500:     Collective on PetscViewer

502:     Input Parameters:
503: +   N - number of integers in array
504: .   idx - array of integers
505: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

507:   Level: intermediate

509: .seealso: PetscRealView() 
510: @*/
511: PetscErrorCode  PetscIntView(PetscInt N,PetscInt idx[],PetscViewer viewer)
512: {
514:   PetscInt       j,i,n = N/20,p = N % 20;
515:   PetscTruth     iascii,isbinary;
516:   MPI_Comm       comm;

519:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
522:   PetscObjectGetComm((PetscObject)viewer,&comm);

524:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);
525:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);
526:   if (iascii) {
527:     for (i=0; i<n; i++) {
528:       PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*i);
529:       for (j=0; j<20; j++) {
530:         PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[i*20+j]);
531:       }
532:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
533:     }
534:     if (p) {
535:       PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*n);
536:       for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[20*n+i]);}
537:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
538:     }
539:     PetscViewerFlush(viewer);
540:   } else if (isbinary) {
541:     PetscMPIInt rank,size,*sizes,Ntotal,*displs, NN = (PetscMPIInt)N;
542:     PetscInt    *array;
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(idx,NN,MPIU_INT,0,0,0,MPIU_INT,0,comm);
550:       } else {
551:         PetscMalloc(size*sizeof(PetscMPIInt),&sizes);
552:         MPI_Gather(&NN,1,MPI_INT,sizes,1,MPIU_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(PetscInt),&array);
561:         MPI_Gatherv(idx,NN,MPIU_INT,array,sizes,displs,MPIU_INT,0,comm);
562:         PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_INT,PETSC_TRUE);
563:         PetscFree(sizes);
564:         PetscFree(displs);
565:         PetscFree(array);
566:       }
567:     } else {
568:       PetscViewerBinaryWrite(viewer,idx,N,PETSC_INT,PETSC_FALSE);
569:     }
570:   } else {
571:     const char *tname;
572:     PetscObjectGetName((PetscObject)viewer,&tname);
573:     SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
574:   }
575:   return(0);
576: }

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

583:     Collective on PetscViewer

585:     Input Parameters:
586: +   N - number of doubles in array
587: .   idx - array of doubles
588: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

590:   Level: intermediate

592: .seealso: PetscIntView() 
593: @*/
594: PetscErrorCode  PetscRealView(PetscInt N,PetscReal idx[],PetscViewer viewer)
595: {
597:   PetscInt       j,i,n = N/5,p = N % 5;
598:   PetscTruth     iascii,isbinary;
599:   MPI_Comm       comm;

602:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
605:   PetscObjectGetComm((PetscObject)viewer,&comm);

607:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);
608:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);
609:   if (iascii) {
610:     for (i=0; i<n; i++) {
611:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*i);
612:       for (j=0; j<5; j++) {
613:          PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*5+j]);
614:       }
615:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
616:     }
617:     if (p) {
618:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*n);
619:       for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[5*n+i]);}
620:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
621:     }
622:     PetscViewerFlush(viewer);
623:   } else if (isbinary) {
624:     PetscMPIInt rank,size,*sizes,*displs, Ntotal,NN = (PetscMPIInt)N;
625:     PetscReal   *array;

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

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

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

667:     Collective on PetscViewer

669:     Input Parameters:
670: +   N - number of scalars in array
671: .   idx - array of scalars
672: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

674:   Level: intermediate

676: .seealso: PetscIntView(), PetscRealView()
677: @*/
678: PetscErrorCode  PetscScalarView(PetscInt N,PetscScalar idx[],PetscViewer viewer)
679: {
681:   PetscInt       j,i,n = N/3,p = N % 3;
682:   PetscTruth     iascii,isbinary;
683:   MPI_Comm       comm;

686:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
689:   PetscObjectGetComm((PetscObject)viewer,&comm);

691:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);
692:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);
693:   if (iascii) {
694:     for (i=0; i<n; i++) {
695:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);
696:       for (j=0; j<3; j++) {
697: #if defined (PETSC_USE_COMPLEX)
698:         PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
699:                                  PetscRealPart(idx[i*3+j]),PetscImaginaryPart(idx[i*3+j]));
700: #else       
701:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*3+j]);
702: #endif
703:       }
704:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
705:     }
706:     if (p) {
707:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);
708:       for (i=0; i<p; i++) {
709: #if defined (PETSC_USE_COMPLEX)
710:         PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
711:                                  PetscRealPart(idx[n*3+i]),PetscImaginaryPart(idx[n*3+i]));
712: #else
713:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[3*n+i]);
714: #endif
715:       }
716:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
717:     }
718:     PetscViewerFlush(viewer);
719:   } else if (isbinary) {
720:     PetscMPIInt size,rank,*sizes,Ntotal,*displs,NN = (PetscMPIInt)N;
721:     PetscScalar *array;

723:     MPI_Comm_rank(comm,&rank);
724:     MPI_Comm_size(comm,&size);

726:     if (size > 1) {
727:       if (rank) {
728:         MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
729:         MPI_Gatherv(idx,NN,MPIU_SCALAR,0,0,0,MPIU_SCALAR,0,comm);
730:       } else {
731:         PetscMalloc(size*sizeof(PetscMPIInt),&sizes);
732:         MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
733:         Ntotal = sizes[0];
734:         PetscMalloc(size*sizeof(PetscMPIInt),&displs);
735:         displs[0] = 0;
736:         for (i=1; i<size; i++) {
737:           Ntotal    += sizes[i];
738:           displs[i] =  displs[i-1] + sizes[i-1];
739:         }
740:         PetscMalloc(Ntotal*sizeof(PetscScalar),&array);
741:         MPI_Gatherv(idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);
742:         PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR,PETSC_TRUE);
743:         PetscFree(sizes);
744:         PetscFree(displs);
745:         PetscFree(array);
746:       }
747:     } else {
748:       PetscViewerBinaryWrite(viewer,idx,N,PETSC_SCALAR,PETSC_FALSE);
749:     }
750:   } else {
751:     const char *tname;
752:     PetscObjectGetName((PetscObject)viewer,&tname);
753:     SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
754:   }
755:   return(0);
756: }