GCC Code Coverage Report


Directory: ./
File: phys/calcratqs.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 17 66 25.8%
Branches: 17 102 16.7%

Line Branch Exec Source
1 480 SUBROUTINE 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 480 ptconv,ptconvth,clwcon0th, rnebcon0th, &
6 paprs,pplay,q_seri,zqsat,fm_therm, &
7 480 ratqs,ratqsc,ratqs_inter)
8
9 implicit 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
21 integer,intent(in) :: klon,klev,prt_level,lunout
22 integer,intent(in) :: iflag_con,iflag_cld_th,iflag_ratqs
23 real,intent(in) :: pdtphys,ratqsbas,ratqshaut,fact_cldcon,tau_ratqs
24 real,intent(in) :: ratqsp0, ratqsdp
25 real, dimension(klon,klev+1),intent(in) :: paprs
26 real, dimension(klon,klev),intent(in) :: pplay,q_seri,zqsat,fm_therm
27 logical, dimension(klon,klev),intent(in) :: ptconv
28 real, dimension(klon,klev),intent(in) :: rnebcon0th,clwcon0th
29 real, dimension(klon,klev),intent(in) :: wake_deltaq,wake_s
30 ! Output
31 real, dimension(klon,klev),intent(inout) :: ratqs,ratqsc,ratqs_inter
32 logical, dimension(klon,klev),intent(inout) :: ptconvth
33
34 ! local
35 integer i,k
36 960 real, dimension(klon,klev) :: ratqss
37 real 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
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 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
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 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
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 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
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 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
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 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
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 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
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 else if (iflag_ratqs==4) then
127
2/2
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 18720 times.
19200 do k=1,klev
128 ratqss(:,k)=ratqsbas+0.5*(ratqshaut-ratqsbas) &
129 ! *( tanh( (50000.-pplay(:,k))/20000.) + 1.)
130
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 *( 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
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 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
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 else if (iflag_cld_th<=6) then
178 ! on ne prend que le ratqs stable pour fisrtilp
179
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
18626880 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
194 480 return
195 end
196