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

Diff of /trunk/phylmd/physiq.f

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

trunk/libf/phylmd/physiq.f90 revision 68 by guez, Wed Nov 14 16:59:30 2012 UTC trunk/phylmd/physiq.f90 revision 76 by guez, Fri Nov 15 18:45:49 2013 UTC
# Line 7  contains Line 7  contains
7    SUBROUTINE physiq(lafin, rdayvrai, time, dtphys, paprs, play, pphi, pphis, &    SUBROUTINE physiq(lafin, rdayvrai, time, dtphys, paprs, play, pphi, pphis, &
8         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, d_ps, dudyn, PVteta)
9    
10      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28 (SVN revision 678)      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
11        ! (subversion revision 678)
12    
13      ! Author: Z.X. Li (LMD/CNRS) 1993      ! Author: Z.X. Li (LMD/CNRS) 1993
14    
15      ! This is the main procedure for the "physics" part of the program.      ! This is the main procedure for the "physics" part of the program.
# Line 23  contains Line 25  contains
25      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &
26           ok_orodr, ok_orolf, soil_model           ok_orodr, ok_orolf, soil_model
27      USE clmain_m, ONLY: clmain      USE clmain_m, ONLY: clmain
28        use clouds_gno_m, only: clouds_gno
29      USE comgeomphy, ONLY: airephy, cuphy, cvphy      USE comgeomphy, ONLY: airephy, cuphy, cvphy
30      USE concvl_m, ONLY: concvl      USE concvl_m, ONLY: concvl
31      USE conf_gcm_m, ONLY: offline, raz_date      USE conf_gcm_m, ONLY: offline, raz_date
# Line 56  contains Line 59  contains
59      USE phytrac_m, ONLY: phytrac      USE phytrac_m, ONLY: phytrac
60      USE qcheck_m, ONLY: qcheck      USE qcheck_m, ONLY: qcheck
61      use radlwsw_m, only: radlwsw      use radlwsw_m, only: radlwsw
62        use readsulfate_m, only: readsulfate
63      use sugwd_m, only: sugwd      use sugwd_m, only: sugwd
64      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt
65      USE temps, ONLY: annee_ref, day_ref, itau_phy      USE temps, ONLY: annee_ref, day_ref, itau_phy
# Line 123  contains Line 127  contains
127      character(len = 6):: ocean = 'force '      character(len = 6):: ocean = 'force '
128      ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")      ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")
129    
     logical ok_ocean  
     SAVE ok_ocean  
   
130      ! "slab" ocean      ! "slab" ocean
131      REAL, save:: tslab(klon) ! temperature of ocean slab      REAL, save:: tslab(klon) ! temperature of ocean slab
132      REAL, save:: seaice(klon) ! glace de mer (kg/m2)      REAL, save:: seaice(klon) ! glace de mer (kg/m2)
# Line 169  contains Line 170  contains
170    
171      !MI Amip2 PV a theta constante      !MI Amip2 PV a theta constante
172    
173      INTEGER klevp1      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)
174      PARAMETER(klevp1 = llm + 1)      REAL swup0(klon, llm + 1), swup(klon, llm + 1)
   
     REAL swdn0(klon, klevp1), swdn(klon, klevp1)  
     REAL swup0(klon, klevp1), swup(klon, klevp1)  
175      SAVE swdn0, swdn, swup0, swup      SAVE swdn0, swdn, swup0, swup
176    
177      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)      REAL lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
178      REAL lwup0(klon, klevp1), lwup(klon, klevp1)      REAL lwup0(klon, llm + 1), lwup(klon, llm + 1)
179      SAVE lwdn0, lwdn, lwup0, lwup      SAVE lwdn0, lwdn, lwup0, lwup
180    
181      !IM Amip2      !IM Amip2
# Line 208  contains Line 206  contains
206      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)
207    
208      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)
209      DATA zx_tau/0.0, 0.3, 1.3, 3.6, 9.4, 23., 60./      DATA zx_tau/0., 0.3, 1.3, 3.6, 9.4, 23., 60./
210      DATA zx_pc/50., 180., 310., 440., 560., 680., 800./      DATA zx_pc/50., 180., 310., 440., 560., 680., 800./
211    
212      ! cldtopres pression au sommet des nuages      ! cldtopres pression au sommet des nuages
# Line 270  contains Line 268  contains
268      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
269      ! soil temperature of surface fraction      ! soil temperature of surface fraction
270    
271      REAL fevap(klon, nbsrf)      REAL, save:: fevap(klon, nbsrf) ! evaporation
     SAVE fevap ! evaporation  
272      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
273      SAVE fluxlat      SAVE fluxlat
274    
# Line 318  contains Line 315  contains
315      SAVE Ma      SAVE Ma
316      REAL qcondc(klon, llm) ! in-cld water content from convect      REAL qcondc(klon, llm) ! in-cld water content from convect
317      SAVE qcondc      SAVE qcondc
318      REAL ema_work1(klon, llm), ema_work2(klon, llm)      REAL, save:: sig1(klon, llm), w01(klon, llm)
319      SAVE ema_work1, ema_work2      REAL, save:: wd(klon)
   
     REAL wd(klon) ! sb  
     SAVE wd ! sb  
