Changeset 2488 for LMDZ5/branches/testing/libf/phylmd/cv30_routines.F90

Timestamp:

Apr 3, 2016, 12:09:34 AM (8 years ago)

Author:

Laurent Fairhead

Message:

Merged trunk changes r2457:2487 into testing branch

Location:

LMDZ5/branches/testing

Files:

• . (modified) (1 prop)
• libf/phylmd/cv30_routines.F90 (modified) (8 diffs)

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

@@ -839 +839 @@
     q, qs, gz, p, h, tv, lv, pbase, buoybase, plcl, inb, tp, tvp, clw, hp, &
     ep, sigp, buoy)
+    ! epmax_cape: ajout arguments
   IMPLICIT NONE
 
@@ -1242 +1243 @@
   REAL dtmin(nloc, nd), sigold(nloc, nd)
 
-
   ! -------------------------------------------------------
   ! -- Initialization
@@ -1348 +1348 @@
 
   ! the interval on which cape is computed starts at pbase :
-
   DO k = 1, nl
     DO i = 1, ncum
@@ -3146 +3145 @@
     vprecip, evap, ep, sig, w0, ft, fq, fu, fv, ftra, inb, ma, upwd, dnwd, &
     dnwd0, qcondc, wd, cape, da, phi, mp, phi2, d1a, dam, sij, elij, clw, &
-    epmlmmm, eplamm, wdtraina, wdtrainm, iflag1, precip1, vprecip1, evap1, &
+    epmlmmm, eplamm, wdtraina, wdtrainm,epmax_diag, iflag1, precip1, vprecip1, evap1, &
     ep1, sig1, w01, ft1, fq1, fu1, fv1, ftra1, inb1, ma1, upwd1, dnwd1, &
     dnwd01, qcondc1, wd1, cape1, da1, phi1, mp1, phi21, d1a1, dam1, sij1, &
-    elij1, clw1, epmlmmm1, eplamm1, wdtraina1, wdtrainm1)
+    elij1, clw1, epmlmmm1, eplamm1, wdtraina1, wdtrainm1,epmax_diag1) ! epmax_cape
   IMPLICIT NONE
 
@@ -3170 +3169 @@
   REAL wd(nloc), cape(nloc)
   REAL da(nloc, nd), phi(nloc, nd, nd), mp(nloc, nd)
+  REAL epmax_diag(nloc) ! epmax_cape
   ! RomP >>>
   REAL phi2(nloc, nd, nd)
@@ -3193 +3193 @@
   REAL wd1(nloc), cape1(nloc)
   REAL da1(nloc, nd), phi1(nloc, nd, nd), mp1(nloc, nd)
+  REAL epmax_diag1(len) ! epmax_cape
   ! RomP >>>
   REAL phi21(len, nd, nd)
@@ -3211 +3212 @@
     inb1(idcum(i)) = inb(i)
     cape1(idcum(i)) = cape(i)
+    epmax_diag1(idcum(i))=epmax_diag(i) ! epmax_cape
   END DO
 
@@ -3269 +3271 @@
 END SUBROUTINE cv30_uncompress
 
+        subroutine cv30_epmax_fn_cape(nloc,ncum,nd &
+                ,cape,ep,hp,icb,inb,clw,nk,t,h,lv &
+                ,epmax_diag)
+        implicit none
+
+        ! On fait varier epmax en fn de la cape
+        ! Il faut donc recalculer ep, et hp qui a déjà été calculé et
+        ! qui en dépend
+        ! Toutes les autres variables fn de ep sont calculées plus bas.
+
+#include "cvthermo.h"
+#include "cv30param.h"
+#include "conema3.h"
+
+! inputs:
+      integer ncum, nd, nloc
+      integer icb(nloc), inb(nloc)
+      real cape(nloc)
+      real clw(nloc,nd),lv(nloc,nd),t(nloc,nd),h(nloc,nd)
+      integer nk(nloc)
+! inouts:
+      real ep(nloc,nd)
+      real hp(nloc,nd)
+! outputs ou local
+      real epmax_diag(nloc)
+! locals
+      integer i,k    
+      real hp_bak(nloc,nd)
+
+        ! on recalcule ep et hp
+        
+        if (coef_epmax_cape.gt.1e-12) then
+        do i=1,ncum
+           epmax_diag(i)=epmax-coef_epmax_cape*sqrt(cape(i))
+           do k=1,nl
+                ep(i,k)=ep(i,k)/epmax*epmax_diag(i)
+                ep(i,k)=amax1(ep(i,k),0.0)
+                ep(i,k)=amin1(ep(i,k),epmax_diag(i))
+           enddo
+        enddo
+
+! On recalcule hp:
+      do k=1,nl
+        do i=1,ncum
+          hp_bak(i,k)=hp(i,k)
+        enddo
+      enddo
+      do k=1,nlp
+        do i=1,ncum
+          hp(i,k)=h(i,k)
+        enddo
+      enddo
+      do k=minorig+1,nl
+       do i=1,ncum
+        if((k.ge.icb(i)).and.(k.le.inb(i)))then
+          hp(i,k)=h(i,nk(i))+(lv(i,k)+(cpd-cpv)*t(i,k))*ep(i,k)*clw(i,k)
+        endif
+       enddo
+      enddo !do k=minorig+1,n
+!     write(*,*) 'cv30_routines 6218: hp(1,20)=',hp(1,20)
+      do i=1,ncum  
+       do k=1,nl
+        if (abs(hp_bak(i,k)-hp(i,k)).gt.0.01) then
+           write(*,*) 'i,k=',i,k
+           write(*,*) 'coef_epmax_cape=',coef_epmax_cape
+           write(*,*) 'epmax_diag(i)=',epmax_diag(i)
+           write(*,*) 'ep(i,k)=',ep(i,k)
+           write(*,*) 'hp(i,k)=',hp(i,k)
+           write(*,*) 'hp_bak(i,k)=',hp_bak(i,k)
+           write(*,*) 'h(i,k)=',h(i,k)
+           write(*,*) 'nk(i)=',nk(i)
+           write(*,*) 'h(i,nk(i))=',h(i,nk(i))
+           write(*,*) 'lv(i,k)=',lv(i,k)
+           write(*,*) 't(i,k)=',t(i,k)
+           write(*,*) 'clw(i,k)=',clw(i,k)
+           write(*,*) 'cpd,cpv=',cpd,cpv
+           stop
+        endif
+       enddo !do k=1,nl
+      enddo !do i=1,ncum  
+      endif !if (coef_epmax_cape.gt.1e-12) then
+
+      return
+      end subroutine cv30_epmax_fn_cape
+
+