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

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

@@ -39 +39 @@
     if (lhook) call dr_hook('radiation_ecckd_interface:setup_gas_optics',0,hook_handle)
 
-    if (config%do_sw) then
+    if (config%do_sw .and. config%i_gas_model_sw == IGasModelECCKD) then
 
       ! Read shortwave ecCKD gas optics NetCDF file
@@ -57 +57 @@
       end if
 
-!      if (allocated(config%i_band_from_g_sw)) deallocate(config%i_band_from_g_sw)
-!      allocate(config%i_band_from_g_sw(config%n_g_sw))
-!      if (allocated(config%i_band_from_reordered_g_sw)) deallocate(config%i_band_from_reordered_g_sw)
-!      allocate(config%i_band_from_reordered_g_sw(config%n_g_sw))
-!      if (allocated(config%i_g_from_reordered_g_sw)) deallocate(config%i_g_from_reordered_g_sw)
-!      allocate(config%i_g_from_reordered_g_sw(config%n_g_sw))
-      if (.not.allocated(config%i_band_from_g_sw)) &
-              allocate(config%i_band_from_g_sw(config%n_g_sw))
-      if (.not.allocated(config%i_band_from_reordered_g_sw)) &
-              allocate(config%i_band_from_reordered_g_sw(config%n_g_sw))
-      if (.not.allocated(config%i_g_from_reordered_g_sw)) &
-              allocate(config%i_g_from_reordered_g_sw(config%n_g_sw))
+      allocate(config%i_band_from_g_sw          (config%n_g_sw))
+      allocate(config%i_band_from_reordered_g_sw(config%n_g_sw))
+      allocate(config%i_g_from_reordered_g_sw   (config%n_g_sw))
         
       if (config%do_cloud_aerosol_per_sw_g_point) then
@@ -93 +84 @@
     end if
 
-    if (config%do_lw) then
+    if (config%do_lw .and. config%i_gas_model_lw == IGasModelECCKD) then
 
       ! Read longwave ecCKD gas optics NetCDF file
@@ -111 +102 @@
       end if
 
-!      if (allocated(config%i_band_from_g_lw)) deallocate(config%i_band_from_g_lw)
-!      allocate(config%i_band_from_g_lw          (config%n_g_lw))
-!      if (allocated(config%i_band_from_reordered_g_lw)) deallocate(config%i_band_from_reordered_g_lw)
-!      allocate(config%i_band_from_reordered_g_lw(config%n_g_lw))
-!      if (allocated(config%i_g_from_reordered_g_lw)) deallocate(config%i_g_from_reordered_g_lw)
-!      allocate(config%i_g_from_reordered_g_lw   (config%n_g_lw))
-      if (.not.allocated(config%i_band_from_g_lw)) &
-         allocate(config%i_band_from_g_lw          (config%n_g_lw))
-      if (.not.allocated(config%i_band_from_reordered_g_lw)) &
-         allocate(config%i_band_from_reordered_g_lw(config%n_g_lw))
-      if (.not.allocated(config%i_g_from_reordered_g_lw)) &
-         allocate(config%i_g_from_reordered_g_lw   (config%n_g_lw))
-
+      allocate(config%i_band_from_g_lw          (config%n_g_lw))
+      allocate(config%i_band_from_reordered_g_lw(config%n_g_lw))
+      allocate(config%i_g_from_reordered_g_lw   (config%n_g_lw))
 
       if (config%do_cloud_aerosol_per_lw_g_point) then
@@ -199 +180 @@
     use yomhook,  only : lhook, dr_hook, jphook
 
-    use radiation_config,         only : config_type
+    use radiation_config,         only : config_type, IGasModelECCKD
     use radiation_thermodynamics, only : thermodynamics_type
     use radiation_single_level,   only : single_level_type
@@ -242 +223 @@
     real(jprb) :: temperature_fl(istartcol:iendcol,nlev)
 
-    integer :: jcol
+    real(jprb) :: concentration_scaling(NMaxGases)
+    
+    logical :: is_volume_mixing_ratio
+    
+    integer :: jcol, jlev, jg
 
     real(jphook) :: hook_handle
@@ -259 +244 @@
          &  / (thermodynamics%pressure_hl(istartcol:iendcol,1:nlev) &
          &    +thermodynamics%pressure_hl(istartcol:iendcol,2:nlev+1))
