Changeset 4853 for LMDZ6/trunk/libf/phylmd/ecrad/radiation/radiation_tripleclouds_sw.F90

Timestamp:

Mar 19, 2024, 3:34:21 PM (2 months ago)

Author:

idelkadi

Message:

Ecrad update in LMDZ / Implementation of Ecrad double call in LMDZ

• version 1.6.1 (commit 210d7911380f53a788c3cad73b3cf9b4e022ef87)
• interface routines between lmdz and ecrad grouped in a new "lmdz" directory
• double call method redesigned so as to go through the Ecrad initialization and configuration part only once for the entire simulation
• clean-up in the read.F routine: delete unitules arguments
• modification of default gas model in namelist (default: ECCKD)

File:

• LMDZ6/trunk/libf/phylmd/ecrad/radiation/radiation_tripleclouds_sw.F90 (modified) (7 diffs)

LMDZ6/trunk/libf/phylmd/ecrad/radiation/radiation_tripleclouds_sw.F90

@@ -74 +74 @@
     ! Gas and aerosol optical depth, single-scattering albedo and
     ! asymmetry factor at each shortwave g-point
-!    real(jprb), intent(in), dimension(istartcol:iendcol,nlev,config%n_g_sw) :: &
-    real(jprb), intent(in), dimension(config%n_g_sw,nlev,istartcol:iendcol) :: &
-         &  od, ssa, g
+    real(jprb), intent(in), dimension(config%n_g_sw,nlev,istartcol:iendcol) &
+         &  :: od, ssa, g
 
     ! Cloud and precipitation optical depth, single-scattering albedo and
     ! asymmetry factor in each shortwave band
-    real(jprb), intent(in), dimension(config%n_bands_sw,nlev,istartcol:iendcol) :: &
-         &  od_cloud, ssa_cloud, g_cloud
+    real(jprb), intent(in), dimension(config%n_bands_sw,nlev,istartcol:iendcol) &
+         &  :: od_cloud, ssa_cloud, g_cloud
 
     ! Optical depth, single scattering albedo and asymmetry factor in
@@ -92 +91 @@
     ! flux into a plane perpendicular to the incoming radiation at
     ! top-of-atmosphere in each of the shortwave g points
-    real(jprb), intent(in), dimension(config%n_g_sw,istartcol:iendcol) :: &
-         &  albedo_direct, albedo_diffuse, incoming_sw
+    real(jprb), intent(in), dimension(config%n_g_sw,istartcol:iendcol) &
+         &  :: albedo_direct, albedo_diffuse, incoming_sw
 
     ! Output
@@ -166 +165 @@
     real(jprb) :: scat_od, scat_od_cloud
 
+    ! Temporaries to speed up summations
+    real(jprb) :: sum_dn_diff, sum_dn_dir, sum_up
+
+    ! Local cosine of solar zenith angle
     real(jprb) :: mu0
 
@@ -444 +447 @@
       end if
       
-      ! Store the TOA broadband fluxes
-      flux%sw_up(jcol,1) = sum(sum(flux_up,1))
-      flux%sw_dn(jcol,1) = mu0 * sum(sum(direct_dn,1))
+      ! Store the TOA broadband fluxes, noting that there is no
+      ! diffuse downwelling at TOA. The intrinsic "sum" command has
+      ! been found to be very slow; better performance is found on
+      ! x86-64 architecture with explicit loops and the "omp simd
+      ! reduction" directive.
+      sum_up     = 0.0_jprb
+      sum_dn_dir = 0.0_jprb
+      do jreg = 1,nregions
+        !$omp simd reduction(+:sum_up, sum_dn_dir)
+        do jg = 1,ng
+          sum_up     = sum_up     + flux_up(jg,jreg)
+          sum_dn_dir = sum_dn_dir + direct_dn(jg,jreg)
+        end do
+      end do
+      flux%sw_up(jcol,1) = sum_up
+      flux%sw_dn(jcol,1) = mu0 * sum_dn_dir
       if (allocated(flux%sw_dn_direct)) then
         flux%sw_dn_direct(jcol,1) = flux%sw_dn(jcol,1)
       end if
       if (config%do_clear) then
