/[lmdze]/trunk/Sources/phylmd/physiq.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/physiq.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 155 by guez, Wed Jul 8 17:03:45 2015 UTC revision 180 by guez, Tue Mar 15 17:07:47 2016 UTC
# Line 19  contains Line 19  contains
19      use aeropt_m, only: aeropt      use aeropt_m, only: aeropt
20      use ajsec_m, only: ajsec      use ajsec_m, only: ajsec
21      use calltherm_m, only: calltherm      use calltherm_m, only: calltherm
22      USE clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, &      USE clesphys, ONLY: cdhmax, cdmmax, ecrit_hf, ecrit_ins, ecrit_mth, &
23           ecrit_mth, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin           ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin
24      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &
25           ok_orodr, ok_orolf           ok_orodr, ok_orolf
26      USE clmain_m, ONLY: clmain      USE clmain_m, ONLY: clmain
# Line 46  contains Line 46  contains
46      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &
47           nbsrf           nbsrf
48      USE ini_histins_m, ONLY: ini_histins      USE ini_histins_m, ONLY: ini_histins
49        use netcdf95, only: NF95_CLOSE
50      use newmicro_m, only: newmicro      use newmicro_m, only: newmicro
51        use nuage_m, only: nuage
52      USE orbite_m, ONLY: orbite      USE orbite_m, ONLY: orbite
53      USE ozonecm_m, ONLY: ozonecm      USE ozonecm_m, ONLY: ozonecm
54      USE phyetat0_m, ONLY: phyetat0, rlat, rlon      USE phyetat0_m, ONLY: phyetat0, rlat, rlon
55      USE phyredem_m, ONLY: phyredem      USE phyredem_m, ONLY: phyredem
56        USE phyredem0_m, ONLY: phyredem0
57      USE phystokenc_m, ONLY: phystokenc      USE phystokenc_m, ONLY: phystokenc
58      USE phytrac_m, ONLY: phytrac      USE phytrac_m, ONLY: phytrac
59      USE qcheck_m, ONLY: qcheck      USE qcheck_m, ONLY: qcheck
60      use radlwsw_m, only: radlwsw      use radlwsw_m, only: radlwsw
61      use readsulfate_m, only: readsulfate      use readsulfate_m, only: readsulfate
62      use readsulfate_preind_m, only: readsulfate_preind      use readsulfate_preind_m, only: readsulfate_preind
63      use sugwd_m, only: sugwd      use yoegwd, only: sugwd
64      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt, romega, rsigma, rtt
65      USE temps, ONLY: itau_phy      use transp_m, only: transp
66        use transp_lay_m, only: transp_lay
67      use unit_nml_m, only: unit_nml      use unit_nml_m, only: unit_nml
68      USE ymds2ju_m, ONLY: ymds2ju      USE ymds2ju_m, ONLY: ymds2ju
69      USE yoethf_m, ONLY: r2es, rvtmp2      USE yoethf_m, ONLY: r2es, rvtmp2
# Line 113  contains Line 117  contains
117      LOGICAL, PARAMETER:: ok_stratus = .FALSE.      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
118      ! Ajouter artificiellement les stratus      ! Ajouter artificiellement les stratus
119    
     ! "slab" ocean  
     REAL, save:: tslab(klon) ! temperature of ocean slab  
     REAL, save:: seaice(klon) ! glace de mer (kg/m2)  
     REAL fluxo(klon) ! flux turbulents ocean-glace de mer  
     REAL fluxg(klon) ! flux turbulents ocean-atmosphere  
   
120      logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.      logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.
121      ! sorties journalieres, mensuelles et instantanees dans les      ! sorties journalieres, mensuelles et instantanees dans les
122      ! fichiers histday, histmth et histins      ! fichiers histday, histmth et histins
# Line 155  contains Line 153  contains
153    
154      integer nlevSTD      integer nlevSTD
155      PARAMETER(nlevSTD = 17)      PARAMETER(nlevSTD = 17)
     real rlevSTD(nlevSTD)  
     DATA rlevSTD/100000., 92500., 85000., 70000., &  
          60000., 50000., 40000., 30000., 25000., 20000., &  
          15000., 10000., 7000., 5000., 3000., 2000., 1000./  
     CHARACTER(LEN = 4) clevSTD(nlevSTD)  
     DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &  
          '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &  
          '70 ', '50 ', '30 ', '20 ', '10 '/  
