source: LMDZ5/branches/LF-private/libf/phylmd/calcratqs.F90 @ 3839

Last change on this file since 3839 was 1689, checked in by Laurent Fairhead, 12 years ago

Nettoyage du moniteur de la physique


Cleaning up the physics controler

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