320    
321      ! Variables locales pour la couche limite (al1):      ! Variables locales pour la couche limite (al1):
322    
# Line 331  contains Line 325  contains
325      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
326      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
327    
328      !AA Pour phytrac      ! Pour phytrac :
329      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
330      REAL yu1(klon) ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
331      REAL yv1(klon) ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
# Line 355  contains Line 349  contains
349    
350      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
351    
352      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon), devap(klon) ! evaporation and its derivative
353      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
354      REAL dlw(klon) ! derivee infra rouge      REAL dlw(klon) ! derivee infra rouge
355      SAVE dlw      SAVE dlw
# Line 376  contains Line 370  contains
370      INTEGER julien      INTEGER julien
371    
372      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
373      REAL pctsrf(klon, nbsrf)      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
374      !IM      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE
     REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE  
375    
     SAVE pctsrf ! sous-fraction du sol  
376      REAL albsol(klon)      REAL albsol(klon)
377      SAVE albsol ! albedo du sol total      SAVE albsol ! albedo du sol total
378      REAL albsollw(klon)      REAL albsollw(klon)
# Line 398  contains Line 390  contains
390    
391      ! Variables locales      ! Variables locales
392    
393      real clwcon(klon, llm), rnebcon(klon, llm)      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
394      real clwcon0(klon, llm), rnebcon0(klon, llm)      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
   
     save rnebcon, clwcon  
395    
396      REAL rhcl(klon, llm) ! humiditi relative ciel clair      REAL rhcl(klon, llm) ! humiditi relative ciel clair
397      REAL dialiq(klon, llm) ! eau liquide nuageuse      REAL dialiq(klon, llm) ! eau liquide nuageuse
# Line 427  contains Line 417  contains
417      REAL heat0(klon, llm) ! chauffage solaire ciel clair      REAL heat0(klon, llm) ! chauffage solaire ciel clair
418      REAL, save:: cool(klon, llm) ! refroidissement infrarouge      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
419      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair
420      REAL, save:: topsw(klon), toplw(klon), solsw(klon), sollw(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
421      real sollwdown(klon) ! downward LW flux at surface      REAL, save:: sollw(klon) ! rayonnement infrarouge montant à la surface
422        real, save:: sollwdown(klon) ! downward LW flux at surface
423      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
424      REAL albpla(klon)      REAL albpla(klon)
425      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface
426      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface
427      SAVE albpla, sollwdown      SAVE albpla
428      SAVE heat0, cool0      SAVE heat0, cool0
429    
430      INTEGER itaprad      INTEGER itaprad
# Line 450  contains Line 441  contains
441      REAL dist, rmu0(klon), fract(klon)      REAL dist, rmu0(klon), fract(klon)
442      REAL zdtime ! pas de temps du rayonnement (s)      REAL zdtime ! pas de temps du rayonnement (s)
443      real zlongi      real zlongi
   
444      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
     LOGICAL zx_ajustq  
   
445      REAL za, zb      REAL za, zb
446      REAL zx_t, zx_qs, zdelta, zcor      REAL zx_t, zx_qs, zdelta, zcor
447      real zqsat(klon, llm)      real zqsat(klon, llm)
448      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
449      REAL t_coup      REAL, PARAMETER:: t_coup = 234.
     PARAMETER (t_coup = 234.0)  
   
450      REAL zphi(klon, llm)      REAL zphi(klon, llm)
451    
452      !IM cf. AM Variables locales pour la CLA (hbtm2)      !IM cf. AM Variables locales pour la CLA (hbtm2)
# Line 497  contains Line 483  contains
483      REAL rflag(klon) ! flag fonctionnement de convect      REAL rflag(klon) ! flag fonctionnement de convect
484      INTEGER iflagctrl(klon) ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
485      ! -- convect43:      ! -- convect43:
     INTEGER ntra ! nb traceurs pour convect4.3  
486      REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)      REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)
487      REAL dplcldt(klon), dplcldr(klon)      REAL dplcldt(klon), dplcldr(klon)
488    
# Line 515  contains Line 500  contains
500      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
501      REAL rneb(klon, llm)      REAL rneb(klon, llm)
502    
503      REAL pmfu(klon, llm), pmfd(klon, llm)      REAL mfu(klon, llm), mfd(klon, llm)
504      REAL pen_u(klon, llm), pen_d(klon, llm)      REAL pen_u(klon, llm), pen_d(klon, llm)
505      REAL pde_u(klon, llm), pde_d(klon, llm)      REAL pde_u(klon, llm), pde_d(klon, llm)
506      INTEGER kcbot(klon), kctop(klon), kdtop(klon)      INTEGER kcbot(klon), kctop(klon), kdtop(klon)
# Line 579  contains Line 564  contains
564    
565      REAL zsto      REAL zsto
566    
     character(len = 20) modname  
     character(len = 80) abort_message  
