source: LMDZ5/branches/testing/libf/phylmd/suphel.F90 @ 2056

Last change on this file since 2056 was 1999, checked in by Laurent Fairhead, 11 years ago

Merged trunk changes r1920:1997 into testing branch
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 6.8 KB
Line 
1
2! $Header$
3
4SUBROUTINE suphel
5
6  include "YOMCST.h"
7  include "YOETHF.h"
8  ! IM cf. JLD
9  LOGICAL firstcall
10  SAVE firstcall
11  !$OMP THREADPRIVATE(firstcall)
12  DATA firstcall/.TRUE./
13
14  IF (firstcall) THEN
15    PRINT *, 'suphel initialise les constantes du GCM'
16    firstcall = .FALSE.
17  ELSE
18    PRINT *, 'suphel DEJA APPELE '
19    RETURN
20  END IF
21  ! -----------------------------------------------------------------
22
23  ! *       1.    DEFINE FUNDAMENTAL CONSTANTS.
24  ! -----------------------------
25
26  WRITE (UNIT=6, FMT='(''0*** Constants of the ICM   ***'')')
27  rpi = 2.*asin(1.)
28  rclum = 299792458.
29  rhpla = 6.6260755E-34
30  rkbol = 1.380658E-23
31  rnavo = 6.0221367E+23
32  WRITE (UNIT=6, FMT='('' *** Fundamental constants ***'')')
33  WRITE (UNIT=6, FMT='(''           PI = '',E13.7,'' -'')') rpi
34  WRITE (UNIT=6, FMT='(''            c = '',E13.7,''m s-1'')') rclum
35  WRITE (UNIT=6, FMT='(''            h = '',E13.7,''J s'')') rhpla
36  WRITE (UNIT=6, FMT='(''            K = '',E13.7,''J K-1'')') rkbol
37  WRITE (UNIT=6, FMT='(''            N = '',E13.7,''mol-1'')') rnavo
38
39  ! ----------------------------------------------------------------
40
41  ! *       2.    DEFINE ASTRONOMICAL CONSTANTS.
42  ! ------------------------------
43
44  rday = 86400.
45  rea = 149597870000.
46  repsm = 0.409093
47
48  rsiyea = 365.25*rday*2.*rpi/6.283076
49  rsiday = rday/(1.+rday/rsiyea)
50  romega = 2.*rpi/rsiday
51
52  ! exp1      R_ecc = 0.05
53  ! exp1      R_peri = 102.04
54  ! exp1      R_incl = 22.5
55  ! exp1      print*, 'Parametres orbitaux modifies'
56  ! ref      R_ecc = 0.016724
57  ! ref      R_peri = 102.04
58  ! ref      R_incl = 23.5
59
60  ! IM 161002 : pour avoir les ctes AMIP II
61  ! IM 161002   R_ecc = 0.016724
62  ! IM 161002   R_peri = 102.04
63  ! IM 161002   R_incl = 23.5
64  ! IM on mets R_ecc, R_peri, R_incl dans conf_phys.F90
65  ! R_ecc = 0.016715
66  ! R_peri = 102.7
67  ! R_incl = 23.441
68
69  WRITE (UNIT=6, FMT='('' *** Astronomical constants ***'')')
70  WRITE (UNIT=6, FMT='(''          day = '',E13.7,'' s'')') rday
71  WRITE (UNIT=6, FMT='('' half g. axis = '',E13.7,'' m'')') rea
72  WRITE (UNIT=6, FMT='('' mean anomaly = '',E13.7,'' -'')') repsm
73  WRITE (UNIT=6, FMT='('' sideral year = '',E13.7,'' s'')') rsiyea
74  WRITE (UNIT=6, FMT='(''  sideral day = '',E13.7,'' s'')') rsiday
75  WRITE (UNIT=6, FMT='(''        omega = '',E13.7,'' s-1'')') romega
76  ! write(unit=6,fmt='('' excentricite = '',e13.7,''-'')')R_ecc
77  ! write(unit=6,fmt='(''     equinoxe = '',e13.7,''-'')')R_peri
78  ! write(unit=6,fmt='(''  inclinaison = '',e13.7,''-'')')R_incl
79
80  ! ------------------------------------------------------------------
81
82  ! *       3.    DEFINE GEOIDE.
83  ! --------------
84
85  rg = 9.80665
86  ra = 6371229.
87  r1sa = sngl(1.D0/dble(ra))
88  WRITE (UNIT=6, FMT='('' ***         Geoide         ***'')')
89  WRITE (UNIT=6, FMT='(''      Gravity = '',E13.7,'' m s-2'')') rg
90  WRITE (UNIT=6, FMT='('' Earth radius = '',E13.7,'' m'')') ra
91  WRITE (UNIT=6, FMT='('' Inverse E.R. = '',E13.7,'' m'')') r1sa
92
93  ! -----------------------------------------------------------------
94
95  ! *       4.    DEFINE RADIATION CONSTANTS.
96  ! ---------------------------
97
98  ! z.x.li      RSIGMA=2. * RPI**5 * RKBOL**4 /(15.* RCLUM**2 * RHPLA**3)
99  rsigma = 2.*rpi**5*(rkbol/rhpla)**3*rkbol/rclum/rclum/15.
100  ! IM init. dans conf_phys.F90   RI0=1365.
101  WRITE (UNIT=6, FMT='('' ***        Radiation       ***'')')
102  WRITE (UNIT=6, FMT='('' Stefan-Bol.  = '',E13.7,'' W m-2 K-4'' &
103    &                                                         &
104    &         )') rsigma
105  ! IM init. dans conf_phys.F90   WRITE(UNIT=6,FMT='('' Solar const. =
106  ! '',E13.7,'' W m-2'')')
107  ! IM init. dans conf_phys.F90  S      RI0
108
109  ! -----------------------------------------------------------------
110
111  ! *       5.    DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE.
112  ! ------------------------------------------
113
114  r = rnavo*rkbol
115  rmd = 28.9644
116  rmo3 = 47.9942
117  rmv = 18.0153
118  rd = 1000.*r/rmd
119  rv = 1000.*r/rmv
120  rcpd = 3.5*rd
121  rcvd = rcpd - rd
122  rcpv = 4.*rv
123  rcvv = rcpv - rv
124  rkappa = rd/rcpd
125  retv = rv/rd - 1.
126  WRITE (UNIT=6, FMT='('' *** Thermodynamic, gas     ***'')')
127  WRITE (UNIT=6, FMT='('' Perfect gas  = '',e13.7)') r
128  WRITE (UNIT=6, FMT='('' Dry air mass = '',e13.7)') rmd
129  WRITE (UNIT=6, FMT='('' Ozone   mass = '',e13.7)') rmo3
130  WRITE (UNIT=6, FMT='('' Vapour  mass = '',e13.7)') rmv
131  WRITE (UNIT=6, FMT='('' Dry air cst. = '',e13.7)') rd
132  WRITE (UNIT=6, FMT='('' Vapour  cst. = '',e13.7)') rv
133  WRITE (UNIT=6, FMT='(''         Cpd  = '',e13.7)') rcpd
134  WRITE (UNIT=6, FMT='(''         Cvd  = '',e13.7)') rcvd
135  WRITE (UNIT=6, FMT='(''         Cpv  = '',e13.7)') rcpv
136  WRITE (UNIT=6, FMT='(''         Cvv  = '',e13.7)') rcvv
137  WRITE (UNIT=6, FMT='(''      Rd/Cpd  = '',e13.7)') rkappa
138  WRITE (UNIT=6, FMT='(''     Rv/Rd-1  = '',e13.7)') retv
139
140  ! ----------------------------------------------------------------
141
142  ! *       6.    DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE.
143  ! ---------------------------------------------
144
145  rcw = rcpv
146  WRITE (UNIT=6, FMT='('' *** Thermodynamic, liquid  ***'')')
147  WRITE (UNIT=6, FMT='(''         Cw   = '',E13.7)') rcw
148
149  ! ----------------------------------------------------------------
150
151  ! *       7.    DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE.
152  ! --------------------------------------------
153
154  rcs = rcpv
155  WRITE (UNIT=6, FMT='('' *** thermodynamic, solid   ***'')')
156  WRITE (UNIT=6, FMT='(''         Cs   = '',E13.7)') rcs
157
158  ! ----------------------------------------------------------------
159
160  ! *       8.    DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE.
161  ! ----------------------------------------------------
162
163  rtt = 273.16
164  rlvtt = 2.5008E+6
165  rlstt = 2.8345E+6
166  rlmlt = rlstt - rlvtt
167  ratm = 100000.
168  WRITE (UNIT=6, FMT='('' *** Thermodynamic, trans.  ***'')')
169  WRITE (UNIT=6, FMT='('' Fusion point  = '',E13.7)') rtt
170  WRITE (UNIT=6, FMT='(''        RLvTt  = '',E13.7)') rlvtt
171  WRITE (UNIT=6, FMT='(''        RLsTt  = '',E13.7)') rlstt
172  WRITE (UNIT=6, FMT='(''        RLMlt  = '',E13.7)') rlmlt
173  WRITE (UNIT=6, FMT='('' Normal press. = '',E13.7)') ratm
174  WRITE (UNIT=6, FMT='('' Latent heat :  '')')
175
176  ! ----------------------------------------------------------------
177
178  ! *       9.    SATURATED VAPOUR PRESSURE.
179  ! --------------------------
180
181  restt = 611.14
182  rgamw = (rcw-rcpv)/rv
183  rbetw = rlvtt/rv + rgamw*rtt
184  ralpw = log(restt) + rbetw/rtt + rgamw*log(rtt)
185  rgams = (rcs-rcpv)/rv
186  rbets = rlstt/rv + rgams*rtt
187  ralps = log(restt) + rbets/rtt + rgams*log(rtt)
188  rgamd = rgams - rgamw
189  rbetd = rbets - rbetw
190  ralpd = ralps - ralpw
191
192  ! ------------------------------------------------------------------
193
194  ! calculer les constantes pour les fonctions thermodynamiques
195
196  rvtmp2 = rcpv/rcpd - 1.
197  rhoh2o = ratm/100.
198  r2es = restt*rd/rv
199  r3les = 17.269
200  r3ies = 21.875
201  r4les = 35.86
202  r4ies = 7.66
203  r5les = r3les*(rtt-r4les)
204  r5ies = r3ies*(rtt-r4ies)
205
206  RETURN
207END SUBROUTINE suphel
Note: See TracBrowser for help on using the repository browser.