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_HR
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 :
30 : contains
31 :
32 :
33 0 : subroutine HR_Plot(id, device_id, ierr)
34 : integer, intent(in) :: id, device_id
35 : integer, intent(out) :: ierr
36 : type (star_info), pointer :: s
37 : ierr = 0
38 0 : call get_star_ptr(id, s, 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_HR_Plot(s, id, device_id, &
46 : s% pg% HR_xleft, s% pg% HR_xright, &
47 : s% pg% HR_ybot, s% pg% HR_ytop, .false., &
48 0 : s% pg% HR_title, s% pg% HR_txt_scale, ierr)
49 0 : if (ierr /= 0) return
50 :
51 0 : call pgebuf()
52 :
53 : end subroutine HR_Plot
54 :
55 :
56 0 : subroutine HR_decorate(id, ierr)
57 : use pgstar_colors
58 : integer, intent(in) :: id
59 : integer, intent(out) :: ierr
60 : type (star_info), pointer :: s
61 0 : real :: logT1, logT2, logL1, logL2
62 : ierr = 0
63 0 : call get_star_ptr(id, s, ierr)
64 0 : if (ierr /= 0) return
65 0 : if (s% pg% show_HR_Mira_instability_region) then
66 0 : logL1 = 2.8
67 0 : logL2 = 4.0
68 0 : logT2 = 3.7
69 0 : logT1 = 3.45
70 :
71 0 : call pgsls(Line_Type_Solid)
72 0 : call pgslw(s% pg% pgstar_lw)
73 0 : call pgsci(clr_Blue)
74 0 : call pgmove(logT1, logL1)
75 0 : call pgdraw(logT1, logL2)
76 0 : call pgdraw(logT2, logL2)
77 0 : call pgdraw(logT2, logL1)
78 0 : call pgdraw(logT1, logL1)
79 : end if
80 0 : if (s% pg% show_HR_classical_instability_strip) then
81 :
82 0 : call pgsls(Line_Type_Solid)
83 0 : call pgslw(s% pg% pgstar_lw)
84 :
85 : ! approximate edges
86 :
87 : ! blue edge
88 0 : logT1 = 3.70
89 0 : logL1 = 5.5
90 :
91 0 : logT2 = 3.93
92 0 : logL2 = 1.0
93 :
94 0 : call pgsci(clr_Blue)
95 0 : call pgmove(logT1, logL1)
96 0 : call pgdraw(logT2, logL2)
97 :
98 : ! red edge
99 0 : logT1 = 3.60
100 0 : logL1 = 5.5
101 :
102 0 : logT2 = 3.83
103 0 : logL2 = 1.0
104 :
105 0 : call pgsci(clr_FireBrick)
106 0 : call pgmove(logT1, logL1)
107 0 : call pgdraw(logT2, logL2)
108 : end if
109 0 : if (s% pg% show_HR_WD_instabilities) then
110 : ! from Winget & Kepler, Annu. Rev. Astron. Astrophys., 2008, Fig 3.
111 0 : call pgsave
112 0 : call pgsls(Line_Type_Solid)
113 0 : call pgslw(s% pg% pgstar_lw)
114 0 : call pgsci(clr_Silver)
115 0 : call pgmove(5.1, 4.3) ! DOV
116 0 : call pgdraw(4.8, 0.3)
117 0 : call pgdraw(4.95, 0.9)
118 0 : call pgdraw(5.38, 4.2)
119 0 : call pgdraw(5.1, 4.3)
120 0 : call pgmove(4.42, -0.7) ! DBV
121 0 : call pgdraw(4.34, -1.2)
122 0 : call pgdraw(4.38, -1.7)
123 0 : call pgdraw(4.45, -1.4)
124 0 : call pgdraw(4.42, -0.7)
125 0 : call pgmove(4.03, -2.4) ! DAV
126 0 : call pgdraw(4.03, -3.4)
127 0 : call pgdraw(4.1, -3.2)
128 0 : call pgdraw(4.1, -2.2)
129 0 : call pgdraw(4.03, -2.4)
130 0 : call pgsch(s% pg% HR_txt_scale*0.7)
131 0 : call pgslw(1)
132 0 : call pgptxt(5.1 - 0.05, 4.3, 0.0, 0.0, 'DOV')
133 0 : call pgptxt(4.42 - 0.05, -0.7, 0.0, 0.0, 'DBV')
134 0 : call pgptxt(4.03 - 0.05, -2.4, 0.0, 0.0, 'DAV')
135 0 : call pgunsa
136 : end if
137 : end subroutine HR_decorate
138 :
139 :
140 0 : subroutine do_HR_Plot(s, id, device_id, &
141 : xleft, xright, ybot, ytop, subplot, &
142 : title, txt_scale, ierr)
143 : use pgstar_hist_track, only: do_Hist_Track
144 : type (star_info), pointer :: s
145 : integer, intent(in) :: id, device_id
146 : real, intent(in) :: xleft, xright, ybot, ytop, txt_scale
147 : logical, intent(in) :: subplot
148 : character (len=*), intent(in) :: title
149 : integer, intent(out) :: ierr
150 : logical, parameter :: &
151 : reverse_xaxis = .true., reverse_yaxis = .false.
152 : ierr = 0
153 : call do_Hist_Track(s, id, device_id, &
154 : xleft, xright, ybot, ytop, subplot, title, txt_scale, &
155 : 'log_Teff', 'log_L', &
156 : 'log Teff', 'log L/L\d\(2281)', &
157 : s% pg% HR_logT_min, s% pg% HR_logT_max, &
158 : s% pg% HR_logT_margin, s% pg% HR_dlogT_min, &
159 : s% pg% HR_logL_min, s% pg% HR_logL_max, &
160 : s% pg% HR_logL_margin, s% pg% HR_dlogL_min, &
161 : s% pg% HR_step_min, s% pg% HR_step_max, &
162 : reverse_xaxis, reverse_yaxis, .false., .false., &
163 : s% pg% show_HR_target_box, s% pg% HR_target_n_sigma, &
164 : s% pg% HR_target_logT, s% pg% HR_target_logL, &
165 : s% pg% HR_target_logT_sigma, s% pg% HR_target_logL_sigma, &
166 : s% pg% show_HR_annotation1, &
167 : s% pg% show_HR_annotation2, &
168 : s% pg% show_HR_annotation3, &
169 : s% pg% HR_fname, &
170 : s% pg% HR_use_decorator, &
171 : s% pg% HR_pgstar_decorator, &
172 0 : HR_decorate, ierr)
173 0 : end subroutine do_HR_Plot
174 :
175 :
176 : end module pgstar_HR
177 :
|