Changeset 5794 for LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp_main.f90

Timestamp:

Jul 29, 2025, 5:41:19 PM (7 days ago)

Author:

aborella

Message:

Added an option to increase cirrus cover for radiative transfer (Brooks et al, 2005)

File:

• LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp_main.f90 (modified) (8 diffs)

LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp_main.f90

@@ -31 +31 @@
      dqvc_sub, dqvc_con, dqvc_mix, qsatl, qsati,        &
      cfc_seri, qtc_seri, nic_seri,                      &
-     qice_cont, flight_dist, flight_fuel, qradice_cont, &
+     qice_cont, flight_dist, flight_fuel,               &
+     contfrarad, qradice_cont,                          &
      Tcritcont, qcritcont, potcontfraP, potcontfraNP,   &
      cloudth_sth,                                       &
@@ -129 +130 @@
 USE lmdz_lscp_ini, ONLY : ok_weibull_warm_clouds, ok_no_issr_strato, ok_ice_sedim
 USE lmdz_lscp_ini, ONLY : ok_plane_contrail
-USE lmdz_lscp_ini, ONLY : ok_nodeep_lscp, ok_nodeep_lscp_rad
+USE lmdz_lscp_ini, ONLY : ok_nodeep_lscp, ok_nodeep_lscp_rad, ok_higher_cirrus_cover
 USE lmdz_lscp_ini, ONLY : ok_lscp_mergecond, gamma_mixth
 
@@ -281 +282 @@
 
   REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qice_cont      !--condensed water in contrails [kg/kg]
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: contfrarad     !--contrail fraction for radiation [-]
   REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qradice_cont   !--condensed water in contrails used in the radiation scheme [kg/kg]
   REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: Tcritcont      !--critical temperature for contrail formation [K]
@@ -356 +358 @@
   REAL, DIMENSION(klon) :: zradocond, zradoice
   REAL, DIMENSION(klon) :: zrho_up, zvelo_up
+  REAL :: dz, coef_cover
   
   ! for condensation and ice supersaturation
@@ -742 +745 @@
 
 
+        DO i = 1, klon
+          !--Calculate the shear value (input for condensation and ice supersat)
+          !--Cell thickness [m]
+          delta_z = ( paprs(i,k) - paprs(i,k+1) ) / RG / pplay(i,k) * zt(i) * RD
+          IF ( iftop ) THEN
+            ! top
+            shear(i) = SQRT( ( (u_seri(i,k) - u_seri(i,k-1)) / delta_z )**2. &
+                           + ( (v_seri(i,k) - v_seri(i,k-1)) / delta_z )**2. )
+          ELSEIF ( k .EQ. 1 ) THEN
+            ! surface
+            shear(i) = SQRT( ( (u_seri(i,k+1) - u_seri(i,k)) / delta_z )**2. &
+                           + ( (v_seri(i,k+1) - v_seri(i,k)) / delta_z )**2. )
+          ELSE
+            ! other layers
+            shear(i) = SQRT( ( ( (u_seri(i,k+1) + u_seri(i,k)) / 2. &
+                               - (u_seri(i,k) + u_seri(i,k-1)) / 2. ) / delta_z )**2. &
+                           + ( ( (v_seri(i,k+1) + v_seri(i,k)) / 2. &
+                               - (v_seri(i,k) + v_seri(i,k-1)) / 2. ) / delta_z )**2. )
+          ENDIF
+        ENDDO
+
         IF ( ok_ice_supersat ) THEN
 
@@ -832 +856 @@
                   nic_seri(i,k) = nic_seri(i,k) * deepconv_coef
                 ENDIF
-              ENDIF
-
-              !--Calculate the shear value (input for condensation and ice supersat)
-              !--Cell thickness [m]
-              delta_z = ( paprs(i,k) - paprs(i,k+1) ) / RG / pplay(i,k) * zt(i) * RD
-              IF ( iftop ) THEN
-                ! top
-                shear(i) = SQRT( ( (u_seri(i,k) - u_seri(i,k-1)) / delta_z )**2. &
-                               + ( (v_seri(i,k) - v_seri(i,k-1)) / delta_z )**2. )
-              ELSEIF ( k .EQ. 1 ) THEN
-                ! surface
-                shear(i) = SQRT( ( (u_seri(i,k+1) - u_seri(i,k)) / delta_z )**2. &
-                               + ( (v_seri(i,k+1) - v_seri(i,k)) / delta_z )**2. )
-              ELSE
-                ! other layers
-                shear(i) = SQRT( ( ( (u_seri(i,k+1) + u_seri(i,k)) / 2. &
-                                   - (u_seri(i,k) + u_seri(i,k-1)) / 2. ) / delta_z )**2. &
-                               + ( ( (v_seri(i,k+1) + v_seri(i,k)) / 2. &
-                                   - (v_seri(i,k) + v_seri(i,k-1)) / 2. ) / delta_z )**2. )
               ENDIF
             ENDIF
@@ -1415 +1420 @@
       qtc_seri(:,k) = qcont(:)
       nic_seri(:,k) = Ncont(:)
+      contfrarad(:,k) = contfra(:)
     ENDIF
 
     IF ( ok_ice_supersat ) THEN
-
       DO i = 1, klon
 
@@ -1470 +1475 @@
         qsub(i,k) = zq(i) - qvc(i) - qissr(i,k)
         qcld(i,k) = qvc(i) + zoliq(i)
+
+        IF ( ok_higher_cirrus_cover .AND. pt_pron_clds(i) .AND. .NOT. ptconv(i,k) ) THEN
+          !--Following Brooks et al. (2005)
+          !--This is only valid for cirrus clouds
+          !--We do not apply it do convective clouds
+          IF ( ( rneb(i,k) .GT. eps ) .AND. ( rneb(i,k) .LT. (1. - eps) ) ) THEN
+            dz = ( paprs(i,k) - paprs(i,k+1) ) / RG / pplay(i,k) * zt(i) * RD
+            coef_cover = (0.0706 + 0.1274 * shear(i)**0.3015) &
+                * dz**0.7679 / SQRT(cell_area(i))**0.2254
+            rneb(i,k) = 1. / (1. + EXP(-coef_cover) * (1. / rneb(i,k) - 1.))
+            IF ( contfrarad(i,k) .GT. eps ) THEN
+              contfrarad(i,k) = cfc_seri(i,k) / cf_seri(i,k) * rneb(i,k)
+            ENDIF
+          ENDIF
+        ENDIF
 
         !--Calculation of the ice supersaturated fraction following Lamquin et al (2012)