Blog: meeting notes: cooling.f90

File cooling.f90, 4.2 KB (added by Erica Kaminski, 6 years ago)
Line 
1!#########################################################################
2!
3! Copyright (C) 2003-2012 Department of Physics and Astronomy,
4! University of Rochester,
5! Rochester, NY
6!
7! cooling.f90 is part of AstroBEAR.
8!
9! AstroBEAR is free software: you can redistribute it and/or modify
10! it under the terms of the GNU General Public License as published by
11! the Free Software Foundation, either version 3 of the License, or
12! (at your option) any later version.
13!
14! AstroBEAR is distributed in the hope that it will be useful,
15! but WITHOUT ANY WARRANTY; without even the implied warranty of
16! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17! GNU General Public License for more details.
18!
19! You should have received a copy of the GNU General Public License
20! along with AstroBEAR. If not, see <http://www.gnu.org/licenses/>.
21!
22!#########################################################################
23!> @dir source
24!! @brief directory containing modules for handling source terms
25
26!> @file cooling.f90
27!! @brief Cooling source terms ingroup
28
29!! @file Source
30
31!> Module for handling cooling source terms
32MODULE CoolingSrc
33
34 USE DataDeclarations
35 USE PhysicsDeclarations
36 USE EOS
37 USE AnalyticCooling
38 USE IICooling
39 USE DMCooling
40 USE ZCooling
41 USE NKCooling
42 USE NeutrinoCooling
43
44 IMPLICIT NONE
45 PRIVATE
46 PUBLIC Cooling, GetCoolingStrength, CoolingInit
47
48
49CONTAINS
50
51
52
53 ! ==================================================================
54 ! = Main Cooling Section =
55 ! ==================================================================
56
57
58 !> Main cooling subroutine, loops over linked list and calls specific cooling source(s)
59 !! @params q variable vector q
60 !! @params dqdt update to variable vector q
61 !! @params x location of current cell center
62 !! @params dx size of current cell
63 SUBROUTINE Cooling(q,dqdt,ne,Temp,divv,pos)
64 ! Interface declarations
65 REAL(KIND=qPrec) :: q(:), dqdt(:), Temp, ne
66 REAL(KIND=qPREC), OPTIONAL :: divv
67 REAL(KIND=qPREC), DIMENSION(3), OPTIONAL :: pos
68
69 IF (Temp > FloorTemp) THEN
70 SELECT CASE(iCooling)
71 CASE(NoCool)
72 ! do nothing
73 CASE(AnalyticCool)
74 CALL Analytic_Cooling(q,dqdt,Temp)
75 CASE(DMCool)
76 CALL DM_Cooling(q,dqdt,ne,Temp)
77 CASE(IICool)
78 CALL II_Cooling(q,dqdt,Temp)
79 CASE(ZCool)
80 CALL Z_Cooling(q,dqdt,ne,Temp)
81 CASE(NKCool)
82 CALL NK_Cooling(q,dqdt,divv,Temp,pos)
83 CASE(NeutrinoCool)
84 CALL Neutrino_Cooling(q,dqdt,Temp)
85 !Print *, 'q(1)=', q(1), 'temp=', temp, 'dqdt=', dqdt
86 CASE DEFAULT
87 END SELECT
88 END IF
89 END SUBROUTINE Cooling
90
91 FUNCTION GetCoolingStrength(q)
92 REAL(KIND=qPrec) :: q(:)
93 REAL(KIND=qPrec) :: GetCoolingStrength,Temp, ne
94 ! Internal declarations
95 GetCoolingStrength=0d0
96 Temp=SourceTemperature(q)
97 IF (Temp > FloorTemp) THEN
98 SELECT CASE(iCooling)
99 CASE(NoCool)
100 ! do nothing
101 CASE(AnalyticCool)
102 GetCoolingStrength = AnalyticCoolingStrength(q,Temp)
103 CASE(DMCool)
104 ne=get_ne(q)
105 GetCoolingStrength = DMCoolingStrength(q,ne,Temp)
106 CASE(IICool)
107 GetCoolingStrength = IICoolingStrength(q,Temp)
108 CASE(ZCool)
109 ne=get_ne(q)
110 GetCoolingStrength = ZCoolingStrength(q,ne,Temp)
111 CASE(NeutrinoCool)
112 GetCoolingStrength = NeutrinoCoolingStrength(q, Temp)
113 CASE DEFAULT
114 END SELECT
115 END IF
116
117 !IF(MPI_ID==0) PRINT *, 'GetCoolingStrength', GetCoolingStrength
118
119 END FUNCTION GetCoolingStrength
120
121
122 !> Finalize initialization of cooling sources, including
123 !! allocating relevant tables
124 SUBROUTINE CoolingInit
125 SELECT CASE(iCooling)
126 CASE(NoCool)
127 CASE(AnalyticCool)
128 CALL InitAnalyticCool
129 CASE(DMCool)
130 CALL InitDMCool
131 CASE(IICool)
132 CALL InitIICool
133 CASE(ZCool)
134 CALL InitZCool
135 CASE(NKCool)
136 CALL Init_NKCool
137 CASE(NeutrinoCool)
138 CALL Init_NeutrinoCool
139 END SELECT
140 END SUBROUTINE CoolingInit
141
142END MODULE CoolingSrc