--- trunk/phylmd/physiq.f90 2014/02/05 17:51:07 78 +++ 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, dudyn, PVteta) + 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 @@ -35,19 +34,15 @@ use diagcld2_m, only: diagcld2 use diagetpq_m, only: diagetpq use diagphy_m, only: diagphy - USE dimens_m, ONLY: iim, jjm, llm, nqmx + USE dimens_m, ONLY: llm, nqmx USE dimphy, ONLY: klon, nbtr USE dimsoil, ONLY: nsoilmx use drag_noro_m, only: drag_noro USE fcttre, ONLY: foeew, qsatl, qsats, thermcep use fisrtilp_m, only: fisrtilp USE hgardfou_m, ONLY: hgardfou - USE histsync_m, ONLY: histsync - USE histwrite_m, ONLY: histwrite USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, & nbsrf - USE ini_histhf_m, ONLY: ini_histhf - USE ini_histday_m, ONLY: ini_histday USE ini_histins_m, ONLY: ini_histins use newmicro_m, only: newmicro USE oasis_m, ONLY: ok_oasis @@ -64,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ée en fraction de jour + 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) @@ -82,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 @@ -93,23 +88,21 @@ REAL, intent(in):: t(klon, llm) ! input temperature (K) REAL, intent(in):: qx(klon, llm, nqmx) - ! (humidité spécifique et fractions massiques des autres traceurs) + ! (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. INTEGER nbteta PARAMETER(nbteta = 3) - REAL PVteta(klon, nbteta) - ! (output vorticite potentielle a des thetas constantes) - LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface PARAMETER (ok_gust = .FALSE.) @@ -125,7 +118,8 @@ parameter(rnpb = .true.) character(len = 6):: ocean = 'force ' - ! (type de modèle océan à 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 @@ -161,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) @@ -178,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 @@ -247,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 @@ -285,7 +276,7 @@ REAL falblw(klon, nbsrf) SAVE falblw ! albedo par type de surface - ! Paramètres de l'orographie à l'échelle sous-maille (OESM) : + ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) : REAL, save:: zmea(klon) ! orographie moyenne REAL, save:: zstd(klon) ! deviation standard de l'OESM REAL, save:: zsig(klon) ! pente de l'OESM @@ -307,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 @@ -382,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 @@ -411,14 +395,14 @@ REAL zxfluxu(klon, llm) REAL zxfluxv(klon, llm) - ! Le rayonnement n'est pas calculé tous les pas, il faut donc que - ! les variables soient rémanentes. + ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que + ! les variables soient r\'emanentes. REAL, save:: heat(klon, llm) ! chauffage solaire REAL heat0(klon, llm) ! chauffage solaire ciel clair REAL, save:: cool(klon, llm) ! refroidissement infrarouge REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair REAL, save:: topsw(klon), toplw(klon), solsw(klon) - REAL, save:: sollw(klon) ! rayonnement infrarouge montant à la surface + REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface real, save:: sollwdown(klon) ! downward LW flux at surface REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon) REAL albpla(klon) @@ -449,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 @@ -472,26 +456,17 @@ 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 ! con: convection ! lsc: large scale condensation ! ajs: ajustement sec - ! eva: évaporation de l'eau liquide nuageuse + ! eva: \'evaporation de l'eau liquide nuageuse ! vdf: vertical diffusion in boundary layer REAL d_t_con(klon, llm), d_q_con(klon, llm) REAL d_u_con(klon, llm), d_v_con(klon, llm) @@ -534,14 +509,12 @@ integer:: iflag_cldcon = 1 logical ptconv(klon, llm) - ! Variables locales pour effectuer les appels en série : + ! Variables locales pour effectuer les appels en s\'erie : 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) @@ -550,12 +523,9 @@ REAL zustrph(klon), zvstrph(klon) REAL aam, torsfc - REAL dudyn(iim + 1, jjm + 1, llm) - REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique - REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm) - 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. @@ -563,21 +533,19 @@ REAL uq_lay(klon, llm) ! transport zonal de l'eau a chaque niveau vert. REAL zsto - - logical ok_sync real date0 - ! Variables liées au bilan d'énergie et d'enthalpie : + ! Variables li\'ees au bilan d'\'energie et d'enthalpie : REAL ztsol(klon) REAL d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec 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 - REAL d_t_ec(klon, llm) ! tendance due à la conversion Ec -> E thermique + REAL d_t_ec(klon, llm) ! tendance due \`a la conversion Ec -> E thermique REAL ZRCPD REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m @@ -643,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) @@ -722,7 +689,7 @@ "Nombre d'appels au rayonnement insuffisant", 1) ENDIF - ! Initialisation pour le schéma de convection d'Emanuel : + ! Initialisation pour le sch\'ema de convection d'Emanuel : IF (iflag_con >= 3) THEN ibas_con = 1 itop_con = 1 @@ -751,8 +718,6 @@ ! Initialisation des sorties - call ini_histhf(dtphys, nid_hf, nid_hf3d) - call ini_histday(dtphys, ok_journe, nid_day, nqmx) call ini_histins(dtphys, ok_instan, nid_ins) CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0) ! Positionner date0 pour initialisation de ORCHIDEE @@ -760,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ées 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) @@ -807,10 +761,10 @@ CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, & ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, & d_ql, d_qs, d_ec) - ! Comme les tendances de la physique sont ajoutés dans la + ! Comme les tendances de la physique sont ajout\'es dans la ! dynamique, la variation d'enthalpie par la dynamique devrait - ! être égale à la variation de la physique au pas de temps - ! précédent. Donc la somme de ces 2 variations devrait être + ! \^etre \'egale \`a la variation de la physique au pas de temps + ! pr\'ec\'edent. Donc la somme de ces 2 variations devrait \^etre ! nulle. call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, & zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol + d_h_vcol_phy, & @@ -857,7 +811,7 @@ ! Prescrire l'ozone et calculer l'albedo sur l'ocean. wo = ozonecm(REAL(julien), paprs) - ! Évaporation de l'eau liquide nuageuse : + ! \'Evaporation de l'eau liquide nuageuse : DO k = 1, llm DO i = 1, klon zb = MAX(0., ql_seri(i, k)) @@ -915,8 +869,8 @@ ENDDO ENDDO - ! Répartition sous maille des flux longwave et shortwave - ! Répartition du longwave par sous-surface linéarisée + ! R\'epartition sous maille des flux longwave et shortwave + ! R\'epartition du longwave par sous-surface lin\'earis\'ee DO nsrf = 1, nbsrf DO i = 1, klon @@ -941,7 +895,7 @@ pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, & fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice) - ! Incrémentation des flux + ! Incr\'ementation des flux zxfluxt = 0. zxfluxq = 0. @@ -959,7 +913,7 @@ END DO DO i = 1, klon sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol - evap(i) = - zxfluxq(i, 1) ! flux d'évaporation au sol + evap(i) = - zxfluxq(i, 1) ! flux d'\'evaporation au sol fder(i) = dlw(i) + dsens(i) + devap(i) ENDDO @@ -1008,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ème 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 @@ -1036,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) @@ -1096,40 +1050,30 @@ 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. - ! Calcul des propriétés des nuages convectifs + ! Calcul des propri\'et\'es des nuages convectifs 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 @@ -1190,7 +1134,7 @@ ENDDO ENDIF - ! Convection sèche (thermiques ou ajustement) + ! Convection s\`eche (thermiques ou ajustement) d_t_ajs = 0. d_u_ajs = 0. @@ -1219,8 +1163,8 @@ ! Caclul des ratqs - ! ratqs convectifs à l'ancienne en fonction de (q(z = 0) - q) / q - ! on écrase le tableau ratqsc calculé par clouds_gno + ! ratqs convectifs \`a l'ancienne en fonction de (q(z = 0) - q) / q + ! on \'ecrase le tableau ratqsc calcul\'e par clouds_gno if (iflag_cldcon == 1) then do k = 1, llm do i = 1, klon @@ -1329,7 +1273,7 @@ ENDDO ELSE IF (iflag_cldcon == 3) THEN ! On prend pour les nuages convectifs le maximum du calcul de - ! la convection et du calcul du pas de temps précédent diminué + ! la convection et du calcul du pas de temps pr\'ec\'edent diminu\'e ! d'un facteur facttemps. facteur = dtphys * facttemps do k = 1, llm @@ -1372,7 +1316,7 @@ dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, & d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec) - ! Humidité relative pour diagnostic : + ! Humidit\'e relative pour diagnostic : DO k = 1, llm DO i = 1, klon zx_t = t_seri(i, k) @@ -1408,7 +1352,8 @@ cg_ae = 0. ENDIF - ! Paramètres optiques des nuages et quelques paramètres 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, & @@ -1472,13 +1417,13 @@ ENDDO ENDDO - ! Calculer le bilan du sol et la dérive de température (couplage) + ! Calculer le bilan du sol et la d\'erive de temp\'erature (couplage) DO i = 1, klon bils(i) = radsol(i) - sens(i) + zxfluxlat(i) ENDDO - ! Paramétrisation de l'orographie à l'échelle sous-maille : + ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille : IF (ok_orodr) THEN ! selection des points pour lesquels le shema est actif: @@ -1507,7 +1452,7 @@ ENDIF IF (ok_orolf) THEN - ! Sélection des points pour lesquels le schéma est actif : + ! S\'election des points pour lesquels le sch\'ema est actif : igwd = 0 DO i = 1, klon itest(i) = 0 @@ -1532,7 +1477,7 @@ ENDDO ENDIF - ! Stress nécessaires : toute la physique + ! Stress n\'ecessaires : toute la physique DO i = 1, klon zustrph(i) = 0. @@ -1645,8 +1590,6 @@ ENDDO ! Ecriture des sorties - call write_histhf - call write_histday call write_histins ! Si c'est la fin, il faut conserver l'etat de redemarrage @@ -1663,51 +1606,17 @@ contains - subroutine write_histday - - use gr_phy_write_3d_m, only: gr_phy_write_3d - integer itau_w ! pas de temps ecriture - - !------------------------------------------------ - - if (ok_journe) THEN - itau_w = itau_phy + itap - if (nqmx <= 4) then - call histwrite(nid_day, "Sigma_O3_Royer", itau_w, & - gr_phy_write_3d(wo) * 1e3) - ! (convert "wo" from kDU to DU) - end if - if (ok_sync) then - call histsync(nid_day) - endif - ENDIF - - End subroutine write_histday - - !**************************** - - subroutine write_histhf - - ! From phylmd/write_histhf.h, version 1.5 2005/05/25 13:10:09 - - !------------------------------------------------ - - call write_histhf3d - - IF (ok_sync) THEN - call histsync(nid_hf) - ENDIF - - end subroutine write_histhf - - !*************************************************************** - subroutine write_histins ! From phylmd/write_histins.h, version 1.2 2005/05/25 13:10:09 + use dimens_m, only: iim, jjm + USE histsync_m, ONLY: histsync + USE histwrite_m, ONLY: histwrite + real zout integer itau_w ! pas de temps ecriture + REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm) !-------------------------------------------------- @@ -1923,51 +1832,11 @@ 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 - !**************************************************** - - subroutine write_histhf3d - - ! From phylmd/write_histhf3d.h, version 1.2 2005/05/25 13:10:09 - - integer itau_w ! pas de temps ecriture - - !------------------------------------------------------- - - itau_w = itau_phy + itap - - ! Champs 3D: - - CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, t_seri, zx_tmp_3d) - CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d) - - CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, qx(1, 1, ivap), zx_tmp_3d) - CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d) - - CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, u_seri, zx_tmp_3d) - CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d) - - CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, v_seri, zx_tmp_3d) - CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d) - - if (nbtr >= 3) then - CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, tr_seri(1, 1, 3), & - zx_tmp_3d) - CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d) - end if - - if (ok_sync) then - call histsync(nid_hf3d) - endif - - end subroutine write_histhf3d - END SUBROUTINE physiq end module physiq_m