/[lmdze]/trunk/libf/phylmd/physiq.f90
ViewVC logotype

Diff of /trunk/libf/phylmd/physiq.f90

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

revision 6 by guez, Tue Mar 4 14:00:42 2008 UTC revision 13 by guez, Fri Jul 25 19:59:34 2008 UTC
# Line 9  module physiq_m Line 9  module physiq_m
9    
10  contains  contains
11    
12    SUBROUTINE physiq (nq, debut, lafin, rjourvrai, gmtime, pdtphys, paprs, &    SUBROUTINE physiq(nq, firstcal, lafin, rdayvrai, gmtime, pdtphys, paprs, &
13         pplay, pphi, pphis, presnivs, clesphy0, u, v, t, qx, omega, d_u, d_v, &         pplay, pphi, pphis, presnivs, u, v, t, qx, omega, d_u, d_v, &
14         d_t, d_qx, d_ps, dudyn, PVteta)         d_t, d_qx, d_ps, dudyn, PVteta)
15    
16      ! From phylmd/physiq.F, v 1.22 2006/02/20 09:38:28      ! From phylmd/physiq.F, v 1.22 2006/02/20 09:38:28
# Line 32  contains Line 32  contains
32      use dimsoil, only: nsoilmx      use dimsoil, only: nsoilmx
33      use temps, only: itau_phy, day_ref, annee_ref, itaufin      use temps, only: itau_phy, day_ref, annee_ref, itaufin
34      use clesphys, only: ecrit_hf, ecrit_hf2mth, &      use clesphys, only: ecrit_hf, ecrit_hf2mth, &
35           ecrit_ins, iflag_con, ok_orolf, ok_orodr, ecrit_mth, ecrit_day, &           ecrit_ins, ecrit_mth, ecrit_day, &
36           nbapp_rad, cycle_diurne, cdmmax, cdhmax, &           cdmmax, cdhmax, &
37           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, new_oliq, &           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, &
38           ok_kzmin, soil_model           ok_kzmin
39      use iniprint, only: lunout, prt_level      use clesphys2, only: iflag_con, ok_orolf, ok_orodr, nbapp_rad, &
40             cycle_diurne, new_oliq, soil_model
41        use iniprint, only: prt_level
42      use abort_gcm_m, only: abort_gcm      use abort_gcm_m, only: abort_gcm
43      use YOMCST, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega      use YOMCST, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega
44      use comgeomphy      use comgeomphy
# Line 58  contains Line 60  contains
60      ! Variables argument:      ! Variables argument:
61    
62      INTEGER nq ! input nombre de traceurs (y compris vapeur d'eau)      INTEGER nq ! input nombre de traceurs (y compris vapeur d'eau)
63      REAL rjourvrai ! input numero du jour de l'experience      REAL, intent(in):: rdayvrai ! input numero du jour de l'experience
64      REAL, intent(in):: gmtime ! heure de la journée en fraction de jour      REAL, intent(in):: gmtime ! heure de la journée en fraction de jour
65      REAL pdtphys ! input pas d'integration pour la physique (seconde)      REAL, intent(in):: pdtphys ! pas d'integration pour la physique (seconde)
66      LOGICAL, intent(in):: debut ! premier passage      LOGICAL, intent(in):: firstcal ! first call to "calfis"
67      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
68    
69      REAL, intent(in):: paprs(klon, llm+1)      REAL, intent(in):: paprs(klon, llm+1)
70      ! (pression pour chaque inter-couche, en Pa)      ! (pression pour chaque inter-couche, en Pa)
71            
72      REAL pplay(klon, llm)      REAL, intent(in):: pplay(klon, llm)
73      ! (input pression pour le mileu de chaque couche (en Pa))      ! (input pression pour le mileu de chaque couche (en Pa))
74    
75      REAL pphi(klon, llm)        REAL pphi(klon, llm)  
# Line 82  contains Line 84  contains
84      REAL v(klon, llm)  ! input vitesse Y (de S a N) en m/s      REAL v(klon, llm)  ! input vitesse Y (de S a N) en m/s
85      REAL t(klon, llm)  ! input temperature (K)      REAL t(klon, llm)  ! input temperature (K)
86    
87      REAL qx(klon, llm, nq)      REAL, intent(in):: qx(klon, llm, nq)
88      ! (input humidite specifique (kg/kg) et d'autres traceurs)      ! (humidite specifique (kg/kg) et fractions massiques des autres traceurs)
89    
90      REAL omega(klon, llm)  ! input vitesse verticale en Pa/s      REAL omega(klon, llm)  ! input vitesse verticale en Pa/s
91      REAL d_u(klon, llm)  ! output tendance physique de "u" (m/s/s)      REAL d_u(klon, llm)  ! output tendance physique de "u" (m/s/s)
# Line 112  contains Line 114  contains
114      INTEGER, SAVE :: npas, nexca      INTEGER, SAVE :: npas, nexca
115      logical rnpb      logical rnpb
116      parameter(rnpb=.true.)      parameter(rnpb=.true.)
117      !      ocean = type de modele ocean a utiliser: force, slab, couple  
118      character(len=6) ocean      character(len=6), save:: ocean
119      SAVE ocean      ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")
120    
121      logical ok_ocean      logical ok_ocean
122      SAVE ok_ocean      SAVE ok_ocean
# Line 317  contains Line 319  contains
319    
320      INTEGER        longcles      INTEGER        longcles
321      PARAMETER    ( longcles = 20 )      PARAMETER    ( longcles = 20 )
     REAL clesphy0( longcles      )  
   
     ! Variables quasi-arguments  
   
     REAL xjour  
     SAVE xjour  
322    
323      ! Variables propres a la physique      ! Variables propres a la physique
324    
     REAL, SAVE:: dtime ! pas temporel de la physique (s)  
   
325      INTEGER, save:: radpas      INTEGER, save:: radpas
326      ! (Radiative transfer computations are made every "radpas" call to      ! (Radiative transfer computations are made every "radpas" call to
327      ! "physiq".)      ! "physiq".)
# Line 335  contains Line 329  contains
329      REAL radsol(klon)      REAL radsol(klon)
330      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif
331    
332      INTEGER, SAVE:: itap ! compteur pour la physique      INTEGER, SAVE:: itap ! number of calls to "physiq"
     REAL co2_ppm_etat0  
     REAL solaire_etat0  
333    
334      REAL ftsol(klon, nbsrf)      REAL ftsol(klon, nbsrf)
335      SAVE ftsol                  ! temperature du sol      SAVE ftsol                  ! temperature du sol
# Line 364  contains Line 356  contains
356      REAL falblw(klon, nbsrf)      REAL falblw(klon, nbsrf)
357      SAVE falblw                 ! albedo par type de surface      SAVE falblw                 ! albedo par type de surface
358    
359      !  Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :
360        REAL, save:: zmea(klon) ! orographie moyenne
361      REAL zmea(klon)      REAL, save:: zstd(klon) ! deviation standard de l'OESM
362      SAVE zmea                   ! orographie moyenne      REAL, save:: zsig(klon) ! pente de l'OESM
363        REAL, save:: zgam(klon) ! anisotropie de l'OESM
364      REAL zstd(klon)      REAL, save:: zthe(klon) ! orientation de l'OESM
365      SAVE zstd                   ! deviation standard de l'OESM      REAL, save:: zpic(klon) ! Maximum de l'OESM
366        REAL, save:: zval(klon) ! Minimum de l'OESM
367      REAL zsig(klon)      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM
     SAVE zsig                   ! pente de l'OESM  
   
     REAL zgam(klon)  
     save zgam                   ! anisotropie de l'OESM  
   
     REAL zthe(klon)  
     SAVE zthe                   ! orientation de l'OESM  
   
     REAL zpic(klon)  
     SAVE zpic                   ! Maximum de l'OESM  
   
     REAL zval(klon)  
     SAVE zval                   ! Minimum de l'OESM  
   
     REAL rugoro(klon)  
     SAVE rugoro                 ! longueur de rugosite de l'OESM  
368    
369      REAL zulow(klon), zvlow(klon)      REAL zulow(klon), zvlow(klon)
370    
# Line 472  contains Line 448  contains
448    
449      INTEGER julien      INTEGER julien
450    
451      INTEGER, SAVE:: lmt_pas ! fréquence de mise à jour      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
452      REAL pctsrf(klon, nbsrf)      REAL pctsrf(klon, nbsrf)
453      !IM      !IM
454      REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE      REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE
# Line 500  contains Line 476  contains
476      EXTERNAL transp    ! transport total de l'eau et de l'energie      EXTERNAL transp    ! transport total de l'eau et de l'energie
477    
478      EXTERNAL ini_undefSTD  !initialise a 0 une variable a 1 niveau de pression      EXTERNAL ini_undefSTD  !initialise a 0 une variable a 1 niveau de pression
479      EXTERNAL undefSTD !somme les valeurs definies d'1 var a 1 niveau de pression  
480        EXTERNAL undefSTD
481        ! (somme les valeurs definies d'1 var a 1 niveau de pression)
482    
483      ! Variables locales      ! Variables locales
484    
# Line 675  contains Line 653  contains
653      REAL d_tr(klon, llm, nbtr)      REAL d_tr(klon, llm, nbtr)
654    
655      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
   
     INTEGER        length  
     PARAMETER    ( length = 100 )  
     REAL tabcntr0( length       )  
   
656      INTEGER ndex2d(iim*(jjm + 1)), ndex3d(iim*(jjm + 1)*llm)      INTEGER ndex2d(iim*(jjm + 1)), ndex3d(iim*(jjm + 1)*llm)
657    
658      REAL zustrdr(klon), zvstrdr(klon)      REAL zustrdr(klon), zvstrdr(klon)
# Line 802  contains Line 775  contains
775         END DO         END DO
776      END IF      END IF
777      ok_sync=.TRUE.      ok_sync=.TRUE.
778      IF (nq .LT. 2) THEN      IF (nq  <  2) THEN
779         abort_message = 'eaux vapeur et liquide sont indispensables'         abort_message = 'eaux vapeur et liquide sont indispensables'
780         CALL abort_gcm (modname, abort_message, 1)         CALL abort_gcm(modname, abort_message, 1)
781      ENDIF      ENDIF
782    
783      xjour = rjourvrai      test_firstcal: IF (firstcal) THEN
   
     test_debut: IF (debut) THEN  
784         !  initialiser         !  initialiser
785         u10m(:, :)=0.         u10m=0.
786         v10m(:, :)=0.         v10m=0.
787         t2m(:, :)=0.         t2m=0.
788         q2m(:, :)=0.         q2m=0.
789         ffonte(:, :)=0.         ffonte=0.
790         fqcalving(:, :)=0.         fqcalving=0.
791         piz_ae(:, :, :)=0.         piz_ae(:, :, :)=0.
792         tau_ae(:, :, :)=0.         tau_ae(:, :, :)=0.
793         cg_ae(:, :, :)=0.         cg_ae(:, :, :)=0.
# Line 829  contains Line 800  contains
800         solswai(:)=0.         solswai(:)=0.
801         solswad(:)=0.         solswad(:)=0.
802    
803         d_u_con(:, :) = 0.0         d_u_con = 0.0
804         d_v_con(:, :) = 0.0         d_v_con = 0.0
805         rnebcon0(:, :) = 0.0         rnebcon0 = 0.0
806         clwcon0(:, :) = 0.0         clwcon0 = 0.0
807         rnebcon(:, :) = 0.0         rnebcon = 0.0
808         clwcon(:, :) = 0.0         clwcon = 0.0
809    
810         pblh(:, :)   =0.        ! Hauteur de couche limite         pblh   =0.        ! Hauteur de couche limite
811         plcl(:, :)   =0.        ! Niveau de condensation de la CLA         plcl   =0.        ! Niveau de condensation de la CLA
812         capCL(:, :)  =0.        ! CAPE de couche limite         capCL  =0.        ! CAPE de couche limite
813         oliqCL(:, :) =0.        ! eau_liqu integree de couche limite         oliqCL =0.        ! eau_liqu integree de couche limite
814         cteiCL(:, :) =0.        ! cloud top instab. crit. couche limite         cteiCL =0.        ! cloud top instab. crit. couche limite
815         pblt(:, :)   =0.        ! T a la Hauteur de couche limite         pblt   =0.        ! T a la Hauteur de couche limite
816         therm(:, :)  =0.         therm  =0.
817         trmb1(:, :)  =0.        ! deep_cape         trmb1  =0.        ! deep_cape
818         trmb2(:, :)  =0.        ! inhibition         trmb2  =0.        ! inhibition
819         trmb3(:, :)  =0.        ! Point Omega         trmb3  =0.        ! Point Omega
820    
821         IF (if_ebil >= 1) d_h_vcol_phy=0.         IF (if_ebil >= 1) d_h_vcol_phy=0.
822    
# Line 863  contains Line 834  contains
834         frugs = 0.         frugs = 0.
835         itap = 0         itap = 0
836         itaprad = 0         itaprad = 0
837         CALL phyetat0("startphy.nc", dtime, co2_ppm_etat0, solaire_etat0, &         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &
838              pctsrf, ftsol, ftsoil, &              seaice, fqsurf, qsol, fsnow, &
             ocean, tslab, seaice, & !IM "slab" ocean  
             fqsurf, qsol, fsnow, &  
839              falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &              falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &
840              dlw, radsol, frugs, agesno, clesphy0, &              dlw, radsol, frugs, agesno, &
841              zmea, zstd, zsig, zgam, zthe, zpic, zval, rugoro, tabcntr0, &              zmea, zstd, zsig, zgam, zthe, zpic, zval, &
842              t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon,  &              t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon,  &
843              run_off_lic_0)              run_off_lic_0)
844    
845         !   ATTENTION : il faudra a terme relire q2 dans l'etat initial         !   ATTENTION : il faudra a terme relire q2 dans l'etat initial
846         q2(:, :, :)=1.e-8         q2(:, :, :)=1.e-8
847    
848         radpas = NINT( 86400. / dtime / nbapp_rad)         radpas = NINT( 86400. / pdtphys / nbapp_rad)
849    
850         ! on remet le calendrier a zero         ! on remet le calendrier a zero
851    
# Line 884  contains Line 853  contains
853            itau_phy = 0            itau_phy = 0
854         ENDIF         ENDIF
855    
856         PRINT*, 'cycle_diurne =', cycle_diurne         PRINT *, 'cycle_diurne = ', cycle_diurne
857    
858         IF(ocean.NE.'force ') THEN         IF(ocean.NE.'force ') THEN
859            ok_ocean=.TRUE.            ok_ocean=.TRUE.
860         ENDIF         ENDIF
861    
862         CALL printflag( tabcntr0, radpas, ok_ocean, ok_oasis, ok_journe, &         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &
863              ok_instan, ok_region )              ok_region)
   
        IF (ABS(dtime-pdtphys).GT.0.001) THEN  
           WRITE(lunout, *) 'Pas physique n est pas correct', dtime, &  
                pdtphys  
           abort_message='Pas physique n est pas correct '  
           call abort_gcm(modname, abort_message, 1)  
        ENDIF  
