Line data Source code
1 : ! ***********************************************************************
2 : !
3 : ! Copyright (C) 2010-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 :
20 : module pulse_gr1d
21 :
22 : use star_private_def
23 : use const_def, only: dp
24 : use utils_lib
25 : use pulse_utils
26 :
27 : implicit none
28 :
29 : private
30 : public :: get_gr1d_data
31 : public :: write_gr1d_data
32 :
33 : contains
34 :
35 0 : subroutine get_gr1d_data (id, global_data, point_data, ierr)
36 :
37 : integer, intent(in) :: id
38 : real(dp), allocatable, intent(out) :: global_data(:)
39 : real(dp), allocatable, intent(out) :: point_data(:,:)
40 : integer, intent(out) :: ierr
41 :
42 : type(star_info), pointer :: s
43 : integer :: nn
44 : integer :: j
45 : integer :: k
46 : integer :: sg
47 :
48 : ! Get model data for GR1D output
49 :
50 0 : call get_star_ptr(id, s, ierr)
51 0 : if (ierr /= 0) then
52 0 : write(*,*) 'bad star id for get_gyre_data'
53 0 : return
54 : end if
55 :
56 : ! Determine data dimensions
57 :
58 0 : nn = s%nz
59 :
60 : ! Store global data
61 :
62 0 : allocate(global_data(0))
63 :
64 : ! Store point data
65 :
66 0 : allocate(point_data(7,nn))
67 :
68 0 : j = 1
69 :
70 : ! Envelope
71 :
72 0 : sg = 1
73 :
74 0 : env_loop : do k = s%nz, 1, -1
75 :
76 0 : call store_point_data_env(j, k)
77 :
78 : end do env_loop
79 :
80 0 : return
81 :
82 : contains
83 :
84 0 : subroutine store_point_data_env (j, k)
85 :
86 : integer, intent(in) :: j
87 : integer, intent(in) :: k
88 :
89 : ! Store data associated with envelope face k into the point_data
90 : ! array at position j
91 :
92 : associate ( &
93 : m => point_data(1,j), &
94 : r => point_data(2,j), &
95 : T => point_data(3,j), &
96 : rho => point_data(4,j), &
97 : v => point_data(5,j), &
98 : ye => point_data(6,j), &
99 : omega => point_data(7,j))
100 :
101 0 : m = s% m(k) - 0.5d0*s% dm(k)
102 :
103 0 : T = s%T(k)
104 0 : rho = s%rho(k)
105 0 : ye = s%ye(k)
106 :
107 0 : if (s% rotation_flag) then
108 0 : if (k == s%nz) then
109 0 : omega = s%omega(k)
110 : else
111 0 : omega = 0.5d0*(s%omega(k) + s%omega(k+1))
112 : end if
113 : else
114 0 : omega = 0d0
115 : end if
116 :
117 0 : if (k == s% nz) then
118 0 : r = 0.5d0*s%r(k)
119 0 : v = 0.5d0*s%v(k)
120 : else
121 0 : r = 0.5d0*(s%r(k) + s%r(k+1))
122 0 : v = 0.5d0*(s%v(k) + s%v(k+1))
123 : end if
124 :
125 : end associate
126 0 : return
127 :
128 : end subroutine store_point_data_env
129 :
130 : end subroutine get_gr1d_data
131 :
132 :
133 0 : subroutine write_gr1d_data (id, filename, global_data, point_data, ierr)
134 :
135 : integer, intent(in) :: id
136 : character(*), intent(in) :: filename
137 : real(dp), intent(in) :: global_data(:)
138 : real(dp), intent(in) :: point_data(:,:)
139 : integer, intent(out) :: ierr
140 :
141 : type(star_info), pointer :: s
142 : integer :: iounit
143 : integer :: nn
144 : integer :: j
145 :
146 : ! Write GR1D data to file
147 :
148 0 : call get_star_ptr(id, s, ierr)
149 0 : if (ierr /= 0) then
150 0 : write(*,*) 'bad star id for write_gr1d_data'
151 0 : return
152 : end if
153 :
154 : ! Open the file
155 :
156 0 : open(newunit=iounit, file=TRIM(filename), status='REPLACE', iostat=ierr)
157 0 : if (ierr /= 0) then
158 0 : write(*,*) 'failed to open '//TRIM(filename)
159 0 : return
160 : end if
161 :
162 : ! Write the data
163 :
164 0 : nn = SIZE(point_data, 2)
165 :
166 0 : write(iounit, 100) nn
167 : 100 format(I6)
168 :
169 0 : do j = 1, nn
170 0 : write(iounit, 100) j, point_data(:,j)
171 : 110 format(I6,1P,99E20.10)
172 : end do
173 :
174 : ! Close the file
175 :
176 0 : close(iounit)
177 :
178 0 : return
179 :
180 : end subroutine write_gr1d_data
181 :
182 : end module pulse_gr1d
|