156    
157      ! prw: precipitable water      ! prw: precipitable water
158      real prw(klon)      real prw(klon)
# Line 175  contains Line 165  contains
165      INTEGER kmax, lmax      INTEGER kmax, lmax
166      PARAMETER(kmax = 8, lmax = 8)      PARAMETER(kmax = 8, lmax = 8)
167      INTEGER kmaxm1, lmaxm1      INTEGER kmaxm1, lmaxm1
168      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)      PARAMETER(kmaxm1 = kmax - 1, lmaxm1 = lmax - 1)
   
     REAL zx_tau(kmaxm1), zx_pc(lmaxm1)  
     DATA zx_tau/0., 0.3, 1.3, 3.6, 9.4, 23., 60./  
     DATA zx_pc/50., 180., 310., 440., 560., 680., 800./  
   
     ! cldtopres pression au sommet des nuages  
     REAL cldtopres(lmaxm1)  
     DATA cldtopres/50., 180., 310., 440., 560., 680., 800./  
   
     ! taulev: numero du niveau de tau dans les sorties ISCCP  
     CHARACTER(LEN = 4) taulev(kmaxm1)  
   
     DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/  
     CHARACTER(LEN = 3) pclev(lmaxm1)  
     DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/  
   
     CHARACTER(LEN = 28) cnameisccp(lmaxm1, kmaxm1)  
     DATA cnameisccp/'pc< 50hPa, tau< 0.3', 'pc= 50-180hPa, tau< 0.3', &  
          'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &  
          'pc= 440-560hPa, tau< 0.3', 'pc= 560-680hPa, tau< 0.3', &  
          'pc= 680-800hPa, tau< 0.3', 'pc< 50hPa, tau= 0.3-1.3', &  
          'pc= 50-180hPa, tau= 0.3-1.3', 'pc= 180-310hPa, tau= 0.3-1.3', &  
          'pc= 310-440hPa, tau= 0.3-1.3', 'pc= 440-560hPa, tau= 0.3-1.3', &  
          'pc= 560-680hPa, tau= 0.3-1.3', 'pc= 680-800hPa, tau= 0.3-1.3', &  
          'pc< 50hPa, tau= 1.3-3.6', 'pc= 50-180hPa, tau= 1.3-3.6', &  
          'pc= 180-310hPa, tau= 1.3-3.6', 'pc= 310-440hPa, tau= 1.3-3.6', &  
          'pc= 440-560hPa, tau= 1.3-3.6', 'pc= 560-680hPa, tau= 1.3-3.6', &  
          'pc= 680-800hPa, tau= 1.3-3.6', 'pc< 50hPa, tau= 3.6-9.4', &  
          'pc= 50-180hPa, tau= 3.6-9.4', 'pc= 180-310hPa, tau= 3.6-9.4', &  
          'pc= 310-440hPa, tau= 3.6-9.4', 'pc= 440-560hPa, tau= 3.6-9.4', &  
          'pc= 560-680hPa, tau= 3.6-9.4', 'pc= 680-800hPa, tau= 3.6-9.4', &  
          'pc< 50hPa, tau= 9.4-23', 'pc= 50-180hPa, tau= 9.4-23', &  
          'pc= 180-310hPa, tau= 9.4-23', 'pc= 310-440hPa, tau= 9.4-23', &  
          'pc= 440-560hPa, tau= 9.4-23', 'pc= 560-680hPa, tau= 9.4-23', &  
          'pc= 680-800hPa, tau= 9.4-23', 'pc< 50hPa, tau= 23-60', &  
          'pc= 50-180hPa, tau= 23-60', 'pc= 180-310hPa, tau= 23-60', &  
          'pc= 310-440hPa, tau= 23-60', 'pc= 440-560hPa, tau= 23-60', &  
          'pc= 560-680hPa, tau= 23-60', 'pc= 680-800hPa, tau= 23-60', &  
          'pc< 50hPa, tau> 60.', 'pc= 50-180hPa, tau> 60.', &  
          'pc= 180-310hPa, tau> 60.', 'pc= 310-440hPa, tau> 60.', &  
          'pc= 440-560hPa, tau> 60.', 'pc= 560-680hPa, tau> 60.', &  
          'pc= 680-800hPa, tau> 60.'/  
   
     ! ISCCP simulator v3.4  
