Actual source code: err.c

  1: /*$Id: err.c,v 1.130 2001/09/07 15:24:29 bsmith Exp $*/
  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:   int    (*handler)(int,char*,char*,char *,int,int,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.  The
 55:    currently available PETSc error handlers include PetscTraceBackErrorHandler(),
 56:    PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscStopErrorHandler()

 58:    Concepts: emacs^going to on error
 59:    Concepts: error handler^going to line in emacs

 61: .seealso:  PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(), 
 62:           PetscAbortErrorHandler()
 63:  @*/
 64: int PetscEmacsClientErrorHandler(int line,char *fun,char* file,char *dir,int n,int p,char *mess,void *ctx)
 65: {
 66:   int         ierr;
 67:   char        command[PETSC_MAX_PATH_LEN],*pdir;
 68:   FILE        *fp;

 71:   /* Note: don't check error codes since this an error handler :-) */
 72:   PetscGetPetscDir(&pdir);
 73:   sprintf(command,"emacsclient +%d %s/%s%s\n",line,pdir,dir,file);
 74:   PetscPOpen(MPI_COMM_WORLD,(char*)ctx,command,"r",&fp);
 75:   PetscFClose(MPI_COMM_WORLD,fp);
 76:   PetscPopErrorHandler(); /* remove this handler from the stack of handlers */
 77:   if (!eh)     PetscTraceBackErrorHandler(line,fun,file,dir,n,p,mess,0);
 78:   else         (*eh->handler)(line,fun,file,dir,n,p,mess,eh->ctx);
 79:   PetscFunctionReturn(ierr);
 80: }

 84: /*@C
 85:    PetscPushErrorHandler - Sets a routine to be called on detection of errors.

 87:    Not Collective

 89:    Input Parameters:
 90: +  handler - error handler routine
 91: -  ctx - optional handler context that contains information needed by the handler (for 
 92:          example file pointers for error messages etc.)

 94:    Calling sequence of handler:
 95: $    int handler(int line,char *func,char *file,char *dir,int n,int p,char *mess,void *ctx);

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

106:    Options Database Keys:
107: +   -on_error_attach_debugger <noxterm,gdb or dbx>
108: -   -on_error_abort

110:    Level: intermediate

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

114: @*/
115: int PetscPushErrorHandler(int (*handler)(int,char *,char*,char*,int,int,char*,void*),void *ctx)
116: {
117:   EH  neweh;

121:   PetscNew(struct _EH,&neweh);
122:   if (eh) {neweh->previous = eh;}
123:   else    {neweh->previous = 0;}
124:   neweh->handler = handler;
125:   neweh->ctx     = ctx;
126:   eh             = neweh;
127:   return(0);
128: }

132: /*@C
133:    PetscPopErrorHandler - Removes the latest error handler that was 
134:    pushed with PetscPushErrorHandler().

136:    Not Collective

138:    Level: intermediate

140:    Concepts: error handler^setting

142: .seealso: PetscPushErrorHandler()
143: @*/
144: int PetscPopErrorHandler(void)
145: {
146:   EH  tmp;

150:   if (!eh) return(0);
151:   tmp  = eh;
152:   eh   = eh->previous;
153:   PetscFree(tmp);

155:   return(0);
156: }
157: 
158: char PetscErrorBaseMessage[1024];

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

166:    Not Collective

168:    Input Parameters:
169: +  line - the line number of the error (indicated by __LINE__)
170: .  func - the function where the error occured (indicated by __FUNCT__)
171: .  dir - the directory of file (indicated by __SDIR__)
172: .  file - the file in which the error was detected (indicated by __FILE__)
173: .  mess - an error text string, usually just printed to the screen
174: .  n - the generic error number
175: .  p - 1 indicates the error was initially detected, 0 indicates this is a traceback from a 
176:    previously detected error
177: -  mess - formatted message string - aka printf

179:   Level: intermediate

181:    Notes:
182:    Most users need not directly use this routine and the error handlers, but
183:    can instead use the simplified interface SETERRQ, which has the calling 
184:    sequence
185: $     SETERRQ(n,mess)

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

189:    Concepts: error^setting condition

191: .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ(), SETERRQ1(), SETERRQ2()
192: @*/
193: int PetscError(int line,char *func,char* file,char *dir,int n,int p,char *mess,...)
194: {
195:   va_list     Argp;
196:   int         ierr;
197:   char        buf[2048],*lbuf = 0;
198:   PetscTruth  ismain,isunknown;

200:   if (!func)  func = "User provided function";
201:   if (!file)  file = "User file";
202:   if (!dir)   dir = " ";

205:   /* Compose the message evaluating the print format */
206:   if (mess) {
207:     va_start(Argp,mess);
208: #if defined(PETSC_HAVE_VPRINTF_CHAR)
209:     vsprintf(buf,mess,(char *)Argp);
210: #else
211:     vsprintf(buf,mess,Argp);
212: #endif
213:     va_end(Argp);
214:     lbuf = buf;
215:     if (p == 1) {
216:       PetscStrncpy(PetscErrorBaseMessage,lbuf,1023);
217:     }
218:   }

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

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

227:     Since this is in the error handler we don't check the errors below. Of course,
228:     PetscStrncmp() does its own error checking which is problamatic
229:   */
230:   PetscStrncmp(func,"main",4,&ismain);
231:   PetscStrncmp(func,"unknown",7,&isunknown);
232:   if (ismain || isunknown) {
233:     MPI_Abort(PETSC_COMM_WORLD,ierr);
234:   }
235:   PetscFunctionReturn(ierr);
236: }

238: /* -------------------------------------------------------------------------*/

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

245:     Collective on PetscViewer

247:     Input Parameters:
248: +   N - number of integers in array
249: .   idx - array of integers
250: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

252:   Level: intermediate

254: .seealso: PetscRealView() 
255: @*/
256: int PetscIntView(int N,int idx[],PetscViewer viewer)
257: {
258:   int        j,i,n = N/20,p = N % 20,ierr;
259:   PetscTruth isascii,issocket;
260:   MPI_Comm   comm;

263:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
266:   PetscObjectGetComm((PetscObject)viewer,&comm);

268:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);
269:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_SOCKET,&issocket);
270:   if (isascii) {
271:     for (i=0; i<n; i++) {
272:       PetscViewerASCIISynchronizedPrintf(viewer,"%d:",20*i);
273:       for (j=0; j<20; j++) {
274:         PetscViewerASCIISynchronizedPrintf(viewer," %d",idx[i*20+j]);
275:       }
276:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
277:     }
278:     if (p) {
279:       PetscViewerASCIISynchronizedPrintf(viewer,"%d:",20*n);
280:       for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %d",idx[20*n+i]);}
281:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
282:     }
283:     PetscViewerFlush(viewer);
284:   } else if (issocket) {
285:     int *array,*sizes,rank,size,Ntotal,*displs;

287:     MPI_Comm_rank(comm,&rank);
288:     MPI_Comm_size(comm,&size);

290:     if (size > 1) {
291:       if (rank) {
292:         MPI_Gather(&N,1,MPI_INT,0,0,MPI_INT,0,comm);
293:         MPI_Gatherv(idx,N,MPI_INT,0,0,0,MPI_INT,0,comm);
294:       } else {
295:         PetscMalloc(size*sizeof(int),&sizes);
296:         MPI_Gather(&N,1,MPI_INT,sizes,1,MPI_INT,0,comm);
297:         Ntotal    = sizes[0];
298:         PetscMalloc(size*sizeof(int),&displs);
299:         displs[0] = 0;
300:         for (i=1; i<size; i++) {
301:           Ntotal    += sizes[i];
302:           displs[i] =  displs[i-1] + sizes[i-1];
303:         }
304:         PetscMalloc(Ntotal*sizeof(int),&array);
305:         MPI_Gatherv(idx,N,MPI_INT,array,sizes,displs,MPI_INT,0,comm);
306:         PetscViewerSocketPutInt(viewer,Ntotal,array);
307:         PetscFree(sizes);
308:         PetscFree(displs);
309:         PetscFree(array);
310:       }
311:     } else {
312:       PetscViewerSocketPutInt(viewer,N,idx);
313:     }
314:   } else {
315:     SETERRQ(1,"Cannot handle that PetscViewer");
316:   }
317:   return(0);
318: }

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

