/[lmdze]/trunk/Sources/phylmd/coefkz.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/coefkz.f

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

revision 178 by guez, Fri Mar 11 18:47:26 2016 UTC revision 233 by guez, Tue Nov 7 10:52:46 2017 UTC
# Line 4  module coefkz_m Line 4  module coefkz_m
4    
5  contains  contains
6    
7    SUBROUTINE coefkz(nsrf, knon, paprs, pplay, ksta, ksta_ter, ts, rugos, u, v, &    SUBROUTINE coefkz(nsrf, paprs, pplay, ksta, ksta_ter, ts, rugos, u, v, t, &
8         t, q, qsurf, coefm, coefh)         q, qsurf, coefm, coefh, ycdragm, ycdragh)
9    
10      ! Authors: F. Hourdin, M. Forichon, Z. X. Li (LMD/CNRS)      ! Authors: F. Hourdin, M. Forichon, Z. X. Li (LMD/CNRS)
11      ! date: 1993/09/22      ! Date: September 22nd, 1993
12      ! Objet : calculer le coefficient de frottement du sol ("Cdrag") et les      ! Objet : calculer le coefficient de frottement du sol ("Cdrag") et les
13      ! coefficients d'échange turbulent dans l'atmosphère.      ! coefficients d'échange turbulent dans l'atmosphère.
14    
15      USE indicesol, ONLY: is_oce      use clcdrag_m, only: clcdrag
16        USE conf_phys_m, ONLY: iflag_pbl
17      USE dimphy, ONLY: klev, klon      USE dimphy, ONLY: klev, klon
18        USE fcttre, ONLY: foede, foeew
19        USE indicesol, ONLY: is_oce
20      USE suphec_m, ONLY: rcpd, rd, retv, rg, rkappa, rlstt, rlvtt, rtt      USE suphec_m, ONLY: rcpd, rd, retv, rg, rkappa, rlstt, rlvtt, rtt
21      USE yoethf_m, ONLY: r2es, r5ies, r5les, rvtmp2      USE yoethf_m, ONLY: r2es, r5ies, r5les, rvtmp2
     USE fcttre, ONLY: dqsatl, dqsats, foede, foeew, qsatl, qsats, thermcep  
     USE conf_phys_m, ONLY: iflag_pbl  
     use clcdrag_m, only: clcdrag  
   
     ! Arguments:  
22    
23      integer, intent(in):: nsrf ! indicateur de la nature du sol      integer, intent(in):: nsrf ! indicateur de la nature du sol
     INTEGER, intent(in):: knon ! nombre de points a traiter  
24    
25      REAL, intent(in):: paprs(klon, klev+1)      REAL, intent(in):: paprs(:, :) ! (klon, klev+1)
26      ! pression a chaque intercouche (en Pa)      ! pression a chaque intercouche (en Pa)
27    
28      real, intent(in):: pplay(klon, klev)      real, intent(in):: pplay(:, :) ! (klon, klev)
29      ! pression au milieu de chaque couche (en Pa)      ! pression au milieu de chaque couche (en Pa)
30    
31      REAL, intent(in):: ksta, ksta_ter      REAL, intent(in):: ksta, ksta_ter
32      REAL, intent(in):: ts(klon) ! temperature du sol (en Kelvin)      REAL, intent(in):: ts(:) ! (knon) temperature du sol (en Kelvin)
33      REAL, intent(in):: rugos(klon) ! longeur de rugosite (en m)      REAL, intent(in):: rugos(:) ! (klon) longeur de rugosite (en m)
34      REAL, intent(in):: u(klon, klev), v(klon, klev) ! wind      REAL, intent(in):: u(:, :), v(:, :) ! (klon, klev) wind
35      REAL, intent(in):: t(klon, klev) ! temperature (K)      REAL, intent(in):: t(:, :) ! (klon, klev) temperature (K)
36      real, intent(in):: q(klon, klev) ! vapeur d'eau (kg/kg)      real, intent(in):: q(:, :) ! (klon, klev) vapeur d'eau (kg/kg)
37      real, intent(in):: qsurf(klon)      real, intent(in):: qsurf(:) ! (knon)
38      REAL, intent(out):: coefm(:, :) ! (knon, klev) coefficient, vitesse      REAL, intent(out):: coefm(:, 2:) ! (knon, 2:klev) coefficient, vitesse
39    
40      real, intent(out):: coefh(:, :) ! (knon, klev)      real, intent(out):: coefh(:, 2:) ! (knon, 2:klev)
41      ! coefficient, chaleur et humidité      ! coefficient, chaleur et humidité
42    
43        real, intent(out):: ycdragm(:), ycdragh(:) ! (knon)
44    
45      ! Local:      ! Local:
46    
47      INTEGER itop(knon) ! numero de couche du sommet de la couche limite      INTEGER knon ! nombre de points a traiter
48        INTEGER itop(size(coefm, 1)) ! (knon) numero de couche du sommet
49                                     ! de la couche limite
50    
51      ! Quelques constantes et options:      ! Quelques constantes et options:
52    
# Line 56  contains Line 57  contains
57      REAL, PARAMETER:: cd = 5.      REAL, PARAMETER:: cd = 5.
58      REAL, PARAMETER:: clam = 160.      REAL, PARAMETER:: clam = 160.
59      REAL, PARAMETER:: ratqs = 0.05 ! largeur de distribution de vapeur d'eau      REAL, PARAMETER:: ratqs = 0.05 ! largeur de distribution de vapeur d'eau
60        
61      LOGICAL, PARAMETER:: richum = .TRUE.      LOGICAL, PARAMETER:: richum = .TRUE.
62      ! utilise le nombre de Richardson humide      ! utilise le nombre de Richardson humide
63    
# Line 86  contains Line 87  contains
87      REAL zt, zq, zcvm5, zcor, zqs, zfr, zdqs      REAL zt, zq, zcvm5, zcor, zqs, zfr, zdqs
88      logical zdelta      logical zdelta
89      REAL z2geomf, zalh2, alm2, zscfh, scfm      REAL z2geomf, zalh2, alm2, zscfh, scfm
     REAL, PARAMETER:: t_coup = 273.15  
