source: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/calcratqs.F @ 4798

Last change on this file since 4798 was 634, checked in by Laurent Fairhead, 20 years ago

Modifications faites à la physique pour la rendre parallele YM
Une branche de travail LMDZ4_par_0 a été créée provisoirement afin de tester
les modifs pleinement avant leurs inclusions dans le tronc principal
LF
  • 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      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./
39
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
49      real zpt_conv(klon,klev)
50
51      REAL zx_min
52      PARAMETER (zx_min=1.0)
53      REAL zx_max
54      PARAMETER (zx_max=0.1)
55
56        zpt_conv=0.
57c
58c Appeler le processus de condensation a grande echelle
59c et le processus de precipitation
60c
61      if (flag_ratqs.eq.0) then
62
63         ratqsmax=0.01
64         ratqsmin=0.3
65
66         if (firstcall) print*,'RATQS ANCIEN '
67         do k=1,klev
68         do i=1,klon
69            zx = pplay(i,k)/paprs(i,1)
70            zx = (zx_max-zx)/(zx_max-zx_min)
71            zx = MIN(MAX(zx,0.0),1.0)
72            zx = zx * zx * zx
73            ratqs(i,k)= zx * (ratqsmax-ratqsmin) + ratqsmin
74         enddo
75         enddo
76
77      else
78
79c  On aplique un ratqs "interactif" a toutes les mailles affectees
80c  par la convection ou se trouvant "sous" une maille affectee.
81         do i=1,klon
82            pt_conv(i,klev)=.false.
83         enddo
84         do k=klev-1,1,-1
85            do i=1,klon
86               pt_conv(i,k)=pt_conv(i,k+1).or.
87     s               (abs(d_t_con(i,k))+abs(d_t_ajs(i,k))).gt.1.e-8
88               if(pt_conv(i,k)) then
89                  zpt_conv(i,k)=1.
90               else
91                  zpt_conv(i,k)=0.
92               endif
93            enddo
94         enddo
95
96         if (flag_ratqs.eq.1) then
97
98            ratqsmin=0.4
99            ratqsmax=0.99
100            if (firstcall) print*,'RATQS INTERACTIF '
101            do k=1,klev
102                do i=1,klon
103                   if (pt_conv(i,k)) then
104                      ratqs(i,k)=0.01
105     s                +1.5*0.25*(q_seri(i,1)-q_seri(i,k))/q_seri(i,k)
106                      ratqs(i,k)=min(ratqs(i,k),ratqsmax)
107                      ratqs(i,k)=max(ratqs(i,k),0.1)
108                   else
109                      ratqs(i,k)=0.01+(ratqsmin-0.01)*
110     s             min((paprs(i,1)-pplay(i,k))/(paprs(i,1)-30000.),1.)
111                   endif
112                enddo
113            enddo
114         else if (flag_ratqs.eq.2) then
115            do k=1,klev
116                do i=1,klon
117                   ratqs(i,k)=0.001+
118     s             (q_seri(i,1)-q_seri(i,k))/q_seri(i,k)
119                   if (pt_conv(i,k)) then
120                      ratqs(i,k)=min(ratqs(i,k),ratqsmax)
121                   else
122                      ratqs(i,k)=min(ratqs(i,k),ratqsmin)
123                   endif
124                enddo
125            enddo
126         else
127            do k=1,klev
128               do i=1,klon
129                  if (pplay(i,k).ge.95000.) then
130                     if (pt_conv(i,k)) then
131                        ratqs(i,k)=ratqsc1
132                     else
133                        ratqs(i,k)=ratqs1
134                     endif
135                  else if (pplay(i,k).ge.75000.) then
136                     if (pt_conv(i,k)) then
137                        ratqs(i,k)=ratqsc2
138                     else
139                        ratqs(i,k)=ratqs2
140                     endif
141                  else if (pplay(i,k).ge.50000.) then
142                     if (pt_conv(i,k)) then
143                        ratqs(i,k)=ratqsc3
144                     else
145                        ratqs(i,k)=ratqs3
146                     endif
147                  else
148                     if (pt_conv(i,k)) then
149                        ratqs(i,k)=ratqsc4
150                     else
151                        ratqs(i,k)=ratqs4
152                     endif
153                  endif
154               enddo
155            enddo
156         endif
157
158      endif
159
160      firstcall=.false.
161
162      return
163      end
Note: See TracBrowser for help on using the repository browser.