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

Diff of /trunk/phylmd/physiq.f

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

trunk/libf/phylmd/physiq.f90 revision 71 by guez, Mon Jul 8 18:12:18 2013 UTC trunk/phylmd/physiq.f revision 90 by guez, Wed Mar 12 21:16:36 2014 UTC
# Line 5  module physiq_m Line 5  module physiq_m
5  contains  contains
6    
7    SUBROUTINE physiq(lafin, rdayvrai, time, dtphys, paprs, play, pphi, pphis, &    SUBROUTINE physiq(lafin, rdayvrai, time, dtphys, paprs, play, pphi, pphis, &
8         u, v, t, qx, omega, d_u, d_v, d_t, d_qx, d_ps, dudyn, PVteta)         u, v, t, qx, omega, d_u, d_v, d_t, d_qx, d_ps)
9    
10        ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
11        ! (subversion revision 678)
12    
     ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28 (SVN revision 678)  
13      ! Author: Z.X. Li (LMD/CNRS) 1993      ! Author: Z.X. Li (LMD/CNRS) 1993
14    
15      ! This is the main procedure for the "physics" part of the program.      ! This is the main procedure for the "physics" part of the program.
# Line 23  contains Line 25  contains
25      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &
26           ok_orodr, ok_orolf, soil_model           ok_orodr, ok_orolf, soil_model
27      USE clmain_m, ONLY: clmain      USE clmain_m, ONLY: clmain
28        use clouds_gno_m, only: clouds_gno
29      USE comgeomphy, ONLY: airephy, cuphy, cvphy      USE comgeomphy, ONLY: airephy, cuphy, cvphy
30      USE concvl_m, ONLY: concvl      USE concvl_m, ONLY: concvl
31      USE conf_gcm_m, ONLY: offline, raz_date      USE conf_gcm_m, ONLY: offline, raz_date
# Line 32  contains Line 35  contains
35      use diagcld2_m, only: diagcld2      use diagcld2_m, only: diagcld2
36      use diagetpq_m, only: diagetpq      use diagetpq_m, only: diagetpq
37      use diagphy_m, only: diagphy      use diagphy_m, only: diagphy
38      USE dimens_m, ONLY: iim, jjm, llm, nqmx      USE dimens_m, ONLY: llm, nqmx
39      USE dimphy, ONLY: klon, nbtr      USE dimphy, ONLY: klon, nbtr
40      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
41      use drag_noro_m, only: drag_noro      use drag_noro_m, only: drag_noro
42      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
43      use fisrtilp_m, only: fisrtilp      use fisrtilp_m, only: fisrtilp
44      USE hgardfou_m, ONLY: hgardfou      USE hgardfou_m, ONLY: hgardfou
     USE histsync_m, ONLY: histsync  
     USE histwrite_m, ONLY: histwrite  
45      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &
46           nbsrf           nbsrf
     USE ini_histhf_m, ONLY: ini_histhf  
     USE ini_histday_m, ONLY: ini_histday  
47      USE ini_histins_m, ONLY: ini_histins      USE ini_histins_m, ONLY: ini_histins
48      use newmicro_m, only: newmicro      use newmicro_m, only: newmicro
49      USE oasis_m, ONLY: ok_oasis      USE oasis_m, ONLY: ok_oasis
# Line 68  contains Line 67  contains
67      REAL, intent(in):: rdayvrai      REAL, intent(in):: rdayvrai
68      ! (elapsed time since January 1st 0h of the starting year, in days)      ! (elapsed time since January 1st 0h of the starting year, in days)
69    
70      REAL, intent(in):: time ! heure de la journée 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      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
73    
# Line 90  contains Line 89  contains
89      REAL, intent(in):: t(klon, llm) ! input temperature (K)      REAL, intent(in):: t(klon, llm) ! input temperature (K)
90    
91      REAL, intent(in):: qx(klon, llm, nqmx)      REAL, intent(in):: qx(klon, llm, nqmx)
92      ! (humidité spécifique et fractions massiques des autres traceurs)      ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)
93    
94      REAL omega(klon, llm) ! input vitesse verticale en Pa/s      REAL omega(klon, llm) ! input vitesse verticale en Pa/s
95      REAL, intent(out):: d_u(klon, llm) ! tendance physique de "u" (m/s/s)      REAL, intent(out):: d_u(klon, llm) ! tendance physique de "u" (m/s/s)
# Line 104  contains Line 103  contains
103      INTEGER nbteta      INTEGER nbteta
104      PARAMETER(nbteta = 3)      PARAMETER(nbteta = 3)
105    
     REAL PVteta(klon, nbteta)  
     ! (output vorticite potentielle a des thetas constantes)  
   