90      REAL gamt(2:klev) ! contre-gradient pour la chaleur sensible: Kelvin/metre      REAL gamt(2:klev) ! contre-gradient pour la chaleur sensible: Kelvin/metre
91    
92      !--------------------------------------------------------------------      !--------------------------------------------------------------------
93    
94        knon = size(coefm, 1)
95    
96      ! Prescrire la valeur de contre-gradient      ! Prescrire la valeur de contre-gradient
97      if (iflag_pbl.eq.1) then      if (iflag_pbl.eq.1) then
98         DO k = 3, klev         DO k = 3, klev
# Line 132  contains Line 134  contains
134         z1(i) = zgeop(i, 1)         z1(i) = zgeop(i, 1)
135      ENDDO      ENDDO
136    
137      CALL clcdrag(klon, knon, nsrf, .false., u1, v1, t1, q1, z1, ts, qsurf, &      CALL clcdrag(nsrf, u1, v1, t1, q1, z1, ts, qsurf, rugos, ycdragm, ycdragh)
          rugos, coefm(:, 1), coefh(:, 1))  
138    
139      ! Calculer les coefficients turbulents dans l'atmosphere      ! Calculer les coefficients turbulents dans l'atmosphere
140    
# Line 150  contains Line 151  contains
151    
152            ! calculer Qs et dQs/dT:            ! calculer Qs et dQs/dT:
153    
154            IF (thermcep) THEN            zdelta = RTT >=zt
155               zdelta = RTT >=zt            zcvm5 = merge(R5IES * RLSTT, R5LES * RLVTT, zdelta) / RCPD &
156               zcvm5 = merge(R5IES * RLSTT, R5LES * RLVTT, zdelta) / RCPD &                 / (1. + RVTMP2*zq)
157                    / (1. + RVTMP2*zq)            zqs = R2ES * FOEEW(zt, zdelta) / pplay(i, k)
158               zqs = R2ES * FOEEW(zt, zdelta) / pplay(i, k)            zqs = MIN(0.5, zqs)
159               zqs = MIN(0.5, zqs)            zcor = 1./(1.-RETV*zqs)
160               zcor = 1./(1.-RETV*zqs)            zqs = zqs*zcor
161               zqs = zqs*zcor            zdqs = FOEDE(zt, zdelta, zcvm5, zqs, zcor)
              zdqs = FOEDE(zt, zdelta, zcvm5, zqs, zcor)  
           ELSE  
              IF (zt  <  t_coup) THEN  
                 zqs = qsats(zt) / pplay(i, k)  
                 zdqs = dqsats(zt, zqs)  
              ELSE  
                 zqs = qsatl(zt) / pplay(i, k)  
                 zdqs = dqsatl(zt, zqs)  
              ENDIF  
           ENDIF  
162    
163            ! calculer la fraction nuageuse (processus humide):            ! calculer la fraction nuageuse (processus humide):
164    
Legend:
Removed from v.178  
changed lines
  Added in v.233
  ViewVC Help
Powered by ViewVC 1.1.21