-        flux%sw_up_clear(jcol,1) = sum(flux_up_clear)
-        flux%sw_dn_clear(jcol,1) = mu0 * sum(direct_dn_clear)
+        sum_up     = 0.0_jprb
+        sum_dn_dir = 0.0_jprb
+        !$omp simd reduction(+:sum_up, sum_dn_dir)
+        do jg = 1,ng
+          sum_up     = sum_up     + flux_up_clear(jg)
+          sum_dn_dir = sum_dn_dir + direct_dn_clear(jg)
+        end do
+        flux%sw_up_clear(jcol,1) = sum_up
+        flux%sw_dn_clear(jcol,1) = mu0 * sum_dn_dir
         if (allocated(flux%sw_dn_direct_clear)) then
           flux%sw_dn_direct_clear(jcol,1) = flux%sw_dn_clear(jcol,1)
@@ -467 +490 @@
              &           config%i_spec_from_reordered_g_sw, &
              &           flux%sw_dn_band(:,jcol,1))
-        flux%sw_dn_band(:,jcol,1) = &
-             &  mu0 * flux%sw_dn_band(:,jcol,1)
+        flux%sw_dn_band(:,jcol,1) = mu0 * flux%sw_dn_band(:,jcol,1)
         if (allocated(flux%sw_dn_direct_band)) then
           flux%sw_dn_direct_band(:,jcol,1) = flux%sw_dn_band(:,jcol,1)
@@ -549 +571 @@
                ! nothing to do
 
-        ! Store the broadband fluxes
-        flux%sw_up(jcol,jlev+1) = sum(sum(flux_up,1))
+        ! Store the broadband fluxes. The intrinsic "sum" command has
+        ! been found to be very slow; better performance is found on
+        ! x86-64 architecture with explicit loops and the "omp simd
+        ! reduction" directive.
+        sum_up      = 0.0_jprb
+        sum_dn_dir  = 0.0_jprb
+        sum_dn_diff = 0.0_jprb
+        do jreg = 1,nregions
+          !$omp simd reduction(+:sum_up, sum_dn_diff, sum_dn_dir)
+          do jg = 1,ng
+            sum_up      = sum_up      + flux_up(jg,jreg)
+            sum_dn_diff = sum_dn_diff + flux_dn(jg,jreg)
+            sum_dn_dir  = sum_dn_dir  + direct_dn(jg,jreg)
+          end do
+        end do
+        flux%sw_up(jcol,jlev+1) = sum_up
+        flux%sw_dn(jcol,jlev+1) = mu0 * sum_dn_dir + sum_dn_diff
         if (allocated(flux%sw_dn_direct)) then
-          flux%sw_dn_direct(jcol,jlev+1) = mu0 * sum(sum(direct_dn,1))
-          flux%sw_dn(jcol,jlev+1) &
-               &  = flux%sw_dn_direct(jcol,jlev+1) + sum(sum(flux_dn,1))
-        else
-          flux%sw_dn(jcol,jlev+1) = mu0 * sum(sum(direct_dn,1)) + sum(sum(flux_dn,1))   
+          flux%sw_dn_direct(jcol,jlev+1) = mu0 * sum_dn_dir
         end if
         if (config%do_clear) then
-          flux%sw_up_clear(jcol,jlev+1) = sum(flux_up_clear)
+          sum_up      = 0.0_jprb
+          sum_dn_dir  = 0.0_jprb
+          sum_dn_diff = 0.0_jprb
+          !$omp simd reduction(+:sum_up, sum_dn_diff, sum_dn_dir)
+          do jg = 1,ng
+            sum_up      = sum_up      + flux_up_clear(jg)
+            sum_dn_diff = sum_dn_diff + flux_dn_clear(jg)
+            sum_dn_dir  = sum_dn_dir  + direct_dn_clear(jg)
+          end do
+          flux%sw_up_clear(jcol,jlev+1) = sum_up
+          flux%sw_dn_clear(jcol,jlev+1) = mu0 * sum_dn_dir + sum_dn_diff
           if (allocated(flux%sw_dn_direct_clear)) then
-            flux%sw_dn_direct_clear(jcol,jlev+1) = mu0 * sum(direct_dn_clear)
-            flux%sw_dn_clear(jcol,jlev+1) &
-                 &  = flux%sw_dn_direct_clear(jcol,jlev+1) + sum(flux_dn_clear)
-          else
-            flux%sw_dn_clear(jcol,jlev+1) = mu0 * sum(direct_dn_clear) &
-                 &  + sum(flux_dn_clear)
+            flux%sw_dn_direct_clear(jcol,jlev+1) = mu0 * sum_dn_dir
           end if
         end if
@@ -605 +643 @@
           end if
         end if
-
       end do ! Final loop over levels