Actual source code: err.c

  1: /*$Id: err.c,v 1.127 2001/04/10 19:34:27 bsmith Exp $*/
  2: /*
  3:       Code that allows one to set the error handlers
  4: */
 5:  #include petsc.h
  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    cookie;
 14:   int    (*handler)(int,char*,char*,char *,int,int,char*,void *);
 15:   void   *ctx;
 16:   EH     previous;
 17: };

 19: static EH eh = 0;

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

 25:    Not Collective

 27:    Input Parameters:
 28: +  line - the line number of the error (indicated by __LINE__)
 29: .  file - the file in which the error was detected (indicated by __FILE__)
 30: .  dir - the directory of the file (indicated by __SDIR__)
 31: .  mess - an error text string, usually just printed to the screen
 32: .  n - the generic error number
 33: .  p - specific error number
 34: -  ctx - error handler context

 36:    Options Database:
 37: .   -on_error_emacs <machinename>

 39:    Level: developer

 41:    Notes:
 42:    You must put (server-start) in your .emacs file for the emacsclient software to work

 44:    Most users need not directly employ this routine and the other error 
 45:    handlers, but can instead use the simplified interface SETERRQ, which has 
 46:    the calling sequence
 47: $     SETERRQ(number,p,mess)

 49:    Notes for experienced users:
 50:    Use PetscPushErrorHandler() to set the desired error handler.  The
 51:    currently available PETSc error handlers include PetscTraceBackErrorHandler(),
 52:    PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscStopErrorHandler()

 54:    Concepts: emacs^going to on error
 55:    Concepts: error handler^going to line in emacs

 57: .seealso:  PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(), 
 58:           PetscAbortErrorHandler()
 59:  @*/
 60: int PetscEmacsClientErrorHandler(int line,char *fun,char* file,char *dir,int n,int p,char *mess,void *ctx)
 61: {
 62:   int         ierr;
 63:   char        command[1024];
 64:   FILE        *fp;

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

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

 80:    Not Collective

 82:    Input Parameters:
 83: +  handler - error handler routine
 84: -  ctx - optional handler context that contains information needed by the handler (for 
 85:          example file pointers for error messages etc.)

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

 90: .  line - the line number of the error (indicated by __LINE__)
 91: .  file - the file in which the error was detected (indicated by __FILE__)
 92: .  dir - the directory of the file (indicated by __SDIR__)
 93: .  n - the generic error number (see list defined in include/petscerror.h)
 94: .  p - the specific error number
 95: .  mess - an error text string, usually just printed to the screen
 96: -  ctx - the error handler context

 98:    Options Database Keys:
 99: +   -on_error_attach_debugger <noxterm,gdb or dbx>
100: -   -on_error_abort

102:    Level: intermediate

104:    Fortran Note:
105:    This routine is not supported in Fortran.

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

109: @*/
110: int PetscPushErrorHandler(int (*handler)(int,char *,char*,char*,int,int,char*,void*),void *ctx)
111: {
112:   EH  neweh;

116:   PetscNew(struct _EH,&neweh);
117:   if (eh) {neweh->previous = eh;}
118:   else    {neweh->previous = 0;}
119:   neweh->handler = handler;
120:   neweh->ctx     = ctx;
121:   eh             = neweh;
122:   return(0);
123: }

125: /*@C
126:    PetscPopErrorHandler - Removes the latest error handler that was 
127:    pushed with PetscPushErrorHandler().

129:    Not Collective

131:    Level: intermediate

133:    Fortran Note:
134:    This routine is not supported in Fortran.

136:    Concepts: error handler^setting

138: .seealso: PetscPushErrorHandler()
139: @*/
140: int PetscPopErrorHandler(void)
141: {
142:   EH  tmp;

146:   if (!eh) return(0);
147:   tmp  = eh;
148:   eh   = eh->previous;
149:   PetscFree(tmp);

151:   return(0);
152: }

154: char PetscErrorBaseMessage[1024];

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

160:    Not Collective

162:    Input Parameters:
163: +  line - the line number of the error (indicated by __LINE__)
164: .  dir - the directory of file (indicated by __SDIR__)
165: .  file - the file in which the error was detected (indicated by __FILE__)
166: .  mess - an error text string, usually just printed to the screen
167: .  n - the generic error number
168: .  p - 1 indicates the error was initially detected, 0 indicates this is a traceback from a 
169:    previously detected error
170: -  mess - formatted message string - aka printf

172:   Level: intermediate

174:    Notes:
175:    Most users need not directly use this routine and the error handlers, but
176:    can instead use the simplified interface SETERRQ, which has the calling 
177:    sequence
178: $     SETERRQ(n,mess)

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

182:    Concepts: error^setting condition

184: .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler()
185: @*/
186: int PetscError(int line,char *func,char* file,char *dir,int n,int p,char *mess,...)
187: {
188:   va_list     Argp;
189:   int         ierr;
190:   char        buf[2048],*lbuf = 0;
191:   PetscTruth  ismain,isunknown;

194:   /* Compose the message evaluating the print format */
195:   if (mess) {
196:     va_start(Argp,mess);
197: #if defined(PETSC_HAVE_VPRINTF_CHAR)
198:     vsprintf(buf,mess,(char *)Argp);
199: #else
200:     vsprintf(buf,mess,Argp);
201: #endif
202:     va_end(Argp);
203:     lbuf = buf;
204:     if (p == 1) {
205:       PetscStrncpy(PetscErrorBaseMessage,lbuf,1023);
206:     }
207:   }

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

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

216:     Since this is in the error handler we don't check the errors below. Of course,
217:     PetscStrncmp() does its own error checking which is problamatic
218:   */
219:   PetscStrncmp(func,"main",4,&ismain);
220:   PetscStrncmp(func,"unknown",7,&isunknown);
221:   if (ismain || isunknown) {
222:     MPI_Abort(PETSC_COMM_WORLD,ierr);
223:   }
224:   PetscFunctionReturn(ierr);
225: }

227: /* -------------------------------------------------------------------------*/

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

232:     Collective on PetscViewer

234:     Input Parameters:
235: +   N - number of integers in array
236: .   idx - array of integers
237: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

239:   Level: intermediate

241: .seealso: PetscDoubleView() 
242: @*/
243: int PetscIntView(int N,int idx[],PetscViewer viewer)
244: {
245:   int        j,i,n = N/20,p = N % 20,ierr;
246:   PetscTruth isascii,issocket;
247:   MPI_Comm   comm;

250:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
253:   PetscObjectGetComm((PetscObject)viewer,&comm);

255:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);
256:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_SOCKET,&issocket);
257:   if (isascii) {
258:     for (i=0; i<n; i++) {
259:       PetscViewerASCIISynchronizedPrintf(viewer,"%d:",20*i);
260:       for (j=0; j<20; j++) {
261:         PetscViewerASCIISynchronizedPrintf(viewer," %d",idx[i*20+j]);
262:       }
263:       PetscViewerASCIISynchronizedPrintf(viewer,"n");
264:     }
265:     if (p) {
266:       PetscViewerASCIISynchronizedPrintf(viewer,"%d:",20*n);
267:       for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %d",idx[20*n+i]);}
268:       PetscViewerASCIISynchronizedPrintf(viewer,"n");
269:     }
270:     PetscViewerFlush(viewer);
271:   } else if (issocket) {
272:     int *array,*sizes,rank,size,Ntotal,*displs;

274:     MPI_Comm_rank(comm,&rank);
275:     MPI_Comm_size(comm,&size);

277:     if (size > 1) {
278:       if (rank) {
279:         MPI_Gather(&N,1,MPI_INT,0,0,MPI_INT,0,comm);
280:         MPI_Gatherv(idx,N,MPI_INT,0,0,0,MPI_INT,0,comm);
281:       } else {
282:         ierr      = PetscMalloc(size*sizeof(int),&sizes);
283:         ierr      = MPI_Gather(&N,1,MPI_INT,sizes,1,MPI_INT,0,comm);
284:         Ntotal    = sizes[0];
285:         ierr      = PetscMalloc(size*sizeof(int),&displs);
286:         displs[0] = 0;
287:         for (i=1; i<size; i++) {
288:           Ntotal    += sizes[i];
289:           displs[i] =  displs[i-1] + sizes[i-1];
290:         }
291:         PetscMalloc(Ntotal*sizeof(int),&array);
292:         MPI_Gatherv(idx,N,MPI_INT,array,sizes,displs,MPI_INT,0,comm);
293:         PetscViewerSocketPutInt(viewer,Ntotal,array);
294:         PetscFree(sizes);
295:         PetscFree(displs);
296:         PetscFree(array);
297:       }
298:     } else {
299:       PetscViewerSocketPutInt(viewer,N,idx);
300:     }
301:   } else {
302:     SETERRQ(1,"Cannot handle that PetscViewer");
303:   }
304:   return(0);
305: }

