1 #include <../src/sys/classes/viewer/impls/ascii/asciiimpl.h> /*I "petscviewer.h" I*/ 2 3 #define QUEUESTRINGSIZE 8192 4 5 static PetscErrorCode PetscViewerFileClose_ASCII(PetscViewer viewer) 6 { 7 PetscMPIInt rank; 8 PetscViewer_ASCII *vascii = (PetscViewer_ASCII *)viewer->data; 9 int err; 10 11 PetscFunctionBegin; 12 PetscCheck(!vascii->sviewer, PetscObjectComm((PetscObject)viewer), PETSC_ERR_ARG_WRONGSTATE, "Cannot call with outstanding call to PetscViewerRestoreSubViewer()"); 13 PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)viewer), &rank)); 14 if (rank == 0 && vascii->fd != stderr && vascii->fd != PETSC_STDOUT) { 15 if (vascii->fd && vascii->closefile) { 16 err = fclose(vascii->fd); 17 PetscCheck(!err, PETSC_COMM_SELF, PETSC_ERR_SYS, "fclose() failed on file"); 18 } 19 if (vascii->storecompressed) { 20 char par[PETSC_MAX_PATH_LEN], buf[PETSC_MAX_PATH_LEN]; 21 FILE *fp; 22 PetscCall(PetscStrncpy(par, "gzip ", sizeof(par))); 23 PetscCall(PetscStrlcat(par, vascii->filename, sizeof(par))); 24 #if defined(PETSC_HAVE_POPEN) 25 PetscCall(PetscPOpen(PETSC_COMM_SELF, NULL, par, "r", &fp)); 26 PetscCheck(!fgets(buf, 1024, fp), PETSC_COMM_SELF, PETSC_ERR_LIB, "Error from compression command %s %s", par, buf); 27 PetscCall(PetscPClose(PETSC_COMM_SELF, fp)); 28 #else 29 SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP_SYS, "Cannot run external programs on this machine"); 30 #endif 31 } 32 } 33 PetscCall(PetscFree(vascii->filename)); 34 PetscFunctionReturn(PETSC_SUCCESS); 35 } 36 37 static PetscErrorCode PetscViewerDestroy_ASCII(PetscViewer viewer) 38 { 39 PetscViewer_ASCII *vascii = (PetscViewer_ASCII *)viewer->data; 40 PetscViewerLink *vlink; 41 PetscMPIInt iflg; 42 43 PetscFunctionBegin; 44 PetscCheck(!vascii->sviewer, PetscObjectComm((PetscObject)viewer), PETSC_ERR_ARG_WRONGSTATE, "Cannot call with outstanding call to PetscViewerRestoreSubViewer()"); 45 PetscCall(PetscViewerFileClose_ASCII(viewer)); 46 PetscCall(PetscFree(vascii)); 47 48 /* remove the viewer from the list in the MPI Communicator */ 49 if (Petsc_Viewer_keyval == MPI_KEYVAL_INVALID) PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, Petsc_DelViewer, &Petsc_Viewer_keyval, NULL)); 50 51 PetscCallMPI(MPI_Comm_get_attr(PetscObjectComm((PetscObject)viewer), Petsc_Viewer_keyval, (void **)&vlink, &iflg)); 52 if (iflg) { 53 if (vlink && vlink->viewer == viewer) { 54 if (vlink->next) { 55 PetscCallMPI(MPI_Comm_set_attr(PetscObjectComm((PetscObject)viewer), Petsc_Viewer_keyval, vlink->next)); 56 } else { 57 PetscCallMPI(MPI_Comm_delete_attr(PetscObjectComm((PetscObject)viewer), Petsc_Viewer_keyval)); 58 } 59 PetscCall(PetscFree(vlink)); 60 } else { 61 while (vlink && vlink->next) { 62 if (vlink->next->viewer == viewer) { 63 PetscViewerLink *nv = vlink->next; 64 vlink->next = vlink->next->next; 65 PetscCall(PetscFree(nv)); 66 } 67 vlink = vlink->next; 68 } 69 } 70 } 71 72 if (Petsc_Viewer_Stdout_keyval != MPI_KEYVAL_INVALID) { 73 PetscViewer aviewer; 74 PetscCallMPI(MPI_Comm_get_attr(PetscObjectComm((PetscObject)viewer), Petsc_Viewer_Stdout_keyval, (void **)&aviewer, &iflg)); 75 if (iflg && aviewer == viewer) PetscCallMPI(MPI_Comm_delete_attr(PetscObjectComm((PetscObject)viewer), Petsc_Viewer_Stdout_keyval)); 76 } 77 if (Petsc_Viewer_Stderr_keyval != MPI_KEYVAL_INVALID) { 78 PetscViewer aviewer; 79 PetscCallMPI(MPI_Comm_get_attr(PetscObjectComm((PetscObject)viewer), Petsc_Viewer_Stderr_keyval, (void **)&aviewer, &iflg)); 80 if (iflg && aviewer == viewer) PetscCallMPI(MPI_Comm_delete_attr(PetscObjectComm((PetscObject)viewer), Petsc_Viewer_Stderr_keyval)); 81 } 82 PetscCall(PetscObjectComposeFunction((PetscObject)viewer, "PetscViewerFileSetName_C", NULL)); 83 PetscCall(PetscObjectComposeFunction((PetscObject)viewer, "PetscViewerFileGetName_C", NULL)); 84 PetscCall(PetscObjectComposeFunction((PetscObject)viewer, "PetscViewerFileGetMode_C", NULL)); 85 PetscCall(PetscObjectComposeFunction((PetscObject)viewer, "PetscViewerFileSetMode_C", NULL)); 86 PetscFunctionReturn(PETSC_SUCCESS); 87 } 88 89 static PetscErrorCode PetscViewerDestroy_ASCII_SubViewer(PetscViewer viewer) 90 { 91 PetscViewer_ASCII *vascii = (PetscViewer_ASCII *)viewer->data; 92 93 PetscFunctionBegin; 94 PetscCall(PetscViewerRestoreSubViewer(vascii->bviewer, 0, &viewer)); 95 PetscFunctionReturn(PETSC_SUCCESS); 96 } 97 98 /*@C 99 PetscViewerASCIIGetPointer - Extracts the file pointer from an ASCII `PetscViewer`. 100 101 Not Collective, depending on the viewer the value may be meaningless except for process 0 of the viewer; No Fortran Support 102 103 Input Parameter: 104 . viewer - `PetscViewer` context, obtained from `PetscViewerASCIIOpen()` 105 106 Output Parameter: 107 . fd - file pointer 108 109 Level: intermediate 110 111 Note: 112 For the standard `PETSCVIEWERASCII` the value is valid only on MPI rank 0 of the viewer 113 114 .seealso: [](sec_viewers), `PETSCVIEWERASCII`, `PetscViewerASCIIOpen()`, `PetscViewerDestroy()`, `PetscViewerSetType()`, 115 `PetscViewerCreate()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscViewerFlush()` 116 @*/ 117 PetscErrorCode PetscViewerASCIIGetPointer(PetscViewer viewer, FILE **fd) 118 { 119 PetscViewer_ASCII *vascii = (PetscViewer_ASCII *)viewer->data; 120 121 PetscFunctionBegin; 122 PetscCheck(!vascii->fileunit, PetscObjectComm((PetscObject)viewer), PETSC_ERR_ARG_WRONGSTATE, "Cannot request file pointer for viewers that use Fortran files"); 123 *fd = vascii->fd; 124 PetscFunctionReturn(PETSC_SUCCESS); 125 } 126 127 static PetscErrorCode PetscViewerFileGetMode_ASCII(PetscViewer viewer, PetscFileMode *mode) 128 { 129 PetscViewer_ASCII *vascii = (PetscViewer_ASCII *)viewer->data; 130 131 PetscFunctionBegin; 132 *mode = vascii->mode; 133 PetscFunctionReturn(PETSC_SUCCESS); 134 } 135 136 static PetscErrorCode PetscViewerFileSetMode_ASCII(PetscViewer viewer, PetscFileMode mode) 137 { 138 PetscViewer_ASCII *vascii = (PetscViewer_ASCII *)viewer->data; 139 140 PetscFunctionBegin; 141 vascii->mode = mode; 142 PetscFunctionReturn(PETSC_SUCCESS); 143 } 144 145 /* 146 If petsc_history is on, then all Petsc*Printf() results are saved 147 if the appropriate (usually .petschistory) file. 148 */ 149 PETSC_INTERN FILE *petsc_history; 150 151 /*@ 152 PetscViewerASCIISetTab - Causes `PetscViewer` to tab in a number of times before printing 153 154 Not Collective, but only first processor in set has any effect; No Fortran Support 155 156 Input Parameters: 157 + viewer - obtained with `PetscViewerASCIIOpen()` 158 - tabs - number of tabs 159 160 Level: developer 161 162 Note: 163 `PetscViewerASCIIPushTab()` and `PetscViewerASCIIPopTab()` are the preferred usage 164 165 .seealso: [](sec_viewers), `PETSCVIEWERASCII`, `PetscPrintf()`, `PetscSynchronizedPrintf()`, `PetscViewerASCIIPrintf()`, 166 `PetscViewerASCIIGetTab()`, 167 `PetscViewerASCIIPopTab()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscViewerASCIIOpen()`, 168 `PetscViewerCreate()`, `PetscViewerDestroy()`, `PetscViewerSetType()`, `PetscViewerASCIIGetPointer()`, 169 `PetscViewerASCIIPushTab()` 170 @*/ 171 PetscErrorCode PetscViewerASCIISetTab(PetscViewer viewer, PetscInt tabs) 172 { 173 PetscViewer_ASCII *ascii = (PetscViewer_ASCII *)viewer->data; 174 PetscBool isascii; 175 176 PetscFunctionBegin; 177 PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 1); 178 PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &isascii)); 179 if (isascii) ascii->tab = tabs; 180 PetscFunctionReturn(PETSC_SUCCESS); 181 } 182 183 /*@ 184 PetscViewerASCIIGetTab - Return the number of tabs used by `PetscViewer`. 185 186 Not Collective, meaningful on first processor only; No Fortran Support 187 188 Input Parameter: 189 . viewer - obtained with `PetscViewerASCIIOpen()` 190 191 Output Parameter: 192 . tabs - number of tabs 193 194 Level: developer 195 196 .seealso: [](sec_viewers), `PETSCVIEWERASCII`, `PetscPrintf()`, `PetscSynchronizedPrintf()`, `PetscViewerASCIIPrintf()`, 197 `PetscViewerASCIISetTab()`, 198 `PetscViewerASCIIPopTab()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscViewerASCIIOpen()`, 199 `PetscViewerCreate()`, `PetscViewerDestroy()`, `PetscViewerSetType()`, `PetscViewerASCIIGetPointer()`, `PetscViewerASCIIPushTab()` 200 @*/ 201 PetscErrorCode PetscViewerASCIIGetTab(PetscViewer viewer, PetscInt *tabs) 202 { 203 PetscViewer_ASCII *ascii = (PetscViewer_ASCII *)viewer->data; 204 PetscBool isascii; 205 206 PetscFunctionBegin; 207 PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 1); 208 PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &isascii)); 209 if (isascii && tabs) *tabs = ascii->tab; 210 PetscFunctionReturn(PETSC_SUCCESS); 211 } 212 213 /*@ 214 PetscViewerASCIIAddTab - Add to the number of times a `PETSCVIEWERASCII` viewer tabs before printing 215 216 Not Collective, but only first processor in set has any effect; No Fortran Support 217 218 Input Parameters: 219 + viewer - obtained with `PetscViewerASCIIOpen()` 220 - tabs - number of tabs 221 222 Level: developer 223 224 Note: 225 `PetscViewerASCIIPushTab()` and `PetscViewerASCIIPopTab()` are the preferred usage 226 227 .seealso: [](sec_viewers), `PETSCVIEWERASCII`, `PetscPrintf()`, `PetscSynchronizedPrintf()`, `PetscViewerASCIIPrintf()`, 228 `PetscViewerASCIIPopTab()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscViewerASCIIOpen()`, 229 `PetscViewerCreate()`, `PetscViewerDestroy()`, `PetscViewerSetType()`, `PetscViewerASCIIGetPointer()`, `PetscViewerASCIIPushTab()` 230 @*/ 231 PetscErrorCode PetscViewerASCIIAddTab(PetscViewer viewer, PetscInt tabs) 232 { 233 PetscViewer_ASCII *ascii = (PetscViewer_ASCII *)viewer->data; 234 PetscBool isascii; 235 236 PetscFunctionBegin; 237 PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 1); 238 PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &isascii)); 239 if (isascii) ascii->tab += tabs; 240 PetscFunctionReturn(PETSC_SUCCESS); 241 } 242 243 /*@ 244 PetscViewerASCIISubtractTab - Subtracts from the number of times a `PETSCVIEWERASCII` viewer tabs before printing 245 246 Not Collective, but only first processor in set has any effect; No Fortran Support 247 248 Input Parameters: 249 + viewer - obtained with `PetscViewerASCIIOpen()` 250 - tabs - number of tabs 251 252 Level: developer 253 254 Note: 255 `PetscViewerASCIIPushTab()` and `PetscViewerASCIIPopTab()` are the preferred usage 256 257 .seealso: [](sec_viewers), `PETSCVIEWERASCII`, `PetscPrintf()`, `PetscSynchronizedPrintf()`, `PetscViewerASCIIPrintf()`, 258 `PetscViewerASCIIPopTab()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscViewerASCIIOpen()`, 259 `PetscViewerCreate()`, `PetscViewerDestroy()`, `PetscViewerSetType()`, `PetscViewerASCIIGetPointer()`, 260 `PetscViewerASCIIPushTab()` 261 @*/ 262 PetscErrorCode PetscViewerASCIISubtractTab(PetscViewer viewer, PetscInt tabs) 263 { 264 PetscViewer_ASCII *ascii = (PetscViewer_ASCII *)viewer->data; 265 PetscBool isascii; 266 267 PetscFunctionBegin; 268 PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 1); 269 PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &isascii)); 270 if (isascii) ascii->tab -= tabs; 271 PetscFunctionReturn(PETSC_SUCCESS); 272 } 273 274 /*@ 275 PetscViewerASCIIPushSynchronized - Allows calls to `PetscViewerASCIISynchronizedPrintf()` for this viewer 276 277 Collective 278 279 Input Parameter: 280 . viewer - obtained with `PetscViewerASCIIOpen()` 281 282 Level: intermediate 283 284 Note: 285 See documentation of `PetscViewerASCIISynchronizedPrintf()` for more details how the synchronized output should be done properly. 286 287 .seealso: [](sec_viewers), `PetscViewerASCIISynchronizedPrintf()`, `PetscViewerFlush()`, `PetscViewerASCIIPopSynchronized()`, 288 `PetscSynchronizedPrintf()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIIOpen()`, 289 `PetscViewerCreate()`, `PetscViewerDestroy()`, `PetscViewerSetType()` 290 @*/ 291 PetscErrorCode PetscViewerASCIIPushSynchronized(PetscViewer viewer) 292 { 293 PetscViewer_ASCII *ascii = (PetscViewer_ASCII *)viewer->data; 294 PetscBool isascii; 295 296 PetscFunctionBegin; 297 PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 1); 298 PetscCheck(!ascii->sviewer, PetscObjectComm((PetscObject)viewer), PETSC_ERR_ARG_WRONGSTATE, "Cannot call with outstanding call to PetscViewerRestoreSubViewer()"); 299 PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &isascii)); 300 if (isascii) ascii->allowsynchronized++; 301 PetscFunctionReturn(PETSC_SUCCESS); 302 } 303 304 /*@ 305 PetscViewerASCIIPopSynchronized - Undoes most recent `PetscViewerASCIIPushSynchronized()` for this viewer 306 307 Collective 308 309 Input Parameter: 310 . viewer - obtained with `PetscViewerASCIIOpen()` 311 312 Level: intermediate 313 314 Note: 315 See documentation of `PetscViewerASCIISynchronizedPrintf()` for more details how the synchronized output should be done properly. 316 317 .seealso: [](sec_viewers), `PetscViewerASCIIPushSynchronized()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscViewerFlush()`, 318 `PetscSynchronizedPrintf()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIIOpen()`, 319 `PetscViewerCreate()`, `PetscViewerDestroy()`, `PetscViewerSetType()` 320 @*/ 321 PetscErrorCode PetscViewerASCIIPopSynchronized(PetscViewer viewer) 322 { 323 PetscViewer_ASCII *ascii = (PetscViewer_ASCII *)viewer->data; 324 PetscBool isascii; 325 326 PetscFunctionBegin; 327 PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 1); 328 PetscCheck(!ascii->sviewer, PetscObjectComm((PetscObject)viewer), PETSC_ERR_ARG_WRONGSTATE, "Cannot call with outstanding call to PetscViewerRestoreSubViewer()"); 329 PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &isascii)); 330 if (isascii) { 331 ascii->allowsynchronized--; 332 PetscCheck(ascii->allowsynchronized >= 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Called more times than PetscViewerASCIIPushSynchronized()"); 333 } 334 PetscFunctionReturn(PETSC_SUCCESS); 335 } 336 337 /*@ 338 PetscViewerASCIIPushTab - Adds one more tab to the amount that `PetscViewerASCIIPrintf()` 339 lines are tabbed. 340 341 Not Collective, but only first MPI rank in the viewer has any effect; No Fortran Support 342 343 Input Parameter: 344 . viewer - obtained with `PetscViewerASCIIOpen()` 345 346 Level: developer 347 348 .seealso: [](sec_viewers), `PetscPrintf()`, `PetscSynchronizedPrintf()`, `PetscViewerASCIIPrintf()`, 349 `PetscViewerASCIIPopTab()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscViewerASCIIOpen()`, 350 `PetscViewerCreate()`, `PetscViewerDestroy()`, `PetscViewerSetType()`, `PetscViewerASCIIGetPointer()` 351 @*/ 352 PetscErrorCode PetscViewerASCIIPushTab(PetscViewer viewer) 353 { 354 PetscViewer_ASCII *ascii = (PetscViewer_ASCII *)viewer->data; 355 PetscBool isascii; 356 357 PetscFunctionBegin; 358 PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 1); 359 PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &isascii)); 360 if (isascii) ascii->tab++; 361 PetscFunctionReturn(PETSC_SUCCESS); 362 } 363 364 /*@ 365 PetscViewerASCIIPopTab - Removes one tab from the amount that `PetscViewerASCIIPrintf()` lines are tabbed that was provided by 366 `PetscViewerASCIIPushTab()` 367 368 Not Collective, but only first MPI rank in the viewer has any effect; No Fortran Support 369 370 Input Parameter: 371 . viewer - obtained with `PetscViewerASCIIOpen()` 372 373 Level: developer 374 375 .seealso: [](sec_viewers), `PetscPrintf()`, `PetscSynchronizedPrintf()`, `PetscViewerASCIIPrintf()`, 376 `PetscViewerASCIIPushTab()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscViewerASCIIOpen()`, 377 `PetscViewerCreate()`, `PetscViewerDestroy()`, `PetscViewerSetType()`, `PetscViewerASCIIGetPointer()` 378 @*/ 379 PetscErrorCode PetscViewerASCIIPopTab(PetscViewer viewer) 380 { 381 PetscViewer_ASCII *ascii = (PetscViewer_ASCII *)viewer->data; 382 PetscBool isascii; 383 384 PetscFunctionBegin; 385 PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 1); 386 PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &isascii)); 387 if (isascii) { 388 PetscCheck(ascii->tab > 0, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "More tabs popped than pushed"); 389 ascii->tab--; 390 } 391 PetscFunctionReturn(PETSC_SUCCESS); 392 } 393 394 /*@ 395 PetscViewerASCIIUseTabs - Turns on or off the use of tabs with the `PETSCVIEWERASCII` `PetscViewer` 396 397 Not Collective, but only first MPI rank in the viewer has any effect; No Fortran Support 398 399 Input Parameters: 400 + viewer - obtained with `PetscViewerASCIIOpen()` 401 - flg - `PETSC_TRUE` or `PETSC_FALSE` 402 403 Level: developer 404 405 .seealso: [](sec_viewers), `PetscPrintf()`, `PetscSynchronizedPrintf()`, `PetscViewerASCIIPrintf()`, 406 `PetscViewerASCIIPopTab()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscViewerASCIIPushTab()`, `PetscViewerASCIIOpen()`, 407 `PetscViewerCreate()`, `PetscViewerDestroy()`, `PetscViewerSetType()`, `PetscViewerASCIIGetPointer()` 408 @*/ 409 PetscErrorCode PetscViewerASCIIUseTabs(PetscViewer viewer, PetscBool flg) 410 { 411 PetscViewer_ASCII *ascii = (PetscViewer_ASCII *)viewer->data; 412 PetscBool isascii; 413 414 PetscFunctionBegin; 415 PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 1); 416 PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &isascii)); 417 if (isascii) { 418 if (flg) ascii->tab = ascii->tab_store; 419 else { 420 ascii->tab_store = ascii->tab; 421 ascii->tab = 0; 422 } 423 } 424 PetscFunctionReturn(PETSC_SUCCESS); 425 } 426 427 #if defined(PETSC_USE_FORTRAN_BINDINGS) 428 429 #if defined(PETSC_HAVE_FORTRAN_CAPS) 430 #define petscviewerasciiopenwithfileunit_ PETSCVIEWERASCIIOPENWITHFILEUNIT 431 #define petscviewerasciisetfileunit_ PETSCVIEWERASCIISETFILEUNIT 432 #define petscviewerasciistdoutsetfileunit_ PETSCVIEWERASCIISTDOUTSETFILEUNIT 433 #define petscfortranprinttofileunit_ PETSCFORTRANPRINTTOFILEUNIT 434 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 435 #define petscviewerasciiopenwithfileunit_ petscviewerasciiopenwithfileunit 436 #define petscviewerasciisetfileunit_ petscviewerasciisetfileunit 437 #define petscviewerasciistdoutsetfileunit_ petscviewerasciistdoutsetfileunit 438 #define petscfortranprinttofileunit_ petscfortranprinttofileunit 439 #endif 440 441 #if defined(__cplusplus) 442 extern "C" void petscfortranprinttofileunit_(int *, const char *, PetscErrorCode *, PETSC_FORTRAN_CHARLEN_T); 443 #else 444 extern void petscfortranprinttofileunit_(int *, const char *, PetscErrorCode *, PETSC_FORTRAN_CHARLEN_T); 445 #endif 446 447 #define PETSCDEFAULTBUFFERSIZE 8 * 1024 448 449 static int PETSC_VIEWER_ASCII_STDOUT_fileunit = 0; 450 451 // PetscClangLinter pragma disable: -fdoc-synopsis-macro-explicit-synopsis-valid-header 452 /*MC 453 PetscViewerASCIIStdoutSetFileUnit - sets `PETSC_VIEWER_STDOUT_()` to write to a Fortran IO unit 454 455 Synopsis: 456 #include <petscviewer.h> 457 void PetscViewerASCIIStdoutSetFileUnit(PetscInt unit, PetscErrorCode ierr) 458 459 Input Parameter: 460 . unit - the unit number 461 462 Output Parameter: 463 . ierr - the error code 464 465 Level: intermediate 466 467 Notes: 468 Can be called before `PetscInitialize()` 469 470 Immediately changes the output for all `PETSC_VIEWER_STDOUT_()` viewers 471 472 This may not work currently with some viewers that (improperly) use the `fd` directly instead of `PetscViewerASCIIPrintf()` 473 474 With this option, for example, `-log_options` results will be saved to the Fortran file 475 476 Any process may call this but only the unit passed on the first process is used 477 478 Fortran Note: 479 Only for Fortran 480 481 Developer Note: 482 `PetscViewerASCIIWORLDSetFilename()` and `PetscViewerASCIIWORLDSetFILE()` could be added 483 484 .seealso: `PetscViewerASCIISetFILE()`, `PETSCVIEWERASCII`, `PetscViewerASCIIOpenWithFileUnit()`, `PetscViewerASCIIStdoutSetFileUnit()`, 485 `PETSC_VIEWER_STDOUT_()`, `PetscViewerASCIIGetStdout()` 486 M*/ 487 PETSC_EXTERN void petscviewerasciistdoutsetfileunit_(int *unit, PetscErrorCode *ierr) 488 { 489 #if defined(PETSC_USE_FORTRAN_BINDINGS) 490 PETSC_VIEWER_ASCII_STDOUT_fileunit = *unit; 491 #endif 492 } 493 494 #include <petsc/private/ftnimpl.h> 495 496 // PetscClangLinter pragma disable: -fdoc-synopsis-macro-explicit-synopsis-valid-header 497 /*MC 498 PetscViewerASCIISetFileUnit - sets the `PETSCVIEWERASCII` `PetscViewer` to write to a Fortran IO unit 499 500 Synopsis: 501 #include <petscviewer.h> 502 void PetscViewerASCIISetFileUnit(PetscViewer lab, PetscInt unit, PetscErrorCode ierr) 503 504 Input Parameters: 505 + lab - the viewer 506 - unit - the unit number 507 508 Output Parameter: 509 . ierr - the error code 510 511 Level: intermediate 512 513 Note: 514 `PetscViewerDestroy()` does not close the unit for this `PetscViewer` 515 516 Fortran Notes: 517 Only for Fortran, use `PetscViewerASCIISetFILE()` for C 518 519 .seealso: `PetscViewerASCIISetFILE()`, `PETSCVIEWERASCII`, `PetscViewerASCIIOpenWithFileUnit()`, `PetscViewerASCIIStdoutSetFileUnit()` 520 M*/ 521 PETSC_EXTERN void petscviewerasciisetfileunit_(PetscViewer *lab, int *unit, PetscErrorCode *ierr) 522 { 523 PetscViewer_ASCII *vascii; 524 PetscViewer v; 525 526 PetscPatchDefaultViewers_Fortran(lab, v); 527 vascii = (PetscViewer_ASCII *)v->data; 528 if (vascii->mode == FILE_MODE_READ) { 529 *ierr = PETSC_ERR_ARG_WRONGSTATE; 530 return; 531 } 532 vascii->fileunit = *unit; 533 } 534 535 // PetscClangLinter pragma disable: -fdoc-synopsis-macro-explicit-synopsis-valid-header 536 /*MC 537 PetscViewerASCIIOpenWithFileUnit - opens a `PETSCVIEWERASCII` to write to a Fortran IO unit 538 539 Synopsis: 540 #include <petscviewer.h> 541 void PetscViewerASCIIOpenWithFileUnit((MPI_Fint comm, integer unit, PetscViewer viewer, PetscErrorCode ierr) 542 543 Input Parameters: 544 + comm - the `MPI_Comm` to share the viewer 545 - unit - the unit number 546 547 Output Parameters: 548 + lab - the viewer 549 - ierr - the error code 550 551 Level: intermediate 552 553 Note: 554 `PetscViewerDestroy()` does not close the unit for this `PetscViewer` 555 556 Fortran Notes: 557 Only for Fortran, use `PetscViewerASCIIOpenWithFILE()` for C 558 559 .seealso: `PetscViewerASCIISetFileUnit()`, `PetscViewerASCIISetFILE()`, `PETSCVIEWERASCII`, `PetscViewerASCIIOpenWithFILE()` 560 M*/ 561 PETSC_EXTERN void petscviewerasciiopenwithfileunit_(MPI_Fint *comm, int *unit, PetscViewer *lab, PetscErrorCode *ierr) 562 { 563 *ierr = PetscViewerCreate(MPI_Comm_f2c(*(MPI_Fint *)&*comm), lab); 564 if (*ierr) return; 565 *ierr = PetscViewerSetType(*lab, PETSCVIEWERASCII); 566 if (*ierr) return; 567 *ierr = PetscViewerFileSetMode(*lab, FILE_MODE_WRITE); 568 if (*ierr) return; 569 petscviewerasciisetfileunit_(lab, unit, ierr); 570 } 571 572 static PetscErrorCode PetscVFPrintfFortran(int unit, const char format[], va_list Argp) 573 { 574 PetscErrorCode ierr; 575 char str[PETSCDEFAULTBUFFERSIZE]; 576 size_t len; 577 578 PetscFunctionBegin; 579 PetscCall(PetscVSNPrintf(str, sizeof(str), format, NULL, Argp)); 580 PetscCall(PetscStrlen(str, &len)); 581 petscfortranprinttofileunit_(&unit, str, &ierr, (int)len); 582 PetscFunctionReturn(PETSC_SUCCESS); 583 } 584 585 static PetscErrorCode PetscFPrintfFortran(int unit, const char str[]) 586 { 587 PetscErrorCode ierr; 588 size_t len; 589 590 PetscFunctionBegin; 591 PetscCall(PetscStrlen(str, &len)); 592 petscfortranprinttofileunit_(&unit, str, &ierr, (int)len); 593 PetscFunctionReturn(PETSC_SUCCESS); 594 } 595 596 #else 597 598 /* these will never be used; but are needed to link with */ 599 static PetscErrorCode PetscVFPrintfFortran(int unit, const char format[], va_list Argp) 600 { 601 PetscFunctionBegin; 602 PetscFunctionReturn(PETSC_SUCCESS); 603 } 604 605 static PetscErrorCode PetscFPrintfFortran(int unit, const char str[]) 606 { 607 PetscFunctionBegin; 608 PetscFunctionReturn(PETSC_SUCCESS); 609 } 610 #endif 611 612 /*@ 613 PetscViewerASCIIGetStdout - Creates a `PETSCVIEWERASCII` `PetscViewer` shared by all processes 614 in a communicator that prints to `stdout`. Error returning version of `PETSC_VIEWER_STDOUT_()` 615 616 Collective 617 618 Input Parameter: 619 . comm - the MPI communicator to share the `PetscViewer` 620 621 Output Parameter: 622 . viewer - the viewer 623 624 Level: beginner 625 626 Note: 627 Use `PetscViewerDestroy()` to destroy it 628 629 Developer Note: 630 This should be used in all PETSc source code instead of `PETSC_VIEWER_STDOUT_()` since it allows error checking 631 632 .seealso: [](sec_viewers), `PetscViewerASCIIGetStderr()`, `PETSC_VIEWER_DRAW_()`, `PetscViewerASCIIOpen()`, `PETSC_VIEWER_STDERR_`, `PETSC_VIEWER_STDOUT_WORLD`, 633 `PETSC_VIEWER_STDOUT_SELF` 634 @*/ 635 PetscErrorCode PetscViewerASCIIGetStdout(MPI_Comm comm, PetscViewer *viewer) 636 { 637 PetscMPIInt iflg; 638 MPI_Comm ncomm; 639 640 PetscFunctionBegin; 641 PetscAssertPointer(viewer, 2); 642 PetscCall(PetscSpinlockLock(&PetscViewerASCIISpinLockStdout)); 643 PetscCall(PetscCommDuplicate(comm, &ncomm, NULL)); 644 if (Petsc_Viewer_Stdout_keyval == MPI_KEYVAL_INVALID) PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, MPI_COMM_NULL_DELETE_FN, &Petsc_Viewer_Stdout_keyval, NULL)); 645 PetscCallMPI(MPI_Comm_get_attr(ncomm, Petsc_Viewer_Stdout_keyval, (void **)viewer, &iflg)); 646 if (!iflg) { /* PetscViewer not yet created */ 647 #if defined(PETSC_USE_FORTRAN_BINDINGS) 648 PetscCallMPI(MPI_Bcast(&PETSC_VIEWER_ASCII_STDOUT_fileunit, 1, MPI_INT, 0, comm)); 649 if (PETSC_VIEWER_ASCII_STDOUT_fileunit) { 650 PetscErrorCode ierr; 651 MPI_Fint fcomm = MPI_Comm_c2f(ncomm); 652 653 petscviewerasciiopenwithfileunit_(&fcomm, &PETSC_VIEWER_ASCII_STDOUT_fileunit, viewer, &ierr); 654 } else 655 #endif 656 { 657 PetscCall(PetscViewerCreate(ncomm, viewer)); 658 PetscCall(PetscViewerSetType(*viewer, PETSCVIEWERASCII)); 659 PetscCall(PetscViewerFileSetName(*viewer, "stdout")); 660 } 661 PetscCall(PetscObjectRegisterDestroy((PetscObject)*viewer)); 662 PetscCallMPI(MPI_Comm_set_attr(ncomm, Petsc_Viewer_Stdout_keyval, (void *)*viewer)); 663 } 664 PetscCall(PetscCommDestroy(&ncomm)); 665 PetscCall(PetscSpinlockUnlock(&PetscViewerASCIISpinLockStdout)); 666 #if defined(PETSC_USE_FORTRAN_BINDINGS) 667 ((PetscViewer_ASCII *)(*viewer)->data)->fileunit = PETSC_VIEWER_ASCII_STDOUT_fileunit; 668 #endif 669 PetscFunctionReturn(PETSC_SUCCESS); 670 } 671 672 /*@C 673 PetscViewerASCIIPrintf - Prints to a file, only from the first 674 processor in the `PetscViewer` of type `PETSCVIEWERASCII` 675 676 Not Collective, but only the first MPI rank in the viewer has any effect 677 678 Input Parameters: 679 + viewer - obtained with `PetscViewerASCIIOpen()` 680 - format - the usual printf() format string 681 682 Level: developer 683 684 Fortran Notes: 685 The call sequence is `PetscViewerASCIIPrintf`(`PetscViewer`, character(*), int ierr) from Fortran. 686 That is, you can only pass a single character string from Fortran. 687 688 .seealso: [](sec_viewers), `PetscPrintf()`, `PetscSynchronizedPrintf()`, `PetscViewerASCIIOpen()`, 689 `PetscViewerASCIIPushTab()`, `PetscViewerASCIIPopTab()`, `PetscViewerASCIISynchronizedPrintf()`, 690 `PetscViewerCreate()`, `PetscViewerDestroy()`, `PetscViewerSetType()`, `PetscViewerASCIIGetPointer()`, `PetscViewerASCIIPushSynchronized()` 691 @*/ 692 PetscErrorCode PetscViewerASCIIPrintf(PetscViewer viewer, const char format[], ...) 693 { 694 PetscViewer_ASCII *ascii = (PetscViewer_ASCII *)viewer->data; 695 PetscMPIInt rank; 696 PetscInt tab = 0, intab = ascii->tab; 697 FILE *fd = ascii->fd; 698 PetscBool isascii; 699 700 PetscFunctionBegin; 701 PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 1); 702 PetscCheck(!ascii->sviewer, PetscObjectComm((PetscObject)viewer), PETSC_ERR_ARG_WRONGSTATE, "Cannot call with outstanding call to PetscViewerRestoreSubViewer()"); 703 PetscAssertPointer(format, 2); 704 PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &isascii)); 705 PetscCheck(isascii, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Not ASCII PetscViewer"); 706 PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)viewer), &rank)); 707 if (rank) PetscFunctionReturn(PETSC_SUCCESS); 708 709 if (ascii->bviewer) { /* pass string up to parent viewer */ 710 char *string; 711 va_list Argp; 712 size_t fullLength; 713 714 PetscCall(PetscCalloc1(QUEUESTRINGSIZE, &string)); 715 for (; tab < ascii->tab; tab++) string[2 * tab] = string[2 * tab + 1] = ' '; 716 va_start(Argp, format); 717 PetscCall(PetscVSNPrintf(string + 2 * intab, QUEUESTRINGSIZE - 2 * intab, format, &fullLength, Argp)); 718 va_end(Argp); 719 PetscCall(PetscViewerASCIISynchronizedPrintf(ascii->bviewer, "%s", string)); 720 PetscCall(PetscFree(string)); 721 } else { /* write directly to file */ 722 va_list Argp; 723 724 tab = intab; 725 while (tab--) { 726 if (!ascii->fileunit) PetscCall(PetscFPrintf(PETSC_COMM_SELF, fd, " ")); 727 else PetscCall(PetscFPrintfFortran(ascii->fileunit, " ")); 728 } 729 730 va_start(Argp, format); 731 if (!ascii->fileunit) PetscCall((*PetscVFPrintf)(fd, format, Argp)); 732 else PetscCall(PetscVFPrintfFortran(ascii->fileunit, format, Argp)); 733 va_end(Argp); 734 PetscCall(PetscFFlush(fd)); 735 } 736 PetscFunctionReturn(PETSC_SUCCESS); 737 } 738 739 /*@ 740 PetscViewerFileSetName - Sets the name of the file the `PetscViewer` should use. 741 742 Collective 743 744 Input Parameters: 745 + viewer - the `PetscViewer`; for example, of type `PETSCVIEWERASCII` or `PETSCVIEWERBINARY` 746 - name - the name of the file it should use 747 748 Level: advanced 749 750 Note: 751 This will have no effect on viewers that are not related to files 752 753 .seealso: [](sec_viewers), `PetscViewerCreate()`, `PetscViewerSetType()`, `PetscViewerASCIIOpen()`, `PetscViewerBinaryOpen()`, `PetscViewerDestroy()`, 754 `PetscViewerASCIIGetPointer()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIISynchronizedPrintf()` 755 @*/ 756 PetscErrorCode PetscViewerFileSetName(PetscViewer viewer, const char name[]) 757 { 758 char filename[PETSC_MAX_PATH_LEN]; 759 760 PetscFunctionBegin; 761 PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 1); 762 PetscAssertPointer(name, 2); 763 PetscCall(PetscStrreplace(PetscObjectComm((PetscObject)viewer), name, filename, sizeof(filename))); 764 PetscTryMethod(viewer, "PetscViewerFileSetName_C", (PetscViewer, const char[]), (viewer, filename)); 765 PetscFunctionReturn(PETSC_SUCCESS); 766 } 767 768 /*@C 769 PetscViewerFileGetName - Gets the name of the file the `PetscViewer` is using 770 771 Not Collective 772 773 Input Parameter: 774 . viewer - the `PetscViewer` 775 776 Output Parameter: 777 . name - the name of the file it is using 778 779 Level: advanced 780 781 Note: 782 This will have no effect on viewers that are not related to files 783 784 .seealso: [](sec_viewers), `PetscViewerCreate()`, `PetscViewerSetType()`, `PetscViewerASCIIOpen()`, `PetscViewerBinaryOpen()`, `PetscViewerFileSetName()` 785 @*/ 786 PetscErrorCode PetscViewerFileGetName(PetscViewer viewer, const char *name[]) 787 { 788 PetscFunctionBegin; 789 PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 1); 790 PetscAssertPointer(name, 2); 791 PetscUseMethod(viewer, "PetscViewerFileGetName_C", (PetscViewer, const char **), (viewer, name)); 792 PetscFunctionReturn(PETSC_SUCCESS); 793 } 794 795 static PetscErrorCode PetscViewerFileGetName_ASCII(PetscViewer viewer, const char **name) 796 { 797 PetscViewer_ASCII *vascii = (PetscViewer_ASCII *)viewer->data; 798 799 PetscFunctionBegin; 800 *name = vascii->filename; 801 PetscFunctionReturn(PETSC_SUCCESS); 802 } 803 804 #include <errno.h> 805 static PetscErrorCode PetscViewerFileSetName_ASCII(PetscViewer viewer, const char name[]) 806 { 807 size_t len; 808 char fname[PETSC_MAX_PATH_LEN], *gz = NULL; 809 PetscViewer_ASCII *vascii = (PetscViewer_ASCII *)viewer->data; 810 PetscBool isstderr, isstdout; 811 PetscMPIInt rank; 812 813 PetscFunctionBegin; 814 PetscCall(PetscViewerFileClose_ASCII(viewer)); 815 if (!name) PetscFunctionReturn(PETSC_SUCCESS); 816 PetscCall(PetscStrallocpy(name, &vascii->filename)); 817 818 /* Is this file to be compressed */ 819 vascii->storecompressed = PETSC_FALSE; 820 821 PetscCall(PetscStrstr(vascii->filename, ".gz", &gz)); 822 if (gz) { 823 PetscCall(PetscStrlen(gz, &len)); 824 if (len == 3) { 825 PetscCheck(vascii->mode == FILE_MODE_WRITE, PetscObjectComm((PetscObject)viewer), PETSC_ERR_SUP, "Cannot open ASCII PetscViewer file that is compressed; uncompress it manually first"); 826 *gz = 0; 827 vascii->storecompressed = PETSC_TRUE; 828 } 829 } 830 PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)viewer), &rank)); 831 if (rank == 0) { 832 PetscCall(PetscStrcmp(name, "stderr", &isstderr)); 833 PetscCall(PetscStrcmp(name, "stdout", &isstdout)); 834 /* empty filename means stdout */ 835 if (name[0] == 0) isstdout = PETSC_TRUE; 836 if (isstderr) vascii->fd = PETSC_STDERR; 837 else if (isstdout) vascii->fd = PETSC_STDOUT; 838 else { 839 PetscCall(PetscFixFilename(name, fname)); 840 switch (vascii->mode) { 841 case FILE_MODE_READ: 842 vascii->fd = fopen(fname, "r"); 843 break; 844 case FILE_MODE_WRITE: 845 vascii->fd = fopen(fname, "w"); 846 break; 847 case FILE_MODE_APPEND: 848 vascii->fd = fopen(fname, "a"); 849 break; 850 case FILE_MODE_UPDATE: 851 vascii->fd = fopen(fname, "r+"); 852 if (!vascii->fd) vascii->fd = fopen(fname, "w+"); 853 break; 854 case FILE_MODE_APPEND_UPDATE: 855 /* I really want a file which is opened at the end for updating, 856 not a+, which opens at the beginning, but makes writes at the end. 857 */ 858 vascii->fd = fopen(fname, "r+"); 859 if (!vascii->fd) vascii->fd = fopen(fname, "w+"); 860 else { 861 int ret = fseek(vascii->fd, 0, SEEK_END); 862 PetscCheck(!ret, PETSC_COMM_SELF, PETSC_ERR_LIB, "fseek() failed with error code %d", ret); 863 } 864 break; 865 default: 866 SETERRQ(PetscObjectComm((PetscObject)viewer), PETSC_ERR_SUP, "Unsupported file mode %s", PetscFileModes[vascii->mode]); 867 } 868 PetscCheck(vascii->fd, PETSC_COMM_SELF, PETSC_ERR_FILE_OPEN, "Cannot open PetscViewer file: %s due to \"%s\"", fname, strerror(errno)); 869 } 870 } 871 PetscCall(PetscLogObjectState((PetscObject)viewer, "File: %s", name)); 872 PetscFunctionReturn(PETSC_SUCCESS); 873 } 874 875 static PetscErrorCode PetscViewerGetSubViewer_ASCII(PetscViewer viewer, MPI_Comm subcomm, PetscViewer *outviewer) 876 { 877 PetscViewer_ASCII *vascii = (PetscViewer_ASCII *)viewer->data, *ovascii; 878 879 PetscFunctionBegin; 880 PetscCheck(!vascii->sviewer, PETSC_COMM_SELF, PETSC_ERR_ORDER, "SubViewer already obtained from PetscViewer and not restored"); 881 PetscCall(PetscViewerASCIIPushSynchronized(viewer)); 882 /* 883 The following line is a bug; it does another PetscViewerASCIIPushSynchronized() on viewer, but if it is removed the code won't work 884 because it relies on this behavior in other places. In particular this line causes the synchronized flush to occur when the viewer is destroyed 885 (since the count never gets to zero) in some examples this displays information that otherwise would be lost 886 887 This code also means another call to PetscViewerASCIIPopSynchronized() must be made after the PetscViewerRestoreSubViewer(), see, for example, 888 PCView_GASM(). 889 */ 890 PetscCall(PetscViewerASCIIPushSynchronized(viewer)); 891 PetscCall(PetscViewerFlush(viewer)); 892 PetscCall(PetscViewerCreate(subcomm, outviewer)); 893 PetscCall(PetscViewerSetType(*outviewer, PETSCVIEWERASCII)); 894 PetscCall(PetscViewerASCIIPushSynchronized(*outviewer)); 895 ovascii = (PetscViewer_ASCII *)(*outviewer)->data; 896 ovascii->fd = vascii->fd; 897 ovascii->fileunit = vascii->fileunit; 898 ovascii->closefile = PETSC_FALSE; 899 900 vascii->sviewer = *outviewer; 901 (*outviewer)->format = viewer->format; 902 ((PetscViewer_ASCII *)((*outviewer)->data))->bviewer = viewer; 903 (*outviewer)->ops->destroy = PetscViewerDestroy_ASCII_SubViewer; 904 PetscFunctionReturn(PETSC_SUCCESS); 905 } 906 907 static PetscErrorCode PetscViewerRestoreSubViewer_ASCII(PetscViewer viewer, MPI_Comm comm, PetscViewer *outviewer) 908 { 909 PetscViewer_ASCII *ascii = (PetscViewer_ASCII *)viewer->data; 910 911 PetscFunctionBegin; 912 PetscCheck(ascii->sviewer, PETSC_COMM_SELF, PETSC_ERR_ORDER, "SubViewer never obtained from PetscViewer"); 913 PetscCheck(ascii->sviewer == *outviewer, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "This PetscViewer did not generate this SubViewer"); 914 915 PetscCall(PetscViewerASCIIPopSynchronized(*outviewer)); 916 ascii->sviewer = NULL; 917 (*outviewer)->ops->destroy = PetscViewerDestroy_ASCII; 918 PetscCall(PetscViewerDestroy(outviewer)); 919 PetscCall(PetscViewerFlush(viewer)); 920 PetscCall(PetscViewerASCIIPopSynchronized(viewer)); 921 PetscFunctionReturn(PETSC_SUCCESS); 922 } 923 924 static PetscErrorCode PetscViewerView_ASCII(PetscViewer v, PetscViewer viewer) 925 { 926 PetscViewer_ASCII *ascii = (PetscViewer_ASCII *)v->data; 927 928 PetscFunctionBegin; 929 if (ascii->fileunit) PetscCall(PetscViewerASCIIPrintf(viewer, "Fortran FILE UNIT: %d\n", ascii->fileunit)); 930 else if (ascii->filename) PetscCall(PetscViewerASCIIPrintf(viewer, "Filename: %s\n", ascii->filename)); 931 PetscFunctionReturn(PETSC_SUCCESS); 932 } 933 934 static PetscErrorCode PetscViewerFlush_ASCII(PetscViewer viewer) 935 { 936 PetscViewer_ASCII *vascii = (PetscViewer_ASCII *)viewer->data; 937 MPI_Comm comm; 938 PetscMPIInt rank, size; 939 FILE *fd = vascii->fd; 940 941 PetscFunctionBegin; 942 PetscCheck(!vascii->sviewer, PetscObjectComm((PetscObject)viewer), PETSC_ERR_ARG_WRONGSTATE, "Cannot call with outstanding call to PetscViewerRestoreSubViewer()"); 943 PetscCall(PetscObjectGetComm((PetscObject)viewer, &comm)); 944 PetscCallMPI(MPI_Comm_rank(comm, &rank)); 945 PetscCallMPI(MPI_Comm_size(comm, &size)); 946 947 if (!vascii->bviewer && rank == 0 && (vascii->mode != FILE_MODE_READ)) PetscCall(PetscFFlush(vascii->fd)); 948 949 if (vascii->allowsynchronized) { 950 PetscMPIInt tag, i, j, n = 0, dummy = 0; 951 char *message; 952 MPI_Status status; 953 954 PetscCall(PetscCommDuplicate(comm, &comm, &tag)); 955 956 /* First processor waits for messages from all other processors */ 957 if (rank == 0) { 958 /* flush my own messages that I may have queued up */ 959 PrintfQueue next = vascii->petsc_printfqueuebase, previous; 960 for (i = 0; i < vascii->petsc_printfqueuelength; i++) { 961 if (!vascii->bviewer) { 962 if (!vascii->fileunit) PetscCall(PetscFPrintf(comm, fd, "%s", next->string)); 963 else PetscCall(PetscFPrintfFortran(vascii->fileunit, next->string)); 964 } else { 965 PetscCall(PetscViewerASCIISynchronizedPrintf(vascii->bviewer, "%s", next->string)); 966 } 967 previous = next; 968 next = next->next; 969 PetscCall(PetscFree(previous->string)); 970 PetscCall(PetscFree(previous)); 971 } 972 vascii->petsc_printfqueue = NULL; 973 vascii->petsc_printfqueuelength = 0; 974 for (i = 1; i < size; i++) { 975 /* to prevent a flood of messages to process zero, request each message separately */ 976 PetscCallMPI(MPI_Send(&dummy, 1, MPI_INT, i, tag, comm)); 977 PetscCallMPI(MPI_Recv(&n, 1, MPI_INT, i, tag, comm, &status)); 978 for (j = 0; j < n; j++) { 979 size_t size; 980 981 PetscCallMPI(MPI_Recv(&size, 1, MPIU_SIZE_T, i, tag, comm, &status)); 982 PetscCall(PetscMalloc1(size, &message)); 983 PetscCallMPI(MPI_Recv(message, (PetscMPIInt)size, MPI_CHAR, i, tag, comm, &status)); 984 if (!vascii->bviewer) { 985 if (!vascii->fileunit) PetscCall(PetscFPrintf(comm, fd, "%s", message)); 986 else PetscCall(PetscFPrintfFortran(vascii->fileunit, message)); 987 } else { 988 PetscCall(PetscViewerASCIISynchronizedPrintf(vascii->bviewer, "%s", message)); 989 } 990 PetscCall(PetscFree(message)); 991 } 992 } 993 } else { /* other processors send queue to processor 0 */ 994 PrintfQueue next = vascii->petsc_printfqueuebase, previous; 995 996 PetscCallMPI(MPI_Recv(&dummy, 1, MPI_INT, 0, tag, comm, &status)); 997 PetscCallMPI(MPI_Send(&vascii->petsc_printfqueuelength, 1, MPI_INT, 0, tag, comm)); 998 for (i = 0; i < vascii->petsc_printfqueuelength; i++) { 999 PetscCallMPI(MPI_Send(&next->size, 1, MPIU_SIZE_T, 0, tag, comm)); 1000 PetscCallMPI(MPI_Send(next->string, (PetscMPIInt)next->size, MPI_CHAR, 0, tag, comm)); 1001 previous = next; 1002 next = next->next; 1003 PetscCall(PetscFree(previous->string)); 1004 PetscCall(PetscFree(previous)); 1005 } 1006 vascii->petsc_printfqueue = NULL; 1007 vascii->petsc_printfqueuelength = 0; 1008 } 1009 PetscCall(PetscCommDestroy(&comm)); 1010 } 1011 PetscFunctionReturn(PETSC_SUCCESS); 1012 } 1013 1014 /*MC 1015 PETSCVIEWERASCII - A viewer that prints to `stdout`, `stderr`, or an ASCII file 1016 1017 Level: beginner 1018 1019 .seealso: [](sec_viewers), `PETSC_VIEWER_STDOUT_()`, `PETSC_VIEWER_STDOUT_SELF`, `PETSC_VIEWER_STDOUT_WORLD`, `PetscViewerCreate()`, `PetscViewerASCIIOpen()`, 1020 `PetscViewerMatlabOpen()`, `VecView()`, `DMView()`, `PetscViewerMatlabPutArray()`, `PETSCVIEWERBINARY`, `PETSCVIEWERMATLAB`, 1021 `PetscViewerFileSetName()`, `PetscViewerFileSetMode()`, `PetscViewerFormat`, `PetscViewerType`, `PetscViewerSetType()` 1022 M*/ 1023 PETSC_EXTERN PetscErrorCode PetscViewerCreate_ASCII(PetscViewer viewer) 1024 { 1025 PetscViewer_ASCII *vascii; 1026 1027 PetscFunctionBegin; 1028 PetscCall(PetscNew(&vascii)); 1029 viewer->data = (void *)vascii; 1030 1031 viewer->ops->destroy = PetscViewerDestroy_ASCII; 1032 viewer->ops->flush = PetscViewerFlush_ASCII; 1033 viewer->ops->getsubviewer = PetscViewerGetSubViewer_ASCII; 1034 viewer->ops->restoresubviewer = PetscViewerRestoreSubViewer_ASCII; 1035 viewer->ops->view = PetscViewerView_ASCII; 1036 viewer->ops->read = PetscViewerASCIIRead; 1037 1038 /* defaults to stdout unless set with PetscViewerFileSetName() */ 1039 vascii->fd = PETSC_STDOUT; 1040 vascii->mode = FILE_MODE_WRITE; 1041 vascii->bviewer = NULL; 1042 vascii->subviewer = NULL; 1043 vascii->sviewer = NULL; 1044 vascii->tab = 0; 1045 vascii->tab_store = 0; 1046 vascii->filename = NULL; 1047 vascii->closefile = PETSC_TRUE; 1048 1049 PetscCall(PetscObjectComposeFunction((PetscObject)viewer, "PetscViewerFileSetName_C", PetscViewerFileSetName_ASCII)); 1050 PetscCall(PetscObjectComposeFunction((PetscObject)viewer, "PetscViewerFileGetName_C", PetscViewerFileGetName_ASCII)); 1051 PetscCall(PetscObjectComposeFunction((PetscObject)viewer, "PetscViewerFileGetMode_C", PetscViewerFileGetMode_ASCII)); 1052 PetscCall(PetscObjectComposeFunction((PetscObject)viewer, "PetscViewerFileSetMode_C", PetscViewerFileSetMode_ASCII)); 1053 PetscFunctionReturn(PETSC_SUCCESS); 1054 } 1055 1056 /*@C 1057 PetscViewerASCIISynchronizedPrintf - Prints synchronized output to the specified `PETSCVIEWERASCII` file from 1058 several processors. Output of the first processor is followed by that of the 1059 second, etc. 1060 1061 Not Collective, must call collective `PetscViewerFlush()` to get the results flushed 1062 1063 Input Parameters: 1064 + viewer - the `PETSCVIEWERASCII` `PetscViewer` 1065 - format - the usual printf() format string 1066 1067 Level: intermediate 1068 1069 Notes: 1070 You must have previously called `PetscViewerASCIIPushSynchronized()` to allow this routine to be called. 1071 Then you can do multiple independent calls to this routine. 1072 1073 The actual synchronized print is then done using `PetscViewerFlush()`. 1074 `PetscViewerASCIIPopSynchronized()` should be then called if we are already done with the synchronized output 1075 to conclude the "synchronized session". 1076 1077 So the typical calling sequence looks like 1078 .vb 1079 PetscViewerASCIIPushSynchronized(viewer); 1080 PetscViewerASCIISynchronizedPrintf(viewer, ...); 1081 PetscViewerASCIISynchronizedPrintf(viewer, ...); 1082 ... 1083 PetscViewerFlush(viewer); 1084 PetscViewerASCIISynchronizedPrintf(viewer, ...); 1085 PetscViewerASCIISynchronizedPrintf(viewer, ...); 1086 ... 1087 PetscViewerFlush(viewer); 1088 PetscViewerASCIIPopSynchronized(viewer); 1089 .ve 1090 1091 Fortran Notes: 1092 Can only print a single character* string 1093 1094 .seealso: [](sec_viewers), `PetscViewerASCIIPushSynchronized()`, `PetscViewerFlush()`, `PetscViewerASCIIPopSynchronized()`, 1095 `PetscSynchronizedPrintf()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIIOpen()`, 1096 `PetscViewerCreate()`, `PetscViewerDestroy()`, `PetscViewerSetType()` 1097 @*/ 1098 PetscErrorCode PetscViewerASCIISynchronizedPrintf(PetscViewer viewer, const char format[], ...) 1099 { 1100 PetscViewer_ASCII *vascii = (PetscViewer_ASCII *)viewer->data; 1101 PetscMPIInt rank; 1102 PetscInt tab = 0; 1103 MPI_Comm comm; 1104 PetscBool isascii; 1105 1106 PetscFunctionBegin; 1107 PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 1); 1108 PetscAssertPointer(format, 2); 1109 PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &isascii)); 1110 PetscCheck(isascii, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Not ASCII PetscViewer"); 1111 PetscCheck(vascii->allowsynchronized, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "First call PetscViewerASCIIPushSynchronized() to allow this call"); 1112 1113 PetscCall(PetscObjectGetComm((PetscObject)viewer, &comm)); 1114 PetscCallMPI(MPI_Comm_rank(comm, &rank)); 1115 1116 if (vascii->bviewer) { 1117 char *string; 1118 va_list Argp; 1119 size_t fullLength; 1120 1121 PetscCall(PetscCalloc1(QUEUESTRINGSIZE, &string)); 1122 for (; tab < vascii->tab; tab++) string[2 * tab] = string[2 * tab + 1] = ' '; 1123 va_start(Argp, format); 1124 PetscCall(PetscVSNPrintf(string + 2 * tab, QUEUESTRINGSIZE - 2 * tab, format, &fullLength, Argp)); 1125 va_end(Argp); 1126 PetscCall(PetscViewerASCIISynchronizedPrintf(vascii->bviewer, "%s", string)); 1127 PetscCall(PetscFree(string)); 1128 } else if (rank == 0) { /* First processor prints immediately to fp */ 1129 va_list Argp; 1130 FILE *fp = vascii->fd; 1131 1132 tab = vascii->tab; 1133 while (tab--) { 1134 if (!vascii->fileunit) PetscCall(PetscFPrintf(PETSC_COMM_SELF, fp, " ")); 1135 else PetscCall(PetscFPrintfFortran(vascii->fileunit, " ")); 1136 } 1137 1138 va_start(Argp, format); 1139 if (!vascii->fileunit) PetscCall((*PetscVFPrintf)(fp, format, Argp)); 1140 else PetscCall(PetscVFPrintfFortran(vascii->fileunit, format, Argp)); 1141 va_end(Argp); 1142 PetscCall(PetscFFlush(fp)); 1143 if (petsc_history) { 1144 va_start(Argp, format); 1145 PetscCall((*PetscVFPrintf)(petsc_history, format, Argp)); 1146 va_end(Argp); 1147 PetscCall(PetscFFlush(petsc_history)); 1148 } 1149 } else { /* other processors add to queue */ 1150 char *string; 1151 va_list Argp; 1152 size_t fullLength; 1153 PrintfQueue next; 1154 1155 PetscCall(PetscNew(&next)); 1156 if (vascii->petsc_printfqueue) { 1157 vascii->petsc_printfqueue->next = next; 1158 vascii->petsc_printfqueue = next; 1159 } else { 1160 vascii->petsc_printfqueuebase = vascii->petsc_printfqueue = next; 1161 } 1162 vascii->petsc_printfqueuelength++; 1163 next->size = QUEUESTRINGSIZE; 1164 PetscCall(PetscCalloc1(next->size, &next->string)); 1165 string = next->string; 1166 1167 tab = vascii->tab; 1168 tab *= 2; 1169 while (tab--) *string++ = ' '; 1170 va_start(Argp, format); 1171 PetscCall(PetscVSNPrintf(string, next->size - 2 * vascii->tab, format, &fullLength, Argp)); 1172 va_end(Argp); 1173 if (fullLength > next->size - 2 * vascii->tab) { 1174 PetscCall(PetscFree(next->string)); 1175 next->size = fullLength + 2 * vascii->tab; 1176 PetscCall(PetscCalloc1(next->size, &next->string)); 1177 string = next->string; 1178 tab = 2 * vascii->tab; 1179 while (tab--) *string++ = ' '; 1180 va_start(Argp, format); 1181 PetscCall(PetscVSNPrintf(string, next->size - 2 * vascii->tab, format, NULL, Argp)); 1182 va_end(Argp); 1183 } 1184 } 1185 PetscFunctionReturn(PETSC_SUCCESS); 1186 } 1187 1188 /*@C 1189 PetscViewerASCIIRead - Reads from a `PETSCVIEWERASCII` file 1190 1191 Only MPI rank 0 in the `PetscViewer` may call this 1192 1193 Input Parameters: 1194 + viewer - the `PETSCVIEWERASCII` viewer 1195 . data - location to write the data, treated as an array of type indicated by `datatype` 1196 . num - number of items of data to read 1197 - dtype - type of data to read 1198 1199 Output Parameter: 1200 . count - number of items of data actually read, or `NULL` 1201 1202 Level: beginner 1203 1204 .seealso: [](sec_viewers), `PetscViewerASCIIOpen()`, `PetscViewerPushFormat()`, `PetscViewerDestroy()`, `PetscViewerCreate()`, `PetscViewerFileSetMode()`, `PetscViewerFileSetName()` 1205 `VecView()`, `MatView()`, `VecLoad()`, `MatLoad()`, `PetscViewerBinaryGetDescriptor()`, 1206 `PetscViewerBinaryGetInfoPointer()`, `PetscFileMode`, `PetscViewer`, `PetscViewerBinaryRead()` 1207 @*/ 1208 PetscErrorCode PetscViewerASCIIRead(PetscViewer viewer, void *data, PetscInt num, PetscInt *count, PetscDataType dtype) 1209 { 1210 PetscViewer_ASCII *vascii = (PetscViewer_ASCII *)viewer->data; 1211 FILE *fd = vascii->fd; 1212 PetscInt i; 1213 int ret = 0; 1214 PetscMPIInt rank; 1215 1216 PetscFunctionBegin; 1217 PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 1); 1218 PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)viewer), &rank)); 1219 PetscCheck(rank == 0, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Can only be called from process 0 in the PetscViewer"); 1220 for (i = 0; i < num; i++) { 1221 if (dtype == PETSC_CHAR) ret = fscanf(fd, "%c", &(((char *)data)[i])); 1222 else if (dtype == PETSC_STRING) ret = fscanf(fd, "%s", &(((char *)data)[i])); 1223 else if (dtype == PETSC_INT) ret = fscanf(fd, "%" PetscInt_FMT, &(((PetscInt *)data)[i])); 1224 else if (dtype == PETSC_ENUM) ret = fscanf(fd, "%d", &(((int *)data)[i])); 1225 else if (dtype == PETSC_INT64) ret = fscanf(fd, "%" PetscInt64_FMT, &(((PetscInt64 *)data)[i])); 1226 else if (dtype == PETSC_LONG) ret = fscanf(fd, "%ld", &(((long *)data)[i])); 1227 else if (dtype == PETSC_COUNT) ret = fscanf(fd, "%" PetscCount_FMT, &(((PetscCount *)data)[i])); 1228 else if (dtype == PETSC_FLOAT) ret = fscanf(fd, "%f", &(((float *)data)[i])); 1229 else if (dtype == PETSC_DOUBLE) ret = fscanf(fd, "%lg", &(((double *)data)[i])); 1230 #if defined(PETSC_USE_REAL___FLOAT128) 1231 else if (dtype == PETSC___FLOAT128) { 1232 double tmp; 1233 ret = fscanf(fd, "%lg", &tmp); 1234 ((__float128 *)data)[i] = tmp; 1235 } 1236 #endif 1237 else 1238 SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Data type %d not supported", (int)dtype); 1239 PetscCheck(ret, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Conversion error for data type %d", (int)dtype); 1240 if (ret < 0) break; /* Proxy for EOF, need to check for it in configure */ 1241 } 1242 if (count) *count = i; 1243 else PetscCheck(ret >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Insufficient data, read only %" PetscInt_FMT " < %" PetscInt_FMT " items", i, num); 1244 PetscFunctionReturn(PETSC_SUCCESS); 1245 } 1246