/[lmdze]/trunk/phylmd/Conflx/flxddraf.f
ViewVC logotype

Annotation of /trunk/phylmd/Conflx/flxddraf.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 78 - (hide annotations)
Wed Feb 5 17:51:07 2014 UTC (10 years, 4 months ago) by guez
Original Path: trunk/phylmd/Conflx/flxddraf.f90
File size: 4043 byte(s) 
Moved procedure inigeom into module comgeom.

In disvert, renamed s_sampling to vert_sampling, following
LMDZ. Removed choice strato1. In case read, read ap and bp instead of
s (following LMDZ).

Added argument phis to start_init_orog and start_init_dyn, and removed
variable phis of module start_init_orog_m. In etat0 and
start_init_orog, renamed relief to zmea_2d. In start_init_dyn, renamed
psol to ps.

In start_init_orog, renamed relief_hi to relief. No need to set
phis(iim + 1, :) = phis(1, :), already done in grid_noro.

Documentation for massbar out of SVN, in massbar.txt. Documentation
was duplicated in massdair, but not relevant in massdair.

In conflx, no need to initialize pen_[ud] and pde_[ud]. In flxasc,
used intermediary variable fact (following LMDZ).

In grid_noro, added local variable zmea0 for zmea not smoothed and
computed zphi from zmea instead of zmea0 (following LMDZ). This
changes the results of ce0l.

Removed arguments pen_u and pde_d of phytrac and nflxtr, which were
not used.
1 guez 78 module flxddraf_m
2    
3     IMPLICIT none
4    
5     contains
6    
7     SUBROUTINE flxddraf(ptenh, pqenh, pgeoh, paph, prfl, ptd, pqd, pmfd, pmfds, &
8     pmfdq, pdmfdp, lddraf, pen_d, pde_d)
9    
10     ! This routine calculates cumulus downdraft descent
11    
12     ! To produce the vertical profiles for cumulus downdrafts
13     ! (i.e. T, q, u and v and fluxes)
14    
15     ! Input is T, q, p, Phi, u, v at half levels.
16     ! It returns fluxes of s, q and evaporation rate
17     ! and u, v at levels where downdraft occurs
18    
19     ! Calculate moist descent for entraining/detraining plume by
20     ! A) moving air dry-adiabatically to next level below and
21     ! B) correcting for evaporation to obtain saturated state.
22    
23     USE dimphy, ONLY: klev, klon
24     USE flxadjtq_m, ONLY: flxadjtq
25     USE suphec_m, ONLY: rcpd, rd, retv, rg
26     USE yoecumf, ONLY: cmfcmin, entrdd
27    
28     REAL ptenh(klon, klev), pqenh(klon, klev)
29     REAL, intent(in):: pgeoh(klon, klev), paph(klon, klev + 1)
30     REAL prfl(klon)
31     REAL ptd(klon, klev), pqd(klon, klev)
32     REAL pmfd(klon, klev), pmfds(klon, klev), pmfdq(klon, klev)
33     REAL pdmfdp(klon, klev)
34     LOGICAL lddraf(klon)
35     REAL pen_d(klon, klev), pde_d(klon, klev)
36    
37     ! Local:
38     real zcond(klon)
39     LOGICAL llo2(klon), llo1
40     INTEGER i, k, is, icall, itopde
41     REAL zentr, zseen, zqeen, zsdde, zqdde, zmfdsk, zmfdqk, zdmfdp
42     REAL zbuo
43    
44     !----------------------------------------------------------------------
45    
46     ! Calculate moist descent for cumulus downdraft by
47    
48     ! (A) calculating entrainment rates, assuming linear decrease of
49     ! massflux in PBL
50    
51     ! (B) doing moist descent - evaporative cooling and moistening is
52     ! calculated in flxadjtq
53    
54     ! (C) checking for negative buoyancy and specifying final T, q, u,
55     ! v and downward fluxes
56    
57     DO k = 3, klev
58     is = 0
59     DO i = 1, klon
60     llo2(i)=lddraf(i).AND.pmfd(i, k-1).LT.0.
61     IF (llo2(i)) is = is + 1
62     ENDDO
63     IF (is.EQ.0) cycle
64    
65     DO i = 1, klon
66     IF (llo2(i)) THEN
67     zentr = ENTRDD*pmfd(i, k-1)*RD*ptenh(i, k-1)/ &
68     (RG*paph(i, k-1))*(paph(i, k)-paph(i, k-1))
69     pen_d(i, k) = zentr
70     pde_d(i, k) = zentr
71     ENDIF
72     ENDDO
73    
74     itopde = klev-2
75     IF (k.GT.itopde) THEN
76     DO i = 1, klon
77     IF (llo2(i)) THEN
78     pen_d(i, k)=0.
79     pde_d(i, k) = pmfd(i, itopde) * (paph(i, k) - paph(i, k - 1)) &
80     / (paph(i, klev + 1) - paph(i, itopde))
81     ENDIF
82     ENDDO
83     ENDIF
84    
85     DO i = 1, klon
86     IF (llo2(i)) THEN
87     pmfd(i, k) = pmfd(i, k-1) + pen_d(i, k)-pde_d(i, k)
88     zseen = (RCPD*ptenh(i, k-1) + pgeoh(i, k-1))*pen_d(i, k)
89     zqeen = pqenh(i, k-1)*pen_d(i, k)
90     zsdde = (RCPD*ptd(i, k-1) + pgeoh(i, k-1))*pde_d(i, k)
91     zqdde = pqd(i, k-1)*pde_d(i, k)
92     zmfdsk = pmfds(i, k-1) + zseen-zsdde
93     zmfdqk = pmfdq(i, k-1) + zqeen-zqdde
94     pqd(i, k) = zmfdqk*(1./MIN(-CMFCMIN, pmfd(i, k)))
95     ptd(i, k) = (zmfdsk*(1./MIN(-CMFCMIN, pmfd(i, k)))- &
96     pgeoh(i, k))/RCPD
97     ptd(i, k) = MIN(400., ptd(i, k))
98     ptd(i, k) = MAX(100., ptd(i, k))
99     zcond(i) = pqd(i, k)
100     ENDIF
101     ENDDO
102    
103     icall = 2
104     CALL flxadjtq(paph(:, k), ptd(1, k), pqd(1, k), llo2, icall)
105    
106     DO i = 1, klon
107     IF (llo2(i)) THEN
108     zcond(i) = zcond(i)-pqd(i, k)
109     zbuo = ptd(i, k)*(1. + RETV *pqd(i, k))- &
110     ptenh(i, k)*(1. + RETV *pqenh(i, k))
111     llo1 = zbuo.LT.0..AND.(prfl(i)-pmfd(i, k)*zcond(i).GT.0.)
112     IF (.not.llo1) pmfd(i, k) = 0.0
113     pmfds(i, k) = (RCPD*ptd(i, k) + pgeoh(i, k))*pmfd(i, k)
114     pmfdq(i, k) = pqd(i, k)*pmfd(i, k)
115     zdmfdp = -pmfd(i, k)*zcond(i)
116     pdmfdp(i, k-1) = zdmfdp
117     prfl(i) = prfl(i) + zdmfdp
118     ENDIF
119     ENDDO
120     end DO
121    
122     END SUBROUTINE flxddraf
123    
124     end module flxddraf_m
  ViewVC Help
Powered by ViewVC 1.1.21