source: LMDZ5/trunk/libf/phylmd/suphel.F90 @ 2029

Last change on this file since 2029 was 1992, checked in by lguez, 11 years ago

Converted to free source form files in libf/phylmd which were still in
fixed source form. The conversion was done using the polish mode of
the NAG Fortran Compiler.

In addition to converting to free source form, the processing of the
files also:

-- indented the code (including comments);

-- set Fortran keywords to uppercase, and set all other identifiers
to lower case;

-- added qualifiers to end statements (for example "end subroutine
conflx", instead of "end");

-- changed the terminating statements of all DO loops so that each
loop ends with an ENDDO statement (instead of a labeled continue).

-- replaced #include by include.
  • 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
RevLine 
[1992]1
[879]2! $Header$
[1992]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.