/[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 97 by guez, Fri Apr 25 14:58:31 2014 UTC revision 98 by guez, Tue May 13 17:23:16 2014 UTC
# Line 35  contains Line 35  contains
35      use diagetpq_m, only: diagetpq      use diagetpq_m, only: diagetpq
36      use diagphy_m, only: diagphy      use diagphy_m, only: diagphy
37      USE dimens_m, ONLY: llm, nqmx      USE dimens_m, ONLY: llm, nqmx
38      USE dimphy, ONLY: klon, nbtr      USE dimphy, ONLY: klon
39      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
40      use drag_noro_m, only: drag_noro      use drag_noro_m, only: drag_noro
41      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
# Line 45  contains Line 45  contains
45           nbsrf           nbsrf
46      USE ini_histins_m, ONLY: ini_histins      USE ini_histins_m, ONLY: ini_histins
47      use newmicro_m, only: newmicro      use newmicro_m, only: newmicro
48      USE oasis_m, ONLY: ok_oasis      USE orbite_m, ONLY: orbite
     USE orbite_m, ONLY: orbite, zenang  
49      USE ozonecm_m, ONLY: ozonecm      USE ozonecm_m, ONLY: ozonecm
50      USE phyetat0_m, ONLY: phyetat0, rlat, rlon      USE phyetat0_m, ONLY: phyetat0, rlat, rlon
51      USE phyredem_m, ONLY: phyredem      USE phyredem_m, ONLY: phyredem
# Line 61  contains Line 60  contains
60      use unit_nml_m, only: unit_nml      use unit_nml_m, only: unit_nml
61      USE ymds2ju_m, ONLY: ymds2ju      USE ymds2ju_m, ONLY: ymds2ju
62      USE yoethf_m, ONLY: r2es, rvtmp2      USE yoethf_m, ONLY: r2es, rvtmp2
63        use zenang_m, only: zenang
64    
65      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
66    
# Line 70  contains Line 70  contains
70      REAL, intent(in):: time ! heure de la journ\'ee en fraction de jour      REAL, intent(in):: time ! heure de la journ\'ee en fraction de jour
71      REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)      REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)
72    
73      REAL, intent(in):: paprs(klon, llm + 1)      REAL, intent(in):: paprs(:, :) ! (klon, llm + 1)
74      ! (pression pour chaque inter-couche, en Pa)      ! pression pour chaque inter-couche, en Pa
75    
76      REAL, intent(in):: play(klon, llm)      REAL, intent(in):: play(:, :) ! (klon, llm)
77      ! (input pression pour le mileu de chaque couche (en Pa))      ! pression pour le mileu de chaque couche (en Pa)
78    
79      REAL, intent(in):: pphi(klon, llm)      REAL, intent(in):: pphi(:, :) ! (klon, llm)
80      ! géopotentiel de chaque couche (référence sol)      ! géopotentiel de chaque couche (référence sol)
81    
82      REAL, intent(in):: pphis(klon) ! géopotentiel du sol      REAL, intent(in):: pphis(:) ! (klon) géopotentiel du sol
83    
84      REAL, intent(in):: u(klon, llm)      REAL, intent(in):: u(:, :) ! (klon, llm)
85      ! vitesse dans la direction X (de O a E) en m/s      ! vitesse dans la direction X (de O a E) en m/s
86    
87      REAL, intent(in):: v(klon, llm) ! vitesse Y (de S a N) en m/s      REAL, intent(in):: v(:, :) ! (klon, llm) vitesse Y (de S a N) en m/s
88      REAL, intent(in):: t(klon, llm) ! input temperature (K)      REAL, intent(in):: t(:, :) ! (klon, llm) temperature (K)
89    
90      REAL, intent(in):: qx(klon, llm, nqmx)      REAL, intent(in):: qx(:, :, :) ! (klon, llm, nqmx)
91      ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)      ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)
92    
93      REAL, intent(in):: omega(klon, llm) ! vitesse verticale en Pa/s      REAL, intent(in):: omega(:, :) ! (klon, llm) vitesse verticale en Pa/s
94      REAL, intent(out):: d_u(klon, llm) ! tendance physique de "u" (m s-2)      REAL, intent(out):: d_u(:, :) ! (klon, llm) tendance physique de "u" (m s-2)
95      REAL, intent(out):: d_v(klon, llm) ! tendance physique de "v" (m s-2)      REAL, intent(out):: d_v(:, :) ! (klon, llm) tendance physique de "v" (m s-2)
96      REAL, intent(out):: d_t(klon, llm) ! tendance physique de "t" (K/s)      REAL, intent(out):: d_t(:, :) ! (klon, llm) tendance physique de "t" (K/s)
97      REAL, intent(out):: d_qx(klon, llm, nqmx) ! tendance physique de "qx" (s-1)  
98        REAL, intent(out):: d_qx(:, :, :) ! (klon, llm, nqmx)
99        ! tendance physique de "qx" (s-1)
100    
101      ! Local:      ! Local:
102    
103      LOGICAL:: firstcal = .true.      LOGICAL:: firstcal = .true.
104    
     INTEGER nbteta  
     PARAMETER(nbteta = 3)  
   
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    
108      LOGICAL check ! Verifier la conservation du modele en eau      LOGICAL, PARAMETER:: check = .FALSE.
109      PARAMETER (check = .FALSE.)      ! Verifier la conservation du modele en eau
110    
111      LOGICAL, PARAMETER:: ok_stratus = .FALSE.      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
112      ! Ajouter artificiellement les stratus      ! Ajouter artificiellement les stratus
113    
     ! Parametres lies au coupleur OASIS:  
     INTEGER, SAVE:: npas, nexca  
     logical rnpb  
     parameter(rnpb = .true.)  
   