864    
865         IF (dtime*REAL(radpas).GT.21600..AND.cycle_diurne) THEN         IF (pdtphys*REAL(radpas).GT.21600..AND.cycle_diurne) THEN
866            WRITE(lunout, *)'Nbre d appels au rayonnement insuffisant'            print *,'Nbre d appels au rayonnement insuffisant'
867            WRITE(lunout, *)"Au minimum 4 appels par jour si cycle diurne"            print *,"Au minimum 4 appels par jour si cycle diurne"
868            abort_message='Nbre d appels au rayonnement insuffisant'            abort_message='Nbre d appels au rayonnement insuffisant'
869            call abort_gcm(modname, abort_message, 1)            call abort_gcm(modname, abort_message, 1)
870         ENDIF         ENDIF
871         WRITE(lunout, *)"Clef pour la convection, iflag_con=", iflag_con         print *,"Clef pour la convection, iflag_con=", iflag_con
872         WRITE(lunout, *)"Clef pour le driver de la convection, ok_cvl=", &         print *,"Clef pour le driver de la convection, ok_cvl=", &
873              ok_cvl              ok_cvl
874    
875         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour la convection de K.E. (sb):
876         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
877    
878            WRITE(lunout, *)"*** Convection de Kerry Emanuel 4.3  "            print *,"*** Convection de Kerry Emanuel 4.3  "
879    
880            !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG            !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG
881            DO i = 1, klon            DO i = 1, klon
# Line 925  contains Line 887  contains
887         ENDIF         ENDIF
888    
889         IF (ok_orodr) THEN         IF (ok_orodr) THEN
890            DO i=1, klon            rugoro = MAX(1e-5, zstd * zsig / 2)
              rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)  
           ENDDO  
