MPI-AMRVAC  3.0
The MPI - Adaptive Mesh Refinement - Versatile Advection Code
mod_usr_methods.t
Go to the documentation of this file.
1 !> Module with all the methods that users can customize in AMRVAC
2 !>
3 !> Each procedure pointer can be initialized in a user's mod_usr.t
5 
6  implicit none
7  public
8 
9  !> Initialize the user's settings (after initializing amrvac)
10  procedure(p_no_args), pointer :: usr_set_parameters => null()
11  !> Initialize earch grid block data
12  procedure(init_one_grid), pointer :: usr_init_one_grid => null()
13 
14  ! Boundary condition related
15  procedure(special_bc), pointer :: usr_special_bc => null()
16  procedure(special_mg_bc), pointer :: usr_special_mg_bc => null()
17 
18  procedure(internal_bc), pointer :: usr_internal_bc => null()
19 
20  ! Output related
21  procedure(p_no_args), pointer :: usr_print_log => null()
22  procedure(p_no_args), pointer :: usr_write_analysis => null()
23  procedure(transform_w), pointer :: usr_transform_w => null()
24  procedure(aux_output), pointer :: usr_aux_output => null()
25  procedure(add_aux_names), pointer :: usr_add_aux_names => null()
26  procedure(sub_modify_io), pointer :: usr_modify_output => null()
27  procedure(special_convert), pointer :: usr_special_convert => null()
28 
29  ! Called at the beginning of every time step (after determining dt)
30  procedure(process_grid), pointer :: usr_process_grid => null()
31  procedure(process_global), pointer :: usr_process_global => null()
32 
33  ! Called every time step just after advance (with w^(n+1), it^n, global_time^n)
34  procedure(process_adv_grid), pointer :: usr_process_adv_grid => null()
35  procedure(process_adv_global), pointer :: usr_process_adv_global => null()
36 
37  ! Called after initial condition before the start of the simulation
38  procedure(p_no_args), pointer :: usr_improve_initial_condition => null()
39 
40  ! Called before the start of the simulation
41  procedure(p_no_args), pointer :: usr_before_main_loop => null()
42 
43  ! Source terms
44  procedure(source), pointer :: usr_source => null()
45  procedure(get_dt), pointer :: usr_get_dt => null()
46  procedure(phys_gravity), pointer :: usr_gravity => null()
47 
48  ! Usr defined dust drag force
49  procedure(phys_dust_get_dt), pointer :: usr_dust_get_dt => null()
50  procedure(phys_dust_get_3d_dragforce), pointer :: usr_get_3d_dragforce => null()
51 
52  ! Usr defined space varying viscosity
53  procedure(phys_visco), pointer :: usr_setvisco => null()
54 
55  ! Usr defined thermal pressure for hydro & energy=.False.
56  procedure(hd_pthermal), pointer :: usr_set_pthermal => null()
57 
58  ! Refinement related procedures
59  procedure(refine_grid), pointer :: usr_refine_grid => null()
60  procedure(var_for_errest), pointer :: usr_var_for_errest => null()
61  procedure(a_refine_threshold), pointer :: usr_refine_threshold => null()
62  procedure(flag_grid), pointer :: usr_flag_grid => null()
63 
64  ! Set time-independent magnetic field for B0 splitting
65  procedure(set_b0), pointer :: usr_set_b0 => null()
66  ! Set time-independent variables for equilibrium splitting, except for B0
67  procedure(set_equi_vars), pointer :: usr_set_equi_vars => null()
68  ! Set time-independent current density for B0 splitting
69  procedure(set_j0), pointer :: usr_set_j0 => null()
70  procedure(special_resistivity), pointer :: usr_special_resistivity => null()
71 
72  ! Particle module related
73  procedure(update_payload), pointer :: usr_update_payload => null()
74  procedure(create_particles), pointer :: usr_create_particles => null()
75  procedure(check_particle), pointer :: usr_check_particle => null()
76  procedure(particle_fields), pointer :: usr_particle_fields => null()
77  procedure(particle_analytic), pointer :: usr_particle_analytic => null()
78  procedure(particle_position), pointer :: usr_particle_position => null()
79 
80  ! Radiation quantity related
81  procedure(special_opacity), pointer :: usr_special_opacity => null()
82  procedure(special_aniso_opacity), pointer :: usr_special_aniso_opacity => null()
83  procedure(special_opacity_qdot), pointer :: usr_special_opacity_qdot => null()
84  procedure(special_fluxlimiter), pointer :: usr_special_fluxlimiter => null()
85  procedure(special_diffcoef), pointer :: usr_special_diffcoef => null()
86 
87  ! Called after the mesh has been adjuste
88  procedure(after_refine), pointer :: usr_after_refine => null()
89 
90  ! initialize vector potential on cell edges for magnetic field
91  procedure(init_vector_potential), pointer :: usr_init_vector_potential => null()
92 
93  ! allow user to change inductive electric field, especially for boundary driven applications
94  procedure(set_electric_field), pointer :: usr_set_electric_field => null()
95 
96  ! allow user to specify variables at physical boundaries
97  procedure(set_wlr), pointer :: usr_set_wlr => null()
98 
99  ! allow user to specify the expansion function for the surface of a cross sectional
100  ! area of a 1D prominence, along with the analytical derivative of that function and its
101  ! primitive shape evaluated in the boundaries \int_(x_i-dx_i/2)^(x_i+dx_i/2) A(s) ds
102  procedure(set_surface), pointer :: usr_set_surface => null()
103 
104  ! for tracing field. allow user to specify variables and field
105  procedure(set_field_w), pointer :: usr_set_field_w => null()
106  procedure(set_field), pointer :: usr_set_field => null()
107 
108  abstract interface
109 
110  subroutine p_no_args()
111  end subroutine p_no_args
112 
113  !> Initialize one grid
114  subroutine init_one_grid(ixI^L,ixO^L,w,x)
116  integer, intent(in) :: ixI^L, ixO^L
117  double precision, intent(in) :: x(ixI^S,1:ndim)
118  double precision, intent(inout) :: w(ixI^S,1:nw)
119  end subroutine init_one_grid
120 
121  !> special boundary types, users must assign conservative
122  !> variables in boundaries
123  subroutine special_bc(qt,ixI^L,ixO^L,iB,w,x)
125  !> Shape of input arrays
126  integer, intent(in) :: ixI^L
127  !> Region where boundary values have to be set
128  integer, intent(in) :: ixO^L
129  !> Integer indicating direction of boundary
130  integer, intent(in) :: iB
131  double precision, intent(in) :: qt, x(ixI^S,1:ndim)
132  double precision, intent(inout) :: w(ixI^S,1:nw)
133  end subroutine special_bc
134 
135  !> Special boundary type for radiation hydrodynamics module, only used to
136  !> set the boundary conditions for the radiation energy.
137  subroutine special_mg_bc(iB)
139  integer, intent(in) :: iB
140  end subroutine special_mg_bc
141 
142  !> internal boundary, user defined
143  !> This subroutine can be used to artificially overwrite ALL conservative
144  !> variables in a user-selected region of the mesh, and thereby act as
145  !> an internal boundary region. It is called just before external (ghost cell)
146  !> boundary regions will be set by the BC selection. Here, you could e.g.
147  !> want to introduce an extra variable (nwextra, to be distinguished from nwaux)
148  !> which can be used to identify the internal boundary region location.
149  !> Its effect should always be local as it acts on the mesh.
150  subroutine internal_bc(level,qt,ixI^L,ixO^L,w,x)
152  integer, intent(in) :: ixI^L,ixO^L,level
153  double precision, intent(in) :: qt
154  double precision, intent(inout) :: w(ixI^S,1:nw)
155  double precision, intent(in) :: x(ixI^S,1:ndim)
156  end subroutine internal_bc
157 
158  !> this subroutine is ONLY to be used for computing auxiliary variables
159  !> which happen to be non-local (like div v), and are in no way used for
160  !> flux computations. As auxiliaries, they are also not advanced
161  subroutine process_grid(igrid,level,ixI^L,ixO^L,qt,w,x)
163  integer, intent(in) :: igrid,level,ixI^L,ixO^L
164  double precision, intent(in) :: qt,x(ixI^S,1:ndim)
165  double precision, intent(inout) :: w(ixI^S,1:nw)
166  end subroutine process_grid
167 
168  !> If defined, this routine is called before writing output, and it can
169  !> set/modify the variables in the w array.
170  subroutine sub_modify_io(ixI^L,ixO^L,qt,w,x)
172  integer, intent(in) :: ixI^L,ixO^L
173  double precision, intent(in) :: qt,x(ixI^S,1:ndim)
174  double precision, intent(inout) :: w(ixI^S,1:nw)
175  end subroutine sub_modify_io
176 
177  !> This subroutine is called at the beginning of each time step
178  !> by each processor. No communication is specified, so the user
179  !> has to implement MPI routines if information has to be shared
180  subroutine process_global(iit,qt)
182  integer, intent(in) :: iit
183  double precision, intent(in) :: qt
184  end subroutine process_global
185 
186  !> for processing after the advance (PIC-MHD, e.g.)
187  subroutine process_adv_grid(igrid,level,ixI^L,ixO^L,qt,w,x)
189  integer, intent(in) :: igrid,level,ixI^L,ixO^L
190  double precision, intent(in) :: qt,x(ixI^S,1:ndim)
191  double precision, intent(inout) :: w(ixI^S,1:nw)
192  end subroutine process_adv_grid
193 
194  !> for processing after the advance (PIC-MHD, e.g.)
195  subroutine process_adv_global(iit,qt)
197  integer, intent(in) :: iit
198  double precision, intent(in) :: qt
199  end subroutine process_adv_global
200 
201  !> this subroutine can be used in convert, to add auxiliary variables to the
202  !> converted output file, for further analysis using tecplot, paraview, ....
203  !> these auxiliary values need to be stored in the nw+1:nw+nwauxio slots
204  !
205  !> the array normconv can be filled in the (nw+1:nw+nwauxio) range with
206  !> corresponding normalization values (default value 1)
207  subroutine aux_output(ixI^L,ixO^L,w,x,normconv)
209  integer, intent(in) :: ixI^L,ixO^L
210  double precision, intent(in) :: x(ixI^S,1:ndim)
211  double precision :: w(ixI^S,nw+nwauxio)
212  double precision :: normconv(0:nw+nwauxio)
213  end subroutine aux_output
214 
215  !> Add names for the auxiliary variables
216  subroutine add_aux_names(varnames)
218  character(len=*) :: varnames
219  end subroutine add_aux_names
220 
221  !> Calculate w(iw)=w(iw)+qdt*SOURCE[wCT,qtC,x] within ixO for all indices
222  !> iw=iwmin...iwmax. wCT is at time qCT
223  subroutine source(qdt,ixI^L,ixO^L,iw^LIM,qtC,wCT,qt,w,x)
225  integer, intent(in) :: ixI^L, ixO^L, iw^LIM
226  double precision, intent(in) :: qdt, qtC, qt
227  double precision, intent(in) :: wCT(ixI^S,1:nw), x(ixI^S,1:ndim)
228  double precision, intent(inout) :: w(ixI^S,1:nw)
229  end subroutine source
230 
231  !> Limit "dt" further if necessary, e.g. due to the special source terms.
232  !> The getdt_courant (CFL condition) and the getdt subroutine in the AMRVACPHYS
233  !> module have already been called.
234  subroutine get_dt(w,ixI^L,ixO^L,dtnew,dx^D,x)
236  integer, intent(in) :: ixI^L, ixO^L
237  double precision, intent(in) :: dx^D, x(ixI^S,1:ndim)
238  double precision, intent(in) :: w(ixI^S,1:nw)
239  double precision, intent(inout) :: dtnew
240  end subroutine get_dt
241 
242  !> Calculate gravitational acceleration in each dimension
243  subroutine phys_gravity(ixI^L,ixO^L,wCT,x,gravity_field)
245  integer, intent(in) :: ixI^L, ixO^L
246  double precision, intent(in) :: x(ixI^S,1:ndim)
247  double precision, intent(in) :: wCT(ixI^S,1:nw)
248  double precision, intent(out) :: gravity_field(ixI^S,ndim)
249  end subroutine phys_gravity
250 
251  !> Calculate the 3d drag force of gas onto dust
252  subroutine phys_dust_get_3d_dragforce(ixI^L, ixO^L, w, x, fdrag, ptherm, vgas,dust_n_species)
254  integer, intent(in) :: ixI^L, ixO^L, dust_n_species
255  double precision, intent(in) :: x(ixI^S, 1:ndim)
256  double precision, intent(in) :: w(ixI^S, 1:nw)
257  double precision, intent(out) :: &
258  fdrag(ixI^S, 1:ndir, 1:dust_n_species)
259  double precision, intent(in) :: ptherm(ixI^S), vgas(ixI^S, ndir)
260  end subroutine phys_dust_get_3d_dragforce
261 
262  !> Calculate the time step associated with the usr drag force
263  subroutine phys_dust_get_dt(w, ixI^L, ixO^L, dtdust, dx^D, x, dust_n_species)
265  integer, intent(in) :: ixI^L, ixO^L, dust_n_species
266  double precision, intent(in) :: dx^D, x(ixI^S,1:ndim)
267  double precision, intent(in) :: w(ixI^S,1:nw)
268  double precision, intent(inout) :: dtdust(1:dust_n_species)
269  end subroutine phys_dust_get_dt
270 
271  !>Calculation anormal viscosity depending on space
272  subroutine phys_visco(ixI^L,ixO^L,x,w,mu)
274  integer, intent(in) :: ixI^L, ixO^L
275  double precision, intent(in) :: x(ixI^S,1:ndim)
276  double precision, intent(in) :: w(ixI^S,1:nw)
277  double precision, intent(out) :: mu(ixI^S)
278  end subroutine phys_visco
279 
280  !>Calculation anormal pressure for hd & energy=.False.
281  subroutine hd_pthermal(w,x,ixI^L,ixO^L,pth)
283  integer, intent(in) :: ixI^L, ixO^L
284  double precision, intent(in) :: x(ixI^S,1:ndim)
285  double precision, intent(in) :: w(ixI^S,1:nw)
286  double precision, intent(out) :: pth(ixI^S)
287  end subroutine hd_pthermal
288 
289  !> Set the "eta" array for resistive MHD based on w or the
290  !> "current" variable which has components between idirmin and 3.
291  subroutine special_resistivity(w,ixI^L,ixO^L,idirmin,x,current,eta)
293  integer, intent(in) :: ixI^L, ixO^L, idirmin
294  double precision, intent(in) :: w(ixI^S,nw), x(ixI^S,1:ndim)
295  double precision :: current(ixI^S,7-2*ndir:3), eta(ixI^S)
296  end subroutine special_resistivity
297 
298 
299  !> Set user defined opacity for use in diffusion coeff, heating and cooling, and radiation force
300  subroutine special_opacity(ixI^L,ixO^L,w,x,kappa)
302  integer, intent(in) :: ixI^L, ixO^L
303  double precision, intent(in) :: w(ixI^S,1:nw), x(ixI^S,1:ndim)
304  double precision, intent(out):: kappa(ixO^S)
305  end subroutine special_opacity
306 
307  !> Set user defined, anisotropic opacity for use in diffusion coeff, heating and cooling, and radiation force
308  subroutine special_aniso_opacity(ixI^L,ixO^L,w,x,kappa,idir)
310  integer, intent(in) :: ixI^L, ixO^L, idir
311  double precision, intent(in) :: w(ixI^S,1:nw), x(ixI^S,1:ndim)
312  double precision, intent(out):: kappa(ixO^S)
313  end subroutine special_aniso_opacity
314 
315  !> Set user defined opacity for use in diffusion coeff, heating and cooling, and radiation force. Overwrites special_opacity
316  subroutine special_opacity_qdot(ixI^L,ixO^L,w,x,kappa)
318  integer, intent(in) :: ixI^L, ixO^L
319  double precision, intent(in) :: w(ixI^S,1:nw), x(ixI^S,1:ndim)
320  double precision, intent(out):: kappa(ixO^S)
321  end subroutine special_opacity_qdot
322 
323  !> Set user defined FLD flux limiter, lambda
324  subroutine special_fluxlimiter(ixI^L,ixO^L,w,x,fld_lambda,fld_R)
326  integer, intent(in) :: ixI^L, ixO^L
327  double precision, intent(in) :: w(ixI^S,1:nw), x(ixI^S,1:ndim)
328  double precision, intent(out):: fld_lambda(ixI^S),fld_R(ixI^S)
329  end subroutine special_fluxlimiter
330 
331  !> Set user defined FLD diffusion coefficient
332  subroutine special_diffcoef(w, wCT, x, ixI^L, ixO^L)
334  integer, intent(in) :: ixI^L, ixO^L
335  double precision, intent(inout) :: w(ixI^S, 1:nw)
336  double precision, intent(in) :: wCT(ixI^S, 1:nw)
337  double precision, intent(in) :: x(ixI^S, 1:ndim)
338  end subroutine special_diffcoef
339 
340  !> Enforce additional refinement or coarsening
341  !> One can use the coordinate info in x and/or time qt=t_n and w(t_n) values w.
342  !> you must set consistent values for integers refine/coarsen:
343  !> refine = -1 enforce to not refine
344  !> refine = 0 doesn't enforce anything
345  !> refine = 1 enforce refinement
346  !> coarsen = -1 enforce to not coarsen
347  !> coarsen = 0 doesn't enforce anything
348  !> coarsen = 1 enforce coarsen
349  !> e.g. refine for negative first coordinate x < 0 as
350  !> if (any(x(ix^S,1) < zero)) refine=1
351  subroutine refine_grid(igrid,level,ixI^L,ixO^L,qt,w,x,refine,coarsen)
353  integer, intent(in) :: igrid, level, ixI^L, ixO^L
354  double precision, intent(in) :: qt, w(ixI^S,1:nw), x(ixI^S,1:ndim)
355  integer, intent(inout) :: refine, coarsen
356  end subroutine refine_grid
357 
358  !> this is the place to compute a local auxiliary variable to be used
359  !> as refinement criterion for the Lohner error estimator only
360  !> -->it is then requiring and iflag>nw
361  !> note that ixO=ixI=ixG, hence the term local (gradients need special attention!)
362  subroutine var_for_errest(ixI^L,ixO^L,iflag,w,x,var)
364  integer, intent(in) :: ixI^L,ixO^L,iflag
365  double precision, intent(in) :: w(ixI^S,1:nw), x(ixI^S,1:ndim)
366  double precision, intent(out) :: var(ixI^S)
367  end subroutine var_for_errest
368 
369  !> Here one can add a steady (time-independent) potential background field
370  subroutine set_b0(ixI^L,ixO^L,x,wB0)
372  integer, intent(in) :: ixI^L,ixO^L
373  double precision, intent(in) :: x(ixI^S,1:ndim)
374  double precision, intent(inout) :: wB0(ixI^S,1:ndir)
375  end subroutine set_b0
376 
377  !> Here one can add a time-independent background current density
378  subroutine set_j0(ixI^L,ixO^L,x,wJ0)
380  integer, intent(in) :: ixI^L,ixO^L
381  double precision, intent(in) :: x(ixI^S,1:ndim)
382  double precision, intent(inout) :: wJ0(ixI^S,7-2*ndir:ndir)
383  end subroutine set_j0
384 
385  !> Here one can add a steady (time-independent) equi vars
386  subroutine set_equi_vars(ixI^L,ixO^L,x,w0)
388  integer, intent(in) :: ixI^L,ixO^L
389  double precision, intent(in) :: x(ixI^S,1:ndim)
390  double precision, intent(inout) :: w0(ixI^S,1:number_equi_vars)
391  end subroutine set_equi_vars
392 
393  !> adjust w when restart from dat file with different w variables
394  subroutine transform_w(ixI^L,ixO^L,nw_in,w_in,x,w_out)
396  integer, intent(in) :: ixI^L, ixO^L, nw_in
397  double precision, intent(in) :: w_in(ixI^S,1:nw_in)
398  double precision, intent(in) :: x(ixI^S, 1:ndim)
399  double precision, intent(out) :: w_out(ixI^S,1:nw)
400  end subroutine transform_w
401 
402  !> use different threshold in special regions for AMR to
403  !> reduce/increase resolution there where nothing/something interesting happens.
404  subroutine a_refine_threshold(wlocal,xlocal,threshold,qt,level)
406  double precision, intent(in) :: wlocal(1:nw),xlocal(1:ndim),qt
407  double precision, intent(inout) :: threshold
408  integer, intent(in) :: level
409  end subroutine a_refine_threshold
410 
411  !> Allow user to use their own data-postprocessing procedures
412  subroutine special_convert(qunitconvert)
414  integer, intent(in) :: qunitconvert
415  character(len=20) :: userconvert_type
416  end subroutine special_convert
417 
418  !> flag=-1 : Treat all cells active, omit deactivation (onentry, default)
419  !> flag=0 : Treat as normal domain
420  !> flag=1 : Treat as passive, but reduce by safety belt
421  !> flag=2 : Always treat as passive
422  subroutine flag_grid(qt,ixI^L,ixO^L,w,x,flag)
424  integer, intent(in) :: ixI^L, ixO^L
425  integer, intent(inout) :: flag
426  double precision, intent(in) :: qt
427  double precision, intent(inout) :: w(ixI^S,1:nw)
428  double precision, intent(in) :: x(ixI^S,1:ndim)
429  end subroutine flag_grid
430 
431  !> Update payload of particles
432  subroutine update_payload(igrid,w,wold,xgrid,x,u,q,m,mypayload,mynpayload,particle_time)
434  integer, intent(in) :: igrid,mynpayload
435  double precision, intent(in) :: w(ixG^T,1:nw),wold(ixG^T,1:nw)
436  double precision, intent(in) :: xgrid(ixG^T,1:ndim),x(1:ndir),u(1:ndir),q,m,particle_time
437  double precision, intent(out) :: mypayload(mynpayload)
438  end subroutine update_payload
439 
440  !> Create particles
441  subroutine create_particles(n_particles, x, v, q, m, follow)
442  integer, intent(in) :: n_particles
443  double precision, intent(out) :: x(3, n_particles)
444  double precision, intent(out) :: v(3, n_particles)
445  double precision, intent(out) :: q(n_particles)
446  double precision, intent(out) :: m(n_particles)
447  logical, intent(out) :: follow(n_particles)
448  end subroutine create_particles
449 
450  !> Check arbitrary particle conditions or modifications
451  subroutine check_particle(igrid,x,v,q,m,follow,check)
453  integer, intent(in) :: igrid
454  double precision, intent(inout) :: x(1:ndir)
455  double precision, intent(inout) :: v(1:ndir),q,m
456  logical, intent(inout) :: follow
457  logical, intent(out) :: check
458  end subroutine check_particle
459 
460  !> Associate fields to particle
461  subroutine particle_fields(w, x, E, B)
463  double precision, intent(in) :: w(ixG^T,1:nw)
464  double precision, intent(in) :: x(ixG^T,1:ndim)
465  double precision, intent(out) :: E(ixG^T, ndir)
466  double precision, intent(out) :: B(ixG^T, ndir)
467  end subroutine particle_fields
468 
469  subroutine particle_analytic(ix, x, tloc, vec)
471  integer, intent(in) :: ix(ndir) !< Indices in gridvars
472  double precision, intent(in) :: x(ndir)
473  double precision, intent(in) :: tloc
474  double precision, intent(out) :: vec(ndir)
475  end subroutine particle_analytic
476 
477  !> User-defined particle movement
478  subroutine particle_position(x, n, tloc, tlocnew)
480  integer, intent(in) :: n
481  double precision, intent(inout) :: x(3)
482  double precision, intent(in) :: tloc, tlocnew
483  end subroutine particle_position
484 
485  subroutine after_refine(n_coarsen, n_refine)
486  integer, intent(in) :: n_coarsen
487  integer, intent(in) :: n_refine
488  end subroutine after_refine
489 
490  !> initialize vector potential on cell edges for magnetic field
491  subroutine init_vector_potential(ixI^L, ixC^L, xC, A, idir)
493 
494  integer, intent(in) :: ixI^L, ixC^L, idir
495  double precision, intent(in) :: xC(ixI^S,1:ndim)
496  double precision, intent(out) :: A(ixI^S)
497 
498  end subroutine init_vector_potential
499 
500  ! allow user to change inductive electric field, especially for boundary driven applications
501  subroutine set_electric_field(ixI^L,ixO^L,qt,qdt,fE,s)
503  integer, intent(in) :: ixI^L, ixO^L
504  double precision, intent(in) :: qt, qdt
505  type(state) :: s
506  double precision, intent(inout) :: fE(ixI^S,7-2*ndim:3)
507 
508  !integer :: ixC^L,ixA^L
509  ! For example, to set inductive electric field at bottom boundary in a 3D box for induction equation
510  ! v and b are from observational data for data-driven application
511 
512  !associate(w=>s%w,ws=>s%ws)
513 
514  !if(s%is_physical_boundary(5)) then
515  ! ixCmin^D=ixOmin^D-1;
516  ! ixCmax^D=ixOmax^D;
517  ! ixAmin^D=ixCmin^D;
518  ! ixAmax^D=ixCmax^D+1;
519  ! fE(nghostcells^%3ixA^S,1)=-ws(nghostcells^%3ixA^S,3)*w(nghostcells^%3ixA^S,mom(2))
520  ! fE(nghostcells^%3ixA^S,2)= ws(nghostcells^%3ixA^S,3)*w(nghostcells^%3ixA^S,mom(1))
521  ! ixAmin^D=ixCmin^D+kr(2,^D);
522  ! ixAmax^D=ixCmax^D+kr(2,^D);
523  ! fE(nghostcells^%3ixC^S,1)=0.5d0*(fE(nghostcells^%3ixC^S,1)+fE(nghostcells^%3ixA^S,1))*&
524  ! qdt*s%dsC(nghostcells^%3ixC^S,1)
525  ! ixAmin^D=ixCmin^D+kr(1,^D);
526  ! ixAmax^D=ixCmax^D+kr(1,^D);
527  ! fE(nghostcells^%3ixC^S,2)=0.5d0*(fE(nghostcells^%3ixC^S,2)+fE(nghostcells^%3ixA^S,2))*&
528  ! qdt*s%dsC(nghostcells^%3ixC^S,2)
529  !end if
530 
531  !end associate
532 
533  end subroutine set_electric_field
534 
535  !> allow user to specify 'variables' left and right state at physical boundaries to control flux through the boundary surface
536  subroutine set_wlr(ixI^L,ixO^L,qt,wLC,wRC,wLp,wRp,s,idir)
538  integer, intent(in) :: ixI^L, ixO^L, idir
539  double precision, intent(in) :: qt
540  double precision, intent(inout) :: wLC(ixI^S,1:nw), wRC(ixI^S,1:nw)
541  double precision, intent(inout) :: wLp(ixI^S,1:nw), wRp(ixI^S,1:nw)
542  type(state) :: s
543 
544  !if(s%is_physical_boundary(3).and.idir==2) then
545  ! wLp(ixOmin2^%2ixO^S,mom(1))=1.d0
546  ! wRp(ixOmin2^%2ixO^S,mom(1))=wRp(ixOmin2^%2ixO^S,mom(1))
547  ! wLC(ixOmin2^%2ixO^S,mom(1))=wLp(ixOmin2^%2ixO^S,mom(1))*wLp(ixOmin2^%2ixO^S,rho_)
548  ! wRC(ixOmin2^%2ixO^S,mom(1))=wRp(ixOmin2^%2ixO^S,mom(1))*wRp(ixOmin2^%2ixO^S,rho_)
549  !end if
550  end subroutine set_wlr
551 
552  subroutine set_surface(ixI^L,x,delx,exp_factor,del_exp_factor,exp_factor_primitive)
554  integer, intent(in) :: ixI^L
555  double precision, intent(in) :: delx(ixI^S,1:ndim), x(ixI^S,1:ndim)
556  double precision, intent(out) :: exp_factor(ixI^S), del_exp_factor(ixI^S)
557  double precision, intent(out) :: exp_factor_primitive(ixI^S)
558 
559  end subroutine set_surface
560 
561  subroutine set_field_w(igrid,ip,xf,wP,wL,numP,nwP,nwL,dL,forward,ftype,tcondi)
563  !use mod_point_searching
564 
565  integer, intent(in) :: igrid,ip,numP,nwP,nwL
566  double precision, intent(in) :: xf(numP,ndim)
567  double precision, intent(inout) :: wP(numP,nwP),wL(1+nwL)
568  double precision, intent(in) :: dL
569  logical, intent(in) :: forward
570  character(len=std_len), intent(in) :: ftype,tcondi
571 
572  !double precision :: xpp(1:ndim),wpp(1:nw)
573 
574  !! nwP=2,nwL=0. get rho/T at line
575  !if (tcondi=='user') then
576  ! xpp(1:ndim)=xf(ip,1:ndim)
577  ! call get_point_w_ingrid(igrid,xpp,wpp,'primitive')
578  ! wP(ip,1)=wpp(rho_)
579  ! wP(ip,2)=wpp(p_)/wpp(rho_)
580  !endif
581 
582  end subroutine set_field_w
583 
584  subroutine set_field(xfn,igrid,field,ftype)
586 
587  integer,intent(in) :: igrid
588  double precision, intent(in) :: xfn(ndim)
589  double precision, intent(inout) :: field(ndim)
590  character(len=std_len), intent(in) :: ftype
591 
592  !if (ftype='xdir') then
593  ! field(:)=zero
594  ! field(1)=1.d0
595  !endif
596 
597  end subroutine set_field
598 
599  end interface
600 
601 end module mod_usr_methods
use different threshold in special regions for AMR to reduce/increase resolution there where nothing/...
Add names for the auxiliary variables.
this subroutine can be used in convert, to add auxiliary variables to the converted output file,...
Check arbitrary particle conditions or modifications.
flag=-1 : Treat all cells active, omit deactivation (onentry, default) flag=0 : Treat as normal domai...
Limit "dt" further if necessary, e.g. due to the special source terms. The getdt_courant (CFL conditi...
Calculation anormal pressure for hd & energy=.False.
initialize vector potential on cell edges for magnetic field
internal boundary, user defined This subroutine can be used to artificially overwrite ALL conservativ...
Associate fields to particle.
User-defined particle movement.
Calculate the 3d drag force of gas onto dust.
Calculate the time step associated with the usr drag force.
Calculate gravitational acceleration in each dimension.
Calculation anormal viscosity depending on space.
for processing after the advance (PIC-MHD, e.g.)
for processing after the advance (PIC-MHD, e.g.)
This subroutine is called at the beginning of each time step by each processor. No communication is s...
this subroutine is ONLY to be used for computing auxiliary variables which happen to be non-local (li...
Enforce additional refinement or coarsening One can use the coordinate info in x and/or time qt=t_n a...
Here one can add a steady (time-independent) equi vars.
Calculate w(iw)=w(iw)+qdt*SOURCE[wCT,qtC,x] within ixO for all indices iw=iwmin......
Set user defined, anisotropic opacity for use in diffusion coeff, heating and cooling,...
special boundary types, users must assign conservative variables in boundaries
Allow user to use their own data-postprocessing procedures.
Set user defined FLD diffusion coefficient.
Set user defined FLD flux limiter, lambda.
Special boundary type for radiation hydrodynamics module, only used to set the boundary conditions fo...
Set user defined opacity for use in diffusion coeff, heating and cooling, and radiation force....
Set user defined opacity for use in diffusion coeff, heating and cooling, and radiation force.
Set the "eta" array for resistive MHD based on w or the "current" variable which has components betwe...
If defined, this routine is called before writing output, and it can set/modify the variables in the ...
adjust w when restart from dat file with different w variables
Update payload of particles.
this is the place to compute a local auxiliary variable to be used as refinement criterion for the Lo...
This module contains definitions of global parameters and variables and some generic functions/subrou...
Module with all the methods that users can customize in AMRVAC.
procedure(source), pointer usr_source
procedure(special_resistivity), pointer usr_special_resistivity
procedure(special_opacity), pointer usr_special_opacity
procedure(process_grid), pointer usr_process_grid
procedure(phys_visco), pointer usr_setvisco
procedure(particle_position), pointer usr_particle_position
procedure(check_particle), pointer usr_check_particle
procedure(p_no_args), pointer usr_improve_initial_condition
procedure(a_refine_threshold), pointer usr_refine_threshold
procedure(set_surface), pointer usr_set_surface
procedure(phys_dust_get_dt), pointer usr_dust_get_dt
procedure(phys_gravity), pointer usr_gravity
procedure(aux_output), pointer usr_aux_output
procedure(p_no_args), pointer usr_print_log
procedure(phys_dust_get_3d_dragforce), pointer usr_get_3d_dragforce
procedure(special_diffcoef), pointer usr_special_diffcoef
procedure(process_adv_grid), pointer usr_process_adv_grid
procedure(particle_analytic), pointer usr_particle_analytic
procedure(special_convert), pointer usr_special_convert
procedure(create_particles), pointer usr_create_particles
procedure(init_one_grid), pointer usr_init_one_grid
Initialize earch grid block data.
procedure(update_payload), pointer usr_update_payload
procedure(p_no_args), pointer usr_write_analysis
procedure(sub_modify_io), pointer usr_modify_output
procedure(p_no_args), pointer usr_before_main_loop
procedure(special_fluxlimiter), pointer usr_special_fluxlimiter
procedure(set_field_w), pointer usr_set_field_w
procedure(flag_grid), pointer usr_flag_grid
procedure(process_global), pointer usr_process_global
procedure(special_bc), pointer usr_special_bc
procedure(process_adv_global), pointer usr_process_adv_global
procedure(internal_bc), pointer usr_internal_bc
procedure(set_equi_vars), pointer usr_set_equi_vars
procedure(special_mg_bc), pointer usr_special_mg_bc
procedure(set_j0), pointer usr_set_j0
procedure(special_opacity_qdot), pointer usr_special_opacity_qdot
procedure(particle_fields), pointer usr_particle_fields
procedure(refine_grid), pointer usr_refine_grid
procedure(hd_pthermal), pointer usr_set_pthermal
procedure(init_vector_potential), pointer usr_init_vector_potential
procedure(p_no_args), pointer usr_set_parameters
Initialize the user's settings (after initializing amrvac)
procedure(var_for_errest), pointer usr_var_for_errest
procedure(set_b0), pointer usr_set_b0
procedure(set_electric_field), pointer usr_set_electric_field
procedure(special_aniso_opacity), pointer usr_special_aniso_opacity
procedure(set_wlr), pointer usr_set_wlr
procedure(transform_w), pointer usr_transform_w
procedure(after_refine), pointer usr_after_refine
procedure(get_dt), pointer usr_get_dt
procedure(set_field), pointer usr_set_field
procedure(add_aux_names), pointer usr_add_aux_names