Scrambler
1
|
00001 !######################################################################### 00002 ! 00003 ! Copyright (C) 2003-2012 Department of Physics and Astronomy, 00004 ! University of Rochester, 00005 ! Rochester, NY 00006 ! 00007 ! BE_module.f90 is part of AstroBEAR. 00008 ! 00009 ! AstroBEAR is free software: you can redistribute it and/or modify 00010 ! it under the terms of the GNU General Public License as published by 00011 ! the Free Software Foundation, either version 3 of the License, or 00012 ! (at your option) any later version. 00013 ! 00014 ! AstroBEAR is distributed in the hope that it will be useful, 00015 ! but WITHOUT ANY WARRANTY; without even the implied warranty of 00016 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00017 ! GNU General Public License for more details. 00018 ! 00019 ! You should have received a copy of the GNU General Public License 00020 ! along with AstroBEAR. If not, see <http://www.gnu.org/licenses/>. 00021 ! 00022 !######################################################################### 00023 00024 MODULE BE_MODULE 00025 00026 00027 USE DataDeclarations 00028 USE GlobalDeclarations 00029 USE PhysicsDeclarations 00030 00031 IMPLICIT NONE 00032 PRIVATE ! Everything is implicitly private, i.e. accessible only 00033 ! to this module. 00034 00035 00036 00037 REAL(KIND=qPrec) :: alpha, d, e 00038 PARAMETER(alpha = 0.551d0) 00039 PARAMETER(d = 3.84d-4) 00040 PARAMETER(e = EXP(one)) 00041 00042 PUBLIC CalcAmbientParams, BE_rho 00043 00044 CONTAINS 00045 00046 SUBROUTINE CalcAmbientParams(central_rho, xi, clump_rad, M_star, at, rho_out, iso_t) 00047 00048 ! Takes 3 provided parameters and returns the mass, isothermal sound speed, and the outer 00049 !density. Formulas are taken from Stahler and Palla and from the analytical paper, 00050 !Polytropic gas spheres: An approximate analytic solution of the Lane-Emden equation, F.K. Liu 00051 00052 REAL(KIND=qPrec) :: central_rho, clump_rad, m_star, at, rho_out, iso_t 00053 REAL:: xi 00054 00055 !All quantities assume CGS and mass density 00056 00057 M_star = 8*PI*central_rho*clump_rad**3 *((1 + alpha)/(6 + xi**2) - (6*alpha)/(6 + xi**2)**2 - alpha/(3**(1/alpha)*12*e + xi**2) + D*(2**(-alpha)-1)/ (1+2**(-alpha) * D* xi**2)*(1+D*xi**2)) 00058 00059 at = (2*clump_rad*SQRT(PI*G*central_rho))/xi 00060 00061 rho_out = central_rho*BE_RHO(xi) 00062 00063 iso_t = (hmass*xmu*(at**2))/boltzmann ! assuming gamma = 1 for isothermal gas 00064 00065 00066 00067 END SUBROUTINE CalcAmbientParams 00068 00069 00070 ! Function inputs nondimensional radius, xi, and returns nondimensional rho: 00071 00072 FUNCTION BE_RHO(xi) 00073 REAL :: BE_RHO, xi 00074 00075 BE_RHO = ((1.0+((xi**2)/((3.0**(1.0/alpha))*12.0*E)))**alpha)*(E**((alpha*((xi**2.0)/6.0))/(1.0+((xi**2)/6.0))))/(((1.0+((xi**2)/6.0))**(1.0+alpha))*(1.0+(((2.0**(-alpha))-1.0)*D*(xi**2)/(1.0+(D*(xi**2)))))) 00076 00077 END FUNCTION BE_RHO 00078 00079 00080 00081 END MODULE BE_MODULE