Changeset 1750 for LMDZ5/branches/testing/libf/phylmd/cv30_routines.F

Timestamp:

Apr 25, 2013, 5:27:27 PM (12 years ago)

Author:

Laurent Fairhead

Message:

Version testing basée sur r1745

---

Testing release based on r1745

Location:

LMDZ5/branches/testing

Files:

• . (modified) (1 prop)
• libf/phylmd/cv30_routines.F (modified) (14 diffs)

LMDZ5/branches/testing/libf/phylmd/cv30_routines.F

@@ -1831 +1831 @@
      :              ,th,tv,lv,cpn,ep,sigp,clw
      :              ,m,ment,elij,delt,plcl
-     :              ,mp,rp,up,vp,trap,wt,water,evap,b)
+     :              ,mp,rp,up,vp,trap,wt,water,evap,b ! RomP-jyg
+     :              ,wdtrainA,wdtrainM)               ! 26/08/10  RomP-jyg
       implicit none
 
@@ -1857 +1858 @@
       real trap(nloc,na,ntra)
       real b(nloc,na)
+! 25/08/10 - RomP---- ajout des masses precipitantes ejectees
+! lascendance adiabatique et des flux melanges Pa et Pm.
+! Distinction des wdtrain
+! Pa = wdtrainA     Pm = wdtrainM
+      real  wdtrainA(nloc,na), wdtrainM(nloc,na)
 
 c local variables
@@ -1898 +1904 @@
 c         enddo
 c        enddo
-
+!! RomP >>>
+         do i=1,nd
+          do il=1,ncum
+          wdtrainA(il,i)=0.0     
+          wdtrainM(il,i)=0.0     
+         enddo
+        enddo
+!! RomP <<<
 c
 c   ***  check whether ep(inb)=0, if so, skip precipitating    ***
@@ -1935 +1948 @@
          if (cvflag_grav) then
           wdtrain(il)=grav*ep(il,i)*m(il,i)*clw(il,i)
+          wdtrainA(il,i) = wdtrain(il)/grav     !   Pa  26/08/10   RomP
          else
           wdtrain(il)=10.0*ep(il,i)*m(il,i)*clw(il,i)
+          wdtrainA(il,i) = wdtrain(il)/10.      !   Pa  26/08/10   RomP
          endif
         endif
@@ -1942 +1957 @@
 
        if(i.gt.1)then
+
         do 320 j=1,i-1
          do il=1,ncum
@@ -1955 +1971 @@
          enddo
 320     continue
+         do il=1,ncum
+           if (cvflag_grav) then
+           wdtrainM(il,i) = wdtrain(il)/grav-wdtrainA(il,i)    !   Pm  26/08/10   RomP
+           else
+           wdtrainM(il,i) = wdtrain(il)/10.-wdtrainA(il,i)    !   Pm  26/08/10   RomP
+           endif
+         enddo
+
        endif
 
@@ -3022 +3046 @@
         end
 
+!!RomP >>>
       SUBROUTINE cv30_tracer(nloc,len,ncum,nd,na,
-     &                        ment,sij,da,phi)
+     &                       ment,sij,da,phi,phi2,d1a,dam,
+     &                       ep,VPrecip,elij,clw,epmlmMm,eplaMm,
+     &                       icb,inb)
         implicit none
+
+#include "cv30param.h"
+
 c inputs:
         integer ncum, nd, na, nloc,len
         real ment(nloc,na,na),sij(nloc,na,na)
+        real clw(nloc,nd),elij(nloc,na,na)
+        real ep(nloc,na)
+        integer icb(nloc),inb(nloc)
+        real VPrecip(nloc,nd+1)
 c ouputs:
         real da(nloc,na),phi(nloc,na,na)
+        real phi2(nloc,na,na)
+        real d1a(nloc,na),dam(nloc,na)
+        real epmlmMm(nloc,na,na),eplaMm(nloc,na)
+! variables pour tracer dans precip de l'AA et des mel
 c local variables:
         integer i,j,k
