From 7dfcc480ba1e19bd3232349fc733caef94034292 Mon Sep 17 00:00:00 2001 From: stainer_t Date: Mon, 8 Sep 2025 13:48:49 +0200 Subject: Initial commit from Polytechnique Montreal --- Utilib/src/XDRCST.f | 197 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 197 insertions(+) create mode 100644 Utilib/src/XDRCST.f (limited to 'Utilib/src/XDRCST.f') diff --git a/Utilib/src/XDRCST.f b/Utilib/src/XDRCST.f new file mode 100644 index 0000000..33ddad6 --- /dev/null +++ b/Utilib/src/XDRCST.f @@ -0,0 +1,197 @@ +*DECK XDRCST + FUNCTION XDRCST(CSTNAM,CSTUNT) +* +*----------------------------------------------------------------------- +* +*Purpose: +* To return the physical constants in the required units or get constant +* for converting between units. +* +*Copyright: +* Copyright (C) 2004 Ecole Polytechnique de Montreal +* +*Author(s): G. Marleau. +* +*Parameters: input +* CSTNAM constant name or initial units for conversion where +* \begin{itemize} +* \item \moc{CSTNAM}=\moc{Avogadro} is for Avogadro number +* with units in N/moles; +* \item \moc{CSTNAM}=\moc{Plank} is for Plank constant +* with units in J$\times$s, MeV$\times$s or eV$\times$s; +* \item \moc{CSTNAM}=\moc{Boltzmann} is for Boltzmann constant +* with units in J/K, MeV/K or eV/K ; +* \item \moc{CSTNAM}=\moc{Neutron mass} is for neutron mass +* with units in kg, amu, MeV or eV; +* \item \moc{CSTNAM}=\moc{Proton mass} is for proton mass +* with units in kg, amu, MeV or eV; +* \item \moc{CSTNAM}=\moc{kg} is the factor to transform kg +* into amu, MeV, eV or J; +* \item \moc{CSTNAM}=\moc{amu} is the factor to transform amu +* into kg, MeV, eV or J; +* \item \moc{CSTNAM}=\moc{eV} is the factor to transform eV +* into J or K; +* \item \moc{CSTNAM}=\moc{K} is the factor to transform K +* into J or eV; +* \item \moc{CSTNAM}=\moc{J} is the factor to transform J +* into eV or K; +* \item \moc{CSTNAM}=\moc{Pi} is for $\pi$ +* without units. +* \end{itemize} +* CSTUNT units for the constant or final units as described for +* \moc{CSTNAM}. +* +*Parameters: input +* XDRCST numerical value of the constant in required unit. +* +*References: +* Peter J. Mohr and Barry N. Taylor, CODATA Recommended Values of the +* Fundamental Physical Constants: 2002. (to be published) +* http://physics.nist.gov/constants +* Last visit: September 04, 2004 +* +*----------------------------------------------------------------------- +* + IMPLICIT NONE +*---- +* Subroutine arguments +*---- + CHARACTER CSTNAM*(*) + CHARACTER CSTUNT*(*) + DOUBLE PRECISION XDRCST +*---- +* Parameters +*---- + INTEGER IOUT + PARAMETER (IOUT=6) + CHARACTER NAMSBR*6 + PARAMETER (NAMSBR='XDRCST') + DOUBLE PRECISION EVJOULE,AMUKG,SPEEDL + PARAMETER (EVJOULE=1.60217653D-19,AMUKG=1.66053886D-27, + > SPEEDL=2.99792458D+08) + DOUBLE PRECISION PI + PARAMETER (PI=3.14159265358979323846D+00) + CHARACTER CSTNT*12 + CHARACTER CSTUT*12 +*---- +* Various constants +*---- + XDRCST=0.0D0 + CSTNT=CSTNAM + CSTUT=CSTUNT + IF(INDEX(CSTNT,'Avogadro') .NE. 0) THEN + XDRCST=6.0221415D+23 + IF(INDEX(CSTUT,'N/moles') .EQ. 0) THEN + CALL XABORT(NAMSBR//': Invalid units for Avogadro number') + ENDIF + ELSE IF(INDEX(CSTNT,'Plank') .NE. 0) THEN + XDRCST=6.6260693D-34 + IF(INDEX(CSTUT,'MeV s') .NE. 0) THEN + XDRCST=1.0D-06*XDRCST/EVJOULE + ELSE IF(INDEX(CSTUT,'eV s') .NE. 0) THEN + XDRCST=XDRCST/EVJOULE + ELSE IF(INDEX(CSTUT,'J s') .EQ. 0) THEN + CALL XABORT(NAMSBR//': Invalid units for Plank constant') + ENDIF + ELSE IF(INDEX(CSTNT,'Boltzmann') .NE. 0) THEN + XDRCST=1.3806505D-23 + IF(INDEX(CSTUT,'MeV/K') .NE. 0) THEN + XDRCST=1.0D-06*XDRCST/EVJOULE + ELSE IF(INDEX(CSTUT,'eV/K') .NE. 0) THEN + XDRCST=XDRCST/EVJOULE + ELSE IF(INDEX(CSTUT,'J/K') .EQ. 0) THEN + CALL XABORT(NAMSBR//': Invalid units for Boltzmann constant') + ENDIF +*---- +* Various mass +*---- + ELSE IF(INDEX(CSTNT,'Neutron mass') .NE. 0) THEN + XDRCST=1.67492728D-27 + IF(INDEX(CSTUT,'amu') .NE. 0) THEN + XDRCST=XDRCST/AMUKG + ELSE IF(INDEX(CSTUT,'MeV') .NE. 0) THEN + XDRCST=1.0D-06*XDRCST*SPEEDL*SPEEDL/EVJOULE + ELSE IF(INDEX(CSTUT,'eV') .NE. 0) THEN + XDRCST=XDRCST*SPEEDL*SPEEDL/EVJOULE + ELSE IF(INDEX(CSTUT,'kg') .EQ. 0) THEN + CALL XABORT(NAMSBR//': Invalid units for neutron mass') + ENDIF + ELSE IF(INDEX(CSTNT,'Proton mass') .NE. 0) THEN + XDRCST=1.67262171D-27 + IF(INDEX(CSTUT,'amu') .NE. 0) THEN + XDRCST=XDRCST/AMUKG + ELSE IF(INDEX(CSTUT,'MeV') .NE. 0) THEN + XDRCST=1.0D-06*XDRCST*SPEEDL*SPEEDL/EVJOULE + ELSE IF(INDEX(CSTUT,'eV') .NE. 0) THEN + XDRCST=XDRCST*SPEEDL*SPEEDL/EVJOULE + ELSE IF(INDEX(CSTUT,'kg') .EQ. 0) THEN + CALL XABORT(NAMSBR//': Invalid units for neutron mass') + ENDIF +*---- +* Various mass energy conversion units +*---- + ELSE IF(INDEX(CSTNT,'kg') .NE. 0) THEN + IF(INDEX(CSTUT,'amu') .NE. 0) THEN + XDRCST=1.0D0/AMUKG + ELSE IF(INDEX(CSTUT,'MeV') .NE. 0) THEN + XDRCST=1.0D-06*SPEEDL*SPEEDL/EVJOULE + ELSE IF(INDEX(CSTUT,'eV') .NE. 0) THEN + XDRCST=SPEEDL*SPEEDL/EVJOULE + ELSE IF(INDEX(CSTUT,'J') .NE. 0) THEN + XDRCST=SPEEDL*SPEEDL + ELSE + CALL XABORT(NAMSBR//': No relations between '//CSTNT// + > ' and '//CSTUT) + ENDIF + ELSE IF(INDEX(CSTNT,'amu') .NE. 0) THEN + IF(INDEX(CSTUT,'kg') .NE. 0) THEN + XDRCST=AMUKG + ELSE IF(INDEX(CSTUT,'MeV') .NE. 0) THEN + XDRCST=1.0D-06*AMUKG*SPEEDL*SPEEDL/EVJOULE + ELSE IF(INDEX(CSTUT,'eV') .NE. 0) THEN + XDRCST=AMUKG*SPEEDL*SPEEDL/EVJOULE + ELSE IF(INDEX(CSTUT,'J') .NE. 0) THEN + XDRCST=AMUKG*SPEEDL*SPEEDL + ELSE + CALL XABORT(NAMSBR//': No relations between '//CSTNT// + > ' and '//CSTUT) + ENDIF + ELSE IF(INDEX(CSTNT,'eV') .NE. 0) THEN + IF(INDEX(CSTUT,'J') .NE. 0) THEN + XDRCST=EVJOULE + ELSE IF(INDEX(CSTUT,'K') .NE. 0) THEN + XDRCST=EVJOULE/1.3806505D-23 + ELSE + CALL XABORT(NAMSBR//': No relations between '//CSTNT// + > ' and '//CSTUT) + ENDIF + ELSE IF(INDEX(CSTNT,'K') .NE. 0) THEN + IF(INDEX(CSTUT,'J') .NE. 0) THEN + XDRCST=1.3806505D-23 + ELSE IF(INDEX(CSTUT,'eV') .NE. 0) THEN + XDRCST=1.3806505D-23/EVJOULE + ELSE + CALL XABORT(NAMSBR//': No relations between '//CSTNT// + > ' and '//CSTUT) + ENDIF + ELSE IF(INDEX(CSTNT,'J') .NE. 0) THEN + IF(INDEX(CSTUT,'eV') .NE. 0) THEN + XDRCST=1.0D0/EVJOULE + ELSE IF(INDEX(CSTUT,'K') .NE. 0) THEN + XDRCST=1.0D0/1.3806505D-23 + ELSE + CALL XABORT(NAMSBR//': No relations between '//CSTNT// + > ' and '//CSTUT) + ENDIF + ELSE IF(INDEX(CSTNT,'Pi') .NE. 0) THEN + IF(CSTUT .EQ. ' ') THEN + XDRCST=PI + ELSE + CALL XABORT(NAMSBR//': No units for Pi ') + ENDIF + ELSE + CALL XABORT(NAMSBR//': '//CSTNT// + > ' is an invalid constant or unit') + ENDIF + RETURN + END -- cgit v1.2.3