1 2 /* 3 Code that allows one to set the error handlers 4 */ 5 #include <petscsys.h> /*I "petscsys.h" I*/ 6 #include <stdarg.h> 7 #if defined(PETSC_HAVE_STDLIB_H) 8 #include <stdlib.h> 9 #endif 10 11 typedef struct _EH *EH; 12 struct _EH { 13 int classid; 14 PetscErrorCode (*handler)(MPI_Comm,int,const char*,const char*,const char *,PetscErrorCode,PetscErrorType,const char*,void *); 15 void *ctx; 16 EH previous; 17 }; 18 19 static EH eh = 0; 20 21 #undef __FUNCT__ 22 #define __FUNCT__ "PetscEmacsClientErrorHandler" 23 /*@C 24 PetscEmacsClientErrorHandler - Error handler that uses the emacsclient program to 25 load the file where the error occured. Then calls the "previous" error handler. 26 27 Not Collective 28 29 Input Parameters: 30 + comm - communicator over which error occured 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(PETSC_COMM_SELF,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 PetscEmacsClientErrorHandler(MPI_Comm comm,int line,const char *fun,const char* file,const char *dir,PetscErrorCode n,PetscErrorType 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); 72 sprintf(command,"cd %s; emacsclient --no-wait +%d %s%s\n",pdir,line,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_COMM_SELF,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(comm,line,fun,file,dir,n,p,mess,0); 81 else ierr = (*eh->handler)(comm,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(MPI_Comm comm,int line,char *func,char *file,char *dir,PetscErrorCode n,int p,char *mess,void *ctx); 99 100 + comm - communicator over which error occured 101 . func - the function where the error occured (indicated by __FUNCT__) 102 . line - the line number of the error (indicated by __LINE__) 103 . file - the file in which the error was detected (indicated by __FILE__) 104 . dir - the directory of the file (indicated by __SDIR__) 105 . n - the generic error number (see list defined in include/petscerror.h) 106 . p - PETSC_ERROR_INITIAL if error just detected, otherwise PETSC_ERROR_REPEAT 107 . mess - an error text string, usually just printed to the screen 108 - ctx - the error handler context 109 110 Options Database Keys: 111 + -on_error_attach_debugger <noxterm,gdb or dbx> 112 - -on_error_abort 113 114 Level: intermediate 115 116 Notes: 117 The currently available PETSc error handlers include PetscTraceBackErrorHandler(), 118 PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscMPIAbortErrorHandler(), PetscReturnErrorHandler(). 119 120 Fortran Notes: You can only push one error handler from Fortran before poping it. 121 122 .seealso: PetscPopErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), PetscTraceBackErrorHandler() 123 124 @*/ 125 PetscErrorCode PetscPushErrorHandler(PetscErrorCode (*handler)(MPI_Comm comm,int,const char *,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*),void *ctx) 126 { 127 EH neweh; 128 PetscErrorCode ierr; 129 130 PetscFunctionBegin; 131 ierr = PetscNew(struct _EH,&neweh);CHKERRQ(ierr); 132 if (eh) {neweh->previous = eh;} 133 else {neweh->previous = 0;} 134 neweh->handler = handler; 135 neweh->ctx = ctx; 136 eh = neweh; 137 PetscFunctionReturn(0); 138 } 139 140 #undef __FUNCT__ 141 #define __FUNCT__ "PetscPopErrorHandler" 142 /*@ 143 PetscPopErrorHandler - Removes the latest error handler that was 144 pushed with PetscPushErrorHandler(). 145 146 Not Collective 147 148 Level: intermediate 149 150 Concepts: error handler^setting 151 152 .seealso: PetscPushErrorHandler() 153 @*/ 154 PetscErrorCode PetscPopErrorHandler(void) 155 { 156 EH tmp; 157 PetscErrorCode ierr; 158 159 PetscFunctionBegin; 160 if (!eh) PetscFunctionReturn(0); 161 tmp = eh; 162 eh = eh->previous; 163 ierr = PetscFree(tmp);CHKERRQ(ierr); 164 165 PetscFunctionReturn(0); 166 } 167 168 #undef __FUNCT__ 169 #define __FUNCT__ "PetscReturnErrorHandler" 170 /*@C 171 PetscReturnErrorHandler - Error handler that causes a return to the current 172 level. 173 174 Not Collective 175 176 Input Parameters: 177 + comm - communicator over which error occurred 178 . line - the line number of the error (indicated by __LINE__) 179 . func - the function where error is detected (indicated by __FUNCT__) 180 . file - the file in which the error was detected (indicated by __FILE__) 181 . dir - the directory of the file (indicated by __SDIR__) 182 . mess - an error text string, usually just printed to the screen 183 . n - the generic error number 184 . p - specific error number 185 - ctx - error handler context 186 187 Level: developer 188 189 Notes: 190 Most users need not directly employ this routine and the other error 191 handlers, but can instead use the simplified interface SETERRQ, which has 192 the calling sequence 193 $ SETERRQ(comm,number,mess) 194 195 Notes for experienced users: 196 This routine is good for catching errors such as zero pivots in preconditioners 197 or breakdown of iterative methods. It is not appropriate for memory violations 198 and similar errors. 199 200 Use PetscPushErrorHandler() to set the desired error handler. The 201 currently available PETSc error handlers include PetscTraceBackErrorHandler(), 202 PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscAbortErrorHandler() 203 204 Concepts: error handler 205 206 .seealso: PetscPushErrorHandler(), PetscPopErrorHandler(). 207 @*/ 208 209 PetscErrorCode PetscReturnErrorHandler(MPI_Comm comm,int line,const char *fun,const char* file,const char *dir,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx) 210 { 211 PetscFunctionBegin; 212 PetscFunctionReturn(n); 213 } 214 215 static char PetscErrorBaseMessage[1024]; 216 /* 217 The numerical values for these are defined in include/petscerror.h; any changes 218 there must also be made here 219 */ 220 static const char *PetscErrorStrings[] = { 221 /*55 */ "Out of memory", 222 "No support for this operation for this object type", 223 "No support for this operation on this system", 224 /*58 */ "Operation done in wrong order", 225 /*59 */ "Signal received", 226 /*60 */ "Nonconforming object sizes", 227 "Argument aliasing not permitted", 228 "Invalid argument", 229 /*63 */ "Argument out of range", 230 "Corrupt argument: see http://www.mcs.anl.gov/petsc/petsc-as/documentation/faq.html#valgrind", 231 "Unable to open file", 232 "Read from file failed", 233 "Write to file failed", 234 "Invalid pointer", 235 /*69 */ "Arguments must have same type", 236 "", 237 /*71 */ "Detected zero pivot in LU factorization\nsee http://www.mcs.anl.gov/petsc/petsc-as/documentation/faq.html#ZeroPivot", 238 /*72 */ "Floating point exception", 239 /*73 */ "Object is in wrong state", 240 "Corrupted Petsc object", 241 "Arguments are incompatible", 242 "Error in external library", 243 /*77 */ "Petsc has generated inconsistent data", 244 "Memory corruption", 245 "Unexpected data in file", 246 /*80 */ "Arguments must have same communicators", 247 /*81 */ "Detected zero pivot in Cholesky factorization\nsee http://www.mcs.anl.gov/petsc/petsc-as/documentation/faq.html#ZeroPivot", 248 " ", 249 " ", 250 " ", 251 /*85 */ "Null argument, when expecting valid pointer", 252 /*86 */ "Unknown type. Check for miss-spelling or missing external package needed for type\n seehttp://www.mcs.anl.gov/petsc/petsc-as/documentation/installation.html#external", 253 /*87 */ "Not used", 254 /*88 */ "Error in system call", 255 /*89 */ "Object Type not set: see http://www.mcs.anl.gov/petsc/petsc-as/documentation/faq.html#objecttypenotset" 256 /*90 */ " ", 257 /* */ " ", 258 /* */ " ", 259 /* */ " ", 260 /* */ " ", 261 /*95 */ " ", 262 }; 263 264 #undef __FUNCT__ 265 #define __FUNCT__ "PetscErrorMessage" 266 /*@C 267 PetscErrorMessage - returns the text string associated with a PETSc error code. 268 269 Not Collective 270 271 Input Parameter: 272 . errnum - the error code 273 274 Output Parameter: 275 + text - the error message (PETSC_NULL if not desired) 276 - specific - the specific error message that was set with SETERRxxx() or PetscError(). (PETSC_NULL if not desired) 277 278 Level: developer 279 280 Concepts: error handler^messages 281 282 .seealso: PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(), 283 PetscAbortErrorHandler(), PetscTraceBackErrorHandler() 284 @*/ 285 PetscErrorCode PetscErrorMessage(int errnum,const char *text[],char **specific) 286 { 287 PetscFunctionBegin; 288 if (text && errnum > PETSC_ERR_MIN_VALUE && errnum < PETSC_ERR_MAX_VALUE) { 289 *text = PetscErrorStrings[errnum-PETSC_ERR_MIN_VALUE-1]; 290 } else if (text) *text = 0; 291 292 if (specific) { 293 *specific = PetscErrorBaseMessage; 294 } 295 PetscFunctionReturn(0); 296 } 297 298 #undef __FUNCT__ 299 #define __FUNCT__ "PetscError" 300 /*@C 301 PetscError - Routine that is called when an error has been detected, 302 usually called through the macro SETERRQ(PETSC_COMM_SELF,). 303 304 Not Collective 305 306 Input Parameters: 307 + comm - communicator over which error occurred. ALL ranks of this communicator MUST call this routine 308 . line - the line number of the error (indicated by __LINE__) 309 . func - the function where the error occured (indicated by __FUNCT__) 310 . dir - the directory of file (indicated by __SDIR__) 311 . file - the file in which the error was detected (indicated by __FILE__) 312 . mess - an error text string, usually just printed to the screen 313 . n - the generic error number 314 . p - PETSC_ERROR_INITIAL indicates the error was initially detected, PETSC_ERROR_REPEAT indicates this is a traceback from a previously detected error 315 - mess - formatted message string - aka printf 316 317 Level: intermediate 318 319 Notes: 320 Most users need not directly use this routine and the error handlers, but 321 can instead use the simplified interface SETERRQ, which has the calling 322 sequence 323 $ SETERRQ(comm,n,mess) 324 325 Experienced users can set the error handler with PetscPushErrorHandler(). 326 327 Concepts: error^setting condition 328 329 .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2() 330 @*/ 331 PetscErrorCode PetscError(MPI_Comm comm,int line,const char *func,const char* file,const char *dir,PetscErrorCode n,PetscErrorType p,const char *mess,...) 332 { 333 va_list Argp; 334 size_t fullLength; 335 PetscErrorCode ierr; 336 char buf[2048],*lbuf = 0; 337 PetscBool ismain,isunknown; 338 339 if (!func) func = "User provided function"; 340 if (!file) file = "User file"; 341 if (!dir) dir = " "; 342 343 PetscFunctionBegin; 344 /* Compose the message evaluating the print format */ 345 if (mess) { 346 va_start(Argp,mess); 347 PetscVSNPrintf(buf,2048,mess,&fullLength,Argp); 348 va_end(Argp); 349 lbuf = buf; 350 if (p == 1) { 351 PetscStrncpy(PetscErrorBaseMessage,lbuf,1023); 352 } 353 } 354 355 if (!eh) ierr = PetscTraceBackErrorHandler(comm,line,func,file,dir,n,p,lbuf,0); 356 else ierr = (*eh->handler)(comm,line,func,file,dir,n,p,lbuf,eh->ctx); 357 358 /* 359 If this is called from the main() routine we call MPI_Abort() instead of 360 return to allow the parallel program to be properly shutdown. 361 362 Since this is in the error handler we don't check the errors below. Of course, 363 PetscStrncmp() does its own error checking which is problamatic 364 */ 365 PetscStrncmp(func,"main",4,&ismain); 366 PetscStrncmp(func,"unknown",7,&isunknown); 367 if (ismain || isunknown) { 368 MPI_Abort(PETSC_COMM_WORLD,(int)ierr); 369 } 370 #if defined(PETSC_CLANGUAGE_CXX) && !defined(PETSC_USE_EXTERN_CXX) 371 if (p == PETSC_ERROR_IN_CXX) { 372 const char *str; 373 if (eh->ctx) { 374 std::ostringstream *msg; 375 msg = (std::ostringstream*) eh->ctx; 376 str = msg->str().c_str(); 377 } else { 378 str = "Error detected in C PETSc"; 379 } 380 throw PETSc::Exception(str); 381 } 382 #endif 383 PetscFunctionReturn(ierr); 384 } 385 386 /* -------------------------------------------------------------------------*/ 387 388 #undef __FUNCT__ 389 #define __FUNCT__ "PetscIntView" 390 /*@C 391 PetscIntView - Prints an array of integers; useful for debugging. 392 393 Collective on PetscViewer 394 395 Input Parameters: 396 + N - number of integers in array 397 . idx - array of integers 398 - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0 399 400 Level: intermediate 401 402 Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done 403 404 .seealso: PetscRealView() 405 @*/ 406 PetscErrorCode PetscIntView(PetscInt N,const PetscInt idx[],PetscViewer viewer) 407 { 408 PetscErrorCode ierr; 409 PetscInt j,i,n = N/20,p = N % 20; 410 PetscBool iascii,isbinary; 411 MPI_Comm comm; 412 413 PetscFunctionBegin; 414 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; 415 PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,3); 416 if (N) PetscValidIntPointer(idx,2); 417 ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr); 418 419 ierr = PetscTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr); 420 ierr = PetscTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);CHKERRQ(ierr); 421 if (iascii) { 422 ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);CHKERRQ(ierr); 423 for (i=0; i<n; i++) { 424 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*i);CHKERRQ(ierr); 425 for (j=0; j<20; j++) { 426 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[i*20+j]);CHKERRQ(ierr); 427 } 428 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 429 } 430 if (p) { 431 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*n);CHKERRQ(ierr); 432 for (i=0; i<p; i++) { ierr = PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[20*n+i]);CHKERRQ(ierr);} 433 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 434 } 435 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 436 ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);CHKERRQ(ierr); 437 } else if (isbinary) { 438 PetscMPIInt rank,size,*sizes,Ntotal,*displs, NN = PetscMPIIntCast(N); 439 PetscInt *array; 440 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 441 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 442 443 if (size > 1) { 444 if (rank) { 445 ierr = MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);CHKERRQ(ierr); 446 ierr = MPI_Gatherv((void*)idx,NN,MPIU_INT,0,0,0,MPIU_INT,0,comm);CHKERRQ(ierr); 447 } else { 448 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&sizes);CHKERRQ(ierr); 449 ierr = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr); 450 Ntotal = sizes[0]; 451 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&displs);CHKERRQ(ierr); 452 displs[0] = 0; 453 for (i=1; i<size; i++) { 454 Ntotal += sizes[i]; 455 displs[i] = displs[i-1] + sizes[i-1]; 456 } 457 ierr = PetscMalloc(Ntotal*sizeof(PetscInt),&array);CHKERRQ(ierr); 458 ierr = MPI_Gatherv((void*)idx,NN,MPIU_INT,array,sizes,displs,MPIU_INT,0,comm);CHKERRQ(ierr); 459 ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_INT,PETSC_TRUE);CHKERRQ(ierr); 460 ierr = PetscFree(sizes);CHKERRQ(ierr); 461 ierr = PetscFree(displs);CHKERRQ(ierr); 462 ierr = PetscFree(array);CHKERRQ(ierr); 463 } 464 } else { 465 ierr = PetscViewerBinaryWrite(viewer,(void *) idx,N,PETSC_INT,PETSC_FALSE);CHKERRQ(ierr); 466 } 467 } else { 468 const char *tname; 469 ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr); 470 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname); 471 } 472 PetscFunctionReturn(0); 473 } 474 475 #undef __FUNCT__ 476 #define __FUNCT__ "PetscRealView" 477 /*@C 478 PetscRealView - Prints an array of doubles; useful for debugging. 479 480 Collective on PetscViewer 481 482 Input Parameters: 483 + N - number of doubles in array 484 . idx - array of doubles 485 - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0 486 487 Level: intermediate 488 489 Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done 490 491 .seealso: PetscIntView() 492 @*/ 493 PetscErrorCode PetscRealView(PetscInt N,const PetscReal idx[],PetscViewer viewer) 494 { 495 PetscErrorCode ierr; 496 PetscInt j,i,n = N/5,p = N % 5; 497 PetscBool iascii,isbinary; 498 MPI_Comm comm; 499 500 PetscFunctionBegin; 501 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; 502 PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,3); 503 PetscValidScalarPointer(idx,2); 504 ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr); 505 506 ierr = PetscTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr); 507 ierr = PetscTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);CHKERRQ(ierr); 508 if (iascii) { 509 ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);CHKERRQ(ierr); 510 for (i=0; i<n; i++) { 511 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*i);CHKERRQ(ierr); 512 for (j=0; j<5; j++) { 513 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*5+j]);CHKERRQ(ierr); 514 } 515 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 516 } 517 if (p) { 518 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*n);CHKERRQ(ierr); 519 for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[5*n+i]);CHKERRQ(ierr);} 520 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 521 } 522 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 523 ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);CHKERRQ(ierr); 524 } else if (isbinary) { 525 PetscMPIInt rank,size,*sizes,*displs, Ntotal,NN = PetscMPIIntCast(N); 526 PetscReal *array; 527 528 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 529 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 530 531 if (size > 1) { 532 if (rank) { 533 ierr = MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);CHKERRQ(ierr); 534 ierr = MPI_Gatherv((void*)idx,NN,MPI_DOUBLE,0,0,0,MPI_DOUBLE,0,comm);CHKERRQ(ierr); 535 } else { 536 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&sizes);CHKERRQ(ierr); 537 ierr = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);CHKERRQ(ierr); 538 Ntotal = sizes[0]; 539 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&displs);CHKERRQ(ierr); 540 displs[0] = 0; 541 for (i=1; i<size; i++) { 542 Ntotal += sizes[i]; 543 displs[i] = displs[i-1] + sizes[i-1]; 544 } 545 ierr = PetscMalloc(Ntotal*sizeof(PetscReal),&array);CHKERRQ(ierr); 546 ierr = MPI_Gatherv((void*)idx,NN,MPI_DOUBLE,array,sizes,displs,MPI_DOUBLE,0,comm);CHKERRQ(ierr); 547 ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_REAL,PETSC_TRUE);CHKERRQ(ierr); 548 ierr = PetscFree(sizes);CHKERRQ(ierr); 549 ierr = PetscFree(displs);CHKERRQ(ierr); 550 ierr = PetscFree(array);CHKERRQ(ierr); 551 } 552 } else { 553 ierr = PetscViewerBinaryWrite(viewer,(void *) idx,N,PETSC_REAL,PETSC_FALSE);CHKERRQ(ierr); 554 } 555 } else { 556 const char *tname; 557 ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr); 558 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname); 559 } 560 PetscFunctionReturn(0); 561 } 562 563 #undef __FUNCT__ 564 #define __FUNCT__ "PetscScalarView" 565 /*@C 566 PetscScalarView - Prints an array of scalars; useful for debugging. 567 568 Collective on PetscViewer 569 570 Input Parameters: 571 + N - number of scalars in array 572 . idx - array of scalars 573 - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0 574 575 Level: intermediate 576 577 Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done 578 579 .seealso: PetscIntView(), PetscRealView() 580 @*/ 581 PetscErrorCode PetscScalarView(PetscInt N,const PetscScalar idx[],PetscViewer viewer) 582 { 583 PetscErrorCode ierr; 584 PetscInt j,i,n = N/3,p = N % 3; 585 PetscBool iascii,isbinary; 586 MPI_Comm comm; 587 588 PetscFunctionBegin; 589 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; 590 PetscValidHeader(viewer,3); 591 PetscValidScalarPointer(idx,2); 592 ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr); 593 594 ierr = PetscTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr); 595 ierr = PetscTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);CHKERRQ(ierr); 596 if (iascii) { 597 ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);CHKERRQ(ierr); 598 for (i=0; i<n; i++) { 599 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);CHKERRQ(ierr); 600 for (j=0; j<3; j++) { 601 #if defined (PETSC_USE_COMPLEX) 602 ierr = PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", 603 PetscRealPart(idx[i*3+j]),PetscImaginaryPart(idx[i*3+j]));CHKERRQ(ierr); 604 #else 605 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*3+j]);CHKERRQ(ierr); 606 #endif 607 } 608 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 609 } 610 if (p) { 611 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);CHKERRQ(ierr); 612 for (i=0; i<p; i++) { 613 #if defined (PETSC_USE_COMPLEX) 614 ierr = PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", 615 PetscRealPart(idx[n*3+i]),PetscImaginaryPart(idx[n*3+i]));CHKERRQ(ierr); 616 #else 617 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[3*n+i]);CHKERRQ(ierr); 618 #endif 619 } 620 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 621 } 622 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 623 ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);CHKERRQ(ierr); 624 } else if (isbinary) { 625 PetscMPIInt size,rank,*sizes,Ntotal,*displs,NN = PetscMPIIntCast(N); 626 PetscScalar *array; 627 628 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 629 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 630 631 if (size > 1) { 632 if (rank) { 633 ierr = MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);CHKERRQ(ierr); 634 ierr = MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,0,0,0,MPIU_SCALAR,0,comm);CHKERRQ(ierr); 635 } else { 636 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&sizes);CHKERRQ(ierr); 637 ierr = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);CHKERRQ(ierr); 638 Ntotal = sizes[0]; 639 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&displs);CHKERRQ(ierr); 640 displs[0] = 0; 641 for (i=1; i<size; i++) { 642 Ntotal += sizes[i]; 643 displs[i] = displs[i-1] + sizes[i-1]; 644 } 645 ierr = PetscMalloc(Ntotal*sizeof(PetscScalar),&array);CHKERRQ(ierr); 646 ierr = MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);CHKERRQ(ierr); 647 ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR,PETSC_TRUE);CHKERRQ(ierr); 648 ierr = PetscFree(sizes);CHKERRQ(ierr); 649 ierr = PetscFree(displs);CHKERRQ(ierr); 650 ierr = PetscFree(array);CHKERRQ(ierr); 651 } 652 } else { 653 ierr = PetscViewerBinaryWrite(viewer,(void *) idx,N,PETSC_SCALAR,PETSC_FALSE);CHKERRQ(ierr); 654 } 655 } else { 656 const char *tname; 657 ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr); 658 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname); 659 } 660 PetscFunctionReturn(0); 661 } 662 663 664 665 666