Line data Source code
1 : ! ***********************************************************************
2 : !
3 : ! Copyright (C) 2021 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_gsm
21 :
22 : use star_private_def
23 : use forum_m, only: hdf5io_t, CREATE_FILE
24 :
25 : implicit none
26 :
27 : private
28 : public :: write_gsm_data
29 :
30 : contains
31 :
32 0 : subroutine write_gsm_data (id, filename, global_data, point_data, ierr)
33 :
34 : integer, intent(in) :: id
35 : character(*), intent(in) :: filename
36 : real(dp), intent(in) :: global_data(:)
37 : real(dp), intent(in) :: point_data(:,:)
38 : integer, intent(out) :: ierr
39 :
40 : type(star_info), pointer :: s
41 0 : type(hdf5io_t) :: hi
42 :
43 : ! Write GYRE data to a GSM (GYRE stellar model) file
44 :
45 0 : call get_star_ptr(id, s, ierr)
46 0 : if (ierr /= 0) then
47 0 : write(*,*) 'bad star id for write_gyre_data'
48 0 : return
49 : end if
50 :
51 0 : select case(s%gyre_data_schema)
52 : case(110,120)
53 : case default
54 0 : write(*,*) 'invalid gyre_data_schema'
55 0 : ierr = -1
56 0 : return
57 : end select
58 :
59 : ! Open the file
60 :
61 0 : hi = hdf5io_t(filename, CREATE_FILE)
62 :
63 : ! Write the data
64 :
65 0 : call hi%write_attr('n', SIZE(point_data, 2))
66 :
67 0 : call hi%write_attr('M_star', global_data(1))
68 0 : call hi%write_attr('R_star', global_data(2))
69 0 : call hi%write_attr('L_star', global_data(3))
70 :
71 0 : call hi%write_attr('version', s%gyre_data_schema)
72 :
73 0 : select case(s%gyre_data_schema)
74 :
75 : case(110)
76 :
77 0 : call hi%write_dset('r', point_data(1,:))
78 0 : call hi%write_dset('M_r', point_data(2,:))
79 0 : call hi%write_dset('L_r', point_data(3,:))
80 0 : call hi%write_dset('P', point_data(4,:))
81 0 : call hi%write_dset('T', point_data(5,:))
82 0 : call hi%write_dset('rho', point_data(6,:))
83 0 : call hi%write_dset('nabla', point_data(7,:))
84 0 : call hi%write_dset('N2', point_data(8,:))
85 0 : call hi%write_dset('Gamma_1', point_data(9,:))
86 0 : call hi%write_dset('nabla_ad', point_data(10,:))
87 0 : call hi%write_dset('delta', point_data(11,:))
88 0 : call hi%write_dset('kap', point_data(12,:))
89 0 : call hi%write_dset('kap_kap_T', point_data(13,:))
90 0 : call hi%write_dset('kap_kap_rho', point_data(14,:))
91 0 : call hi%write_dset('eps', point_data(15,:))
92 0 : call hi%write_dset('eps_eps_T', point_data(16,:))
93 0 : call hi%write_dset('eps_eps_rho', point_data(17,:))
94 0 : call hi%write_dset('Omega_rot', point_data(18,:))
95 :
96 : case(120)
97 :
98 0 : call hi%write_dset('r', point_data(1,:))
99 0 : call hi%write_dset('M_r', point_data(2,:))
100 0 : call hi%write_dset('L_r', point_data(3,:))
101 0 : call hi%write_dset('P', point_data(4,:))
102 0 : call hi%write_dset('T', point_data(5,:))
103 0 : call hi%write_dset('rho', point_data(6,:))
104 0 : call hi%write_dset('nabla', point_data(7,:))
105 0 : call hi%write_dset('N2', point_data(8,:))
106 0 : call hi%write_dset('Gamma_1', point_data(9,:))
107 0 : call hi%write_dset('nabla_ad', point_data(10,:))
108 0 : call hi%write_dset('delta', point_data(11,:))
109 0 : call hi%write_dset('kap', point_data(12,:))
110 0 : call hi%write_dset('kap_kap_T', point_data(13,:))
111 0 : call hi%write_dset('kap_kap_rho', point_data(14,:))
112 0 : call hi%write_dset('eps', point_data(15,:))
113 0 : call hi%write_dset('eps_eps_T', point_data(16,:))
114 0 : call hi%write_dset('eps_eps_rho', point_data(17,:))
115 0 : call hi%write_dset('eps_grav', point_data(18,:))
116 0 : call hi%write_dset('Omega_rot', point_data(19,:))
117 :
118 : end select
119 :
120 : ! Close the file
121 :
122 0 : call hi%final()
123 :
124 0 : ierr = 0
125 :
126 0 : return
127 :
128 0 : end subroutine write_gsm_data
129 :
130 : end module pulse_gsm
|