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 currently available PETSc error handlers include PetscTraceBackErrorHandler(),
117:    PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscMPIAbortErrorHandler(), PetscReturnErrorHandler().

119:    Fortran Notes: You can only push one error handler from Fortran before poping it.

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

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

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

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

145:    Not Collective

147:    Level: intermediate

149:    Concepts: error handler^setting

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

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

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

173:    Not Collective

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

185:    Level: developer

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

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

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

202:    Concepts: error handler

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

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

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

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

260:    Not Collective

262:    Input Parameter:
263: .   errnum - the error code

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

269:    Level: developer

271:    Concepts: error handler^messages

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

283:   if (specific) {
284:     *specific = PetscErrorBaseMessage;
285:   }
286:   return(0);
287: }

289: #if defined(PETSC_USE_ERRORCHECKING)
290: PetscErrorCode  PetscErrorUncatchable[PETSC_EXCEPTIONS_MAX] = {0};
291: PetscInt        PetscErrorUncatchableCount                  = 0;
292: PetscErrorCode  PetscExceptions[PETSC_EXCEPTIONS_MAX]       = {0};
293: PetscInt        PetscExceptionsCount                        = 0;
294: PetscErrorCode  PetscExceptionTmp                           = 0;
295: PetscErrorCode  PetscExceptionTmp1                          = 0;

299: /*@C
300:       PetscErrorIsCatchable - Returns if a PetscErrorCode can be caught with a PetscExceptionTry1() or
301:            PetscExceptionPush()

303:   Input Parameters:
304: .   err - error code 

306:   Level: advanced

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

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

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

328:   Input Parameters:
329: +   err - error code 
330: -   flg - PETSC_TRUE means allow to be caught, PETSC_FALSE means do not allow to be caught

332:   Level: advanced

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

337: .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop(), PetscErrorIsCatchable()
338: @*/
339: PetscErrorCode  PetscErrorSetCatchable(PetscErrorCode err,PetscTruth flg)
340: {
342:   if (!flg && PetscErrorIsCatchable(err)) {
343:     /* add to list of uncatchable */
344:     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");
345:     PetscErrorUncatchable[PetscErrorUncatchableCount++] = err;
346:   } else if (flg && !PetscErrorIsCatchable(err)) {
347:     /* remove from list of uncatchable */
348:     PetscInt i;
349:     for (i=0; i<PetscErrorUncatchableCount; i++) {
350:       if (PetscErrorUncatchable[i] == err) break;
351:     }
352:     for (;i<PetscErrorUncatchableCount; i++) {
353:       PetscErrorUncatchable[i] = PetscErrorUncatchable[i+1];
354:     }
355:     PetscErrorUncatchableCount--;
356:   }
357:   return(0);
358: }

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

366:   Input Parameters:
367: .   err - the exception to catch

369:   Level: advanced

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

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

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

378: .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop()
379: @*/
380: PetscErrorCode  PetscExceptionPush(PetscErrorCode err)
381: {
383:   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");
384:   if (PetscErrorIsCatchable(err)) PetscExceptions[PetscExceptionsCount++] = err;
385:   return(0);
386: }

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

393:   Input Parameters:
394: .   err - the exception that was pushed

396:   Level: advanced

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

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

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

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

420:    Not Collective

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

433:   Level: intermediate

435:    Notes:
436:    Most users need not directly use this routine and the error handlers, but
437:    can instead use the simplified interface SETERRQ, which has the calling 
438:    sequence
439: $     SETERRQ(n,mess)

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

443:    Concepts: error^setting condition

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

458:   if (!func)  func = "User provided function";
459:   if (!file)  file = "User file";
460:   if (!dir)   dir = " ";

463:   /* Compose the message evaluating the print format */
464:   if (mess) {
465:     va_start(Argp,mess);
466:     PetscVSNPrintf(buf,2048,mess,&fullLength,Argp);
467:     va_end(Argp);
468:     lbuf = buf;
469:     if (p == 1) {
470:       PetscStrncpy(PetscErrorBaseMessage,lbuf,1023);
471:     }
472:   }

