xref: /petsc/src/sys/error/err.c (revision 8cda6cd7047ed8bb2d68b8e371c012553cb590ce)
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 currently available PETSc error handlers include PetscTraceBackErrorHandler(),
117    PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscMPIAbortErrorHandler(), PetscReturnErrorHandler().
118 
119    Fortran Notes: You can only push one error handler from Fortran before poping it.
120 
121 .seealso: PetscPopErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), PetscTraceBackErrorHandler()
122 
123 @*/
124 PetscErrorCode PETSC_DLLEXPORT PetscPushErrorHandler(PetscErrorCode (*handler)(int,const char *,const char*,const char*,PetscErrorCode,int,const char*,void*),void *ctx)
125 {
126   EH  neweh;
127   PetscErrorCode ierr;
128 
129   PetscFunctionBegin;
130   ierr = PetscNew(struct _EH,&neweh);CHKERRQ(ierr);
131   if (eh) {neweh->previous = eh;}
132   else    {neweh->previous = 0;}
133   neweh->handler = handler;
134   neweh->ctx     = ctx;
135   eh             = neweh;
136   PetscFunctionReturn(0);
137 }
138 
139 #undef __FUNCT__
140 #define __FUNCT__ "PetscPopErrorHandler"
141 /*@
142    PetscPopErrorHandler - Removes the latest error handler that was
143    pushed with PetscPushErrorHandler().
144 
145    Not Collective
146 
147    Level: intermediate
148 
149    Concepts: error handler^setting
150 
151 .seealso: PetscPushErrorHandler()
152 @*/
153 PetscErrorCode PETSC_DLLEXPORT PetscPopErrorHandler(void)
154 {
155   EH  tmp;
156   PetscErrorCode ierr;
157 
158   PetscFunctionBegin;
159   if (!eh) PetscFunctionReturn(0);
160   tmp  = eh;
161   eh   = eh->previous;
162   ierr = PetscFree(tmp);CHKERRQ(ierr);
163 
164   PetscFunctionReturn(0);
165 }
166 
167 #undef __FUNCT__
168 #define __FUNCT__ "PetscReturnErrorHandler"
169 /*@C
170   PetscReturnErrorHandler - Error handler that causes a return to the current
171   level.
172 
173    Not Collective
174 
175    Input Parameters:
176 +  line - the line number of the error (indicated by __LINE__)
177 .  func - the function where error is detected (indicated by __FUNCT__)
178 .  file - the file in which the error was detected (indicated by __FILE__)
179 .  dir - the directory of the file (indicated by __SDIR__)
180 .  mess - an error text string, usually just printed to the screen
181 .  n - the generic error number
182 .  p - specific error number
183 -  ctx - error handler context
184 
185    Level: developer
186 
187    Notes:
188    Most users need not directly employ this routine and the other error
189    handlers, but can instead use the simplified interface SETERRQ, which has
190    the calling sequence
191 $     SETERRQ(number,p,mess)
192 
193    Notes for experienced users:
194    This routine is good for catching errors such as zero pivots in preconditioners
195    or breakdown of iterative methods. It is not appropriate for memory violations
196    and similar errors.
197 
198    Use PetscPushErrorHandler() to set the desired error handler.  The
199    currently available PETSc error handlers include PetscTraceBackErrorHandler(),
200    PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscAbortErrorHandler()
201 
202    Concepts: error handler
203 
204 .seealso:  PetscPushErrorHandler(), PetscPopErrorHandler().
205  @*/
206 
207 PetscErrorCode PETSC_DLLEXPORT PetscReturnErrorHandler(int line,const char *fun,const char* file,const char *dir,PetscErrorCode n,int p,const char *mess,void *ctx)
208 {
209   PetscFunctionBegin;
210   PetscFunctionReturn(n);
211 }
212 
213 static char PetscErrorBaseMessage[1024];
214 /*
215        The numerical values for these are defined in include/petscerror.h; any changes
216    there must also be made here
217 */
218 static const char *PetscErrorStrings[] = {
219   /*55 */ "Out of memory",
220           "No support for this operation for this object type",
221           "No support for this operation on this system",
222   /*58 */ "Operation done in wrong order",
223   /*59 */ "Signal received",
224   /*60 */ "Nonconforming object sizes",
225           "Argument aliasing not permitted",
226           "Invalid argument",
227   /*63 */ "Argument out of range",
228           "Corrupt argument: see http://www.mcs.anl.gov/petsc/petsc-as/documentation/troubleshooting.html#Corrupt",
229           "Unable to open file",
230           "Read from file failed",
231           "Write to file failed",
232           "Invalid pointer",
233   /*69 */ "Arguments must have same type",
234           "",
235   /*71 */ "Detected zero pivot in LU factorization\nsee http://www.mcs.anl.gov/petsc/petsc-as/documentation/troubleshooting.html#ZeroPivot",
236   /*72 */ "Floating point exception",
237   /*73 */ "Object is in wrong state",
238           "Corrupted Petsc object",
239           "Arguments are incompatible",
240           "Error in external library",
241   /*77 */ "Petsc has generated inconsistent data",
242           "Memory corruption",
243           "Unexpected data in file",
244   /*80 */ "Arguments must have same communicators",
245   /*81 */ "Detected zero pivot in Cholesky factorization\nsee http://www.mcs.anl.gov/petsc/petsc-as/documentation/troubleshooting.html#ZeroPivot",
246           "  ",
247           "  ",
248           "  ",
249   /*85 */ "Null argument, when expecting valid pointer",
250   /*86 */ "Unknown type. Check for miss-spelling or missing external package needed for type",
251   /*87 */ "Not used",
252   /*88 */ "Error in system call",
253   /*89 */ "Object Type not set: see http://www.mcs.anl.gov/petsc/petsc-as/documentation/troubleshooting.html#typenotset"};
254 
255 #undef __FUNCT__
256 #define __FUNCT__ "PetscErrorMessage"
257 /*@C
258    PetscErrorMessage - returns the text string associated with a PETSc error code.
259 
260    Not Collective
261 
262    Input Parameter:
263 .   errnum - the error code
264 
265    Output Parameter:
266 +  text - the error message (PETSC_NULL if not desired)
267 -  specific - the specific error message that was set with SETERRxxx() or PetscError().  (PETSC_NULL if not desired)
268 
269    Level: developer
270 
271    Concepts: error handler^messages
272 
273 .seealso:  PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(),
274           PetscAbortErrorHandler(), PetscTraceBackErrorHandler()
275  @*/
276 PetscErrorCode PETSC_DLLEXPORT PetscErrorMessage(int errnum,const char *text[],char **specific)
277 {
278   PetscFunctionBegin;
279   if (text && errnum > PETSC_ERR_MIN_VALUE && errnum < PETSC_ERR_MAX_VALUE) {
280     *text = PetscErrorStrings[errnum-PETSC_ERR_MIN_VALUE-1];
281   } else if (text) *text = 0;
282 
283   if (specific) {
284     *specific = PetscErrorBaseMessage;
285   }
286   PetscFunctionReturn(0);
287 }
288 
289 #if defined(PETSC_USE_ERRORCHECKING)
290 PetscErrorCode PETSC_DLLEXPORT PetscErrorUncatchable[PETSC_EXCEPTIONS_MAX] = {0};
291 PetscInt       PETSC_DLLEXPORT PetscErrorUncatchableCount                  = 0;
292 PetscErrorCode PETSC_DLLEXPORT PetscExceptions[PETSC_EXCEPTIONS_MAX]       = {0};
293 PetscInt       PETSC_DLLEXPORT PetscExceptionsCount                        = 0;
294 PetscErrorCode PETSC_DLLEXPORT PetscExceptionTmp                           = 0;
295 PetscErrorCode PETSC_DLLEXPORT PetscExceptionTmp1                          = 0;
296 
297 #undef __FUNCT__
298 #define __FUNCT__ "PetscErrorIsCatchable"
299 /*@C
300       PetscErrorIsCatchable - Returns if a PetscErrorCode can be caught with a PetscExceptionTry1() or
301            PetscExceptionPush()
302 
303   Input Parameters:
304 .   err - error code
305 
306   Level: advanced
307 
308    Notes:
309     PETSc must not be configured using the option --with-errorchecking=0 for this to work
310 
311 .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop(), PetscErrorSetCatchable()
312 @*/
313 PetscTruth PETSC_DLLEXPORT PetscErrorIsCatchable(PetscErrorCode err)
314 {
315   PetscInt i;
316   for (i=0; i<PetscErrorUncatchableCount; i++) {
317     if (err == PetscErrorUncatchable[i]) return PETSC_FALSE;
318   }
319   return PETSC_TRUE;
320 }
321 
322 #undef __FUNCT__
323 #define __FUNCT__ "PetscErrorSetCatchable"
324 /*@
325       PetscErrorSetCatchable - Sets if a PetscErrorCode can be caught with a PetscExceptionTry1()
326     PetscExceptionCaught() pair, or PetscExceptionPush(). By default all errors are catchable.
327 
328   Input Parameters:
329 +   err - error code
330 -   flg - PETSC_TRUE means allow to be caught, PETSC_FALSE means do not allow to be caught
331 
332   Level: advanced
333 
334    Notes:
335     PETSc must not be configured using the option --with-errorchecking=0 for this to work
336 
337 .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop(), PetscErrorIsCatchable()
338 @*/
339 PetscErrorCode PETSC_DLLEXPORT PetscErrorSetCatchable(PetscErrorCode err,PetscTruth flg)
340 {
341   PetscFunctionBegin;
342   if (!flg && PetscErrorIsCatchable(err)) {
343     /* add to list of uncatchable */
344     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");
345     PetscErrorUncatchable[PetscErrorUncatchableCount++] = err;
346   } else if (flg && !PetscErrorIsCatchable(err)) {
347     /* remove from list of uncatchable */
348     PetscInt i;
349     for (i=0; i<PetscErrorUncatchableCount; i++) {
350       if (PetscErrorUncatchable[i] == err) break;
351     }
352     for (;i<PetscErrorUncatchableCount; i++) {
353       PetscErrorUncatchable[i] = PetscErrorUncatchable[i+1];
354     }
355     PetscErrorUncatchableCount--;
356   }
357   PetscFunctionReturn(0);
358 }
359 
360 #undef __FUNCT__
361 #define __FUNCT__ "PetscExceptionPush"
362 /*@
363       PetscExceptionPush - Adds the exception as one to be caught and passed up. If passed up
364         can be checked with PetscExceptionCaught() or PetscExceptionValue()
365 
366   Input Parameters:
367 .   err - the exception to catch
368 
369   Level: advanced
370 
371    Notes:
372     PETSc must not be configured using the option --with-errorchecking=0 for this to work
373 
374     Use PetscExceptionPop() to remove this as a value to be caught
375 
376     This is not usually needed in C/C++ rather use PetscExceptionTry1()
377 
378 .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop()
379 @*/
380 PetscErrorCode PETSC_DLLEXPORT PetscExceptionPush(PetscErrorCode err)
381 {
382   PetscFunctionBegin;
383   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");
384   if (PetscErrorIsCatchable(err)) PetscExceptions[PetscExceptionsCount++] = err;
385   PetscFunctionReturn(0);
386 }
387 
388 #undef __FUNCT__
389 #define __FUNCT__ "PetscExceptionPop"
390 /*@
391       PetscExceptionPop - Removes  the most recent exception asked to be caught with PetscExceptionPush()
392 
393   Input Parameters:
394 .   err - the exception that was pushed
395 
396   Level: advanced
397 
398    Notes:
399     PETSc must not be configured using the option --with-errorchecking=0 for this to work
400 
401     This is not usually needed in C/C++ rather use PetscExceptionTry1()
402 
403 .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop()
404 @*/
405 PetscErrorCode PETSC_DLLEXPORT PetscExceptionPop(PetscErrorCode err)
406 {
407   PetscFunctionBegin;
408   if (PetscExceptionsCount <= 0)SETERRQ(PETSC_ERR_PLIB,"Stack for PetscExceptions is empty");
409   if (PetscErrorIsCatchable(err)) PetscExceptionsCount--;
410   PetscFunctionReturn(0);
411 }
412 #endif
413 
414 #undef __FUNCT__
415 #define __FUNCT__ "PetscError"
416 /*@C
417    PetscError - Routine that is called when an error has been detected,
418    usually called through the macro SETERRQ().
419 
420    Not Collective
421 
422    Input Parameters:
423 +  line - the line number of the error (indicated by __LINE__)
424 .  func - the function where the error occured (indicated by __FUNCT__)
425 .  dir - the directory of file (indicated by __SDIR__)
426 .  file - the file in which the error was detected (indicated by __FILE__)
427 .  mess - an error text string, usually just printed to the screen
428 .  n - the generic error number
429 .  p - 1 indicates the error was initially detected, 0 indicates this is a traceback from a
430    previously detected error
431 -  mess - formatted message string - aka printf
432 
433   Level: intermediate
434 
435    Notes:
436    Most users need not directly use this routine and the error handlers, but
437    can instead use the simplified interface SETERRQ, which has the calling
438    sequence
439 $     SETERRQ(n,mess)
440 
441    Experienced users can set the error handler with PetscPushErrorHandler().
442 
443    Concepts: error^setting condition
444 
445 .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2()
446 @*/
447 PetscErrorCode PETSC_DLLEXPORT PetscError(int line,const char *func,const char* file,const char *dir,PetscErrorCode n,int p,const char *mess,...)
448 {
449   va_list        Argp;
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,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 #ifdef PETSC_CLANGUAGE_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 .seealso: PetscRealView()
589 @*/
590 PetscErrorCode PETSC_DLLEXPORT PetscIntView(PetscInt N,PetscInt idx[],PetscViewer viewer)
591 {
592   PetscErrorCode ierr;
593   PetscInt       j,i,n = N/20,p = N % 20;
594   PetscTruth     iascii,isbinary;
595   MPI_Comm       comm;
596 
597   PetscFunctionBegin;
598   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
599   PetscValidHeaderSpecific(viewer,PETSC_VIEWER_COOKIE,3);
600   PetscValidIntPointer(idx,2);
601   ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr);
602 
603   ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);CHKERRQ(ierr);
604   ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);CHKERRQ(ierr);
605   if (iascii) {
606     for (i=0; i<n; i++) {
607       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*i);CHKERRQ(ierr);
608       for (j=0; j<20; j++) {
609         ierr = PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[i*20+j]);CHKERRQ(ierr);
610       }
611       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
612     }
613     if (p) {
614       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*n);CHKERRQ(ierr);
615       for (i=0; i<p; i++) { ierr = PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[20*n+i]);CHKERRQ(ierr);}
616       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
617     }
618     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
619   } else if (isbinary) {
620     PetscMPIInt rank,size,*sizes,Ntotal,*displs, NN = PetscMPIIntCast(N);
621     PetscInt    *array;
622     ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
623     ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
624 
625     if (size > 1) {
626       if (rank) {
627         ierr = MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);CHKERRQ(ierr);
628         ierr = MPI_Gatherv(idx,NN,MPIU_INT,0,0,0,MPIU_INT,0,comm);CHKERRQ(ierr);
629       } else {
630 	ierr      = PetscMalloc(size*sizeof(PetscMPIInt),&sizes);CHKERRQ(ierr);
631         ierr      = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
632         Ntotal    = sizes[0];
633 	ierr      = PetscMalloc(size*sizeof(PetscMPIInt),&displs);CHKERRQ(ierr);
634         displs[0] = 0;
635         for (i=1; i<size; i++) {
636           Ntotal    += sizes[i];
637           displs[i] =  displs[i-1] + sizes[i-1];
638         }
639 	ierr = PetscMalloc(Ntotal*sizeof(PetscInt),&array);CHKERRQ(ierr);
640         ierr = MPI_Gatherv(idx,NN,MPIU_INT,array,sizes,displs,MPIU_INT,0,comm);CHKERRQ(ierr);
641         ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_INT,PETSC_TRUE);CHKERRQ(ierr);
642         ierr = PetscFree(sizes);CHKERRQ(ierr);
643         ierr = PetscFree(displs);CHKERRQ(ierr);
644         ierr = PetscFree(array);CHKERRQ(ierr);
645       }
646     } else {
647       ierr = PetscViewerBinaryWrite(viewer,idx,N,PETSC_INT,PETSC_FALSE);CHKERRQ(ierr);
648     }
649   } else {
650     const char *tname;
651     ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr);
652     SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
653   }
654   PetscFunctionReturn(0);
655 }
656 
657 #undef __FUNCT__
658 #define __FUNCT__ "PetscRealView"
659 /*@C
660     PetscRealView - Prints an array of doubles; useful for debugging.
661 
662     Collective on PetscViewer
663 
664     Input Parameters:
665 +   N - number of doubles in array
666 .   idx - array of doubles
667 -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
668 
669   Level: intermediate
670 
671 .seealso: PetscIntView()
672 @*/
673 PetscErrorCode PETSC_DLLEXPORT PetscRealView(PetscInt N,PetscReal idx[],PetscViewer viewer)
674 {
675   PetscErrorCode ierr;
676   PetscInt       j,i,n = N/5,p = N % 5;
677   PetscTruth     iascii,isbinary;
678   MPI_Comm       comm;
679 
680   PetscFunctionBegin;
681   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
682   PetscValidHeaderSpecific(viewer,PETSC_VIEWER_COOKIE,3);
683   PetscValidScalarPointer(idx,2);
684   ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr);
685 
686   ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);CHKERRQ(ierr);
687   ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);CHKERRQ(ierr);
688   if (iascii) {
689     for (i=0; i<n; i++) {
690       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*i);CHKERRQ(ierr);
691       for (j=0; j<5; j++) {
692          ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*5+j]);CHKERRQ(ierr);
693       }
694       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
695     }
696     if (p) {
697       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*n);CHKERRQ(ierr);
698       for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[5*n+i]);CHKERRQ(ierr);}
699       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
700     }
701     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
702   } else if (isbinary) {
703     PetscMPIInt rank,size,*sizes,*displs, Ntotal,NN = PetscMPIIntCast(N);
704     PetscReal   *array;
705 
706     ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
707     ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
708 
709     if (size > 1) {
710       if (rank) {
711         ierr = MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);CHKERRQ(ierr);
712         ierr = MPI_Gatherv(idx,NN,MPI_DOUBLE,0,0,0,MPI_DOUBLE,0,comm);CHKERRQ(ierr);
713       } else {
714 	ierr   = PetscMalloc(size*sizeof(PetscMPIInt),&sizes);CHKERRQ(ierr);
715         ierr   = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);CHKERRQ(ierr);
716         Ntotal = sizes[0];
717 	ierr   = PetscMalloc(size*sizeof(PetscMPIInt),&displs);CHKERRQ(ierr);
718         displs[0] = 0;
719         for (i=1; i<size; i++) {
720           Ntotal    += sizes[i];
721           displs[i] =  displs[i-1] + sizes[i-1];
722         }
723 	ierr = PetscMalloc(Ntotal*sizeof(PetscReal),&array);CHKERRQ(ierr);
724         ierr = MPI_Gatherv(idx,NN,MPI_DOUBLE,array,sizes,displs,MPI_DOUBLE,0,comm);CHKERRQ(ierr);
725         ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_REAL,PETSC_TRUE);CHKERRQ(ierr);
726         ierr = PetscFree(sizes);CHKERRQ(ierr);
727         ierr = PetscFree(displs);CHKERRQ(ierr);
728         ierr = PetscFree(array);CHKERRQ(ierr);
729       }
730     } else {
731       ierr = PetscViewerBinaryWrite(viewer,idx,N,PETSC_REAL,PETSC_FALSE);CHKERRQ(ierr);
732     }
733   } else {
734     const char *tname;
735     ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr);
736     SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
737   }
738   PetscFunctionReturn(0);
739 }
740 
741 #undef __FUNCT__
742 #define __FUNCT__ "PetscScalarView"
743 /*@C
744     PetscScalarView - Prints an array of scalars; useful for debugging.
745 
746     Collective on PetscViewer
747 
748     Input Parameters:
749 +   N - number of scalars in array
750 .   idx - array of scalars
751 -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
752 
753   Level: intermediate
754 
755 .seealso: PetscIntView(), PetscRealView()
756 @*/
757 PetscErrorCode PETSC_DLLEXPORT PetscScalarView(PetscInt N,PetscScalar idx[],PetscViewer viewer)
758 {
759   PetscErrorCode ierr;
760   PetscInt       j,i,n = N/3,p = N % 3;
761   PetscTruth     iascii,isbinary;
762   MPI_Comm       comm;
763 
764   PetscFunctionBegin;
765   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
766   PetscValidHeader(viewer,3);
767   PetscValidScalarPointer(idx,2);
768   ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr);
769 
770   ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);CHKERRQ(ierr);
771   ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);CHKERRQ(ierr);
772   if (iascii) {
773     for (i=0; i<n; i++) {
774       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);CHKERRQ(ierr);
775       for (j=0; j<3; j++) {
776 #if defined (PETSC_USE_COMPLEX)
777         ierr = PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
778                                  PetscRealPart(idx[i*3+j]),PetscImaginaryPart(idx[i*3+j]));CHKERRQ(ierr);
779 #else
780         ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*3+j]);CHKERRQ(ierr);
781 #endif
782       }
783       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
784     }
785     if (p) {
786       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);CHKERRQ(ierr);
787       for (i=0; i<p; i++) {
788 #if defined (PETSC_USE_COMPLEX)
789         ierr = PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
790                                  PetscRealPart(idx[n*3+i]),PetscImaginaryPart(idx[n*3+i]));CHKERRQ(ierr);
791 #else
792         ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[3*n+i]);CHKERRQ(ierr);
793 #endif
794       }
795       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
796     }
797     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
798   } else if (isbinary) {
799     PetscMPIInt size,rank,*sizes,Ntotal,*displs,NN = PetscMPIIntCast(N);
800     PetscScalar *array;
801 
802     ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
803     ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
804 
805     if (size > 1) {
806       if (rank) {
807         ierr = MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);CHKERRQ(ierr);
808         ierr = MPI_Gatherv(idx,NN,MPIU_SCALAR,0,0,0,MPIU_SCALAR,0,comm);CHKERRQ(ierr);
809       } else {
810 	ierr   = PetscMalloc(size*sizeof(PetscMPIInt),&sizes);CHKERRQ(ierr);
811         ierr   = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);CHKERRQ(ierr);
812         Ntotal = sizes[0];
813 	ierr   = PetscMalloc(size*sizeof(PetscMPIInt),&displs);CHKERRQ(ierr);
814         displs[0] = 0;
815         for (i=1; i<size; i++) {
816           Ntotal    += sizes[i];
817           displs[i] =  displs[i-1] + sizes[i-1];
818         }
819 	ierr = PetscMalloc(Ntotal*sizeof(PetscScalar),&array);CHKERRQ(ierr);
820         ierr = MPI_Gatherv(idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);CHKERRQ(ierr);
821         ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR,PETSC_TRUE);CHKERRQ(ierr);
822         ierr = PetscFree(sizes);CHKERRQ(ierr);
823         ierr = PetscFree(displs);CHKERRQ(ierr);
824         ierr = PetscFree(array);CHKERRQ(ierr);
825       }
826     } else {
827       ierr = PetscViewerBinaryWrite(viewer,idx,N,PETSC_SCALAR,PETSC_FALSE);CHKERRQ(ierr);
828     }
829   } else {
830     const char *tname;
831     ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr);
832     SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
833   }
834   PetscFunctionReturn(0);
835 }
836 
837 
838 
839 
840