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

Diff of /trunk/phylmd/physiq.f

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

revision 61 by guez, Fri Apr 20 14:58:43 2012 UTC revision 68 by guez, Wed Nov 14 16:59:30 2012 UTC
# Line 14  contains Line 14  contains
14    
15      use aaam_bud_m, only: aaam_bud      use aaam_bud_m, only: aaam_bud
16      USE abort_gcm_m, ONLY: abort_gcm      USE abort_gcm_m, ONLY: abort_gcm
17        use aeropt_m, only: aeropt
18      use ajsec_m, only: ajsec      use ajsec_m, only: ajsec
19      USE calendar, ONLY: ymds2ju      USE calendar, ONLY: ymds2ju
20      use calltherm_m, only: calltherm      use calltherm_m, only: calltherm
# Line 26  contains Line 27  contains
27      USE concvl_m, ONLY: concvl      USE concvl_m, ONLY: concvl
28      USE conf_gcm_m, ONLY: offline, raz_date      USE conf_gcm_m, ONLY: offline, raz_date
29      USE conf_phys_m, ONLY: conf_phys      USE conf_phys_m, ONLY: conf_phys
30        use conflx_m, only: conflx
31      USE ctherm, ONLY: iflag_thermals, nsplit_thermals      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
32      use diagcld2_m, only: diagcld2      use diagcld2_m, only: diagcld2
33      use diagetpq_m, only: diagetpq      use diagetpq_m, only: diagetpq
34        use diagphy_m, only: diagphy
35      USE dimens_m, ONLY: iim, jjm, llm, nqmx      USE dimens_m, ONLY: iim, jjm, llm, nqmx
36      USE dimphy, ONLY: klon, nbtr      USE dimphy, ONLY: klon, nbtr
37      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
38      use drag_noro_m, only: drag_noro      use drag_noro_m, only: drag_noro
39      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
40        use fisrtilp_m, only: fisrtilp
41      USE hgardfou_m, ONLY: hgardfou      USE hgardfou_m, ONLY: hgardfou
42      USE histsync_m, ONLY: histsync      USE histsync_m, ONLY: histsync
43      USE histwrite_m, ONLY: histwrite      USE histwrite_m, ONLY: histwrite
# Line 42  contains Line 46  contains
46      USE ini_histhf_m, ONLY: ini_histhf      USE ini_histhf_m, ONLY: ini_histhf
47      USE ini_histday_m, ONLY: ini_histday      USE ini_histday_m, ONLY: ini_histday
48      USE ini_histins_m, ONLY: ini_histins      USE ini_histins_m, ONLY: ini_histins
49        use newmicro_m, only: newmicro
50      USE oasis_m, ONLY: ok_oasis      USE oasis_m, ONLY: ok_oasis
51      USE orbite_m, ONLY: orbite, zenang      USE orbite_m, ONLY: orbite, zenang
52      USE ozonecm_m, ONLY: ozonecm      USE ozonecm_m, ONLY: ozonecm
# Line 54  contains Line 59  contains
59      use sugwd_m, only: sugwd      use sugwd_m, only: sugwd
60      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt
61      USE temps, ONLY: annee_ref, day_ref, itau_phy      USE temps, ONLY: annee_ref, day_ref, itau_phy
62        use unit_nml_m, only: unit_nml
63      USE yoethf_m, ONLY: r2es, rvtmp2      USE yoethf_m, ONLY: r2es, rvtmp2
64    
65      ! Arguments:      ! Arguments:
# Line 100  contains Line 106  contains
106      REAL PVteta(klon, nbteta)      REAL PVteta(klon, nbteta)
107      ! (output vorticite potentielle a des thetas constantes)      ! (output vorticite potentielle a des thetas constantes)
108    
     LOGICAL ok_cvl ! pour activer le nouveau driver pour convection KE  
     PARAMETER (ok_cvl = .TRUE.)  
