MPI-AMRVAC 3.1
The MPI - Adaptive Mesh Refinement - Versatile Advection Code (development version)
Loading...
Searching...
No Matches
mod_variables.t
Go to the documentation of this file.
3
4 implicit none
5 public
6
7 !> Number of flux variables
8 integer :: nwflux = 0
9
10 !> Number of flux variables which need user to specify boundary type
11 integer :: nwfluxbc = 0
12
13 !> Number of auxiliary variables in w
14 integer :: nwaux = 0
15
16 !> Number of extra variables in w
17 integer :: nwextra = 0
18
19 !> Number of extra variables in wextra seperated from w
20 integer :: nw_extra = 0
21
22 !> Number of variables need reconstruction in w
23 integer :: nw_recon = 0
24
25 !> Total number of variables
26 integer :: nw = 0
27
28 !> Total number of stagger variables
29 integer :: nws = 0
30
31 !> Number of variables which need to be updated in ghost cells
32 integer :: nwgc = 0
33
34 !> Number of vector variables (used for writing output)
35 integer :: nvector = 0
36
37 !> Indices of vector variables
38 integer, dimension(:), allocatable :: iw_vector
39
40 ! the number of the first w variable to exchange ghost cells
41 integer :: iwstart=1
42
43 !> Maximum number of variables
44 integer, parameter :: max_nw = 50
45
46 ! Global indices of variables that are often used
47
48 !> Index of the (gas) density
49 integer :: iw_rho = -1
50
51 !> Indices of the momentum density
52 integer, allocatable :: iw_mom(:)
53
54 !> Index of the energy density
55 integer :: iw_e = -1
56
57 !> Index of the radiation energy density
58 integer :: iw_r_e = -1
59
60 !> Index of heat flux
61 integer :: iw_q = -1
62
63 !> Indices of the magnetic field components
64 integer, allocatable, protected :: iw_mag(:)
65
66 !> Index of the cutoff temperature for the TRAC method
67 integer :: iw_tcoff = -1
68 integer :: iw_tweight= -1
69
70 !> number of species: each species has different characterictic speeds and should
71 !> be used accordingly in mod_finite_volume and mod_finite_difference
72 integer :: number_species = 1
73
74 !> index of the var
75 !> whose velocity appears in the induction eq.
76 integer :: index_v_mag = 1
77
78 !> the indices in 1:nwflux array are assumed consecutive for each species
79 !> this array should be of size number_species and contain the first index in the array of
80 !> the number_species
81 integer, allocatable :: start_indices(:)
82 !> the indices in 1:nwflux array are assumed consecutive for each species
83 !> this array should be of size number_species and contain the last index in the array of
84 !> the first number_species, the last index for the last one is nwflux
85 integer, allocatable :: stop_indices(:)
86
87 ! indices of equi for the species index_v_mag
88 ! these are needed for hlld solver, TODO: consider moving in a separate file
89 integer :: iw_equi_rho = -1
90 integer :: iw_equi_p = -1
91
92 !> Primitive variable names
93 character(len=name_len) :: prim_wnames(max_nw)
94
95 !> Conservative variable names
96 character(len=name_len) :: cons_wnames(max_nw)
97
98contains
99
100 !> Set generic flux variable
101 function var_set_fluxvar(name_cons, name_prim, ix, need_bc) result(iw)
102 character(len=*), intent(in) :: name_cons !< Conservative name
103 character(len=*), intent(in) :: name_prim !< Primitive name
104 integer, intent(in), optional :: ix !< Optional index (to make var1, var2, ...)
105 logical, intent(in), optional :: need_bc !< Require boundary condition (default: true)
106 integer :: iw
107 logical :: add_bc
108
109 nwflux = nwflux + 1
110 nw = nw + 1
111 iw = nwflux
112
113 add_bc = .true.
114 if (present(need_bc)) add_bc = need_bc
115 if (add_bc) nwfluxbc = nwfluxbc + 1
116
117 if (.not. present(ix)) then
118 prim_wnames(nwflux) = name_cons
119 cons_wnames(nwflux) = name_prim
120 else
121 write(cons_wnames(nwflux),"(A,I0)") name_cons, ix
122 write(prim_wnames(nwflux),"(A,I0)") name_prim, ix
123 end if
124 end function var_set_fluxvar
125
126 !> Set extra variable in w, which is not advected and has no boundary conditions.
127 !> This has to be done after defining flux variables and auxiliary variables.
128 function var_set_extravar(name_cons, name_prim, ix) result(iw)
129 character(len=*), intent(in) :: name_cons, name_prim
130 integer, intent(in), optional :: ix
131 integer :: iw
132
133 nwextra = nwextra + 1
134 nw = nw + 1
135 iw = nw
136
137 if (.not. present(ix)) then
138 prim_wnames(iw) = name_cons
139 cons_wnames(iw) = name_prim
140 else
141 write(cons_wnames(iw),"(A,I0)") name_cons, ix
142 write(prim_wnames(iw),"(A,I0)") name_prim, ix
143 end if
144 end function var_set_extravar
145
146 !> Set extra variable in wextra, which is not advected and has no boundary conditions and not output in dat.
147 !> This has to be done after defining flux variables and auxiliary variables.
148 function var_set_wextra() result(iw)
149 integer :: iw
150
151 nw_extra = nw_extra + 1
152 iw = nw_extra
153
154 end function var_set_wextra
155
156 !> Set auxiliary variable, which is not advected but has boundary conditions.
157 !> This has to be done after defining flux variables.
158 function var_set_auxvar(name_cons, name_prim, ix) result(iw)
159 character(len=*), intent(in) :: name_cons, name_prim
160 integer, intent(in), optional :: ix
161 integer :: iw
162
163 nwaux = nwaux + 1
164 nw = nw + 1
165 iw = nw
166
167 if (.not. present(ix)) then
168 prim_wnames(iw) = name_cons
169 cons_wnames(iw) = name_prim
170 else
171 write(cons_wnames(iw),"(A,I0)") name_cons, ix
172 write(prim_wnames(iw),"(A,I0)") name_prim, ix
173 end if
174 end function var_set_auxvar
175
176 !> Set density variable
177 function var_set_rho() result(iw)
178 integer :: iw
179
180 nwflux = nwflux + 1
181 nwfluxbc = nwfluxbc + 1
182 nw = nw + 1
183 iw_rho = nwflux
184 iw = nwflux
185 prim_wnames(nwflux) = 'rho'
186 cons_wnames(nwflux) = 'rho'
187 end function var_set_rho
188
189 ! THE INCLUDE files cannot use other modules
190 ! mpistop replaced by errormsg, should it exit?
191 !> Exit MPI-AMRVAC with an error message
192 subroutine errormsg(message)
193
194 character(len=*), intent(in) :: message !< The error message
195
196 write(*, *) "ERROR for processor"
197 write(*, *) trim(message)
198
199
200 end subroutine errormsg
201 !> Set momentum variables
202 function var_set_momentum(ndir) result(iw)
203 integer, intent(in) :: ndir
204 integer :: iw(ndir), idir
205
206 if (allocated(iw_mom)) &
207 call errormsg("Error: set_mom was already called")
208 allocate(iw_mom(ndir))
209
210 do idir = 1, ndir
211 nwflux = nwflux + 1
212 nwfluxbc = nwfluxbc + 1
213 nw = nw + 1
214 iw_mom(idir) = nwflux
215 iw(idir) = nwflux
216 write(cons_wnames(nwflux),"(A1,I1)") "m", idir
217 write(prim_wnames(nwflux),"(A1,I1)") "v", idir
218 end do
219 end function var_set_momentum
220
221 !> Set energy variable
222 function var_set_energy() result(iw)
223 integer :: iw
224
225 nwflux = nwflux + 1
226 nwfluxbc = nwfluxbc + 1
227 nw = nw + 1
228 iw_e = nwflux
229 iw = nwflux
230 cons_wnames(nwflux) = 'e'
231 prim_wnames(nwflux) = 'p'
232 end function var_set_energy
233
234 function var_set_q() result(iw)
235 integer :: iw
236
237 nwflux = nwflux + 1
238 nwfluxbc = nwfluxbc + 1
239 nw = nw + 1
240 iw_q = nwflux
241 iw = nwflux
242 prim_wnames(nwflux) = 'q'
243 cons_wnames(nwflux) = 'q'
244 end function var_set_q
245
246 function var_set_radiation_energy() result(iw)
247 integer :: iw
248
249 nwflux = nwflux + 1
250 nwfluxbc = nwfluxbc + 1
251 nw = nw + 1
252 iw_r_e = nwflux
253 iw = nwflux
254 cons_wnames(nwflux) = 'r_e'
255 prim_wnames(nwflux) = 'r_e'
256 end function var_set_radiation_energy
257
258 !> Set magnetic field variables
259 function var_set_bfield(ndir) result(iw)
260 integer, intent(in) :: ndir
261 integer :: iw(ndir), idir
262
263 if (allocated(iw_mag)) &
264 call errormsg("Error: set_mag was already called")
265 allocate(iw_mag(ndir))
266
267 do idir = 1, ndir
268 nwflux = nwflux + 1
269 nwfluxbc = nwfluxbc + 1
270 nw = nw + 1
271 iw_mag(idir) = nwflux
272 iw(idir) = nwflux
273 write(cons_wnames(nwflux),"(A1,I1)") "b", idir
274 write(prim_wnames(nwflux),"(A1,I1)") "b", idir
275 end do
276 end function var_set_bfield
277
278end module mod_variables
Module with basic data types used in amrvac.
integer function var_set_q()
integer iw_tcoff
Index of the cutoff temperature for the TRAC method.
integer nwextra
Number of extra variables in w.
character(len=name_len), dimension(max_nw) prim_wnames
Primitive variable names.
integer nw
Total number of variables.
character(len=name_len), dimension(max_nw) cons_wnames
Conservative variable names.
integer iw_equi_rho
integer nw_recon
Number of variables need reconstruction in w.
integer nwaux
Number of auxiliary variables in w.
integer function var_set_rho()
Set density variable.
integer function var_set_energy()
Set energy variable.
integer nvector
Number of vector variables (used for writing output)
integer number_species
number of species: each species has different characterictic speeds and should be used accordingly in...
integer, dimension(:), allocatable iw_mom
Indices of the momentum density.
integer, dimension(:), allocatable start_indices
the indices in 1:nwflux array are assumed consecutive for each species this array should be of size n...
integer nws
Total number of stagger variables.
integer, dimension(:), allocatable stop_indices
the indices in 1:nwflux array are assumed consecutive for each species this array should be of size n...
integer, dimension(:), allocatable, protected iw_mag
Indices of the magnetic field components.
integer function var_set_auxvar(name_cons, name_prim, ix)
Set auxiliary variable, which is not advected but has boundary conditions. This has to be done after ...
integer iw_tweight
subroutine errormsg(message)
Exit MPI-AMRVAC with an error message.
integer function var_set_wextra()
Set extra variable in wextra, which is not advected and has no boundary conditions and not output in ...
integer, dimension(:), allocatable iw_vector
Indices of vector variables.
integer, parameter max_nw
Maximum number of variables.
integer function var_set_extravar(name_cons, name_prim, ix)
Set extra variable in w, which is not advected and has no boundary conditions. This has to be done af...
integer nwgc
Number of variables which need to be updated in ghost cells.
integer function, dimension(ndir) var_set_momentum(ndir)
Set momentum variables.
integer function var_set_radiation_energy()
integer iw_rho
Index of the (gas) density.
integer nwflux
Number of flux variables.
integer iw_r_e
Index of the radiation energy density.
integer iw_equi_p
integer index_v_mag
index of the var whose velocity appears in the induction eq.
integer function, dimension(ndir) var_set_bfield(ndir)
Set magnetic field variables.
integer iw_q
Index of heat flux.
integer nw_extra
Number of extra variables in wextra seperated from w.
integer iw_e
Index of the energy density.
integer function var_set_fluxvar(name_cons, name_prim, ix, need_bc)
Set generic flux variable.
integer nwfluxbc
Number of flux variables which need user to specify boundary type.