--- trunk/phylmd/clqh.f 2018/07/20 16:46:48 282 +++ trunk/phylmd/clqh.f 2018/07/20 17:53:18 285 @@ -52,14 +52,17 @@ REAL, intent(in):: pplay(:, :) ! (knon, klev) ! pression au milieu de couche (Pa) - REAL delp(klon, klev) ! epaisseur de couche en pression (Pa) + REAL, intent(in):: delp(:, :) ! (knon, klev) + ! epaisseur de couche en pression (Pa) REAL, intent(in):: radsol(:) ! (knon) ! rayonnement net au sol (Solaire + IR) W / m2 REAL, intent(inout):: albedo(:) ! (knon) albedo de la surface REAL, intent(inout):: snow(:) ! (knon) ! hauteur de neige - REAL qsurf(klon) ! humidite de l'air au dessus de la surface + + REAL, intent(out):: qsurf(:) ! (knon) + ! humidite de l'air au dessus de la surface real, intent(in):: precip_rain(klon) ! liquid water mass flux (kg / m2 / s), positive down @@ -82,8 +85,8 @@ REAL, intent(out):: flux_q(:) ! (knon) ! flux de la vapeur d'eau à la surface, en kg / (m**2 s) - REAL dflux_s(:) ! (knon) derivee du flux sensible dF / dTs - REAL dflux_l(:) ! (knon) derivee du flux latent dF / dTs + REAL, intent(out):: dflux_s(:) ! (knon) derivee du flux sensible dF / dTs + REAL, intent(out):: dflux_l(:) ! (knon) derivee du flux latent dF / dTs REAL, intent(out):: fqcalving(:) ! (knon) ! Flux d'eau "perdue" par la surface et n\'ecessaire pour que limiter la @@ -95,11 +98,11 @@ REAL run_off_lic_0(klon)! runof glacier au pas de temps precedent ! Local: - INTEGER knon + + INTEGER knon, k REAL evap(size(knindex)) ! (knon) evaporation au sol - INTEGER i, k REAL, dimension(size(knindex), klev):: cq, dq, ch, dh ! (knon, klev) - REAL buf1(klon), buf2(klon) + REAL buf1(size(knindex)), buf2(size(knindex)) REAL zx_coef(size(knindex), 2:klev) ! (knon, 2:klev) REAL h(size(knindex), klev) ! (knon, klev) enthalpie potentielle REAL local_q(size(knindex), klev) ! (knon, klev) @@ -114,7 +117,6 @@ REAL gamah(size(knindex), 2:klev) ! (knon, 2:klev) real tsurf_new(size(knindex)) ! (knon) - real zzpk !---------------------------------------------------------------- @@ -139,51 +141,41 @@ ! Preparer les flux lies aux contre-gardients forall (k = 2:klev) gamah(:, k) = gamt(:, k) * (RD * (t(:, k - 1) & + t(:, k)) / 2. / RG / paprs(:, k) * (pplay(:, k - 1) - pplay(:, k))) & - * RCPD * (psref(:) / paprs(:, k))**RKAPPA + * RCPD * (psref / paprs(:, k))**RKAPPA - DO i = 1, knon - buf1(i) = zx_coef(i, klev) + delp(i, klev) - cq(i, klev) = q(i, klev) * delp(i, klev) / buf1(i) - dq(i, klev) = zx_coef(i, klev) / buf1(i) - - zzpk=(pplay(i, klev) / psref(i))**RKAPPA - buf2(i) = zzpk * delp(i, klev) + zx_coef(i, klev) - ch(i, klev) = (h(i, klev) * zzpk * delp(i, klev) & - - zx_coef(i, klev) * gamah(i, klev)) / buf2(i) - dh(i, klev) = zx_coef(i, klev) / buf2(i) - ENDDO + buf1 = zx_coef(:, klev) + delp(:, klev) + cq(:, klev) = q(:, klev) * delp(:, klev) / buf1 + dq(:, klev) = zx_coef(:, klev) / buf1 + + buf2 = delp(:, klev) / pkf(:, klev) + zx_coef(:, klev) + ch(:, klev) = (h(:, klev) / pkf(:, klev) * delp(:, klev) & + - zx_coef(:, klev) * gamah(:, klev)) / buf2 + dh(:, klev) = zx_coef(:, klev) / buf2 DO k = klev - 1, 2, - 1 - DO i = 1, knon - buf1(i) = delp(i, k) + zx_coef(i, k) & - + zx_coef(i, k + 1) * (1. - dq(i, k + 1)) - cq(i, k) = (q(i, k) * delp(i, k) & - + zx_coef(i, k + 1) * cq(i, k + 1)) / buf1(i) - dq(i, k) = zx_coef(i, k) / buf1(i) - - zzpk=(pplay(i, k) / psref(i))**RKAPPA - buf2(i) = zzpk * delp(i, k) + zx_coef(i, k) & - + zx_coef(i, k + 1) * (1. - dh(i, k + 1)) - ch(i, k) = (h(i, k) * zzpk * delp(i, k) & - + zx_coef(i, k + 1) * ch(i, k + 1) & - + zx_coef(i, k + 1) * gamah(i, k + 1) & - - zx_coef(i, k) * gamah(i, k)) / buf2(i) - dh(i, k) = zx_coef(i, k) / buf2(i) - ENDDO + buf1 = delp(:, k) + zx_coef(:, k) & + + zx_coef(:, k + 1) * (1. - dq(:, k + 1)) + cq(:, k) = (q(:, k) * delp(:, k) & + + zx_coef(:, k + 1) * cq(:, k + 1)) / buf1 + dq(:, k) = zx_coef(:, k) / buf1 + + buf2 = delp(:, k) / pkf(:, k) + zx_coef(:, k) & + + zx_coef(:, k + 1) * (1. - dh(:, k + 1)) + ch(:, k) = (h(:, k) / pkf(:, k) * delp(:, k) & + + zx_coef(:, k + 1) * ch(:, k + 1) & + + zx_coef(:, k + 1) * gamah(:, k + 1) & + - zx_coef(:, k) * gamah(:, k)) / buf2 + dh(:, k) = zx_coef(:, k) / buf2 ENDDO - DO i = 1, knon - buf1(i) = delp(i, 1) + zx_coef(i, 2) * (1. - dq(i, 2)) - cq(i, 1) = (q(i, 1) * delp(i, 1) & - + zx_coef(i, 2) * cq(i, 2)) / buf1(i) - dq(i, 1) = - 1. * RG / buf1(i) - - zzpk=(pplay(i, 1) / psref(i))**RKAPPA - buf2(i) = zzpk * delp(i, 1) + zx_coef(i, 2) * (1. - dh(i, 2)) - ch(i, 1) = (h(i, 1) * zzpk * delp(i, 1) & - + zx_coef(i, 2) * (gamah(i, 2) + ch(i, 2))) / buf2(i) - dh(i, 1) = - 1. * RG / buf2(i) - ENDDO + buf1 = delp(:, 1) + zx_coef(:, 2) * (1. - dq(:, 2)) + cq(:, 1) = (q(:, 1) * delp(:, 1) + zx_coef(:, 2) * cq(:, 2)) / buf1 + dq(:, 1) = - 1. * RG / buf1 + + buf2 = delp(:, 1) / pkf(:, 1) + zx_coef(:, 2) * (1. - dh(:, 2)) + ch(:, 1) = (h(:, 1) / pkf(:, 1) * delp(:, 1) & + + zx_coef(:, 2) * (gamah(:, 2) + ch(:, 2))) / buf2 + dh(:, 1) = - 1. * RG / buf2 CALL interfsurf_hq(dtime, julien, rmu0, nisurf, knindex, debut, tsoil, & qsol, u1lay, v1lay, t(:, 1), q(:, 1), tq_cdrag(:knon), ch(:, 1), &