libf/phylmd/suphec.f90

module suphec_m

  implicit none

  ! A1.0 Fundamental constants
  REAL RPI
  real, parameter:: RCLUM = 299792458.
  real, parameter:: RHPLA = 6.6260755E-34
  real, parameter:: RKBOL = 1.380658E-23 ! Boltzmann constant, in J K-1
  real, parameter:: RNAVO = 6.0221367E+23 ! Avogadro number, in mol-1

  ! A1.1 Astronomical constants
  REAL RSIYEA, RSIDAY, ROMEGA
  real, parameter:: RDAY = 86400.
  real, parameter:: REA = 149597870000.
  real, parameter:: REPSM = 0.409093

  ! A1.2 Geoide
  real, parameter:: RG = 9.80665 ! acceleration of gravity, in m s-2
  real, parameter:: RA = 6371229.

  ! A1.3 Radiation
  REAL RSIGMA

  ! A1.4 Thermodynamic gas phase
  REAL, parameter:: R = RNAVO * RKBOL ! ideal gas constant, in J K-1 mol-1
  real RV, RCPD, RCPV, RCVD, RCVV
  real, parameter:: RMD = 28.9644 ! molar mass of dry air, in g mol-1

  real, parameter:: RD = 1000. * R / RMD
  ! specific ideal gas constant for dry air, in J K-1 kg-1
  ! (factor 1000: conversion from g to kg)

  real, parameter:: RMO3 = 47.9942
  real, parameter:: RMV = 18.0153
  REAL RKAPPA, RETV

  ! A1.5, 6 Thermodynamic liquid, solid phases
  REAL RCW, RCS

  ! A1.7 Thermodynamic transition of phase
  REAL RLMLT
  real, parameter:: RTT = 273.16
  real, parameter:: RLVTT = 2.5008E+6
  real, parameter:: RLSTT = 2.8345E+6
  real, parameter:: RATM = 100000.

  ! A1.8 Curve of saturation
  REAL RALPW, RBETW, RGAMW, RALPS, RBETS, RGAMS
  real, parameter:: RESTT = 611.14
  REAL RALPD, RBETD, RGAMD

  save

contains

  SUBROUTINE suphec

    ! From phylmd/suphec.F, v 1.2 2005/06/06 13:16:33
    ! Initialise certaines constantes et parametres physiques.

    !------------------------------------------

    PRINT *, 'Call sequence information: suphec'

    ! 1. DEFINE FUNDAMENTAL CONSTANTS

    print *, 'Constants of the ICM'
    RPI = 2.*ASIN(1.)
    print *, 'Fundamental constants '
    print '('' PI = '', E13.7, '' -'')', RPI
    print '('' c = '', E13.7, ''m s-1'')', RCLUM
    print '('' h = '', E13.7, ''J s'')', RHPLA
    print '('' K = '', E13.7, ''J K-1'')', RKBOL
    print '('' N = '', E13.7, ''mol-1'')', RNAVO

    ! 2. DEFINE ASTRONOMICAL CONSTANTS

    RSIYEA = 365.25*RDAY*2.*RPI/6.283076
    RSIDAY = RDAY/(1.+RDAY/RSIYEA)
    ROMEGA = 2.*RPI/RSIDAY

    print *, 'Astronomical constants '
    print '('' day = '', E13.7, '' s'')', RDAY
    print '('' half g. axis = '', E13.7, '' m'')', REA
    print '('' mean anomaly = '', E13.7, '' -'')', REPSM
    print '('' sideral year = '', E13.7, '' s'')', RSIYEA
    print '('' sideral day = '', E13.7, '' s'')', RSIDAY
    print '('' omega = '', E13.7, '' s-1'')', ROMEGA

    ! 3. DEFINE GEOIDE.

    print *, ' Geoide '
    print '('' Gravity = '', E13.7, '' m s-2'')', RG
    print '('' Earth radius = '', E13.7, '' m'')', RA

    ! 4. DEFINE RADIATION CONSTANTS.

    rsigma = 2.*rpi**5 * (rkbol/rhpla)**3 * rkbol/rclum/rclum/15.
    print *, ' Radiation '
    print '('' Stefan-Bol. = '', E13.7, '' W m-2 K-4'')', RSIGMA

    ! 5. DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE.

    RV = 1000.*R/RMV
    RCPD = 3.5*RD
    RCVD = RCPD-RD
    RCPV = 4. *RV
    RCVV = RCPV-RV
    RKAPPA = RD/RCPD
    RETV = RV/RD-1.
    print *, 'Thermodynamic, gas '
    print '('' Perfect gas = '', e13.7)', R
    print '('' Ozone mass = '', e13.7)', RMO3
    print '('' Vapour mass = '', e13.7)', RMV
    print '('' Dry air constant = '', e13.7)', RD
    print '('' Vapour constant = '', e13.7)', RV
    print '('' Cpd = '', e13.7)', RCPD
    print '('' Cvd = '', e13.7)', RCVD
    print '('' Cpv = '', e13.7)', RCPV
    print '('' Cvv = '', e13.7)', RCVV
    print '('' Rd/Cpd = '', e13.7)', RKAPPA
    print '('' Rv/Rd-1 = '', e13.7)', RETV

    ! 6. DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE.

    RCW = RCPV
    print *, 'Thermodynamic, liquid '
    print '('' Cw = '', E13.7)', RCW

    ! 7. DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE.

    RCS = RCPV
    print *, 'thermodynamic, solid'
    print '('' Cs = '', E13.7)', RCS

    ! 8. DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE.

    RLMLT = RLSTT-RLVTT
    print *, 'Thermodynamic, trans. '
    print '('' Fusion point = '', E13.7)', RTT
    print '('' RLvTt = '', E13.7)', RLVTT
    print '('' RLsTt = '', E13.7)', RLSTT
    print '('' RLMlt = '', E13.7)', RLMLT
    print '('' Normal press. = '', E13.7)', RATM

    ! 9. SATURATED VAPOUR PRESSURE.

    RGAMW = (RCW-RCPV)/RV
    RBETW = RLVTT/RV+RGAMW*RTT
    RALPW = LOG(RESTT)+RBETW/RTT+RGAMW*LOG(RTT)
    RGAMS = (RCS-RCPV)/RV
    RBETS = RLSTT/RV+RGAMS*RTT
    RALPS = LOG(RESTT)+RBETS/RTT+RGAMS*LOG(RTT)
    RGAMD = RGAMS-RGAMW
    RBETD = RBETS-RBETW
    RALPD = RALPS-RALPW

  END SUBROUTINE suphec

