My Project
 All Classes Files Functions Variables Macros
q_sat.F
Go to the documentation of this file.
1 !
2 ! $Header$
3 !
4 c
5 c
6 
7  subroutine q_sat(np,temp,pres,qsat)
8 c
9  IMPLICIT none
10 c======================================================================
11 c Autheur(s): Z.X. Li (LMD/CNRS)
12 c reecriture vectorisee par F. Hourdin.
13 c Objet: calculer la vapeur d'eau saturante (formule Centre Euro.)
14 c======================================================================
15 c Arguments:
16 c kelvin---input-R: temperature en Kelvin
17 c millibar--input-R: pression en mb
18 c
19 c q_sat----output-R: vapeur d'eau saturante en kg/kg
20 c======================================================================
21 c
22  integer np
23  REAL temp(np),pres(np),qsat(np)
24 c
25  REAL r2es
26  parameter(r2es=611.14 *18.0153/28.9644)
27 c
28  REAL r3les, r3ies, r3es
29  parameter(r3les=17.269)
30  parameter(r3ies=21.875)
31 c
32  REAL r4les, r4ies, r4es
33  parameter(r4les=35.86)
34  parameter(r4ies=7.66)
35 c
36  REAL rtt
37  parameter(rtt=273.16)
38 c
39  REAL retv
40  parameter(retv=28.9644/18.0153 - 1.0)
41 
42  real zqsat
43  integer ip
44 c
45 C ------------------------------------------------------------------
46 c
47 c
48 
49  do ip=1,np
50 
51 c write(*,*)'kelvin,millibar=',kelvin,millibar
52 c write(*,*)'temp,pres=',temp(ip),pres(ip)
53 c
54  IF (temp(ip) .LE. rtt) THEN
55  r3es = r3ies
56  r4es = r4ies
57  ELSE
58  r3es = r3les
59  r4es = r4les
60  ENDIF
61 c
62  zqsat=r2es/pres(ip)*exp(r3es*(temp(ip)-rtt)/(temp(ip)-r4es))
63  zqsat=min(0.5,zqsat)
64  zqsat=zqsat/(1.-retv *zqsat)
65 c
66  qsat(ip)= zqsat
67 c write(*,*)'qsat=',qsat(ip)
68 
69  enddo
70 c
71  RETURN
72  END