- 
-    if (config%do_sw) then
-
-      call config%gas_optics_sw%calc_optical_depth(ncol,nlev,istartcol,iendcol, &
-           &  NMaxGases, thermodynamics%pressure_hl, &
-           &  temperature_fl, &
-           &  gas%mixing_ratio, &
-!           &  reshape(gas%mixing_ratio(istartcol:iendcol,:,:), &
-!           &          [nlev,iendcol-istartcol+1,NMaxGases],order=[2,1,3]), &
-           &  od_sw, rayleigh_od_fl=ssa_sw)
+
+    ! Check that the gas concentrations are stored in volume mixing
+    ! ratio with no scaling; if not, return a vector of scalings
+    call gas%assert_units(IVolumeMixingRatio, scale_factor=1.0_jprb, &
+         &                istatus=is_volume_mixing_ratio)
+    if (.not. is_volume_mixing_ratio) then
+      call gas%get_scaling(IVolumeMixingRatio, concentration_scaling)
+    else
+      concentration_scaling = 1.0_jprb
+    end if
+    
+    if (config%do_sw .and. config%i_gas_model_sw == IGasModelECCKD) then
+
+      if (is_volume_mixing_ratio) then
+        call config%gas_optics_sw%calc_optical_depth(ncol,nlev,istartcol,iendcol, &
+             &  NMaxGases, thermodynamics%pressure_hl, &
+             &  temperature_fl, gas%mixing_ratio, &
+             &  od_sw, rayleigh_od_fl=ssa_sw)
+      else
+        call config%gas_optics_sw%calc_optical_depth(ncol,nlev,istartcol,iendcol, &
+             &  NMaxGases, thermodynamics%pressure_hl, &
+             &  temperature_fl, gas%mixing_ratio, &
+             &  od_sw, rayleigh_od_fl=ssa_sw, concentration_scaling=concentration_scaling)
+      end if
+      
       ! At this point od_sw = absorption optical depth and ssa_sw =
       ! rayleigh optical depth: convert to total optical depth and
       ! single-scattering albedo
-      od_sw = od_sw + ssa_sw
-      ssa_sw = ssa_sw / od_sw
+      do jcol = istartcol,iendcol
+        do jlev = 1, nlev
+          do jg = 1, config%n_g_sw
+            od_sw(jg,jlev,jcol)  = od_sw(jg,jlev,jcol) + ssa_sw(jg,jlev,jcol)
+            ssa_sw(jg,jlev,jcol) = ssa_sw(jg,jlev,jcol) / od_sw(jg,jlev,jcol)
+          end do
+        end do
+      end do
 
       if (present(incoming_sw)) then
@@ -287 +293 @@
     end if
 
-    if (config%do_lw) then
-
-      call config%gas_optics_lw%calc_optical_depth(ncol,nlev,istartcol,iendcol, &
-           &  NMaxGases, thermodynamics%pressure_hl, &
-           &  temperature_fl, &
-           &  gas%mixing_ratio, &
-!           &  reshape(gas%mixing_ratio(istartcol:iendcol,:,:), &
-!           &          [nlev,iendcol-istartcol+1,NMaxGases],order=[2,1,3]), &
-           &  od_lw)
+    if (config%do_lw .and. config%i_gas_model_lw == IGasModelECCKD) then
+
+      if (is_volume_mixing_ratio) then
+        call config%gas_optics_lw%calc_optical_depth(ncol,nlev,istartcol,iendcol, &
+             &  NMaxGases, thermodynamics%pressure_hl, &
+             &  temperature_fl, gas%mixing_ratio, &
+             &  od_lw)
+      else
+        call config%gas_optics_lw%calc_optical_depth(ncol,nlev,istartcol,iendcol, &
+             &  NMaxGases, thermodynamics%pressure_hl, &
+             &  temperature_fl, gas%mixing_ratio, &
+             &  od_lw, concentration_scaling=concentration_scaling)
+      end if
 
       ! Calculate the Planck function for each g point
@@ -305 +315 @@
            &  single_level%skin_temperature(istartcol:iendcol), &
            &  lw_emission(:,:))
+!NEC$ forced_collapse
       lw_emission = lw_emission * (1.0_jprb - lw_albedo)