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_Color_Magnitude
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 Color_Magnitude1_plot(id, device_id, ierr)
32 : integer, intent(in) :: id, device_id
33 : integer, intent(out) :: ierr
34 : type (star_info), pointer :: s
35 : ierr = 0
36 0 : call get_star_ptr(id, s, ierr)
37 0 : if (ierr /= 0) return
38 0 : call pgslct(device_id)
39 0 : call pgbbuf()
40 0 : call pgeras()
41 : call do_Color_Magnitude1_plot(s, id, device_id, &
42 : s% pg% Color_Magnitude1_xleft, s% pg% Color_Magnitude1_xright, &
43 : s% pg% Color_Magnitude1_ybot, s% pg% Color_Magnitude1_ytop, .false., &
44 0 : s% pg% Color_Magnitude1_title, s% pg% Color_Magnitude1_txt_scale, ierr)
45 0 : if (ierr /= 0) return
46 0 : call pgebuf()
47 : end subroutine Color_Magnitude1_plot
48 :
49 :
50 0 : subroutine do_Color_Magnitude1_plot(s, id, device_id, &
51 : vp_xleft, vp_xright, vp_ybot, vp_ytop, subplot, title, txt_scale, ierr)
52 : type (star_info), pointer :: s
53 : integer, intent(in) :: id, device_id
54 : real, intent(in) :: vp_xleft, vp_xright, vp_ybot, vp_ytop, txt_scale
55 : logical, intent(in) :: subplot
56 : character (len=*), intent(in) :: title
57 : integer, intent(out) :: ierr
58 : call do_Color_Magnitude_plot( &
59 : id, s, device_id, &
60 : vp_xleft, vp_xright, vp_ybot, vp_ytop, subplot, title, txt_scale, &
61 : s% pg% Color_Magnitude1_xaxis1_name, &
62 : s% pg% Color_Magnitude1_xaxis2_name, &
63 : s% pg% Color_Magnitude1_xmin, &
64 : s% pg% Color_Magnitude1_xmax, &
65 : s% pg% Color_Magnitude1_dxmin, &
66 : s% pg% Color_Magnitude1_xmargin, &
67 : s% pg% Color_Magnitude1_max_width, &
68 : s% pg% Color_Magnitude1_num_panels, &
69 : s% pg% Color_Magnitude1_other_ymin, &
70 : s% pg% Color_Magnitude1_other_ymax, &
71 : s% pg% Color_Magnitude1_yaxis_reversed, &
72 : s% pg% Color_Magnitude1_other_yaxis_log, &
73 : s% pg% Color_Magnitude1_other_dymin, &
74 : s% pg% Color_Magnitude1_other_ymargin, &
75 : s% pg% Color_Magnitude1_other_yaxis1_name, &
76 : s% pg% Color_Magnitude1_other_yaxis2_name, &
77 : s% pg% Color_Magnitude1_ymin, &
78 : s% pg% Color_Magnitude1_ymax, &
79 : s% pg% Color_Magnitude1_xaxis_reversed, &
80 : s% pg% Color_Magnitude1_yaxis_reversed, &
81 : s% pg% Color_Magnitude1_xaxis_log, &
82 : s% pg% Color_Magnitude1_yaxis_log, &
83 : s% pg% Color_Magnitude1_dymin, &
84 : s% pg% Color_Magnitude1_ymargin, &
85 : s% pg% Color_Magnitude1_yaxis1_name, &
86 : s% pg% Color_Magnitude1_yaxis2_name, &
87 : s% pg% Color_Magnitude1_use_decorator, &
88 : s% pg% Color_Magnitude1_pgstar_decorator, &
89 0 : ierr)
90 0 : end subroutine do_Color_Magnitude1_plot
91 :
92 :
93 0 : subroutine Color_Magnitude2_plot(id, device_id, ierr)
94 : integer, intent(in) :: id, device_id
95 : integer, intent(out) :: ierr
96 : type (star_info), pointer :: s
97 : ierr = 0
98 0 : call get_star_ptr(id, s, ierr)
99 0 : if (ierr /= 0) return
100 0 : call pgslct(device_id)
101 0 : call pgbbuf()
102 0 : call pgeras()
103 : call do_Color_Magnitude2_plot(s, id, device_id, &
104 : s% pg% Color_Magnitude2_xleft, s% pg% Color_Magnitude2_xright, &
105 : s% pg% Color_Magnitude2_ybot, s% pg% Color_Magnitude2_ytop, .false., &
106 0 : s% pg% Color_Magnitude2_title, s% pg% Color_Magnitude2_txt_scale, ierr)
107 0 : if (ierr /= 0) return
108 0 : call pgebuf()
109 : end subroutine Color_Magnitude2_plot
110 :
111 :
112 0 : subroutine do_Color_Magnitude2_plot(s, id, device_id, &
113 : vp_xleft, vp_xright, vp_ybot, vp_ytop, subplot, title, txt_scale, ierr)
114 : type (star_info), pointer :: s
115 : integer, intent(in) :: id, device_id
116 : real, intent(in) :: vp_xleft, vp_xright, vp_ybot, vp_ytop, txt_scale
117 : logical, intent(in) :: subplot
118 : character (len=*), intent(in) :: title
119 : integer, intent(out) :: ierr
120 : call do_Color_Magnitude_plot( &
121 : id, s, device_id, &
122 : vp_xleft, vp_xright, vp_ybot, vp_ytop, subplot, title, txt_scale, &
123 : s% pg% Color_Magnitude2_xaxis1_name, &
124 : s% pg% Color_Magnitude2_xaxis2_name, &
125 : s% pg% Color_Magnitude2_xmin, &
126 : s% pg% Color_Magnitude2_xmax, &
127 : s% pg% Color_Magnitude2_dxmin, &
128 : s% pg% Color_Magnitude2_xmargin, &
129 : s% pg% Color_Magnitude2_max_width, &
130 : s% pg% Color_Magnitude2_num_panels, &
131 : s% pg% Color_Magnitude2_other_ymin, &
132 : s% pg% Color_Magnitude2_other_ymax, &
133 : s% pg% Color_Magnitude2_yaxis_reversed, &
134 : s% pg% Color_Magnitude2_other_yaxis_log, &
135 : s% pg% Color_Magnitude2_other_dymin, &
136 : s% pg% Color_Magnitude2_other_ymargin, &
137 : s% pg% Color_Magnitude2_other_yaxis1_name, &
138 : s% pg% Color_Magnitude2_other_yaxis2_name, &
139 : s% pg% Color_Magnitude2_ymin, &
140 : s% pg% Color_Magnitude2_ymax, &
141 : s% pg% Color_Magnitude2_xaxis_reversed, &
142 : s% pg% Color_Magnitude2_yaxis_reversed, &
143 : s% pg% Color_Magnitude2_xaxis_log, &
144 : s% pg% Color_Magnitude2_yaxis_log, &
145 : s% pg% Color_Magnitude2_dymin, &
146 : s% pg% Color_Magnitude2_ymargin, &
147 : s% pg% Color_Magnitude2_yaxis1_name, &
148 : s% pg% Color_Magnitude2_yaxis2_name, &
149 : s% pg% Color_Magnitude2_use_decorator, &
150 : s% pg% Color_Magnitude2_pgstar_decorator, &
151 0 : ierr)
152 0 : end subroutine do_Color_Magnitude2_plot
153 :
154 :
155 0 : subroutine Color_Magnitude3_plot(id, device_id, ierr)
156 : integer, intent(in) :: id, device_id
157 : integer, intent(out) :: ierr
158 : type (star_info), pointer :: s
159 : ierr = 0
160 0 : call get_star_ptr(id, s, ierr)
161 0 : if (ierr /= 0) return
162 0 : call pgslct(device_id)
163 0 : call pgbbuf()
164 0 : call pgeras()
165 : call do_Color_Magnitude3_plot(s, id, device_id, &
166 : s% pg% Color_Magnitude3_xleft, s% pg% Color_Magnitude3_xright, &
167 : s% pg% Color_Magnitude3_ybot, s% pg% Color_Magnitude3_ytop, .false., &
168 0 : s% pg% Color_Magnitude3_title, s% pg% Color_Magnitude3_txt_scale, ierr)
169 0 : if (ierr /= 0) return
170 0 : call pgebuf()
171 : end subroutine Color_Magnitude3_plot
172 :
173 :
174 0 : subroutine do_Color_Magnitude3_plot(s, id, device_id, &
175 : vp_xleft, vp_xright, vp_ybot, vp_ytop, subplot, title, txt_scale, ierr)
176 : type (star_info), pointer :: s
177 : integer, intent(in) :: id, device_id
178 : real, intent(in) :: vp_xleft, vp_xright, vp_ybot, vp_ytop, txt_scale
179 : logical, intent(in) :: subplot
180 : character (len=*), intent(in) :: title
181 : integer, intent(out) :: ierr
182 : call do_Color_Magnitude_plot( &
183 : id, s, device_id, &
184 : vp_xleft, vp_xright, vp_ybot, vp_ytop, subplot, title, txt_scale, &
185 : s% pg% Color_Magnitude3_xaxis1_name, &
186 : s% pg% Color_Magnitude3_xaxis2_name, &
187 : s% pg% Color_Magnitude3_xmin, &
188 : s% pg% Color_Magnitude3_xmax, &
189 : s% pg% Color_Magnitude3_dxmin, &
190 : s% pg% Color_Magnitude3_xmargin, &
191 : s% pg% Color_Magnitude3_max_width, &
192 : s% pg% Color_Magnitude3_num_panels, &
193 : s% pg% Color_Magnitude3_other_ymin, &
194 : s% pg% Color_Magnitude3_other_ymax, &
195 : s% pg% Color_Magnitude3_yaxis_reversed, &
196 : s% pg% Color_Magnitude3_other_yaxis_log, &
197 : s% pg% Color_Magnitude3_other_dymin, &
198 : s% pg% Color_Magnitude3_other_ymargin, &
199 : s% pg% Color_Magnitude3_other_yaxis1_name, &
200 : s% pg% Color_Magnitude3_other_yaxis2_name, &
201 : s% pg% Color_Magnitude3_ymin, &
202 : s% pg% Color_Magnitude3_ymax, &
203 : s% pg% Color_Magnitude3_xaxis_reversed, &
204 : s% pg% Color_Magnitude3_yaxis_reversed, &
205 : s% pg% Color_Magnitude3_xaxis_log, &
206 : s% pg% Color_Magnitude3_yaxis_log, &
207 : s% pg% Color_Magnitude3_dymin, &
208 : s% pg% Color_Magnitude3_ymargin, &
209 : s% pg% Color_Magnitude3_yaxis1_name, &
210 : s% pg% Color_Magnitude3_yaxis2_name, &
211 : s% pg% Color_Magnitude3_use_decorator, &
212 : s% pg% Color_Magnitude3_pgstar_decorator, &
213 0 : ierr)
214 0 : end subroutine do_Color_Magnitude3_plot
215 :
216 :
217 0 : subroutine Color_Magnitude4_plot(id, device_id, ierr)
218 : integer, intent(in) :: id, device_id
219 : integer, intent(out) :: ierr
220 : type (star_info), pointer :: s
221 : ierr = 0
222 0 : call get_star_ptr(id, s, ierr)
223 0 : if (ierr /= 0) return
224 0 : call pgslct(device_id)
225 0 : call pgbbuf()
226 0 : call pgeras()
227 : call do_Color_Magnitude4_plot(s, id, device_id, &
228 : s% pg% Color_Magnitude4_xleft, s% pg% Color_Magnitude4_xright, &
229 : s% pg% Color_Magnitude4_ybot, s% pg% Color_Magnitude4_ytop, .false., &
230 0 : s% pg% Color_Magnitude4_title, s% pg% Color_Magnitude4_txt_scale, ierr)
231 0 : if (ierr /= 0) return
232 0 : call pgebuf()
233 : end subroutine Color_Magnitude4_plot
234 :
235 :
236 0 : subroutine do_Color_Magnitude4_plot(s, id, device_id, &
237 : vp_xleft, vp_xright, vp_ybot, vp_ytop, subplot, title, txt_scale, ierr)
238 : type (star_info), pointer :: s
239 : integer, intent(in) :: id, device_id
240 : real, intent(in) :: vp_xleft, vp_xright, vp_ybot, vp_ytop, txt_scale
241 : logical, intent(in) :: subplot
242 : character (len=*), intent(in) :: title
243 : integer, intent(out) :: ierr
244 : call do_Color_Magnitude_plot( &
245 : id, s, device_id, &
246 : vp_xleft, vp_xright, vp_ybot, vp_ytop, subplot, title, txt_scale, &
247 : s% pg% Color_Magnitude4_xaxis1_name, &
248 : s% pg% Color_Magnitude4_xaxis2_name, &
249 : s% pg% Color_Magnitude4_xmin, &
250 : s% pg% Color_Magnitude4_xmax, &
251 : s% pg% Color_Magnitude4_dxmin, &
252 : s% pg% Color_Magnitude4_xmargin, &
253 : s% pg% Color_Magnitude4_max_width, &
254 : s% pg% Color_Magnitude4_num_panels, &
255 : s% pg% Color_Magnitude4_other_ymin, &
256 : s% pg% Color_Magnitude4_other_ymax, &
257 : s% pg% Color_Magnitude4_yaxis_reversed, &
258 : s% pg% Color_Magnitude4_other_yaxis_log, &
259 : s% pg% Color_Magnitude4_other_dymin, &
260 : s% pg% Color_Magnitude4_other_ymargin, &
261 : s% pg% Color_Magnitude4_other_yaxis1_name, &
262 : s% pg% Color_Magnitude4_other_yaxis2_name, &
263 : s% pg% Color_Magnitude4_ymin, &
264 : s% pg% Color_Magnitude4_ymax, &
265 : s% pg% Color_Magnitude4_xaxis_reversed, &
266 : s% pg% Color_Magnitude4_yaxis_reversed, &
267 : s% pg% Color_Magnitude4_xaxis_log, &
268 : s% pg% Color_Magnitude4_yaxis_log, &
269 : s% pg% Color_Magnitude4_dymin, &
270 : s% pg% Color_Magnitude4_ymargin, &
271 : s% pg% Color_Magnitude4_yaxis1_name, &
272 : s% pg% Color_Magnitude4_yaxis2_name, &
273 : s% pg% Color_Magnitude4_use_decorator, &
274 : s% pg% Color_Magnitude4_pgstar_decorator, &
275 0 : ierr)
276 0 : end subroutine do_Color_Magnitude4_plot
277 :
278 :
279 0 : subroutine Color_Magnitude5_plot(id, device_id, ierr)
280 : integer, intent(in) :: id, device_id
281 : integer, intent(out) :: ierr
282 : type (star_info), pointer :: s
283 : ierr = 0
284 0 : call get_star_ptr(id, s, ierr)
285 0 : if (ierr /= 0) return
286 0 : call pgslct(device_id)
287 0 : call pgbbuf()
288 0 : call pgeras()
289 : call do_Color_Magnitude5_plot(s, id, device_id, &
290 : s% pg% Color_Magnitude5_xleft, s% pg% Color_Magnitude5_xright, &
291 : s% pg% Color_Magnitude5_ybot, s% pg% Color_Magnitude5_ytop, .false., &
292 0 : s% pg% Color_Magnitude5_title, s% pg% Color_Magnitude5_txt_scale, ierr)
293 0 : if (ierr /= 0) return
294 0 : call pgebuf()
295 : end subroutine Color_Magnitude5_plot
296 :
297 :
298 0 : subroutine do_Color_Magnitude5_plot(s, id, device_id, &
299 : vp_xleft, vp_xright, vp_ybot, vp_ytop, subplot, title, txt_scale, ierr)
300 : type (star_info), pointer :: s
301 : integer, intent(in) :: id, device_id
302 : real, intent(in) :: vp_xleft, vp_xright, vp_ybot, vp_ytop, txt_scale
303 : logical, intent(in) :: subplot
304 : character (len=*), intent(in) :: title
305 : integer, intent(out) :: ierr
306 : call do_Color_Magnitude_plot( &
307 : id, s, device_id, &
308 : vp_xleft, vp_xright, vp_ybot, vp_ytop, subplot, title, txt_scale, &
309 : s% pg% Color_Magnitude5_xaxis1_name, &
310 : s% pg% Color_Magnitude5_xaxis2_name, &
311 : s% pg% Color_Magnitude5_xmin, &
312 : s% pg% Color_Magnitude5_xmax, &
313 : s% pg% Color_Magnitude5_dxmin, &
314 : s% pg% Color_Magnitude5_xmargin, &
315 : s% pg% Color_Magnitude5_max_width, &
316 : s% pg% Color_Magnitude5_num_panels, &
317 : s% pg% Color_Magnitude5_other_ymin, &
318 : s% pg% Color_Magnitude5_other_ymax, &
319 : s% pg% Color_Magnitude5_yaxis_reversed, &
320 : s% pg% Color_Magnitude5_other_yaxis_log, &
321 : s% pg% Color_Magnitude5_other_dymin, &
322 : s% pg% Color_Magnitude5_other_ymargin, &
323 : s% pg% Color_Magnitude5_other_yaxis1_name, &
324 : s% pg% Color_Magnitude5_other_yaxis2_name, &
325 : s% pg% Color_Magnitude5_ymin, &
326 : s% pg% Color_Magnitude5_ymax, &
327 : s% pg% Color_Magnitude5_xaxis_reversed, &
328 : s% pg% Color_Magnitude5_yaxis_reversed, &
329 : s% pg% Color_Magnitude5_xaxis_log, &
330 : s% pg% Color_Magnitude5_yaxis_log, &
331 : s% pg% Color_Magnitude5_dymin, &
332 : s% pg% Color_Magnitude5_ymargin, &
333 : s% pg% Color_Magnitude5_yaxis1_name, &
334 : s% pg% Color_Magnitude5_yaxis2_name, &
335 : s% pg% Color_Magnitude5_use_decorator, &
336 : s% pg% Color_Magnitude5_pgstar_decorator, &
337 0 : ierr)
338 0 : end subroutine do_Color_Magnitude5_plot
339 :
340 :
341 0 : subroutine Color_Magnitude6_plot(id, device_id, ierr)
342 : integer, intent(in) :: id, device_id
343 : integer, intent(out) :: ierr
344 : type (star_info), pointer :: s
345 : ierr = 0
346 0 : call get_star_ptr(id, s, ierr)
347 0 : if (ierr /= 0) return
348 0 : call pgslct(device_id)
349 0 : call pgbbuf()
350 0 : call pgeras()
351 : call do_Color_Magnitude6_plot(s, id, device_id, &
352 : s% pg% Color_Magnitude6_xleft, s% pg% Color_Magnitude6_xright, &
353 : s% pg% Color_Magnitude6_ybot, s% pg% Color_Magnitude6_ytop, .false., &
354 0 : s% pg% Color_Magnitude6_title, s% pg% Color_Magnitude6_txt_scale, ierr)
355 0 : if (ierr /= 0) return
356 0 : call pgebuf()
357 : end subroutine Color_Magnitude6_plot
358 :
359 :
360 0 : subroutine do_Color_Magnitude6_plot(s, id, device_id, &
361 : vp_xleft, vp_xright, vp_ybot, vp_ytop, subplot, title, txt_scale, ierr)
362 : type (star_info), pointer :: s
363 : integer, intent(in) :: id, device_id
364 : real, intent(in) :: vp_xleft, vp_xright, vp_ybot, vp_ytop, txt_scale
365 : logical, intent(in) :: subplot
366 : character (len=*), intent(in) :: title
367 : integer, intent(out) :: ierr
368 : call do_Color_Magnitude_plot( &
369 : id, s, device_id, &
370 : vp_xleft, vp_xright, vp_ybot, vp_ytop, subplot, title, txt_scale, &
371 : s% pg% Color_Magnitude6_xaxis1_name, &
372 : s% pg% Color_Magnitude6_xaxis2_name, &
373 : s% pg% Color_Magnitude6_xmin, &
374 : s% pg% Color_Magnitude6_xmax, &
375 : s% pg% Color_Magnitude6_dxmin, &
376 : s% pg% Color_Magnitude6_xmargin, &
377 : s% pg% Color_Magnitude6_max_width, &
378 : s% pg% Color_Magnitude6_num_panels, &
379 : s% pg% Color_Magnitude6_other_ymin, &
380 : s% pg% Color_Magnitude6_other_ymax, &
381 : s% pg% Color_Magnitude6_yaxis_reversed, &
382 : s% pg% Color_Magnitude6_other_yaxis_log, &
383 : s% pg% Color_Magnitude6_other_dymin, &
384 : s% pg% Color_Magnitude6_other_ymargin, &
385 : s% pg% Color_Magnitude6_other_yaxis1_name, &
386 : s% pg% Color_Magnitude6_other_yaxis2_name, &
387 : s% pg% Color_Magnitude6_ymin, &
388 : s% pg% Color_Magnitude6_ymax, &
389 : s% pg% Color_Magnitude6_xaxis_reversed, &
390 : s% pg% Color_Magnitude6_yaxis_reversed, &
391 : s% pg% Color_Magnitude6_xaxis_log, &
392 : s% pg% Color_Magnitude6_yaxis_log, &
393 : s% pg% Color_Magnitude6_dymin, &
394 : s% pg% Color_Magnitude6_ymargin, &
395 : s% pg% Color_Magnitude6_yaxis1_name, &
396 : s% pg% Color_Magnitude6_yaxis2_name, &
397 : s% pg% Color_Magnitude6_use_decorator, &
398 : s% pg% Color_Magnitude6_pgstar_decorator, &
399 0 : ierr)
400 0 : end subroutine do_Color_Magnitude6_plot
401 :
402 :
403 0 : subroutine Color_Magnitude7_plot(id, device_id, ierr)
404 : integer, intent(in) :: id, device_id
405 : integer, intent(out) :: ierr
406 : type (star_info), pointer :: s
407 : ierr = 0
408 0 : call get_star_ptr(id, s, ierr)
409 0 : if (ierr /= 0) return
410 0 : call pgslct(device_id)
411 0 : call pgbbuf()
412 0 : call pgeras()
413 : call do_Color_Magnitude7_plot(s, id, device_id, &
414 : s% pg% Color_Magnitude7_xleft, s% pg% Color_Magnitude7_xright, &
415 : s% pg% Color_Magnitude7_ybot, s% pg% Color_Magnitude7_ytop, .false., &
416 0 : s% pg% Color_Magnitude7_title, s% pg% Color_Magnitude7_txt_scale, ierr)
417 0 : if (ierr /= 0) return
418 0 : call pgebuf()
419 : end subroutine Color_Magnitude7_plot
420 :
421 :
422 0 : subroutine do_Color_Magnitude7_plot(s, id, device_id, &
423 : vp_xleft, vp_xright, vp_ybot, vp_ytop, subplot, title, txt_scale, ierr)
424 : type (star_info), pointer :: s
425 : integer, intent(in) :: id, device_id
426 : real, intent(in) :: vp_xleft, vp_xright, vp_ybot, vp_ytop, txt_scale
427 : logical, intent(in) :: subplot
428 : character (len=*), intent(in) :: title
429 : integer, intent(out) :: ierr
430 : call do_Color_Magnitude_plot( &
431 : id, s, device_id, &
432 : vp_xleft, vp_xright, vp_ybot, vp_ytop, subplot, title, txt_scale, &
433 : s% pg% Color_Magnitude7_xaxis1_name, &
434 : s% pg% Color_Magnitude7_xaxis2_name, &
435 : s% pg% Color_Magnitude7_xmin, &
436 : s% pg% Color_Magnitude7_xmax, &
437 : s% pg% Color_Magnitude7_dxmin, &
438 : s% pg% Color_Magnitude7_xmargin, &
439 : s% pg% Color_Magnitude7_max_width, &
440 : s% pg% Color_Magnitude7_num_panels, &
441 : s% pg% Color_Magnitude7_other_ymin, &
442 : s% pg% Color_Magnitude7_other_ymax, &
443 : s% pg% Color_Magnitude7_yaxis_reversed, &
444 : s% pg% Color_Magnitude7_other_yaxis_log, &
445 : s% pg% Color_Magnitude7_other_dymin, &
446 : s% pg% Color_Magnitude7_other_ymargin, &
447 : s% pg% Color_Magnitude7_other_yaxis1_name, &
448 : s% pg% Color_Magnitude7_other_yaxis2_name, &
449 : s% pg% Color_Magnitude7_ymin, &
450 : s% pg% Color_Magnitude7_ymax, &
451 : s% pg% Color_Magnitude7_xaxis_reversed, &
452 : s% pg% Color_Magnitude7_yaxis_reversed, &
453 : s% pg% Color_Magnitude7_xaxis_log, &
454 : s% pg% Color_Magnitude7_yaxis_log, &
455 : s% pg% Color_Magnitude7_dymin, &
456 : s% pg% Color_Magnitude7_ymargin, &
457 : s% pg% Color_Magnitude7_yaxis1_name, &
458 : s% pg% Color_Magnitude7_yaxis2_name, &
459 : s% pg% Color_Magnitude7_use_decorator, &
460 : s% pg% Color_Magnitude7_pgstar_decorator, &
461 0 : ierr)
462 0 : end subroutine do_Color_Magnitude7_plot
463 :
464 :
465 0 : subroutine Color_Magnitude8_plot(id, device_id, ierr)
466 : integer, intent(in) :: id, device_id
467 : integer, intent(out) :: ierr
468 : type (star_info), pointer :: s
469 : ierr = 0
470 0 : call get_star_ptr(id, s, ierr)
471 0 : if (ierr /= 0) return
472 0 : call pgslct(device_id)
473 0 : call pgbbuf()
474 0 : call pgeras()
475 : call do_Color_Magnitude8_plot(s, id, device_id, &
476 : s% pg% Color_Magnitude8_xleft, s% pg% Color_Magnitude8_xright, &
477 : s% pg% Color_Magnitude8_ybot, s% pg% Color_Magnitude8_ytop, .false., &
478 0 : s% pg% Color_Magnitude8_title, s% pg% Color_Magnitude8_txt_scale, ierr)
479 0 : if (ierr /= 0) return
480 0 : call pgebuf()
481 : end subroutine Color_Magnitude8_plot
482 :
483 :
484 0 : subroutine do_Color_Magnitude8_plot(s, id, device_id, &
485 : vp_xleft, vp_xright, vp_ybot, vp_ytop, subplot, title, txt_scale, ierr)
486 : type (star_info), pointer :: s
487 : integer, intent(in) :: id, device_id
488 : real, intent(in) :: vp_xleft, vp_xright, vp_ybot, vp_ytop, txt_scale
489 : logical, intent(in) :: subplot
490 : character (len=*), intent(in) :: title
491 : integer, intent(out) :: ierr
492 : call do_Color_Magnitude_plot( &
493 : id, s, device_id, &
494 : vp_xleft, vp_xright, vp_ybot, vp_ytop, subplot, title, txt_scale, &
495 : s% pg% Color_Magnitude8_xaxis1_name, &
496 : s% pg% Color_Magnitude8_xaxis2_name, &
497 : s% pg% Color_Magnitude8_xmin, &
498 : s% pg% Color_Magnitude8_xmax, &
499 : s% pg% Color_Magnitude8_dxmin, &
500 : s% pg% Color_Magnitude8_xmargin, &
501 : s% pg% Color_Magnitude8_max_width, &
502 : s% pg% Color_Magnitude8_num_panels, &
503 : s% pg% Color_Magnitude8_other_ymin, &
504 : s% pg% Color_Magnitude8_other_ymax, &
505 : s% pg% Color_Magnitude8_yaxis_reversed, &
506 : s% pg% Color_Magnitude8_other_yaxis_log, &
507 : s% pg% Color_Magnitude8_other_dymin, &
508 : s% pg% Color_Magnitude8_other_ymargin, &
509 : s% pg% Color_Magnitude8_other_yaxis1_name, &
510 : s% pg% Color_Magnitude8_other_yaxis2_name, &
511 : s% pg% Color_Magnitude8_ymin, &
512 : s% pg% Color_Magnitude8_ymax, &
513 : s% pg% Color_Magnitude8_xaxis_reversed, &
514 : s% pg% Color_Magnitude8_yaxis_reversed, &
515 : s% pg% Color_Magnitude8_xaxis_log, &
516 : s% pg% Color_Magnitude8_yaxis_log, &
517 : s% pg% Color_Magnitude8_dymin, &
518 : s% pg% Color_Magnitude8_ymargin, &
519 : s% pg% Color_Magnitude8_yaxis1_name, &
520 : s% pg% Color_Magnitude8_yaxis2_name, &
521 : s% pg% Color_Magnitude8_use_decorator, &
522 : s% pg% Color_Magnitude8_pgstar_decorator, &
523 0 : ierr)
524 0 : end subroutine do_Color_Magnitude8_plot
525 :
526 :
527 0 : subroutine Color_Magnitude9_plot(id, device_id, ierr)
528 : integer, intent(in) :: id, device_id
529 : integer, intent(out) :: ierr
530 : type (star_info), pointer :: s
531 : ierr = 0
532 0 : call get_star_ptr(id, s, ierr)
533 0 : if (ierr /= 0) return
534 0 : call pgslct(device_id)
535 0 : call pgbbuf()
536 0 : call pgeras()
537 : call do_Color_Magnitude9_plot(s, id, device_id, &
538 : s% pg% Color_Magnitude9_xleft, s% pg% Color_Magnitude9_xright, &
539 : s% pg% Color_Magnitude9_ybot, s% pg% Color_Magnitude9_ytop, .false., &
540 0 : s% pg% Color_Magnitude9_title, s% pg% Color_Magnitude9_txt_scale, ierr)
541 0 : if (ierr /= 0) return
542 0 : call pgebuf()
543 : end subroutine Color_Magnitude9_plot
544 :
545 :
546 0 : subroutine do_Color_Magnitude9_plot(s, id, device_id, &
547 : vp_xleft, vp_xright, vp_ybot, vp_ytop, subplot, title, txt_scale, ierr)
548 : type (star_info), pointer :: s
549 : integer, intent(in) :: id, device_id
550 : real, intent(in) :: vp_xleft, vp_xright, vp_ybot, vp_ytop, txt_scale
551 : logical, intent(in) :: subplot
552 : character (len=*), intent(in) :: title
553 : integer, intent(out) :: ierr
554 : call do_Color_Magnitude_plot( &
555 : id, s, device_id, &
556 : vp_xleft, vp_xright, vp_ybot, vp_ytop, subplot, title, txt_scale, &
557 : s% pg% Color_Magnitude9_xaxis1_name, &
558 : s% pg% Color_Magnitude9_xaxis2_name, &
559 : s% pg% Color_Magnitude9_xmin, &
560 : s% pg% Color_Magnitude9_xmax, &
561 : s% pg% Color_Magnitude9_dxmin, &
562 : s% pg% Color_Magnitude9_xmargin, &
563 : s% pg% Color_Magnitude9_max_width, &
564 : s% pg% Color_Magnitude9_num_panels, &
565 : s% pg% Color_Magnitude9_other_ymin, &
566 : s% pg% Color_Magnitude9_other_ymax, &
567 : s% pg% Color_Magnitude9_yaxis_reversed, &
568 : s% pg% Color_Magnitude9_other_yaxis_log, &
569 : s% pg% Color_Magnitude9_other_dymin, &
570 : s% pg% Color_Magnitude9_other_ymargin, &
571 : s% pg% Color_Magnitude9_other_yaxis1_name, &
572 : s% pg% Color_Magnitude9_other_yaxis2_name, &
573 : s% pg% Color_Magnitude9_ymin, &
574 : s% pg% Color_Magnitude9_ymax, &
575 : s% pg% Color_Magnitude9_xaxis_reversed, &
576 : s% pg% Color_Magnitude9_yaxis_reversed, &
577 : s% pg% Color_Magnitude9_xaxis_log, &
578 : s% pg% Color_Magnitude9_yaxis_log, &
579 : s% pg% Color_Magnitude9_dymin, &
580 : s% pg% Color_Magnitude9_ymargin, &
581 : s% pg% Color_Magnitude9_yaxis1_name, &
582 : s% pg% Color_Magnitude9_yaxis2_name, &
583 : s% pg% Color_Magnitude9_use_decorator, &
584 : s% pg% Color_Magnitude9_pgstar_decorator, &
585 0 : ierr)
586 0 : end subroutine do_Color_Magnitude9_plot
587 :
588 :
589 0 : subroutine do_Color_Magnitude_plot( &
590 : id, s, device_id, &
591 : vp_xleft, vp_xright, vp_ybot, vp_ytop, subplot, title, txt_scale, &
592 : color_xaxis1_name,color_xaxis2_name,&
593 : color_xmin_in, color_xmax, dxmin,color_xmargin, &
594 : color_max_width, color_num_panels, &
595 0 : color_other_ymin, color_other_ymax, &
596 0 : color_other_yaxis_reversed, color_other_yaxis_log, &
597 0 : color_other_dymin, color_other_ymargin, &
598 0 : color_other_yaxis1_name,color_other_yaxis2_name, &
599 0 : color_ymin, color_ymax, &
600 0 : color_xaxis_reversed, color_yaxis_reversed, &
601 : color_xaxis_log,color_yaxis_log, &
602 0 : color_dymin, color_ymargin, &
603 0 : color_yaxis1_name, color_yaxis2_name, &
604 : color_use_decorator, color_pgstar_decorator, &
605 : ierr)
606 : use utils_lib
607 : use star_def
608 : use pgstar_colors
609 :
610 : type (star_info), pointer :: s
611 : integer, intent(in) :: id, device_id, color_num_panels
612 : logical, intent(in) :: subplot, color_xaxis_reversed, color_xaxis_log
613 : character (len=*), intent(in) :: title, color_xaxis1_name,color_xaxis2_name
614 : real, intent(in) :: &
615 : vp_xleft, vp_xright, vp_ybot, vp_ytop, txt_scale, &
616 : color_xmin_in, color_xmax, color_max_width, color_xmargin, dxmin
617 : real, intent(in), dimension(:) :: &
618 : color_other_ymin, color_other_ymax, &
619 : color_other_dymin, color_other_ymargin, &
620 : color_ymin, color_ymax, color_dymin, color_ymargin
621 : logical, intent(in), dimension(:) :: &
622 : color_other_yaxis_reversed, color_other_yaxis_log, &
623 : color_yaxis_reversed, color_yaxis_log
624 : logical, intent(in) :: color_use_decorator
625 : character (len=*), intent(in), dimension(:) :: &
626 : color_other_yaxis1_name, color_other_yaxis2_name, &
627 : color_yaxis1_name,color_yaxis2_name
628 : integer, intent(out) :: ierr
629 : procedure(pgstar_decorator_interface), pointer :: color_pgstar_decorator
630 :
631 : character (len=strlen) :: yname1,yname2, &
632 : other_yname1,other_yname2
633 0 : real, allocatable, dimension(:) :: xvec1,xvec2, yvec1,yvec2,&
634 0 : other_yvec1,other_yvec2
635 0 : real, allocatable, dimension(:) :: xvec, yvec, other_yvec
636 :
637 : integer :: i, n, j, step_min, step_max, &
638 : y_color, other_y_color
639 0 : real :: color_xmin, xleft, xright, &
640 0 : ymargin, panel_dy, panel_ytop, panel_ybot, &
641 0 : ybot, ytop, &
642 0 : other_ybot, other_ytop
643 : logical :: have_yaxis1, have_other_yaxis1,have_yaxis2, have_other_yaxis2,have_xaxis2
644 : logical :: have_yaxis,have_other_yaxis
645 :
646 : integer :: ix1,ix2
647 :
648 : include 'formats'
649 0 : ierr = 0
650 0 : have_xaxis2=.False.
651 :
652 0 : step_min = 1
653 0 : step_max = s% model_number
654 :
655 0 : n = count_hist_points(s, step_min, step_max)
656 :
657 0 : allocate(xvec1(n), xvec2(n), yvec1(n), yvec2(n), other_yvec1(n), other_yvec2(n), stat=ierr)
658 0 : if (ierr /= 0) then
659 0 : write(*,*) 'allocate failed for PGSTAR'
660 0 : return
661 : end if
662 :
663 0 : allocate(xvec(n),yvec(n),other_yvec(n), stat=ierr)
664 0 : if (ierr /= 0) then
665 0 : write(*,*) 'allocate failed for PGSTAR'
666 0 : return
667 : end if
668 :
669 0 : call integer_dict_lookup(s% history_names_dict, color_xaxis1_name, ix1, ierr)
670 0 : if (ierr /= 0) ix1 = -1
671 0 : if (ix1 <= 0) then
672 0 : write(*,'(A)')
673 : write(*,*) 'ERROR: failed to find ' // &
674 0 : trim(color_xaxis1_name) // ' in history data'
675 0 : write(*,'(A)')
676 0 : ierr = -1
677 : end if
678 :
679 0 : if(len_trim(color_xaxis2_name)>0) THEN
680 0 : have_xaxis2=.True.
681 0 : call integer_dict_lookup(s% history_names_dict, color_xaxis2_name, ix2, ierr)
682 0 : if (ierr /= 0) ix2 = -1
683 0 : if (ix2 <= 0) then
684 0 : write(*,'(A)')
685 : write(*,*) 'ERROR: failed to find ' // &
686 0 : trim(color_xaxis2_name) // ' in history data'
687 0 : write(*,'(A)')
688 : ierr = -1
689 : end if
690 : end if
691 :
692 0 : color_xmin = color_xmin_in
693 :
694 0 : call get_hist_points(s, step_min, step_max, n, ix1, xvec1, ierr)
695 0 : if (ierr /= 0) then
696 0 : write(*,*) 'pgstar get_hist_points failed ' // trim(color_xaxis1_name)
697 0 : deallocate(xvec1, xvec2)
698 0 : call dealloc
699 0 : ierr = 0
700 0 : return
701 : end if
702 0 : if (have_xaxis2) call get_hist_points(s, step_min, step_max, n, ix2, xvec2, ierr)
703 0 : if (ierr /= 0) then
704 0 : write(*,*) 'pgstar get_hist_points failed ' // trim(color_xaxis2_name)
705 0 : deallocate(xvec1,xvec2)
706 0 : call dealloc
707 0 : ierr = 0
708 0 : return
709 : end if
710 :
711 0 : xvec=xvec1
712 0 : if(have_xaxis2) xvec=xvec-xvec2
713 :
714 0 : deallocate(xvec1,xvec2)
715 :
716 : call set_xleft_xright( &
717 : n, xvec, color_xmin, color_xmax, color_xmargin, &
718 0 : color_xaxis_reversed, dxmin, xleft, xright)
719 :
720 0 : call pgsave
721 0 : call pgsch(txt_scale)
722 :
723 0 : ymargin = 0.05
724 0 : y_color = clr_Goldenrod
725 0 : other_y_color = clr_LightSkyBlue
726 :
727 0 : panel_dy = (vp_ytop - vp_ybot)/real(color_num_panels)
728 :
729 0 : do j = 1, color_num_panels
730 :
731 0 : yname1 = color_yaxis1_name(j)
732 0 : if (len_trim(yname1) == 0) then
733 : have_yaxis1 = .false.
734 : else
735 0 : have_yaxis1 = get1_yvec(yname1, yvec1)
736 : end if
737 :
738 0 : yname2 = color_yaxis2_name(j)
739 0 : if (len_trim(yname2) == 0) then
740 : have_yaxis2 = .false.
741 : else
742 0 : have_yaxis2 = get1_yvec(yname2, yvec2)
743 : end if
744 :
745 0 : other_yname1 = color_other_yaxis1_name(j)
746 0 : if (len_trim(color_other_yaxis1_name(j)) == 0) then
747 : have_other_yaxis1 = .false.
748 : else
749 0 : have_other_yaxis1 = get1_yvec(other_yname1, other_yvec1)
750 : end if
751 :
752 0 : other_yname2 = color_other_yaxis2_name(j)
753 0 : if (len_trim(color_other_yaxis2_name(j)) == 0) then
754 : have_other_yaxis2 = .false.
755 : else
756 0 : have_other_yaxis2 = get1_yvec(other_yname2, other_yvec2)
757 : end if
758 :
759 0 : if(have_yaxis1)then
760 : have_yaxis=.True.
761 : else
762 0 : have_yaxis=.false.
763 : end if
764 :
765 0 : if(have_other_yaxis1) then
766 : have_other_yaxis=.True.
767 : else
768 0 : have_other_yaxis=.false.
769 : end if
770 :
771 0 : if ((.not. have_yaxis) .and. (.not. have_other_yaxis)) cycle
772 :
773 0 : yvec=yvec1
774 0 : if(have_yaxis2) yvec=yvec-yvec2
775 :
776 : ! Make sure limits are sensible for plotting
777 0 : do i=lbound(yvec,dim=1),ubound(yvec,dim=1)
778 0 : if (yvec(i)>100) yvec(i)=100
779 0 : if (yvec(i)<-100) yvec(i)=-100
780 : end do
781 :
782 0 : other_yvec=other_yvec1
783 0 : if(have_other_yaxis2) other_yvec=other_yvec-other_yvec2
784 :
785 : ! Make sure limits are sensible for plotting
786 0 : do i=lbound(other_yvec,dim=1),ubound(other_yvec,dim=1)
787 0 : if (other_yvec(i)>100) other_yvec(i)=100
788 0 : if (other_yvec(i)<-100) other_yvec(i)=-100
789 : end do
790 :
791 :
792 0 : panel_ytop = vp_ytop - real(j-1)*panel_dy
793 0 : panel_ybot = panel_ytop - panel_dy
794 :
795 0 : call pgsvp(vp_xleft, vp_xright, panel_ybot, panel_ytop)
796 :
797 0 : if (j == 1) then
798 0 : if (.not. subplot) then
799 0 : call show_model_number_pgstar(s)
800 0 : call show_age_pgstar(s)
801 : end if
802 0 : call show_title_pgstar(s, title)
803 : end if
804 :
805 0 : if (have_other_yaxis) then
806 : call set_ytop_ybot( &
807 : n, other_yvec, color_other_ymin(j), color_other_ymax(j), -101.0, &
808 : color_other_ymargin(j), color_other_yaxis_reversed(j), &
809 0 : color_other_dymin(j), other_ybot, other_ytop)
810 0 : call pgswin(xleft, xright, other_ybot, other_ytop)
811 0 : call pgscf(1)
812 0 : call pgsci(clr_Foreground)
813 0 : call show_box_pgstar(s,'','CMSTV')
814 0 : call pgsci(other_y_color)
815 :
816 0 : if (have_other_yaxis2) then
817 0 : call show_right_yaxis_label_pgstar(s,trim(create_label(other_yname1,other_yname2)))
818 : else
819 0 : call show_right_yaxis_label_pgstar(s,trim(create_label(other_yname1,'')))
820 : end if
821 :
822 0 : call pgslw(s% pg% pgstar_lw)
823 0 : call pgline(n, xvec, other_yvec)
824 0 : call pgslw(1)
825 : end if
826 :
827 0 : if (have_yaxis) then
828 : call set_ytop_ybot( &
829 : n, yvec, color_ymin(j), color_ymax(j), -101.0, &
830 : color_ymargin(j), color_yaxis_reversed(j), &
831 0 : color_dymin(j), ybot, ytop)
832 0 : call pgswin(xleft, xright, ybot, ytop)
833 0 : call pgscf(1)
834 0 : call pgsci(clr_Foreground)
835 0 : if (j < color_num_panels) then
836 0 : if (.not. have_other_yaxis) then
837 0 : call show_box_pgstar(s,'BCST1','BCMNSTV1')
838 : else
839 0 : call show_box_pgstar(s,'BCST','BNSTV')
840 : end if
841 : else
842 0 : if (.not. have_other_yaxis) then
843 0 : call show_box_pgstar(s,'BCNST1','BCMNSTV1')
844 : else
845 0 : call show_box_pgstar(s,'BCNST','BNSTV')
846 : end if
847 : end if
848 0 : call pgsci(y_color)
849 0 : if(have_yaxis2)then
850 0 : call show_left_yaxis_label_pgstar(s,trim(create_label(yname1,yname2)))
851 : else
852 0 : call show_left_yaxis_label_pgstar(s,trim(create_label(yname1,'')))
853 : end if
854 0 : call pgslw(s% pg% pgstar_lw)
855 0 : call pgline(n, xvec, yvec)
856 0 : call pgslw(1)
857 : end if
858 :
859 0 : call pgsci(clr_Foreground)
860 :
861 0 : call show_pgstar_decorator(s%id,color_use_decorator,color_pgstar_decorator, j, ierr)
862 :
863 : end do
864 :
865 0 : if (have_xaxis2) then
866 0 : call show_xaxis_label_pgstar(s,trim(create_label(color_xaxis1_name,color_xaxis2_name)))
867 : else
868 0 : call show_xaxis_label_pgstar(s,trim(create_label(color_xaxis1_name,'')))
869 : end if
870 :
871 0 : call pgunsa
872 :
873 0 : call dealloc
874 :
875 : contains
876 :
877 0 : subroutine dealloc
878 0 : deallocate(xvec, yvec, other_yvec, yvec1, yvec2, other_yvec1, other_yvec2)
879 0 : end subroutine dealloc
880 :
881 0 : logical function get1_yvec(name, vec)
882 : character (len=*) :: name
883 : real, dimension(:), allocatable :: vec
884 0 : get1_yvec = get1_hist_yvec(s, step_min, step_max, n, name, vec)
885 0 : end function get1_yvec
886 :
887 0 : function create_label(str1,str2) result(new_str)
888 : character(len=*) :: str1,str2
889 : integer :: len1,len2,endStr1
890 : character(len=strlen) :: new_str
891 :
892 0 : new_str=''
893 :
894 0 : len1=len_trim(str1)
895 0 : len2=len_trim(str2)
896 :
897 : !Strings start with bc_
898 0 : if(str1(1:3)=='bc_') then
899 0 : new_str=str1(4:len1)
900 : !String start with abs_mag_
901 0 : else if(str1(1:8)=='abs_mag_') then
902 0 : new_str='M\d'//str1(9:len1)//'\u'
903 : else
904 0 : new_str=str1(1:len1)
905 : end if
906 0 : endStr1=len_trim(new_str)
907 :
908 0 : if(len2>0)then
909 : !Strings start with bc_
910 0 : if(str1(1:1)=='b') then
911 0 : new_str(endStr1+1:)=' - '//str2(4:len2)
912 : !String start with abs_mag_
913 0 : else if(str1(1:1)=='a') then
914 0 : new_str(endStr1+1:)=' - M\d'//str2(9:len2)//'\u'
915 : else
916 0 : new_str(endStr1+1:)=str2(1:len2)
917 : end if
918 : end if
919 :
920 0 : end function create_label
921 :
922 : end subroutine do_Color_Magnitude_plot
923 :
924 : end module pgstar_Color_Magnitude
|