891            CALL SUGWD(klon, llm, paprs, pplay)            CALL SUGWD(klon, llm, paprs, pplay)
892           else
893              rugoro = 0.
894         ENDIF         ENDIF
895    
896         lmt_pas = NINT(86400. / dtime)  ! tous les jours         lmt_pas = NINT(86400. / pdtphys)  ! tous les jours
897         print *, 'La frequence de lecture surface est de ', lmt_pas         print *, 'Number of time steps of "physics" per day: ', lmt_pas
898    
899         ecrit_ins = NINT(ecrit_ins/dtime)         ecrit_ins = NINT(ecrit_ins/pdtphys)
900         ecrit_hf = NINT(ecrit_hf/dtime)         ecrit_hf = NINT(ecrit_hf/pdtphys)
901         ecrit_day = NINT(ecrit_day/dtime)         ecrit_day = NINT(ecrit_day/pdtphys)
902         ecrit_mth = NINT(ecrit_mth/dtime)         ecrit_mth = NINT(ecrit_mth/pdtphys)
903         ecrit_tra = NINT(86400.*ecrit_tra/dtime)         ecrit_tra = NINT(86400.*ecrit_tra/pdtphys)
904         ecrit_reg = NINT(ecrit_reg/dtime)         ecrit_reg = NINT(ecrit_reg/pdtphys)
905    
906         ! Initialiser le couplage si necessaire         ! Initialiser le couplage si necessaire
907    
908         npas = 0         npas = 0
909         nexca = 0         nexca = 0
        if (ocean == 'couple') then  
           npas = itaufin/ iphysiq  
           nexca = 86400 / int(dtime)  
           write(lunout, *)' Ocean couple'  
           write(lunout, *)' Valeurs des pas de temps'  
           write(lunout, *)' npas = ', npas  
           write(lunout, *)' nexca = ', nexca  
        endif  
