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