source: LMDZ.3.3/branches/rel-LF/libf/phylmd/calcratqs.F @ 345

Last change on this file since 345 was 304, checked in by lmdzadmin, 23 years ago

Probleme de flag_ratqs en cas d'utilisation de KE FH
LF
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 4.8 KB
Line 
1c $Header$
2      SUBROUTINE calcratqs ( flag_ratqs,
3     I            paprs,pplay,q_seri,d_t_con,d_t_ajs
4     O           ,ratqs,zpt_conv)
5      IMPLICIT none
6c======================================================================
7c
8c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
9c
10c Objet: Moniteur general de la physique du modele
11cAA      Modifications quant aux traceurs :
12cAA                  -  uniformisation des parametrisations ds phytrac
13cAA                  -  stockage des moyennes des champs necessaires
14cAA                     en mode traceur off-line
15c======================================================================
16c    modif   ( P. Le Van ,  12/10/98 )
17c
18c  Arguments:
19c
20c paprs---input-R-pression pour chaque inter-couche (en Pa)
21c pplay---input-R-pression pour le mileu de chaque couche (en Pa)
22c presnivs-input_R_pressions approximat. des milieux couches ( en PA)
23#include "dimensions.h"
24#include "dimphy.h"
25      REAL paprs(klon,klev+1)
26      REAL pplay(klon,klev)
27      REAL d_t_con(klon,klev)
28      REAL d_t_ajs(klon,klev)
29      REAL ratqs(klon,klev)
30      LOGICAL pt_conv(klon,klev)
31      REAL q_seri(klon,klev)
32
33      logical firstcall
34      save firstcall
35      data firstcall/.true./
36
37
38      REAL ratqsmin,ratqsmax,zx,epmax
39      REAL ratqs1,ratqs2,ratqs3,ratqs4
40      REAL ratqsc1,ratqsc2,ratqsc3,ratqsc4
41      INTEGER i,k
42      INTEGER flag_ratqs
43      save ratqsmin,ratqsmax,epmax
44      save ratqs1,ratqs2,ratqs3,ratqs4
45      save ratqsc1,ratqsc2,ratqsc3,ratqsc4
46      real zpt_conv(klon,klev)
47
48      REAL zx_min
49      PARAMETER (zx_min=1.0)
50      REAL zx_max
51      PARAMETER (zx_max=0.1)
52
53        zpt_conv=0.
54c
55c Appeler le processus de condensation a grande echelle
56c et le processus de precipitation
57c
58      if (flag_ratqs.eq.0) then
59
60         ratqsmax=0.01
61         ratqsmin=0.3
62
63         if (firstcall) print*,'RATQS ANCIEN '
64         do k=1,klev
65         do i=1,klon
66            zx = pplay(i,k)/paprs(i,1)
67            zx = (zx_max-zx)/(zx_max-zx_min)
68            zx = MIN(MAX(zx,0.0),1.0)
69            zx = zx * zx * zx
70            ratqs(i,k)= zx * (ratqsmax-ratqsmin) + ratqsmin
71         enddo
72         enddo
73
74      else
75
76c  On aplique un ratqs "interactif" a toutes les mailles affectees
77c  par la convection ou se trouvant "sous" une maille affectee.
78         do i=1,klon
79            pt_conv(i,klev)=.false.
80         enddo
81         do k=klev-1,1,-1
82            do i=1,klon
83               pt_conv(i,k)=pt_conv(i,k+1).or.
84     s               (abs(d_t_con(i,k))+abs(d_t_ajs(i,k))).gt.1.e-8
85               if(pt_conv(i,k)) then
86                  zpt_conv(i,k)=1.
87               else
88                  zpt_conv(i,k)=0.
89               endif
90            enddo
91         enddo
92
93         if (flag_ratqs.eq.1) then
94
95            ratqsmin=0.4
96            ratqsmax=0.99
97            if (firstcall) print*,'RATQS INTERACTIF '
98            do k=1,klev
99                do i=1,klon
100                   if (pt_conv(i,k)) then
101                      ratqs(i,k)=0.01
102     s                +0.25*(q_seri(i,1)-q_seri(i,k))/q_seri(i,k)
103                      ratqs(i,k)=min(ratqs(i,k),ratqsmax)
104                      ratqs(i,k)=max(ratqs(i,k),0.1)
105                   else
106                      ratqs(i,k)=0.01+(ratqsmin-0.01)*
107     s             min((paprs(i,1)-pplay(i,k))/(paprs(i,1)-30000.),1.)
108                   endif
109                enddo
110            enddo
111         else if (flag_ratqs.eq.2) then
112            do k=1,klev
113                do i=1,klon
114                   ratqs(i,k)=0.001+
115     s             (q_seri(i,1)-q_seri(i,k))/q_seri(i,k)
116                   if (pt_conv(i,k)) then
117                      ratqs(i,k)=min(ratqs(i,k),ratqsmax)
118                   else
119                      ratqs(i,k)=min(ratqs(i,k),ratqsmin)
120                   endif
121                enddo
122            enddo
123         else
124            do k=1,klev
125               do i=1,klon
126                  if (pplay(i,k).ge.95000.) then
127                     if (pt_conv(i,k)) then
128                        ratqs(i,k)=ratqsc1
129                     else
130                        ratqs(i,k)=ratqs1
131                     endif
132                  else if (pplay(i,k).ge.75000.) then
133                     if (pt_conv(i,k)) then
134                        ratqs(i,k)=ratqsc2
135                     else
136                        ratqs(i,k)=ratqs2
137                     endif
138                  else if (pplay(i,k).ge.50000.) then
139                     if (pt_conv(i,k)) then
140                        ratqs(i,k)=ratqsc3
141                     else
142                        ratqs(i,k)=ratqs3
143                     endif
144                  else
145                     if (pt_conv(i,k)) then
146                        ratqs(i,k)=ratqsc4
147                     else
148                        ratqs(i,k)=ratqs4
149                     endif
150                  endif
151               enddo
152            enddo
153         endif
154
155      endif
156
157      firstcall=.false.
158
159      return
160      end
Note: See TracBrowser for help on using the repository browser.