/[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 73 by guez, Fri Nov 15 17:48:30 2013 UTC trunk/phylmd/physiq.f revision 91 by guez, Wed Mar 26 17:18:58 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)
9    
10      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
11      ! (subversion revision 678)      ! (subversion revision 678)
# Line 35  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 66  contains Line 62  contains
62      use unit_nml_m, only: unit_nml      use unit_nml_m, only: unit_nml
63      USE yoethf_m, ONLY: r2es, rvtmp2      USE yoethf_m, ONLY: r2es, rvtmp2
64    
65      ! Arguments:      logical, intent(in):: lafin ! dernier passage
66    
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)
     logical, intent(in):: lafin ! dernier passage  
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)
# Line 93  contains Line 88  contains
88      REAL, intent(in):: t(klon, llm) ! input temperature (K)      REAL, intent(in):: t(klon, llm) ! input temperature (K)
89    
90      REAL, intent(in):: qx(klon, llm, nqmx)      REAL, intent(in):: qx(klon, llm, nqmx)
91      ! (humidité spécifique et fractions massiques des autres traceurs)      ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)
92    
93      REAL omega(klon, llm) ! input 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/s)      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/s)      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 d_qx(klon, llm, nqmx) ! output tendance physique de "qx" (kg/kg/s)      REAL, intent(out):: d_qx(klon, llm, nqmx) ! tendance physique de "qx" (s-1)
98      REAL d_ps(klon) ! output tendance physique de la pression au sol  
99        ! Local:
100    
101      LOGICAL:: firstcal = .true.      LOGICAL:: firstcal = .true.
102    
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 125  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
122        ! pas "couple")
123    
124      ! "slab" ocean      ! "slab" ocean
125      REAL, save:: tslab(klon) ! temperature of ocean slab      REAL, save:: tslab(klon) ! temperature of ocean slab
# Line 161  contains Line 155  contains
155    
156      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
157    
158      !IM Amip2 PV a theta constante      ! Amip2 PV a theta constante
159    
160      CHARACTER(LEN = 3) ctetaSTD(nbteta)      CHARACTER(LEN = 3) ctetaSTD(nbteta)
161      DATA ctetaSTD/'350', '380', '405'/      DATA ctetaSTD/'350', '380', '405'/
162      REAL rtetaSTD(nbteta)      REAL rtetaSTD(nbteta)
163      DATA rtetaSTD/350., 380., 405./      DATA rtetaSTD/350., 380., 405./
164    
165      !MI Amip2 PV a theta constante      ! Amip2 PV a theta constante
166    
167      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)
168      REAL swup0(klon, llm + 1), swup(klon, llm + 1)      REAL swup0(klon, llm + 1), swup(klon, llm + 1)
# Line 178  contains Line 172  contains
172      REAL lwup0(klon, llm + 1), lwup(klon, llm + 1)      REAL lwup0(klon, llm + 1), lwup(klon, llm + 1)
173      SAVE lwdn0, lwdn, lwup0, lwup      SAVE lwdn0, lwdn, lwup0, lwup
174    
175      !IM Amip2      ! Amip2
176      ! variables a une pression donnee      ! variables a une pression donnee
177    
178      integer nlevSTD      integer nlevSTD
# Line 247  contains Line 241  contains
241           'pc= 440-560hPa, tau> 60.', 'pc= 560-680hPa, tau> 60.', &           'pc= 440-560hPa, tau> 60.', 'pc= 560-680hPa, tau> 60.', &
242           'pc= 680-800hPa, tau> 60.'/           'pc= 680-800hPa, tau> 60.'/
243    
244      !IM ISCCP simulator v3.4      ! ISCCP simulator v3.4
245    
246      integer nid_hf, nid_hf3d      integer nid_hf, nid_hf3d
247      save nid_hf, nid_hf3d      save nid_hf, nid_hf3d
# Line 285  contains Line 279  contains
279      REAL falblw(klon, nbsrf)      REAL falblw(klon, nbsrf)
280      SAVE falblw ! albedo par type de surface      SAVE falblw ! albedo par type de surface
281    
282      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :
283      REAL, save:: zmea(klon) ! orographie moyenne      REAL, save:: zmea(klon) ! orographie moyenne
284      REAL, save:: zstd(klon) ! deviation standard de l'OESM      REAL, save:: zstd(klon) ! deviation standard de l'OESM
285      REAL, save:: zsig(klon) ! pente de l'OESM      REAL, save:: zsig(klon) ! pente de l'OESM
# Line 411  contains Line 405  contains
405      REAL zxfluxu(klon, llm)      REAL zxfluxu(klon, llm)
406      REAL zxfluxv(klon, llm)      REAL zxfluxv(klon, llm)
407    
408      ! 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
409      ! les variables soient rémanentes.      ! les variables soient r\'emanentes.
410      REAL, save:: heat(klon, llm) ! chauffage solaire      REAL, save:: heat(klon, llm) ! chauffage solaire
411      REAL heat0(klon, llm) ! chauffage solaire ciel clair      REAL heat0(klon, llm) ! chauffage solaire ciel clair
412      REAL, save:: cool(klon, llm) ! refroidissement infrarouge      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
413      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair
414      REAL, save:: topsw(klon), toplw(klon), solsw(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
415      REAL, save:: sollw(klon) ! rayonnement infrarouge montant à la surface      REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface
416      real, save:: sollwdown(klon) ! downward LW flux at surface      real, save:: sollwdown(klon) ! downward LW flux at surface
417      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
418      REAL albpla(klon)      REAL albpla(klon)
# Line 449  contains Line 443  contains
443      REAL, PARAMETER:: t_coup = 234.      REAL, PARAMETER:: t_coup = 234.
444      REAL zphi(klon, llm)      REAL zphi(klon, llm)
445    
446      !IM cf. AM Variables locales pour la CLA (hbtm2)      ! cf. AM Variables locales pour la CLA (hbtm2)
447    
448      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
449      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
# Line 491  contains Line 485  contains
485      ! con: convection      ! con: convection
486      ! lsc: large scale condensation      ! lsc: large scale condensation
487      ! ajs: ajustement sec      ! ajs: ajustement sec
488      ! eva: évaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
489      ! vdf: vertical diffusion in boundary layer      ! vdf: vertical diffusion in boundary layer
490      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
491      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL d_u_con(klon, llm), d_v_con(klon, llm)
# Line 534  contains Line 528  contains
528      integer:: iflag_cldcon = 1      integer:: iflag_cldcon = 1
529      logical ptconv(klon, llm)      logical ptconv(klon, llm)
530    
531      ! Variables locales pour effectuer les appels en série :      ! Variables locales pour effectuer les appels en s\'erie :
532    
533      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
534      REAL ql_seri(klon, llm), qs_seri(klon, llm)      REAL ql_seri(klon, llm), qs_seri(klon, llm)
# Line 550  contains Line 544  contains
544      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
545      REAL aam, torsfc      REAL aam, torsfc
546    
     REAL dudyn(iim + 1, jjm + 1, llm)  
   
547      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)  
548    
549      INTEGER, SAVE:: nid_day, nid_ins      INTEGER, SAVE:: nid_day, nid_ins
550    
# Line 563  contains Line 554  contains
554      REAL uq_lay(klon, llm) ! transport zonal de l'eau a chaque niveau vert.      REAL uq_lay(klon, llm) ! transport zonal de l'eau a chaque niveau vert.
555    
556      REAL zsto      REAL zsto
   
     logical ok_sync  