109      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
110      PARAMETER (ok_gust = .FALSE.)      PARAMETER (ok_gust = .FALSE.)
111    
# Line 116  contains Line 120  contains
120      logical rnpb      logical rnpb
121      parameter(rnpb = .true.)      parameter(rnpb = .true.)
122    
123      character(len = 6), save:: ocean      character(len = 6):: ocean = 'force '
124      ! (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")
125    
126      logical ok_ocean      logical ok_ocean
# Line 129  contains Line 133  contains
133      REAL fluxg(klon) ! flux turbulents ocean-atmosphere      REAL fluxg(klon) ! flux turbulents ocean-atmosphere
134    
135      ! Modele thermique du sol, a activer pour le cycle diurne:      ! Modele thermique du sol, a activer pour le cycle diurne:
136      logical, save:: ok_veget      logical:: ok_veget = .false. ! type de modele de vegetation utilise
     LOGICAL, save:: ok_journe ! sortir le fichier journalier  
137    
138      LOGICAL ok_mensuel ! sortir le fichier mensuel      logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.
139        ! sorties journalieres, mensuelles et instantanees dans les
140      LOGICAL ok_instan ! sortir le fichier instantane      ! fichiers histday, histmth et histins
     save ok_instan  
141    
142      LOGICAL ok_region ! sortir le fichier regional      LOGICAL ok_region ! sortir le fichier regional
143      PARAMETER (ok_region = .FALSE.)      PARAMETER (ok_region = .FALSE.)
# Line 348  contains Line 350  contains
350      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)
351      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
352    
353      !AA      REAL, save:: rain_fall(klon) ! pluie
354      REAL rain_fall(klon) ! pluie      REAL, save:: snow_fall(klon) ! neige
355      REAL snow_fall(klon) ! neige  
     save snow_fall, rain_fall  
     !IM cf FH pour Tiedtke 080604  
356      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
357    
358      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon), devap(klon) ! evaporation et sa derivee
# Line 393  contains Line 393  contains
393      EXTERNAL alboc ! calculer l'albedo sur ocean      EXTERNAL alboc ! calculer l'albedo sur ocean
394      !KE43      !KE43
395      EXTERNAL conema3 ! convect4.3      EXTERNAL conema3 ! convect4.3
     EXTERNAL fisrtilp ! schema de condensation a grande echelle (pluie)  
396      EXTERNAL nuage ! calculer les proprietes radiatives      EXTERNAL nuage ! calculer les proprietes radiatives
397      EXTERNAL transp ! transport total de l'eau et de l'energie      EXTERNAL transp ! transport total de l'eau et de l'energie
398    
# Line 422  contains Line 421  contains
421      REAL zxfluxu(klon, llm)      REAL zxfluxu(klon, llm)
422      REAL zxfluxv(klon, llm)      REAL zxfluxv(klon, llm)
423    
424      ! Le rayonnement n'est pas calcule tous les pas, il faut donc      ! Le rayonnement n'est pas calculé tous les pas, il faut donc que
425      ! que les variables soient rémanentes      ! les variables soient rémanentes.
426      REAL, save:: heat(klon, llm) ! chauffage solaire      REAL, save:: heat(klon, llm) ! chauffage solaire
427      REAL heat0(klon, llm) ! chauffage solaire ciel clair      REAL heat0(klon, llm) ! chauffage solaire ciel clair
428      REAL cool(klon, llm) ! refroidissement infrarouge      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
429      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair
430      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon), sollw(klon)
431      real sollwdown(klon) ! downward LW flux at surface      real sollwdown(klon) ! downward LW flux at surface
432      REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
433      REAL albpla(klon)      REAL albpla(klon)
434      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface
435      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface
436      SAVE cool, albpla, topsw, toplw, solsw, sollw, sollwdown      SAVE albpla, sollwdown
437      SAVE topsw0, toplw0, solsw0, sollw0, heat0, cool0      SAVE heat0, cool0
438    
439      INTEGER itaprad      INTEGER itaprad
440      SAVE itaprad      SAVE itaprad
# Line 482  contains Line 481  contains
481      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)
482      REAL s_trmb3(klon)      REAL s_trmb3(klon)
483    
484      ! Variables locales pour la convection de K. Emanuel (sb):      ! Variables locales pour la convection de K. Emanuel :
485    
486      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
487      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
# Line 523  contains Line 522  contains
522      REAL pmflxr(klon, llm + 1), pmflxs(klon, llm + 1)      REAL pmflxr(klon, llm + 1), pmflxs(klon, llm + 1)
523      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)
524    
525      INTEGER,save:: ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
526    
527      REAL rain_con(klon), rain_lsc(klon)      REAL rain_con(klon), rain_lsc(klon)
528      REAL snow_con(klon), snow_lsc(klon)      REAL snow_con(klon), snow_lsc(klon)
# Line 537  contains Line 536  contains
536      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)
537      REAL d_t_lif(klon, llm)      REAL d_t_lif(klon, llm)
538    
539      REAL ratqs(klon, llm), ratqss(klon, llm), ratqsc(klon, llm)      REAL, save:: ratqs(klon, llm)
540      real ratqsbas, ratqshaut      real ratqss(klon, llm), ratqsc(klon, llm)
541      save ratqsbas, ratqshaut, ratqs      real:: ratqsbas = 0.01, ratqshaut = 0.3
542    
543      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
544      real, save:: fact_cldcon      real:: fact_cldcon = 0.375
545      real, save:: facttemps      real:: facttemps = 1.e-4
546      logical ok_newmicro      logical:: ok_newmicro = .true.
     save ok_newmicro  
