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:\nsee http://www.mcs.anl.gov/petsc/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/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/documentation/faq.html#ZeroPivot", 248 " ", 249 " ", 250 "Overflow in integer operation:\nsee http://www.mcs.anl.gov/petsc/documentation/faq.html#64-bit-indices", 251 /*85 */ "Null argument, when expecting valid pointer", 252 /*86 */ "Unknown type. Check for miss-spelling or missing external package needed for type:\nsee http://www.mcs.anl.gov/petsc/documentation/installation.html#external", 253 /*87 */ "Not used", 254 /*88 */ "Error in system call", 255 /*89 */ "Object Type not set:\nsee http://www.mcs.anl.gov/petsc/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 && 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 = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr); 420 ierr = PetscObjectTypeCompare((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; 439 PetscInt *array; 440 441 NN = PetscMPIIntCast(N); 442 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 443 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 444 445 if (size > 1) { 446 if (rank) { 447 ierr = MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);CHKERRQ(ierr); 448 ierr = MPI_Gatherv((void*)idx,NN,MPIU_INT,0,0,0,MPIU_INT,0,comm);CHKERRQ(ierr); 449 } else { 450 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&sizes);CHKERRQ(ierr); 451 ierr = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr); 452 Ntotal = sizes[0]; 453 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&displs);CHKERRQ(ierr); 454 displs[0] = 0; 455 for (i=1; i<size; i++) { 456 Ntotal += sizes[i]; 457 displs[i] = displs[i-1] + sizes[i-1]; 458 } 459 ierr = PetscMalloc(Ntotal*sizeof(PetscInt),&array);CHKERRQ(ierr); 460 ierr = MPI_Gatherv((void*)idx,NN,MPIU_INT,array,sizes,displs,MPIU_INT,0,comm);CHKERRQ(ierr); 461 ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_INT,PETSC_TRUE);CHKERRQ(ierr); 462 ierr = PetscFree(sizes);CHKERRQ(ierr); 463 ierr = PetscFree(displs);CHKERRQ(ierr); 464 ierr = PetscFree(array);CHKERRQ(ierr); 465 } 466 } else { 467 ierr = PetscViewerBinaryWrite(viewer,(void *) idx,N,PETSC_INT,PETSC_FALSE);CHKERRQ(ierr); 468 } 469 } else { 470 const char *tname; 471 ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr); 472 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname); 473 } 474 PetscFunctionReturn(0); 475 } 476 477 #undef __FUNCT__ 478 #define __FUNCT__ "PetscRealView" 479 /*@C 480 PetscRealView - Prints an array of doubles; useful for debugging. 481 482 Collective on PetscViewer 483 484 Input Parameters: 485 + N - number of doubles in array 486 . idx - array of doubles 487 - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0 488 489 Level: intermediate 490 491 Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done 492 493 .seealso: PetscIntView() 494 @*/ 495 PetscErrorCode PetscRealView(PetscInt N,const PetscReal idx[],PetscViewer viewer) 496 { 497 PetscErrorCode ierr; 498 PetscInt j,i,n = N/5,p = N % 5; 499 PetscBool iascii,isbinary; 500 MPI_Comm comm; 501 502 PetscFunctionBegin; 503 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; 504 PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,3); 505 PetscValidScalarPointer(idx,2); 506 ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr); 507 508 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr); 509 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);CHKERRQ(ierr); 510 if (iascii) { 511 ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);CHKERRQ(ierr); 512 for (i=0; i<n; i++) { 513 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*i);CHKERRQ(ierr); 514 for (j=0; j<5; j++) { 515 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*5+j]);CHKERRQ(ierr); 516 } 517 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 518 } 519 if (p) { 520 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*n);CHKERRQ(ierr); 521 for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[5*n+i]);CHKERRQ(ierr);} 522 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 523 } 524 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 525 ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);CHKERRQ(ierr); 526 } else if (isbinary) { 527 PetscMPIInt rank,size,*sizes,*displs, Ntotal,NN; 528 PetscReal *array; 529 530 NN = PetscMPIIntCast(N); 531 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 532 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 533 534 if (size > 1) { 535 if (rank) { 536 ierr = MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);CHKERRQ(ierr); 537 ierr = MPI_Gatherv((void*)idx,NN,MPI_DOUBLE,0,0,0,MPI_DOUBLE,0,comm);CHKERRQ(ierr); 538 } else { 539 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&sizes);CHKERRQ(ierr); 540 ierr = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);CHKERRQ(ierr); 541 Ntotal = sizes[0]; 542 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&displs);CHKERRQ(ierr); 543 displs[0] = 0; 544 for (i=1; i<size; i++) { 545 Ntotal += sizes[i]; 546 displs[i] = displs[i-1] + sizes[i-1]; 547 } 548 ierr = PetscMalloc(Ntotal*sizeof(PetscReal),&array);CHKERRQ(ierr); 549 ierr = MPI_Gatherv((void*)idx,NN,MPI_DOUBLE,array,sizes,displs,MPI_DOUBLE,0,comm);CHKERRQ(ierr); 550 ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_REAL,PETSC_TRUE);CHKERRQ(ierr); 551 ierr = PetscFree(sizes);CHKERRQ(ierr); 552 ierr = PetscFree(displs);CHKERRQ(ierr); 553 ierr = PetscFree(array);CHKERRQ(ierr); 554 } 555 } else { 556 ierr = PetscViewerBinaryWrite(viewer,(void *) idx,N,PETSC_REAL,PETSC_FALSE);CHKERRQ(ierr); 557 } 558 } else { 559 const char *tname; 560 ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr); 561 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname); 562 } 563 PetscFunctionReturn(0); 564 } 565 566 #undef __FUNCT__ 567 #define __FUNCT__ "PetscScalarView" 568 /*@C 569 PetscScalarView - Prints an array of scalars; useful for debugging. 570 571 Collective on PetscViewer 572 573 Input Parameters: 574 + N - number of scalars in array 575 . idx - array of scalars 576 - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0 577 578 Level: intermediate 579 580 Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done 581 582 .seealso: PetscIntView(), PetscRealView() 583 @*/ 584 PetscErrorCode PetscScalarView(PetscInt N,const PetscScalar idx[],PetscViewer viewer) 585 { 586 PetscErrorCode ierr; 587 PetscInt j,i,n = N/3,p = N % 3; 588 PetscBool iascii,isbinary; 589 MPI_Comm comm; 590 591 PetscFunctionBegin; 592 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; 593 PetscValidHeader(viewer,3); 594 PetscValidScalarPointer(idx,2); 595 ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr); 596 597 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr); 598 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);CHKERRQ(ierr); 599 if (iascii) { 600 ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);CHKERRQ(ierr); 601 for (i=0; i<n; i++) { 602 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);CHKERRQ(ierr); 603 for (j=0; j<3; j++) { 604 #if defined (PETSC_USE_COMPLEX) 605 ierr = PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", 606 PetscRealPart(idx[i*3+j]),PetscImaginaryPart(idx[i*3+j]));CHKERRQ(ierr); 607 #else 608 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*3+j]);CHKERRQ(ierr); 609 #endif 610 } 611 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 612 } 613 if (p) { 614 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);CHKERRQ(ierr); 615 for (i=0; i<p; i++) { 616 #if defined (PETSC_USE_COMPLEX) 617 ierr = PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", 618 PetscRealPart(idx[n*3+i]),PetscImaginaryPart(idx[n*3+i]));CHKERRQ(ierr); 619 #else 620 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[3*n+i]);CHKERRQ(ierr); 621 #endif 622 } 623 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 624 } 625 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 626 ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);CHKERRQ(ierr); 627 } else if (isbinary) { 628 PetscMPIInt size,rank,*sizes,Ntotal,*displs,NN; 629 PetscScalar *array; 630 631 NN = PetscMPIIntCast(N); 632 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 633 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 634 635 if (size > 1) { 636 if (rank) { 637 ierr = MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);CHKERRQ(ierr); 638 ierr = MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,0,0,0,MPIU_SCALAR,0,comm);CHKERRQ(ierr); 639 } else { 640 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&sizes);CHKERRQ(ierr); 641 ierr = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);CHKERRQ(ierr); 642 Ntotal = sizes[0]; 643 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&displs);CHKERRQ(ierr); 644 displs[0] = 0; 645 for (i=1; i<size; i++) { 646 Ntotal += sizes[i]; 647 displs[i] = displs[i-1] + sizes[i-1]; 648 } 649 ierr = PetscMalloc(Ntotal*sizeof(PetscScalar),&array);CHKERRQ(ierr); 650 ierr = MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);CHKERRQ(ierr); 651 ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR,PETSC_TRUE);CHKERRQ(ierr); 652 ierr = PetscFree(sizes);CHKERRQ(ierr); 653 ierr = PetscFree(displs);CHKERRQ(ierr); 654 ierr = PetscFree(array);CHKERRQ(ierr); 655 } 656 } else { 657 ierr = PetscViewerBinaryWrite(viewer,(void *) idx,N,PETSC_SCALAR,PETSC_FALSE);CHKERRQ(ierr); 658 } 659 } else { 660 const char *tname; 661 ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr); 662 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname); 663 } 664 PetscFunctionReturn(0); 665 } 666 667 668 669 670