Changeset 4584 for LMDZ6/branches/Portage_acc/libf/phylmd/ecrad/radiation_mcica_lw.F90

Timestamp:

Jun 23, 2023, 4:10:41 PM (12 months ago)

Author:

Laurent Fairhead

Message:

Merged trunk revisions from r4443 to r4582 (HEAD) into branch

File:

• LMDZ6/branches/Portage_acc/libf/phylmd/ecrad/radiation_mcica_lw.F90 (modified) (6 diffs)

LMDZ6/branches/Portage_acc/libf/phylmd/ecrad/radiation_mcica_lw.F90

@@ -157 +157 @@
         ! transmittance etc at each model level
         do jlev = 1,nlev
-          ssa_total = ssa(:,jlev,jcol)
-          g_total   = g(:,jlev,jcol)
-          call calc_two_stream_gammas_lw(ng, ssa_total, g_total, &
+          call calc_two_stream_gammas_lw(ng, ssa(:,jlev,jcol), g(:,jlev,jcol), &
                &  gamma1, gamma2)
           call calc_reflectance_transmittance_lw(ng, &
@@ -206 +204 @@
            &  config%cloud_inhom_decorr_scaling, cloud%fractional_std(jcol,:), &
            &  config%pdf_sampler, od_scaling, total_cloud_cover, &
-           &  is_beta_overlap=config%use_beta_overlap)
+           &  use_beta_overlap=config%use_beta_overlap, &
+           &  use_vectorizable_generator=config%use_vectorizable_generator)
       
       ! Store total cloud cover
@@ -225 +224 @@
             end if
 
-            od_cloud_new = od_scaling(:,jlev) &
-                 &  * od_cloud(config%i_band_from_reordered_g_lw,jlev,jcol)
-            od_total = od(:,jlev,jcol) + od_cloud_new
-            ssa_total = 0.0_jprb
-            g_total   = 0.0_jprb
+            do jg = 1,ng
+              od_cloud_new(jg) = od_scaling(jg,jlev) &
+                 &  * od_cloud(config%i_band_from_reordered_g_lw(jg),jlev,jcol)
+              od_total(jg)  = od(jg,jlev,jcol) + od_cloud_new(jg)
+              ssa_total(jg) = 0.0_jprb
+              g_total(jg)   = 0.0_jprb
+            end do
 
             if (config%do_lw_cloud_scattering) then
@@ -239 +240 @@
                 ! case that od_total > 0.0 and ssa_total > 0.0 but
                 ! od_total*ssa_total == 0 due to underflow
-                scat_od_total = ssa(:,jlev,jcol)*od(:,jlev,jcol) &
-                     &     + ssa_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
-                     &     *  od_cloud_new
-                where (scat_od_total > 0.0_jprb)
-                  g_total = (g(:,jlev,jcol)*ssa(:,jlev,jcol)*od(:,jlev,jcol) &
-                       &     +   g_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
-                       &     * ssa_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
-                       &     *  od_cloud_new) &
-                       &     / scat_od_total
-                end where                
-                where (od_total > 0.0_jprb)
-                  ssa_total = scat_od_total / od_total
-                end where
+                do jg = 1,ng
+                  if (od_total(jg) > 0.0_jprb) then
+                    scat_od_total(jg) = ssa(jg,jlev,jcol)*od(jg,jlev,jcol) &
+                     &     + ssa_cloud(config%i_band_from_reordered_g_lw(jg),jlev,jcol) &
+                     &     *  od_cloud_new(jg)
+                    ssa_total(jg) = scat_od_total(jg) / od_total(jg)
+
+                    if (scat_od_total(jg) > 0.0_jprb) then
+                      g_total(jg) = (g(jg,jlev,jcol)*ssa(jg,jlev,jcol)*od(jg,jlev,jcol) &
+                         &     +   g_cloud(config%i_band_from_reordered_g_lw(jg),jlev,jcol) &
+                         &     * ssa_cloud(config%i_band_from_reordered_g_lw(jg),jlev,jcol) &
+                         &     *  od_cloud_new(jg)) &
+                         &     / scat_od_total(jg)
+                    end if
+                  end if
+                end do
+
               else
+
                 do jg = 1,ng
                   if (od_total(jg) > 0.0_jprb) then
@@ -265 +271 @@
                   end if
                 end do
+
               end if
             
@@ -301 +308 @@
           ! Use adding method to compute fluxes but optimize for the
           ! presence of clear-sky layers
-!          call adding_ica_lw(ng, nlev, reflectance, transmittance, source_up, source_dn, &
-!               &  emission(:,jcol), albedo(:,jcol), &
-!               &  flux_up, flux_dn)
           call fast_adding_ica_lw(ng, nlev, reflectance, transmittance, source_up, source_dn, &
                &  emission(:,jcol), albedo(:,jcol), &