source: LMDZ4/trunk/libf/phytherm/calcratqs.F @ 1053

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

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