MPI-AMRVAC  3.0
The MPI - Adaptive Mesh Refinement - Versatile Advection Code
mod_global_parameters.t
Go to the documentation of this file.
1 !> This module contains definitions of global parameters and variables and some
2 !> generic functions/subroutines used in AMRVAC.
3 !>
7  use mpi
8  use mod_constants
9  use mod_variables
10  use mod_basic_types
11 
12  implicit none
13  public
14 
15  ! Parameters
16  character(len=*), parameter :: undefined = 'undefined'
17 
18  !> The number of MPI tasks
19  integer :: npe
20 
21  !> The rank of the current MPI task
22  integer :: mype
23 
24  !> The MPI communicator
25  integer :: icomm
26 
27  !> A global MPI error return code
28  integer :: ierrmpi
29 
30  !> MPI file handle for logfile
31  integer :: log_fh
32  !> MPI type for block including ghost cells and its size
33  integer :: type_block, size_block
34  !> MPI type for block coarsened by 2, and for its children blocks
36  !> MPI type for staggered block coarsened by 2, and for its children blocks
37  integer :: type_coarse_block_stg(^nd,2^d&), type_sub_block_stg(^ND,2^D&)
38  !> MPI type for IO: block excluding ghost cells
40  !> MPI type for IO of staggered variables
42  !> MPI type for IO: cell corner (xc) or cell center (xcc) coordinates
44  !> MPI type for IO: cell corner (wc) or cell center (wcc) variables
46 
47 
48  ! geometry and domain setups
49 
50  !> the mesh range (within a block with ghost cells)
51  integer :: ixm^ll
52 
53  !> minimum and maximum domain boundaries for each dimension
54  double precision :: xprob^l
55 
56  !> Indices for cylindrical coordinates FOR TESTS, negative value when not used:
57  integer :: r_ = -1
58  integer :: phi_ = -1
59  integer :: z_ = -1
60 
61  !> Number of spatial dimensions for grid variables
62  integer, parameter :: ndim=^nd
63 
64  !> Number of spatial dimensions (components) for vector variables
65  integer :: ndir=ndim
66 
67  !> Cartesian geometry or not
68  logical :: slab
69 
70  !> uniform Cartesian geometry or not (stretched Cartesian)
71  logical :: slab_uniform
72 
73  !> number of grid blocks in domain per dimension, in array over levels
74  integer, dimension(:), allocatable :: ng^d
75  !> extent of grid blocks in domain per dimension, in array over levels
76  double precision, dimension(:), allocatable :: dg^d
77 
78  !> number of cells for each dimension in level-one mesh
79  integer :: domain_nx^d
80 
81  !> number of cells for each dimension in grid block excluding ghostcells
82  integer :: block_nx^d
83 
84  !> Lower index of grid block arrays (always 1)
85  integer, parameter :: {ixglo^d = 1|, }
86 
87  !> Upper index of grid block arrays
88  integer :: ixghi^d
89 
90  !> Lower index of stagger grid block arrays (always 0)
91  integer, parameter :: {ixgslo^d = 0|, }
92 
93  !> Upper index of stagger grid block arrays
94  integer :: ixgshi^d
95 
96  !> Number of ghost cells surrounding a grid
97  integer :: nghostcells = 2
98 
99  integer, parameter :: stretch_none = 0 !< No stretching
100  integer, parameter :: stretch_uni = 1 !< Unidirectional stretching from a side
101  integer, parameter :: stretch_symm = 2 !< Symmetric stretching around the center
102 
103  !> If true, adjust mod_geometry routines to account for grid stretching (but
104  !> the flux computation will not)
106  !> True if a dimension is stretched
107  logical :: stretched_dim(ndim)
108  !> What kind of stretching is used per dimension
109  integer :: stretch_type(ndim)
110  !> stretch factor between cells at AMR level 1, per dimension
111  double precision :: qstretch_baselevel(ndim)
112  !> (even) number of (symmetrically) stretched
113  !> blocks at AMR level 1, per dimension
115  !> (even) number of (symmetrically) stretched blocks per level and dimension
116  integer, allocatable :: nstretchedblocks(:,:)
117  !> physical extent of stretched border in symmetric stretching
118  double precision :: xstretch^d
119  !> Stretching factors and first cell size for each AMR level and dimension
120  double precision, allocatable :: qstretch(:,:), dxfirst(:,:), &
121  dxfirst_1mq(:,:), dxmid(:,:)
122 
123  !> grid hierarchy info (level and grid indices)
124  integer, parameter :: nodehi=^nd+1
125  integer, parameter :: plevel_=1
126  integer, parameter :: pig^d_=plevel_+^d
127 
128  integer, allocatable :: node(:,:)
129  integer, allocatable :: node_sub(:,:)
130 
131  !> grid location info (corner coordinates and grid spacing)
132  integer, parameter :: rnodehi=3*^nd
133  integer, parameter :: rpxmin0_=0
134  integer, parameter :: rpxmin^d_=rpxmin0_+^d
135  integer, parameter :: rpxmax0_=^nd
136  integer, parameter :: rpxmax^d_=rpxmax0_+^d
137  integer, parameter :: rpdx^d_=2*^nd+^d
138 
139  !> Corner coordinates
140  double precision, allocatable :: rnode(:,:)
141  double precision, allocatable :: rnode_sub(:,:)
142 
143  double precision, allocatable :: dx(:,:)
144  double precision :: dxlevel(ndim)
145 
146  ! IO related quantities
147 
148  !> Maximum number of saves that can be defined by tsave or itsave
149  integer, parameter :: nsavehi=100
150 
151  !> Number of output methods
152  integer, parameter :: nfile = 5
153 
154  !> index number of the latest existing data file
155  integer :: index_latest_data
156 
157  !> Names of the output methods
158  character(len=40), parameter :: output_names(nfile) = &
159  ['log ', 'normal ', 'slice ', 'collapsed', 'analysis ']
160 
161  !> User parameter file
162  character(len=std_len) :: usr_filename
163 
164  !> If collapse(DIM) is true, generate output integrated over DIM
165  logical :: collapse(ndim)
166 
167  !> Save output of type N on times tsave(:, N)
168  double precision :: tsave(nsavehi,nfile)
169 
170  double precision :: tsavelast(nfile)
171 
172  !> Repeatedly save output of type N when dtsave(N) simulation time has passed
173  double precision :: dtsave(nfile)
174 
175  !> Save output of type N on iterations itsave(:, N)
176  integer :: itsave(nsavehi,nfile)
177 
178  integer :: itsavelast(nfile)
179 
180  !> Repeatedly save output of type N when ditsave(N) time steps have passed
181  integer :: ditsave(nfile)
182 
183  integer :: isavet(nfile)
184 
185  integer :: isaveit(nfile)
186 
187  !> Start of read out (not counting specified read outs)
188  double precision :: tsavestart(nfile)
189 
190  !> The level at which to produce line-integrated / collapsed output
191  integer :: collapselevel
192 
193  !> Number of saved files of each type
194  integer :: n_saves(1:nfile)
195 
196  !> whether or not to save an output file
197  logical :: save_file(nfile)
198 
199  !> to monitor timeintegration loop at given wall-clock time intervals
200  double precision :: time_between_print
201 
202  !> accumulated wall-clock time spent on boundary conditions
203  double precision :: time_bc
204 
205  !> IO: snapshot and collapsed views output numbers/labels
207 
208  !> Constant indicating log output
209  integer, parameter :: filelog_ = 1
210 
211  !> Constant indicating regular output
212  integer, parameter :: fileout_ = 2
213 
214  !> Constant indicating slice output
215  integer, parameter :: fileslice_ = 3
216 
217  !> Constant indicating collapsed output
218  integer, parameter :: filecollapse_ = 4
219 
220  !> Constant indicating analysis output (see @ref analysis.md)
221  integer, parameter :: fileanalysis_ = 5
222 
223  !> Unit for standard input
224  integer, parameter :: unitstdin=5
225 
226  !> Unit for standard output
227  integer, parameter :: unitterm=6
228 
229  !> Unit for error messages
230  integer, parameter :: uniterr=6
231 
232  !> file handle for IO
233  integer, parameter :: unitpar=9
234  integer, parameter :: unitconvert=10
235  integer, parameter :: unitslice=11
236  integer, parameter :: unitsnapshot=12
237  integer, parameter :: unitcollapse=13
238  integer, parameter :: unitanalysis=14
239 
240  !> Number of auxiliary variables that are only included in output
241  integer :: nwauxio
242 
243  !> IO switches for conversion
244  logical :: nocartesian
245  logical, allocatable :: w_write(:)
246  logical, allocatable :: writelevel(:)
247  double precision :: writespshift(ndim,2)
249 
250  !> Which par files are used as input
251  character(len=std_len), allocatable :: par_files(:)
252 
253  !> Base file name for simulation output, which will be followed by a number
254  character(len=std_len) :: base_filename
255 
256  !> If not 'unavailable', resume from snapshot with this base file name
257  character(len=std_len) :: restart_from_file
258 
259  !> Which type of log to write: 'normal', 'special', 'regression_test'
260  character(len=std_len) :: typefilelog
261 
262  !> Resume from the snapshot with this index
263  integer :: snapshotini
264 
265  !> If true, restart a previous run from the latest snapshot
267 
268  !> If true and restart_from_file is given, convert snapshots to
269  !> other file formats
270  logical :: convert
271 
272  !> If true, already convert to output format during the run
273  logical :: autoconvert
274 
275  !> If true, convert from conservative to primitive variables in output
276  logical :: saveprim
277 
278  !> Which format to use when converting
279  !>
280  !> Options are: tecplot, tecplotCC, vtu, vtuCC, vtuB, vtuBCC,
281  !> tecplotmpi, tecplotCCmpi, vtumpi, vtuCCmpi, vtuBmpi, vtuBCCmpi, pvtumpi, pvtuCCmpi,
282  !> pvtuBmpi, pvtuBCCmpi, tecline, teclinempi, onegrid
283  character(len=std_len) :: convert_type
284 
285  character(len=std_len) :: collapse_type
286 
287  !> Conversion factors the primitive variables
288  double precision, allocatable :: w_convert_factor(:)
289 
290  double precision :: length_convert_factor
291 
292  !> Conversion factor for time unit
293  double precision :: time_convert_factor
294 
295  !> Stores the memory and load imbalance, used in printlog
296  double precision :: xload, xmemory
297 
298  !> Save a snapshot before crash a run met unphysical values
299  logical :: crash=.false.
300 
301  ! Physics factors
302 
303  !> Physical scaling factor for length
304  double precision :: unit_length=1.d0
305 
306  !> Physical scaling factor for time
307  double precision :: unit_time=1.d0
308 
309  !> Physical scaling factor for density
310  double precision :: unit_density=1.d0
311 
312  !> Physical scaling factor for velocity
313  double precision :: unit_velocity=1.d0
314 
315  !> Physical scaling factor for temperature
316  double precision :: unit_temperature=1.d0
317 
318  !> Physical scaling factor for pressure
319  double precision :: unit_pressure=1.d0
320 
321  !> Physical scaling factor for magnetic field
322  double precision :: unit_magneticfield=1.d0
323 
324  !> Physical scaling factor for number density
325  double precision :: unit_numberdensity=1.d0
326 
327  !> Physical scaling factor for charge
328  double precision :: unit_charge=1.d0
329 
330  !> Physical scaling factor for mass
331  double precision :: unit_mass=1.d0
332 
333  !> Normalised speed of light
334  double precision :: c_norm=1.d0
335 
336  !> Physical scaling factor for Opacity
337  double precision :: unit_opacity=1.d0
338 
339  !> Physical scaling factor for radiation flux
340  double precision :: unit_radflux=1.d0
341 
342  !> error handling
344 
345  !> amplitude of background dipolar, quadrupolar, octupolar, user's field
346  double precision :: bdip=0.d0
347  double precision :: bquad=0.d0
348  double precision :: boct=0.d0
349  double precision :: busr=0.d0
350 
351  !> check and optionally fix unphysical small values (density, gas pressure)
352  logical :: check_small_values=.true.
353  logical :: fix_small_values=.false.
354 
355  !> split magnetic field as background B0 field
356  logical :: b0field=.false.
357 
358  ! number of equilibrium set variables, besides the mag field
359  integer :: number_equi_vars = 0
360 
361  !> Use SI units (.true.) or use cgs units (.false.)
362  logical :: si_unit=.false.
363 
364  !> Use TRAC (Johnston 2019 ApJL, 873, L22) for MHD or 1D HD
365  logical :: phys_trac=.false.
366  integer :: phys_trac_type=1
367  double precision :: phys_trac_mask
368 
369  !> Enable to strictly conserve the angular momentum
370  !> (works both in cylindrical and spherical coordinates)
371  logical :: angmomfix=.false.
372 
373  !> Use particles module or not
374  logical :: use_particles=.false.
375 
376  !> Use multigrid (only available in 2D and 3D)
377  logical :: use_multigrid = .false.
378 
379  ! AMR switches
380 
381  !> The maximum number of grid blocks in a processor
382  integer :: max_blocks
383 
384  !> The maximum number of levels in the grid refinement
385  integer, parameter :: nlevelshi = 20
386 
387  !> Maximal number of AMR levels
388  integer :: refine_max_level
389 
390  !> Weights of variables used to calculate error for mesh refinement
391  double precision, allocatable :: w_refine_weight(:)
392 
393  !> Fix the AMR grid after this time
394  double precision :: tfixgrid
395 
396  !> Whether to apply flux conservation at refinement boundaries
397  logical :: fix_conserve_global = .true.
398 
399  !> Fix the AMR grid after this many time steps
400  integer :: itfixgrid
401 
402  !> Reconstruct the AMR grid once every ditregrid iteration(s)
403  integer :: ditregrid
404 
405  !> refinement: lohner estimate wavefilter setting
406  double precision, allocatable :: amr_wavefilter(:)
407 
408  integer :: refine_criterion
409  logical :: prolongprimitive=.false.
410  logical :: coarsenprimitive=.false.
411 
412  !> Error tolerance for refinement decision
413  double precision, allocatable :: refine_threshold(:)
414  double precision, allocatable :: derefine_ratio(:)
415 
416  !> If true, rebuild the AMR grid upon restarting
417  logical :: reset_grid
418  !> True for using stagger grid
419  logical :: stagger_grid=.false.
420  !> True for record electric field
421  logical :: record_electric_field=.false.
422 
423  !> Number of cells as buffer zone
424  integer :: nbufferx^d
425 
426  integer :: levmin
427  integer :: levmax
428  integer :: levmax_sub
429 
430  ! Miscellaneous
431 
432  !> problem switch allowing different setups in same usr_mod.t
433  integer :: iprob
434 
435  !> Kronecker delta tensor
436  integer :: kr(3,3)
437 
438  !> Levi-Civita tensor
439  integer :: lvc(3,3,3)
440 
441  ! Time integration aspects
442 
443  double precision :: dt
444 
445  logical :: time_advance
446 
447  !> The Courant (CFL) number used for the simulation
448  double precision :: courantpar
449 
450  !> How to compute the CFL-limited time step
451  integer :: type_courant=1
452  !> integer switchers for type courant
453  integer, parameter :: type_maxsum=1
454  integer, parameter :: type_summax=2
455  integer, parameter :: type_minimum=3
456 
457  !> If dtpar is positive, it sets the timestep dt, otherwise courantpar is used
458  !> to limit the time step based on the Courant condition.
459  double precision :: dtpar
460 
461  !> For resistive MHD, the time step is also limited by the diffusion time:
462  !> \f$ dt < dtdiffpar \times dx^2/eta \f$
463  double precision :: dtdiffpar
464 
465  !> The global simulation time
466  double precision :: global_time
467 
468  !> Start time for the simulation
469  double precision :: time_init
470 
471  !> End time for the simulation
472  double precision :: time_max
473 
474  !> Ending wall time (in hours) for the simulation
475  double precision :: wall_time_max
476 
477  !> Stop the simulation when the time step becomes smaller than this value
478  double precision :: dtmin
479 
480  !> Force timeloop exit when final dt < dtmin
481  logical :: final_dt_exit
482 
483  !> If true, reset iteration count and global_time to original values, and
484  !> start writing snapshots at index 0
485  logical :: reset_time
486 
487  !> If true, reset iteration count to 0
488  logical :: reset_it
489 
490  !> If true, allow final dt reduction for matching time_max on output
492 
493  !> If true, call initonegrid_usr upon restarting
494  logical :: firstprocess
495 
496  !> If true, wall time is up, modify snapshotnext for later overwrite
497  logical :: pass_wall_time
498 
499  !> If true, do H-correction to fix the carbuncle problem at grid-aligned shocks
500  logical :: h_correction=.false.
501 
502  !> Number of time steps taken
503  integer :: it
504 
505  !> Stop the simulation after this many time steps have been taken
506  integer :: it_max
507 
508  !> initial iteration count
509  integer :: it_init
510 
511  !> If > 1, then in the first slowsteps-1 time steps dt is reduced
512  !> by a factor \f$ 1 - (1- step/slowsteps)^2 \f$
513  integer :: slowsteps
514 
515  ! Method switches
516 
517  !> Index of the sub-step in a multi-step time integrator
518  integer :: istep
519 
520  !> How many sub-steps the time integrator takes
521  integer :: nstep
522 
523  !> Which flux scheme of spatial discretization to use (per grid level)
524  integer, allocatable :: flux_method(:)
525 
526  !> The spatial discretization for the predictor step when using a two
527  !> step PC method
528  integer, allocatable :: typepred1(:)
529 
530  !> flux schemes
531  integer, parameter :: fs_hll=1
532  integer, parameter :: fs_hllc=2
533  integer, parameter :: fs_hlld=3
534  integer, parameter :: fs_hllcd=4
535  integer, parameter :: fs_tvdlf=5
536  integer, parameter :: fs_tvdmu=6
537  integer, parameter :: fs_tvd=7
538  integer, parameter :: fs_hancock=8
539  integer, parameter :: fs_cd=9
540  integer, parameter :: fs_cd4=10
541  integer, parameter :: fs_fd=11
542  integer, parameter :: fs_source=12
543  integer, parameter :: fs_nul=13
544 
545  !> time stepper type
546  integer :: t_stepper=0
547  integer, parameter :: onestep=1
548  integer, parameter :: twostep=2
549  integer, parameter :: threestep=3
550  integer, parameter :: fourstep=4
551  integer, parameter :: fivestep=5
552 
553  !> time integrator method
554  integer :: t_integrator=0
555  integer, parameter :: forward_euler=1
556  integer, parameter :: predictor_corrector=2
557  integer, parameter :: ssprk3=3
558  integer, parameter :: ssprk4=4
559  integer, parameter :: ssprk5=5
560 
561  integer, parameter :: imex_euler=6
562  integer, parameter :: imex_sp=7
563  integer, parameter :: rk2_alf=8
564  integer, parameter :: ssprk2=9
565  integer, parameter :: imex_midpoint=10
566  integer, parameter :: imex_trapezoidal=11
567  integer, parameter :: imex_222=12
568 
569  integer, parameter :: rk3_bt=13
570  integer, parameter :: imex_ars3=14
571  integer, parameter :: imex_232=15
572  integer, parameter :: imex_cb3a=16
573 
574  integer, parameter :: rk4=17
575 
576  !> Type of slope limiter used for reconstructing variables on cell edges
577  integer, allocatable :: type_limiter(:)
578 
579  !> Type of slope limiter used for computing gradients or divergences, when
580  !> typegrad or typediv are set to 'limited'
581  integer, allocatable :: type_gradient_limiter(:)
582 
583  !> background magnetic field location indicator
584  integer :: b0i=0
585 
586  !> Limiter used for prolongation to refined grids and ghost cells
587  integer :: prolong_limiter=0
588 
589  !> Which type of entropy fix to use with Riemann-type solvers
590  character(len=std_len), allocatable :: typeentropy(:)
591 
592  !> Which type of TVD method to use
593  character(len=std_len) :: typetvd
594 
595  !> bound (left/min and right.max) speed of Riemann fan
596  integer :: boundspeed
597 
598  character(len=std_len) :: typeaverage
599  character(len=std_len) :: typedimsplit
600  character(len=std_len) :: geometry_name='default'
601  character(len=std_len) :: typepoly
602 
603  integer :: nxdiffusehllc
604  double precision, allocatable :: entropycoef(:)
605  double precision :: tvdlfeps
606  logical, allocatable :: loglimit(:), logflag(:)
607  logical :: flathllc,flatcd,flatsh
608  !> Use split or unsplit way to add user's source terms, default: unsplit
609  logical :: source_split_usr
610  logical :: dimsplit
611 
612  !> RK2(alfa) method parameters from Butcher tableau
613  double precision :: rk_a21,rk_b1,rk_b2
614  !> IMEX-222(lambda) one-parameter family of schemes
615  double precision :: imex222_lambda
616  !> SSPRK choice of methods (both threestep and fourstep, Shu-Osher 2N* implementation)
617  !> also fivestep SSPRK54
618  integer :: ssprk_order
622  !> RK3 Butcher table
623  integer :: rk3_switch
625  !> IMEX_ARS3 parameter ars_gamma
626  double precision :: ars_gamma
627  !> IMEX_232 choice and parameters
628  integer :: imex_switch
630  double precision :: imex_b3,imex_c2,imex_c3
631  !> IMEX_CB3a extra parameters
632  double precision :: imex_a22, imex_a33, imex_ha32
633  !> whether IMEX in use or not
634  logical :: use_imex_scheme
635 
636  character(len=std_len) :: typediv,typegrad
637 
638  !> global fastest wave speed needed in fd scheme and glm method
639  double precision :: cmax_global
640 
641  !> global fastest flow speed needed in glm method
642  double precision :: vmax_global
643 
644  !> global largest a2 for schmid scheme
645  double precision :: a2max_global(ndim)
646 
647  !> need global maximal wave speed
648  logical :: need_global_cmax=.false.
649 
650  !> global value for schmid scheme
651  logical :: need_global_a2max=.false.
652 
653  ! Boundary region parameters
654 
655  !> True for dimensions with periodic boundaries
656  logical :: periodb(ndim)
657 
658  !> Indicates whether there is a pole at a boundary
659  logical :: poleb(2,ndim)
660 
661  !> True for dimensions with aperiodic boundaries
662  logical :: aperiodb(ndim)
663 
664  !> True for save physical boundary cells in dat files
666 
667  !> True if a block has any physical boundary
668  logical, allocatable :: phyboundblock(:)
669 
670  !> Array indicating the type of boundary condition per variable and per
671  !> physical boundary
672  integer, allocatable :: typeboundary(:, :)
673  !> boundary condition types
674  integer, parameter :: bc_special=1
675  integer, parameter :: bc_cont=2
676  integer, parameter :: bc_symm=3
677  integer, parameter :: bc_asymm=4
678  integer, parameter :: bc_periodic=5
679  integer, parameter :: bc_aperiodic=6
680  integer, parameter :: bc_noinflow=7
681  integer, parameter :: bc_data=8
682  integer, parameter :: bc_character=9
683 
684  !> whether copy values instead of interpolation in ghost cells of finer blocks
685  logical :: ghost_copy=.false.
686 
687  !> if there is an internal boundary
688  logical :: internalboundary
689 
690  !> Base file name for synthetic EUV emission output
691  character(len=std_len) :: filename_euv
692  !> wavelength for output
693  integer :: wavelength
694  !> resolution of the EUV image
695  character(len=std_len) :: resolution_euv
696  !> Base file name for synthetic SXR emission output
697  character(len=std_len) :: filename_sxr
698  ! minimum and maximum energy of SXR (keV)
699  integer :: emin_sxr,emax_sxr
700  !> resolution of the SXR image
701  character(len=std_len) :: resolution_sxr
702  !> direction of the line of sight (LOS)
703  double precision :: los_theta,los_phi
704  !> rotation of image
705  double precision :: image_rotate
706  !> where the is the origin (X=0,Y=0) of image
707  double precision :: x_origin(1:3)
708  !> big image
709  logical :: big_image
710  !> Base file name for synthetic EUV spectrum output
711  character(len=std_len) :: filename_spectrum
712  !> wave length for spectrum
713  integer :: spectrum_wl
714  !> spectral window
716  !> location of the slit
717  double precision :: location_slit
718  !> direction of the slit
719  integer :: direction_slit
720  !> resolution of the spectrum
721  character(len=std_len) :: resolution_spectrum
722 
723  !> Block pointer for using one block and its previous state
724  type(state), pointer :: block
725 
726  !$OMP THREADPRIVATE(block,dxlevel,b0i)
727 
728 contains
729 
730  !> Cross product of two vectors
731  pure subroutine cross_product(ixI^L,ixO^L,a,b,axb)
732  integer, intent(in) :: ixi^l, ixo^l
733  double precision, intent(in) :: a(ixi^s,3), b(ixi^s,3)
734  double precision, intent(out) :: axb(ixi^s,3)
735 
736  axb(ixo^s,1)=a(ixo^s,2)*b(ixo^s,3)-a(ixo^s,3)*b(ixo^s,2)
737  axb(ixo^s,2)=a(ixo^s,3)*b(ixo^s,1)-a(ixo^s,1)*b(ixo^s,3)
738  axb(ixo^s,3)=a(ixo^s,1)*b(ixo^s,2)-a(ixo^s,2)*b(ixo^s,1)
739  end subroutine cross_product
740 
741 end module mod_global_parameters
Module with basic data types used in amrvac.
This module contains variables that describe the connectivity of the mesh and also data structures fo...
Module for physical and numeric constants.
Definition: mod_constants.t:2
This module contains definitions of global parameters and variables and some generic functions/subrou...
character(len=std_len), dimension(:), allocatable typeentropy
Which type of entropy fix to use with Riemann-type solvers.
double precision, dimension(nfile) tsavelast
double precision, dimension(:), allocatable w_convert_factor
Conversion factors the primitive variables.
type(state), pointer block
Block pointer for using one block and its previous state.
double precision xload
Stores the memory and load imbalance, used in printlog.
integer, parameter unitslice
integer nstep
How many sub-steps the time integrator takes.
logical h_correction
If true, do H-correction to fix the carbuncle problem at grid-aligned shocks.
integer it_max
Stop the simulation after this many time steps have been taken.
logical, dimension(ndim) aperiodb
True for dimensions with aperiodic boundaries.
logical internalboundary
if there is an internal boundary
character(len=std_len) filename_sxr
Base file name for synthetic SXR emission output.
integer spectrum_wl
wave length for spectrum
logical nocartesian
IO switches for conversion.
integer, dimension(:), allocatable typepred1
The spatial discretization for the predictor step when using a two step PC method.
double precision dtdiffpar
For resistive MHD, the time step is also limited by the diffusion time: .
character(len=std_len) typegrad
integer ixgshi
Upper index of stagger grid block arrays.
logical reset_it
If true, reset iteration count to 0.
double precision unit_charge
Physical scaling factor for charge.
integer, parameter bc_noinflow
integer type_coarse_block
MPI type for block coarsened by 2, and for its children blocks.
integer, parameter fs_tvdlf
double precision small_pressure
integer ixghi
Upper index of grid block arrays.
integer, parameter stretch_uni
Unidirectional stretching from a side.
character(len=std_len) geometry_name
integer, dimension(3, 3, 3) lvc
Levi-Civita tensor.
double precision unit_time
Physical scaling factor for time.
double precision unit_density
Physical scaling factor for density.
character(len=std_len) typepoly
integer, parameter fs_hlld
logical source_split_usr
Use split or unsplit way to add user's source terms, default: unsplit.
integer, parameter imex_euler
double precision unit_opacity
Physical scaling factor for Opacity.
integer domain_nx
number of cells for each dimension in level-one mesh
integer, parameter unitpar
file handle for IO
character(len=std_len) filename_spectrum
Base file name for synthetic EUV spectrum output.
logical, dimension(nfile) save_file
whether or not to save an output file
integer, parameter bc_asymm
logical resume_previous_run
If true, restart a previous run from the latest snapshot.
double precision global_time
The global simulation time.
integer type_block_xc_io
MPI type for IO: cell corner (xc) or cell center (xcc) coordinates.
integer, dimension(nsavehi, nfile) itsave
Save output of type N on iterations itsave(:, N)
double precision unit_mass
Physical scaling factor for mass.
logical use_imex_scheme
whether IMEX in use or not
integer istep
Index of the sub-step in a multi-step time integrator.
double precision time_max
End time for the simulation.
integer, dimension(3, 3) kr
Kronecker delta tensor.
integer, parameter threestep
double precision xstretch
physical extent of stretched border in symmetric stretching
logical, dimension(:), allocatable logflag
double precision time_init
Start time for the simulation.
logical stretch_uncentered
If true, adjust mod_geometry routines to account for grid stretching (but the flux computation will n...
double precision phys_trac_mask
logical firstprocess
If true, call initonegrid_usr upon restarting.
integer, parameter imex_232
integer snapshotini
Resume from the snapshot with this index.
double precision small_temperature
error handling
double precision xprob
minimum and maximum domain boundaries for each dimension
integer it
Number of time steps taken.
character(len=std_len) filename_euv
Base file name for synthetic EUV emission output.
logical, dimension(:), allocatable loglimit
double precision, dimension(:), allocatable dg
extent of grid blocks in domain per dimension, in array over levels
integer, parameter fivestep
integer, parameter bc_character
integer it_init
initial iteration count
integer, dimension(:, :), allocatable typeboundary
Array indicating the type of boundary condition per variable and per physical boundary.
integer ditregrid
Reconstruct the AMR grid once every ditregrid iteration(s)
logical saveprim
If true, convert from conservative to primitive variables in output.
double precision ars_gamma
IMEX_ARS3 parameter ars_gamma.
double precision unit_numberdensity
Physical scaling factor for number density.
integer, parameter fs_hllcd
character(len=std_len) convert_type
Which format to use when converting.
double precision unit_pressure
Physical scaling factor for pressure.
integer, parameter type_maxsum
integer switchers for type courant
integer, parameter ndim
Number of spatial dimensions for grid variables.
integer itfixgrid
Fix the AMR grid after this many time steps.
integer, parameter filecollapse_
Constant indicating collapsed output.
logical angmomfix
Enable to strictly conserve the angular momentum (works both in cylindrical and spherical coordinates...
integer prolong_limiter
Limiter used for prolongation to refined grids and ghost cells.
double precision, dimension(:), allocatable amr_wavefilter
refinement: lohner estimate wavefilter setting
double precision unit_length
Physical scaling factor for length.
integer, parameter nlevelshi
The maximum number of levels in the grid refinement.
double precision location_slit
location of the slit
logical save_physical_boundary
True for save physical boundary cells in dat files.
double precision vmax_global
global fastest flow speed needed in glm method
logical stagger_grid
True for using stagger grid.
double precision cmax_global
global fastest wave speed needed in fd scheme and glm method
double precision time_convert_factor
Conversion factor for time unit.
logical, dimension(:), allocatable phyboundblock
True if a block has any physical boundary.
integer, dimension(:,:), allocatable nstretchedblocks
(even) number of (symmetrically) stretched blocks per level and dimension
integer, parameter imex_ars3
integer, dimension(^nd, 2^d &) type_coarse_block_stg
MPI type for staggered block coarsened by 2, and for its children blocks.
integer, parameter bc_data
logical use_particles
Use particles module or not.
integer, parameter fs_tvdmu
character(len=std_len), dimension(:), allocatable par_files
Which par files are used as input.
integer icomm
The MPI communicator.
integer, dimension(:), allocatable ng
number of grid blocks in domain per dimension, in array over levels
logical reset_time
If true, reset iteration count and global_time to original values, and start writing snapshots at ind...
double precision bdip
amplitude of background dipolar, quadrupolar, octupolar, user's field
integer b0i
background magnetic field location indicator
integer, parameter imex_trapezoidal
integer, parameter nsavehi
Maximum number of saves that can be defined by tsave or itsave.
integer mype
The rank of the current MPI task.
double precision dtpar
If dtpar is positive, it sets the timestep dt, otherwise courantpar is used to limit the time step ba...
integer, dimension(1:nfile) n_saves
Number of saved files of each type.
character(len=std_len) typediv
integer block_nx
number of cells for each dimension in grid block excluding ghostcells
integer type_block_io
MPI type for IO: block excluding ghost cells.
double precision, dimension(nfile) tsavestart
Start of read out (not counting specified read outs)
integer, dimension(nfile) ditsave
Repeatedly save output of type N when ditsave(N) time steps have passed.
integer, parameter plevel_
integer, dimension(2^d &) type_sub_block
logical, dimension(ndim) collapse
If collapse(DIM) is true, generate output integrated over DIM.
integer, parameter unitstdin
Unit for standard input.
integer, dimension(:), allocatable, parameter d
character(len=std_len) usr_filename
User parameter file.
logical need_global_a2max
global value for schmid scheme
logical ghost_copy
whether copy values instead of interpolation in ghost cells of finer blocks
double precision length_convert_factor
integer, parameter nodehi
grid hierarchy info (level and grid indices)
integer ndir
Number of spatial dimensions (components) for vector variables.
integer, parameter uniterr
Unit for error messages.
double precision imex222_lambda
IMEX-222(lambda) one-parameter family of schemes.
double precision courantpar
The Courant (CFL) number used for the simulation.
double precision wall_time_max
Ending wall time (in hours) for the simulation.
integer ixm
the mesh range (within a block with ghost cells)
integer ierrmpi
A global MPI error return code.
logical autoconvert
If true, already convert to output format during the run.
integer, dimension(:), allocatable flux_method
Which flux scheme of spatial discretization to use (per grid level)
character(len=std_len) collapse_type
logical slab
Cartesian geometry or not.
integer slowsteps
If > 1, then in the first slowsteps-1 time steps dt is reduced by a factor .
integer ssprk_order
SSPRK choice of methods (both threestep and fourstep, Shu-Osher 2N* implementation) also fivestep SSP...
double precision image_rotate
rotation of image
double precision, dimension(:,:), allocatable qstretch
Stretching factors and first cell size for each AMR level and dimension.
integer, parameter bc_periodic
integer type_block_wc_io
MPI type for IO: cell corner (wc) or cell center (wcc) variables.
integer type_courant
How to compute the CFL-limited time step.
character(len=std_len) resolution_sxr
resolution of the SXR image
integer, parameter bc_special
boundary condition types
integer snapshotnext
IO: snapshot and collapsed views output numbers/labels.
double precision unit_magneticfield
Physical scaling factor for magnetic field.
integer, parameter unitanalysis
integer, parameter rk2_alf
logical, dimension(ndim) stretched_dim
True if a dimension is stretched.
integer, dimension(ndim) nstretchedblocks_baselevel
(even) number of (symmetrically) stretched blocks at AMR level 1, per dimension
integer npe
The number of MPI tasks.
integer nwauxio
Number of auxiliary variables that are only included in output.
double precision unit_velocity
Physical scaling factor for velocity.
integer index_latest_data
index number of the latest existing data file
integer, dimension(nfile) itsavelast
integer, parameter stretch_none
No stretching.
double precision, dimension(ndim) qstretch_baselevel
stretch factor between cells at AMR level 1, per dimension
double precision, dimension(ndim, 2) writespshift
integer imex_switch
IMEX_232 choice and parameters.
integer, parameter fs_hll
flux schemes
double precision time_between_print
to monitor timeintegration loop at given wall-clock time intervals
integer, parameter unitterm
Unit for standard output.
double precision, dimension(nfile) dtsave
Repeatedly save output of type N when dtsave(N) simulation time has passed.
logical, dimension(:), allocatable w_write
integer iprob
problem switch allowing different setups in same usr_mod.t
character(len=std_len) restart_from_file
If not 'unavailable', resume from snapshot with this base file name.
logical, dimension(ndim) periodb
True for dimensions with periodic boundaries.
double precision c_norm
Normalised speed of light.
logical b0field
split magnetic field as background B0 field
double precision, dimension(:,:), allocatable rnode
Corner coordinates.
integer, parameter filelog_
Constant indicating log output.
character(len=40), dimension(nfile), parameter output_names
Names of the output methods.
double precision unit_temperature
Physical scaling factor for temperature.
double precision unit_radflux
Physical scaling factor for radiation flux.
integer, dimension(:), allocatable type_limiter
Type of slope limiter used for reconstructing variables on cell edges.
integer, parameter imex_sp
logical final_dt_reduction
If true, allow final dt reduction for matching time_max on output.
integer, parameter bc_cont
logical si_unit
Use SI units (.true.) or use cgs units (.false.)
logical, dimension(:), allocatable writelevel
integer, parameter unitcollapse
integer, parameter fileout_
Constant indicating regular output.
double precision los_theta
direction of the line of sight (LOS)
integer, parameter type_summax
character(len=std_len) typetvd
Which type of TVD method to use.
integer nbufferx
Number of cells as buffer zone.
double precision, dimension(:), allocatable entropycoef
integer, parameter twostep
double precision time_bc
accumulated wall-clock time spent on boundary conditions
double precision, dimension(:,:), allocatable dx
integer, parameter rpxmax0_
integer type_block
MPI type for block including ghost cells and its size.
integer, parameter onestep
double precision rk_a21
RK2(alfa) method parameters from Butcher tableau.
integer, parameter predictor_corrector
double precision tfixgrid
Fix the AMR grid after this time.
integer, parameter unitsnapshot
pure subroutine cross_product(ixIL, ixOL, a, b, axb)
Cross product of two vectors.
integer nghostcells
Number of ghost cells surrounding a grid.
double precision, dimension(:), allocatable w_refine_weight
Weights of variables used to calculate error for mesh refinement.
integer, parameter bc_symm
integer, parameter forward_euler
logical phys_trac
Use TRAC (Johnston 2019 ApJL, 873, L22) for MHD or 1D HD.
logical fix_conserve_global
Whether to apply flux conservation at refinement boundaries.
character(len=std_len) typedimsplit
character(len=std_len) typeaverage
character(len= *), parameter undefined
double precision, dimension(nsavehi, nfile) tsave
Save output of type N on times tsave(:, N)
double precision spectrum_window_max
logical need_global_cmax
need global maximal wave speed
logical convert
If true and restart_from_file is given, convert snapshots to other file formats.
character(len=std_len) resolution_euv
resolution of the EUV image
integer wavelength
wavelength for output
integer collapselevel
The level at which to produce line-integrated / collapsed output.
logical reset_grid
If true, rebuild the AMR grid upon restarting.
integer, dimension(ndim) stretch_type
What kind of stretching is used per dimension.
logical crash
Save a snapshot before crash a run met unphysical values.
integer t_stepper
time stepper type
double precision, dimension(:,:), allocatable rnode_sub
logical use_multigrid
Use multigrid (only available in 2D and 3D)
logical slab_uniform
uniform Cartesian geometry or not (stretched Cartesian)
integer, parameter fourstep
character(len=std_len) resolution_spectrum
resolution of the spectrum
double precision, dimension(:), allocatable refine_threshold
Error tolerance for refinement decision.
character(len=std_len) base_filename
Base file name for simulation output, which will be followed by a number.
integer, parameter rnodehi
grid location info (corner coordinates and grid spacing)
double precision small_density
double precision spectrum_window_min
spectral window
double precision dtmin
Stop the simulation when the time step becomes smaller than this value.
integer refine_max_level
Maximal number of AMR levels.
integer, parameter fs_hllc
integer, parameter fileslice_
Constant indicating slice output.
double precision, dimension(:), allocatable derefine_ratio
integer, parameter nfile
Number of output methods.
integer max_blocks
The maximum number of grid blocks in a processor.
integer, parameter stretch_symm
Symmetric stretching around the center.
integer, parameter fileanalysis_
Constant indicating analysis output (see Writing a custom analysis subroutine)
integer r_
Indices for cylindrical coordinates FOR TESTS, negative value when not used:
integer rk3_switch
RK3 Butcher table.
integer, parameter rpxmin0_
integer, parameter bc_aperiodic
character(len=std_len) typefilelog
Which type of log to write: 'normal', 'special', 'regression_test'.
double precision imex_a22
IMEX_CB3a extra parameters.
integer direction_slit
direction of the slit
integer type_block_io_stg
MPI type for IO of staggered variables.
logical, dimension(2, ndim) poleb
Indicates whether there is a pole at a boundary.
integer boundspeed
bound (left/min and right.max) speed of Riemann fan
logical pass_wall_time
If true, wall time is up, modify snapshotnext for later overwrite.
integer, parameter imex_cb3a
integer, parameter ixgslo
Lower index of stagger grid block arrays (always 0)
double precision, dimension(1:3) x_origin
where the is the origin (X=0,Y=0) of image
logical record_electric_field
True for record electric field.
integer, parameter imex_222
integer, parameter unitconvert
double precision, dimension(:,:), allocatable dxfirst
integer t_integrator
time integrator method
integer, parameter fs_hancock
logical final_dt_exit
Force timeloop exit when final dt < dtmin.
integer, dimension(nfile) isaveit
integer, dimension(:), allocatable type_gradient_limiter
Type of slope limiter used for computing gradients or divergences, when typegrad or typediv are set t...
integer, dimension(:,:), allocatable node
integer, dimension(:,:), allocatable node_sub
integer, parameter type_minimum
integer, parameter fs_source
double precision, dimension(ndim) dxlevel
integer, dimension(nfile) isavet
integer, parameter imex_midpoint
double precision, dimension(:,:), allocatable dxfirst_1mq
double precision, dimension(ndim) a2max_global
global largest a2 for schmid scheme
logical check_small_values
check and optionally fix unphysical small values (density, gas pressure)
double precision, dimension(:,:), allocatable dxmid
integer, parameter ixglo
Lower index of grid block arrays (always 1)
integer log_fh
MPI file handle for logfile.