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_profile
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_profile_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_profile_plot(s, id, device_id, &
45 : s% pg% Summary_Profile_xleft, s% pg% Summary_Profile_xright, &
46 : s% pg% Summary_Profile_ybot, s% pg% Summary_Profile_ytop, .false., &
47 0 : s% pg% Summary_Profile_title, s% pg% Summary_Profile_txt_scale, ierr)
48 :
49 0 : call pgebuf()
50 :
51 : end subroutine summary_profile_plot
52 :
53 :
54 0 : subroutine do_summary_profile_plot(s, id, device_id, &
55 : winxmin, winxmax, winymin, winymax, subplot, title, txt_scale, ierr)
56 : type (star_info), pointer :: s
57 : integer, intent(in) :: id, device_id
58 : real, intent(in) :: winxmin, winxmax, winymin, winymax
59 : logical, intent(in) :: subplot
60 : character (len=*), intent(in) :: title
61 : real, intent(in) :: txt_scale
62 : integer, intent(out) :: ierr
63 : call do_summary_profile_panel(s, id, device_id, &
64 : winxmin, winxmax, winymin, winymax, subplot, &
65 : title, txt_scale, s% pg% Summary_Profile_xaxis_name, &
66 : s% pg% Summary_Profile_xmin, s% pg% Summary_Profile_xmax, &
67 : s% pg% Summary_Profile_xaxis_reversed, &
68 0 : .false., .true., ierr)
69 0 : end subroutine do_summary_profile_plot
70 :
71 :
72 0 : subroutine do_summary_profile_panel(s, id, device_id, &
73 : winxmin, winxmax, winymin, winymax, subplot, title, txt_scale, &
74 : xaxis_name, xaxis_min, xaxis_max, xaxis_reversed, &
75 : panel_flag, xaxis_numeric_labels_flag, ierr)
76 : use utils_lib
77 : use chem_def
78 : use net_def
79 : use const_def, only: Msun, Rsun
80 : use pgstar_colors
81 :
82 : type (star_info), pointer :: s
83 : integer, intent(in) :: id, device_id
84 : real, intent(in) :: &
85 : winxmin, winxmax, winymin, winymax, xaxis_min, xaxis_max
86 : logical, intent(in) :: subplot
87 : character (len=*), intent(in) :: title, xaxis_name
88 : real, intent(in) :: txt_scale
89 : logical, intent(in) :: &
90 : xaxis_reversed, panel_flag, xaxis_numeric_labels_flag
91 : integer, intent(out) :: ierr
92 :
93 : character (len=strlen) :: yname
94 0 : real, allocatable, dimension(:) :: xvec, yvec, unshifted_xvec
95 0 : real :: xmin, xmax, xleft, xright, dx, windy, &
96 0 : ymin, ymax, xmargin, &
97 0 : legend_xmin, legend_xmax, legend_ymin, legend_ymax
98 : integer :: lw, lw_sav, grid_min, grid_max, npts, nz, num_lines
99 : integer, parameter :: num_colors = 20
100 : integer :: colors(num_colors)
101 :
102 : include 'formats'
103 :
104 0 : ierr = 0
105 :
106 0 : nz = s% nz
107 :
108 0 : num_lines = s% pg% Summary_Profile_num_lines
109 :
110 : colors(:) = [ &
111 : clr_MediumSlateBlue, clr_Goldenrod, clr_LightSkyBlue, clr_Lilac, &
112 : clr_Coral, clr_Crimson, clr_LightSkyGreen, clr_DarkGray, &
113 : clr_Tan, clr_IndianRed, clr_Gold, &
114 : clr_Teal, clr_Silver, clr_BrightBlue, clr_FireBrick, &
115 : clr_RoyalPurple, clr_SlateGray, clr_LightSteelBlue, &
116 0 : clr_Gray, clr_RoyalBlue ]
117 :
118 0 : windy = winymax - winymin
119 :
120 0 : legend_xmin = winxmax - 0.01
121 0 : legend_xmax = 0.99
122 0 : legend_ymin = winymin
123 0 : legend_ymax = winymax
124 :
125 0 : allocate(xvec(nz), yvec(nz),unshifted_xvec(nz))
126 :
127 0 : xmargin = 0
128 : call set_xaxis_bounds( &
129 : s, xaxis_name, xaxis_min, xaxis_max, xaxis_reversed, xmargin, &
130 : xvec, xmin, xmax, xleft, xright, dx, &
131 0 : grid_min, grid_max, npts, ierr)
132 :
133 0 : if (ierr == 0) then
134 0 : call pgsave
135 0 : call pgsch(txt_scale)
136 0 : call plot(ierr)
137 0 : call pgunsa
138 : end if
139 :
140 0 : deallocate(xvec, yvec,unshifted_xvec)
141 :
142 :
143 : contains
144 :
145 :
146 0 : subroutine plot(ierr)
147 0 : use rates_def
148 : use profile_getval, only : get_profile_val,get_profile_id
149 : integer, intent(out) :: ierr
150 :
151 : integer :: j, cnt, k, yaxis_id
152 0 : logical :: show(num_lines)
153 : logical, parameter :: dbg = .false.
154 0 : real :: ybot, yvec_min, yvec_max
155 :
156 : include 'formats'
157 :
158 0 : ymax = 1.02
159 0 : ymin = 0.0
160 :
161 0 : lw = s% pg% pgstar_lw
162 0 : call pgqlw(lw_sav)
163 :
164 0 : call pgsvp(winxmin, winxmax, winymin, winymax)
165 0 : if (.not. panel_flag) then
166 0 : if (.not. subplot) then
167 0 : call show_model_number_pgstar(s)
168 0 : call show_age_pgstar(s)
169 : end if
170 0 : call show_title_pgstar(s, title)
171 : end if
172 :
173 0 : ybot = -0.02
174 0 : call pgswin(xleft, xright, ymin+ybot, ymax)
175 0 : call pgscf(1)
176 0 : call pgsci(clr_Foreground)
177 0 : if (xaxis_numeric_labels_flag) then
178 0 : call show_box_pgstar(s,'BCNST','BCNSTV')
179 : else
180 0 : call show_box_pgstar(s,'BCST','BCNSTV')
181 : end if
182 :
183 0 : do k=1,nz
184 0 : unshifted_xvec(k) = xvec(k)
185 : end do
186 0 : if (grid_min > 1) then
187 0 : do k=1,npts
188 0 : xvec(k) = xvec(k+grid_min-1)
189 : end do
190 : end if
191 :
192 0 : cnt = 0
193 0 : do j = 1, num_lines
194 :
195 0 : yname = s% pg% Summary_Profile_name(j)
196 0 : if (len_trim(yname) == 0 .or. trim(yname) == trim(xaxis_name)) then
197 0 : show(j) = .false.
198 0 : cycle
199 : end if
200 :
201 0 : yaxis_id = get_profile_id(s, yname)
202 0 : if (yaxis_id <= 0) then
203 : write(*,*) &
204 0 : 'bad yaxis for Profile panels plot ' // trim(yname)
205 : return
206 : end if
207 :
208 0 : do k=1,npts
209 0 : yvec(k) = get_profile_val(s, yaxis_id, k+grid_min-1)
210 : end do
211 :
212 0 : if (s% pg% Summary_Profile_scaled_value(j)) then ! scale yvec
213 :
214 0 : yvec_max = maxval(yvec(1:npts))
215 0 : yvec_min = minval(yvec(1:npts))
216 0 : show(j) = (yvec_max > yvec_min)
217 0 : if (.not. show(j)) then
218 : cycle
219 : end if
220 0 : do k=1,npts
221 0 : yvec(k) = (yvec(k) - yvec_min)/(yvec_max - yvec_min)
222 : end do
223 :
224 : else
225 :
226 0 : show(j) = .true.
227 :
228 : end if
229 :
230 0 : call pgslw(lw)
231 0 : cnt = summary_profile_line(cnt, yvec)
232 0 : call pgslw(lw_sav)
233 :
234 : end do
235 :
236 0 : if (.not. panel_flag) then ! show xaxis info
237 0 : call pgsci(clr_Foreground)
238 0 : call show_xaxis_name(s,xaxis_name,ierr)
239 0 : if (ierr == 0) then ! show mix regions at bottom of plot
240 0 : call pgslw(10)
241 : call show_mix_regions_on_xaxis( &
242 0 : s,ymin+ybot,ymax,grid_min,grid_max,unshifted_xvec)
243 : end if
244 : end if
245 :
246 : ! show the legend
247 0 : call pgsave
248 0 : call pgsvp(legend_xmin, legend_xmax, legend_ymin, legend_ymax)
249 0 : call pgswin(0.0, 1.0, ymin, ymax)
250 0 : cnt = 0
251 0 : do j=1,num_lines
252 0 : if (.not. show(j)) cycle
253 0 : if (len_trim(s% pg% Summary_Profile_legend(j)) == 0) then
254 : cnt = summary_profile_line_legend( &
255 0 : cnt,s% pg% Summary_Profile_name(j))
256 : else
257 : cnt = summary_profile_line_legend( &
258 0 : cnt,s% pg% Summary_Profile_legend(j))
259 : end if
260 : end do
261 0 : call pgunsa
262 :
263 : call show_pgstar_decorator(s%id, s% pg% summary_profile_use_decorator, &
264 0 : s% pg% summary_profile_pgstar_decorator, 0, ierr)
265 :
266 :
267 0 : end subroutine plot
268 :
269 :
270 0 : integer function summary_profile_line(cnt, yvec)
271 : integer, intent(in) :: cnt
272 : real, intent(in) :: yvec(:)
273 : integer :: iclr
274 0 : iclr = cnt - num_colors*(cnt/num_colors) + 1
275 0 : summary_profile_line = cnt + 1
276 0 : call pgsci(colors(iclr))
277 0 : call pgline(npts, xvec, yvec)
278 0 : end function summary_profile_line
279 :
280 :
281 0 : integer function summary_profile_line_legend(cnt, name)
282 : integer, intent(in) :: cnt
283 : character (len=*), intent(in) :: name
284 0 : real :: dx, dyline, ypos, xpts(2), ypts(2)
285 : integer :: iclr, num_max
286 0 : num_max = max_num_Summary_Profile_Lines
287 0 : summary_profile_line_legend = cnt
288 0 : iclr = cnt - num_colors*(cnt/num_colors) + 1
289 0 : call pgsci(colors(iclr))
290 0 : dx = 0.1
291 0 : dyline = (ymax-ymin)/num_max
292 0 : ypos = ymax - (cnt+1.5)*dyline
293 0 : xpts(1) = 1.3*dx
294 0 : xpts(2) = xpts(1) + 2.3*dx
295 0 : ypts = ypos + dyline*0.1
296 0 : call pgslw(lw)
297 0 : call pgline(2, xpts, ypts)
298 0 : call pgslw(lw_sav)
299 0 : call pgsci(clr_Foreground)
300 0 : call pgsch(txt_scale*0.70)
301 0 : call pgptxt(xpts(2) + dx, ypos, 0.0, 0.0, name)
302 0 : summary_profile_line_legend = cnt + 1
303 0 : end function summary_profile_line_legend
304 :
305 : end subroutine do_summary_profile_panel
306 :
307 : end module pgstar_summary_profile
|
