Changeset 2925 for LMDZ5/branches/LMDZ_tree_FC/libf/phylmd/cv3_routines.F90

Timestamp:

Jun 30, 2017, 12:17:42 PM (7 years ago)

Author:

fcheruy

Message:

Update tree branch to trunk version

Location:

LMDZ5/branches/LMDZ_tree_FC

Files:

• . (modified) (1 prop)
• libf/phylmd/cv3_routines.F90 (modified) (14 diffs)

LMDZ5/branches/LMDZ_tree_FC/libf/phylmd/cv3_routines.F90

@@ -111 +111 @@
      ok_optim_yield=.False.
      CALL getin_p('ok_optim_yield',ok_optim_yield)
+     ok_homo_tend=.TRUE.
+     CALL getin_p('ok_homo_tend',ok_homo_tend)
+     ok_entrain=.TRUE.
+     CALL getin_p('ok_entrain',ok_entrain)
+
      coef_peel=0.25
      CALL getin_p('coef_peel',coef_peel)
@@ -277 +282 @@
 
 SUBROUTINE cv3_feed(len, nd, ok_conserv_q, &
-                    t, q, u, v, p, ph, hm, gz, &
+                    t, q, u, v, p, ph, h, gz, &
                     p1feed, p2feed, wght, &
                     wghti, tnk, thnk, qnk, qsnk, unk, vnk, &
@@ -283 +288 @@
 
   USE mod_phys_lmdz_transfert_para, ONLY : bcast
+  USE add_phys_tend_mod, ONLY: fl_cor_ebil
   IMPLICIT NONE
 
@@ -292 +298 @@
 ! - here, nk(i)=minorig
 ! - icb defined differently (plcl compared with ph instead of p)
+! - dry static energy as argument instead of moist static energy
 
 ! Main differences with convect3:
@@ -307 +314 @@
   REAL, DIMENSION (len, nd), INTENT (IN)             :: t, q, p
   REAL, DIMENSION (len, nd), INTENT (IN)             :: u, v
-  REAL, DIMENSION (len, nd), INTENT (IN)             :: hm, gz
+  REAL, DIMENSION (len, nd), INTENT (IN)             :: h, gz
   REAL, DIMENSION (len, nd+1), INTENT (IN)           :: ph
   REAL, DIMENSION (len), INTENT (IN)                 :: p1feed
@@ -378 +385 @@
     pup(i) = p2feed(i)
   END DO
-  CALL cv3_vertmix(len, nd, iflag, p1feed, pup, p, ph, &
-                   t, q, u, v, wght, &
-                   wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plclup)
+  IF (fl_cor_ebil >=2 ) THEN
+    CALL cv3_estatmix(len, nd, iflag, p1feed, pup, p, ph, &
+                     t, q, u, v, h, gz, wght, &
+                     wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plclup)
+  ELSE
+    CALL cv3_enthalpmix(len, nd, iflag, p1feed, pup, p, ph, &
+                       t, q, u, v, wght, &
+                       wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plclup)
+  ENDIF  ! (fl_cor_ebil >=2 ) 
 ! 1.b- LCL associated with ph(nk+1)
   DO i = 1, len
     plo(i) = ph(i, nk(i)+1)
   END DO
-  CALL cv3_vertmix(len, nd, iflag, p1feed, plo, p, ph, &
-                   t, q, u, v, wght, &
-                   wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plcllo)
+  IF (fl_cor_ebil >=2 ) THEN
+    CALL cv3_estatmix(len, nd, iflag, p1feed, plo, p, ph, &
+                     t, q, u, v, h, gz, wght, &
+                     wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plcllo)
+  ELSE
+    CALL cv3_enthalpmix(len, nd, iflag, p1feed, plo, p, ph, &
+                       t, q, u, v, wght, &
+                       wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plcllo)
+  ENDIF  ! (fl_cor_ebil >=2 ) 
 ! 2- Iterations
   niter = 5
@@ -434 +453 @@
 !jyg>
 
-    CALL cv3_vertmix(len, nd, iflag, p1feed, pfeed, p, ph, &
-                   t, q, u, v, wght, &
-                   wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plclfeed)
+    IF (fl_cor_ebil >=2 ) THEN
+      CALL cv3_estatmix(len, nd, iflag, p1feed, pfeed, p, ph, &
+                       t, q, u, v, h, gz, wght, &
+                       wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plclfeed)
+    ELSE
+      CALL cv3_enthalpmix(len, nd, iflag, p1feed, pfeed, p, ph, &
+                         t, q, u, v, wght, &
+                         wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plclfeed)
+    ENDIF  ! (fl_cor_ebil >=2 ) 
 !jyg20140217<
     IF (ok_new_feed) THEN
@@ -1647 +1672 @@
       DO i = 1, ncum
         IF ((k>=icb(i)) .AND. (k<=inb(i))) THEN
+!jyg<   (energy conservation tests)
+!!          hp(i, k) = hnk(i) + (lv(i,k)+(cpd-cpv)*tp(i,k))*ep(i, k)*clw(i, k)
+!!          hp(i, k) = ( hnk(i) + (lv(i,k)+(cpd-cpv)*t(i,k))*ep(i, k)*clw(i, k) ) / &
+!!                     (1. - ep(i,k)*clw(i,k))
+!!          hp(i, k) = ( hnk(i) + (lv(i,k)+(cpd-cl)*t(i,k))*ep(i, k)*clw(i, k) ) / &
+!!                     (1. - ep(i,k)*clw(i,k))
           hp(i, k) = hnk(i) + (lv(i,k)+(cpd-cpv)*t(i,k))*ep(i, k)*clw(i, k)
         END IF
@@ -2984 +3015 @@
                      qcondc, wd, &
                      ftd, fqd, qnk, qtc, sigt, tau_cld_cv, coefw_cld_cv)
