eos module Interface

The primary entry point to the eos module is through the routine eosDT_get. Broadly, one provides the density, temperature and full composition information. Then the EOS returns its main set of results, their temperature and density derivatives, and the composition derivatives of a small subset of the results.

 1      subroutine eosDT_get( &
 2               handle, species, chem_id, net_iso, xa, &
 3               Rho, logRho, T, logT, &
 4               res, d_dlnd, d_dlnT, d_dxa, ierr)
 5         use eos_def
 6         use eosDT_eval, only: Get_eosDT_Results
 7         use chem_lib, only: basic_composition_info
 8         integer, intent(in) :: handle ! eos handle; from star, pass s% eos_handle
 9         integer, intent(in) :: species ! number of species
10         integer, pointer :: chem_id(:) ! maps species to chem id
11         integer, pointer :: net_iso(:) ! maps chem id to species number
12         real(dp), intent(in) :: xa(:) ! mass fractions         
13         real(dp), intent(in) :: Rho, logRho ! the density
14         real(dp), intent(in) :: T, logT ! the temperature         
15         real(dp), intent(inout) :: res(:) ! (num_eos_basic_results)         
16         real(dp), intent(inout) :: d_dlnd(:) ! (num_eos_basic_results) 
17         real(dp), intent(inout) :: d_dlnT(:) ! (num_eos_basic_results)
18         real(dp), intent(inout) :: d_dxa(:,:) ! (num_eos_d_dxa_results,species)
19         integer, intent(out) :: ierr ! 0 means AOK.
20         real(dp), allocatable :: d_dxa_eos(:,:) ! eos internally returns derivs of all quantities
21         type (EoS_General_Info), pointer :: rq
22         real(dp) :: X, Y, Z, abar, zbar, z2bar, z53bar, ye, mass_correction, sumx
23         call get_eos_ptr(handle,rq,ierr)
24         if (ierr /= 0) then
25            write(*,*) 'invalid handle for eos_get -- did you call alloc_eos_handle?'
26            return
27         end if
28         call basic_composition_info( &
29            species, chem_id, xa, X, Y, Z, &
30            abar, zbar, z2bar, z53bar, ye, mass_correction, sumx)
31         allocate(d_dxa_eos(num_eos_basic_results, species))
32         call Get_eosDT_Results( &
33            rq, Z, X, abar, zbar, &
34            species, chem_id, net_iso, xa, &
35            Rho, logRho, T, logT, &
36            res, d_dlnd, d_dlnT, d_dxa_eos, ierr)
37         ! only return 1st two d_dxa results (lnE and lnPgas) to star
38         d_dxa(1:num_eos_d_dxa_results,1:species) = d_dxa_eos(1:num_eos_d_dxa_results, 1:species)
39      end subroutine eosDT_get

The underlying EOS is in a density-temperature basis, but if one has only density or temperature, there are search interfaces (eosDT_get_Rho and eosDT_get_T) for searching for the other, given some another known EOS quantity (e.g., lnE).

 1      subroutine eosDT_get_T( &
 2               handle, &
 3               species, chem_id, net_iso, xa, &
 4               logRho, which_other, other_value, &
 5               logT_tol, other_tol, max_iter, logT_guess, &
 6               logT_bnd1, logT_bnd2, other_at_bnd1, other_at_bnd2, &
 7               logT_result, res, d_dlnRho_const_T, d_dlnT_const_Rho, &
 8               d_dxa_const_TRho, eos_calls, ierr)
 9
10         ! finds log10 T given values for density and 'other', and initial guess for temperature.
11         ! does up to max_iter attempts until logT changes by less than tol.
12
13         ! 'other' can be any of the basic result variables for the eos
14         ! specify 'which_other' by means of the definitions in eos_def (e.g., i_lnE)
15
16         use chem_lib, only: basic_composition_info
17         use eos_def
18         use eosDT_eval, only : get_T
19
20         integer, intent(in) :: handle ! eos handle; from star, pass s% eos_handle
21
22         integer, intent(in) :: species ! number of species
23         integer, pointer :: chem_id(:) ! maps species to chem id
24            ! index from 1 to species
25            ! value is between 1 and num_chem_isos
26         integer, pointer :: net_iso(:) ! maps chem id to species number
27            ! index from 1 to num_chem_isos (defined in chem_def)
28            ! value is 0 if the iso is not in the current net
29            ! else is value between 1 and number of species in current net
30         real(dp), intent(in) :: xa(:) ! mass fractions
31
32         real(dp), intent(in) :: logRho ! log10 of density
33         integer, intent(in) :: which_other ! from eos_def.  e.g., i_lnE
34         real(dp), intent(in) :: other_value ! desired value for the other variable
35         real(dp), intent(in) :: other_tol
36
37         real(dp), intent(in) :: logT_tol
38         integer, intent(in) :: max_iter ! max number of iterations
39
40         real(dp), intent(in) :: logT_guess ! log10 of temperature
41         real(dp), intent(in) :: logT_bnd1, logT_bnd2 ! bounds for logT
42            ! if don't know bounds, just set to arg_not_provided (defined in const_def)
43         real(dp), intent(in) :: other_at_bnd1, other_at_bnd2 ! values at bounds
44            ! if don't know these values, just set to arg_not_provided (defined in const_def)
45
46         real(dp), intent(inout) :: logT_result ! log10 of temperature
47         real(dp), intent(inout) :: res(:) ! (num_eos_basic_results)
48         real(dp), intent(inout) :: d_dlnRho_const_T(:) ! (num_eos_basic_results)
49         real(dp), intent(inout) :: d_dlnT_const_Rho(:) ! (num_eos_basic_results)
50         real(dp), intent(inout) :: d_dxa_const_TRho(:,:) ! (num_eos_d_dxa_results, species)
51         real(dp), allocatable :: d_dxa_eos(:,:) ! eos internally returns derivs of all quantities
52
53         integer, intent(out) :: eos_calls
54         integer, intent(out) :: ierr ! 0 means AOK.
55
56         ! compute composition info
57         real(dp) :: Y, Z, X, abar, zbar, z2bar, z53bar, ye, mass_correction, sumx
58
59         call basic_composition_info( &
60            species, chem_id, xa, X, Y, Z, &
61            abar, zbar, z2bar, z53bar, ye, mass_correction, sumx)
62
63         allocate(d_dxa_eos(num_eos_basic_results, species))
64
65         call get_T( &
66               handle, Z, X, abar, zbar, &
67               species, chem_id, net_iso, xa, &
68               logRho, which_other, other_value, &
69               logT_tol, other_tol, max_iter, logT_guess, &
70               logT_bnd1, logT_bnd2,  other_at_bnd1, other_at_bnd2, &
71               logT_result, res, d_dlnRho_const_T, d_dlnT_const_Rho, &
72               d_dxa_eos, eos_calls, ierr)
73         ! only return 1st two d_dxa results (lnE and lnPgas) to star
74         d_dxa_const_TRho(1:num_eos_d_dxa_results,1:species) = d_dxa_eos(1:num_eos_d_dxa_results, 1:species)
75
76         deallocate(d_dxa_eos)
77
78      end subroutine eosDT_get_T

