Line data Source code
1 : module mod_test_chem
2 : use chem_lib
3 : use chem_def
4 : use const_def, only: dp
5 : use utils_lib, only: mesa_error
6 :
7 : implicit none
8 :
9 : contains
10 :
11 1 : subroutine do_test
12 : use const_lib, only: const_init
13 : use math_lib, only: math_init
14 : integer :: ierr, i
15 : character(len=32) :: my_mesa_dir
16 1 : my_mesa_dir = '../..'
17 1 : call const_init(my_mesa_dir, ierr)
18 1 : if (ierr /= 0) then
19 0 : write (*, *) 'const_init failed'
20 0 : call mesa_error(__FILE__, __LINE__)
21 : end if
22 1 : call math_init()
23 1 : call chem_init('isotopes.data', ierr)
24 1 : if (ierr /= 0) then
25 0 : write (*, *) 'FATAL ERROR: failed in chem_init'
26 0 : call mesa_error(__FILE__, __LINE__)
27 : end if
28 1 : call do_test_lodders
29 1 : call do_tests
30 51 : do i = 1, 50
31 50 : call do_tests
32 51 : write (*, *) 'done i', i
33 : end do
34 1 : end subroutine do_test
35 :
36 51 : subroutine do_tests
37 :
38 51 : write (*, *) 'call do_test_chem'
39 51 : flush (6)
40 51 : call do_test_chem
41 :
42 51 : write (*, *) 'call do_test_composition_info'
43 51 : flush (6)
44 51 : call do_test_composition_info
45 :
46 51 : write (*, *) 'call do_test_Qtotal'
47 51 : flush (6)
48 51 : call do_test_Qtotal
49 :
50 51 : write (*, *) 'done do_tests'
51 51 : flush (6)
52 :
53 1 : end subroutine do_tests
54 :
55 51 : subroutine do_test_chem
56 51 : real(dp) :: c, n, o, cno
57 : integer :: ic12, in14, io16
58 : include 'formats'
59 :
60 51 : ic12 = get_nuclide_index('c12')
61 51 : in14 = get_nuclide_index('n14')
62 51 : io16 = get_nuclide_index('o16')
63 :
64 51 : write (*, *)
65 51 : write (*, *)
66 51 : write (*, 1) 'chem_W(io16)', chem_isos%W(io16)
67 51 : flush (6)
68 51 : write (*, 1) 'chem_Z(io16)', dble(chem_isos%Z(io16))
69 51 : flush (6)
70 51 : write (*, 1) 'chem_binding_energy(io16)', chem_isos%binding_energy(io16)
71 51 : flush (6)
72 51 : write (*, *)
73 51 : write (*, *) 'chem_name(io16) ', chem_isos%name(io16)
74 51 : flush (6)
75 51 : write (*, *) 'get_nuclide_index("o16") == io16', get_nuclide_index("o16") == io16
76 51 : flush (6)
77 51 : write (*, *)
78 51 : write (*, *) 'chem_element_Name(e_he) ', chem_element_Name(e_he)
79 51 : flush (6)
80 51 : write (*, *) 'chem_get_element_id("he") == e_he', chem_get_element_id("he") == e_he
81 51 : flush (6)
82 51 : write (*, *)
83 51 : write (*, *)
84 51 : write (*, 1) 'Anders & Grevesse 1989 zsol', zsol
85 51 : write (*, 1) 'Anders & Grevesse 1989 yesol', yesol
86 51 : write (*, *)
87 51 : write (*, *)
88 51 : write (*, *) 'cno fraction by mass of Z'
89 51 : write (*, *)
90 51 : flush (6)
91 :
92 51 : c = chem_Xsol('c12')
93 51 : n = chem_Xsol('n14')
94 51 : o = chem_Xsol('o16')
95 : !write(*,1) 'c', c
96 : !write(*,1) 'n', n
97 : !write(*,1) 'o', o
98 51 : cno = c + n + o
99 51 : write (*, 1) 'Anders & Grevesse 1989', cno/zsol
100 51 : write (*, *)
101 51 : cno = GN93_element_zfrac(e_c) + GN93_element_zfrac(e_n) + GN93_element_zfrac(e_o)
102 51 : write (*, 1) 'Grevesse and Noels 1993', cno
103 51 : write (*, *)
104 51 : cno = GS98_element_zfrac(e_c) + GS98_element_zfrac(e_n) + GS98_element_zfrac(e_o)
105 51 : write (*, 1) 'Grevesse and Sauval 1998', cno
106 51 : write (*, *)
107 51 : cno = L03_element_zfrac(e_c) + L03_element_zfrac(e_n) + L03_element_zfrac(e_o)
108 51 : write (*, 1) 'Lodders 2003', cno
109 51 : write (*, *)
110 51 : cno = AGS05_element_zfrac(e_c) + AGS05_element_zfrac(e_n) + AGS05_element_zfrac(e_o)
111 51 : write (*, 1) 'Asplund, Grevesse and Sauval 2005', cno
112 51 : write (*, *)
113 51 : return
114 :
115 : write (*, 1) 'Grevesse and Sauval 1998 C', GS98_element_zfrac(e_c)
116 : write (*, *)
117 : write (*, 1) 'Grevesse and Sauval 1998 N', GS98_element_zfrac(e_n)
118 : write (*, *)
119 : write (*, 1) 'Grevesse and Sauval 1998 O', GS98_element_zfrac(e_o)
120 : write (*, *)
121 : write (*, 1) 'Grevesse and Sauval 1998 Ne', GS98_element_zfrac(e_ne)
122 : write (*, *)
123 : write (*, 1) 'Grevesse and Sauval 1998 Mg', GS98_element_zfrac(e_mg)
124 : write (*, *)
125 : write (*, 1) 'Grevesse and Sauval 1998 Si', GS98_element_zfrac(e_si)
126 : write (*, *)
127 : write (*, 1) 'Grevesse and Sauval 1998 Fe', GS98_element_zfrac(e_fe)
128 : write (*, *)
129 : return
130 :
131 : stop
132 :
133 : end subroutine do_test_chem
134 :
135 51 : subroutine do_test_composition_info
136 : integer, parameter :: num_species = 2
137 : integer, dimension(num_species) :: ids
138 153 : real(dp), dimension(num_species) :: X
139 51 : real(dp) :: xh, xhe, xz, abar, zbar, z2bar, z53bar, ye, mass_correction, sumx
140 357 : real(dp) :: dabar_dx(num_species), dzbar_dx(num_species), dmc_dx(num_species)
141 : character(len=*), parameter :: form1 = '(a,t12,"=",f11.6)'
142 51 : ids(1) = get_nuclide_index('c12')
143 51 : ids(2) = get_nuclide_index('fe56')
144 153 : X = 0.5d0
145 : call composition_info(num_species, ids, X, xh, xhe, xz, &
146 51 : abar, zbar, z2bar, z53bar, ye, mass_correction, sumx, dabar_dx, dzbar_dx, dmc_dx)
147 51 : write (*, *) 'test moments of composition and the mass correction factor'
148 51 : write (*, *) 'for a C12-Fe56 mixture (both 50% by mass)'
149 51 : write (*, *)
150 51 : write (*, form1) 'Abar', abar
151 51 : write (*, form1) 'Zbar', zbar
152 51 : write (*, form1) 'Z2bar', z2bar
153 51 : write (*, form1) 'Ye', ye
154 51 : write (*, form1) 'sum(X*W/A)', mass_correction
155 51 : end subroutine do_test_composition_info
156 :
157 51 : subroutine do_test_Qtotal
158 :
159 : integer, parameter :: num_in = 2, num_out = 3
160 : integer :: reactants(num_in + num_out)
161 51 : real(dp) :: Qtotal
162 :
163 : include 'formats'
164 :
165 51 : write (*, *) 'test Qtotal for 2 he3 => 2 h1 + he4'
166 51 : write (*, *)
167 :
168 51 : reactants(1) = ihe3
169 51 : reactants(2) = ihe3
170 51 : reactants(3) = ihe4
171 51 : reactants(4) = ih1
172 51 : reactants(5) = ih1
173 51 : Qtotal = reaction_Qtotal(num_in, num_out, reactants, chem_isos)
174 :
175 51 : write (*, 1) 'Qtotal', Qtotal ! expect 12.86
176 51 : write (*, *)
177 :
178 51 : end subroutine do_test_Qtotal
179 :
180 1 : subroutine do_test_lodders
181 : integer :: i
182 1 : real(dp) :: percent
183 1 : write (*, *)
184 1 : write (*, '(a,/,72("="))') 'output of solar abundances: compare with Lodders (2003) table'
185 1 : write (*, '(a7,tr3,a11)') 'isotope', '% abundance'
186 287 : do i = 1, size(namsol)
187 286 : percent = lodders03_element_atom_percent(namsol(i))
188 287 : write (*, '(a7,tr3,f11.6)') namsol(i), percent
189 : end do
190 1 : end subroutine do_test_lodders
191 :
192 0 : subroutine write_chem_ids_file
193 : integer, parameter :: iounit = 33
194 : integer :: ierr
195 0 : ierr = 0
196 0 : open (unit=iounit, file=trim('chem_ids.list'), action='write', status='replace', iostat=ierr)
197 0 : if (ierr /= 0) then
198 0 : write (*, *) 'failed to open file for write_chem_ids'
199 0 : call mesa_error(__FILE__, __LINE__)
200 : end if
201 0 : call write_chem_ids(iounit)
202 0 : close (iounit)
203 0 : end subroutine write_chem_ids_file
204 :
205 0 : subroutine write_chem_ids(iounit)
206 : integer, intent(in) :: iounit
207 : integer :: i
208 0 : do i = 1, num_chem_isos
209 0 : write (iounit, '(5x,i5,3x,a5)') i, chem_isos%name(i)
210 : end do
211 0 : write (iounit, *)
212 0 : end subroutine write_chem_ids
213 :
214 0 : subroutine write_element_ids
215 : integer :: i
216 0 : do i = 0, max_el_z
217 0 : write (*, *) el_name(i), el_long_name(i)
218 : end do
219 0 : end subroutine write_element_ids
220 :
221 : end module mod_test_chem
222 :
223 1 : program test_chem
224 1 : use mod_test_chem
225 : implicit none
226 : !call write_element_ids; stop
227 1 : call do_test
228 1 : end program test_chem
|
