1 |
module suphec_m |
2 |
|
3 |
use nr_util, only: pi, twoPI |
4 |
|
5 |
implicit none |
6 |
|
7 |
! A1.0 Fundamental constants |
8 |
real, parameter:: RCLUM = 299792458. ! speed of light, m s-1 |
9 |
real, parameter:: RHPLA = 6.6260755E-34 ! Planck constant, J s |
10 |
real, parameter:: KBOL = 1.380658E-23 ! Boltzmann constant, in J K-1 |
11 |
real, parameter:: NAVO = 6.0221367E23 ! Avogadro number, in mol-1 |
12 |
|
13 |
! A1.1 Astronomical constants |
14 |
|
15 |
real, parameter:: RDAY = 86400. |
16 |
|
17 |
REAL, parameter:: RSIYEA = 365.25 * RDAY * 2. * PI / 6.283076 |
18 |
! sideral year, in s |
19 |
|
20 |
REAL, parameter:: RSIDAY = RDAY / (1. + RDAY / RSIYEA) ! sideral day, in s |
21 |
REAL, parameter:: ROMEGA = twoPI / RSIDAY |
22 |
|
23 |
! A1.2 Geoide |
24 |
real, parameter:: RG = 9.80665 ! acceleration of gravity, in m s-2 |
25 |
real, parameter:: RA = 6371229. |
26 |
|
27 |
! A1.3 Radiation |
28 |
REAL, parameter:: rsigma = 2. * pi**5 * (kbol / rhpla)**3 * kbol / rclum**2 & |
29 |
/ 15. |
30 |
|
31 |
! A1.4 Thermodynamic gas phase |
32 |
REAL, parameter:: R = NAVO * KBOL ! ideal gas constant, in J K-1 mol-1 |
33 |
real, parameter:: MV = 18.0153 ! molar mass of water, in g mol-1 |
34 |
|
35 |
real, parameter:: RV = 1e3 * R / MV |
36 |
! specific ideal gas constant for water vapor, in J K-1 kg-1 |
37 |
! (factor 1e3: conversion from g to kg) |
38 |
|
39 |
real, parameter:: MD = 28.9644 ! molar mass of dry air, in g mol-1 |
40 |
|
41 |
real, parameter:: RD = 1e3 * R / MD |
42 |
! specific ideal gas constant for dry air, in J K-1 kg-1 |
43 |
! (factor 1e3: conversion from g to kg) |
44 |
|
45 |
real, parameter:: RCPV = 4. * RV |
46 |
! specific heat capacity at constant pressure of water vapor, in J K-1 kg-1 |
47 |
|
48 |
real, parameter:: RCVV = RCPV - RV |
49 |
! specific heat capacity at constant volume of water vapor, in J K-1 kg-1 |
50 |
|
51 |
real, parameter:: RCPD = 7. / 2 * RD |
52 |
! specific heat capacity at constant pressure of dry air, in J K-1 kg-1 |
53 |
|
54 |
real, parameter:: RCVD = RCPD - RD |
55 |
! specific heat capacity at constant volume of dry air, in J K-1 kg-1 |
56 |
|
57 |
real, parameter:: RMO3 = 47.9942 |
58 |
REAL, parameter:: RKAPPA = RD/RCPD |
59 |
real, parameter:: RETV = RV / RD - 1. |
60 |
|
61 |
! A1.5, 6 Thermodynamic liquid, solid phases |
62 |
|
63 |
REAL, parameter:: RCW = RCPV ! LIQUID PHASE Cw |
64 |
real, save:: RCS |
65 |
|
66 |
! A1.7 Thermodynamic transition of phase |
67 |
REAL, save:: RLMLT |
68 |
real, parameter:: RTT = 273.16 |
69 |
|
70 |
real, parameter:: RLVTT = 2.5008E+6 |
71 |
! specific latent heat of vaporization of water at triple point, in J kg-1 |
72 |
|
73 |
real, parameter:: RLSTT = 2.8345E+6 |
74 |
real, parameter:: RATM = 1e5 |
75 |
|
76 |
! A1.8 Curve of saturation |
77 |
REAL, save:: RALPW, RBETW, RGAMW, RALPS, RBETS, RGAMS |
78 |
real, parameter:: RESTT = 611.14 |
79 |
REAL, save:: RALPD, RBETD, RGAMD |
80 |
|
81 |
private pi |
82 |
|
83 |
contains |
84 |
|
85 |
SUBROUTINE suphec |
86 |
|
87 |
! From phylmd/suphec.F, version 1.2 2005/06/06 13:16:33 |
88 |
! Initialise certaines constantes et certains paramètres physiques. |
89 |
|
90 |
!------------------------------------------ |
91 |
|
92 |
PRINT *, 'Call sequence information: suphec' |
93 |
|
94 |
print *, 'Astronomical constants ' |
95 |
print '('' omega = '', E13.7, '' s-1'')', ROMEGA |
96 |
|
97 |
print *, 'Geoid:' |
98 |
print '('' Gravity = '', E13.7, '' m s-2'')', RG |
99 |
print '('' Earth radius = '', E13.7, '' m'')', RA |
100 |
|
101 |
print *, 'Radiation constants:' |
102 |
print '('' Stefan-Bol. = '', E13.7, '' W m-2 K-4'')', RSIGMA |
103 |
|
104 |
print *, 'Thermodynamical constants, gas phase:' |
105 |
print *, "rd = ", RD, "J K-1 kg-1" |
106 |
print *, "rv = ", RV, "J K-1 kg-1" |
107 |
print '('' Cpd = '', e13.7)', RCPD |
108 |
print '('' Cvd = '', e13.7)', RCVD |
109 |
print '('' Cvv = '', e13.7)', RCVV |
110 |
print '('' Rd/Cpd = '', e13.7)', RKAPPA |
111 |
print '('' Rv / Rd - 1 = '', e13.7)', RETV |
112 |
|
113 |
! 7. DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE. |
114 |
|
115 |
RCS = RCPV |
116 |
print *, 'thermodynamic, solid' |
117 |
print '('' Cs = '', E13.7)', RCS |
118 |
|
119 |
! 8. DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE. |
120 |
|
121 |
RLMLT = RLSTT-RLVTT |
122 |
print *, 'Thermodynamic, transition of phase:' |
123 |
print '('' Fusion point = '', E13.7)', RTT |
124 |
print '('' RLsTt = '', E13.7)', RLSTT |
125 |
print '('' RLMlt = '', E13.7)', RLMLT |
126 |
print '('' Normal pressure = '', E13.7)', RATM |
127 |
|
128 |
! 9. SATURATED VAPOUR PRESSURE. |
129 |
|
130 |
RGAMW = (RCW-RCPV)/RV |
131 |
RBETW = RLVTT/RV+RGAMW*RTT |
132 |
RALPW = LOG(RESTT)+RBETW/RTT+RGAMW*LOG(RTT) |
133 |
RGAMS = (RCS-RCPV)/RV |
134 |
RBETS = RLSTT/RV+RGAMS*RTT |
135 |
RALPS = LOG(RESTT)+RBETS/RTT+RGAMS*LOG(RTT) |
136 |
RGAMD = RGAMS-RGAMW |
137 |
RBETD = RBETS-RBETW |
138 |
RALPD = RALPS-RALPW |
139 |
|
140 |
END SUBROUTINE suphec |
141 |
|
142 |
end module suphec_m |