557      real date0      real date0
558    
559      ! Variables liées au bilan d'énergie et d'enthalpie :      ! Variables li\'ees au bilan d'\'energie et d'enthalpie :
560      REAL ztsol(klon)      REAL ztsol(klon)
561      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
562      REAL, SAVE:: d_h_vcol_phy      REAL, SAVE:: d_h_vcol_phy
# Line 577  contains Line 566  contains
566      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
567      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation
568    
569      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
570      REAL ZRCPD      REAL ZRCPD
571    
572      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 643  contains Line 632  contains
632      !----------------------------------------------------------------      !----------------------------------------------------------------
633    
634      IF (if_ebil >= 1) zero_v = 0.      IF (if_ebil >= 1) zero_v = 0.
     ok_sync = .TRUE.  
635      IF (nqmx < 2) CALL abort_gcm('physiq', &      IF (nqmx < 2) CALL abort_gcm('physiq', &
636           'eaux vapeur et liquide sont indispensables', 1)           'eaux vapeur et liquide sont indispensables', 1)
637    
# Line 722  contains Line 710  contains
710                 "Nombre d'appels au rayonnement insuffisant", 1)                 "Nombre d'appels au rayonnement insuffisant", 1)
711         ENDIF         ENDIF
712    
713         ! Initialisation pour le schéma de convection d'Emanuel :         ! Initialisation pour le sch\'ema de convection d'Emanuel :
714         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
715            ibas_con = 1            ibas_con = 1
716            itop_con = 1            itop_con = 1
# Line 751  contains Line 739  contains
739    
740         ! Initialisation des sorties         ! Initialisation des sorties
741    
        call ini_histhf(dtphys, nid_hf, nid_hf3d)  
        call ini_histday(dtphys, ok_journe, nid_day, nqmx)  
