--- trunk/phylmd/physiq.f 2014/03/12 21:16:36 90 +++ trunk/phylmd/physiq.f 2014/04/25 14:58:31 97 @@ -5,7 +5,7 @@ contains SUBROUTINE physiq(lafin, rdayvrai, time, dtphys, paprs, play, pphi, pphis, & - u, v, t, qx, omega, d_u, d_v, d_t, d_qx, d_ps) + u, v, t, qx, omega, d_u, d_v, d_t, d_qx) ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28 ! (subversion revision 678) @@ -18,7 +18,6 @@ USE abort_gcm_m, ONLY: abort_gcm use aeropt_m, only: aeropt use ajsec_m, only: ajsec - USE calendar, ONLY: ymds2ju use calltherm_m, only: calltherm USE clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, & ecrit_mth, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin @@ -60,16 +59,16 @@ USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt USE temps, ONLY: annee_ref, day_ref, itau_phy use unit_nml_m, only: unit_nml + USE ymds2ju_m, ONLY: ymds2ju USE yoethf_m, ONLY: r2es, rvtmp2 - ! Arguments: + logical, intent(in):: lafin ! dernier passage REAL, intent(in):: rdayvrai ! (elapsed time since January 1st 0h of the starting year, in days) REAL, intent(in):: time ! heure de la journ\'ee en fraction de jour REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde) - logical, intent(in):: lafin ! dernier passage REAL, intent(in):: paprs(klon, llm + 1) ! (pression pour chaque inter-couche, en Pa) @@ -78,9 +77,9 @@ ! (input pression pour le mileu de chaque couche (en Pa)) REAL, intent(in):: pphi(klon, llm) - ! (input geopotentiel de chaque couche (g z) (reference sol)) + ! géopotentiel de chaque couche (référence sol) - REAL, intent(in):: pphis(klon) ! input geopotentiel du sol + REAL, intent(in):: pphis(klon) ! géopotentiel du sol REAL, intent(in):: u(klon, llm) ! vitesse dans la direction X (de O a E) en m/s @@ -91,12 +90,13 @@ REAL, intent(in):: qx(klon, llm, nqmx) ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs) - REAL omega(klon, llm) ! input vitesse verticale en Pa/s - REAL, intent(out):: d_u(klon, llm) ! tendance physique de "u" (m/s/s) - REAL, intent(out):: d_v(klon, llm) ! tendance physique de "v" (m/s/s) + REAL, intent(in):: omega(klon, llm) ! vitesse verticale en Pa/s + REAL, intent(out):: d_u(klon, llm) ! tendance physique de "u" (m s-2) + REAL, intent(out):: d_v(klon, llm) ! tendance physique de "v" (m s-2) REAL, intent(out):: d_t(klon, llm) ! tendance physique de "t" (K/s) - REAL d_qx(klon, llm, nqmx) ! output tendance physique de "qx" (kg/kg/s) - REAL d_ps(klon) ! output tendance physique de la pression au sol + REAL, intent(out):: d_qx(klon, llm, nqmx) ! tendance physique de "qx" (s-1) + + ! Local: LOGICAL:: firstcal = .true. @@ -118,7 +118,8 @@ parameter(rnpb = .true.) character(len = 6):: ocean = 'force ' - ! (type de mod\`ele oc\'ean \`a utiliser: "force" ou "slab" mais pas "couple") + ! (type de mod\`ele oc\'ean \`a utiliser: "force" ou "slab" mais + ! pas "couple") ! "slab" ocean REAL, save:: tslab(klon) ! temperature of ocean slab @@ -154,14 +155,14 @@ real da(klon, llm), phi(klon, llm, llm), mp(klon, llm) - !IM Amip2 PV a theta constante + ! Amip2 PV a theta constante CHARACTER(LEN = 3) ctetaSTD(nbteta) DATA ctetaSTD/'350', '380', '405'/ REAL rtetaSTD(nbteta) DATA rtetaSTD/350., 380., 405./ - !MI Amip2 PV a theta constante + ! Amip2 PV a theta constante REAL swdn0(klon, llm + 1), swdn(klon, llm + 1) REAL swup0(klon, llm + 1), swup(klon, llm + 1) @@ -171,7 +172,7 @@ REAL lwup0(klon, llm + 1), lwup(klon, llm + 1) SAVE lwdn0, lwdn, lwup0, lwup - !IM Amip2 + ! Amip2 ! variables a une pression donnee integer nlevSTD @@ -240,10 +241,7 @@ 'pc= 440-560hPa, tau> 60.', 'pc= 560-680hPa, tau> 60.', & 'pc= 680-800hPa, tau> 60.'/ - !IM ISCCP simulator v3.4 - - integer nid_hf, nid_hf3d - save nid_hf, nid_hf3d + ! ISCCP simulator v3.4 ! Variables propres a la physique @@ -300,10 +298,6 @@ !KE43 ! Variables liees a la convection de K. Emanuel (sb): - REAL bas, top ! cloud base and top levels - SAVE bas - SAVE top - REAL Ma(klon, llm) ! undilute upward mass flux SAVE Ma REAL qcondc(klon, llm) ! in-cld water content from convect @@ -375,9 +369,6 @@ ! Declaration des procedures appelees - EXTERNAL alboc ! calculer l'albedo sur ocean - !KE43 - EXTERNAL conema3 ! convect4.3 EXTERNAL nuage ! calculer les proprietes radiatives EXTERNAL transp ! transport total de l'eau et de l'energie @@ -442,7 +433,7 @@ REAL, PARAMETER:: t_coup = 234. REAL zphi(klon, llm) - !IM cf. AM Variables locales pour la CLA (hbtm2) + ! cf. AM Variables locales pour la CLA (hbtm2) REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA @@ -465,19 +456,10 @@ REAL upwd(klon, llm) ! saturated updraft mass flux REAL dnwd(klon, llm) ! saturated downdraft mass flux REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux - REAL tvp(klon, llm) ! virtual temp of lifted parcel REAL cape(klon) ! CAPE SAVE cape - REAL pbase(klon) ! cloud base pressure - SAVE pbase - REAL bbase(klon) ! cloud base buoyancy - SAVE bbase - REAL rflag(klon) ! flag fonctionnement de convect INTEGER iflagctrl(klon) ! flag fonctionnement de convect - ! -- convect43: - REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm) - REAL dplcldt(klon), dplcldr(klon) ! Variables du changement @@ -532,9 +514,7 @@ REAL t_seri(klon, llm), q_seri(klon, llm) REAL ql_seri(klon, llm), qs_seri(klon, llm) REAL u_seri(klon, llm), v_seri(klon, llm) - REAL tr_seri(klon, llm, nbtr) - REAL d_tr(klon, llm, nbtr) REAL zx_rh(klon, llm) @@ -545,7 +525,7 @@ REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique - INTEGER, SAVE:: nid_day, nid_ins + INTEGER, SAVE:: nid_ins REAL ve_lay(klon, llm) ! transport meri. de l'energie a chaque niveau vert. REAL vq_lay(klon, llm) ! transport meri. de l'eau a chaque niveau vert. @@ -553,8 +533,6 @@ REAL uq_lay(klon, llm) ! transport zonal de l'eau a chaque niveau vert. REAL zsto - - logical ok_sync real date0 ! Variables li\'ees au bilan d'\'energie et d'enthalpie : @@ -563,7 +541,7 @@ REAL, SAVE:: d_h_vcol_phy REAL fs_bound, fq_bound REAL zero_v(klon) - CHARACTER(LEN = 15) tit + CHARACTER(LEN = 20) tit INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation @@ -633,7 +611,6 @@ !---------------------------------------------------------------- IF (if_ebil >= 1) zero_v = 0. - ok_sync = .TRUE. IF (nqmx < 2) CALL abort_gcm('physiq', & 'eaux vapeur et liquide sont indispensables', 1) @@ -748,23 +725,12 @@ ENDIF test_firstcal ! Mettre a zero des variables de sortie (pour securite) - - DO i = 1, klon - d_ps(i) = 0. - ENDDO - DO iq = 1, nqmx - DO k = 1, llm - DO i = 1, klon - d_qx(i, k, iq) = 0. - ENDDO - ENDDO - ENDDO da = 0. mp = 0. phi = 0. - ! Ne pas affecter les valeurs entr\'ees de u, v, h, et q : - + ! We will modify variables *_seri and we will not touch variables + ! u, v, h, q: DO k = 1, llm DO i = 1, klon t_seri(i, k) = t(i, k) @@ -996,7 +962,8 @@ IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) & + pctsrf(i, is_sic) - 1.) > EPSFRA) print *, & - 'physiq : probl\`eme sous surface au point ', i, pctsrf(i, 1 : nbsrf) + 'physiq : probl\`eme sous surface au point ', i, & + pctsrf(i, 1 : nbsrf) ENDDO DO nsrf = 1, nbsrf DO i = 1, klon @@ -1024,8 +991,7 @@ ENDDO ENDDO - ! Si une sous-fraction n'existe pas, elle prend la temp. moyenne - + ! Si une sous-fraction n'existe pas, elle prend la température moyenne : DO nsrf = 1, nbsrf DO i = 1, klon IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i) @@ -1084,17 +1050,10 @@ else ! iflag_con >= 3 - CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, & - v_seri, tr_seri, sig1, w01, d_t_con, d_q_con, & - d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, & - itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, & - pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, & - wd, pmflxr, pmflxs, da, phi, mp, ntra=1) - ! (number of tracers for the convection scheme of Kerry Emanuel: - ! la partie traceurs est faite dans phytrac - ! on met ntra = 1 pour limiter les appels mais on peut - ! supprimer les calculs / ftra.) - + CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, & + w01, d_t_con, d_q_con, d_u_con, d_v_con, rain_con, snow_con, & + ibas_con, itop_con, upwd, dnwd, dnwd0, Ma, cape, iflagctrl, & + qcondc, wd, pmflxr, pmflxs, da, phi, mp) clwcon0 = qcondc mfu = upwd + dnwd IF (.NOT. ok_gust) wd = 0. @@ -1103,21 +1062,18 @@ DO k = 1, llm DO i = 1, klon - zx_t = t_seri(i, k) IF (thermcep) THEN - zdelta = MAX(0., SIGN(1., rtt-zx_t)) - zx_qs = r2es * FOEEW(zx_t, zdelta) / play(i, k) - zx_qs = MIN(0.5, zx_qs) - zcor = 1./(1.-retv*zx_qs) - zx_qs = zx_qs*zcor + zdelta = MAX(0., SIGN(1., rtt - t_seri(i, k))) + zqsat(i, k) = r2es * FOEEW(t_seri(i, k), zdelta) / play(i, k) + zqsat(i, k) = MIN(0.5, zqsat(i, k)) + zqsat(i, k) = zqsat(i, k) / (1.-retv*zqsat(i, k)) ELSE - IF (zx_t < t_coup) THEN - zx_qs = qsats(zx_t)/play(i, k) + IF (t_seri(i, k) < t_coup) THEN + zqsat(i, k) = qsats(t_seri(i, k))/play(i, k) ELSE - zx_qs = qsatl(zx_t)/play(i, k) + zqsat(i, k) = qsatl(t_seri(i, k))/play(i, k) ENDIF ENDIF - zqsat(i, k) = zx_qs ENDDO ENDDO @@ -1396,7 +1352,8 @@ cg_ae = 0. ENDIF - ! Param\`etres optiques des nuages et quelques param\`etres pour diagnostics : + ! Param\`etres optiques des nuages et quelques param\`etres pour + ! diagnostics : if (ok_newmicro) then CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, & cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, & @@ -1875,9 +1832,7 @@ CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_q_vdf, zx_tmp_3d) CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d) - if (ok_sync) then - call histsync(nid_ins) - endif + call histsync(nid_ins) ENDIF end subroutine write_histins