567      logical ok_sync      logical ok_sync
568      real date0      real date0
569    
# Line 598  contains Line 581  contains
581      REAL ZRCPD      REAL ZRCPD
582    
583      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m
584      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m
585      REAL zt2m(klon), zq2m(klon) !temp., hum. 2m moyenne s/ 1 maille      REAL zt2m(klon), zq2m(klon) ! temp., hum. 2 m moyenne s/ 1 maille
586      REAL zu10m(klon), zv10m(klon) !vents a 10m moyennes s/1 maille      REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes s/1 maille
587      !jq Aerosol effects (Johannes Quaas, 27/11/2003)  
588      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]      ! Aerosol effects:
589    
590        REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)
591    
592      REAL, save:: sulfate_pi(klon, llm)      REAL, save:: sulfate_pi(klon, llm)
593      ! (SO4 aerosol concentration, in ug/m3, pre-industrial value)      ! SO4 aerosol concentration, in micro g/m3, pre-industrial value
594    
595      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
596      ! (Cloud optical thickness for pre-industrial (pi) aerosols)      ! cloud optical thickness for pre-industrial (pi) aerosols
597    
598      REAL re(klon, llm) ! Cloud droplet effective radius      REAL re(klon, llm) ! Cloud droplet effective radius
599      REAL fl(klon, llm) ! denominator of re      REAL fl(klon, llm) ! denominator of re
# Line 618  contains Line 603  contains
603      REAL, save:: cg_ae(klon, llm, 2)      REAL, save:: cg_ae(klon, llm, 2)
604    
605      REAL topswad(klon), solswad(klon) ! aerosol direct effect      REAL topswad(klon), solswad(klon) ! aerosol direct effect
     ! ok_ade --> ADE = topswad - topsw  
   
606      REAL topswai(klon), solswai(klon) ! aerosol indirect effect      REAL topswai(klon), solswai(klon) ! aerosol indirect effect
     ! ok_aie .and. ok_ade --> AIE = topswai - topswad  
     ! ok_aie .and. .not. ok_ade --> AIE = topswai - topsw  
607    
608      REAL aerindex(klon) ! POLDER aerosol index      REAL aerindex(klon) ! POLDER aerosol index
609    
# Line 630  contains Line 611  contains
611      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect
612    
613      REAL:: bl95_b0 = 2., bl95_b1 = 0.2      REAL:: bl95_b0 = 2., bl95_b1 = 0.2
614      ! Parameters in the formula to link CDNC to aerosol mass conc      ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus
615      ! (Boucher and Lohmann, 1995), used in nuage.F      ! B). They link cloud droplet number concentration to aerosol mass
616        ! concentration.
617    
618      SAVE u10m      SAVE u10m
619      SAVE v10m      SAVE v10m
# Line 647  contains Line 629  contains
629      SAVE solswad      SAVE solswad
630      SAVE d_u_con      SAVE d_u_con
631      SAVE d_v_con      SAVE d_v_con
     SAVE rnebcon0  
     SAVE clwcon0  
632    
633      real zmasse(klon, llm)      real zmasse(klon, llm)
634      ! (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)
# Line 662  contains Line 642  contains
642    
643      !----------------------------------------------------------------      !----------------------------------------------------------------
644    
645      modname = 'physiq'      IF (if_ebil >= 1) zero_v = 0.
     IF (if_ebil >= 1) THEN  
        DO i = 1, klon  
           zero_v(i) = 0.  
        END DO  
     END IF  
646      ok_sync = .TRUE.      ok_sync = .TRUE.
647      IF (nqmx < 2) THEN      IF (nqmx < 2) CALL abort_gcm('physiq', &
648         abort_message = 'eaux vapeur et liquide sont indispensables'           'eaux vapeur et liquide sont indispensables', 1)
        CALL abort_gcm(modname, abort_message, 1)  
     ENDIF  
649    
650      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
651         ! initialiser         ! initialiser
# Line 687  contains Line 660  contains
660         cg_ae = 0.         cg_ae = 0.
661         rain_con(:) = 0.         rain_con(:) = 0.
662         snow_con(:) = 0.         snow_con(:) = 0.
        bl95_b0 = 0.  
        bl95_b1 = 0.  
663         topswai(:) = 0.         topswai(:) = 0.
664         topswad(:) = 0.         topswad(:) = 0.
665         solswai(:) = 0.         solswai(:) = 0.
666         solswad(:) = 0.         solswad(:) = 0.
667    
668         d_u_con = 0.0         d_u_con = 0.
669         d_v_con = 0.0         d_v_con = 0.
670         rnebcon0 = 0.0         rnebcon0 = 0.
671         clwcon0 = 0.0         clwcon0 = 0.
672         rnebcon = 0.0         rnebcon = 0.
673         clwcon = 0.0         clwcon = 0.
674    
675         pblh =0. ! Hauteur de couche limite         pblh =0. ! Hauteur de couche limite
676         plcl =0. ! Niveau de condensation de la CLA         plcl =0. ! Niveau de condensation de la CLA
# Line 720  contains Line 691  contains
691         read(unit=*, nml=physiq_nml)         read(unit=*, nml=physiq_nml)
692         write(unit_nml, nml=physiq_nml)         write(unit_nml, nml=physiq_nml)
693    
        ! Appel à la lecture du run.def physique  