547      real facteur      real facteur
548    
549      integer iflag_cldcon      integer:: iflag_cldcon = 1
     save iflag_cldcon  
   
550      logical ptconv(klon, llm)      logical ptconv(klon, llm)
551    
552      ! Variables locales pour effectuer les appels en série :      ! Variables locales pour effectuer les appels en série :
# Line 594  contains Line 590  contains
590      REAL, SAVE:: d_h_vcol_phy      REAL, SAVE:: d_h_vcol_phy
591      REAL fs_bound, fq_bound      REAL fs_bound, fq_bound
592      REAL zero_v(klon)      REAL zero_v(klon)
593      CHARACTER(LEN = 15) ztit      CHARACTER(LEN = 15) tit
594      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
595      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation
596    
597      REAL d_t_ec(klon, llm) ! tendance due à la conversion Ec -> E thermique      REAL d_t_ec(klon, llm) ! tendance due à la conversion Ec -> E thermique
598      REAL ZRCPD      REAL ZRCPD
# Line 618  contains Line 614  contains
614      REAL fl(klon, llm) ! denominator of re      REAL fl(klon, llm) ! denominator of re
615    
616      ! Aerosol optical properties      ! Aerosol optical properties
617      REAL tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)
618      REAL cg_ae(klon, llm, 2)      REAL, save:: cg_ae(klon, llm, 2)
619    
620      REAL topswad(klon), solswad(klon) ! Aerosol direct effect.      REAL topswad(klon), solswad(klon) ! aerosol direct effect
621      ! ok_ade = True -ADE = topswad-topsw      ! ok_ade --> ADE = topswad - topsw
622    
623      REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.      REAL topswai(klon), solswai(klon) ! aerosol indirect effect
624      ! ok_aie = True ->      ! ok_aie .and. ok_ade --> AIE = topswai - topswad
625      ! ok_ade = True -AIE = topswai-topswad      ! ok_aie .and. .not. ok_ade --> AIE = topswai - topsw
     ! ok_ade = F -AIE = topswai-topsw  
626    
627      REAL aerindex(klon) ! POLDER aerosol index      REAL aerindex(klon) ! POLDER aerosol index
628    
629      ! Parameters      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
630      LOGICAL ok_ade, ok_aie ! Apply aerosol (in)direct effects or not      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect
631      REAL bl95_b0, bl95_b1 ! Parameter in Boucher and Lohmann (1995)  
632        REAL:: bl95_b0 = 2., bl95_b1 = 0.2
633        ! Parameters in the formula to link CDNC to aerosol mass conc
634        ! (Boucher and Lohmann, 1995), used in nuage.F
635    
     SAVE ok_ade, ok_aie, bl95_b0, bl95_b1  
636      SAVE u10m      SAVE u10m
637      SAVE v10m      SAVE v10m
638      SAVE t2m      SAVE t2m
639      SAVE q2m      SAVE q2m
640      SAVE ffonte      SAVE ffonte
641      SAVE fqcalving      SAVE fqcalving
     SAVE piz_ae  
     SAVE tau_ae  
     SAVE cg_ae  
