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