xref: /petsc/src/sys/classes/viewer/impls/ascii/filev.c (revision a336c15037c72f93cd561f5a5e11e93175f2efd9)
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 viewer, PetscInt unit, PetscErrorCode ierr)
503 
504   Input Parameters:
505 + viewer - 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 *viewer, int *unit, PetscErrorCode *ierr)
522 {
523   PetscViewer_ASCII *vascii;
524   PetscViewer        v;
525 
526   PetscPatchDefaultViewers_Fortran(viewer, 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 + viewer - 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 *viewer, PetscErrorCode *ierr)
562 {
563   *ierr = PetscViewerCreate(MPI_Comm_f2c(*(MPI_Fint *)&*comm), viewer);
564   if (*ierr) return;
565   *ierr = PetscViewerSetType(*viewer, PETSCVIEWERASCII);
566   if (*ierr) return;
567   *ierr = PetscViewerFileSetMode(*viewer, FILE_MODE_WRITE);
568   if (*ierr) return;
569   petscviewerasciisetfileunit_(viewer, 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       PetscViewerFormat format;
658       PetscBool         set;
659 
660       PetscCall(PetscViewerCreate(ncomm, viewer));
661       PetscCall(PetscViewerSetType(*viewer, PETSCVIEWERASCII));
662       PetscCall(PetscOptionsGetEnum(NULL, NULL, "-petsc_viewer_stdout_format", PetscViewerFormats, (PetscEnum *)&format, &set));
663       if (set) PetscCall(PetscViewerPushFormat(*viewer, format));
664       PetscCall(PetscViewerFileSetName(*viewer, "stdout"));
665     }
666     PetscCall(PetscObjectRegisterDestroy((PetscObject)*viewer));
667     PetscCallMPI(MPI_Comm_set_attr(ncomm, Petsc_Viewer_Stdout_keyval, (void *)*viewer));
668   }
669   PetscCall(PetscCommDestroy(&ncomm));
670   PetscCall(PetscSpinlockUnlock(&PetscViewerASCIISpinLockStdout));
671 #if defined(PETSC_USE_FORTRAN_BINDINGS)
672   ((PetscViewer_ASCII *)(*viewer)->data)->fileunit = PETSC_VIEWER_ASCII_STDOUT_fileunit;
673 #endif
674   PetscFunctionReturn(PETSC_SUCCESS);
675 }
676 
677 /*@C
678   PetscViewerASCIIPrintf - Prints to a file, only from the first
679   processor in the `PetscViewer` of type `PETSCVIEWERASCII`
680 
681   Not Collective, but only the first MPI rank in the viewer has any effect
682 
683   Input Parameters:
684 + viewer - obtained with `PetscViewerASCIIOpen()`
685 - format - the usual printf() format string
686 
687   Level: developer
688 
689   Fortran Notes:
690   The call sequence is `PetscViewerASCIIPrintf`(`PetscViewer`, character(*), int ierr) from Fortran.
691   That is, you can only pass a single character string from Fortran.
692 
693 .seealso: [](sec_viewers), `PetscPrintf()`, `PetscSynchronizedPrintf()`, `PetscViewerASCIIOpen()`,
694           `PetscViewerASCIIPushTab()`, `PetscViewerASCIIPopTab()`, `PetscViewerASCIISynchronizedPrintf()`,
695           `PetscViewerCreate()`, `PetscViewerDestroy()`, `PetscViewerSetType()`, `PetscViewerASCIIGetPointer()`, `PetscViewerASCIIPushSynchronized()`
696 @*/
697 PetscErrorCode PetscViewerASCIIPrintf(PetscViewer viewer, const char format[], ...)
698 {
699   PetscViewer_ASCII *ascii = (PetscViewer_ASCII *)viewer->data;
700   PetscMPIInt        rank;
701   PetscInt           tab = 0, intab = ascii->tab;
702   FILE              *fd = ascii->fd;
703   PetscBool          isascii;
704 
705   PetscFunctionBegin;
706   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 1);
707   PetscCheck(!ascii->sviewer, PetscObjectComm((PetscObject)viewer), PETSC_ERR_ARG_WRONGSTATE, "Cannot call with outstanding call to PetscViewerRestoreSubViewer()");
708   PetscAssertPointer(format, 2);
709   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &isascii));
710   PetscCheck(isascii, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Not ASCII PetscViewer");
711   PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)viewer), &rank));
712   if (rank) PetscFunctionReturn(PETSC_SUCCESS);
713 
714   if (ascii->bviewer) { /* pass string up to parent viewer */
715     char   *string;
716     va_list Argp;
717     size_t  fullLength;
718 
719     PetscCall(PetscCalloc1(QUEUESTRINGSIZE, &string));
720     for (; tab < ascii->tab; tab++) string[2 * tab] = string[2 * tab + 1] = ' ';
721     va_start(Argp, format);
722     PetscCall(PetscVSNPrintf(string + 2 * intab, QUEUESTRINGSIZE - 2 * intab, format, &fullLength, Argp));
723     va_end(Argp);
724     PetscCall(PetscViewerASCIISynchronizedPrintf(ascii->bviewer, "%s", string));
725     PetscCall(PetscFree(string));
726   } else { /* write directly to file */
727     va_list Argp;
728 
729     tab = intab;
730     while (tab--) {
731       if (!ascii->fileunit) PetscCall(PetscFPrintf(PETSC_COMM_SELF, fd, "  "));
732       else PetscCall(PetscFPrintfFortran(ascii->fileunit, "   "));
733     }
734 
735     va_start(Argp, format);
736     if (!ascii->fileunit) PetscCall((*PetscVFPrintf)(fd, format, Argp));
737     else PetscCall(PetscVFPrintfFortran(ascii->fileunit, format, Argp));
738     va_end(Argp);
739     PetscCall(PetscFFlush(fd));
740   }
741   PetscFunctionReturn(PETSC_SUCCESS);
742 }
743 
744 /*@
745   PetscViewerFileSetName - Sets the name of the file the `PetscViewer` should use.
746 
747   Collective
748 
749   Input Parameters:
750 + viewer - the `PetscViewer`; for example, of type `PETSCVIEWERASCII` or `PETSCVIEWERBINARY`
751 - name   - the name of the file it should use
752 
753   Level: advanced
754 
755   Note:
756   This will have no effect on viewers that are not related to files
757 
758 .seealso: [](sec_viewers), `PetscViewerCreate()`, `PetscViewerSetType()`, `PetscViewerASCIIOpen()`, `PetscViewerBinaryOpen()`, `PetscViewerDestroy()`,
759           `PetscViewerASCIIGetPointer()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIISynchronizedPrintf()`
760 @*/
761 PetscErrorCode PetscViewerFileSetName(PetscViewer viewer, const char name[])
762 {
763   char filename[PETSC_MAX_PATH_LEN];
764 
765   PetscFunctionBegin;
766   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 1);
767   PetscAssertPointer(name, 2);
768   PetscCall(PetscStrreplace(PetscObjectComm((PetscObject)viewer), name, filename, sizeof(filename)));
769   PetscTryMethod(viewer, "PetscViewerFileSetName_C", (PetscViewer, const char[]), (viewer, filename));
770   PetscFunctionReturn(PETSC_SUCCESS);
771 }
772 
773 /*@C
774   PetscViewerFileGetName - Gets the name of the file the `PetscViewer` is using
775 
776   Not Collective
777 
778   Input Parameter:
779 . viewer - the `PetscViewer`
780 
781   Output Parameter:
782 . name - the name of the file it is using
783 
784   Level: advanced
785 
786   Note:
787   This will have no effect on viewers that are not related to files
788 
789 .seealso: [](sec_viewers), `PetscViewerCreate()`, `PetscViewerSetType()`, `PetscViewerASCIIOpen()`, `PetscViewerBinaryOpen()`, `PetscViewerFileSetName()`
790 @*/
791 PetscErrorCode PetscViewerFileGetName(PetscViewer viewer, const char *name[])
792 {
793   PetscFunctionBegin;
794   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 1);
795   PetscAssertPointer(name, 2);
796   PetscUseMethod(viewer, "PetscViewerFileGetName_C", (PetscViewer, const char **), (viewer, name));
797   PetscFunctionReturn(PETSC_SUCCESS);
798 }
799 
800 static PetscErrorCode PetscViewerFileGetName_ASCII(PetscViewer viewer, const char **name)
801 {
802   PetscViewer_ASCII *vascii = (PetscViewer_ASCII *)viewer->data;
803 
804   PetscFunctionBegin;
805   *name = vascii->filename;
806   PetscFunctionReturn(PETSC_SUCCESS);
807 }
808 
809 #include <errno.h>
810 static PetscErrorCode PetscViewerFileSetName_ASCII(PetscViewer viewer, const char name[])
811 {
812   size_t             len;
813   char               fname[PETSC_MAX_PATH_LEN], *gz = NULL;
814   PetscViewer_ASCII *vascii = (PetscViewer_ASCII *)viewer->data;
815   PetscBool          isstderr, isstdout;
816   PetscMPIInt        rank;
817 
818   PetscFunctionBegin;
819   PetscCall(PetscViewerFileClose_ASCII(viewer));
820   if (!name) PetscFunctionReturn(PETSC_SUCCESS);
821   PetscCall(PetscStrallocpy(name, &vascii->filename));
822 
823   /* Is this file to be compressed */
824   vascii->storecompressed = PETSC_FALSE;
825 
826   PetscCall(PetscStrstr(vascii->filename, ".gz", &gz));
827   if (gz) {
828     PetscCall(PetscStrlen(gz, &len));
829     if (len == 3) {
830       PetscCheck(vascii->mode == FILE_MODE_WRITE, PetscObjectComm((PetscObject)viewer), PETSC_ERR_SUP, "Cannot open ASCII PetscViewer file that is compressed; uncompress it manually first");
831       *gz                     = 0;
832       vascii->storecompressed = PETSC_TRUE;
833     }
834   }
835   PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)viewer), &rank));
836   if (rank == 0) {
837     PetscCall(PetscStrcmp(name, "stderr", &isstderr));
838     PetscCall(PetscStrcmp(name, "stdout", &isstdout));
839     /* empty filename means stdout */
840     if (name[0] == 0) isstdout = PETSC_TRUE;
841     if (isstderr) vascii->fd = PETSC_STDERR;
842     else if (isstdout) vascii->fd = PETSC_STDOUT;
843     else {
844       PetscCall(PetscFixFilename(name, fname));
845       switch (vascii->mode) {
846       case FILE_MODE_READ:
847         vascii->fd = fopen(fname, "r");
848         break;
849       case FILE_MODE_WRITE:
850         vascii->fd = fopen(fname, "w");
851         break;
852       case FILE_MODE_APPEND:
853         vascii->fd = fopen(fname, "a");
854         break;
855       case FILE_MODE_UPDATE:
856         vascii->fd = fopen(fname, "r+");
857         if (!vascii->fd) vascii->fd = fopen(fname, "w+");
858         break;
859       case FILE_MODE_APPEND_UPDATE:
860         /* I really want a file which is opened at the end for updating,
861            not a+, which opens at the beginning, but makes writes at the end.
862         */
863         vascii->fd = fopen(fname, "r+");
864         if (!vascii->fd) vascii->fd = fopen(fname, "w+");
865         else {
866           int ret = fseek(vascii->fd, 0, SEEK_END);
867           PetscCheck(!ret, PETSC_COMM_SELF, PETSC_ERR_LIB, "fseek() failed with error code %d", ret);
868         }
869         break;
870       default:
871         SETERRQ(PetscObjectComm((PetscObject)viewer), PETSC_ERR_SUP, "Unsupported file mode %s", PetscFileModes[vascii->mode]);
872       }
873       PetscCheck(vascii->fd, PETSC_COMM_SELF, PETSC_ERR_FILE_OPEN, "Cannot open PetscViewer file: %s due to \"%s\"", fname, strerror(errno));
874     }
875   }
876   PetscCall(PetscLogObjectState((PetscObject)viewer, "File: %s", name));
877   PetscFunctionReturn(PETSC_SUCCESS);
878 }
879 
880 static PetscErrorCode PetscViewerGetSubViewer_ASCII(PetscViewer viewer, MPI_Comm subcomm, PetscViewer *outviewer)
881 {
882   PetscViewer_ASCII *vascii = (PetscViewer_ASCII *)viewer->data, *ovascii;
883 
884   PetscFunctionBegin;
885   PetscCheck(!vascii->sviewer, PETSC_COMM_SELF, PETSC_ERR_ORDER, "SubViewer already obtained from PetscViewer and not restored");
886   PetscCall(PetscViewerASCIIPushSynchronized(viewer));
887   /*
888      The following line is a bug; it does another PetscViewerASCIIPushSynchronized() on viewer, but if it is removed the code won't work
889      because it relies on this behavior in other places. In particular this line causes the synchronized flush to occur when the viewer is destroyed
890      (since the count never gets to zero) in some examples this displays information that otherwise would be lost
891 
892      This code also means another call to PetscViewerASCIIPopSynchronized() must be made after the PetscViewerRestoreSubViewer(), see, for example,
893      PCView_GASM().
894   */
895   PetscCall(PetscViewerASCIIPushSynchronized(viewer));
896   PetscCall(PetscViewerFlush(viewer));
897   PetscCall(PetscViewerCreate(subcomm, outviewer));
898   PetscCall(PetscViewerSetType(*outviewer, PETSCVIEWERASCII));
899   PetscCall(PetscViewerASCIIPushSynchronized(*outviewer));
900   ovascii            = (PetscViewer_ASCII *)(*outviewer)->data;
901   ovascii->fd        = vascii->fd;
902   ovascii->fileunit  = vascii->fileunit;
903   ovascii->closefile = PETSC_FALSE;
904 
905   vascii->sviewer                                      = *outviewer;
906   (*outviewer)->format                                 = viewer->format;
907   ((PetscViewer_ASCII *)((*outviewer)->data))->bviewer = viewer;
908   (*outviewer)->ops->destroy                           = PetscViewerDestroy_ASCII_SubViewer;
909   PetscFunctionReturn(PETSC_SUCCESS);
910 }
911 
912 static PetscErrorCode PetscViewerRestoreSubViewer_ASCII(PetscViewer viewer, MPI_Comm comm, PetscViewer *outviewer)
913 {
914   PetscViewer_ASCII *ascii = (PetscViewer_ASCII *)viewer->data;
915 
916   PetscFunctionBegin;
917   PetscCheck(ascii->sviewer, PETSC_COMM_SELF, PETSC_ERR_ORDER, "SubViewer never obtained from PetscViewer");
918   PetscCheck(ascii->sviewer == *outviewer, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "This PetscViewer did not generate this SubViewer");
919 
920   PetscCall(PetscViewerASCIIPopSynchronized(*outviewer));
921   ascii->sviewer             = NULL;
922   (*outviewer)->ops->destroy = PetscViewerDestroy_ASCII;
923   PetscCall(PetscViewerDestroy(outviewer));
924   PetscCall(PetscViewerFlush(viewer));
925   PetscCall(PetscViewerASCIIPopSynchronized(viewer));
926   PetscFunctionReturn(PETSC_SUCCESS);
927 }
928 
929 static PetscErrorCode PetscViewerView_ASCII(PetscViewer v, PetscViewer viewer)
930 {
931   PetscViewer_ASCII *ascii = (PetscViewer_ASCII *)v->data;
932 
933   PetscFunctionBegin;
934   if (ascii->fileunit) PetscCall(PetscViewerASCIIPrintf(viewer, "Fortran FILE UNIT: %d\n", ascii->fileunit));
935   else if (ascii->filename) PetscCall(PetscViewerASCIIPrintf(viewer, "Filename: %s\n", ascii->filename));
936   PetscFunctionReturn(PETSC_SUCCESS);
937 }
938 
939 static PetscErrorCode PetscViewerFlush_ASCII(PetscViewer viewer)
940 {
941   PetscViewer_ASCII *vascii = (PetscViewer_ASCII *)viewer->data;
942   MPI_Comm           comm;
943   PetscMPIInt        rank, size;
944   FILE              *fd = vascii->fd;
945 
946   PetscFunctionBegin;
947   PetscCheck(!vascii->sviewer, PetscObjectComm((PetscObject)viewer), PETSC_ERR_ARG_WRONGSTATE, "Cannot call with outstanding call to PetscViewerRestoreSubViewer()");
948   PetscCall(PetscObjectGetComm((PetscObject)viewer, &comm));
949   PetscCallMPI(MPI_Comm_rank(comm, &rank));
950   PetscCallMPI(MPI_Comm_size(comm, &size));
951 
952   if (!vascii->bviewer && rank == 0 && (vascii->mode != FILE_MODE_READ)) PetscCall(PetscFFlush(vascii->fd));
953 
954   if (vascii->allowsynchronized) {
955     PetscMPIInt tag, i, j, n = 0, dummy = 0;
956     char       *message;
957     MPI_Status  status;
958 
959     PetscCall(PetscCommDuplicate(comm, &comm, &tag));
960 
961     /* First processor waits for messages from all other processors */
962     if (rank == 0) {
963       /* flush my own messages that I may have queued up */
964       PrintfQueue next = vascii->petsc_printfqueuebase, previous;
965       for (i = 0; i < vascii->petsc_printfqueuelength; i++) {
966         if (!vascii->bviewer) {
967           if (!vascii->fileunit) PetscCall(PetscFPrintf(comm, fd, "%s", next->string));
968           else PetscCall(PetscFPrintfFortran(vascii->fileunit, next->string));
969         } else {
970           PetscCall(PetscViewerASCIISynchronizedPrintf(vascii->bviewer, "%s", next->string));
971         }
972         previous = next;
973         next     = next->next;
974         PetscCall(PetscFree(previous->string));
975         PetscCall(PetscFree(previous));
976       }
977       vascii->petsc_printfqueue       = NULL;
978       vascii->petsc_printfqueuelength = 0;
979       for (i = 1; i < size; i++) {
980         /* to prevent a flood of messages to process zero, request each message separately */
981         PetscCallMPI(MPI_Send(&dummy, 1, MPI_INT, i, tag, comm));
982         PetscCallMPI(MPI_Recv(&n, 1, MPI_INT, i, tag, comm, &status));
983         for (j = 0; j < n; j++) {
984           size_t size;
985 
986           PetscCallMPI(MPI_Recv(&size, 1, MPIU_SIZE_T, i, tag, comm, &status));
987           PetscCall(PetscMalloc1(size, &message));
988           PetscCallMPI(MPI_Recv(message, (PetscMPIInt)size, MPI_CHAR, i, tag, comm, &status));
989           if (!vascii->bviewer) {
990             if (!vascii->fileunit) PetscCall(PetscFPrintf(comm, fd, "%s", message));
991             else PetscCall(PetscFPrintfFortran(vascii->fileunit, message));
992           } else {
993             PetscCall(PetscViewerASCIISynchronizedPrintf(vascii->bviewer, "%s", message));
994           }
995           PetscCall(PetscFree(message));
996         }
997       }
998     } else { /* other processors send queue to processor 0 */
999       PrintfQueue next = vascii->petsc_printfqueuebase, previous;
1000 
1001       PetscCallMPI(MPI_Recv(&dummy, 1, MPI_INT, 0, tag, comm, &status));
1002       PetscCallMPI(MPI_Send(&vascii->petsc_printfqueuelength, 1, MPI_INT, 0, tag, comm));
1003       for (i = 0; i < vascii->petsc_printfqueuelength; i++) {
1004         PetscCallMPI(MPI_Send(&next->size, 1, MPIU_SIZE_T, 0, tag, comm));
1005         PetscCallMPI(MPI_Send(next->string, (PetscMPIInt)next->size, MPI_CHAR, 0, tag, comm));
1006         previous = next;
1007         next     = next->next;
1008         PetscCall(PetscFree(previous->string));
1009         PetscCall(PetscFree(previous));
1010       }
1011       vascii->petsc_printfqueue       = NULL;
1012       vascii->petsc_printfqueuelength = 0;
1013     }
1014     PetscCall(PetscCommDestroy(&comm));
1015   }
1016   PetscFunctionReturn(PETSC_SUCCESS);
1017 }
1018 
1019 /*MC
1020    PETSCVIEWERASCII - A viewer that prints to `stdout`, `stderr`, or an ASCII file
1021 
1022   Level: beginner
1023 
1024 .seealso: [](sec_viewers), `PETSC_VIEWER_STDOUT_()`, `PETSC_VIEWER_STDOUT_SELF`, `PETSC_VIEWER_STDOUT_WORLD`, `PetscViewerCreate()`, `PetscViewerASCIIOpen()`,
1025           `PetscViewerMatlabOpen()`, `VecView()`, `DMView()`, `PetscViewerMatlabPutArray()`, `PETSCVIEWERBINARY`, `PETSCVIEWERMATLAB`,
1026           `PetscViewerFileSetName()`, `PetscViewerFileSetMode()`, `PetscViewerFormat`, `PetscViewerType`, `PetscViewerSetType()`
1027 M*/
1028 PETSC_EXTERN PetscErrorCode PetscViewerCreate_ASCII(PetscViewer viewer)
1029 {
1030   PetscViewer_ASCII *vascii;
1031 
1032   PetscFunctionBegin;
1033   PetscCall(PetscNew(&vascii));
1034   viewer->data = (void *)vascii;
1035 
1036   viewer->ops->destroy          = PetscViewerDestroy_ASCII;
1037   viewer->ops->flush            = PetscViewerFlush_ASCII;
1038   viewer->ops->getsubviewer     = PetscViewerGetSubViewer_ASCII;
1039   viewer->ops->restoresubviewer = PetscViewerRestoreSubViewer_ASCII;
1040   viewer->ops->view             = PetscViewerView_ASCII;
1041   viewer->ops->read             = PetscViewerASCIIRead;
1042 
1043   /* defaults to stdout unless set with PetscViewerFileSetName() */
1044   vascii->fd        = PETSC_STDOUT;
1045   vascii->mode      = FILE_MODE_WRITE;
1046   vascii->bviewer   = NULL;
1047   vascii->subviewer = NULL;
1048   vascii->sviewer   = NULL;
1049   vascii->tab       = 0;
1050   vascii->tab_store = 0;
1051   vascii->filename  = NULL;
1052   vascii->closefile = PETSC_TRUE;
1053 
1054   PetscCall(PetscObjectComposeFunction((PetscObject)viewer, "PetscViewerFileSetName_C", PetscViewerFileSetName_ASCII));
1055   PetscCall(PetscObjectComposeFunction((PetscObject)viewer, "PetscViewerFileGetName_C", PetscViewerFileGetName_ASCII));
1056   PetscCall(PetscObjectComposeFunction((PetscObject)viewer, "PetscViewerFileGetMode_C", PetscViewerFileGetMode_ASCII));
1057   PetscCall(PetscObjectComposeFunction((PetscObject)viewer, "PetscViewerFileSetMode_C", PetscViewerFileSetMode_ASCII));
1058   PetscFunctionReturn(PETSC_SUCCESS);
1059 }
1060 
1061 /*@C
1062   PetscViewerASCIISynchronizedPrintf - Prints synchronized output to the specified `PETSCVIEWERASCII` file from
1063   several processors.  Output of the first processor is followed by that of the
1064   second, etc.
1065 
1066   Not Collective, must call collective `PetscViewerFlush()` to get the results flushed
1067 
1068   Input Parameters:
1069 + viewer - the `PETSCVIEWERASCII` `PetscViewer`
1070 - format - the usual printf() format string
1071 
1072   Level: intermediate
1073 
1074   Notes:
1075   You must have previously called `PetscViewerASCIIPushSynchronized()` to allow this routine to be called.
1076   Then you can do multiple independent calls to this routine.
1077 
1078   The actual synchronized print is then done using `PetscViewerFlush()`.
1079   `PetscViewerASCIIPopSynchronized()` should be then called if we are already done with the synchronized output
1080   to conclude the "synchronized session".
1081 
1082   So the typical calling sequence looks like
1083 .vb
1084     PetscViewerASCIIPushSynchronized(viewer);
1085     PetscViewerASCIISynchronizedPrintf(viewer, ...);
1086     PetscViewerASCIISynchronizedPrintf(viewer, ...);
1087     ...
1088     PetscViewerFlush(viewer);
1089     PetscViewerASCIISynchronizedPrintf(viewer, ...);
1090     PetscViewerASCIISynchronizedPrintf(viewer, ...);
1091     ...
1092     PetscViewerFlush(viewer);
1093     PetscViewerASCIIPopSynchronized(viewer);
1094 .ve
1095 
1096   Fortran Notes:
1097   Can only print a single character* string
1098 
1099 .seealso: [](sec_viewers), `PetscViewerASCIIPushSynchronized()`, `PetscViewerFlush()`, `PetscViewerASCIIPopSynchronized()`,
1100           `PetscSynchronizedPrintf()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIIOpen()`,
1101           `PetscViewerCreate()`, `PetscViewerDestroy()`, `PetscViewerSetType()`
1102 @*/
1103 PetscErrorCode PetscViewerASCIISynchronizedPrintf(PetscViewer viewer, const char format[], ...)
1104 {
1105   PetscViewer_ASCII *vascii = (PetscViewer_ASCII *)viewer->data;
1106   PetscMPIInt        rank;
1107   PetscInt           tab = 0;
1108   MPI_Comm           comm;
1109   PetscBool          isascii;
1110 
1111   PetscFunctionBegin;
1112   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 1);
1113   PetscAssertPointer(format, 2);
1114   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &isascii));
1115   PetscCheck(isascii, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Not ASCII PetscViewer");
1116   PetscCheck(vascii->allowsynchronized, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "First call PetscViewerASCIIPushSynchronized() to allow this call");
1117 
1118   PetscCall(PetscObjectGetComm((PetscObject)viewer, &comm));
1119   PetscCallMPI(MPI_Comm_rank(comm, &rank));
1120 
1121   if (vascii->bviewer) {
1122     char   *string;
1123     va_list Argp;
1124     size_t  fullLength;
1125 
1126     PetscCall(PetscCalloc1(QUEUESTRINGSIZE, &string));
1127     for (; tab < vascii->tab; tab++) string[2 * tab] = string[2 * tab + 1] = ' ';
1128     va_start(Argp, format);
1129     PetscCall(PetscVSNPrintf(string + 2 * tab, QUEUESTRINGSIZE - 2 * tab, format, &fullLength, Argp));
1130     va_end(Argp);
1131     PetscCall(PetscViewerASCIISynchronizedPrintf(vascii->bviewer, "%s", string));
1132     PetscCall(PetscFree(string));
1133   } else if (rank == 0) { /* First processor prints immediately to fp */
1134     va_list Argp;
1135     FILE   *fp = vascii->fd;
1136 
1137     tab = vascii->tab;
1138     while (tab--) {
1139       if (!vascii->fileunit) PetscCall(PetscFPrintf(PETSC_COMM_SELF, fp, "  "));
1140       else PetscCall(PetscFPrintfFortran(vascii->fileunit, "   "));
1141     }
1142 
1143     va_start(Argp, format);
1144     if (!vascii->fileunit) PetscCall((*PetscVFPrintf)(fp, format, Argp));
1145     else PetscCall(PetscVFPrintfFortran(vascii->fileunit, format, Argp));
1146     va_end(Argp);
1147     PetscCall(PetscFFlush(fp));
1148     if (petsc_history) {
1149       va_start(Argp, format);
1150       PetscCall((*PetscVFPrintf)(petsc_history, format, Argp));
1151       va_end(Argp);
1152       PetscCall(PetscFFlush(petsc_history));
1153     }
1154   } else { /* other processors add to queue */
1155     char       *string;
1156     va_list     Argp;
1157     size_t      fullLength;
1158     PrintfQueue next;
1159 
1160     PetscCall(PetscNew(&next));
1161     if (vascii->petsc_printfqueue) {
1162       vascii->petsc_printfqueue->next = next;
1163       vascii->petsc_printfqueue       = next;
1164     } else {
1165       vascii->petsc_printfqueuebase = vascii->petsc_printfqueue = next;
1166     }
1167     vascii->petsc_printfqueuelength++;
1168     next->size = QUEUESTRINGSIZE;
1169     PetscCall(PetscCalloc1(next->size, &next->string));
1170     string = next->string;
1171 
1172     tab = vascii->tab;
1173     tab *= 2;
1174     while (tab--) *string++ = ' ';
1175     va_start(Argp, format);
1176     PetscCall(PetscVSNPrintf(string, next->size - 2 * vascii->tab, format, &fullLength, Argp));
1177     va_end(Argp);
1178     if (fullLength > next->size - 2 * vascii->tab) {
1179       PetscCall(PetscFree(next->string));
1180       next->size = fullLength + 2 * vascii->tab;
1181       PetscCall(PetscCalloc1(next->size, &next->string));
1182       string = next->string;
1183       tab    = 2 * vascii->tab;
1184       while (tab--) *string++ = ' ';
1185       va_start(Argp, format);
1186       PetscCall(PetscVSNPrintf(string, next->size - 2 * vascii->tab, format, NULL, Argp));
1187       va_end(Argp);
1188     }
1189   }
1190   PetscFunctionReturn(PETSC_SUCCESS);
1191 }
1192 
1193 /*@C
1194   PetscViewerASCIIRead - Reads from a `PETSCVIEWERASCII` file
1195 
1196   Only MPI rank 0 in the `PetscViewer` may call this
1197 
1198   Input Parameters:
1199 + viewer - the `PETSCVIEWERASCII` viewer
1200 . data   - location to write the data, treated as an array of type indicated by `datatype`
1201 . num    - number of items of data to read
1202 - dtype  - type of data to read
1203 
1204   Output Parameter:
1205 . count - number of items of data actually read, or `NULL`
1206 
1207   Level: beginner
1208 
1209 .seealso: [](sec_viewers), `PetscViewerASCIIOpen()`, `PetscViewerPushFormat()`, `PetscViewerDestroy()`, `PetscViewerCreate()`, `PetscViewerFileSetMode()`, `PetscViewerFileSetName()`
1210           `VecView()`, `MatView()`, `VecLoad()`, `MatLoad()`, `PetscViewerBinaryGetDescriptor()`,
1211           `PetscViewerBinaryGetInfoPointer()`, `PetscFileMode`, `PetscViewer`, `PetscViewerBinaryRead()`
1212 @*/
1213 PetscErrorCode PetscViewerASCIIRead(PetscViewer viewer, void *data, PetscInt num, PetscInt *count, PetscDataType dtype)
1214 {
1215   PetscViewer_ASCII *vascii = (PetscViewer_ASCII *)viewer->data;
1216   FILE              *fd     = vascii->fd;
1217   PetscInt           i;
1218   int                ret = 0;
1219   PetscMPIInt        rank;
1220 
1221   PetscFunctionBegin;
1222   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 1);
1223   PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)viewer), &rank));
1224   PetscCheck(rank == 0, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Can only be called from process 0 in the PetscViewer");
1225   for (i = 0; i < num; i++) {
1226     if (dtype == PETSC_CHAR) ret = fscanf(fd, "%c", &(((char *)data)[i]));
1227     else if (dtype == PETSC_STRING) ret = fscanf(fd, "%s", &(((char *)data)[i]));
1228     else if (dtype == PETSC_INT) ret = fscanf(fd, "%" PetscInt_FMT, &(((PetscInt *)data)[i]));
1229     else if (dtype == PETSC_ENUM) ret = fscanf(fd, "%d", &(((int *)data)[i]));
1230     else if (dtype == PETSC_INT64) ret = fscanf(fd, "%" PetscInt64_FMT, &(((PetscInt64 *)data)[i]));
1231     else if (dtype == PETSC_LONG) ret = fscanf(fd, "%ld", &(((long *)data)[i]));
1232     else if (dtype == PETSC_COUNT) ret = fscanf(fd, "%" PetscCount_FMT, &(((PetscCount *)data)[i]));
1233     else if (dtype == PETSC_FLOAT) ret = fscanf(fd, "%f", &(((float *)data)[i]));
1234     else if (dtype == PETSC_DOUBLE) ret = fscanf(fd, "%lg", &(((double *)data)[i]));
1235 #if defined(PETSC_USE_REAL___FLOAT128)
1236     else if (dtype == PETSC___FLOAT128) {
1237       double tmp;
1238       ret                     = fscanf(fd, "%lg", &tmp);
1239       ((__float128 *)data)[i] = tmp;
1240     }
1241 #endif
1242     else
1243       SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Data type %d not supported", (int)dtype);
1244     PetscCheck(ret, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Conversion error for data type %d", (int)dtype);
1245     if (ret < 0) break; /* Proxy for EOF, need to check for it in configure */
1246   }
1247   if (count) *count = i;
1248   else PetscCheck(ret >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Insufficient data, read only %" PetscInt_FMT " < %" PetscInt_FMT " items", i, num);
1249   PetscFunctionReturn(PETSC_SUCCESS);
1250 }
1251