Changeset 619 for LMDZ4/trunk/libf/phylmd/cv3_routines.F

Timestamp:

Apr 15, 2005, 2:36:17 PM (19 years ago)

Author:

lmdzadmin

Message:

Rajout convection Kerry Emanuel pour traceurs- MAF+JYG

File:

• LMDZ4/trunk/libf/phylmd/cv3_routines.F (modified) (12 diffs)

LMDZ4/trunk/libf/phylmd/cv3_routines.F

@@ -2164 +2164 @@
      :                    ,ment,qent,uent,vent,nent,elij,traent,sig
      :                    ,tv,tvp
-     :                    ,iflag,precip,ft,fr,fu,fv,ftra
+     :                    ,iflag,precip,VPrecip,ft,fr,fu,fv,ftra
      :                    ,upwd,dnwd,dnwd0,ma,mike,tls,tps,qcondc,wd)
       implicit none
@@ -2197 +2197 @@
 c outputs:
       real precip(nloc)
+      real VPrecip(nloc,nd+1)
       real ft(nloc,nd), fr(nloc,nd), fu(nloc,nd), fv(nloc,nd)
       real ftra(nloc,nd,ntra)
@@ -2228 +2229 @@
        precip(il)=0.0
        wd(il)=0.0     ! gust
+       VPrecip(il,nd+1)=0.
       enddo
 
       do i=1,nd
        do il=1,ncum
+         VPrecip(il,i)=0.0
          ft(il,i)=0.0
          fr(il,i)=0.0
@@ -2270 +2273 @@
       enddo 
 
+C   ***  CALCULATE VERTICAL PROFILE OF  PRECIPITATIONs IN kg/m2/s  ===
+C
+c MAF rajout pour lessivage
+       do k=1,nl
+         do il=1,ncum
+          if (k.le.inb(il)) then
+            if (cvflag_grav) then
+             VPrecip(il,k) = wt(il,k)*sigd*water(il,k)/grav
+            else
+             VPrecip(il,k) = wt(il,k)*sigd*water(il,k)/10.
+            endif 
+          endif
+         end do
+       end do
+C
 c
 c   ***  Calculate downdraft velocity scale    ***
@@ -3025 +3043 @@
       SUBROUTINE cv3_uncompress(nloc,len,ncum,nd,ntra,idcum
      :         ,iflag
-     :         ,precip,sig,w0
+     :         ,precip,VPrecip,sig,w0
      :         ,ft,fq,fu,fv,ftra
+     :         ,inb
      :         ,Ma,upwd,dnwd,dnwd0,qcondc,wd,cape
+     :         ,da,phi,mp
      :         ,iflag1
-     :         ,precip1,sig1,w01
+     :         ,precip1,VPrecip1,sig1,w01
      :         ,ft1,fq1,fu1,fv1,ftra1
+     :         ,inb1
      :         ,Ma1,upwd1,dnwd1,dnwd01,qcondc1,wd1,cape1
-     :                               )
+     :         ,da1,phi1,mp1)
       implicit none
 
@@ -3041 +3062 @@
       integer idcum(nloc)
       integer iflag(nloc)
+      integer inb(nloc)
       real precip(nloc)
+      real VPrecip(nloc,nd+1)
       real sig(nloc,nd), w0(nloc,nd)
       real ft(nloc,nd), fq(nloc,nd), fu(nloc,nd), fv(nloc,nd)
@@ -3049 +3072 @@
       real qcondc(nloc,nd)
       real wd(nloc),cape(nloc)
+      real da(nloc,nd),phi(nloc,nd,nd),mp(nloc,nd)
 
 c outputs:
       integer iflag1(len)
+      integer inb1(len)
       real precip1(len)
+      real VPrecip1(len,nd+1)
       real sig1(len,nd), w01(len,nd)
       real ft1(len,nd), fq1(len,nd), fu1(len,nd), fv1(len,nd)
@@ -3060 +3086 @@
       real qcondc1(nloc,nd)
       real wd1(nloc),cape1(nloc)
+      real da1(nloc,nd),phi1(nloc,nd,nd),mp1(nloc,nd)
 
 c local variables:
@@ -3068 +3095 @@
          iflag1(idcum(i))=iflag(i)
          wd1(idcum(i))=wd(i)
+         inb1(idcum(i))=inb(i)
          cape1(idcum(i))=cape(i)
  2000   continue
@@ -3073 +3101 @@
         do 2020 k=1,nl
           do 2010 i=1,ncum
+            VPrecip1(idcum(i),k)=VPrecip(i,k)
             sig1(idcum(i),k)=sig(i,k)
             w01(idcum(i),k)=w0(i,k)
@@ -3084 +3113 @@
             dnwd01(idcum(i),k)=dnwd0(i,k)
             qcondc1(idcum(i),k)=qcondc(i,k)
+            da1(idcum(i),k)=da(i,k)
+            mp1(idcum(i),k)=mp(i,k)
  2010     continue
  2020   continue
@@ -3099 +3130 @@
 c 2110    continue
 c 2100   continue
+        do j=1,nd
+         do k=1,nd 
+          do i=1,ncum
+            phi1(idcum(i),k,j)=phi(i,k,j)
+          end do
+         end do
+        end do
 
         return