642      SAVE rain_con      SAVE rain_con
643      SAVE snow_con      SAVE snow_con
644      SAVE topswai      SAVE topswai
# Line 661  contains Line 655  contains
655    
656      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
657    
658        namelist /physiq_nml/ ocean, ok_veget, ok_journe, ok_mensuel, ok_instan, &
659             fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, ratqsbas, &
660             ratqshaut, if_ebil, ok_ade, ok_aie, bl95_b0, bl95_b1, iflag_thermals, &
661             nsplit_thermals
662    
663      !----------------------------------------------------------------      !----------------------------------------------------------------
664    
665      modname = 'physiq'      modname = 'physiq'
# Line 715  contains Line 714  contains
714    
715         IF (if_ebil >= 1) d_h_vcol_phy = 0.         IF (if_ebil >= 1) d_h_vcol_phy = 0.
716    
717         ! appel a la lecture du run.def physique         iflag_thermals = 0
718           nsplit_thermals = 1
719           print *, "Enter namelist 'physiq_nml'."
720           read(unit=*, nml=physiq_nml)
721           write(unit_nml, nml=physiq_nml)
722    
723         call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, &         ! Appel à la lecture du run.def physique
724              ok_instan, fact_cldcon, facttemps, ok_newmicro, &         call conf_phys
             iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &  
             ok_ade, ok_aie, &  
             bl95_b0, bl95_b1, &  
             iflag_thermals, nsplit_thermals)  
725    
726         ! Initialiser les compteurs:         ! Initialiser les compteurs:
727    
# Line 753  contains Line 752  contains
752              ok_region)              ok_region)
753    
754         IF (dtphys*REAL(radpas) > 21600..AND.cycle_diurne) THEN         IF (dtphys*REAL(radpas) > 21600..AND.cycle_diurne) THEN
755            print *,'Nbre d appels au rayonnement insuffisant'            print *, 'Nbre d appels au rayonnement insuffisant'
756            print *,"Au minimum 4 appels par jour si cycle diurne"            print *, "Au minimum 4 appels par jour si cycle diurne"
757            abort_message = 'Nbre d appels au rayonnement insuffisant'            abort_message = 'Nbre d appels au rayonnement insuffisant'
758            call abort_gcm(modname, abort_message, 1)            call abort_gcm(modname, abort_message, 1)
759         ENDIF         ENDIF
760         print *,"Clef pour la convection, iflag_con = ", iflag_con         print *, "Clef pour la convection, iflag_con = ", iflag_con
        print *,"Clef pour le driver de la convection, ok_cvl = ", &  
             ok_cvl  
761    
762         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour la convection de K.E. (sb):
763         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
764              print *, "Convection de Kerry Emanuel 4.3"
765    
           print *,"*** Convection de Kerry Emanuel 4.3 "  
   
           !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG  
766            DO i = 1, klon            DO i = 1, klon
767               ibas_con(i) = 1               ibas_con(i) = 1
768               itop_con(i) = 1               itop_con(i) = 1
769            ENDDO            ENDDO
           !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>END  
   
770         ENDIF         ENDIF
771    
772         IF (ok_orodr) THEN         IF (ok_orodr) THEN
# Line 797  contains Line 790  contains
790         npas = 0         npas = 0
791         nexca = 0         nexca = 0
792    
        print *,'AVANT HIST IFLAG_CON = ', iflag_con  
   
