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

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

Parent Directory | Revision Log | View Patch Patch

-trunk/libf/phylmd/coefkz.f90
revision 71 by guez,
Mon Jul  8 18:12:18 2013 UTC
+trunk/Sources/phylmd/coefkz.f
revision 229 by guez,
Mon Nov  6 17:20:45 2017 UTC
 Line 4 
 module coefkz_m
  contains
-   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, &
-        t, q, qsurf, coefm, coefh)
+        q, qsurf, coefm, coefh)
      ! Authors: F. Hourdin, M. Forichon, Z. X. Li (LMD/CNRS)
-     ! date: 1993/09/22
+     ! Date: September 22nd, 1993
      ! Objet : calculer le coefficient de frottement du sol ("Cdrag") et les
      ! coefficients d'échange turbulent dans l'atmosphère.
-     USE indicesol, ONLY: is_oce
+     use clcdrag_m, only: clcdrag
+     USE conf_phys_m, ONLY: iflag_pbl
      USE dimphy, ONLY: klev, klon
-     USE conf_gcm_m, ONLY: prt_level
+     USE fcttre, ONLY: foede, foeew
+     USE indicesol, ONLY: is_oce
      USE suphec_m, ONLY: rcpd, rd, retv, rg, rkappa, rlstt, rlvtt, rtt
      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:
      integer, intent(in):: nsrf ! indicateur de la nature du sol
-     INTEGER, intent(in):: knon ! nombre de points a traiter
-     REAL, intent(in):: paprs(klon, klev+1)
+     REAL, intent(in):: paprs(:, :) ! (klon, klev+1)
      ! pression a chaque intercouche (en Pa)
-     real, intent(in):: pplay(klon, klev)
+     real, intent(in):: pplay(:, :) ! (klon, klev)
      ! pression au milieu de chaque couche (en Pa)
      REAL, intent(in):: ksta, ksta_ter
-     REAL, intent(in):: ts(klon) ! temperature du sol (en Kelvin)
+     REAL, intent(in):: ts(:) ! (knon) temperature du sol (en Kelvin)
-     REAL, intent(in):: rugos(klon) ! longeur de rugosite (en m)
+     REAL, intent(in):: rugos(:) ! (klon) longeur de rugosite (en m)
-     REAL, intent(in):: u(klon, klev), v(klon, klev) ! wind
+     REAL, intent(in):: u(:, :), v(:, :) ! (klon, klev) wind
-     REAL, intent(in):: t(klon, klev) ! temperature (K)
+     REAL, intent(in):: t(:, :) ! (klon, klev) temperature (K)
-     real, intent(in):: q(klon, klev) ! vapeur d'eau (kg/kg)
+     real, intent(in):: q(:, :) ! (klon, klev) vapeur d'eau (kg/kg)
-     real, intent(in):: qsurf(klon)
+     real, intent(in):: qsurf(:) ! (knon)
      REAL, intent(out):: coefm(:, :) ! (knon, klev) coefficient, vitesse
      real, intent(out):: coefh(:, :) ! (knon, klev)
-Line 46 
 contains
+Line 42 
 contains
      ! Local:
-     INTEGER itop(knon) ! numero de couche du sommet de la couche limite
+     INTEGER knon ! nombre de points a traiter
+     INTEGER itop(size(coefm, 1)) ! (knon) numero de couche du sommet
+                                  ! de la couche limite
      ! Quelques constantes et options:
-Line 57 
 contains
+Line 55 
 contains
      REAL, PARAMETER:: cd = 5.
      REAL, PARAMETER:: clam = 160.
      REAL, PARAMETER:: ratqs = 0.05 ! largeur de distribution de vapeur d'eau
      LOGICAL, PARAMETER:: richum = .TRUE.
      ! utilise le nombre de Richardson humide
-Line 74 
 contains
+Line 72 
 contains
      LOGICAL, PARAMETER:: opt_ec = .FALSE.
      ! formule du Centre Europeen dans l'atmosphere
-     INTEGER i, k, kk
+     INTEGER i, k
      REAL zgeop(klon, klev)
      REAL zmgeom(klon)
      REAL ri(klon)
-Line 84 
 contains
+Line 82 
 contains
      REAL zdphi, zdu2, ztvd, ztvu, cdn
      REAL scf
-     REAL zt, zq, zdelta, zcvm5, zcor, zqs, zfr, zdqs
+     REAL zt, zq, zcvm5, zcor, zqs, zfr, zdqs
+     logical zdelta
      REAL z2geomf, zalh2, alm2, zscfh, scfm
-     REAL, PARAMETER:: t_coup = 273.15
      REAL gamt(2:klev) ! contre-gradient pour la chaleur sensible: Kelvin/metre
      !--------------------------------------------------------------------
+     knon = size(coefm, 1)
      ! Prescrire la valeur de contre-gradient
      if (iflag_pbl.eq.1) then
         DO k = 3, klev
 Line 132 
 contains
         z1(i) = zgeop(i, 1)
      ENDDO
-     CALL clcdrag(klon, knon, nsrf, .false., u1, v1, t1, q1, z1, ts, qsurf, &
+     CALL clcdrag(nsrf, u1, v1, t1, q1, z1, ts, qsurf, rugos, coefm(:, 1), &
-          rugos, coefm(:, 1), coefh(:, 1))
+          coefh(:, 1))
      ! Calculer les coefficients turbulents dans l'atmosphere
 Line 150 
 contains
            ! calculer Qs et dQs/dT:
-           IF (thermcep) THEN
+           zdelta = RTT >=zt
-              zdelta = MAX(0., SIGN(1., RTT-zt))
+           zcvm5 = merge(R5IES * RLSTT, R5LES * RLVTT, zdelta) / RCPD &
-              zcvm5 = R5LES*RLVTT/RCPD/(1.0+RVTMP2*zq)*(1.-zdelta)  &
+                / (1. + RVTMP2*zq)
-                   + R5IES*RLSTT/RCPD/(1.0+RVTMP2*zq)*zdelta
+           zqs = R2ES * FOEEW(zt, zdelta) / pplay(i, k)
-              zqs = R2ES * FOEEW(zt, zdelta) / pplay(i, k)
+           zqs = MIN(0.5, zqs)
-              zqs = MIN(0.5, zqs)
+           zcor = 1./(1.-RETV*zqs)
-              zcor = 1./(1.-RETV*zqs)
+           zqs = zqs*zcor
-              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
            ! calculer la fraction nuageuse (processus humide):

 Legend:



Removed from v.71
 


changed lines


 
Added in v.229
 Legend:



Removed from v.71
 


changed lines


 
Added in v.229
-Removed from v.71
+Added in v.229

	ViewVC Help
Powered by ViewVC 1.1.21