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