GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/suphel.F90 Lines: 119 119 100.0 %
Date: 2023-06-30 12:51:15 Branches: 2 2 100.0 %

Line Branch Exec Source
1
2
! $Header$
3
4
8
SUBROUTINE suphel
5
6
  IMPLICIT NONE
7
8
  include "YOMCST.h"
9
  include "YOETHF.h"
10
  ! IM cf. JLD
11
  LOGICAL firstcall
12
  SAVE firstcall
13
  !$OMP THREADPRIVATE(firstcall)
14
  DATA firstcall/.TRUE./
15
16
2
  IF (firstcall) THEN
17
1
    PRINT *, 'suphel initialise les constantes du GCM'
18
1
    firstcall = .FALSE.
19
  ELSE
20
1
    PRINT *, 'suphel DEJA APPELE '
21
1
    RETURN
22
  END IF
23
  ! -----------------------------------------------------------------
24
25
  ! *       1.    DEFINE FUNDAMENTAL CONSTANTS.
26
  ! -----------------------------
27
28
1
  WRITE (UNIT=6, FMT='(''0*** Constants of the ICM   ***'')')
29
1
  rpi = 2.*asin(1.)
30
1
  rclum = 299792458.
31
1
  rhpla = 6.6260755E-34
32
1
  rkbol = 1.380658E-23
33
1
  rnavo = 6.0221367E+23
34
1
  WRITE (UNIT=6, FMT='('' *** Fundamental constants ***'')')
35
1
  WRITE (UNIT=6, FMT='(''           PI = '',E13.7,'' -'')') rpi
36
1
  WRITE (UNIT=6, FMT='(''            c = '',E13.7,''m s-1'')') rclum
37
1
  WRITE (UNIT=6, FMT='(''            h = '',E13.7,''J s'')') rhpla
38
1
  WRITE (UNIT=6, FMT='(''            K = '',E13.7,''J K-1'')') rkbol
39
1
  WRITE (UNIT=6, FMT='(''            N = '',E13.7,''mol-1'')') rnavo
40
41
  ! ----------------------------------------------------------------
42
43
  ! *       2.    DEFINE ASTRONOMICAL CONSTANTS.
44
  ! ------------------------------
45
46
1
  rday = 86400.
47
1
  rea = 149597870000.
48
1
  repsm = 0.409093
49
50
1
  rsiyea = 365.25*rday*2.*rpi/6.283076
51
1
  rsiday = rday/(1.+rday/rsiyea)
52
1
  romega = 2.*rpi/rsiday
53
54
  ! exp1      R_ecc = 0.05
55
  ! exp1      R_peri = 102.04
56
  ! exp1      R_incl = 22.5
57
  ! exp1      print*, 'Parametres orbitaux modifies'
58
  ! ref      R_ecc = 0.016724
59
  ! ref      R_peri = 102.04
60
  ! ref      R_incl = 23.5
61
62
  ! IM 161002 : pour avoir les ctes AMIP II
63
  ! IM 161002   R_ecc = 0.016724
64
  ! IM 161002   R_peri = 102.04
65
  ! IM 161002   R_incl = 23.5
66
  ! IM on mets R_ecc, R_peri, R_incl dans conf_phys.F90
67
  ! R_ecc = 0.016715
68
  ! R_peri = 102.7
69
  ! R_incl = 23.441
70
71
1
  WRITE (UNIT=6, FMT='('' *** Astronomical constants ***'')')
72
1
  WRITE (UNIT=6, FMT='(''          day = '',E13.7,'' s'')') rday
73
1
  WRITE (UNIT=6, FMT='('' half g. axis = '',E13.7,'' m'')') rea
74
1
  WRITE (UNIT=6, FMT='('' mean anomaly = '',E13.7,'' -'')') repsm
75
1
  WRITE (UNIT=6, FMT='('' sideral year = '',E13.7,'' s'')') rsiyea
76
1
  WRITE (UNIT=6, FMT='(''  sideral day = '',E13.7,'' s'')') rsiday
77
1
  WRITE (UNIT=6, FMT='(''        omega = '',E13.7,'' s-1'')') romega
78
  ! write(unit=6,fmt='('' excentricite = '',e13.7,''-'')')R_ecc
79
  ! write(unit=6,fmt='(''     equinoxe = '',e13.7,''-'')')R_peri
80
  ! write(unit=6,fmt='(''  inclinaison = '',e13.7,''-'')')R_incl
81
82
  ! ------------------------------------------------------------------
83
84
  ! *       3.    DEFINE GEOIDE.