169    
170      ! Variables propres a la physique      ! Variables propres a la physique
171    
# Line 230  contains Line 176  contains
176      REAL radsol(klon)      REAL radsol(klon)
177      SAVE radsol ! bilan radiatif au sol calcule par code radiatif      SAVE radsol ! bilan radiatif au sol calcule par code radiatif
178    
179      INTEGER, SAVE:: itap ! number of calls to "physiq"      INTEGER:: itap = 0 ! number of calls to "physiq"
180    
181      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
182    
# Line 259  contains Line 205  contains
205      REAL, save:: zpic(klon) ! Maximum de l'OESM      REAL, save:: zpic(klon) ! Maximum de l'OESM
206      REAL, save:: zval(klon) ! Minimum de l'OESM      REAL, save:: zval(klon) ! Minimum de l'OESM
207      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM
   
208      REAL zulow(klon), zvlow(klon)      REAL zulow(klon), zvlow(klon)
209        INTEGER igwd, itest(klon)
     INTEGER igwd, idx(klon), itest(klon)  
210    
211      REAL agesno(klon, nbsrf)      REAL agesno(klon, nbsrf)
212      SAVE agesno ! age de la neige      SAVE agesno ! age de la neige
# Line 279  contains Line 223  contains
223      REAL, save:: sig1(klon, llm), w01(klon, llm)      REAL, save:: sig1(klon, llm), w01(klon, llm)
224      REAL, save:: wd(klon)      REAL, save:: wd(klon)
225    
226      ! Variables locales pour la couche limite (al1):      ! Variables pour la couche limite (al1):
   
     ! Variables locales:  
227    
228      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
229      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
# Line 336  contains Line 278  contains
278      REAL, save:: albsol(klon) ! albedo du sol total visible      REAL, save:: albsol(klon) ! albedo du sol total visible
279      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU
280    
     ! Declaration des procedures appelees  
   
     EXTERNAL nuage ! calculer les proprietes radiatives  
     EXTERNAL transp ! transport total de l'eau et de l'energie  
   
     ! Variables locales  
   
281      real, save:: clwcon(klon, llm), rnebcon(klon, llm)      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
282      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
283    
# Line 396  contains Line 331  contains
331      REAL, PARAMETER:: t_coup = 234.      REAL, PARAMETER:: t_coup = 234.
332      REAL zphi(klon, llm)      REAL zphi(klon, llm)
333    
334      ! cf. AM Variables locales pour la CLA (hbtm2)      ! cf. AM Variables pour la CLA (hbtm2)
335    
336      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
337      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
# Line 414  contains Line 349  contains
349      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)
350      REAL s_trmb3(klon)      REAL s_trmb3(klon)
351    
352      ! Variables locales pour la convection de K. Emanuel :      ! Variables pour la convection de K. Emanuel :
353    
354      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
355      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
# Line 448  contains Line 383  contains
383      INTEGER, save:: ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
384    
385      REAL rain_con(klon), rain_lsc(klon)      REAL rain_con(klon), rain_lsc(klon)
386      REAL snow_con(klon), snow_lsc(klon)      REAL, save:: snow_con(klon)
387        real snow_lsc(klon)
388      REAL d_ts(klon, nbsrf)      REAL d_ts(klon, nbsrf)
389    
390      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)
# Line 472  contains Line 408  contains
408      integer:: iflag_cldcon = 1      integer:: iflag_cldcon = 1
409      logical ptconv(klon, llm)      logical ptconv(klon, llm)
410    
411      ! Variables locales pour effectuer les appels en s\'erie :      ! Variables pour effectuer les appels en s\'erie :
412    
413      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
414      REAL ql_seri(klon, llm)      REAL ql_seri(klon, llm)
# Line 519  contains Line 455  contains
455      REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)      REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)
456    
457      REAL, save:: sulfate_pi(klon, llm)      REAL, save:: sulfate_pi(klon, llm)
458      ! SO4 aerosol concentration, in micro g/m3, pre-industrial value      ! SO4 aerosol concentration, in \mu g/m3, pre-industrial value
459    
460      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
461      ! cloud optical thickness for pre-industrial (pi) aerosols      ! cloud optical thickness for pre-industrial (pi) aerosols
# Line 551  contains Line 487  contains
487      SAVE ffonte      SAVE ffonte
488      SAVE fqcalving      SAVE fqcalving
489      SAVE rain_con      SAVE rain_con
     SAVE snow_con  
