source: LMDZ4/trunk/libf/dyn3dpar/q_sat.F @ 4596

Last change on this file since 4596 was 774, checked in by Laurent Fairhead, 17 years ago

Suite du merge entre la version et la HEAD: quelques modifications de
Yann sur le

LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 1.6 KB
RevLine 
[630]1!
2! $Header$
3!
4c
5c
6
7      subroutine q_sat(np,temp,pres,qsat)
8c
9      IMPLICIT none
10c======================================================================
11c Autheur(s): Z.X. Li (LMD/CNRS)
12c  reecriture vectorisee par F. Hourdin.
13c Objet: calculer la vapeur d'eau saturante (formule Centre Euro.)
14c======================================================================
15c Arguments:
16c kelvin---input-R: temperature en Kelvin
17c millibar--input-R: pression en mb
18c
19c q_sat----output-R: vapeur d'eau saturante en kg/kg
20c======================================================================
21c
22      integer np
23      REAL temp(np),pres(np),qsat(np)
24c
25      REAL r2es
26      PARAMETER (r2es=611.14 *18.0153/28.9644)
27c
28      REAL r3les, r3ies, r3es
29      PARAMETER (R3LES=17.269)
30      PARAMETER (R3IES=21.875)
31c
32      REAL r4les, r4ies, r4es
33      PARAMETER (R4LES=35.86)
34      PARAMETER (R4IES=7.66)
35c
36      REAL rtt
37      PARAMETER (rtt=273.16)
38c
39      REAL retv
40      PARAMETER (retv=28.9644/18.0153 - 1.0)
41
42      real zqsat
43      integer ip
44c
45C     ------------------------------------------------------------------
46c
47c
48
49      do ip=1,np
50
51c      write(*,*)'kelvin,millibar=',kelvin,millibar
52c       write(*,*)'temp,pres=',temp(ip),pres(ip)
53c
54         IF (temp(ip) .LE. rtt) THEN
55            r3es = r3ies
56            r4es = r4ies
57         ELSE
58            r3es = r3les
59            r4es = r4les
60         ENDIF
61c
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)
65c
66         qsat(ip)= zqsat
67c      write(*,*)'qsat=',qsat(ip)
68
69      enddo
70c
71      RETURN
72      END
Note: See TracBrowser for help on using the repository browser.