Line data Source code
1 : ! ***********************************************************************
2 : !
3 : ! Copyright (C) 2010-2019 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_trho_profile
21 :
22 : use star_private_def
23 : use const_def, only: dp, ln10, pi4, msun
24 : use pgstar_support
25 : use star_pgstar
26 :
27 : implicit none
28 :
29 :
30 : contains
31 :
32 :
33 0 : subroutine TRho_Profile_plot(id, device_id, ierr)
34 : integer, intent(in) :: id, device_id
35 : integer, intent(out) :: ierr
36 : type (star_info), pointer :: s
37 :
38 : ierr = 0
39 0 : call get_star_ptr(id, s, ierr)
40 0 : if (ierr /= 0) return
41 :
42 0 : call pgslct(device_id)
43 0 : call pgbbuf()
44 0 : call pgeras()
45 :
46 : call do_TRho_Profile_plot(s, id, device_id, &
47 : s% pg% TRho_Profile_xleft, s% pg% TRho_Profile_xright, &
48 : s% pg% TRho_Profile_ybot, s% pg% TRho_Profile_ytop, .false., &
49 0 : s% pg% TRho_Profile_title, s% pg% TRho_Profile_txt_scale, ierr)
50 :
51 0 : call pgebuf()
52 :
53 : end subroutine TRho_Profile_plot
54 :
55 :
56 0 : subroutine do_TRho_Profile_plot(s, id, device_id, &
57 : xleft, xright, ybot, ytop, subplot, title, txt_scale_in, ierr)
58 : use utils_lib
59 : use pgstar_colors
60 :
61 : type (star_info), pointer :: s
62 : integer, intent(in) :: id, device_id
63 : real, intent(in) :: xleft, xright, ybot, ytop, txt_scale_in
64 : logical, intent(in) :: subplot
65 : character (len=*), intent(in) :: title
66 : integer, intent(out) :: ierr
67 :
68 : integer :: nz, k
69 0 : real :: xmin, xmax, ymin, ymax, xpos, ypos, dx, dy, &
70 0 : txt_scale, lgT1, lgT2
71 : real, allocatable, dimension(:) :: xvec, yvec
72 : real, parameter :: lgrho1 = -8, lgrho2 = 5
73 :
74 : include 'formats'
75 :
76 0 : ierr = 0
77 0 : nz = s% nz
78 0 : allocate (xvec(nz), yvec(nz))
79 :
80 0 : txt_scale = txt_scale_in
81 :
82 0 : if (s% pg% TRho_switch_to_Column_Depth) then
83 0 : do k=1,nz
84 0 : xvec(k) = safe_log10(s% xmstar*sum(s% dq(1:k-1))/(pi4*s% r(k)*s% r(k)))
85 : end do
86 : else ! log rho
87 0 : do k=1,nz
88 0 : xvec(k) = s% lnd(k)/ln10
89 : end do
90 : end if
91 0 : if (s% pg% TRho_switch_to_mass) then
92 0 : do k = 1, nz
93 0 : xvec(k) = safe_log10((s% xmstar - s% m(k))/Msun)
94 : end do
95 : end if
96 0 : xmin = s% pg% TRho_Profile_xmin
97 0 : xmax = s% pg% TRho_Profile_xmax
98 0 : dx = xmax - xmin
99 :
100 0 : call pgsave
101 0 : call pgsch(txt_scale)
102 :
103 : ! log T
104 0 : do k=1,nz
105 0 : yvec(k) = s% lnT(k)/ln10
106 : end do
107 0 : ymin = s% pg% TRho_Profile_ymin
108 0 : ymax = s% pg% TRho_Profile_ymax
109 0 : dy = ymax - ymin
110 :
111 0 : call pgsvp(xleft, xright, ybot, ytop)
112 0 : call pgswin(xmin, xmax, ymin, ymax)
113 0 : call pgscf(1)
114 0 : call pgsci(clr_Foreground)
115 0 : call show_box_pgstar(s,'BCNST1','BCMNSTV1')
116 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
117 0 : if (s% pg% show_TRho_accretion_mesh_borders) then
118 0 : if(s% pg% TRho_switch_to_mass) then
119 : call do_accretion_mesh_borders(safe_log10((s% xmstar&
120 : - s% m(s% k_const_mass))/Msun), &
121 : safe_log10((s% xmstar&
122 : -s% m( s% k_below_const_q))/Msun), &
123 : safe_log10((s% xmstar&
124 : - s% m( s% k_below_just_added))/Msun),&
125 0 : ymin, ymax)
126 : end if
127 0 : if(s% pg% TRho_switch_to_Column_Depth) then
128 : call do_accretion_mesh_borders(safe_log10(s% xmstar*sum(s% &
129 : dq(1:s% k_const_mass-1))/(pi4*s% r(s% k_const_mass)&
130 : *s% r(s% k_const_mass))), &
131 : safe_log10(s% xmstar*sum(s% &
132 : dq(1:s% k_below_const_q-1))/(pi4*s% r(s% k_below_const_q)&
133 : * s% r(s% k_below_const_q))), &
134 : safe_log10(s% xmstar*sum(s% &
135 : dq(1:s% k_below_just_added-1))/(pi4*s% r(s% k_below_just_added)&
136 : * s% r(s% k_below_just_added))),&
137 0 : ymin, ymax)
138 : end if
139 :
140 0 : if( .not. s% pg% TRho_switch_to_Column_Depth .and. .not. s% pg% TRho_switch_to_mass) then
141 : call do_accretion_mesh_borders( s% lnd(s% k_const_mass)/ln10,&
142 : s% lnd(s% k_below_const_q)/ln10,&
143 : s% lnd(s% k_below_just_added)/ln10,&
144 0 : ymin, ymax)
145 : end if
146 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
147 :
148 : end if
149 0 : if (s% pg% TRho_switch_to_Column_Depth) then
150 0 : call show_xaxis_label_pgstar(s,'log column depth (g cm\u-2\d)')
151 : end if
152 0 : if(.not. s% pg% TRho_switch_to_Column_Depth .and. .not. s% pg% &
153 : TRho_switch_to_mass) then
154 0 : call show_xaxis_label_pgstar(s,'log Density (g cm\u-3\d)')
155 : end if
156 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
157 0 : if(s% pg% TRho_switch_to_mass) then
158 0 : call show_xaxis_label_pgstar(s,'log M - m (Msun)')
159 : end if
160 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
161 0 : call show_left_yaxis_label_pgstar(s,'log Temperature (K)')
162 :
163 0 : if (.not. subplot) then
164 0 : call show_model_number_pgstar(s)
165 0 : call show_age_pgstar(s)
166 : end if
167 0 : call show_title_pgstar(s, title)
168 :
169 0 : if (.not. s% pg% TRho_switch_to_Column_Depth .and. .not. s% pg% TRho_switch_to_mass) then
170 0 : if (s% pg% show_TRho_Profile_kap_regions) call do_kap_regions
171 0 : if (s% pg% show_TRho_Profile_eos_regions) call do_eos_regions
172 : ! for now, show eos regions will imply showing gamma1 4/3 also
173 0 : if (s% pg% show_TRho_Profile_gamma1_4_3rd .or. s% pg% show_TRho_Profile_eos_regions) call do_gamma1_4_3rd
174 0 : if (s% pg% show_TRho_Profile_degeneracy_line) call do_degeneracy_line
175 0 : if (s% pg% show_TRho_Profile_Pgas_Prad_line) call do_Pgas_Prad_line
176 0 : if (s% pg% show_TRho_Profile_burn_lines) call do_burn_lines
177 : end if
178 :
179 :
180 0 : if (len_trim(s% pg% TRho_Profile_fname) > 0) then
181 :
182 0 : call mesa_error(__FILE__,__LINE__,'NEED TO ADD ABILITY TO SHOW EXTRA PROFILE FOR COMPARISON')
183 :
184 : end if
185 :
186 : call show_profile_line(s, xvec, yvec, txt_scale, xmin, xmax, ymin, ymax, &
187 : s% pg% show_TRho_Profile_legend, s% pg% TRho_Profile_legend_coord, &
188 : s% pg% TRho_Profile_legend_disp1, s% pg% TRho_Profile_legend_del_disp, &
189 : s% pg% TRho_Profile_legend_fjust, &
190 0 : s% pg% show_TRho_Profile_mass_locs)
191 :
192 0 : if (s% pg% show_TRho_Profile_text_info) &
193 : call do_show_Profile_text_info( &
194 : s, txt_scale, xmin, xmax, ymin, ymax, &
195 : s% pg% TRho_Profile_text_info_xfac, s% pg% TRho_Profile_text_info_dxfac, &
196 : s% pg% TRho_Profile_text_info_yfac, s% pg% TRho_Profile_text_info_dyfac, &
197 0 : .false., .false.)
198 :
199 : call show_annotations(s, &
200 : s% pg% show_TRho_Profile_annotation1, &
201 : s% pg% show_TRho_Profile_annotation2, &
202 0 : s% pg% show_TRho_Profile_annotation3)
203 :
204 0 : deallocate(xvec, yvec)
205 :
206 : call show_pgstar_decorator(s%id,s% pg% TRho_Profile_use_decorator,&
207 0 : s% pg% TRho_Profile_pgstar_decorator, 0, ierr)
208 :
209 :
210 0 : call pgunsa
211 :
212 :
213 : contains
214 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
215 0 : subroutine do_accretion_mesh_borders(x_Lagrange,x_Eulerian,x_just_added, min_T, max_T)
216 : real(dp), intent(in) :: x_Lagrange,x_Eulerian, x_just_added
217 : real, intent(in) :: min_T, max_T
218 0 : call pgsci(clr_RoyalPurple)
219 0 : call stroke_line(real(x_Lagrange), min_T, real(x_Lagrange), max_T)
220 0 : call pgsci(clr_RoyalBlue)
221 0 : call stroke_line(real(x_Eulerian), min_T, real(x_Eulerian), max_T)
222 0 : call pgsci(clr_Tan)
223 0 : call stroke_line(real(x_just_added), min_T, real(x_just_added), max_T)
224 0 : call pgsci(clr_Gray)
225 0 : end subroutine do_accretion_mesh_borders
226 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
227 :
228 :
229 0 : subroutine do_degeneracy_line
230 0 : call pgsave
231 0 : call pgsch(txt_scale*0.9)
232 0 : call pgsci(clr_Gray)
233 0 : call pgsls(Line_Type_Dash)
234 0 : call pgline(size(psi4_logT), psi4_logRho, psi4_logT)
235 0 : call pgsls(Line_Type_Solid)
236 0 : xpos = -0.2 ! 1.9 ! psi4_logRho(1)
237 0 : ypos = 4 ! 5.9 ! psi4_logT(1)-dy*0.04
238 0 : if (inside(xpos, ypos)) call pgptxt(xpos, ypos, 0.0, 0.5, '\ge\dF\u/kT\(0248)4')
239 0 : call pgunsa
240 0 : end subroutine do_degeneracy_line
241 :
242 :
243 0 : subroutine add_TR_line(logR1, logT1, logR2, logT2)
244 : real, intent(in) :: logR1, logT1, logR2, logT2
245 : real :: logRho1, logRho2
246 0 : logRho1 = logR1 + 3 * logT1 - 18
247 0 : logRho2 = logR2 + 3 * logT2 - 18
248 0 : call pgmove(logRho1, logT1)
249 0 : call pgdraw(logRho2, logT2)
250 0 : end subroutine add_TR_line
251 :
252 :
253 0 : subroutine show_label(xpos, ypos, angle, justification, txt)
254 : real, intent(in) :: xpos, ypos, angle, justification
255 : character (len=*), intent(in) :: txt
256 0 : if (inside(xpos, ypos)) call pgptxt(xpos, ypos, angle, justification, txt)
257 0 : end subroutine show_label
258 :
259 :
260 0 : subroutine do_kap_regions
261 : real :: logT_lo, logT_hi, logT_max
262 : real, parameter :: min_logR_for_freedman = 1
263 : real, parameter :: freg_blend_logT2 = 4.10
264 : real, parameter :: freg_blend_logT1 = 3.93
265 :
266 0 : call pgsave
267 :
268 0 : call pgsci(clr_Coral)
269 0 : call pgsls(Line_Type_Solid)
270 0 : logT_lo = 2.7; logT_hi = 8.7; logT_max = 10.3
271 0 : call add_TR_line(-8.0, logT_lo, -8.0, logT_hi)
272 0 : call add_TR_line(1.0, logT_lo, 1.0, logT_hi)
273 0 : call add_TR_line(1.0, logT_lo, -8.0, logT_lo)
274 0 : call add_TR_line(1.0, logT_hi, -8.0, logT_hi)
275 0 : call add_TR_line(1.0, 2.7, -8.0, 2.7)
276 0 : call add_TR_line(1.0, freg_blend_logT1, -8.0, freg_blend_logT1)
277 0 : call add_TR_line(1.0, freg_blend_logT2, -8.0, freg_blend_logT2)
278 0 : call add_TR_line(1.0, 8.2, -8.0, 8.2)
279 :
280 0 : call pgsci(clr_Foreground)
281 0 : call add_TR_line(-8.0, logT_hi, -8.0, logT_max)
282 0 : call add_TR_line(-8.0, logT_max, 8.0, logT_max)
283 : !call add_TR_line(8.0, logT_lo, 8.0, logT_hi)
284 : !call add_TR_line(1.0, logT_lo, 8.0, logT_lo)
285 :
286 : ! Freedman
287 0 : call pgsci(clr_Tan)
288 0 : call pgmove(-8.8,1.88)
289 0 : call pgdraw(-3.36,1.88)
290 0 : call pgdraw(-1.5,2.5)
291 0 : call pgdraw(-2.6,3.6)
292 0 : call pgdraw(-11.3,3.6)
293 0 : call pgdraw(-9.5,1.88)
294 0 : call pgdraw(-8.8,1.88)
295 :
296 :
297 0 : call pgsci(clr_Foreground)
298 0 : call show_label(-4.9, 2.47, 0.0, 0.5, 'FREEDMAN')
299 0 : call show_label(-8.5, 3.3, 0.0, 0.5, 'FERGUSON')
300 0 : call show_label(-7.5, 5.1, 0.0, 0.5, 'OPAL/OP')
301 0 : call show_label(5.5, 9.0, 0.0, 0.5, 'COMPTON')
302 0 : call show_label(1.8, 8.35, 0.0, 0.5, 'BLEND')
303 0 : call show_label(-8.5, (freg_blend_logT1 + freg_blend_logT2)/2, 0.0, 0.5, 'BLEND')
304 0 : call show_label(0.2, 3.9, 0.0, 1.0, '\(0636)\drad\u = \(0636)\dcond\u')
305 0 : call pgsci(clr_Crimson)
306 0 : call show_label(3.8, 9.4, 0.0, 0.5, 'e\u-\de\u+\d')
307 0 : call pgsci(clr_Foreground)
308 :
309 0 : call show_label(-6.8, 6.9, 0.0, 0.5, 'logR = -8')
310 0 : call show_label(5.0, 6.9, 0.0, 0.5, 'logR = 1')
311 0 : call show_label(2.8, 3.8, 0.0, 0.5, 'logR = 8')
312 :
313 : ! show where electron to baryon ratio is twice that expected
314 0 : call pgsci(clr_Crimson)
315 0 : call pgsls(Line_Type_Dash)
316 0 : call pgline(size(elect_data_logT), elect_data_logRho, elect_data_logT)
317 : ! show where kap_rad == kap_cond
318 0 : call pgsci(clr_LightSkyBlue)
319 0 : call pgsls(Line_Type_Dot)
320 0 : call pgline(size(kap_rad_cond_eq_logT), kap_rad_cond_eq_logRho, kap_rad_cond_eq_logT)
321 0 : call pgunsa
322 0 : end subroutine do_kap_regions
323 :
324 :
325 0 : subroutine do_eos_regions
326 : real :: logRho0, logRho1, logRho2, logRho3, logRho4, logRho5, logRho6
327 : real :: logT1, logT2, logT3, logT4, logT5, logT6
328 :
329 0 : call pgsave
330 :
331 : ! blend from table to non-table
332 0 : call pgsci(clr_LightSkyGreen)
333 0 : call pgsls(Line_Type_Dash)
334 :
335 0 : logT1 = s% eos_rq% logT_min_for_all_Skye
336 0 : logT2 = s% eos_rq% logT_min_for_any_Skye
337 0 : logT3 = 0 ! s% eos_rq% logT_min_FreeEOS_lo
338 0 : logT4 = 0 ! s% eos_rq% logT_min_FreeEOS_lo
339 :
340 0 : logRho1 = s% eos_rq% logRho_min_for_all_Skye
341 0 : logRho2 = s% eos_rq% logRho_min_for_any_Skye
342 0 : logRho3 = s% eos_rq% logQ_min_FreeEOS_lo + 2*logT1 - 12
343 0 : logRho4 = s% eos_rq% logQ_min_FreeEOS_hi + 2*logT2 - 12
344 0 : logRho5 = s% eos_rq% logQ_min_FreeEOS_lo + 2*logT3 - 12
345 0 : logRho6 = s% eos_rq% logQ_min_FreeEOS_hi + 2*logT4 - 12
346 :
347 0 : call stroke_line(logRho1, logT1, logRho3, logT1)
348 0 : call stroke_line(logRho2, logT2, logRho4, logT2)
349 0 : call stroke_line(logRho3, logT1, logRho5, logT3)
350 0 : call stroke_line(logRho4, logT2, logRho6, logT4)
351 :
352 0 : call stroke_line(logRho1, logT1, logRho1, logT3)
353 0 : call stroke_line(logRho2, logT2, logRho2, logT4)
354 :
355 : ! blend from OPAL to SCVH
356 0 : call pgsci(clr_LightSkyBlue)
357 0 : call pgsls(Line_Type_Dot)
358 :
359 0 : logRho0 = logRho1
360 :
361 0 : logT1 = s% eos_rq% logT_cut_FreeEOS_hi
362 0 : logT2 = s% eos_rq% logT_cut_FreeEOS_lo
363 0 : logT3 = s% eos_rq% logT_min_FreeEOS_hi
364 0 : logT4 = s% eos_rq% logT_min_FreeEOS_lo
365 0 : logT5 = 0.5*(logRho0 - s% eos_rq% logQ_max_OPAL_SCVH + 12)
366 0 : logT6 = s% eos_rq% logT_low_all_HELM
367 :
368 0 : logRho1 = s% eos_rq% logQ_cut_lo_Z_FreeEOS_hi + 2*logT1 - 12
369 0 : logRho2 = s% eos_rq% logQ_cut_lo_Z_FreeEOS_lo + 2*logT2 - 12
370 0 : logRho3 = s% eos_rq% logQ_cut_lo_Z_FreeEOS_hi + 2*logT3 - 12
371 0 : logRho4 = s% eos_rq% logQ_cut_lo_Z_FreeEOS_lo + 2*logT4 - 12
372 0 : logRho5 = s% eos_rq% logRho_min_OPAL_SCVH_limit
373 0 : logRho6 = s% eos_rq% logQ_max_OPAL_SCVH + 2*logT6 - 12
374 :
375 0 : call stroke_line(logRho0, logT1, logRho2, logT1)
376 0 : call stroke_line(logRho2, logT1, logRho4, logT3)
377 0 : call stroke_line(logRho4, logT3, logRho5, logT3)
378 :
379 0 : call stroke_line(logRho0, logT2, logRho1, logT2)
380 0 : call stroke_line(logRho1, logT2, logRho3, logT4)
381 0 : call stroke_line(logRho3, logT4, logRho5, logT4)
382 :
383 0 : call stroke_line(logRho0, logT5, logRho6, logT6)
384 0 : call stroke_line(logRho5, logT6, logRho6, logT6)
385 :
386 0 : call pgsci(clr_Foreground)
387 0 : call show_label(1.0, 3.2, 0.0, 0.5, 'HELM')
388 0 : call show_label(-7.2, 5.8, 0.0, 0.5, 'FreeEOS')
389 0 : call show_label(-1.5, 3.7, 0.0, 0.5, 'OPAL/SCVH')
390 0 : call show_label(-1.5, 9.7, 0.0, 0.5, 'HELM/Skye EOS')
391 0 : call show_label(6.0, 4.5, 0.0, 0.5, 'Skye EOS')
392 :
393 0 : call pgunsa
394 0 : end subroutine do_eos_regions
395 :
396 :
397 0 : subroutine do_gamma1_4_3rd
398 0 : call pgsave
399 : ! show where gamma1 = 4/3
400 0 : call pgsci(clr_Gold)
401 0 : call pgsls(Line_Type_Solid)
402 0 : call pgslw(3)
403 0 : call show_label(3.0, 9.3, 0.0, 0.5, '\(0529)\d1\u < 4/3')
404 0 : call pgslw(4)
405 0 : call pgline(size(gamma_4_thirds_logT), gamma_4_thirds_logRho, gamma_4_thirds_logT)
406 0 : call pgunsa
407 0 : end subroutine do_gamma1_4_3rd
408 :
409 :
410 0 : subroutine stroke_line(x1, y1, x2, y2)
411 : real, intent(in) :: x1, y1, x2, y2
412 0 : call pgmove(x1, y1)
413 0 : call pgdraw(x2, y2)
414 : end subroutine stroke_line
415 :
416 :
417 0 : subroutine do_Pgas_Prad_line
418 0 : lgT1 = log10(3.2d7) + (lgRho1 - log10(0.7d0))/3.0
419 0 : lgT2 = log10(3.2d7) + (lgRho2 - log10(0.7d0))/3.0
420 0 : call pgsave
421 0 : call pgsch(txt_scale*0.9)
422 0 : call pgsci(clr_Gray)
423 0 : call pgsls(Line_Type_Dash)
424 0 : call pgmove(lgRho1, lgT1)
425 0 : call pgdraw(lgRho2, lgT2)
426 0 : call pgsls(Line_Type_Solid)
427 0 : xpos = -4 ! lgRho1-dx*0.065
428 0 : ypos = 6.5 ! lgT1-dy*0.025
429 0 : if (inside(xpos, ypos)) call pgptxt(xpos, ypos, 0.0, 0.0, 'P\drad\u\(0248)P\dgas\u')
430 0 : call pgunsa
431 0 : end subroutine do_Pgas_Prad_line
432 :
433 :
434 0 : subroutine do_burn_lines
435 0 : call pgsave
436 0 : call pgsch(txt_scale*0.9)
437 0 : call pgsci(clr_Gray)
438 0 : call pgsls(Line_Type_Dash)
439 0 : call write_burn_line(hydrogen_burn_logRho, hydrogen_burn_logT, 'H burn')
440 0 : call write_burn_line(helium_burn_logRho, helium_burn_logT, 'He burn')
441 0 : call write_burn_line(carbon_burn_logRho, carbon_burn_logT, 'C burn')
442 0 : call write_burn_line(oxygen_burn_logRho, oxygen_burn_logT, 'O burn')
443 0 : call pgsls(Line_Type_Solid)
444 0 : call pgunsa
445 0 : end subroutine do_burn_lines
446 :
447 :
448 0 : logical function inside(xpos, ypos)
449 : real, intent(in) :: xpos, ypos
450 0 : inside = .false.
451 0 : if (xpos <= s% pg% TRho_Profile_xmin .or. xpos >= s% pg% TRho_Profile_xmax) return
452 0 : if (ypos <= s% pg% TRho_Profile_ymin .or. ypos >= s% pg% TRho_Profile_ymax) return
453 0 : inside = .true.
454 : end function inside
455 :
456 :
457 0 : subroutine write_burn_line(logRho, logT, label)
458 : real, dimension(:), allocatable :: logRho, logT
459 : character (len=*), intent(in) :: label
460 : integer :: sz
461 0 : real :: xpos, ypos
462 : character (len=128) :: str
463 0 : sz = size(logRho)
464 0 : call pgline(sz, logRho, logT)
465 0 : if (.not. s% pg% show_TRho_Profile_burn_labels) return
466 0 : xpos = logRho(sz)
467 0 : ypos = logT(sz)
468 0 : if (.not. inside(xpos,ypos)) return
469 0 : write(str,'(a)') trim(label)
470 0 : call pgptxt(xpos, ypos, 0.0, 1.0, trim(adjustl(str)))
471 : end subroutine write_burn_line
472 :
473 :
474 : end subroutine do_TRho_Profile_plot
475 :
476 :
477 0 : subroutine do_show_Profile_text_info( &
478 : s, txt_scale, xmin, xmax, ymin, ymax, xfac, dxfac, yfac, dyfac, &
479 : xaxis_reversed, yaxis_reversed)
480 : use pgstar_colors, only: clr_Foreground
481 : type (star_info), pointer :: s
482 : real, intent(in) :: txt_scale, xmin, xmax, ymin, ymax, xfac, dxfac, yfac, dyfac
483 : logical, intent(in) :: xaxis_reversed, yaxis_reversed
484 :
485 0 : real :: dxpos, xpos0, dxval, ypos, dypos
486 0 : real(dp) :: age
487 : integer :: cnt
488 :
489 : include 'formats'
490 :
491 0 : call pgsave
492 0 : call pgsch(0.7*txt_scale)
493 0 : call pgsci(clr_Foreground)
494 0 : dxpos = 0
495 0 : xpos0 = xmin + xfac*(xmax-xmin)
496 0 : dxval = dxfac*(xmax-xmin)
497 0 : if (xaxis_reversed) dxval = -dxval
498 0 : ypos = ymin + yfac*(ymax-ymin)
499 0 : dypos = dyfac*(ymax-ymin)
500 0 : if (yaxis_reversed) dypos = -dypos
501 :
502 0 : cnt = 0; ypos = ypos + dypos
503 : cnt = write_info_line_flt(cnt, ypos, xpos0, dxpos, dxval, &
504 0 : 'mass', s% star_mass)
505 :
506 0 : cnt = 0; ypos = ypos + dypos
507 : cnt = write_info_line_flt(cnt, ypos, xpos0, dxpos, dxval, &
508 0 : 'H rich', s% star_mass - s% he_core_mass)
509 :
510 0 : cnt = 0; ypos = ypos + dypos
511 : cnt = write_info_line_flt(cnt, ypos, xpos0, dxpos, dxval, &
512 0 : 'He core', s% he_core_mass)
513 :
514 0 : cnt = 0; ypos = ypos + dypos
515 : cnt = write_info_line_flt(cnt, ypos, xpos0, dxpos, dxval, &
516 0 : 'CO core', s% co_core_mass)
517 :
518 0 : cnt = 0; ypos = ypos + dypos
519 : cnt = write_info_line_flt(cnt, ypos, xpos0, dxpos, dxval, &
520 0 : 'lg mdot', safe_log10(abs(s% star_mdot)))
521 :
522 0 : cnt = 0; ypos = ypos + dypos
523 : cnt = write_info_line_flt2(cnt, ypos, xpos0, dxpos, dxval, &
524 0 : 'Teff', s% Teff)
525 :
526 0 : cnt = 0; ypos = ypos + dypos
527 : cnt = write_info_line_flt(cnt, ypos, xpos0, dxpos, dxval, &
528 0 : 'lg L', s% log_surface_luminosity)
529 :
530 0 : cnt = 0; ypos = ypos + dypos
531 : cnt = write_info_line_flt(cnt, ypos, xpos0, dxpos, dxval, &
532 0 : 'lg LH', safe_log10(s% power_h_burn))
533 :
534 0 : cnt = 0; ypos = ypos + dypos
535 : cnt = write_info_line_flt(cnt, ypos, xpos0, dxpos, dxval, &
536 0 : 'lg LHe', safe_log10(s% power_he_burn))
537 :
538 0 : cnt = 0; ypos = ypos + dypos
539 : cnt = write_info_line_flt(cnt, ypos, xpos0, dxpos, dxval, &
540 0 : 'lg R', s% log_surface_radius)
541 :
542 0 : cnt = 0; ypos = ypos + dypos
543 : cnt = write_info_line_flt(cnt, ypos, xpos0, dxpos, dxval, &
544 0 : 'max lg T', s% log_max_temperature)
545 :
546 0 : cnt = 0; ypos = ypos + dypos
547 : cnt = write_info_line_exp(cnt, ypos, xpos0, dxpos, dxval, &
548 0 : 'lg dt yr', log10(s% time_step))
549 :
550 0 : cnt = 0; ypos = ypos + dypos
551 0 : age = s% star_age
552 0 : if (s% pg% pgstar_show_age_in_seconds) then
553 : cnt = write_info_line_exp(cnt, ypos, xpos0, dxpos, dxval, &
554 0 : 'age sec', age*secyer)
555 : else
556 : cnt = write_info_line_exp(cnt, ypos, xpos0, dxpos, dxval, &
557 0 : 'age yr', age)
558 : end if
559 :
560 0 : call pgunsa
561 :
562 0 : end subroutine do_show_Profile_text_info
563 :
564 :
565 : end module pgstar_trho_profile
566 :
|
