| Directory: | ./ |
|---|---|
| File: | phys/thermcell_dry.f90 |
| Date: | 2022-01-11 19:19:34 |
| Exec | Total | Coverage | |
|---|---|---|---|
| Lines: | 57 | 63 | 90.5% |
| Branches: | 51 | 54 | 94.4% |
| Line | Branch | Exec | Source |
|---|---|---|---|
| 1 | ! | ||
| 2 | ! $Id: thermcell_dry.F90 2311 2015-06-25 07:45:24Z emillour $ | ||
| 3 | ! | ||
| 4 | 1369932 | SUBROUTINE thermcell_dry(ngrid,nlay,zlev,pphi,ztv,alim_star, & | |
| 5 | 480 | & lalim,lmin,zmax,wmax,lev_out) | |
| 6 | |||
| 7 | !-------------------------------------------------------------------------- | ||
| 8 | !thermcell_dry: calcul de zmax et wmax du thermique sec | ||
| 9 | ! Calcul de la vitesse maximum et de la hauteur maximum pour un panache | ||
| 10 | ! ascendant avec une fonction d'alimentation alim_star et sans changement | ||
| 11 | ! de phase. | ||
| 12 | ! Le calcul pourrait etre sans doute simplifier. | ||
| 13 | ! La temperature potentielle virtuelle dans la panache ascendant est | ||
| 14 | ! la temperature potentielle virtuelle pondérée par alim_star. | ||
| 15 | !-------------------------------------------------------------------------- | ||
| 16 | |||
| 17 | USE print_control_mod, ONLY: prt_level | ||
| 18 | IMPLICIT NONE | ||
| 19 | ! | ||
| 20 | ! $Header$ | ||
| 21 | ! | ||
| 22 | ! ATTENTION!!!!: ce fichier include est compatible format fixe/format libre | ||
| 23 | ! veillez � n'utiliser que des ! pour les commentaires | ||
| 24 | ! et � bien positionner les & des lignes de continuation | ||
| 25 | ! (les placer en colonne 6 et en colonne 73) | ||
| 26 | ! | ||
| 27 | ! | ||
| 28 | ! A1.0 Fundamental constants | ||
| 29 | REAL RPI,RCLUM,RHPLA,RKBOL,RNAVO | ||
| 30 | ! A1.1 Astronomical constants | ||
| 31 | REAL RDAY,REA,REPSM,RSIYEA,RSIDAY,ROMEGA | ||
| 32 | ! A1.1.bis Constantes concernant l'orbite de la Terre: | ||
| 33 | REAL R_ecc, R_peri, R_incl | ||
| 34 | ! A1.2 Geoide | ||
| 35 | REAL RA,RG,R1SA | ||
| 36 | ! A1.3 Radiation | ||
| 37 | ! REAL RSIGMA,RI0 | ||
| 38 | REAL RSIGMA | ||
| 39 | ! A1.4 Thermodynamic gas phase | ||
| 40 | REAL RMO3,RMCO2,RMC,RMCH4,RMN2O,RMCFC11,RMCFC12 | ||
| 41 | REAL R,RMD,RMV,RD,RV,RCPD,RCPV,RCVD,RCVV | ||
| 42 | REAL RKAPPA,RETV, eps_w | ||
| 43 | ! A1.5,6 Thermodynamic liquid,solid phases | ||
| 44 | REAL RCW,RCS | ||
| 45 | ! A1.7 Thermodynamic transition of phase | ||
| 46 | REAL RLVTT,RLSTT,RLMLT,RTT,RATM | ||
| 47 | ! A1.8 Curve of saturation | ||
| 48 | REAL RESTT,RALPW,RBETW,RGAMW,RALPS,RBETS,RGAMS | ||
| 49 | REAL RALPD,RBETD,RGAMD | ||
| 50 | ! | ||
| 51 | COMMON/YOMCST/RPI ,RCLUM ,RHPLA ,RKBOL ,RNAVO & | ||
| 52 | & ,RDAY ,REA ,REPSM ,RSIYEA,RSIDAY,ROMEGA & | ||
| 53 | & ,R_ecc, R_peri, R_incl & | ||
| 54 | & ,RA ,RG ,R1SA & | ||
| 55 | & ,RSIGMA & | ||
| 56 | & ,R ,RMD ,RMV ,RD ,RV ,RCPD & | ||
| 57 | & ,RMO3 ,RMCO2 ,RMC ,RMCH4 ,RMN2O ,RMCFC11 ,RMCFC12 & | ||
| 58 | & ,RCPV ,RCVD ,RCVV ,RKAPPA,RETV, eps_w & | ||
| 59 | & ,RCW ,RCS & | ||
| 60 | & ,RLVTT ,RLSTT ,RLMLT ,RTT ,RATM & | ||
| 61 | & ,RESTT ,RALPW ,RBETW ,RGAMW ,RALPS ,RBETS ,RGAMS & | ||
| 62 | & ,RALPD ,RBETD ,RGAMD | ||
| 63 | ! ------------------------------------------------------------------ | ||
| 64 | !$OMP THREADPRIVATE(/YOMCST/) | ||
| 65 | INTEGER l,ig | ||
| 66 | |||
| 67 | INTEGER ngrid,nlay | ||
| 68 | REAL zlev(ngrid,nlay+1) | ||
| 69 | REAL pphi(ngrid,nlay) | ||
| 70 | REAl ztv(ngrid,nlay) | ||
| 71 | REAL alim_star(ngrid,nlay) | ||
| 72 | INTEGER lalim(ngrid) | ||
| 73 | integer lev_out ! niveau pour les print | ||
| 74 | |||
| 75 | REAL zmax(ngrid) | ||
| 76 | REAL wmax(ngrid) | ||
| 77 | |||
| 78 | !variables locales | ||
| 79 | 960 | REAL zw2(ngrid,nlay+1) | |
| 80 | 960 | REAL f_star(ngrid,nlay+1) | |
| 81 | 960 | REAL ztva(ngrid,nlay+1) | |
| 82 | 960 | REAL wmaxa(ngrid) | |
| 83 | 960 | REAL wa_moy(ngrid,nlay+1) | |
| 84 | 960 | REAL linter(ngrid),zlevinter(ngrid) | |
| 85 | 480 | INTEGER lmix(ngrid),lmax(ngrid),lmin(ngrid) | |
| 86 | CHARACTER (LEN=20) :: modname='thermcell_dry' | ||
| 87 | CHARACTER (LEN=80) :: abort_message | ||
| 88 | |||
| 89 | !initialisations | ||
| 90 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | do ig=1,ngrid |
| 91 |
2/2✓ Branch 0 taken 19084800 times.
✓ Branch 1 taken 477120 times.
|
19562400 | do l=1,nlay+1 |
| 92 | 19084800 | zw2(ig,l)=0. | |
| 93 | 19561920 | wa_moy(ig,l)=0. | |
| 94 | enddo | ||
| 95 | enddo | ||
| 96 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | do ig=1,ngrid |
| 97 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 477120 times.
|
19085280 | do l=1,nlay |
| 98 | 19084800 | ztva(ig,l)=ztv(ig,l) | |
| 99 | enddo | ||
| 100 | enddo | ||
| 101 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | do ig=1,ngrid |
| 102 | 477120 | wmax(ig)=0. | |
| 103 | 477600 | wmaxa(ig)=0. | |
| 104 | enddo | ||
| 105 | !calcul de la vitesse a partir de la CAPE en melangeant thetav | ||
| 106 | |||
| 107 | |||
| 108 | ! Calcul des F^*, integrale verticale de E^* | ||
| 109 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | f_star(:,1)=0. |
| 110 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do l=1,nlay |
| 111 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 18607680 times.
|
18626880 | f_star(:,l+1)=f_star(:,l)+alim_star(:,l) |
| 112 | enddo | ||
| 113 | |||
| 114 | ! niveau (reel) auquel zw2 s'annule FH :n'etait pas initialise | ||
| 115 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | linter(:)=0. |
| 116 | |||
| 117 | ! couche la plus haute concernee par le thermique. | ||
| 118 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | lmax(:)=1 |
| 119 | |||
| 120 | ! Le niveau linter est une variable continue qui se trouve dans la couche | ||
| 121 | ! lmax | ||
| 122 | |||
| 123 |
2/2✓ Branch 0 taken 17760 times.
✓ Branch 1 taken 480 times.
|
18240 | do l=1,nlay-2 |
| 124 |
2/2✓ Branch 0 taken 17653440 times.
✓ Branch 1 taken 17760 times.
|
17671680 | do ig=1,ngrid |
| 125 |
4/4✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 17176320 times.
✓ Branch 2 taken 248430 times.
✓ Branch 3 taken 228690 times.
|
17653440 | if (l.eq.lmin(ig).and.lalim(ig).gt.1) then |
| 126 | |||
| 127 | !------------------------------------------------------------------------ | ||
| 128 | ! Calcul de la vitesse en haut de la premiere couche instable. | ||
| 129 | ! Premiere couche du panache thermique | ||
| 130 | !------------------------------------------------------------------------ | ||
| 131 | |||
| 132 | zw2(ig,l+1)=2.*RG*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig,l+1) & | ||
| 133 | & *(zlev(ig,l+1)-zlev(ig,l)) & | ||
| 134 | 248430 | & *0.4*pphi(ig,l)/(pphi(ig,l+1)-pphi(ig,l)) | |
| 135 | |||
| 136 | !------------------------------------------------------------------------ | ||
| 137 | ! Tant que la vitesse en bas de la couche et la somme du flux de masse | ||
| 138 | ! et de l'entrainement (c'est a dire le flux de masse en haut) sont | ||
| 139 | ! positifs, on calcul | ||
| 140 | ! 1. le flux de masse en haut f_star(ig,l+1) | ||
| 141 | ! 2. la temperature potentielle virtuelle dans la couche ztva(ig,l) | ||
| 142 | ! 3. la vitesse au carr� en haut zw2(ig,l+1) | ||
| 143 | !------------------------------------------------------------------------ | ||
| 144 | |||
| 145 |
2/2✓ Branch 0 taken 1121022 times.
✓ Branch 1 taken 16283988 times.
|
17405010 | else if (zw2(ig,l).ge.1e-10) then |
| 146 | |||
| 147 | ztva(ig,l)=(f_star(ig,l)*ztva(ig,l-1)+alim_star(ig,l) & | ||
| 148 | 1121022 | & *ztv(ig,l))/f_star(ig,l+1) | |
| 149 | zw2(ig,l+1)=zw2(ig,l)*(f_star(ig,l)/f_star(ig,l+1))**2+ & | ||
| 150 | & 2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l) & | ||
| 151 | 1121022 | & *(zlev(ig,l+1)-zlev(ig,l)) | |
| 152 | endif | ||
| 153 | ! determination de zmax continu par interpolation lineaire | ||
| 154 | !------------------------------------------------------------------------ | ||
| 155 | |||
| 156 |
3/4✓ Branch 0 taken 1121022 times.
✓ Branch 1 taken 16532418 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 1121022 times.
|
17653440 | if (zw2(ig,l+1)>0. .and. zw2(ig,l+1).lt.1.e-10) then |
| 157 | ! stop'On tombe sur le cas particulier de thermcell_dry' | ||
| 158 | ! print*,'On tombe sur le cas particulier de thermcell_dry' | ||
| 159 | ✗ | zw2(ig,l+1)=0. | |
| 160 | ✗ | linter(ig)=l+1 | |
| 161 | ✗ | lmax(ig)=l | |
| 162 | endif | ||
| 163 | |||
| 164 |
2/2✓ Branch 0 taken 248430 times.
✓ Branch 1 taken 17405010 times.
|
17653440 | if (zw2(ig,l+1).lt.0.) then |
| 165 | linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l)) & | ||
| 166 | 248430 | & -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l)) | |
| 167 | 248430 | zw2(ig,l+1)=0. | |
| 168 | 248430 | lmax(ig)=l | |
| 169 | ! endif | ||
| 170 | !CR:zmax continu 06/05/12: calcul de linter quand le thermique est stoppe par le detrainement | ||
| 171 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 17405010 times.
|
17405010 | elseif (f_star(ig,l+1).lt.0.) then |
| 172 | linter(ig)=(l*(f_star(ig,l+1)-f_star(ig,l)) & | ||
| 173 | ✗ | & -f_star(ig,l))/(f_star(ig,l+1)-f_star(ig,l)) | |
| 174 | ✗ | zw2(ig,l+1)=0. | |
| 175 | ✗ | lmax(ig)=l | |
| 176 | endif | ||
| 177 | !CRfin | ||
| 178 | 17653440 | wa_moy(ig,l+1)=sqrt(zw2(ig,l+1)) | |
| 179 | |||
| 180 |
2/2✓ Branch 0 taken 1033842 times.
✓ Branch 1 taken 16619598 times.
|
17671200 | if (wa_moy(ig,l+1).gt.wmaxa(ig)) then |
| 181 | ! lmix est le niveau de la couche ou w (wa_moy) est maximum | ||
| 182 | 1033842 | lmix(ig)=l+1 | |
| 183 | 1033842 | wmaxa(ig)=wa_moy(ig,l+1) | |
| 184 | endif | ||
| 185 | enddo | ||
| 186 | enddo | ||
| 187 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'fin calcul zw2' |
| 188 | ! | ||
| 189 | ! Determination de zw2 max | ||
| 190 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | do ig=1,ngrid |
| 191 | 477600 | wmax(ig)=0. | |
| 192 | enddo | ||
| 193 | |||
| 194 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do l=1,nlay |
| 195 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | do ig=1,ngrid |
| 196 |
2/2✓ Branch 0 taken 1598142 times.
✓ Branch 1 taken 17009538 times.
|
18626400 | if (l.le.lmax(ig)) then |
| 197 | 1598142 | zw2(ig,l)=sqrt(zw2(ig,l)) | |
| 198 | 1598142 | wmax(ig)=max(wmax(ig),zw2(ig,l)) | |
| 199 | else | ||
| 200 | 17009538 | zw2(ig,l)=0. | |
| 201 | endif | ||
| 202 | enddo | ||
| 203 | enddo | ||
| 204 | |||
| 205 | ! Longueur caracteristique correspondant a la hauteur des thermiques. | ||
| 206 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | do ig=1,ngrid |
| 207 | 477120 | zmax(ig)=0. | |
| 208 | 477600 | zlevinter(ig)=zlev(ig,1) | |
| 209 | enddo | ||
| 210 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | do ig=1,ngrid |
| 211 | ! calcul de zlevinter | ||
| 212 | zlevinter(ig)=zlev(ig,lmax(ig)) + & | ||
| 213 | 477120 | & (linter(ig)-lmax(ig))*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig))) | |
| 214 | 477600 | zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,lmin(ig))) | |
| 215 | enddo | ||
| 216 | |||
| 217 | 480 | RETURN | |
| 218 | END | ||
| 219 |