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