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 |
265 |
REAL, save:: ftsoil(klon, nsoilmx, nbsrf) |
REAL, save:: ftsoil(klon, nsoilmx, nbsrf) |
266 |
! soil temperature of surface fraction |
! soil temperature of surface fraction |
267 |
|
|
268 |
REAL fevap(klon, nbsrf) |
REAL, save:: fevap(klon, nbsrf) ! evaporation |
|
SAVE fevap ! evaporation |
|
269 |
REAL fluxlat(klon, nbsrf) |
REAL fluxlat(klon, nbsrf) |
270 |
SAVE fluxlat |
SAVE fluxlat |
271 |
|
|
347 |
|
|
348 |
REAL rain_tiedtke(klon), snow_tiedtke(klon) |
REAL rain_tiedtke(klon), snow_tiedtke(klon) |
349 |
|
|
350 |
REAL evap(klon), devap(klon) ! evaporation et sa derivee |
REAL evap(klon), devap(klon) ! evaporation and its derivative |
351 |
REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee |
REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee |
352 |
REAL dlw(klon) ! derivee infra rouge |
REAL dlw(klon) ! derivee infra rouge |
353 |
SAVE dlw |
SAVE dlw |
368 |
INTEGER julien |
INTEGER julien |
369 |
|
|
370 |
INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day |
INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day |
371 |
REAL pctsrf(klon, nbsrf) |
REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface |
372 |
!IM |
REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE |
|
REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE |
|
373 |
|
|
|
SAVE pctsrf ! sous-fraction du sol |
|
374 |
REAL albsol(klon) |
REAL albsol(klon) |
375 |
SAVE albsol ! albedo du sol total |
SAVE albsol ! albedo du sol total |
376 |
REAL albsollw(klon) |
REAL albsollw(klon) |
499 |
REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm) |
REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm) |
500 |
REAL rneb(klon, llm) |
REAL rneb(klon, llm) |
501 |
|
|
502 |
REAL pmfu(klon, llm), pmfd(klon, llm) |
REAL mfu(klon, llm), mfd(klon, llm) |
503 |
REAL pen_u(klon, llm), pen_d(klon, llm) |
REAL pen_u(klon, llm), pen_d(klon, llm) |
504 |
REAL pde_u(klon, llm), pde_d(klon, llm) |
REAL pde_u(klon, llm), pde_d(klon, llm) |
505 |
INTEGER kcbot(klon), kctop(klon), kdtop(klon) |
INTEGER kcbot(klon), kctop(klon), kdtop(klon) |
951 |
DO nsrf = 1, nbsrf |
DO nsrf = 1, nbsrf |
952 |
DO k = 1, llm |
DO k = 1, llm |
953 |
DO i = 1, klon |
DO i = 1, klon |
954 |
zxfluxt(i, k) = zxfluxt(i, k) + & |
zxfluxt(i, k) = zxfluxt(i, k) + fluxt(i, k, nsrf) * pctsrf(i, nsrf) |
955 |
fluxt(i, k, nsrf) * pctsrf(i, nsrf) |
zxfluxq(i, k) = zxfluxq(i, k) + fluxq(i, k, nsrf) * pctsrf(i, nsrf) |
956 |
zxfluxq(i, k) = zxfluxq(i, k) + & |
zxfluxu(i, k) = zxfluxu(i, k) + fluxu(i, k, nsrf) * pctsrf(i, nsrf) |
957 |
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) |
|
958 |
END DO |
END DO |
959 |
END DO |
END DO |
960 |
END DO |
END DO |
1085 |
|
|
1086 |
if (iflag_con == 2) then |
if (iflag_con == 2) then |
1087 |
z_avant = sum((q_seri + ql_seri) * zmasse, dim=2) |
z_avant = sum((q_seri + ql_seri) * zmasse, dim=2) |
1088 |
CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, & |
CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:-1), & |
1089 |
zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, & |
q_seri(:, llm:1:-1), conv_t, conv_q, zxfluxq(:, 1), omega, & |
1090 |
pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, & |
d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:-1), & |
1091 |
pmflxs) |
mfd(:, llm:1:-1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, & |
1092 |
|
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 |
ibas_con = llm + 1 - kcbot |
1096 |
ibas_con(i) = llm + 1 - kcbot(i) |
itop_con = llm + 1 - kctop |
|
itop_con(i) = llm + 1 - kctop(i) |
|
|
ENDDO |
|
1097 |
else |
else |
1098 |
! iflag_con >= 3 |
! iflag_con >= 3 |
1099 |
CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, & |
CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, & |
1108 |
! supprimer les calculs / ftra.) |
! supprimer les calculs / ftra.) |
1109 |
|
|
1110 |
clwcon0 = qcondc |
clwcon0 = qcondc |
1111 |
pmfu = upwd + dnwd |
mfu = upwd + dnwd |
1112 |
IF (.NOT. ok_gust) wd = 0. |
IF (.NOT. ok_gust) wd = 0. |
1113 |
|
|
1114 |
! Calcul des propriétés des nuages convectifs |
! Calcul des propriétés des nuages convectifs |
1118 |
zx_t = t_seri(i, k) |
zx_t = t_seri(i, k) |
1119 |
IF (thermcep) THEN |
IF (thermcep) THEN |
1120 |
zdelta = MAX(0., SIGN(1., rtt-zx_t)) |
zdelta = MAX(0., SIGN(1., rtt-zx_t)) |
1121 |
zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k) |
zx_qs = r2es * FOEEW(zx_t, zdelta) / play(i, k) |
1122 |
zx_qs = MIN(0.5, zx_qs) |
zx_qs = MIN(0.5, zx_qs) |
1123 |
zcor = 1./(1.-retv*zx_qs) |
zcor = 1./(1.-retv*zx_qs) |
1124 |
zx_qs = zx_qs*zcor |
zx_qs = zx_qs*zcor |
1134 |
ENDDO |
ENDDO |
1135 |
|
|
1136 |
! calcul des proprietes des nuages convectifs |
! calcul des proprietes des nuages convectifs |
1137 |
clwcon0 = fact_cldcon*clwcon0 |
clwcon0 = fact_cldcon * clwcon0 |
1138 |
call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, & |
call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, & |
1139 |
rnebcon0) |
rnebcon0) |
1140 |
END if |
END if |
1213 |
|
|
1214 |
! Caclul des ratqs |
! Caclul des ratqs |
1215 |
|
|
1216 |
! 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 |
1217 |
! on ecrase le tableau ratqsc calcule par clouds_gno |
! on écrase le tableau ratqsc calculé par clouds_gno |
1218 |
if (iflag_cldcon == 1) then |
if (iflag_cldcon == 1) then |
1219 |
do k = 1, llm |
do k = 1, llm |
1220 |
do i = 1, klon |
do i = 1, klon |
1221 |
if(ptconv(i, k)) then |
if(ptconv(i, k)) then |
1222 |
ratqsc(i, k) = ratqsbas & |
ratqsc(i, k) = ratqsbas + fact_cldcon & |
1223 |
+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) |
1224 |
else |
else |
1225 |
ratqsc(i, k) = 0. |
ratqsc(i, k) = 0. |
1226 |
endif |
endif |
1231 |
! ratqs stables |
! ratqs stables |
1232 |
do k = 1, llm |
do k = 1, llm |
1233 |
do i = 1, klon |
do i = 1, klon |
1234 |
ratqss(i, k) = ratqsbas + (ratqshaut-ratqsbas)* & |
ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) & |
1235 |
min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.) |
* min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.) |
1236 |
enddo |
enddo |
1237 |
enddo |
enddo |
1238 |
|
|
1242 |
! ratqs final |
! ratqs final |
1243 |
! 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 |
1244 |
! relaxation des ratqs |
! relaxation des ratqs |
1245 |
facteur = exp(-dtphys*facttemps) |
ratqs = max(ratqs * exp(- dtphys * facttemps), ratqss) |
|
ratqs = max(ratqs*facteur, ratqss) |
|
1246 |
ratqs = max(ratqs, ratqsc) |
ratqs = max(ratqs, ratqsc) |
1247 |
else |
else |
1248 |
! on ne prend que le ratqs stable pour fisrtilp |
! on ne prend que le ratqs stable pour fisrtilp |
1330 |
facteur = dtphys *facttemps |
facteur = dtphys *facttemps |
1331 |
do k = 1, llm |
do k = 1, llm |
1332 |
do i = 1, klon |
do i = 1, klon |
1333 |
rnebcon(i, k) = rnebcon(i, k)*facteur |
rnebcon(i, k) = rnebcon(i, k) * facteur |
1334 |
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)) & |
1335 |
then |
then |
1336 |
rnebcon(i, k) = rnebcon0(i, k) |
rnebcon(i, k) = rnebcon0(i, k) |
1552 |
|
|
1553 |
! Calcul des tendances traceurs |
! Calcul des tendances traceurs |
1554 |
call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, & |
call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, & |
1555 |
dtphys, u, t, paprs, play, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, & |
dtphys, u, t, paprs, play, mfu, mfd, pen_u, pde_u, pen_d, pde_d, & |
1556 |
ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, & |
ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, & |
1557 |
frac_nucl, pphis, albsol, rhcl, cldfra, rneb, diafra, cldliq, & |
frac_nucl, pphis, albsol, rhcl, cldfra, rneb, diafra, cldliq, & |
1558 |
pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse) |
pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse) |
1559 |
|
|
1560 |
IF (offline) THEN |
IF (offline) THEN |
1561 |
call phystokenc(dtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, & |
call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, pde_u, & |
1562 |
pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, & |
pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, & |
1563 |
pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap) |
pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap) |
1564 |
ENDIF |
ENDIF |