+
+    USE print_control_mod, ONLY: lunout, prt_level
+    USE add_phys_tend_mod, only : fl_cor_ebil
 
   IMPLICIT NONE
@@ -3220 +3254 @@
 
       IF ((0.01*grav*work(il)*am(il))>=delti) iflag(il) = 1 !consist vect
-      ft(il, 1) = ft(il, 1) + 0.01*grav*work(il)*am(il) * &
-                                   (t(il,2)-t(il,1)+(gz(il,2)-gz(il,1))/cpn(il,1))
+!jyg<
+        IF (fl_cor_ebil >= 2) THEN
+          ft(il, 1) = ft(il, 1) + 0.01*grav*work(il)*am(il) * &
+                    ((t(il,2)-t(il,1))*cpn(il,2)+gz(il,2)-gz(il,1))/cpn(il,1)
+        ELSE
+          ft(il, 1) = ft(il, 1) + 0.01*grav*work(il)*am(il) * &
+                    (t(il,2)-t(il,1)+(gz(il,2)-gz(il,1))/cpn(il,1))
+        ENDIF
+!>jyg
     END IF ! iflag
   END DO
@@ -3529 +3570 @@
 
 ! sature
-        ft(il, i) = ft(il, i) + 0.01*grav*dpinv * &
+!jyg<
+        IF (fl_cor_ebil >= 2) THEN
+          ft(il, i) = ft(il, i) + 0.01*grav*dpinv * &
+              ( amp1(il)*( (t(il,i+1)-t(il,i))*cpn(il,i+1) + gz(il,i+1)-gz(il,i))*cpinv - &
+                ad(il)*( (t(il,i)-t(il,i-1))*cpn(il,i-1) + gz(il,i)-gz(il,i-1))*cpinv)
+        ELSE
+          ft(il, i) = ft(il, i) + 0.01*grav*dpinv * &
                      (amp1(il)*(t(il,i+1)-t(il,i) + (gz(il,i+1)-gz(il,i))*cpinv) - &
                       ad(il)*(t(il,i)-t(il,i-1)+(gz(il,i)-gz(il,i-1))*cpinv))
+        ENDIF
+!>jyg
 
 
@@ -3538 +3587 @@
                                     t(il,i)*(cpv-cpd)*(rr(il,i)-qent(il,i,i)))*cpinv
         END IF
-
-
-
+!
 ! sb: on ne fait pas encore la correction permettant de mieux
 ! conserver l'eau:
@@ -3873 +3920 @@
 
 !!!!      do 700 i=1,icb(il)-1
-  DO i = 1, nl
-    DO il = 1, ncum
-      IF (i<=(icb(il)-1) .AND. iflag(il)<=1) THEN
-        ftd(il, i) = esum(il)*t_wake(il, i)/(th_wake(il,i)*hsum(il))
-        fqd(il, i) = fsum(il)/gsum(il)
-        ft(il, i) = ftd(il, i) + asum(il)*t(il, i)/(th(il,i)*dsum(il))
-        fr(il, i) = fqd(il, i) + bsum(il)/csum(il)
-      END IF
-    END DO
-  END DO
+  IF (ok_homo_tend) THEN
+    DO i = 1, nl
+      DO il = 1, ncum
+        IF (i<=(icb(il)-1) .AND. iflag(il)<=1) THEN
+          ftd(il, i) = esum(il)*t_wake(il, i)/(th_wake(il,i)*hsum(il))
+          fqd(il, i) = fsum(il)/gsum(il)
+          ft(il, i) = ftd(il, i) + asum(il)*t(il, i)/(th(il,i)*dsum(il))
+          fr(il, i) = fqd(il, i) + bsum(il)/csum(il)
+        END IF
+      END DO
+    END DO
+  ENDIF
 
 !jyg<
@@ -3920 +3969 @@
   END DO
 !
-!    print *,' YIELD : alpha_qpos ',alpha_qpos(1)
+    IF (prt_level .GE. 5) THEN
+      print *,' CV3_YIELD : alpha_qpos ',alpha_qpos(1)
+    ENDIF
 !
   DO il = 1, ncum