/[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 62 by guez, Thu Jul 26 14:37:37 2012 UTC
# Line 26  contains Line 26  contains
26      USE concvl_m, ONLY: concvl      USE concvl_m, ONLY: concvl
27      USE conf_gcm_m, ONLY: offline, raz_date      USE conf_gcm_m, ONLY: offline, raz_date
28      USE conf_phys_m, ONLY: conf_phys      USE conf_phys_m, ONLY: conf_phys
29        use conflx_m, only: conflx
30      USE ctherm, ONLY: iflag_thermals, nsplit_thermals      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
31      use diagcld2_m, only: diagcld2      use diagcld2_m, only: diagcld2
32      use diagetpq_m, only: diagetpq      use diagetpq_m, only: diagetpq
33        use diagphy_m, only: diagphy
34      USE dimens_m, ONLY: iim, jjm, llm, nqmx      USE dimens_m, ONLY: iim, jjm, llm, nqmx
35      USE dimphy, ONLY: klon, nbtr      USE dimphy, ONLY: klon, nbtr
36      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
# Line 100  contains Line 102  contains
102      REAL PVteta(klon, nbteta)      REAL PVteta(klon, nbteta)
103      ! (output vorticite potentielle a des thetas constantes)      ! (output vorticite potentielle a des thetas constantes)
104    
     LOGICAL ok_cvl ! pour activer le nouveau driver pour convection KE  
     PARAMETER (ok_cvl = .TRUE.)  
105      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
106      PARAMETER (ok_gust = .FALSE.)      PARAMETER (ok_gust = .FALSE.)
107    
# Line 348  contains Line 348  contains
348      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)
349      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
350    
351      !AA      REAL, save:: rain_fall(klon) ! pluie
352      REAL rain_fall(klon) ! pluie      REAL, save:: snow_fall(klon) ! neige
353      REAL snow_fall(klon) ! neige  
     save snow_fall, rain_fall  
     !IM cf FH pour Tiedtke 080604  
