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