source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/calcratqs.F90 @ 4934

Last change on this file since 4934 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
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

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.

  • 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.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.