From c1cec1142babd2d549858346df9fccd7ff13320e Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 11 Feb 2020 10:57:40 -0700 Subject: [PATCH 1/3] Switched to rte-rrtmgp dtc/branch. --- .gitmodules | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index 19b855a70..45475032d 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,4 +1,4 @@ [submodule "physics/rte-rrtmgp"] path = physics/rte-rrtmgp - url = https://dustinswales@github.com/dustinswales/rte-rrtmgp - branch = rrtmgp-CCPP \ No newline at end of file + url = https://dustinswales@github.com/RobertPincus/rte-rrtmgp + branch = dtc/ccpp \ No newline at end of file From 30b523724d8339de8c4ef2a98e778e0c878b494e Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 11 Feb 2020 11:09:46 -0700 Subject: [PATCH 2/3] Updated submodule --- physics/rte-rrtmgp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index a2566ac81..7dfff2025 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit a2566ac81f6d7f63bc01be92388702c95f0a3703 +Subproject commit 7dfff2025cae02c84b12df2402a39d77065f0e62 From 75c479d4f3c8e99649ed8ab8e8d83892eaf72592 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 11 Feb 2020 15:13:34 -0700 Subject: [PATCH 3/3] Updated interface to rte-rrtmgp routines. --- physics/GFS_rrtmgp_pre.F90 | 140 +++++++++++++++++++++-------- physics/GFS_rrtmgp_pre.meta | 11 ++- physics/rrtmgp_lw_cloud_optics.F90 | 46 +++++----- physics/rrtmgp_lw_gas_optics.F90 | 6 +- physics/rrtmgp_lw_gas_optics.meta | 2 +- physics/rrtmgp_sw_cloud_optics.F90 | 48 +++++----- physics/rrtmgp_sw_gas_optics.F90 | 11 +-- physics/rrtmgp_sw_gas_optics.meta | 4 +- physics/rrtmgp_sw_rte.F90 | 1 + physics/rrtmgp_sw_rte.meta | 2 +- 10 files changed, 174 insertions(+), 97 deletions(-) diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 4d076706c..29f1ac37e 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -58,9 +58,25 @@ module GFS_rrtmgp_pre amo3 = 47.9982_kind_phys, & ! Modelular weight of ozone (g/mol) amdw = amd/amw, & ! Molecular weight of dry air / water vapor amdo3 = amd/amo3 ! Molecular weight of dry air / ozone - - public GFS_rrtmgp_pre_run,GFS_rrtmgp_pre_init,GFS_rrtmgp_pre_finalize - + + ! Some common trace gas on/off flags. + ! This allows for control over which trace gases are used in RRTMGP radiation scheme via + ! namelist. + logical :: & + isActive_h2o = .false., & ! + isActive_co2 = .false., & ! + isActive_o3 = .false., & ! + isActive_n2o = .false., & ! + isActive_ch4 = .false., & ! + isActive_o2 = .false., & ! + isActive_ccl4 = .false., & ! + isActive_cfc11 = .false., & ! + isActive_cfc12 = .false., & ! + isActive_cfc22 = .false. ! + integer :: iStr_h2o, iStr_co2, iStr_o3, iStr_n2o, iStr_ch4, iStr_o2, iStr_ccl4, & + iStr_cfc11, iStr_cfc12, iStr_cfc22 + + public GFS_rrtmgp_pre_run,GFS_rrtmgp_pre_init,GFS_rrtmgp_pre_finalize contains ! ######################################################################################### @@ -77,7 +93,7 @@ subroutine GFS_rrtmgp_pre_init(Model, Radtend, active_gases_array, errmsg, errfl Radtend ! DDT: FV3-GFS radiation tendencies ! Outputs - character(len=128),dimension(Model%ngases), intent(out) :: & + character(len=*),dimension(Model%ngases), intent(out) :: & active_gases_array ! Character array containing trace gases to include in RRTMGP character(len=*), intent(out) :: & errmsg ! Error message @@ -93,27 +109,72 @@ subroutine GFS_rrtmgp_pre_init(Model, Radtend, active_gases_array, errmsg, errfl errmsg = '' errflg = 0 + if (len(Model%active_gases) .eq. 0) return + ! Which gases are active? Provided via physics namelist. - if (len(Model%active_gases) .gt. 0) then - - ! Pull out gas names from list... - ! First grab indices in character array corresponding to start:end of gas name. - gasIndices(1,1)=1 - count=1 - do ij=1,len(Model%active_gases) - tempstr=trim(Model%active_gases(ij:ij)) - if (tempstr .eq. '_') then - gasIndices(count,2)=ij-1 - gasIndices(count+1,1)=ij+1 - count=count+1 - endif - enddo - gasIndices(Model%ngases,2)=len(trim(Model%active_gases)) - ! Now extract the gas names - do ij=1,Model%ngases - active_gases_array(ij) = Model%active_gases(gasIndices(ij,1):gasIndices(ij,2)) - enddo - endif + + ! Pull out gas names from list... + ! First grab indices in character array corresponding to start:end of gas name. + gasIndices(1,1)=1 + count=1 + do ij=1,len(Model%active_gases) + tempstr=trim(Model%active_gases(ij:ij)) + if (tempstr .eq. '_') then + gasIndices(count,2)=ij-1 + gasIndices(count+1,1)=ij+1 + count=count+1 + endif + enddo + gasIndices(Model%ngases,2)=len(trim(Model%active_gases)) + + ! Now extract the gas names + do ij=1,Model%ngases + active_gases_array(ij) = Model%active_gases(gasIndices(ij,1):gasIndices(ij,2)) + enddo + + ! Which gases are active? (This is purely for flexibility) + do ij=1,Model%ngases + if(trim(active_gases_array(ij)) .eq. 'h2o') then + isActive_h2o = .true. + istr_h2o = ij + endif + if(trim(active_gases_array(ij)) .eq. 'co2') then + isActive_co2 = .true. + istr_co2 = ij + endif + if(trim(active_gases_array(ij)) .eq. 'o3') then + isActive_o3 = .true. + istr_o3 = ij + endif + if(trim(active_gases_array(ij)) .eq. 'n2o') then + isActive_n2o = .true. + istr_n2o = ij + endif + if(trim(active_gases_array(ij)) .eq. 'ch4') then + isActive_ch4 = .true. + istr_ch4 = ij + endif + if(trim(active_gases_array(ij)) .eq. 'o2') then + isActive_o2 = .true. + istr_o2 = ij + endif + if(trim(active_gases_array(ij)) .eq. 'ccl4') then + isActive_ccl4 = .true. + istr_ccl4 = ij + endif + if(trim(active_gases_array(ij)) .eq. 'cfc11') then + isActive_cfc11 = .true. + istr_cfc11 = ij + endif + if(trim(active_gases_array(ij)) .eq. 'cfc12') then + isActive_cfc12 = .true. + istr_cfc12 = ij + endif + if(trim(active_gases_array(ij)) .eq. 'cfc22') then + isActive_cfc22 = .true. + istr_cfc22 = ij + endif + enddo end subroutine GFS_rrtmgp_pre_init @@ -123,11 +184,11 @@ end subroutine GFS_rrtmgp_pre_init !> \section arg_table_GFS_rrtmgp_pre_run !! \htmlinclude GFS_rrtmgp_pre.html !! - subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, Tbd, & ! IN - ncol, lw_gas_props, sec_diff_byband, & ! IN - raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, cld_frac, cld_lwp, & ! OUT - cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, & ! OUT - tv_lay, relhum, tracer, cldsa, mtopa, mbota, de_lgth, gas_concentrations, & ! OUT + subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, Tbd, & ! IN + ncol, lw_gas_props, active_gases_array, & ! IN + sec_diff_byband, raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, cld_frac, cld_lwp,& ! OUT + cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, & ! OUT + tv_lay, relhum, tracer, cldsa, mtopa, mbota, de_lgth, gas_concentrations, & ! OUT errmsg, errflg) ! Inputs @@ -147,8 +208,10 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, Tbd ! DDT: FV3-GFS data not yet assigned to a defined container integer, intent(in) :: & ncol ! Number of horizontal grid points - type(ty_gas_optics_rrtmgp),intent(in) :: & - lw_gas_props ! RRTMGP DDT: longwave spectral information + type(ty_gas_optics_rrtmgp),intent(in) :: & + lw_gas_props ! RRTMGP DDT: longwave spectral information + character(len=*),dimension(Model%ngases), intent(in) :: & + active_gases_array ! Character array containing trace gases to include in RRTMGP ! Outputs real(kind_phys), dimension(ncol,Model%levs), intent(out) :: & @@ -296,13 +359,14 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, vmr_h2o = merge((q_lay/(1-q_lay))*amdw, 0., q_lay .ne. 1.) vmr_o3 = merge(o3_lay*amdo3, 0., o3_lay .gt. 0.) - ! Populate RRTMGP DDT w/ gas-concentrations - call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr('o2', gas_vmr(:,:,4))) - call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr('co2', gas_vmr(:,:,1))) - call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr('ch4', gas_vmr(:,:,3))) - call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr('n2o', gas_vmr(:,:,2))) - call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr('h2o', vmr_h2o)) - call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr('o3', vmr_o3)) + ! Initialize and opulate RRTMGP DDT w/ gas-concentrations + call check_error_msg('sw_gas_optics_init',gas_concentrations%init(active_gases_array)) + if (isActive_o2) call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_o2), gas_vmr(:,:,4))) + if (isActive_co2) call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_co2), gas_vmr(:,:,1))) + if (isActive_ch4) call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_ch4), gas_vmr(:,:,3))) + if (isActive_n2o) call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_n2o), gas_vmr(:,:,2))) + if (isActive_h2o) call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_h2o), vmr_h2o)) + if (isActive_o3) call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_o3), vmr_o3)) ! ####################################################################################### ! Compute diffusivity angle adjustments for each longwave band diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 35f455447..c80098709 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -23,7 +23,7 @@ units = none dimensions = (number_of_active_gases_used_by_RRTMGP) type = character - kind = len=128 + kind = len=* intent = out optional = F [errmsg] @@ -120,6 +120,15 @@ type = ty_gas_optics_rrtmgp intent = in optional = F +[active_gases_array] + standard_name = list_of_active_gases_used_by_RRTMGP + long_name = list of active gases used by RRTMGP + units = none + dimensions = (number_of_active_gases_used_by_RRTMGP) + type = character + kind = len=* + intent = in + optional = F [raddt] standard_name = time_step_for_radiation long_name = radiation time step diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index d12ccaa23..ab811128c 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -91,7 +91,7 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d ! Local variables integer :: dimID,varID,status,ncid character(len=264) :: lw_cloud_props_file - integer,parameter :: max_strlen=256 + integer,parameter :: max_strlen=256, nrghice_default=2 #ifdef MPI integer :: mpierr #endif @@ -131,15 +131,17 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d status = nf90_inquire_dimension(ncid, dimid, len=npairs) status = nf90_close(ncid) - ! Has the number of ice-roughnesses been provided from the namelist? - ! If not provided, use all categories in file (default) + ! Has the number of ice-roughnesses to use been provided from the namelist? + ! If not provided, use default number of ice-roughness categories if (nrghice .eq. 0) then + nrghice = nrghice_default + else nrghice = nrghice_fromfile - endif - ! If provided in the namelist, check to ensure that number of ice-roughness categories is feasible. - if (nrghice .gt. nrghice_fromfile) then - errmsg = 'Number of RRTMGP ice-roughness categories requested in namelist file is not allowed. Using nrghice from file...' - nrghice = nrghice_fromfile + ! If provided in the namelist, check to ensure that number of ice-roughness categories is feasible. + if (nrghice .gt. nrghice_fromfile) then + errmsg = 'Number of RRTMGP ice-roughness categories requested in namelist file is not allowed. Using default number of categories.' + nrghice = nrghice_default + endif endif ! Allocate space for arrays @@ -147,17 +149,17 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d allocate(lut_extliq(nSize_liq, nBand)) allocate(lut_ssaliq(nSize_liq, nBand)) allocate(lut_asyliq(nSize_liq, nBand)) - allocate(lut_extice(nSize_ice, nBand, nrghice)) - allocate(lut_ssaice(nSize_ice, nBand, nrghice)) - allocate(lut_asyice(nSize_ice, nBand, nrghice)) + allocate(lut_extice(nSize_ice, nBand, nrghice_fromfile)) + allocate(lut_ssaice(nSize_ice, nBand, nrghice_fromfile)) + allocate(lut_asyice(nSize_ice, nBand, nrghice_fromfile)) endif if (cld_optics_scheme .eq. 2) then allocate(pade_extliq(nBand, nSizeReg, nCoeff_ext )) allocate(pade_ssaliq(nBand, nSizeReg, nCoeff_ssa_g)) allocate(pade_asyliq(nBand, nSizeReg, nCoeff_ssa_g)) - allocate(pade_extice(nBand, nSizeReg, nCoeff_ext, nrghice)) - allocate(pade_ssaice(nBand, nSizeReg, nCoeff_ssa_g, nrghice)) - allocate(pade_asyice(nBand, nSizeReg, nCoeff_ssa_g, nrghice)) + allocate(pade_extice(nBand, nSizeReg, nCoeff_ext, nrghice_fromfile)) + allocate(pade_ssaice(nBand, nSizeReg, nCoeff_ssa_g, nrghice_fromfile)) + allocate(pade_asyice(nBand, nSizeReg, nCoeff_ssa_g, nrghice_fromfile)) allocate(pade_sizereg_extliq(nBound)) allocate(pade_sizereg_ssaliq(nBound)) allocate(pade_sizereg_asyliq(nBound)) @@ -304,18 +306,18 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d ! Load tables data for RRTMGP cloud-optics if (cld_optics_scheme .eq. 1) then - call check_error_msg('lw_cloud_optics_init',lw_cloud_props%set_ice_roughness(nrghice)) call check_error_msg('lw_cloud_optics_init',lw_cloud_props%load(band_lims, & radliq_lwr, radliq_upr, radliq_fac, radice_lwr, radice_upr, radice_fac, & lut_extliq, lut_ssaliq, lut_asyliq, lut_extice, lut_ssaice, lut_asyice)) endif if (cld_optics_scheme .eq. 2) then - call check_error_msg('lw_cloud_optics_init', lw_cloud_props%set_ice_roughness(nrghice)) call check_error_msg('lw_cloud_optics_init', lw_cloud_props%load(band_lims, & pade_extliq, pade_ssaliq, pade_asyliq, pade_extice, pade_ssaice, pade_asyice,& pade_sizereg_extliq, pade_sizereg_ssaliq, pade_sizereg_asyliq, & pade_sizereg_extice, pade_sizereg_ssaice, pade_sizereg_asyice)) endif + call check_error_msg('lw_cloud_optics_init', lw_cloud_props%set_ice_roughness(nrghice)) + end subroutine rrtmgp_lw_cloud_optics_init ! ######################################################################################### @@ -393,12 +395,12 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, nCol, nLev, cld_optics_scheme, nr if (rrtmgp_cld_optics .gt. 0) then ! i) RRTMGP cloud-optics. call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_cloud_props%cloud_optics(& - ncol, & ! IN - Number of horizontal gridpoints - nLev, & ! IN - Number of vertical layers - lw_cloud_props%get_nband(), & ! IN - Number of LW bands - nrghice, & ! IN - Number of ice-roughness categories - liqmask, & ! IN - Liquid-cloud mask (1) - icemask, & ! IN - Ice-cloud mask (1) + !ncol, & ! IN - Number of horizontal gridpoints + !nLev, & ! IN - Number of vertical layers + !lw_cloud_props%get_nband(), & ! IN - Number of LW bands + !nrghice, & ! IN - Number of ice-roughness categories + !liqmask, & ! IN - Liquid-cloud mask (1) + !icemask, & ! IN - Ice-cloud mask (1) cld_lwp, & ! IN - Cloud liquid water path (g/m2) cld_iwp, & ! IN - Cloud ice water path (g/m2) cld_reliq, & ! IN - Cloud liquid effective radius (microns) diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index 440b40242..bc27db93f 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -29,7 +29,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp rrtmgp_lw_file_gas ! RRTMGP file containing coefficients used to compute gaseous optical properties integer, intent(in) :: & rrtmgp_nGases ! Number of trace gases active in RRTMGP - character(len=128),dimension(rrtmgp_nGases), intent(in) :: & + character(len=*),dimension(rrtmgp_nGases), intent(in) :: & active_gases_array ! Character array containing trace gases to include in RRTMGP integer,intent(in) :: & mpicomm, & ! MPI communicator @@ -317,9 +317,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp #endif ! Initialize gas concentrations and gas optics class - do iGas=1,rrtmgp_nGases - call check_error_msg('lw_gas_optics_init',gas_concentrations%set_vmr(active_gases_array(iGas), 0._kind_phys)) - enddo + call check_error_msg('lw_gas_optics_init',gas_concentrations%init(active_gases_array)) call check_error_msg('lw_gas_optics_init',lw_gas_props%load(gas_concentrations, gas_names, & key_species, band2gpt, band_lims, press_ref, press_ref_trop, temp_ref, temp_ref_p, & temp_ref_t, vmr_ref, kmajor, kminor_lower, kminor_upper, gas_minor, identifier_minor, & diff --git a/physics/rrtmgp_lw_gas_optics.meta b/physics/rrtmgp_lw_gas_optics.meta index cacda8c1c..36b8067dd 100644 --- a/physics/rrtmgp_lw_gas_optics.meta +++ b/physics/rrtmgp_lw_gas_optics.meta @@ -33,7 +33,7 @@ units = none dimensions = (number_of_active_gases_used_by_RRTMGP) type = character - kind = len=128 + kind = len=* intent = in optional = F [mpirank] diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index 87aa27df9..c0f8134e8 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -91,6 +91,7 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d ! Local variables integer :: status,ncid,dimid,varID character(len=264) :: sw_cloud_props_file + integer,parameter :: nrghice_default=2 #ifdef MPI integer :: mpierr #endif @@ -128,15 +129,17 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d status = nf90_inq_dimid(ncid, 'pair', dimid) status = nf90_inquire_dimension(ncid, dimid, len=nPairs) - ! Has the number of ice-roughnesses been provided from the namelist? - ! If not provided, use all categories in file (default) + ! Has the number of ice-roughnesses to use been provided from the namelist? + ! If not provided, use default number of ice-roughness categories if (nrghice .eq. 0) then + nrghice = nrghice_default + else nrghice = nrghice_fromfile - endif - ! If provided in the namelist, check to ensure that number of ice-roughness categories is feasible. - if (nrghice .gt. nrghice_fromfile) then - errmsg = 'Number of RRTMGP ice-roughness categories requested in namelist file is not allowed. Using nrghice from file...' - nrghice = nrghice_fromfile + ! If provided in the namelist, check to ensure that number of ice-roughness categories is feasible. + if (nrghice .gt. nrghice_fromfile) then + errmsg = 'Number of RRTMGP ice-roughness categories requested in namelist file is not allowed. Using default number of categories.' + nrghice = nrghice_default + endif endif ! Allocate space for arrays @@ -144,17 +147,17 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d allocate(lut_extliq(nSize_liq, nBand)) allocate(lut_ssaliq(nSize_liq, nBand)) allocate(lut_asyliq(nSize_liq, nBand)) - allocate(lut_extice(nSize_ice, nBand, nrghice)) - allocate(lut_ssaice(nSize_ice, nBand, nrghice)) - allocate(lut_asyice(nSize_ice, nBand, nrghice)) + allocate(lut_extice(nSize_ice, nBand, nrghice_fromfile)) + allocate(lut_ssaice(nSize_ice, nBand, nrghice_fromfile)) + allocate(lut_asyice(nSize_ice, nBand, nrghice_fromfile)) endif if (cld_optics_scheme .eq. 2) then allocate(pade_extliq(nBand, nSizeReg, nCoeff_ext )) allocate(pade_ssaliq(nBand, nSizeReg, nCoeff_ssa_g)) allocate(pade_asyliq(nBand, nSizeReg, nCoeff_ssa_g)) - allocate(pade_extice(nBand, nSizeReg, nCoeff_ext, nrghice)) - allocate(pade_ssaice(nBand, nSizeReg, nCoeff_ssa_g, nrghice)) - allocate(pade_asyice(nBand, nSizeReg, nCoeff_ssa_g, nrghice)) + allocate(pade_extice(nBand, nSizeReg, nCoeff_ext, nrghice_fromfile)) + allocate(pade_ssaice(nBand, nSizeReg, nCoeff_ssa_g, nrghice_fromfile)) + allocate(pade_asyice(nBand, nSizeReg, nCoeff_ssa_g, nrghice_fromfile)) allocate(pade_sizereg_extliq(nBound)) allocate(pade_sizereg_ssaliq(nBound)) allocate(pade_sizereg_asyliq(nBound)) @@ -301,18 +304,17 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d ! Load tables data for RRTMGP cloud-optics if (cld_optics_scheme .eq. 1) then - call check_error_msg('sw_cloud_optics_init',sw_cloud_props%set_ice_roughness(nrghice)) - call check_error_msg('sw_cloud_optics_init',sw_cloud_props%load(band_lims, & + call check_error_msg('sw_cloud_optics_init',sw_cloud_props%load(band_lims, & radliq_lwr, radliq_upr, radliq_fac, radice_lwr, radice_upr, radice_fac, & lut_extliq, lut_ssaliq, lut_asyliq, lut_extice, lut_ssaice, lut_asyice)) endif if (cld_optics_scheme .eq. 2) then - call check_error_msg('sw_cloud_optics_init',sw_cloud_props%set_ice_roughness(nrghice)) - call check_error_msg('sw_cloud_optics_init', sw_cloud_props%load(band_lims, & + call check_error_msg('sw_cloud_optics_init', sw_cloud_props%load(band_lims, & pade_extliq, pade_ssaliq, pade_asyliq, pade_extice, pade_ssaice, pade_asyice,& pade_sizereg_extliq, pade_sizereg_ssaliq, pade_sizereg_asyliq, & pade_sizereg_extice, pade_sizereg_ssaice, pade_sizereg_asyice)) endif + call check_error_msg('sw_cloud_optics_init',sw_cloud_props%set_ice_roughness(nrghice)) end subroutine rrtmgp_sw_cloud_optics_init ! ######################################################################################### @@ -390,12 +392,12 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, nCol, nLev, nDay, idxday, nrghice if (cld_optics_scheme .gt. 0) then ! RRTMGP cloud-optics. call check_error_msg('rrtmgp_sw_cloud_optics_run',sw_cloud_props%cloud_optics(& - nday, & ! IN - Number of daylit gridpoints - nLev, & ! IN - Number of vertical layers - sw_cloud_props%get_nband(), & ! IN - Number of SW bands - nrghice, & ! IN - Number of ice-roughness categories - liqmask, & ! IN - Liquid-cloud mask - icemask, & ! IN - Ice-cloud mask + !nday, & ! IN - Number of daylit gridpoints + !nLev, & ! IN - Number of vertical layers + !sw_cloud_props%get_nband(), & ! IN - Number of SW bands + !nrghice, & ! IN - Number of ice-roughness categories + !liqmask, & ! IN - Liquid-cloud mask + !icemask, & ! IN - Ice-cloud mask cld_lwp(idxday(1:nday),:), & ! IN - Cloud liquid water path cld_iwp(idxday(1:nday),:), & ! IN - Cloud ice water path cld_reliq(idxday(1:nday),:), & ! IN - Cloud liquid effective radius diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index 1b1ca8409..e9a2b64bc 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -29,7 +29,7 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp rrtmgp_sw_file_gas ! RRTMGP file containing coefficients used to compute gaseous optical properties integer, intent(in) :: & rrtmgp_nGases ! Number of trace gases active in RRTMGP - character(len=128),dimension(rrtmgp_nGases), intent(in) :: & + character(len=*),dimension(rrtmgp_nGases), intent(in) :: & active_gases_array ! Character array containing trace gases to include in RRTMGP integer,intent(in) :: & mpicomm, & ! MPI communicator @@ -316,9 +316,7 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp #endif ! Initialize gas concentrations and gas optics class - do iGas=1,rrtmgp_nGases - call check_error_msg('sw_gas_optics_init',gas_concentrations%set_vmr(active_gases_array(iGas), 0._kind_phys)) - enddo + call check_error_msg('sw_gas_optics_init',gas_concentrations%init(active_gases_array)) call check_error_msg('sw_gas_optics_init',sw_gas_props%load(gas_concentrations, gas_names, & key_species, band2gpt, band_lims, press_ref, press_ref_trop, temp_ref, temp_ref_p, & temp_ref_t, vmr_ref, kmajor, kminor_lower, kminor_upper, gas_minor, identifier_minor, & @@ -362,7 +360,7 @@ subroutine rrtmgp_sw_gas_optics_run(doSWrad, nCol, nLev, nday, idxday, sw_gas_pr solcon ! Solar constant integer, intent(in) :: & rrtmgp_nGases ! Number of trace gases active in RRTMGP - character(len=128),dimension(rrtmgp_nGases), intent(in) :: & + character(len=*),dimension(rrtmgp_nGases), intent(in) :: & active_gases_array ! Character array containing trace gases to include in RRTMGP ! Output @@ -392,6 +390,9 @@ subroutine rrtmgp_sw_gas_optics_run(doSWrad, nCol, nLev, nday, idxday, sw_gas_pr ! Allocate space call check_error_msg('rrtmgp_sw_gas_optics_run',sw_optical_props_clrsky%alloc_2str(nday, nLev, sw_gas_props)) + ! Initialize gas concentrations and gas optics class + call check_error_msg('rrtmgp_sw_rte_run',gas_concentrations_daylit%init(active_gases_array)) + ! Subset the gas concentrations, only need daylit points. do iGas=1,rrtmgp_nGases call check_error_msg('rrtmgp_sw_rte_run',& diff --git a/physics/rrtmgp_sw_gas_optics.meta b/physics/rrtmgp_sw_gas_optics.meta index bdcfd8cbb..fc8e72a9a 100644 --- a/physics/rrtmgp_sw_gas_optics.meta +++ b/physics/rrtmgp_sw_gas_optics.meta @@ -33,7 +33,7 @@ units = none dimensions = (number_of_active_gases_used_by_RRTMGP) type = character - kind = len=128 + kind = len=* intent = in optional = F [mpirank] @@ -214,7 +214,7 @@ units = none dimensions = (number_of_active_gases_used_by_RRTMGP) type = character - kind = len=128 + kind = len=* intent = in optional = F [errmsg] diff --git a/physics/rrtmgp_sw_rte.F90 b/physics/rrtmgp_sw_rte.F90 index 6543df9d0..de31a10f9 100644 --- a/physics/rrtmgp_sw_rte.F90 +++ b/physics/rrtmgp_sw_rte.F90 @@ -146,6 +146,7 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t endif ! Subset the gas concentrations, only need daylit points. + call check_error_msg('rrtmgp_sw_rte_run',gas_concentrations_daylit%init(active_gases_array)) do iGas=1,rrtmgp_nGases call check_error_msg('rrtmgp_sw_rte_run',& gas_concentrations%get_vmr(trim(active_gases_array(iGas)),vmrTemp)) diff --git a/physics/rrtmgp_sw_rte.meta b/physics/rrtmgp_sw_rte.meta index 4722a70f8..eaf4eab11 100644 --- a/physics/rrtmgp_sw_rte.meta +++ b/physics/rrtmgp_sw_rte.meta @@ -176,7 +176,7 @@ units = none dimensions = (number_of_active_gases_used_by_RRTMGP) type = character - kind = len=128 + kind = len=* intent = in optional = F [scmpsw]