-c        
-        da(:,:)=0.
-c
+        real epm(nloc,na,na)
+c
+! variables d'Emanuel : du second indice au troisieme
+! --->    tab(i,k,j) -> de l origine k a l arrivee j 
+!  ment, sij, elij
+! variables personnelles : du troisieme au second indice
+! --->    tab(i,j,k) -> de k a j 
+! phi, phi2
+!
+! initialisations
+       do j=1,na
+        do i=1,ncum
+         da(i,j)=0.
+         d1a(i,j)=0.
+         dam(i,j)=0.
+         eplaMm(i,j)=0.
+        enddo
+       enddo
+      do k=1,na
+       do j=1,na
+        do i=1,ncum
+         epm(i,j,k)=0.
+         epmlmMm(i,j,k)=0.
+         phi(i,j,k)=0.
+         phi2(i,j,k)=0.
+        enddo
+       enddo
+      enddo
+c
+!  fraction deau condensee dans les melanges convertie en precip : epm
+! et eau condensée précipitée dans masse d'air saturé : l_m*dM_m/dzdz.dzdz
+        do j=1,na
+         do k=1,j-1
+           do i=1,ncum
+            if(k.ge.icb(i).and.k.le.inb(i).and.
+     &         j.le.inb(i)) then
+!!jyg             epm(i,j,k)=1.-(1.-ep(i,j))*clw(i,j)/elij(i,k,j)
+             epm(i,j,k)=1.-(1.-ep(i,j))*clw(i,j)/
+     &                     max(elij(i,k,j),1.e-16)
+!!
+             epm(i,j,k)=max(epm(i,j,k),0.0)
+            endif
+           end do 
+         end do 
+        end do
+!
+        do j=1,na
+         do k=1,na
+           do i=1,ncum
+            if(k.ge.icb(i).and.k.le.inb(i)) then
+             eplaMm(i,j)=eplaMm(i,j) + ep(i,j)*clw(i,j)
+     &                  *ment(i,j,k)*(1.-sij(i,j,k))
+            endif
+           end do 
+         end do 
+        end do
+!
+        do j=1,na
+         do k=1,j-1
+           do i=1,ncum
+            if(k.ge.icb(i).and.k.le.inb(i).and.
+     &         j.le.inb(i)) then
+             epmlmMm(i,j,k)=epm(i,j,k)*elij(i,k,j)*ment(i,k,j)
+            endif
+           end do 
+         end do 
+        end do
+
+!  matrices pour calculer la tendance des concentrations dans cvltr.F90
         do j=1,na
           do k=1,na
             do i=1,ncum
-            da(i,j)=da(i,j)+(1.-sij(i,k,j))*ment(i,k,j)
-            phi(i,j,k)=sij(i,k,j)*ment(i,k,j)
-c            print *,'da',j,k,da(i,j),sij(i,k,j),ment(i,k,j)
+             da(i,j)=da(i,j)+(1.-sij(i,k,j))*ment(i,k,j)
+             phi(i,j,k)=sij(i,k,j)*ment(i,k,j)
+             d1a(i,j)=d1a(i,j)+ment(i,k,j)*ep(i,k)
+     &              *(1.-sij(i,k,j))
             end do 
           end do 
         end do 
-    
+
+        do j=1,na
+          do k=1,j-1
+            do i=1,ncum
+             dam(i,j)=dam(i,j)+ment(i,k,j)
+     &             *epm(i,j,k)*(1.-ep(i,k))*(1.-sij(i,k,j)) 
+             phi2(i,j,k)=phi(i,j,k)*epm(i,j,k)
+            end do 
+          end do 
+        end do 
+
         return
         end
-
+!RomP <<<
 
       SUBROUTINE cv30_uncompress(nloc,len,ncum,nd,ntra,idcum
      :         ,iflag
-     :         ,precip,VPrecip,sig,w0
+     :         ,precip,VPrecip,evap,ep,sig,w0
      :         ,ft,fq,fu,fv,ftra
      :         ,inb
      :         ,Ma,upwd,dnwd,dnwd0,qcondc,wd,cape
-     :         ,da,phi,mp
+     :         ,da,phi,mp,phi2,d1a,dam,sij
+     :         ,elij,clw,epmlmMm,eplaMm
+     :         ,wdtrainA,wdtrainM
      :         ,iflag1
-     :         ,precip1,VPrecip1,sig1,w01
+     :         ,precip1,VPrecip1,evap1,ep1,sig1,w01
      :         ,ft1,fq1,fu1,fv1,ftra1
      :         ,inb1
      :         ,Ma1,upwd1,dnwd1,dnwd01,qcondc1,wd1,cape1
-     :         ,da1,phi1,mp1)
+     :         ,da1,phi1,mp1,phi21,d1a1,dam1,sij1
+     :         ,elij1,clw1,epmlmMm1,eplaMm1
+     :         ,wdtrainA1,wdtrainM1)
       implicit none
 
