diff --git a/src/clima_types.f90 b/src/clima_types.f90 index 87d966f..27d9790 100644 --- a/src/clima_types.f90 +++ b/src/clima_types.f90 @@ -15,10 +15,8 @@ module clima_types end type type :: SettingsOpacity - integer, allocatable :: new_num_k_bins character(:), allocatable :: k_method - integer :: nbins logical, allocatable :: k_distributions_bool character(s_str_len), allocatable :: k_distributions(:) diff --git a/src/clima_types_create.f90 b/src/clima_types_create.f90 index 6acbbb3..6d658b2 100644 --- a/src/clima_types_create.f90 +++ b/src/clima_types_create.f90 @@ -817,9 +817,8 @@ subroutine unpack_settingsopacity(op_dict, filename, op, err) type(type_list), pointer :: tmp class(type_node), pointer :: node type(type_dictionary), pointer :: opacities - type(type_scalar), pointer :: scalar type (type_error), allocatable :: io_err - integer :: ind, tmp_int + integer :: ind logical :: success if (allocated(op)) deallocate(op) @@ -833,29 +832,13 @@ subroutine unpack_settingsopacity(op_dict, filename, op, err) if (associated(node)) then ! k-distribution settings - ! ability to rebin k-coefficients in the files, before any calculations - scalar => op_dict%get_scalar('new-num-k-bins',required=.false.,error = io_err) - if (associated(scalar)) then - tmp_int = scalar%to_integer(0, success) - if (.not. success) then - err = 'Failed to convert "new-num-k-bins" to a real in "'//filename//'"' - return - endif - allocate(op%new_num_k_bins) - op%new_num_k_bins = tmp_int - if (op%new_num_k_bins < 1) then - err = '"new-num-k-bins" in "'//filename//'" must be bigger than 0.' - return - endif - endif ! get k-method, and check that it is valid op%k_method = op_dict%get_string("k-method", error=io_err) if (allocated(io_err)) then; err = trim(filename)//trim(io_err%message); return; endif op%k_method = trim(op%k_method) if (op%k_method == "RandomOverlapResortRebin") then - op%nbins = op_dict%get_integer("number-of-bins", error=io_err) - if (allocated(io_err)) then; err = trim(filename)//trim(io_err%message); return; endif + ! do nothing elseif (op%k_method == "RandomOverlap") then ! do nothing elseif (op%k_method == "AdaptiveEquivalentExtinction") then diff --git a/src/radtran/clima_radtran_types.f90 b/src/radtran/clima_radtran_types.f90 index 01bbd46..03028fc 100644 --- a/src/radtran/clima_radtran_types.f90 +++ b/src/radtran/clima_radtran_types.f90 @@ -78,7 +78,6 @@ module clima_radtran_types end enum type :: Ksettings - integer, allocatable :: new_num_k_bins ! approach to combining k-distributions character(:), allocatable :: k_method_name ! name integer :: k_method ! enum (see above) @@ -253,7 +252,6 @@ function OpticalProperties_opacities2yaml(self) result(out) character(:), allocatable :: out character(:), allocatable :: line - character(s_str_len) :: tmp_str integer :: i out = '' @@ -262,22 +260,6 @@ function OpticalProperties_opacities2yaml(self) result(out) line = line//'k-method: '//self%kset%k_method_name out = out//line - if (self%kset%k_method == k_RandomOverlapResortRebin) then - out = out//new_line('(a)') - write(tmp_str,'(i0)') self%kset%nbin - line = ' ' - line = line//'number-of-bins: '//trim(tmp_str) - out = out//line - endif - - if (allocated(self%kset%new_num_k_bins)) then - out = out//new_line('(a)') - write(tmp_str,'(i0)') self%kset%new_num_k_bins - line = ' ' - line = line//'new-num-k-bins: '//trim(tmp_str) - out = out//line - endif - out = out//new_line('(a)') line = ' ' line = line//'opacities:' diff --git a/src/radtran/clima_radtran_types_create.f90 b/src/radtran/clima_radtran_types_create.f90 index b48b0af..747b260 100644 --- a/src/radtran/clima_radtran_types_create.f90 +++ b/src/radtran/clima_radtran_types_create.f90 @@ -162,25 +162,19 @@ function create_Ksettings(sop) result(kset) type(SettingsOpacity), intent(in) :: sop type(Ksettings) :: kset - - real(dp), allocatable :: tmp(:) ! dummy variable. - - if (allocated(sop%new_num_k_bins)) then - allocate(kset%new_num_k_bins) - kset%new_num_k_bins = sop%new_num_k_bins - endif kset%k_method_name = sop%k_method ! method for mixing k-distributions. if (sop%k_method == "RandomOverlapResortRebin") then kset%k_method = k_RandomOverlapResortRebin - kset%nbin = sop%nbins + ! We will hard code the bins to be something reasonable + kset%nbin = 8 allocate(kset%wbin_e(kset%nbin+1)) allocate(kset%wbin(kset%nbin)) - allocate(tmp(kset%nbin)) - call gauss_legendre(tmp, kset%wbin) - kset%wbin = kset%wbin/2.0_dp + kset%wbin(:) = [0.16523105_dp, 0.30976894_dp, 0.30976894_dp, & + 0.16523105_dp, 0.00869637_dp, 0.01630363_dp, & + 0.01630363_dp, 0.00869637_dp] call weights_to_bins(kset%wbin, kset%wbin_e) elseif (sop%k_method == "RandomOverlap") then kset%k_method = k_RandomOverlap @@ -289,7 +283,7 @@ module function create_OpticalProperties(datadir, optype, species_names, & '"k-distributions" is not in the list of species.' return endif - op%k(i) = create_Ktable(filename, ind1, optype, op%wavl, sop%new_num_k_bins, err) + op%k(i) = create_Ktable(filename, ind1, optype, op%wavl, err) if (allocated(err)) return enddo @@ -1213,7 +1207,7 @@ subroutine read_h5_Xsection(filename, wavl, xs, err) end subroutine - function create_Ktable(filename, sp_ind, optype, wavl, new_num_k_bins, err) result(k) + function create_Ktable(filename, sp_ind, optype, wavl, err) result(k) use h5fortran use futils, only: is_close use clima_eqns, only: weights_to_bins @@ -1222,7 +1216,6 @@ function create_Ktable(filename, sp_ind, optype, wavl, new_num_k_bins, err) resu integer, intent(in) :: sp_ind integer, intent(in) :: optype real(dp), intent(in) :: wavl(:) - integer, allocatable, intent(in) :: new_num_k_bins character(:), allocatable, intent(out) :: err type(Ktable) :: k @@ -1317,12 +1310,6 @@ function create_Ktable(filename, sp_ind, optype, wavl, new_num_k_bins, err) resu call h%close() - ! Give the option to rebin k-coeffs - if (allocated(new_num_k_bins)) then - call rebin_Ktable(filename, new_num_k_bins, k, log10k, err) - if (allocated(err)) return - endif - ! initalize interpolators allocate(k%log10k(k%ngauss,k%nwav)) do i = 1,k%nwav @@ -1348,63 +1335,6 @@ function create_Ktable(filename, sp_ind, optype, wavl, new_num_k_bins, err) resu k%T_max = maxval(k%temp) end function - - subroutine rebin_Ktable(filename, nbin, k, log10k, err) - use futils, only: rebin, gauss_legendre - use clima_eqns, only: weights_to_bins - - character(*), intent(in) :: filename - integer, intent(in) :: nbin - type(Ktable), intent(inout) :: k - real(dp), allocatable, intent(inout) :: log10k(:,:,:,:) - character(:), allocatable, intent(out) :: err - - integer :: i, j, ii, ierr - real(dp), allocatable :: wbin(:) ,wbin_e(:), tmp(:), tmp1(:) - real(dp), allocatable :: log10k_new(:,:,:,:) - - if (nbin > k%ngauss) then - err = '"new-num-k-bins" in the settings file should not be bigger than '//& - 'number of k-bins in '//filename - return - endif - - allocate(wbin(nbin),wbin_e(nbin+1),tmp(nbin)) - call gauss_legendre(tmp, wbin) - wbin = wbin/2.0_dp - call weights_to_bins(wbin, wbin_e) - - allocate(log10k_new(nbin,size(log10k,2),size(log10k,3),size(log10k,4))) - allocate(tmp1(size(log10k,1))) - - do i = 1,size(log10k,4) - do j = 1,size(log10k,3) - do ii = 1,size(log10k,2) - tmp1(:) = 10.0_dp**log10k(:,ii,j,i) - call rebin(k%weight_e, tmp1, wbin_e, log10k_new(:,ii,j,i), ierr) - if (ierr /= 0) then - err = 'Rebinning k-coefficients in file "'//filename//'" failed' - return - endif - log10k_new(:,ii,j,i) = log10(log10k_new(:,ii,j,i)) - enddo - enddo - enddo - - ! replace with new bins - k%ngauss = nbin - deallocate(k%weights) - allocate(k%weights(nbin)) - k%weights(:) = wbin(:) - deallocate(k%weight_e) - allocate(k%weight_e(nbin+1)) - k%weight_e(:) = wbin_e(:) - - deallocate(log10k) - allocate(log10k(nbin,size(log10k_new,2),size(log10k_new,3),size(log10k_new,4))) - log10k(:,:,:,:) = log10k_new(:,:,:,:) - - end subroutine subroutine check_h5_dataset(h, dataset, ndims, dtype, prefix, err) use h5fortran, only: hdf5_file diff --git a/templates/AdiabatClimate/Earth/settings.yaml b/templates/AdiabatClimate/Earth/settings.yaml index a3c4c00..4bfcee9 100644 --- a/templates/AdiabatClimate/Earth/settings.yaml +++ b/templates/AdiabatClimate/Earth/settings.yaml @@ -26,10 +26,6 @@ optical-properties: # These methods are explained in Amundsen et al. (2017) (DOI: 10.1051/0004-6361/201629322). k-method: RandomOverlapResortRebin - # If you choose method RandomOverlapResortRebin, then you must supply - # `number-of-bins`, which is the number of bins the method rebins to - number-of-bins: 16 - # Here you specify opacites. You can see avaliable opacities by looking in # `clima/data/` folder. `CIA`, `rayleigh`, `photolysis-xs` and `water-continuum` # are optional. If you omit these keys then these opacities will not be included. @@ -39,5 +35,4 @@ optical-properties: opacities: {k-distributions: on, CIA: on, rayleigh: on} solar: k-method: RandomOverlapResortRebin - number-of-bins: 16 opacities: {k-distributions: on, CIA: on, rayleigh: on} diff --git a/templates/AdiabatClimate/Mars/settings.yaml b/templates/AdiabatClimate/Mars/settings.yaml index 82897d1..1b2c9c2 100644 --- a/templates/AdiabatClimate/Mars/settings.yaml +++ b/templates/AdiabatClimate/Mars/settings.yaml @@ -12,7 +12,6 @@ planet: optical-properties: ir: k-method: RandomOverlapResortRebin - number-of-bins: 32 opacities: k-distributions: [H2O, CO2, CH4] CIA: [CH4-CH4, CO2-CH4, CO2-CO2, CO2-H2, H2-CH4, H2-H2, N2-H2, N2-N2] @@ -20,7 +19,6 @@ optical-properties: water-continuum: MT_CKD solar: k-method: RandomOverlapResortRebin - number-of-bins: 32 opacities: k-distributions: [H2O, CO2, CH4] CIA: [CH4-CH4, CO2-CH4, CO2-CO2, CO2-H2, H2-CH4, H2-H2, N2-H2, N2-N2]