end module suphec_m
1	guez	3	module suphec_m
2
3			implicit none
4
5	guez	38	! A1.0 Fundamental constants
6			REAL RPI
7	guez	40	real, parameter:: RCLUM = 299792458.
8			real, parameter:: RHPLA = 6.6260755E-34
9	guez	47	real, parameter:: RKBOL = 1.380658E-23 ! Boltzmann constant, in J K-1
10			real, parameter:: RNAVO = 6.0221367E+23 ! Avogadro number, in mol-1
11	guez	38
12			! A1.1 Astronomical constants
13	guez	40	REAL RSIYEA, RSIDAY, ROMEGA
14			real, parameter:: RDAY = 86400.
15			real, parameter:: REA = 149597870000.
16			real, parameter:: REPSM = 0.409093
17	guez	38
18			! A1.2 Geoide
19	guez	47	real, parameter:: RG = 9.80665 ! acceleration of gravity, in m s-2
20	guez	40	real, parameter:: RA = 6371229.
21	guez	38
22			! A1.3 Radiation
23			REAL RSIGMA
24
25			! A1.4 Thermodynamic gas phase
26	guez	47	REAL, parameter:: R = RNAVO * RKBOL ! ideal gas constant, in J K-1 mol-1
27			real RV, RCPD, RCPV, RCVD, RCVV
28			real, parameter:: RMD = 28.9644 ! molar mass of dry air, in g mol-1
29
30			real, parameter:: RD = 1000. * R / RMD
31			! specific ideal gas constant for dry air, in J K-1 kg-1
32	guez	49	! (factor 1000: conversion from g to kg)
33	guez	47
34	guez	40	real, parameter:: RMO3 = 47.9942
35			real, parameter:: RMV = 18.0153
36			REAL RKAPPA, RETV
37	guez	38
38	guez	40	! A1.5, 6 Thermodynamic liquid, solid phases
39			REAL RCW, RCS
40	guez	38
41			! A1.7 Thermodynamic transition of phase
42			REAL RLMLT
43	guez	40	real, parameter:: RTT = 273.16
44			real, parameter:: RLVTT = 2.5008E+6
45			real, parameter:: RLSTT = 2.8345E+6
46			real, parameter:: RATM = 100000.
47	guez	38
48			! A1.8 Curve of saturation
49	guez	40	REAL RALPW, RBETW, RGAMW, RALPS, RBETS, RGAMS
50			real, parameter:: RESTT = 611.14
51			REAL RALPD, RBETD, RGAMD
52	guez	38
53			save
54
55	guez	3	contains
56
57			SUBROUTINE suphec
58
59	guez	40	! From phylmd/suphec.F, v 1.2 2005/06/06 13:16:33
60	guez	3	! Initialise certaines constantes et parametres physiques.
61
62			!------------------------------------------
63
64	guez	37	PRINT *, 'Call sequence information: suphec'
65	guez	17
66	guez	37	! 1. DEFINE FUNDAMENTAL CONSTANTS
67	guez	17
68	guez	37	print *, 'Constants of the ICM'
69	guez	40	RPI = 2.*ASIN(1.)
70	guez	37	print *, 'Fundamental constants '
71	guez	40	print '('' PI = '', E13.7, '' -'')', RPI
72			print '('' c = '', E13.7, ''m s-1'')', RCLUM
73			print '('' h = '', E13.7, ''J s'')', RHPLA
74			print '('' K = '', E13.7, ''J K-1'')', RKBOL
75			print '('' N = '', E13.7, ''mol-1'')', RNAVO
76	guez	17
77	guez	37	! 2. DEFINE ASTRONOMICAL CONSTANTS
78	guez	17
79	guez	40	RSIYEA = 365.25RDAY2.*RPI/6.283076
80			RSIDAY = RDAY/(1.+RDAY/RSIYEA)
81			ROMEGA = 2.*RPI/RSIDAY
82	guez	17
83	guez	37	print *, 'Astronomical constants '
84	guez	40	print '('' day = '', E13.7, '' s'')', RDAY
85			print '('' half g. axis = '', E13.7, '' m'')', REA
86			print '('' mean anomaly = '', E13.7, '' -'')', REPSM
87			print '('' sideral year = '', E13.7, '' s'')', RSIYEA
88			print '('' sideral day = '', E13.7, '' s'')', RSIDAY
89			print '('' omega = '', E13.7, '' s-1'')', ROMEGA
90	guez	17
91	guez	40	! 3. DEFINE GEOIDE.
92	guez	17
93	guez	40	print *, ' Geoide '
94			print '('' Gravity = '', E13.7, '' m s-2'')', RG
95			print '('' Earth radius = '', E13.7, '' m'')', RA
96	guez	17
97	guez	40	! 4. DEFINE RADIATION CONSTANTS.
98	guez	17
99	guez	37	rsigma = 2.rpi5 (rkbol/rhpla)*3 rkbol/rclum/rclum/15.
100	guez	40	print *, ' Radiation '
101			print '('' Stefan-Bol. = '', E13.7, '' W m-2 K-4'')', RSIGMA
102	guez	3
103	guez	40	! 5. DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE.
104	guez	17
105	guez	40	RV = 1000.*R/RMV
106			RCPD = 3.5*RD
107			RCVD = RCPD-RD
108			RCPV = 4. *RV
109			RCVV = RCPV-RV
110			RKAPPA = RD/RCPD
111			RETV = RV/RD-1.
112			print *, 'Thermodynamic, gas '
113			print '('' Perfect gas = '', e13.7)', R
114			print '('' Ozone mass = '', e13.7)', RMO3
115			print '('' Vapour mass = '', e13.7)', RMV
116			print '('' Dry air constant = '', e13.7)', RD
117			print '('' Vapour constant = '', e13.7)', RV
118			print '('' Cpd = '', e13.7)', RCPD
119			print '('' Cvd = '', e13.7)', RCVD
120			print '('' Cpv = '', e13.7)', RCPV
121			print '('' Cvv = '', e13.7)', RCVV
122			print '('' Rd/Cpd = '', e13.7)', RKAPPA
123			print '('' Rv/Rd-1 = '', e13.7)', RETV
124	guez	17
125	guez	40	! 6. DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE.
126	guez	17
127	guez	40	RCW = RCPV
128			print *, 'Thermodynamic, liquid '
129			print '('' Cw = '', E13.7)', RCW
130	guez	17
131	guez	40	! 7. DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE.
132	guez	17
133	guez	40	RCS = RCPV
134	guez	37	print *, 'thermodynamic, solid'
135	guez	40	print '('' Cs = '', E13.7)', RCS
136	guez	17
137	guez	40	! 8. DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE.
138	guez	17
139	guez	40	RLMLT = RLSTT-RLVTT
140			print *, 'Thermodynamic, trans. '
141			print '('' Fusion point = '', E13.7)', RTT
142			print '('' RLvTt = '', E13.7)', RLVTT
143			print '('' RLsTt = '', E13.7)', RLSTT
144			print '('' RLMlt = '', E13.7)', RLMLT
145			print '('' Normal press. = '', E13.7)', RATM
146	guez	17
147	guez	40	! 9. SATURATED VAPOUR PRESSURE.
148	guez	17
149	guez	40	RGAMW = (RCW-RCPV)/RV
150			RBETW = RLVTT/RV+RGAMW*RTT
151			RALPW = LOG(RESTT)+RBETW/RTT+RGAMW*LOG(RTT)
152			RGAMS = (RCS-RCPV)/RV
153			RBETS = RLSTT/RV+RGAMS*RTT
154			RALPS = LOG(RESTT)+RBETS/RTT+RGAMS*LOG(RTT)
155			RGAMD = RGAMS-RGAMW
156			RBETD = RBETS-RBETW
157			RALPD = RALPS-RALPW
158	guez	17
159	guez	3	END SUBROUTINE suphec
160
161			end module suphec_m