694         call conf_phys         call conf_phys
695    
696         ! Initialiser les compteurs:         ! Initialiser les compteurs:
# Line 730  contains Line 700  contains
700         itaprad = 0         itaprad = 0
701         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &
702              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &
703              snow_fall, solsw, sollwdown, dlw, radsol, frugs, agesno, zmea, &              snow_fall, solsw, sollw, dlw, radsol, frugs, agesno, zmea, &
704              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &
705              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0)              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)
706    
707         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
708         q2 = 1.e-8         q2 = 1e-8
709    
710         radpas = NINT(86400. / dtphys / nbapp_rad)         radpas = NINT(86400. / dtphys / nbapp_rad)
711    
# Line 743  contains Line 713  contains
713         IF (raz_date) itau_phy = 0         IF (raz_date) itau_phy = 0
714    
715         PRINT *, 'cycle_diurne = ', cycle_diurne         PRINT *, 'cycle_diurne = ', cycle_diurne
716           CALL printflag(radpas, ocean /= 'force', ok_oasis, ok_journe, &
717                ok_instan, ok_region)
718    
719         IF(ocean.NE.'force ') THEN         IF (dtphys * REAL(radpas) > 21600. .AND. cycle_diurne) THEN
           ok_ocean = .TRUE.  
        ENDIF  
   
        CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &  
             ok_region)  
   
        IF (dtphys*REAL(radpas) > 21600..AND.cycle_diurne) THEN  
           print *, 'Nbre d appels au rayonnement insuffisant'  
720            print *, "Au minimum 4 appels par jour si cycle diurne"            print *, "Au minimum 4 appels par jour si cycle diurne"
721            abort_message = 'Nbre d appels au rayonnement insuffisant'            call abort_gcm('physiq', &
722            call abort_gcm(modname, abort_message, 1)                 "Nombre d'appels au rayonnement insuffisant", 1)
723         ENDIF         ENDIF
        print *, "Clef pour la convection, iflag_con = ", iflag_con  
724    
725         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour le schéma de convection d'Emanuel :
726         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
727            print *, "Convection de Kerry Emanuel 4.3"            ibas_con = 1
728              itop_con = 1
           DO i = 1, klon  
              ibas_con(i) = 1  
              itop_con(i) = 1  
           ENDDO  
