Line data Source code
1 : ! ***********************************************************************
2 : !
3 : ! Copyright (C) 2010-2019 Rich Townsend & 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 pulse
21 :
22 : use star_def
23 : use utils_lib
24 :
25 : use pulse_cafein
26 : use pulse_fgong
27 : use pulse_osc
28 : use pulse_gyre
29 : use pulse_gsm
30 : use pulse_saio
31 : use pulse_gr1d
32 :
33 : implicit none
34 :
35 : private
36 : public :: export_pulse_data
37 : public :: get_pulse_data
38 : public :: write_pulse_data
39 :
40 : contains
41 :
42 0 : subroutine export_pulse_data (id, data_format, filename, &
43 : add_center_point, keep_surface_point, add_atmosphere, ierr)
44 :
45 : integer, intent(in) :: id
46 : character(*), intent(in) :: data_format
47 : character(*), intent(in) :: filename
48 : logical, intent(in) :: add_center_point
49 : logical, intent(in) :: keep_surface_point
50 : logical, intent(in) :: add_atmosphere
51 : integer, intent(out) :: ierr
52 :
53 : type(star_info), pointer :: s
54 0 : real(dp), allocatable :: global_data(:)
55 0 : real(dp), allocatable :: point_data(:,:)
56 :
57 : ! Export pulsation data to a file with the specified format
58 :
59 0 : call get_star_ptr(id, s, ierr)
60 0 : if (ierr /= 0) then
61 0 : write(*,*) 'bad star id for export_pulse_data'
62 0 : return
63 : end if
64 :
65 : ! If necessary, hand off to the user hook
66 :
67 0 : if (s%use_other_export_pulse_data .AND. ASSOCIATED(s%other_export_pulse_data)) then
68 : call s%other_export_pulse_data(id, data_format, filename, &
69 0 : add_center_point, keep_surface_point, add_atmosphere, ierr)
70 0 : return
71 : end if
72 :
73 : ! Get the pulsation data
74 :
75 : call get_pulse_data(id, data_format, &
76 0 : add_center_point, keep_surface_point, add_atmosphere, global_data, point_data, ierr)
77 0 : if (ierr /= 0) return
78 :
79 : ! Write the pulsation data
80 :
81 0 : call write_pulse_data(id, data_format, filename, global_data, point_data, ierr)
82 : if (ierr /= 0) return
83 :
84 : return
85 :
86 0 : end subroutine export_pulse_data
87 :
88 :
89 0 : subroutine get_pulse_data (id, data_format, &
90 : add_center_point, keep_surface_point, add_atmosphere, global_data, point_data, ierr)
91 :
92 : integer, intent(in) :: id
93 : character(*), intent(in) :: data_format
94 : logical, intent(in) :: add_center_point
95 : logical, intent(in) :: keep_surface_point
96 : logical, intent(in) :: add_atmosphere
97 : real(dp), allocatable, intent(out) :: global_data(:)
98 : real(dp), allocatable, intent(out) :: point_data(:,:)
99 : integer, intent(out) :: ierr
100 :
101 : type(star_info), pointer :: s
102 :
103 : ! Get pulsation data
104 :
105 0 : call get_star_ptr(id, s, ierr)
106 0 : if (ierr /= 0) then
107 0 : write(*,*) 'bad star id for export_pulse_data'
108 0 : return
109 : end if
110 :
111 : ! If necessary, hand off to the user hook
112 :
113 0 : if (s%use_other_get_pulse_data .AND. ASSOCIATED(s%other_get_pulse_data)) then
114 : call s%other_get_pulse_data(id, data_format, &
115 0 : add_center_point, keep_surface_point, add_atmosphere, global_data, point_data, ierr)
116 0 : return
117 : end if
118 :
119 0 : select case (StrLowCase(data_format))
120 : case ('cafein')
121 0 : call get_cafein_data(id, add_center_point, keep_surface_point, add_atmosphere, global_data, point_data, ierr)
122 : case ('fgong')
123 0 : call get_fgong_data(id, add_center_point, keep_surface_point, add_atmosphere, global_data, point_data, ierr)
124 : case ('osc')
125 0 : call get_osc_data(id, add_center_point, keep_surface_point, add_atmosphere, global_data, point_data, ierr)
126 : case ('gyre')
127 0 : call get_gyre_data(id, add_center_point, keep_surface_point, add_atmosphere, global_data, point_data, ierr)
128 : case ('gsm')
129 0 : call get_gyre_data(id, add_center_point, keep_surface_point, add_atmosphere, global_data, point_data, ierr)
130 : case ('saio')
131 0 : call get_saio_data(id, keep_surface_point, add_atmosphere, global_data, point_data, ierr)
132 : case ('gr1d')
133 0 : call get_gr1d_data(id, global_data, point_data, ierr)
134 : case default
135 0 : write(*,*) 'unknown format in get_pulse_data: '//TRIM(data_format)
136 0 : ierr = -1
137 : end select
138 :
139 : ! Edit the data
140 :
141 0 : if (s%use_other_edit_pulse_data .AND. ASSOCIATED(s%other_edit_pulse_data)) then
142 0 : call s%other_edit_pulse_data(s%id, data_format, global_data, point_data, ierr)
143 : end if
144 :
145 : return
146 :
147 : end subroutine get_pulse_data
148 :
149 :
150 0 : subroutine write_pulse_data (id, data_format, filename, global_data, point_data, ierr)
151 :
152 : integer, intent(in) :: id
153 : character(*), intent(in) :: data_format
154 : character(*), intent(in) :: filename
155 : real(dp), intent(in) :: global_data(:)
156 : real(dp), intent(in) :: point_data(:,:)
157 : integer, intent(out) :: ierr
158 :
159 : ! Write pulsation data
160 :
161 0 : select case (StrLowCase(data_format))
162 : case ('cafein')
163 0 : call write_cafein_data(id, filename, global_data, point_data, ierr)
164 : case ('fgong')
165 0 : call write_fgong_data(id, filename, global_data, point_data, ierr)
166 : case ('osc')
167 0 : call write_osc_data(id, filename, global_data, point_data, ierr)
168 : case ('gyre')
169 0 : call write_gyre_data(id, filename, global_data, point_data, ierr)
170 : case ('gsm')
171 0 : call write_gsm_data(id, filename, global_data, point_data, ierr)
172 : case ('saio')
173 0 : call write_saio_data(id, filename, global_data, point_data, ierr)
174 : case ('gr1d')
175 0 : call write_saio_data(id, filename, global_data, point_data, ierr)
176 : case default
177 0 : write(*,*) 'unknown format in write_pulse_data: '//TRIM(data_format)
178 0 : ierr = -1
179 : end select
180 :
181 0 : return
182 :
183 : end subroutine write_pulse_data
184 :
185 : end module pulse
|
