Line data Source code
1 : ! ***********************************************************************
2 : !
3 : ! Copyright (C) 2013-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_history
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 summary_history_plot(id, device_id, ierr)
33 : integer, intent(in) :: id, device_id
34 : integer, intent(out) :: ierr
35 :
36 : type (binary_info), pointer :: b
37 : ierr = 0
38 0 : call get_binary_ptr(id, b, ierr)
39 0 : if (ierr /= 0) return
40 :
41 0 : call pgslct(device_id)
42 0 : call pgbbuf()
43 0 : call pgeras()
44 :
45 : call do_summary_history_plot(b, id, device_id, &
46 : b% pg% Summary_History_xleft, b% pg% Summary_History_xright, &
47 : b% pg% Summary_History_ybot, b% pg% Summary_History_ytop, .false., &
48 0 : b% pg% Summary_History_title, b% pg% Summary_History_txt_scale, ierr)
49 :
50 0 : call pgebuf()
51 :
52 : end subroutine summary_history_plot
53 :
54 :
55 0 : subroutine do_summary_history_plot(b, id, device_id, &
56 : winxmin, winxmax, winymin, winymax, subplot, title, txt_scale, ierr)
57 :
58 : use utils_lib
59 : use chem_def
60 : use net_def
61 : use const_def, only : Msun, Rsun
62 : use pgstar_colors
63 :
64 : type (binary_info), pointer :: b
65 : integer, intent(in) :: id, device_id
66 : real, intent(in) :: winxmin, winxmax, winymin, winymax
67 : logical, intent(in) :: subplot
68 : character (len = *), intent(in) :: title
69 : real, intent(in) :: txt_scale
70 : integer, intent(out) :: ierr
71 :
72 : character (len = strlen) :: yname
73 0 : real, pointer, dimension(:) :: xvec, yvec
74 0 : real :: xmin, xmax, windy, ymin, ymax, &
75 0 : legend_xmin, legend_xmax, legend_ymin, legend_ymax
76 : integer :: lw, lw_sav, num_lines, &
77 : npts, step_min, step_max
78 : integer, parameter :: num_colors = 20
79 : integer :: colors(num_colors)
80 :
81 : include 'formats'
82 :
83 0 : ierr = 0
84 :
85 0 : step_min = b% pg% Summary_History_xmin
86 0 : if (step_min <= 0) step_min = 1
87 0 : step_max = b% pg% Summary_History_xmax
88 0 : if (step_max <= 0) step_max = b% model_number
89 :
90 0 : if (step_min >= b% model_number) step_min = 1
91 :
92 0 : if (b% pg% Summary_History_max_width > 0) &
93 0 : step_min = max(step_min, step_max - b% pg% Summary_History_max_width)
94 :
95 0 : npts = count_hist_points(b, step_min, step_max)
96 0 : if (npts <= 1) return
97 :
98 0 : xmin = real(max(1, step_min))
99 0 : xmax = real(min(b% model_number, step_max))
100 :
101 0 : num_lines = b% pg% Summary_History_num_lines
102 :
103 : colors(:) = [ &
104 : clr_MediumSlateBlue, clr_Goldenrod, clr_LightSkyBlue, clr_Lilac, &
105 : clr_Coral, clr_Crimson, clr_LightSkyGreen, clr_DarkGray, &
106 : clr_Tan, clr_IndianRed, clr_Gold, &
107 : clr_Teal, clr_Silver, clr_BrightBlue, clr_FireBrick, &
108 : clr_RoyalPurple, clr_SlateGray, clr_LightSteelBlue, &
109 0 : clr_Gray, clr_RoyalBlue ]
110 :
111 0 : windy = winymax - winymin
112 :
113 0 : legend_xmin = winxmax - 0.01
114 0 : legend_xmax = 0.99
115 0 : legend_ymin = winymin
116 0 : legend_ymax = winymax
117 :
118 0 : allocate(xvec(npts), yvec(npts))
119 :
120 : call set_hist_points_steps(&
121 0 : b, step_min, step_max, npts, xvec, ierr)
122 0 : if (ierr /= 0) then
123 0 : write(*, *) 'set_hist_points_steps failed for PGSTAR Summary History'
124 0 : return
125 : end if
126 :
127 0 : if (ierr == 0) then
128 0 : call pgsave
129 0 : call pgsch(txt_scale)
130 0 : call plot(ierr)
131 0 : call pgunsa
132 : end if
133 :
134 0 : deallocate(xvec, yvec)
135 :
136 :
137 : contains
138 :
139 :
140 0 : subroutine plot(ierr)
141 0 : use rates_def
142 : integer, intent(out) :: ierr
143 :
144 : integer :: j, cnt, k
145 0 : logical :: show(num_lines)
146 : logical, parameter :: dbg = .false.
147 0 : real :: ybot, yvec_min, yvec_max
148 :
149 : include 'formats'
150 :
151 0 : ymax = 1.02
152 0 : ymin = 0.0
153 :
154 0 : lw = b% pg% pgbinary_lw
155 0 : call pgqlw(lw_sav)
156 :
157 0 : call pgsvp(winxmin, winxmax, winymin, winymax)
158 0 : if (.not. subplot) then
159 0 : call show_model_number_pgbinary(b)
160 0 : call show_age_pgbinary(b)
161 : end if
162 0 : call show_title_pgbinary(b, title)
163 :
164 0 : ybot = 0
165 0 : call pgswin(xmin, xmax, ymin + ybot, ymax)
166 0 : call pgscf(1)
167 0 : call pgsci(clr_Foreground)
168 0 : call show_box_pgbinary(b, 'BCNST', 'BCNSTV')
169 0 : call show_left_yaxis_label_pgbinary(b, 'rel=(val-min)/(max-min)')
170 :
171 0 : cnt = 0
172 0 : do j = 1, num_lines
173 :
174 0 : yname = b% pg% Summary_History_name(j)
175 0 : if (len_trim(yname) == 0) then
176 0 : show(j) = .false.
177 0 : cycle
178 : end if
179 :
180 0 : show(j) = get1_yvec(yname, yvec)
181 0 : if (.not. show(j)) then
182 0 : write(*, *) 'failed to find history information for ' // trim(yname)
183 0 : cycle
184 : end if
185 :
186 0 : if (b% pg% Summary_History_scaled_value(j)) then ! scale yvec
187 :
188 0 : yvec_max = maxval(yvec(1:npts))
189 0 : yvec_min = minval(yvec(1:npts))
190 0 : show(j) = (yvec_max > yvec_min)
191 0 : if (.not. show(j)) then
192 0 : write(*, 1) trim(yname) // ' same min max', yvec_max
193 0 : cycle
194 : end if
195 : !write(*,1) 'relative ' // trim(yname), yvec_min, yvec_max
196 0 : do k = 1, npts
197 0 : yvec(k) = (yvec(k) - yvec_min) / (yvec_max - yvec_min)
198 : end do
199 :
200 : else
201 :
202 0 : show(j) = .true.
203 : !write(*,1) 'absolute ' // trim(yname), yvec_min, yvec_max
204 :
205 : end if
206 :
207 0 : call pgslw(lw)
208 0 : cnt = summary_history_line(cnt, yvec)
209 0 : call pgslw(lw_sav)
210 :
211 : end do
212 :
213 0 : call pgsci(clr_Foreground)
214 0 : call show_xaxis_label_pgbinary(b, 'model number')
215 :
216 : ! show the legend
217 0 : call pgsave
218 0 : call pgsvp(legend_xmin, legend_xmax, legend_ymin, legend_ymax)
219 0 : call pgswin(0.0, 1.0, ymin, ymax)
220 0 : cnt = 0
221 0 : do j = 1, num_lines
222 0 : if (.not. show(j)) cycle
223 0 : if (len_trim(b% pg% Summary_History_legend(j)) == 0) then
224 : cnt = summary_history_line_legend(&
225 0 : cnt, b% pg% Summary_History_name(j))
226 : else
227 : cnt = summary_history_line_legend(&
228 0 : cnt, b% pg% Summary_History_legend(j))
229 : end if
230 : end do
231 0 : call pgunsa
232 :
233 : call show_pgbinary_decorator(b% binary_id, b% pg% Summary_history_use_decorator, &
234 0 : b% pg% Summary_history_pgbinary_decorator, 0, ierr)
235 :
236 0 : end subroutine plot
237 :
238 :
239 0 : logical function get1_yvec(name, vec)
240 : character (len = *) :: name
241 : real, dimension(:), pointer :: vec
242 0 : get1_yvec = get1_hist_yvec(b, step_min, step_max, npts, name, vec)
243 0 : end function get1_yvec
244 :
245 :
246 0 : integer function summary_history_line(cnt, yvec)
247 : integer, intent(in) :: cnt
248 : real, intent(in) :: yvec(:)
249 : integer :: iclr
250 0 : iclr = cnt - num_colors * (cnt / num_colors) + 1
251 0 : summary_history_line = cnt + 1
252 0 : call pgsci(colors(iclr))
253 0 : call pgline(npts, xvec(1:npts), yvec(1:npts))
254 0 : end function summary_history_line
255 :
256 :
257 0 : integer function summary_history_line_legend(cnt, name)
258 : integer, intent(in) :: cnt
259 : character (len = *), intent(in) :: name
260 0 : real :: dx, dyline, ypos, xpts(2), ypts(2)
261 : integer :: iclr, num_max
262 0 : num_max = max_num_Summary_History_Lines
263 0 : summary_history_line_legend = cnt
264 0 : iclr = cnt - num_colors * (cnt / num_colors) + 1
265 0 : call pgsci(colors(iclr))
266 0 : dx = 0.1
267 0 : dyline = (ymax - ymin) / num_max
268 0 : ypos = ymax - (cnt + 1.5) * dyline
269 0 : xpts(1) = 1.3 * dx
270 0 : xpts(2) = xpts(1) + 2.3 * dx
271 0 : ypts = ypos + dyline * 0.1
272 0 : call pgslw(lw)
273 0 : call pgline(2, xpts, ypts)
274 0 : call pgslw(lw_sav)
275 0 : call pgsci(clr_Foreground)
276 0 : call pgsch(txt_scale * 0.70)
277 0 : call pgptxt(xpts(2) + dx, ypos, 0.0, 0.0, name)
278 0 : summary_history_line_legend = cnt + 1
279 0 : end function summary_history_line_legend
280 :
281 :
282 : end subroutine do_summary_history_plot
283 :
284 :
285 : end module pgbinary_summary_history
286 :
|
