/[lmdze]/trunk/phylmd/Interface_surf/hbtm.f90
ViewVC logotype

Diff of /trunk/phylmd/Interface_surf/hbtm.f90

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

trunk/libf/phylmd/hbtm.f90 revision 37 by guez, Tue Dec 21 15:45:48 2010 UTC trunk/Sources/phylmd/hbtm.f revision 149 by guez, Thu Jun 18 12:23:44 2015 UTC
# Line 4  module HBTM_m Line 4  module HBTM_m
4    
5  contains  contains
6    
7    SUBROUTINE HBTM(knon, paprs, pplay, t2m, t10m, q2m, q10m, ustar, flux_t, &    SUBROUTINE HBTM(knon, paprs, pplay, t2m, q2m, ustar, flux_t, &
8         flux_q, u, v, t, q, pblh, cape, EauLiq, ctei, pblT, therm, trmb1, &         flux_q, u, v, t, q, pblh, cape, EauLiq, ctei, pblT, therm, trmb1, &
9         trmb2, trmb3, plcl)         trmb2, trmb3, plcl)
10    
11      use dimens_m      ! D'apr\'es Holstag et Boville et Troen et Mahrt
     use dimphy  
     use YOMCST  
     use yoethf  
     use fcttre  
   
     ! D'apres Holstag & Boville et Troen & Mahrt  
12      ! JAS 47 BLM      ! JAS 47 BLM
13      ! Algorithme thèse Anne Mathieu      ! Algorithme th\'ese Anne Mathieu
14      ! Critère d'entraînement Peter Duynkerke (JAS 50)      ! Crit\'ere d'entra\^inement Peter Duynkerke (JAS 50)
15      ! written by: Anne MATHIEU and Alain LAHELLEC, 22nd November 1999      ! written by: Anne MATHIEU and Alain LAHELLEC, 22nd November 1999
16      ! features : implem. exces Mathieu      ! features : implem. exces Mathieu
17    
# Line 29  contains Line 23  contains
23    
24      ! fin therm a la HBTM passage a forme Mathieu 12/09/2001      ! fin therm a la HBTM passage a forme Mathieu 12/09/2001
25    
26      ! Adaptation a LMDZ version couplee      ! Adaptation a LMDZ version couplee Pour le moment on fait passer
27      ! Pour le moment on fait passer en argument les grandeurs de surface :      ! en argument les grandeurs de surface : flux, t, q2m, t, on va
28      ! flux, t, q2m, t, q10m, on va utiliser systematiquement les grandeurs a 2m      ! utiliser systematiquement les grandeurs a 2m mais on garde la
29      ! mais on garde la possibilité de changer si besoin est (jusqu'à présent      ! possibilit\'e de changer si besoin est (jusqu'à pr\'esent la
30      ! la forme de HB avec le 1er niveau modele etait conservee)      ! forme de HB avec le 1er niveau modele etait conservee)
31    
32        USE dimphy, ONLY: klev, klon
33        USE suphec_m, ONLY: rcpd, rd, retv, rg, rkappa, rlvtt, rtt, rv
34        USE yoethf_m, ONLY: r2es, rvtmp2
35        USE fcttre, ONLY: foeew
36    
37      REAL RLvCp, REPS      REAL RLvCp, REPS
38      ! Arguments:      ! Arguments:
# Line 42  contains Line 41  contains
41      INTEGER, intent(in):: knon      INTEGER, intent(in):: knon
42    
43      REAL, intent(in):: t2m(klon) ! temperature a 2 m      REAL, intent(in):: t2m(klon) ! temperature a 2 m
     real t10m(klon) ! temperature a 10 m  
44      ! q a 2 et 10m      ! q a 2 et 10m
45      REAL q2m(klon), q10m(klon)      REAL q2m(klon)
46      REAL ustar(klon)      REAL ustar(klon)
47      ! pression a inter-couche (Pa)      ! pression a inter-couche (Pa)
48      REAL paprs(klon, klev+1)      REAL paprs(klon, klev+1)
# Line 165  contains Line 163  contains
163      REAL EauLiq(klon)      REAL EauLiq(klon)
164      ! Critere d'instab d'entrainmt des nuages de      ! Critere d'instab d'entrainmt des nuages de
165      REAL ctei(klon)      REAL ctei(klon)
166      REAL the1, the2, aa, zthvd, zthvu, xintpos, qqsat      REAL aa, zthvd, zthvu, qqsat
167      REAL a1, a2, a3      REAL a1, a2, a3
168      REAL xhis, rnum, th1, thv1, thv2, ql2      REAL t2
     REAL qsat2, qT1, q2, t1, t2, xnull  
     REAL quadsat, spblh, reduc  
169    
170      ! inverse phi function for momentum      ! inverse phi function for momentum
171      REAL phiminv(klon)      REAL phiminv(klon)
# Line 199  contains Line 195  contains
195      REAL zm(klon)      REAL zm(klon)
196      ! current level height + one level up      ! current level height + one level up
197      REAL zp(klon)      REAL zp(klon)
198      REAL zcor, zdelta, zcvm5      REAL zcor
199    
200      REAL fac, pblmin, zmzp, term      REAL fac, pblmin, zmzp, term
201    
# Line 447  contains Line 443  contains
443    
444      ! Main level loop to compute the diffusivities and      ! Main level loop to compute the diffusivities and
445      ! counter-gradient terms:      ! counter-gradient terms:
446      DO k = 2, isommet      loop_level: DO k = 2, isommet
447         ! Find levels within boundary layer:         ! Find levels within boundary layer:
448         DO i = 1, knon         DO i = 1, knon
449            unslev(i) = .FALSE.            unslev(i) = .FALSE.
# Line 517  contains Line 513  contains
513    
514         ! For all layers, compute integral info and CTEI         ! For all layers, compute integral info and CTEI
515         DO i = 1, knon         DO i = 1, knon
516            if (check(i).or.omegafl(i)) then            if (check(i) .or. omegafl(i)) then
517               if (.not.Zsat(i)) then               if (.not. Zsat(i)) then
518                  T2 = T2m(i) * s(i, k)                  T2 = T2m(i) * s(i, k)
519                  ! thermodyn functions                  ! thermodyn functions
520                  zdelta=MAX(0., SIGN(1., RTT - T2))                  qqsat= r2es * FOEEW(T2, RTT >= T2) / pplay(i, k)
                 qqsat= r2es * FOEEW(T2, zdelta) / pplay(i, k)  
521                  qqsat=MIN(0.5, qqsat)                  qqsat=MIN(0.5, qqsat)
522                  zcor=1./(1.-retv*qqsat)                  zcor=1./(1.-retv*qqsat)
523                  qqsat=qqsat*zcor                  qqsat=qqsat*zcor
# Line 543  contains Line 538  contains
538               ! cette ligne a deja ete faite normalement ?               ! cette ligne a deja ete faite normalement ?
539            endif            endif
540         ENDDO         ENDDO
541      end DO      end DO loop_level
542    
543    END SUBROUTINE HBTM    END SUBROUTINE HBTM
544    
Legend:
Removed from v.37  
changed lines
  Added in v.149
  ViewVC Help
Powered by ViewVC 1.1.21