Changeset 5143 for LMDZ6/branches/Amaury_dev/libf/phylmd/concvl.F90
- Timestamp:
- Jul 29, 2024, 5:47:53 PM (3 months ago)
- File:
-
- 1 edited
-
LMDZ6/branches/Amaury_dev/libf/phylmd/concvl.F90 (modified) (19 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/phylmd/concvl.F90
r5140 r5143 1 1 SUBROUTINE concvl(iflag_clos, & 2 dtime, paprs, pplay, k_upper_cv, & 3 t, q, t_wake, q_wake, s_wake, u, v, tra, ntra, & 4 Ale, Alp, sig1, w01, & 5 d_t, d_q, d_qcomp, d_u, d_v, d_tra, & 6 rain, snow, kbas, ktop, sigd, & 7 cbmf, plcl, plfc, wbeff, convoccur, & 8 upwd, dnwd, dnwdbis, & 9 Ma, mip, Vprecip, & 10 cape, cin, tvp, Tconv, iflag, & 11 pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, & 12 qcondc, wd, pmflxr, pmflxs, & 13 !RomP >>> 14 !! . da,phi,mp,dd_t,dd_q,lalim_conv,wght_th) 15 da, phi, mp, phii, d1a, dam, sij, qta, clw, elij, &! RomP 16 dd_t, dd_q, lalim_conv, wght_th, & ! RomP 17 evap, ep, epmlmMm, eplaMm, & ! RomP 18 wdtrainA, wdtrainS, wdtrainM, wght, qtc, sigt, detrain, & 19 tau_cld_cv, coefw_cld_cv, & ! RomP+RL, AJ 20 !RomP <<< 21 epmax_diag) ! epmax_cape 22 ! ************************************************************** 23 ! * 24 ! CONCVL * 25 ! * 26 ! * 27 ! written by : Sandrine Bony-Lena, 17/05/2003, 11.16.04 * 28 ! modified by : * 29 ! ************************************************************** 30 2 dtime, paprs, pplay, k_upper_cv, & 3 t, q, t_wake, q_wake, s_wake, u, v, tra, ntra, & 4 Ale, Alp, sig1, w01, & 5 d_t, d_q, d_qcomp, d_u, d_v, d_tra, & 6 rain, snow, kbas, ktop, sigd, & 7 cbmf, plcl, plfc, wbeff, convoccur, & 8 upwd, dnwd, dnwdbis, & 9 Ma, mip, Vprecip, & 10 cape, cin, tvp, Tconv, iflag, & 11 pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, & 12 qcondc, wd, pmflxr, pmflxs, & 13 !RomP >>> 14 !! . da,phi,mp,dd_t,dd_q,lalim_conv,wght_th) 15 da, phi, mp, phii, d1a, dam, sij, qta, clw, elij, &! RomP 16 dd_t, dd_q, lalim_conv, wght_th, & ! RomP 17 evap, ep, epmlmMm, eplaMm, & ! RomP 18 wdtrainA, wdtrainS, wdtrainM, wght, qtc, sigt, detrain, & 19 tau_cld_cv, coefw_cld_cv, & ! RomP+RL, AJ 20 !RomP <<< 21 epmax_diag) ! epmax_cape 22 ! ************************************************************** 23 ! * 24 ! CONCVL * 25 ! * 26 ! * 27 ! written by : Sandrine Bony-Lena, 17/05/2003, 11.16.04 * 28 ! modified by : * 29 ! ************************************************************** 31 30 32 31 USE dimphy … … 36 35 USE lmdz_clesphys 37 36 USE lmdz_conema3 37 USE lmdz_YOETHF 38 USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep 38 39 39 40 IMPLICIT NONE 40 ! ======================================================================41 ! Auteur(s): S. Bony-Lena (LMD/CNRS) date: ???42 ! Objet: schema de convection de Emanuel (1991) interface43 ! ======================================================================44 ! Arguments:45 ! dtime--input-R-pas d'integration (s)46 ! s-------input-R-la vAleur "s" pour chaque couche47 ! sigs----input-R-la vAleur "sigma" de chaque couche48 ! sig-----input-R-la vAleur de "sigma" pour chaque niveau49 ! psolpa--input-R-la pression au sol (en Pa)50 ! pskapa--input-R-exponentiel kappa de psolpa51 ! h-------input-R-enthAlpie potentielle (Cp*T/P**kappa)52 ! q-------input-R-vapeur d'eau (en kg/kg)53 54 ! work*: input et output: deux variables de travail,55 ! on peut les mettre a 0 au debut56 ! ALE--------input-R-energie disponible pour soulevement57 ! ALP--------input-R-puissance disponible pour soulevement58 59 ! d_h--------output-R-increment de l'enthAlpie potentielle (h)60 ! d_q--------output-R-increment de la vapeur d'eau61 ! rain-------output-R-la pluie (mm/s)62 ! snow-------output-R-la neige (mm/s)63 ! upwd-------output-R-saturated updraft mass flux (kg/m**2/s)64 ! dnwd-------output-R-saturated downdraft mass flux (kg/m**2/s)65 ! dnwd0------output-R-unsaturated downdraft mass flux (kg/m**2/s)66 ! Ma---------output-R-adiabatic ascent mass flux (kg/m2/s)67 ! mip--------output-R-mass flux shed by adiabatic ascent (kg/m2/s)68 ! Vprecip----output-R-vertical profile of total precipitation (kg/m2/s)69 ! Tconv------output-R-environment temperature seen by convective scheme (K)70 ! Cape-------output-R-CAPE (J/kg)71 ! Cin -------output-R-CIN (J/kg)72 ! Tvp--------output-R-Temperature virtuelle d'une parcelle soulevee73 ! adiabatiquement a partir du niveau 1 (K)74 ! deltapb----output-R-distance entre LCL et base de la colonne (<0 ; Pa)75 ! Ice_flag---input-L-TRUE->prise en compte de la thermodynamique de la glace76 ! dd_t-------output-R-increment de la temperature du aux descentes precipitantes77 ! dd_q-------output-R-increment de la vapeur d'eau du aux desc precip78 ! lalim_conv-79 ! wght_th----80 ! evap-------output-R81 ! ep---------output-R82 ! epmlmMm----output-R83 ! eplaMm-----output-R84 ! wdtrainA---output-R85 ! wdtrainS---output-R86 ! wdtrainM---output-R87 ! wght-------output-R88 ! ======================================================================89 90 INTEGER, INTENT(IN) 91 REAL, INTENT(IN) 92 REAL, DIMENSION(klon, klev), INTENT(IN):: pplay93 REAL, DIMENSION(klon, klev+1), INTENT(IN):: paprs94 INTEGER, INTENT(IN):: k_upper_cv95 REAL, DIMENSION(klon, klev), INTENT(IN):: t, q, u, v96 REAL, DIMENSION(klon, klev), INTENT(IN):: t_wake, q_wake97 REAL, DIMENSION(klon), INTENT(IN):: s_wake98 REAL, DIMENSION(klon, klev, nbtr),INTENT(IN):: tra99 INTEGER, INTENT(IN):: ntra100 REAL, DIMENSION(klon), INTENT(IN):: Ale, Alp101 !CR:test: on passe lentr et alim_star des thermiques102 INTEGER, DIMENSION(klon), INTENT(IN):: lalim_conv103 REAL, DIMENSION(klon, klev), INTENT(IN):: wght_th104 105 REAL, DIMENSION(klon, klev), INTENT(INOUT):: sig1, w01106 107 REAL, DIMENSION(klon, klev), INTENT(OUT):: d_t, d_q, d_qcomp, d_u, d_v108 REAL, DIMENSION(klon, klev, nbtr),INTENT(OUT):: d_tra109 REAL, DIMENSION(klon), INTENT(OUT):: rain, snow110 111 INTEGER, DIMENSION(klon), INTENT(OUT):: kbas, ktop112 REAL, DIMENSION(klon), INTENT(OUT):: sigd113 REAL, DIMENSION(klon), INTENT(OUT):: cbmf, plcl, plfc, wbeff114 REAL, DIMENSION(klon), INTENT(OUT):: convoccur115 REAL, DIMENSION(klon, klev), INTENT(OUT):: upwd, dnwd, dnwdbis116 117 !! REAL Ma(klon,klev), mip(klon,klev),Vprecip(klon,klev) !jyg118 REAL, DIMENSION(klon, klev), INTENT(OUT) :: Ma, mip119 REAL, DIMENSION(klon, klev+1), INTENT(OUT):: Vprecip !jyg120 REAL, DIMENSION(klon), INTENT(OUT):: cape, cin121 REAL, DIMENSION(klon, klev), INTENT(OUT):: tvp122 REAL, DIMENSION(klon, klev), INTENT(OUT):: Tconv123 INTEGER, DIMENSION(klon), INTENT(OUT):: iflag124 REAL, DIMENSION(klon), INTENT(OUT):: pbase, bbase125 REAL, DIMENSION(klon, klev), INTENT(OUT):: dtvpdt1, dtvpdq1126 REAL, DIMENSION(klon), INTENT(OUT):: dplcldt, dplcldr127 REAL, DIMENSION(klon, klev), INTENT(OUT):: qcondc128 REAL, DIMENSION(klon), INTENT(OUT):: wd129 REAL, DIMENSION(klon, klev+1), INTENT(OUT):: pmflxr, pmflxs130 131 REAL, DIMENSION(klon, klev), INTENT(OUT):: da, mp132 REAL, DIMENSION(klon, klev,klev),INTENT(OUT):: phi133 ! RomP >>>134 REAL, DIMENSION(klon, klev,klev),INTENT(OUT):: phii135 REAL, DIMENSION(klon, klev), INTENT(OUT):: d1a, dam136 REAL, DIMENSION(klon, klev,klev),INTENT(OUT):: sij, elij137 REAL, DIMENSION(klon, klev), INTENT(OUT):: qta138 REAL, DIMENSION(klon, klev), INTENT(OUT):: clw139 REAL, DIMENSION(klon, klev), INTENT(OUT):: dd_t, dd_q140 REAL, DIMENSION(klon, klev), INTENT(OUT):: evap, ep141 REAL, DIMENSION(klon, klev), INTENT(OUT):: eplaMm142 REAL, DIMENSION(klon, klev,klev), INTENT(OUT):: epmlmMm143 REAL, DIMENSION(klon, klev), INTENT(OUT):: wdtrainA, wdtrainS, wdtrainM144 ! RomP <<<145 REAL, DIMENSION(klon, klev), INTENT(OUT):: wght !RL146 REAL, DIMENSION(klon, klev), INTENT(OUT):: qtc147 REAL, DIMENSION(klon, klev), INTENT(OUT):: sigt, detrain148 REAL, INTENT(OUT):: tau_cld_cv, coefw_cld_cv149 REAL, DIMENSION(klon), INTENT(OUT):: epmax_diag ! epmax_cape150 151 ! Local152 ! ----153 REAL, DIMENSION(klon, klev):: em_p154 REAL, DIMENSION(klon, klev+1):: em_ph155 REAL 156 REAL 157 REAL, DIMENSION(klev) 158 REAL, DIMENSION(klon, klev+1):: Vprecipi !jyg159 !on enleve le save160 ! SAVE em_sig1feed,em_sig2feed,em_wght161 162 REAL, DIMENSION(klon) 163 REAL, DIMENSION(klon) 164 REAL, DIMENSION(klon) 165 REAL, DIMENSION(klon, klev):: asupmax166 REAL, DIMENSION(klon) 167 REAL 168 169 ! INTEGER iflag_mix170 ! SAVE iflag_mix171 INTEGER 172 INTEGER :: i,j, k, itra173 REAL, DIMENSION(klon, klev):: qs, qs_wake174 !LF SAVE cbmf175 !IM/JYG REAL, SAVE, ALLOCATABLE :: cbmf(:)176 !!!$OMP THREADPRIVATE(cbmf)!177 REAL, DIMENSION(klon) 178 179 180 ! Variables supplementaires liees au bilan d'energie181 ! Real paire(klon)182 !LF Real ql(klon,klev)183 ! Save paire184 !LF Save ql185 !LF Real t1(klon,klev),q1(klon,klev)186 !LF Save t1,q1187 ! Data paire /1./41 ! ====================================================================== 42 ! Auteur(s): S. Bony-Lena (LMD/CNRS) date: ??? 43 ! Objet: schema de convection de Emanuel (1991) interface 44 ! ====================================================================== 45 ! Arguments: 46 ! dtime--input-R-pas d'integration (s) 47 ! s-------input-R-la vAleur "s" pour chaque couche 48 ! sigs----input-R-la vAleur "sigma" de chaque couche 49 ! sig-----input-R-la vAleur de "sigma" pour chaque niveau 50 ! psolpa--input-R-la pression au sol (en Pa) 51 ! pskapa--input-R-exponentiel kappa de psolpa 52 ! h-------input-R-enthAlpie potentielle (Cp*T/P**kappa) 53 ! q-------input-R-vapeur d'eau (en kg/kg) 54 55 ! work*: input et output: deux variables de travail, 56 ! on peut les mettre a 0 au debut 57 ! ALE--------input-R-energie disponible pour soulevement 58 ! ALP--------input-R-puissance disponible pour soulevement 59 60 ! d_h--------output-R-increment de l'enthAlpie potentielle (h) 61 ! d_q--------output-R-increment de la vapeur d'eau 62 ! rain-------output-R-la pluie (mm/s) 63 ! snow-------output-R-la neige (mm/s) 64 ! upwd-------output-R-saturated updraft mass flux (kg/m**2/s) 65 ! dnwd-------output-R-saturated downdraft mass flux (kg/m**2/s) 66 ! dnwd0------output-R-unsaturated downdraft mass flux (kg/m**2/s) 67 ! Ma---------output-R-adiabatic ascent mass flux (kg/m2/s) 68 ! mip--------output-R-mass flux shed by adiabatic ascent (kg/m2/s) 69 ! Vprecip----output-R-vertical profile of total precipitation (kg/m2/s) 70 ! Tconv------output-R-environment temperature seen by convective scheme (K) 71 ! Cape-------output-R-CAPE (J/kg) 72 ! Cin -------output-R-CIN (J/kg) 73 ! Tvp--------output-R-Temperature virtuelle d'une parcelle soulevee 74 ! adiabatiquement a partir du niveau 1 (K) 75 ! deltapb----output-R-distance entre LCL et base de la colonne (<0 ; Pa) 76 ! Ice_flag---input-L-TRUE->prise en compte de la thermodynamique de la glace 77 ! dd_t-------output-R-increment de la temperature du aux descentes precipitantes 78 ! dd_q-------output-R-increment de la vapeur d'eau du aux desc precip 79 ! lalim_conv- 80 ! wght_th---- 81 ! evap-------output-R 82 ! ep---------output-R 83 ! epmlmMm----output-R 84 ! eplaMm-----output-R 85 ! wdtrainA---output-R 86 ! wdtrainS---output-R 87 ! wdtrainM---output-R 88 ! wght-------output-R 89 ! ====================================================================== 90 91 INTEGER, INTENT(IN) :: iflag_clos 92 REAL, INTENT(IN) :: dtime 93 REAL, DIMENSION(klon, klev), INTENT(IN) :: pplay 94 REAL, DIMENSION(klon, klev + 1), INTENT(IN) :: paprs 95 INTEGER, INTENT(IN) :: k_upper_cv 96 REAL, DIMENSION(klon, klev), INTENT(IN) :: t, q, u, v 97 REAL, DIMENSION(klon, klev), INTENT(IN) :: t_wake, q_wake 98 REAL, DIMENSION(klon), INTENT(IN) :: s_wake 99 REAL, DIMENSION(klon, klev, nbtr), INTENT(IN) :: tra 100 INTEGER, INTENT(IN) :: ntra 101 REAL, DIMENSION(klon), INTENT(IN) :: Ale, Alp 102 !CR:test: on passe lentr et alim_star des thermiques 103 INTEGER, DIMENSION(klon), INTENT(IN) :: lalim_conv 104 REAL, DIMENSION(klon, klev), INTENT(IN) :: wght_th 105 106 REAL, DIMENSION(klon, klev), INTENT(INOUT) :: sig1, w01 107 108 REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_t, d_q, d_qcomp, d_u, d_v 109 REAL, DIMENSION(klon, klev, nbtr), INTENT(OUT) :: d_tra 110 REAL, DIMENSION(klon), INTENT(OUT) :: rain, snow 111 112 INTEGER, DIMENSION(klon), INTENT(OUT) :: kbas, ktop 113 REAL, DIMENSION(klon), INTENT(OUT) :: sigd 114 REAL, DIMENSION(klon), INTENT(OUT) :: cbmf, plcl, plfc, wbeff 115 REAL, DIMENSION(klon), INTENT(OUT) :: convoccur 116 REAL, DIMENSION(klon, klev), INTENT(OUT) :: upwd, dnwd, dnwdbis 117 118 !! REAL Ma(klon,klev), mip(klon,klev),Vprecip(klon,klev) !jyg 119 REAL, DIMENSION(klon, klev), INTENT(OUT) :: Ma, mip 120 REAL, DIMENSION(klon, klev + 1), INTENT(OUT) :: Vprecip !jyg 121 REAL, DIMENSION(klon), INTENT(OUT) :: cape, cin 122 REAL, DIMENSION(klon, klev), INTENT(OUT) :: tvp 123 REAL, DIMENSION(klon, klev), INTENT(OUT) :: Tconv 124 INTEGER, DIMENSION(klon), INTENT(OUT) :: iflag 125 REAL, DIMENSION(klon), INTENT(OUT) :: pbase, bbase 126 REAL, DIMENSION(klon, klev), INTENT(OUT) :: dtvpdt1, dtvpdq1 127 REAL, DIMENSION(klon), INTENT(OUT) :: dplcldt, dplcldr 128 REAL, DIMENSION(klon, klev), INTENT(OUT) :: qcondc 129 REAL, DIMENSION(klon), INTENT(OUT) :: wd 130 REAL, DIMENSION(klon, klev + 1), INTENT(OUT) :: pmflxr, pmflxs 131 132 REAL, DIMENSION(klon, klev), INTENT(OUT) :: da, mp 133 REAL, DIMENSION(klon, klev, klev), INTENT(OUT) :: phi 134 ! RomP >>> 135 REAL, DIMENSION(klon, klev, klev), INTENT(OUT) :: phii 136 REAL, DIMENSION(klon, klev), INTENT(OUT) :: d1a, dam 137 REAL, DIMENSION(klon, klev, klev), INTENT(OUT) :: sij, elij 138 REAL, DIMENSION(klon, klev), INTENT(OUT) :: qta 139 REAL, DIMENSION(klon, klev), INTENT(OUT) :: clw 140 REAL, DIMENSION(klon, klev), INTENT(OUT) :: dd_t, dd_q 141 REAL, DIMENSION(klon, klev), INTENT(OUT) :: evap, ep 142 REAL, DIMENSION(klon, klev), INTENT(OUT) :: eplaMm 143 REAL, DIMENSION(klon, klev, klev), INTENT(OUT) :: epmlmMm 144 REAL, DIMENSION(klon, klev), INTENT(OUT) :: wdtrainA, wdtrainS, wdtrainM 145 ! RomP <<< 146 REAL, DIMENSION(klon, klev), INTENT(OUT) :: wght !RL 147 REAL, DIMENSION(klon, klev), INTENT(OUT) :: qtc 148 REAL, DIMENSION(klon, klev), INTENT(OUT) :: sigt, detrain 149 REAL, INTENT(OUT) :: tau_cld_cv, coefw_cld_cv 150 REAL, DIMENSION(klon), INTENT(OUT) :: epmax_diag ! epmax_cape 151 152 ! Local 153 ! ---- 154 REAL, DIMENSION(klon, klev) :: em_p 155 REAL, DIMENSION(klon, klev + 1) :: em_ph 156 REAL :: em_sig1feed ! sigma at lower bound of feeding layer 157 REAL :: em_sig2feed ! sigma at upper bound of feeding layer 158 REAL, DIMENSION(klev) :: em_wght ! weight density determining the feeding mixture 159 REAL, DIMENSION(klon, klev + 1) :: Vprecipi !jyg 160 !on enleve le save 161 ! SAVE em_sig1feed,em_sig2feed,em_wght 162 163 REAL, DIMENSION(klon) :: rflag 164 REAL, DIMENSION(klon) :: plim1, plim2 165 REAL, DIMENSION(klon) :: ptop2 166 REAL, DIMENSION(klon, klev) :: asupmax 167 REAL, DIMENSION(klon) :: supmax0, asupmaxmin 168 REAL :: zx_t, zdelta, zx_qs, zcor 169 170 ! INTEGER iflag_mix 171 ! SAVE iflag_mix 172 INTEGER :: noff, minorig 173 INTEGER :: i, j, k, itra 174 REAL, DIMENSION(klon, klev) :: qs, qs_wake 175 !LF SAVE cbmf 176 !IM/JYG REAL, SAVE, ALLOCATABLE :: cbmf(:) 177 !!!$OMP THREADPRIVATE(cbmf)! 178 REAL, DIMENSION(klon) :: cbmflast 179 180 181 ! Variables supplementaires liees au bilan d'energie 182 ! Real paire(klon) 183 !LF Real ql(klon,klev) 184 ! Save paire 185 !LF Save ql 186 !LF Real t1(klon,klev),q1(klon,klev) 187 !LF Save t1,q1 188 ! Data paire /1./ 188 189 REAL, SAVE, ALLOCATABLE :: ql(:, :), q1(:, :), t1(:, :) 189 !$OMP THREADPRIVATE(ql, q1, t1)190 191 ! Variables liees au bilan d'energie et d'enthAlpi190 !$OMP THREADPRIVATE(ql, q1, t1) 191 192 ! Variables liees au bilan d'energie et d'enthAlpi 192 193 REAL ztsol(klon) 193 194 REAL h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot, & 194 195 h_qs_tot, qw_tot, ql_tot, qs_tot, ec_tot 195 196 SAVE h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot, & 196 197 !$OMP THREADPRIVATE(h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot)198 !$OMP THREADPRIVATE(h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot)197 h_qs_tot, qw_tot, ql_tot, qs_tot, ec_tot 198 !$OMP THREADPRIVATE(h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot) 199 !$OMP THREADPRIVATE(h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot) 199 200 REAL d_h_vcol, d_h_dair, d_qt, d_qw, d_ql, d_qs, d_ec 200 201 REAL d_h_vcol_phy 201 202 REAL fs_bound, fq_bound 202 203 SAVE d_h_vcol_phy 203 !$OMP THREADPRIVATE(d_h_vcol_phy)204 !$OMP THREADPRIVATE(d_h_vcol_phy) 204 205 REAL zero_v(klon) 205 206 CHARACTER *15 ztit … … 207 208 SAVE ip_ebil 208 209 DATA ip_ebil/2/ 209 !$OMP THREADPRIVATE(ip_ebil)210 !$OMP THREADPRIVATE(ip_ebil) 210 211 INTEGER if_ebil ! level for energy conserv. dignostics 211 212 SAVE if_ebil 212 213 DATA if_ebil/2/ 213 !$OMP THREADPRIVATE(if_ebil)214 !+jld ec_conser214 !$OMP THREADPRIVATE(if_ebil) 215 !+jld ec_conser 215 216 REAL d_t_ec(klon, klev) ! tendance du a la conersion Ec -> E thermique 216 217 REAL zrcpd 217 !-jld ec_conser218 !LF218 !-jld ec_conser 219 !LF 219 220 INTEGER nloc 220 LOGICAL, SAVE :: first = .TRUE. 221 !$OMP THREADPRIVATE(first) 222 INTEGER, SAVE :: itap, igout 223 !$OMP THREADPRIVATE(itap, igout) 224 221 LOGICAL, SAVE :: first = .TRUE. 222 !$OMP THREADPRIVATE(first) 223 INTEGER, SAVE :: itap, igout 224 !$OMP THREADPRIVATE(itap, igout) 225 225 226 226 include "YOMCST.h" 227 227 include "YOMCST2.h" 228 include "YOETHF.h"229 include "FCTTRE.h"230 228 231 229 IF (first) THEN 232 ! Allocate some variables LF 04/2008233 234 !IM/JYG allocate(cbmf(klon))235 ALLOCATE (ql(klon, klev))236 ALLOCATE (t1(klon, klev))237 ALLOCATE (q1(klon, klev))230 ! Allocate some variables LF 04/2008 231 232 !IM/JYG allocate(cbmf(klon)) 233 ALLOCATE (ql(klon, klev)) 234 ALLOCATE (t1(klon, klev)) 235 ALLOCATE (q1(klon, klev)) 238 236 239 237 convoccur(:) = 0. 240 238 241 239 itap = 0 242 igout = klon /2 + 1/klon240 igout = klon / 2 + 1 / klon 243 241 END IF 244 ! Incrementer le compteur de la physique242 ! Incrementer le compteur de la physique 245 243 itap = itap + 1 246 244 247 ! Copy T into Tconv245 ! Copy T into Tconv 248 246 DO k = 1, klev 249 247 DO i = 1, klon … … 262 260 END IF 263 261 264 ! ym262 ! ym 265 263 snow(:) = 0 266 264 … … 268 266 first = .FALSE. 269 267 270 ! ===========================================================================271 ! READ IN PARAMETERS FOR THE CLOSURE AND THE MIXING DISTRIBUTION272 ! ===========================================================================268 ! =========================================================================== 269 ! READ IN PARAMETERS FOR THE CLOSURE AND THE MIXING DISTRIBUTION 270 ! =========================================================================== 273 271 274 272 IF (iflag_con==3) THEN 275 ! CALL cv3_inicp()273 ! CALL cv3_inicp() 276 274 CALL cv3_inip() 277 275 END IF 278 276 279 ! ===========================================================================280 ! READ IN PARAMETERS FOR CONVECTIVE INHIBITION BY TROPOS. DRYNESS281 ! ===========================================================================282 283 ! c$$$ open (56,file='supcrit.data')284 ! c$$$ read (56,*) Supcrit1, Supcrit2285 ! c$$$ close (56)277 ! =========================================================================== 278 ! READ IN PARAMETERS FOR CONVECTIVE INHIBITION BY TROPOS. DRYNESS 279 ! =========================================================================== 280 281 ! c$$$ open (56,file='supcrit.data') 282 ! c$$$ read (56,*) Supcrit1, Supcrit2 283 ! c$$$ close (56) 286 284 287 285 IF (prt_level>=10) WRITE (lunout, *) 'supcrit1, supcrit2', supcrit1, supcrit2 288 286 289 ! ===========================================================================290 ! Initialisation pour les bilans d'eau et d'energie291 ! ===========================================================================287 ! =========================================================================== 288 ! Initialisation pour les bilans d'eau et d'energie 289 ! =========================================================================== 292 290 IF (if_ebil>=1) d_h_vcol_phy = 0. 293 291 294 292 DO i = 1, klon 295 293 cbmf(i) = 0. 296 !! plcl(i) = 0.294 !! plcl(i) = 0. 297 295 sigd(i) = 0. 298 296 END DO 299 297 END IF !(first) 300 298 301 ! Initialisation a chaque pas de temps299 ! Initialisation a chaque pas de temps 302 300 plfc(:) = 0. 303 301 wbeff(:) = 100. … … 306 304 DO k = 1, klev + 1 307 305 DO i = 1, klon 308 em_ph(i, k) = paprs(i, k) /100.0306 em_ph(i, k) = paprs(i, k) / 100.0 309 307 pmflxr(i, k) = 0. 310 308 pmflxs(i, k) = 0. … … 314 312 DO k = 1, klev 315 313 DO i = 1, klon 316 em_p(i, k) = pplay(i, k) /100.0317 END DO 318 END DO 319 320 321 ! Feeding layer314 em_p(i, k) = pplay(i, k) / 100.0 315 END DO 316 END DO 317 318 319 ! Feeding layer 322 320 323 321 em_sig1feed = 1. 324 !jyg<325 ! em_sig2feed = 0.97322 !jyg< 323 ! em_sig2feed = 0.97 326 324 em_sig2feed = cvl_sig2feed 327 !>jyg328 ! em_sig2feed = 0.8329 ! Relative Weight densities325 !>jyg 326 ! em_sig2feed = 0.8 327 ! Relative Weight densities 330 328 DO k = 1, klev 331 329 em_wght(k) = 1. 332 330 END DO 333 !CRtest: couche alim des tehrmiques ponderee par a*334 ! DO i = 1, klon335 ! do k=1,lalim_conv(i)336 ! em_wght(k)=wght_th(i,k)337 ! PRINT*,'em_wght=',em_wght(k),wght_th(i,k)338 ! END DO339 ! END DO331 !CRtest: couche alim des tehrmiques ponderee par a* 332 ! DO i = 1, klon 333 ! do k=1,lalim_conv(i) 334 ! em_wght(k)=wght_th(i,k) 335 ! PRINT*,'em_wght=',em_wght(k),wght_th(i,k) 336 ! END DO 337 ! END DO 340 338 341 339 IF (iflag_con==4) THEN … … 343 341 DO i = 1, klon 344 342 zx_t = t(i, k) 345 zdelta = max(0., sign(1., rtt-zx_t))346 zx_qs = min(0.5, r2es *foeew(zx_t,zdelta)/em_p(i,k)/100.0)347 zcor = 1. /(1.-retv*zx_qs)348 qs(i, k) = zx_qs *zcor343 zdelta = max(0., sign(1., rtt - zx_t)) 344 zx_qs = min(0.5, r2es * foeew(zx_t, zdelta) / em_p(i, k) / 100.0) 345 zcor = 1. / (1. - retv * zx_qs) 346 qs(i, k) = zx_qs * zcor 349 347 END DO 350 348 DO i = 1, klon 351 349 zx_t = t_wake(i, k) 352 zdelta = max(0., sign(1., rtt-zx_t))353 zx_qs = min(0.5, r2es *foeew(zx_t,zdelta)/em_p(i,k)/100.0)354 zcor = 1. /(1.-retv*zx_qs)355 qs_wake(i, k) = zx_qs *zcor350 zdelta = max(0., sign(1., rtt - zx_t)) 351 zx_qs = min(0.5, r2es * foeew(zx_t, zdelta) / em_p(i, k) / 100.0) 352 zcor = 1. / (1. - retv * zx_qs) 353 qs_wake(i, k) = zx_qs * zcor 356 354 END DO 357 355 END DO … … 360 358 DO i = 1, klon 361 359 zx_t = t(i, k) 362 zdelta = max(0., sign(1., rtt-zx_t))363 zx_qs = r2es *foeew(zx_t, zdelta)/em_p(i, k)/100.0360 zdelta = max(0., sign(1., rtt - zx_t)) 361 zx_qs = r2es * foeew(zx_t, zdelta) / em_p(i, k) / 100.0 364 362 zx_qs = min(0.5, zx_qs) 365 zcor = 1. /(1.-retv*zx_qs)366 zx_qs = zx_qs *zcor363 zcor = 1. / (1. - retv * zx_qs) 364 zx_qs = zx_qs * zcor 367 365 qs(i, k) = zx_qs 368 366 END DO 369 367 DO i = 1, klon 370 368 zx_t = t_wake(i, k) 371 zdelta = max(0., sign(1., rtt-zx_t))372 zx_qs = r2es *foeew(zx_t, zdelta)/em_p(i, k)/100.0369 zdelta = max(0., sign(1., rtt - zx_t)) 370 zx_qs = r2es * foeew(zx_t, zdelta) / em_p(i, k) / 100.0 373 371 zx_qs = min(0.5, zx_qs) 374 zcor = 1. /(1.-retv*zx_qs)375 zx_qs = zx_qs *zcor372 zcor = 1. / (1. - retv * zx_qs) 373 zx_qs = zx_qs * zcor 376 374 qs_wake(i, k) = zx_qs 377 375 END DO … … 379 377 END IF ! iflag_con 380 378 381 ! ------------------------------------------------------------------ 382 383 ! Main driver for convection: 384 ! iflag_con=3 -> nvlle version de KE (JYG) 385 ! iflag_con = 30 -> equivAlent to convect3 386 ! iflag_con = 4 -> equivAlent to convect1/2 387 379 ! ------------------------------------------------------------------ 380 381 ! Main driver for convection: 382 ! iflag_con=3 -> nvlle version de KE (JYG) 383 ! iflag_con = 30 -> equivAlent to convect3 384 ! iflag_con = 4 -> equivAlent to convect1/2 388 385 389 386 IF (iflag_con==30) THEN 390 387 391 ! print *, '-> cv_driver' !jyg388 ! print *, '-> cv_driver' !jyg 392 389 CALL cv_driver(klon, klev, klevp1, ntra, iflag_con, & 393 394 395 396 397 398 399 400 401 402 403 ! print *, 'cv_driver ->' !jyg390 t, q, qs, u, v, tra, & 391 em_p, em_ph, iflag, & 392 d_t, d_q, d_u, d_v, d_tra, rain, & 393 Vprecip, cbmf, sig1, w01, & !jyg 394 kbas, ktop, & 395 dtime, Ma, upwd, dnwd, dnwdbis, qcondc, wd, cape, & 396 da, phi, mp, phii, d1a, dam, sij, clw, elij, & !RomP 397 evap, ep, epmlmMm, eplaMm, & !RomP 398 wdtrainA, wdtrainM, & !RomP 399 epmax_diag) ! epmax_cape 400 ! print *, 'cv_driver ->' !jyg 404 401 405 402 DO i = 1, klon … … 407 404 END DO 408 405 409 !RL406 !RL 410 407 wght(:, :) = 0. 411 408 DO i = 1, klon 412 409 wght(i, 1) = 1. 413 410 END DO 414 !RL411 !RL 415 412 416 413 ELSE 417 414 418 !LF necessary for gathered fields415 !LF necessary for gathered fields 419 416 nloc = klon 420 CALL cva_driver(klon, klev, klev +1, ntra, nloc, k_upper_cv, &421 422 423 424 425 426 427 428 429 430 431 432 433 !AC!+!RomP+jyg434 !! da,phi,mp,phii,d1a,dam,sij,clw,elij, & ! RomP435 !! evap,ep,epmlmMm,eplaMm, ! RomP436 437 438 439 440 !AC!+!RomP+jyg441 417 CALL cva_driver(klon, klev, klev + 1, ntra, nloc, k_upper_cv, & 418 iflag_con, iflag_mix, iflag_ice_thermo, & 419 iflag_clos, ok_conserv_q, dtime, cvl_comp_threshold, & 420 t, q, qs, t_wake, q_wake, qs_wake, s_wake, u, v, tra, & 421 em_p, em_ph, & 422 Ale, Alp, omega, & 423 em_sig1feed, em_sig2feed, em_wght, & 424 iflag, d_t, d_q, d_qcomp, d_u, d_v, d_tra, rain, kbas, ktop, & 425 cbmf, plcl, plfc, wbeff, sig1, w01, ptop2, sigd, & 426 Ma, mip, Vprecip, Vprecipi, upwd, dnwd, dnwdbis, qcondc, wd, & 427 cape, cin, tvp, & 428 dd_t, dd_q, plim1, plim2, asupmax, supmax0, & 429 asupmaxmin, lalim_conv, & 430 !AC!+!RomP+jyg 431 !! da,phi,mp,phii,d1a,dam,sij,clw,elij, & ! RomP 432 !! evap,ep,epmlmMm,eplaMm, ! RomP 433 da, phi, mp, phii, d1a, dam, sij, wght, & ! RomP+RL 434 qta, clw, elij, evap, ep, epmlmMm, eplaMm, & ! RomP+RL 435 wdtrainA, wdtrainS, wdtrainM, qtc, sigt, detrain, & 436 tau_cld_cv, coefw_cld_cv, & ! RomP,AJ 437 !AC!+!RomP+jyg 438 epmax_diag) ! epmax_cape 442 439 END IF 443 ! ------------------------------------------------------------------440 ! ------------------------------------------------------------------ 444 441 IF (prt_level>=10) WRITE (lunout, *) ' cva_driver -> cbmf,plcl,plfc,wbeff, d_t, d_q ', & 445 cbmf(1), plcl(1), plfc(1), wbeff(1), d_t(1,1), d_q(1,1)442 cbmf(1), plcl(1), plfc(1), wbeff(1), d_t(1, 1), d_q(1, 1) 446 443 447 444 DO i = 1, klon 448 rain(i) = rain(i) /86400.445 rain(i) = rain(i) / 86400. 449 446 rflag(i) = iflag(i) 450 447 END DO … … 452 449 DO k = 1, klev 453 450 DO i = 1, klon 454 d_t(i, k) = dtime *d_t(i, k)455 d_q(i, k) = dtime *d_q(i, k)456 d_u(i, k) = dtime *d_u(i, k)457 d_v(i, k) = dtime *d_v(i, k)451 d_t(i, k) = dtime * d_t(i, k) 452 d_q(i, k) = dtime * d_q(i, k) 453 d_u(i, k) = dtime * d_u(i, k) 454 d_v(i, k) = dtime * d_v(i, k) 458 455 END DO 459 456 END DO 460 457 461 458 IF (iflag_con==3) THEN 462 DO i = 1, klon459 DO i = 1, klon 463 460 IF (wbeff(i) > 100. .OR. wbeff(i) == 0 .OR. iflag(i) > 3) THEN 464 461 wbeff(i) = 0. 465 convoccur(i) = 0. 462 convoccur(i) = 0. 466 463 ELSE 467 464 convoccur(i) = 1. … … 474 471 DO k = 1, klev 475 472 DO i = 1, klon 476 !RL! d_tra(i,k,itra) =dtime*d_tra(i,k,itra)473 !RL! d_tra(i,k,itra) =dtime*d_tra(i,k,itra) 477 474 d_tra(i, k, itra) = 0. 478 475 END DO … … 481 478 END IF 482 479 483 !!AC!480 !!AC! 484 481 IF (iflag_con==3) THEN 485 482 DO itra = 1, ntra 486 483 DO k = 1, klev 487 484 DO i = 1, klon 488 !RL! d_tra(i,k,itra) =dtime*d_tra(i,k,itra)485 !RL! d_tra(i,k,itra) =dtime*d_tra(i,k,itra) 489 486 d_tra(i, k, itra) = 0. 490 487 END DO … … 492 489 END DO 493 490 END IF 494 !!AC!491 !!AC! 495 492 496 493 DO k = 1, klev … … 500 497 END DO 501 498 END DO 502 ! !jyg499 ! !jyg 503 500 IF (iflag_con == 30 .OR. iflag_ice_thermo ==0) THEN 504 ! --Separation neige/pluie (pour diagnostics) !jyg501 ! --Separation neige/pluie (pour diagnostics) !jyg 505 502 DO k = 1, klev !jyg 506 503 DO i = 1, klon !jyg 507 IF (t1(i, k)<rtt) THEN !jyg504 IF (t1(i, k)<rtt) THEN !jyg 508 505 pmflxs(i, k) = Vprecip(i, k) !jyg 509 506 ELSE !jyg … … 516 513 DO i = 1, klon !jyg 517 514 pmflxs(i, k) = Vprecipi(i, k) !jyg 518 pmflxr(i, k) = Vprecip(i, k) -Vprecipi(i, k) !jyg515 pmflxr(i, k) = Vprecip(i, k) - Vprecipi(i, k) !jyg 519 516 END DO !jyg 520 517 END DO !jyg 521 518 ENDIF 522 519 523 ! c IF (if_ebil.ge.2) THEN524 ! c ztit='after convect'525 ! c CALL diagetpq(paire,ztit,ip_ebil,2,2,dtime526 ! c e , t1,q1,ql,qs,u,v,paprs,pplay527 ! c s , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)528 ! c CALL diagphy(paire,ztit,ip_ebil529 ! c e , zero_v, zero_v, zero_v, zero_v, zero_v530 ! c e , zero_v, rain, zero_v, ztsol531 ! c e , d_h_vcol, d_qt, d_ec532 ! c s , fs_bound, fq_bound )533 ! c END IF534 535 536 ! les traceurs ne sont pas mis dans cette version de convect4:520 ! c IF (if_ebil.ge.2) THEN 521 ! c ztit='after convect' 522 ! c CALL diagetpq(paire,ztit,ip_ebil,2,2,dtime 523 ! c e , t1,q1,ql,qs,u,v,paprs,pplay 524 ! c s , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec) 525 ! c CALL diagphy(paire,ztit,ip_ebil 526 ! c e , zero_v, zero_v, zero_v, zero_v, zero_v 527 ! c e , zero_v, rain, zero_v, ztsol 528 ! c e , d_h_vcol, d_qt, d_ec 529 ! c s , fs_bound, fq_bound ) 530 ! c END IF 531 532 533 ! les traceurs ne sont pas mis dans cette version de convect4: 537 534 IF (iflag_con==4) THEN 538 535 DO itra = 1, ntra … … 544 541 END DO 545 542 END IF 546 ! PRINT*, 'concvl->: dd_t,dd_q ',dd_t(1,1),dd_q(1,1)543 ! PRINT*, 'concvl->: dd_t,dd_q ',dd_t(1,1),dd_q(1,1) 547 544 548 545 DO k = 1, klev … … 559 556 IF (prt_level>=20) THEN 560 557 DO k = 1, klev 561 ! PRINT*,'physiq apres_add_con i k it d_u d_v d_t d_q qdl0',igout, &562 ! k,itap,d_u_con(igout,k) ,d_v_con(igout,k), d_t_con(igout,k), &563 ! d_q_con(igout,k),dql0(igout,k)564 ! PRINT*,'phys apres_add_con itap Ma cin ALE ALP wak t q undi t q', &565 ! itap,Ma(igout,k),cin(igout),ALE(igout), ALP(igout), &566 ! t_wake(igout,k),q_wake(igout,k),t_undi(igout,k),q_undi(igout,k)567 ! PRINT*,'phy apres_add_con itap CON rain snow EMA wk1 wk2 Vpp mip', &568 ! itap,rain_con(igout),snow_con(igout),ema_work1(igout,k), &569 ! ema_work2(igout,k),Vprecip(igout,k), mip(igout,k)570 ! PRINT*,'phy apres_add_con itap upwd dnwd dnwd0 cape tvp Tconv ', &571 ! itap,upwd(igout,k),dnwd(igout,k),dnwd0(igout,k),cape(igout), &572 ! tvp(igout,k),Tconv(igout,k)573 ! PRINT*,'phy apres_add_con itap dtvpdt dtvdq dplcl dplcldr qcondc', &574 ! itap,dtvpdt1(igout,k),dtvpdq1(igout,k),dplcldt(igout), &575 ! dplcldr(igout),qcondc(igout,k)576 ! PRINT*,'phy apres_add_con itap wd pmflxr Kpmflxr Kp1 Kpmflxs Kp1', &577 ! itap,wd(igout),pmflxr(igout,k),pmflxr(igout,k+1),pmflxs(igout,k), &578 ! pmflxs(igout,k+1)579 ! PRINT*,'phy apres_add_con itap da phi mp ftd fqd lalim wgth', &580 ! itap,da(igout,k),phi(igout,k,k),mp(igout,k),ftd(igout,k), &581 ! fqd(igout,k),lalim_conv(igout),wght_th(igout,k)558 ! PRINT*,'physiq apres_add_con i k it d_u d_v d_t d_q qdl0',igout, & 559 ! k,itap,d_u_con(igout,k) ,d_v_con(igout,k), d_t_con(igout,k), & 560 ! d_q_con(igout,k),dql0(igout,k) 561 ! PRINT*,'phys apres_add_con itap Ma cin ALE ALP wak t q undi t q', & 562 ! itap,Ma(igout,k),cin(igout),ALE(igout), ALP(igout), & 563 ! t_wake(igout,k),q_wake(igout,k),t_undi(igout,k),q_undi(igout,k) 564 ! PRINT*,'phy apres_add_con itap CON rain snow EMA wk1 wk2 Vpp mip', & 565 ! itap,rain_con(igout),snow_con(igout),ema_work1(igout,k), & 566 ! ema_work2(igout,k),Vprecip(igout,k), mip(igout,k) 567 ! PRINT*,'phy apres_add_con itap upwd dnwd dnwd0 cape tvp Tconv ', & 568 ! itap,upwd(igout,k),dnwd(igout,k),dnwd0(igout,k),cape(igout), & 569 ! tvp(igout,k),Tconv(igout,k) 570 ! PRINT*,'phy apres_add_con itap dtvpdt dtvdq dplcl dplcldr qcondc', & 571 ! itap,dtvpdt1(igout,k),dtvpdq1(igout,k),dplcldt(igout), & 572 ! dplcldr(igout),qcondc(igout,k) 573 ! PRINT*,'phy apres_add_con itap wd pmflxr Kpmflxr Kp1 Kpmflxs Kp1', & 574 ! itap,wd(igout),pmflxr(igout,k),pmflxr(igout,k+1),pmflxs(igout,k), & 575 ! pmflxs(igout,k+1) 576 ! PRINT*,'phy apres_add_con itap da phi mp ftd fqd lalim wgth', & 577 ! itap,da(igout,k),phi(igout,k,k),mp(igout,k),ftd(igout,k), & 578 ! fqd(igout,k),lalim_conv(igout),wght_th(igout,k) 582 579 END DO 583 580 END IF !(prt_level.EQ.20) THEN 584 581 585 586 582 END SUBROUTINE concvl 587 583
Note: See TracChangeset
for help on using the changeset viewer.
