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 257 #undef __FUNCT__ 258 #define __FUNCT__ "PetscErrorMessage" 259 /*@C 260 PetscErrorMessage - returns the text string associated with a PETSc error code. 261 262 Not Collective 263 264 Input Parameter: 265 . errnum - the error code 266 267 Output Parameter: 268 + text - the error message (PETSC_NULL if not desired) 269 - specific - the specific error message that was set with SETERRxxx() or PetscError(). (PETSC_NULL if not desired) 270 271 Level: developer 272 273 Concepts: error handler^messages 274 275 .seealso: PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(), 276 PetscAbortErrorHandler(), PetscTraceBackErrorHandler() 277 @*/ 278 PetscErrorCode PetscErrorMessage(int errnum,const char *text[],char **specific) 279 { 280 PetscFunctionBegin; 281 if (text && errnum > PETSC_ERR_MIN_VALUE && errnum < PETSC_ERR_MAX_VALUE) { 282 *text = PetscErrorStrings[errnum-PETSC_ERR_MIN_VALUE-1]; 283 } else if (text) *text = 0; 284 285 if (specific) { 286 *specific = PetscErrorBaseMessage; 287 } 288 PetscFunctionReturn(0); 289 } 290 291 #undef __FUNCT__ 292 #define __FUNCT__ "PetscError" 293 /*@C 294 PetscError - Routine that is called when an error has been detected, 295 usually called through the macro SETERRQ(PETSC_COMM_SELF,). 296 297 Not Collective 298 299 Input Parameters: 300 + comm - communicator over which error occurred. ALL ranks of this communicator MUST call this routine 301 . line - the line number of the error (indicated by __LINE__) 302 . func - the function where the error occured (indicated by __FUNCT__) 303 . dir - the directory of file (indicated by __SDIR__) 304 . file - the file in which the error was detected (indicated by __FILE__) 305 . mess - an error text string, usually just printed to the screen 306 . n - the generic error number 307 . p - PETSC_ERROR_INITIAL indicates the error was initially detected, PETSC_ERROR_REPEAT indicates this is a traceback from a previously detected error 308 - mess - formatted message string - aka printf 309 310 Level: intermediate 311 312 Notes: 313 Most users need not directly use this routine and the error handlers, but 314 can instead use the simplified interface SETERRQ, which has the calling 315 sequence 316 $ SETERRQ(comm,n,mess) 317 318 Experienced users can set the error handler with PetscPushErrorHandler(). 319 320 Concepts: error^setting condition 321 322 .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2() 323 @*/ 324 PetscErrorCode PetscError(MPI_Comm comm,int line,const char *func,const char* file,const char *dir,PetscErrorCode n,PetscErrorType p,const char *mess,...) 325 { 326 va_list Argp; 327 size_t fullLength; 328 PetscErrorCode ierr; 329 char buf[2048],*lbuf = 0; 330 PetscBool ismain,isunknown; 331 332 if (!func) func = "User provided function"; 333 if (!file) file = "User file"; 334 if (!dir) dir = " "; 335 336 PetscFunctionBegin; 337 /* Compose the message evaluating the print format */ 338 if (mess) { 339 va_start(Argp,mess); 340 PetscVSNPrintf(buf,2048,mess,&fullLength,Argp); 341 va_end(Argp); 342 lbuf = buf; 343 if (p == 1) { 344 PetscStrncpy(PetscErrorBaseMessage,lbuf,1023); 345 } 346 } 347 348 if (!eh) ierr = PetscTraceBackErrorHandler(comm,line,func,file,dir,n,p,lbuf,0); 349 else ierr = (*eh->handler)(comm,line,func,file,dir,n,p,lbuf,eh->ctx); 350 351 /* 352 If this is called from the main() routine we call MPI_Abort() instead of 353 return to allow the parallel program to be properly shutdown. 354 355 Since this is in the error handler we don't check the errors below. Of course, 356 PetscStrncmp() does its own error checking which is problamatic 357 */ 358 PetscStrncmp(func,"main",4,&ismain); 359 PetscStrncmp(func,"unknown",7,&isunknown); 360 if (ismain || isunknown) { 361 MPI_Abort(PETSC_COMM_WORLD,(int)ierr); 362 } 363 #if defined(PETSC_CLANGUAGE_CXX) && !defined(PETSC_USE_EXTERN_CXX) 364 if (p == PETSC_ERROR_IN_CXX) { 365 const char *str; 366 if (eh->ctx) { 367 std::ostringstream *msg; 368 msg = (std::ostringstream*) eh->ctx; 369 str = msg->str().c_str(); 370 } else { 371 str = "Error detected in C PETSc"; 372 } 373 throw PETSc::Exception(str); 374 } 375 #endif 376 PetscFunctionReturn(ierr); 377 } 378 379 /* -------------------------------------------------------------------------*/ 380 381 #undef __FUNCT__ 382 #define __FUNCT__ "PetscIntView" 383 /*@C 384 PetscIntView - Prints an array of integers; useful for debugging. 385 386 Collective on PetscViewer 387 388 Input Parameters: 389 + N - number of integers in array 390 . idx - array of integers 391 - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0 392 393 Level: intermediate 394 395 Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done 396 397 .seealso: PetscRealView() 398 @*/ 399 PetscErrorCode PetscIntView(PetscInt N,const PetscInt idx[],PetscViewer viewer) 400 { 401 PetscErrorCode ierr; 402 PetscInt j,i,n = N/20,p = N % 20; 403 PetscBool iascii,isbinary; 404 MPI_Comm comm; 405 406 PetscFunctionBegin; 407 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; 408 PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,3); 409 if (N) PetscValidIntPointer(idx,2); 410 ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr); 411 412 ierr = PetscTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr); 413 ierr = PetscTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);CHKERRQ(ierr); 414 if (iascii) { 415 ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);CHKERRQ(ierr); 416 for (i=0; i<n; i++) { 417 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*i);CHKERRQ(ierr); 418 for (j=0; j<20; j++) { 419 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[i*20+j]);CHKERRQ(ierr); 420 } 421 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 422 } 423 if (p) { 424 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*n);CHKERRQ(ierr); 425 for (i=0; i<p; i++) { ierr = PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[20*n+i]);CHKERRQ(ierr);} 426 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 427 } 428 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 429 ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);CHKERRQ(ierr); 430 } else if (isbinary) { 431 PetscMPIInt rank,size,*sizes,Ntotal,*displs, NN = PetscMPIIntCast(N); 432 PetscInt *array; 433 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 434 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 435 436 if (size > 1) { 437 if (rank) { 438 ierr = MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);CHKERRQ(ierr); 439 ierr = MPI_Gatherv((void*)idx,NN,MPIU_INT,0,0,0,MPIU_INT,0,comm);CHKERRQ(ierr); 440 } else { 441 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&sizes);CHKERRQ(ierr); 442 ierr = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr); 443 Ntotal = sizes[0]; 444 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&displs);CHKERRQ(ierr); 445 displs[0] = 0; 446 for (i=1; i<size; i++) { 447 Ntotal += sizes[i]; 448 displs[i] = displs[i-1] + sizes[i-1]; 449 } 450 ierr = PetscMalloc(Ntotal*sizeof(PetscInt),&array);CHKERRQ(ierr); 451 ierr = MPI_Gatherv((void*)idx,NN,MPIU_INT,array,sizes,displs,MPIU_INT,0,comm);CHKERRQ(ierr); 452 ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_INT,PETSC_TRUE);CHKERRQ(ierr); 453 ierr = PetscFree(sizes);CHKERRQ(ierr); 454 ierr = PetscFree(displs);CHKERRQ(ierr); 455 ierr = PetscFree(array);CHKERRQ(ierr); 456 } 457 } else { 458 ierr = PetscViewerBinaryWrite(viewer,(void *) idx,N,PETSC_INT,PETSC_FALSE);CHKERRQ(ierr); 459 } 460 } else { 461 const char *tname; 462 ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr); 463 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname); 464 } 465 PetscFunctionReturn(0); 466 } 467 468 #undef __FUNCT__ 469 #define __FUNCT__ "PetscRealView" 470 /*@C 471 PetscRealView - Prints an array of doubles; useful for debugging. 472 473 Collective on PetscViewer 474 475 Input Parameters: 476 + N - number of doubles in array 477 . idx - array of doubles 478 - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0 479 480 Level: intermediate 481 482 Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done 483 484 .seealso: PetscIntView() 485 @*/ 486 PetscErrorCode PetscRealView(PetscInt N,const PetscReal idx[],PetscViewer viewer) 487 { 488 PetscErrorCode ierr; 489 PetscInt j,i,n = N/5,p = N % 5; 490 PetscBool iascii,isbinary; 491 MPI_Comm comm; 492 493 PetscFunctionBegin; 494 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; 495 PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,3); 496 PetscValidScalarPointer(idx,2); 497 ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr); 498 499 ierr = PetscTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr); 500 ierr = PetscTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);CHKERRQ(ierr); 501 if (iascii) { 502 ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);CHKERRQ(ierr); 503 for (i=0; i<n; i++) { 504 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*i);CHKERRQ(ierr); 505 for (j=0; j<5; j++) { 506 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*5+j]);CHKERRQ(ierr); 507 } 508 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 509 } 510 if (p) { 511 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*n);CHKERRQ(ierr); 512 for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[5*n+i]);CHKERRQ(ierr);} 513 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 514 } 515 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 516 ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);CHKERRQ(ierr); 517 } else if (isbinary) { 518 PetscMPIInt rank,size,*sizes,*displs, Ntotal,NN = PetscMPIIntCast(N); 519 PetscReal *array; 520 521 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 522 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 523 524 if (size > 1) { 525 if (rank) { 526 ierr = MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);CHKERRQ(ierr); 527 ierr = MPI_Gatherv((void*)idx,NN,MPI_DOUBLE,0,0,0,MPI_DOUBLE,0,comm);CHKERRQ(ierr); 528 } else { 529 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&sizes);CHKERRQ(ierr); 530 ierr = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);CHKERRQ(ierr); 531 Ntotal = sizes[0]; 532 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&displs);CHKERRQ(ierr); 533 displs[0] = 0; 534 for (i=1; i<size; i++) { 535 Ntotal += sizes[i]; 536 displs[i] = displs[i-1] + sizes[i-1]; 537 } 538 ierr = PetscMalloc(Ntotal*sizeof(PetscReal),&array);CHKERRQ(ierr); 539 ierr = MPI_Gatherv((void*)idx,NN,MPI_DOUBLE,array,sizes,displs,MPI_DOUBLE,0,comm);CHKERRQ(ierr); 540 ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_REAL,PETSC_TRUE);CHKERRQ(ierr); 541 ierr = PetscFree(sizes);CHKERRQ(ierr); 542 ierr = PetscFree(displs);CHKERRQ(ierr); 543 ierr = PetscFree(array);CHKERRQ(ierr); 544 } 545 } else { 546 ierr = PetscViewerBinaryWrite(viewer,(void *) idx,N,PETSC_REAL,PETSC_FALSE);CHKERRQ(ierr); 547 } 548 } else { 549 const char *tname; 550 ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr); 551 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname); 552 } 553 PetscFunctionReturn(0); 554 } 555 556 #undef __FUNCT__ 557 #define __FUNCT__ "PetscScalarView" 558 /*@C 559 PetscScalarView - Prints an array of scalars; useful for debugging. 560 561 Collective on PetscViewer 562 563 Input Parameters: 564 + N - number of scalars in array 565 . idx - array of scalars 566 - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0 567 568 Level: intermediate 569 570 Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done 571 572 .seealso: PetscIntView(), PetscRealView() 573 @*/ 574 PetscErrorCode PetscScalarView(PetscInt N,const PetscScalar idx[],PetscViewer viewer) 575 { 576 PetscErrorCode ierr; 577 PetscInt j,i,n = N/3,p = N % 3; 578 PetscBool iascii,isbinary; 579 MPI_Comm comm; 580 581 PetscFunctionBegin; 582 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; 583 PetscValidHeader(viewer,3); 584 PetscValidScalarPointer(idx,2); 585 ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr); 586 587 ierr = PetscTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr); 588 ierr = PetscTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);CHKERRQ(ierr); 589 if (iascii) { 590 ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);CHKERRQ(ierr); 591 for (i=0; i<n; i++) { 592 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);CHKERRQ(ierr); 593 for (j=0; j<3; j++) { 594 #if defined (PETSC_USE_COMPLEX) 595 ierr = PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", 596 PetscRealPart(idx[i*3+j]),PetscImaginaryPart(idx[i*3+j]));CHKERRQ(ierr); 597 #else 598 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*3+j]);CHKERRQ(ierr); 599 #endif 600 } 601 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 602 } 603 if (p) { 604 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);CHKERRQ(ierr); 605 for (i=0; i<p; i++) { 606 #if defined (PETSC_USE_COMPLEX) 607 ierr = PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", 608 PetscRealPart(idx[n*3+i]),PetscImaginaryPart(idx[n*3+i]));CHKERRQ(ierr); 609 #else 610 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[3*n+i]);CHKERRQ(ierr); 611 #endif 612 } 613 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 614 } 615 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 616 ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);CHKERRQ(ierr); 617 } else if (isbinary) { 618 PetscMPIInt size,rank,*sizes,Ntotal,*displs,NN = PetscMPIIntCast(N); 619 PetscScalar *array; 620 621 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 622 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 623 624 if (size > 1) { 625 if (rank) { 626 ierr = MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);CHKERRQ(ierr); 627 ierr = MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,0,0,0,MPIU_SCALAR,0,comm);CHKERRQ(ierr); 628 } else { 629 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&sizes);CHKERRQ(ierr); 630 ierr = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);CHKERRQ(ierr); 631 Ntotal = sizes[0]; 632 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&displs);CHKERRQ(ierr); 633 displs[0] = 0; 634 for (i=1; i<size; i++) { 635 Ntotal += sizes[i]; 636 displs[i] = displs[i-1] + sizes[i-1]; 637 } 638 ierr = PetscMalloc(Ntotal*sizeof(PetscScalar),&array);CHKERRQ(ierr); 639 ierr = MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);CHKERRQ(ierr); 640 ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR,PETSC_TRUE);CHKERRQ(ierr); 641 ierr = PetscFree(sizes);CHKERRQ(ierr); 642 ierr = PetscFree(displs);CHKERRQ(ierr); 643 ierr = PetscFree(array);CHKERRQ(ierr); 644 } 645 } else { 646 ierr = PetscViewerBinaryWrite(viewer,(void *) idx,N,PETSC_SCALAR,PETSC_FALSE);CHKERRQ(ierr); 647 } 648 } else { 649 const char *tname; 650 ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr); 651 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname); 652 } 653 PetscFunctionReturn(0); 654 } 655 656 657 658 659