793         ! Initialisation des sorties         ! Initialisation des sorties
794    
795         call ini_histhf(dtphys, nid_hf, nid_hf3d)         call ini_histhf(dtphys, nid_hf, nid_hf3d)
# Line 853  contains Line 844  contains
844      ENDDO      ENDDO
845    
846      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
847         ztit = 'after dynamics'         tit = 'after dynamics'
848         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
849              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
850              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
851         ! Comme les tendances de la physique sont ajoutés dans la         ! Comme les tendances de la physique sont ajoutés dans la
# Line 862  contains Line 853  contains
853         !  être égale à la variation de la physique au pas de temps         !  être égale à la variation de la physique au pas de temps
854         !  précédent.  Donc la somme de ces 2 variations devrait être         !  précédent.  Donc la somme de ces 2 variations devrait être
855         !  nulle.         !  nulle.
856         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
857              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol + d_h_vcol_phy, &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol + d_h_vcol_phy, &
858              d_qt, 0., fs_bound, fq_bound)              d_qt, 0., fs_bound, fq_bound)
859      END IF      END IF
# Line 919  contains Line 910  contains
910      ql_seri = 0.      ql_seri = 0.
911    
912      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
913         ztit = 'after reevap'         tit = 'after reevap'
914         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &
915              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
916              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
917         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
918              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
919              fs_bound, fq_bound)              fs_bound, fq_bound)
920    
# Line 1027  contains Line 1018  contains
1018      ENDDO      ENDDO
1019    
1020      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1021         ztit = 'after clmain'         tit = 'after clmain'
1022         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1023              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1024              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1025         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1026              sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &              sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
1027              fs_bound, fq_bound)              fs_bound, fq_bound)
1028      END IF      END IF
# Line 1139  contains Line 1130  contains
1130         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1131         print *, "avantcon = ", za         print *, "avantcon = ", za
1132      ENDIF      ENDIF
1133      zx_ajustq = .FALSE.      zx_ajustq = iflag_con == 2
     IF (iflag_con == 2) zx_ajustq = .TRUE.  
1134      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1135         DO i = 1, klon         DO i = 1, klon
1136            z_avant(i) = 0.0            z_avant(i) = 0.0
# Line 1154  contains Line 1144  contains
1144      ENDIF      ENDIF
1145    
1146      select case (iflag_con)      select case (iflag_con)
     case (1)  
        print *, 'Réactiver l''appel à "conlmd" dans "physiq.F".'  
        stop 1  
1147      case (2)      case (2)
1148         CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, &         CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, &
1149              zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, &              zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, &
# Line 1177  contains Line 1164  contains
1164         ! Schéma de convection modularisé et vectorisé :         ! Schéma de convection modularisé et vectorisé :
1165         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1166    
1167         IF (ok_cvl) THEN         CALL concvl(iflag_con, dtphys, paprs, play, t_seri, q_seri, u_seri, &
1168            ! new driver for convectL              v_seri, tr_seri, ntra, ema_work1, ema_work2, d_t_con, d_q_con, &
1169            CALL concvl(iflag_con, dtphys, paprs, play, t_seri, q_seri, &              d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, itop_con, &
1170                 u_seri, v_seri, tr_seri, ntra, ema_work1, ema_work2, d_t_con, &              upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, bbase, &
1171                 d_q_con, d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &              dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, pmflxs, &
1172                 itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, &              da, phi, mp)
1173                 bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, &         clwcon0 = qcondc
1174                 pmflxs, da, phi, mp)         pmfu = upwd + dnwd
           clwcon0 = qcondc  
           pmfu = upwd + dnwd  
        ELSE  
           ! conema3 ne contient pas les traceurs  
           CALL conema3(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, bas, top, Ma, cape, tvp, rflag, &  
                pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, clwcon0)  
        ENDIF  
