1 |
guez |
3 |
module suphec_m |
2 |
|
|
|
3 |
|
|
implicit none |
4 |
|
|
|
5 |
|
|
contains |
6 |
|
|
|
7 |
|
|
SUBROUTINE suphec |
8 |
|
|
|
9 |
|
|
! From phylmd/suphec.F,v 1.2 2005/06/06 13:16:33 |
10 |
|
|
|
11 |
|
|
! Initialise certaines constantes et parametres physiques. |
12 |
|
|
|
13 |
|
|
use YOMCST, only: rpi, rclum, rhpla, rkbol, rnavo, rday, rea, repsm, & |
14 |
|
|
rsiyea, rsiday,romega, rg, ra, r1sa, rsigma, r, rmd, rmo3, rmv, rd, & |
15 |
|
|
rv, rcpd, rcvd, rcpv, rcvv, rkappa, retv, rcw, rcs, rtt, rlvtt, & |
16 |
|
|
rlstt, rlmlt, ratm, restt, rgamw, rbetw, ralpw, rgams, rbets, ralps, & |
17 |
|
|
rgamd, rbetd, ralpd |
18 |
|
|
use yoethf |
19 |
|
|
|
20 |
|
|
LOGICAL:: firstcall = .TRUE. |
21 |
|
|
|
22 |
|
|
!------------------------------------------ |
23 |
|
|
|
24 |
|
|
IF (firstcall) THEN |
25 |
|
|
PRINT *, 'suphec initialise les constantes du GCM' |
26 |
|
|
firstcall = .FALSE. |
27 |
guez |
17 |
|
28 |
guez |
3 |
!* 1. DEFINE FUNDAMENTAL CONSTANTS. |
29 |
guez |
17 |
|
30 |
guez |
3 |
WRITE(UNIT=6,FMT='(''0*** Constants of the ICM ***'')') |
31 |
|
|
RPI=2.*ASIN(1.) |
32 |
|
|
RCLUM=299792458. |
33 |
|
|
RHPLA=6.6260755E-34 |
34 |
|
|
RKBOL=1.380658E-23 |
35 |
|
|
RNAVO=6.0221367E+23 |
36 |
|
|
WRITE(UNIT=6,FMT='('' *** Fundamental constants ***'')') |
37 |
|
|
WRITE(UNIT=6,FMT='('' PI = '',E13.7,'' -'')')RPI |
38 |
|
|
WRITE(UNIT=6,FMT='('' c = '',E13.7,''m s-1'')') & |
39 |
|
|
RCLUM |
40 |
|
|
WRITE(UNIT=6,FMT='('' h = '',E13.7,''J s'')') & |
41 |
|
|
RHPLA |
42 |
|
|
WRITE(UNIT=6,FMT='('' K = '',E13.7,''J K-1'')') & |
43 |
|
|
RKBOL |
44 |
|
|
WRITE(UNIT=6,FMT='('' N = '',E13.7,''mol-1'')') & |
45 |
|
|
RNAVO |
46 |
guez |
17 |
|
47 |
guez |
3 |
!* 2. DEFINE ASTRONOMICAL CONSTANTS. |
48 |
guez |
17 |
|
49 |
guez |
3 |
RDAY=86400. |
50 |
|
|
REA=149597870000. |
51 |
|
|
REPSM=0.409093 |
52 |
guez |
17 |
|
53 |
guez |
3 |
RSIYEA=365.25*RDAY*2.*RPI/6.283076 |
54 |
|
|
RSIDAY=RDAY/(1.+RDAY/RSIYEA) |
55 |
|
|
ROMEGA=2.*RPI/RSIDAY |
56 |
guez |
17 |
|
57 |
guez |
3 |
WRITE(UNIT=6,FMT='('' *** Astronomical constants ***'')') |
58 |
|
|
WRITE(UNIT=6,FMT='('' day = '',E13.7,'' s'')')RDAY |
59 |
|
|
WRITE(UNIT=6,FMT='('' half g. axis = '',E13.7,'' m'')')REA |
60 |
|
|
WRITE(UNIT=6,FMT='('' mean anomaly = '',E13.7,'' -'')')REPSM |
61 |
|
|
WRITE(UNIT=6,FMT='('' sideral year = '',E13.7,'' s'')')RSIYEA |
62 |
|
|
WRITE(UNIT=6,FMT='('' sideral day = '',E13.7,'' s'')')RSIDAY |
63 |
|
|
WRITE(UNIT=6,FMT='('' omega = '',E13.7,'' s-1'')') & |
64 |
|
|
ROMEGA |
65 |
guez |
17 |
|
66 |
guez |
3 |
!* 3. DEFINE GEOIDE. |
67 |
guez |
17 |
|
68 |
guez |
3 |
RG=9.80665 |
69 |
|
|
RA=6371229. |
70 |
|
|
R1SA=SNGL(1.D0/DBLE(RA)) |
71 |
|
|
WRITE(UNIT=6,FMT='('' *** Geoide ***'')') |
72 |
|
|
WRITE(UNIT=6,FMT='('' Gravity = '',E13.7,'' m s-2'')') & |
73 |
|
|
RG |
74 |
|
|
WRITE(UNIT=6,FMT='('' Earth radius = '',E13.7,'' m'')')RA |
75 |
|
|
WRITE(UNIT=6,FMT='('' Inverse E.R. = '',E13.7,'' m'')')R1SA |
76 |
guez |
17 |
|
77 |
guez |
3 |
!* 4. DEFINE RADIATION CONSTANTS. |
78 |
guez |
17 |
|
79 |
guez |
3 |
rsigma = 2.*rpi**5 * (rkbol/rhpla)**3 * rkbol/rclum/rclum/15. |
80 |
|
|
!IM init. dans conf_phys.F90 RI0=1365. |
81 |
|
|
WRITE(UNIT=6,FMT='('' *** Radiation ***'')') |
82 |
|
|
WRITE(UNIT=6,FMT='('' Stefan-Bol. = '',E13.7,'' W m-2 K-4'')') RSIGMA |
83 |
|
|
|
84 |
|
|
!* 5. DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE. |
85 |
guez |
17 |
|
86 |
guez |
3 |
R=RNAVO*RKBOL |
87 |
|
|
RMD=28.9644 |
88 |
|
|
RMO3=47.9942 |
89 |
|
|
RMV=18.0153 |
90 |
|
|
RD=1000.*R/RMD |
91 |
|
|
RV=1000.*R/RMV |
92 |
|
|
RCPD=3.5*RD |
93 |
|
|
RCVD=RCPD-RD |
94 |
|
|
RCPV=4. *RV |
95 |
|
|
RCVV=RCPV-RV |
96 |
|
|
RKAPPA=RD/RCPD |
97 |
|
|
RETV=RV/RD-1. |
98 |
|
|
WRITE(UNIT=6,FMT='('' *** Thermodynamic, gas ***'')') |
99 |
|
|
WRITE(UNIT=6,FMT='('' Perfect gas = '',e13.7)') R |
100 |
|
|
WRITE(UNIT=6,FMT='('' Dry air mass = '',e13.7)') RMD |
101 |
|
|
WRITE(UNIT=6,FMT='('' Ozone mass = '',e13.7)') RMO3 |
102 |
|
|
WRITE(UNIT=6,FMT='('' Vapour mass = '',e13.7)') RMV |
103 |
|
|
WRITE(UNIT=6,FMT='('' Dry air cst. = '',e13.7)') RD |
104 |
|
|
WRITE(UNIT=6,FMT='('' Vapour cst. = '',e13.7)') RV |
105 |
|
|
WRITE(UNIT=6,FMT='('' Cpd = '',e13.7)') RCPD |
106 |
|
|
WRITE(UNIT=6,FMT='('' Cvd = '',e13.7)') RCVD |
107 |
|
|
WRITE(UNIT=6,FMT='('' Cpv = '',e13.7)') RCPV |
108 |
|
|
WRITE(UNIT=6,FMT='('' Cvv = '',e13.7)') RCVV |
109 |
|
|
WRITE(UNIT=6,FMT='('' Rd/Cpd = '',e13.7)') RKAPPA |
110 |
|
|
WRITE(UNIT=6,FMT='('' Rv/Rd-1 = '',e13.7)') RETV |
111 |
guez |
17 |
|
112 |
guez |
3 |
!* 6. DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE. |
113 |
guez |
17 |
|
114 |
guez |
3 |
RCW=RCPV |
115 |
|
|
WRITE(UNIT=6,FMT='('' *** Thermodynamic, liquid ***'')') |
116 |
|
|
WRITE(UNIT=6,FMT='('' Cw = '',E13.7)') RCW |
117 |
guez |
17 |
|
118 |
guez |
3 |
!* 7. DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE. |
119 |
guez |
17 |
|
120 |
guez |
3 |
RCS=RCPV |
121 |
|
|
WRITE(UNIT=6,FMT='('' *** thermodynamic, solid ***'')') |
122 |
|
|
WRITE(UNIT=6,FMT='('' Cs = '',E13.7)') RCS |
123 |
guez |
17 |
|
124 |
guez |
3 |
!* 8. DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE. |
125 |
guez |
17 |
|
126 |
guez |
3 |
RTT=273.16 |
127 |
|
|
RLVTT=2.5008E+6 |
128 |
|
|
RLSTT=2.8345E+6 |
129 |
|
|
RLMLT=RLSTT-RLVTT |
130 |
|
|
RATM=100000. |
131 |
|
|
WRITE(UNIT=6,FMT='('' *** Thermodynamic, trans. ***'')') |
132 |
|
|
WRITE(UNIT=6,FMT='('' Fusion point = '',E13.7)') RTT |
133 |
|
|
WRITE(UNIT=6,FMT='('' RLvTt = '',E13.7)') RLVTT |
134 |
|
|
WRITE(UNIT=6,FMT='('' RLsTt = '',E13.7)') RLSTT |
135 |
|
|
WRITE(UNIT=6,FMT='('' RLMlt = '',E13.7)') RLMLT |
136 |
|
|
WRITE(UNIT=6,FMT='('' Normal press. = '',E13.7)') RATM |
137 |
|
|
WRITE(UNIT=6,FMT='('' Latent heat : '')') |
138 |
guez |
17 |
|
139 |
guez |
3 |
!* 9. SATURATED VAPOUR PRESSURE. |
140 |
guez |
17 |
|
141 |
guez |
3 |
RESTT=611.14 |
142 |
|
|
RGAMW=(RCW-RCPV)/RV |
143 |
|
|
RBETW=RLVTT/RV+RGAMW*RTT |
144 |
|
|
RALPW=LOG(RESTT)+RBETW/RTT+RGAMW*LOG(RTT) |
145 |
|
|
RGAMS=(RCS-RCPV)/RV |
146 |
|
|
RBETS=RLSTT/RV+RGAMS*RTT |
147 |
|
|
RALPS=LOG(RESTT)+RBETS/RTT+RGAMS*LOG(RTT) |
148 |
|
|
RGAMD=RGAMS-RGAMW |
149 |
|
|
RBETD=RBETS-RBETW |
150 |
|
|
RALPD=RALPS-RALPW |
151 |
guez |
17 |
|
152 |
guez |
3 |
! calculer les constantes pour les fonctions thermodynamiques |
153 |
guez |
17 |
|
154 |
guez |
3 |
RVTMP2=RCPV/RCPD-1. |
155 |
|
|
RHOH2O=RATM/100. |
156 |
|
|
R2ES=RESTT*RD/RV |
157 |
|
|
R3LES=17.269 |
158 |
|
|
R3IES=21.875 |
159 |
|
|
R4LES=35.86 |
160 |
|
|
R4IES=7.66 |
161 |
|
|
R5LES=R3LES*(RTT-R4LES) |
162 |
|
|
R5IES=R3IES*(RTT-R4IES) |
163 |
|
|
ELSE |
164 |
|
|
PRINT *, 'suphec DEJA APPELE ' |
165 |
|
|
ENDIF |
166 |
|
|
|
167 |
|
|
END SUBROUTINE suphec |
168 |
|
|
|
169 |
|
|
end module suphec_m |