source: lmdz_wrf/WRFV3/lmdz/suphel.F90 @ 1

Last change on this file since 1 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

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