source: LMDZ6/trunk/libf/misc/q_sat.f90 @ 5442

Last change on this file since 5442 was 5246, checked in by abarral, 2 months ago

Convert fixed-form to free-form sources .F -> .{f,F}90
(WIP: some .F remain, will be handled in subsequent commits)

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