106      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
107      PARAMETER (ok_gust = .FALSE.)      PARAMETER (ok_gust = .FALSE.)
108    
# Line 122  contains Line 118  contains
118      parameter(rnpb = .true.)      parameter(rnpb = .true.)
119    
120      character(len = 6):: ocean = 'force '      character(len = 6):: ocean = 'force '
121      ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")      ! (type de mod\`ele oc\'ean \`a utiliser: "force" ou "slab" mais pas "couple")
122    
123      ! "slab" ocean      ! "slab" ocean
124      REAL, save:: tslab(klon) ! temperature of ocean slab      REAL, save:: tslab(klon) ! temperature of ocean slab
# Line 203  contains Line 199  contains
199      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)
200    
201      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)
202      DATA zx_tau/0.0, 0.3, 1.3, 3.6, 9.4, 23., 60./      DATA zx_tau/0., 0.3, 1.3, 3.6, 9.4, 23., 60./
203      DATA zx_pc/50., 180., 310., 440., 560., 680., 800./      DATA zx_pc/50., 180., 310., 440., 560., 680., 800./
204    
205      ! cldtopres pression au sommet des nuages      ! cldtopres pression au sommet des nuages
# Line 282  contains Line 278  contains
278      REAL falblw(klon, nbsrf)      REAL falblw(klon, nbsrf)
279      SAVE falblw ! albedo par type de surface      SAVE falblw ! albedo par type de surface
280    
281      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :
282      REAL, save:: zmea(klon) ! orographie moyenne      REAL, save:: zmea(klon) ! orographie moyenne
283      REAL, save:: zstd(klon) ! deviation standard de l'OESM      REAL, save:: zstd(klon) ! deviation standard de l'OESM
284      REAL, save:: zsig(klon) ! pente de l'OESM      REAL, save:: zsig(klon) ! pente de l'OESM
# Line 312  contains Line 308  contains
308      SAVE Ma      SAVE Ma
309      REAL qcondc(klon, llm) ! in-cld water content from convect      REAL qcondc(klon, llm) ! in-cld water content from convect
310      SAVE qcondc      SAVE qcondc
311      REAL ema_work1(klon, llm), ema_work2(klon, llm)      REAL, save:: sig1(klon, llm), w01(klon, llm)
     SAVE ema_work1, ema_work2  
312      REAL, save:: wd(klon)      REAL, save:: wd(klon)
313    
314      ! Variables locales pour la couche limite (al1):      ! Variables locales pour la couche limite (al1):
# Line 388  contains Line 383  contains
383    
384      ! Variables locales      ! Variables locales
385    
386      real clwcon(klon, llm), rnebcon(klon, llm)      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
387      real clwcon0(klon, llm), rnebcon0(klon, llm)      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
   
     save rnebcon, clwcon  
