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