729         ENDIF         ENDIF
730    
731         IF (ok_orodr) THEN         IF (ok_orodr) THEN
# Line 796  contains Line 755  contains
755         call ini_histday(dtphys, ok_journe, nid_day, nqmx)         call ini_histday(dtphys, ok_journe, nid_day, nqmx)
756         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
757         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
758         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
759         WRITE(*, *) 'physiq date0: ', date0         print *, 'physiq date0: ', date0
760      ENDIF test_firstcal      ENDIF test_firstcal
761    
762      ! Mettre a zero des variables de sortie (pour securite)      ! Mettre a zero des variables de sortie (pour securite)
763    
764      DO i = 1, klon      DO i = 1, klon
765         d_ps(i) = 0.0         d_ps(i) = 0.
766      ENDDO      ENDDO
767      DO iq = 1, nqmx      DO iq = 1, nqmx
768         DO k = 1, llm         DO k = 1, llm
769            DO i = 1, klon            DO i = 1, klon
770               d_qx(i, k, iq) = 0.0               d_qx(i, k, iq) = 0.
771            ENDDO            ENDDO
772         ENDDO         ENDDO
773      ENDDO      ENDDO
# Line 869  contains Line 828  contains
828      ELSE      ELSE
829         DO k = 1, llm         DO k = 1, llm
830            DO i = 1, klon            DO i = 1, klon
831               d_t_dyn(i, k) = 0.0               d_t_dyn(i, k) = 0.
832               d_q_dyn(i, k) = 0.0               d_q_dyn(i, k) = 0.
833            ENDDO            ENDDO
834         ENDDO         ENDDO
835         ancien_ok = .TRUE.         ancien_ok = .TRUE.
# Line 893  contains Line 852  contains
852    
853      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg
854    
855      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst etc.).
856    
857      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
858      wo = ozonecm(REAL(julien), paprs)      wo = ozonecm(REAL(julien), paprs)
# Line 923  contains Line 882  contains
882      ! Appeler la diffusion verticale (programme de couche limite)      ! Appeler la diffusion verticale (programme de couche limite)
883    
884      DO i = 1, klon      DO i = 1, klon
885         zxrugs(i) = 0.0         zxrugs(i) = 0.
886      ENDDO      ENDDO
887      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
888         DO i = 1, klon         DO i = 1, klon
# Line 956  contains Line 915  contains
915         ENDDO         ENDDO
916      ENDDO      ENDDO
917    
918      ! Repartition sous maille des flux LW et SW      ! Répartition sous maille des flux longwave et shortwave
919      ! Repartition du longwave par sous-surface linearisee      ! Répartition du longwave par sous-surface linéarisée
920    
921      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
922         DO i = 1, klon         DO i = 1, klon
923            fsollw(i, nsrf) = sollw(i) &            fsollw(i, nsrf) = sollw(i) &
924                 + 4.0*RSIGMA*ztsol(i)**3 * (ztsol(i)-ftsol(i, nsrf))                 + 4. * RSIGMA * ztsol(i)**3 * (ztsol(i) - ftsol(i, nsrf))
925            fsolsw(i, nsrf) = solsw(i)*(1.-falbe(i, nsrf))/(1.-albsol(i))            fsolsw(i, nsrf) = solsw(i) * (1. - falbe(i, nsrf)) / (1. - albsol(i))
926         ENDDO         ENDDO
927      ENDDO      ENDDO
928    
# Line 971  contains Line 930  contains
930    
931      ! Couche limite:      ! Couche limite:
932    
933      CALL clmain(dtphys, itap, date0, pctsrf, pctsrf_new, t_seri, q_seri, &      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, &
934           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, npas, nexca, &           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, &
935           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &
936           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &
937           rain_fall, snow_fall, fsolsw, fsollw, sollwdown, fder, rlon, rlat, &           rain_fall, snow_fall, fsolsw, fsollw, fder, rlon, rlat, &
938           cuphy, cvphy, frugs, firstcal, lafin, agesno, rugoro, d_t_vdf, &           frugs, firstcal, agesno, rugoro, d_t_vdf, &
939           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &
940           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &
941           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &
# Line 991  contains Line 950  contains
950      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
951         DO k = 1, llm         DO k = 1, llm
952            DO i = 1, klon            DO i = 1, klon
953               zxfluxt(i, k) = zxfluxt(i, k) + &               zxfluxt(i, k) = zxfluxt(i, k) + fluxt(i, k, nsrf) * pctsrf(i, nsrf)
954                    fluxt(i, k, nsrf) * pctsrf(i, nsrf)               zxfluxq(i, k) = zxfluxq(i, k) + fluxq(i, k, nsrf) * pctsrf(i, nsrf)
955               zxfluxq(i, k) = zxfluxq(i, k) + &               zxfluxu(i, k) = zxfluxu(i, k) + fluxu(i, k, nsrf) * pctsrf(i, nsrf)
956                    fluxq(i, k, nsrf) * pctsrf(i, nsrf)               zxfluxv(i, k) = zxfluxv(i, k) + fluxv(i, k, nsrf) * pctsrf(i, nsrf)
              zxfluxu(i, k) = zxfluxu(i, k) + &  
                   fluxu(i, k, nsrf) * pctsrf(i, nsrf)  
              zxfluxv(i, k) = zxfluxv(i, k) + &  
                   fluxv(i, k, nsrf) * pctsrf(i, nsrf)  
957            END DO            END DO
958         END DO         END DO
959      END DO      END DO
960      DO i = 1, klon      DO i = 1, klon
961         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol
962         evap(i) = - zxfluxq(i, 1) ! flux d'evaporation au sol         evap(i) = - zxfluxq(i, 1) ! flux d'évaporation au sol
963         fder(i) = dlw(i) + dsens(i) + devap(i)         fder(i) = dlw(i) + dsens(i) + devap(i)
964      ENDDO      ENDDO
965    
# Line 1030  contains Line 985  contains
985      ! Update surface temperature:      ! Update surface temperature:
986    
987      DO i = 1, klon      DO i = 1, klon
988         zxtsol(i) = 0.0         zxtsol(i) = 0.
989         zxfluxlat(i) = 0.0         zxfluxlat(i) = 0.
990    
991         zt2m(i) = 0.0         zt2m(i) = 0.
992         zq2m(i) = 0.0         zq2m(i) = 0.
993         zu10m(i) = 0.0         zu10m(i) = 0.
994         zv10m(i) = 0.0         zv10m(i) = 0.
995         zxffonte(i) = 0.0         zxffonte(i) = 0.
996         zxfqcalving(i) = 0.0         zxfqcalving(i) = 0.
997    
998         s_pblh(i) = 0.0         s_pblh(i) = 0.
999         s_lcl(i) = 0.0         s_lcl(i) = 0.
1000         s_capCL(i) = 0.0         s_capCL(i) = 0.
1001         s_oliqCL(i) = 0.0         s_oliqCL(i) = 0.
1002         s_cteiCL(i) = 0.0         s_cteiCL(i) = 0.
1003         s_pblT(i) = 0.0         s_pblT(i) = 0.
1004         s_therm(i) = 0.0         s_therm(i) = 0.
1005         s_trmb1(i) = 0.0         s_trmb1(i) = 0.
1006         s_trmb2(i) = 0.0         s_trmb2(i) = 0.
1007         s_trmb3(i) = 0.0         s_trmb3(i) = 0.
1008    
1009         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) &
1010              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.)  >  EPSFRA) &              + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &
1011              THEN              'physiq : problème sous surface au point ', i, pctsrf(i, 1 : nbsrf)
           WRITE(*, *) 'physiq : pb sous surface au point ', i, &  
                pctsrf(i, 1 : nbsrf)  
        ENDIF  