354      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
355    
356      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon), devap(klon) ! evaporation et sa derivee
# Line 422  contains Line 420  contains
420      REAL zxfluxu(klon, llm)      REAL zxfluxu(klon, llm)
421      REAL zxfluxv(klon, llm)      REAL zxfluxv(klon, llm)
422    
423      ! 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
424      ! que les variables soient rémanentes      ! les variables soient rémanentes.
425      REAL, save:: heat(klon, llm) ! chauffage solaire      REAL, save:: heat(klon, llm) ! chauffage solaire
426      REAL heat0(klon, llm) ! chauffage solaire ciel clair      REAL heat0(klon, llm) ! chauffage solaire ciel clair
427      REAL cool(klon, llm) ! refroidissement infrarouge      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
428      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair
429      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon), sollw(klon)
430      real sollwdown(klon) ! downward LW flux at surface      real sollwdown(klon) ! downward LW flux at surface
431      REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
432      REAL albpla(klon)      REAL albpla(klon)
433      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface
434      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface
435      SAVE cool, albpla, topsw, toplw, solsw, sollw, sollwdown      SAVE albpla, sollwdown
436      SAVE topsw0, toplw0, solsw0, sollw0, heat0, cool0      SAVE heat0, cool0
437    
438      INTEGER itaprad      INTEGER itaprad
439      SAVE itaprad      SAVE itaprad
# Line 482  contains Line 480  contains
480      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)
481      REAL s_trmb3(klon)      REAL s_trmb3(klon)
482    
483      ! Variables locales pour la convection de K. Emanuel (sb):      ! Variables locales pour la convection de K. Emanuel :
484    
485      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
486      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
# Line 523  contains Line 521  contains
521      REAL pmflxr(klon, llm + 1), pmflxs(klon, llm + 1)      REAL pmflxr(klon, llm + 1), pmflxs(klon, llm + 1)
522      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)
523    
524      INTEGER,save:: ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
525    
526      REAL rain_con(klon), rain_lsc(klon)      REAL rain_con(klon), rain_lsc(klon)
527      REAL snow_con(klon), snow_lsc(klon)      REAL snow_con(klon), snow_lsc(klon)
# Line 594  contains Line 592  contains
592      REAL, SAVE:: d_h_vcol_phy      REAL, SAVE:: d_h_vcol_phy
593      REAL fs_bound, fq_bound      REAL fs_bound, fq_bound
594      REAL zero_v(klon)      REAL zero_v(klon)
595      CHARACTER(LEN = 15) ztit      CHARACTER(LEN = 15) tit
596      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
597      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics
598    
# Line 624  contains Line 622  contains
622      REAL topswad(klon), solswad(klon) ! Aerosol direct effect.      REAL topswad(klon), solswad(klon) ! Aerosol direct effect.
623      ! ok_ade = True -ADE = topswad-topsw      ! ok_ade = True -ADE = topswad-topsw
624    
625      REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.      REAL topswai(klon), solswai(klon) ! aerosol indirect effect
626      ! ok_aie = True ->      ! ok_aie = True ->
627      ! ok_ade = True -AIE = topswai-topswad      ! ok_ade = True -AIE = topswai-topswad
628      ! ok_ade = F -AIE = topswai-topsw      ! ok_ade = F -AIE = topswai-topsw
# Line 632  contains Line 630  contains
630      REAL aerindex(klon) ! POLDER aerosol index      REAL aerindex(klon) ! POLDER aerosol index
631    
632      ! Parameters      ! Parameters
633      LOGICAL ok_ade, ok_aie ! Apply aerosol (in)direct effects or not      LOGICAL, save:: ok_ade ! apply aerosol direct effect
634        LOGICAL, save:: ok_aie ! Apply aerosol indirect effect
635      REAL bl95_b0, bl95_b1 ! Parameter in Boucher and Lohmann (1995)      REAL bl95_b0, bl95_b1 ! Parameter in Boucher and Lohmann (1995)
636    
637      SAVE ok_ade, ok_aie, bl95_b0, bl95_b1      SAVE bl95_b0, bl95_b1
638      SAVE u10m      SAVE u10m
639      SAVE v10m      SAVE v10m
640      SAVE t2m      SAVE t2m
# 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         ! Appel à la lecture du run.def physique
718           call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, ok_instan, &
719         call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, &              fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, ratqsbas, &
720              ok_instan, fact_cldcon, facttemps, ok_newmicro, &              ratqshaut, if_ebil, ok_ade, ok_aie, bl95_b0, bl95_b1, &
             iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &  
             ok_ade, ok_aie, &  
             bl95_b0, bl95_b1, &  
721              iflag_thermals, nsplit_thermals)              iflag_thermals, nsplit_thermals)
722    
723         ! Initialiser les compteurs:         ! Initialiser les compteurs:
# Line 753  contains Line 749  contains
749              ok_region)              ok_region)
750    
751         IF (dtphys*REAL(radpas) > 21600..AND.cycle_diurne) THEN         IF (dtphys*REAL(radpas) > 21600..AND.cycle_diurne) THEN
752            print *,'Nbre d appels au rayonnement insuffisant'            print *, 'Nbre d appels au rayonnement insuffisant'
753            print *,"Au minimum 4 appels par jour si cycle diurne"            print *, "Au minimum 4 appels par jour si cycle diurne"
754            abort_message = 'Nbre d appels au rayonnement insuffisant'            abort_message = 'Nbre d appels au rayonnement insuffisant'
755            call abort_gcm(modname, abort_message, 1)            call abort_gcm(modname, abort_message, 1)
756         ENDIF         ENDIF
757         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  
758    
759         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour la convection de K.E. (sb):
760         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
761              print *, "Convection de Kerry Emanuel 4.3"
762    
           print *,"*** Convection de Kerry Emanuel 4.3 "  
   
           !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG  
763            DO i = 1, klon            DO i = 1, klon
764               ibas_con(i) = 1               ibas_con(i) = 1
765               itop_con(i) = 1               itop_con(i) = 1
766            ENDDO            ENDDO
           !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>END  
   
