xref: /petsc/src/sys/error/err.c (revision 1cbcd9c41d26426b9e0594c714fd92552a02df39)
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 PetscErrorCode PETSC_DLLEXPORT PetscExceptionTmp1                          = 0;
292 
293 #undef __FUNCT__
294 #define __FUNCT__ "PetscErrorIsCatchable"
295 /*@C
296       PetscErrorIsCatchable - Returns if a PetscErrorCode can be caught with a PetscExceptionTry1() or
297            PetscExceptionPush()
298 
299   Input Parameters:
300 .   err - error code
301 
302   Level: advanced
303 
304    Notes:
305     PETSc must not be configured using the option --with-errorchecking=0 for this to work
306 
307 .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop(), PetscErrorSetCatchable()
308 @*/
309 PetscTruth PETSC_DLLEXPORT PetscErrorIsCatchable(PetscErrorCode err)
310 {
311   PetscInt i;
312   for (i=0; i<PetscErrorUncatchableCount; i++) {
313     if (err == PetscErrorUncatchable[i]) return PETSC_FALSE;
314   }
315   return PETSC_TRUE;
316 }
317 
318 #undef __FUNCT__
319 #define __FUNCT__ "PetscErrorSetCatchable"
320 /*@
321       PetscErrorSetCatchable - Sets if a PetscErrorCode can be caught with a PetscExceptionTry1()
322     PetscExceptionCaught() pair, or PetscExceptionPush(). By default all errors are catchable.
323 
324   Input Parameters:
325 +   err - error code
326 -   flg - PETSC_TRUE means allow to be caught, PETSC_FALSE means do not allow to be caught
327 
328   Level: advanced
329 
330    Notes:
331     PETSc must not be configured using the option --with-errorchecking=0 for this to work
332 
333 .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop(), PetscErrorIsCatchable()
334 @*/
335 PetscErrorCode PETSC_DLLEXPORT PetscErrorSetCatchable(PetscErrorCode err,PetscTruth flg)
336 {
337   PetscFunctionBegin;
338   if (!flg && PetscErrorIsCatchable(err)) {
339     /* add to list of uncatchable */
340     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");
341     PetscErrorUncatchable[PetscErrorUncatchableCount++] = err;
342   } else if (flg && !PetscErrorIsCatchable(err)) {
343     /* remove from list of uncatchable */
344     PetscInt i;
345     for (i=0; i<PetscErrorUncatchableCount; i++) {
346       if (PetscErrorUncatchable[i] == err) break;
347     }
348     for (;i<PetscErrorUncatchableCount; i++) {
349       PetscErrorUncatchable[i] = PetscErrorUncatchable[i+1];
350     }
351     PetscErrorUncatchableCount--;
352   }
353   PetscFunctionReturn(0);
354 }
355 
356 #undef __FUNCT__
357 #define __FUNCT__ "PetscExceptionPush"
358 /*@
359       PetscExceptionPush - Adds the exception as one to be caught and passed up. If passed up
360         can be checked with PetscExceptionCaught() or PetscExceptionValue()
361 
362   Input Parameters:
363 .   err - the exception to catch
364 
365   Level: advanced
366 
367    Notes:
368     PETSc must not be configured using the option --with-errorchecking=0 for this to work
369 
370     Use PetscExceptionPop() to remove this as a value to be caught
371 
372     This is not usually needed in C/C++ rather use PetscExceptionTry1()
373 
374 .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop()
375 @*/
376 PetscErrorCode PETSC_DLLEXPORT PetscExceptionPush(PetscErrorCode err)
377 {
378   PetscFunctionBegin;
379   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");
380   if (PetscErrorIsCatchable(err)) PetscExceptions[PetscExceptionsCount++] = err;
381   PetscFunctionReturn(0);
382 }
383 
384 #undef __FUNCT__
385 #define __FUNCT__ "PetscExceptionPop"
386 /*@
387       PetscExceptionPop - Removes  the most recent exception asked to be caught with PetscExceptionPush()
388 
389   Input Parameters:
390 .   err - the exception that was pushed
391 
392   Level: advanced
393 
394    Notes:
395     PETSc must not be configured using the option --with-errorchecking=0 for this to work
396 
397     This is not usually needed in C/C++ rather use PetscExceptionTry1()
398 
399 .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop()
400 @*/
401 PetscErrorCode PETSC_DLLEXPORT PetscExceptionPop(PetscErrorCode err)
402 {
403   PetscFunctionBegin;
404   if (PetscExceptionsCount <= 0)SETERRQ(PETSC_ERR_PLIB,"Stack for PetscExceptions is empty");
405   if (PetscErrorIsCatchable(err)) PetscExceptionsCount--;
406   PetscFunctionReturn(0);
407 }
408 #endif
409 
410 #undef __FUNCT__
411 #define __FUNCT__ "PetscError"
412 /*@C
413    PetscError - Routine that is called when an error has been detected,
414    usually called through the macro SETERRQ().
415 
416    Not Collective
417 
418    Input Parameters:
419 +  line - the line number of the error (indicated by __LINE__)
420 .  func - the function where the error occured (indicated by __FUNCT__)
421 .  dir - the directory of file (indicated by __SDIR__)
422 .  file - the file in which the error was detected (indicated by __FILE__)
423 .  mess - an error text string, usually just printed to the screen
424 .  n - the generic error number
425 .  p - 1 indicates the error was initially detected, 0 indicates this is a traceback from a
426    previously detected error
427 -  mess - formatted message string - aka printf
428 
429   Level: intermediate
430 
431    Notes:
432    Most users need not directly use this routine and the error handlers, but
433    can instead use the simplified interface SETERRQ, which has the calling
434    sequence
435 $     SETERRQ(n,mess)
436 
437    Experienced users can set the error handler with PetscPushErrorHandler().
438 
439    Concepts: error^setting condition
440 
441 .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2()
442 @*/
443 PetscErrorCode PETSC_DLLEXPORT PetscError(int line,const char *func,const char* file,const char *dir,PetscErrorCode n,int p,const char *mess,...)
444 {
445   va_list        Argp;
446   PetscErrorCode ierr;
447   char           buf[2048],*lbuf = 0;
448   PetscTruth     ismain,isunknown;
449 #if defined(PETSC_USE_ERRORCHECKING)
450   PetscInt       i;
451 #endif
452 
453   if (!func)  func = "User provided function";
454   if (!file)  file = "User file";
455   if (!dir)   dir = " ";
456 
457   PetscFunctionBegin;
458   /* Compose the message evaluating the print format */
459   if (mess) {
460     va_start(Argp,mess);
461     PetscVSNPrintf(buf,2048,mess,Argp);
462     va_end(Argp);
463     lbuf = buf;
464     if (p == 1) {
465       PetscStrncpy(PetscErrorBaseMessage,lbuf,1023);
466     }
467   }
468 
469 #if defined(PETSC_USE_ERRORCHECKING)
470   /* check if user is catching this exception */
471   for (i=0; i<PetscExceptionsCount; i++) {
472     if (n == PetscExceptions[i])  PetscFunctionReturn(n);
473   }
474 #endif
475 
476   if (!eh)     ierr = PetscTraceBackErrorHandler(line,func,file,dir,n,p,lbuf,0);
477   else         ierr = (*eh->handler)(line,func,file,dir,n,p,lbuf,eh->ctx);
478 
479   /*
480       If this is called from the main() routine we call MPI_Abort() instead of
481     return to allow the parallel program to be properly shutdown.
482 
483     Since this is in the error handler we don't check the errors below. Of course,
484     PetscStrncmp() does its own error checking which is problamatic
485   */
486   PetscStrncmp(func,"main",4,&ismain);
487   PetscStrncmp(func,"unknown",7,&isunknown);
488   if (ismain || isunknown) {
489     MPI_Abort(PETSC_COMM_WORLD,(int)ierr);
490   }
491   PetscFunctionReturn(ierr);
492 }
493 
494 #ifdef PETSC_CLANGUAGE_CXX
495 #undef __FUNCT__
496 #define __FUNCT__ "PetscErrorCxx"
497 /*@C
498    PetscErrorCxx - Routine that is called when an error has been detected,
499    usually called through the macro SETERROR().
500 
501    Not Collective
502 
503    Input Parameters:
504 +  line - the line number of the error (indicated by __LINE__)
505 .  func - the function where the error occured (indicated by __FUNCT__)
506 .  dir - the directory of file (indicated by __SDIR__)
507 .  file - the file in which the error was detected (indicated by __FILE__)
508 .  n - the generic error number
509 .  p - 1 indicates the error was initially detected, 0 indicates this is a traceback from a
510    previously detected error
511 
512   Level: intermediate
513 
514    Notes:
515    Most users need not directly use this routine and the error handlers, but
516    can instead use the simplified interface SETERRQ, which has the calling
517    sequence
518 $     SETERRQ(n,mess)
519 
520    Experienced users can set the error handler with PetscPushErrorHandler().
521 
522    Concepts: error^setting condition
523 
524 .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2()
525 @*/
526 void PETSC_DLLEXPORT PetscErrorCxx(int line,const char *func,const char* file,const char *dir,PetscErrorCode n,int p)
527 {
528   PetscTruth ismain, isunknown;
529 #if 0
530 #if defined(PETSC_USE_ERRORCHECKING)
531   PetscInt   i;
532 #endif
533 #endif
534 
535   if (!func) func = "User provided function";
536   if (!file) file = "User file";
537   if (!dir)  dir  = " ";
538 
539 #if 0
540 #if defined(PETSC_USE_ERRORCHECKING)
541   /* check if user is catching this exception */
542   for (i=0; i<PetscExceptionsCount; i++) {
543     if (n == PetscExceptions[i])  PetscFunctionReturn(n);
544   }
545 #endif
546 #endif
547 
548   std::ostringstream msg;
549 
550   PetscTraceBackErrorHandlerCxx(line, func, file, dir, n, p, msg);
551 
552   /*
553       If this is called from the main() routine we call MPI_Abort() instead of
554     return to allow the parallel program to be properly shutdown.
555 
556     Since this is in the error handler we don't check the errors below. Of course,
557     PetscStrncmp() does its own error checking which is problamatic
558   */
559   PetscStrncmp(func,"main",4,&ismain);
560   PetscStrncmp(func,"unknown",7,&isunknown);
561   if (ismain || isunknown) {
562     MPI_Abort(PETSC_COMM_WORLD, (int) n);
563   }
564   throw PETSc::Exception(msg.str().c_str());
565 }
566 #endif
567 
568 /* -------------------------------------------------------------------------*/
569 
570 #undef __FUNCT__
571 #define __FUNCT__ "PetscIntView"
572 /*@C
573     PetscIntView - Prints an array of integers; useful for debugging.
574 
575     Collective on PetscViewer
576 
577     Input Parameters:
578 +   N - number of integers in array
579 .   idx - array of integers
580 -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
581 
582   Level: intermediate
583 
584 .seealso: PetscRealView()
585 @*/
586 PetscErrorCode PETSC_DLLEXPORT PetscIntView(PetscInt N,PetscInt idx[],PetscViewer viewer)
587 {
588   PetscErrorCode ierr;
589   PetscInt       j,i,n = N/20,p = N % 20;
590   PetscTruth     iascii,isbinary;
591   MPI_Comm       comm;
592 
593   PetscFunctionBegin;
594   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
595   PetscValidHeaderSpecific(viewer,PETSC_VIEWER_COOKIE,3);
596   PetscValidIntPointer(idx,2);
597   ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr);
598 
599   ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);CHKERRQ(ierr);
600   ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);CHKERRQ(ierr);
601   if (iascii) {
602     for (i=0; i<n; i++) {
603       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*i);CHKERRQ(ierr);
604       for (j=0; j<20; j++) {
605         ierr = PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[i*20+j]);CHKERRQ(ierr);
606       }
607       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
608     }
609     if (p) {
610       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*n);CHKERRQ(ierr);
611       for (i=0; i<p; i++) { ierr = PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[20*n+i]);CHKERRQ(ierr);}
612       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
613     }
614     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
615   } else if (isbinary) {
616     PetscMPIInt rank,size,*sizes,Ntotal,*displs, NN = PetscMPIIntCast(N);
617     PetscInt    *array;
618     ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
619     ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
620 
621     if (size > 1) {
622       if (rank) {
623         ierr = MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);CHKERRQ(ierr);
624         ierr = MPI_Gatherv(idx,NN,MPIU_INT,0,0,0,MPIU_INT,0,comm);CHKERRQ(ierr);
625       } else {
626 	ierr      = PetscMalloc(size*sizeof(PetscMPIInt),&sizes);CHKERRQ(ierr);
627         ierr      = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
628         Ntotal    = sizes[0];
629 	ierr      = PetscMalloc(size*sizeof(PetscMPIInt),&displs);CHKERRQ(ierr);
630         displs[0] = 0;
631         for (i=1; i<size; i++) {
632           Ntotal    += sizes[i];
633           displs[i] =  displs[i-1] + sizes[i-1];
634         }
635 	ierr = PetscMalloc(Ntotal*sizeof(PetscInt),&array);CHKERRQ(ierr);
636         ierr = MPI_Gatherv(idx,NN,MPIU_INT,array,sizes,displs,MPIU_INT,0,comm);CHKERRQ(ierr);
637         ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_INT,PETSC_TRUE);CHKERRQ(ierr);
638         ierr = PetscFree(sizes);CHKERRQ(ierr);
639         ierr = PetscFree(displs);CHKERRQ(ierr);
640         ierr = PetscFree(array);CHKERRQ(ierr);
641       }
642     } else {
643       ierr = PetscViewerBinaryWrite(viewer,idx,N,PETSC_INT,PETSC_FALSE);CHKERRQ(ierr);
644     }
645   } else {
646     const char *tname;
647     ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr);
648     SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
649   }
650   PetscFunctionReturn(0);
651 }
652 
653 #undef __FUNCT__
654 #define __FUNCT__ "PetscRealView"
655 /*@C
656     PetscRealView - Prints an array of doubles; useful for debugging.
657 
658     Collective on PetscViewer
659 
660     Input Parameters:
661 +   N - number of doubles in array
662 .   idx - array of doubles
663 -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
664 
665   Level: intermediate
666 
667 .seealso: PetscIntView()
668 @*/
669 PetscErrorCode PETSC_DLLEXPORT PetscRealView(PetscInt N,PetscReal idx[],PetscViewer viewer)
670 {
671   PetscErrorCode ierr;
672   PetscInt       j,i,n = N/5,p = N % 5;
673   PetscTruth     iascii,isbinary;
674   MPI_Comm       comm;
675 
676   PetscFunctionBegin;
677   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
678   PetscValidHeaderSpecific(viewer,PETSC_VIEWER_COOKIE,3);
679   PetscValidScalarPointer(idx,2);
680   ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr);
681 
682   ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);CHKERRQ(ierr);
683   ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);CHKERRQ(ierr);
684   if (iascii) {
685     for (i=0; i<n; i++) {
686       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*i);CHKERRQ(ierr);
687       for (j=0; j<5; j++) {
688          ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*5+j]);CHKERRQ(ierr);
689       }
690       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
691     }
692     if (p) {
693       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*n);CHKERRQ(ierr);
694       for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[5*n+i]);CHKERRQ(ierr);}
695       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
696     }
697     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
698   } else if (isbinary) {
699     PetscMPIInt rank,size,*sizes,*displs, Ntotal,NN = PetscMPIIntCast(N);
700     PetscReal   *array;
701 
702     ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
703     ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
704 
705     if (size > 1) {
706       if (rank) {
707         ierr = MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);CHKERRQ(ierr);
708         ierr = MPI_Gatherv(idx,NN,MPI_DOUBLE,0,0,0,MPI_DOUBLE,0,comm);CHKERRQ(ierr);
709       } else {
710 	ierr   = PetscMalloc(size*sizeof(PetscMPIInt),&sizes);CHKERRQ(ierr);
711         ierr   = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);CHKERRQ(ierr);
712         Ntotal = sizes[0];
713 	ierr   = PetscMalloc(size*sizeof(PetscMPIInt),&displs);CHKERRQ(ierr);
714         displs[0] = 0;
715         for (i=1; i<size; i++) {
716           Ntotal    += sizes[i];
717           displs[i] =  displs[i-1] + sizes[i-1];
718         }
719 	ierr = PetscMalloc(Ntotal*sizeof(PetscReal),&array);CHKERRQ(ierr);
720         ierr = MPI_Gatherv(idx,NN,MPI_DOUBLE,array,sizes,displs,MPI_DOUBLE,0,comm);CHKERRQ(ierr);
721         ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_REAL,PETSC_TRUE);CHKERRQ(ierr);
722         ierr = PetscFree(sizes);CHKERRQ(ierr);
723         ierr = PetscFree(displs);CHKERRQ(ierr);
724         ierr = PetscFree(array);CHKERRQ(ierr);
725       }
726     } else {
727       ierr = PetscViewerBinaryWrite(viewer,idx,N,PETSC_REAL,PETSC_FALSE);CHKERRQ(ierr);
728     }
729   } else {
730     const char *tname;
731     ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr);
732     SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
733   }
734   PetscFunctionReturn(0);
735 }
736 
737 #undef __FUNCT__
738 #define __FUNCT__ "PetscScalarView"
739 /*@C
740     PetscScalarView - Prints an array of scalars; useful for debugging.
741 
742     Collective on PetscViewer
743 
744     Input Parameters:
745 +   N - number of scalars in array
746 .   idx - array of scalars
747 -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
748 
749   Level: intermediate
750 
751 .seealso: PetscIntView(), PetscRealView()
752 @*/
753 PetscErrorCode PETSC_DLLEXPORT PetscScalarView(PetscInt N,PetscScalar idx[],PetscViewer viewer)
754 {
755   PetscErrorCode ierr;
756   PetscInt       j,i,n = N/3,p = N % 3;
757   PetscTruth     iascii,isbinary;
758   MPI_Comm       comm;
759 
760   PetscFunctionBegin;
761   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
762   PetscValidHeader(viewer,3);
763   PetscValidScalarPointer(idx,2);
764   ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr);
765 
766   ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);CHKERRQ(ierr);
767   ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);CHKERRQ(ierr);
768   if (iascii) {
769     for (i=0; i<n; i++) {
770       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);CHKERRQ(ierr);
771       for (j=0; j<3; j++) {
772 #if defined (PETSC_USE_COMPLEX)
773         ierr = PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
774                                  PetscRealPart(idx[i*3+j]),PetscImaginaryPart(idx[i*3+j]));CHKERRQ(ierr);
775 #else
776         ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*3+j]);CHKERRQ(ierr);
777 #endif
778       }
779       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
780     }
781     if (p) {
782       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);CHKERRQ(ierr);
783       for (i=0; i<p; i++) {
784 #if defined (PETSC_USE_COMPLEX)
785         ierr = PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
786                                  PetscRealPart(idx[n*3+i]),PetscImaginaryPart(idx[n*3+i]));CHKERRQ(ierr);
787 #else
788         ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[3*n+i]);CHKERRQ(ierr);
789 #endif
790       }
791       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
792     }
793     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
794   } else if (isbinary) {
795     PetscMPIInt size,rank,*sizes,Ntotal,*displs,NN = PetscMPIIntCast(N);
796     PetscScalar *array;
797 
798     ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
799     ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
800 
801     if (size > 1) {
802       if (rank) {
803         ierr = MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);CHKERRQ(ierr);
804         ierr = MPI_Gatherv(idx,NN,MPIU_SCALAR,0,0,0,MPIU_SCALAR,0,comm);CHKERRQ(ierr);
805       } else {
806 	ierr   = PetscMalloc(size*sizeof(PetscMPIInt),&sizes);CHKERRQ(ierr);
807         ierr   = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);CHKERRQ(ierr);
808         Ntotal = sizes[0];
809 	ierr   = PetscMalloc(size*sizeof(PetscMPIInt),&displs);CHKERRQ(ierr);
810         displs[0] = 0;
811         for (i=1; i<size; i++) {
812           Ntotal    += sizes[i];
813           displs[i] =  displs[i-1] + sizes[i-1];
814         }
815 	ierr = PetscMalloc(Ntotal*sizeof(PetscScalar),&array);CHKERRQ(ierr);
816         ierr = MPI_Gatherv(idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);CHKERRQ(ierr);
817         ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR,PETSC_TRUE);CHKERRQ(ierr);
818         ierr = PetscFree(sizes);CHKERRQ(ierr);
819         ierr = PetscFree(displs);CHKERRQ(ierr);
820         ierr = PetscFree(array);CHKERRQ(ierr);
821       }
822     } else {
823       ierr = PetscViewerBinaryWrite(viewer,idx,N,PETSC_SCALAR,PETSC_FALSE);CHKERRQ(ierr);
824     }
825   } else {
826     const char *tname;
827     ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr);
828     SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
829   }
830   PetscFunctionReturn(0);
831 }
832 
833 
834 
835 
836