--- trunk/Sources/phylmd/phystokenc.f 2015/04/29 15:47:56 134 +++ trunk/Sources/phylmd/phystokenc.f 2016/09/01 10:30:53 207 @@ -4,23 +4,24 @@ contains - SUBROUTINE phystokenc(pdtphys, rlon, rlat, pt, pmfu, pmfd, pen_u, pde_u, & - pen_d, pde_d, pfm_therm, pentr_therm, pcoefh, yu1, yv1, ftsol, pctsrf, & - frac_impa, frac_nucl, pphis, paire, dtime, itap) + SUBROUTINE phystokenc(pdtphys, pt, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, & + pfm_therm, pentr_therm, pcoefh, yu1, yv1, ftsol, pctsrf, frac_impa, & + frac_nucl, pphis, paire, dtime) ! From phylmd/phystokenc.F, version 1.2 2004/06/22 11:45:35 - ! Author: Frédéric Hourdin - ! Objet : écriture des variables pour transport offline + ! Author: Fr\'ed\'eric Hourdin + ! Objet : \'ecriture des variables pour transport offline + use gr_phy_write_m, only: gr_phy_write USE histwrite_m, ONLY: histwrite USE histsync_m, ONLY: histsync - USE dimens_m, ONLY: iim, jjm, nqmx USE indicesol, ONLY: nbsrf + use initphysto_m, only: initphysto USE dimphy, ONLY: klev, klon + use time_phylmdz, only: itap USE tracstoke, ONLY: istphy REAL, INTENT (IN):: pdtphys ! pas d'integration pour la physique (seconde) - REAL, INTENT (IN):: rlon(klon), rlat(klon) REAL, intent(in):: pt(klon, klev) ! convection: @@ -40,35 +41,31 @@ ! flux detraine dans le panache descendant ! Les Thermiques - REAL pfm_therm(klon, klev+1) - REAL pentr_therm(klon, klev) + REAL, intent(in):: pfm_therm(klon, klev+1) + REAL, intent(in):: pentr_therm(klon, klev) ! Couche limite: - - REAL pcoefh(klon, klev) ! coeff melange Couche limite - REAL yu1(klon) - REAL yv1(klon) + REAL, intent(in):: pcoefh(klon, klev) ! coeff melange Couche limite + REAL, intent(in):: yu1(klon) + REAL, intent(in):: yv1(klon) ! Arguments necessaires pour les sources et puits de traceur - REAL ftsol(klon, nbsrf) ! Temperature du sol (surf)(Kelvin) - REAL pctsrf(klon, nbsrf) ! Pourcentage de sol f(nature du sol) - - ! Lessivage: + REAL, intent(in):: ftsol(klon, nbsrf) ! Temperature du sol (surf)(Kelvin) + REAL, intent(in):: pctsrf(klon, nbsrf) ! Pourcentage de sol f(nature du sol) - REAL frac_impa(klon, klev) - REAL frac_nucl(klon, klev) + ! Coefficients de lessivage: + REAL, intent(in):: frac_impa(klon, klev) ! facteur d'impaction + REAL, intent(in):: frac_nucl(klon, klev) ! facteur de nucleation REAL, INTENT(IN):: pphis(klon) - real paire(klon) + real, intent(in):: paire(klon) REAL, INTENT (IN):: dtime - INTEGER, INTENT (IN):: itap - ! Variables local to the procedure: + ! Local: real t(klon, klev) INTEGER, SAVE:: physid - REAL zx_tmp_3d(iim, jjm+1, klev), zx_tmp_2d(iim, jjm+1) ! Les Thermiques @@ -94,8 +91,6 @@ REAL dtcum INTEGER:: iadvtr = 0, irec = 1 - REAL zmin, zmax - LOGICAL ok_sync SAVE t, mfd, en_u, de_u, en_d, de_d, coefh, dtcum SAVE fm_therm, entr_therm @@ -105,21 +100,11 @@ ! Couche limite: - ok_sync = .TRUE. - - IF (iadvtr==0) THEN - CALL initphysto('phystoke', rlon, rlat, dtime, dtime*istphy, & - dtime*istphy, nqmx, physid) - END IF - - i = itap - CALL gr_fi_ecrit(1, klon, iim, jjm+1, pphis, zx_tmp_2d) - CALL histwrite(physid, 'phis', i, zx_tmp_2d) - - i = itap - CALL gr_fi_ecrit(1, klon, iim, jjm+1, paire, zx_tmp_2d) - CALL histwrite(physid, 'aire', i, zx_tmp_2d) + IF (iadvtr==0) CALL initphysto('phystoke', dtime, dtime * istphy, & + dtime * istphy, physid) + CALL histwrite(physid, 'phis', itap, gr_phy_write(pphis)) + CALL histwrite(physid, 'aire', itap, gr_phy_write(paire)) iadvtr = iadvtr + 1 IF (mod(iadvtr, istphy) == 1 .OR. istphy == 1) THEN @@ -154,26 +139,26 @@ DO k = 1, klev DO i = 1, klon - mfu(i, k) = mfu(i, k) + pmfu(i, k)*pdtphys - mfd(i, k) = mfd(i, k) + pmfd(i, k)*pdtphys - en_u(i, k) = en_u(i, k) + pen_u(i, k)*pdtphys - de_u(i, k) = de_u(i, k) + pde_u(i, k)*pdtphys - en_d(i, k) = en_d(i, k) + pen_d(i, k)*pdtphys - de_d(i, k) = de_d(i, k) + pde_d(i, k)*pdtphys - coefh(i, k) = coefh(i, k) + pcoefh(i, k)*pdtphys - t(i, k) = t(i, k) + pt(i, k)*pdtphys - fm_therm(i, k) = fm_therm(i, k) + pfm_therm(i, k)*pdtphys - entr_therm(i, k) = entr_therm(i, k) + pentr_therm(i, k)*pdtphys + mfu(i, k) = mfu(i, k) + pmfu(i, k) * pdtphys + mfd(i, k) = mfd(i, k) + pmfd(i, k) * pdtphys + en_u(i, k) = en_u(i, k) + pen_u(i, k) * pdtphys + de_u(i, k) = de_u(i, k) + pde_u(i, k) * pdtphys + en_d(i, k) = en_d(i, k) + pen_d(i, k) * pdtphys + de_d(i, k) = de_d(i, k) + pde_d(i, k) * pdtphys + coefh(i, k) = coefh(i, k) + pcoefh(i, k) * pdtphys + t(i, k) = t(i, k) + pt(i, k) * pdtphys + fm_therm(i, k) = fm_therm(i, k) + pfm_therm(i, k) * pdtphys + entr_therm(i, k) = entr_therm(i, k) + pentr_therm(i, k) * pdtphys END DO END DO DO i = 1, klon - pyv1(i) = pyv1(i) + yv1(i)*pdtphys - pyu1(i) = pyu1(i) + yu1(i)*pdtphys + pyv1(i) = pyv1(i) + yv1(i) * pdtphys + pyu1(i) = pyu1(i) + yu1(i) * pdtphys END DO DO k = 1, nbsrf DO i = 1, klon - pftsol(i, k) = pftsol(i, k) + ftsol(i, k)*pdtphys - ppsrf(i, k) = ppsrf(i, k) + pctsrf(i, k)*pdtphys + pftsol(i, k) = pftsol(i, k) + ftsol(i, k) * pdtphys + ppsrf(i, k) = ppsrf(i, k) + pctsrf(i, k) * pdtphys END DO END DO @@ -190,7 +175,6 @@ en_d(i, k) = en_d(i, k)/dtcum de_d(i, k) = de_d(i, k)/dtcum coefh(i, k) = coefh(i, k)/dtcum - ! Unitel a enlever t(i, k) = t(i, k)/dtcum fm_therm(i, k) = fm_therm(i, k)/dtcum entr_therm(i, k) = entr_therm(i, k)/dtcum @@ -216,93 +200,40 @@ END DO END DO - ! ecriture des champs + ! \'Ecriture des champs irec = irec + 1 - CALL gr_fi_ecrit(klev, klon, iim, jjm+1, t, zx_tmp_3d) - CALL histwrite(physid, 't', itap, zx_tmp_3d) - - CALL gr_fi_ecrit(klev, klon, iim, jjm+1, mfu, zx_tmp_3d) - CALL histwrite(physid, 'mfu', itap, zx_tmp_3d) - CALL gr_fi_ecrit(klev, klon, iim, jjm+1, mfd, zx_tmp_3d) - CALL histwrite(physid, 'mfd', itap, zx_tmp_3d) - CALL gr_fi_ecrit(klev, klon, iim, jjm+1, en_u, zx_tmp_3d) - CALL histwrite(physid, 'en_u', itap, zx_tmp_3d) - CALL gr_fi_ecrit(klev, klon, iim, jjm+1, de_u, zx_tmp_3d) - CALL histwrite(physid, 'de_u', itap, zx_tmp_3d) - CALL gr_fi_ecrit(klev, klon, iim, jjm+1, en_d, zx_tmp_3d) - CALL histwrite(physid, 'en_d', itap, zx_tmp_3d) - CALL gr_fi_ecrit(klev, klon, iim, jjm+1, de_d, zx_tmp_3d) - CALL histwrite(physid, 'de_d', itap, zx_tmp_3d) - CALL gr_fi_ecrit(klev, klon, iim, jjm+1, coefh, zx_tmp_3d) - CALL histwrite(physid, 'coefh', itap, zx_tmp_3d) - + CALL histwrite(physid, 't', itap, gr_phy_write(t)) + CALL histwrite(physid, 'mfu', itap, gr_phy_write(mfu)) + CALL histwrite(physid, 'mfd', itap, gr_phy_write(mfd)) + CALL histwrite(physid, 'en_u', itap, gr_phy_write(en_u)) + CALL histwrite(physid, 'de_u', itap, gr_phy_write(de_u)) + CALL histwrite(physid, 'en_d', itap, gr_phy_write(en_d)) + CALL histwrite(physid, 'de_d', itap, gr_phy_write(de_d)) + CALL histwrite(physid, 'coefh', itap, gr_phy_write(coefh)) DO k = 1, klev DO i = 1, klon fm_therm1(i, k) = fm_therm(i, k) END DO END DO - CALL gr_fi_ecrit(klev, klon, iim, jjm+1, fm_therm1, zx_tmp_3d) - CALL histwrite(physid, 'fm_th', itap, zx_tmp_3d) - - CALL gr_fi_ecrit(klev, klon, iim, jjm+1, entr_therm, zx_tmp_3d) - CALL histwrite(physid, 'en_th', itap, zx_tmp_3d) - !ccc - CALL gr_fi_ecrit(klev, klon, iim, jjm+1, frac_impa, zx_tmp_3d) - CALL histwrite(physid, 'frac_impa', itap, zx_tmp_3d) - - CALL gr_fi_ecrit(klev, klon, iim, jjm+1, frac_nucl, zx_tmp_3d) - CALL histwrite(physid, 'frac_nucl', itap, zx_tmp_3d) - - CALL gr_fi_ecrit(1, klon, iim, jjm+1, pyu1, zx_tmp_2d) - CALL histwrite(physid, 'pyu1', itap, zx_tmp_2d) - - CALL gr_fi_ecrit(1, klon, iim, jjm+1, pyv1, zx_tmp_2d) - CALL histwrite(physid, 'pyv1', itap, zx_tmp_2d) - - CALL gr_fi_ecrit(1, klon, iim, jjm+1, pftsol1, zx_tmp_2d) - CALL histwrite(physid, 'ftsol1', itap, zx_tmp_2d) - CALL gr_fi_ecrit(1, klon, iim, jjm+1, pftsol2, zx_tmp_2d) - CALL histwrite(physid, 'ftsol2', itap, zx_tmp_2d) - CALL gr_fi_ecrit(1, klon, iim, jjm+1, pftsol3, zx_tmp_2d) - CALL histwrite(physid, 'ftsol3', itap, zx_tmp_2d) - CALL gr_fi_ecrit(1, klon, iim, jjm+1, pftsol4, zx_tmp_2d) - CALL histwrite(physid, 'ftsol4', itap, zx_tmp_2d) - - CALL gr_fi_ecrit(1, klon, iim, jjm+1, ppsrf1, zx_tmp_2d) - CALL histwrite(physid, 'psrf1', itap, zx_tmp_2d) - CALL gr_fi_ecrit(1, klon, iim, jjm+1, ppsrf2, zx_tmp_2d) - CALL histwrite(physid, 'psrf2', itap, zx_tmp_2d) - CALL gr_fi_ecrit(1, klon, iim, jjm+1, ppsrf3, zx_tmp_2d) - CALL histwrite(physid, 'psrf3', itap, zx_tmp_2d) - CALL gr_fi_ecrit(1, klon, iim, jjm+1, ppsrf4, zx_tmp_2d) - CALL histwrite(physid, 'psrf4', itap, zx_tmp_2d) - - IF (ok_sync) CALL histsync(physid) + CALL histwrite(physid, 'fm_th', itap, gr_phy_write(fm_therm1)) + CALL histwrite(physid, 'en_th', itap, gr_phy_write(entr_therm)) + CALL histwrite(physid, 'frac_impa', itap, gr_phy_write(frac_impa)) + CALL histwrite(physid, 'frac_nucl', itap, gr_phy_write(frac_nucl)) + CALL histwrite(physid, 'pyu1', itap, gr_phy_write(pyu1)) + CALL histwrite(physid, 'pyv1', itap, gr_phy_write(pyv1)) + CALL histwrite(physid, 'ftsol1', itap, gr_phy_write(pftsol1)) + CALL histwrite(physid, 'ftsol2', itap, gr_phy_write(pftsol2)) + CALL histwrite(physid, 'ftsol3', itap, gr_phy_write(pftsol3)) + CALL histwrite(physid, 'ftsol4', itap, gr_phy_write(pftsol4)) + CALL histwrite(physid, 'psrf1', itap, gr_phy_write(ppsrf1)) + CALL histwrite(physid, 'psrf2', itap, gr_phy_write(ppsrf2)) + CALL histwrite(physid, 'psrf3', itap, gr_phy_write(ppsrf3)) + CALL histwrite(physid, 'psrf4', itap, gr_phy_write(ppsrf4)) - ! Test sur la valeur des coefficients de lessivage - - zmin = 1E33 - zmax = -1E33 - DO k = 1, klev - DO i = 1, klon - zmax = max(zmax, frac_nucl(i, k)) - zmin = min(zmin, frac_nucl(i, k)) - END DO - END DO - PRINT *, 'coefs de lessivage (min et max)' - PRINT *, 'facteur de nucleation ', zmin, zmax - zmin = 1E33 - zmax = -1E33 - DO k = 1, klev - DO i = 1, klon - zmax = max(zmax, frac_impa(i, k)) - zmin = min(zmin, frac_impa(i, k)) - END DO - END DO - PRINT *, 'facteur d impaction ', zmin, zmax + CALL histsync(physid) END IF END SUBROUTINE phystokenc