xref: /petsc/src/sys/error/err.c (revision f0eb1ee0b85f9d09d0f36508d79bdee620f217eb)
1 #define PETSC_DLL
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
10 
11 typedef struct _EH *EH;
12 struct _EH {
13   int            classid;
14   PetscErrorCode (*handler)(int,const char*,const char*,const char *,PetscErrorCode,int,const char*,void *);
15   void           *ctx;
16   EH             previous;
17 };
18 
19 static EH eh = 0;
20 
21 #undef __FUNCT__
22 #define __FUNCT__ "PetscEmacsClientErrorHandler"
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.
26 
27    Not Collective
28 
29    Input Parameters:
30 +  line - the line number of the error (indicated by __LINE__)
31 .  func - the function where error is detected (indicated by __FUNCT__)
32 .  file - the file in which the error was detected (indicated by __FILE__)
33 .  dir - the directory of the file (indicated by __SDIR__)
34 .  mess - an error text string, usually just printed to the screen
35 .  n - the generic error number
36 .  p - specific error number
37 -  ctx - error handler context
38 
39    Options Database Key:
40 .   -on_error_emacs <machinename>
41 
42    Level: developer
43 
44    Notes:
45    You must put (server-start) in your .emacs file for the emacsclient software to work
46 
47    Most users need not directly employ this routine and the other error
48    handlers, but can instead use the simplified interface SETERRQ, which has
49    the calling sequence
50 $     SETERRQ(number,p,mess)
51 
52    Notes for experienced users:
53    Use PetscPushErrorHandler() to set the desired error handler.
54 
55    Concepts: emacs^going to on error
56    Concepts: error handler^going to line in emacs
57 
58 .seealso:  PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(),
59           PetscAbortErrorHandler()
60  @*/
61 PetscErrorCode PETSC_DLLEXPORT PetscEmacsClientErrorHandler(int line,const char *fun,const char* file,const char *dir,PetscErrorCode n,int p,const char *mess,void *ctx)
62 {
63   PetscErrorCode ierr;
64   char        command[PETSC_MAX_PATH_LEN];
65   const char  *pdir;
66   FILE        *fp;
67 
68   PetscFunctionBegin;
69   /* Note: don't check error codes since this an error handler :-) */
70   ierr = PetscGetPetscDir(&pdir);CHKERRQ(ierr);
71   sprintf(command,"emacsclient +%d %s/%s%s\n",line,pdir,dir,file);
72 #if defined(PETSC_HAVE_POPEN)
73   ierr = PetscPOpen(MPI_COMM_WORLD,(char*)ctx,command,"r",&fp);
74   ierr = PetscPClose(MPI_COMM_WORLD,fp);
75 #else
76   SETERRQ(PETSC_ERR_SUP_SYS,"Cannot run external programs on this machine");
77 #endif
78   ierr = PetscPopErrorHandler(); /* remove this handler from the stack of handlers */
79   if (!eh)     ierr = PetscTraceBackErrorHandler(line,fun,file,dir,n,p,mess,0);
80   else         ierr = (*eh->handler)(line,fun,file,dir,n,p,mess,eh->ctx);
81   PetscFunctionReturn(ierr);
82 }
83 
84 #undef __FUNCT__
85 #define __FUNCT__ "PetscPushErrorHandler"
86 /*@C
87    PetscPushErrorHandler - Sets a routine to be called on detection of errors.
88 
89    Not Collective
90 
91    Input Parameters:
92 +  handler - error handler routine
93 -  ctx - optional handler context that contains information needed by the handler (for
94          example file pointers for error messages etc.)
95 
96    Calling sequence of handler:
97 $    int handler(int line,char *func,char *file,char *dir,PetscErrorCode n,int p,char *mess,void *ctx);
98 
99 +  func - the function where the error occured (indicated by __FUNCT__)
100 .  line - the line number of the error (indicated by __LINE__)
101 .  file - the file in which the error was detected (indicated by __FILE__)
102 .  dir - the directory of the file (indicated by __SDIR__)
103 .  n - the generic error number (see list defined in include/petscerror.h)
104 .  p - the specific error number
105 .  mess - an error text string, usually just printed to the screen
106 -  ctx - the error handler context
107 
108    Options Database Keys:
109 +   -on_error_attach_debugger <noxterm,gdb or dbx>
110 -   -on_error_abort
111 
112    Level: intermediate
113 
114    Notes:
115    The currently available PETSc error handlers include PetscTraceBackErrorHandler(),
116    PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscMPIAbortErrorHandler(), PetscReturnErrorHandler().
117 
118    Fortran Notes: You can only push one error handler from Fortran before poping it.
119 
120 .seealso: PetscPopErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), PetscTraceBackErrorHandler()
121 
122 @*/
123 PetscErrorCode PETSC_DLLEXPORT PetscPushErrorHandler(PetscErrorCode (*handler)(int,const char *,const char*,const char*,PetscErrorCode,int,const char*,void*),void *ctx)
124 {
125   EH  neweh;
126   PetscErrorCode ierr;
127 
128   PetscFunctionBegin;
129   ierr = PetscNew(struct _EH,&neweh);CHKERRQ(ierr);
130   if (eh) {neweh->previous = eh;}
131   else    {neweh->previous = 0;}
132   neweh->handler = handler;
133   neweh->ctx     = ctx;
134   eh             = neweh;
135   PetscFunctionReturn(0);
136 }
137 
138 #undef __FUNCT__
139 #define __FUNCT__ "PetscPopErrorHandler"
140 /*@
141    PetscPopErrorHandler - Removes the latest error handler that was
142    pushed with PetscPushErrorHandler().
143 
144    Not Collective
145 
146    Level: intermediate
147 
148    Concepts: error handler^setting
149 
150 .seealso: PetscPushErrorHandler()
151 @*/
152 PetscErrorCode PETSC_DLLEXPORT PetscPopErrorHandler(void)
153 {
154   EH  tmp;
155   PetscErrorCode ierr;
156 
157   PetscFunctionBegin;
158   if (!eh) PetscFunctionReturn(0);
159   tmp  = eh;
160   eh   = eh->previous;
161   ierr = PetscFree(tmp);CHKERRQ(ierr);
162 
163   PetscFunctionReturn(0);
164 }
165 
166 #undef __FUNCT__
167 #define __FUNCT__ "PetscReturnErrorHandler"
168 /*@C
169   PetscReturnErrorHandler - Error handler that causes a return to the current
170   level.
171 
172    Not Collective
173 
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
183 
184    Level: developer
185 
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)
191 
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.
196 
197    Use PetscPushErrorHandler() to set the desired error handler.  The
198    currently available PETSc error handlers include PetscTraceBackErrorHandler(),
199    PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscAbortErrorHandler()
200 
201    Concepts: error handler
202 
203 .seealso:  PetscPushErrorHandler(), PetscPopErrorHandler().
204  @*/
205 
206 PetscErrorCode PETSC_DLLEXPORT PetscReturnErrorHandler(int line,const char *fun,const char* file,const char *dir,PetscErrorCode n,int p,const char *mess,void *ctx)
207 {
208   PetscFunctionBegin;
209   PetscFunctionReturn(n);
210 }
211 
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/faq.html#valgrind",
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/faq.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/faq.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\n seehttp://www.mcs.anl.gov/petsc/petsc-as/documentation/installation.html#external",
250   /*87 */ "Not used",
251   /*88 */ "Error in system call",
252   /*89 */ "Object Type not set: see http://www.mcs.anl.gov/petsc/petsc-as/documentation/faq.html#objecttypenotset"};
253 
254 #undef __FUNCT__
255 #define __FUNCT__ "PetscErrorMessage"
256 /*@C
257    PetscErrorMessage - returns the text string associated with a PETSc error code.
258 
259    Not Collective
260 
261    Input Parameter:
262 .   errnum - the error code
263 
264    Output Parameter:
265 +  text - the error message (PETSC_NULL if not desired)
266 -  specific - the specific error message that was set with SETERRxxx() or PetscError().  (PETSC_NULL if not desired)
267 
268    Level: developer
269 
270    Concepts: error handler^messages
271 
272 .seealso:  PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(),
273           PetscAbortErrorHandler(), PetscTraceBackErrorHandler()
274  @*/
275 PetscErrorCode PETSC_DLLEXPORT PetscErrorMessage(int errnum,const char *text[],char **specific)
276 {
277   PetscFunctionBegin;
278   if (text && errnum > PETSC_ERR_MIN_VALUE && errnum < PETSC_ERR_MAX_VALUE) {
279     *text = PetscErrorStrings[errnum-PETSC_ERR_MIN_VALUE-1];
280   } else if (text) *text = 0;
281 
282   if (specific) {
283     *specific = PetscErrorBaseMessage;
284   }
285   PetscFunctionReturn(0);
286 }
287 
288 #if defined(PETSC_USE_ERRORCHECKING)
289 PetscErrorCode PETSC_DLLEXPORT PetscErrorUncatchable[PETSC_EXCEPTIONS_MAX] = {0};
290 PetscInt       PETSC_DLLEXPORT PetscErrorUncatchableCount                  = 0;
291 PetscErrorCode PETSC_DLLEXPORT PetscExceptions[PETSC_EXCEPTIONS_MAX]       = {0};
292 PetscInt       PETSC_DLLEXPORT PetscExceptionsCount                        = 0;
293 PetscErrorCode PETSC_DLLEXPORT PetscExceptionTmp                           = 0;
294 PetscErrorCode PETSC_DLLEXPORT PetscExceptionTmp1                          = 0;
295 
296 #undef __FUNCT__
297 #define __FUNCT__ "PetscErrorIsCatchable"
298 /*@C
299       PetscErrorIsCatchable - Returns if a PetscErrorCode can be caught with a PetscExceptionTry1() or
300            PetscExceptionPush()
301 
302   Input Parameters:
303 .   err - error code
304 
305   Level: advanced
306 
307    Notes:
308     PETSc must not be configured using the option --with-errorchecking=0 for this to work
309 
310 .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop(), PetscErrorSetCatchable()
311 @*/
312 PetscTruth PETSC_DLLEXPORT PetscErrorIsCatchable(PetscErrorCode err)
313 {
314   PetscInt i;
315   for (i=0; i<PetscErrorUncatchableCount; i++) {
316     if (err == PetscErrorUncatchable[i]) return PETSC_FALSE;
317   }
318   return PETSC_TRUE;
319 }
320 
321 #undef __FUNCT__
322 #define __FUNCT__ "PetscErrorSetCatchable"
323 /*@
324       PetscErrorSetCatchable - Sets if a PetscErrorCode can be caught with a PetscExceptionTry1()
325     PetscExceptionCaught() pair, or PetscExceptionPush(). By default all errors are catchable.
326 
327   Input Parameters:
328 +   err - error code
329 -   flg - PETSC_TRUE means allow to be caught, PETSC_FALSE means do not allow to be caught
330 
331   Level: advanced
332 
333    Notes:
334     PETSc must not be configured using the option --with-errorchecking=0 for this to work
335 
336 .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop(), PetscErrorIsCatchable()
337 @*/
338 PetscErrorCode PETSC_DLLEXPORT PetscErrorSetCatchable(PetscErrorCode err,PetscTruth flg)
339 {
340   PetscFunctionBegin;
341   if (!flg && PetscErrorIsCatchable(err)) {
342     /* add to list of uncatchable */
343     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");
344     PetscErrorUncatchable[PetscErrorUncatchableCount++] = err;
345   } else if (flg && !PetscErrorIsCatchable(err)) {
346     /* remove from list of uncatchable */
347     PetscInt i;
348     for (i=0; i<PetscErrorUncatchableCount; i++) {
349       if (PetscErrorUncatchable[i] == err) break;
350     }
351     for (;i<PetscErrorUncatchableCount; i++) {
352       PetscErrorUncatchable[i] = PetscErrorUncatchable[i+1];
353     }
354     PetscErrorUncatchableCount--;
355   }
356   PetscFunctionReturn(0);
357 }
358 
359 #undef __FUNCT__
360 #define __FUNCT__ "PetscExceptionPush"
361 /*@
362       PetscExceptionPush - Adds the exception as one to be caught and passed up. If passed up
363         can be checked with PetscExceptionCaught() or PetscExceptionValue()
364 
365   Input Parameters:
366 .   err - the exception to catch
367 
368   Level: advanced
369 
370    Notes:
371     PETSc must not be configured using the option --with-errorchecking=0 for this to work
372 
373     Use PetscExceptionPop() to remove this as a value to be caught
374 
375     This is not usually needed in C/C++ rather use PetscExceptionTry1()
376 
377 .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop()
378 @*/
379 PetscErrorCode PETSC_DLLEXPORT PetscExceptionPush(PetscErrorCode err)
380 {
381   PetscFunctionBegin;
382   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");
383   if (PetscErrorIsCatchable(err)) PetscExceptions[PetscExceptionsCount++] = err;
384   PetscFunctionReturn(0);
385 }
386 
387 #undef __FUNCT__
388 #define __FUNCT__ "PetscExceptionPop"
389 /*@
390       PetscExceptionPop - Removes  the most recent exception asked to be caught with PetscExceptionPush()
391 
392   Input Parameters:
393 .   err - the exception that was pushed
394 
395   Level: advanced
396 
397    Notes:
398     PETSc must not be configured using the option --with-errorchecking=0 for this to work
399 
400     This is not usually needed in C/C++ rather use PetscExceptionTry1()
401 
402 .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop()
403 @*/
404 PetscErrorCode PETSC_DLLEXPORT PetscExceptionPop(PetscErrorCode err)
405 {
406   PetscFunctionBegin;
407   if (PetscExceptionsCount <= 0)SETERRQ(PETSC_ERR_PLIB,"Stack for PetscExceptions is empty");
408   if (PetscErrorIsCatchable(err)) PetscExceptionsCount--;
409   PetscFunctionReturn(0);
410 }
411 #endif
412 
413 #undef __FUNCT__
414 #define __FUNCT__ "PetscError"
415 /*@C
416    PetscError - Routine that is called when an error has been detected,
417    usually called through the macro SETERRQ().
418 
419    Not Collective
420 
421    Input Parameters:
422 +  line - the line number of the error (indicated by __LINE__)
423 .  func - the function where the error occured (indicated by __FUNCT__)
424 .  dir - the directory of file (indicated by __SDIR__)
425 .  file - the file in which the error was detected (indicated by __FILE__)
426 .  mess - an error text string, usually just printed to the screen
427 .  n - the generic error number
428 .  p - 1 indicates the error was initially detected, 0 indicates this is a traceback from a
429    previously detected error
430 -  mess - formatted message string - aka printf
431 
432   Level: intermediate
433 
434    Notes:
435    Most users need not directly use this routine and the error handlers, but
436    can instead use the simplified interface SETERRQ, which has the calling
437    sequence
438 $     SETERRQ(n,mess)
439 
440    Experienced users can set the error handler with PetscPushErrorHandler().
441 
442    Concepts: error^setting condition
443 
444 .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2()
445 @*/
446 PetscErrorCode PETSC_DLLEXPORT PetscError(int line,const char *func,const char* file,const char *dir,PetscErrorCode n,int p,const char *mess,...)
447 {
448   va_list        Argp;
449   int            fullLength;
450   PetscErrorCode ierr;
451   char           buf[2048],*lbuf = 0;
452   PetscTruth     ismain,isunknown;
453 #if defined(PETSC_USE_ERRORCHECKING)
454   PetscInt       i;
455 #endif
456 
457   if (!func)  func = "User provided function";
458   if (!file)  file = "User file";
459   if (!dir)   dir = " ";
460 
461   PetscFunctionBegin;
462   /* Compose the message evaluating the print format */
463   if (mess) {
464     va_start(Argp,mess);
465     PetscVSNPrintf(buf,2048,mess,&fullLength,Argp);
466     va_end(Argp);
467     lbuf = buf;
468     if (p == 1) {
469       PetscStrncpy(PetscErrorBaseMessage,lbuf,1023);
470     }
471   }
472 
473 #if defined(PETSC_USE_ERRORCHECKING)
474   /* check if user is catching this exception */
475   for (i=0; i<PetscExceptionsCount; i++) {
476     if (n == PetscExceptions[i])  PetscFunctionReturn(n);
477   }
478 #endif
479 
480   if (!eh)     ierr = PetscTraceBackErrorHandler(line,func,file,dir,n,p,lbuf,0);
481   else         ierr = (*eh->handler)(line,func,file,dir,n,p,lbuf,eh->ctx);
482 
483   /*
484       If this is called from the main() routine we call MPI_Abort() instead of
485     return to allow the parallel program to be properly shutdown.
486 
487     Since this is in the error handler we don't check the errors below. Of course,
488     PetscStrncmp() does its own error checking which is problamatic
489   */
490   PetscStrncmp(func,"main",4,&ismain);
491   PetscStrncmp(func,"unknown",7,&isunknown);
492   if (ismain || isunknown) {
493     MPI_Abort(PETSC_COMM_WORLD,(int)ierr);
494   }
495   PetscFunctionReturn(ierr);
496 }
497 
498 #if defined(PETSC_CLANGUAGE_CXX) && !defined(PETSC_USE_EXTERN_CXX)
499 #undef __FUNCT__
500 #define __FUNCT__ "PetscErrorCxx"
501 /*@C
502    PetscErrorCxx - Routine that is called when an error has been detected,
503    usually called through the macro SETERROR().
504 
505    Not Collective
506 
507    Input Parameters:
508 +  line - the line number of the error (indicated by __LINE__)
509 .  func - the function where the error occured (indicated by __FUNCT__)
510 .  dir - the directory of file (indicated by __SDIR__)
511 .  file - the file in which the error was detected (indicated by __FILE__)
512 .  n - the generic error number
513 .  p - 1 indicates the error was initially detected, 0 indicates this is a traceback from a
514    previously detected error
515 
516   Level: intermediate
517 
518    Notes:
519    Most users need not directly use this routine and the error handlers, but
520    can instead use the simplified interface SETERRQ, which has the calling
521    sequence
522 $     SETERRQ(n,mess)
523 
524    Experienced users can set the error handler with PetscPushErrorHandler().
525 
526    Concepts: error^setting condition
527 
528 .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2()
529 @*/
530 void PETSC_DLLEXPORT PetscErrorCxx(int line,const char *func,const char* file,const char *dir,PetscErrorCode n,int p)
531 {
532   PetscTruth ismain, isunknown;
533 #if 0
534 #if defined(PETSC_USE_ERRORCHECKING)
535   PetscInt   i;
536 #endif
537 #endif
538 
539   if (!func) func = "User provided function";
540   if (!file) file = "User file";
541   if (!dir)  dir  = " ";
542 
543 #if 0
544 #if defined(PETSC_USE_ERRORCHECKING)
545   /* check if user is catching this exception */
546   for (i=0; i<PetscExceptionsCount; i++) {
547     if (n == PetscExceptions[i])  PetscFunctionReturn(n);
548   }
549 #endif
550 #endif
551 
552   std::ostringstream msg;
553 
554   PetscTraceBackErrorHandlerCxx(line, func, file, dir, n, p, msg);
555 
556   /*
557       If this is called from the main() routine we call MPI_Abort() instead of
558     return to allow the parallel program to be properly shutdown.
559 
560     Since this is in the error handler we don't check the errors below. Of course,
561     PetscStrncmp() does its own error checking which is problamatic
562   */
563   PetscStrncmp(func,"main",4,&ismain);
564   PetscStrncmp(func,"unknown",7,&isunknown);
565   if (ismain || isunknown) {
566     MPI_Abort(PETSC_COMM_WORLD, (int) n);
567   }
568   throw PETSc::Exception(msg.str().c_str());
569 }
570 #endif
571 
572 /* -------------------------------------------------------------------------*/
573 
574 #undef __FUNCT__
575 #define __FUNCT__ "PetscIntView"
576 /*@C
577     PetscIntView - Prints an array of integers; useful for debugging.
578 
579     Collective on PetscViewer
580 
581     Input Parameters:
582 +   N - number of integers in array
583 .   idx - array of integers
584 -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
585 
586   Level: intermediate
587 
588     Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done
589 
590 .seealso: PetscRealView()
591 @*/
592 PetscErrorCode PETSC_DLLEXPORT PetscIntView(PetscInt N,const PetscInt idx[],PetscViewer viewer)
593 {
594   PetscErrorCode ierr;
595   PetscInt       j,i,n = N/20,p = N % 20;
596   PetscTruth     iascii,isbinary;
597   MPI_Comm       comm;
598 
599   PetscFunctionBegin;
600   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
601   PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,3);
602   if (N) PetscValidIntPointer(idx,2);
603   ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr);
604 
605   ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);CHKERRQ(ierr);
606   ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);CHKERRQ(ierr);
607   if (iascii) {
608     for (i=0; i<n; i++) {
609       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*i);CHKERRQ(ierr);
610       for (j=0; j<20; j++) {
611         ierr = PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[i*20+j]);CHKERRQ(ierr);
612       }
613       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
614     }
615     if (p) {
616       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*n);CHKERRQ(ierr);
617       for (i=0; i<p; i++) { ierr = PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[20*n+i]);CHKERRQ(ierr);}
618       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
619     }
620     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
621   } else if (isbinary) {
622     PetscMPIInt rank,size,*sizes,Ntotal,*displs, NN = PetscMPIIntCast(N);
623     PetscInt    *array;
624     ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
625     ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
626 
627     if (size > 1) {
628       if (rank) {
629         ierr = MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);CHKERRQ(ierr);
630         ierr = MPI_Gatherv((void*)idx,NN,MPIU_INT,0,0,0,MPIU_INT,0,comm);CHKERRQ(ierr);
631       } else {
632 	ierr      = PetscMalloc(size*sizeof(PetscMPIInt),&sizes);CHKERRQ(ierr);
633         ierr      = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
634         Ntotal    = sizes[0];
635 	ierr      = PetscMalloc(size*sizeof(PetscMPIInt),&displs);CHKERRQ(ierr);
636         displs[0] = 0;
637         for (i=1; i<size; i++) {
638           Ntotal    += sizes[i];
639           displs[i] =  displs[i-1] + sizes[i-1];
640         }
641 	ierr = PetscMalloc(Ntotal*sizeof(PetscInt),&array);CHKERRQ(ierr);
642         ierr = MPI_Gatherv((void*)idx,NN,MPIU_INT,array,sizes,displs,MPIU_INT,0,comm);CHKERRQ(ierr);
643         ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_INT,PETSC_TRUE);CHKERRQ(ierr);
644         ierr = PetscFree(sizes);CHKERRQ(ierr);
645         ierr = PetscFree(displs);CHKERRQ(ierr);
646         ierr = PetscFree(array);CHKERRQ(ierr);
647       }
648     } else {
649       ierr = PetscViewerBinaryWrite(viewer,(void *) idx,N,PETSC_INT,PETSC_FALSE);CHKERRQ(ierr);
650     }
651   } else {
652     const char *tname;
653     ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr);
654     SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
655   }
656   PetscFunctionReturn(0);
657 }
658 
659 #undef __FUNCT__
660 #define __FUNCT__ "PetscRealView"
661 /*@C
662     PetscRealView - Prints an array of doubles; useful for debugging.
663 
664     Collective on PetscViewer
665 
666     Input Parameters:
667 +   N - number of doubles in array
668 .   idx - array of doubles
669 -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
670 
671   Level: intermediate
672 
673     Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done
674 
675 .seealso: PetscIntView()
676 @*/
677 PetscErrorCode PETSC_DLLEXPORT PetscRealView(PetscInt N,const PetscReal idx[],PetscViewer viewer)
678 {
679   PetscErrorCode ierr;
680   PetscInt       j,i,n = N/5,p = N % 5;
681   PetscTruth     iascii,isbinary;
682   MPI_Comm       comm;
683 
684   PetscFunctionBegin;
685   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
686   PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,3);
687   PetscValidScalarPointer(idx,2);
688   ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr);
689 
690   ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);CHKERRQ(ierr);
691   ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);CHKERRQ(ierr);
692   if (iascii) {
693     for (i=0; i<n; i++) {
694       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*i);CHKERRQ(ierr);
695       for (j=0; j<5; j++) {
696          ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*5+j]);CHKERRQ(ierr);
697       }
698       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
699     }
700     if (p) {
701       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*n);CHKERRQ(ierr);
702       for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[5*n+i]);CHKERRQ(ierr);}
703       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
704     }
705     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
706   } else if (isbinary) {
707     PetscMPIInt rank,size,*sizes,*displs, Ntotal,NN = PetscMPIIntCast(N);
708     PetscReal   *array;
709 
710     ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
711     ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
712 
713     if (size > 1) {
714       if (rank) {
715         ierr = MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);CHKERRQ(ierr);
716         ierr = MPI_Gatherv((void*)idx,NN,MPI_DOUBLE,0,0,0,MPI_DOUBLE,0,comm);CHKERRQ(ierr);
717       } else {
718 	ierr   = PetscMalloc(size*sizeof(PetscMPIInt),&sizes);CHKERRQ(ierr);
719         ierr   = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);CHKERRQ(ierr);
720         Ntotal = sizes[0];
721 	ierr   = PetscMalloc(size*sizeof(PetscMPIInt),&displs);CHKERRQ(ierr);
722         displs[0] = 0;
723         for (i=1; i<size; i++) {
724           Ntotal    += sizes[i];
725           displs[i] =  displs[i-1] + sizes[i-1];
726         }
727 	ierr = PetscMalloc(Ntotal*sizeof(PetscReal),&array);CHKERRQ(ierr);
728         ierr = MPI_Gatherv((void*)idx,NN,MPI_DOUBLE,array,sizes,displs,MPI_DOUBLE,0,comm);CHKERRQ(ierr);
729         ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_REAL,PETSC_TRUE);CHKERRQ(ierr);
730         ierr = PetscFree(sizes);CHKERRQ(ierr);
731         ierr = PetscFree(displs);CHKERRQ(ierr);
732         ierr = PetscFree(array);CHKERRQ(ierr);
733       }
734     } else {
735       ierr = PetscViewerBinaryWrite(viewer,(void *) idx,N,PETSC_REAL,PETSC_FALSE);CHKERRQ(ierr);
736     }
737   } else {
738     const char *tname;
739     ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr);
740     SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
741   }
742   PetscFunctionReturn(0);
743 }
744 
745 #undef __FUNCT__
746 #define __FUNCT__ "PetscScalarView"
747 /*@C
748     PetscScalarView - Prints an array of scalars; useful for debugging.
749 
750     Collective on PetscViewer
751 
752     Input Parameters:
753 +   N - number of scalars in array
754 .   idx - array of scalars
755 -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
756 
757   Level: intermediate
758 
759     Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done
760 
761 .seealso: PetscIntView(), PetscRealView()
762 @*/
763 PetscErrorCode PETSC_DLLEXPORT PetscScalarView(PetscInt N,const PetscScalar idx[],PetscViewer viewer)
764 {
765   PetscErrorCode ierr;
766   PetscInt       j,i,n = N/3,p = N % 3;
767   PetscTruth     iascii,isbinary;
768   MPI_Comm       comm;
769 
770   PetscFunctionBegin;
771   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
772   PetscValidHeader(viewer,3);
773   PetscValidScalarPointer(idx,2);
774   ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr);
775 
776   ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);CHKERRQ(ierr);
777   ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);CHKERRQ(ierr);
778   if (iascii) {
779     for (i=0; i<n; i++) {
780       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);CHKERRQ(ierr);
781       for (j=0; j<3; j++) {
782 #if defined (PETSC_USE_COMPLEX)
783         ierr = PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
784                                  PetscRealPart(idx[i*3+j]),PetscImaginaryPart(idx[i*3+j]));CHKERRQ(ierr);
785 #else
786         ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*3+j]);CHKERRQ(ierr);
787 #endif
788       }
789       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
790     }
791     if (p) {
792       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);CHKERRQ(ierr);
793       for (i=0; i<p; i++) {
794 #if defined (PETSC_USE_COMPLEX)
795         ierr = PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
796                                  PetscRealPart(idx[n*3+i]),PetscImaginaryPart(idx[n*3+i]));CHKERRQ(ierr);
797 #else
798         ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[3*n+i]);CHKERRQ(ierr);
799 #endif
800       }
801       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
802     }
803     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
804   } else if (isbinary) {
805     PetscMPIInt size,rank,*sizes,Ntotal,*displs,NN = PetscMPIIntCast(N);
806     PetscScalar *array;
807 
808     ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
809     ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
810 
811     if (size > 1) {
812       if (rank) {
813         ierr = MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);CHKERRQ(ierr);
814         ierr = MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,0,0,0,MPIU_SCALAR,0,comm);CHKERRQ(ierr);
815       } else {
816 	ierr   = PetscMalloc(size*sizeof(PetscMPIInt),&sizes);CHKERRQ(ierr);
817         ierr   = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);CHKERRQ(ierr);
818         Ntotal = sizes[0];
819 	ierr   = PetscMalloc(size*sizeof(PetscMPIInt),&displs);CHKERRQ(ierr);
820         displs[0] = 0;
821         for (i=1; i<size; i++) {
822           Ntotal    += sizes[i];
823           displs[i] =  displs[i-1] + sizes[i-1];
824         }
825 	ierr = PetscMalloc(Ntotal*sizeof(PetscScalar),&array);CHKERRQ(ierr);
826         ierr = MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);CHKERRQ(ierr);
827         ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR,PETSC_TRUE);CHKERRQ(ierr);
828         ierr = PetscFree(sizes);CHKERRQ(ierr);
829         ierr = PetscFree(displs);CHKERRQ(ierr);
830         ierr = PetscFree(array);CHKERRQ(ierr);
831       }
832     } else {
833       ierr = PetscViewerBinaryWrite(viewer,(void *) idx,N,PETSC_SCALAR,PETSC_FALSE);CHKERRQ(ierr);
834     }
835   } else {
836     const char *tname;
837     ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr);
838     SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
839   }
840   PetscFunctionReturn(0);
841 }
842 
843 
844 
845 
846