/[lmdze]/trunk/libf/phylmd/conema3.f90
ViewVC logotype

Diff of /trunk/libf/phylmd/conema3.f90

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

trunk/libf/phylmd/conema3.f revision 51 by guez, Thu Jan 6 17:52:19 2011 UTC trunk/libf/phylmd/conema3.f90 revision 52 by guez, Fri Sep 23 12:28:01 2011 UTC
# Line 1  Line 1 
1  !  SUBROUTINE conema3 (dtime,paprs,pplay,t,q,u,v,tra,ntra, &
2  ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/conema3.F,v 1.1.1.1 2004/05/19 12:53:09 lmdzadmin Exp $       work1,work2,d_t,d_q,d_u,d_v,d_tra, &
3  !       rain, snow, kbas, ktop, &
4        SUBROUTINE conema3 (dtime,paprs,pplay,t,q,u,v,tra,ntra,       upwd,dnwd,dnwdbis,bas,top,Ma,cape,tvp,rflag, &
5       .             work1,work2,d_t,d_q,d_u,d_v,d_tra,       pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr, &
6       .             rain, snow, kbas, ktop,       qcond_incld)
7       .             upwd,dnwd,dnwdbis,bas,top,Ma,cape,tvp,rflag,  
8       .             pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,    ! From LMDZ4/libf/phylmd/conema3.F,v 1.1.1.1 2004/05/19 12:53:09
9       .             qcond_incld)  
10      use dimens_m
11        use dimens_m    use dimphy
12        use dimphy    use SUPHEC_M
13        use SUPHEC_M    use conema3_m
14        use conema3_m    use yoethf_m
15        use yoethf_m    use fcttre
16        use fcttre    IMPLICIT none
17        IMPLICIT none    !======================================================================
18  c======================================================================    ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
19  c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818    ! Objet: schema de convection de Emanuel (1991) interface
20  c Objet: schema de convection de Emanuel (1991) interface    ! Mai 1998: Interface modifiee pour implementation dans LMDZ
21  c Mai 1998: Interface modifiee pour implementation dans LMDZ    !======================================================================
22  c======================================================================    ! Arguments:
23  c Arguments:    ! dtime---input-R-pas d'integration (s)
24  c dtime---input-R-pas d'integration (s)    ! paprs---input-R-pression inter-couches (Pa)
25  c paprs---input-R-pression inter-couches (Pa)    ! pplay---input-R-pression au milieu des couches (Pa)
26  c pplay---input-R-pression au milieu des couches (Pa)    ! t-------input-R-temperature (K)
27  c t-------input-R-temperature (K)    ! q-------input-R-humidite specifique (kg/kg)
28  c q-------input-R-humidite specifique (kg/kg)    ! u-------input-R-vitesse du vent zonal (m/s)
29  c u-------input-R-vitesse du vent zonal (m/s)    ! v-------input-R-vitesse duvent meridien (m/s)
30  c v-------input-R-vitesse duvent meridien (m/s)    ! tra-----input-R-tableau de rapport de melange des traceurs
31  c tra-----input-R-tableau de rapport de melange des traceurs    ! work*: input et output: deux variables de travail,
32  c work*: input et output: deux variables de travail,    !                            on peut les mettre a 0 au debut
33  c                            on peut les mettre a 0 au debut    !
34  c    ! d_t-----output-R-increment de la temperature
35  C d_t-----output-R-increment de la temperature    ! d_q-----output-R-increment de la vapeur d'eau
36  c d_q-----output-R-increment de la vapeur d'eau    ! d_u-----output-R-increment de la vitesse zonale
37  c d_u-----output-R-increment de la vitesse zonale    ! d_v-----output-R-increment de la vitesse meridienne
38  c d_v-----output-R-increment de la vitesse meridienne    ! d_tra---output-R-increment du contenu en traceurs
39  c d_tra---output-R-increment du contenu en traceurs    ! rain----output-R-la pluie (mm/s)
40  c rain----output-R-la pluie (mm/s)    ! snow----output-R-la neige (mm/s)
41  c snow----output-R-la neige (mm/s)    ! kbas----output-R-bas du nuage (integer)
42  c kbas----output-R-bas du nuage (integer)    ! ktop----output-R-haut du nuage (integer)
43  c ktop----output-R-haut du nuage (integer)    ! upwd----output-R-saturated updraft mass flux (kg/m**2/s)
44  c upwd----output-R-saturated updraft mass flux (kg/m**2/s)    ! dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)
45  c dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)    ! dnwdbis-output-R-unsaturated downdraft mass flux (kg/m**2/s)
46  c dnwdbis-output-R-unsaturated downdraft mass flux (kg/m**2/s)    ! bas-----output-R-bas du nuage (real)
47  c bas-----output-R-bas du nuage (real)    ! top-----output-R-haut du nuage (real)
48  c top-----output-R-haut du nuage (real)    ! Ma------output-R-flux ascendant non dilue (kg/m**2/s)
49  c Ma------output-R-flux ascendant non dilue (kg/m**2/s)    ! cape----output-R-CAPE
50  c cape----output-R-CAPE    ! tvp-----output-R-virtual temperature of the lifted parcel
51  c tvp-----output-R-virtual temperature of the lifted parcel    ! rflag---output-R-flag sur le fonctionnement de convect
52  c rflag---output-R-flag sur le fonctionnement de convect    ! pbase---output-R-pression a la base du nuage (Pa)
53  c pbase---output-R-pression a la base du nuage (Pa)    ! bbase---output-R-buoyancy a la base du nuage (K)
54  c bbase---output-R-buoyancy a la base du nuage (K)    ! dtvpdt1-output-R-derivative of parcel virtual temp wrt T1
55  c dtvpdt1-output-R-derivative of parcel virtual temp wrt T1    ! dtvpdq1-output-R-derivative of parcel virtual temp wrt Q1
56  c dtvpdq1-output-R-derivative of parcel virtual temp wrt Q1    ! dplcldt-output-R-derivative of the PCP pressure wrt T1
57  c dplcldt-output-R-derivative of the PCP pressure wrt T1    ! dplcldr-output-R-derivative of the PCP pressure wrt Q1
58  c dplcldr-output-R-derivative of the PCP pressure wrt Q1    !======================================================================
59  c======================================================================    !
60  c    INTEGER i, l,m,itra
61        INTEGER i, l,m,itra    INTEGER ntra,ntrac !number of tracers; if no tracer transport
62        INTEGER ntra,ntrac !number of tracers; if no tracer transport    ! is needed, set ntra = 1 (or 0)
63                           ! is needed, set ntra = 1 (or 0)    PARAMETER (ntrac=nqmx-2)
64        PARAMETER (ntrac=nqmx-2)    REAL, intent(in):: dtime
65        REAL, intent(in):: dtime    !
66  c    REAL d_t2(klon,klev), d_q2(klon,klev) ! sbl
67        REAL d_t2(klon,klev), d_q2(klon,klev) ! sbl    REAL d_u2(klon,klev), d_v2(klon,klev) ! sbl
68        REAL d_u2(klon,klev), d_v2(klon,klev) ! sbl    REAL em_d_t2(klev), em_d_q2(klev)     ! sbl  
69        REAL em_d_t2(klev), em_d_q2(klev)     ! sbl      REAL em_d_u2(klev), em_d_v2(klev)     ! sbl  
70        REAL em_d_u2(klev), em_d_v2(klev)     ! sbl      !
71  c    REAL, intent(in):: paprs(klon,klev+1)
72        REAL, intent(in):: paprs(klon,klev+1)    real, intent(in):: pplay(klon,klev)
73        real, intent(in):: pplay(klon,klev)    REAL, intent(in):: t(klon,klev)
74        REAL t(klon,klev), q(klon,klev), d_t(klon,klev), d_q(klon,klev)    real q(klon,klev), d_t(klon,klev), d_q(klon,klev)
75        REAL u(klon,klev), v(klon,klev)    REAL u(klon,klev), v(klon,klev)
76        real, intent(in):: tra(klon,klev,ntra)    real, intent(in):: tra(klon,klev,ntra)
77        REAL d_u(klon,klev), d_v(klon,klev), d_tra(klon,klev,ntra)    REAL d_u(klon,klev), d_v(klon,klev), d_tra(klon,klev,ntra)
78        REAL work1(klon,klev), work2(klon,klev)    REAL work1(klon,klev), work2(klon,klev)
79        REAL upwd(klon,klev), dnwd(klon,klev), dnwdbis(klon,klev)    REAL upwd(klon,klev), dnwd(klon,klev), dnwdbis(klon,klev)
80        REAL rain(klon)    REAL rain(klon)
81        REAL snow(klon)    REAL snow(klon)
82        REAL cape(klon), tvp(klon,klev), rflag(klon)    REAL cape(klon), tvp(klon,klev), rflag(klon)
83        REAL pbase(klon), bbase(klon)    REAL pbase(klon), bbase(klon)
84        REAL dtvpdt1(klon,klev), dtvpdq1(klon,klev)    REAL dtvpdt1(klon,klev), dtvpdq1(klon,klev)
85        REAL dplcldt(klon), dplcldr(klon)    REAL dplcldt(klon), dplcldr(klon)
86        INTEGER kbas(klon), ktop(klon)    INTEGER kbas(klon), ktop(klon)
87    
88        REAL wd(klon)    REAL wd(klon)
89        REAL qcond_incld(klon,klev)    REAL qcond_incld(klon,klev)
90  c    !
91        REAL em_t(klev)    REAL em_t(klev)
92        REAL em_q(klev)    REAL em_q(klev)
93        REAL em_qs(klev)    REAL em_qs(klev)
94        REAL em_u(klev), em_v(klev), em_tra(klev,ntrac)    REAL em_u(klev), em_v(klev), em_tra(klev,ntrac)
95        REAL em_ph(klev+1), em_p(klev)    REAL em_ph(klev+1), em_p(klev)
96        REAL em_work1(klev), em_work2(klev)    REAL em_work1(klev), em_work2(klev)
97        REAL em_precip, em_d_t(klev), em_d_q(klev)    REAL em_precip, em_d_t(klev), em_d_q(klev)
98        REAL em_d_u(klev), em_d_v(klev), em_d_tra(klev,ntrac)    REAL em_d_u(klev), em_d_v(klev), em_d_tra(klev,ntrac)
99        REAL em_upwd(klev), em_dnwd(klev), em_dnwdbis(klev)    REAL em_upwd(klev), em_dnwd(klev), em_dnwdbis(klev)
100        REAL em_dtvpdt1(klev), em_dtvpdq1(klev)    REAL em_dtvpdt1(klev), em_dtvpdq1(klev)
101        REAL em_dplcldt, em_dplcldr    REAL em_dplcldt, em_dplcldr
102        SAVE em_t,em_q, em_qs, em_ph, em_p, em_work1, em_work2    SAVE em_t,em_q, em_qs, em_ph, em_p, em_work1, em_work2
103        SAVE em_u,em_v, em_tra    SAVE em_u,em_v, em_tra
104        SAVE em_d_u,em_d_v, em_d_tra    SAVE em_d_u,em_d_v, em_d_tra
105        SAVE em_precip, em_d_t, em_d_q, em_upwd, em_dnwd, em_dnwdbis    SAVE em_precip, em_d_t, em_d_q, em_upwd, em_dnwd, em_dnwdbis
106        INTEGER em_bas, em_top    INTEGER em_bas, em_top
107        SAVE em_bas, em_top    SAVE em_bas, em_top
108    
109        REAL em_wd    REAL em_wd
110        REAL em_qcond(klev)    REAL em_qcond(klev)
111        REAL em_qcondc(klev)    REAL em_qcondc(klev)
112  c    !
113        REAL zx_t, zx_qs, zdelta, zcor    REAL zx_t, zx_qs, zdelta, zcor
114        INTEGER iflag    INTEGER iflag
115        REAL sigsum    REAL sigsum
116  ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc    !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
117  c     VARIABLES A SORTIR    !     VARIABLES A SORTIR
118  cccccccccccccccccccccccccccccccccccccccccccccccccc    !ccccccccccccccccccccccccccccccccccccccccccccccccc
119    
120        REAL emmip(klev) !variation de flux ascnon dilue i et i+1    REAL emmip(klev) !variation de flux ascnon dilue i et i+1
121        SAVE emmip    SAVE emmip
122        real emMke(klev)    real emMke(klev)
123        save emMke    save emMke
124        real top    real top
125        real bas    real bas
126        real emMa(klev)    real emMa(klev)
127        save emMa    save emMa
128        real Ma(klon,klev)    real Ma(klon,klev)
129        real Ment(klev,klev)    real Ment(klev,klev)
130        real Qent(klev,klev)    real Qent(klev,klev)
131        real TPS(klev),TLS(klev)    real TPS(klev),TLS(klev)
132        real SIJ(klev,klev)    real SIJ(klev,klev)
133        real em_CAPE, em_TVP(klev)    real em_CAPE, em_TVP(klev)
134        real em_pbase, em_bbase    real em_pbase, em_bbase
135        integer iw,j,k,ix,iy    integer iw,j,k,ix,iy
136    
137  c -- sb: pour schema nuages:    ! -- sb: pour schema nuages:
138    
139         integer iflagcon    integer iflagcon
140         integer em_ifc(klev)    integer em_ifc(klev)
141        
142         real em_pradj    real em_pradj
143         real em_cldf(klev), em_cldq(klev)    real em_cldf(klev), em_cldq(klev)
144         real em_ftadj(klev), em_fradj(klev)    real em_ftadj(klev), em_fradj(klev)
145    
146         integer ifc(klon,klev)    integer ifc(klon,klev)
147         real pradj(klon)    real pradj(klon)
148         real cldf(klon,klev), cldq(klon,klev)    real cldf(klon,klev), cldq(klon,klev)
149         real ftadj(klon,klev), fqadj(klon,klev)    real ftadj(klon,klev), fqadj(klon,klev)
150    
151  c sb --    ! sb --
152    
153  ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc    !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
154  c    !
155    
156        qcond_incld(:,:) = 0.    qcond_incld(:,:) = 0.
157  c    !
158  c$$$      print*,'debut conema'    !$$$      print*,'debut conema'
159    
160        DO 999 i = 1, klon    DO i = 1, klon
161        DO l = 1, klev+1       DO l = 1, klev+1
162           em_ph(l) = paprs(i,l) / 100.0          em_ph(l) = paprs(i,l) / 100.0
163        ENDDO       ENDDO
164  c       !
165        DO l = 1, klev       DO l = 1, klev
166           em_p(l) = pplay(i,l) / 100.0          em_p(l) = pplay(i,l) / 100.0
167           em_t(l) = t(i,l)          em_t(l) = t(i,l)
168           em_q(l) = q(i,l)          em_q(l) = q(i,l)
169           em_u(l) = u(i,l)          em_u(l) = u(i,l)
170           em_v(l) = v(i,l)          em_v(l) = v(i,l)
171           do itra = 1, ntra          do itra = 1, ntra
172            em_tra(l,itra) = tra(i,l,itra)             em_tra(l,itra) = tra(i,l,itra)
          enddo  
 c$$$      print*,'em_t',em_t  
 c$$$      print*,'em_q',em_q  
 c$$$      print*,'em_qs',em_qs  
 c$$$      print*,'em_u',em_u  
 c$$$      print*,'em_v',em_v  
 c$$$      print*,'em_tra',em_tra  
 c$$$      print*,'em_p',em_p  
   
   
 c  
          zx_t = em_t(l)  
          zdelta=MAX(0.,SIGN(1.,rtt-zx_t))  
          zx_qs= r2es * FOEEW(zx_t,zdelta)/em_p(l)/100.0  
          zx_qs=MIN(0.5,zx_qs)  
 c$$$       print*,'zx_qs',zx_qs  
          zcor=1./(1.-retv*zx_qs)  
          zx_qs=zx_qs*zcor  
          em_qs(l) = zx_qs  
 c$$$      print*,'em_qs',em_qs  
 c  
          em_work1(l) = work1(i,l)  
          em_work2(l) = work2(i,l)  
          emMke(l)=0  
 c        emMa(l)=0  
 c        Ma(i,l)=0  
       
          em_dtvpdt1(l) = 0.  
          em_dtvpdq1(l) = 0.  
          dtvpdt1(i,l) = 0.  
          dtvpdq1(i,l) = 0.  
       ENDDO  
 c  
       em_dplcldt = 0.  
       em_dplcldr = 0.  
       rain(i) = 0.0  
       snow(i) = 0.0  
       kbas(i) = 1  
       ktop(i) = 1  
 c ajout SB:  
       bas = 1  
       top = 1  
   
   
 c sb3d      write(*,1792) (em_work1(m),m=1,klev)  
 1792  format('sig avant convect ',/,10(1X,E13.5))  
 c  
 c sb d      write(*,1793) (em_work2(m),m=1,klev)  
 1793  format('w avant convect ',/,10(1X,E13.5))  
   
 c$$$      print*,'avant convect'  
 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc  
 c  
   
 c     print*,'avant convect i=',i  
       CALL convect3(dtime,epmax,ok_adj_ema,  
      .              em_t, em_q, em_qs,em_u ,em_v ,  
      .              em_tra, em_p, em_ph,  
      .              klev, klev+1, klev-1,ntra, dtime, iflag,  
      .              em_d_t, em_d_q,em_d_u,em_d_v,  
      .              em_d_tra, em_precip,  
      .              em_bas, em_top,em_upwd, em_dnwd, em_dnwdbis,  
      .              em_work1, em_work2,emmip,emMke,emMa,Ment,  
      .  Qent,TPS,TLS,SIJ,em_CAPE,em_TVP,em_pbase,em_bbase,  
      .  em_dtvpdt1,em_dtvpdq1,em_dplcldt,em_dplcldr, ! sbl  
      .  em_d_t2,em_d_q2,em_d_u2,em_d_v2,em_wd,em_qcond,em_qcondc)!sbl  
 c     print*,'apres convect '  
 c  
 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc  
 c  
 c -- sb: Appel schema statistique de nuages couple a la convection  
 c (Bony et Emanuel 2001):  
   
 c -- creer cvthermo.h qui contiendra les cstes thermo de LMDZ:  
   
         iflagcon = 3  
 c       CALL cv_thermo(iflagcon)  
   
 c -- appel schema de nuages:  
   
         do k = 1, klev  
          cldf(i,k)  = em_cldf(k)  ! cloud fraction (0-1)  
          cldq(i,k)  = em_cldq(k)  ! in-cloud water content (kg/kg)  
          ftadj(i,k) = em_ftadj(k) ! (dT/dt)_{LS adj} (K/s)  
          fqadj(i,k) = em_fradj(k) ! (dq/dt)_{LS adj} (kg/kg/s)  
          ifc(i,k)   = em_ifc(k)   ! flag convergence clouds_gno (1 ou 2)  
