Skip to content

Commit

Permalink
Merge pull request #27 from drieg/ecckd-opt-interface
Browse files Browse the repository at this point in the history 
Refactor optional concentration_scaling in ecckd
  • Loading branch information
@reuterbal
reuterbal authored Dec 9, 2024
2 parents 21a24fa + f929ac4 commit 5ecf17e
Showing 1 changed file with 22 additions and 21 deletions.
43 changes: 22 additions & 21 deletions radiation/radiation_ecckd.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -495,6 +495,7 @@ subroutine calc_optical_depth_ckd_model(this, ncol, nlev, istartcol, iendcol, nm

real(jprb) :: multiplier(nlev), simple_multiplier(nlev), global_multiplier, temperature1
real(jprb) :: scaling
real(jprb) :: local_concentration_scaling(nmaxgas)

! Indices and weights in temperature, pressure and concentration interpolation
real(jprb) :: pindex1, tindex1, cindex1
Expand All @@ -514,6 +515,8 @@ subroutine calc_optical_depth_ckd_model(this, ncol, nlev, istartcol, iendcol, nm
if (lhook) call dr_hook('radiation_ecckd:calc_optical_depth',0,hook_handle)

global_multiplier = 1.0_jprb / (AccelDueToGravity * 0.001_jprb * AirMolarMass)
local_concentration_scaling = 1.0_jprb
if (present(concentration_scaling)) local_concentration_scaling = concentration_scaling

do jcol = istartcol,iendcol

Expand Down Expand Up @@ -556,9 +559,7 @@ subroutine calc_optical_depth_ckd_model(this, ncol, nlev, istartcol, iendcol, nm
molar_abs => this%single_gas(jgas)%molar_abs
multiplier = simple_multiplier * mole_fraction_fl(jcol,:,igascode)

if (present(concentration_scaling)) then
multiplier = multiplier * concentration_scaling(igascode)
end if
multiplier = multiplier * local_concentration_scaling(igascode)

do jlev = 1,nlev
optical_depth_fl(:,jlev,jcol) = optical_depth_fl(:,jlev,jcol) &
Expand All @@ -571,14 +572,9 @@ subroutine calc_optical_depth_ckd_model(this, ncol, nlev, istartcol, iendcol, nm
case (IConcDependenceRelativeLinear)
molar_abs => this%single_gas(jgas)%molar_abs

if (present(concentration_scaling)) then
multiplier = simple_multiplier &
& * (mole_fraction_fl(jcol,:,igascode)*concentration_scaling(igascode) &
multiplier = simple_multiplier &
& * (mole_fraction_fl(jcol,:,igascode)*local_concentration_scaling(igascode) &
& - single_gas%reference_mole_frac)
else
multiplier = simple_multiplier * (mole_fraction_fl(jcol,:,igascode) &
& - single_gas%reference_mole_frac)
end if

do jlev = 1,nlev
optical_depth_fl(:,jlev,jcol) = optical_depth_fl(:,jlev,jcol) &
Expand All @@ -601,11 +597,7 @@ subroutine calc_optical_depth_ckd_model(this, ncol, nlev, istartcol, iendcol, nm

case (IConcDependenceLUT)

if (present(concentration_scaling)) then
scaling = concentration_scaling(igascode)
else
scaling = 1.0_jprb
end if
scaling = local_concentration_scaling(igascode)

! Logarithmic interpolation in concentration space
molar_abs_conc => this%single_gas(jgas)%molar_abs_conc
Expand Down Expand Up @@ -667,7 +659,7 @@ end subroutine calc_optical_depth_ckd_model
! Vectorized variant of above routine
subroutine calc_optical_depth_ckd_model_vec(this, ncol, nlev, istartcol, iendcol, nmaxgas, &
& pressure_hl, temperature_fl, mole_fraction_fl, &
& optical_depth_fl, rayleigh_od_fl)
& optical_depth_fl, rayleigh_od_fl, concentration_scaling)

use yomhook, only : lhook, dr_hook, jphook
use radiation_constants, only : AccelDueToGravity
Expand All @@ -683,6 +675,8 @@ subroutine calc_optical_depth_ckd_model_vec(this, ncol, nlev, istartcol, iendcol
real(jprb), intent(in) :: temperature_fl(istartcol:iendcol,nlev)
! Gas mole fractions at full levels (mol mol-1), dimensioned (ncol,nlev,nmaxgas)
real(jprb), intent(in) :: mole_fraction_fl(ncol,nlev,nmaxgas)
! Optional concentration scaling of each gas
real(jprb), optional, intent(in) :: concentration_scaling(nmaxgas)

! Output variables

Expand All @@ -703,6 +697,8 @@ subroutine calc_optical_depth_ckd_model_vec(this, ncol, nlev, istartcol, iendcol
!real(jprb) :: od_single_gas(this%ng)

real(jprb) :: multiplier, simple_multiplier(ncol,nlev), global_multiplier, temperature1
real(jprb) :: scaling
real(jprb) :: local_concentration_scaling(nmaxgas)

! Indices and weights in temperature, pressure and concentration interpolation
real(jprb) :: pindex1, tindex1, cindex1
Expand All @@ -725,6 +721,8 @@ subroutine calc_optical_depth_ckd_model_vec(this, ncol, nlev, istartcol, iendcol
if (lhook) call dr_hook('radiation_ecckd:calc_optical_depth_vec',0,hook_handle)

global_multiplier = 1.0_jprb / (AccelDueToGravity * 0.001_jprb * AirMolarMass)
local_concentration_scaling = 1._jprb
if (present(concentration_scaling)) local_concentration_scaling = concentration_scaling

od_fl(:,:,:) = 0.0_jprb

Expand Down Expand Up @@ -770,7 +768,8 @@ subroutine calc_optical_depth_ckd_model_vec(this, ncol, nlev, istartcol, iendcol
do jlev = 1,nlev
do jg = 1, this%ng
do jcol = istartcol,iendcol
multiplier = simple_multiplier(jcol,jlev) * mole_fraction_fl(jcol,jlev,igascode)
multiplier = simple_multiplier(jcol,jlev) * mole_fraction_fl(jcol,jlev,igascode) &
& * local_concentration_scaling(igascode)

od_fl(jcol,jg,jlev) = od_fl(jcol,jg,jlev) &
& + (multiplier*tw1(jcol,jlev)) * (pw1(jcol,jlev) * molar_abs(jg,ip1(jcol,jlev),it1(jcol,jlev)) &
Expand All @@ -787,8 +786,9 @@ subroutine calc_optical_depth_ckd_model_vec(this, ncol, nlev, istartcol, iendcol
do jlev = 1,nlev
do jg = 1, this%ng
do jcol = istartcol,iendcol
multiplier = simple_multiplier(jcol,jlev) * (mole_fraction_fl(jcol,jlev,igascode) &
& - single_gas%reference_mole_frac)
multiplier = simple_multiplier(jcol,jlev) * (mole_fraction_fl(jcol,jlev,igascode) &
& * local_concentration_scaling(igascode) &
& - single_gas%reference_mole_frac)

od_fl(jcol,jg,jlev) = od_fl(jcol,jg,jlev) &
& + (multiplier*tw1(jcol,jlev)) * (pw1(jcol,jlev) * molar_abs(jg,ip1(jcol,jlev),it1(jcol,jlev)) &
Expand Down Expand Up @@ -818,14 +818,15 @@ subroutine calc_optical_depth_ckd_model_vec(this, ncol, nlev, istartcol, iendcol
end do

case (IConcDependenceLUT)
scaling = local_concentration_scaling(igascode)
! Logarithmic interpolation in concentration space
molar_abs_conc => this%single_gas(jgas)%molar_abs_conc
mole_frac1 = exp(single_gas%log_mole_frac1)

do jlev = 1,nlev
do jcol = istartcol,iendcol
! Take care of mole_fraction == 0
log_conc = log(max(mole_fraction_fl(jcol,jlev,igascode), mole_frac1))
log_conc = log(max(mole_fraction_fl(jcol,jlev,igascode)*scaling, mole_frac1))
cindex1 = (log_conc - single_gas%log_mole_frac1) / single_gas%d_log_mole_frac
cindex1 = 1.0_jprb + max(0.0_jprb, min(cindex1, single_gas%n_mole_frac-1.0001_jprb))
ic1(jcol,jlev) = int(cindex1)
Expand All @@ -840,7 +841,7 @@ subroutine calc_optical_depth_ckd_model_vec(this, ncol, nlev, istartcol, iendcol
do jcol = istartcol,iendcol

od_fl(jcol,jg,jlev) = od_fl(jcol,jg,jlev) &
& + (simple_multiplier(jcol,jlev) * mole_fraction_fl(jcol,jlev,igascode)) * ( &
& + (simple_multiplier(jcol,jlev) * mole_fraction_fl(jcol,jlev,igascode) *scaling) * ( &
& (cw1(jcol,jlev) * tw1(jcol,jlev) * pw1(jcol,jlev)) * &
& molar_abs_conc(jg,ip1(jcol,jlev),it1(jcol,jlev),ic1(jcol,jlev)) &
& +(cw1(jcol,jlev) * tw1(jcol,jlev) * pw2(jcol,jlev)) * &
Expand Down

0 comments on commit 5ecf17e

Please sign in to comment.