85
  ! --------------
86
87
1
  rg = 9.80665
88
1
  ra = 6371229.
89
1
  r1sa = sngl(1.D0/dble(ra))
90
1
  WRITE (UNIT=6, FMT='('' ***         Geoide         ***'')')
91
1
  WRITE (UNIT=6, FMT='(''      Gravity = '',E13.7,'' m s-2'')') rg
92
1
  WRITE (UNIT=6, FMT='('' Earth radius = '',E13.7,'' m'')') ra
93
1
  WRITE (UNIT=6, FMT='('' Inverse E.R. = '',E13.7,'' m'')') r1sa
94
95
  ! -----------------------------------------------------------------
96
97
  ! *       4.    DEFINE RADIATION CONSTANTS.
98
  ! ---------------------------
99
100
  ! z.x.li      RSIGMA=2. * RPI**5 * RKBOL**4 /(15.* RCLUM**2 * RHPLA**3)
101
1
  rsigma = 2.*rpi**5*(rkbol/rhpla)**3*rkbol/rclum/rclum/15.
102
  ! IM init. dans conf_phys.F90   RI0=1365.
103
1
  WRITE (UNIT=6, FMT='('' ***        Radiation       ***'')')
104
  WRITE (UNIT=6, FMT='('' Stefan-Bol.  = '',E13.7,'' W m-2 K-4'' &
105
    &                                                         &
106
1
    &         )') rsigma
107
  ! IM init. dans conf_phys.F90   WRITE(UNIT=6,FMT='('' Solar const. =
108
  ! '',E13.7,'' W m-2'')')
109
  ! IM init. dans conf_phys.F90  S      RI0
110
111
  ! -----------------------------------------------------------------
112
113
  ! *       5.    DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE.
114
  ! ------------------------------------------
115
116
1
  r = rnavo*rkbol
117
1
  rmd = 28.9644
118
1
  rmo3 = 47.9942
119
1
  rmco2 = 44.011
120
1
  rmch4 = 16.043
121
1
  rmn2o = 44.013
122
1
  rmcfc11 = 137.3686
123
1
  rmcfc12 = 120.9140
124
1
  rmc   = 12.0107
125
1
  rmv = 18.0153
126
1
  rd = 1000.*r/rmd
127
1
  rv = 1000.*r/rmv
128
1
  rcpd = 3.5*rd
129
1
  rcvd = rcpd - rd
130
1
  rcpv = 4.*rv
131
1
  rcvv = rcpv - rv
132
1
  rkappa = rd/rcpd
133
1
  eps_w = rmv / rmd
134
1
  retv = rv/rd - 1.
135
1
  WRITE (UNIT=6, FMT='('' *** Thermodynamic, gas     ***'')')
136
1
  WRITE (UNIT=6, FMT='('' Perfect gas  = '',e13.7,'' J mol-1 K-1'')') r
137
1
  WRITE (UNIT=6, FMT='('' Dry air mass = '',e13.7,'' g mol-1'')') rmd
138
1
  WRITE (UNIT=6, FMT='('' Ozone   mass = '',e13.7,'' g mol-1'')') rmo3
139
1
  WRITE (UNIT=6, FMT='('' CO2     mass = '',e13.7,'' g mol-1'')') rmco2
140
1
  WRITE (UNIT=6, FMT='('' C       mass = '',e13.7,'' g mol-1'')') rmc
141
1
  WRITE (UNIT=6, FMT='('' CH4     mass = '',e13.7,'' g mol-1'')') rmch4
142
1
  WRITE (UNIT=6, FMT='('' N2O     mass = '',e13.7,'' g mol-1'')') rmn2o
143
1
  WRITE (UNIT=6, FMT='('' CFC11   mass = '',e13.7,'' g mol-1'')') rmcfc11
144
1
  WRITE (UNIT=6, FMT='('' CFC12   mass = '',e13.7,'' g mol-1'')') rmcfc12
145
1
  WRITE (UNIT=6, FMT='('' Vapour  mass = '',e13.7,'' g mol-1'')') rmv
146
1
  WRITE (UNIT=6, FMT='('' Dry air cst. = '',e13.7,'' J K-1 kg-1'')') rd
147
1
  WRITE (UNIT=6, FMT='('' Vapour  cst. = '',e13.7,'' J K-1 kg-1'')') rv
148
1
  WRITE (UNIT=6, FMT='(''         Cpd  = '',e13.7,'' J K-1 kg-1'')') rcpd
