/[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 12 by guez, Mon Jul 21 16:05:07 2008 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 YOMCST    use conema3_m
14        use conema3_m    use yoethf_m
15        use yoethf    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), tra(klon,klev,ntra)    REAL u(klon,klev), v(klon,klev)
76        REAL d_u(klon,klev), d_v(klon,klev), d_tra(klon,klev,ntra)    real, intent(in):: tra(klon,klev,ntra)
77        REAL work1(klon,klev), work2(klon,klev)    REAL d_u(klon,klev), d_v(klon,klev), d_tra(klon,klev,ntra)
78        REAL upwd(klon,klev), dnwd(klon,klev), dnwdbis(klon,klev)    REAL work1(klon,klev), work2(klon,klev)
79        REAL rain(klon)    REAL upwd(klon,klev), dnwd(klon,klev), dnwdbis(klon,klev)
80        REAL snow(klon)    REAL rain(klon)
81        REAL cape(klon), tvp(klon,klev), rflag(klon)    REAL snow(klon)
82        REAL pbase(klon), bbase(klon)    REAL cape(klon), tvp(klon,klev), rflag(klon)
83        REAL dtvpdt1(klon,klev), dtvpdq1(klon,klev)    REAL pbase(klon), bbase(klon)
84        REAL dplcldt(klon), dplcldr(klon)    REAL dtvpdt1(klon,klev), dtvpdq1(klon,klev)
85        INTEGER kbas(klon), ktop(klon)    REAL dplcldt(klon), dplcldr(klon)
86      INTEGER kbas(klon), ktop(klon)
87        REAL wd(klon)  
88        REAL qcond_incld(klon,klev)    REAL wd(klon)
89  c    REAL qcond_incld(klon,klev)
90        REAL em_t(klev)    !
91        REAL em_q(klev)    REAL em_t(klev)
92        REAL em_qs(klev)    REAL em_q(klev)
93        REAL em_u(klev), em_v(klev), em_tra(klev,ntrac)    REAL em_qs(klev)
94        REAL em_ph(klev+1), em_p(klev)    REAL em_u(klev), em_v(klev), em_tra(klev,ntrac)
95        REAL em_work1(klev), em_work2(klev)    REAL em_ph(klev+1), em_p(klev)
96        REAL em_precip, em_d_t(klev), em_d_q(klev)    REAL em_work1(klev), em_work2(klev)
97        REAL em_d_u(klev), em_d_v(klev), em_d_tra(klev,ntrac)    REAL em_precip, em_d_t(klev), em_d_q(klev)
98        REAL em_upwd(klev), em_dnwd(klev), em_dnwdbis(klev)    REAL em_d_u(klev), em_d_v(klev), em_d_tra(klev,ntrac)
99        REAL em_dtvpdt1(klev), em_dtvpdq1(klev)    REAL em_upwd(klev), em_dnwd(klev), em_dnwdbis(klev)
100        REAL em_dplcldt, em_dplcldr    REAL em_dtvpdt1(klev), em_dtvpdq1(klev)
101        SAVE em_t,em_q, em_qs, em_ph, em_p, em_work1, em_work2    REAL em_dplcldt, em_dplcldr
102        SAVE em_u,em_v, em_tra    SAVE em_t,em_q, em_qs, em_ph, em_p, em_work1, em_work2
103        SAVE em_d_u,em_d_v, em_d_tra    SAVE em_u,em_v, em_tra
104        SAVE em_precip, em_d_t, em_d_q, em_upwd, em_dnwd, em_dnwdbis    SAVE em_d_u,em_d_v, em_d_tra
105        INTEGER em_bas, em_top    SAVE em_precip, em_d_t, em_d_q, em_upwd, em_dnwd, em_dnwdbis
106        SAVE em_bas, em_top    INTEGER em_bas, em_top
107      SAVE em_bas, em_top
108        REAL em_wd  
109        REAL em_qcond(klev)    REAL em_wd
110        REAL em_qcondc(klev)    REAL em_qcond(klev)
111  c    REAL em_qcondc(klev)
112        REAL zx_t, zx_qs, zdelta, zcor    !
113        INTEGER iflag    REAL zx_t, zx_qs, zdelta, zcor
114        REAL sigsum    INTEGER iflag
115  ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc    REAL sigsum
116  c     VARIABLES A SORTIR    !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
117  cccccccccccccccccccccccccccccccccccccccccccccccccc    !     VARIABLES A SORTIR
118      !ccccccccccccccccccccccccccccccccccccccccccccccccc
119        REAL emmip(klev) !variation de flux ascnon dilue i et i+1  
120        SAVE emmip    REAL emmip(klev) !variation de flux ascnon dilue i et i+1
121        real emMke(klev)    SAVE emmip
122        save emMke    real emMke(klev)
123        real top    save emMke
124        real bas    real top
125        real emMa(klev)    real bas
126        save emMa    real emMa(klev)
127        real Ma(klon,klev)    save emMa
128        real Ment(klev,klev)    real Ma(klon,klev)
129        real Qent(klev,klev)    real Ment(klev,klev)
130        real TPS(klev),TLS(klev)    real Qent(klev,klev)
131        real SIJ(klev,klev)    real TPS(klev),TLS(klev)
132        real em_CAPE, em_TVP(klev)    real SIJ(klev,klev)
133        real em_pbase, em_bbase    real em_CAPE, em_TVP(klev)
134        integer iw,j,k,ix,iy    real em_pbase, em_bbase
135      integer iw,j,k,ix,iy
136  c -- sb: pour schema nuages:  
137      ! -- sb: pour schema nuages:
138         integer iflagcon  
139         integer em_ifc(klev)    integer iflagcon
140          integer em_ifc(klev)
141         real em_pradj  
142         real em_cldf(klev), em_cldq(klev)    real em_pradj
143         real em_ftadj(klev), em_fradj(klev)    real em_cldf(klev), em_cldq(klev)
144      real em_ftadj(klev), em_fradj(klev)
145         integer ifc(klon,klev)  
146         real pradj(klon)    integer ifc(klon,klev)
147         real cldf(klon,klev), cldq(klon,klev)    real pradj(klon)
148         real ftadj(klon,klev), fqadj(klon,klev)    real cldf(klon,klev), cldq(klon,klev)
149      real ftadj(klon,klev), fqadj(klon,klev)
150  c sb --  
151      ! sb --
152  ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc  
153  c    !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
154      !
155        qcond_incld(:,:) = 0.  
156  c    qcond_incld(:,:) = 0.
157  c$$$      print*,'debut conema'    !
158      !$$$      print*,'debut conema'
159        DO 999 i = 1, klon  
160        DO l = 1, klev+1    DO i = 1, klon
161           em_ph(l) = paprs(i,l) / 100.0       DO l = 1, klev+1
162        ENDDO          em_ph(l) = paprs(i,l) / 100.0
163  c       ENDDO
164        DO l = 1, klev       !
165           em_p(l) = pplay(i,l) / 100.0       DO l = 1, klev
166           em_t(l) = t(i,l)          em_p(l) = pplay(i,l) / 100.0
167           em_q(l) = q(i,l)          em_t(l) = t(i,l)
168           em_u(l) = u(i,l)          em_q(l) = q(i,l)
169           em_v(l) = v(i,l)          em_u(l) = u(i,l)
170           do itra = 1, ntra          em_v(l) = v(i,l)
171            em_tra(l,itra) = tra(i,l,itra)          do itra = 1, ntra
172           enddo             em_tra(l,itra) = tra(i,l,itra)
 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.12  
changed lines
  Added in v.52

  ViewVC Help
Powered by ViewVC 1.1.21