490      SAVE topswai      SAVE topswai
491      SAVE topswad      SAVE topswad
492      SAVE solswai      SAVE solswai
# Line 563  contains Line 498  contains
498      ! (column-density of mass of air in a cell, in kg m-2)      ! (column-density of mass of air in a cell, in kg m-2)
499    
500      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
501        integer, save:: ncid_startphy, itau_phy
502    
503      namelist /physiq_nml/ ok_journe, ok_mensuel, ok_instan, fact_cldcon, &      namelist /physiq_nml/ ok_journe, ok_mensuel, ok_instan, fact_cldcon, &
504           facttemps, ok_newmicro, iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &           facttemps, ok_newmicro, iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &
# Line 572  contains Line 508  contains
508    
509      IF (if_ebil >= 1) zero_v = 0.      IF (if_ebil >= 1) zero_v = 0.
510      IF (nqmx < 2) CALL abort_gcm('physiq', &      IF (nqmx < 2) CALL abort_gcm('physiq', &
511           'eaux vapeur et liquide sont indispensables', 1)           'eaux vapeur et liquide sont indispensables')
512    
513      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
514         ! initialiser         ! initialiser
# Line 623  contains Line 559  contains
559         ! Initialiser les compteurs:         ! Initialiser les compteurs:
560    
561         frugs = 0.         frugs = 0.
562         itap = 0         CALL phyetat0(pctsrf, ftsol, ftsoil, fqsurf, qsol, &
563         CALL phyetat0(pctsrf, ftsol, ftsoil, tslab, seaice, fqsurf, qsol, &              fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, dlw, &
564              fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, &              radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &
565              dlw, radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, &              t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, &
566              zval, t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, &              run_off_lic_0, sig1, w01, ncid_startphy, itau_phy)
             run_off_lic_0, sig1, w01)  