1175    
1176         IF (.NOT. ok_gust) THEN         IF (.NOT. ok_gust) THEN
1177            do i = 1, klon            do i = 1, klon
# Line 1226  contains Line 1203  contains
1203    
1204         ! calcul des proprietes des nuages convectifs         ! calcul des proprietes des nuages convectifs
1205         clwcon0 = fact_cldcon*clwcon0         clwcon0 = fact_cldcon*clwcon0
1206         call clouds_gno &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
1207              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)              rnebcon0)
1208      case default      case default
1209         print *, "iflag_con non-prevu", iflag_con         print *, "iflag_con non-prevu", iflag_con
1210         stop 1         stop 1
# Line 1243  contains Line 1220  contains
1220      ENDDO      ENDDO
1221    
1222      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1223         ztit = 'after convect'         tit = 'after convect'
1224         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1225              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1226              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1227         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1228              zero_v, zero_v, rain_con, snow_con, ztsol, d_h_vcol, d_qt, d_ec, &              zero_v, zero_v, rain_con, snow_con, ztsol, d_h_vcol, d_qt, d_ec, &
1229              fs_bound, fq_bound)              fs_bound, fq_bound)
1230      END IF      END IF
1231    
1232      IF (check) THEN      IF (check) THEN
1233         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1234         print *,"aprescon = ", za         print *, "aprescon = ", za
1235         zx_t = 0.0         zx_t = 0.0
1236         za = 0.0         za = 0.0
1237         DO i = 1, klon         DO i = 1, klon
# Line 1263  contains Line 1240  contains
1240                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
1241         ENDDO         ENDDO
1242         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1243         print *,"Precip = ", zx_t         print *, "Precip = ", zx_t
1244      ENDIF      ENDIF
1245      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1246         DO i = 1, klon         DO i = 1, klon
# Line 1310  contains Line 1287  contains
1287      endif      endif
1288    
1289      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1290         ztit = 'after dry_adjust'         tit = 'after dry_adjust'
1291         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1292              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1293              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1294      END IF      END IF
# Line 1375  contains Line 1352  contains
1352      ENDDO      ENDDO
1353      IF (check) THEN      IF (check) THEN
1354         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1355         print *,"apresilp = ", za         print *, "apresilp = ", za
1356         zx_t = 0.0         zx_t = 0.0
1357         za = 0.0         za = 0.0
1358         DO i = 1, klon         DO i = 1, klon
# Line 1384  contains Line 1361  contains
1361                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1362         ENDDO         ENDDO
1363         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1364         print *,"Precip = ", zx_t         print *, "Precip = ", zx_t
1365      ENDIF      ENDIF
1366    
1367      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1368         ztit = 'after fisrt'         tit = 'after fisrt'
1369         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1370              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1371              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1372         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1373              zero_v, zero_v, rain_lsc, snow_lsc, ztsol, d_h_vcol, d_qt, d_ec, &              zero_v, zero_v, rain_lsc, snow_lsc, ztsol, d_h_vcol, d_qt, d_ec, &
1374              fs_bound, fq_bound)              fs_bound, fq_bound)
1375      END IF      END IF
# Line 1401  contains Line 1378  contains
1378    
1379      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
1380    
1381      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke      IF (iflag_cldcon <= -1) THEN
1382           ! seulement pour Tiedtke
1383         snow_tiedtke = 0.         snow_tiedtke = 0.
1384         if (iflag_cldcon == -1) then         if (iflag_cldcon == -1) then
1385            rain_tiedtke = rain_con            rain_tiedtke = rain_con
# Line 1465  contains Line 1443  contains
1443      ENDIF      ENDIF
1444    
1445      ! Precipitation totale      ! Precipitation totale
   
1446      DO i = 1, klon      DO i = 1, klon
1447         rain_fall(i) = rain_con(i) + rain_lsc(i)         rain_fall(i) = rain_con(i) + rain_lsc(i)
1448         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
1449      ENDDO      ENDDO
1450    
1451      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) CALL diagetpq(airephy, "after diagcld", ip_ebil, 2, 2, &
1452         ztit = "after diagcld"           dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &
1453         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &           d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
     END IF  
1454    
1455      ! Humidité relative pour diagnostic:      ! Humidité relative pour diagnostic :
1456      DO k = 1, llm      DO k = 1, llm
1457         DO i = 1, klon         DO i = 1, klon
1458            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
# Line 1501  contains Line 1475  contains
1475      ENDDO      ENDDO
1476    
1477      ! Introduce the aerosol direct and first indirect radiative forcings:      ! Introduce the aerosol direct and first indirect radiative forcings:
     ! Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)  
1478      IF (ok_ade .OR. ok_aie) THEN      IF (ok_ade .OR. ok_aie) THEN
1479         ! Get sulfate aerosol distribution         ! Get sulfate aerosol distribution :
1480         CALL readsulfate(rdayvrai, firstcal, sulfate)         CALL readsulfate(rdayvrai, firstcal, sulfate)
1481         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)
1482    
        ! Calculate aerosol optical properties (Olivier Boucher)  
1483         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &
1484              aerindex)              aerindex)
1485      ELSE      ELSE
# Line 1516  contains Line 1488  contains
1488         cg_ae = 0.         cg_ae = 0.
1489      ENDIF      ENDIF
1490    
1491      ! Paramètres optiques des nuages et quelques paramètres pour      ! Paramètres optiques des nuages et quelques paramètres pour diagnostics :
     ! diagnostics :  
