Line data Source code
1 : ! ***********************************************************************
2 : !
3 : ! Copyright (C) 2010 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 other_kap
21 :
22 : ! consult star/other/README for general usage instructions
23 : ! control name: use_other_kap = .true.
24 : ! procedure pointers: s% other_kap_get => my_routine
25 : ! (if using OP MONO) s% other_kap_get_op_mono => my_routine
26 :
27 : implicit none
28 :
29 : contains
30 :
31 0 : subroutine null_other_kap_get( &
32 : id, k, handle, species, chem_id, net_iso, xa, &
33 : log10_rho, log10_T, &
34 : lnfree_e, d_lnfree_e_dlnRho, d_lnfree_e_dlnT, &
35 : eta, d_eta_dlnRho, d_eta_dlnT, &
36 0 : kap_fracs, kap, dln_kap_dlnRho, dln_kap_dlnT, dln_kap_dxa, ierr)
37 : use star_def
38 : use kap_def, only: num_kap_fracs
39 :
40 : ! INPUT
41 : integer, intent(in) :: id ! star id if available; 0 otherwise
42 : integer, intent(in) :: k ! cell number or 0 if not for a particular cell
43 : integer, intent(in) :: handle ! from alloc_kap_handle
44 : integer, intent(in) :: species
45 : integer, pointer :: chem_id(:) ! maps species to chem id
46 : ! index from 1 to species
47 : ! value is between 1 and num_chem_isos
48 : integer, pointer :: net_iso(:) ! maps chem id to species number
49 : ! index from 1 to num_chem_isos (defined in chem_def)
50 : ! value is 0 if the iso is not in the current net
51 : ! else is value between 1 and number of species in current net
52 : real(dp), intent(in) :: xa(:) ! mass fractions
53 : real(dp), intent(in) :: log10_rho ! density
54 : real(dp), intent(in) :: log10_T ! temperature
55 : real(dp), intent(in) :: lnfree_e, d_lnfree_e_dlnRho, d_lnfree_e_dlnT
56 : ! free_e := total combined number per nucleon of free electrons and positrons
57 : real(dp), intent(in) :: eta, d_eta_dlnRho, d_eta_dlnT
58 : ! eta := electron degeneracy parameter
59 :
60 : ! OUTPUT
61 : real(dp), intent(out) :: kap_fracs(num_kap_fracs)
62 : real(dp), intent(out) :: kap ! opacity
63 : real(dp), intent(out) :: dln_kap_dlnRho ! partial derivative at constant T
64 : real(dp), intent(out) :: dln_kap_dlnT ! partial derivative at constant Rho
65 : real(dp), intent(out) :: dln_kap_dxa(:) ! partial derivative w.r.t. to species
66 : integer, intent(out) :: ierr ! 0 means AOK.
67 :
68 0 : kap_fracs = 0; kap = 0; dln_kap_dlnRho = 0; dln_kap_dlnT = 0; dln_kap_dxa = 0
69 :
70 0 : write (*, *) 'no implementation for other_kap_get'
71 0 : ierr = -1
72 :
73 0 : end subroutine null_other_kap_get
74 :
75 0 : subroutine null_other_kap_get_op_mono( &
76 : handle, zbar, log10_rho, log10_T, &
77 : ! args for op_mono
78 : use_op_mono_alt_get_kap, &
79 : nel, izzp, fap, fac, screening, umesh, semesh, ff, rs, &
80 : ! output
81 : kap, dlnkap_dlnRho, dlnkap_dlnT, ierr)
82 0 : use star_def
83 : integer, intent(in) :: handle ! from alloc_kap_handle
84 : real(dp), intent(in) :: zbar ! average ionic charge (for electron conduction)
85 : real(dp), intent(in) :: log10_rho ! the density
86 : real(dp), intent(in) :: log10_T ! the temperature
87 : ! args for op_mono_get_kap
88 : logical, intent(in) :: use_op_mono_alt_get_kap
89 : integer, intent(in) :: nel
90 : integer, intent(in) :: izzp(:) ! (nel)
91 : real(dp), intent(in) :: fap(:) ! (nel) number fractions of elements
92 : real(dp), intent(in) :: fac(:) ! (nel) scale factors for element opacity
93 : logical, intent(in) :: screening
94 : ! work arrays
95 : real, pointer :: umesh(:), semesh(:), ff(:, :, :, :), rs(:, :, :)
96 : ! umesh(nptot)
97 : ! umesh(nptot)
98 : ! ff(nptot, ipe, 4, 4)
99 : ! rs(nptot, 4, 4)
100 : ! ss(nptot, nrad, 4, 4)
101 : ! output
102 : real(dp), intent(out) :: kap ! opacity
103 : real(dp), intent(out) :: dlnkap_dlnRho ! partial derivative at constant T
104 : real(dp), intent(out) :: dlnkap_dlnT ! partial derivative at constant Rho
105 : integer, intent(out) :: ierr ! 0 means AOK.
106 0 : kap = 0; dlnkap_dlnRho = 0; dlnkap_dlnT = 0
107 0 : ierr = -1
108 0 : end subroutine null_other_kap_get_op_mono
109 :
110 : end module other_kap
111 :
|