567    
568         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
569         q2 = 1e-8         q2 = 1e-8
# Line 664  contains Line 599  contains
599    
600         ! Initialisation des sorties         ! Initialisation des sorties
601    
602         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins, itau_phy)
603         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)
604         ! Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
605         print *, 'physiq date0: ', date0         print *, 'physiq date0: ', date0
606           CALL phyredem0(lmt_pas, itau_phy)
607      ENDIF test_firstcal      ENDIF test_firstcal
608    
609      ! We will modify variables *_seri and we will not touch variables      ! We will modify variables *_seri and we will not touch variables
# Line 677  contains Line 613  contains
613      v_seri = v      v_seri = v
614      q_seri = qx(:, :, ivap)      q_seri = qx(:, :, ivap)
615      ql_seri = qx(:, :, iliq)      ql_seri = qx(:, :, iliq)
616      tr_seri = qx(:, :, 3: nqmx)      tr_seri = qx(:, :, 3:nqmx)
617    
618      ztsol = sum(ftsol * pctsrf, dim = 2)      ztsol = sum(ftsol * pctsrf, dim = 2)
619    
# Line 762  contains Line 698  contains
698      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
699         CALL zenang(longi, time, dtphys * radpas, mu0, fract)         CALL zenang(longi, time, dtphys * radpas, mu0, fract)
700      ELSE      ELSE
701         mu0 = -999.999         mu0 = - 999.999
702      ENDIF      ENDIF
703    
704      ! Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
# Line 782  contains Line 718  contains
718      ! Couche limite:      ! Couche limite:
719    
720      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, u_seri, &      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, u_seri, &
721           v_seri, julien, mu0, co2_ppm, ftsol, cdmmax, cdhmax, ksta, ksta_ter, &           v_seri, julien, mu0, ftsol, cdmmax, cdhmax, ksta, ksta_ter, &
722           ok_kzmin, ftsoil, qsol, paprs, play, fsnow, fqsurf, fevap, falbe, &           ok_kzmin, ftsoil, qsol, paprs, play, fsnow, fqsurf, fevap, falbe, &
723           fluxlat, rain_fall, snow_fall, fsolsw, fsollw, fder, rlat, frugs, &           fluxlat, rain_fall, snow_fall, fsolsw, fsollw, fder, rlat, frugs, &
724           firstcal, agesno, rugoro, d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &           firstcal, agesno, rugoro, d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &
725           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, q2, dsens, devap, &           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, q2, dsens, devap, &
726           ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, pblh, capCL, oliqCL, cteiCL, &           ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, pblh, capCL, oliqCL, cteiCL, &
727           pblT, therm, trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, &           pblT, therm, trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, &
728           run_off_lic_0, fluxo, fluxg, tslab)           run_off_lic_0)
729    
730      ! Incr\'ementation des flux      ! Incr\'ementation des flux
731    
# Line 924  contains Line 860  contains
860         conv_q = d_q_dyn + d_q_vdf / dtphys         conv_q = d_q_dyn + d_q_vdf / dtphys
861         conv_t = d_t_dyn + d_t_vdf / dtphys         conv_t = d_t_dyn + d_t_vdf / dtphys
862         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
863         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:-1), &         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:- 1), &
864              q_seri(:, llm:1:-1), conv_t, conv_q, zxfluxq(:, 1), omega, &              q_seri(:, llm:1:- 1), conv_t, conv_q, zxfluxq(:, 1), omega, &
865              d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:-1), &              d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:- 1), &
866              mfd(:, llm:1:-1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &              mfd(:, llm:1:- 1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
867              kdtop, pmflxr, pmflxs)              kdtop, pmflxr, pmflxs)
868         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
869         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
# Line 942  contains Line 878  contains
878         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, &         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, &
879              w01, d_t_con, d_q_con, d_u_con, d_v_con, rain_con, snow_con, &              w01, d_t_con, d_q_con, d_u_con, d_v_con, rain_con, snow_con, &
880              ibas_con, itop_con, upwd, dnwd, dnwd0, Ma, cape, iflagctrl, &              ibas_con, itop_con, upwd, dnwd, dnwd0, Ma, cape, iflagctrl, &
881              qcondc, wd, pmflxr, pmflxs, da, phi, mp)              qcondc, wd, pmflxr, da, phi, mp)
882         clwcon0 = qcondc         clwcon0 = qcondc
883         mfu = upwd + dnwd         mfu = upwd + dnwd
884         IF (.NOT. ok_gust) wd = 0.         IF (.NOT. ok_gust) wd = 0.
# Line 1115  contains Line 1051  contains
1051    
1052      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
1053    
1054      IF (iflag_cldcon <= -1) THEN      IF (iflag_cldcon <= - 1) THEN
1055         ! seulement pour Tiedtke         ! seulement pour Tiedtke
1056         snow_tiedtke = 0.         snow_tiedtke = 0.
1057         if (iflag_cldcon == -1) then         if (iflag_cldcon == - 1) then
1058            rain_tiedtke = rain_con            rain_tiedtke = rain_con
1059         else         else
1060            rain_tiedtke = 0.            rain_tiedtke = 0.
1061            do k = 1, llm            do k = 1, llm
1062               do i = 1, klon               do i = 1, klon
1063                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
1064                     rain_tiedtke(i) = rain_tiedtke(i)-d_q_con(i, k)/dtphys &                     rain_tiedtke(i) = rain_tiedtke(i) - d_q_con(i, k)/dtphys &
1065                          *zmasse(i, k)                          *zmasse(i, k)
1066                  endif                  endif
1067               enddo               enddo
# Line 1195  contains Line 1131  contains
1131            IF (thermcep) THEN            IF (thermcep) THEN
1132               zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t)/play(i, k)               zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t)/play(i, k)
1133               zx_qs = MIN(0.5, zx_qs)               zx_qs = MIN(0.5, zx_qs)
1134               zcor = 1./(1.-retv*zx_qs)               zcor = 1./(1. - retv*zx_qs)
1135               zx_qs = zx_qs*zcor               zx_qs = zx_qs*zcor
1136            ELSE            ELSE
1137               IF (zx_t < t_coup) THEN               IF (zx_t < t_coup) THEN
# Line 1253  contains Line 1189  contains
1189    
1190      DO k = 1, llm      DO k = 1, llm
1191         DO i = 1, klon         DO i = 1, klon
1192            t_seri(i, k) = t_seri(i, k) + (heat(i, k)-cool(i, k)) * dtphys/86400.            t_seri(i, k) = t_seri(i, k) + (heat(i, k) - cool(i, k)) * dtphys/86400.
1193         ENDDO         ENDDO
1194      ENDDO      ENDDO
1195    
# Line 1286  contains Line 1222  contains
1222      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :
1223    
1224      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1225         ! selection des points pour lesquels le shema est actif:         ! S\'election des points pour lesquels le sch\'ema est actif :
1226         igwd = 0         igwd = 0
1227         DO i = 1, klon         DO i = 1, klon
1228            itest(i) = 0            itest(i) = 0
1229            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.)) THEN            IF (zpic(i) - zmea(i) > 100. .AND. zstd(i) > 10.) THEN
1230               itest(i) = 1               itest(i) = 1
1231               igwd = igwd + 1               igwd = igwd + 1
              idx(igwd) = i  
