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_mode_prop
21 :
22 : use star_private_def
23 : use const_def, only: dp, pi, msun, rsun
24 : use pgstar_support
25 : use star_pgstar
26 :
27 : implicit none
28 :
29 : contains
30 :
31 0 : subroutine mode_propagation_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_mode_propagation_plot(s, id, device_id, &
45 : s% pg% Mode_Prop_xleft, s% pg% Mode_Prop_xright, &
46 : s% pg% Mode_Prop_ybot, s% pg% Mode_Prop_ytop, .false., &
47 0 : s% pg% Mode_Prop_title, s% pg% Mode_Prop_txt_scale, ierr)
48 :
49 0 : call pgebuf()
50 :
51 : end subroutine mode_propagation_plot
52 :
53 :
54 0 : subroutine do_mode_propagation_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_mode_propagation_panel(s, id, device_id, &
64 : winxmin, winxmax, winymin, winymax, subplot, &
65 : title, txt_scale, s% pg% Mode_Prop_xaxis_name, &
66 : s% pg% Mode_Prop_xmin, s% pg% Mode_Prop_xmax, &
67 0 : s% pg% Mode_Prop_xaxis_reversed, .false., .true., ierr)
68 0 : end subroutine do_mode_propagation_plot
69 :
70 :
71 0 : subroutine do_mode_propagation_panel(s, id, device_id, &
72 : winxmin, winxmax, winymin, winymax, subplot, title, txt_scale, &
73 : xaxis_name, xaxis_min, xaxis_max, xaxis_reversed, &
74 : panel_flag, xaxis_numeric_labels_flag, ierr)
75 : use utils_lib
76 : use chem_def
77 : use net_def
78 : use pgstar_colors
79 :
80 : type (star_info), pointer :: s
81 : integer, intent(in) :: id, device_id
82 : real, intent(in) :: &
83 : winxmin, winxmax, winymin, winymax, xaxis_min, xaxis_max
84 : logical, intent(in) :: subplot
85 : character (len=*), intent(in) :: title, xaxis_name
86 : real, intent(in) :: txt_scale
87 : logical, intent(in) :: &
88 : xaxis_reversed, panel_flag, xaxis_numeric_labels_flag
89 : integer, intent(out) :: ierr
90 :
91 : real, allocatable, dimension(:) :: xvec, log_brunt_nu, &
92 : log_lamb_Sl1, log_lamb_Sl2, log_lamb_Sl3, temp_vec
93 0 : real :: xmin, xmax, xleft, xright, dx, chScale, windy, &
94 0 : ymin, ymax, xmargin, &
95 : legend_xmin, legend_xmax, legend_ymin, legend_ymax
96 : integer :: lw, lw_sav, grid_min, grid_max, npts, nz
97 : integer, parameter :: num_colors = 20
98 : integer :: colors(num_colors)
99 :
100 : include 'formats'
101 :
102 0 : ierr = 0
103 0 : if (.not. s% calculate_Brunt_N2) &
104 0 : call mesa_error(__FILE__,__LINE__,'pgstar mode_propagation: must have calculate_Brunt_N2 = .true.')
105 :
106 0 : nz = s% nz
107 :
108 : colors(:) = [ &
109 : clr_MediumSlateBlue, clr_Goldenrod, clr_LightSkyBlue, clr_Lilac, &
110 : clr_Coral, clr_Crimson, clr_LightSkyGreen, clr_DarkGray, &
111 : clr_Tan, clr_IndianRed, clr_Gold, &
112 : clr_Teal, clr_Silver, clr_BrightBlue, clr_FireBrick, &
113 : clr_RoyalPurple, clr_SlateGray, clr_LightSteelBlue, &
114 0 : clr_Gray, clr_RoyalBlue ]
115 :
116 0 : chScale = txt_scale
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 : allocate (xvec(nz), log_brunt_nu(nz), &
126 0 : log_lamb_Sl1(nz), log_lamb_Sl2(nz), log_lamb_Sl3(nz), temp_vec(nz))
127 :
128 0 : xmargin = 0
129 : call set_xaxis_bounds( &
130 : s, xaxis_name, xaxis_min, xaxis_max, xaxis_reversed, xmargin, &
131 : xvec, xmin, xmax, xleft, xright, dx, &
132 0 : grid_min, grid_max, npts, ierr)
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, log_brunt_nu, &
141 0 : log_lamb_Sl1, log_lamb_Sl2, log_lamb_Sl3, temp_vec)
142 :
143 : contains
144 :
145 :
146 0 : subroutine plot(ierr)
147 0 : use rates_def
148 : integer, intent(out) :: ierr
149 :
150 : integer :: cnt, k
151 : logical, parameter :: dbg = .false.
152 0 : real :: ybot, nu_max, lg_nu_max, lg_2pt0_nu_max, lg_0pt5_nu_max, lg_nu_max_obs
153 : real, parameter :: teff_sun = 5777.0, nu_max_sun = 3100.0
154 :
155 : include 'formats'
156 :
157 0 : do k=grid_min,grid_max
158 0 : log_brunt_nu(k) = safe_log10((1d6/(2*pi))*sqrt(max(0d0,s% brunt_N2(k))))
159 0 : log_lamb_Sl1(k) = safe_log10((1d6/(2*pi))*sqrt(2d0)*s% csound_face(k)/s% r(k))
160 0 : log_lamb_Sl2(k) = safe_log10((1d6/(2*pi))*sqrt(6d0)*s% csound_face(k)/s% r(k))
161 0 : log_lamb_Sl3(k) = safe_log10((1d6/(2*pi))*sqrt(12d0)*s% csound_face(k)/s% r(k))
162 : end do
163 :
164 0 : nu_max = nu_max_sun*s% star_mass/(pow2(s% photosphere_r)*sqrt(s% Teff/teff_sun))
165 0 : lg_nu_max = log10(dble(nu_max))
166 0 : lg_2pt0_nu_max = log10(dble(2.0*nu_max))
167 0 : lg_0pt5_nu_max = log10(dble(0.5*nu_max))
168 0 : lg_nu_max_obs = safe_log10(dble(s% pg% Mode_Prop_nu_max_obs))
169 :
170 0 : ymax = max(1.33*lg_2pt0_nu_max, maxval(log_brunt_nu(grid_min:grid_max)))
171 0 : ymin = 0.5*lg_0pt5_nu_max
172 0 : ymax = ymax + 0.1*(ymax-ymin)
173 :
174 0 : if (s% pg% Mode_Prop_ymax /= -101) ymax = s% pg% Mode_Prop_ymax
175 0 : if (s% pg% Mode_Prop_ymin /= -101) ymin = s% pg% Mode_Prop_ymin
176 :
177 0 : lw = s% pg% pgstar_lw
178 0 : call pgqlw(lw_sav)
179 :
180 0 : call pgsave
181 0 : call pgsvp(legend_xmin, legend_xmax, legend_ymin, legend_ymax)
182 0 : call pgswin(0.0, 1.0, ymin, ymax)
183 0 : cnt = 0
184 0 : cnt = mode_propagation_line_legend(cnt,'N\dBV\u')
185 0 : cnt = mode_propagation_line_legend(cnt,'S\dl=1\u')
186 0 : cnt = mode_propagation_line_legend(cnt,'S\dl=2\u')
187 0 : cnt = mode_propagation_line_legend(cnt,'S\dl=3\u')
188 0 : cnt = mode_propagation_line_legend(cnt,'2\(2723)\(2139)\dmax\u')
189 0 : cnt = mode_propagation_line_legend(cnt,'\(2139)\dmax\u')
190 0 : call pgsls(4) ! dotted
191 0 : cnt = mode_propagation_line_legend(cnt,'\(2139)\dmax\uobs')
192 0 : call pgsls(1) ! solid
193 0 : cnt = mode_propagation_line_legend(cnt,'0.5\(2723)\(2139)\dmax\u')
194 0 : call pgunsa
195 :
196 0 : call pgsave
197 0 : call pgsvp(winxmin, winxmax, winymin, winymax)
198 0 : if (.not. panel_flag) then
199 0 : if (.not. subplot) then
200 0 : call show_model_number_pgstar(s)
201 0 : call show_age_pgstar(s)
202 : end if
203 0 : call show_title_pgstar(s, title)
204 : end if
205 :
206 0 : ybot = -0.05
207 0 : call pgswin(xleft, xright, ymin+ybot, ymax)
208 0 : call pgscf(1)
209 0 : call pgsci(clr_Foreground)
210 0 : if (xaxis_numeric_labels_flag) then
211 0 : call show_box_pgstar(s,'BCNST','BCNSTV')
212 : else
213 0 : call show_box_pgstar(s,'BCST','BCNSTV')
214 : end if
215 0 : call show_left_yaxis_label_pgstar(s,'log \(2139) (\(2138)Hz)')
216 :
217 0 : call pgslw(lw)
218 0 : cnt = 0
219 0 : cnt = mode_propagation_line(cnt, log_brunt_nu)
220 0 : cnt = mode_propagation_line(cnt, log_lamb_Sl1)
221 0 : cnt = mode_propagation_line(cnt, log_lamb_Sl2)
222 0 : cnt = mode_propagation_line(cnt, log_lamb_Sl3)
223 0 : temp_vec(1:nz) = lg_2pt0_nu_max
224 0 : cnt = mode_propagation_line(cnt, temp_vec)
225 0 : temp_vec(1:nz) = lg_nu_max
226 0 : cnt = mode_propagation_line(cnt, temp_vec)
227 0 : call pgsls(4) ! dotted
228 0 : temp_vec(1:nz) = lg_nu_max_obs
229 0 : cnt = mode_propagation_line(cnt, temp_vec)
230 0 : call pgsls(1) ! solid
231 0 : temp_vec(1:nz) = lg_0pt5_nu_max
232 0 : cnt = mode_propagation_line(cnt, temp_vec)
233 0 : call pgslw(lw_sav)
234 :
235 0 : if (.not. panel_flag) then
236 0 : call pgsci(clr_Foreground)
237 0 : call show_xaxis_name(s,xaxis_name,ierr)
238 0 : if (ierr == 0) then ! show mix regions at bottom of plot
239 0 : call pgslw(10)
240 : call show_mix_regions_on_xaxis( &
241 0 : s,ymin+ybot,ymax,grid_min,grid_max,xvec)
242 : end if
243 : end if
244 :
245 0 : call pgunsa
246 :
247 : call show_pgstar_decorator(s%id,s% pg% mode_prop_use_decorator,&
248 0 : s% pg% mode_prop_pgstar_decorator, 0, ierr)
249 :
250 :
251 0 : end subroutine plot
252 :
253 :
254 0 : integer function mode_propagation_line(cnt, yvec)
255 : integer, intent(in) :: cnt
256 : real, intent(in) :: yvec(:)
257 : integer :: iclr
258 0 : iclr = cnt - num_colors*(cnt/num_colors) + 1
259 0 : mode_propagation_line = cnt + 1
260 0 : call pgsci(colors(iclr))
261 0 : call pgline(npts, xvec(grid_min:grid_max), yvec(grid_min:grid_max))
262 0 : end function mode_propagation_line
263 :
264 :
265 0 : integer function mode_propagation_line_legend(cnt, name)
266 : integer, intent(in) :: cnt
267 : character (len=*), intent(in) :: name
268 0 : real :: dx, dyline, ypos, xpts(2), ypts(2)
269 : integer :: iclr, num_max
270 0 : num_max = 10
271 0 : mode_propagation_line_legend = cnt
272 0 : iclr = cnt - num_colors*(cnt/num_colors) + 1
273 0 : call pgsci(colors(iclr))
274 0 : dx = 0.1
275 0 : dyline = (ymax-ymin)/num_max
276 0 : ypos = ymax - (cnt+1.5)*dyline
277 0 : xpts(1) = 1.3*dx
278 0 : xpts(2) = xpts(1) + 2.3*dx
279 0 : ypts = ypos + dyline*0.1
280 0 : call pgslw(lw)
281 0 : call pgline(2, xpts, ypts)
282 0 : call pgslw(lw_sav)
283 0 : call pgsci(clr_Foreground)
284 0 : call pgsch(txt_scale*0.70)
285 0 : call pgptxt(xpts(2) + dx, ypos, 0.0, 0.0, name)
286 0 : mode_propagation_line_legend = cnt + 1
287 0 : end function mode_propagation_line_legend
288 :
289 : end subroutine do_mode_propagation_panel
290 :
291 : end module pgstar_mode_prop
|
