source: LMDZ6/branches/Amaury_dev/libf/phylmd/suphel.F90 @ 5099

Last change on this file since 5099 was 5087, checked in by abarral, 5 months ago

remove fixed-form \s+& remaining in .f90,.F90
  • 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: 7.9 KB
RevLine 
[1992]1
[879]2! $Header$
[1992]3
4SUBROUTINE suphel
5
[3319]6  IMPLICIT NONE
7
[1992]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  IF (firstcall) THEN
17    PRINT *, 'suphel initialise les constantes du GCM'
18    firstcall = .FALSE.
19  ELSE
20    PRINT *, 'suphel DEJA APPELE '
21    RETURN
22  END IF
23  ! -----------------------------------------------------------------
24
25  ! *       1.    DEFINE FUNDAMENTAL CONSTANTS.
26  ! -----------------------------
27
28  WRITE (UNIT=6, FMT='(''0*** Constants of the ICM   ***'')')
29  rpi = 2.*asin(1.)
30  rclum = 299792458.
31  rhpla = 6.6260755E-34
32  rkbol = 1.380658E-23
33  rnavo = 6.0221367E+23
34  WRITE (UNIT=6, FMT='('' *** Fundamental constants ***'')')
35  WRITE (UNIT=6, FMT='(''           PI = '',E13.7,'' -'')') rpi
36  WRITE (UNIT=6, FMT='(''            c = '',E13.7,''m s-1'')') rclum
37  WRITE (UNIT=6, FMT='(''            h = '',E13.7,''J s'')') rhpla
38  WRITE (UNIT=6, FMT='(''            K = '',E13.7,''J K-1'')') rkbol
39  WRITE (UNIT=6, FMT='(''            N = '',E13.7,''mol-1'')') rnavo
40
41  ! ----------------------------------------------------------------
42
43  ! *       2.    DEFINE ASTRONOMICAL CONSTANTS.
44  ! ------------------------------
45
46  rday = 86400.
47  rea = 149597870000.
48  repsm = 0.409093
49
50  rsiyea = 365.25*rday*2.*rpi/6.283076
51  rsiday = rday/(1.+rday/rsiyea)
52  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  WRITE (UNIT=6, FMT='('' *** Astronomical constants ***'')')
72  WRITE (UNIT=6, FMT='(''          day = '',E13.7,'' s'')') rday
73  WRITE (UNIT=6, FMT='('' half g. axis = '',E13.7,'' m'')') rea
74  WRITE (UNIT=6, FMT='('' mean anomaly = '',E13.7,'' -'')') repsm
75  WRITE (UNIT=6, FMT='('' sideral year = '',E13.7,'' s'')') rsiyea
76  WRITE (UNIT=6, FMT='(''  sideral day = '',E13.7,'' s'')') rsiday
77  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  rg = 9.80665
88  ra = 6371229.
89  r1sa = sngl(1.D0/dble(ra))
90  WRITE (UNIT=6, FMT='('' ***         Geoide         ***'')')
91  WRITE (UNIT=6, FMT='(''      Gravity = '',E13.7,'' m s-2'')') rg
92  WRITE (UNIT=6, FMT='('' Earth radius = '',E13.7,'' m'')') ra
93  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  rsigma = 2.*rpi**5*(rkbol/rhpla)**3*rkbol/rclum/rclum/15.
102  ! IM init. dans conf_phys.F90   RI0=1365.
103  WRITE (UNIT=6, FMT='('' ***        Radiation       ***'')')
104  WRITE (UNIT=6, FMT='('' Stefan-Bol.  = '',E13.7,'' W m-2 K-4'' &
[5087]105
106           )') rsigma
[1992]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  r = rnavo*rkbol
117  rmd = 28.9644
118  rmo3 = 47.9942
[3393]119  rmco2 = 44.011
[3447]120  rmch4 = 16.043
121  rmn2o = 44.013
122  rmcfc11 = 137.3686
123  rmcfc12 = 120.9140
[3394]124  rmc   = 12.0107
[1992]125  rmv = 18.0153
126  rd = 1000.*r/rmd
127  rv = 1000.*r/rmv
128  rcpd = 3.5*rd
129  rcvd = rcpd - rd
130  rcpv = 4.*rv
131  rcvv = rcpv - rv
132  rkappa = rd/rcpd
[3815]133  eps_w = rmv / rmd
[1992]134  retv = rv/rd - 1.
135  WRITE (UNIT=6, FMT='('' *** Thermodynamic, gas     ***'')')
[4001]136  WRITE (UNIT=6, FMT='('' Perfect gas  = '',e13.7,'' J mol-1 K-1'')') r
137  WRITE (UNIT=6, FMT='('' Dry air mass = '',e13.7,'' g mol-1'')') rmd
138  WRITE (UNIT=6, FMT='('' Ozone   mass = '',e13.7,'' g mol-1'')') rmo3
139  WRITE (UNIT=6, FMT='('' CO2     mass = '',e13.7,'' g mol-1'')') rmco2
140  WRITE (UNIT=6, FMT='('' C       mass = '',e13.7,'' g mol-1'')') rmc
141  WRITE (UNIT=6, FMT='('' CH4     mass = '',e13.7,'' g mol-1'')') rmch4
142  WRITE (UNIT=6, FMT='('' N2O     mass = '',e13.7,'' g mol-1'')') rmn2o
143  WRITE (UNIT=6, FMT='('' CFC11   mass = '',e13.7,'' g mol-1'')') rmcfc11
144  WRITE (UNIT=6, FMT='('' CFC12   mass = '',e13.7,'' g mol-1'')') rmcfc12
145  WRITE (UNIT=6, FMT='('' Vapour  mass = '',e13.7,'' g mol-1'')') rmv
146  WRITE (UNIT=6, FMT='('' Dry air cst. = '',e13.7,'' J K-1 kg-1'')') rd
147  WRITE (UNIT=6, FMT='('' Vapour  cst. = '',e13.7,'' J K-1 kg-1'')') rv
148  WRITE (UNIT=6, FMT='(''         Cpd  = '',e13.7,'' J K-1 kg-1'')') rcpd
149  WRITE (UNIT=6, FMT='(''         Cvd  = '',e13.7,'' J K-1 kg-1'')') rcvd
150  WRITE (UNIT=6, FMT='(''         Cpv  = '',e13.7,'' J K-1 kg-1'')') rcpv
151  WRITE (UNIT=6, FMT='(''         Cvv  = '',e13.7,'' J K-1 kg-1'')') rcvv
[1992]152  WRITE (UNIT=6, FMT='(''      Rd/Cpd  = '',e13.7)') rkappa
153  WRITE (UNIT=6, FMT='(''     Rv/Rd-1  = '',e13.7)') retv
[4000]154  WRITE (UNIT=6, FMT='(''        Rd/Rv = '',e13.7)') eps_w
[1992]155
156  ! ----------------------------------------------------------------
157
158  ! *       6.    DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE.
159  ! ---------------------------------------------
160
161  rcw = rcpv
162  WRITE (UNIT=6, FMT='('' *** Thermodynamic, liquid  ***'')')
[4001]163  WRITE (UNIT=6, FMT='(''         Cw   = '',E13.7,'' J K-1 kg-1'')') rcw
[1992]164
165  ! ----------------------------------------------------------------
166
167  ! *       7.    DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE.
168  ! --------------------------------------------
169
170  rcs = rcpv
171  WRITE (UNIT=6, FMT='('' *** thermodynamic, solid   ***'')')
[4001]172  WRITE (UNIT=6, FMT='(''         Cs   = '',E13.7,'' J K-1 kg-1'')') rcs
[1992]173
174  ! ----------------------------------------------------------------
175
176  ! *       8.    DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE.
177  ! ----------------------------------------------------
178
179  rtt = 273.16
180  rlvtt = 2.5008E+6
181  rlstt = 2.8345E+6
182  rlmlt = rlstt - rlvtt
183  ratm = 100000.
184  WRITE (UNIT=6, FMT='('' *** Thermodynamic, trans.  ***'')')
[4001]185  WRITE (UNIT=6, FMT='('' Fusion point  = '',E13.7,'' K'')') rtt
186  WRITE (UNIT=6, FMT='(''        RLvTt  = '',E13.7,'' J kg-1'')') rlvtt
187  WRITE (UNIT=6, FMT='(''        RLsTt  = '',E13.7,'' J kg-1'')') rlstt
188  WRITE (UNIT=6, FMT='(''        RLMlt  = '',E13.7,'' J kg-1'')') rlmlt
189  WRITE (UNIT=6, FMT='('' Normal press. = '',E13.7,'' Pa'')') ratm
[1992]190  WRITE (UNIT=6, FMT='('' Latent heat :  '')')
191
192  ! ----------------------------------------------------------------
193
194  ! *       9.    SATURATED VAPOUR PRESSURE.
195  ! --------------------------
196
[4001]197  restt = 611.14   !--saturation water vapour pressure at triple point (Pa)
[1992]198  rgamw = (rcw-rcpv)/rv
199  rbetw = rlvtt/rv + rgamw*rtt
200  ralpw = log(restt) + rbetw/rtt + rgamw*log(rtt)
201  rgams = (rcs-rcpv)/rv
202  rbets = rlstt/rv + rgams*rtt
203  ralps = log(restt) + rbets/rtt + rgams*log(rtt)
204  rgamd = rgams - rgamw
205  rbetd = rbets - rbetw
206  ralpd = ralps - ralpw
207
208  ! ------------------------------------------------------------------
209
[2136]210  ! *       10.   CONSTANTS FOR THERMODYNAMICAL FUNCTIONS.
211  ! ----------------------------------------
[1992]212
213  rvtmp2 = rcpv/rcpd - 1.
214  rhoh2o = ratm/100.
215  r2es = restt*rd/rv
216  r3les = 17.269
217  r3ies = 21.875
218  r4les = 35.86
219  r4ies = 7.66
220  r5les = r3les*(rtt-r4les)
221  r5ies = r3ies*(rtt-r4ies)
222
[2136]223  ! ------------------------------------------------------------------
224
225  ! *       10.   CONSTANTS FOR METHANE OXIDATION AND PHOTOLYSIS.
226  ! -----------------------------------------------
227
228  CALL SUMETHOX()
229
[1992]230  RETURN
231END SUBROUTINE suphel
Note: See TracBrowser for help on using the repository browser.