474: #if defined(PETSC_USE_ERRORCHECKING)
475:   /* check if user is catching this exception */
476:   for (i=0; i<PetscExceptionsCount; i++) {
477:     if (n == PetscExceptions[i])  PetscFunctionReturn(n);
478:   }
479: #endif

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

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

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

499: #ifdef PETSC_CLANGUAGE_CXX
502: /*@C
503:    PetscErrorCxx - Routine that is called when an error has been detected, 
504:    usually called through the macro SETERROR().

506:    Not Collective

508:    Input Parameters:
509: +  line - the line number of the error (indicated by __LINE__)
510: .  func - the function where the error occured (indicated by __FUNCT__)
511: .  dir - the directory of file (indicated by __SDIR__)
512: .  file - the file in which the error was detected (indicated by __FILE__)
513: .  n - the generic error number
514: .  p - 1 indicates the error was initially detected, 0 indicates this is a traceback from a 
515:    previously detected error

517:   Level: intermediate

519:    Notes:
520:    Most users need not directly use this routine and the error handlers, but
521:    can instead use the simplified interface SETERRQ, which has the calling 
522:    sequence
523: $     SETERRQ(n,mess)

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

527:    Concepts: error^setting condition

529: .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2()
530: @*/
531: void  PetscErrorCxx(int line,const char *func,const char* file,const char *dir,PetscErrorCode n,int p)
532: {
533:   PetscTruth ismain, isunknown;
534: #if 0
535: #if defined(PETSC_USE_ERRORCHECKING)
536:   PetscInt   i;
537: #endif
538: #endif

540:   if (!func) func = "User provided function";
541:   if (!file) file = "User file";
542:   if (!dir)  dir  = " ";

544: #if 0
545: #if defined(PETSC_USE_ERRORCHECKING)
546:   /* check if user is catching this exception */
547:   for (i=0; i<PetscExceptionsCount; i++) {
548:     if (n == PetscExceptions[i])  PetscFunctionReturn(n);
549:   }
550: #endif
551: #endif

553:   std::ostringstream msg;

555:   PetscTraceBackErrorHandlerCxx(line, func, file, dir, n, p, msg);

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

561:     Since this is in the error handler we don't check the errors below. Of course,
562:     PetscStrncmp() does its own error checking which is problamatic
563:   */
564:   PetscStrncmp(func,"main",4,&ismain);
565:   PetscStrncmp(func,"unknown",7,&isunknown);
566:   if (ismain || isunknown) {
567:     MPI_Abort(PETSC_COMM_WORLD, (int) n);
568:   }
569:   throw PETSc::Exception(msg.str().c_str());
570: }
571: #endif

573: /* -------------------------------------------------------------------------*/

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

580:     Collective on PetscViewer

582:     Input Parameters:
583: +   N - number of integers in array
584: .   idx - array of integers
585: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

587:   Level: intermediate

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

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

601:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
604:   PetscObjectGetComm((PetscObject)viewer,&comm);

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

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

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

665:     Collective on PetscViewer

667:     Input Parameters:
668: +   N - number of doubles in array
669: .   idx - array of doubles
670: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

672:   Level: intermediate

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