910    
911         write(lunout, *)'AVANT HIST IFLAG_CON=', iflag_con         print *,'AVANT HIST IFLAG_CON=', iflag_con
912    
913         !   Initialisation des sorties         !   Initialisation des sorties
914    
915         call ini_histhf(dtime, presnivs, nid_hf, nid_hf3d)         call ini_histhf(pdtphys, presnivs, nid_hf, nid_hf3d)
916         call ini_histday(dtime, presnivs, ok_journe, nid_day)         call ini_histday(pdtphys, presnivs, ok_journe, nid_day)
917         call ini_histins(dtime, presnivs, ok_instan, nid_ins)         call ini_histins(pdtphys, presnivs, ok_instan, nid_ins)
918         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
919         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         !XXXPB Positionner date0 pour initialisation de ORCHIDEE
920         WRITE(*, *) 'physiq date0 : ', date0         WRITE(*, *) 'physiq date0 : ', date0
921      ENDIF test_debut      ENDIF test_firstcal
922    
923      ! Mettre a zero des variables de sortie (pour securite)      ! Mettre a zero des variables de sortie (pour securite)
924    
# Line 985  contains Line 939  contains
939            ENDDO            ENDDO
940         ENDDO         ENDDO
941      ENDDO      ENDDO
942      da(:, :)=0.      da=0.
943      mp(:, :)=0.      mp=0.
944      phi(:, :, :)=0.      phi(:, :, :)=0.
945    
946      ! Ne pas affecter les valeurs entrees de u, v, h, et q      ! Ne pas affecter les valeurs entrees de u, v, h, et q
# Line 1018  contains Line 972  contains
972    
973      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
974         ztit='after dynamic'         ztit='after dynamic'
975         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &
976              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
977              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
978         !     Comme les tendances de la physique sont ajoute dans la dynamique,         !     Comme les tendances de la physique sont ajoute dans la dynamique,
979         !     on devrait avoir que la variation d'entalpie par la dynamique         !     on devrait avoir que la variation d'entalpie par la dynamique
# Line 1037  contains Line 991  contains
991      IF (ancien_ok) THEN      IF (ancien_ok) THEN
992         DO k = 1, llm         DO k = 1, llm
993            DO i = 1, klon            DO i = 1, klon
994               d_t_dyn(i, k) = (t_seri(i, k)-t_ancien(i, k))/dtime               d_t_dyn(i, k) = (t_seri(i, k)-t_ancien(i, k))/pdtphys
995               d_q_dyn(i, k) = (q_seri(i, k)-q_ancien(i, k))/dtime               d_q_dyn(i, k) = (q_seri(i, k)-q_ancien(i, k))/pdtphys
996            ENDDO            ENDDO
997         ENDDO         ENDDO
998      ELSE      ELSE
# Line 1065  contains Line 1019  contains
1019    
1020      ! Incrementer le compteur de la physique      ! Incrementer le compteur de la physique
1021    
1022      itap   = itap + 1      itap = itap + 1
1023      julien = MOD(NINT(xjour), 360)      julien = MOD(NINT(rdayvrai), 360)
1024      if (julien == 0) julien = 360      if (julien == 0) julien = 360
1025    
1026      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst, etc.).
# Line 1094  contains Line 1048  contains
1048    
1049      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1050         ztit='after reevap'         ztit='after reevap'
1051         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, pdtphys &
1052              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1053              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1054         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1055              , zero_v, zero_v, zero_v, zero_v, zero_v &              , zero_v, zero_v, zero_v, zero_v, zero_v &
# Line 1125  contains Line 1079  contains
1079    
1080      CALL orbite(REAL(julien), zlongi, dist)      CALL orbite(REAL(julien), zlongi, dist)
1081      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
1082         zdtime = dtime * REAL(radpas)         zdtime = pdtphys * REAL(radpas)
1083         CALL zenang(zlongi, gmtime, zdtime, rmu0, fract)         CALL zenang(zlongi, gmtime, zdtime, rmu0, fract)
1084      ELSE      ELSE
1085         rmu0 = -999.999         rmu0 = -999.999
# Line 1154  contains Line 1108  contains
1108    
1109      fder = dlw      fder = dlw
1110    
1111      CALL clmain(dtime, itap, date0, pctsrf, pctsrf_new, &      CALL clmain(pdtphys, itap, date0, pctsrf, pctsrf_new, &
1112           t_seri, q_seri, u_seri, v_seri, &           t_seri, q_seri, u_seri, v_seri, &
1113           julien, rmu0, co2_ppm,  &           julien, rmu0, co2_ppm,  &
1114           ok_veget, ocean, npas, nexca, ftsol, &           ok_veget, ocean, npas, nexca, ftsol, &
# Line 1164  contains Line 1118  contains
1118           fluxlat, rain_fall, snow_fall, &           fluxlat, rain_fall, snow_fall, &
1119           fsolsw, fsollw, sollwdown, fder, &           fsolsw, fsollw, sollwdown, fder, &
1120           rlon, rlat, cuphy, cvphy, frugs, &           rlon, rlat, cuphy, cvphy, frugs, &
1121           debut, lafin, agesno, rugoro, &           firstcal, lafin, agesno, rugoro, &
1122           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &
1123           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &
1124           q2, dsens, devap, &           q2, dsens, devap, &
# Line 1211  contains Line 1165  contains
1165    
1166      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1167         ztit='after clmain'         ztit='after clmain'
1168         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1169              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1170              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1171         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1172              , zero_v, zero_v, zero_v, zero_v, sens &              , zero_v, zero_v, zero_v, zero_v, sens &
# Line 1282  contains Line 1236  contains
1236    
1237      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1238         DO i = 1, klon         DO i = 1, klon
1239            IF (pctsrf(i, nsrf) .LT. epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf)  <  epsfra) ftsol(i, nsrf) = zxtsol(i)
1240    
1241            IF (pctsrf(i, nsrf) .LT. epsfra) t2m(i, nsrf) = zt2m(i)            IF (pctsrf(i, nsrf)  <  epsfra) t2m(i, nsrf) = zt2m(i)
1242            IF (pctsrf(i, nsrf) .LT. epsfra) q2m(i, nsrf) = zq2m(i)            IF (pctsrf(i, nsrf)  <  epsfra) q2m(i, nsrf) = zq2m(i)
1243            IF (pctsrf(i, nsrf) .LT. epsfra) u10m(i, nsrf) = zu10m(i)            IF (pctsrf(i, nsrf)  <  epsfra) u10m(i, nsrf) = zu10m(i)
1244            IF (pctsrf(i, nsrf) .LT. epsfra) v10m(i, nsrf) = zv10m(i)            IF (pctsrf(i, nsrf)  <  epsfra) v10m(i, nsrf) = zv10m(i)
1245            IF (pctsrf(i, nsrf) .LT. epsfra) ffonte(i, nsrf) = zxffonte(i)            IF (pctsrf(i, nsrf)  <  epsfra) ffonte(i, nsrf) = zxffonte(i)
1246            IF (pctsrf(i, nsrf) .LT. epsfra)  &            IF (pctsrf(i, nsrf)  <  epsfra)  &
1247                 fqcalving(i, nsrf) = zxfqcalving(i)                 fqcalving(i, nsrf) = zxfqcalving(i)
1248            IF (pctsrf(i, nsrf) .LT. epsfra) pblh(i, nsrf)=s_pblh(i)            IF (pctsrf(i, nsrf)  <  epsfra) pblh(i, nsrf)=s_pblh(i)
1249            IF (pctsrf(i, nsrf) .LT. epsfra) plcl(i, nsrf)=s_lcl(i)            IF (pctsrf(i, nsrf)  <  epsfra) plcl(i, nsrf)=s_lcl(i)
1250            IF (pctsrf(i, nsrf) .LT. epsfra) capCL(i, nsrf)=s_capCL(i)            IF (pctsrf(i, nsrf)  <  epsfra) capCL(i, nsrf)=s_capCL(i)
1251            IF (pctsrf(i, nsrf) .LT. epsfra) oliqCL(i, nsrf)=s_oliqCL(i)            IF (pctsrf(i, nsrf)  <  epsfra) oliqCL(i, nsrf)=s_oliqCL(i)
1252            IF (pctsrf(i, nsrf) .LT. epsfra) cteiCL(i, nsrf)=s_cteiCL(i)            IF (pctsrf(i, nsrf)  <  epsfra) cteiCL(i, nsrf)=s_cteiCL(i)
1253            IF (pctsrf(i, nsrf) .LT. epsfra) pblT(i, nsrf)=s_pblT(i)            IF (pctsrf(i, nsrf)  <  epsfra) pblT(i, nsrf)=s_pblT(i)
1254            IF (pctsrf(i, nsrf) .LT. epsfra) therm(i, nsrf)=s_therm(i)            IF (pctsrf(i, nsrf)  <  epsfra) therm(i, nsrf)=s_therm(i)
1255            IF (pctsrf(i, nsrf) .LT. epsfra) trmb1(i, nsrf)=s_trmb1(i)            IF (pctsrf(i, nsrf)  <  epsfra) trmb1(i, nsrf)=s_trmb1(i)
1256            IF (pctsrf(i, nsrf) .LT. epsfra) trmb2(i, nsrf)=s_trmb2(i)            IF (pctsrf(i, nsrf)  <  epsfra) trmb2(i, nsrf)=s_trmb2(i)
1257            IF (pctsrf(i, nsrf) .LT. epsfra) trmb3(i, nsrf)=s_trmb3(i)            IF (pctsrf(i, nsrf)  <  epsfra) trmb3(i, nsrf)=s_trmb3(i)
1258         ENDDO         ENDDO
1259      ENDDO      ENDDO
1260    
# Line 1315  contains Line 1269  contains
1269      DO k = 1, llm      DO k = 1, llm
1270         DO i = 1, klon         DO i = 1, klon
1271            conv_q(i, k) = d_q_dyn(i, k)  &            conv_q(i, k) = d_q_dyn(i, k)  &
1272                 + d_q_vdf(i, k)/dtime                 + d_q_vdf(i, k)/pdtphys
1273            conv_t(i, k) = d_t_dyn(i, k)  &            conv_t(i, k) = d_t_dyn(i, k)  &
1274                 + d_t_vdf(i, k)/dtime                 + d_t_vdf(i, k)/pdtphys
1275         ENDDO         ENDDO
1276      ENDDO      ENDDO
1277      IF (check) THEN      IF (check) THEN
1278         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1279         WRITE(lunout, *) "avantcon=", za         print *, "avantcon=", za
1280      ENDIF      ENDIF
1281      zx_ajustq = .FALSE.      zx_ajustq = .FALSE.
1282      IF (iflag_con == 2) zx_ajustq=.TRUE.      IF (iflag_con == 2) zx_ajustq=.TRUE.
# Line 1340  contains Line 1294  contains
1294      IF (iflag_con == 1) THEN      IF (iflag_con == 1) THEN
1295         stop 'reactiver le call conlmd dans physiq.F'         stop 'reactiver le call conlmd dans physiq.F'
1296      ELSE IF (iflag_con == 2) THEN      ELSE IF (iflag_con == 2) THEN
1297         CALL conflx(dtime, paprs, pplay, t_seri, q_seri, &         CALL conflx(pdtphys, paprs, pplay, t_seri, q_seri, &
1298              conv_t, conv_q, zxfluxq(1, 1), omega, &              conv_t, conv_q, zxfluxq(1, 1), omega, &
1299              d_t_con, d_q_con, rain_con, snow_con, &              d_t_con, d_q_con, rain_con, snow_con, &
1300              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
# Line 1361  contains Line 1315  contains
1315         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1316    
1317         IF (ok_cvl) THEN ! new driver for convectL         IF (ok_cvl) THEN ! new driver for convectL
   
1318            CALL concvl (iflag_con, &            CALL concvl (iflag_con, &
1319                 dtime, paprs, pplay, t_seri, q_seri, &                 pdtphys, paprs, pplay, t_seri, q_seri, &
1320                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1321                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
1322                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &
# Line 1375  contains Line 1328  contains
1328                 da, phi, mp)                 da, phi, mp)
1329    
1330            clwcon0=qcondc            clwcon0=qcondc
1331            pmfu(:, :)=upwd(:, :)+dnwd(:, :)            pmfu=upwd+dnwd
   
1332         ELSE ! ok_cvl         ELSE ! ok_cvl
1333            ! MAF conema3 ne contient pas les traceurs            ! MAF conema3 ne contient pas les traceurs
1334            CALL conema3 (dtime, &            CALL conema3 (pdtphys, &
1335                 paprs, pplay, t_seri, q_seri, &                 paprs, pplay, t_seri, q_seri, &
1336                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1337                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
# Line 1390  contains Line 1342  contains
1342                 pbase &                 pbase &
1343                 , bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr &                 , bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr &
1344                 , clwcon0)                 , clwcon0)
   
1345         ENDIF ! ok_cvl         ENDIF ! ok_cvl
1346    
1347         IF (.NOT. ok_gust) THEN         IF (.NOT. ok_gust) THEN
# Line 1411  contains Line 1362  contains
1362                  zcor   = 1./(1.-retv*zx_qs)                  zcor   = 1./(1.-retv*zx_qs)
1363                  zx_qs  = zx_qs*zcor                  zx_qs  = zx_qs*zcor
1364               ELSE               ELSE
1365                  IF (zx_t.LT.t_coup) THEN                  IF (zx_t < t_coup) THEN
1366                     zx_qs = qsats(zx_t)/pplay(i, k)                     zx_qs = qsats(zx_t)/pplay(i, k)
1367                  ELSE                  ELSE
1368                     zx_qs = qsatl(zx_t)/pplay(i, k)                     zx_qs = qsatl(zx_t)/pplay(i, k)
# Line 1422  contains Line 1373  contains
1373         ENDDO         ENDDO
1374    
1375         !   calcul des proprietes des nuages convectifs         !   calcul des proprietes des nuages convectifs
1376         clwcon0(:, :)=fact_cldcon*clwcon0(:, :)         clwcon0=fact_cldcon*clwcon0
1377         call clouds_gno &         call clouds_gno &
1378              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)
1379      ELSE      ELSE
1380         WRITE(lunout, *) "iflag_con non-prevu", iflag_con         print *, "iflag_con non-prevu", iflag_con
1381         stop 1         stop 1
1382      ENDIF      ENDIF
1383    
# Line 1441  contains Line 1392  contains
1392    
1393      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1394         ztit='after convect'         ztit='after convect'
1395         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1396              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1397              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1398         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1399              , zero_v, zero_v, zero_v, zero_v, zero_v &              , zero_v, zero_v, zero_v, zero_v, zero_v &
# Line 1453  contains Line 1404  contains
1404    
1405      IF (check) THEN      IF (check) THEN
1406         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1407         WRITE(lunout, *)"aprescon=", za         print *,"aprescon=", za
1408         zx_t = 0.0         zx_t = 0.0
1409         za = 0.0         za = 0.0
1410         DO i = 1, klon         DO i = 1, klon
# Line 1461  contains Line 1412  contains
1412            zx_t = zx_t + (rain_con(i)+ &            zx_t = zx_t + (rain_con(i)+ &
1413                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
1414         ENDDO         ENDDO
1415         zx_t = zx_t/za*dtime         zx_t = zx_t/za*pdtphys
1416         WRITE(lunout, *)"Precip=", zx_t         print *,"Precip=", zx_t
1417      ENDIF      ENDIF
1418      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1419         DO i = 1, klon         DO i = 1, klon
# Line 1475  contains Line 1426  contains
1426            ENDDO            ENDDO
1427         ENDDO         ENDDO
1428         DO i = 1, klon         DO i = 1, klon
1429            z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtime) &            z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*pdtphys) &
1430                 /z_apres(i)                 /z_apres(i)
1431         ENDDO         ENDDO
1432         DO k = 1, llm         DO k = 1, llm
1433            DO i = 1, klon            DO i = 1, klon
1434               IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &               IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &
1435                    z_factor(i).LT.(1.0-1.0E-08)) THEN                    z_factor(i) < (1.0-1.0E-08)) THEN
1436                  q_seri(i, k) = q_seri(i, k) * z_factor(i)                  q_seri(i, k) = q_seri(i, k) * z_factor(i)
1437               ENDIF               ENDIF
1438            ENDDO            ENDDO
# Line 1491  contains Line 1442  contains
1442    
1443      ! Convection seche (thermiques ou ajustement)      ! Convection seche (thermiques ou ajustement)
1444    
1445      d_t_ajs(:, :)=0.      d_t_ajs=0.
1446      d_u_ajs(:, :)=0.      d_u_ajs=0.
1447      d_v_ajs(:, :)=0.      d_v_ajs=0.
1448      d_q_ajs(:, :)=0.      d_q_ajs=0.
1449      fm_therm(:, :)=0.      fm_therm=0.
1450      entr_therm(:, :)=0.      entr_therm=0.
1451    
1452      IF(prt_level>9)WRITE(lunout, *) &      IF(prt_level>9)print *, &
1453           'AVANT LA CONVECTION SECHE, iflag_thermals=' &           'AVANT LA CONVECTION SECHE, iflag_thermals=' &
1454           , iflag_thermals, '   nsplit_thermals=', nsplit_thermals           , iflag_thermals, '   nsplit_thermals=', nsplit_thermals
1455      if(iflag_thermals.lt.0) then      if(iflag_thermals < 0) then
1456         !  Rien         !  Rien
1457         IF(prt_level>9)WRITE(lunout, *)'pas de convection'         IF(prt_level>9)print *,'pas de convection'
1458      else if(iflag_thermals == 0) then      else if(iflag_thermals == 0) then
1459         !  Ajustement sec         !  Ajustement sec
1460         IF(prt_level>9)WRITE(lunout, *)'ajsec'         IF(prt_level>9)print *,'ajsec'
1461         CALL ajsec(paprs, pplay, t_seri, q_seri, d_t_ajs, d_q_ajs)         CALL ajsec(paprs, pplay, t_seri, q_seri, d_t_ajs, d_q_ajs)
1462         t_seri(:, :) = t_seri(:, :) + d_t_ajs(:, :)         t_seri = t_seri + d_t_ajs
1463         q_seri(:, :) = q_seri(:, :) + d_q_ajs(:, :)         q_seri = q_seri + d_q_ajs
1464      else      else
1465         !  Thermiques         !  Thermiques
1466         IF(prt_level>9)WRITE(lunout, *)'JUSTE AVANT, iflag_thermals=' &         IF(prt_level>9)print *,'JUSTE AVANT, iflag_thermals=' &
1467              , iflag_thermals, '   nsplit_thermals=', nsplit_thermals              , iflag_thermals, '   nsplit_thermals=', nsplit_thermals
1468         call calltherm(pdtphys &         call calltherm(pdtphys &
1469              , pplay, paprs, pphi &              , pplay, paprs, pphi &
# Line 1523  contains Line 1474  contains
1474    
1475      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1476         ztit='after dry_adjust'         ztit='after dry_adjust'
1477         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1478              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1479              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1480      END IF      END IF
1481    
# Line 1560  contains Line 1511  contains
1511         !   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
1512         !   relaxation des ratqs         !   relaxation des ratqs
1513         facteur=exp(-pdtphys*facttemps)         facteur=exp(-pdtphys*facttemps)
1514         ratqs(:, :)=max(ratqs(:, :)*facteur, ratqss(:, :))         ratqs=max(ratqs*facteur, ratqss)
1515         ratqs(:, :)=max(ratqs(:, :), ratqsc(:, :))         ratqs=max(ratqs, ratqsc)
1516      else      else
1517         !   on ne prend que le ratqs stable pour fisrtilp         !   on ne prend que le ratqs stable pour fisrtilp
1518         ratqs(:, :)=ratqss(:, :)         ratqs=ratqss
1519      endif      endif
1520    
1521      ! Appeler le processus de condensation a grande echelle      ! Appeler le processus de condensation a grande echelle
1522      ! et le processus de precipitation      ! et le processus de precipitation
1523      CALL fisrtilp(dtime, paprs, pplay, &      CALL fisrtilp(pdtphys, paprs, pplay, &
1524           t_seri, q_seri, ptconv, ratqs, &           t_seri, q_seri, ptconv, ratqs, &
1525           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &
1526           rain_lsc, snow_lsc, &           rain_lsc, snow_lsc, &
# Line 1590  contains Line 1541  contains
1541      ENDDO      ENDDO
1542      IF (check) THEN      IF (check) THEN
1543         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1544         WRITE(lunout, *)"apresilp=", za         print *,"apresilp=", za
1545         zx_t = 0.0         zx_t = 0.0
1546         za = 0.0         za = 0.0
1547         DO i = 1, klon         DO i = 1, klon
# Line 1598  contains Line 1549  contains
1549            zx_t = zx_t + (rain_lsc(i) &            zx_t = zx_t + (rain_lsc(i) &
1550                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1551         ENDDO         ENDDO
1552         zx_t = zx_t/za*dtime         zx_t = zx_t/za*pdtphys
1553         WRITE(lunout, *)"Precip=", zx_t         print *,"Precip=", zx_t
1554      ENDIF      ENDIF
1555    
1556      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1557         ztit='after fisrt'         ztit='after fisrt'
1558         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1559              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1560              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1561         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1562              , zero_v, zero_v, zero_v, zero_v, zero_v &              , zero_v, zero_v, zero_v, zero_v, zero_v &
# Line 1626  contains Line 1577  contains
1577            rain_tiedtke=0.            rain_tiedtke=0.
1578            do k=1, llm            do k=1, llm
1579               do i=1, klon               do i=1, klon
1580                  if (d_q_con(i, k).lt.0.) then                  if (d_q_con(i, k) < 0.) then
1581                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &
1582                          *(paprs(i, k)-paprs(i, k+1))/rg                          *(paprs(i, k)-paprs(i, k+1))/rg
1583                  endif                  endif
# Line 1648  contains Line 1599  contains
1599         ENDDO         ENDDO
1600    
1601      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1602         !  On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le max du calcul de la
1603         !  convection et du calcul du pas de temps précédent diminué d'un facteur         ! convection et du calcul du pas de temps précédent diminué d'un facteur
1604         !  facttemps         ! facttemps
1605         facteur = pdtphys *facttemps         facteur = pdtphys *facttemps
1606         do k=1, llm         do k=1, llm
1607            do i=1, klon            do i=1, klon
# Line 1664  contains Line 1615  contains
1615         enddo         enddo
1616    
1617         !   On prend la somme des fractions nuageuses et des contenus en eau         !   On prend la somme des fractions nuageuses et des contenus en eau
1618         cldfra(:, :)=min(max(cldfra(:, :), rnebcon(:, :)), 1.)         cldfra=min(max(cldfra, rnebcon), 1.)
1619         cldliq(:, :)=cldliq(:, :)+rnebcon(:, :)*clwcon(:, :)         cldliq=cldliq+rnebcon*clwcon
1620    
1621      ENDIF      ENDIF
1622    
# Line 1692  contains Line 1643  contains
1643    
1644      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1645         ztit="after diagcld"         ztit="after diagcld"
1646         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1647              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1648              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1649      END IF      END IF
1650    
# Line 1709  contains Line 1660  contains
1660               zcor   = 1./(1.-retv*zx_qs)               zcor   = 1./(1.-retv*zx_qs)
1661               zx_qs  = zx_qs*zcor               zx_qs  = zx_qs*zcor
1662            ELSE            ELSE
1663               IF (zx_t.LT.t_coup) THEN               IF (zx_t < t_coup) THEN
1664                  zx_qs = qsats(zx_t)/pplay(i, k)                  zx_qs = qsats(zx_t)/pplay(i, k)
1665               ELSE               ELSE
1666                  zx_qs = qsatl(zx_t)/pplay(i, k)                  zx_qs = qsatl(zx_t)/pplay(i, k)
# Line 1723  contains Line 1674  contains
1674      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
1675      IF (ok_ade.OR.ok_aie) THEN      IF (ok_ade.OR.ok_aie) THEN
1676         ! Get sulfate aerosol distribution         ! Get sulfate aerosol distribution
1677         CALL readsulfate(rjourvrai, debut, sulfate)         CALL readsulfate(rdayvrai, firstcal, sulfate)
1678         CALL readsulfate_preind(rjourvrai, debut, sulfate_pi)         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)
1679    
1680         ! Calculate aerosol optical properties (Olivier Boucher)         ! Calculate aerosol optical properties (Olivier Boucher)
1681         CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, &         CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, &
# Line 1796  contains Line 1747  contains
1747      DO k = 1, llm      DO k = 1, llm
1748         DO i = 1, klon         DO i = 1, klon
1749            t_seri(i, k) = t_seri(i, k) &            t_seri(i, k) = t_seri(i, k) &
1750                 + (heat(i, k)-cool(i, k)) * dtime/86400.                 + (heat(i, k)-cool(i, k)) * pdtphys/86400.
1751         ENDDO         ENDDO
1752      ENDDO      ENDDO
1753    
1754      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1755         ztit='after rad'         ztit='after rad'
1756         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1757              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1758              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1759         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1760              , topsw, toplw, solsw, sollw, zero_v &              , topsw, toplw, solsw, sollw, zero_v &
# Line 1831  contains Line 1782  contains
1782         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1783      ENDDO      ENDDO
1784    
1785      !moddeblott(jan95)      !mod deb lott(jan95)
1786      ! Appeler le programme de parametrisation de l'orographie      ! Appeler le programme de parametrisation de l'orographie
1787      ! a l'echelle sous-maille:      ! a l'echelle sous-maille:
1788    
1789      IF (ok_orodr) THEN      IF (ok_orodr) THEN
   
1790         !  selection des points pour lesquels le shema est actif:         !  selection des points pour lesquels le shema est actif:
1791         igwd=0         igwd=0
1792         DO i=1, klon         DO i=1, klon
# Line 1848  contains Line 1798  contains
1798            ENDIF            ENDIF
1799         ENDDO         ENDDO
1800    
1801         CALL drag_noro(klon, llm, dtime, paprs, pplay, &         CALL drag_noro(klon, llm, pdtphys, paprs, pplay, &
1802              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zmea, zstd, zsig, zgam, zthe, zpic, zval, &
1803              igwd, idx, itest, &              igwd, idx, itest, &
1804              t_seri, u_seri, v_seri, &              t_seri, u_seri, v_seri, &
# Line 1863  contains Line 1813  contains
1813               v_seri(i, k) = v_seri(i, k) + d_v_oro(i, k)               v_seri(i, k) = v_seri(i, k) + d_v_oro(i, k)
1814            ENDDO            ENDDO
1815         ENDDO         ENDDO
1816        ENDIF
     ENDIF ! fin de test sur ok_orodr  
1817    
1818      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1819    
# Line 1879  contains Line 1828  contains
1828            ENDIF            ENDIF
1829         ENDDO         ENDDO
1830    
1831         CALL lift_noro(klon, llm, dtime, paprs, pplay, &         CALL lift_noro(klon, llm, pdtphys, paprs, pplay, &
1832              rlat, zmea, zstd, zpic, &              rlat, zmea, zstd, zpic, &
1833              itest, &              itest, &
1834              t_seri, u_seri, v_seri, &              t_seri, u_seri, v_seri, &
# Line 1905  contains Line 1854  contains
1854      ENDDO      ENDDO
1855      DO k = 1, llm      DO k = 1, llm
1856         DO i = 1, klon         DO i = 1, klon
1857            zustrph(i)=zustrph(i)+(u_seri(i, k)-u(i, k))/dtime* &            zustrph(i)=zustrph(i)+(u_seri(i, k)-u(i, k))/pdtphys* &
1858                 (paprs(i, k)-paprs(i, k+1))/rg                 (paprs(i, k)-paprs(i, k+1))/rg
1859            zvstrph(i)=zvstrph(i)+(v_seri(i, k)-v(i, k))/dtime* &            zvstrph(i)=zvstrph(i)+(v_seri(i, k)-v(i, k))/pdtphys* &
1860                 (paprs(i, k)-paprs(i, k+1))/rg                 (paprs(i, k)-paprs(i, k+1))/rg
1861         ENDDO         ENDDO
1862      ENDDO      ENDDO
1863    
1864      !IM calcul composantes axiales du moment angulaire et couple des montagnes      !IM calcul composantes axiales du moment angulaire et couple des montagnes
1865    
1866      CALL aaam_bud (27, klon, llm, rjourvrai, gmtime, &      CALL aaam_bud (27, klon, llm, gmtime, &
1867           ra, rg, romega, &           ra, rg, romega, &
1868           rlat, rlon, pphis, &           rlat, rlon, pphis, &
1869           zustrdr, zustrli, zustrph, &           zustrdr, zustrli, zustrph, &
# Line 1924  contains Line 1873  contains
1873    
1874      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1875         ztit='after orography'         ztit='after orography'
1876         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1877              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1878              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1879      END IF      END IF
1880    
# Line 1933  contains Line 1882  contains
1882    
1883      !   Calcul  des tendances traceurs      !   Calcul  des tendances traceurs
1884    
1885      call phytrac(rnpb, itap,  julien,  gmtime, debut, lafin, nq-2, &      call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nq-2, &
1886           dtime, u, v, t, paprs, pplay, &           pdtphys, u, v, t, paprs, pplay, pmfu,  pmfd,  pen_u,  pde_u,  pen_d, &
1887           pmfu,  pmfd,  pen_u,  pde_u,  pen_d,  pde_d, &           pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &
1888           ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, &           frac_impa,  frac_nucl, presnivs, pphis, pphi, albsol, rhcl, cldfra, &
1889           pctsrf, frac_impa,  frac_nucl, &           rneb,  diafra,  cldliq, itop_con, ibas_con, pmflxr, pmflxs, prfl, &
1890           presnivs, pphis, pphi, albsol, qx(1, 1, 1),  &           psfl, da, phi, mp, upwd, dnwd, tr_seri)
          rhcl, cldfra,  rneb,  diafra,  cldliq,  &  
          itop_con, ibas_con, pmflxr, pmflxs, &  
          prfl, psfl, da, phi, mp, upwd, dnwd, &  
          tr_seri)  
1891    
1892      IF (offline) THEN      IF (offline) THEN
1893    
# Line 1952  contains Line 1897  contains
1897              fm_therm, entr_therm, &              fm_therm, entr_therm, &
1898              ycoefh, yu1, yv1, ftsol, pctsrf, &              ycoefh, yu1, yv1, ftsol, pctsrf, &
1899              frac_impa, frac_nucl, &              frac_impa, frac_nucl, &
1900              pphis, airephy, dtime, itap)              pphis, airephy, pdtphys, itap)
1901    
1902      ENDIF      ENDIF
1903    
# Line 1977  contains Line 1922  contains
1922            d_t_ec(i, k)=0.5/ZRCPD &            d_t_ec(i, k)=0.5/ZRCPD &
1923                 *(u(i, k)**2+v(i, k)**2-u_seri(i, k)**2-v_seri(i, k)**2)                 *(u(i, k)**2+v(i, k)**2-u_seri(i, k)**2-v_seri(i, k)**2)
1924            t_seri(i, k)=t_seri(i, k)+d_t_ec(i, k)            t_seri(i, k)=t_seri(i, k)+d_t_ec(i, k)
1925            d_t_ec(i, k) = d_t_ec(i, k)/dtime            d_t_ec(i, k) = d_t_ec(i, k)/pdtphys
1926         END DO         END DO
1927      END DO      END DO
1928      !-jld ec_conser      !-jld ec_conser
1929      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1930         ztit='after physic'         ztit='after physic'
1931         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &
1932              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1933              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1934         !     Comme les tendances de la physique sont ajoute dans la dynamique,         !     Comme les tendances de la physique sont ajoute dans la dynamique,
1935         !     on devrait avoir que la variation d'entalpie par la dynamique         !     on devrait avoir que la variation d'entalpie par la dynamique
# Line 2021  contains Line 1966  contains
1966    
1967      DO k = 1, llm      DO k = 1, llm
1968         DO i = 1, klon         DO i = 1, klon
1969            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / dtime            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / pdtphys
1970            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / dtime            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / pdtphys
1971            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / dtime            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / pdtphys
1972            d_qx(i, k, ivap) = ( q_seri(i, k) - qx(i, k, ivap) ) / dtime            d_qx(i, k, ivap) = ( q_seri(i, k) - qx(i, k, ivap) ) / pdtphys
1973            d_qx(i, k, iliq) = ( ql_seri(i, k) - qx(i, k, iliq) ) / dtime            d_qx(i, k, iliq) = ( ql_seri(i, k) - qx(i, k, iliq) ) / pdtphys
1974         ENDDO         ENDDO
1975      ENDDO      ENDDO
1976    
# Line 2033  contains Line 1978  contains
1978         DO iq = 3, nq         DO iq = 3, nq
1979            DO  k = 1, llm            DO  k = 1, llm
1980               DO  i = 1, klon               DO  i = 1, klon
1981                  d_qx(i, k, iq) = ( tr_seri(i, k, iq-2) - qx(i, k, iq) ) / dtime                  d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / pdtphys
1982               ENDDO               ENDDO
1983            ENDDO            ENDDO
1984         ENDDO         ENDDO
# Line 2058  contains Line 2003  contains
2003    
2004      IF (lafin) THEN      IF (lafin) THEN
2005         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
2006         CALL phyredem ("restartphy.nc", dtime, radpas, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &
2007              rlat, rlon, pctsrf, ftsol, ftsoil, &              ftsoil, tslab, seaice, fqsurf, qsol, &
             tslab, seaice,  & !IM "slab" ocean  
             fqsurf, qsol, &  
2008              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &
2009              solsw, sollwdown, dlw, &              solsw, sollwdown, dlw, &
2010              radsol, frugs, agesno, &              radsol, frugs, agesno, &
2011              zmea, zstd, zsig, zgam, zthe, zpic, zval, rugoro, &              zmea, zstd, zsig, zgam, zthe, zpic, zval, &
2012              t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)              t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)
2013      ENDIF      ENDIF
2014    
# Line 2227  contains Line 2170  contains
2170    
2171        ENDDO !k=1, nlevSTD        ENDDO !k=1, nlevSTD
2172    
2173        !IM on somme les valeurs definies a chaque pas de temps de la physique ou        !IM on somme les valeurs definies a chaque pas de temps de la
2174        !IM toutes les 6 heures        ! physique ou toutes les 6 heures
2175    
2176        oknondef(1:klon, 1:nlevSTD, 1:nout)=.TRUE.        oknondef(1:klon, 1:nlevSTD, 1:nout)=.TRUE.
2177        CALL undefSTD(nlevSTD, itap, tlevSTD, &        CALL undefSTD(nlevSTD, itap, tlevSTD, &
# Line 2484  contains Line 2427  contains
2427    
2428           ! Champs 2D:           ! Champs 2D:
2429    
2430           zsto = dtime * ecrit_ins           zsto = pdtphys * ecrit_ins
2431           zout = dtime * ecrit_ins           zout = pdtphys * ecrit_ins
2432           itau_w = itau_phy + itap           itau_w = itau_phy + itap
2433    
2434           i = NINT(zout/zsto)           i = NINT(zout/zsto)
Legend:
Removed from v.6  
changed lines
  Added in v.13
  ViewVC Help
Powered by ViewVC 1.1.21