173          enddo          enddo
174          pradj(i) = em_pradj       ! precip from LS supersat adj (mm/day)          !$$$      print*,'em_t',em_t
175            !$$$      print*,'em_q',em_q
176  c sb --          !$$$      print*,'em_qs',em_qs
177  c          !$$$      print*,'em_u',em_u
178  c SB:          !$$$      print*,'em_v',em_v
179        if (iflag.ne.1 .and. iflag.ne.4) then          !$$$      print*,'em_tra',em_tra
180           em_CAPE = 0.          !$$$      print*,'em_p',em_p
181        do l = 1, klev  
182           em_upwd(l) = 0.  
183           em_dnwd(l) = 0.          !
184           em_dnwdbis(l) = 0.          zx_t = em_t(l)
185           emMa(l) = 0.          zdelta=MAX(0.,SIGN(1.,rtt-zx_t))
186           em_TVP(l) = 0.          zx_qs= r2es * FOEEW(zx_t,zdelta)/em_p(l)/100.0
187        enddo          zx_qs=MIN(0.5,zx_qs)
188        endif          !$$$       print*,'zx_qs',zx_qs
189  c fin SB          zcor=1./(1.-retv*zx_qs)
190  c          zx_qs=zx_qs*zcor
191  c  If sig has been set to zero, then set Ma to zero          em_qs(l) = zx_qs
192  c          !$$$      print*,'em_qs',em_qs
193        sigsum = 0.          !
194        do k = 1,klev          em_work1(l) = work1(i,l)
195            em_work2(l) = work2(i,l)
196            emMke(l)=0
197            !        emMa(l)=0
198            !        Ma(i,l)=0
199    
200            em_dtvpdt1(l) = 0.
201            em_dtvpdq1(l) = 0.
202            dtvpdt1(i,l) = 0.
203            dtvpdq1(i,l) = 0.
204         ENDDO
205         !
206         em_dplcldt = 0.
207         em_dplcldr = 0.
208         rain(i) = 0.0
209         snow(i) = 0.0
210         kbas(i) = 1
211         ktop(i) = 1
212         ! ajout SB:
213         bas = 1
214         top = 1
215    
216    
217         ! sb3d      write(*,1792) (em_work1(m),m=1,klev)
218    1792 format('sig avant convect ',/,10(1X,E13.5))
219         !
220         ! sb d      write(*,1793) (em_work2(m),m=1,klev)
221    1793 format('w avant convect ',/,10(1X,E13.5))
222    
223         !$$$      print*,'avant convect'
224         !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
225         !
226    
227         !     print*,'avant convect i=',i
228         CALL convect3(dtime,epmax,ok_adj_ema, &
229              em_t, em_q, em_qs,em_u ,em_v , &
230              em_tra, em_p, em_ph, &
231              klev, klev+1, klev-1,ntra, dtime, iflag, &
232              em_d_t, em_d_q,em_d_u,em_d_v, &
233              em_d_tra, em_precip, &
234              em_bas, em_top,em_upwd, em_dnwd, em_dnwdbis, &
235              em_work1, em_work2,emmip,emMke,emMa,Ment, &
236              Qent,TPS,TLS,SIJ,em_CAPE,em_TVP,em_pbase,em_bbase, &
237              em_dtvpdt1,em_dtvpdq1,em_dplcldt,em_dplcldr, &
238              em_d_t2,em_d_q2,em_d_u2,em_d_v2,em_wd,em_qcond,em_qcondc)!sbl
239         !     print*,'apres convect '
240         !
241         !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
242         !
243         ! -- sb: Appel schema statistique de nuages couple a la convection
244         ! (Bony et Emanuel 2001):
245    
246         ! -- creer cvthermo.h qui contiendra les cstes thermo de LMDZ:
247    
248         iflagcon = 3
249         !       CALL cv_thermo(iflagcon)
250    
251         ! -- appel schema de nuages:
252    
253         do k = 1, klev
254            cldf(i,k)  = em_cldf(k)  ! cloud fraction (0-1)
255            cldq(i,k)  = em_cldq(k)  ! in-cloud water content (kg/kg)
256            ftadj(i,k) = em_ftadj(k) ! (dT/dt)_{LS adj} (K/s)
257            fqadj(i,k) = em_fradj(k) ! (dq/dt)_{LS adj} (kg/kg/s)
258            ifc(i,k)   = em_ifc(k)   ! flag convergence clouds_gno (1 ou 2)
259         enddo
260         pradj(i) = em_pradj       ! precip from LS supersat adj (mm/day)
261    
262         ! sb --
263         !
264         ! SB:
265         if (iflag.ne.1 .and. iflag.ne.4) then
266            em_CAPE = 0.
267            do l = 1, klev
268               em_upwd(l) = 0.
269               em_dnwd(l) = 0.
270               em_dnwdbis(l) = 0.
271               emMa(l) = 0.
272               em_TVP(l) = 0.
273            enddo
274         endif
275         ! fin SB
276         !
277         !  If sig has been set to zero, then set Ma to zero
278         !
279         sigsum = 0.
280         do k = 1,klev
281          sigsum = sigsum + em_work1(k)          sigsum = sigsum + em_work1(k)
282        enddo       enddo
283        if (sigsum .eq. 0.0) then       if (sigsum .eq. 0.0) then
284          do k = 1,klev          do k = 1,klev
285            emMa(k) = 0.             emMa(k) = 0.
286          enddo          enddo
287        endif       endif
288  c       !
289  c sb3d       print*,'i, iflag=',i,iflag       ! sb3d       print*,'i, iflag=',i,iflag
290  c       !
291  ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc       !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
292  c       !
293  c       SORTIE DES ICB ET INB       !       SORTIE DES ICB ET INB
294  c       en fait inb et icb correspondent au niveau ou se trouve       !       en fait inb et icb correspondent au niveau ou se trouve
295  c       le nuage,le numero d'interface       !       le nuage,le numero d'interface
296  cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc       !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
297    
298  c modif SB:       ! modif SB:
299        if (iflag.EQ.1 .or. iflag.EQ.4) then       if (iflag.EQ.1 .or. iflag.EQ.4) then
300         top=em_top          top=em_top
301         bas=em_bas          bas=em_bas
302         kbas(i) = em_bas          kbas(i) = em_bas
303         ktop(i) = em_top          ktop(i) = em_top
304        endif       endif
305    
306        pbase(i) = em_pbase       pbase(i) = em_pbase
307        bbase(i) = em_bbase       bbase(i) = em_bbase
308        rain(i) = em_precip/ 86400.0       rain(i) = em_precip/ 86400.0
309        snow(i) = 0.0       snow(i) = 0.0
310        cape(i) = em_CAPE       cape(i) = em_CAPE
311        wd(i) = em_wd       wd(i) = em_wd
312        rflag(i) = float(iflag)       rflag(i) = float(iflag)
313  c SB      kbas(i) = em_bas       ! SB      kbas(i) = em_bas
314  c SB      ktop(i) = em_top       ! SB      ktop(i) = em_top
315        dplcldt(i) = em_dplcldt       dplcldt(i) = em_dplcldt
316        dplcldr(i) = em_dplcldr       dplcldr(i) = em_dplcldr
317        DO l = 1, klev       DO l = 1, klev
318           d_t2(i,l) = dtime * em_d_t2(l)          d_t2(i,l) = dtime * em_d_t2(l)
319           d_q2(i,l) = dtime * em_d_q2(l)          d_q2(i,l) = dtime * em_d_q2(l)
320           d_u2(i,l) = dtime * em_d_u2(l)          d_u2(i,l) = dtime * em_d_u2(l)
321           d_v2(i,l) = dtime * em_d_v2(l)          d_v2(i,l) = dtime * em_d_v2(l)
322    
323           d_t(i,l) = dtime * em_d_t(l)          d_t(i,l) = dtime * em_d_t(l)
324           d_q(i,l) = dtime * em_d_q(l)          d_q(i,l) = dtime * em_d_q(l)
325           d_u(i,l) = dtime * em_d_u(l)          d_u(i,l) = dtime * em_d_u(l)
326           d_v(i,l) = dtime * em_d_v(l)          d_v(i,l) = dtime * em_d_v(l)
327           do itra = 1, ntra          do itra = 1, ntra
328           d_tra(i,l,itra) = dtime * em_d_tra(l,itra)             d_tra(i,l,itra) = dtime * em_d_tra(l,itra)
329           enddo          enddo
330           upwd(i,l) = em_upwd(l)          upwd(i,l) = em_upwd(l)
331           dnwd(i,l) = em_dnwd(l)          dnwd(i,l) = em_dnwd(l)
332           dnwdbis(i,l) = em_dnwdbis(l)          dnwdbis(i,l) = em_dnwdbis(l)
333           work1(i,l) = em_work1(l)          work1(i,l) = em_work1(l)
334           work2(i,l) = em_work2(l)          work2(i,l) = em_work2(l)
335           Ma(i,l)=emMa(l)          Ma(i,l)=emMa(l)
336           tvp(i,l)=em_TVP(l)          tvp(i,l)=em_TVP(l)
337           dtvpdt1(i,l) = em_dtvpdt1(l)          dtvpdt1(i,l) = em_dtvpdt1(l)
338           dtvpdq1(i,l) = em_dtvpdq1(l)          dtvpdq1(i,l) = em_dtvpdq1(l)
339    
340           if (iflag_clw.eq.0) then          if (iflag_clw.eq.0) then
341              qcond_incld(i,l) = em_qcondc(l)             qcond_incld(i,l) = em_qcondc(l)
342           else if (iflag_clw.eq.1) then          else if (iflag_clw.eq.1) then
343              qcond_incld(i,l) = em_qcond(l)             qcond_incld(i,l) = em_qcond(l)
344           endif          endif
345        ENDDO       ENDDO
346    999 CONTINUE    end DO
347    
348  c   On calcule une eau liquide diagnostique en fonction de la    !   On calcule une eau liquide diagnostique en fonction de la
349  c  precip.    !  precip.
350        if ( iflag_clw.eq.2 ) then    if ( iflag_clw.eq.2 ) then
351        do l=1,klev       do l=1,klev
352           do i=1,klon          do i=1,klon
353              if (ktop(i)-kbas(i).gt.0.and.             if (ktop(i)-kbas(i).gt.0.and. &
354       s         l.ge.kbas(i).and.l.le.ktop(i)) then                  l.ge.kbas(i).and.l.le.ktop(i)) then
355                 qcond_incld(i,l)=rain(i)*8.e4                qcond_incld(i,l)=rain(i)*8.e4 &
356       s         /(pplay(i,kbas(i))-pplay(i,ktop(i)))                     /(pplay(i,kbas(i))-pplay(i,ktop(i)))
357  c    s         **2                !    s         **2
358              else             else
359                 qcond_incld(i,l)=0.                qcond_incld(i,l)=0.
360              endif             endif
361           enddo          enddo
362           print*,'l=',l,',   qcond_incld=',qcond_incld(1,l)          print*,'l=',l,',   qcond_incld=',qcond_incld(1,l)
363        enddo       enddo
364        endif    endif
   
   
       RETURN  
       END  
365    
366    END SUBROUTINE conema3

Legend:
Removed from v.51  
changed lines
  Added in v.52

  ViewVC Help
Powered by ViewVC 1.1.21