9 |
|
|
10 |
contains |
contains |
11 |
|
|
12 |
SUBROUTINE physiq (nq, debut, lafin, rjourvrai, gmtime, pdtphys, paprs, & |
SUBROUTINE physiq (nq, firstcal, lafin, rdayvrai, gmtime, pdtphys, paprs, & |
13 |
pplay, pphi, pphis, presnivs, clesphy0, u, v, t, qx, omega, d_u, d_v, & |
pplay, pphi, pphis, presnivs, clesphy0, u, v, t, qx, omega, d_u, d_v, & |
14 |
d_t, d_qx, d_ps, dudyn, PVteta) |
d_t, d_qx, d_ps, dudyn, PVteta) |
15 |
|
|
58 |
! Variables argument: |
! Variables argument: |
59 |
|
|
60 |
INTEGER nq ! input nombre de traceurs (y compris vapeur d'eau) |
INTEGER nq ! input nombre de traceurs (y compris vapeur d'eau) |
61 |
REAL rjourvrai ! input numero du jour de l'experience |
REAL, intent(in):: rdayvrai ! input numero du jour de l'experience |
62 |
REAL, intent(in):: gmtime ! heure de la journée en fraction de jour |
REAL, intent(in):: gmtime ! heure de la journée en fraction de jour |
63 |
REAL pdtphys ! input pas d'integration pour la physique (seconde) |
REAL pdtphys ! input pas d'integration pour la physique (seconde) |
64 |
LOGICAL, intent(in):: debut ! premier passage |
LOGICAL, intent(in):: firstcal ! first call to "calfis" |
65 |
logical, intent(in):: lafin ! dernier passage |
logical, intent(in):: lafin ! dernier passage |
66 |
|
|
67 |
REAL, intent(in):: paprs(klon, llm+1) |
REAL, intent(in):: paprs(klon, llm+1) |
319 |
PARAMETER ( longcles = 20 ) |
PARAMETER ( longcles = 20 ) |
320 |
REAL clesphy0( longcles ) |
REAL clesphy0( longcles ) |
321 |
|
|
|
! Variables quasi-arguments |
|
|
|
|
|
REAL xjour |
|
|
SAVE xjour |
|
|
|
|
322 |
! Variables propres a la physique |
! Variables propres a la physique |
323 |
|
|
324 |
REAL, SAVE:: dtime ! pas temporel de la physique (s) |
REAL, SAVE:: dtime ! pas temporel de la physique (s) |
330 |
REAL radsol(klon) |
REAL radsol(klon) |
331 |
SAVE radsol ! bilan radiatif au sol calcule par code radiatif |
SAVE radsol ! bilan radiatif au sol calcule par code radiatif |
332 |
|
|
333 |
INTEGER, SAVE:: itap ! compteur pour la physique |
INTEGER, SAVE:: itap ! number of calls to "physiq" |
334 |
REAL co2_ppm_etat0 |
REAL co2_ppm_etat0 |
335 |
REAL solaire_etat0 |
REAL solaire_etat0 |
336 |
|
|
467 |
|
|
468 |
INTEGER julien |
INTEGER julien |
469 |
|
|
470 |
INTEGER, SAVE:: lmt_pas ! fréquence de mise à jour |
INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day |
471 |
REAL pctsrf(klon, nbsrf) |
REAL pctsrf(klon, nbsrf) |
472 |
!IM |
!IM |
473 |
REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE |
REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE |
495 |
EXTERNAL transp ! transport total de l'eau et de l'energie |
EXTERNAL transp ! transport total de l'eau et de l'energie |
496 |
|
|
497 |
EXTERNAL ini_undefSTD !initialise a 0 une variable a 1 niveau de pression |
EXTERNAL ini_undefSTD !initialise a 0 une variable a 1 niveau de pression |
498 |
EXTERNAL undefSTD !somme les valeurs definies d'1 var a 1 niveau de pression |
|
499 |
|
EXTERNAL undefSTD |
500 |
|
! (somme les valeurs definies d'1 var a 1 niveau de pression) |
501 |
|
|
502 |
! Variables locales |
! Variables locales |
503 |
|
|
799 |
END DO |
END DO |
800 |
END IF |
END IF |
801 |
ok_sync=.TRUE. |
ok_sync=.TRUE. |
802 |
IF (nq .LT. 2) THEN |
IF (nq < 2) THEN |
803 |
abort_message = 'eaux vapeur et liquide sont indispensables' |
abort_message = 'eaux vapeur et liquide sont indispensables' |
804 |
CALL abort_gcm (modname, abort_message, 1) |
CALL abort_gcm (modname, abort_message, 1) |
805 |
ENDIF |
ENDIF |
806 |
|
|
807 |
xjour = rjourvrai |
test_firstcal: IF (firstcal) THEN |
|
|
|
|
test_debut: IF (debut) THEN |
|
808 |
! initialiser |
! initialiser |
809 |
u10m(:, :)=0. |
u10m(:, :)=0. |
810 |
v10m(:, :)=0. |
v10m(:, :)=0. |
927 |
ENDIF |
ENDIF |
928 |
|
|
929 |
lmt_pas = NINT(86400. / dtime) ! tous les jours |
lmt_pas = NINT(86400. / dtime) ! tous les jours |
930 |
print *, 'La frequence de lecture surface est de ', lmt_pas |
print *, 'Number of time steps of "physics" per day: ', lmt_pas |
931 |
|
|
932 |
ecrit_ins = NINT(ecrit_ins/dtime) |
ecrit_ins = NINT(ecrit_ins/dtime) |
933 |
ecrit_hf = NINT(ecrit_hf/dtime) |
ecrit_hf = NINT(ecrit_hf/dtime) |
959 |
CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0) |
CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0) |
960 |
!XXXPB Positionner date0 pour initialisation de ORCHIDEE |
!XXXPB Positionner date0 pour initialisation de ORCHIDEE |
961 |
WRITE(*, *) 'physiq date0 : ', date0 |
WRITE(*, *) 'physiq date0 : ', date0 |
962 |
ENDIF test_debut |
ENDIF test_firstcal |
963 |
|
|
964 |
! Mettre a zero des variables de sortie (pour securite) |
! Mettre a zero des variables de sortie (pour securite) |
965 |
|
|
1060 |
|
|
1061 |
! Incrementer le compteur de la physique |
! Incrementer le compteur de la physique |
1062 |
|
|
1063 |
itap = itap + 1 |
itap = itap + 1 |
1064 |
julien = MOD(NINT(xjour), 360) |
julien = MOD(NINT(rdayvrai), 360) |
1065 |
if (julien == 0) julien = 360 |
if (julien == 0) julien = 360 |
1066 |
|
|
1067 |
! Mettre en action les conditions aux limites (albedo, sst, etc.). |
! Mettre en action les conditions aux limites (albedo, sst, etc.). |
1159 |
fluxlat, rain_fall, snow_fall, & |
fluxlat, rain_fall, snow_fall, & |
1160 |
fsolsw, fsollw, sollwdown, fder, & |
fsolsw, fsollw, sollwdown, fder, & |
1161 |
rlon, rlat, cuphy, cvphy, frugs, & |
rlon, rlat, cuphy, cvphy, frugs, & |
1162 |
debut, lafin, agesno, rugoro, & |
firstcal, lafin, agesno, rugoro, & |
1163 |
d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, & |
d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, & |
1164 |
fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, & |
fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, & |
1165 |
q2, dsens, devap, & |
q2, dsens, devap, & |
1277 |
|
|
1278 |
DO nsrf = 1, nbsrf |
DO nsrf = 1, nbsrf |
1279 |
DO i = 1, klon |
DO i = 1, klon |
1280 |
IF (pctsrf(i, nsrf) .LT. epsfra) ftsol(i, nsrf) = zxtsol(i) |
IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i) |
1281 |
|
|
1282 |
IF (pctsrf(i, nsrf) .LT. epsfra) t2m(i, nsrf) = zt2m(i) |
IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i) |
1283 |
IF (pctsrf(i, nsrf) .LT. epsfra) q2m(i, nsrf) = zq2m(i) |
IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i) |
1284 |
IF (pctsrf(i, nsrf) .LT. epsfra) u10m(i, nsrf) = zu10m(i) |
IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i) |
1285 |
IF (pctsrf(i, nsrf) .LT. epsfra) v10m(i, nsrf) = zv10m(i) |
IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i) |
1286 |
IF (pctsrf(i, nsrf) .LT. epsfra) ffonte(i, nsrf) = zxffonte(i) |
IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i) |
1287 |
IF (pctsrf(i, nsrf) .LT. epsfra) & |
IF (pctsrf(i, nsrf) < epsfra) & |
1288 |
fqcalving(i, nsrf) = zxfqcalving(i) |
fqcalving(i, nsrf) = zxfqcalving(i) |
1289 |
IF (pctsrf(i, nsrf) .LT. epsfra) pblh(i, nsrf)=s_pblh(i) |
IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf)=s_pblh(i) |
1290 |
IF (pctsrf(i, nsrf) .LT. epsfra) plcl(i, nsrf)=s_lcl(i) |
IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf)=s_lcl(i) |
1291 |
IF (pctsrf(i, nsrf) .LT. epsfra) capCL(i, nsrf)=s_capCL(i) |
IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf)=s_capCL(i) |
1292 |
IF (pctsrf(i, nsrf) .LT. epsfra) oliqCL(i, nsrf)=s_oliqCL(i) |
IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf)=s_oliqCL(i) |
1293 |
IF (pctsrf(i, nsrf) .LT. epsfra) cteiCL(i, nsrf)=s_cteiCL(i) |
IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf)=s_cteiCL(i) |
1294 |
IF (pctsrf(i, nsrf) .LT. epsfra) pblT(i, nsrf)=s_pblT(i) |
IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf)=s_pblT(i) |
1295 |
IF (pctsrf(i, nsrf) .LT. epsfra) therm(i, nsrf)=s_therm(i) |
IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf)=s_therm(i) |
1296 |
IF (pctsrf(i, nsrf) .LT. epsfra) trmb1(i, nsrf)=s_trmb1(i) |
IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf)=s_trmb1(i) |
1297 |
IF (pctsrf(i, nsrf) .LT. epsfra) trmb2(i, nsrf)=s_trmb2(i) |
IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf)=s_trmb2(i) |
1298 |
IF (pctsrf(i, nsrf) .LT. epsfra) trmb3(i, nsrf)=s_trmb3(i) |
IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf)=s_trmb3(i) |
1299 |
ENDDO |
ENDDO |
1300 |
ENDDO |
ENDDO |
1301 |
|
|
1406 |
zcor = 1./(1.-retv*zx_qs) |
zcor = 1./(1.-retv*zx_qs) |
1407 |
zx_qs = zx_qs*zcor |
zx_qs = zx_qs*zcor |
1408 |
ELSE |
ELSE |
1409 |
IF (zx_t.LT.t_coup) THEN |
IF (zx_t < t_coup) THEN |
1410 |
zx_qs = qsats(zx_t)/pplay(i, k) |
zx_qs = qsats(zx_t)/pplay(i, k) |
1411 |
ELSE |
ELSE |
1412 |
zx_qs = qsatl(zx_t)/pplay(i, k) |
zx_qs = qsatl(zx_t)/pplay(i, k) |
1476 |
DO k = 1, llm |
DO k = 1, llm |
1477 |
DO i = 1, klon |
DO i = 1, klon |
1478 |
IF (z_factor(i).GT.(1.0+1.0E-08) .OR. & |
IF (z_factor(i).GT.(1.0+1.0E-08) .OR. & |
1479 |
z_factor(i).LT.(1.0-1.0E-08)) THEN |
z_factor(i) < (1.0-1.0E-08)) THEN |
1480 |
q_seri(i, k) = q_seri(i, k) * z_factor(i) |
q_seri(i, k) = q_seri(i, k) * z_factor(i) |
1481 |
ENDIF |
ENDIF |
1482 |
ENDDO |
ENDDO |
1496 |
IF(prt_level>9)WRITE(lunout, *) & |
IF(prt_level>9)WRITE(lunout, *) & |
1497 |
'AVANT LA CONVECTION SECHE, iflag_thermals=' & |
'AVANT LA CONVECTION SECHE, iflag_thermals=' & |
1498 |
, iflag_thermals, ' nsplit_thermals=', nsplit_thermals |
, iflag_thermals, ' nsplit_thermals=', nsplit_thermals |
1499 |
if(iflag_thermals.lt.0) then |
if(iflag_thermals < 0) then |
1500 |
! Rien |
! Rien |
1501 |
IF(prt_level>9)WRITE(lunout, *)'pas de convection' |
IF(prt_level>9)WRITE(lunout, *)'pas de convection' |
1502 |
else if(iflag_thermals == 0) then |
else if(iflag_thermals == 0) then |
1621 |
rain_tiedtke=0. |
rain_tiedtke=0. |
1622 |
do k=1, llm |
do k=1, llm |
1623 |
do i=1, klon |
do i=1, klon |
1624 |
if (d_q_con(i, k).lt.0.) then |
if (d_q_con(i, k) < 0.) then |
1625 |
rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys & |
rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys & |
1626 |
*(paprs(i, k)-paprs(i, k+1))/rg |
*(paprs(i, k)-paprs(i, k+1))/rg |
1627 |
endif |
endif |
1643 |
ENDDO |
ENDDO |
1644 |
|
|
1645 |
ELSE IF (iflag_cldcon == 3) THEN |
ELSE IF (iflag_cldcon == 3) THEN |
1646 |
! On prend pour les nuages convectifs le max du calcul de la |
! On prend pour les nuages convectifs le max du calcul de la |
1647 |
! convection et du calcul du pas de temps précédent diminué d'un facteur |
! convection et du calcul du pas de temps précédent diminué d'un facteur |
1648 |
! facttemps |
! facttemps |
1649 |
facteur = pdtphys *facttemps |
facteur = pdtphys *facttemps |
1650 |
do k=1, llm |
do k=1, llm |
1651 |
do i=1, klon |
do i=1, klon |
1704 |
zcor = 1./(1.-retv*zx_qs) |
zcor = 1./(1.-retv*zx_qs) |
1705 |
zx_qs = zx_qs*zcor |
zx_qs = zx_qs*zcor |
1706 |
ELSE |
ELSE |
1707 |
IF (zx_t.LT.t_coup) THEN |
IF (zx_t < t_coup) THEN |
1708 |
zx_qs = qsats(zx_t)/pplay(i, k) |
zx_qs = qsats(zx_t)/pplay(i, k) |
1709 |
ELSE |
ELSE |
1710 |
zx_qs = qsatl(zx_t)/pplay(i, k) |
zx_qs = qsatl(zx_t)/pplay(i, k) |
1718 |
!jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr) |
!jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr) |
1719 |
IF (ok_ade.OR.ok_aie) THEN |
IF (ok_ade.OR.ok_aie) THEN |
1720 |
! Get sulfate aerosol distribution |
! Get sulfate aerosol distribution |
1721 |
CALL readsulfate(rjourvrai, debut, sulfate) |
CALL readsulfate(rdayvrai, firstcal, sulfate) |
1722 |
CALL readsulfate_preind(rjourvrai, debut, sulfate_pi) |
CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi) |
1723 |
|
|
1724 |
! Calculate aerosol optical properties (Olivier Boucher) |
! Calculate aerosol optical properties (Olivier Boucher) |
1725 |
CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, & |
CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, & |
1909 |
|
|
1910 |
!IM calcul composantes axiales du moment angulaire et couple des montagnes |
!IM calcul composantes axiales du moment angulaire et couple des montagnes |
1911 |
|
|
1912 |
CALL aaam_bud (27, klon, llm, rjourvrai, gmtime, & |
CALL aaam_bud (27, klon, llm, gmtime, & |
1913 |
ra, rg, romega, & |
ra, rg, romega, & |
1914 |
rlat, rlon, pphis, & |
rlat, rlon, pphis, & |
1915 |
zustrdr, zustrli, zustrph, & |
zustrdr, zustrli, zustrph, & |
1928 |
|
|
1929 |
! Calcul des tendances traceurs |
! Calcul des tendances traceurs |
1930 |
|
|
1931 |
call phytrac(rnpb, itap, julien, gmtime, debut, lafin, nq-2, & |
call phytrac(rnpb, itap, lmt_pas, julien, gmtime, firstcal, lafin, nq-2, & |
1932 |
dtime, u, v, t, paprs, pplay, & |
dtime, u, v, t, paprs, pplay, & |
1933 |
pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, & |
pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, & |
1934 |
ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, & |
ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, & |
2222 |
|
|
2223 |
ENDDO !k=1, nlevSTD |
ENDDO !k=1, nlevSTD |
2224 |
|
|
2225 |
!IM on somme les valeurs definies a chaque pas de temps de la physique ou |
!IM on somme les valeurs definies a chaque pas de temps de la |
2226 |
!IM toutes les 6 heures |
! physique ou toutes les 6 heures |
2227 |
|
|
2228 |
oknondef(1:klon, 1:nlevSTD, 1:nout)=.TRUE. |
oknondef(1:klon, 1:nlevSTD, 1:nout)=.TRUE. |
2229 |
CALL undefSTD(nlevSTD, itap, tlevSTD, & |
CALL undefSTD(nlevSTD, itap, tlevSTD, & |