[4437] | 1 | SUBROUTINE thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,eup,dup,edn,ddn,masse,trac,dtrac) |
---|
[4351] | 2 | |
---|
[4437] | 3 | USE thermcell_ini_mod, ONLY: iflag_thermals_down |
---|
| 4 | |
---|
| 5 | |
---|
[4383] | 6 | !----------------------------------------------------------------- |
---|
| 7 | ! thermcell_updown_dq: computes the tendency of tracers associated |
---|
| 8 | ! with the presence of convective up/down drafts |
---|
| 9 | ! This routine that has been collectively written during the |
---|
| 10 | ! "ateliers downdrafts" in 2022/2023 |
---|
| 11 | ! Maelle, Frédéric, Catherine, Fleur, Florent, Etienne |
---|
| 12 | !------------------------------------------------------------------ |
---|
[4351] | 13 | |
---|
| 14 | |
---|
[4365] | 15 | IMPLICIT NONE |
---|
| 16 | |
---|
[4383] | 17 | ! declarations |
---|
| 18 | !============================================================== |
---|
[4365] | 19 | |
---|
[4383] | 20 | ! input/output |
---|
[4365] | 21 | |
---|
[4383] | 22 | integer,intent(in) :: ngrid ! number of horizontal grid points |
---|
| 23 | integer, intent(in) :: nlay ! number of vertical layers |
---|
| 24 | real,intent(in) :: ptimestep ! time step of the physics [s] |
---|
| 25 | real,intent(in), dimension(ngrid,nlay) :: eup ! entrainment to updrafts * dz [same unit as flux] |
---|
| 26 | real,intent(in), dimension(ngrid,nlay) :: dup ! detrainment from updrafts * dz [same unit as flux] |
---|
| 27 | real,intent(in), dimension(ngrid,nlay) :: edn ! entrainment to downdrafts * dz [same unit as flux] |
---|
| 28 | real,intent(in), dimension(ngrid,nlay) :: ddn ! detrainment from downdrafts * dz [same unit as flux] |
---|
| 29 | real,intent(in), dimension(ngrid,nlay) :: masse ! mass of layers = rho dz |
---|
[4396] | 30 | real,intent(in), dimension(ngrid,nlay) :: trac ! tracer |
---|
[4383] | 31 | integer, intent(in), dimension(ngrid) :: lmax ! max level index at which downdraft are present |
---|
[4396] | 32 | real,intent(out),dimension(ngrid,nlay) ::dtrac ! tendance du traceur |
---|
[4383] | 33 | |
---|
[4365] | 34 | |
---|
| 35 | ! Local |
---|
| 36 | |
---|
[4437] | 37 | real, dimension(ngrid,nlay+1) :: fup,fdn,fc,fthu,fthd,fthe,fthtot |
---|
| 38 | real, dimension(ngrid,nlay) :: tracu,tracd,traci,tracold |
---|
| 39 | real :: www, mstar_inv |
---|
[4365] | 40 | integer ig,ilay |
---|
[4437] | 41 | real, dimension(ngrid,nlay):: s1,s2,num !coefficients pour la resolution implicite |
---|
| 42 | integer :: iflag_impl=1 ! 0 pour explicite, 1 pour implicite "classique", 2 pour implicite avec entrainement et detrainement |
---|
| 43 | |
---|
[4365] | 44 | fdn(:,:)=0. |
---|
[4377] | 45 | fup(:,:)=0. |
---|
[4437] | 46 | fc(:,:)=0. |
---|
[4377] | 47 | fthu(:,:)=0. |
---|
| 48 | fthd(:,:)=0. |
---|
| 49 | fthe(:,:)=0. |
---|
| 50 | fthtot(:,:)=0. |
---|
[4383] | 51 | tracd(:,:)=0. |
---|
| 52 | tracu(:,:)=0. |
---|
[4437] | 53 | traci(:,:)=trac(:,:) |
---|
| 54 | tracold(:,:)=trac(:,:) |
---|
| 55 | s1(:,:)=0. |
---|
| 56 | s2(:,:)=0. |
---|
| 57 | num(:,:)=1. |
---|
[4365] | 58 | |
---|
[4437] | 59 | if ( iflag_thermals_down < 10 ) then |
---|
| 60 | stop 'thermcell_down_dq = 0 or >= 10' |
---|
| 61 | else |
---|
| 62 | iflag_impl=iflag_thermals_down-10 |
---|
| 63 | endif |
---|
| 64 | |
---|
| 65 | |
---|
[4365] | 66 | ! lmax : indice tel que fu(kmax+1)=0 |
---|
| 67 | |
---|
[4383] | 68 | ! Dans ce cas, pas besoin d'initialiser tracd(lmax) ( =trac(lmax) ) |
---|
[4365] | 69 | |
---|
[4377] | 70 | print*,'ON PASSE BIEN PAR LA CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' |
---|
| 71 | ! Boucle pour le downdraft |
---|
[4365] | 72 | do ilay=nlay,1,-1 |
---|
| 73 | do ig=1,ngrid |
---|
[4377] | 74 | if (ilay.le.lmax(ig) .and. lmax(ig)>1) then |
---|
[4365] | 75 | fdn(ig,ilay)=fdn(ig,ilay+1)+edn(ig,ilay)-ddn(ig,ilay) |
---|
[4377] | 76 | if ( 1 == 0 ) then |
---|
[4383] | 77 | tracd(ig,ilay)=( fdn(ig,ilay+1)*tracd(ig,ilay+1) + edn(ig,ilay)*trac(ig,ilay) ) / (fdn(ig,ilay)+ddn(ig,ilay)) |
---|
[4377] | 78 | else |
---|
| 79 | www=fdn(ig,ilay+1)/ (fdn(ig,ilay)+ddn(ig,ilay)) |
---|
[4383] | 80 | tracd(ig,ilay)=www*tracd(ig,ilay+1) + (1.-www)*trac(ig,ilay) |
---|
[4377] | 81 | endif |
---|
[4365] | 82 | endif |
---|
| 83 | enddo |
---|
[4437] | 84 | enddo !Fin boucle sur l'updraft |
---|
| 85 | fdn(:,1)=0. |
---|
[4365] | 86 | |
---|
[4377] | 87 | !Boucle pour l'updraft |
---|
| 88 | do ilay=1,nlay,1 |
---|
| 89 | do ig=1,ngrid |
---|
[4396] | 90 | if (ilay.lt.lmax(ig) .and. lmax(ig)>1) then |
---|
[4377] | 91 | fup(ig,ilay+1)=fup(ig,ilay)+eup(ig,ilay)-dup(ig,ilay) |
---|
| 92 | if (ilay == 1 ) then |
---|
[4383] | 93 | tracu(ig,ilay)=trac(ig,ilay) |
---|
[4377] | 94 | else |
---|
[4383] | 95 | !tracu(ig,ilay)=( fup(ig,ilay)*tracu(ig,ilay-1) + eup(ig,ilay)*trac(ig,ilay) ) / (fup(ig,ilay+1)+dup(ig,ilay)) |
---|
[4377] | 96 | !eup(ig,ilay)=fup(ig,ilay+1)-fup(ig,ilay)+dup(ig,ilay) |
---|
[4383] | 97 | !tracu(ig,ilay)=( fup(ig,ilay)*tracu(ig,ilay-1) + (fup(ig,ilay+1)-fup(ig,ilay)+dup(ig,ilay))*trac(ig,ilay) ) / (fup(ig,ilay+1)+dup(ig,ilay)) |
---|
[4377] | 98 | www=fup(ig,ilay)/(fup(ig,ilay+1)+dup(ig,ilay)) |
---|
| 99 | !1-www=(fup(ig,ilay+1)+dup(ig,ilay)-fup(ig,ilay))/(fup(ig,ilay+1)+dup(ig,ilay)) |
---|
[4383] | 100 | tracu(ig,ilay)=www*tracu(ig,ilay-1)+(1.-www)*trac(ig,ilay) |
---|
[4377] | 101 | endif |
---|
| 102 | endif |
---|
| 103 | enddo |
---|
[4437] | 104 | enddo !fin boucle sur le downdraft |
---|
| 105 | |
---|
| 106 | ! Calcul des flux des traceurs dans les updraft et les downdrfat |
---|
| 107 | ! et du flux de masse compensateur |
---|
| 108 | ! en ilay=1 et nlay+1, fthu=0 et fthd=0 |
---|
| 109 | fthu(:,1)=0. |
---|
| 110 | fthu(:,nlay+1)=0. |
---|
| 111 | fthd(:,1)=0. |
---|
| 112 | fthd(:,nlay+1)=0. |
---|
| 113 | fc(:,1)=0. |
---|
| 114 | fc(:,nlay+1)=0. |
---|
| 115 | do ilay=2,nlay,1 !boucle sur les interfaces |
---|
[4377] | 116 | do ig=1,ngrid |
---|
[4383] | 117 | fthu(ig,ilay)=fup(ig,ilay)*tracu(ig,ilay-1) |
---|
| 118 | fthd(ig,ilay)=-fdn(ig,ilay)*tracd(ig,ilay) |
---|
[4437] | 119 | fc(ig,ilay)=fup(ig,ilay)-fdn(ig,ilay) |
---|
[4377] | 120 | enddo |
---|
| 121 | enddo |
---|
[4437] | 122 | |
---|
| 123 | |
---|
| 124 | !Boucle pour calculer le flux du traceur flux updraft, flux downdraft, flux compensatoire |
---|
| 125 | !Methode explicite : |
---|
| 126 | if(iflag_impl==0) then |
---|
| 127 | do ilay=2,nlay,1 |
---|
| 128 | do ig=1,ngrid |
---|
| 129 | !!!!ATTENTION HYPOTHESE de FLUX COMPENSATOIRE DESCENDANT ET DONC comme schema amont on va chercher trac au dessus!!!!! |
---|
| 130 | !!!! tentative de prise en compte d'un flux compensatoire montant !!!! |
---|
| 131 | if (fup(ig,ilay)-fdn(ig,ilay) .lt. 0.) then |
---|
| 132 | write(*,*) 'flux compensatoire montant, cas non traite par thermcell_updown_dq' |
---|
| 133 | stop |
---|
| 134 | !fthe(ig,ilay)=(fup(ig,ilay)-fdn(ig,ilay))*trac(ig,ilay-1) |
---|
| 135 | else |
---|
| 136 | fthe(ig,ilay)=-(fup(ig,ilay)-fdn(ig,ilay))*trac(ig,ilay) |
---|
| 137 | endif |
---|
| 138 | !! si on voulait le prendre en compte on |
---|
| 139 | !fthe(ig,ilay)=-(fup(ig,ilay)-fdn(ig,ilay))*trac(ig,ilay-1) |
---|
| 140 | fthtot(ig,ilay)=fthu(ig,ilay)+fthd(ig,ilay)+fthe(ig,ilay) |
---|
| 141 | enddo |
---|
[4377] | 142 | enddo |
---|
[4437] | 143 | !Boucle pour calculer trac |
---|
| 144 | do ilay=1,nlay |
---|
| 145 | do ig=1,ngrid |
---|
| 146 | dtrac(ig,ilay)=(fthtot(ig,ilay)-fthtot(ig,ilay+1))/masse(ig,ilay) |
---|
| 147 | ! trac(ig,ilay)=trac(ig,ilay) + (fthtot(ig,ilay)-fthtot(ig,ilay+1))*(ptimestep/masse(ig,ilay)) |
---|
| 148 | enddo |
---|
| 149 | enddo !fin du calculer de la tendance du traceur avec la methode explicite |
---|
[4365] | 150 | |
---|
[4437] | 151 | !!! Reecriture du schéma explicite avec les notations du schéma implicite |
---|
| 152 | else if(iflag_impl==-1) then |
---|
| 153 | write(*,*) 'nouveau schéma explicite !!!' |
---|
| 154 | !!! Calcul de s1 |
---|
| 155 | do ilay=1,nlay |
---|
| 156 | do ig=1,ngrid |
---|
| 157 | s1(ig,ilay)=fthu(ig,ilay)-fthu(ig,ilay+1)+fthd(ig,ilay)-fthd(ig,ilay+1) |
---|
| 158 | s2(ig,ilay)=s1(ig,ilay)+fthe(ig,ilay)-fthe(ig,ilay+1) |
---|
| 159 | enddo |
---|
| 160 | enddo |
---|
[4365] | 161 | |
---|
[4437] | 162 | do ilay=2,nlay,1 |
---|
| 163 | do ig=1,ngrid |
---|
| 164 | if (fup(ig,ilay)-fdn(ig,ilay) .lt. 0.) then |
---|
| 165 | write(*,*) 'flux compensatoire montant, cas non traite par thermcell_updown_dq' |
---|
| 166 | stop |
---|
| 167 | else |
---|
| 168 | fthe(ig,ilay)=-(fup(ig,ilay)-fdn(ig,ilay))*trac(ig,ilay) |
---|
| 169 | endif |
---|
| 170 | fthtot(ig,ilay)=fthu(ig,ilay)+fthd(ig,ilay)+fthe(ig,ilay) |
---|
| 171 | enddo |
---|
| 172 | enddo |
---|
| 173 | !Boucle pour calculer trac |
---|
| 174 | do ilay=1,nlay |
---|
| 175 | do ig=1,ngrid |
---|
| 176 | ! dtrac(ig,ilay)=(fthtot(ig,ilay)-fthtot(ig,ilay+1))/masse(ig,ilay) |
---|
| 177 | dtrac(ig,ilay)=(s1(ig,ilay)+fthe(ig,ilay)-fthe(ig,ilay+1))/masse(ig,ilay) |
---|
| 178 | ! trac(ig,ilay)=trac(ig,ilay) + (fthtot(ig,ilay)-fthtot(ig,ilay+1))*(ptimestep/masse(ig,ilay)) |
---|
| 179 | ! trac(ig,ilay)=trac(ig,ilay) + (s1(ig,ilay)+fthe(ig,ilay)-fthe(ig,ilay+1))*(ptimestep/masse(ig,ilay)) |
---|
| 180 | enddo |
---|
| 181 | enddo !fin du calculer de la tendance du traceur avec la methode explicite |
---|
[4377] | 182 | |
---|
[4437] | 183 | else if (iflag_impl==1) then |
---|
| 184 | write(*,*) 'SCHEMA IMPLICITE EN COURS DE DEVELOPPEMENT !' |
---|
| 185 | do ilay=1,nlay |
---|
| 186 | do ig=1,ngrid |
---|
| 187 | s1(ig,ilay)=fthu(ig,ilay)-fthu(ig,ilay+1)+fthd(ig,ilay)-fthd(ig,ilay+1) |
---|
| 188 | enddo |
---|
| 189 | enddo |
---|
| 190 | |
---|
| 191 | !Boucle pour calculer traci = trac((t+dt) |
---|
| 192 | do ilay=nlay-1,1,-1 |
---|
| 193 | do ig=1,ngrid |
---|
| 194 | if((fup(ig,ilay)-fdn(ig,ilay)) .lt. 0) then |
---|
| 195 | write(*,*) 'flux compensatoire montant, cas non traite par thermcell_updown_dq dans le cas d une resolution implicite, ilay : ', ilay |
---|
| 196 | stop |
---|
| 197 | else |
---|
| 198 | mstar_inv=ptimestep/masse(ig,ilay) |
---|
| 199 | traci(ig,ilay)=((traci(ig,ilay+1)*fc(ig,ilay+1)+s1(ig,ilay))*mstar_inv+tracold(ig,ilay))/(1.+fc(ig,ilay)*mstar_inv) |
---|
| 200 | endif |
---|
| 201 | enddo |
---|
| 202 | enddo |
---|
| 203 | do ilay=1,nlay |
---|
| 204 | do ig=1,ngrid |
---|
| 205 | dtrac(ig,ilay)=(traci(ig,ilay)-tracold(ig,ilay))/ptimestep |
---|
| 206 | enddo |
---|
| 207 | enddo |
---|
[4377] | 208 | |
---|
[4437] | 209 | else |
---|
| 210 | write(*,*) 'valeur de iflag_impl non prevue' |
---|
| 211 | stop |
---|
[4377] | 212 | |
---|
[4437] | 213 | endif |
---|
[4377] | 214 | |
---|
[4365] | 215 | RETURN |
---|
| 216 | END |
---|
| 217 | |
---|
| 218 | !========================================================================= |
---|
| 219 | |
---|
| 220 | SUBROUTINE thermcell_down(ngrid,nlay,po,pt,pu,pv,pplay,pplev, & |
---|
| 221 | & lmax,fup,eup,dup,theta) |
---|
| 222 | |
---|
| 223 | !-------------------------------------------------------------- |
---|
[4377] | 224 | !thermcell_down: calcul des propri??t??s du panache descendant. |
---|
[4365] | 225 | !-------------------------------------------------------------- |
---|
| 226 | |
---|
| 227 | |
---|
[4351] | 228 | USE thermcell_ini_mod, ONLY : prt_level,RLvCp,RKAPPA,RETV |
---|
| 229 | IMPLICIT NONE |
---|
| 230 | |
---|
| 231 | ! arguments |
---|
| 232 | |
---|
| 233 | integer,intent(in) :: ngrid,nlay |
---|
[4365] | 234 | real,intent(in), dimension(ngrid,nlay) :: po,pt,pu,pv,pplay,eup,dup |
---|
| 235 | real,intent(in), dimension(ngrid,nlay) :: theta |
---|
[4351] | 236 | real,intent(in), dimension(ngrid,nlay+1) :: pplev,fup |
---|
| 237 | integer, intent(in), dimension(ngrid) :: lmax |
---|
| 238 | |
---|
| 239 | |
---|
| 240 | |
---|
| 241 | ! Local |
---|
| 242 | |
---|
[4365] | 243 | real, dimension(ngrid,nlay) :: edn,ddn,thetad |
---|
[4351] | 244 | real, dimension(ngrid,nlay+1) :: fdn |
---|
| 245 | |
---|
| 246 | integer ig,ilay |
---|
| 247 | real dqsat_dT |
---|
| 248 | logical mask(ngrid,nlay) |
---|
| 249 | |
---|
| 250 | edn(:,:)=0. |
---|
| 251 | ddn(:,:)=0. |
---|
| 252 | fdn(:,:)=0. |
---|
[4365] | 253 | thetad(:,:)=0. |
---|
[4351] | 254 | |
---|
[4365] | 255 | ! lmax : indice tel que fu(kmax+1)=0 |
---|
[4351] | 256 | |
---|
[4365] | 257 | ! Dans ce cas, pas besoin d'initialiser thetad(lmax) ( =theta(lmax) ) |
---|
[4351] | 258 | |
---|
[4365] | 259 | ! FH MODIFS APRES REUNIONS POUR COMMISSIONS |
---|
| 260 | ! quelques erreurs de declaration |
---|
[4377] | 261 | ! probleme si lmax=1 ce qui a l'air d'??tre le cas en d??but de simu. Devrait ??tre 0 ? |
---|
[4365] | 262 | ! Remarques : |
---|
[4377] | 263 | ! on pourrait ??crire la formule de thetad |
---|
[4365] | 264 | ! www=fdn(ig,ilay+1)/ (fdn(ig,ilay)+ddn(ig,ilay)) |
---|
| 265 | ! thetad(ig,ilay)= www * thetad(ig,ilay+1) + (1.-www) * theta(ig,ilay) |
---|
[4377] | 266 | ! Elle a l'avantage de bien montr?? la conservation, l'id??e fondamentale dans le |
---|
[4365] | 267 | ! transport qu'on ne fait que sommer des "sources" au travers d'un "propagateur" |
---|
| 268 | ! (Green) |
---|
[4377] | 269 | ! Elle montre aussi beaucoup plus clairement pourquoi on n'a pas ?? se souccier (trop) |
---|
| 270 | ! de la possible nulit?? du d??nominateur |
---|
[4365] | 271 | |
---|
| 272 | |
---|
| 273 | do ilay=nlay,1,-1 |
---|
[4351] | 274 | do ig=1,ngrid |
---|
[4365] | 275 | if (ilay.le.lmax(ig).and.lmax(ig)>1) then |
---|
| 276 | edn(ig,ilay)=0.5*dup(ig,ilay) |
---|
| 277 | ddn(ig,ilay)=0.5*eup(ig,ilay) |
---|
| 278 | fdn(ig,ilay)=fdn(ig,ilay+1)+edn(ig,ilay)-ddn(ig,ilay) |
---|
| 279 | thetad(ig,ilay)=( fdn(ig,ilay+1)*thetad(ig,ilay+1) + edn(ig,ilay)*theta(ig,ilay) ) / (fdn(ig,ilay)+ddn(ig,ilay)) |
---|
[4351] | 280 | endif |
---|
| 281 | enddo |
---|
| 282 | enddo |
---|
| 283 | |
---|
| 284 | ! Suite du travail : |
---|
| 285 | ! Ecrire la conservervation de theta_l dans le panache descendant |
---|
| 286 | ! Eventuellement faire la transformation theta_l -> theta_v |
---|
[4377] | 287 | ! Si l'air est sec (et qu'on oublie le c??t?? theta_v) on peut |
---|
[4351] | 288 | ! se contenter de conserver theta. |
---|
| 289 | ! |
---|
[4377] | 290 | ! Connaissant thetadn, on peut calculer la flotabilit??. |
---|
| 291 | ! Connaissant la flotabilit??, on peut calculer w de proche en proche |
---|
| 292 | ! On peut calculer le detrainement de facon ?? garder alpha*rho = cste |
---|
| 293 | ! On en d??duit l'entrainement lat??ral |
---|
| 294 | ! C'est le mod??le des mini-projets. |
---|
[4351] | 295 | |
---|
| 296 | !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ |
---|
| 297 | ! Initialisations : |
---|
| 298 | !------------------ |
---|
| 299 | |
---|
| 300 | |
---|
| 301 | ! |
---|
| 302 | RETURN |
---|
| 303 | END |
---|