@@ -3072 +3191 @@
       integer inb(nloc)
       real precip(nloc)
-      real VPrecip(nloc,nd+1)
+      real VPrecip(nloc,nd+1),evap(nloc,nd)
+      real ep(nloc,nd)
       real sig(nloc,nd), w0(nloc,nd)
       real ft(nloc,nd), fq(nloc,nd), fu(nloc,nd), fv(nloc,nd)
@@ -3081 +3201 @@
       real wd(nloc),cape(nloc)
       real da(nloc,nd),phi(nloc,nd,nd),mp(nloc,nd)
+!RomP >>>
+      real phi2(nloc,nd,nd)
+      real d1a(nloc,nd),dam(nloc,nd)
+      real wdtrainA(nloc,nd), wdtrainM(nloc,nd)
+      real sij(nloc,nd,nd)
+      real elij(nloc,nd,nd),clw(nloc,nd)
+      real epmlmMm(nloc,nd,nd),eplaMm(nloc,nd)
+!RomP <<<
 
 c outputs:
@@ -3086 +3214 @@
       integer inb1(len)
       real precip1(len)
-      real VPrecip1(len,nd+1)
+      real VPrecip1(len,nd+1),evap1(len,nd) !<<< RomP
+      real ep1(len,nd)                      !<<< RomP
       real sig1(len,nd), w01(len,nd)
       real ft1(len,nd), fq1(len,nd), fu1(len,nd), fv1(len,nd)
@@ -3095 +3224 @@
       real wd1(nloc),cape1(nloc)
       real da1(nloc,nd),phi1(nloc,nd,nd),mp1(nloc,nd)
+!RomP >>>
+      real phi21(len,nd,nd)
+      real d1a1(len,nd),dam1(len,nd)
+      real wdtrainA1(len,nd), wdtrainM1(len,nd)
+      real sij1(len,nd,nd)
+      real elij1(len,nd,nd),clw1(len,nd)
+      real epmlmMm1(len,nd,nd),eplaMm1(len,nd)
+!RomP <<<
 
 c local variables:
@@ -3110 +3247 @@
           do 2010 i=1,ncum
             VPrecip1(idcum(i),k)=VPrecip(i,k)
+            evap1(idcum(i),k)=evap(i,k)   !<<< RomP
             sig1(idcum(i),k)=sig(i,k)
             w01(idcum(i),k)=w0(i,k)
@@ -3123 +3261 @@
             da1(idcum(i),k)=da(i,k)
             mp1(idcum(i),k)=mp(i,k)
+!RomP >>>
+            ep1(idcum(i),k)=ep(i,k)
+            d1a1(idcum(i),k)=d1a(i,k)
+            dam1(idcum(i),k)=dam(i,k)
+            clw1(idcum(i),k)=clw(i,k)
+            eplaMm1(idcum(i),k)=eplaMm(i,k)
+            wdtrainA1(idcum(i),k)=wdtrainA(i,k)
+            wdtrainM1(idcum(i),k)=wdtrainM(i,k)
+!RomP <<<
  2010     continue
  2020   continue
@@ -3141 +3288 @@
          do k=1,nd 
           do i=1,ncum
+            sij1(idcum(i),k,j)=sij(i,k,j)
             phi1(idcum(i),k,j)=phi(i,k,j)
+            phi21(idcum(i),k,j)=phi2(i,k,j)
+            elij1(idcum(i),k,j)=elij(i,k,j)
+            epmlmMm1(idcum(i),k,j)=epmlmMm(i,k,j)
           end do
          end do