For legacy reasons, there is also an eosPT_get entry point. (The same result could ultimately be achieved via eosDT_get_Rho.) Internally, this is also implemented as a root-find using the standard density-temperature EOS.

 1      subroutine eosPT_get( &
 2               handle, &
 3               species, chem_id, net_iso, xa, &
 4               Pgas, log10Pgas, T, log10T, &
 5               Rho, log10Rho, dlnRho_dlnPgas_const_T, dlnRho_dlnT_const_Pgas, &
 6               res, d_dlnRho_const_T, d_dlnT_const_Rho, &
 7               d_dxa_const_TRho, ierr)
 8
 9         use chem_lib, only: basic_composition_info
10         use eos_def
11         use eosPT_eval, only: Get_eosPT_Results
12
13         ! INPUT
14
15         integer, intent(in) :: handle ! eos handle; from star, pass s% eos_handle
16
17         integer, intent(in) :: species ! number of species
18         integer, pointer :: chem_id(:) ! maps species to chem id
19            ! index from 1 to species
20            ! value is between 1 and num_chem_isos
21         integer, pointer :: net_iso(:) ! maps chem id to species number
22            ! index from 1 to num_chem_isos (defined in chem_def)
23            ! value is 0 if the iso is not in the current net
24            ! else is value between 1 and number of species in current net
25         real(dp), intent(in) :: xa(:) ! mass fractions
26
27         real(dp), intent(in) :: Pgas, log10Pgas ! the gas pressure
28            ! provide both if you have them.  else pass one and set the other to arg_not_provided
29            ! "arg_not_provided" is defined in mesa const_def
30
31         real(dp), intent(in) :: T, log10T ! the temperature
32            ! provide both if you have them.  else pass one and set the other to arg_not_provided
33
34         ! OUTPUT
35
36         real(dp), intent(out) :: Rho, log10Rho ! density
37         real(dp), intent(out) :: dlnRho_dlnPgas_const_T
38         real(dp), intent(out) :: dlnRho_dlnT_const_Pgas
39
40         real(dp), intent(inout) :: res(:) ! (num_eos_basic_results)
41
42         ! partial derivatives of the basic results
43
44         real(dp), intent(inout) :: d_dlnRho_const_T(:) ! (num_eos_basic_results)
45         ! d_dlnRho_const_T(i) = d(res(i))/dlnd|T,X where X = composition
46         real(dp), intent(inout) :: d_dlnT_const_Rho(:) ! (num_eos_basic_results)
47         ! d_dlnT_const_Rho(i) = d(res(i))/dlnT|Rho,X where X = composition
48         real(dp), intent(inout) :: d_dxa_const_TRho(:,:) ! (num_eos_d_dxa_results, species)
49         ! d_dxa_const_TRho(i) = d(res(i))/X|T,Rho,X where X = composition
50
51         real(dp), allocatable :: d_dxa_eos(:,:) ! eos internally returns derivs of all quantities
52
53         integer, intent(out) :: ierr ! 0 means AOK.
54
55         type (EoS_General_Info), pointer :: rq
56
57         real(dp) :: X, Y, Z, abar, zbar, z2bar, z53bar, ye, mass_correction, sumx
58
59         call get_eos_ptr(handle,rq,ierr)
60         if (ierr /= 0) then
61            write(*,*) 'invalid handle for eos -- did you call alloc_eos_handle?'
62            return
63         end if
64
65         call basic_composition_info( &
66            species, chem_id, xa, X, Y, Z, &
67            abar, zbar, z2bar, z53bar, ye, mass_correction, sumx)
68
69         allocate(d_dxa_eos(num_eos_basic_results, species))
70
71         call Get_eosPT_Results( &
72                  rq, Z, X, abar, zbar, &
73                  species, chem_id, net_iso, xa, &
74                  Pgas, log10Pgas, T, log10T, &
75                  Rho, log10Rho, dlnRho_dlnPgas_const_T, dlnRho_dlnT_const_Pgas, &
76                  res, d_dlnRho_const_T, d_dlnT_const_Rho, d_dxa_eos, &
77                  ierr)
78         ! only return 1st two d_dxa results (lnE and lnPgas) to star
79         d_dxa_const_TRho(1:num_eos_d_dxa_results,1:species) = d_dxa_eos(1:num_eos_d_dxa_results, 1:species)
80
81      end subroutine eosPT_get