167 |
|
|
168 |
!MI Amip2 PV a theta constante |
!MI Amip2 PV a theta constante |
169 |
|
|
170 |
INTEGER klevp1 |
REAL swdn0(klon, llm + 1), swdn(klon, llm + 1) |
171 |
PARAMETER(klevp1 = llm + 1) |
REAL swup0(klon, llm + 1), swup(klon, llm + 1) |
|
|
|
|
REAL swdn0(klon, klevp1), swdn(klon, klevp1) |
|
|
REAL swup0(klon, klevp1), swup(klon, klevp1) |
|
172 |
SAVE swdn0, swdn, swup0, swup |
SAVE swdn0, swdn, swup0, swup |
173 |
|
|
174 |
REAL lwdn0(klon, klevp1), lwdn(klon, klevp1) |
REAL lwdn0(klon, llm + 1), lwdn(klon, llm + 1) |
175 |
REAL lwup0(klon, klevp1), lwup(klon, klevp1) |
REAL lwup0(klon, llm + 1), lwup(klon, llm + 1) |
176 |
SAVE lwdn0, lwdn, lwup0, lwup |
SAVE lwdn0, lwdn, lwup0, lwup |
177 |
|
|
178 |
!IM Amip2 |
!IM Amip2 |
369 |
INTEGER julien |
INTEGER julien |
370 |
|
|
371 |
INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day |
INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day |
372 |
REAL pctsrf(klon, nbsrf) |
REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface |
373 |
!IM |
REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE |
|
REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE |
|
374 |
|
|
|
SAVE pctsrf ! sous-fraction du sol |
|
375 |
REAL albsol(klon) |
REAL albsol(klon) |
376 |
SAVE albsol ! albedo du sol total |
SAVE albsol ! albedo du sol total |
377 |
REAL albsollw(klon) |
REAL albsollw(klon) |
952 |
DO nsrf = 1, nbsrf |
DO nsrf = 1, nbsrf |
953 |
DO k = 1, llm |
DO k = 1, llm |
954 |
DO i = 1, klon |
DO i = 1, klon |
955 |
zxfluxt(i, k) = zxfluxt(i, k) + & |
zxfluxt(i, k) = zxfluxt(i, k) + fluxt(i, k, nsrf) * pctsrf(i, nsrf) |
956 |
fluxt(i, k, nsrf) * pctsrf(i, nsrf) |
zxfluxq(i, k) = zxfluxq(i, k) + fluxq(i, k, nsrf) * pctsrf(i, nsrf) |
957 |
zxfluxq(i, k) = zxfluxq(i, k) + & |
zxfluxu(i, k) = zxfluxu(i, k) + fluxu(i, k, nsrf) * pctsrf(i, nsrf) |
958 |
fluxq(i, k, nsrf) * pctsrf(i, nsrf) |
zxfluxv(i, k) = zxfluxv(i, k) + fluxv(i, k, nsrf) * pctsrf(i, nsrf) |
|
zxfluxu(i, k) = zxfluxu(i, k) + & |
|
|
fluxu(i, k, nsrf) * pctsrf(i, nsrf) |
|
|
zxfluxv(i, k) = zxfluxv(i, k) + & |
|
|
fluxv(i, k, nsrf) * pctsrf(i, nsrf) |
|
959 |
END DO |
END DO |
960 |
END DO |
END DO |
961 |
END DO |
END DO |
1086 |
|
|
1087 |
if (iflag_con == 2) then |
if (iflag_con == 2) then |
1088 |
z_avant = sum((q_seri + ql_seri) * zmasse, dim=2) |
z_avant = sum((q_seri + ql_seri) * zmasse, dim=2) |
1089 |
CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, & |
CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:-1), q_seri, & |
1090 |
zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, & |
conv_t, conv_q, zxfluxq(:, 1), omega, d_t_con, d_q_con, & |
1091 |
pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, & |
rain_con, snow_con, pmfu, pmfd, pen_u, pde_u, pen_d, & |
1092 |
pmflxs) |
pde_d, kcbot, kctop, kdtop, pmflxr, pmflxs) |
1093 |
WHERE (rain_con < 0.) rain_con = 0. |
WHERE (rain_con < 0.) rain_con = 0. |
1094 |
WHERE (snow_con < 0.) snow_con = 0. |
WHERE (snow_con < 0.) snow_con = 0. |
1095 |
DO i = 1, klon |
DO i = 1, klon |
1215 |
|
|
1216 |
! Caclul des ratqs |
! Caclul des ratqs |
1217 |
|
|
1218 |
! ratqs convectifs a l'ancienne en fonction de q(z = 0)-q / q |
! ratqs convectifs à l'ancienne en fonction de (q(z = 0) - q) / q |
1219 |
! on ecrase le tableau ratqsc calcule par clouds_gno |
! on écrase le tableau ratqsc calculé par clouds_gno |
1220 |
if (iflag_cldcon == 1) then |
if (iflag_cldcon == 1) then |
1221 |
do k = 1, llm |
do k = 1, llm |
1222 |
do i = 1, klon |
do i = 1, klon |
1223 |
if(ptconv(i, k)) then |
if(ptconv(i, k)) then |
1224 |
ratqsc(i, k) = ratqsbas & |
ratqsc(i, k) = ratqsbas + fact_cldcon & |
1225 |
+fact_cldcon*(q_seri(i, 1)-q_seri(i, k))/q_seri(i, k) |
* (q_seri(i, 1) - q_seri(i, k)) / q_seri(i, k) |
1226 |
else |
else |
1227 |
ratqsc(i, k) = 0. |
ratqsc(i, k) = 0. |
1228 |
endif |
endif |
1233 |
! ratqs stables |
! ratqs stables |
1234 |
do k = 1, llm |
do k = 1, llm |
1235 |
do i = 1, klon |
do i = 1, klon |
1236 |
ratqss(i, k) = ratqsbas + (ratqshaut-ratqsbas)* & |
ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) & |
1237 |
min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.) |
* min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.) |
1238 |
enddo |
enddo |
1239 |
enddo |
enddo |
1240 |
|
|
1244 |
! ratqs final |
! ratqs final |
1245 |
! 1e4 (en gros 3 heures), en dur pour le moment, est le temps de |
! 1e4 (en gros 3 heures), en dur pour le moment, est le temps de |
1246 |
! relaxation des ratqs |
! relaxation des ratqs |
1247 |
facteur = exp(-dtphys*facttemps) |
ratqs = max(ratqs * exp(- dtphys * facttemps), ratqss) |
|
ratqs = max(ratqs*facteur, ratqss) |
|
1248 |
ratqs = max(ratqs, ratqsc) |
ratqs = max(ratqs, ratqsc) |
1249 |
else |
else |
1250 |
! on ne prend que le ratqs stable pour fisrtilp |
! on ne prend que le ratqs stable pour fisrtilp |
1332 |
facteur = dtphys *facttemps |
facteur = dtphys *facttemps |
1333 |
do k = 1, llm |
do k = 1, llm |
1334 |
do i = 1, klon |
do i = 1, klon |
1335 |
rnebcon(i, k) = rnebcon(i, k)*facteur |
rnebcon(i, k) = rnebcon(i, k) * facteur |
1336 |
if (rnebcon0(i, k)*clwcon0(i, k) > rnebcon(i, k)*clwcon(i, k)) & |
if (rnebcon0(i, k)*clwcon0(i, k) > rnebcon(i, k)*clwcon(i, k)) & |
1337 |
then |
then |
1338 |
rnebcon(i, k) = rnebcon0(i, k) |
rnebcon(i, k) = rnebcon0(i, k) |