676: .seealso: PetscIntView() 
677: @*/
678: PetscErrorCode  PetscRealView(PetscInt N,PetscReal idx[],PetscViewer viewer)
679: {
681:   PetscInt       j,i,n = N/5,p = N % 5;
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:",5*i);
696:       for (j=0; j<5; j++) {
697:          PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*5+j]);
698:       }
699:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
700:     }
701:     if (p) {
702:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*n);
703:       for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[5*n+i]);}
704:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
705:     }
706:     PetscViewerFlush(viewer);
707:   } else if (isbinary) {
708:     PetscMPIInt rank,size,*sizes,*displs, Ntotal,NN = PetscMPIIntCast(N);
709:     PetscReal   *array;

711:     MPI_Comm_rank(comm,&rank);
712:     MPI_Comm_size(comm,&size);

714:     if (size > 1) {
715:       if (rank) {
716:         MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
717:         MPI_Gatherv((void*)idx,NN,MPI_DOUBLE,0,0,0,MPI_DOUBLE,0,comm);
718:       } else {
719:         PetscMalloc(size*sizeof(PetscMPIInt),&sizes);
720:         MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
721:         Ntotal = sizes[0];
722:         PetscMalloc(size*sizeof(PetscMPIInt),&displs);
723:         displs[0] = 0;
724:         for (i=1; i<size; i++) {
725:           Ntotal    += sizes[i];
726:           displs[i] =  displs[i-1] + sizes[i-1];
727:         }
728:         PetscMalloc(Ntotal*sizeof(PetscReal),&array);
729:         MPI_Gatherv((void*)idx,NN,MPI_DOUBLE,array,sizes,displs,MPI_DOUBLE,0,comm);
730:         PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_REAL,PETSC_TRUE);
731:         PetscFree(sizes);
732:         PetscFree(displs);
733:         PetscFree(array);
734:       }
735:     } else {
736:       PetscViewerBinaryWrite(viewer,idx,N,PETSC_REAL,PETSC_FALSE);
737:     }
738:   } else {
739:     const char *tname;
740:     PetscObjectGetName((PetscObject)viewer,&tname);
741:     SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
742:   }
743:   return(0);
744: }

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

751:     Collective on PetscViewer

753:     Input Parameters:
754: +   N - number of scalars in array
755: .   idx - array of scalars
756: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

758:   Level: intermediate

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

762: .seealso: PetscIntView(), PetscRealView()
763: @*/
764: PetscErrorCode  PetscScalarView(PetscInt N,PetscScalar idx[],PetscViewer viewer)
765: {
767:   PetscInt       j,i,n = N/3,p = N % 3;
768:   PetscTruth     iascii,isbinary;
769:   MPI_Comm       comm;

772:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
775:   PetscObjectGetComm((PetscObject)viewer,&comm);

777:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);
778:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);
779:   if (iascii) {
780:     for (i=0; i<n; i++) {
781:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);
782:       for (j=0; j<3; j++) {
783: #if defined (PETSC_USE_COMPLEX)
784:         PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
785:                                  PetscRealPart(idx[i*3+j]),PetscImaginaryPart(idx[i*3+j]));
786: #else       
787:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*3+j]);
788: #endif
789:       }
790:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
791:     }
792:     if (p) {
793:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);
794:       for (i=0; i<p; i++) {
795: #if defined (PETSC_USE_COMPLEX)
796:         PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
797:                                  PetscRealPart(idx[n*3+i]),PetscImaginaryPart(idx[n*3+i]));
798: #else
799:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[3*n+i]);
800: #endif
801:       }
802:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
803:     }
804:     PetscViewerFlush(viewer);
805:   } else if (isbinary) {
806:     PetscMPIInt size,rank,*sizes,Ntotal,*displs,NN = PetscMPIIntCast(N);
807:     PetscScalar *array;

809:     MPI_Comm_rank(comm,&rank);
810:     MPI_Comm_size(comm,&size);

812:     if (size > 1) {
813:       if (rank) {
814:         MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
815:         MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,0,0,0,MPIU_SCALAR,0,comm);
816:       } else {
817:         PetscMalloc(size*sizeof(PetscMPIInt),&sizes);
818:         MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
819:         Ntotal = sizes[0];
820:         PetscMalloc(size*sizeof(PetscMPIInt),&displs);
821:         displs[0] = 0;
822:         for (i=1; i<size; i++) {
823:           Ntotal    += sizes[i];
824:           displs[i] =  displs[i-1] + sizes[i-1];
825:         }
826:         PetscMalloc(Ntotal*sizeof(PetscScalar),&array);
827:         MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);
828:         PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR,PETSC_TRUE);
829:         PetscFree(sizes);
830:         PetscFree(displs);
831:         PetscFree(array);
832:       }
833:     } else {
834:       PetscViewerBinaryWrite(viewer,idx,N,PETSC_SCALAR,PETSC_FALSE);
835:     }
836:   } else {
837:     const char *tname;
838:     PetscObjectGetName((PetscObject)viewer,&tname);
839:     SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
840:   }
841:   return(0);
842: }