1012      ENDDO      ENDDO
1013      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1014         DO i = 1, klon         DO i = 1, klon
# Line 1113  contains Line 1065  contains
1065      ! Calculer la derive du flux infrarouge      ! Calculer la derive du flux infrarouge
1066    
1067      DO i = 1, klon      DO i = 1, klon
1068         dlw(i) = - 4.0*RSIGMA*zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3
1069      ENDDO      ENDDO
1070    
1071      ! Appeler la convection (au choix)      ! Appeler la convection (au choix)
1072    
1073      DO k = 1, llm      DO k = 1, llm
1074         DO i = 1, klon         DO i = 1, klon
1075            conv_q(i, k) = d_q_dyn(i, k) &            conv_q(i, k) = d_q_dyn(i, k) + d_q_vdf(i, k)/dtphys
1076                 + d_q_vdf(i, k)/dtphys            conv_t(i, k) = d_t_dyn(i, k) + d_t_vdf(i, k)/dtphys
           conv_t(i, k) = d_t_dyn(i, k) &  
                + d_t_vdf(i, k)/dtphys  
1077         ENDDO         ENDDO
1078      ENDDO      ENDDO
1079    
1080      IF (check) THEN      IF (check) THEN
1081         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1082         print *, "avantcon = ", za         print *, "avantcon = ", za
1083      ENDIF      ENDIF
     zx_ajustq = iflag_con == 2  
     IF (zx_ajustq) THEN  
        DO i = 1, klon  
           z_avant(i) = 0.0  
        ENDDO  
        DO k = 1, llm  
           DO i = 1, klon  
              z_avant(i) = z_avant(i) + (q_seri(i, k) + ql_seri(i, k)) &  
                   *zmasse(i, k)  
           ENDDO  
        ENDDO  
     ENDIF  
1084    
1085      select case (iflag_con)      if (iflag_con == 2) then
1086      case (2)         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
1087         CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, &         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:-1), &
1088              zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, &              q_seri(:, llm:1:-1), conv_t, conv_q, zxfluxq(:, 1), omega, &
1089              pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, &              d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:-1), &
1090              pmflxs)              mfd(:, llm:1:-1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
1091                kdtop, pmflxr, pmflxs)
1092         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
1093         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
1094         DO i = 1, klon         ibas_con = llm + 1 - kcbot
1095            ibas_con(i) = llm + 1 - kcbot(i)         itop_con = llm + 1 - kctop
1096            itop_con(i) = llm + 1 - kctop(i)      else
1097         ENDDO         ! iflag_con >= 3
1098      case (3:)  
1099         ! number of tracers for the convection scheme of Kerry Emanuel:         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, &
1100                v_seri, tr_seri, sig1, w01, d_t_con, d_q_con, &
1101                d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &
1102                itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, &
1103                pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, &
1104                wd, pmflxr, pmflxs, da, phi, mp, ntra=1)
1105           ! (number of tracers for the convection scheme of Kerry Emanuel:
1106         ! la partie traceurs est faite dans phytrac         ! la partie traceurs est faite dans phytrac
1107         ! on met ntra = 1 pour limiter les appels mais on peut         ! on met ntra = 1 pour limiter les appels mais on peut
1108         ! supprimer les calculs / ftra.         ! supprimer les calculs / ftra.)
        ntra = 1  
        ! Schéma de convection modularisé et vectorisé :  
        ! (driver commun aux versions 3 et 4)  
   
        CALL concvl(iflag_con, dtphys, paprs, play, t_seri, q_seri, u_seri, &  
             v_seri, tr_seri, ntra, ema_work1, ema_work2, 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)  
        clwcon0 = qcondc  
        pmfu = upwd + dnwd  
1109    
1110         IF (.NOT. ok_gust) THEN         clwcon0 = qcondc
1111            do i = 1, klon         mfu = upwd + dnwd
1112               wd(i) = 0.0         IF (.NOT. ok_gust) wd = 0.
           enddo  
        ENDIF  
