Changeset 4838

Timestamp:

Mar 2, 2024, 12:54:02 AM (2 months ago)

Author:

fhourdin

Message:

Nouvelle version poches (Lamine, Jean-Yves, Fredho)

File:

• LMDZ6/trunk/libf/phylmd/lmdz_wake.F90 (modified) (3 diffs)

LMDZ6/trunk/libf/phylmd/lmdz_wake.F90

@@ -2449 +2449 @@
 REAL,     DIMENSION (klon)         :: sum_dth
 
+INTEGER,     DIMENSION (klon)                     :: k_ptop_provis
+REAL,     DIMENSION (klon)                        :: omega        !!
+REAL,     DIMENSION (klon,klev+1)                 :: int_dth      !! 
+REAL,     DIMENSION (klon,klev+1)                 :: dzz          !!
+REAL,     DIMENSION (klon,klev+1)                 :: zzz          !!
+REAL,     DIMENSION (klon)                 :: frac_int_dth          !!
+REAL                                              :: epsil        !!
+REAL                                              :: ddd!!
+
+LOGICAL :: new_ptop
+
+INTEGER, SAVE :: ipas=0
+
+
+LOGICAL new_top
+
 !INTEGER, SAVE :: compte=0
 
@@ -2456 +2472 @@
 !compte=compte+1
 !print*,'compte=',compte
+
+new_top=.false.
 
  
@@ -2618 +2636 @@
     kupper(i) = min(kupper(i), klev-1)
   END DO 
+
+    ! -----------------------------------------------------------------------
+    ! nouveau calcul de hw et ptop
+    ! -----------------------------------------------------------------------
+if (new_ptop) then
+    
+    epsil = 0.05                            ! 5 pour cent
+   !  epsil = 0.20
+    
+       DO i = 1, klon
+          IF (wk_adv(i)) THEN 
+             int_dth(i,1) = 0.
+         END IF
+       END DO
+    
+    
+    
+    DO K = 2, klev+1
+       Do i = 1, klon
+          IF (wk_adv(i)) THEN
+             if (k<=k_ptop_provis(i)) then
+                  ddd=dth(i,k-1)*(ph(i,k-1) - min(ptop_provis(i),ph(i,k)))
+             else
+                  ddd=0.
+             endif
+             int_dth(i,k) = int_dth(i,k-1) + ddd
+          END IF
+       END DO
+    END DO
+   ! print*, 'xxx, int_dth', (k,int_dth(1,k),k=1,klev)
+   ! print*, 'xxx, k_ptop_provis', k_ptop_provis(1)
+   
+ 
+    DO i=1,klon
+       IF (wk_adv(i)) THEN
+        frac_int_dth(i)=(1.-epsil)*int_dth(i,k_ptop_provis(i))
+       ENDIF
+    ENDDO
+    DO k = 1,klev
+       DO i =1, klon
+!         print*,ipas,'yyy ',k,int_dth(i,k),frac_int_dth(i)
+          IF (wk_adv(i) .AND. int_dth(i,k)>=frac_int_dth(i)) THEN
+            ktop1(i) = min(k, k_ptop_provis(i))
+            !print*,ipas,'yyy ktop1= ',ktop1
+          END if
+       END DO
+    END DO
+    !print*, 'LAMINE'
+    
+    DO i = 1, klon
+       IF (wk_adv(i)) THEN
+           !print*, ipas,'xxx1, int_dth(i,ktop1(i)), frac_int_dth(i), int_dth(i,ktop1(i)+1) ',ktop1
+           ddd=int_dth(i,ktop1(i)+1)-int_dth(i,ktop1(i))
+           if (ddd==0.) then
+              omega(i)=0.
+           else
+              omega(i) = (frac_int_dth(i) - int_dth(i,ktop1(i)))/ddd
+           endif
+           print*,'OMEGA ',omega(i)
+       END IF
+    END DO
+    
+    print*, 'xxx'
+    DO i = 1, klon
+       IF (wk_adv(i)) THEN
+      ! print*, 'xxx, int_dth(i,ktop1(i)), frac_int_dth(i), int_dth(i,ktop1(i)+1) ', &
+      !               int_dth(i,ktop1(i)), frac_int_dth(i), int_dth(i,ktop1(i)+1)
+      ! print*, 'xxx, omega(i), ph(i,ktop1(i)), ph(i,ktop1(i)+1) ',  &
+      !e               omega(i), ph(i,ktop1(i)), ph(i,ktop1(i)+1)
+          ptop1(i) = min((1 - omega(i))*ph(i,ktop1(i)) + omega(i)*ph(i,ktop1(i)+1), ph(i,1))
+      END IF
+    END DO
+    
+    DO i=1, klon
+       IF (wk_adv(i)) THEN 
+           zzz(i, 1) = 0
+       END IF
+     END DO
+    DO k = 1, klev
+       DO i = 1, klon 
+           IF (wk_adv(i)) THEN         
+              dzz(i,k) = (ph(i,k) - ph(i,k+1))/(rho(i,k)*RG)
+              zzz(i,k+1) = zzz(i,k) + dzz(i,k)
+           END IF
+       END DO
+    END DO
+    
+    DO i =1, klon
+       IF (wk_adv(i)) THEN
+           h_zzz(i) = max((1- omega(i))*zzz(i,ktop1(i)) + omega(i)*zzz(i,ktop1(i)+1), hwmin)
+       END IF
+    END DO
+
+endif
+  !---------- FIN nouveau calcul hw et ptop -------------------------------------
+
     RETURN
 END SUBROUTINE pkupper