114      character(len = 6):: ocean = 'force '      character(len = 6):: ocean = 'force '
115      ! (type de mod\`ele oc\'ean \`a utiliser: "force" ou "slab" mais      ! (type de mod\`ele oc\'ean \`a utiliser: "force" ou "slab" mais
116      ! pas "couple")      ! pas "couple")
# Line 142  contains Line 136  contains
136      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
137      real, save:: q2(klon, llm + 1, nbsrf)      real, save:: q2(klon, llm + 1, nbsrf)
138    
139      INTEGER ivap ! indice de traceurs pour vapeur d'eau      INTEGER, PARAMETER:: ivap = 1 ! indice de traceur pour vapeur d'eau
140      PARAMETER (ivap = 1)      INTEGER, PARAMETER:: iliq = 2 ! indice de traceur pour eau liquide
     INTEGER iliq ! indice de traceurs pour eau liquide  
     PARAMETER (iliq = 2)  
141    
142      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
143      LOGICAL, save:: ancien_ok      LOGICAL, save:: ancien_ok
# Line 155  contains Line 147  contains
147    
148      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
149    
     ! Amip2 PV a theta constante  
   
     CHARACTER(LEN = 3) ctetaSTD(nbteta)  
     DATA ctetaSTD/'350', '380', '405'/  
     REAL rtetaSTD(nbteta)  
     DATA rtetaSTD/350., 380., 405./  
   
     ! Amip2 PV a theta constante  
   
150      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)
151      REAL swup0(klon, llm + 1), swup(klon, llm + 1)      REAL swup0(klon, llm + 1), swup(klon, llm + 1)
152      SAVE swdn0, swdn, swup0, swup      SAVE swdn0, swdn, swup0, swup
# Line 263  contains Line 246  contains
246      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
247      SAVE fluxlat      SAVE fluxlat
248    
249      REAL fqsurf(klon, nbsrf)      REAL, save:: fqsurf(klon, nbsrf)
250      SAVE fqsurf ! humidite de l'air au contact de la surface      ! humidite de l'air au contact de la surface
251    
252      REAL, save:: qsol(klon) ! hauteur d'eau dans le sol      REAL, save:: qsol(klon) ! hauteur d'eau dans le sol
253        REAL, save:: fsnow(klon, nbsrf) ! epaisseur neigeuse
254      REAL fsnow(klon, nbsrf)      REAL, save:: falbe(klon, nbsrf) ! albedo par type de surface
255      SAVE fsnow ! epaisseur neigeuse      REAL, save:: falblw(klon, nbsrf) ! albedo par type de surface
   
     REAL falbe(klon, nbsrf)  
     SAVE falbe ! albedo par type de surface  
     REAL falblw(klon, nbsrf)  
     SAVE falblw ! albedo par type de surface  
256    
257      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :
258      REAL, save:: zmea(klon) ! orographie moyenne      REAL, save:: zmea(klon) ! orographie moyenne
# Line 348  contains Line 326  contains
326      REAL ue(klon) ! integr. verticale du transport zonal de l'energie      REAL ue(klon) ! integr. verticale du transport zonal de l'energie
327      REAL uq(klon) ! integr. verticale du transport zonal de l'eau      REAL uq(klon) ! integr. verticale du transport zonal de l'eau
328    
329      REAL frugs(klon, nbsrf) ! longueur de rugosite      REAL, save:: frugs(klon, nbsrf) ! longueur de rugosite
     save frugs  
330      REAL zxrugs(klon) ! longueur de rugosite      REAL zxrugs(klon) ! longueur de rugosite
331    
332      ! Conditions aux limites      ! Conditions aux limites
333    
334      INTEGER julien      INTEGER julien
   
335      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
336      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
337      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE
338        REAL, save:: albsol(klon) ! albedo du sol total
339      REAL albsol(klon)      REAL, save:: albsollw(klon) ! albedo du sol total
     SAVE albsol ! albedo du sol total  
     REAL albsollw(klon)  
     SAVE albsollw ! albedo du sol total  
   
340      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU
341    
342      ! Declaration des procedures appelees      ! Declaration des procedures appelees
# Line 423  contains Line 395  contains
395      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)
396    
397      REAL dist, rmu0(klon), fract(klon)      REAL dist, rmu0(klon), fract(klon)
     REAL zdtime ! pas de temps du rayonnement (s)  
398      real zlongi      real zlongi
399      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
400      REAL za, zb      REAL za, zb
# Line 512  contains Line 483  contains
483      ! Variables locales pour effectuer les appels en s\'erie :      ! Variables locales pour effectuer les appels en s\'erie :
484    
485      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
486      REAL ql_seri(klon, llm), qs_seri(klon, llm)      REAL ql_seri(klon, llm)
487      REAL u_seri(klon, llm), v_seri(klon, llm)      REAL u_seri(klon, llm), v_seri(klon, llm)
488      REAL tr_seri(klon, llm, nbtr)      REAL tr_seri(klon, llm, nqmx - 2)
489    
490      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
491    
# Line 537  contains Line 508  contains
508    
509      ! Variables li\'ees au bilan d'\'energie et d'enthalpie :      ! Variables li\'ees au bilan d'\'energie et d'enthalpie :
510      REAL ztsol(klon)      REAL ztsol(klon)
511      REAL d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec      REAL d_h_vcol, d_qt, d_ec
512      REAL, SAVE:: d_h_vcol_phy      REAL, SAVE:: d_h_vcol_phy
513      REAL fs_bound, fq_bound      REAL fs_bound, fq_bound
514      REAL zero_v(klon)      REAL zero_v(klon)
# Line 625  contains Line 596  contains
596         piz_ae = 0.         piz_ae = 0.
597         tau_ae = 0.         tau_ae = 0.
598         cg_ae = 0.         cg_ae = 0.
599         rain_con(:) = 0.         rain_con = 0.
600         snow_con(:) = 0.         snow_con = 0.
601         topswai(:) = 0.         topswai = 0.
602         topswad(:) = 0.         topswad = 0.
603         solswai(:) = 0.         solswai = 0.
604         solswad(:) = 0.         solswad = 0.
605    
606         d_u_con = 0.         d_u_con = 0.
607         d_v_con = 0.         d_v_con = 0.
# Line 680  contains Line 651  contains
651         IF (raz_date) itau_phy = 0         IF (raz_date) itau_phy = 0
652    
653         PRINT *, 'cycle_diurne = ', cycle_diurne         PRINT *, 'cycle_diurne = ', cycle_diurne
654         CALL printflag(radpas, ocean /= 'force', ok_oasis, ok_journe, &         CALL printflag(radpas, ocean /= 'force', ok_journe, ok_instan, ok_region)
             ok_instan, ok_region)  
655    
656         IF (dtphys * REAL(radpas) > 21600. .AND. cycle_diurne) THEN         IF (dtphys * REAL(radpas) > 21600. .AND. cycle_diurne) THEN
657            print *, "Au minimum 4 appels par jour si cycle diurne"            print *, "Au minimum 4 appels par jour si cycle diurne"
# Line 711  contains Line 681  contains
681         ecrit_tra = NINT(86400.*ecrit_tra/dtphys)         ecrit_tra = NINT(86400.*ecrit_tra/dtphys)
682         ecrit_reg = NINT(ecrit_reg/dtphys)         ecrit_reg = NINT(ecrit_reg/dtphys)
683    
        ! Initialiser le couplage si necessaire  
   
        npas = 0  
        nexca = 0  
   
684         ! Initialisation des sorties         ! Initialisation des sorties
685    
686         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
# Line 730  contains Line 695  contains
695      phi = 0.      phi = 0.
696    
697      ! We will modify variables *_seri and we will not touch variables      ! We will modify variables *_seri and we will not touch variables
698      ! u, v, h, q:      ! u, v, t, qx:
699      DO k = 1, llm      t_seri = t
700         DO i = 1, klon      u_seri = u
701            t_seri(i, k) = t(i, k)      v_seri = v
702            u_seri(i, k) = u(i, k)      q_seri = qx(:, :, ivap)
703            v_seri(i, k) = v(i, k)      ql_seri = qx(:, :, iliq)
704            q_seri(i, k) = qx(i, k, ivap)      tr_seri = qx(:, :, 3: nqmx)
           ql_seri(i, k) = qx(i, k, iliq)  
           qs_seri(i, k) = 0.  
        ENDDO  
     ENDDO  
     IF (nqmx >= 3) THEN  
        tr_seri(:, :, :nqmx-2) = qx(:, :, 3:nqmx)  
     ELSE  
        tr_seri(:, :, 1) = 0.  
     ENDIF  
705    
706      DO i = 1, klon      ztsol = sum(ftsol * pctsrf, dim = 2)
        ztsol(i) = 0.  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           ztsol(i) = ztsol(i) + ftsol(i, nsrf)*pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
707    
708      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
709         tit = 'after dynamics'         tit = 'after dynamics'
710         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
711              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
             d_ql, d_qs, d_ec)  
712         ! Comme les tendances de la physique sont ajout\'es dans la         ! Comme les tendances de la physique sont ajout\'es dans la
713         !  dynamique, la variation d'enthalpie par la dynamique devrait         !  dynamique, la variation d'enthalpie par la dynamique devrait
714         !  \^etre \'egale \`a la variation de la physique au pas de temps         !  \^etre \'egale \`a la variation de la physique au pas de temps
# Line 768  contains Line 716  contains
716         !  nulle.         !  nulle.
717         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
718              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, &
719              d_qt, 0., fs_bound, fq_bound)              d_qt, 0.)
720      END IF      END IF
721    
722      ! Diagnostic de la tendance dynamique :      ! Diagnostic de la tendance dynamique :
# Line 799  contains Line 747  contains
747      ! Check temperatures:      ! Check temperatures:
748      CALL hgardfou(t_seri, ftsol)      CALL hgardfou(t_seri, ftsol)
749    
750      ! Incrementer le compteur de la physique      ! Incrémenter le compteur de la physique
751      itap = itap + 1      itap = itap + 1
752      julien = MOD(NINT(rdayvrai), 360)      julien = MOD(NINT(rdayvrai), 360)
753      if (julien == 0) julien = 360      if (julien == 0) julien = 360
754    
755      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg
756    
757      ! Mettre en action les conditions aux limites (albedo, sst etc.).      ! Prescrire l'ozone :
   
     ! Prescrire l'ozone et calculer l'albedo sur l'ocean.  
758      wo = ozonecm(REAL(julien), paprs)      wo = ozonecm(REAL(julien), paprs)
759    
760      ! \'Evaporation de l'eau liquide nuageuse :      ! \'Evaporation de l'eau liquide nuageuse :
# Line 825  contains Line 771  contains
771      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
772         tit = 'after reevap'         tit = 'after reevap'
773         CALL diagetpq(airephy, tit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &
774              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
             d_ql, d_qs, d_ec)  
775         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
776              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)
             fs_bound, fq_bound)  
   
777      END IF      END IF
778    
779      ! Appeler la diffusion verticale (programme de couche limite)      frugs = MAX(frugs, 0.000015)
780        zxrugs = sum(frugs * pctsrf, dim = 2)
781    
782      DO i = 1, klon      ! Calculs nécessaires au calcul de l'albedo dans l'interface
        zxrugs(i) = 0.  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           frugs(i, nsrf) = MAX(frugs(i, nsrf), 0.000015)  
        ENDDO  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           zxrugs(i) = zxrugs(i) + frugs(i, nsrf)*pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
   
     ! calculs necessaires au calcul de l'albedo dans l'interface  
783    
784      CALL orbite(REAL(julien), zlongi, dist)      CALL orbite(REAL(julien), zlongi, dist)
785      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
786         zdtime = dtphys * REAL(radpas)         CALL zenang(zlongi, time, dtphys * REAL(radpas), rmu0, fract)
        CALL zenang(zlongi, time, zdtime, rmu0, fract)  
787      ELSE      ELSE
788         rmu0 = -999.999         rmu0 = -999.999
789      ENDIF      ENDIF
790    
791      ! Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
792      albsol(:) = 0.      albsol = sum(falbe * pctsrf, dim = 2)
793      albsollw(:) = 0.      albsollw = sum(falblw * pctsrf, dim = 2)
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)  
           albsollw(i) = albsollw(i) + falblw(i, nsrf) * pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
794    
795      ! R\'epartition sous maille des flux longwave et shortwave      ! R\'epartition sous maille des flux longwave et shortwave
796      ! R\'epartition du longwave par sous-surface lin\'earis\'ee      ! R\'epartition du longwave par sous-surface lin\'earis\'ee
797    
798      DO nsrf = 1, nbsrf      forall (nsrf = 1: nbsrf)
799         DO i = 1, klon         fsollw(:, nsrf) = sollw + 4. * RSIGMA * ztsol**3 &
800            fsollw(i, nsrf) = sollw(i) &              * (ztsol - ftsol(:, nsrf))
801                 + 4. * RSIGMA * ztsol(i)**3 * (ztsol(i) - ftsol(i, nsrf))         fsolsw(:, nsrf) = solsw * (1. - falbe(:, nsrf)) / (1. - albsol)
802            fsolsw(i, nsrf) = solsw(i) * (1. - falbe(i, nsrf)) / (1. - albsol(i))      END forall
        ENDDO  
     ENDDO  
803    
804      fder = dlw      fder = dlw
805    
806      ! Couche limite:      ! Couche limite:
807    
808      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, &      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, u_seri, &
809           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, &           v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, ftsol, soil_model, &
810           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &           cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, play, &
811           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &           fsnow, fqsurf, fevap, falbe, falblw, fluxlat, rain_fall, snow_fall, &
812           rain_fall, snow_fall, fsolsw, fsollw, fder, rlon, rlat, &           fsolsw, fsollw, fder, rlon, rlat, frugs, firstcal, agesno, rugoro, &
813           frugs, firstcal, agesno, rugoro, d_t_vdf, &           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, &
814           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &           fluxv, cdragh, cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, &
815           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &           u10m, v10m, pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, &
816           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &           trmb3, plcl, fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, &
817           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice)           seaice)
818    
819      ! Incr\'ementation des flux      ! Incr\'ementation des flux
820    
# Line 929  contains Line 850  contains
850      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
851         tit = 'after clmain'         tit = 'after clmain'
852         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
853              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
             d_ql, d_qs, d_ec)  
854         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
855              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)
             fs_bound, fq_bound)  
856      END IF      END IF
857    
858      ! Update surface temperature:      ! Update surface temperature:
# Line 1016  contains Line 935  contains
935         ENDDO         ENDDO
936      ENDDO      ENDDO
937    
938      ! Calculer la derive du flux infrarouge      ! Calculer la dérive du flux infrarouge
939    
940      DO i = 1, klon      DO i = 1, klon
941         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3
# Line 1026  contains Line 945  contains
945    
946      DO k = 1, llm      DO k = 1, llm
947         DO i = 1, klon         DO i = 1, klon
948            conv_q(i, k) = d_q_dyn(i, k) + d_q_vdf(i, k)/dtphys            conv_q(i, k) = d_q_dyn(i, k) + d_q_vdf(i, k) / dtphys
949            conv_t(i, k) = d_t_dyn(i, k) + d_t_vdf(i, k)/dtphys            conv_t(i, k) = d_t_dyn(i, k) + d_t_vdf(i, k) / dtphys
950         ENDDO         ENDDO
951      ENDDO      ENDDO
952    
953      IF (check) THEN      IF (check) print *, "avantcon = ", qcheck(paprs, q_seri, ql_seri)
        za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)  
        print *, "avantcon = ", za  
     ENDIF  
954    
955      if (iflag_con == 2) then      if (iflag_con == 2) then
956         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
# Line 1101  contains Line 1017  contains
1017      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1018         tit = 'after convect'         tit = 'after convect'
1019         CALL diagetpq(airephy, tit, 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, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
             d_ql, d_qs, d_ec)  
1021         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1022              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)
             fs_bound, fq_bound)  
1023      END IF      END IF
1024    
1025      IF (check) THEN      IF (check) THEN
1026         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(paprs, q_seri, ql_seri)
1027         print *, "aprescon = ", za         print *, "aprescon = ", za
1028         zx_t = 0.         zx_t = 0.
1029         za = 0.         za = 0.
# Line 1157  contains Line 1071  contains
1071      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1072         tit = 'after dry_adjust'         tit = 'after dry_adjust'
1073         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1074              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
             d_ql, d_qs, d_ec)  
1075      END IF      END IF
1076    
1077      ! Caclul des ratqs      ! Caclul des ratqs
# Line 1216  contains Line 1129  contains
1129         ENDDO         ENDDO
1130      ENDDO      ENDDO
1131      IF (check) THEN      IF (check) THEN
1132         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(paprs, q_seri, ql_seri)
1133         print *, "apresilp = ", za         print *, "apresilp = ", za
1134         zx_t = 0.         zx_t = 0.
1135         za = 0.         za = 0.
# Line 1232  contains Line 1145  contains
1145      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1146         tit = 'after fisrt'         tit = 'after fisrt'
1147         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1148              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
             d_ql, d_qs, d_ec)  
1149         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1150              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)
             fs_bound, fq_bound)  
1151      END IF      END IF
1152    
1153      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
# Line 1313  contains Line 1224  contains
1224      ENDDO      ENDDO
1225    
1226      IF (if_ebil >= 2) CALL diagetpq(airephy, "after diagcld", ip_ebil, 2, 2, &      IF (if_ebil >= 2) CALL diagetpq(airephy, "after diagcld", ip_ebil, 2, 2, &
1227           dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &           dtphys, t_seri, q_seri, ql_seri, u_seri, v_seri, paprs, d_h_vcol, &
1228           d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)           d_qt, d_ec)
1229    
1230      ! Humidit\'e relative pour diagnostic :      ! Humidit\'e relative pour diagnostic :
1231      DO k = 1, llm      DO k = 1, llm
# Line 1398  contains Line 1309  contains
1309      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1310         tit = 'after rad'         tit = 'after rad'
1311         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1312              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
             d_ql, d_qs, d_ec)  
1313         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, &         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, &
1314              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)
             fs_bound, fq_bound)  
1315      END IF      END IF
1316    
1317      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
# Line 1496  contains Line 1405  contains
1405           zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)           zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
1406    
1407      IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &      IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &
1408           2, dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &           2, dtphys, t_seri, q_seri, ql_seri, u_seri, v_seri, paprs, d_h_vcol, &
1409           d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)           d_qt, d_ec)
1410    
1411      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1412      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &      call phytrac(itap, lmt_pas, julien, time, firstcal, lafin, dtphys, u, t, &
1413           dtphys, u, t, paprs, play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, &           paprs, play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, &
1414           entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, pphis, &           yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, pphis, albsol, rhcl, &
1415           albsol, rhcl, cldfra, rneb, diafra, cldliq, pmflxr, pmflxs, prfl, &           cldfra, rneb, diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, &
1416           psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)           mp, upwd, dnwd, tr_seri, zmasse)
1417    
1418      IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &      IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &
1419           pde_u, pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &           pde_u, pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
# Line 1535  contains Line 1444  contains
1444      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1445         tit = 'after physic'         tit = 'after physic'
1446         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
1447              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
             d_ql, d_qs, d_ec)  
1448         ! Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoute dans la dynamique,
1449         ! on devrait avoir que la variation d'entalpie par la dynamique         ! on devrait avoir que la variation d'entalpie par la dynamique
1450         ! 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.
1451         ! Donc la somme de ces 2 variations devrait etre nulle.         ! Donc la somme de ces 2 variations devrait etre nulle.
1452         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, sens, &         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, sens, &
1453              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)
             fs_bound, fq_bound)  
   
1454         d_h_vcol_phy = d_h_vcol         d_h_vcol_phy = d_h_vcol
   
1455      END IF      END IF
1456    
1457      ! SORTIES      ! SORTIES
# Line 1571  contains Line 1476  contains
1476         ENDDO         ENDDO
1477      ENDDO      ENDDO
1478    
1479      IF (nqmx >= 3) THEN      DO iq = 3, nqmx
1480         DO iq = 3, nqmx         DO k = 1, llm
1481            DO k = 1, llm            DO i = 1, klon
1482               DO i = 1, klon               d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / dtphys
                 d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / dtphys  
              ENDDO  
1483            ENDDO            ENDDO
1484         ENDDO         ENDDO
1485      ENDIF      ENDDO
1486    
1487      ! Sauvegarder les valeurs de t et q a la fin de la physique:      ! Sauvegarder les valeurs de t et q a la fin de la physique:
1488      DO k = 1, llm      DO k = 1, llm
Legend:
Removed from v.97  
changed lines
  Added in v.98
  ViewVC Help
Powered by ViewVC 1.1.21