307: /*@C
308:     PetscDoubleView - Prints an array of doubles; useful for debugging.

310:     Collective on PetscViewer

312:     Input Parameters:
313: +   N - number of doubles in array
314: .   idx - array of doubles
315: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

317:   Level: intermediate

319: .seealso: PetscIntView() 
320: @*/
321: int PetscDoubleView(int N,PetscReal idx[],PetscViewer viewer)
322: {
323:   int        j,i,n = N/5,p = N % 5,ierr;
324:   PetscTruth isascii,issocket;
325:   MPI_Comm   comm;

328:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
331:   PetscObjectGetComm((PetscObject)viewer,&comm);

333:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);
334:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_SOCKET,&issocket);
335:   if (isascii) {
336:     for (i=0; i<n; i++) {
337:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*i);
338:       for (j=0; j<5; j++) {
339:          PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*5+j]);
340:       }
341:       PetscViewerASCIISynchronizedPrintf(viewer,"n");
342:     }
343:     if (p) {
344:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*n);
345:       for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[5*n+i]);}
346:       PetscViewerASCIISynchronizedPrintf(viewer,"n");
347:     }
348:     PetscViewerFlush(viewer);
349:   } else if (issocket) {
350:     int    *sizes,rank,size,Ntotal,*displs;
351:     PetscReal *array;

353:     MPI_Comm_rank(comm,&rank);
354:     MPI_Comm_size(comm,&size);

356:     if (size > 1) {
357:       if (rank) {
358:         MPI_Gather(&N,1,MPI_INT,0,0,MPI_INT,0,comm);
359:         MPI_Gatherv(idx,N,MPI_DOUBLE,0,0,0,MPI_DOUBLE,0,comm);
360:       } else {
361:         ierr   = PetscMalloc(size*sizeof(int),&sizes);
362:         ierr   = MPI_Gather(&N,1,MPI_INT,sizes,1,MPI_INT,0,comm);
363:         Ntotal = sizes[0];
364:         ierr   = PetscMalloc(size*sizeof(int),&displs);
365:         displs[0] = 0;
366:         for (i=1; i<size; i++) {
367:           Ntotal    += sizes[i];
368:           displs[i] =  displs[i-1] + sizes[i-1];
369:         }
370:         PetscMalloc(Ntotal*sizeof(PetscReal),&array);
371:         MPI_Gatherv(idx,N,MPI_DOUBLE,array,sizes,displs,MPI_DOUBLE,0,comm);
372:         PetscViewerSocketPutReal(viewer,Ntotal,1,array);
373:         PetscFree(sizes);
374:         PetscFree(displs);
375:         PetscFree(array);
376:       }
377:     } else {
378:       PetscViewerSocketPutReal(viewer,N,1,idx);
379:     }
380:   } else {
381:     SETERRQ(1,"Cannot handle that PetscViewer");
382:   }
383:   return(0);
384: }

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