1232            ENDIF            ENDIF
1233         ENDDO         ENDDO
1234    
# Line 1316  contains Line 1251  contains
1251         igwd = 0         igwd = 0
1252         DO i = 1, klon         DO i = 1, klon
1253            itest(i) = 0            itest(i) = 0
1254            IF ((zpic(i) - zmea(i)) > 100.) THEN            IF (zpic(i) - zmea(i) > 100.) THEN
1255               itest(i) = 1               itest(i) = 1
1256               igwd = igwd + 1               igwd = igwd + 1
              idx(igwd) = i  
1257            ENDIF            ENDIF
1258         ENDDO         ENDDO
1259    
# Line 1352  contains Line 1286  contains
1286         ENDDO         ENDDO
1287      ENDDO      ENDDO
1288    
1289      CALL aaam_bud(ra, rg, romega, rlat, rlon, pphis, zustrdr, zustrli, &      CALL aaam_bud(rg, romega, rlat, rlon, pphis, zustrdr, zustrli, zustrph, &
1290           zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)           zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
1291    
1292      IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &      IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &
1293           2, dtphys, t_seri, q_seri, ql_seri, u_seri, v_seri, paprs, d_h_vcol, &           2, dtphys, t_seri, q_seri, ql_seri, u_seri, v_seri, paprs, d_h_vcol, &
# Line 1362  contains Line 1296  contains
1296      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1297      call phytrac(itap, lmt_pas, julien, time, firstcal, lafin, dtphys, t, &      call phytrac(itap, lmt_pas, julien, time, firstcal, lafin, dtphys, t, &
1298           paprs, play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, &           paprs, play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, &
1299           yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, pphis, da, phi, mp, &           yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, &
1300           upwd, dnwd, tr_seri, zmasse)           dnwd, tr_seri, zmasse, ncid_startphy, nid_ins, itau_phy)
1301    
1302      IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &      IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &
1303           pde_u, pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &           pde_u, pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1304           pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)           pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)
1305    
1306      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1307      CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &      CALL transp(paprs, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, ue, uq)
          ue, uq)  
