Changeset 1750 for LMDZ5/branches/testing/libf/phylmd/cv3_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/cv3_routines.F (modified) (6 diffs)

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

@@ -1950 +1950 @@
      :              ,th,tv,lv,cpn,ep,sigp,clw
      :              ,m,ment,elij,delt,plcl,coef_clos
-     o              ,mp,rp,up,vp,trap,wt,water,evap,b,sigd)
+     o              ,mp,rp,up,vp,trap,wt,water,evap,b,sigd
+     o              ,wdtrainA,wdtrainM)                                ! RomP
       implicit none
 
@@ -1979 +1980 @@
       real trap(nloc,na,ntra)
       real b(nloc,na), sigd(nloc)
+! 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
@@ -2021 +2027 @@
 !AC!         enddo
 !AC!        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    ***
@@ -2065 +2079 @@
          if (cvflag_grav) then
           wdtrain(il)=grav*ep(il,i)*m(il,i)*clw(il,i)
+          wdtrainA(il,i) = wdtrain(il)/grav     !   Pa   RomP
          else
           wdtrain(il)=10.0*ep(il,i)*m(il,i)*clw(il,i)
+          wdtrainA(il,i) = wdtrain(il)/10.      !   Pa   RomP
          endif
         endif
@@ -2079 +2095 @@
            if (cvflag_grav) then
             wdtrain(il)=wdtrain(il)+grav*awat*ment(il,j,i)
+            wdtrainM(il,i) = wdtrain(il)/grav-wdtrainA(il,i)    !   Pm  RomP
            else
             wdtrain(il)=wdtrain(il)+10.0*awat*ment(il,j,i)
+            wdtrainM(il,i) = wdtrain(il)/10.-wdtrainA(il,i)    !   Pm  RomP
            endif
           endif
@@ -3540 +3558 @@
         end
 
-!AC!
+!AC! et !RomP >>>
       SUBROUTINE cv3_tracer(nloc,len,ncum,nd,na,
-     &                        ment,sij,da,phi)
+     &                       ment,sigij,da,phi,phi2,d1a,dam,
+     &                       ep,Vprecip,elij,clw,icb,inb)
         implicit none
+
+#include "cv3param.h"
+
 c inputs:
         integer ncum, nd, na, nloc,len
-        real ment(nloc,na,na),sij(nloc,na,na)
+        real ment(nloc,na,na),sigij(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)
+! 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, sigij, elij
+! variables personnelles : du troisieme au second indice
+! --->    tab(i,j,k) -> de k a j 
+! phi, phi2
+!
+! initialisations
+c
+       da(:,:)=0.
+       d1a(:,:)=0.
+       dam(:,:)=0.
+       epm(:,:,:)=0.
+c
+!  fraction deau condensee dans les melanges convertie en precip
+        do j=1,na
+         do k=1,na
+           do i=1,ncum
+            if(k.ge.icb(i).and.k.le.inb(i).and.
+     &         j.ge.k.and.j.le.inb(i)) then
+             epm(i,j,k)=1.-(1.-ep(i,j))*clw(i,j)/elij(i,k,j)
+             epm(i,j,k)=max(epm(i,j,k),0.0)
+            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)
+             da(i,j)=da(i,j)+(1.-sigij(i,k,j))*ment(i,k,j)
+             phi(i,j,k)=sigij(i,k,j)*ment(i,k,j)
+             d1a(i,j)=d1a(i,j)+ment(i,k,j)*ep(i,k)
+     &              *(1.-sigij(i,k,j))
+            if(k.le.j) then
+             dam(i,j)=dam(i,j)+ment(i,k,j)
+     &             *epm(i,k,j)*(1.-ep(i,k))*(1.-sigij(i,k,j)) 
+
+             phi2(i,j,k)=phi(i,j,k)*epm(i,j,k)   
+            else
+             dam(i,j)=0.
+             phi2(i,j,k)=0.
+            endif
             end do 
           end do 
         end do 
+   
         return
         end
-!AC!
+!AC! et !RomP <<<
 
       SUBROUTINE cv3_uncompress(nloc,len,ncum,nd,ntra,idcum