389:     Collective on PetscViewer

391:     Input Parameters:
392: +   N - number of scalars in array
393: .   idx - array of scalars
394: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

396:   Level: intermediate

398: .seealso: PetscIntView(), PetscDoubleView()
399: @*/
400: int PetscScalarView(int N,Scalar idx[],PetscViewer viewer)
401: {
402:   int        j,i,n = N/3,p = N % 3,ierr;
403:   PetscTruth isascii,issocket;
404:   MPI_Comm   comm;

407:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
410:   PetscObjectGetComm((PetscObject)viewer,&comm);

412:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);
413:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_SOCKET,&issocket);
414:   if (isascii) {
415:     for (i=0; i<n; i++) {
416:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);
417:       for (j=0; j<3; j++) {
418: #if defined (PETSC_USE_COMPLEX)
419:         PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
420:                                  PetscRealPart(idx[i*3+j]),PetscImaginaryPart(idx[i*3+j]));
421: #else       
422:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*3+j]);
423: #endif
424:       }
425:       PetscViewerASCIISynchronizedPrintf(viewer,"n");
426:     }
427:     if (p) {
428:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);
429:       for (i=0; i<p; i++) {
430: #if defined (PETSC_USE_COMPLEX)
431:         PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
432:                                  PetscRealPart(idx[i*3+j]),PetscImaginaryPart(idx[i*3+j]));
433: #else
434:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[3*n+i]);
435: #endif
436:       }
437:       PetscViewerASCIISynchronizedPrintf(viewer,"n");
438:     }
439:     PetscViewerFlush(viewer);
440:   } else if (issocket) {
441:     int    *sizes,rank,size,Ntotal,*displs;
442:     Scalar *array;

444:     MPI_Comm_rank(comm,&rank);
445:     MPI_Comm_size(comm,&size);

447:     if (size > 1) {
448:       if (rank) {
449:         MPI_Gather(&N,1,MPI_INT,0,0,MPI_INT,0,comm);
450:         MPI_Gatherv(idx,N,MPIU_SCALAR,0,0,0,MPIU_SCALAR,0,comm);
451:       } else {
452:         ierr   = PetscMalloc(size*sizeof(int),&sizes);
453:         ierr   = MPI_Gather(&N,1,MPI_INT,sizes,1,MPI_INT,0,comm);
454:         Ntotal = sizes[0];
455:         ierr   = PetscMalloc(size*sizeof(int),&displs);
456:         displs[0] = 0;
457:         for (i=1; i<size; i++) {
458:           Ntotal    += sizes[i];
459:           displs[i] =  displs[i-1] + sizes[i-1];
460:         }
461:         PetscMalloc(Ntotal*sizeof(Scalar),&array);
462:         MPI_Gatherv(idx,N,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);
463:         PetscViewerSocketPutScalar(viewer,Ntotal,1,array);
464:         PetscFree(sizes);
465:         PetscFree(displs);
466:         PetscFree(array);
467:       }
468:     } else {
469:       PetscViewerSocketPutScalar(viewer,N,1,idx);
470:     }
471:   } else {
472:     SETERRQ(1,"Cannot handle that PetscViewer");
473:   }
474:   return(0);
475: }