source: LMDZ4/branches/IPSL-CM4_IPCC_patches/libf/phylmd/calcratqs.F @ 581

Last change on this file since 581 was 524, checked in by lmdzadmin, 21 years ago

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