7 |
|
|
8 |
contains |
contains |
9 |
|
|
10 |
SUBROUTINE phytrac(julien, gmtime, firstcal, lafin, pdtphys, t_seri, paprs, & |
SUBROUTINE phytrac(julien, gmtime, firstcal, lafin, t_seri, paprs, pplay, & |
11 |
pplay, pmfu, pmfd, pde_u, pen_d, coefh, fm_therm, entr_therm, yu1, & |
pmfu, pmfd, pde_u, pen_d, coefh, cdragh, fm_therm, entr_therm, yu1, & |
12 |
yv1, ftsol, pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, dnwd, & |
yv1, ftsol, pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, dnwd, & |
13 |
tr_seri, zmasse, ncid_startphy) |
tr_seri, zmasse, ncid_startphy) |
14 |
|
|
32 |
use clesphys2, only: conv_emanuel |
use clesphys2, only: conv_emanuel |
33 |
use cltrac_m, only: cltrac |
use cltrac_m, only: cltrac |
34 |
use cltracrn_m, only: cltracrn |
use cltracrn_m, only: cltracrn |
35 |
|
use comconst, only: dtphys |
36 |
USE conf_gcm_m, ONLY: lmt_pas |
USE conf_gcm_m, ONLY: lmt_pas |
37 |
use ctherm, only: iflag_thermals |
use ctherm, only: iflag_thermals |
38 |
use cvltr_m, only: cvltr |
use cvltr_m, only: cvltr |
39 |
use dimens_m, only: llm, nqmx |
use dimensions, only: llm, nqmx |
40 |
use dimphy, only: klon |
use dimphy, only: klon |
41 |
use histwrite_phy_m, only: histwrite_phy |
use histwrite_phy_m, only: histwrite_phy |
42 |
use indicesol, only: nbsrf |
use indicesol, only: nbsrf |
60 |
real, intent(in):: gmtime ! heure de la journ\'ee en fraction de jour |
real, intent(in):: gmtime ! heure de la journ\'ee en fraction de jour |
61 |
logical, intent(in):: firstcal ! first call to "calfis" |
logical, intent(in):: firstcal ! first call to "calfis" |
62 |
logical, intent(in):: lafin ! fin de la physique |
logical, intent(in):: lafin ! fin de la physique |
|
real, intent(in):: pdtphys ! pas d'integration pour la physique (s) |
|
63 |
real, intent(in):: t_seri(klon, llm) ! temperature, in K |
real, intent(in):: t_seri(klon, llm) ! temperature, in K |
64 |
|
|
65 |
real, intent(in):: paprs(klon, llm+1) |
real, intent(in):: paprs(klon, llm+1) |
77 |
|
|
78 |
REAL pde_u(klon, llm) ! flux detraine dans le panache montant |
REAL pde_u(klon, llm) ! flux detraine dans le panache montant |
79 |
REAL pen_d(klon, llm) ! flux entraine dans le panache descendant |
REAL pen_d(klon, llm) ! flux entraine dans le panache descendant |
80 |
REAL coefh(:, :) ! (klon, llm) coeff melange couche limite |
REAL coefh(:, 2:) ! (klon, 2:llm) coeff melange couche limite |
81 |
|
real cdragh(:) ! (klon) |
82 |
real fm_therm(klon, llm+1), entr_therm(klon, llm) ! thermiques |
real fm_therm(klon, llm+1), entr_therm(klon, llm) ! thermiques |
83 |
REAL, intent(in):: yu1(:), yv1(:) ! (klon) vent au premier niveau |
REAL, intent(in):: yu1(:), yv1(:) ! (klon) vent au premier niveau |
84 |
|
|
119 |
|
|
120 |
REAL, save:: trs(klon, nqmx - 2) ! Concentration de traceur dans le sol |
REAL, save:: trs(klon, nqmx - 2) ! Concentration de traceur dans le sol |
121 |
|
|
122 |
REAL masktr(klon, nqmx - 2) ! Masque reservoir de sol traceur |
REAL, save:: masktr(klon, nqmx - 2) ! Masque reservoir de sol traceur |
123 |
! Masque de l'echange avec la surface |
! Masque de l'echange avec la surface |
124 |
! (1 = reservoir) ou (possible => 1) |
! (1 = reservoir) ou (possible => 1) |
125 |
SAVE masktr |
|
126 |
REAL fshtr(klon, nqmx - 2) ! Flux surfacique dans le reservoir de sol |
REAL, save:: fshtr(klon, nqmx - 2) |
127 |
SAVE fshtr |
! Flux surfacique dans le reservoir de sol |
128 |
REAL hsoltr(nqmx - 2) ! Epaisseur equivalente du reservoir de sol |
|
129 |
SAVE hsoltr |
REAL, save:: hsoltr(nqmx - 2) ! Epaisseur equivalente du reservoir de sol |
130 |
REAL tautr(nqmx - 2) ! Constante de decroissance radioactive |
REAL, save:: tautr(nqmx - 2) ! constante de d\'ecroissance radioactive |
|
SAVE tautr |
|
|
REAL vdeptr(nqmx - 2) ! Vitesse de depot sec dans la couche Brownienne |
|
|
SAVE vdeptr |
|
|
REAL scavtr(nqmx - 2) ! Coefficient de lessivage |
|
|
SAVE scavtr |
|
131 |
|
|
132 |
|
REAL, save:: vdeptr(nqmx - 2) |
133 |
|
! Vitesse de depot sec dans la couche Brownienne |
134 |
|
|
135 |
|
REAL, save:: scavtr(nqmx - 2) ! Coefficient de lessivage |
136 |
CHARACTER itn |
CHARACTER itn |
137 |
|
|
138 |
logical, save:: aerosol(nqmx - 2) ! Nature du traceur |
logical, save:: aerosol(nqmx - 2) ! Nature du traceur |
217 |
! Calcul de l'effet de la convection |
! Calcul de l'effet de la convection |
218 |
DO it=1, nqmx - 2 |
DO it=1, nqmx - 2 |
219 |
if (conv_emanuel) then |
if (conv_emanuel) then |
220 |
call cvltr(pdtphys, da, phi, mp, paprs, tr_seri(:, :, it), upwd, & |
call cvltr(dtphys, da, phi, mp, paprs, tr_seri(:, :, it), upwd, & |
221 |
dnwd, d_tr_cv(:, :, it)) |
dnwd, d_tr_cv(:, :, it)) |
222 |
else |
else |
223 |
CALL nflxtr(pdtphys, pmfu, pmfd, pde_u, pen_d, paprs, & |
CALL nflxtr(dtphys, pmfu, pmfd, pde_u, pen_d, paprs, & |
224 |
tr_seri(:, :, it), d_tr_cv(:, :, it)) |
tr_seri(:, :, it), d_tr_cv(:, :, it)) |
225 |
endif |
endif |
226 |
|
|
252 |
DO it=1, nqmx - 2 |
DO it=1, nqmx - 2 |
253 |
do isplit=1, nsplit |
do isplit=1, nsplit |
254 |
! Thermiques |
! Thermiques |
255 |
call dqthermcell(klon, llm, pdtphys/nsplit & |
call dqthermcell(klon, llm, dtphys/nsplit & |
256 |
, fm_therm, entr_therm, zmasse & |
, fm_therm, entr_therm, zmasse & |
257 |
, tr_seri(1:klon, 1:llm, it), d_tr, ztra_th) |
, tr_seri(1:klon, 1:llm, it), d_tr, ztra_th) |
258 |
|
|
259 |
do k=1, llm |
do k=1, llm |
260 |
do i=1, klon |
do i=1, klon |
261 |
d_tr(i, k)=pdtphys*d_tr(i, k)/nsplit |
d_tr(i, k)=dtphys*d_tr(i, k)/nsplit |
262 |
d_tr_th(i, k, it)=d_tr_th(i, k, it)+d_tr(i, k) |
d_tr_th(i, k, it)=d_tr_th(i, k, it)+d_tr(i, k) |
263 |
tr_seri(i, k, it)=max(tr_seri(i, k, it)+d_tr(i, k), 0.) |
tr_seri(i, k, it)=max(tr_seri(i, k, it)+d_tr(i, k), 0.) |
264 |
enddo |
enddo |
279 |
DO it=1, nqmx - 2 |
DO it=1, nqmx - 2 |
280 |
if (clsol(it)) then |
if (clsol(it)) then |
281 |
! couche limite avec quantite dans le sol calculee |
! couche limite avec quantite dans le sol calculee |
282 |
CALL cltracrn(it, pdtphys, yu1, yv1, coefh(:, 2:llm), coefh(:, 1), & |
CALL cltracrn(it, dtphys, yu1, yv1, coefh, cdragh, t_seri, ftsol, & |
283 |
t_seri, ftsol, pctsrf, tr_seri(:, :, it), trs(:, it), paprs, & |
pctsrf, tr_seri(:, :, it), trs(:, it), paprs, pplay, delp, & |
284 |
pplay, delp, masktr(1, it), fshtr(1, it), hsoltr(it), & |
masktr(1, it), fshtr(1, it), hsoltr(it), tautr(it), & |
285 |
tautr(it), vdeptr(it), rlat, d_tr_cl(1, 1, it), d_trs) |
vdeptr(it), rlat, d_tr_cl(1, 1, it), d_trs) |
286 |
DO k = 1, llm |
DO k = 1, llm |
287 |
DO i = 1, klon |
DO i = 1, klon |
288 |
tr_seri(i, k, it) = tr_seri(i, k, it) + d_tr_cl(i, k, it) |
tr_seri(i, k, it) = tr_seri(i, k, it) + d_tr_cl(i, k, it) |
297 |
source(i) = 0. ! pas de source, pour l'instant |
source(i) = 0. ! pas de source, pour l'instant |
298 |
ENDDO |
ENDDO |
299 |
|
|
300 |
CALL cltrac(pdtphys, coefh(:, 2:llm), t_seri, tr_seri(:, :, it), source, & |
CALL cltrac(dtphys, coefh, t_seri, tr_seri(:, :, it), source, & |
301 |
paprs, pplay, delp, d_tr_cl(1, 1, it)) |
paprs, pplay, delp, d_tr_cl(1, 1, it)) |
302 |
DO k = 1, llm |
DO k = 1, llm |
303 |
DO i = 1, klon |
DO i = 1, klon |
311 |
|
|
312 |
! MAF il faudrait faire une modification pour passer dans radiornpb |
! MAF il faudrait faire une modification pour passer dans radiornpb |
313 |
! si radio=true |
! si radio=true |
314 |
d_tr_dec = radiornpb(tr_seri, pdtphys, tautr) |
d_tr_dec = radiornpb(tr_seri, dtphys, tautr) |
315 |
DO it = 1, nqmx - 2 |
DO it = 1, nqmx - 2 |
316 |
if (radio(it)) then |
if (radio(it)) then |
317 |
tr_seri(:, :, it) = tr_seri(:, :, it) + d_tr_dec(:, :, it) |
tr_seri(:, :, it) = tr_seri(:, :, it) + d_tr_dec(:, :, it) |
326 |
! Once per day, update the coefficients for ozone chemistry: |
! Once per day, update the coefficients for ozone chemistry: |
327 |
call regr_pr_comb_coefoz(julien, paprs, pplay) |
call regr_pr_comb_coefoz(julien, paprs, pplay) |
328 |
end if |
end if |
329 |
call o3_chem(julien, gmtime, t_seri, zmasse, pdtphys, tr_seri(:, :, 3)) |
call o3_chem(julien, gmtime, t_seri, zmasse, dtphys, tr_seri(:, :, 3)) |
330 |
end if |
end if |
331 |
|
|
332 |
! Calcul de l'effet de la precipitation |
! Calcul de l'effet de la precipitation |
370 |
DO i = 1, klon |
DO i = 1, klon |
371 |
flestottr(i, k, it) = flestottr(i, k, it) & |
flestottr(i, k, it) = flestottr(i, k, it) & |
372 |
- (d_tr_lessi_nucl(i, k, it) + d_tr_lessi_impa(i, k, it)) & |
- (d_tr_lessi_nucl(i, k, it) + d_tr_lessi_impa(i, k, it)) & |
373 |
* (paprs(i, k)-paprs(i, k+1)) / (RG * pdtphys) |
* (paprs(i, k)-paprs(i, k+1)) / (RG * dtphys) |
374 |
ENDDO |
ENDDO |
375 |
ENDDO |
ENDDO |
376 |
ENDDO |
ENDDO |