767         ENDIF         ENDIF
768    
769         IF (ok_orodr) THEN         IF (ok_orodr) THEN
# Line 797  contains Line 787  contains
787         npas = 0         npas = 0
788         nexca = 0         nexca = 0
789    
        print *,'AVANT HIST IFLAG_CON = ', iflag_con  
   
790         ! Initialisation des sorties         ! Initialisation des sorties
791    
792         call ini_histhf(dtphys, nid_hf, nid_hf3d)         call ini_histhf(dtphys, nid_hf, nid_hf3d)
# Line 853  contains Line 841  contains
841      ENDDO      ENDDO
842    
843      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
844         ztit = 'after dynamics'         tit = 'after dynamics'
845         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, &
846              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, &
847              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
848         ! 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 850  contains
850         !  être égale à la variation de la physique au pas de temps         !  être égale à la variation de la physique au pas de temps
851         !  précédent.  Donc la somme de ces 2 variations devrait être         !  précédent.  Donc la somme de ces 2 variations devrait être
852         !  nulle.         !  nulle.
853         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, &
854              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, &
855              d_qt, 0., fs_bound, fq_bound)              d_qt, 0., fs_bound, fq_bound)
856      END IF      END IF
# Line 919  contains Line 907  contains
907      ql_seri = 0.      ql_seri = 0.
908    
909      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
910         ztit = 'after reevap'         tit = 'after reevap'
911         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, &
912              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, &
913              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
914         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, &
915              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, &
916              fs_bound, fq_bound)              fs_bound, fq_bound)
917    
# Line 1027  contains Line 1015  contains
1015      ENDDO      ENDDO
1016    
1017      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1018         ztit = 'after clmain'         tit = 'after clmain'
1019         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, &
1020              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, &
1021              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1022         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, &
1023              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, &
1024              fs_bound, fq_bound)              fs_bound, fq_bound)
1025      END IF      END IF
# Line 1139  contains Line 1127  contains
1127         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1128         print *, "avantcon = ", za         print *, "avantcon = ", za
1129      ENDIF      ENDIF
1130      zx_ajustq = .FALSE.      zx_ajustq = iflag_con == 2
     IF (iflag_con == 2) zx_ajustq = .TRUE.  
1131      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1132         DO i = 1, klon         DO i = 1, klon
1133            z_avant(i) = 0.0            z_avant(i) = 0.0
# Line 1154  contains Line 1141  contains
1141      ENDIF      ENDIF
1142    
1143      select case (iflag_con)      select case (iflag_con)
     case (1)  
        print *, 'Réactiver l''appel à "conlmd" dans "physiq.F".'  
        stop 1  