1308    
1309      ! diag. bilKP      ! diag. bilKP
1310    
1311      CALL transp_lay(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, &      CALL transp_lay(paprs, t_seri, q_seri, u_seri, v_seri, zphi, &
1312           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
1313    
1314      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
# Line 1429  contains Line 1362  contains
1362      DO iq = 3, nqmx      DO iq = 3, nqmx
1363         DO k = 1, llm         DO k = 1, llm
1364            DO i = 1, klon            DO i = 1, klon
1365               d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / dtphys               d_qx(i, k, iq) = (tr_seri(i, k, iq - 2) - qx(i, k, iq)) / dtphys
1366            ENDDO            ENDDO
1367         ENDDO         ENDDO
1368      ENDDO      ENDDO
# Line 1442  contains Line 1375  contains
1375         ENDDO         ENDDO
1376      ENDDO      ENDDO
1377    
     ! Ecriture des sorties  
1378      call write_histins      call write_histins
1379    
1380      ! Si c'est la fin, il faut conserver l'etat de redemarrage      IF (lafin) then
1381      IF (lafin) THEN         call NF95_CLOSE(ncid_startphy)
1382         itau_phy = itau_phy + itap         CALL phyredem(pctsrf, ftsol, ftsoil, fqsurf, qsol, &
1383         CALL phyredem("restartphy.nc", pctsrf, ftsol, ftsoil, tslab, seaice, &              fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, dlw, &
1384              fqsurf, qsol, fsnow, falbe, fevap, rain_fall, snow_fall, &              radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &
1385              solsw, sollw, dlw, radsol, frugs, agesno, zmea, zstd, zsig, zgam, &              t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &
1386              zthe, zpic, zval, t_ancien, q_ancien, rnebcon, ratqs, clwcon, &              w01)
1387              run_off_lic_0, sig1, w01)      end IF
     ENDIF  
1388    
1389      firstcal = .FALSE.      firstcal = .FALSE.
1390    
# Line 1463  contains Line 1394  contains
1394    
1395        ! From phylmd/write_histins.h, version 1.2 2005/05/25 13:10:09        ! From phylmd/write_histins.h, version 1.2 2005/05/25 13:10:09
1396    
1397          ! Ecriture des sorties
1398    
1399        use dimens_m, only: iim, jjm        use dimens_m, only: iim, jjm
1400        USE histsync_m, ONLY: histsync        USE histsync_m, ONLY: histsync
1401        USE histwrite_m, ONLY: histwrite        USE histwrite_m, ONLY: histwrite
# Line 1549  contains Line 1482  contains
1482           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, bils, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, bils, zx_tmp_2d)
1483           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)
1484    
1485           zx_tmp_fi2d(1:klon) = -1*sens(1:klon)           zx_tmp_fi2d(1:klon) = - sens(1:klon)
1486           ! CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sens, zx_tmp_2d)           ! CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sens, zx_tmp_2d)
1487           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1488           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)
# Line 1678  contains Line 1611  contains
1611           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_q_vdf, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_q_vdf, zx_tmp_3d)
1612           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)
1613    
1614             CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, zx_rh, zx_tmp_3d)
1615             CALL histwrite(nid_ins, "rhum", itau_w, zx_tmp_3d)
1616    
1617           call histsync(nid_ins)           call histsync(nid_ins)
1618        ENDIF        ENDIF
1619    
Legend:
Removed from v.155  
changed lines
  Added in v.180
  ViewVC Help
Powered by ViewVC 1.1.21