149
1
  WRITE (UNIT=6, FMT='(''         Cvd  = '',e13.7,'' J K-1 kg-1'')') rcvd
150
1
  WRITE (UNIT=6, FMT='(''         Cpv  = '',e13.7,'' J K-1 kg-1'')') rcpv
151
1
  WRITE (UNIT=6, FMT='(''         Cvv  = '',e13.7,'' J K-1 kg-1'')') rcvv
152
1
  WRITE (UNIT=6, FMT='(''      Rd/Cpd  = '',e13.7)') rkappa
153
1
  WRITE (UNIT=6, FMT='(''     Rv/Rd-1  = '',e13.7)') retv
154
1
  WRITE (UNIT=6, FMT='(''        Rd/Rv = '',e13.7)') eps_w
155
156
  ! ----------------------------------------------------------------
157
158
  ! *       6.    DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE.
159
  ! ---------------------------------------------
160
161
1
  rcw = rcpv
162
1
  WRITE (UNIT=6, FMT='('' *** Thermodynamic, liquid  ***'')')
163
1
  WRITE (UNIT=6, FMT='(''         Cw   = '',E13.7,'' J K-1 kg-1'')') rcw
164
165
  ! ----------------------------------------------------------------
166
167
  ! *       7.    DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE.
168
  ! --------------------------------------------
169
170
1
  rcs = rcpv
171
1
  WRITE (UNIT=6, FMT='('' *** thermodynamic, solid   ***'')')
172
1
  WRITE (UNIT=6, FMT='(''         Cs   = '',E13.7,'' J K-1 kg-1'')') rcs
173
174
  ! ----------------------------------------------------------------
175
176
  ! *       8.    DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE.
177
  ! ----------------------------------------------------
178
179
1
  rtt = 273.16
180
1
  rlvtt = 2.5008E+6
181
1
  rlstt = 2.8345E+6
182
1
  rlmlt = rlstt - rlvtt
183
1
  ratm = 100000.
184
1
  WRITE (UNIT=6, FMT='('' *** Thermodynamic, trans.  ***'')')
185
1
  WRITE (UNIT=6, FMT='('' Fusion point  = '',E13.7,'' K'')') rtt
186
1
  WRITE (UNIT=6, FMT='(''        RLvTt  = '',E13.7,'' J kg-1'')') rlvtt
187
1
  WRITE (UNIT=6, FMT='(''        RLsTt  = '',E13.7,'' J kg-1'')') rlstt
188
1
  WRITE (UNIT=6, FMT='(''        RLMlt  = '',E13.7,'' J kg-1'')') rlmlt
189
1
  WRITE (UNIT=6, FMT='('' Normal press. = '',E13.7,'' Pa'')') ratm
190
1
  WRITE (UNIT=6, FMT='('' Latent heat :  '')')
191
192
  ! ----------------------------------------------------------------
193
194
  ! *       9.    SATURATED VAPOUR PRESSURE.
195
  ! --------------------------
196
197
1
  restt = 611.14   !--saturation water vapour pressure at triple point (Pa)
198
1
  rgamw = (rcw-rcpv)/rv
199
1
  rbetw = rlvtt/rv + rgamw*rtt
200
1
  ralpw = log(restt) + rbetw/rtt + rgamw*log(rtt)
201
1
  rgams = (rcs-rcpv)/rv
202
1
  rbets = rlstt/rv + rgams*rtt
203
1
  ralps = log(restt) + rbets/rtt + rgams*log(rtt)
204
1
  rgamd = rgams - rgamw
205
1
  rbetd = rbets - rbetw
206
1
  ralpd = ralps - ralpw
207
208
  ! ------------------------------------------------------------------
209
210
  ! *       10.   CONSTANTS FOR THERMODYNAMICAL FUNCTIONS.
211
  ! ----------------------------------------
212
213
1
  rvtmp2 = rcpv/rcpd - 1.
214
1
  rhoh2o = ratm/100.
215
1
  r2es = restt*rd/rv
216
1
  r3les = 17.269
217
1
  r3ies = 21.875
218
1
  r4les = 35.86
219
1
  r4ies = 7.66
220
1
  r5les = r3les*(rtt-r4les)
221
1
  r5ies = r3ies*(rtt-r4ies)
222
223
  ! ------------------------------------------------------------------
224
225
  ! *       10.   CONSTANTS FOR METHANE OXIDATION AND PHOTOLYSIS.
226
  ! -----------------------------------------------
227
228
1
  CALL SUMETHOX()
229
230
1
  RETURN
231
END SUBROUTINE suphel