Line data Source code
1 : ! ***********************************************************************
2 : !
3 : ! Copyright (C) 2015-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 : module pgstar_network
20 :
21 : use star_private_def
22 : use const_def, only: dp
23 : use pgstar_support
24 : use star_pgstar
25 : use pgstar_colors
26 :
27 : implicit none
28 : private
29 :
30 : public :: network_plot, do_network_plot
31 :
32 : contains
33 :
34 0 : subroutine network_plot(id, device_id, ierr)
35 : integer, intent(in) :: id, device_id
36 : integer, intent(out) :: ierr
37 :
38 : type (star_info), pointer :: s
39 :
40 : ierr = 0
41 0 : call get_star_ptr(id, s, ierr)
42 0 : if (ierr /= 0) return
43 :
44 0 : call pgslct(device_id)
45 0 : call pgbbuf()
46 0 : call pgeras()
47 :
48 : call do_Network_plot(s, id, device_id, &
49 : s% pg% Network_xleft, s% pg% Network_xright, &
50 : s% pg% Network_ybot, s% pg% Network_ytop, .false., &
51 0 : s% pg% Network_title, s% pg% Network_txt_scale, ierr)
52 :
53 0 : call pgebuf()
54 :
55 : end subroutine network_plot
56 :
57 :
58 0 : subroutine do_network_plot(s, id, device_id, &
59 : winxmin, winxmax, winymin, winymax, subplot, &
60 : title, txt_scale, ierr)
61 : type (star_info), pointer :: s
62 : integer, intent(in) :: id, device_id
63 : real, intent(in) :: winxmin, winxmax, winymin, winymax
64 : logical, intent(in) :: subplot
65 : character (len=*), intent(in) :: title
66 : real, intent(in) :: txt_scale
67 : integer, intent(out) :: ierr
68 : call do_network_panel(s, id, device_id, &
69 : winxmin, winxmax, winymin, winymax, subplot, &
70 0 : title, txt_scale, ierr)
71 0 : end subroutine do_network_plot
72 :
73 :
74 0 : subroutine do_network_panel(s, id, device_id, &
75 : winxmin, winxmax, winymin, winymax, subplot, title, txt_scale, &
76 : ierr)
77 : use utils_lib
78 : use chem_def
79 : use net_def
80 : use const_def, only: Msun
81 :
82 : type (star_info), pointer :: s
83 : integer, intent(in) :: id, device_id
84 : real, intent(in) :: &
85 : winxmin, winxmax, winymin, winymax
86 : character (len=*), intent(in) :: title
87 : real, intent(in) :: txt_scale
88 : logical, intent(in) :: subplot
89 : integer, intent(out) :: ierr
90 :
91 0 : real :: xleft, xright, chScale, xmargin
92 :
93 : include 'formats'
94 : ierr = 0
95 :
96 0 : chScale = txt_scale
97 :
98 0 : xmargin = 0
99 0 : call plot(ierr)
100 :
101 :
102 : contains
103 :
104 0 : subroutine plot(ierr)
105 0 : use chem_def
106 : integer, intent(out) :: ierr
107 :
108 : integer :: i, j
109 :
110 : integer :: z,n,zmax,zmin,nmin,nmax
111 : integer :: clr,mid_map
112 0 : real :: abun,xhigh,xlow
113 0 : real :: ymin,ymax,log10_min_abun,log10_max_abun
114 : real,parameter :: pad=2.5,step=0.5
115 :
116 : include 'formats'
117 0 : ierr = 0
118 :
119 0 : call pgsave
120 0 : call pgsch(txt_scale)
121 0 : call pgsvp(winxmin, winxmax, winymin, winymax)
122 :
123 0 : zmax=0
124 0 : nmax=0
125 0 : zmin=HUGE(zmin)
126 0 : nmin=HUGE(nmin)
127 :
128 :
129 0 : log10_min_abun=s% pg% Network_log_mass_frac_min
130 0 : log10_max_abun=s% pg% Network_log_mass_frac_max
131 :
132 0 : do i=1,s%species
133 :
134 0 : Z=chem_isos%Z(s%chem_id(i))
135 0 : N=chem_isos%N(s%chem_id(i))
136 :
137 0 : zmax=max(Z,zmax)
138 0 : nmax=max(n,nmax)
139 :
140 0 : zmin=min(Z,zmin)
141 0 : nmin=min(n,nmin)
142 :
143 : end do
144 :
145 0 : if (s% pg% network_zmax > -100) then
146 : ymax = s% pg% network_zmax
147 : else
148 0 : ymax = zmax
149 : end if
150 :
151 0 : if (s% pg% network_zmin > -100) then
152 : ymin = s% pg% network_zmin
153 : else
154 0 : ymin = zmin
155 : end if
156 :
157 0 : if (s% pg% network_nmax > -100) then
158 0 : xright = s% pg% network_nmax
159 : else
160 0 : xright= nmax
161 : end if
162 :
163 0 : if (s% pg% network_nmin > -100) then
164 0 : xleft = s% pg% network_nmin
165 : else
166 0 : xleft = nmin
167 : end if
168 :
169 : !Set xaxis and yaxis bounds
170 0 : call pgswin(xleft-5,xright+pad,ymin-pad,ymax+pad)
171 : !Create a box with ticks
172 0 : call show_box_pgstar(s,'BCNST','BCNSTV')
173 : !Labels
174 0 : call show_xaxis_name(s,'N',ierr)
175 0 : call show_left_yaxis_label_pgstar(s,'Z',-1.5)
176 :
177 0 : if (.not. subplot) then
178 0 : call show_model_number_pgstar(s)
179 0 : call show_age_pgstar(s)
180 : end if
181 0 : call show_title_pgstar(s, title)
182 :
183 0 : mid_map = colormap_length/2
184 0 : do i=1,s%species
185 :
186 0 : Z=chem_isos%Z(s%chem_id(i))
187 0 : N=chem_isos%N(s%chem_id(i))
188 : abun=(dot_product(s%xa(i,1:s%nz),s%dm(1:s%nz))/msun)/&
189 0 : ((s%star_mass)-(s%m_center/msun))
190 :
191 0 : abun=safe_log10(dble(abun))
192 :
193 0 : if(z<ymin .or. z>ymax .or. n<xleft .or.n>xright)CYCLE
194 :
195 0 : if (s% pg% Network_show_element_names) THEN
196 0 : call pgsci(clr_Foreground)
197 0 : call pgtext(xleft-3.5,z*1.0-0.25,el_name(Z))
198 : end if
199 :
200 : !Plot colored dots for mass fractions
201 0 : if(s% pg% Network_show_mass_fraction) then
202 0 : if(abun>log10_min_abun .and. abun < log10_max_abun)THEN
203 0 : do j=mid_map,colormap_length
204 0 : xlow=log10_min_abun+(j-mid_map)*(log10_max_abun-log10_min_abun)/(colormap_length-mid_map)
205 0 : xhigh=log10_min_abun+(j-mid_map+1)*(log10_max_abun-log10_min_abun)/(colormap_length-mid_map)
206 0 : if(abun>=xlow .and. abun<xhigh)THEN
207 0 : clr = colormap_offset + (colormap_length-(j-mid_map))
208 0 : call pgsci(clr)
209 : end if
210 : end do
211 :
212 0 : call pgrect(n-step,n+step,z-step,z+step)
213 : end if
214 : end if
215 :
216 : !Plot box centered on the (N,Z)
217 0 : call pgsci(clr_Foreground)
218 0 : call pgline(5,[n-step,n+step,n+step,n-step,n-step],[z-step,z-step,z+step,z+step,z-step])
219 : end do
220 :
221 0 : call pgunsa
222 :
223 0 : if(s% pg% network_show_colorbar)then
224 0 : call network_colorbar_legend(winxmin, winxmax, winymin, winymax,log10_min_abun,log10_max_abun)
225 : end if
226 :
227 0 : call show_pgstar_decorator(s%id,s% pg% network_use_decorator,s% pg% network_pgstar_decorator, 0, ierr)
228 :
229 :
230 0 : end subroutine plot
231 :
232 :
233 : end subroutine do_network_panel
234 :
235 :
236 0 : subroutine network_colorbar_legend(winxmin, winxmax, winymin, winymax,abun_min,abun_max)
237 : real,intent(in) :: winxmin, winxmax, winymin, winymax,abun_min,abun_max
238 : real :: legend_xmin,legend_xmax,legend_ymin,legend_ymax
239 0 : real :: xmin,xmax,ymin,ymax
240 0 : real :: dx, dyline, xpts(2),yt,yb,text
241 : character(len=16) :: str
242 :
243 : integer :: i,j,clr,mid_map,num_cms
244 :
245 0 : call PGQWIN(xmin, xmax, ymin, ymax)
246 :
247 0 : legend_xmin = winxmax - 0.01
248 0 : legend_xmax = 0.99
249 0 : legend_ymin = winymin
250 0 : legend_ymax = winymax
251 :
252 0 : mid_map = colormap_length/2
253 0 : num_cms=colormap_length-mid_map
254 0 : dyline = (ymax-ymin)/num_cms
255 0 : dx = 0.1
256 :
257 0 : xpts(1) = 2.0*dx
258 0 : xpts(2) = xpts(1) + 2.0*dx
259 :
260 0 : call pgsave
261 0 : call pgsvp(legend_xmin, legend_xmax, legend_ymin, legend_ymax)
262 0 : call pgswin(0.0, 1.0, ymin, ymax)
263 0 : do j=mid_map,colormap_length
264 0 : i=j-mid_map
265 0 : clr = colormap_offset + (colormap_length-i+1)
266 0 : call pgsci(clr)
267 0 : yt = ymin + (i)*dyline
268 0 : yb = ymin + (i-1)*dyline
269 :
270 0 : call pgrect(xpts(1),xpts(2),yb,yt)
271 : end do
272 :
273 0 : call pgsci(clr_Foreground)
274 0 : do j=1,5
275 0 : text=abun_min+(j-1)*(abun_max-abun_min)/4.0
276 0 : write(str,'(F8.3)') text
277 0 : call pgptxt(xpts(2) + 0.025, ymin+(j-1)*(ymax-ymin)/4.0, 0.0, 0.0, trim(str))
278 : end do
279 :
280 0 : call pgunsa
281 :
282 0 : end subroutine network_colorbar_legend
283 :
284 : end module pgstar_network
|
