Changeset 4853 for LMDZ6/trunk/libf/phylmd/ecrad/radiation/radiation_mcica_lw.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_mcica_lw.F90 (modified) (6 diffs)

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

@@ -19 +19 @@
 !   2017-10-23  R. Hogan  Renamed single-character variables
 
+#include "ecrad_config.h"
+
 module radiation_mcica_lw
 
@@ -124 +126 @@
     ! Identify clear-sky layers
     logical :: is_clear_sky_layer(nlev)
+
+    ! Temporary storage for more efficient summation
+#ifdef DWD_REDUCTION_OPTIMIZATIONS
+    real(jprb), dimension(nlev+1,2) :: sum_aux
+#else
+    real(jprb) :: sum_up, sum_dn
+#endif
 
     ! Index of the highest cloudy layer
@@ -179 +188 @@
 
       ! Sum over g-points to compute broadband fluxes
-      flux%lw_up_clear(jcol,:) = sum(flux_up_clear,1)
-      flux%lw_dn_clear(jcol,:) = sum(flux_dn_clear,1)
+#ifdef DWD_REDUCTION_OPTIMIZATIONS
+      sum_aux(:,:) = 0.0_jprb
+      do jg = 1,ng
+        do jlev = 1,nlev+1
+          sum_aux(jlev,1) = sum_aux(jlev,1) + flux_up_clear(jg,jlev)
+          sum_aux(jlev,2) = sum_aux(jlev,2) + flux_dn_clear(jg,jlev)
+        end do
+      end do
+      flux%lw_up_clear(jcol,:) = sum_aux(:,1)
+      flux%lw_dn_clear(jcol,:) = sum_aux(:,2)
+#else
+      do jlev = 1,nlev+1
+        sum_up = 0.0_jprb
+        sum_dn = 0.0_jprb
+        !$omp simd reduction(+:sum_up, sum_dn)
+        do jg = 1,ng
+          sum_up = sum_up + flux_up_clear(jg,jlev)
+          sum_dn = sum_dn + flux_dn_clear(jg,jlev)
+        end do
+        flux%lw_up_clear(jcol,jlev) = sum_up
+        flux%lw_dn_clear(jcol,jlev) = sum_dn
+      end do
+#endif
+
       ! Store surface spectral downwelling fluxes
       flux%lw_dn_surf_clear_g(:,jcol) = flux_dn_clear(:,nlev+1)
@@ -279 +310 @@
           else
             ! Clear-sky layer: copy over clear-sky values
-            reflectance(:,jlev) = ref_clear(:,jlev)
-            transmittance(:,jlev) = trans_clear(:,jlev)
-            source_up(:,jlev) = source_up_clear(:,jlev)
-            source_dn(:,jlev) = source_dn_clear(:,jlev)
+            do jg = 1,ng
+              reflectance(jg,jlev) = ref_clear(jg,jlev)
+              transmittance(jg,jlev) = trans_clear(jg,jlev)
+              source_up(jg,jlev) = source_up_clear(jg,jlev)
+              source_dn(jg,jlev) = source_dn_clear(jg,jlev)
+            end do
           end if
         end do
@@ -307 +340 @@
         
         ! Store overcast broadband fluxes
-        flux%lw_up(jcol,:) = sum(flux_up,1)
-        flux%lw_dn(jcol,:) = sum(flux_dn,1)
+#ifdef DWD_REDUCTION_OPTIMIZATIONS
+        sum_aux(:,:) = 0._jprb
+        do jg = 1, ng
+          do jlev = 1, nlev+1
+            sum_aux(jlev,1) = sum_aux(jlev,1) + flux_up(jg,jlev)
+            sum_aux(jlev,2) = sum_aux(jlev,2) + flux_dn(jg,jlev)
+          end do
+        end do
+        flux%lw_up(jcol,:) = sum_aux(:,1)
+        flux%lw_dn(jcol,:) = sum_aux(:,2)
+#else
+        do jlev = 1,nlev+1
+          sum_up = 0.0_jprb
+          sum_dn = 0.0_jprb
+          !$omp simd reduction(+:sum_up, sum_dn)
+          do jg = 1,ng
+            sum_up = sum_up + flux_up(jg,jlev)
+            sum_dn = sum_dn + flux_dn(jg,jlev)
+          end do
+          flux%lw_up(jcol,jlev) = sum_up
+          flux%lw_dn(jcol,jlev) = sum_dn
+        end do
+#endif
 
         ! Cloudy flux profiles currently assume completely overcast
         ! skies; perform weighted average with clear-sky profile
-        flux%lw_up(jcol,:) =  total_cloud_cover *flux%lw_up(jcol,:) &
-             &  + (1.0_jprb - total_cloud_cover)*flux%lw_up_clear(jcol,:)
-        flux%lw_dn(jcol,:) =  total_cloud_cover *flux%lw_dn(jcol,:) &
-             &  + (1.0_jprb - total_cloud_cover)*flux%lw_dn_clear(jcol,:)
+        do jlev = 1,nlev+1
+          flux%lw_up(jcol,jlev) =  total_cloud_cover *flux%lw_up(jcol,jlev) &
+             &       + (1.0_jprb - total_cloud_cover)*flux%lw_up_clear(jcol,jlev)
+          flux%lw_dn(jcol,jlev) =  total_cloud_cover *flux%lw_dn(jcol,jlev) &
+             &       + (1.0_jprb - total_cloud_cover)*flux%lw_dn_clear(jcol,jlev)
+        end do
         ! Store surface spectral downwelling fluxes
         flux%lw_dn_surf_g(:,jcol) = total_cloud_cover*flux_dn(:,nlev+1) &
@@ -335 +391 @@
         ! No cloud in profile and clear-sky fluxes already
         ! calculated: copy them over
-        flux%lw_up(jcol,:) = flux%lw_up_clear(jcol,:)
-        flux%lw_dn(jcol,:) = flux%lw_dn_clear(jcol,:)
+        do jlev = 1,nlev+1
+          flux%lw_up(jcol,jlev) = flux%lw_up_clear(jcol,jlev)
+          flux%lw_dn(jcol,jlev) = flux%lw_dn_clear(jcol,jlev)
+        end do
         flux%lw_dn_surf_g(:,jcol) = flux%lw_dn_surf_clear_g(:,jcol)
         if (config%do_lw_derivatives) then