1144      case (2)      case (2)
1145         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, &
1146              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 1161  contains
1161         ! Schéma de convection modularisé et vectorisé :         ! Schéma de convection modularisé et vectorisé :
1162         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1163    
1164         IF (ok_cvl) THEN         CALL concvl(iflag_con, dtphys, paprs, play, t_seri, q_seri, u_seri, &
1165            ! new driver for convectL              v_seri, tr_seri, ntra, ema_work1, ema_work2, d_t_con, d_q_con, &
1166            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, &
1167                 u_seri, v_seri, tr_seri, ntra, ema_work1, ema_work2, d_t_con, &              upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, bbase, &
1168                 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, &
1169                 itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, &              da, phi, mp)
1170                 bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, &         clwcon0 = qcondc
1171                 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  
1172    
1173         IF (.NOT. ok_gust) THEN         IF (.NOT. ok_gust) THEN
1174            do i = 1, klon            do i = 1, klon
# Line 1226  contains Line 1200  contains
1200    
1201         ! calcul des proprietes des nuages convectifs         ! calcul des proprietes des nuages convectifs
1202         clwcon0 = fact_cldcon*clwcon0         clwcon0 = fact_cldcon*clwcon0
1203         call clouds_gno &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
1204              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)              rnebcon0)
1205      case default      case default
1206         print *, "iflag_con non-prevu", iflag_con         print *, "iflag_con non-prevu", iflag_con
1207         stop 1         stop 1
# Line 1243  contains Line 1217  contains
1217      ENDDO      ENDDO
1218    
1219      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1220         ztit = 'after convect'         tit = 'after convect'
1221         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, &
1222              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, &
1223              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1224         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, &
1225              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, &
1226              fs_bound, fq_bound)              fs_bound, fq_bound)
1227      END IF      END IF
1228    
1229      IF (check) THEN      IF (check) THEN
1230         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1231         print *,"aprescon = ", za         print *, "aprescon = ", za
1232         zx_t = 0.0         zx_t = 0.0
1233         za = 0.0         za = 0.0
1234         DO i = 1, klon         DO i = 1, klon
# Line 1263  contains Line 1237  contains
1237                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
1238         ENDDO         ENDDO
1239         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1240         print *,"Precip = ", zx_t         print *, "Precip = ", zx_t
1241      ENDIF      ENDIF
1242      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1243         DO i = 1, klon         DO i = 1, klon
# Line 1310  contains Line 1284  contains
1284      endif      endif
1285    
1286      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1287         ztit = 'after dry_adjust'         tit = 'after dry_adjust'
1288         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, &
1289              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, &
1290              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1291      END IF      END IF
# Line 1375  contains Line 1349  contains
1349      ENDDO      ENDDO
1350      IF (check) THEN      IF (check) THEN
1351         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1352         print *,"apresilp = ", za         print *, "apresilp = ", za
1353         zx_t = 0.0         zx_t = 0.0
1354         za = 0.0         za = 0.0
1355         DO i = 1, klon         DO i = 1, klon
# Line 1384  contains Line 1358  contains
1358                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1359         ENDDO         ENDDO
1360         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1361         print *,"Precip = ", zx_t         print *, "Precip = ", zx_t
1362      ENDIF      ENDIF
1363    
1364      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1365         ztit = 'after fisrt'         tit = 'after fisrt'
1366         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, &
1367              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, &
1368              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1369         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, &
1370              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, &
1371              fs_bound, fq_bound)              fs_bound, fq_bound)
1372      END IF      END IF
# Line 1401  contains Line 1375  contains
1375    
1376      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
1377    
1378      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke      IF (iflag_cldcon <= -1) THEN
1379           ! seulement pour Tiedtke
1380         snow_tiedtke = 0.         snow_tiedtke = 0.
1381         if (iflag_cldcon == -1) then         if (iflag_cldcon == -1) then
1382            rain_tiedtke = rain_con            rain_tiedtke = rain_con
# Line 1465  contains Line 1440  contains
1440      ENDIF      ENDIF
1441    
1442      ! Precipitation totale      ! Precipitation totale
   
1443      DO i = 1, klon      DO i = 1, klon
1444         rain_fall(i) = rain_con(i) + rain_lsc(i)         rain_fall(i) = rain_con(i) + rain_lsc(i)
1445         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
1446      ENDDO      ENDDO
1447    
1448      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) CALL diagetpq(airephy, "after diagcld", ip_ebil, 2, 2, &
1449         ztit = "after diagcld"           dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &
1450         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  
1451    
1452      ! Humidité relative pour diagnostic:      ! Humidité relative pour diagnostic :
1453      DO k = 1, llm      DO k = 1, llm
1454         DO i = 1, klon         DO i = 1, klon
1455            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
# Line 1501  contains Line 1472  contains
1472      ENDDO      ENDDO
1473    
1474      ! Introduce the aerosol direct and first indirect radiative forcings:      ! Introduce the aerosol direct and first indirect radiative forcings:
1475      ! Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)      ! Johannes Quaas, 27/11/2003
1476      IF (ok_ade .OR. ok_aie) THEN      IF (ok_ade .OR. ok_aie) THEN
1477         ! Get sulfate aerosol distribution         ! Get sulfate aerosol distribution
1478         CALL readsulfate(rdayvrai, firstcal, sulfate)         CALL readsulfate(rdayvrai, firstcal, sulfate)
# Line 1516  contains Line 1487  contains
1487         cg_ae = 0.         cg_ae = 0.
1488      ENDIF      ENDIF
1489    
1490      ! Paramètres optiques des nuages et quelques paramètres pour      ! Paramètres optiques des nuages et quelques paramètres pour diagnostics :
     ! diagnostics :  
