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