388    
389      REAL rhcl(klon, llm) ! humiditi relative ciel clair      REAL rhcl(klon, llm) ! humiditi relative ciel clair
390      REAL dialiq(klon, llm) ! eau liquide nuageuse      REAL dialiq(klon, llm) ! eau liquide nuageuse
# Line 411  contains Line 404  contains
404      REAL zxfluxu(klon, llm)      REAL zxfluxu(klon, llm)
405      REAL zxfluxv(klon, llm)      REAL zxfluxv(klon, llm)
406    
407      ! Le rayonnement n'est pas calculé tous les pas, il faut donc que      ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que
408      ! les variables soient rémanentes.      ! les variables soient r\'emanentes.
409      REAL, save:: heat(klon, llm) ! chauffage solaire      REAL, save:: heat(klon, llm) ! chauffage solaire
410      REAL heat0(klon, llm) ! chauffage solaire ciel clair      REAL heat0(klon, llm) ! chauffage solaire ciel clair
411      REAL, save:: cool(klon, llm) ! refroidissement infrarouge      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
412      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair
413      REAL, save:: topsw(klon), toplw(klon), solsw(klon), sollw(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
414      real sollwdown(klon) ! downward LW flux at surface      REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface
415        real, save:: sollwdown(klon) ! downward LW flux at surface
416      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
417      REAL albpla(klon)      REAL albpla(klon)
418      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface
419      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface
420      SAVE albpla, sollwdown      SAVE albpla
421      SAVE heat0, cool0      SAVE heat0, cool0
422    
423      INTEGER itaprad      INTEGER itaprad
# Line 490  contains Line 484  contains
484      ! con: convection      ! con: convection
485      ! lsc: large scale condensation      ! lsc: large scale condensation
486      ! ajs: ajustement sec      ! ajs: ajustement sec
487      ! eva: évaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
488      ! vdf: vertical diffusion in boundary layer      ! vdf: vertical diffusion in boundary layer
489      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
490      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL d_u_con(klon, llm), d_v_con(klon, llm)
# Line 533  contains Line 527  contains
527      integer:: iflag_cldcon = 1      integer:: iflag_cldcon = 1
528      logical ptconv(klon, llm)      logical ptconv(klon, llm)
529    
530      ! Variables locales pour effectuer les appels en série :      ! Variables locales pour effectuer les appels en s\'erie :
531    
532      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
533      REAL ql_seri(klon, llm), qs_seri(klon, llm)      REAL ql_seri(klon, llm), qs_seri(klon, llm)
# Line 549  contains Line 543  contains
543      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
544      REAL aam, torsfc      REAL aam, torsfc
545    
     REAL dudyn(iim + 1, jjm + 1, llm)  
   
546      REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique      REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique
     REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)  
