Line data Source code
1 : ! ***********************************************************************
2 : !
3 : ! Copyright (C) 2010-2022 The MESA Team, Bill Paxton & Matthias Fabry
4 : !
5 : ! This program is free software: you can redistribute it and/or modify
6 : ! it under the terms of the GNU Lesser General Public License
7 : ! as published by the Free Software Foundation,
8 : ! either version 3 of the License, or (at your option) any later version.
9 : !
10 : ! This program is distributed in the hope that it will be useful,
11 : ! but WITHOUT ANY WARRANTY; without even the implied warranty of
12 : ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13 : ! See the GNU Lesser General Public License for more details.
14 : !
15 : ! You should have received a copy of the GNU Lesser General Public License
16 : ! along with this program. If not, see <https://www.gnu.org/licenses/>.
17 : !
18 : ! ***********************************************************************
19 :
20 : module pgbinary_summary
21 :
22 : use binary_private_def
23 : use const_def, only: dp
24 : use pgbinary_support
25 :
26 : implicit none
27 :
28 :
29 : contains
30 :
31 :
32 0 : subroutine Text_Summary1_plot(id, device_id, ierr)
33 : integer, intent(in) :: id, device_id
34 : integer, intent(out) :: ierr
35 : type (binary_info), pointer :: b
36 : ierr = 0
37 0 : call get_binary_ptr(id, b, ierr)
38 0 : if (ierr /= 0) return
39 0 : call pgslct(device_id)
40 0 : call pgbbuf()
41 0 : call pgeras()
42 : call do_Text_Summary1_plot(b, id, device_id, &
43 : b% pg% Text_Summary1_xleft, b% pg% Text_Summary1_xright, &
44 : b% pg% Text_Summary1_ybot, b% pg% Text_Summary1_ytop, .false., &
45 0 : b% pg% Text_Summary1_title, b% pg% Text_Summary1_txt_scale, ierr)
46 0 : if (ierr /= 0) return
47 0 : call pgebuf()
48 : end subroutine Text_Summary1_plot
49 :
50 :
51 0 : subroutine do_Text_Summary1_plot(b, id, device_id, &
52 : winxmin, winxmax, winymin, winymax, subplot, title, txt_scale, ierr)
53 : type (binary_info), pointer :: b
54 : integer, intent(in) :: id, device_id
55 : real, intent(in) :: winxmin, winxmax, winymin, winymax, txt_scale
56 : logical, intent(in) :: subplot
57 : character (len = *), intent(in) :: title
58 : integer, intent(out) :: ierr
59 : call Summary_plot(b, device_id, &
60 : winxmin, winxmax, winymin, winymax, subplot, title, txt_scale, &
61 : b% pg% Text_Summary1_num_rows, b% pg% Text_Summary1_num_cols, &
62 0 : b% pg% Text_Summary1_name, ierr)
63 0 : end subroutine do_Text_Summary1_plot
64 :
65 :
66 0 : subroutine Text_Summary2_plot(id, device_id, ierr)
67 : integer, intent(in) :: id, device_id
68 : integer, intent(out) :: ierr
69 : type (binary_info), pointer :: b
70 : ierr = 0
71 0 : call get_binary_ptr(id, b, ierr)
72 0 : if (ierr /= 0) return
73 0 : call pgslct(device_id)
74 0 : call pgbbuf()
75 0 : call pgeras()
76 : call do_Text_Summary2_plot(b, id, device_id, &
77 : b% pg% Text_Summary2_xleft, b% pg% Text_Summary2_xright, &
78 : b% pg% Text_Summary2_ybot, b% pg% Text_Summary2_ytop, .false., &
79 0 : b% pg% Text_Summary2_title, b% pg% Text_Summary2_txt_scale, ierr)
80 0 : if (ierr /= 0) return
81 0 : call pgebuf()
82 : end subroutine Text_Summary2_plot
83 :
84 :
85 0 : subroutine do_Text_Summary2_plot(b, id, device_id, &
86 : winxmin, winxmax, winymin, winymax, subplot, title, txt_scale, ierr)
87 : type (binary_info), pointer :: b
88 : integer, intent(in) :: id, device_id
89 : real, intent(in) :: winxmin, winxmax, winymin, winymax, txt_scale
90 : logical, intent(in) :: subplot
91 : character (len = *), intent(in) :: title
92 : integer, intent(out) :: ierr
93 : call Summary_plot(b, device_id, &
94 : winxmin, winxmax, winymin, winymax, subplot, title, txt_scale, &
95 : b% pg% Text_Summary2_num_rows, b% pg% Text_Summary2_num_cols, &
96 0 : b% pg% Text_Summary2_name, ierr)
97 0 : end subroutine do_Text_Summary2_plot
98 :
99 :
100 0 : subroutine Text_Summary3_plot(id, device_id, ierr)
101 : integer, intent(in) :: id, device_id
102 : integer, intent(out) :: ierr
103 : type (binary_info), pointer :: b
104 : ierr = 0
105 0 : call get_binary_ptr(id, b, ierr)
106 0 : if (ierr /= 0) return
107 0 : call pgslct(device_id)
108 0 : call pgbbuf()
109 0 : call pgeras()
110 : call do_Text_Summary3_plot(b, id, device_id, &
111 : b% pg% Text_Summary3_xleft, b% pg% Text_Summary3_xright, &
112 : b% pg% Text_Summary3_ybot, b% pg% Text_Summary3_ytop, .false., &
113 0 : b% pg% Text_Summary3_title, b% pg% Text_Summary3_txt_scale, ierr)
114 0 : if (ierr /= 0) return
115 0 : call pgebuf()
116 : end subroutine Text_Summary3_plot
117 :
118 :
119 0 : subroutine do_Text_Summary3_plot(b, id, device_id, &
120 : winxmin, winxmax, winymin, winymax, subplot, title, txt_scale, ierr)
121 : type (binary_info), pointer :: b
122 : integer, intent(in) :: id, device_id
123 : real, intent(in) :: winxmin, winxmax, winymin, winymax, txt_scale
124 : logical, intent(in) :: subplot
125 : character (len = *), intent(in) :: title
126 : integer, intent(out) :: ierr
127 : call Summary_plot(b, device_id, &
128 : winxmin, winxmax, winymin, winymax, subplot, title, txt_scale, &
129 : b% pg% Text_Summary3_num_rows, b% pg% Text_Summary3_num_cols, &
130 0 : b% pg% Text_Summary3_name, ierr)
131 0 : end subroutine do_Text_Summary3_plot
132 :
133 :
134 0 : subroutine Text_Summary4_plot(id, device_id, ierr)
135 : integer, intent(in) :: id, device_id
136 : integer, intent(out) :: ierr
137 : type (binary_info), pointer :: b
138 : ierr = 0
139 0 : call get_binary_ptr(id, b, ierr)
140 0 : if (ierr /= 0) return
141 0 : call pgslct(device_id)
142 0 : call pgbbuf()
143 0 : call pgeras()
144 : call do_Text_Summary4_plot(b, id, device_id, &
145 : b% pg% Text_Summary4_xleft, b% pg% Text_Summary4_xright, &
146 : b% pg% Text_Summary4_ybot, b% pg% Text_Summary4_ytop, .false., &
147 0 : b% pg% Text_Summary4_title, b% pg% Text_Summary4_txt_scale, ierr)
148 0 : if (ierr /= 0) return
149 0 : call pgebuf()
150 : end subroutine Text_Summary4_plot
151 :
152 :
153 0 : subroutine do_Text_Summary4_plot(b, id, device_id, &
154 : winxmin, winxmax, winymin, winymax, subplot, title, txt_scale, ierr)
155 : type (binary_info), pointer :: b
156 : integer, intent(in) :: id, device_id
157 : real, intent(in) :: winxmin, winxmax, winymin, winymax, txt_scale
158 : logical, intent(in) :: subplot
159 : character (len = *), intent(in) :: title
160 : integer, intent(out) :: ierr
161 : call Summary_plot(b, device_id, &
162 : winxmin, winxmax, winymin, winymax, subplot, title, txt_scale, &
163 : b% pg% Text_Summary4_num_rows, b% pg% Text_Summary4_num_cols, &
164 0 : b% pg% Text_Summary4_name, ierr)
165 0 : end subroutine do_Text_Summary4_plot
166 :
167 :
168 0 : subroutine Text_Summary5_plot(id, device_id, ierr)
169 : integer, intent(in) :: id, device_id
170 : integer, intent(out) :: ierr
171 : type (binary_info), pointer :: b
172 : ierr = 0
173 0 : call get_binary_ptr(id, b, ierr)
174 0 : if (ierr /= 0) return
175 0 : call pgslct(device_id)
176 0 : call pgbbuf()
177 0 : call pgeras()
178 : call do_Text_Summary5_plot(b, id, device_id, &
179 : b% pg% Text_Summary5_xleft, b% pg% Text_Summary5_xright, &
180 : b% pg% Text_Summary5_ybot, b% pg% Text_Summary5_ytop, .false., &
181 0 : b% pg% Text_Summary5_title, b% pg% Text_Summary5_txt_scale, ierr)
182 0 : if (ierr /= 0) return
183 0 : call pgebuf()
184 : end subroutine Text_Summary5_plot
185 :
186 :
187 0 : subroutine do_Text_Summary5_plot(b, id, device_id, &
188 : winxmin, winxmax, winymin, winymax, subplot, title, txt_scale, ierr)
189 : type (binary_info), pointer :: b
190 : integer, intent(in) :: id, device_id
191 : real, intent(in) :: winxmin, winxmax, winymin, winymax, txt_scale
192 : logical, intent(in) :: subplot
193 : character (len = *), intent(in) :: title
194 : integer, intent(out) :: ierr
195 : call Summary_plot(b, device_id, &
196 : winxmin, winxmax, winymin, winymax, subplot, title, txt_scale, &
197 : b% pg% Text_Summary5_num_rows, b% pg% Text_Summary5_num_cols, &
198 0 : b% pg% Text_Summary5_name, ierr)
199 0 : end subroutine do_Text_Summary5_plot
200 :
201 :
202 0 : subroutine Text_Summary6_plot(id, device_id, ierr)
203 : integer, intent(in) :: id, device_id
204 : integer, intent(out) :: ierr
205 : type (binary_info), pointer :: b
206 : ierr = 0
207 0 : call get_binary_ptr(id, b, ierr)
208 0 : if (ierr /= 0) return
209 0 : call pgslct(device_id)
210 0 : call pgbbuf()
211 0 : call pgeras()
212 : call do_Text_Summary6_plot(b, id, device_id, &
213 : b% pg% Text_Summary6_xleft, b% pg% Text_Summary6_xright, &
214 : b% pg% Text_Summary6_ybot, b% pg% Text_Summary6_ytop, .false., &
215 0 : b% pg% Text_Summary6_title, b% pg% Text_Summary6_txt_scale, ierr)
216 0 : if (ierr /= 0) return
217 0 : call pgebuf()
218 : end subroutine Text_Summary6_plot
219 :
220 :
221 0 : subroutine do_Text_Summary6_plot(b, id, device_id, &
222 : winxmin, winxmax, winymin, winymax, subplot, title, txt_scale, ierr)
223 : type (binary_info), pointer :: b
224 : integer, intent(in) :: id, device_id
225 : real, intent(in) :: winxmin, winxmax, winymin, winymax, txt_scale
226 : logical, intent(in) :: subplot
227 : character (len = *), intent(in) :: title
228 : integer, intent(out) :: ierr
229 : call Summary_plot(b, device_id, &
230 : winxmin, winxmax, winymin, winymax, subplot, title, txt_scale, &
231 : b% pg% Text_Summary6_num_rows, b% pg% Text_Summary6_num_cols, &
232 0 : b% pg% Text_Summary6_name, ierr)
233 0 : end subroutine do_Text_Summary6_plot
234 :
235 :
236 0 : subroutine Text_Summary7_plot(id, device_id, ierr)
237 : integer, intent(in) :: id, device_id
238 : integer, intent(out) :: ierr
239 : type (binary_info), pointer :: b
240 : ierr = 0
241 0 : call get_binary_ptr(id, b, ierr)
242 0 : if (ierr /= 0) return
243 0 : call pgslct(device_id)
244 0 : call pgbbuf()
245 0 : call pgeras()
246 : call do_Text_Summary7_plot(b, id, device_id, &
247 : b% pg% Text_Summary7_xleft, b% pg% Text_Summary7_xright, &
248 : b% pg% Text_Summary7_ybot, b% pg% Text_Summary7_ytop, .false., &
249 0 : b% pg% Text_Summary7_title, b% pg% Text_Summary7_txt_scale, ierr)
250 0 : if (ierr /= 0) return
251 0 : call pgebuf()
252 : end subroutine Text_Summary7_plot
253 :
254 :
255 0 : subroutine do_Text_Summary7_plot(b, id, device_id, &
256 : winxmin, winxmax, winymin, winymax, subplot, title, txt_scale, ierr)
257 : type (binary_info), pointer :: b
258 : integer, intent(in) :: id, device_id
259 : real, intent(in) :: winxmin, winxmax, winymin, winymax, txt_scale
260 : logical, intent(in) :: subplot
261 : character (len = *), intent(in) :: title
262 : integer, intent(out) :: ierr
263 : call Summary_plot(b, device_id, &
264 : winxmin, winxmax, winymin, winymax, subplot, title, txt_scale, &
265 : b% pg% Text_Summary7_num_rows, b% pg% Text_Summary7_num_cols, &
266 0 : b% pg% Text_Summary7_name, ierr)
267 0 : end subroutine do_Text_Summary7_plot
268 :
269 :
270 0 : subroutine Text_Summary8_plot(id, device_id, ierr)
271 : integer, intent(in) :: id, device_id
272 : integer, intent(out) :: ierr
273 : type (binary_info), pointer :: b
274 : ierr = 0
275 0 : call get_binary_ptr(id, b, ierr)
276 0 : if (ierr /= 0) return
277 0 : call pgslct(device_id)
278 0 : call pgbbuf()
279 0 : call pgeras()
280 : call do_Text_Summary8_plot(b, id, device_id, &
281 : b% pg% Text_Summary8_xleft, b% pg% Text_Summary8_xright, &
282 : b% pg% Text_Summary8_ybot, b% pg% Text_Summary8_ytop, .false., &
283 0 : b% pg% Text_Summary8_title, b% pg% Text_Summary8_txt_scale, ierr)
284 0 : if (ierr /= 0) return
285 0 : call pgebuf()
286 : end subroutine Text_Summary8_plot
287 :
288 :
289 0 : subroutine do_Text_Summary8_plot(b, id, device_id, &
290 : winxmin, winxmax, winymin, winymax, subplot, title, txt_scale, ierr)
291 : type (binary_info), pointer :: b
292 : integer, intent(in) :: id, device_id
293 : real, intent(in) :: winxmin, winxmax, winymin, winymax, txt_scale
294 : logical, intent(in) :: subplot
295 : character (len = *), intent(in) :: title
296 : integer, intent(out) :: ierr
297 : call Summary_plot(b, device_id, &
298 : winxmin, winxmax, winymin, winymax, subplot, title, txt_scale, &
299 : b% pg% Text_Summary8_num_rows, b% pg% Text_Summary8_num_cols, &
300 0 : b% pg% Text_Summary8_name, ierr)
301 0 : end subroutine do_Text_Summary8_plot
302 :
303 :
304 0 : subroutine Text_Summary9_plot(id, device_id, ierr)
305 : integer, intent(in) :: id, device_id
306 : integer, intent(out) :: ierr
307 : type (binary_info), pointer :: b
308 : ierr = 0
309 0 : call get_binary_ptr(id, b, ierr)
310 0 : if (ierr /= 0) return
311 0 : call pgslct(device_id)
312 0 : call pgbbuf()
313 0 : call pgeras()
314 : call do_Text_Summary9_plot(b, id, device_id, &
315 : b% pg% Text_Summary9_xleft, b% pg% Text_Summary9_xright, &
316 : b% pg% Text_Summary9_ybot, b% pg% Text_Summary9_ytop, .false., &
317 0 : b% pg% Text_Summary9_title, b% pg% Text_Summary9_txt_scale, ierr)
318 0 : if (ierr /= 0) return
319 0 : call pgebuf()
320 : end subroutine Text_Summary9_plot
321 :
322 :
323 0 : subroutine do_Text_Summary9_plot(b, id, device_id, &
324 : winxmin, winxmax, winymin, winymax, subplot, title, txt_scale, ierr)
325 : type (binary_info), pointer :: b
326 : integer, intent(in) :: id, device_id
327 : real, intent(in) :: winxmin, winxmax, winymin, winymax, txt_scale
328 : logical, intent(in) :: subplot
329 : character (len = *), intent(in) :: title
330 : integer, intent(out) :: ierr
331 : call Summary_plot(b, device_id, &
332 : winxmin, winxmax, winymin, winymax, subplot, title, txt_scale, &
333 : b% pg% Text_Summary9_num_rows, b% pg% Text_Summary9_num_cols, &
334 0 : b% pg% Text_Summary9_name, ierr)
335 0 : end subroutine do_Text_Summary9_plot
336 :
337 :
338 0 : subroutine Summary_plot(b, device_id, &
339 : winxmin, winxmax, winymin, winymax, subplot, title, txt_scale, &
340 : Text_Summary_num_rows, Text_Summary_num_cols, &
341 0 : Text_Summary_name, ierr)
342 :
343 : use utils_lib
344 : use pgstar_colors, only: clr_Foreground
345 : use pgstar_support, only : write_info_line_exp, write_info_line_flt, &
346 : write_info_line_int
347 :
348 : type (binary_info), pointer :: b
349 : integer, intent(in) :: device_id
350 : real, intent(in) :: winxmin, winxmax, winymin, winymax, txt_scale
351 : logical, intent(in) :: subplot
352 : character (len = *), intent(in) :: title
353 : integer, intent(in) :: Text_Summary_num_rows, Text_Summary_num_cols
354 : character (len = *), intent(in) :: Text_Summary_name(:, :)
355 : integer, intent(out) :: ierr
356 :
357 : integer :: col, num_cols, num_rows
358 :
359 : include 'formats'
360 :
361 0 : ierr = 0
362 :
363 0 : num_rows = Text_Summary_num_rows
364 0 : num_cols = Text_Summary_num_cols
365 0 : if (num_rows <= 0 .or. num_cols <= 0) return
366 :
367 0 : call pgsave
368 0 : call pgsch(txt_scale)
369 :
370 0 : call pgsvp(winxmin, winxmax, winymin, winymax)
371 0 : call pgsci(clr_Foreground)
372 0 : call pgscf(1)
373 0 : call pgswin(0.0, 1.0, 0.0, 1.0)
374 0 : call show_title_pgbinary(b, title)
375 0 : call pgsch(txt_scale * 0.8)
376 :
377 0 : do col = 1, num_cols
378 0 : call show_column(col, num_rows)
379 : end do
380 :
381 0 : call pgunsa
382 :
383 :
384 : contains
385 :
386 :
387 0 : subroutine show_column(col, num_rows)
388 0 : use binary_history, only : get_binary_history_specs, get_binary_history_values, get1_binary_hist_value
389 : integer, intent(in) :: col, num_rows
390 :
391 0 : real(dp) :: values(num_rows)
392 0 : integer :: int_values(num_rows), specs(num_rows)
393 0 : logical :: is_int_value(num_rows)
394 0 : logical :: failed_to_find_value(num_rows)
395 :
396 : integer :: i, cnt
397 0 : real :: xpos0, dxpos, dxval, ypos, dypos
398 0 : real(dp) :: val
399 :
400 : call get_binary_history_specs(&
401 0 : b, num_rows, Text_Summary_name(:, col), specs, .false.)
402 : call get_binary_history_values(&
403 : b, num_rows, specs, &
404 0 : is_int_value, int_values, values, failed_to_find_value)
405 :
406 0 : xpos0 = (real(col) - 0.5) / real(num_cols)
407 :
408 0 : dxpos = 0.00
409 0 : dxval = 0.02
410 :
411 0 : ypos = 0.90
412 0 : dypos = -0.95 / num_rows
413 :
414 0 : do i = 1, num_rows
415 0 : if (i > 1) ypos = ypos + dypos
416 0 : if (failed_to_find_value(i)) then
417 0 : if (.not. get1_binary_hist_value(b, Text_Summary_name(i, col), val)) then
418 0 : if (len_trim(Text_Summary_name(i, col)) > 0) &
419 : write(*, '(a)') 'failed_to_find_value ' // trim(Text_Summary_name(i, col)) &
420 0 : // '. check that it is in your history_columns.list'
421 : cycle
422 : end if
423 0 : values(i) = val
424 0 : else if (is_int_value(i)) then
425 : cnt = write_info_line_int(0, ypos, xpos0, dxpos, dxval, &
426 0 : Text_Summary_name(i, col), int_values(i))
427 0 : cycle
428 : end if
429 0 : if (values(i) == 0d0) then
430 : cnt = write_info_line_int(0, ypos, xpos0, dxpos, dxval, &
431 0 : Text_Summary_name(i, col), 0)
432 0 : else if (abs(values(i)) > 1d-3 .and. abs(values(i)) < 1d3) then
433 : cnt = write_info_line_flt(0, ypos, xpos0, dxpos, dxval, &
434 0 : Text_Summary_name(i, col), values(i))
435 : else
436 : cnt = write_info_line_exp(0, ypos, xpos0, dxpos, dxval, &
437 0 : Text_Summary_name(i, col), values(i))
438 : end if
439 : end do
440 :
441 0 : end subroutine show_column
442 :
443 :
444 : end subroutine Summary_plot
445 :
446 :
447 : end module pgbinary_summary
448 :
|
