diff --git a/doc/specs/index.md b/doc/specs/index.md index b61b16042..de3eb8f38 100644 --- a/doc/specs/index.md +++ b/doc/specs/index.md @@ -14,6 +14,7 @@ This is an index/directory of the specifications (specs) for each new module/fea - [ansi](./stdlib_ansi.html) - Terminal color and style escape sequences - [array](./stdlib_array.html) - Procedures for index manipulation and array handling - [ascii](./stdlib_ascii.html) - Procedures for handling ASCII characters + - [constants](./stdlib_constants.html) - Constants - [bitsets](./stdlib_bitsets.html) - Bitset data types and procedures - [error](./stdlib_error.html) - Catching and handling errors - [hash](./stdlib_hash_procedures.html) - Hashing integer diff --git a/doc/specs/stdlib_constants.md b/doc/specs/stdlib_constants.md new file mode 100644 index 000000000..c12f29ea1 --- /dev/null +++ b/doc/specs/stdlib_constants.md @@ -0,0 +1,78 @@ +--- +title: constants +--- + +[TOC] + +## Introduction + + +The [[stdlib_constants]] module provides mathematical constants and the most common physical constants. + +**Warning**: The names of the most common physical constants are kept short as they are inside a dedicated module. +Nonetheless, in case of overlapping names, they can always be renamed as following: + +```fortran +use stdlib_constants, only: clight => c +``` + +## Codata + +The [[stdlib_codata(module)]] module defines all codata (physical) constants as derived +type. The module is automatically generated with a simple +[parser written in Python](https://github.com/MilanSkocic/codata/) +The latest codata constants were released in 2022 by the [NIST](http://physics.nist.gov/constants) +All values for the codata constants are provided as double precision reals. +The names are quite long and can be aliased with shorter names. + +The derived type [[stdlib_codata_type(module):codata_constant_type(type)]] defines: + +* 4 members: + + * `name` (string) + * `value` (double precision real) + * `uncertainty` (double precision real) + * `unit` (string) + +* 2 type-bound procedures: + + * `print`: to print the values of the constant members; + * `to_real`: to get the value or the uncertainty to the desired precision. + +A module level interface [[stdlib_codata_type(module):to_real(interface)]] is +available for getting the constant value or uncertainty of a constant. + +## `to_real` - Get the constant value or its uncertainty. + +### Status + +Experimental + +### Description + +Convert a [[stdlib_codata_type(module):codata_constant_type(type)]] to a `real` (at least `sp`, or `dp`) scalar. +**Warning**: Some constants cannot be converted to single precision `sp` reals due to the value of the exponents. + +### Syntax + +`r = ` [[stdlib_codata_type(module):to_real(interface)]] `(c, mold [, uncertainty])` + +### Arguments + +`c`: argument has `intent(in) ` and shall be of type [[stdlib_codata_type(module):codata_constant_type(type)]]. + +`mold`: argument has `intent(in)` and shall be of `real` type. +**Note**: The type of the `mold` argument defines the type of the result. + +`uncertainty` (optional): argument has `intent(in)` and shall be of `logical` type. +It specifies if the uncertainty needs to be returned instead of the value. Default to `.false.`. + +### Return value + +Returns a scalar of `real` type which is either the value or the uncertainty of a codata constant. + +## Example + +```fortran +{!example/constants/example_constants.f90!} +``` diff --git a/doc/specs/stdlib_linalg.md b/doc/specs/stdlib_linalg.md index c414c071a..ffc4f7c42 100644 --- a/doc/specs/stdlib_linalg.md +++ b/doc/specs/stdlib_linalg.md @@ -767,7 +767,7 @@ Result vector `x` returns the approximate solution that minimizes the 2-norm \( `b`: Shall be a rank-1 or rank-2 array of the same kind as `a`, containing one or more right-hand-side vector(s), each in its leading dimension. It is an `intent(in)` argument. -`x`: Shall be an array of same kind and rank as `b`, containing the solution(s) to the least squares system. It is an `intent(inout)` argument. +`x`: Shall be an array of same kind and rank as `b`, and leading dimension of at least `n`, containing the solution(s) to the least squares system. It is an `intent(inout)` argument. `real_storage` (optional): Shall be a `real` rank-1 array of the same kind `a`, providing working storage for the solver. It minimum size can be determined with a call to [[stdlib_linalg(module):lstsq_space(interface)]]. It is an `intent(inout)` argument. diff --git a/doc/specs/stdlib_sorting.md b/doc/specs/stdlib_sorting.md index 04720a480..faa21f82f 100644 --- a/doc/specs/stdlib_sorting.md +++ b/doc/specs/stdlib_sorting.md @@ -25,15 +25,15 @@ module's `string_type` type. ## Overview of the module The module `stdlib_sorting` defines several public entities, one -default integer parameter, `int_size`, and four overloaded +default integer parameter, `int_index`, and four overloaded subroutines: `ORD_SORT`, `SORT`, `RADIX_SORT` and `SORT_INDEX`. The overloaded subroutines also each have several specific names for versions corresponding to different types of array arguments. -### The `int_size` parameter +### The `int_index` parameter -The `int_size` parameter is used to specify the kind of integer used -in indexing the various arrays. Currently the module sets `int_size` +The `int_index` parameter is used to specify the kind of integer used +in indexing the various arrays. Currently the module sets `int_index` to the value of `int64` from the `stdlib_kinds` module. ### The module subroutines @@ -414,7 +414,7 @@ It is an `intent(inout)` argument. On input it will be an array whose sorting indices are to be determined. On return it will be the sorted array. -`index`: shall be a rank one integer array of kind `int_size` and of +`index`: shall be a rank one integer array of kind `int_index` and of the size of `array`. It is an `intent(out)` argument. On return it shall have values that are the indices needed to sort the original array in the desired direction. @@ -427,7 +427,7 @@ static storage, its use can significantly reduce the stack memory requirements for the code. Its contents on return are undefined. `iwork` (optional): shall be a rank one integer array of kind -`int_size`, and shall have at least `size(array)/2` elements. It +`int_index`, and shall have at least `size(array)/2` elements. It is an `intent(out)` argument. It is intended to be used as "scratch" memory for internal record keeping. If associated with an array in static storage, its use can significantly reduce the stack memory @@ -465,8 +465,8 @@ Sorting a related rank one array: integer, intent(inout) :: a(:) integer(int32), intent(inout) :: b(:) ! The same size as a integer(int32), intent(out) :: work(:) - integer(int_size), intent(out) :: index(:) - integer(int_size), intent(out) :: iwork(:) + integer(int_index), intent(out) :: index(:) + integer(int_index), intent(out) :: iwork(:) ! Find the indices to sort a call sort_index(a, index(1:size(a)),& work(1:size(a)/2), iwork(1:size(a)/2)) @@ -483,8 +483,8 @@ Sorting a rank 2 array based on the data in a column integer, intent(inout) :: array(:,:) integer(int32), intent(in) :: column integer(int32), intent(out) :: work(:) - integer(int_size), intent(out) :: index(:) - integer(int_size), intent(out) :: iwork(:) + integer(int_index), intent(out) :: index(:) + integer(int_index), intent(out) :: iwork(:) integer, allocatable :: dummy(:) integer :: i allocate(dummy(size(array, dim=1))) @@ -508,8 +508,8 @@ Sorting an array of a derived type based on the data in one component type(a_type), intent(inout) :: a_data(:) integer(int32), intent(inout) :: a(:) integer(int32), intent(out) :: work(:) - integer(int_size), intent(out) :: index(:) - integer(int_size), intent(out) :: iwork(:) + integer(int_index), intent(out) :: index(:) + integer(int_index), intent(out) :: iwork(:) ! Extract a component of `a_data` a(1:size(a_data)) = a_data(:) % a ! Find the indices to sort the component diff --git a/example/CMakeLists.txt b/example/CMakeLists.txt index 3dd43694f..cbef7f075 100644 --- a/example/CMakeLists.txt +++ b/example/CMakeLists.txt @@ -9,6 +9,7 @@ endmacro(ADD_EXAMPLE) add_subdirectory(array) add_subdirectory(ascii) add_subdirectory(bitsets) +add_subdirectory(constants) add_subdirectory(error) add_subdirectory(hashmaps) add_subdirectory(hash_procedures) diff --git a/example/constants/CMakeLists.txt b/example/constants/CMakeLists.txt new file mode 100644 index 000000000..98306777c --- /dev/null +++ b/example/constants/CMakeLists.txt @@ -0,0 +1 @@ +ADD_EXAMPLE(constants) diff --git a/example/constants/example_constants.f90 b/example/constants/example_constants.f90 new file mode 100644 index 000000000..398d1088f --- /dev/null +++ b/example/constants/example_constants.f90 @@ -0,0 +1,25 @@ +program example_constants + use stdlib_constants, only: c, pi=>PI_dp + use stdlib_codata, only: alpha=>ALPHA_PARTICLE_ELECTRON_MASS_RATIO + use stdlib_codata_type, only : to_real + use stdlib_kinds, only: dp, sp + + ! Use most common physical constants defined as double precision reals + print *, "speed of light in vacuum= ", c + + ! Use of mathematical constants such as PI + print *, "PI as double precision real= ", pi + + ! Use codata_constant type for evaluating the value to the desired precision + print *, "Value of alpha... evaluated to double precision=", alpha%to_real(1.0_dp) + print *, "Uncertainty of alpha... evaluated to double precision=", alpha%to_real(1.0_sp, .true.) + print *, "Value of alpha... evaluated to single precision=", alpha%to_real(1.0_sp) + + ! Convert a codata constant to a real + print *, "Value of the alpha... evaluated to double precision=", to_real(alpha, 1.0_dp) + + + ! Print out codata constant attributes: name, value, uncertainty and unit + call alpha%print() + +end program example_constants diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index ace3443b3..5bd3c5d7f 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -6,14 +6,16 @@ set(fppFiles stdlib_bitsets.fypp stdlib_bitsets_64.fypp stdlib_bitsets_large.fypp - stdlib_hash_32bit.fypp + stdlib_codata_type.fypp + stdlib_constants.fypp + stdlib_hash_32bit.fypp stdlib_hash_32bit_fnv.fypp - stdlib_hash_32bit_nm.fypp - stdlib_hash_32bit_water.fypp - stdlib_hash_64bit.fypp - stdlib_hash_64bit_fnv.fypp - stdlib_hash_64bit_pengy.fypp - stdlib_hash_64bit_spookyv2.fypp + stdlib_hash_32bit_nm.fypp + stdlib_hash_32bit_water.fypp + stdlib_hash_64bit.fypp + stdlib_hash_64bit_fnv.fypp + stdlib_hash_64bit_pengy.fypp + stdlib_hash_64bit_spookyv2.fypp stdlib_io.fypp stdlib_io_npy.fypp stdlib_io_npy_load.fypp @@ -25,9 +27,9 @@ set(fppFiles stdlib_linalg_outer_product.fypp stdlib_linalg_kronecker.fypp stdlib_linalg_cross_product.fypp - stdlib_linalg_solve.fypp + stdlib_linalg_solve.fypp stdlib_linalg_determinant.fypp - stdlib_linalg_state.fypp + stdlib_linalg_state.fypp stdlib_optval.fypp stdlib_selection.fypp stdlib_sorting.fypp @@ -71,7 +73,7 @@ set(fppFiles stdlib_version.fypp ) -# Preprocessed files to contain preprocessor directives -> .F90 +# Preprocessed files to contain preprocessor directives -> .F90 set(cppFiles stdlib_linalg_constants.fypp stdlib_linalg_blas.fypp @@ -100,6 +102,7 @@ set(SRC stdlib_ansi_operator.f90 stdlib_ansi_to_string.f90 stdlib_array.f90 + stdlib_codata.f90 stdlib_error.f90 stdlib_hashmap_wrappers.f90 stdlib_hashmaps.f90 diff --git a/src/stdlib_codata.f90 b/src/stdlib_codata.f90 new file mode 100644 index 000000000..5b6bb48be --- /dev/null +++ b/src/stdlib_codata.f90 @@ -0,0 +1,1784 @@ +module stdlib_codata + !! Codata Constants - Autogenerated + use stdlib_kinds, only: dp, int32 + use stdlib_codata_type + private + +integer(int32), parameter, public :: YEAR = 2022 !! Year of release. + +type(codata_constant_type), parameter, public :: ALPHA_PARTICLE_ELECTRON_MASS_RATIO = & +codata_constant_type("alpha particle-electron mass ratio", & +7294.29954171_dp, 0.00000017_dp, & +"") !! alpha particle-electron mass ratio + +type(codata_constant_type), parameter, public :: ALPHA_PARTICLE_MASS = & +codata_constant_type("alpha particle mass", & +6.6446573450e-27_dp, 0.0000000021e-27_dp, & +"kg") !! alpha particle mass + +type(codata_constant_type), parameter, public :: ALPHA_PARTICLE_MASS_ENERGY_EQUIVALENT = & +codata_constant_type("alpha particle mass energy equivalent", & +5.9719201997e-10_dp, 0.0000000019e-10_dp, & +"J") !! alpha particle mass energy equivalent + +type(codata_constant_type), parameter, public :: ALPHA_PARTICLE_MASS_ENERGY_EQUIVALENT_IN_MEV = & +codata_constant_type("alpha particle mass energy equivalent in MeV", & +3727.3794118_dp, 0.0000012_dp, & +"MeV") !! alpha particle mass energy equivalent in MeV + +type(codata_constant_type), parameter, public :: ALPHA_PARTICLE_MASS_IN_U = & +codata_constant_type("alpha particle mass in u", & +4.001506179129_dp, 0.000000000062_dp, & +"u") !! alpha particle mass in u + +type(codata_constant_type), parameter, public :: ALPHA_PARTICLE_MOLAR_MASS = & +codata_constant_type("alpha particle molar mass", & +4.0015061833e-3_dp, 0.0000000012e-3_dp, & +"kg mol^-1") !! alpha particle molar mass + +type(codata_constant_type), parameter, public :: ALPHA_PARTICLE_PROTON_MASS_RATIO = & +codata_constant_type("alpha particle-proton mass ratio", & +3.972599690252_dp, 0.000000000070_dp, & +"") !! alpha particle-proton mass ratio + +type(codata_constant_type), parameter, public :: ALPHA_PARTICLE_RELATIVE_ATOMIC_MASS = & +codata_constant_type("alpha particle relative atomic mass", & +4.001506179129_dp, 0.000000000062_dp, & +"") !! alpha particle relative atomic mass + +type(codata_constant_type), parameter, public :: ALPHA_PARTICLE_RMS_CHARGE_RADIUS = & +codata_constant_type("alpha particle rms charge radius", & +1.6785e-15_dp, 0.0021e-15_dp, & +"m") !! alpha particle rms charge radius + +type(codata_constant_type), parameter, public :: ANGSTROM_STAR = & +codata_constant_type("Angstrom star", & +1.00001495e-10_dp, 0.00000090e-10_dp, & +"m") !! Angstrom star + +type(codata_constant_type), parameter, public :: ATOMIC_MASS_CONSTANT = & +codata_constant_type("atomic mass constant", & +1.66053906892e-27_dp, 0.00000000052e-27_dp, & +"kg") !! atomic mass constant + +type(codata_constant_type), parameter, public :: ATOMIC_MASS_CONSTANT_ENERGY_EQUIVALENT = & +codata_constant_type("atomic mass constant energy equivalent", & +1.49241808768e-10_dp, 0.00000000046e-10_dp, & +"J") !! atomic mass constant energy equivalent + +type(codata_constant_type), parameter, public :: ATOMIC_MASS_CONSTANT_ENERGY_EQUIVALENT_IN_MEV = & +codata_constant_type("atomic mass constant energy equivalent in MeV", & +931.49410372_dp, 0.00000029_dp, & +"MeV") !! atomic mass constant energy equivalent in MeV + +type(codata_constant_type), parameter, public :: ATOMIC_MASS_UNIT_ELECTRON_VOLT_RELATIONSHIP = & +codata_constant_type("atomic mass unit-electron volt relationship", & +9.3149410372e8_dp, 0.0000000029e8_dp, & +"eV") !! atomic mass unit-electron volt relationship + +type(codata_constant_type), parameter, public :: ATOMIC_MASS_UNIT_HARTREE_RELATIONSHIP = & +codata_constant_type("atomic mass unit-hartree relationship", & +3.4231776922e7_dp, 0.0000000011e7_dp, & +"E_h") !! atomic mass unit-hartree relationship + +type(codata_constant_type), parameter, public :: ATOMIC_MASS_UNIT_HERTZ_RELATIONSHIP = & +codata_constant_type("atomic mass unit-hertz relationship", & +2.25234272185e23_dp, 0.00000000070e23_dp, & +"Hz") !! atomic mass unit-hertz relationship + +type(codata_constant_type), parameter, public :: ATOMIC_MASS_UNIT_INVERSE_METER_RELATIONSHIP = & +codata_constant_type("atomic mass unit-inverse meter relationship", & +7.5130066209e14_dp, 0.0000000023e14_dp, & +"m^-1") !! atomic mass unit-inverse meter relationship + +type(codata_constant_type), parameter, public :: ATOMIC_MASS_UNIT_JOULE_RELATIONSHIP = & +codata_constant_type("atomic mass unit-joule relationship", & +1.49241808768e-10_dp, 0.00000000046e-10_dp, & +"J") !! atomic mass unit-joule relationship + +type(codata_constant_type), parameter, public :: ATOMIC_MASS_UNIT_KELVIN_RELATIONSHIP = & +codata_constant_type("atomic mass unit-kelvin relationship", & +1.08095402067e13_dp, 0.00000000034e13_dp, & +"K") !! atomic mass unit-kelvin relationship + +type(codata_constant_type), parameter, public :: ATOMIC_MASS_UNIT_KILOGRAM_RELATIONSHIP = & +codata_constant_type("atomic mass unit-kilogram relationship", & +1.66053906892e-27_dp, 0.00000000052e-27_dp, & +"kg") !! atomic mass unit-kilogram relationship + +type(codata_constant_type), parameter, public :: ATOMIC_UNIT_OF_1ST_HYPERPOLARIZABILITY = & +codata_constant_type("atomic unit of 1st hyperpolarizability", & +3.2063612996e-53_dp, 0.0000000015e-53_dp, & +"C^3 m^3 J^-2") !! atomic unit of 1st hyperpolarizability + +type(codata_constant_type), parameter, public :: ATOMIC_UNIT_OF_2ND_HYPERPOLARIZABILITY = & +codata_constant_type("atomic unit of 2nd hyperpolarizability", & +6.2353799735e-65_dp, 0.0000000039e-65_dp, & +"C^4 m^4 J^-3") !! atomic unit of 2nd hyperpolarizability + +type(codata_constant_type), parameter, public :: ATOMIC_UNIT_OF_ACTION = & +codata_constant_type("atomic unit of action", & +1.054571817e-34_dp, 0.0_dp, & +"J s") !! atomic unit of action + +type(codata_constant_type), parameter, public :: ATOMIC_UNIT_OF_CHARGE = & +codata_constant_type("atomic unit of charge", & +1.602176634e-19_dp, 0.0_dp, & +"C") !! atomic unit of charge + +type(codata_constant_type), parameter, public :: ATOMIC_UNIT_OF_CHARGE_DENSITY = & +codata_constant_type("atomic unit of charge density", & +1.08120238677e12_dp, 0.00000000051e12_dp, & +"C m^-3") !! atomic unit of charge density + +type(codata_constant_type), parameter, public :: ATOMIC_UNIT_OF_CURRENT = & +codata_constant_type("atomic unit of current", & +6.6236182375082e-3_dp, 0.0000000000072e-3_dp, & +"A") !! atomic unit of current + +type(codata_constant_type), parameter, public :: ATOMIC_UNIT_OF_ELECTRIC_DIPOLE_MOM = & +codata_constant_type("atomic unit of electric dipole mom.", & +8.4783536198e-30_dp, 0.0000000013e-30_dp, & +"C m") !! atomic unit of electric dipole mom. + +type(codata_constant_type), parameter, public :: ATOMIC_UNIT_OF_ELECTRIC_FIELD = & +codata_constant_type("atomic unit of electric field", & +5.14220675112e11_dp, 0.00000000080e11_dp, & +"V m^-1") !! atomic unit of electric field + +type(codata_constant_type), parameter, public :: ATOMIC_UNIT_OF_ELECTRIC_FIELD_GRADIENT = & +codata_constant_type("atomic unit of electric field gradient", & +9.7173624424e21_dp, 0.0000000030e21_dp, & +"V m^-2") !! atomic unit of electric field gradient + +type(codata_constant_type), parameter, public :: ATOMIC_UNIT_OF_ELECTRIC_POLARIZABILITY = & +codata_constant_type("atomic unit of electric polarizability", & +1.64877727212e-41_dp, 0.00000000051e-41_dp, & +"C^2 m^2 J^-1") !! atomic unit of electric polarizability + +type(codata_constant_type), parameter, public :: ATOMIC_UNIT_OF_ELECTRIC_POTENTIAL = & +codata_constant_type("atomic unit of electric potential", & +27.211386245981_dp, 0.000000000030_dp, & +"V") !! atomic unit of electric potential + +type(codata_constant_type), parameter, public :: ATOMIC_UNIT_OF_ELECTRIC_QUADRUPOLE_MOM = & +codata_constant_type("atomic unit of electric quadrupole mom.", & +4.4865515185e-40_dp, 0.0000000014e-40_dp, & +"C m^2") !! atomic unit of electric quadrupole mom. + +type(codata_constant_type), parameter, public :: ATOMIC_UNIT_OF_ENERGY = & +codata_constant_type("atomic unit of energy", & +4.3597447222060e-18_dp, 0.0000000000048e-18_dp, & +"J") !! atomic unit of energy + +type(codata_constant_type), parameter, public :: ATOMIC_UNIT_OF_FORCE = & +codata_constant_type("atomic unit of force", & +8.2387235038e-8_dp, 0.0000000013e-8_dp, & +"N") !! atomic unit of force + +type(codata_constant_type), parameter, public :: ATOMIC_UNIT_OF_LENGTH = & +codata_constant_type("atomic unit of length", & +5.29177210544e-11_dp, 0.00000000082e-11_dp, & +"m") !! atomic unit of length + +type(codata_constant_type), parameter, public :: ATOMIC_UNIT_OF_MAG_DIPOLE_MOM = & +codata_constant_type("atomic unit of mag. dipole mom.", & +1.85480201315e-23_dp, 0.00000000058e-23_dp, & +"J T^-1") !! atomic unit of mag. dipole mom. + +type(codata_constant_type), parameter, public :: ATOMIC_UNIT_OF_MAG_FLUX_DENSITY = & +codata_constant_type("atomic unit of mag. flux density", & +2.35051757077e5_dp, 0.00000000073e5_dp, & +"T") !! atomic unit of mag. flux density + +type(codata_constant_type), parameter, public :: ATOMIC_UNIT_OF_MAGNETIZABILITY = & +codata_constant_type("atomic unit of magnetizability", & +7.8910365794e-29_dp, 0.0000000049e-29_dp, & +"J T^-2") !! atomic unit of magnetizability + +type(codata_constant_type), parameter, public :: ATOMIC_UNIT_OF_MASS = & +codata_constant_type("atomic unit of mass", & +9.1093837139e-31_dp, 0.0000000028e-31_dp, & +"kg") !! atomic unit of mass + +type(codata_constant_type), parameter, public :: ATOMIC_UNIT_OF_MOMENTUM = & +codata_constant_type("atomic unit of momentum", & +1.99285191545e-24_dp, 0.00000000031e-24_dp, & +"kg m s^-1") !! atomic unit of momentum + +type(codata_constant_type), parameter, public :: ATOMIC_UNIT_OF_PERMITTIVITY = & +codata_constant_type("atomic unit of permittivity", & +1.11265005620e-10_dp, 0.00000000017e-10_dp, & +"F m^-1") !! atomic unit of permittivity + +type(codata_constant_type), parameter, public :: ATOMIC_UNIT_OF_TIME = & +codata_constant_type("atomic unit of time", & +2.4188843265864e-17_dp, 0.0000000000026e-17_dp, & +"s") !! atomic unit of time + +type(codata_constant_type), parameter, public :: ATOMIC_UNIT_OF_VELOCITY = & +codata_constant_type("atomic unit of velocity", & +2.18769126216e6_dp, 0.00000000034e6_dp, & +"m s^-1") !! atomic unit of velocity + +type(codata_constant_type), parameter, public :: AVOGADRO_CONSTANT = & +codata_constant_type("Avogadro constant", & +6.02214076e23_dp, 0.0_dp, & +"mol^-1") !! Avogadro constant + +type(codata_constant_type), parameter, public :: BOHR_MAGNETON = & +codata_constant_type("Bohr magneton", & +9.2740100657e-24_dp, 0.0000000029e-24_dp, & +"J T^-1") !! Bohr magneton + +type(codata_constant_type), parameter, public :: BOHR_MAGNETON_IN_EV_T = & +codata_constant_type("Bohr magneton in eV/T", & +5.7883817982e-5_dp, 0.0000000018e-5_dp, & +"eV T^-1") !! Bohr magneton in eV/T + +type(codata_constant_type), parameter, public :: BOHR_MAGNETON_IN_HZ_T = & +codata_constant_type("Bohr magneton in Hz/T", & +1.39962449171e10_dp, 0.00000000044e10_dp, & +"Hz T^-1") !! Bohr magneton in Hz/T + +type(codata_constant_type), parameter, public :: BOHR_MAGNETON_IN_INVERSE_METER_PER_TESLA = & +codata_constant_type("Bohr magneton in inverse meter per tesla", & +46.686447719_dp, 0.000000015_dp, & +"m^-1 T^-1") !! Bohr magneton in inverse meter per tesla + +type(codata_constant_type), parameter, public :: BOHR_MAGNETON_IN_K_T = & +codata_constant_type("Bohr magneton in K/T", & +0.67171381472_dp, 0.00000000021_dp, & +"K T^-1") !! Bohr magneton in K/T + +type(codata_constant_type), parameter, public :: BOHR_RADIUS = & +codata_constant_type("Bohr radius", & +5.29177210544e-11_dp, 0.00000000082e-11_dp, & +"m") !! Bohr radius + +type(codata_constant_type), parameter, public :: BOLTZMANN_CONSTANT = & +codata_constant_type("Boltzmann constant", & +1.380649e-23_dp, 0.0_dp, & +"J K^-1") !! Boltzmann constant + +type(codata_constant_type), parameter, public :: BOLTZMANN_CONSTANT_IN_EV_K = & +codata_constant_type("Boltzmann constant in eV/K", & +8.617333262e-5_dp, 0.0_dp, & +"eV K^-1") !! Boltzmann constant in eV/K + +type(codata_constant_type), parameter, public :: BOLTZMANN_CONSTANT_IN_HZ_K = & +codata_constant_type("Boltzmann constant in Hz/K", & +2.083661912e10_dp, 0.0_dp, & +"Hz K^-1") !! Boltzmann constant in Hz/K + +type(codata_constant_type), parameter, public :: BOLTZMANN_CONSTANT_IN_INVERSE_METER_PER_KELVIN = & +codata_constant_type("Boltzmann constant in inverse meter per kelvin", & +69.50348004_dp, 0.0_dp, & +"m^-1 K^-1") !! Boltzmann constant in inverse meter per kelvin + +type(codata_constant_type), parameter, public :: CHARACTERISTIC_IMPEDANCE_OF_VACUUM = & +codata_constant_type("characteristic impedance of vacuum", & +376.730313412_dp, 0.000000059_dp, & +"ohm") !! characteristic impedance of vacuum + +type(codata_constant_type), parameter, public :: CLASSICAL_ELECTRON_RADIUS = & +codata_constant_type("classical electron radius", & +2.8179403205e-15_dp, 0.0000000013e-15_dp, & +"m") !! classical electron radius + +type(codata_constant_type), parameter, public :: COMPTON_WAVELENGTH = & +codata_constant_type("Compton wavelength", & +2.42631023538e-12_dp, 0.00000000076e-12_dp, & +"m") !! Compton wavelength + +type(codata_constant_type), parameter, public :: CONDUCTANCE_QUANTUM = & +codata_constant_type("conductance quantum", & +7.748091729e-5_dp, 0.0_dp, & +"S") !! conductance quantum + +type(codata_constant_type), parameter, public :: CONVENTIONAL_VALUE_OF_AMPERE_90 = & +codata_constant_type("conventional value of ampere-90", & +1.00000008887_dp, 0.0_dp, & +"A") !! conventional value of ampere-90 + +type(codata_constant_type), parameter, public :: CONVENTIONAL_VALUE_OF_COULOMB_90 = & +codata_constant_type("conventional value of coulomb-90", & +1.00000008887_dp, 0.0_dp, & +"C") !! conventional value of coulomb-90 + +type(codata_constant_type), parameter, public :: CONVENTIONAL_VALUE_OF_FARAD_90 = & +codata_constant_type("conventional value of farad-90", & +0.99999998220_dp, 0.0_dp, & +"F") !! conventional value of farad-90 + +type(codata_constant_type), parameter, public :: CONVENTIONAL_VALUE_OF_HENRY_90 = & +codata_constant_type("conventional value of henry-90", & +1.00000001779_dp, 0.0_dp, & +"H") !! conventional value of henry-90 + +type(codata_constant_type), parameter, public :: CONVENTIONAL_VALUE_OF_JOSEPHSON_CONSTANT = & +codata_constant_type("conventional value of Josephson constant", & +483597.9e9_dp, 0.0_dp, & +"Hz V^-1") !! conventional value of Josephson constant + +type(codata_constant_type), parameter, public :: CONVENTIONAL_VALUE_OF_OHM_90 = & +codata_constant_type("conventional value of ohm-90", & +1.00000001779_dp, 0.0_dp, & +"ohm") !! conventional value of ohm-90 + +type(codata_constant_type), parameter, public :: CONVENTIONAL_VALUE_OF_VOLT_90 = & +codata_constant_type("conventional value of volt-90", & +1.00000010666_dp, 0.0_dp, & +"V") !! conventional value of volt-90 + +type(codata_constant_type), parameter, public :: CONVENTIONAL_VALUE_OF_VON_KLITZING_CONSTANT = & +codata_constant_type("conventional value of von Klitzing constant", & +25812.807_dp, 0.0_dp, & +"ohm") !! conventional value of von Klitzing constant + +type(codata_constant_type), parameter, public :: CONVENTIONAL_VALUE_OF_WATT_90 = & +codata_constant_type("conventional value of watt-90", & +1.00000019553_dp, 0.0_dp, & +"W") !! conventional value of watt-90 + +type(codata_constant_type), parameter, public :: COPPER_X_UNIT = & +codata_constant_type("Copper x unit", & +1.00207697e-13_dp, 0.00000028e-13_dp, & +"m") !! Copper x unit + +type(codata_constant_type), parameter, public :: DEUTERON_ELECTRON_MAG_MOM_RATIO = & +codata_constant_type("deuteron-electron mag. mom. ratio", & +-4.664345550e-4_dp, 0.000000012e-4_dp, & +"") !! deuteron-electron mag. mom. ratio + +type(codata_constant_type), parameter, public :: DEUTERON_ELECTRON_MASS_RATIO = & +codata_constant_type("deuteron-electron mass ratio", & +3670.482967655_dp, 0.000000063_dp, & +"") !! deuteron-electron mass ratio + +type(codata_constant_type), parameter, public :: DEUTERON_G_FACTOR = & +codata_constant_type("deuteron g factor", & +0.8574382335_dp, 0.0000000022_dp, & +"") !! deuteron g factor + +type(codata_constant_type), parameter, public :: DEUTERON_MAG_MOM = & +codata_constant_type("deuteron mag. mom.", & +4.330735087e-27_dp, 0.000000011e-27_dp, & +"J T^-1") !! deuteron mag. mom. + +type(codata_constant_type), parameter, public :: DEUTERON_MAG_MOM_TO_BOHR_MAGNETON_RATIO = & +codata_constant_type("deuteron mag. mom. to Bohr magneton ratio", & +4.669754568e-4_dp, 0.000000012e-4_dp, & +"") !! deuteron mag. mom. to Bohr magneton ratio + +type(codata_constant_type), parameter, public :: DEUTERON_MAG_MOM_TO_NUCLEAR_MAGNETON_RATIO = & +codata_constant_type("deuteron mag. mom. to nuclear magneton ratio", & +0.8574382335_dp, 0.0000000022_dp, & +"") !! deuteron mag. mom. to nuclear magneton ratio + +type(codata_constant_type), parameter, public :: DEUTERON_MASS = & +codata_constant_type("deuteron mass", & +3.3435837768e-27_dp, 0.0000000010e-27_dp, & +"kg") !! deuteron mass + +type(codata_constant_type), parameter, public :: DEUTERON_MASS_ENERGY_EQUIVALENT = & +codata_constant_type("deuteron mass energy equivalent", & +3.00506323491e-10_dp, 0.00000000094e-10_dp, & +"J") !! deuteron mass energy equivalent + +type(codata_constant_type), parameter, public :: DEUTERON_MASS_ENERGY_EQUIVALENT_IN_MEV = & +codata_constant_type("deuteron mass energy equivalent in MeV", & +1875.61294500_dp, 0.00000058_dp, & +"MeV") !! deuteron mass energy equivalent in MeV + +type(codata_constant_type), parameter, public :: DEUTERON_MASS_IN_U = & +codata_constant_type("deuteron mass in u", & +2.013553212544_dp, 0.000000000015_dp, & +"u") !! deuteron mass in u + +type(codata_constant_type), parameter, public :: DEUTERON_MOLAR_MASS = & +codata_constant_type("deuteron molar mass", & +2.01355321466e-3_dp, 0.00000000063e-3_dp, & +"kg mol^-1") !! deuteron molar mass + +type(codata_constant_type), parameter, public :: DEUTERON_NEUTRON_MAG_MOM_RATIO = & +codata_constant_type("deuteron-neutron mag. mom. ratio", & +-0.44820652_dp, 0.00000011_dp, & +"") !! deuteron-neutron mag. mom. ratio + +type(codata_constant_type), parameter, public :: DEUTERON_PROTON_MAG_MOM_RATIO = & +codata_constant_type("deuteron-proton mag. mom. ratio", & +0.30701220930_dp, 0.00000000079_dp, & +"") !! deuteron-proton mag. mom. ratio + +type(codata_constant_type), parameter, public :: DEUTERON_PROTON_MASS_RATIO = & +codata_constant_type("deuteron-proton mass ratio", & +1.9990075012699_dp, 0.0000000000084_dp, & +"") !! deuteron-proton mass ratio + +type(codata_constant_type), parameter, public :: DEUTERON_RELATIVE_ATOMIC_MASS = & +codata_constant_type("deuteron relative atomic mass", & +2.013553212544_dp, 0.000000000015_dp, & +"") !! deuteron relative atomic mass + +type(codata_constant_type), parameter, public :: DEUTERON_RMS_CHARGE_RADIUS = & +codata_constant_type("deuteron rms charge radius", & +2.12778e-15_dp, 0.00027e-15_dp, & +"m") !! deuteron rms charge radius + +type(codata_constant_type), parameter, public :: ELECTRON_CHARGE_TO_MASS_QUOTIENT = & +codata_constant_type("electron charge to mass quotient", & +-1.75882000838e11_dp, 0.00000000055e11_dp, & +"C kg^-1") !! electron charge to mass quotient + +type(codata_constant_type), parameter, public :: ELECTRON_DEUTERON_MAG_MOM_RATIO = & +codata_constant_type("electron-deuteron mag. mom. ratio", & +-2143.9234921_dp, 0.0000056_dp, & +"") !! electron-deuteron mag. mom. ratio + +type(codata_constant_type), parameter, public :: ELECTRON_DEUTERON_MASS_RATIO = & +codata_constant_type("electron-deuteron mass ratio", & +2.724437107629e-4_dp, 0.000000000047e-4_dp, & +"") !! electron-deuteron mass ratio + +type(codata_constant_type), parameter, public :: ELECTRON_G_FACTOR = & +codata_constant_type("electron g factor", & +-2.00231930436092_dp, 0.00000000000036_dp, & +"") !! electron g factor + +type(codata_constant_type), parameter, public :: ELECTRON_GYROMAG_RATIO = & +codata_constant_type("electron gyromag. ratio", & +1.76085962784e11_dp, 0.00000000055e11_dp, & +"s^-1 T^-1") !! electron gyromag. ratio + +type(codata_constant_type), parameter, public :: ELECTRON_GYROMAG_RATIO_IN_MHZ_T = & +codata_constant_type("electron gyromag. ratio in MHz/T", & +28024.9513861_dp, 0.0000087_dp, & +"MHz T^-1") !! electron gyromag. ratio in MHz/T + +type(codata_constant_type), parameter, public :: ELECTRON_HELION_MASS_RATIO = & +codata_constant_type("electron-helion mass ratio", & +1.819543074649e-4_dp, 0.000000000053e-4_dp, & +"") !! electron-helion mass ratio + +type(codata_constant_type), parameter, public :: ELECTRON_MAG_MOM = & +codata_constant_type("electron mag. mom.", & +-9.2847646917e-24_dp, 0.0000000029e-24_dp, & +"J T^-1") !! electron mag. mom. + +type(codata_constant_type), parameter, public :: ELECTRON_MAG_MOM_ANOMALY = & +codata_constant_type("electron mag. mom. anomaly", & +1.15965218046e-3_dp, 0.00000000018e-3_dp, & +"") !! electron mag. mom. anomaly + +type(codata_constant_type), parameter, public :: ELECTRON_MAG_MOM_TO_BOHR_MAGNETON_RATIO = & +codata_constant_type("electron mag. mom. to Bohr magneton ratio", & +-1.00115965218046_dp, 0.00000000000018_dp, & +"") !! electron mag. mom. to Bohr magneton ratio + +type(codata_constant_type), parameter, public :: ELECTRON_MAG_MOM_TO_NUCLEAR_MAGNETON_RATIO = & +codata_constant_type("electron mag. mom. to nuclear magneton ratio", & +-1838.281971877_dp, 0.000000032_dp, & +"") !! electron mag. mom. to nuclear magneton ratio + +type(codata_constant_type), parameter, public :: ELECTRON_MASS = & +codata_constant_type("electron mass", & +9.1093837139e-31_dp, 0.0000000028e-31_dp, & +"kg") !! electron mass + +type(codata_constant_type), parameter, public :: ELECTRON_MASS_ENERGY_EQUIVALENT = & +codata_constant_type("electron mass energy equivalent", & +8.1871057880e-14_dp, 0.0000000026e-14_dp, & +"J") !! electron mass energy equivalent + +type(codata_constant_type), parameter, public :: ELECTRON_MASS_ENERGY_EQUIVALENT_IN_MEV = & +codata_constant_type("electron mass energy equivalent in MeV", & +0.51099895069_dp, 0.00000000016_dp, & +"MeV") !! electron mass energy equivalent in MeV + +type(codata_constant_type), parameter, public :: ELECTRON_MASS_IN_U = & +codata_constant_type("electron mass in u", & +5.485799090441e-4_dp, 0.000000000097e-4_dp, & +"u") !! electron mass in u + +type(codata_constant_type), parameter, public :: ELECTRON_MOLAR_MASS = & +codata_constant_type("electron molar mass", & +5.4857990962e-7_dp, 0.0000000017e-7_dp, & +"kg mol^-1") !! electron molar mass + +type(codata_constant_type), parameter, public :: ELECTRON_MUON_MAG_MOM_RATIO = & +codata_constant_type("electron-muon mag. mom. ratio", & +206.7669881_dp, 0.0000046_dp, & +"") !! electron-muon mag. mom. ratio + +type(codata_constant_type), parameter, public :: ELECTRON_MUON_MASS_RATIO = & +codata_constant_type("electron-muon mass ratio", & +4.83633170e-3_dp, 0.00000011e-3_dp, & +"") !! electron-muon mass ratio + +type(codata_constant_type), parameter, public :: ELECTRON_NEUTRON_MAG_MOM_RATIO = & +codata_constant_type("electron-neutron mag. mom. ratio", & +960.92048_dp, 0.00023_dp, & +"") !! electron-neutron mag. mom. ratio + +type(codata_constant_type), parameter, public :: ELECTRON_NEUTRON_MASS_RATIO = & +codata_constant_type("electron-neutron mass ratio", & +5.4386734416e-4_dp, 0.0000000022e-4_dp, & +"") !! electron-neutron mass ratio + +type(codata_constant_type), parameter, public :: ELECTRON_PROTON_MAG_MOM_RATIO = & +codata_constant_type("electron-proton mag. mom. ratio", & +-658.21068789_dp, 0.00000019_dp, & +"") !! electron-proton mag. mom. ratio + +type(codata_constant_type), parameter, public :: ELECTRON_PROTON_MASS_RATIO = & +codata_constant_type("electron-proton mass ratio", & +5.446170214889e-4_dp, 0.000000000094e-4_dp, & +"") !! electron-proton mass ratio + +type(codata_constant_type), parameter, public :: ELECTRON_RELATIVE_ATOMIC_MASS = & +codata_constant_type("electron relative atomic mass", & +5.485799090441e-4_dp, 0.000000000097e-4_dp, & +"") !! electron relative atomic mass + +type(codata_constant_type), parameter, public :: ELECTRON_TAU_MASS_RATIO = & +codata_constant_type("electron-tau mass ratio", & +2.87585e-4_dp, 0.00019e-4_dp, & +"") !! electron-tau mass ratio + +type(codata_constant_type), parameter, public :: ELECTRON_TO_ALPHA_PARTICLE_MASS_RATIO = & +codata_constant_type("electron to alpha particle mass ratio", & +1.370933554733e-4_dp, 0.000000000032e-4_dp, & +"") !! electron to alpha particle mass ratio + +type(codata_constant_type), parameter, public :: ELECTRON_TO_SHIELDED_HELION_MAG_MOM_RATIO = & +codata_constant_type("electron to shielded helion mag. mom. ratio", & +864.05823986_dp, 0.00000070_dp, & +"") !! electron to shielded helion mag. mom. ratio + +type(codata_constant_type), parameter, public :: ELECTRON_TO_SHIELDED_PROTON_MAG_MOM_RATIO = & +codata_constant_type("electron to shielded proton mag. mom. ratio", & +-658.2275856_dp, 0.0000027_dp, & +"") !! electron to shielded proton mag. mom. ratio + +type(codata_constant_type), parameter, public :: ELECTRON_TRITON_MASS_RATIO = & +codata_constant_type("electron-triton mass ratio", & +1.819200062327e-4_dp, 0.000000000068e-4_dp, & +"") !! electron-triton mass ratio + +type(codata_constant_type), parameter, public :: ELECTRON_VOLT = & +codata_constant_type("electron volt", & +1.602176634e-19_dp, 0.0_dp, & +"J") !! electron volt + +type(codata_constant_type), parameter, public :: ELECTRON_VOLT_ATOMIC_MASS_UNIT_RELATIONSHIP = & +codata_constant_type("electron volt-atomic mass unit relationship", & +1.07354410083e-9_dp, 0.00000000033e-9_dp, & +"u") !! electron volt-atomic mass unit relationship + +type(codata_constant_type), parameter, public :: ELECTRON_VOLT_HARTREE_RELATIONSHIP = & +codata_constant_type("electron volt-hartree relationship", & +3.6749322175665e-2_dp, 0.0000000000040e-2_dp, & +"E_h") !! electron volt-hartree relationship + +type(codata_constant_type), parameter, public :: ELECTRON_VOLT_HERTZ_RELATIONSHIP = & +codata_constant_type("electron volt-hertz relationship", & +2.417989242e14_dp, 0.0_dp, & +"Hz") !! electron volt-hertz relationship + +type(codata_constant_type), parameter, public :: ELECTRON_VOLT_INVERSE_METER_RELATIONSHIP = & +codata_constant_type("electron volt-inverse meter relationship", & +8.065543937e5_dp, 0.0_dp, & +"m^-1") !! electron volt-inverse meter relationship + +type(codata_constant_type), parameter, public :: ELECTRON_VOLT_JOULE_RELATIONSHIP = & +codata_constant_type("electron volt-joule relationship", & +1.602176634e-19_dp, 0.0_dp, & +"J") !! electron volt-joule relationship + +type(codata_constant_type), parameter, public :: ELECTRON_VOLT_KELVIN_RELATIONSHIP = & +codata_constant_type("electron volt-kelvin relationship", & +1.160451812e4_dp, 0.0_dp, & +"K") !! electron volt-kelvin relationship + +type(codata_constant_type), parameter, public :: ELECTRON_VOLT_KILOGRAM_RELATIONSHIP = & +codata_constant_type("electron volt-kilogram relationship", & +1.782661921e-36_dp, 0.0_dp, & +"kg") !! electron volt-kilogram relationship + +type(codata_constant_type), parameter, public :: ELEMENTARY_CHARGE = & +codata_constant_type("elementary charge", & +1.602176634e-19_dp, 0.0_dp, & +"C") !! elementary charge + +type(codata_constant_type), parameter, public :: ELEMENTARY_CHARGE_OVER_H_BAR = & +codata_constant_type("elementary charge over h-bar", & +1.519267447e15_dp, 0.0_dp, & +"A J^-1") !! elementary charge over h-bar + +type(codata_constant_type), parameter, public :: FARADAY_CONSTANT = & +codata_constant_type("Faraday constant", & +96485.33212_dp, 0.0_dp, & +"C mol^-1") !! Faraday constant + +type(codata_constant_type), parameter, public :: FERMI_COUPLING_CONSTANT = & +codata_constant_type("Fermi coupling constant", & +1.1663787e-5_dp, 0.0000006e-5_dp, & +"GeV^-2") !! Fermi coupling constant + +type(codata_constant_type), parameter, public :: FINE_STRUCTURE_CONSTANT = & +codata_constant_type("fine-structure constant", & +7.2973525643e-3_dp, 0.0000000011e-3_dp, & +"") !! fine-structure constant + +type(codata_constant_type), parameter, public :: FIRST_RADIATION_CONSTANT = & +codata_constant_type("first radiation constant", & +3.741771852e-16_dp, 0.0_dp, & +"W m^2") !! first radiation constant + +type(codata_constant_type), parameter, public :: FIRST_RADIATION_CONSTANT_FOR_SPECTRAL_RADIANCE = & +codata_constant_type("first radiation constant for spectral radiance", & +1.191042972e-16_dp, 0.0_dp, & +"W m^2 sr^-1") !! first radiation constant for spectral radiance + +type(codata_constant_type), parameter, public :: HARTREE_ATOMIC_MASS_UNIT_RELATIONSHIP = & +codata_constant_type("hartree-atomic mass unit relationship", & +2.92126231797e-8_dp, 0.00000000091e-8_dp, & +"u") !! hartree-atomic mass unit relationship + +type(codata_constant_type), parameter, public :: HARTREE_ELECTRON_VOLT_RELATIONSHIP = & +codata_constant_type("hartree-electron volt relationship", & +27.211386245981_dp, 0.000000000030_dp, & +"eV") !! hartree-electron volt relationship + +type(codata_constant_type), parameter, public :: HARTREE_ENERGY = & +codata_constant_type("Hartree energy", & +4.3597447222060e-18_dp, 0.0000000000048e-18_dp, & +"J") !! Hartree energy + +type(codata_constant_type), parameter, public :: HARTREE_ENERGY_IN_EV = & +codata_constant_type("Hartree energy in eV", & +27.211386245981_dp, 0.000000000030_dp, & +"eV") !! Hartree energy in eV + +type(codata_constant_type), parameter, public :: HARTREE_HERTZ_RELATIONSHIP = & +codata_constant_type("hartree-hertz relationship", & +6.5796839204999e15_dp, 0.0000000000072e15_dp, & +"Hz") !! hartree-hertz relationship + +type(codata_constant_type), parameter, public :: HARTREE_INVERSE_METER_RELATIONSHIP = & +codata_constant_type("hartree-inverse meter relationship", & +2.1947463136314e7_dp, 0.0000000000024e7_dp, & +"m^-1") !! hartree-inverse meter relationship + +type(codata_constant_type), parameter, public :: HARTREE_JOULE_RELATIONSHIP = & +codata_constant_type("hartree-joule relationship", & +4.3597447222060e-18_dp, 0.0000000000048e-18_dp, & +"J") !! hartree-joule relationship + +type(codata_constant_type), parameter, public :: HARTREE_KELVIN_RELATIONSHIP = & +codata_constant_type("hartree-kelvin relationship", & +3.1577502480398e5_dp, 0.0000000000034e5_dp, & +"K") !! hartree-kelvin relationship + +type(codata_constant_type), parameter, public :: HARTREE_KILOGRAM_RELATIONSHIP = & +codata_constant_type("hartree-kilogram relationship", & +4.8508702095419e-35_dp, 0.0000000000053e-35_dp, & +"kg") !! hartree-kilogram relationship + +type(codata_constant_type), parameter, public :: HELION_ELECTRON_MASS_RATIO = & +codata_constant_type("helion-electron mass ratio", & +5495.88527984_dp, 0.00000016_dp, & +"") !! helion-electron mass ratio + +type(codata_constant_type), parameter, public :: HELION_G_FACTOR = & +codata_constant_type("helion g factor", & +-4.2552506995_dp, 0.0000000034_dp, & +"") !! helion g factor + +type(codata_constant_type), parameter, public :: HELION_MAG_MOM = & +codata_constant_type("helion mag. mom.", & +-1.07461755198e-26_dp, 0.00000000093e-26_dp, & +"J T^-1") !! helion mag. mom. + +type(codata_constant_type), parameter, public :: HELION_MAG_MOM_TO_BOHR_MAGNETON_RATIO = & +codata_constant_type("helion mag. mom. to Bohr magneton ratio", & +-1.15874098083e-3_dp, 0.00000000094e-3_dp, & +"") !! helion mag. mom. to Bohr magneton ratio + +type(codata_constant_type), parameter, public :: HELION_MAG_MOM_TO_NUCLEAR_MAGNETON_RATIO = & +codata_constant_type("helion mag. mom. to nuclear magneton ratio", & +-2.1276253498_dp, 0.0000000017_dp, & +"") !! helion mag. mom. to nuclear magneton ratio + +type(codata_constant_type), parameter, public :: HELION_MASS = & +codata_constant_type("helion mass", & +5.0064127862e-27_dp, 0.0000000016e-27_dp, & +"kg") !! helion mass + +type(codata_constant_type), parameter, public :: HELION_MASS_ENERGY_EQUIVALENT = & +codata_constant_type("helion mass energy equivalent", & +4.4995394185e-10_dp, 0.0000000014e-10_dp, & +"J") !! helion mass energy equivalent + +type(codata_constant_type), parameter, public :: HELION_MASS_ENERGY_EQUIVALENT_IN_MEV = & +codata_constant_type("helion mass energy equivalent in MeV", & +2808.39161112_dp, 0.00000088_dp, & +"MeV") !! helion mass energy equivalent in MeV + +type(codata_constant_type), parameter, public :: HELION_MASS_IN_U = & +codata_constant_type("helion mass in u", & +3.014932246932_dp, 0.000000000074_dp, & +"u") !! helion mass in u + +type(codata_constant_type), parameter, public :: HELION_MOLAR_MASS = & +codata_constant_type("helion molar mass", & +3.01493225010e-3_dp, 0.00000000094e-3_dp, & +"kg mol^-1") !! helion molar mass + +type(codata_constant_type), parameter, public :: HELION_PROTON_MASS_RATIO = & +codata_constant_type("helion-proton mass ratio", & +2.993152671552_dp, 0.000000000070_dp, & +"") !! helion-proton mass ratio + +type(codata_constant_type), parameter, public :: HELION_RELATIVE_ATOMIC_MASS = & +codata_constant_type("helion relative atomic mass", & +3.014932246932_dp, 0.000000000074_dp, & +"") !! helion relative atomic mass + +type(codata_constant_type), parameter, public :: HELION_SHIELDING_SHIFT = & +codata_constant_type("helion shielding shift", & +5.9967029e-5_dp, 0.0000023e-5_dp, & +"") !! helion shielding shift + +type(codata_constant_type), parameter, public :: HERTZ_ATOMIC_MASS_UNIT_RELATIONSHIP = & +codata_constant_type("hertz-atomic mass unit relationship", & +4.4398216590e-24_dp, 0.0000000014e-24_dp, & +"u") !! hertz-atomic mass unit relationship + +type(codata_constant_type), parameter, public :: HERTZ_ELECTRON_VOLT_RELATIONSHIP = & +codata_constant_type("hertz-electron volt relationship", & +4.135667696e-15_dp, 0.0_dp, & +"eV") !! hertz-electron volt relationship + +type(codata_constant_type), parameter, public :: HERTZ_HARTREE_RELATIONSHIP = & +codata_constant_type("hertz-hartree relationship", & +1.5198298460574e-16_dp, 0.0000000000017e-16_dp, & +"E_h") !! hertz-hartree relationship + +type(codata_constant_type), parameter, public :: HERTZ_INVERSE_METER_RELATIONSHIP = & +codata_constant_type("hertz-inverse meter relationship", & +3.335640951e-9_dp, 0.0_dp, & +"m^-1") !! hertz-inverse meter relationship + +type(codata_constant_type), parameter, public :: HERTZ_JOULE_RELATIONSHIP = & +codata_constant_type("hertz-joule relationship", & +6.62607015e-34_dp, 0.0_dp, & +"J") !! hertz-joule relationship + +type(codata_constant_type), parameter, public :: HERTZ_KELVIN_RELATIONSHIP = & +codata_constant_type("hertz-kelvin relationship", & +4.799243073e-11_dp, 0.0_dp, & +"K") !! hertz-kelvin relationship + +type(codata_constant_type), parameter, public :: HERTZ_KILOGRAM_RELATIONSHIP = & +codata_constant_type("hertz-kilogram relationship", & +7.372497323e-51_dp, 0.0_dp, & +"kg") !! hertz-kilogram relationship + +type(codata_constant_type), parameter, public :: HYPERFINE_TRANSITION_FREQUENCY_OF_CS_133 = & +codata_constant_type("hyperfine transition frequency of Cs-133", & +9192631770_dp, 0.0_dp, & +"Hz") !! hyperfine transition frequency of Cs-133 + +type(codata_constant_type), parameter, public :: INVERSE_FINE_STRUCTURE_CONSTANT = & +codata_constant_type("inverse fine-structure constant", & +137.035999177_dp, 0.000000021_dp, & +"") !! inverse fine-structure constant + +type(codata_constant_type), parameter, public :: INVERSE_METER_ATOMIC_MASS_UNIT_RELATIONSHIP = & +codata_constant_type("inverse meter-atomic mass unit relationship", & +1.33102504824e-15_dp, 0.00000000041e-15_dp, & +"u") !! inverse meter-atomic mass unit relationship + +type(codata_constant_type), parameter, public :: INVERSE_METER_ELECTRON_VOLT_RELATIONSHIP = & +codata_constant_type("inverse meter-electron volt relationship", & +1.239841984e-6_dp, 0.0_dp, & +"eV") !! inverse meter-electron volt relationship + +type(codata_constant_type), parameter, public :: INVERSE_METER_HARTREE_RELATIONSHIP = & +codata_constant_type("inverse meter-hartree relationship", & +4.5563352529132e-8_dp, 0.0000000000050e-8_dp, & +"E_h") !! inverse meter-hartree relationship + +type(codata_constant_type), parameter, public :: INVERSE_METER_HERTZ_RELATIONSHIP = & +codata_constant_type("inverse meter-hertz relationship", & +299792458_dp, 0.0_dp, & +"Hz") !! inverse meter-hertz relationship + +type(codata_constant_type), parameter, public :: INVERSE_METER_JOULE_RELATIONSHIP = & +codata_constant_type("inverse meter-joule relationship", & +1.986445857e-25_dp, 0.0_dp, & +"J") !! inverse meter-joule relationship + +type(codata_constant_type), parameter, public :: INVERSE_METER_KELVIN_RELATIONSHIP = & +codata_constant_type("inverse meter-kelvin relationship", & +1.438776877e-2_dp, 0.0_dp, & +"K") !! inverse meter-kelvin relationship + +type(codata_constant_type), parameter, public :: INVERSE_METER_KILOGRAM_RELATIONSHIP = & +codata_constant_type("inverse meter-kilogram relationship", & +2.210219094e-42_dp, 0.0_dp, & +"kg") !! inverse meter-kilogram relationship + +type(codata_constant_type), parameter, public :: INVERSE_OF_CONDUCTANCE_QUANTUM = & +codata_constant_type("inverse of conductance quantum", & +12906.40372_dp, 0.0_dp, & +"ohm") !! inverse of conductance quantum + +type(codata_constant_type), parameter, public :: JOSEPHSON_CONSTANT = & +codata_constant_type("Josephson constant", & +483597.8484e9_dp, 0.0_dp, & +"Hz V^-1") !! Josephson constant + +type(codata_constant_type), parameter, public :: JOULE_ATOMIC_MASS_UNIT_RELATIONSHIP = & +codata_constant_type("joule-atomic mass unit relationship", & +6.7005352471e9_dp, 0.0000000021e9_dp, & +"u") !! joule-atomic mass unit relationship + +type(codata_constant_type), parameter, public :: JOULE_ELECTRON_VOLT_RELATIONSHIP = & +codata_constant_type("joule-electron volt relationship", & +6.241509074e18_dp, 0.0_dp, & +"eV") !! joule-electron volt relationship + +type(codata_constant_type), parameter, public :: JOULE_HARTREE_RELATIONSHIP = & +codata_constant_type("joule-hartree relationship", & +2.2937122783969e17_dp, 0.0000000000025e17_dp, & +"E_h") !! joule-hartree relationship + +type(codata_constant_type), parameter, public :: JOULE_HERTZ_RELATIONSHIP = & +codata_constant_type("joule-hertz relationship", & +1.509190179e33_dp, 0.0_dp, & +"Hz") !! joule-hertz relationship + +type(codata_constant_type), parameter, public :: JOULE_INVERSE_METER_RELATIONSHIP = & +codata_constant_type("joule-inverse meter relationship", & +5.034116567e24_dp, 0.0_dp, & +"m^-1") !! joule-inverse meter relationship + +type(codata_constant_type), parameter, public :: JOULE_KELVIN_RELATIONSHIP = & +codata_constant_type("joule-kelvin relationship", & +7.242970516e22_dp, 0.0_dp, & +"K") !! joule-kelvin relationship + +type(codata_constant_type), parameter, public :: JOULE_KILOGRAM_RELATIONSHIP = & +codata_constant_type("joule-kilogram relationship", & +1.112650056e-17_dp, 0.0_dp, & +"kg") !! joule-kilogram relationship + +type(codata_constant_type), parameter, public :: KELVIN_ATOMIC_MASS_UNIT_RELATIONSHIP = & +codata_constant_type("kelvin-atomic mass unit relationship", & +9.2510872884e-14_dp, 0.0000000029e-14_dp, & +"u") !! kelvin-atomic mass unit relationship + +type(codata_constant_type), parameter, public :: KELVIN_ELECTRON_VOLT_RELATIONSHIP = & +codata_constant_type("kelvin-electron volt relationship", & +8.617333262e-5_dp, 0.0_dp, & +"eV") !! kelvin-electron volt relationship + +type(codata_constant_type), parameter, public :: KELVIN_HARTREE_RELATIONSHIP = & +codata_constant_type("kelvin-hartree relationship", & +3.1668115634564e-6_dp, 0.0000000000035e-6_dp, & +"E_h") !! kelvin-hartree relationship + +type(codata_constant_type), parameter, public :: KELVIN_HERTZ_RELATIONSHIP = & +codata_constant_type("kelvin-hertz relationship", & +2.083661912e10_dp, 0.0_dp, & +"Hz") !! kelvin-hertz relationship + +type(codata_constant_type), parameter, public :: KELVIN_INVERSE_METER_RELATIONSHIP = & +codata_constant_type("kelvin-inverse meter relationship", & +69.50348004_dp, 0.0_dp, & +"m^-1") !! kelvin-inverse meter relationship + +type(codata_constant_type), parameter, public :: KELVIN_JOULE_RELATIONSHIP = & +codata_constant_type("kelvin-joule relationship", & +1.380649e-23_dp, 0.0_dp, & +"J") !! kelvin-joule relationship + +type(codata_constant_type), parameter, public :: KELVIN_KILOGRAM_RELATIONSHIP = & +codata_constant_type("kelvin-kilogram relationship", & +1.536179187e-40_dp, 0.0_dp, & +"kg") !! kelvin-kilogram relationship + +type(codata_constant_type), parameter, public :: KILOGRAM_ATOMIC_MASS_UNIT_RELATIONSHIP = & +codata_constant_type("kilogram-atomic mass unit relationship", & +6.0221407537e26_dp, 0.0000000019e26_dp, & +"u") !! kilogram-atomic mass unit relationship + +type(codata_constant_type), parameter, public :: KILOGRAM_ELECTRON_VOLT_RELATIONSHIP = & +codata_constant_type("kilogram-electron volt relationship", & +5.609588603e35_dp, 0.0_dp, & +"eV") !! kilogram-electron volt relationship + +type(codata_constant_type), parameter, public :: KILOGRAM_HARTREE_RELATIONSHIP = & +codata_constant_type("kilogram-hartree relationship", & +2.0614857887415e34_dp, 0.0000000000022e34_dp, & +"E_h") !! kilogram-hartree relationship + +type(codata_constant_type), parameter, public :: KILOGRAM_HERTZ_RELATIONSHIP = & +codata_constant_type("kilogram-hertz relationship", & +1.356392489e50_dp, 0.0_dp, & +"Hz") !! kilogram-hertz relationship + +type(codata_constant_type), parameter, public :: KILOGRAM_INVERSE_METER_RELATIONSHIP = & +codata_constant_type("kilogram-inverse meter relationship", & +4.524438335e41_dp, 0.0_dp, & +"m^-1") !! kilogram-inverse meter relationship + +type(codata_constant_type), parameter, public :: KILOGRAM_JOULE_RELATIONSHIP = & +codata_constant_type("kilogram-joule relationship", & +8.987551787e16_dp, 0.0_dp, & +"J") !! kilogram-joule relationship + +type(codata_constant_type), parameter, public :: KILOGRAM_KELVIN_RELATIONSHIP = & +codata_constant_type("kilogram-kelvin relationship", & +6.509657260e39_dp, 0.0_dp, & +"K") !! kilogram-kelvin relationship + +type(codata_constant_type), parameter, public :: LATTICE_PARAMETER_OF_SILICON = & +codata_constant_type("lattice parameter of silicon", & +5.431020511e-10_dp, 0.000000089e-10_dp, & +"m") !! lattice parameter of silicon + +type(codata_constant_type), parameter, public :: LATTICE_SPACING_OF_IDEAL_SI_220 = & +codata_constant_type("lattice spacing of ideal Si (220)", & +1.920155716e-10_dp, 0.000000032e-10_dp, & +"m") !! lattice spacing of ideal Si (220) + +type(codata_constant_type), parameter, public :: LOSCHMIDT_CONSTANT_273_15_K_100_KPA = & +codata_constant_type("Loschmidt constant (273.15 K, 100 kPa)", & +2.651645804e25_dp, 0.0_dp, & +"m^-3") !! Loschmidt constant (273.15 K, 100 kPa) + +type(codata_constant_type), parameter, public :: LOSCHMIDT_CONSTANT_273_15_K_101_325_KPA = & +codata_constant_type("Loschmidt constant (273.15 K, 101.325 kPa)", & +2.686780111e25_dp, 0.0_dp, & +"m^-3") !! Loschmidt constant (273.15 K, 101.325 kPa) + +type(codata_constant_type), parameter, public :: LUMINOUS_EFFICACY = & +codata_constant_type("luminous efficacy", & +683_dp, 0.0_dp, & +"lm W^-1") !! luminous efficacy + +type(codata_constant_type), parameter, public :: MAG_FLUX_QUANTUM = & +codata_constant_type("mag. flux quantum", & +2.067833848e-15_dp, 0.0_dp, & +"Wb") !! mag. flux quantum + +type(codata_constant_type), parameter, public :: MOLAR_GAS_CONSTANT = & +codata_constant_type("molar gas constant", & +8.314462618_dp, 0.0_dp, & +"J mol^-1 K^-1") !! molar gas constant + +type(codata_constant_type), parameter, public :: MOLAR_MASS_CONSTANT = & +codata_constant_type("molar mass constant", & +1.00000000105e-3_dp, 0.00000000031e-3_dp, & +"kg mol^-1") !! molar mass constant + +type(codata_constant_type), parameter, public :: MOLAR_MASS_OF_CARBON_12 = & +codata_constant_type("molar mass of carbon-12", & +12.0000000126e-3_dp, 0.0000000037e-3_dp, & +"kg mol^-1") !! molar mass of carbon-12 + +type(codata_constant_type), parameter, public :: MOLAR_PLANCK_CONSTANT = & +codata_constant_type("molar Planck constant", & +3.990312712e-10_dp, 0.0_dp, & +"J Hz^-1 mol^-1") !! molar Planck constant + +type(codata_constant_type), parameter, public :: MOLAR_VOLUME_OF_IDEAL_GAS_273_15_K_100_KPA = & +codata_constant_type("molar volume of ideal gas (273.15 K, 100 kPa)", & +22.71095464e-3_dp, 0.0_dp, & +"m^3 mol^-1") !! molar volume of ideal gas (273.15 K, 100 kPa) + +type(codata_constant_type), parameter, public :: MOLAR_VOLUME_OF_IDEAL_GAS_273_15_K_101_325_KPA = & +codata_constant_type("molar volume of ideal gas (273.15 K, 101.325 kPa)", & +22.41396954e-3_dp, 0.0_dp, & +"m^3 mol^-1") !! molar volume of ideal gas (273.15 K, 101.325 kPa) + +type(codata_constant_type), parameter, public :: MOLAR_VOLUME_OF_SILICON = & +codata_constant_type("molar volume of silicon", & +1.205883199e-5_dp, 0.000000060e-5_dp, & +"m^3 mol^-1") !! molar volume of silicon + +type(codata_constant_type), parameter, public :: MOLYBDENUM_X_UNIT = & +codata_constant_type("Molybdenum x unit", & +1.00209952e-13_dp, 0.00000053e-13_dp, & +"m") !! Molybdenum x unit + +type(codata_constant_type), parameter, public :: MUON_COMPTON_WAVELENGTH = & +codata_constant_type("muon Compton wavelength", & +1.173444110e-14_dp, 0.000000026e-14_dp, & +"m") !! muon Compton wavelength + +type(codata_constant_type), parameter, public :: MUON_ELECTRON_MASS_RATIO = & +codata_constant_type("muon-electron mass ratio", & +206.7682827_dp, 0.0000046_dp, & +"") !! muon-electron mass ratio + +type(codata_constant_type), parameter, public :: MUON_G_FACTOR = & +codata_constant_type("muon g factor", & +-2.00233184123_dp, 0.00000000082_dp, & +"") !! muon g factor + +type(codata_constant_type), parameter, public :: MUON_MAG_MOM = & +codata_constant_type("muon mag. mom.", & +-4.49044830e-26_dp, 0.00000010e-26_dp, & +"J T^-1") !! muon mag. mom. + +type(codata_constant_type), parameter, public :: MUON_MAG_MOM_ANOMALY = & +codata_constant_type("muon mag. mom. anomaly", & +1.16592062e-3_dp, 0.00000041e-3_dp, & +"") !! muon mag. mom. anomaly + +type(codata_constant_type), parameter, public :: MUON_MAG_MOM_TO_BOHR_MAGNETON_RATIO = & +codata_constant_type("muon mag. mom. to Bohr magneton ratio", & +-4.84197048e-3_dp, 0.00000011e-3_dp, & +"") !! muon mag. mom. to Bohr magneton ratio + +type(codata_constant_type), parameter, public :: MUON_MAG_MOM_TO_NUCLEAR_MAGNETON_RATIO = & +codata_constant_type("muon mag. mom. to nuclear magneton ratio", & +-8.89059704_dp, 0.00000020_dp, & +"") !! muon mag. mom. to nuclear magneton ratio + +type(codata_constant_type), parameter, public :: MUON_MASS = & +codata_constant_type("muon mass", & +1.883531627e-28_dp, 0.000000042e-28_dp, & +"kg") !! muon mass + +type(codata_constant_type), parameter, public :: MUON_MASS_ENERGY_EQUIVALENT = & +codata_constant_type("muon mass energy equivalent", & +1.692833804e-11_dp, 0.000000038e-11_dp, & +"J") !! muon mass energy equivalent + +type(codata_constant_type), parameter, public :: MUON_MASS_ENERGY_EQUIVALENT_IN_MEV = & +codata_constant_type("muon mass energy equivalent in MeV", & +105.6583755_dp, 0.0000023_dp, & +"MeV") !! muon mass energy equivalent in MeV + +type(codata_constant_type), parameter, public :: MUON_MASS_IN_U = & +codata_constant_type("muon mass in u", & +0.1134289257_dp, 0.0000000025_dp, & +"u") !! muon mass in u + +type(codata_constant_type), parameter, public :: MUON_MOLAR_MASS = & +codata_constant_type("muon molar mass", & +1.134289258e-4_dp, 0.000000025e-4_dp, & +"kg mol^-1") !! muon molar mass + +type(codata_constant_type), parameter, public :: MUON_NEUTRON_MASS_RATIO = & +codata_constant_type("muon-neutron mass ratio", & +0.1124545168_dp, 0.0000000025_dp, & +"") !! muon-neutron mass ratio + +type(codata_constant_type), parameter, public :: MUON_PROTON_MAG_MOM_RATIO = & +codata_constant_type("muon-proton mag. mom. ratio", & +-3.183345146_dp, 0.000000071_dp, & +"") !! muon-proton mag. mom. ratio + +type(codata_constant_type), parameter, public :: MUON_PROTON_MASS_RATIO = & +codata_constant_type("muon-proton mass ratio", & +0.1126095262_dp, 0.0000000025_dp, & +"") !! muon-proton mass ratio + +type(codata_constant_type), parameter, public :: MUON_TAU_MASS_RATIO = & +codata_constant_type("muon-tau mass ratio", & +5.94635e-2_dp, 0.00040e-2_dp, & +"") !! muon-tau mass ratio + +type(codata_constant_type), parameter, public :: NATURAL_UNIT_OF_ACTION = & +codata_constant_type("natural unit of action", & +1.054571817e-34_dp, 0.0_dp, & +"J s") !! natural unit of action + +type(codata_constant_type), parameter, public :: NATURAL_UNIT_OF_ACTION_IN_EV_S = & +codata_constant_type("natural unit of action in eV s", & +6.582119569e-16_dp, 0.0_dp, & +"eV s") !! natural unit of action in eV s + +type(codata_constant_type), parameter, public :: NATURAL_UNIT_OF_ENERGY = & +codata_constant_type("natural unit of energy", & +8.1871057880e-14_dp, 0.0000000026e-14_dp, & +"J") !! natural unit of energy + +type(codata_constant_type), parameter, public :: NATURAL_UNIT_OF_ENERGY_IN_MEV = & +codata_constant_type("natural unit of energy in MeV", & +0.51099895069_dp, 0.00000000016_dp, & +"MeV") !! natural unit of energy in MeV + +type(codata_constant_type), parameter, public :: NATURAL_UNIT_OF_LENGTH = & +codata_constant_type("natural unit of length", & +3.8615926744e-13_dp, 0.0000000012e-13_dp, & +"m") !! natural unit of length + +type(codata_constant_type), parameter, public :: NATURAL_UNIT_OF_MASS = & +codata_constant_type("natural unit of mass", & +9.1093837139e-31_dp, 0.0000000028e-31_dp, & +"kg") !! natural unit of mass + +type(codata_constant_type), parameter, public :: NATURAL_UNIT_OF_MOMENTUM = & +codata_constant_type("natural unit of momentum", & +2.73092453446e-22_dp, 0.00000000085e-22_dp, & +"kg m s^-1") !! natural unit of momentum + +type(codata_constant_type), parameter, public :: NATURAL_UNIT_OF_MOMENTUM_IN_MEV_C = & +codata_constant_type("natural unit of momentum in MeV/c", & +0.51099895069_dp, 0.00000000016_dp, & +"MeV/c") !! natural unit of momentum in MeV/c + +type(codata_constant_type), parameter, public :: NATURAL_UNIT_OF_TIME = & +codata_constant_type("natural unit of time", & +1.28808866644e-21_dp, 0.00000000040e-21_dp, & +"s") !! natural unit of time + +type(codata_constant_type), parameter, public :: NATURAL_UNIT_OF_VELOCITY = & +codata_constant_type("natural unit of velocity", & +299792458_dp, 0.0_dp, & +"m s^-1") !! natural unit of velocity + +type(codata_constant_type), parameter, public :: NEUTRON_COMPTON_WAVELENGTH = & +codata_constant_type("neutron Compton wavelength", & +1.31959090382e-15_dp, 0.00000000067e-15_dp, & +"m") !! neutron Compton wavelength + +type(codata_constant_type), parameter, public :: NEUTRON_ELECTRON_MAG_MOM_RATIO = & +codata_constant_type("neutron-electron mag. mom. ratio", & +1.04066884e-3_dp, 0.00000024e-3_dp, & +"") !! neutron-electron mag. mom. ratio + +type(codata_constant_type), parameter, public :: NEUTRON_ELECTRON_MASS_RATIO = & +codata_constant_type("neutron-electron mass ratio", & +1838.68366200_dp, 0.00000074_dp, & +"") !! neutron-electron mass ratio + +type(codata_constant_type), parameter, public :: NEUTRON_G_FACTOR = & +codata_constant_type("neutron g factor", & +-3.82608552_dp, 0.00000090_dp, & +"") !! neutron g factor + +type(codata_constant_type), parameter, public :: NEUTRON_GYROMAG_RATIO = & +codata_constant_type("neutron gyromag. ratio", & +1.83247174e8_dp, 0.00000043e8_dp, & +"s^-1 T^-1") !! neutron gyromag. ratio + +type(codata_constant_type), parameter, public :: NEUTRON_GYROMAG_RATIO_IN_MHZ_T = & +codata_constant_type("neutron gyromag. ratio in MHz/T", & +29.1646935_dp, 0.0000069_dp, & +"MHz T^-1") !! neutron gyromag. ratio in MHz/T + +type(codata_constant_type), parameter, public :: NEUTRON_MAG_MOM = & +codata_constant_type("neutron mag. mom.", & +-9.6623653e-27_dp, 0.0000023e-27_dp, & +"J T^-1") !! neutron mag. mom. + +type(codata_constant_type), parameter, public :: NEUTRON_MAG_MOM_TO_BOHR_MAGNETON_RATIO = & +codata_constant_type("neutron mag. mom. to Bohr magneton ratio", & +-1.04187565e-3_dp, 0.00000025e-3_dp, & +"") !! neutron mag. mom. to Bohr magneton ratio + +type(codata_constant_type), parameter, public :: NEUTRON_MAG_MOM_TO_NUCLEAR_MAGNETON_RATIO = & +codata_constant_type("neutron mag. mom. to nuclear magneton ratio", & +-1.91304276_dp, 0.00000045_dp, & +"") !! neutron mag. mom. to nuclear magneton ratio + +type(codata_constant_type), parameter, public :: NEUTRON_MASS = & +codata_constant_type("neutron mass", & +1.67492750056e-27_dp, 0.00000000085e-27_dp, & +"kg") !! neutron mass + +type(codata_constant_type), parameter, public :: NEUTRON_MASS_ENERGY_EQUIVALENT = & +codata_constant_type("neutron mass energy equivalent", & +1.50534976514e-10_dp, 0.00000000076e-10_dp, & +"J") !! neutron mass energy equivalent + +type(codata_constant_type), parameter, public :: NEUTRON_MASS_ENERGY_EQUIVALENT_IN_MEV = & +codata_constant_type("neutron mass energy equivalent in MeV", & +939.56542194_dp, 0.00000048_dp, & +"MeV") !! neutron mass energy equivalent in MeV + +type(codata_constant_type), parameter, public :: NEUTRON_MASS_IN_U = & +codata_constant_type("neutron mass in u", & +1.00866491606_dp, 0.00000000040_dp, & +"u") !! neutron mass in u + +type(codata_constant_type), parameter, public :: NEUTRON_MOLAR_MASS = & +codata_constant_type("neutron molar mass", & +1.00866491712e-3_dp, 0.00000000051e-3_dp, & +"kg mol^-1") !! neutron molar mass + +type(codata_constant_type), parameter, public :: NEUTRON_MUON_MASS_RATIO = & +codata_constant_type("neutron-muon mass ratio", & +8.89248408_dp, 0.00000020_dp, & +"") !! neutron-muon mass ratio + +type(codata_constant_type), parameter, public :: NEUTRON_PROTON_MAG_MOM_RATIO = & +codata_constant_type("neutron-proton mag. mom. ratio", & +-0.68497935_dp, 0.00000016_dp, & +"") !! neutron-proton mag. mom. ratio + +type(codata_constant_type), parameter, public :: NEUTRON_PROTON_MASS_DIFFERENCE = & +codata_constant_type("neutron-proton mass difference", & +2.30557461e-30_dp, 0.00000067e-30_dp, & +"kg") !! neutron-proton mass difference + +type(codata_constant_type), parameter, public :: NEUTRON_PROTON_MASS_DIFFERENCE_ENERGY_EQUIVALENT = & +codata_constant_type("neutron-proton mass difference energy equivalent", & +2.07214712e-13_dp, 0.00000060e-13_dp, & +"J") !! neutron-proton mass difference energy equivalent + +type(codata_constant_type), parameter, public :: NEUTRON_PROTON_MASS_DIFFERENCE_ENERGY_EQUIVALENT_IN_MEV = & +codata_constant_type("neutron-proton mass difference energy equivalent in MeV", & +1.29333251_dp, 0.00000038_dp, & +"MeV") !! neutron-proton mass difference energy equivalent in MeV + +type(codata_constant_type), parameter, public :: NEUTRON_PROTON_MASS_DIFFERENCE_IN_U = & +codata_constant_type("neutron-proton mass difference in u", & +1.38844948e-3_dp, 0.00000040e-3_dp, & +"u") !! neutron-proton mass difference in u + +type(codata_constant_type), parameter, public :: NEUTRON_PROTON_MASS_RATIO = & +codata_constant_type("neutron-proton mass ratio", & +1.00137841946_dp, 0.00000000040_dp, & +"") !! neutron-proton mass ratio + +type(codata_constant_type), parameter, public :: NEUTRON_RELATIVE_ATOMIC_MASS = & +codata_constant_type("neutron relative atomic mass", & +1.00866491606_dp, 0.00000000040_dp, & +"") !! neutron relative atomic mass + +type(codata_constant_type), parameter, public :: NEUTRON_TAU_MASS_RATIO = & +codata_constant_type("neutron-tau mass ratio", & +0.528779_dp, 0.000036_dp, & +"") !! neutron-tau mass ratio + +type(codata_constant_type), parameter, public :: NEUTRON_TO_SHIELDED_PROTON_MAG_MOM_RATIO = & +codata_constant_type("neutron to shielded proton mag. mom. ratio", & +-0.68499694_dp, 0.00000016_dp, & +"") !! neutron to shielded proton mag. mom. ratio + +type(codata_constant_type), parameter, public :: NEWTONIAN_CONSTANT_OF_GRAVITATION = & +codata_constant_type("Newtonian constant of gravitation", & +6.67430e-11_dp, 0.00015e-11_dp, & +"m^3 kg^-1 s^-2") !! Newtonian constant of gravitation + +type(codata_constant_type), parameter, public :: NEWTONIAN_CONSTANT_OF_GRAVITATION_OVER_H_BAR_C = & +codata_constant_type("Newtonian constant of gravitation over h-bar c", & +6.70883e-39_dp, 0.00015e-39_dp, & +"(GeV/c^2)^-2") !! Newtonian constant of gravitation over h-bar c + +type(codata_constant_type), parameter, public :: NUCLEAR_MAGNETON = & +codata_constant_type("nuclear magneton", & +5.0507837393e-27_dp, 0.0000000016e-27_dp, & +"J T^-1") !! nuclear magneton + +type(codata_constant_type), parameter, public :: NUCLEAR_MAGNETON_IN_EV_T = & +codata_constant_type("nuclear magneton in eV/T", & +3.15245125417e-8_dp, 0.00000000098e-8_dp, & +"eV T^-1") !! nuclear magneton in eV/T + +type(codata_constant_type), parameter, public :: NUCLEAR_MAGNETON_IN_INVERSE_METER_PER_TESLA = & +codata_constant_type("nuclear magneton in inverse meter per tesla", & +2.54262341009e-2_dp, 0.00000000079e-2_dp, & +"m^-1 T^-1") !! nuclear magneton in inverse meter per tesla + +type(codata_constant_type), parameter, public :: NUCLEAR_MAGNETON_IN_K_T = & +codata_constant_type("nuclear magneton in K/T", & +3.6582677706e-4_dp, 0.0000000011e-4_dp, & +"K T^-1") !! nuclear magneton in K/T + +type(codata_constant_type), parameter, public :: NUCLEAR_MAGNETON_IN_MHZ_T = & +codata_constant_type("nuclear magneton in MHz/T", & +7.6225932188_dp, 0.0000000024_dp, & +"MHz T^-1") !! nuclear magneton in MHz/T + +type(codata_constant_type), parameter, public :: PLANCK_CONSTANT = & +codata_constant_type("Planck constant", & +6.62607015e-34_dp, 0.0_dp, & +"J Hz^-1") !! Planck constant + +type(codata_constant_type), parameter, public :: PLANCK_CONSTANT_IN_EV_HZ = & +codata_constant_type("Planck constant in eV/Hz", & +4.135667696e-15_dp, 0.0_dp, & +"eV Hz^-1") !! Planck constant in eV/Hz + +type(codata_constant_type), parameter, public :: PLANCK_LENGTH = & +codata_constant_type("Planck length", & +1.616255e-35_dp, 0.000018e-35_dp, & +"m") !! Planck length + +type(codata_constant_type), parameter, public :: PLANCK_MASS = & +codata_constant_type("Planck mass", & +2.176434e-8_dp, 0.000024e-8_dp, & +"kg") !! Planck mass + +type(codata_constant_type), parameter, public :: PLANCK_MASS_ENERGY_EQUIVALENT_IN_GEV = & +codata_constant_type("Planck mass energy equivalent in GeV", & +1.220890e19_dp, 0.000014e19_dp, & +"GeV") !! Planck mass energy equivalent in GeV + +type(codata_constant_type), parameter, public :: PLANCK_TEMPERATURE = & +codata_constant_type("Planck temperature", & +1.416784e32_dp, 0.000016e32_dp, & +"K") !! Planck temperature + +type(codata_constant_type), parameter, public :: PLANCK_TIME = & +codata_constant_type("Planck time", & +5.391247e-44_dp, 0.000060e-44_dp, & +"s") !! Planck time + +type(codata_constant_type), parameter, public :: PROTON_CHARGE_TO_MASS_QUOTIENT = & +codata_constant_type("proton charge to mass quotient", & +9.5788331430e7_dp, 0.0000000030e7_dp, & +"C kg^-1") !! proton charge to mass quotient + +type(codata_constant_type), parameter, public :: PROTON_COMPTON_WAVELENGTH = & +codata_constant_type("proton Compton wavelength", & +1.32140985360e-15_dp, 0.00000000041e-15_dp, & +"m") !! proton Compton wavelength + +type(codata_constant_type), parameter, public :: PROTON_ELECTRON_MASS_RATIO = & +codata_constant_type("proton-electron mass ratio", & +1836.152673426_dp, 0.000000032_dp, & +"") !! proton-electron mass ratio + +type(codata_constant_type), parameter, public :: PROTON_G_FACTOR = & +codata_constant_type("proton g factor", & +5.5856946893_dp, 0.0000000016_dp, & +"") !! proton g factor + +type(codata_constant_type), parameter, public :: PROTON_GYROMAG_RATIO = & +codata_constant_type("proton gyromag. ratio", & +2.6752218708e8_dp, 0.0000000011e8_dp, & +"s^-1 T^-1") !! proton gyromag. ratio + +type(codata_constant_type), parameter, public :: PROTON_GYROMAG_RATIO_IN_MHZ_T = & +codata_constant_type("proton gyromag. ratio in MHz/T", & +42.577478461_dp, 0.000000018_dp, & +"MHz T^-1") !! proton gyromag. ratio in MHz/T + +type(codata_constant_type), parameter, public :: PROTON_MAG_MOM = & +codata_constant_type("proton mag. mom.", & +1.41060679545e-26_dp, 0.00000000060e-26_dp, & +"J T^-1") !! proton mag. mom. + +type(codata_constant_type), parameter, public :: PROTON_MAG_MOM_TO_BOHR_MAGNETON_RATIO = & +codata_constant_type("proton mag. mom. to Bohr magneton ratio", & +1.52103220230e-3_dp, 0.00000000045e-3_dp, & +"") !! proton mag. mom. to Bohr magneton ratio + +type(codata_constant_type), parameter, public :: PROTON_MAG_MOM_TO_NUCLEAR_MAGNETON_RATIO = & +codata_constant_type("proton mag. mom. to nuclear magneton ratio", & +2.79284734463_dp, 0.00000000082_dp, & +"") !! proton mag. mom. to nuclear magneton ratio + +type(codata_constant_type), parameter, public :: PROTON_MAG_SHIELDING_CORRECTION = & +codata_constant_type("proton mag. shielding correction", & +2.56715e-5_dp, 0.00041e-5_dp, & +"") !! proton mag. shielding correction + +type(codata_constant_type), parameter, public :: PROTON_MASS = & +codata_constant_type("proton mass", & +1.67262192595e-27_dp, 0.00000000052e-27_dp, & +"kg") !! proton mass + +type(codata_constant_type), parameter, public :: PROTON_MASS_ENERGY_EQUIVALENT = & +codata_constant_type("proton mass energy equivalent", & +1.50327761802e-10_dp, 0.00000000047e-10_dp, & +"J") !! proton mass energy equivalent + +type(codata_constant_type), parameter, public :: PROTON_MASS_ENERGY_EQUIVALENT_IN_MEV = & +codata_constant_type("proton mass energy equivalent in MeV", & +938.27208943_dp, 0.00000029_dp, & +"MeV") !! proton mass energy equivalent in MeV + +type(codata_constant_type), parameter, public :: PROTON_MASS_IN_U = & +codata_constant_type("proton mass in u", & +1.0072764665789_dp, 0.0000000000083_dp, & +"u") !! proton mass in u + +type(codata_constant_type), parameter, public :: PROTON_MOLAR_MASS = & +codata_constant_type("proton molar mass", & +1.00727646764e-3_dp, 0.00000000031e-3_dp, & +"kg mol^-1") !! proton molar mass + +type(codata_constant_type), parameter, public :: PROTON_MUON_MASS_RATIO = & +codata_constant_type("proton-muon mass ratio", & +8.88024338_dp, 0.00000020_dp, & +"") !! proton-muon mass ratio + +type(codata_constant_type), parameter, public :: PROTON_NEUTRON_MAG_MOM_RATIO = & +codata_constant_type("proton-neutron mag. mom. ratio", & +-1.45989802_dp, 0.00000034_dp, & +"") !! proton-neutron mag. mom. ratio + +type(codata_constant_type), parameter, public :: PROTON_NEUTRON_MASS_RATIO = & +codata_constant_type("proton-neutron mass ratio", & +0.99862347797_dp, 0.00000000040_dp, & +"") !! proton-neutron mass ratio + +type(codata_constant_type), parameter, public :: PROTON_RELATIVE_ATOMIC_MASS = & +codata_constant_type("proton relative atomic mass", & +1.0072764665789_dp, 0.0000000000083_dp, & +"") !! proton relative atomic mass + +type(codata_constant_type), parameter, public :: PROTON_RMS_CHARGE_RADIUS = & +codata_constant_type("proton rms charge radius", & +8.4075e-16_dp, 0.0064e-16_dp, & +"m") !! proton rms charge radius + +type(codata_constant_type), parameter, public :: PROTON_TAU_MASS_RATIO = & +codata_constant_type("proton-tau mass ratio", & +0.528051_dp, 0.000036_dp, & +"") !! proton-tau mass ratio + +type(codata_constant_type), parameter, public :: QUANTUM_OF_CIRCULATION = & +codata_constant_type("quantum of circulation", & +3.6369475467e-4_dp, 0.0000000011e-4_dp, & +"m^2 s^-1") !! quantum of circulation + +type(codata_constant_type), parameter, public :: QUANTUM_OF_CIRCULATION_TIMES_2 = & +codata_constant_type("quantum of circulation times 2", & +7.2738950934e-4_dp, 0.0000000023e-4_dp, & +"m^2 s^-1") !! quantum of circulation times 2 + +type(codata_constant_type), parameter, public :: REDUCED_COMPTON_WAVELENGTH = & +codata_constant_type("reduced Compton wavelength", & +3.8615926744e-13_dp, 0.0000000012e-13_dp, & +"m") !! reduced Compton wavelength + +type(codata_constant_type), parameter, public :: REDUCED_MUON_COMPTON_WAVELENGTH = & +codata_constant_type("reduced muon Compton wavelength", & +1.867594306e-15_dp, 0.000000042e-15_dp, & +"m") !! reduced muon Compton wavelength + +type(codata_constant_type), parameter, public :: REDUCED_NEUTRON_COMPTON_WAVELENGTH = & +codata_constant_type("reduced neutron Compton wavelength", & +2.1001941520e-16_dp, 0.0000000011e-16_dp, & +"m") !! reduced neutron Compton wavelength + +type(codata_constant_type), parameter, public :: REDUCED_PLANCK_CONSTANT = & +codata_constant_type("reduced Planck constant", & +1.054571817e-34_dp, 0.0_dp, & +"J s") !! reduced Planck constant + +type(codata_constant_type), parameter, public :: REDUCED_PLANCK_CONSTANT_IN_EV_S = & +codata_constant_type("reduced Planck constant in eV s", & +6.582119569e-16_dp, 0.0_dp, & +"eV s") !! reduced Planck constant in eV s + +type(codata_constant_type), parameter, public :: REDUCED_PLANCK_CONSTANT_TIMES_C_IN_MEV_FM = & +codata_constant_type("reduced Planck constant times c in MeV fm", & +197.3269804_dp, 0.0_dp, & +"MeV fm") !! reduced Planck constant times c in MeV fm + +type(codata_constant_type), parameter, public :: REDUCED_PROTON_COMPTON_WAVELENGTH = & +codata_constant_type("reduced proton Compton wavelength", & +2.10308910051e-16_dp, 0.00000000066e-16_dp, & +"m") !! reduced proton Compton wavelength + +type(codata_constant_type), parameter, public :: REDUCED_TAU_COMPTON_WAVELENGTH = & +codata_constant_type("reduced tau Compton wavelength", & +1.110538e-16_dp, 0.000075e-16_dp, & +"m") !! reduced tau Compton wavelength + +type(codata_constant_type), parameter, public :: RYDBERG_CONSTANT = & +codata_constant_type("Rydberg constant", & +10973731.568157_dp, 0.000012_dp, & +"m^-1") !! Rydberg constant + +type(codata_constant_type), parameter, public :: RYDBERG_CONSTANT_TIMES_C_IN_HZ = & +codata_constant_type("Rydberg constant times c in Hz", & +3.2898419602500e15_dp, 0.0000000000036e15_dp, & +"Hz") !! Rydberg constant times c in Hz + +type(codata_constant_type), parameter, public :: RYDBERG_CONSTANT_TIMES_HC_IN_EV = & +codata_constant_type("Rydberg constant times hc in eV", & +13.605693122990_dp, 0.000000000015_dp, & +"eV") !! Rydberg constant times hc in eV + +type(codata_constant_type), parameter, public :: RYDBERG_CONSTANT_TIMES_HC_IN_J = & +codata_constant_type("Rydberg constant times hc in J", & +2.1798723611030e-18_dp, 0.0000000000024e-18_dp, & +"J") !! Rydberg constant times hc in J + +type(codata_constant_type), parameter, public :: SACKUR_TETRODE_CONSTANT_1_K_100_KPA = & +codata_constant_type("Sackur-Tetrode constant (1 K, 100 kPa)", & +-1.15170753496_dp, 0.00000000047_dp, & +"") !! Sackur-Tetrode constant (1 K, 100 kPa) + +type(codata_constant_type), parameter, public :: SACKUR_TETRODE_CONSTANT_1_K_101_325_KPA = & +codata_constant_type("Sackur-Tetrode constant (1 K, 101.325 kPa)", & +-1.16487052149_dp, 0.00000000047_dp, & +"") !! Sackur-Tetrode constant (1 K, 101.325 kPa) + +type(codata_constant_type), parameter, public :: SECOND_RADIATION_CONSTANT = & +codata_constant_type("second radiation constant", & +1.438776877e-2_dp, 0.0_dp, & +"m K") !! second radiation constant + +type(codata_constant_type), parameter, public :: SHIELDED_HELION_GYROMAG_RATIO = & +codata_constant_type("shielded helion gyromag. ratio", & +2.0378946078e8_dp, 0.0000000018e8_dp, & +"s^-1 T^-1") !! shielded helion gyromag. ratio + +type(codata_constant_type), parameter, public :: SHIELDED_HELION_GYROMAG_RATIO_IN_MHZ_T = & +codata_constant_type("shielded helion gyromag. ratio in MHz/T", & +32.434100033_dp, 0.000000028_dp, & +"MHz T^-1") !! shielded helion gyromag. ratio in MHz/T + +type(codata_constant_type), parameter, public :: SHIELDED_HELION_MAG_MOM = & +codata_constant_type("shielded helion mag. mom.", & +-1.07455311035e-26_dp, 0.00000000093e-26_dp, & +"J T^-1") !! shielded helion mag. mom. + +type(codata_constant_type), parameter, public :: SHIELDED_HELION_MAG_MOM_TO_BOHR_MAGNETON_RATIO = & +codata_constant_type("shielded helion mag. mom. to Bohr magneton ratio", & +-1.15867149457e-3_dp, 0.00000000094e-3_dp, & +"") !! shielded helion mag. mom. to Bohr magneton ratio + +type(codata_constant_type), parameter, public :: SHIELDED_HELION_MAG_MOM_TO_NUCLEAR_MAGNETON_RATIO = & +codata_constant_type("shielded helion mag. mom. to nuclear magneton ratio", & +-2.1274977624_dp, 0.0000000017_dp, & +"") !! shielded helion mag. mom. to nuclear magneton ratio + +type(codata_constant_type), parameter, public :: SHIELDED_HELION_TO_PROTON_MAG_MOM_RATIO = & +codata_constant_type("shielded helion to proton mag. mom. ratio", & +-0.76176657721_dp, 0.00000000066_dp, & +"") !! shielded helion to proton mag. mom. ratio + +type(codata_constant_type), parameter, public :: SHIELDED_HELION_TO_SHIELDED_PROTON_MAG_MOM_RATIO = & +codata_constant_type("shielded helion to shielded proton mag. mom. ratio", & +-0.7617861334_dp, 0.0000000031_dp, & +"") !! shielded helion to shielded proton mag. mom. ratio + +type(codata_constant_type), parameter, public :: SHIELDED_PROTON_GYROMAG_RATIO = & +codata_constant_type("shielded proton gyromag. ratio", & +2.675153194e8_dp, 0.000000011e8_dp, & +"s^-1 T^-1") !! shielded proton gyromag. ratio + +type(codata_constant_type), parameter, public :: SHIELDED_PROTON_GYROMAG_RATIO_IN_MHZ_T = & +codata_constant_type("shielded proton gyromag. ratio in MHz/T", & +42.57638543_dp, 0.00000017_dp, & +"MHz T^-1") !! shielded proton gyromag. ratio in MHz/T + +type(codata_constant_type), parameter, public :: SHIELDED_PROTON_MAG_MOM = & +codata_constant_type("shielded proton mag. mom.", & +1.4105705830e-26_dp, 0.0000000058e-26_dp, & +"J T^-1") !! shielded proton mag. mom. + +type(codata_constant_type), parameter, public :: SHIELDED_PROTON_MAG_MOM_TO_BOHR_MAGNETON_RATIO = & +codata_constant_type("shielded proton mag. mom. to Bohr magneton ratio", & +1.5209931551e-3_dp, 0.0000000062e-3_dp, & +"") !! shielded proton mag. mom. to Bohr magneton ratio + +type(codata_constant_type), parameter, public :: SHIELDED_PROTON_MAG_MOM_TO_NUCLEAR_MAGNETON_RATIO = & +codata_constant_type("shielded proton mag. mom. to nuclear magneton ratio", & +2.792775648_dp, 0.000000011_dp, & +"") !! shielded proton mag. mom. to nuclear magneton ratio + +type(codata_constant_type), parameter, public :: SHIELDING_DIFFERENCE_OF_D_AND_P_IN_HD = & +codata_constant_type("shielding difference of d and p in HD", & +1.98770e-8_dp, 0.00010e-8_dp, & +"") !! shielding difference of d and p in HD + +type(codata_constant_type), parameter, public :: SHIELDING_DIFFERENCE_OF_T_AND_P_IN_HT = & +codata_constant_type("shielding difference of t and p in HT", & +2.39450e-8_dp, 0.00020e-8_dp, & +"") !! shielding difference of t and p in HT + +type(codata_constant_type), parameter, public :: SPEED_OF_LIGHT_IN_VACUUM = & +codata_constant_type("speed of light in vacuum", & +299792458_dp, 0.0_dp, & +"m s^-1") !! speed of light in vacuum + +type(codata_constant_type), parameter, public :: STANDARD_ACCELERATION_OF_GRAVITY = & +codata_constant_type("standard acceleration of gravity", & +9.80665_dp, 0.0_dp, & +"m s^-2") !! standard acceleration of gravity + +type(codata_constant_type), parameter, public :: STANDARD_ATMOSPHERE = & +codata_constant_type("standard atmosphere", & +101325_dp, 0.0_dp, & +"Pa") !! standard atmosphere + +type(codata_constant_type), parameter, public :: STANDARD_STATE_PRESSURE = & +codata_constant_type("standard-state pressure", & +100000_dp, 0.0_dp, & +"Pa") !! standard-state pressure + +type(codata_constant_type), parameter, public :: STEFAN_BOLTZMANN_CONSTANT = & +codata_constant_type("Stefan-Boltzmann constant", & +5.670374419e-8_dp, 0.0_dp, & +"W m^-2 K^-4") !! Stefan-Boltzmann constant + +type(codata_constant_type), parameter, public :: TAU_COMPTON_WAVELENGTH = & +codata_constant_type("tau Compton wavelength", & +6.97771e-16_dp, 0.00047e-16_dp, & +"m") !! tau Compton wavelength + +type(codata_constant_type), parameter, public :: TAU_ELECTRON_MASS_RATIO = & +codata_constant_type("tau-electron mass ratio", & +3477.23_dp, 0.23_dp, & +"") !! tau-electron mass ratio + +type(codata_constant_type), parameter, public :: TAU_ENERGY_EQUIVALENT = & +codata_constant_type("tau energy equivalent", & +1776.86_dp, 0.12_dp, & +"MeV") !! tau energy equivalent + +type(codata_constant_type), parameter, public :: TAU_MASS = & +codata_constant_type("tau mass", & +3.16754e-27_dp, 0.00021e-27_dp, & +"kg") !! tau mass + +type(codata_constant_type), parameter, public :: TAU_MASS_ENERGY_EQUIVALENT = & +codata_constant_type("tau mass energy equivalent", & +2.84684e-10_dp, 0.00019e-10_dp, & +"J") !! tau mass energy equivalent + +type(codata_constant_type), parameter, public :: TAU_MASS_IN_U = & +codata_constant_type("tau mass in u", & +1.90754_dp, 0.00013_dp, & +"u") !! tau mass in u + +type(codata_constant_type), parameter, public :: TAU_MOLAR_MASS = & +codata_constant_type("tau molar mass", & +1.90754e-3_dp, 0.00013e-3_dp, & +"kg mol^-1") !! tau molar mass + +type(codata_constant_type), parameter, public :: TAU_MUON_MASS_RATIO = & +codata_constant_type("tau-muon mass ratio", & +16.8170_dp, 0.0011_dp, & +"") !! tau-muon mass ratio + +type(codata_constant_type), parameter, public :: TAU_NEUTRON_MASS_RATIO = & +codata_constant_type("tau-neutron mass ratio", & +1.89115_dp, 0.00013_dp, & +"") !! tau-neutron mass ratio + +type(codata_constant_type), parameter, public :: TAU_PROTON_MASS_RATIO = & +codata_constant_type("tau-proton mass ratio", & +1.89376_dp, 0.00013_dp, & +"") !! tau-proton mass ratio + +type(codata_constant_type), parameter, public :: THOMSON_CROSS_SECTION = & +codata_constant_type("Thomson cross section", & +6.6524587051e-29_dp, 0.0000000062e-29_dp, & +"m^2") !! Thomson cross section + +type(codata_constant_type), parameter, public :: TRITON_ELECTRON_MASS_RATIO = & +codata_constant_type("triton-electron mass ratio", & +5496.92153551_dp, 0.00000021_dp, & +"") !! triton-electron mass ratio + +type(codata_constant_type), parameter, public :: TRITON_G_FACTOR = & +codata_constant_type("triton g factor", & +5.957924930_dp, 0.000000012_dp, & +"") !! triton g factor + +type(codata_constant_type), parameter, public :: TRITON_MAG_MOM = & +codata_constant_type("triton mag. mom.", & +1.5046095178e-26_dp, 0.0000000030e-26_dp, & +"J T^-1") !! triton mag. mom. + +type(codata_constant_type), parameter, public :: TRITON_MAG_MOM_TO_BOHR_MAGNETON_RATIO = & +codata_constant_type("triton mag. mom. to Bohr magneton ratio", & +1.6223936648e-3_dp, 0.0000000032e-3_dp, & +"") !! triton mag. mom. to Bohr magneton ratio + +type(codata_constant_type), parameter, public :: TRITON_MAG_MOM_TO_NUCLEAR_MAGNETON_RATIO = & +codata_constant_type("triton mag. mom. to nuclear magneton ratio", & +2.9789624650_dp, 0.0000000059_dp, & +"") !! triton mag. mom. to nuclear magneton ratio + +type(codata_constant_type), parameter, public :: TRITON_MASS = & +codata_constant_type("triton mass", & +5.0073567512e-27_dp, 0.0000000016e-27_dp, & +"kg") !! triton mass + +type(codata_constant_type), parameter, public :: TRITON_MASS_ENERGY_EQUIVALENT = & +codata_constant_type("triton mass energy equivalent", & +4.5003878119e-10_dp, 0.0000000014e-10_dp, & +"J") !! triton mass energy equivalent + +type(codata_constant_type), parameter, public :: TRITON_MASS_ENERGY_EQUIVALENT_IN_MEV = & +codata_constant_type("triton mass energy equivalent in MeV", & +2808.92113668_dp, 0.00000088_dp, & +"MeV") !! triton mass energy equivalent in MeV + +type(codata_constant_type), parameter, public :: TRITON_MASS_IN_U = & +codata_constant_type("triton mass in u", & +3.01550071597_dp, 0.00000000010_dp, & +"u") !! triton mass in u + +type(codata_constant_type), parameter, public :: TRITON_MOLAR_MASS = & +codata_constant_type("triton molar mass", & +3.01550071913e-3_dp, 0.00000000094e-3_dp, & +"kg mol^-1") !! triton molar mass + +type(codata_constant_type), parameter, public :: TRITON_PROTON_MASS_RATIO = & +codata_constant_type("triton-proton mass ratio", & +2.99371703403_dp, 0.00000000010_dp, & +"") !! triton-proton mass ratio + +type(codata_constant_type), parameter, public :: TRITON_RELATIVE_ATOMIC_MASS = & +codata_constant_type("triton relative atomic mass", & +3.01550071597_dp, 0.00000000010_dp, & +"") !! triton relative atomic mass + +type(codata_constant_type), parameter, public :: TRITON_TO_PROTON_MAG_MOM_RATIO = & +codata_constant_type("triton to proton mag. mom. ratio", & +1.0666399189_dp, 0.0000000021_dp, & +"") !! triton to proton mag. mom. ratio + +type(codata_constant_type), parameter, public :: UNIFIED_ATOMIC_MASS_UNIT = & +codata_constant_type("unified atomic mass unit", & +1.66053906892e-27_dp, 0.00000000052e-27_dp, & +"kg") !! unified atomic mass unit + +type(codata_constant_type), parameter, public :: VACUUM_ELECTRIC_PERMITTIVITY = & +codata_constant_type("vacuum electric permittivity", & +8.8541878188e-12_dp, 0.0000000014e-12_dp, & +"F m^-1") !! vacuum electric permittivity + +type(codata_constant_type), parameter, public :: VACUUM_MAG_PERMEABILITY = & +codata_constant_type("vacuum mag. permeability", & +1.25663706127e-6_dp, 0.00000000020e-6_dp, & +"N A^-2") !! vacuum mag. permeability + +type(codata_constant_type), parameter, public :: VON_KLITZING_CONSTANT = & +codata_constant_type("von Klitzing constant", & +25812.80745_dp, 0.0_dp, & +"ohm") !! von Klitzing constant + +type(codata_constant_type), parameter, public :: WEAK_MIXING_ANGLE = & +codata_constant_type("weak mixing angle", & +0.22305_dp, 0.00023_dp, & +"") !! weak mixing angle + +type(codata_constant_type), parameter, public :: WIEN_FREQUENCY_DISPLACEMENT_LAW_CONSTANT = & +codata_constant_type("Wien frequency displacement law constant", & +5.878925757e10_dp, 0.0_dp, & +"Hz K^-1") !! Wien frequency displacement law constant + +type(codata_constant_type), parameter, public :: WIEN_WAVELENGTH_DISPLACEMENT_LAW_CONSTANT = & +codata_constant_type("Wien wavelength displacement law constant", & +2.897771955e-3_dp, 0.0_dp, & +"m K") !! Wien wavelength displacement law constant + +type(codata_constant_type), parameter, public :: W_TO_Z_MASS_RATIO = & +codata_constant_type("W to Z mass ratio", & +0.88145_dp, 0.00013_dp, & +"") !! W to Z mass ratio + +end module stdlib_codata \ No newline at end of file diff --git a/src/stdlib_codata_type.fypp b/src/stdlib_codata_type.fypp new file mode 100644 index 000000000..1df032bef --- /dev/null +++ b/src/stdlib_codata_type.fypp @@ -0,0 +1,68 @@ +#:include "common.fypp" +#:set KINDS = REAL_KINDS +module stdlib_codata_type + !! Codata constant type + !! ([Specification](../page/specs/stdlib_constants.html)) + use stdlib_kinds, only: #{for k in KINDS[:-1]}#${k}$, #{endfor}#${KINDS[-1]}$ + use stdlib_io, only: FMT_REAL_DP + use stdlib_optval, only: optval + private + + type, public :: codata_constant_type + !! version: experimental + !! + !! Derived type for representing a Codata constant. + !! ([Specification](../page/specs/stdlib_constants.html)) + character(len=64) :: name + real(dp) :: value + real(dp) :: uncertainty + character(len=32) :: unit + contains + procedure :: print + #:for k in KINDS + procedure :: to_real_${k}$ + #:endfor + generic :: to_real => #{for k in KINDS[:-1]}#to_real_${k}$, #{endfor}#to_real_${KINDS[-1]}$ + end type + + interface to_real + !! Get the constant value or uncertainty. + #:for k in KINDS + module procedure to_real_${k}$ + #:endfor + end interface + + public :: to_real + +contains + +subroutine print(self) + !! Print out the constant's name, value, uncertainty and unit. + class(codata_constant_type), intent(in) :: self + print "(A64, SP, "//FMT_REAL_DP//", A5, "//FMT_REAL_DP//", 1X, A32)", self%name, self%value, "+/-", self%uncertainty, self%unit +end subroutine + +#:for k in KINDS +elemental pure real(${k}$) function to_real_${k}$(self, mold, uncertainty) result(r) + !! version: experimental + !! + !! Get the constant value or uncertainty for the kind ${k}$ + !! ([Specification](../page/specs/stdlib_constants.html)) + + class(codata_constant_type), intent(in) :: self !! Codata constant + real(${k}$), intent(in) :: mold !! dummy argument to disambiguate at compile time the generic interface + logical, intent(in), optional :: uncertainty !! Set to true if the uncertainty is required. Default to .false.. + !! + logical :: u + + u = optval(uncertainty, .false.) + + if(u .eqv. .false.)then + r = real(self%value, kind(mold)) + else + r = real(self%uncertainty, kind(mold)) + end if +end function +#:endfor + +end module stdlib_codata_type diff --git a/src/stdlib_constants.fypp b/src/stdlib_constants.fypp new file mode 100644 index 000000000..e169dbb3b --- /dev/null +++ b/src/stdlib_constants.fypp @@ -0,0 +1,64 @@ +#:include "common.fypp" +#:set KINDS = REAL_KINDS +module stdlib_constants + !! Constants + !! ([Specification](../page/specs/stdlib_constants.html)) + use stdlib_kinds, only: #{for k in KINDS[:-1]}#${k}$, #{endfor}#${KINDS[-1]}$ + use stdlib_codata, only: SPEED_OF_LIGHT_IN_VACUUM, & + VACUUM_ELECTRIC_PERMITTIVITY, & + VACUUM_MAG_PERMEABILITY, & + PLANCK_CONSTANT, & + NEWTONIAN_CONSTANT_OF_GRAVITATION, & + STANDARD_ACCELERATION_OF_GRAVITY, & + ELEMENTARY_CHARGE, & + MOLAR_GAS_CONSTANT, & + FINE_STRUCTURE_CONSTANT, & + AVOGADRO_CONSTANT, & + BOLTZMANN_CONSTANT, & + STEFAN_BOLTZMANN_CONSTANT, & + WIEN_WAVELENGTH_DISPLACEMENT_LAW_CONSTANT, & + RYDBERG_CONSTANT, & + ELECTRON_MASS, & + PROTON_MASS, & + NEUTRON_MASS, & + ATOMIC_MASS_CONSTANT + private + + ! mathematical constants + #:for k in KINDS + real(${k}$), parameter, public :: PI_${k}$ = acos(-1.0_${k}$) !! PI + #:endfor + + ! Physical constants + real(dp), parameter, public :: c = SPEED_OF_LIGHT_IN_VACUUM%value !! Speed of light in vacuum + real(dp), parameter, public :: speed_of_light = SPEED_OF_LIGHT_IN_VACUUM%value !! Speed of light in vacuum + real(dp), parameter, public :: mu_0 = VACUUM_MAG_PERMEABILITY%value !! vacuum mag. permeability + real(dp), parameter, public :: epsilon_0 = VACUUM_ELECTRIC_PERMITTIVITY%value !! vacuum mag. permeability + real(dp), parameter, public :: h = PLANCK_CONSTANT%value !! Planck constant + real(dp), parameter, public :: Planck = PLANCK_CONSTANT%value !! Planck constant + real(dp), parameter, public :: hbar = PLANCK_CONSTANT%value / PI_dp !! Reduced Planck constant + real(dp), parameter, public :: G = NEWTONIAN_CONSTANT_OF_GRAVITATION%value !! Newtonian constant of gravitation + real(dp), parameter, public :: gravitation_constant = NEWTONIAN_CONSTANT_OF_GRAVITATION%value !! Newtonian constant of gravitation + real(dp), parameter, public :: g2 = STANDARD_ACCELERATION_OF_GRAVITY%value !! Standard acceleration of gravity + real(dp), parameter, public :: e = ELEMENTARY_CHARGE%value !! Elementary charge + real(dp), parameter, public :: R = MOLAR_GAS_CONSTANT%value !! Molar gas constant + real(dp), parameter, public :: gas_constant = MOLAR_GAS_CONSTANT%value !! Molar gas constant + real(dp), parameter, public :: alpha = FINE_STRUCTURE_CONSTANT%value !! Fine structure constant + real(dp), parameter, public :: fine_structure = FINE_STRUCTURE_CONSTANT%value !! Fine structure constant + real(dp), parameter, public :: N_A = AVOGADRO_CONSTANT%value !! Avogadro constant + real(dp), parameter, public :: Avogadro = AVOGADRO_CONSTANT%value !! Avogadro constant + real(dp), parameter, public :: k = BOLTZMANN_CONSTANT%value !! Boltzmann constant + real(dp), parameter, public :: Boltzmann = BOLTZMANN_CONSTANT%value !! Boltzmann constant + real(dp), parameter, public :: sigma = STEFAN_BOLTZMANN_CONSTANT%value !! Stefan-Boltzmann constant + real(dp), parameter, public :: Stefan_Boltzmann = STEFAN_BOLTZMANN_CONSTANT%value !! Stefan-Boltzmann constant + real(dp), parameter, public :: Wien = WIEN_WAVELENGTH_DISPLACEMENT_LAW_CONSTANT%value !! Wien wavelength displacement law constant + real(dp), parameter, public :: Rydberg = RYDBERG_CONSTANT%value !! Rydberg constant + real(dp), parameter, public :: m_e = ELECTRON_MASS%value !! Electron mass + real(dp), parameter, public :: m_p = PROTON_MASS%value !! Proton mass + real(dp), parameter, public :: m_n = NEUTRON_MASS%value !! Neutron mass + real(dp), parameter, public :: m_u = ATOMIC_MASS_CONSTANT%value !! Atomic mass constant + real(dp), parameter, public :: u = ATOMIC_MASS_CONSTANT%value !! Atomic mass constant + + ! Additional constants if needed + +end module stdlib_constants diff --git a/src/stdlib_linalg_lapack.fypp b/src/stdlib_linalg_lapack.fypp index 8d0b4ce2c..ac6f43f77 100644 --- a/src/stdlib_linalg_lapack.fypp +++ b/src/stdlib_linalg_lapack.fypp @@ -5261,7 +5261,7 @@ module stdlib_linalg_lapack !! HB2ST_KERNELS is an internal routine used by the CHETRD_HB2ST !! subroutine. #ifdef STDLIB_EXTERNAL_LAPACK - pure subroutine chb2st_kernels( uplo, wantz, ttype,st, ed, sweep, n, nb, ib,a, & + pure subroutine chb2st_kernels( uplo, wantz, ttype,st, ed, sweep, n, nb, ib,a, & lda, v, tau, ldvt, work) import sp,dp,qp,ilp,lk implicit none(type,external) @@ -6394,7 +6394,7 @@ module stdlib_linalg_lapack !! tridiagonal form T by a unitary similarity transformation: !! Q**H * A * Q = T. #ifdef STDLIB_EXTERNAL_LAPACK - pure subroutine chetrd_hb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, & + subroutine chetrd_hb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, & lhous, work, lwork, info ) import sp,dp,qp,ilp,lk implicit none(type,external) @@ -6412,7 +6412,7 @@ module stdlib_linalg_lapack module procedure stdlib_whetrd_hb2st #:endif #ifdef STDLIB_EXTERNAL_LAPACK - pure subroutine zhetrd_hb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, & + subroutine zhetrd_hb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, & lhous, work, lwork, info ) import sp,dp,qp,ilp,lk implicit none(type,external) @@ -6435,7 +6435,7 @@ module stdlib_linalg_lapack !! band-diagonal form AB by a unitary similarity transformation: !! Q**H * A * Q = AB. #ifdef STDLIB_EXTERNAL_LAPACK - pure subroutine chetrd_he2hb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info & + subroutine chetrd_he2hb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info & ) import sp,dp,qp,ilp,lk implicit none(type,external) @@ -6452,7 +6452,7 @@ module stdlib_linalg_lapack module procedure stdlib_whetrd_he2hb #:endif #ifdef STDLIB_EXTERNAL_LAPACK - pure subroutine zhetrd_he2hb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info & + subroutine zhetrd_he2hb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info & ) import sp,dp,qp,ilp,lk implicit none(type,external) @@ -24182,7 +24182,7 @@ module stdlib_linalg_lapack !! tridiagonal form T by a orthogonal similarity transformation: !! Q**T * A * Q = T. #ifdef STDLIB_EXTERNAL_LAPACK - pure subroutine dsytrd_sb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, & + subroutine dsytrd_sb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, & lhous, work, lwork, info ) import sp,dp,qp,ilp,lk implicit none(type,external) @@ -24199,7 +24199,7 @@ module stdlib_linalg_lapack module procedure stdlib_qsytrd_sb2st #:endif #ifdef STDLIB_EXTERNAL_LAPACK - pure subroutine ssytrd_sb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, & + subroutine ssytrd_sb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, & lhous, work, lwork, info ) import sp,dp,qp,ilp,lk implicit none(type,external) @@ -24221,7 +24221,7 @@ module stdlib_linalg_lapack !! band-diagonal form AB by a orthogonal similarity transformation: !! Q**T * A * Q = AB. #ifdef STDLIB_EXTERNAL_LAPACK - pure subroutine dsytrd_sy2sb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info & + subroutine dsytrd_sy2sb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info & ) import sp,dp,qp,ilp,lk implicit none(type,external) @@ -24238,7 +24238,7 @@ module stdlib_linalg_lapack module procedure stdlib_qsytrd_sy2sb #:endif #ifdef STDLIB_EXTERNAL_LAPACK - pure subroutine ssytrd_sy2sb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info & + subroutine ssytrd_sy2sb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info & ) import sp,dp,qp,ilp,lk implicit none(type,external) diff --git a/src/stdlib_linalg_lapack_aux.fypp b/src/stdlib_linalg_lapack_aux.fypp index 593bc9b58..99b5ca03c 100644 --- a/src/stdlib_linalg_lapack_aux.fypp +++ b/src/stdlib_linalg_lapack_aux.fypp @@ -1708,7 +1708,7 @@ module stdlib_linalg_lapack_aux end function stdlib_ilaenv - pure integer(ilp) function stdlib_iparam2stage( ispec, name, opts,ni, nbi, ibi, nxi ) + integer(ilp) function stdlib_iparam2stage( ispec, name, opts,ni, nbi, ibi, nxi ) !! This program sets problem and machine dependent parameters !! useful for xHETRD_2STAGE, xHETRD_HE2HB, xHETRD_HB2ST, !! xGEBRD_2STAGE, xGEBRD_GE2GB, xGEBRD_GB2BD @@ -1892,7 +1892,7 @@ module stdlib_linalg_lapack_aux end function stdlib_iparam2stage - pure integer(ilp) function stdlib_ilaenv2stage( ispec, name, opts, n1, n2, n3, n4 ) + integer(ilp) function stdlib_ilaenv2stage( ispec, name, opts, n1, n2, n3, n4 ) !! ILAENV2STAGE is called from the LAPACK routines to choose problem-dependent !! parameters for the local environment. See ISPEC for a description of !! the parameters. diff --git a/src/stdlib_linalg_lapack_c.fypp b/src/stdlib_linalg_lapack_c.fypp index 3a78bd745..65dbcb36d 100644 --- a/src/stdlib_linalg_lapack_c.fypp +++ b/src/stdlib_linalg_lapack_c.fypp @@ -36212,7 +36212,7 @@ module stdlib_linalg_lapack_c end subroutine stdlib_chetrd - pure subroutine stdlib_chetrd_hb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, lhous, & + subroutine stdlib_chetrd_hb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, lhous, & !! CHETRD_HB2ST reduces a complex Hermitian band matrix A to real symmetric !! tridiagonal form T by a unitary similarity transformation: !! Q**H * A * Q = T. @@ -36485,7 +36485,7 @@ module stdlib_linalg_lapack_c end subroutine stdlib_chetrd_hb2st - pure subroutine stdlib_chetrd_he2hb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info ) + subroutine stdlib_chetrd_he2hb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info ) !! CHETRD_HE2HB reduces a complex Hermitian matrix A to complex Hermitian !! band-diagonal form AB by a unitary similarity transformation: !! Q**H * A * Q = AB. diff --git a/src/stdlib_linalg_lapack_d.fypp b/src/stdlib_linalg_lapack_d.fypp index 5b98ebab5..557311435 100644 --- a/src/stdlib_linalg_lapack_d.fypp +++ b/src/stdlib_linalg_lapack_d.fypp @@ -41285,7 +41285,7 @@ module stdlib_linalg_lapack_d end subroutine stdlib_dsytrd - pure subroutine stdlib_dsytrd_sb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, lhous, & + subroutine stdlib_dsytrd_sb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, lhous, & !! DSYTRD_SB2ST reduces a real symmetric band matrix A to real symmetric !! tridiagonal form T by a orthogonal similarity transformation: !! Q**T * A * Q = T. @@ -57070,7 +57070,7 @@ module stdlib_linalg_lapack_d end subroutine stdlib_dsysvx - pure subroutine stdlib_dsytrd_sy2sb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info ) + subroutine stdlib_dsytrd_sy2sb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info ) !! DSYTRD_SY2SB reduces a real symmetric matrix A to real symmetric !! band-diagonal form AB by a orthogonal similarity transformation: !! Q**T * A * Q = AB. diff --git a/src/stdlib_linalg_lapack_q.fypp b/src/stdlib_linalg_lapack_q.fypp index 7abcbf5d3..6dd252a47 100644 --- a/src/stdlib_linalg_lapack_q.fypp +++ b/src/stdlib_linalg_lapack_q.fypp @@ -72649,7 +72649,7 @@ module stdlib_linalg_lapack_q end subroutine stdlib_qsytrd - pure subroutine stdlib_qsytrd_sb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, lhous, & + subroutine stdlib_qsytrd_sb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, lhous, & !! DSYTRD_SB2ST: reduces a real symmetric band matrix A to real symmetric !! tridiagonal form T by a orthogonal similarity transformation: !! Q**T * A * Q = T. @@ -72895,7 +72895,7 @@ module stdlib_linalg_lapack_q end subroutine stdlib_qsytrd_sb2st - pure subroutine stdlib_qsytrd_sy2sb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info ) + subroutine stdlib_qsytrd_sy2sb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info ) !! DSYTRD_SY2SB: reduces a real symmetric matrix A to real symmetric !! band-diagonal form AB by a orthogonal similarity transformation: !! Q**T * A * Q = AB. diff --git a/src/stdlib_linalg_lapack_s.fypp b/src/stdlib_linalg_lapack_s.fypp index 426881202..61c96b29c 100644 --- a/src/stdlib_linalg_lapack_s.fypp +++ b/src/stdlib_linalg_lapack_s.fypp @@ -41195,7 +41195,7 @@ module stdlib_linalg_lapack_s end subroutine stdlib_ssytrd - pure subroutine stdlib_ssytrd_sb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, lhous, & + subroutine stdlib_ssytrd_sb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, lhous, & !! SSYTRD_SB2ST reduces a real symmetric band matrix A to real symmetric !! tridiagonal form T by a orthogonal similarity transformation: !! Q**T * A * Q = T. @@ -55545,7 +55545,7 @@ module stdlib_linalg_lapack_s end subroutine stdlib_ssysvx - pure subroutine stdlib_ssytrd_sy2sb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info ) + subroutine stdlib_ssytrd_sy2sb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info ) !! SSYTRD_SY2SB reduces a real symmetric matrix A to real symmetric !! band-diagonal form AB by a orthogonal similarity transformation: !! Q**T * A * Q = AB. diff --git a/src/stdlib_linalg_lapack_w.fypp b/src/stdlib_linalg_lapack_w.fypp index 1c7aefaa6..ea71d6446 100644 --- a/src/stdlib_linalg_lapack_w.fypp +++ b/src/stdlib_linalg_lapack_w.fypp @@ -28573,7 +28573,7 @@ module stdlib_linalg_lapack_w end subroutine stdlib_whetrd - pure subroutine stdlib_whetrd_hb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, lhous, & + subroutine stdlib_whetrd_hb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, lhous, & !! ZHETRD_HB2ST: reduces a complex Hermitian band matrix A to real symmetric !! tridiagonal form T by a unitary similarity transformation: !! Q**H * A * Q = T. @@ -28846,7 +28846,7 @@ module stdlib_linalg_lapack_w end subroutine stdlib_whetrd_hb2st - pure subroutine stdlib_whetrd_he2hb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info ) + subroutine stdlib_whetrd_he2hb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info ) !! ZHETRD_HE2HB: reduces a complex Hermitian matrix A to complex Hermitian !! band-diagonal form AB by a unitary similarity transformation: !! Q**H * A * Q = AB. diff --git a/src/stdlib_linalg_lapack_z.fypp b/src/stdlib_linalg_lapack_z.fypp index 288340565..e28d61961 100644 --- a/src/stdlib_linalg_lapack_z.fypp +++ b/src/stdlib_linalg_lapack_z.fypp @@ -36627,7 +36627,7 @@ module stdlib_linalg_lapack_z end subroutine stdlib_zhetrd - pure subroutine stdlib_zhetrd_hb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, lhous, & + subroutine stdlib_zhetrd_hb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, lhous, & !! ZHETRD_HB2ST reduces a complex Hermitian band matrix A to real symmetric !! tridiagonal form T by a unitary similarity transformation: !! Q**H * A * Q = T. @@ -36900,7 +36900,7 @@ module stdlib_linalg_lapack_z end subroutine stdlib_zhetrd_hb2st - pure subroutine stdlib_zhetrd_he2hb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info ) + subroutine stdlib_zhetrd_he2hb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info ) !! ZHETRD_HE2HB reduces a complex Hermitian matrix A to complex Hermitian !! band-diagonal form AB by a unitary similarity transformation: !! Q**H * A * Q = AB. diff --git a/src/stdlib_linalg_least_squares.fypp b/src/stdlib_linalg_least_squares.fypp index 0b7c2e139..65c7c0b9f 100644 --- a/src/stdlib_linalg_least_squares.fypp +++ b/src/stdlib_linalg_least_squares.fypp @@ -85,7 +85,7 @@ submodule (stdlib_linalg) stdlib_linalg_least_squares pure module subroutine stdlib_linalg_${ri}$_lstsq_space_${ndsuf}$(a,b,lrwork,liwork#{if rt.startswith('c')}#,lcwork#{endif}#) !> Input matrix a[m,n] ${rt}$, intent(in), target :: a(:,:) - !> Right hand side vector or array, b[n] or b[n,nrhs] + !> Right hand side vector or array, b[m] or b[m,nrhs] ${rt}$, intent(in) :: b${nd}$ !> Size of the working space arrays integer(ilp), intent(out) :: lrwork,liwork @@ -111,7 +111,7 @@ submodule (stdlib_linalg) stdlib_linalg_least_squares !! This function computes the least-squares solution of a linear matrix problem. !! !! param: a Input matrix of size [m,n]. - !! param: b Right-hand-side vector of size [n] or matrix of size [n,nrhs]. + !! param: b Right-hand-side vector of size [m] or matrix of size [m,nrhs]. !! param: cond [optional] Real input threshold indicating that singular values `s_i <= cond*maxval(s)` !! do not contribute to the matrix rank. !! param: overwrite_a [optional] Flag indicating if the input matrix can be overwritten. @@ -121,7 +121,7 @@ submodule (stdlib_linalg) stdlib_linalg_least_squares !! !> Input matrix a[m,n] ${rt}$, intent(inout), target :: a(:,:) - !> Right hand side vector or array, b[n] or b[n,nrhs] + !> Right hand side vector or array, b[m] or b[m,nrhs] ${rt}$, intent(in) :: b${nd}$ !> [optional] cutoff for rank evaluation: singular values s(i)<=cond*maxval(s) are considered 0. real(${rk}$), optional, intent(in) :: cond @@ -134,9 +134,19 @@ submodule (stdlib_linalg) stdlib_linalg_least_squares !> Result array/matrix x[n] or x[n,nrhs] ${rt}$, allocatable, target :: x${nd}$ - ! Initialize solution with the shape of the rhs - allocate(x,mold=b) + integer(ilp) :: n,nrhs,ldb + + n = size(a,2,kind=ilp) + ldb = size(b,1,kind=ilp) + nrhs = size(b,kind=ilp)/ldb + ! Initialize solution with the shape of the rhs + #:if ndsuf=="one" + allocate(x(n)) + #:else + allocate(x(n,nrhs)) + #:endif + call stdlib_linalg_${ri}$_solve_lstsq_${ndsuf}$(a,b,x,& cond=cond,overwrite_a=overwrite_a,rank=rank,err=err) @@ -155,7 +165,7 @@ submodule (stdlib_linalg) stdlib_linalg_least_squares !! !! param: a Input matrix of size [m,n]. !! param: b Right-hand-side vector of size [n] or matrix of size [n,nrhs]. - !! param: x Solution vector of size [n] or solution matrix of size [n,nrhs]. + !! param: x Solution vector of size at [>=n] or solution matrix of size [>=n,nrhs]. !! param: real_storage [optional] Real working space !! param: int_storage [optional] Integer working space #:if rt.startswith('c') @@ -198,7 +208,7 @@ submodule (stdlib_linalg) stdlib_linalg_least_squares integer(ilp) :: m,n,lda,ldb,nrhs,ldx,nrhsx,info,mnmin,mnmax,arank,lrwork,liwork,lcwork integer(ilp) :: nrs,nis,ncs,nsvd integer(ilp), pointer :: iwork(:) - logical(lk) :: copy_a + logical(lk) :: copy_a,large_enough_x real(${rk}$) :: acond,rcond real(${rk}$), pointer :: rwork(:),singular(:) ${rt}$, pointer :: xmat(:,:),amat(:,:),cwork(:) @@ -214,8 +224,8 @@ submodule (stdlib_linalg) stdlib_linalg_least_squares mnmin = min(m,n) mnmax = max(m,n) - if (lda<1 .or. n<1 .or. ldb<1 .or. ldb/=m .or. ldx/=m) then - err0 = linalg_state_type(this,LINALG_VALUE_ERROR,'invalid sizes: a=',[lda,n], & + if (lda<1 .or. n<1 .or. ldb<1 .or. ldb/=m .or. ldx 0) then + write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop + end if + +end program diff --git a/test/linalg/test_linalg_lstsq.fypp b/test/linalg/test_linalg_lstsq.fypp index 54c2b2893..cf57bb178 100644 --- a/test/linalg/test_linalg_lstsq.fypp +++ b/test/linalg/test_linalg_lstsq.fypp @@ -71,7 +71,8 @@ module test_linalg_least_squares type(linalg_state_type) :: state integer(ilp), parameter :: n = 12, m = 3 real :: Arnd(n,m),xrnd(m) - ${rt}$ :: xsol(m),x(m),y(n),A(n,m) + ${rt}$, allocatable :: x(:) + ${rt}$ :: xsol(m),y(n),A(n,m) ! Random coefficient matrix and solution call random_number(Arnd) @@ -88,6 +89,10 @@ module test_linalg_least_squares call check(error,state%ok(),state%print()) if (allocated(error)) return + ! Check size + call check(error,size(x)==m) + if (allocated(error)) return + call check(error, all(abs(x-xsol)<1.0e-4_${rk}$), 'data converged') if (allocated(error)) return diff --git a/test/sorting/test_sorting.f90 b/test/sorting/test_sorting.f90 index 4c9f1ffa5..99fd35cea 100644 --- a/test/sorting/test_sorting.f90 +++ b/test/sorting/test_sorting.f90 @@ -54,13 +54,13 @@ module test_sorting type(string_type) :: string_dummy(0:string_size-1) type(bitset_large) :: bitsetl_dummy(0:bitset_size-1) type(bitset_64) :: bitset64_dummy(0:bitset_size-1) - integer(int_size) :: index(0:max(test_size, char_size, string_size)-1) + integer(int_index) :: index(0:max(test_size, char_size, string_size)-1) integer(int32) :: work(0:test_size/2-1) character(len=4) :: char_work(0:char_size/2-1) type(string_type) :: string_work(0:string_size/2-1) type(bitset_large) :: bitsetl_work(0:bitset_size/2-1) type(bitset_64) :: bitset64_work(0:bitset_size/2-1) - integer(int_size) :: iwork(0:max(test_size, char_size, & + integer(int_index) :: iwork(0:max(test_size, char_size, & string_size)/2-1) integer :: count, i, index1, index2, j, k, l, temp real(sp) :: arand, brand