Changeset 4489 for LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud_optics.F90

Timestamp:

Mar 31, 2023, 8:42:57 PM (17 months ago)

Author:

lguez

Message:

Merge LMDZ_ECRad branch back into trunk!

Location:

LMDZ6/trunk

Files:

• . (modified) (1 prop)
• libf/phylmd/ecrad/radiation_cloud_optics.F90 (modified) (5 diffs)

LMDZ6/trunk/libf/phylmd/ecrad/radiation_cloud_optics.F90

@@ -19 +19 @@
 
   implicit none
+
   public
 
@@ -271 +272 @@
     type(cloud_optics_type), pointer :: ho
 
-    integer    :: jcol, jlev
+    integer    :: jcol, jlev, jb
 
     real(jprb) :: hook_handle
@@ -345 +346 @@
             end if
 
+            ! Delta-Eddington scaling in the shortwave only
             if (.not. config%do_sw_delta_scaling_with_gases) then
-              ! Delta-Eddington scaling in the shortwave only
               call delta_eddington_scat_od(od_sw_liq, scat_od_sw_liq, g_sw_liq)
             end if
+            !call delta_eddington_scat_od(od_lw_liq, scat_od_lw_liq, g_lw_liq)
+
           else
             ! Liquid not present: set properties to zero
@@ -437 +440 @@
             end if
 
+            ! Delta-Eddington scaling in both longwave and shortwave
+            ! (assume that particles are larger than wavelength even
+            ! in longwave)
             if (.not. config%do_sw_delta_scaling_with_gases) then
-              ! Delta-Eddington scaling in both longwave and shortwave
-              ! (assume that particles are larger than wavelength even
-              ! in longwave)
               call delta_eddington_scat_od(od_sw_ice, scat_od_sw_ice, g_sw_ice)
             end if
-
             call delta_eddington_scat_od(od_lw_ice, scat_od_lw_ice, g_lw_ice)
+
           else
             ! Ice not present: set properties to zero
@@ -458 +461 @@
           ! Combine liquid and ice 
           if (config%do_lw_cloud_scattering) then
-            od_lw_cloud(:,jlev,jcol) = od_lw_liq + od_lw_ice
-            where (scat_od_lw_liq+scat_od_lw_ice > 0.0_jprb)
-              g_lw_cloud(:,jlev,jcol) = (g_lw_liq * scat_od_lw_liq &
-                   &  + g_lw_ice * scat_od_lw_ice) &
-                   &  / (scat_od_lw_liq+scat_od_lw_ice)
-            elsewhere
-              g_lw_cloud(:,jlev,jcol) = 0.0_jprb
-            end where
-            ssa_lw_cloud(:,jlev,jcol) = (scat_od_lw_liq + scat_od_lw_ice) &
-                 &                    / (od_lw_liq + od_lw_ice)
+! Added for DWD (2020)
+!NEC$ shortloop
+            do jb = 1, config%n_bands_lw
+              od_lw_cloud(jb,jlev,jcol) = od_lw_liq(jb) + od_lw_ice(jb)
+              if (scat_od_lw_liq(jb)+scat_od_lw_ice(jb) > 0.0_jprb) then
+                g_lw_cloud(jb,jlev,jcol) = (g_lw_liq(jb) * scat_od_lw_liq(jb) &
+                   &  + g_lw_ice(jb) * scat_od_lw_ice(jb)) &
+                   &  / (scat_od_lw_liq(jb)+scat_od_lw_ice(jb))
+              else
+                g_lw_cloud(jb,jlev,jcol) = 0.0_jprb
+              end if
+              ssa_lw_cloud(jb,jlev,jcol) = (scat_od_lw_liq(jb) + scat_od_lw_ice(jb)) &
+                 &                    / (od_lw_liq(jb) + od_lw_ice(jb))
+            end do
           else
             ! If longwave scattering is to be neglected then the
             ! best approximation is to set the optical depth equal
             ! to the absorption optical depth
-            od_lw_cloud(:,jlev,jcol) = od_lw_liq - scat_od_lw_liq &
-                 &                   + od_lw_ice - scat_od_lw_ice
+! Added for DWD (2020)
+!NEC$ shortloop
+            do jb = 1, config%n_bands_lw
+              od_lw_cloud(jb,jlev,jcol) = od_lw_liq(jb) - scat_od_lw_liq(jb) &
+                    &                   + od_lw_ice(jb) - scat_od_lw_ice(jb)
+            end do
           end if
-          od_sw_cloud(:,jlev,jcol) = od_sw_liq + od_sw_ice
-          g_sw_cloud(:,jlev,jcol) = (g_sw_liq * scat_od_sw_liq &
-               &  + g_sw_ice * scat_od_sw_ice) &
-               &  / (scat_od_sw_liq + scat_od_sw_ice)
-          ssa_sw_cloud(:,jlev,jcol) &
-               &  = (scat_od_sw_liq + scat_od_sw_ice) / (od_sw_liq + od_sw_ice)
+! Added for DWD (2020)
+!NEC$ shortloop
+          do jb = 1, config%n_bands_sw
+            od_sw_cloud(jb,jlev,jcol) = od_sw_liq(jb) + od_sw_ice(jb)
+            g_sw_cloud(jb,jlev,jcol) = (g_sw_liq(jb) * scat_od_sw_liq(jb) &
+               &  + g_sw_ice(jb) * scat_od_sw_ice(jb)) &
+               &  / (scat_od_sw_liq(jb) + scat_od_sw_ice(jb))
+            ssa_sw_cloud(jb,jlev,jcol) &
+               &  = (scat_od_sw_liq(jb) + scat_od_sw_ice(jb)) / (od_sw_liq(jb) + od_sw_ice(jb))
+          end do
         end if ! Cloud present
       end do ! Loop over column