325:     Collective on PetscViewer

327:     Input Parameters:
328: +   N - number of doubles in array
329: .   idx - array of doubles
330: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

332:   Level: intermediate

334: .seealso: PetscIntView() 
335: @*/
336: int PetscRealView(int N,PetscReal idx[],PetscViewer viewer)
337: {
338:   int        j,i,n = N/5,p = N % 5,ierr;
339:   PetscTruth isascii,issocket;
340:   MPI_Comm   comm;

343:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
346:   PetscObjectGetComm((PetscObject)viewer,&comm);

348:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);
349:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_SOCKET,&issocket);
350:   if (isascii) {
351:     for (i=0; i<n; i++) {
352:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*i);
353:       for (j=0; j<5; j++) {
354:          PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*5+j]);
355:       }
356:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
357:     }
358:     if (p) {
359:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*n);
360:       for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[5*n+i]);}
361:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
362:     }
363:     PetscViewerFlush(viewer);
364:   } else if (issocket) {
365:     int    *sizes,rank,size,Ntotal,*displs;
366:     PetscReal *array;

368:     MPI_Comm_rank(comm,&rank);
369:     MPI_Comm_size(comm,&size);

371:     if (size > 1) {
372:       if (rank) {
373:         MPI_Gather(&N,1,MPI_INT,0,0,MPI_INT,0,comm);
374:         MPI_Gatherv(idx,N,MPI_DOUBLE,0,0,0,MPI_DOUBLE,0,comm);
375:       } else {
376:         PetscMalloc(size*sizeof(int),&sizes);
377:         MPI_Gather(&N,1,MPI_INT,sizes,1,MPI_INT,0,comm);
378:         Ntotal = sizes[0];
379:         PetscMalloc(size*sizeof(int),&displs);
380:         displs[0] = 0;
381:         for (i=1; i<size; i++) {
382:           Ntotal    += sizes[i];
383:           displs[i] =  displs[i-1] + sizes[i-1];
384:         }
385:         PetscMalloc(Ntotal*sizeof(PetscReal),&array);
386:         MPI_Gatherv(idx,N,MPI_DOUBLE,array,sizes,displs,MPI_DOUBLE,0,comm);
387:         PetscViewerSocketPutReal(viewer,Ntotal,1,array);
388:         PetscFree(sizes);
389:         PetscFree(displs);
390:         PetscFree(array);
391:       }
392:     } else {
393:       PetscViewerSocketPutReal(viewer,N,1,idx);
394:     }
395:   } else {
396:     SETERRQ(1,"Cannot handle that PetscViewer");
397:   }
398:   return(0);
399: }

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

