--- trunk/phylmd/Interface_surf/clqh.f 2018/07/26 13:23:28 295 +++ trunk/phylmd/Interface_surf/clqh.f 2018/08/02 17:23:07 301 @@ -4,24 +4,23 @@ contains - SUBROUTINE clqh(dtime, julien, debut, nisurf, knindex, tsoil, qsol, rmu0, & - rugos, rugoro, u1lay, v1lay, coef, tq_cdrag, t, q, ts, paprs, pplay, & - delp, radsol, albedo, snow, qsurf, precip_rain, precip_snow, fluxlat, & - pctsrf_new_sic, agesno, d_t, d_q, d_ts, z0_new, flux_t, flux_q, & - dflux_s, dflux_l, fqcalving, ffonte, run_off_lic_0) + SUBROUTINE clqh(julien, nisurf, knindex, tsoil, qsol, mu0, rugos, rugoro, & + u1lay, v1lay, coef, tq_cdrag, t, q, ts, paprs, pplay, delp, radsol, & + albedo, snow, qsurf, precip_rain, precip_snow, fluxlat, pctsrf_new_sic, & + agesno, d_t, d_q, d_ts, z0_new, flux_t, flux_q, dflux_s, dflux_l, & + fqcalving, ffonte, run_off_lic_0, run_off_lic) ! Author: Z. X. Li (LMD/CNRS) ! Date: 1993 Aug. 18th ! Objet : diffusion verticale de "q" et de "h" use climb_hq_down_m, only: climb_hq_down - USE dimphy, ONLY: klev, klon + use climb_hq_up_m, only: climb_hq_up + USE dimphy, ONLY: klev USE interfsurf_hq_m, ONLY: interfsurf_hq - USE suphec_m, ONLY: rcpd + USE suphec_m, ONLY: rkappa - REAL, intent(in):: dtime ! intervalle du temps (s) integer, intent(in):: julien ! jour de l'annee en cours - logical, intent(in):: debut integer, intent(in):: nisurf integer, intent(in):: knindex(:) ! (knon) REAL, intent(inout):: tsoil(:, :) ! (knon, nsoilmx) @@ -29,7 +28,7 @@ REAL, intent(inout):: qsol(:) ! (knon) ! column-density of water in soil, in kg m-2 - real, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal + real, intent(in):: mu0(:) ! (knon) cosinus de l'angle solaire zenithal real, intent(in):: rugos(:) ! (knon) rugosite REAL, intent(in):: rugoro(:) ! (knon) @@ -64,14 +63,14 @@ REAL, intent(out):: qsurf(:) ! (knon) ! humidite de l'air au dessus de la surface - real, intent(in):: precip_rain(klon) + real, intent(in):: precip_rain(:) ! (knon) ! liquid water mass flux (kg / m2 / s), positive down - real, intent(in):: precip_snow(klon) + real, intent(in):: precip_snow(:) ! (knon) ! solid water mass flux (kg / m2 / s), positive down real, intent(out):: fluxlat(:) ! (knon) - real, intent(in):: pctsrf_new_sic(:) ! (klon) + real, intent(in):: pctsrf_new_sic(:) ! (knon) REAL, intent(inout):: agesno(:) ! (knon) REAL, intent(out):: d_t(:, :) ! (knon, klev) incrementation de "t" REAL, intent(out):: d_q(:, :) ! (knon, klev) incrementation de "q" @@ -92,45 +91,37 @@ ! Flux d'eau "perdue" par la surface et n\'ecessaire pour que limiter la ! hauteur de neige, en kg / m2 / s - REAL ffonte(klon) - ! Flux thermique utiliser pour fondre la neige + REAL, intent(out):: ffonte(:) ! (knon) + ! flux thermique utilis\'e pour fondre la neige + + REAL, intent(inout):: run_off_lic_0(:) ! (knon) + ! run-off glacier au pas de temps precedent - REAL run_off_lic_0(klon)! runof glacier au pas de temps precedent + REAL, intent(OUT):: run_off_lic(:) ! (knon) ruissellement total ! Local: INTEGER k REAL evap(size(knindex)) ! (knon) evaporation au sol REAL, dimension(size(knindex), klev):: cq, dq, ch, dh ! (knon, klev) - REAL h(size(knindex), klev) ! (knon, klev) enthalpie potentielle - REAL local_q(size(knindex), klev) ! (knon, klev) REAL pkf(size(knindex), klev) ! (knon, klev) real tsurf_new(size(knindex)) ! (knon) !---------------------------------------------------------------- - call climb_hq_down(pkf, cq, dq, ch, dh, paprs, pplay, t, coef, dtime, & - delp, q) - CALL interfsurf_hq(dtime, julien, rmu0, nisurf, knindex, debut, tsoil, & - qsol, u1lay, v1lay, t(:, 1), q(:, 1), tq_cdrag, ch(:, 1), cq(:, 1), & - dh(:, 1), dq(:, 1), precip_rain, precip_snow, rugos, rugoro, snow, & - qsurf, ts, pplay(:, 1), paprs(:, 1), radsol, evap, flux_t, fluxlat, & - dflux_l, dflux_s, tsurf_new, albedo, z0_new, pctsrf_new_sic, agesno, & - fqcalving, ffonte, run_off_lic_0) + forall (k = 1:klev) pkf(:, k) = (paprs(:, 1) / pplay(:, k))**RKAPPA + ! (La pression de r\'ef\'erence est celle au sol.) + call climb_hq_down(pkf, cq, dq, ch, dh, paprs, pplay, t, coef, delp, q) + CALL interfsurf_hq(julien, mu0, nisurf, knindex, tsoil, qsol, u1lay, & + v1lay, t(:, 1), q(:, 1), tq_cdrag, ch(:, 1), cq(:, 1), dh(:, 1), & + dq(:, 1), precip_rain, precip_snow, rugos, rugoro, snow, qsurf, ts, & + pplay(:, 1), paprs(:, 1), radsol, evap, flux_t, fluxlat, dflux_l, & + dflux_s, tsurf_new, albedo, z0_new, pctsrf_new_sic, agesno, & + fqcalving, ffonte, run_off_lic_0, run_off_lic) flux_q = - evap d_ts = tsurf_new - ts - - h(:, 1) = ch(:, 1) + dh(:, 1) * flux_t * dtime - local_q(:, 1) = cq(:, 1) + dq(:, 1) * flux_q * dtime - - DO k = 2, klev - h(:, k) = ch(:, k) + dh(:, k) * h(:, k - 1) - local_q(:, k) = cq(:, k) + dq(:, k) * local_q(:, k - 1) - ENDDO - - d_t = h / pkf / RCPD - t - d_q = local_q - q + call climb_hq_up(d_t, d_q, cq, dq, ch, dh, flux_t, flux_q, pkf, t, q) END SUBROUTINE clqh