Changeset 5149 for LMDZ6/trunk/libf

Timestamp:

Jul 31, 2024, 2:38:51 PM (4 months ago)

Author:

Sebastien Nguyen

Message:

finished rewriting reevap.F90 with large arrays qx and d_qx_eva

File:

• LMDZ6/trunk/libf/phylmdiso/reevap.F90 (modified) (5 diffs)

LMDZ6/trunk/libf/phylmdiso/reevap.F90

@@ -22 +22 @@
     REAL, DIMENSION(klon,klev,nqtot), INTENT(in) ::     qx
     REAL, DIMENSION(klon,klev), INTENT(out) :: d_t_eva
-    REAL, DIMENSION(klon,klev,nqtot), INTENT(out) ::        d_qx_eva
+    REAL, DIMENSION(klon,klev,nqtot), INTENT(out) ::    d_qx_eva
 
     REAL za,zb,zdelta,zlvdcp,zlsdcp
@@ -35 +35 @@
     !IM 100106 BEG : pouvoir sortir les ctes de la physique
     !
-do ixt=1,1+ntiso
+    DO ixt = 1, 1+ntiso
     ! Re-evaporer l'eau liquide nuageuse
     !
@@ -43 +43 @@
 !print *,'rrevap ; fl_cor_ebil:',fl_cor_ebil,' iflag_ice_thermo:',iflag_ice_thermo,' RVTMP2',RVTMP2
     DO k = 1, klev  ! re-evaporation de l'eau liquide nuageuse
-       DO i = 1, klon
+      DO i = 1, klon
 
-        if (ixt.eq.1) then
-         if (fl_cor_ebil .GT. 0) then
-          !zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*(q_seri(i,k)+ql_seri(i,k)+qs_seri(i,k)))
-          !zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*(q_seri(i,k)+ql_seri(i,k)+qs_seri(i,k)))
-          zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*(qx(i,k,ivapcur)+qx(i,k,iliqcur)+qx(i,k,isolcur)))
-          zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*(qx(i,k,ivapcur)+qx(i,k,iliqcur)+qx(i,k,isolcur)))
-         else
-           zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*qx(i,k,ivapcur))
-           !jyg<
-           !  Attention : Arnaud a propose des formules completement differentes
-           !                  A verifier !!!
-           zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*qx(i,k,ivapcur))
-         end if
-         IF (iflag_ice_thermo .EQ. 0) THEN
-             zlsdcp=zlvdcp
+        IF (ixt == 1) THEN ! water
+          IF (fl_cor_ebil > 0) THEN
+            !zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*(q_seri(i,k)+ql_seri(i,k)+qs_seri(i,k)))
+            !zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*(q_seri(i,k)+ql_seri(i,k)+qs_seri(i,k)))
+            zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*(qx(i,k,ivapcur)+qx(i,k,iliqcur)+qx(i,k,isolcur)))
+            zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*(qx(i,k,ivapcur)+qx(i,k,iliqcur)+qx(i,k,isolcur)))
+          ELSE
+            zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*qx(i,k,ivapcur))
+            !jyg<
+            !  Attention : Arnaud a propose des formules completement differentes
+            !                  A verifier !!!
+            zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*qx(i,k,ivapcur))
          ENDIF
+          IF (iflag_ice_thermo == 0) THEN
+            zlsdcp=zlvdcp
+          ENDIF
           !>jyg
+        ENDIF
+        IF (iflag_ice_thermo == 0) THEN   
+           !pas necessaire a priori
+
+            zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
+            zdelta = 0.
+            zb = MAX(0.0,qx(i,k,iliqcur))
+            IF (ixt == 1) THEN
+              za = - MAX(0.0,qx(i,k,iliqcur)) &
+                   * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
+              d_t_eva(i,k) = za
+            ENDIF
+            d_qx_eva(i,k,ivapcur)  = zb
+            d_qx_eva(i,k,iliqcur) = -qx(i,k,iliqcur)
+            d_qx_eva(i,k,isolcur) = 0.
+
+        ELSE
+              
              !CR: on r\'e-\'evapore eau liquide et glace
 
@@ -68 +86 @@
              !        za = - MAX(0.0,ql_seri(i,k)) &
              !             * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
-             za = - MAX(0.0,qx(i,k,iliqcur))*zlvdcp & 
-                  - MAX(0.0,qx(i,k,iliqcur))*zlsdcp
-             d_t_eva(i,k) = za
-
-          endif !if (ixt.eq.1) then
-
+            IF (ixt == 1) THEN
+              za = - MAX(0.0,qx(i,k,iliqcur))*zlvdcp & 
+                   - MAX(0.0,qx(i,k,iliqcur))*zlsdcp
+              d_t_eva(i,k) = za
+            ENDIF
             !zb = MAX(0.0,ql_seri(i,k)+qs_seri(i,k))
             !d_q_eva(i,k) = zb
@@ -83 +100 @@
             d_qx_eva(i,k,iliqcur) = -qx(i,k,iliqcur)
             d_qx_eva(i,k,isolcur) = -qx(i,k,isolcur)
+        ENDIF
 
 
-       ENDDO
+      ENDDO
     ENDDO
 
-    enddo ! do ixt=1,1+niso*(nzone +1)
-    
+    ENDDO ! DO ixt = 1, 1+niso*(nzone +1)
 
 RETURN