406:     Collective on PetscViewer

408:     Input Parameters:
409: +   N - number of scalars in array
410: .   idx - array of scalars
411: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

413:   Level: intermediate

415: .seealso: PetscIntView(), PetscRealView()
416: @*/
417: int PetscScalarView(int N,PetscScalar idx[],PetscViewer viewer)
418: {
419:   int        j,i,n = N/3,p = N % 3,ierr;
420:   PetscTruth isascii,issocket;
421:   MPI_Comm   comm;

424:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
427:   PetscObjectGetComm((PetscObject)viewer,&comm);

429:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);
430:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_SOCKET,&issocket);
431:   if (isascii) {
432:     for (i=0; i<n; i++) {
433:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);
434:       for (j=0; j<3; j++) {
435: #if defined (PETSC_USE_COMPLEX)
436:         PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
437:                                  PetscRealPart(idx[i*3+j]),PetscImaginaryPart(idx[i*3+j]));
438: #else       
439:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*3+j]);
440: #endif
441:       }
442:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
443:     }
444:     if (p) {
445:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);
446:       for (i=0; i<p; i++) {
447: #if defined (PETSC_USE_COMPLEX)
448:         PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
449:                                  PetscRealPart(idx[n*3+i]),PetscImaginaryPart(idx[n*3+i]));
450: #else
451:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[3*n+i]);
452: #endif
453:       }
454:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
455:     }
456:     PetscViewerFlush(viewer);
457:   } else if (issocket) {
458:     int         *sizes,rank,size,Ntotal,*displs;
459:     PetscScalar *array;

461:     MPI_Comm_rank(comm,&rank);
462:     MPI_Comm_size(comm,&size);

464:     if (size > 1) {
465:       if (rank) {
466:         MPI_Gather(&N,1,MPI_INT,0,0,MPI_INT,0,comm);
467:         MPI_Gatherv(idx,N,MPIU_SCALAR,0,0,0,MPIU_SCALAR,0,comm);
468:       } else {
469:         PetscMalloc(size*sizeof(int),&sizes);
470:         MPI_Gather(&N,1,MPI_INT,sizes,1,MPI_INT,0,comm);
471:         Ntotal = sizes[0];
472:         PetscMalloc(size*sizeof(int),&displs);
473:         displs[0] = 0;
474:         for (i=1; i<size; i++) {
475:           Ntotal    += sizes[i];
476:           displs[i] =  displs[i-1] + sizes[i-1];
477:         }
478:         PetscMalloc(Ntotal*sizeof(PetscScalar),&array);
479:         MPI_Gatherv(idx,N,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);
480:         PetscViewerSocketPutScalar(viewer,Ntotal,1,array);
481:         PetscFree(sizes);
482:         PetscFree(displs);
483:         PetscFree(array);
484:       }
485:     } else {
486:       PetscViewerSocketPutScalar(viewer,N,1,idx);
487:     }
488:   } else {
489:     SETERRQ(1,"Cannot handle that PetscViewer");
490:   }
491:   return(0);
492: }