diff --git a/src/const_and_precisions.f90 b/src/const_and_precisions.f90 index 326ae57..644a8f6 100644 --- a/src/const_and_precisions.f90 +++ b/src/const_and_precisions.f90 @@ -1,157 +1,61 @@ -!########################################################################! +module const_and_precisions + implicit none + public - MODULE const_and_precisions -!########################################################################! - IMPLICIT NONE - PUBLIC -!------------------------------------------------------------------------ -! common precisions -!------------------------------------------------------------------------ -! INTEGER, PARAMETER :: i1 = SELECTED_INT_KIND (2) ! Integer*1 -! INTEGER, PARAMETER :: i2 = SELECTED_INT_KIND (4) ! Integer*2 - INTEGER, PARAMETER :: i4 = SELECTED_INT_KIND (9) ! Integer*4 - INTEGER, PARAMETER :: i8 = SELECTED_INT_KIND (18) ! Integer*8 - INTEGER, PARAMETER :: r4 = SELECTED_REAL_KIND (6, 37) ! Real*4 - INTEGER, PARAMETER :: r8 = SELECTED_REAL_KIND (15, 300) ! Real*8 -! INTEGER, PARAMETER :: sp_ = r4 ! single precision -! INTEGER, PARAMETER :: dp_ = r8 ! double precision - INTEGER, PARAMETER :: wp_ = r8 ! work-precision -! INTEGER, PARAMETER :: odep_ = dp_ ! ODE-solver precision -! INTEGER, PARAMETER :: xp_ = wp_ ! for ext. modules if necessary -!------------------------------------------------------------------------ -! precisions which are in use in CONFIG_yat -!------------------------------------------------------------------------ -! INTEGER, PARAMETER :: ypi_ = 4 ! <- direct precision def. -! INTEGER, PARAMETER :: ypd_ = 8 ! <- direct precision def. -!------------------------------------------------------------------------ -! length of the file names -!------------------------------------------------------------------------ - !INTEGER, PARAMETER :: lfn_ = 256 ! <- requested for yat -!!======================================================================== -! Arithmetic constants -!======================================================================== - integer, parameter :: izero = 0 - REAL(wp_), PARAMETER :: zero = 0.0_wp_ - REAL(wp_), PARAMETER :: half = 0.5_wp_ - REAL(wp_), PARAMETER :: one = 1.0_wp_ - REAL(wp_), PARAMETER :: two = 2.0_wp_ - real(wp_), parameter :: pi = 3.141592653589793_wp_ ! 3.141592653589793238462643383280 - real(wp_), parameter :: pihalf = 1.57079632679489661923_wp_ - REAL(wp_), PARAMETER :: sqrt_pi = 1.772453850905516_wp_ -! REAL(wp_), PARAMETER :: sqrt_2 = 1.414213562373095_wp_ - REAL(wp_), PARAMETER :: degree = pi/180.0_wp_ - REAL(wp_), PARAMETER :: emn1 = 0.367879441171442_wp_ ! exp(-1) -!--- -! REAL(wp_), PARAMETER :: ex(1:3) = (/one ,zero,zero/) -! REAL(wp_), PARAMETER :: ey(1:3) = (/zero,one ,zero/) -! REAL(wp_), PARAMETER :: ez(1:3) = (/zero,zero,one /) -!--- -! REAL(wp_), PARAMETER :: kron(3,3) = reshape((/one ,zero,zero, & -! zero,one ,zero, & -! zero,zero,one /),(/3,3/)) - COMPLEX(wp_), PARAMETER :: im = (0.0_wp_,1.0_wp_) - COMPLEX(wp_), PARAMETER :: czero = (0.0_wp_,0.0_wp_) - COMPLEX(wp_), PARAMETER :: cunit = (1.0_wp_,0.0_wp_) -! COMPLEX(wp_), PARAMETER :: ctwo = (2.0_wp_,0.0_wp_) -!======================================================================== -! Computer constants -!======================================================================== - REAL(wp_), PARAMETER :: comp_eps = EPSILON(one) -! REAL(wp_), PARAMETER :: comp_eps2 = comp_eps**2 - REAL(wp_), PARAMETER :: comp_tiny = TINY(one) - REAL(wp_), PARAMETER :: comp_huge = HUGE(one) -! REAL(wp_), PARAMETER :: comp_tinylog =-200 ! LOG10(comp_tiny) -! REAL(wp_), PARAMETER :: comp_hugelog =+200 ! LOG10(comp_huge) -! REAL(wp_), PARAMETER :: comp_tiny1 = 1d+50*comp_tiny -! REAL(wp_), PARAMETER :: comp_huge1 = 1d-50*comp_huge -! REAL(wp_), PARAMETER :: comp_tiny1log = LOG10(comp_tiny1) -! REAL(wp_), PARAMETER :: comp_huge1log = LOG10(comp_huge1) -!------------------------------------------------------------------------ -! Conventional constants -!------------------------------------------------------------------------ - INTEGER, PARAMETER :: int_invalid = -999999999 - REAL(R8), PARAMETER :: r8_invalid = -9.0e40_r8 -! REAL(wp_), PARAMETER :: output_tiny = 1.0d-66 -! REAL(wp_), PARAMETER :: output_huge = 1.0d+66 -!======================================================================== -! Physical constants (SI) -!======================================================================== - real (wp_), parameter :: e_ = 1.602176487e-19_wp_ ! elementary charge, C - real (wp_), parameter :: me_ = 9.10938215e-31_wp_ ! electron mass, kg -! real (wp_), parameter :: mp_ = 1.672621637e-27_wp_ ! proton mass, kg -! real (wp_), parameter :: md_ = 3.34358320e-27_wp_ ! deuteron mass, kg -! real (wp_), parameter :: mt_ = 5.00735588e-27_wp_ ! triton mass, kg -! real (wp_), parameter :: ma_ = 6.64465620e-27_wp_ ! alpha mass, kg -! real (wp_), parameter :: amu_ = 1.660538782e-27_wp_ ! amu, kg -! REAL (wp_), PARAMETER :: rmpe_ = mp_/me_ ! proton-electron mass ratio - real (wp_), parameter :: c_ = 2.99792458e8_wp_ ! speed of light, m/s - real (wp_), parameter :: mu0_ = 4.0e-7_wp_ * pi ! magnetic permeability of vacuum - real (wp_), parameter :: eps0_ = 1.0_wp_ / (mu0_ * c_**2) ! dielectric constant of vacuum, F/m -! real (wp_), parameter :: avogr = 6.02214179e23_wp_ -! real (wp_), parameter :: KBolt = 1.3806504e-23_wp_ -!======================================================================== -! Physical constants (cgs) -!======================================================================== - real (wp_), parameter :: ccgs_ = c_*1.e2_wp_ ! speed of light, cm/s - real (wp_), parameter :: mecgs_ = me_*1.e3_wp_ ! electron mass, g - real (wp_), parameter :: ecgs_ = e_*c_*10._wp_ ! elementary charge, statcoul -!------------------------------------------------------------------------ -! Useful definitions -!------------------------------------------------------------------------ - REAL(wp_), PARAMETER :: keV_ = 1.e3_wp_*e_ ! [J] - REAL(wp_), PARAMETER :: mc2_SI = me_*c_**2 ! [J] - REAL(wp_), PARAMETER :: mc2_ = mc2_SI/keV_ ! [keV] - REAL(wp_), PARAMETER :: mu0inv = 1._wp_/mu0_ ! -! REAL(wp_), PARAMETER :: mc_ = me_*c_ ! [kg*m/s] -! ! f_ce = fce1_*B (B in Tesla): ! - REAL(wp_), PARAMETER :: wce1_ = e_/me_ ! [rad/s] -! REAL(wp_), PARAMETER :: fce1_ = wce1_/(2*pi) ! [1/s] -! ! f_pl = fpe1_*sqrt(Ne) (Ne in 1/m**3): ! -! REAL(wp_), PARAMETER :: wpe1_ = 56.4049201 ! [rad/s] -! REAL(wp_), PARAMETER :: fpe1_ = wpe1_/(2*pi) ! [1/s] -! REAL(wp_), PARAMETER :: wpe12_ = wpe1_**2 ! -! ! vte = vte1_*sqrt(Te) (Te in keV): ! -! REAL(wp_), PARAMETER :: vte1_ = 1.8755328e7 ! [m/s] -! ! je = curr1_*sqrt(Te)*Ne (Ne in 1/m**3): ! -! REAL(wp_), PARAMETER :: curr1_ = e_*vte1_ ! [A/m**2] -!!======================================================================== -!! Upper limit for the momentum value for integration -!!======================================================================== -! REAL(wp_), PARAMETER :: umax_ = 7.0d0 ! max of (p/pth) -! INTEGER, PARAMETER :: nu_ = 700 ! size of upar-array -!======================================================================== -! minimal value of Nparallel -!======================================================================== -! REAL(wp_), PARAMETER :: Npar_min = 1.0d-3 -!########################################################################! + !------------------------------------------------------------------------ + ! Common precisions + !------------------------------------------------------------------------ + integer, parameter :: i4 = selected_int_kind (9) ! Integer*4 + integer, parameter :: i8 = selected_int_kind (18) ! Integer*8 + integer, parameter :: r4 = selected_real_kind (6, 37) ! Real*4 + integer, parameter :: r8 = selected_real_kind (15, 300) ! Real*8 + integer, parameter :: wp_ = r8 ! Work precision - interface is_valid - module procedure is_valid_int4, is_valid_int8, is_valid_real8 - end interface + !------------------------------------------------------------------------ + ! Arithmetic constants + !------------------------------------------------------------------------ + integer, parameter :: izero = 0 ! Integer 0 + real(wp_), parameter :: zero = 0.0_wp_ ! Real 0 + real(wp_), parameter :: half = 0.5_wp_ ! Real 1/2 + real(wp_), parameter :: one = 1.0_wp_ ! Real 1 + real(wp_), parameter :: two = 2.0_wp_ ! Real 2 + real(wp_), parameter :: pi = 3.141592653589793_wp_ ! pi + real(wp_), parameter :: pihalf = 1.57079632679489661923_wp_ ! pi/2 + real(wp_), parameter :: sqrt_pi = 1.772453850905516_wp_ ! sqrt(pi) + real(wp_), parameter :: degree = pi/180.0_wp_ ! 1° = pi/180 + real(wp_), parameter :: emn1 = 0.367879441171442_wp_ ! exp(-1) + complex(wp_), parameter :: im = (0.0_wp_,1.0_wp_) ! Imaginary unit + complex(wp_), parameter :: czero = (0.0_wp_,0.0_wp_) ! Complex zero + complex(wp_), parameter :: cunit = (1.0_wp_,0.0_wp_) ! Complex one -contains + !------------------------------------------------------------------------ + ! Computer constants + !------------------------------------------------------------------------ + real(wp_), parameter :: comp_eps = epsilon(one) ! Smallest number larger than 1 + real(wp_), parameter :: comp_tiny = tiny(one) ! Smallest positive number + real(wp_), parameter :: comp_huge = huge(one) ! Largest positive number - logical function is_valid_int4(in_int) - implicit none - integer(i4), intent(in) :: in_int - is_valid_int4 = in_int /= int_invalid - return - end function is_valid_int4 + !------------------------------------------------------------------------ + ! Physical constants (SI) + !------------------------------------------------------------------------ + real (wp_), parameter :: e_ = 1.602176487e-19_wp_ ! Elementary charge, C + real (wp_), parameter :: me_ = 9.10938215e-31_wp_ ! Electron mass, kg + real (wp_), parameter :: c_ = 2.99792458e8_wp_ ! Speed of light, m/s + real (wp_), parameter :: mu0_ = 4.0e-7_wp_ * pi ! Magnetic permeability of vacuum, H/m - logical function is_valid_int8(in_int) - implicit none - integer(i8), intent(in) :: in_int - is_valid_int8 = in_int /= int_invalid - return - end function is_valid_int8 + !------------------------------------------------------------------------ + ! Physical constants (CGS) + !------------------------------------------------------------------------ + real (wp_), parameter :: ccgs_ = c_*1.e2_wp_ ! Speed of light in a vacuum, cm/s + real (wp_), parameter :: mecgs_ = me_*1.e3_wp_ ! Electron mass, g + real (wp_), parameter :: ecgs_ = e_*c_*10._wp_ ! Elementary charge, statcoul - logical function is_valid_real8(in_real) - implicit none - real(r8), intent(in) :: in_real - is_valid_real8 = abs(in_real - r8_invalid) > abs(r8_invalid) * 1.0e-15_r8 - return - end function is_valid_real8 + !------------------------------------------------------------------------ + ! Useful definitions + !------------------------------------------------------------------------ + real(wp_), parameter :: kev_ = 1.e3_wp_*e_ ! 1 keV, J + real(wp_), parameter :: mc2_ = me_*c_**2/kev_ ! Electron rest energy, keV + real(wp_), parameter :: mu0inv = 1._wp_/mu0_ ! Inverse magnetic permeability of vacuum, m/H + real(wp_), parameter :: wce1_ = e_/me_ ! ECR (angular) frequency / magnetic field, rad/s/T - END MODULE const_and_precisions - -!########################################################################! +end module const_and_precisions