547    
548      INTEGER, SAVE:: nid_day, nid_ins      INTEGER, SAVE:: nid_day, nid_ins
549    
# Line 566  contains Line 557  contains
557      logical ok_sync      logical ok_sync
558      real date0      real date0
559    
560      ! Variables liées au bilan d'énergie et d'enthalpie :      ! Variables li\'ees au bilan d'\'energie et d'enthalpie :
561      REAL ztsol(klon)      REAL ztsol(klon)
562      REAL d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec      REAL d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec
563      REAL, SAVE:: d_h_vcol_phy      REAL, SAVE:: d_h_vcol_phy
# Line 576  contains Line 567  contains
567      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
568      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation
569    
570      REAL d_t_ec(klon, llm) ! tendance due à la conversion Ec -> E thermique      REAL d_t_ec(klon, llm) ! tendance due \`a la conversion Ec -> E thermique
571      REAL ZRCPD      REAL ZRCPD
572    
573      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m
# Line 628  contains Line 619  contains
619      SAVE solswad      SAVE solswad
620      SAVE d_u_con      SAVE d_u_con
621      SAVE d_v_con      SAVE d_v_con
     SAVE rnebcon0  
     SAVE clwcon0  
622    
623      real zmasse(klon, llm)      real zmasse(klon, llm)
624      ! (column-density of mass of air in a cell, in kg m-2)      ! (column-density of mass of air in a cell, in kg m-2)
# Line 666  contains Line 655  contains
655         solswai(:) = 0.         solswai(:) = 0.
656         solswad(:) = 0.         solswad(:) = 0.
657    
658         d_u_con = 0.0         d_u_con = 0.
659         d_v_con = 0.0         d_v_con = 0.
660         rnebcon0 = 0.0         rnebcon0 = 0.
661         clwcon0 = 0.0         clwcon0 = 0.
662         rnebcon = 0.0         rnebcon = 0.
663         clwcon = 0.0         clwcon = 0.
664    
665         pblh =0. ! Hauteur de couche limite         pblh =0. ! Hauteur de couche limite
666         plcl =0. ! Niveau de condensation de la CLA         plcl =0. ! Niveau de condensation de la CLA
# Line 701  contains Line 690  contains
690         itaprad = 0         itaprad = 0
691         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &
692              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &
693              snow_fall, solsw, sollwdown, dlw, radsol, frugs, agesno, zmea, &              snow_fall, solsw, sollw, dlw, radsol, frugs, agesno, zmea, &
694              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &
695              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0)              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)
696    
697         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
698         q2 = 1e-8         q2 = 1e-8
# Line 723  contains Line 712  contains
712                 "Nombre d'appels au rayonnement insuffisant", 1)                 "Nombre d'appels au rayonnement insuffisant", 1)
713         ENDIF         ENDIF
714    
715         ! Initialisation pour le schéma de convection d'Emanuel :         ! Initialisation pour le sch\'ema de convection d'Emanuel :
716         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
717            ibas_con = 1            ibas_con = 1
718            itop_con = 1            itop_con = 1
# Line 752  contains Line 741  contains
741    
742         ! Initialisation des sorties         ! Initialisation des sorties
743    
        call ini_histhf(dtphys, nid_hf, nid_hf3d)  
        call ini_histday(dtphys, ok_journe, nid_day, nqmx)  
744         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
745         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
746         ! Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
# Line 776  contains Line 763  contains
763      mp = 0.      mp = 0.
764      phi = 0.      phi = 0.
765    
766      ! Ne pas affecter les valeurs entrées de u, v, h, et q :      ! Ne pas affecter les valeurs entr\'ees de u, v, h, et q :
767    
768      DO k = 1, llm      DO k = 1, llm
769         DO i = 1, klon         DO i = 1, klon
# Line 808  contains Line 795  contains
795         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, &
796              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, &
797              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
798         ! Comme les tendances de la physique sont ajoutés dans la         ! Comme les tendances de la physique sont ajout\'es dans la
799         !  dynamique, la variation d'enthalpie par la dynamique devrait         !  dynamique, la variation d'enthalpie par la dynamique devrait
800         !  être égale à la variation de la physique au pas de temps         !  \^etre \'egale \`a la variation de la physique au pas de temps
801         !  précédent.  Donc la somme de ces 2 variations devrait être         !  pr\'ec\'edent.  Donc la somme de ces 2 variations devrait \^etre
802         !  nulle.         !  nulle.
803         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, &
804              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, &
# Line 829  contains Line 816  contains
816      ELSE      ELSE
817         DO k = 1, llm         DO k = 1, llm
818            DO i = 1, klon            DO i = 1, klon
819               d_t_dyn(i, k) = 0.0               d_t_dyn(i, k) = 0.
820               d_q_dyn(i, k) = 0.0               d_q_dyn(i, k) = 0.
821            ENDDO            ENDDO
822         ENDDO         ENDDO
823         ancien_ok = .TRUE.         ancien_ok = .TRUE.
# Line 858  contains Line 845  contains
845      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
846      wo = ozonecm(REAL(julien), paprs)      wo = ozonecm(REAL(julien), paprs)
847    
848      ! Évaporation de l'eau liquide nuageuse :      ! \'Evaporation de l'eau liquide nuageuse :
849      DO k = 1, llm      DO k = 1, llm
850         DO i = 1, klon         DO i = 1, klon
851            zb = MAX(0., ql_seri(i, k))            zb = MAX(0., ql_seri(i, k))
# Line 883  contains Line 870  contains
870      ! Appeler la diffusion verticale (programme de couche limite)      ! Appeler la diffusion verticale (programme de couche limite)
871    
872      DO i = 1, klon      DO i = 1, klon
873         zxrugs(i) = 0.0         zxrugs(i) = 0.
874      ENDDO      ENDDO
875      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
876         DO i = 1, klon         DO i = 1, klon
# Line 916  contains Line 903  contains
903         ENDDO         ENDDO
904      ENDDO      ENDDO
905    
906      ! Repartition sous maille des flux LW et SW      ! R\'epartition sous maille des flux longwave et shortwave
907      ! Repartition du longwave par sous-surface linearisee      ! R\'epartition du longwave par sous-surface lin\'earis\'ee
908    
909      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
910         DO i = 1, klon         DO i = 1, klon
# Line 931  contains Line 918  contains
918    
919      ! Couche limite:      ! Couche limite:
920    
921      CALL clmain(dtphys, itap, date0, pctsrf, pctsrf_new, t_seri, q_seri, &      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, &
922           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, npas, nexca, &           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, &
923           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &
924           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &
925           rain_fall, snow_fall, fsolsw, fsollw, sollwdown, fder, rlon, rlat, &           rain_fall, snow_fall, fsolsw, fsollw, fder, rlon, rlat, &
926           cuphy, cvphy, frugs, firstcal, lafin, agesno, rugoro, d_t_vdf, &           frugs, firstcal, agesno, rugoro, d_t_vdf, &
927           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &
928           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &
929           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &
930           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice)           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice)
931    
932      ! Incrémentation des flux      ! Incr\'ementation des flux
933    
934      zxfluxt = 0.      zxfluxt = 0.
935      zxfluxq = 0.      zxfluxq = 0.
# Line 960  contains Line 947  contains
947      END DO      END DO
948      DO i = 1, klon      DO i = 1, klon
949         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol
950         evap(i) = - zxfluxq(i, 1) ! flux d'évaporation au sol         evap(i) = - zxfluxq(i, 1) ! flux d'\'evaporation au sol
951         fder(i) = dlw(i) + dsens(i) + devap(i)         fder(i) = dlw(i) + dsens(i) + devap(i)
952      ENDDO      ENDDO
953    
# Line 986  contains Line 973  contains
973      ! Update surface temperature:      ! Update surface temperature:
974    
975      DO i = 1, klon      DO i = 1, klon
976         zxtsol(i) = 0.0         zxtsol(i) = 0.
977         zxfluxlat(i) = 0.0         zxfluxlat(i) = 0.
978    
979         zt2m(i) = 0.0         zt2m(i) = 0.
980         zq2m(i) = 0.0         zq2m(i) = 0.
981         zu10m(i) = 0.0         zu10m(i) = 0.
982         zv10m(i) = 0.0         zv10m(i) = 0.
983         zxffonte(i) = 0.0         zxffonte(i) = 0.
984         zxfqcalving(i) = 0.0         zxfqcalving(i) = 0.
985    
986         s_pblh(i) = 0.0         s_pblh(i) = 0.
987         s_lcl(i) = 0.0         s_lcl(i) = 0.
988         s_capCL(i) = 0.0         s_capCL(i) = 0.
989         s_oliqCL(i) = 0.0         s_oliqCL(i) = 0.
990         s_cteiCL(i) = 0.0         s_cteiCL(i) = 0.
991         s_pblT(i) = 0.0         s_pblT(i) = 0.
992         s_therm(i) = 0.0         s_therm(i) = 0.
993         s_trmb1(i) = 0.0         s_trmb1(i) = 0.
994         s_trmb2(i) = 0.0         s_trmb2(i) = 0.
995         s_trmb3(i) = 0.0         s_trmb3(i) = 0.
996    
997         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) &
998              + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &              + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &
999              'physiq : problème sous surface au point ', i, pctsrf(i, 1 : nbsrf)              'physiq : probl\`eme sous surface au point ', i, pctsrf(i, 1 : nbsrf)
1000      ENDDO      ENDDO
1001      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1002         DO i = 1, klon         DO i = 1, klon
# Line 1096  contains Line 1083  contains
1083         itop_con = llm + 1 - kctop         itop_con = llm + 1 - kctop
1084      else      else
1085         ! iflag_con >= 3         ! iflag_con >= 3
1086    
1087         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, &         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, &
1088              v_seri, tr_seri, ema_work1, ema_work2, d_t_con, d_q_con, &              v_seri, tr_seri, sig1, w01, d_t_con, d_q_con, &
1089              d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &              d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &
1090              itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, &              itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, &
1091              pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, &              pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, &
# Line 1111  contains Line 1099  contains
1099         mfu = upwd + dnwd         mfu = upwd + dnwd
1100         IF (.NOT. ok_gust) wd = 0.         IF (.NOT. ok_gust) wd = 0.
1101    
1102         ! Calcul des propriétés des nuages convectifs         ! Calcul des propri\'et\'es des nuages convectifs
1103    
1104         DO k = 1, llm         DO k = 1, llm
1105            DO i = 1, klon            DO i = 1, klon
# Line 1137  contains Line 1125  contains
1125         clwcon0 = fact_cldcon * clwcon0         clwcon0 = fact_cldcon * clwcon0
1126         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
1127              rnebcon0)              rnebcon0)
1128    
1129           mfd = 0.
1130           pen_u = 0.
1131           pen_d = 0.
1132           pde_d = 0.
1133           pde_u = 0.
1134      END if      END if
1135    
1136      DO k = 1, llm      DO k = 1, llm
# Line 1161  contains Line 1155  contains
1155      IF (check) THEN      IF (check) THEN
1156         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1157         print *, "aprescon = ", za         print *, "aprescon = ", za
1158         zx_t = 0.0         zx_t = 0.
1159         za = 0.0         za = 0.
1160         DO i = 1, klon         DO i = 1, klon
1161            za = za + airephy(i)/REAL(klon)            za = za + airephy(i)/REAL(klon)
1162            zx_t = zx_t + (rain_con(i)+ &            zx_t = zx_t + (rain_con(i)+ &
# Line 1184  contains Line 1178  contains
1178         ENDDO         ENDDO
1179      ENDIF      ENDIF
1180    
1181      ! Convection sèche (thermiques ou ajustement)      ! Convection s\`eche (thermiques ou ajustement)
1182    
1183      d_t_ajs = 0.      d_t_ajs = 0.
1184      d_u_ajs = 0.      d_u_ajs = 0.
# Line 1213  contains Line 1207  contains
1207    
1208      ! Caclul des ratqs      ! Caclul des ratqs
1209    
1210      ! ratqs convectifs à l'ancienne en fonction de (q(z = 0) - q) / q      ! ratqs convectifs \`a l'ancienne en fonction de (q(z = 0) - q) / q
1211      ! on écrase le tableau ratqsc calculé par clouds_gno      ! on \'ecrase le tableau ratqsc calcul\'e par clouds_gno
1212      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1213         do k = 1, llm         do k = 1, llm
1214            do i = 1, klon            do i = 1, klon
# Line 1249  contains Line 1243  contains
1243         ratqs = ratqss         ratqs = ratqss
1244      endif      endif
1245    
     ! Processus de condensation à grande echelle et processus de  
     ! précipitation :  
1246      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &
1247           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &
1248           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &
# Line 1270  contains Line 1262  contains
1262      IF (check) THEN      IF (check) THEN
1263         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1264         print *, "apresilp = ", za         print *, "apresilp = ", za
1265         zx_t = 0.0         zx_t = 0.
1266         za = 0.0         za = 0.
1267         DO i = 1, klon         DO i = 1, klon
1268            za = za + airephy(i)/REAL(klon)            za = za + airephy(i)/REAL(klon)
1269            zx_t = zx_t + (rain_lsc(i) &            zx_t = zx_t + (rain_lsc(i) &
# Line 1324  contains Line 1316  contains
1316            ENDDO            ENDDO
1317         ENDDO         ENDDO
1318      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1319         ! On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le maximum du calcul de
1320         ! convection et du calcul du pas de temps précédent diminué d'un facteur         ! la convection et du calcul du pas de temps pr\'ec\'edent diminu\'e
1321         ! facttemps         ! d'un facteur facttemps.
1322         facteur = dtphys *facttemps         facteur = dtphys * facttemps
1323         do k = 1, llm         do k = 1, llm
1324            do i = 1, klon            do i = 1, klon
1325               rnebcon(i, k) = rnebcon(i, k) * facteur               rnebcon(i, k) = rnebcon(i, k) * facteur
1326               if (rnebcon0(i, k)*clwcon0(i, k) > rnebcon(i, k)*clwcon(i, k)) &               if (rnebcon0(i, k) * clwcon0(i, k) &
1327                    then                    > rnebcon(i, k) * clwcon(i, k)) then
1328                  rnebcon(i, k) = rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
1329                  clwcon(i, k) = clwcon0(i, k)                  clwcon(i, k) = clwcon0(i, k)
1330               endif               endif
# Line 1368  contains Line 1360  contains
1360           dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &           dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &
1361           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)
1362    
1363      ! Humidité relative pour diagnostic :      ! Humidit\'e relative pour diagnostic :
1364      DO k = 1, llm      DO k = 1, llm
1365         DO i = 1, klon         DO i = 1, klon
1366            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
# Line 1404  contains Line 1396  contains
1396         cg_ae = 0.         cg_ae = 0.
1397      ENDIF      ENDIF
1398    
1399      ! Paramètres optiques des nuages et quelques paramètres pour diagnostics :      ! Param\`etres optiques des nuages et quelques param\`etres pour diagnostics :
1400      if (ok_newmicro) then      if (ok_newmicro) then
1401         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
1402              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &
# Line 1458  contains Line 1450  contains
1450    
1451      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
1452      DO i = 1, klon      DO i = 1, klon
1453         zxqsurf(i) = 0.0         zxqsurf(i) = 0.
1454         zxsnow(i) = 0.0         zxsnow(i) = 0.
1455      ENDDO      ENDDO
1456      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1457         DO i = 1, klon         DO i = 1, klon
# Line 1468  contains Line 1460  contains
1460         ENDDO         ENDDO
1461      ENDDO      ENDDO
1462    
1463      ! Calculer le bilan du sol et la dérive de température (couplage)      ! Calculer le bilan du sol et la d\'erive de temp\'erature (couplage)
1464    
1465      DO i = 1, klon      DO i = 1, klon
1466         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1467      ENDDO      ENDDO
1468    
1469      ! Paramétrisation de l'orographie à l'échelle sous-maille :      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :
1470    
1471      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1472         ! selection des points pour lesquels le shema est actif:         ! selection des points pour lesquels le shema est actif:
1473         igwd = 0         igwd = 0
1474         DO i = 1, klon         DO i = 1, klon
1475            itest(i) = 0            itest(i) = 0
1476            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.0)) THEN            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.)) THEN
1477               itest(i) = 1               itest(i) = 1
1478               igwd = igwd + 1               igwd = igwd + 1
1479               idx(igwd) = i               idx(igwd) = i
# Line 1503  contains Line 1495  contains
1495      ENDIF      ENDIF
1496    
1497      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1498         ! Sélection des points pour lesquels le schéma est actif :         ! S\'election des points pour lesquels le sch\'ema est actif :
1499         igwd = 0         igwd = 0
1500         DO i = 1, klon         DO i = 1, klon
1501            itest(i) = 0            itest(i) = 0
# Line 1528  contains Line 1520  contains
1520         ENDDO         ENDDO
1521      ENDIF      ENDIF
1522    
1523      ! Stress nécessaires : toute la physique      ! Stress n\'ecessaires : toute la physique
1524    
1525      DO i = 1, klon      DO i = 1, klon
1526         zustrph(i) = 0.         zustrph(i) = 0.
# Line 1552  contains Line 1544  contains
1544    
1545      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1546      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &
1547           dtphys, u, t, paprs, play, mfu, mfd, pen_u, pde_u, pen_d, pde_d, &           dtphys, u, t, paprs, play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, &
1548           ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, &           entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, pphis, &
1549           frac_nucl, pphis, albsol, rhcl, cldfra, rneb, diafra, cldliq, &           albsol, rhcl, cldfra, rneb, diafra, cldliq, pmflxr, pmflxs, prfl, &
1550           pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)           psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)
1551    
1552      IF (offline) THEN      IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &
1553         call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, pde_u, &           pde_u, pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1554              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &           pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)
             pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)  
     ENDIF  
1555    
1556      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1557      CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &      CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &
# Line 1643  contains Line 1633  contains
1633      ENDDO      ENDDO
1634    
1635      ! Ecriture des sorties      ! Ecriture des sorties
     call write_histhf  
     call write_histday  
1636      call write_histins      call write_histins
1637    
1638      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
# Line 1652  contains Line 1640  contains
1640         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1641         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &
1642              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &
1643              rain_fall, snow_fall, solsw, sollwdown, dlw, radsol, frugs, &              rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &
1644              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
1645              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)
1646      ENDIF      ENDIF
1647    
1648      firstcal = .FALSE.      firstcal = .FALSE.
1649    
1650    contains    contains
1651    
     subroutine write_histday  
   
       use gr_phy_write_3d_m, only: gr_phy_write_3d  
       integer itau_w ! pas de temps ecriture  
   
       !------------------------------------------------  
   
       if (ok_journe) THEN  
          itau_w = itau_phy + itap  
          if (nqmx <= 4) then  
             call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &  
                  gr_phy_write_3d(wo) * 1e3)  
             ! (convert "wo" from kDU to DU)  
          end if  
          if (ok_sync) then  
             call histsync(nid_day)  
          endif  
       ENDIF  
   
     End subroutine write_histday  
   
     !****************************  
   
     subroutine write_histhf  
   
       ! From phylmd/write_histhf.h, version 1.5 2005/05/25 13:10:09  
   
       !------------------------------------------------  
   
       call write_histhf3d  
   
       IF (ok_sync) THEN  
          call histsync(nid_hf)  
       ENDIF  
   
     end subroutine write_histhf  
   
     !***************************************************************  
   
1652      subroutine write_histins      subroutine write_histins
1653    
1654        ! From phylmd/write_histins.h, version 1.2 2005/05/25 13:10:09        ! From phylmd/write_histins.h, version 1.2 2005/05/25 13:10:09
1655    
1656          use dimens_m, only: iim, jjm
1657          USE histsync_m, ONLY: histsync
1658          USE histwrite_m, ONLY: histwrite
1659    
1660        real zout        real zout
1661        integer itau_w ! pas de temps ecriture        integer itau_w ! pas de temps ecriture
1662          REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)
1663    
1664        !--------------------------------------------------        !--------------------------------------------------
1665    
# Line 1928  contains Line 1882  contains
1882    
1883      end subroutine write_histins      end subroutine write_histins
1884    
     !****************************************************  
   
     subroutine write_histhf3d  
   
       ! From phylmd/write_histhf3d.h, version 1.2 2005/05/25 13:10:09  
   
       integer itau_w ! pas de temps ecriture  
   
       !-------------------------------------------------------  
   
       itau_w = itau_phy + itap  
   
       ! Champs 3D:  
   
       CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, t_seri, zx_tmp_3d)  
       CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)  
   
       CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, qx(1, 1, ivap), zx_tmp_3d)  
       CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)  
   
       CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, u_seri, zx_tmp_3d)  
       CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)  
   
       CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, v_seri, zx_tmp_3d)  
       CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)  
   
       if (nbtr >= 3) then  
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, tr_seri(1, 1, 3), &  
               zx_tmp_3d)  
          CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)  
       end if  
   
       if (ok_sync) then  
          call histsync(nid_hf3d)  
       endif  
   
     end subroutine write_histhf3d  
   
1885    END SUBROUTINE physiq    END SUBROUTINE physiq
1886    
1887  end module physiq_m  end module physiq_m
Legend:
Removed from v.71  
changed lines
  Added in v.90
  ViewVC Help
Powered by ViewVC 1.1.21