source: LMDZ6/trunk/libf/phylmd/calcratqs.F90 @ 3982

Last change on this file since 3982 was 3856, checked in by fhourdin, 4 years ago

Introduction d'un ratqs (largeur relative de la distribution sous maille de l'eau)
interactif (travail de Louis D'Alençon, Frédéric Hourdin et Catherine Rio).
Contrôlé par le flag iflag_ratqs=10 (précédemment 4).
N'affecte pas les calculs si iflag_ratqs=4.
Fredho
  • 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
File size: 6.7 KB
Line 
1SUBROUTINE calcratqs(klon,klev,prt_level,lunout,       &
2           iflag_ratqs,iflag_con,iflag_cld_th,pdtphys, &
3           ratqsbas,ratqshaut,ratqsp0,ratqsdp, &
4           tau_ratqs,fact_cldcon,wake_s, wake_deltaq,   &
5           ptconv,ptconvth,clwcon0th, rnebcon0th,      &
6           paprs,pplay,q_seri,zqsat,fm_therm,          &
7           ratqs,ratqsc,ratqs_inter)
8
9implicit none
10
11!========================================================================
12! Computation of ratqs, the width of the subrid scale water distribution
13! (normalized by the mean value)
14! Various options controled by flags iflag_con and iflag_ratqs
15! F Hourdin 2012/12/06
16!========================================================================
17
18! Declarations
19
20! Input
21integer,intent(in) :: klon,klev,prt_level,lunout
22integer,intent(in) :: iflag_con,iflag_cld_th,iflag_ratqs
23real,intent(in) :: pdtphys,ratqsbas,ratqshaut,fact_cldcon,tau_ratqs
24real,intent(in) :: ratqsp0, ratqsdp
25real, dimension(klon,klev+1),intent(in) :: paprs
26real, dimension(klon,klev),intent(in) :: pplay,q_seri,zqsat,fm_therm
27logical, dimension(klon,klev),intent(in) :: ptconv
28real, dimension(klon,klev),intent(in) :: rnebcon0th,clwcon0th
29real, dimension(klon,klev),intent(in) :: wake_deltaq,wake_s
30! Output
31real, dimension(klon,klev),intent(inout) :: ratqs,ratqsc,ratqs_inter
32logical, dimension(klon,klev),intent(inout) :: ptconvth
33
34! local
35integer i,k
36real, dimension(klon,klev) :: ratqss
37real facteur,zfratqs1,zfratqs2
38
39!-------------------------------------------------------------------------
40!  Caclul des ratqs
41!-------------------------------------------------------------------------
42
43!      print*,'calcul des ratqs'
44!   ratqs convectifs a l'ancienne en fonction de q(z=0)-q / q
45!   ----------------
46!   on ecrase le tableau ratqsc calcule par clouds_gno
47      if (iflag_cld_th.eq.1) then
48         do k=1,klev
49         do i=1,klon
50            if(ptconv(i,k)) then
51              ratqsc(i,k)=ratqsbas &
52              +fact_cldcon*(q_seri(i,1)-q_seri(i,k))/q_seri(i,k)
53            else
54               ratqsc(i,k)=0.
55            endif
56         enddo
57         enddo
58
59!-----------------------------------------------------------------------
60!  par nversion de la fonction log normale
61!-----------------------------------------------------------------------
62      else if (iflag_cld_th.eq.4) then
63         ptconvth(:,:)=.false.
64         ratqsc(:,:)=0.
65         if(prt_level.ge.9) print*,'avant clouds_gno thermique'
66         call clouds_gno &
67         (klon,klev,q_seri,zqsat,clwcon0th,ptconvth,ratqsc,rnebcon0th)
68         if(prt_level.ge.9) print*,' CLOUDS_GNO OK'
69       
70       endif
71
72!   ratqs stables
73!   -------------
74
75      if (iflag_ratqs.eq.0) then
76
77! Le cas iflag_ratqs=0 correspond a la version IPCC 2005 du modele.
78         do k=1,klev
79            do i=1, klon
80               ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)* &
81               min((paprs(i,1)-pplay(i,k))/(paprs(i,1)-30000.),1.)
82            enddo
83         enddo
84
85! Pour iflag_ratqs=1 ou 2, le ratqs est constant au dessus de
86! 300 hPa (ratqshaut), varie lineariement en fonction de la pression
87! entre 600 et 300 hPa et est soit constant (ratqsbas) pour iflag_ratqs=1
88! soit lineaire (entre 0 a la surface et ratqsbas) pour iflag_ratqs=2
89! Il s'agit de differents tests dans la phase de reglage du modele
90! avec thermiques.
91
92      else if (iflag_ratqs.eq.1) then
93
94         do k=1,klev
95            do i=1, klon
96               if (pplay(i,k).ge.60000.) then
97                  ratqss(i,k)=ratqsbas
98               else if ((pplay(i,k).ge.30000.).and.(pplay(i,k).lt.60000.)) then
99                  ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)*(60000.-pplay(i,k))/(60000.-30000.)
100               else
101                  ratqss(i,k)=ratqshaut
102               endif
103            enddo
104         enddo
105
106      else if (iflag_ratqs.eq.2) then
107
108         do k=1,klev
109            do i=1, klon
110               if (pplay(i,k).ge.60000.) then
111                  ratqss(i,k)=ratqsbas*(paprs(i,1)-pplay(i,k))/(paprs(i,1)-60000.)
112               else if ((pplay(i,k).ge.30000.).and.(pplay(i,k).lt.60000.)) then
113                    ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)*(60000.-pplay(i,k))/(60000.-30000.)
114               else
115                    ratqss(i,k)=ratqshaut
116               endif
117            enddo
118         enddo
119
120      else if (iflag_ratqs==3) then
121         do k=1,klev
122           ratqss(:,k)=ratqsbas+(ratqshaut-ratqsbas) &
123           *min( ((paprs(:,1)-pplay(:,k))/70000.)**2 , 1. )
124         enddo
125
126      else if (iflag_ratqs==4) then
127         do k=1,klev
128           ratqss(:,k)=ratqsbas+0.5*(ratqshaut-ratqsbas) &
129!          *( tanh( (50000.-pplay(:,k))/20000.) + 1.)
130           *( tanh( (ratqsp0-pplay(:,k))/ratqsdp) + 1.)
131         enddo
132
133      else if (iflag_ratqs==10) then ! ratqs interactif dépendant de la présence de poches froides
134         call calcratqs_inter(klon,klev,pdtphys,ratqsbas,wake_deltaq,wake_s,q_seri,ratqs_inter)
135         do k=1,klev
136            do i=1, klon
137                ratqss(i,k)=ratqs_inter(i,k)+0.5*(ratqshaut-ratqs_inter(i,k)) &
138                *( tanh( (ratqsp0-pplay(i,k))/ratqsdp) + 1.)
139            enddo
140         enddo
141
142      endif
143
144
145!  ratqs final
146!  -----------
147
148      if (iflag_cld_th.eq.1 .or.iflag_cld_th.eq.2.or.iflag_cld_th.eq.4) then
149
150! On ajoute une constante au ratqsc*2 pour tenir compte de
151! fluctuations turbulentes de petite echelle
152
153         do k=1,klev
154            do i=1,klon
155               if ((fm_therm(i,k).gt.1.e-10)) then
156                  ratqsc(i,k)=sqrt(ratqsc(i,k)**2+0.05**2)
157               endif
158            enddo
159         enddo
160
161!   les ratqs sont une combinaison de ratqss et ratqsc
162       if(prt_level.ge.9) write(lunout,*)'PHYLMD NOUVEAU TAU_RATQS ',tau_ratqs
163
164         if (tau_ratqs>1.e-10) then
165            facteur=exp(-pdtphys/tau_ratqs)
166         else
167            facteur=0.
168         endif
169         ratqs(:,:)=ratqsc(:,:)*(1.-facteur)+ratqs(:,:)*facteur
170!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
171! FH 22/09/2009
172! La ligne ci-dessous faisait osciller le modele et donnait une solution
173! assymptotique bidon et dépendant fortement du pas de temps.
174!        ratqs(:,:)=sqrt(ratqs(:,:)**2+ratqss(:,:)**2)
175!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
176         ratqs(:,:)=max(ratqs(:,:),ratqss(:,:))
177      else if (iflag_cld_th<=6) then
178!   on ne prend que le ratqs stable pour fisrtilp
179         ratqs(:,:)=ratqss(:,:)
180      else
181          zfratqs1=exp(-pdtphys/10800.)
182          zfratqs2=exp(-pdtphys/10800.)
183          do k=1,klev
184             do i=1,klon
185                if (ratqsc(i,k).gt.1.e-10) then
186                   ratqs(i,k)=ratqs(i,k)*zfratqs2+(iflag_cld_th/100.)*ratqsc(i,k)*(1.-zfratqs2)
187                endif
188                ratqs(i,k)=min(ratqs(i,k)*zfratqs1+ratqss(i,k)*(1.-zfratqs1),0.5)
189             enddo
190          enddo
191      endif
192
193
194return
195end
Note: See TracBrowser for help on using the repository browser.