source: trunk/LMDZ.EARTH/libf/phylmd/suphel.F @ 357

Last change on this file since 357 was 1, checked in by emillour, 14 years ago

Import initial LMDZ5
File size: 7.1 KB
Line 
1!
2! $Header$
3!
4      SUBROUTINE suphel
5C
6#include "YOMCST.h"
7#include "YOETHF.h"
8cIM cf. JLD
9       LOGICAL firstcall
10       SAVE firstcall
11c$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       ENDIF
21C      -----------------------------------------------------------------
22C
23C*       1.    DEFINE FUNDAMENTAL CONSTANTS.
24C              -----------------------------
25C
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'')')
35     S RCLUM
36      WRITE(UNIT=6,FMT='(''            h = '',E13.7,''J s'')')
37     S RHPLA
38      WRITE(UNIT=6,FMT='(''            K = '',E13.7,''J K-1'')')
39     S RKBOL
40      WRITE(UNIT=6,FMT='(''            N = '',E13.7,''mol-1'')')
41     S RNAVO
42C
43C     ----------------------------------------------------------------
44C
45C*       2.    DEFINE ASTRONOMICAL CONSTANTS.
46C              ------------------------------
47C
48      RDAY=86400.
49      REA=149597870000.
50      REPSM=0.409093
51C
52      RSIYEA=365.25*RDAY*2.*RPI/6.283076
53      RSIDAY=RDAY/(1.+RDAY/RSIYEA)
54      ROMEGA=2.*RPI/RSIDAY
55c
56c exp1      R_ecc = 0.05
57c exp1      R_peri = 102.04
58c exp1      R_incl = 22.5
59c exp1      print*, 'Parametres orbitaux modifies'
60c ref      R_ecc = 0.016724
61c ref      R_peri = 102.04
62c ref      R_incl = 23.5
63c
64cIM 161002 : pour avoir les ctes AMIP II
65cIM 161002   R_ecc = 0.016724
66cIM 161002   R_peri = 102.04
67cIM 161002   R_incl = 23.5
68cIM on mets R_ecc, R_peri, R_incl dans conf_phys.F90
69c     R_ecc = 0.016715
70c     R_peri = 102.7
71c     R_incl = 23.441
72c
73      WRITE(UNIT=6,FMT='('' *** Astronomical constants ***'')')
74      WRITE(UNIT=6,FMT='(''          day = '',E13.7,'' s'')')RDAY
75      WRITE(UNIT=6,FMT='('' half g. axis = '',E13.7,'' m'')')REA
76      WRITE(UNIT=6,FMT='('' mean anomaly = '',E13.7,'' -'')')REPSM
77      WRITE(UNIT=6,FMT='('' sideral year = '',E13.7,'' s'')')RSIYEA
78      WRITE(UNIT=6,FMT='(''  sideral day = '',E13.7,'' s'')')RSIDAY
79      WRITE(UNIT=6,FMT='(''        omega = '',E13.7,'' s-1'')')
80     S                  ROMEGA
81c     write(unit=6,fmt='('' excentricite = '',e13.7,''-'')')R_ecc
82c     write(unit=6,fmt='(''     equinoxe = '',e13.7,''-'')')R_peri
83c     write(unit=6,fmt='(''  inclinaison = '',e13.7,''-'')')R_incl
84C
85C     ------------------------------------------------------------------
86C
87C*       3.    DEFINE GEOIDE.
88C              --------------
89C
90      RG=9.80665
91      RA=6371229.
92      R1SA=SNGL(1.D0/DBLE(RA))
93      WRITE(UNIT=6,FMT='('' ***         Geoide         ***'')')
94      WRITE(UNIT=6,FMT='(''      Gravity = '',E13.7,'' m s-2'')')
95     S      RG
96      WRITE(UNIT=6,FMT='('' Earth radius = '',E13.7,'' m'')')RA
97      WRITE(UNIT=6,FMT='('' Inverse E.R. = '',E13.7,'' m'')')R1SA
98C
99C     -----------------------------------------------------------------
100C
101C*       4.    DEFINE RADIATION CONSTANTS.
102C              ---------------------------
103C
104c z.x.li      RSIGMA=2. * RPI**5 * RKBOL**4 /(15.* RCLUM**2 * RHPLA**3)
105      rsigma = 2.*rpi**5 * (rkbol/rhpla)**3 * rkbol/rclum/rclum/15.
106cIM init. dans conf_phys.F90   RI0=1365.
107      WRITE(UNIT=6,FMT='('' ***        Radiation       ***'')')
108      WRITE(UNIT=6,FMT='('' Stefan-Bol.  = '',E13.7,'' W m-2 K-4''
109     S )')  RSIGMA
110cIM init. dans conf_phys.F90   WRITE(UNIT=6,FMT='('' Solar const. = '',E13.7,'' W m-2'')')
111cIM init. dans conf_phys.F90  S      RI0
112C
113C     -----------------------------------------------------------------
114C
115C*       5.    DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE.
116C              ------------------------------------------
117C
118      R=RNAVO*RKBOL
119      RMD=28.9644
120      RMO3=47.9942
121      RMV=18.0153
122      RD=1000.*R/RMD
123      RV=1000.*R/RMV
124      RCPD=3.5*RD
125      RCVD=RCPD-RD
126      RCPV=4. *RV
127      RCVV=RCPV-RV
128      RKAPPA=RD/RCPD
129      RETV=RV/RD-1.
130      WRITE(UNIT=6,FMT='('' *** Thermodynamic, gas     ***'')')
131      WRITE(UNIT=6,FMT='('' Perfect gas  = '',e13.7)') R
132      WRITE(UNIT=6,FMT='('' Dry air mass = '',e13.7)') RMD
133      WRITE(UNIT=6,FMT='('' Ozone   mass = '',e13.7)') RMO3
134      WRITE(UNIT=6,FMT='('' Vapour  mass = '',e13.7)') RMV
135      WRITE(UNIT=6,FMT='('' Dry air cst. = '',e13.7)') RD
136      WRITE(UNIT=6,FMT='('' Vapour  cst. = '',e13.7)') RV
137      WRITE(UNIT=6,FMT='(''         Cpd  = '',e13.7)') RCPD
138      WRITE(UNIT=6,FMT='(''         Cvd  = '',e13.7)') RCVD
139      WRITE(UNIT=6,FMT='(''         Cpv  = '',e13.7)') RCPV
140      WRITE(UNIT=6,FMT='(''         Cvv  = '',e13.7)') RCVV
141      WRITE(UNIT=6,FMT='(''      Rd/Cpd  = '',e13.7)') RKAPPA
142      WRITE(UNIT=6,FMT='(''     Rv/Rd-1  = '',e13.7)') RETV
143C
144C     ----------------------------------------------------------------
145C
146C*       6.    DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE.
147C              ---------------------------------------------
148C
149      RCW=RCPV
150      WRITE(UNIT=6,FMT='('' *** Thermodynamic, liquid  ***'')')
151      WRITE(UNIT=6,FMT='(''         Cw   = '',E13.7)') RCW
152C
153C     ----------------------------------------------------------------
154C
155C*       7.    DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE.
156C              --------------------------------------------
157C
158      RCS=RCPV
159      WRITE(UNIT=6,FMT='('' *** thermodynamic, solid   ***'')')
160      WRITE(UNIT=6,FMT='(''         Cs   = '',E13.7)') RCS
161C
162C     ----------------------------------------------------------------
163C
164C*       8.    DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE.
165C              ----------------------------------------------------
166C
167      RTT=273.16
168      RLVTT=2.5008E+6
169      RLSTT=2.8345E+6
170      RLMLT=RLSTT-RLVTT
171      RATM=100000.
172      WRITE(UNIT=6,FMT='('' *** Thermodynamic, trans.  ***'')')
173      WRITE(UNIT=6,FMT='('' Fusion point  = '',E13.7)') RTT
174      WRITE(UNIT=6,FMT='(''        RLvTt  = '',E13.7)') RLVTT
175      WRITE(UNIT=6,FMT='(''        RLsTt  = '',E13.7)') RLSTT
176      WRITE(UNIT=6,FMT='(''        RLMlt  = '',E13.7)') RLMLT
177      WRITE(UNIT=6,FMT='('' Normal press. = '',E13.7)') RATM
178      WRITE(UNIT=6,FMT='('' Latent heat :  '')')
179C
180C     ----------------------------------------------------------------
181C
182C*       9.    SATURATED VAPOUR PRESSURE.
183C              --------------------------
184C
185      RESTT=611.14
186      RGAMW=(RCW-RCPV)/RV
187      RBETW=RLVTT/RV+RGAMW*RTT
188      RALPW=LOG(RESTT)+RBETW/RTT+RGAMW*LOG(RTT)
189      RGAMS=(RCS-RCPV)/RV
190      RBETS=RLSTT/RV+RGAMS*RTT
191      RALPS=LOG(RESTT)+RBETS/RTT+RGAMS*LOG(RTT)
192      RGAMD=RGAMS-RGAMW
193      RBETD=RBETS-RBETW
194      RALPD=RALPS-RALPW
195C
196C     ------------------------------------------------------------------
197c
198c calculer les constantes pour les fonctions thermodynamiques
199c
200      RVTMP2=RCPV/RCPD-1.
201      RHOH2O=RATM/100.
202      R2ES=RESTT*RD/RV
203      R3LES=17.269
204      R3IES=21.875
205      R4LES=35.86
206      R4IES=7.66
207      R5LES=R3LES*(RTT-R4LES)
208      R5IES=R3IES*(RTT-R4IES)
209C
210      RETURN
211      END
Note: See TracBrowser for help on using the repository browser.