1113    
1114         ! Calcul des propriétés des nuages convectifs         ! Calcul des propriétés des nuages convectifs
1115    
# Line 1186  contains Line 1118  contains
1118               zx_t = t_seri(i, k)               zx_t = t_seri(i, k)
1119               IF (thermcep) THEN               IF (thermcep) THEN
1120                  zdelta = MAX(0., SIGN(1., rtt-zx_t))                  zdelta = MAX(0., SIGN(1., rtt-zx_t))
1121                  zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)                  zx_qs = r2es * FOEEW(zx_t, zdelta) / play(i, k)
1122                  zx_qs = MIN(0.5, zx_qs)                  zx_qs = MIN(0.5, zx_qs)
1123                  zcor = 1./(1.-retv*zx_qs)                  zcor = 1./(1.-retv*zx_qs)
1124                  zx_qs = zx_qs*zcor                  zx_qs = zx_qs*zcor
# Line 1202  contains Line 1134  contains
1134         ENDDO         ENDDO
1135    
1136         ! calcul des proprietes des nuages convectifs         ! calcul des proprietes des nuages convectifs
1137         clwcon0 = fact_cldcon*clwcon0         clwcon0 = fact_cldcon * clwcon0
1138         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
1139              rnebcon0)              rnebcon0)
1140      case default  
1141         print *, "iflag_con non-prevu", iflag_con         mfd = 0.
1142         stop 1         pen_u = 0.
1143      END select         pen_d = 0.
1144           pde_d = 0.
1145           pde_u = 0.
1146        END if
1147    
1148      DO k = 1, llm      DO k = 1, llm
1149         DO i = 1, klon         DO i = 1, klon
# Line 1232  contains Line 1167  contains
1167      IF (check) THEN      IF (check) THEN
1168         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1169         print *, "aprescon = ", za         print *, "aprescon = ", za
1170         zx_t = 0.0         zx_t = 0.
1171         za = 0.0         za = 0.
1172         DO i = 1, klon         DO i = 1, klon
1173            za = za + airephy(i)/REAL(klon)            za = za + airephy(i)/REAL(klon)
1174            zx_t = zx_t + (rain_con(i)+ &            zx_t = zx_t + (rain_con(i)+ &
# Line 1242  contains Line 1177  contains
1177         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1178         print *, "Precip = ", zx_t         print *, "Precip = ", zx_t
1179      ENDIF      ENDIF
1180      IF (zx_ajustq) THEN  
1181         DO i = 1, klon      IF (iflag_con == 2) THEN
1182            z_apres(i) = 0.0         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
1183         ENDDO         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
        DO k = 1, llm  
           DO i = 1, klon  
              z_apres(i) = z_apres(i) + (q_seri(i, k) + ql_seri(i, k)) &  
                   *zmasse(i, k)  
           ENDDO  
        ENDDO  
        DO i = 1, klon  
           z_factor(i) = (z_avant(i)-(rain_con(i) + snow_con(i))*dtphys) &  
                /z_apres(i)  
        ENDDO  
1184         DO k = 1, llm         DO k = 1, llm
1185            DO i = 1, klon            DO i = 1, klon
1186               IF (z_factor(i) > 1. + 1E-8 .OR. z_factor(i) < 1. - 1E-8) THEN               IF (z_factor(i) > 1. + 1E-8 .OR. z_factor(i) < 1. - 1E-8) THEN
# Line 1264  contains Line 1189  contains
1189            ENDDO            ENDDO
1190         ENDDO         ENDDO
1191      ENDIF      ENDIF
     zx_ajustq = .FALSE.  
1192    
1193      ! Convection sèche (thermiques ou ajustement)      ! Convection sèche (thermiques ou ajustement)
1194    
# Line 1295  contains Line 1219  contains
1219    
1220      ! Caclul des ratqs      ! Caclul des ratqs
1221    
1222      ! ratqs convectifs a l'ancienne en fonction de q(z = 0)-q / q      ! ratqs convectifs à l'ancienne en fonction de (q(z = 0) - q) / q
1223      ! on ecrase le tableau ratqsc calcule par clouds_gno      ! on écrase le tableau ratqsc calculé par clouds_gno
1224      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1225         do k = 1, llm         do k = 1, llm
1226            do i = 1, klon            do i = 1, klon
1227               if(ptconv(i, k)) then               if(ptconv(i, k)) then
1228                  ratqsc(i, k) = ratqsbas &                  ratqsc(i, k) = ratqsbas + fact_cldcon &
1229                       +fact_cldcon*(q_seri(i, 1)-q_seri(i, k))/q_seri(i, k)                       * (q_seri(i, 1) - q_seri(i, k)) / q_seri(i, k)
1230               else               else
1231                  ratqsc(i, k) = 0.                  ratqsc(i, k) = 0.
1232               endif               endif
# Line 1313  contains Line 1237  contains
1237      ! ratqs stables      ! ratqs stables
1238      do k = 1, llm      do k = 1, llm
1239         do i = 1, klon         do i = 1, klon
1240            ratqss(i, k) = ratqsbas + (ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
1241                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
1242         enddo         enddo
1243      enddo      enddo
1244    
1245      ! ratqs final      ! ratqs final
1246      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then      if (iflag_cldcon == 1 .or. iflag_cldcon == 2) then
1247         ! les ratqs sont une conbinaison de ratqss et ratqsc         ! les ratqs sont une conbinaison de ratqss et ratqsc
1248         ! ratqs final         ! ratqs final
1249         ! 1e4 (en gros 3 heures), en dur pour le moment, est le temps de         ! 1e4 (en gros 3 heures), en dur pour le moment, est le temps de
1250         ! relaxation des ratqs         ! relaxation des ratqs
1251         facteur = exp(-dtphys*facttemps)         ratqs = max(ratqs * exp(- dtphys * facttemps), ratqss)
        ratqs = max(ratqs*facteur, ratqss)  
1252         ratqs = max(ratqs, ratqsc)         ratqs = max(ratqs, ratqsc)
1253      else      else
1254         ! on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
1255         ratqs = ratqss         ratqs = ratqss
1256      endif      endif
1257    
     ! Processus de condensation à grande echelle et processus de  
     ! précipitation :  
1258      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &
1259           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &
1260           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &
# Line 1353  contains Line 1274  contains
1274      IF (check) THEN      IF (check) THEN
1275         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1276         print *, "apresilp = ", za         print *, "apresilp = ", za
1277         zx_t = 0.0         zx_t = 0.
1278         za = 0.0         za = 0.
1279         DO i = 1, klon         DO i = 1, klon
1280            za = za + airephy(i)/REAL(klon)            za = za + airephy(i)/REAL(klon)
1281            zx_t = zx_t + (rain_lsc(i) &            zx_t = zx_t + (rain_lsc(i) &
# Line 1396  contains Line 1317  contains
1317         endif         endif
1318    
1319         ! Nuages diagnostiques pour Tiedtke         ! Nuages diagnostiques pour Tiedtke
1320         CALL diagcld1(paprs, play, &         CALL diagcld1(paprs, play, rain_tiedtke, snow_tiedtke, ibas_con, &
1321              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &              itop_con, diafra, dialiq)
             diafra, dialiq)  
1322         DO k = 1, llm         DO k = 1, llm
1323            DO i = 1, klon            DO i = 1, klon
1324               IF (diafra(i, k) > cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
# Line 1408  contains Line 1328  contains
1328            ENDDO            ENDDO
1329         ENDDO         ENDDO
1330      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1331         ! On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le maximum du calcul de
1332         ! convection et du calcul du pas de temps précédent diminué d'un facteur         ! la convection et du calcul du pas de temps précédent diminué
1333         ! facttemps         ! d'un facteur facttemps.
1334         facteur = dtphys *facttemps         facteur = dtphys * facttemps
1335         do k = 1, llm         do k = 1, llm
1336            do i = 1, klon            do i = 1, klon
1337               rnebcon(i, k) = rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k) * facteur
1338               if (rnebcon0(i, k)*clwcon0(i, k) > rnebcon(i, k)*clwcon(i, k)) &               if (rnebcon0(i, k) * clwcon0(i, k) &
1339                    then                    > rnebcon(i, k) * clwcon(i, k)) then
1340                  rnebcon(i, k) = rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
1341                  clwcon(i, k) = clwcon0(i, k)                  clwcon(i, k) = clwcon0(i, k)
1342               endif               endif
# Line 1490  contains Line 1410  contains
1410    
1411      ! Paramètres optiques des nuages et quelques paramètres pour diagnostics :      ! Paramètres optiques des nuages et quelques paramètres pour diagnostics :
1412      if (ok_newmicro) then      if (ok_newmicro) then
1413         CALL newmicro(paprs, play, ok_newmicro, t_seri, cldliq, cldfra, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
1414              cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, &              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &
1415              fiwc, ok_aie, sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, &              sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, re, fl)
             re, fl)  
1416      else      else
1417         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
1418              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &
# Line 1543  contains Line 1462  contains
1462    
1463      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
1464      DO i = 1, klon      DO i = 1, klon
1465         zxqsurf(i) = 0.0         zxqsurf(i) = 0.
1466         zxsnow(i) = 0.0         zxsnow(i) = 0.
1467      ENDDO      ENDDO
1468      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1469         DO i = 1, klon         DO i = 1, klon
# Line 1566  contains Line 1485  contains
1485         igwd = 0         igwd = 0
1486         DO i = 1, klon         DO i = 1, klon
1487            itest(i) = 0            itest(i) = 0
1488            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.0)) THEN            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.)) THEN
1489               itest(i) = 1               itest(i) = 1
1490               igwd = igwd + 1               igwd = igwd + 1
1491               idx(igwd) = i               idx(igwd) = i
# Line 1637  contains Line 1556  contains
1556    
1557      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1558      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &
1559           dtphys, u, t, paprs, play, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &           dtphys, u, t, paprs, play, mfu, mfd, pen_u, pde_u, pen_d, pde_d, &
1560           ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, &           ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, &
1561           frac_nucl, pphis, albsol, rhcl, cldfra, rneb, diafra, cldliq, &           frac_nucl, pphis, albsol, rhcl, cldfra, rneb, diafra, cldliq, &
1562           pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)           pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)
1563    
1564      IF (offline) THEN      IF (offline) THEN
1565         call phystokenc(dtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &         call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, pde_u, &
1566              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1567              pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)              pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)
1568      ENDIF      ENDIF
# Line 1689  contains Line 1608  contains
1608    
1609      ! SORTIES      ! SORTIES
1610    
1611      !cc prw = eau precipitable      ! prw = eau precipitable
1612      DO i = 1, klon      DO i = 1, klon
1613         prw(i) = 0.         prw(i) = 0.
1614         DO k = 1, llm         DO k = 1, llm
# Line 1737  contains Line 1656  contains
1656         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1657         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &
1658              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &
1659              rain_fall, snow_fall, solsw, sollwdown, dlw, radsol, frugs, &              rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &
1660              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
1661              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)
1662      ENDIF      ENDIF
1663    
1664      firstcal = .FALSE.      firstcal = .FALSE.
Legend:
Removed from v.68  
changed lines
  Added in v.76
  ViewVC Help
Powered by ViewVC 1.1.21