742         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
743         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
744         ! Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
# Line 760  contains Line 746  contains
746      ENDIF test_firstcal      ENDIF test_firstcal
747    
748      ! Mettre a zero des variables de sortie (pour securite)      ! Mettre a zero des variables de sortie (pour securite)
   
     DO i = 1, klon  
        d_ps(i) = 0.  
     ENDDO  
     DO iq = 1, nqmx  
        DO k = 1, llm  
           DO i = 1, klon  
              d_qx(i, k, iq) = 0.  
           ENDDO  
        ENDDO  
     ENDDO  
749      da = 0.      da = 0.
750      mp = 0.      mp = 0.
751      phi = 0.      phi = 0.
752    
753      ! Ne pas affecter les valeurs entrées de u, v, h, et q :      ! We will modify variables *_seri and we will not touch variables
754        ! u, v, h, q:
755      DO k = 1, llm      DO k = 1, llm
756         DO i = 1, klon         DO i = 1, klon
757            t_seri(i, k) = t(i, k)            t_seri(i, k) = t(i, k)
# Line 807  contains Line 782  contains
782         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, &
783              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, &
784              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
785         ! Comme les tendances de la physique sont ajoutés dans la         ! Comme les tendances de la physique sont ajout\'es dans la
786         !  dynamique, la variation d'enthalpie par la dynamique devrait         !  dynamique, la variation d'enthalpie par la dynamique devrait
787         !  être égale à la variation de la physique au pas de temps         !  \^etre \'egale \`a la variation de la physique au pas de temps
788         !  précédent.  Donc la somme de ces 2 variations devrait être         !  pr\'ec\'edent.  Donc la somme de ces 2 variations devrait \^etre
789         !  nulle.         !  nulle.
790         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, &
791              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 857  contains Line 832  contains
832      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
833      wo = ozonecm(REAL(julien), paprs)      wo = ozonecm(REAL(julien), paprs)
834    
835      ! Évaporation de l'eau liquide nuageuse :      ! \'Evaporation de l'eau liquide nuageuse :
836      DO k = 1, llm      DO k = 1, llm
837         DO i = 1, klon         DO i = 1, klon
838            zb = MAX(0., ql_seri(i, k))            zb = MAX(0., ql_seri(i, k))
# Line 915  contains Line 890  contains
890         ENDDO         ENDDO
891      ENDDO      ENDDO
892    
893      ! Répartition sous maille des flux longwave et shortwave      ! R\'epartition sous maille des flux longwave et shortwave
894      ! Répartition du longwave par sous-surface linéarisée      ! R\'epartition du longwave par sous-surface lin\'earis\'ee
895    
896      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
897         DO i = 1, klon         DO i = 1, klon
# Line 941  contains Line 916  contains
916           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &
917           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice)           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice)
918    
919      ! Incrémentation des flux      ! Incr\'ementation des flux
920    
921      zxfluxt = 0.      zxfluxt = 0.
922      zxfluxq = 0.      zxfluxq = 0.
# Line 959  contains Line 934  contains
934      END DO      END DO
935      DO i = 1, klon      DO i = 1, klon
936         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol
937         evap(i) = - zxfluxq(i, 1) ! flux d'évaporation au sol         evap(i) = - zxfluxq(i, 1) ! flux d'\'evaporation au sol
938         fder(i) = dlw(i) + dsens(i) + devap(i)         fder(i) = dlw(i) + dsens(i) + devap(i)
939      ENDDO      ENDDO
940    
# Line 1008  contains Line 983  contains
983    
984         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) &
985              + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &              + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &
986              'physiq : problème sous surface au point ', i, pctsrf(i, 1 : nbsrf)              'physiq : probl\`eme sous surface au point ', i, pctsrf(i, 1 : nbsrf)
987      ENDDO      ENDDO
988      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
989         DO i = 1, klon         DO i = 1, klon
# Line 1111  contains Line 1086  contains
1086         mfu = upwd + dnwd         mfu = upwd + dnwd
1087         IF (.NOT. ok_gust) wd = 0.         IF (.NOT. ok_gust) wd = 0.
1088    
1089         ! Calcul des propriétés des nuages convectifs         ! Calcul des propri\'et\'es des nuages convectifs
1090    
1091         DO k = 1, llm         DO k = 1, llm
1092            DO i = 1, klon            DO i = 1, klon
# Line 1190  contains Line 1165  contains
1165         ENDDO         ENDDO
1166      ENDIF      ENDIF
1167    
1168      ! Convection sèche (thermiques ou ajustement)      ! Convection s\`eche (thermiques ou ajustement)
1169    
1170      d_t_ajs = 0.      d_t_ajs = 0.
1171      d_u_ajs = 0.      d_u_ajs = 0.
# Line 1219  contains Line 1194  contains
1194    
1195      ! Caclul des ratqs      ! Caclul des ratqs
1196    
1197      ! 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
1198      ! on écrase le tableau ratqsc calculé par clouds_gno      ! on \'ecrase le tableau ratqsc calcul\'e par clouds_gno
1199      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1200         do k = 1, llm         do k = 1, llm
1201            do i = 1, klon            do i = 1, klon
# Line 1329  contains Line 1304  contains
1304         ENDDO         ENDDO
1305      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1306         ! On prend pour les nuages convectifs le maximum du calcul de         ! On prend pour les nuages convectifs le maximum du calcul de
1307         ! la convection et du calcul du pas de temps précédent diminué         ! la convection et du calcul du pas de temps pr\'ec\'edent diminu\'e
1308         ! d'un facteur facttemps.         ! d'un facteur facttemps.
1309         facteur = dtphys * facttemps         facteur = dtphys * facttemps
1310         do k = 1, llm         do k = 1, llm
# Line 1372  contains Line 1347  contains
1347           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, &
1348           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)
1349    
1350      ! Humidité relative pour diagnostic :      ! Humidit\'e relative pour diagnostic :
1351      DO k = 1, llm      DO k = 1, llm
1352         DO i = 1, klon         DO i = 1, klon
1353            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
# Line 1408  contains Line 1383  contains
1383         cg_ae = 0.         cg_ae = 0.
1384      ENDIF      ENDIF
1385    
1386      ! Paramètres optiques des nuages et quelques paramètres pour diagnostics :      ! Param\`etres optiques des nuages et quelques param\`etres pour diagnostics :
1387      if (ok_newmicro) then      if (ok_newmicro) then
1388         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
1389              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &
# Line 1472  contains Line 1447  contains
1447         ENDDO         ENDDO
1448      ENDDO      ENDDO
1449    
1450      ! 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)
1451    
1452      DO i = 1, klon      DO i = 1, klon
1453         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1454      ENDDO      ENDDO
1455    
1456      ! Paramétrisation de l'orographie à l'échelle sous-maille :      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :
1457    
1458      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1459         ! selection des points pour lesquels le shema est actif:         ! selection des points pour lesquels le shema est actif:
# Line 1507  contains Line 1482  contains
1482      ENDIF      ENDIF
1483    
1484      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1485         ! Sélection des points pour lesquels le schéma est actif :         ! S\'election des points pour lesquels le sch\'ema est actif :
1486         igwd = 0         igwd = 0
1487         DO i = 1, klon         DO i = 1, klon
1488            itest(i) = 0            itest(i) = 0
# Line 1532  contains Line 1507  contains
1507         ENDDO         ENDDO
1508      ENDIF      ENDIF
1509    
1510      ! Stress nécessaires : toute la physique      ! Stress n\'ecessaires : toute la physique
1511    
1512      DO i = 1, klon      DO i = 1, klon
1513         zustrph(i) = 0.         zustrph(i) = 0.
# Line 1556  contains Line 1531  contains
1531    
1532      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1533      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &
1534           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, &
1535           ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, &           entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, pphis, &
1536           frac_nucl, pphis, albsol, rhcl, cldfra, rneb, diafra, cldliq, &           albsol, rhcl, cldfra, rneb, diafra, cldliq, pmflxr, pmflxs, prfl, &
1537           pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)           psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)
1538    
1539      IF (offline) THEN      IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &
1540         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, &
1541              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  
1542    
1543      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1544      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 1647  contains Line 1620  contains
1620      ENDDO      ENDDO
1621    
1622      ! Ecriture des sorties      ! Ecriture des sorties
     call write_histhf  
     call write_histday  
1623      call write_histins      call write_histins
1624    
1625      ! 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 1665  contains Line 1636  contains
1636    
1637    contains    contains
1638    
     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  
   
     !***************************************************************  
   
1639      subroutine write_histins      subroutine write_histins
1640    
1641        ! 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
1642    
1643          use dimens_m, only: iim, jjm
1644          USE histsync_m, ONLY: histsync
1645          USE histwrite_m, ONLY: histwrite
1646    
1647        real zout        real zout
1648        integer itau_w ! pas de temps ecriture        integer itau_w ! pas de temps ecriture
1649          REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)
1650    
1651        !--------------------------------------------------        !--------------------------------------------------
1652    
# Line 1925  contains Line 1862  contains
1862           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_q_vdf, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_q_vdf, zx_tmp_3d)
1863           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)
1864    
1865           if (ok_sync) then           call histsync(nid_ins)
             call histsync(nid_ins)  
          endif  
1866        ENDIF        ENDIF
1867    
1868      end subroutine write_histins      end subroutine write_histins
1869    
     !****************************************************  
   
     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  
   
1870    END SUBROUTINE physiq    END SUBROUTINE physiq
1871    
1872  end module physiq_m  end module physiq_m
Legend:
Removed from v.73  
changed lines
  Added in v.91
  ViewVC Help
Powered by ViewVC 1.1.21