SUBROUTINE SUCST(KULOUT) 1
C
C**** *SUCST * - Routine to initialize the constants of the model.
C
C Purpose.
C --------
C Initialize and print the common YOMCST
C
C Author.
C -------
C Mats Hamrud and Philippe Courtier *ECMWF*
*
* Revision:
* JM Belanger CMDA/SMC Aug 2000
* . 32 bits conversion
* (enforce double precision constants)
C
C Modifications.
C --------------
C Original : 87-10-15
C Additions : 90-07-30 (J.-F. Geleyn)
C Modifications: 92-05-15 (P. Gauthier *ARMA/AES)
C 94-03-10 (p. KOCLAS CMC/CMDA) RPECIS (NEC)
C 97-11-24 (p. KOCLAS CMC/CMDA) NR8SIZ
C 98-11-19 (c.charette *ARMA/AES) RMBTPA,RPATMB.
C Initialize thermodynamics constants.
C RG,RD changed to match GRAV,RGASD
C from thermodynamics constants
C S. Pellerin *ARMA/SMC May 2000
C . introduction of specific humidity threshold and
C t-td max
C Y.J. Rochon *ARQX/EC April 2006 (in 3D-Var-Chem)
C . Changed value of RMINHU to 1E-7 kg/kg following
C agreement between Pierre Gauthier, Simon Chabrillat,
C Jean de Grandpre, Martin Charron, Cecilien Charette,
C Alain Robichaud, Stephane Laroche, and Yves J. Rochon.
C Y.J. Rochon *ARQX/EC Feb 2010
C . Changed value of RMINHU back to 2.5E-6 for consistency
C with operational 3D-Var.
C
C ------------------------------------------------------------------
IMPLICIT NONE
#include "comcst.cdk"
INTEGER KULOUT
INTEGER QQQR8SZ
C -----------------------------------------------------------------
C
C* 1. Define fundamental constants.
C . -----------------------------
C
100 CONTINUE
C
WRITE(UNIT=KULOUT,FMT='(//,4x
S ,"- SUCST: definition of Physical constants ***",/)')
RPI=2.0D0*ASIN(1.0D0)
RCLUM=299792458.D0
RHPLA=6.6260755D-34
RKBOL=1.380658D-23
RNAVO=6.0221367D+23
WRITE(UNIT=KULOUT,FMT='(/," *** FUNDAMENTAL CONSTANTS ***")')
WRITE(UNIT=KULOUT,FMT='(" PI = ",E13.7," -")')RPI
WRITE(UNIT=KULOUT,FMT='(" c = ",E13.7,"m s-1")')
S RCLUM
WRITE(UNIT=KULOUT,FMT='(" h = ",E13.7,"J s")')
S RHPLA
WRITE(UNIT=KULOUT,FMT='(" K = ",E13.7,"J K-1")')
S RKBOL
WRITE(UNIT=KULOUT,FMT='(" N = ",E13.7,"mol-1")')
S RNAVO
C
C ----------------------------------------------------------------
C
C* 2. DEFINE ASTRONOMICAL CONSTANTS.
C ------------------------------
C
200 CONTINUE
C
RDAY=86400.D0
REA=149597870000.D0
REPSM=0.409093D0
C
RSIYEA=365.25D0*RDAY*2.*RPI/6.283076D0
RSIDAY=RDAY/(1.D0+RDAY/RSIYEA)
ROMEGA=2.D0*RPI/RSIDAY
C
WRITE(UNIT=KULOUT,FMT='(" *** ASTRONOMICAL CONSTANTS ***")')
WRITE(UNIT=KULOUT,FMT='(" Day (RDAY) = "
S ,E13.7," s")')RDAY
WRITE(UNIT=KULOUT,FMT='(" Half g. Axis (REA) = "
S ,E13.7," m")')REA
WRITE(UNIT=KULOUT,FMT='(" Mean Anomaly (REPSM) = "
S ,E13.7," -")')REPSM
WRITE(UNIT=KULOUT,FMT='(" Sideral Year (RSIYEA) = "
S ,E13.7," s")')RSIYEA
WRITE(UNIT=KULOUT,FMT='(" Sideral Day (RSIDAY) = "
S ,E13.7," s")')RSIDAY
WRITE(UNIT=KULOUT,FMT='(" Omega (ROMEGA) = "
S ,E13.7," s-1")')ROMEGA
C
C
C* 3. Define geoid
C . ------------
C
300 CONTINUE
C
RG=9.80616D0
RA=6371229.D0
cjmb R1SA=SNGL(1.D0/DBLE(RA))
R1SA=1.D0/DBLE(RA)
C
WRITE(UNIT=KULOUT,FMT='(" *** GEOID ***")')
WRITE(UNIT=KULOUT,FMT='(" Gravity (RG) = "
S ,E13.7," m s-2")') RG
WRITE(UNIT=KULOUT,FMT='(" Earth radius (RA) = "
S ,E13.7," m")')RA
WRITE(UNIT=KULOUT,FMT='(" Inverse E.R. (R1SA) = "
S ,E13.7," m")')R1SA
C
C* 4. Define radiation constants.
C . ---------------------------
400 CONTINUE
C
RSIGMA = 5.66961D-8
RI0=1370.D0
C
WRITE(UNIT=KULOUT,FMT='(" *** RADIATION ***")')
WRITE(UNIT=KULOUT,FMT='(" Stefan-Bol. (RSIGMA) = "
S ,E13.7," W m-2 K-4")') RSIGMA
WRITE(UNIT=KULOUT,FMT='(" Solar const. (RIO) = "
S ,E13.7," W m-2")') RI0
C
C* 5. Define thermodynamic constants, gas phase.
C . ------------------------------------------
C
500 CONTINUE
C
R = RNAVO*RKBOL
RMD = 28.9644D0
RMV = 18.0153D0
ccc RD = 1000.D0*R/RMD
RD = 287.05D0
RV = 1000.D0*R/RMV
RCPD = 3.5D0*RD
RCVD = RCPD-RD
RCPV = 4.D0 *RV
RCVV = RCPV-RV
RKAPPA = RD/RCPD
RETV = RV/RD-1.D0
RHO_STP = 1.293D0
RDCJ = 8.31D0
RAV = 6.023D23
C
C 6. Definition of constants used in units conversion
C . ------------------------------------------------
C
600 CONTINUE
RKNTMS = 1.94246D0
cjmb RMSKNT = SNGL(1.D0/DBLE(RKNTMS))
RMSKNT = 1.D0/DBLE(RKNTMS)
RMBTPA = 1.0D2
RPATMB = 1.0D-2
C
WRITE(UNIT=KULOUT,FMT='(" *** THERMODYNAMIC, GAS ***")')
WRITE(UNIT=KULOUT,FMT='(" Perfect gas (R) = "
S ,e13.7)') R
WRITE(UNIT=KULOUT,FMT='(" Dry air mass (RMD) = "
S ,e13.7)') RMD
WRITE(UNIT=KULOUT,FMT='(" Vapour mass (RMV) = "
S ,e13.7)') RMV
WRITE(UNIT=KULOUT,FMT='(" Dry air cst. (RD) = "
S ,e13.7)') RD
WRITE(UNIT=KULOUT,FMT='(" Vapour cst. (RV) = "
S ,e13.7)') RV
WRITE(UNIT=KULOUT,FMT='(" Cpd (RCPD) = "
S ,e13.7)') RCPD
WRITE(UNIT=KULOUT,FMT='(" Cvd (RCVD) = "
S ,e13.7)') RCVD
WRITE(UNIT=KULOUT,FMT='(" Cpv (RCPV) = "
S ,e13.7)') RCPV
WRITE(UNIT=KULOUT,FMT='(" Cvv (RCVV) = "
S ,e13.7)') RCVV
WRITE(UNIT=KULOUT,FMT='(" Rd/Cpd (RKAPPA) = "
S ,e13.7)') RKAPPA
WRITE(UNIT=KULOUT,FMT='(" Rv/Rd-1 (RETV) = "
S ,e13.7)') RETV
WRITE(UNIT=KULOUT,FMT=9600)RKNTMS,RMSKNT
9600 FORMAT(/,6X,'RKNTMS (winds from M/S to Knots) : ',
S G12.6,/,6X,'RMSKNT (winds from Knots to M/S) : ',
S G12.6)
WRITE(UNIT=KULOUT,FMT=9610)RMBTPA,RPATMB
9610 FORMAT(/,6X,'RMBTMA (pressure from millibar to pascal) : ',
S G12.6,/,6X,'RPATMB (pressure from pascal to millibar) : ',
S G12.6)
C
C 7. Definition of constants used in thermodynamics conversion
C . ----------------------------------------------
700 CONTINUE
WRITE(UNIT=KULOUT,FMT=9620)
9620 FORMAT(/,6X,'Initialize thermodynamics constants from physics ',
S /,6x,'and store in comdeck comphy.cdk ')
C
CALL INCTPHYV
C
rminhu = 2.5D-6
cyjr rminhu = 1.0D-7
rmaxes = 30.D0
C
C 8. Constants associated with the machine accuracy
C . ----------------------------------------------
800 CONTINUE
NR8SIZ=QQQR8SZ()
#if defined (C910)
RINFINI = 1.D+35
RZERO = 1.D-35
RPRECIS = 1.D-6
#else
RINFINI = 1.D+75
RZERO = 1.D-79
RPRECIS = 1.D-12
#endif
RETURN
END