1491      if (ok_newmicro) then      if (ok_newmicro) then
1492         CALL newmicro(paprs, play, ok_newmicro, t_seri, cldliq, cldfra, &         CALL newmicro(paprs, play, ok_newmicro, t_seri, cldliq, cldfra, &
1493              cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, &              cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, &
# Line 1541  contains Line 1511  contains
1511                 + falblw(i, is_ter) * pctsrf(i, is_ter) &                 + falblw(i, is_ter) * pctsrf(i, is_ter) &
1512                 + falblw(i, is_sic) * pctsrf(i, is_sic)                 + falblw(i, is_sic) * pctsrf(i, is_sic)
1513         ENDDO         ENDDO
1514         ! nouveau rayonnement (compatible Arpege-IFS):         ! Rayonnement (compatible Arpege-IFS) :
1515         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &
1516              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &
1517              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &
# Line 1561  contains Line 1531  contains
1531      ENDDO      ENDDO
1532    
1533      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1534         ztit = 'after rad'         tit = 'after rad'
1535         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, &
1536              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, &
1537              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1538         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, &         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, &
1539              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, &
1540              fs_bound, fq_bound)              fs_bound, fq_bound)
1541      END IF      END IF
# Line 1642  contains Line 1612  contains
1612         ENDDO         ENDDO
1613      ENDIF      ENDIF
1614    
1615      ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE      ! Stress nécessaires : toute la physique
1616    
1617      DO i = 1, klon      DO i = 1, klon
1618         zustrph(i) = 0.         zustrph(i) = 0.
# Line 1650  contains Line 1620  contains
1620      ENDDO      ENDDO
1621      DO k = 1, llm      DO k = 1, llm
1622         DO i = 1, klon         DO i = 1, klon
1623            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 &
1624            zvstrph(i) = zvstrph(i) + (v_seri(i, k)-v(i, k))/dtphys* zmasse(i, k)                 * zmasse(i, k)
1625              zvstrph(i) = zvstrph(i) + (v_seri(i, k) - v(i, k)) / dtphys &
1626                   * zmasse(i, k)
1627         ENDDO         ENDDO
1628      ENDDO      ENDDO
1629    
1630      CALL aaam_bud(ra, rg, romega, rlat, rlon, pphis, zustrdr, zustrli, &      CALL aaam_bud(ra, rg, romega, rlat, rlon, pphis, zustrdr, zustrli, &
1631           zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)           zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
1632    
1633      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &
1634         ztit = 'after orography'           2, dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &
1635         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  
1636    
1637      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1638      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, &      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &
1639           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, &
1640           pen_d, pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &           ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, &
1641           frac_impa, frac_nucl, pphis, albsol, rhcl, cldfra, rneb, &           frac_nucl, pphis, albsol, rhcl, cldfra, rneb, diafra, cldliq, &
1642           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)  
1643    
1644      IF (offline) THEN      IF (offline) THEN
1645         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 1670  contains
1670      END DO      END DO
1671    
1672      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1673         ztit = 'after physic'         tit = 'after physic'
1674         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, &
1675              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, &
1676              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1677         ! Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoute dans la dynamique,
1678         ! on devrait avoir que la variation d'entalpie par la dynamique         ! on devrait avoir que la variation d'entalpie par la dynamique
1679         ! 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.
1680         ! Donc la somme de ces 2 variations devrait etre nulle.         ! Donc la somme de ces 2 variations devrait etre nulle.
1681         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, sens, &         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, sens, &
1682              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, &
1683              fs_bound, fq_bound)              fs_bound, fq_bound)
1684    
Legend:
Removed from v.61  
changed lines
  Added in v.62
  ViewVC Help
Powered by ViewVC 1.1.21