1492      if (ok_newmicro) then      if (ok_newmicro) then
1493         CALL newmicro(paprs, play, ok_newmicro, t_seri, cldliq, cldfra, &         CALL newmicro(paprs, play, ok_newmicro, t_seri, cldliq, cldfra, &
1494              cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, &              cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, &
# Line 1541  contains Line 1512  contains
1512                 + falblw(i, is_ter) * pctsrf(i, is_ter) &                 + falblw(i, is_ter) * pctsrf(i, is_ter) &
1513                 + falblw(i, is_sic) * pctsrf(i, is_sic)                 + falblw(i, is_sic) * pctsrf(i, is_sic)
1514         ENDDO         ENDDO
1515         ! nouveau rayonnement (compatible Arpege-IFS):         ! Rayonnement (compatible Arpege-IFS) :
1516         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &
1517              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &
1518              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &
# Line 1561  contains Line 1532  contains
1532      ENDDO      ENDDO
1533    
1534      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1535         ztit = 'after rad'         tit = 'after rad'
1536         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1537              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1538              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1539         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, &         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, &
1540              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
1541              fs_bound, fq_bound)              fs_bound, fq_bound)
1542      END IF      END IF
# Line 1642  contains Line 1613  contains
1613         ENDDO         ENDDO
1614      ENDIF      ENDIF
1615    
1616      ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE      ! Stress nécessaires : toute la physique
1617    
1618      DO i = 1, klon      DO i = 1, klon
1619         zustrph(i) = 0.         zustrph(i) = 0.
# Line 1650  contains Line 1621  contains
1621      ENDDO      ENDDO
1622      DO k = 1, llm      DO k = 1, llm
1623         DO i = 1, klon         DO i = 1, klon
1624            zustrph(i) = zustrph(i) + (u_seri(i, k)-u(i, k))/dtphys* zmasse(i, k)            zustrph(i) = zustrph(i) + (u_seri(i, k) - u(i, k)) / dtphys &
1625            zvstrph(i) = zvstrph(i) + (v_seri(i, k)-v(i, k))/dtphys* zmasse(i, k)                 * zmasse(i, k)
1626              zvstrph(i) = zvstrph(i) + (v_seri(i, k) - v(i, k)) / dtphys &
1627                   * zmasse(i, k)
1628         ENDDO         ENDDO
1629      ENDDO      ENDDO
1630    
1631      CALL aaam_bud(ra, rg, romega, rlat, rlon, pphis, zustrdr, zustrli, &      CALL aaam_bud(ra, rg, romega, rlat, rlon, pphis, zustrdr, zustrli, &
1632           zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)           zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
1633    
1634      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &
1635         ztit = 'after orography'           2, dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &
1636         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &           d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
     END IF  
1637    
1638      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1639      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, &      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &
1640           nqmx-2, dtphys, u, t, paprs, play, pmfu, pmfd, pen_u, pde_u, &           dtphys, u, t, paprs, play, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
1641           pen_d, pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &           ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, &
1642           frac_impa, frac_nucl, pphis, albsol, rhcl, cldfra, rneb, &           frac_nucl, pphis, albsol, rhcl, cldfra, rneb, diafra, cldliq, &
1643           diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, &           pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)
          tr_seri, zmasse)  
1644    
1645      IF (offline) THEN      IF (offline) THEN
1646         call phystokenc(dtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &         call phystokenc(dtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &
# Line 1702  contains Line 1671  contains
1671      END DO      END DO
1672    
1673      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1674         ztit = 'after physic'         tit = 'after physic'
1675         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
1676              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1677              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1678         ! Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoute dans la dynamique,
1679         ! on devrait avoir que la variation d'entalpie par la dynamique         ! on devrait avoir que la variation d'entalpie par la dynamique
1680         ! est egale a la variation de la physique au pas de temps precedent.         ! est egale a la variation de la physique au pas de temps precedent.
1681         ! Donc la somme de ces 2 variations devrait etre nulle.         ! Donc la somme de ces 2 variations devrait etre nulle.
1682         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, sens, &         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, sens, &
1683              evap, rain_fall, snow_fall, ztsol, d_h_vcol, d_qt, d_ec, &              evap, rain_fall, snow_fall, ztsol, d_h_vcol, d_qt, d_ec, &
1684              fs_bound, fq_bound)              fs_bound, fq_bound)
1685    
Legend:
Removed from v.61  
changed lines
  Added in v.68
  ViewVC Help
Powered by ViewVC 1.1.21