diff --git a/GEOS_RadiationShared/RRTMGP_cmake/CMakeLists.txt b/GEOS_RadiationShared/RRTMGP_cmake/CMakeLists.txt index 18cc215..9e7b5a3 100644 --- a/GEOS_RadiationShared/RRTMGP_cmake/CMakeLists.txt +++ b/GEOS_RadiationShared/RRTMGP_cmake/CMakeLists.txt @@ -2,9 +2,9 @@ esma_set_this (OVERRIDE RRTMGP) # These are from RRTMGP set (RRTMGP_SRCS - rte-frontend/mo_rte_kind.F90 rte-frontend/mo_rte_config.F90 rte-frontend/mo_rte_util_array_validation.F90 + rte-kernels/mo_rte_kind.F90 rte-kernels/mo_rte_util_array.F90 rte-kernels/mo_rte_solver_kernels.F90 rte-kernels/mo_optical_props_kernels.F90 @@ -19,6 +19,7 @@ set (RRTMGP_SRCS gas-optics/mo_gas_concentrations.F90 gas-optics/mo_gas_optics.F90 rrtmgp-kernels/mo_gas_optics_rrtmgp_kernels.F90 + rrtmgp-kernels/mo_cloud_optics_rrtmgp_kernels.F90 rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 rrtmgp-frontend/mo_cloud_optics_rrtmgp.F90 extensions/mo_compute_bc.F90 diff --git a/GEOSirrad_GridComp/GEOS_IrradGridComp.F90 b/GEOSirrad_GridComp/GEOS_IrradGridComp.F90 index d1ddf81..ab95dc9 100644 --- a/GEOSirrad_GridComp/GEOS_IrradGridComp.F90 +++ b/GEOSirrad_GridComp/GEOS_IrradGridComp.F90 @@ -1459,7 +1459,7 @@ subroutine LW_Driver(IM,JM,LM,LATS,LONS,RC) use mo_fluxes_byband, only: ty_fluxes_byband use mo_rte_lw, only: rte_lw use mo_load_coefficients, only: load_and_init - use mo_load_cloud_coefficients, only: load_cld_lutcoeff, load_cld_padecoeff + use mo_load_cloud_coefficients, only: load_cld_lutcoeff ! used to avoid a reshaped copy of some arrays in RRTMGP blocking ! (Tom Clune's suggestion) @@ -1659,7 +1659,7 @@ subroutine LW_Driver(IM,JM,LM,LATS,LONS,RC) class(ty_optical_props_arry), allocatable :: clean_optical_props, dirty_optical_props ! RRTMGP locals - logical :: top_at_1, u2s, partial_block, gen_mro, cond_inhomo + logical :: u2s, partial_block, gen_mro, cond_inhomo logical :: need_dirty_optical_props, need_cloud_optical_props logical :: export_clrnoa, export_clrsky, export_allnoa, export_allsky logical :: calc_clrnoa, calc_clrsky, calc_allnoa, calc_allsky @@ -2148,7 +2148,7 @@ subroutine LW_Driver(IM,JM,LM,LATS,LONS,RC) TEST_(error_msg) if (associated( CO2_3d)) & - allocate(CO2_R(IM*JM,LM),__STAT__) + allocate(CO2_R(IM*JM,LM),__STAT__) allocate( Q_R(IM*JM,LM),__STAT__) allocate( O3_R(IM*JM,LM),__STAT__) allocate(N2O_R(IM*JM,LM),__STAT__) @@ -2260,11 +2260,6 @@ subroutine LW_Driver(IM,JM,LM,LATS,LONS,RC) p_lev = real(reshape(PLE ,(/ncol,LM+1/)), kind=wp) cf_wp = real(reshape(FCLD,(/ncol,LM /)), kind=wp) - ! RRTMGP's rte_lw takes a vertical ordering flag - ! (no need to flip columns as with RRTMG) - top_at_1 = p_lay(1, 1) < p_lay(1, LM) - _ASSERT(top_at_1, 'unexpected vertical ordering') - ! layer pressure thicknesses used for cloud water path calculations ! (do before any KLUGE to top pressure so optical paths wont be affected) ! (also better to use these unKLUGED pressure intervals in t_lev calculation) @@ -2515,8 +2510,6 @@ subroutine LW_Driver(IM,JM,LM,LATS,LONS,RC) call MAPL_TimerOn(MAPL,"---RRTMGP_IO_CLOUDS",__RC__) if (trim(cloud_optics_type)=='LUT') then call load_cld_lutcoeff (cloud_optics, cloud_optics_file) - elseif (trim(cloud_optics_type)=='PADE') then - call load_cld_padecoeff(cloud_optics, cloud_optics_file) else TEST_('unknown cloud_optics_type: '//trim(cloud_optics_file)) end if @@ -2663,7 +2656,7 @@ subroutine LW_Driver(IM,JM,LM,LATS,LONS,RC) call PROCESS_RRTMGP_LW_BLOCK( & b, rrtmgp_blockSize, ncol, LM, nmom, ngpt, nga, & IM, IM_World, iBeg, jBeg, & - top_at_1, u2s, & + u2s, & seeds(2), seeds(3), & cwp_fac, & need_cloud_optical_props, need_dirty_optical_props, & @@ -3626,7 +3619,7 @@ end subroutine compute_lw_gas_optics !----------------------------------------------------------------------- subroutine compute_lw_rte( & colS, colE, ncols_block, LM, nmom, & - top_at_1, u2s, nga, & + u2s, nga, & calc_clrnoa, calc_allnoa, calc_clrsky, calc_allsky, & allnoa_to_allsky_band_xfer_needed, any_band_output, & export_clrsky, export_allsky, & @@ -3652,7 +3645,7 @@ subroutine compute_lw_rte( & #define TEST_(msg) if (msg /= '') then; write(0,*) trim(msg); VERIFY_(STATUS); end if integer, intent(in) :: colS, colE, ncols_block, LM, nmom - logical, intent(in) :: top_at_1, u2s + logical, intent(in) :: u2s integer, intent(in) :: nga logical, intent(in) :: calc_clrnoa, calc_allnoa, calc_clrsky, calc_allsky logical, intent(in) :: allnoa_to_allsky_band_xfer_needed, any_band_output @@ -3688,7 +3681,7 @@ subroutine compute_lw_rte( & fluxes_clrnoa%flux_up_Jac => dfupdts_clrnoa(colS:colE,:) error_msg = rte_lw( & clean_optical_props, & - top_at_1, sources, emis_sfc(:,colS:colE), & + sources, emis_sfc(:,colS:colE), & fluxes_clrnoa, n_gauss_angles=nga, use_2stream=u2s) TEST_(error_msg) end if @@ -3733,7 +3726,7 @@ subroutine compute_lw_rte( & fluxes_byband_allnoa%bnd_flux_up_Jac => bnd_dfupdts_allnoa(colS:colE,:,:) error_msg = rte_lw( & clean_optical_props, & - top_at_1, sources, emis_sfc(:,colS:colE), & + sources, emis_sfc(:,colS:colE), & fluxes_byband_allnoa, n_gauss_angles=nga, use_2stream=u2s) TEST_(error_msg) else @@ -3743,7 +3736,7 @@ subroutine compute_lw_rte( & fluxes_allnoa%flux_up_Jac => dfupdts_allnoa(colS:colE,:) error_msg = rte_lw( & clean_optical_props, & - top_at_1, sources, emis_sfc(:,colS:colE), & + sources, emis_sfc(:,colS:colE), & fluxes_allnoa, n_gauss_angles=nga, use_2stream=u2s) TEST_(error_msg) endif @@ -3765,7 +3758,7 @@ subroutine compute_lw_rte( & fluxes_clrsky%flux_up_Jac => dfupdts_clrsky(colS:colE,:) error_msg = rte_lw( & dirty_optical_props, & - top_at_1, sources, emis_sfc(:,colS:colE), & + sources, emis_sfc(:,colS:colE), & fluxes_clrsky, n_gauss_angles=nga, use_2stream=u2s) TEST_(error_msg) end if @@ -3786,7 +3779,7 @@ subroutine compute_lw_rte( & fluxes_byband_allsky%bnd_flux_up_Jac => bnd_dfupdts_allsky(colS:colE,:,:) error_msg = rte_lw( & dirty_optical_props, & - top_at_1, sources, emis_sfc(:,colS:colE), & + sources, emis_sfc(:,colS:colE), & fluxes_byband_allsky, n_gauss_angles=nga, use_2stream=u2s) TEST_(error_msg) else @@ -3795,7 +3788,7 @@ subroutine compute_lw_rte( & fluxes_allsky%flux_up_Jac => dfupdts_allsky(colS:colE,:) error_msg = rte_lw( & dirty_optical_props, & - top_at_1, sources, emis_sfc(:,colS:colE), & + sources, emis_sfc(:,colS:colE), & fluxes_allsky, n_gauss_angles=nga, use_2stream=u2s) TEST_(error_msg) end if @@ -3840,7 +3833,7 @@ end subroutine compute_lw_rte subroutine PROCESS_RRTMGP_LW_BLOCK( & b, rrtmgp_blockSize, ncol, LM, nmom, ngpt, nga, & IM, IM_World, iBeg, jBeg, & - top_at_1, u2s, & + u2s, & seeds_time_key, seeds_ctr_key, & cwp_fac, & need_cloud_optical_props, need_dirty_optical_props, & @@ -3872,7 +3865,7 @@ subroutine PROCESS_RRTMGP_LW_BLOCK( & integer, intent(in) :: b, rrtmgp_blockSize, ncol, LM, nmom, ngpt, nga integer, intent(in) :: IM, IM_World, iBeg, jBeg - logical, intent(in) :: top_at_1, u2s + logical, intent(in) :: u2s integer, intent(in) :: seeds_time_key, seeds_ctr_key real(wp), intent(in) :: cwp_fac logical, intent(in) :: need_cloud_optical_props, need_dirty_optical_props @@ -3995,7 +3988,7 @@ subroutine PROCESS_RRTMGP_LW_BLOCK( & if (need_dirty_optical_props .and. need_cloud_optical_props) then call compute_lw_rte( & colS, colE, ncols_block, LM, nmom, & - top_at_1, u2s, nga, & + u2s, nga, & calc_clrnoa, calc_allnoa, calc_clrsky, calc_allsky, & allnoa_to_allsky_band_xfer_needed, any_band_output, & export_clrsky, export_allsky, & @@ -4013,7 +4006,7 @@ subroutine PROCESS_RRTMGP_LW_BLOCK( & else if (need_dirty_optical_props) then call compute_lw_rte( & colS, colE, ncols_block, LM, nmom, & - top_at_1, u2s, nga, & + u2s, nga, & calc_clrnoa, calc_allnoa, calc_clrsky, calc_allsky, & allnoa_to_allsky_band_xfer_needed, any_band_output, & export_clrsky, export_allsky, & @@ -4030,7 +4023,7 @@ subroutine PROCESS_RRTMGP_LW_BLOCK( & else if (need_cloud_optical_props) then call compute_lw_rte( & colS, colE, ncols_block, LM, nmom, & - top_at_1, u2s, nga, & + u2s, nga, & calc_clrnoa, calc_allnoa, calc_clrsky, calc_allsky, & allnoa_to_allsky_band_xfer_needed, any_band_output, & export_clrsky, export_allsky, & @@ -4047,7 +4040,7 @@ subroutine PROCESS_RRTMGP_LW_BLOCK( & else call compute_lw_rte( & colS, colE, ncols_block, LM, nmom, & - top_at_1, u2s, nga, & + u2s, nga, & calc_clrnoa, calc_allnoa, calc_clrsky, calc_allsky, & allnoa_to_allsky_band_xfer_needed, any_band_output, & export_clrsky, export_allsky, & diff --git a/GEOSsolar_GridComp/GEOS_SolarGridComp.F90 b/GEOSsolar_GridComp/GEOS_SolarGridComp.F90 index f74bcd4..2c6243d 100644 --- a/GEOSsolar_GridComp/GEOS_SolarGridComp.F90 +++ b/GEOSsolar_GridComp/GEOS_SolarGridComp.F90 @@ -2,10 +2,10 @@ #define LIN2_ARG1(VAR,I,J,FINT) (VAR(I,J) + FINT * (VAR(I+1,J)-VAR(I,J))) ! ============================================================================== -! Note: the SOLAR_RADVAL compile time flag (enabled with the ENABLE_SOLAR_RADVAL +! Note: the SOLAR_RADVAL compile time flag (enabled with the ENABLE_SOLAR_RADVAL ! CMake option) is used to select solar diagnostic features which are generally ! more advanced than what a regular user will need and mainly for use by the -! the radiation code development team. They are chosen by compile time flag +! the radiation code development team. They are chosen by compile time flag ! because they bloat the restart state and may also incur other computational ! costs that are not warranted under normal (non-development) use. ! ============================================================================== @@ -473,7 +473,7 @@ subroutine SetServices ( GC, RC ) type (ty_RRTMGP_wrap) :: wrap ! for OSRBbbRG, ISRBbbRG, and TBRBbbRG - integer :: ibnd + integer :: ibnd character*2 :: bb !============================================================================= @@ -521,7 +521,7 @@ subroutine SetServices ( GC, RC ) ! Decide if should make OBIO exports call MAPL_GetResource ( MAPL, DO_OBIO, Label="USE_OCEANOBIOGEOCHEM:",DEFAULT=0, RC=STATUS) VERIFY_(STATUS) - + SOLAR_TO_OBIO = (DO_OBIO/=0) ! Set the state variable specs. @@ -790,21 +790,21 @@ subroutine SetServices ( GC, RC ) do ibnd = 1,nbndsw if (band_output_supported(ibnd)) then write(bb,'(I0.2)') ibnd - + call MAPL_AddInternalSpec(GC, & SHORT_NAME = 'OSRB'//bb//'RGN', & LONG_NAME = 'normalized_upwelling_shortwave_flux_at_TOA_in_RR_band'//bb, & UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, __RC__ ) - + call MAPL_AddInternalSpec(GC, & SHORT_NAME = 'ISRB'//bb//'RGN', & LONG_NAME = 'normalized_downwelling_shortwave_flux_at_TOA_in_RR_band'//bb, & UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, __RC__ ) - + end if end do end if @@ -1475,7 +1475,7 @@ subroutine SetServices ( GC, RC ) VLOCATION = MAPL_VLocationNone, & FRIENDLYTO = trim(COMP_NAME), __RC__) - ! super-layerized phase-split cloud SSA and ASM + ! super-layerized phase-split cloud SSA and ASM call MAPL_AddInternalSpec(GC, & SHORT_NAME = 'SSALDENLOPAR', & @@ -2668,28 +2668,28 @@ subroutine SetServices ( GC, RC ) do ibnd = 1,nbndsw if (band_output_supported(ibnd)) then write(bb,'(I0.2)') ibnd - + call MAPL_AddExportSpec(GC, & SHORT_NAME = 'OSRB'//bb//'RG', & LONG_NAME = 'upwelling_shortwave_flux_at_TOA_in_RR_band'//bb, & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, __RC__ ) - + call MAPL_AddExportSpec(GC, & SHORT_NAME = 'ISRB'//bb//'RG', & LONG_NAME = 'downwelling_shortwave_flux_at_TOA_in_RR_band'//bb, & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, __RC__ ) - + call MAPL_AddExportSpec(GC, & SHORT_NAME = 'TBRB'//bb//'RG', & LONG_NAME = 'brightness_temperature_in_RR_SW_band'//bb, & UNITS = 'K', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, __RC__ ) - + end if end do end if @@ -2961,7 +2961,7 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) ! (only RRTMG[P]; OSRBbbRG, ISRBbbRG, and TBRBbbRG) logical :: band_output (nbndsw) integer :: ibnd - character*2 :: bb + character*2 :: bb real, parameter :: SSA_MAX = 0.999999 real, parameter :: ASY_MAX = 0.999 @@ -3073,7 +3073,7 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) _FAIL('Total number of radiation bands is inconsistent!') end if - ! select which bands require OSRB output ... + ! select which bands require OSRB output ... ! ------------------------------------------ ! Only available for RRTMG[P] ! Must be supported AND requested by exports 'OSRBbbRG', 'ISRBbbRG', or 'TBRBbbRG' @@ -3083,16 +3083,16 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) if (.not. band_output_supported(ibnd)) cycle write(bb,'(I0.2)') ibnd call MAPL_GetPointer(EXPORT, ptr2d, 'OSRB'//bb//'RG', __RC__) - if (associated(ptr2d)) then + if (associated(ptr2d)) then band_output(ibnd) = .true. cycle - end if + end if call MAPL_GetPointer(EXPORT, ptr2d, 'ISRB'//bb//'RG', __RC__) - if (associated(ptr2d)) then + if (associated(ptr2d)) then band_output(ibnd) = .true. cycle - end if - call MAPL_GetPointer(EXPORT, ptr2d, 'TBRB'//bb//'RG', __RC__) + end if + call MAPL_GetPointer(EXPORT, ptr2d, 'TBRB'//bb//'RG', __RC__) if (associated(ptr2d)) then band_output(ibnd) = .true. cycle @@ -3485,7 +3485,7 @@ subroutine SORADCORE(IM,JM,LM,include_aerosols,CURRTIME,MaxPasses,LoadBalance,RC use mo_fluxes_byband, only: ty_fluxes_byband use mo_rte_sw, only: rte_sw use mo_load_coefficients, only: load_and_init - use mo_load_cloud_coefficients, only: load_cld_lutcoeff, load_cld_padecoeff + use mo_load_cloud_coefficients, only: load_cld_lutcoeff #ifdef HAVE_MKL ! Type of MKL VSL Basic RNGs @@ -3677,7 +3677,7 @@ subroutine SORADCORE(IM,JM,LM,include_aerosols,CURRTIME,MaxPasses,LoadBalance,RC ! PMN: my earlier RRTMGP implementations used cloud_props for liq and ice combined, ! but now, to allow separate delta-scaling for the two phases, we keep separate liq and - ! ice properties, and combine them later. There may be some speedup possible here, but + ! ice properties, and combine them later. There may be some speedup possible here, but ! to allow for future more independent phases (e.g., separate condensate inhomogeneity ! for the phases), we keep the phase optical properties separate as long as possible. @@ -3694,7 +3694,7 @@ subroutine SORADCORE(IM,JM,LM,include_aerosols,CURRTIME,MaxPasses,LoadBalance,RC class(ty_optical_props_arry), allocatable :: optical_props ! RRTMGP locals - logical :: top_at_1, need_aer_optical_props + logical :: need_aer_optical_props logical :: gen_mro, cond_inhomo logical :: rrtmgp_delta_scale, rrtmgp_use_rrtmg_iceflg3_like_forwice integer :: nbnd, ngpt, nmom, icergh @@ -4105,7 +4105,7 @@ subroutine SORADCORE(IM,JM,LM,include_aerosols,CURRTIME,MaxPasses,LoadBalance,RC QR => ptr2(1:Num2do,:) case('QS') QS => ptr2(1:Num2do,:) - case('QG') + case('QG') QG => ptr2(1:Num2do,:) case('RL') RL => ptr2(1:Num2do,:) @@ -4980,11 +4980,6 @@ subroutine SORADCORE(IM,JM,LM,include_aerosols,CURRTIME,MaxPasses,LoadBalance,RC t_lay = real(T , kind=wp) p_lev = real(PLE, kind=wp) - ! RRTMGP's rte_sw takes a vertical ordering flag - ! (no need to flip columns as with RRTMG) - top_at_1 = p_lay(1, 1) < p_lay(1, LM) - _ASSERT(top_at_1, 'unexpected vertical ordering') - ! layer pressure thicknesses used for cloud water path calculations ! (do before any KLUGE to top pressure so optical paths wont be affected) ! (also better to use these unKLUGED pressure intervals in t_lev calculation) @@ -5063,8 +5058,6 @@ subroutine SORADCORE(IM,JM,LM,include_aerosols,CURRTIME,MaxPasses,LoadBalance,RC call MAPL_TimerOn(MAPL,"--RRTMGP_IO_CLOUDS",__RC__) if (trim(cloud_optics_type)=='LUT') then call load_cld_lutcoeff (cloud_optics, cloud_optics_file) - elseif (trim(cloud_optics_type)=='PADE') then - call load_cld_padecoeff(cloud_optics, cloud_optics_file) else TEST_('unknown cloud_optics_type: '//trim(cloud_optics_file)) end if @@ -5202,7 +5195,7 @@ subroutine SORADCORE(IM,JM,LM,include_aerosols,CURRTIME,MaxPasses,LoadBalance,RC b, ncol, rrtmgp_blockSize, LM, ngpt, nbnd, nmom, & LCLDLM, LCLDMH, include_aerosols, gen_mro, cond_inhomo, & cloud_overlap_type, IM_World, seeds(2), & - need_aer_optical_props, top_at_1, & + need_aer_optical_props, & rrtmgp_delta_scale, rrtmgp_use_rrtmg_iceflg3_like_forwice, & cwp_fac, & gas_concs, k_dist, cloud_optics, & @@ -5295,10 +5288,10 @@ subroutine SORADCORE(IM,JM,LM,include_aerosols,CURRTIME,MaxPasses,LoadBalance,RC end do endif ! TOA band fluxes - if (include_aerosols) then + if (include_aerosols) then if (USE_RRTMG .or. USE_RRTMGP) then do ib = 1, nbnd - if (band_output(ib)) then + if (band_output(ib)) then ISRBRGN(ib) % p = real(bnd_flux_dn_allsky(:,1,ib)) OSRBRGN(ib) % p = real(bnd_flux_dn_allsky(:,1,ib) - bnd_flux_net_allsky(:,1,ib)) end if @@ -5409,9 +5402,9 @@ subroutine SORADCORE(IM,JM,LM,include_aerosols,CURRTIME,MaxPasses,LoadBalance,RC call MAPL_GetResource(MAPL,ICEFLGSW,'RRTMG_ICEFLG:',DEFAULT=3,__RC__) call MAPL_GetResource(MAPL,LIQFLGSW,'RRTMG_LIQFLG:',DEFAULT=1,__RC__) - if (LM > 72) then + if (LM > 72) then call MAPL_GetResource(MAPL,USE_PRECIP_IN_RADIATION,'RRTMGSW_USE_PRECIP_IN_RADIATION:',DEFAULT=.TRUE.,RC=STATUS) - VERIFY_(STATUS) + VERIFY_(STATUS) else call MAPL_GetResource(MAPL,USE_PRECIP_IN_RADIATION,'RRTMGSW_USE_PRECIP_IN_RADIATION:',DEFAULT=.FALSE.,RC=STATUS) VERIFY_(STATUS) @@ -7119,7 +7112,7 @@ end subroutine compute_sprlyr_diags_postdelta subroutine compute_rte_sw( & colS, colE, ngpt, & tsi, toa_flux, optical_props, & - top_at_1, mu0, sfc_alb_dir, sfc_alb_dif, & + mu0, sfc_alb_dir, sfc_alb_dif, & fluxes_clrsky, flux_up_clrsky, flux_net_clrsky, & fluxes_allsky, flux_up_allsky, flux_net_allsky, & bnd_flux_dn_allsky, bnd_flux_dir_allsky, bnd_flux_net_allsky, & @@ -7135,7 +7128,6 @@ subroutine compute_rte_sw( & real(wp), intent(in) :: tsi(:) real(wp), intent(inout) :: toa_flux(:,:) class(ty_optical_props_arry), intent(inout) :: optical_props - logical, intent(in) :: top_at_1 real(wp), intent(in) :: mu0(:) real(wp), intent(in) :: sfc_alb_dir(:,:) real(wp), intent(in) :: sfc_alb_dif(:,:) @@ -7167,7 +7159,7 @@ subroutine compute_rte_sw( & fluxes_clrsky%flux_up => flux_up_clrsky fluxes_clrsky%flux_net => flux_net_clrsky error_msg = rte_sw( & - optical_props, top_at_1, mu0(colS:colE), toa_flux, & + optical_props, mu0(colS:colE), toa_flux, & sfc_alb_dir(:,colS:colE), sfc_alb_dif(:,colS:colE), & fluxes_clrsky) TEST_(error_msg) @@ -7184,7 +7176,7 @@ subroutine compute_rte_sw( & fluxes_allsky%bnd_flux_dn_dir => bnd_flux_dir_allsky fluxes_allsky%bnd_flux_net => bnd_flux_net_allsky error_msg = rte_sw( & - optical_props, top_at_1, mu0(colS:colE), toa_flux, & + optical_props, mu0(colS:colE), toa_flux, & sfc_alb_dir(:,colS:colE), sfc_alb_dif(:,colS:colE), & fluxes_allsky) TEST_(error_msg) @@ -7201,7 +7193,7 @@ subroutine PROCESS_RRTMGP_BLOCK( & b, ncol, rrtmgp_blockSize, LM, ngpt, nbnd, nmom, & LCLDLM, LCLDMH, include_aerosols, gen_mro, cond_inhomo, & cloud_overlap_type, IM_World, seeds_time_key, & - need_aer_optical_props, top_at_1, & + need_aer_optical_props, & rrtmgp_delta_scale, rrtmgp_use_rrtmg_iceflg3_like_forwice, & cwp_fac_arg, & gas_concs, k_dist, cloud_optics, & @@ -7267,7 +7259,6 @@ subroutine PROCESS_RRTMGP_BLOCK( & integer, intent(in) :: IM_World integer, intent(in) :: seeds_time_key logical, intent(in) :: need_aer_optical_props - logical, intent(in) :: top_at_1 logical, intent(in) :: rrtmgp_delta_scale logical, intent(in) :: rrtmgp_use_rrtmg_iceflg3_like_forwice real(wp), intent(in) :: cwp_fac_arg @@ -7519,7 +7510,7 @@ subroutine PROCESS_RRTMGP_BLOCK( & call compute_rte_sw( & colS, colE, ngpt, & tsi, toa_flux, optical_props, & - top_at_1, mu0, sfc_alb_dir, sfc_alb_dif, & + mu0, sfc_alb_dir, sfc_alb_dif, & fluxes_clrsky, flux_up_clrsky(colS:colE,:), flux_net_clrsky(colS:colE,:), & fluxes_allsky, flux_up_allsky(colS:colE,:), flux_net_allsky(colS:colE,:), & bnd_flux_dn_allsky(colS:colE,:,:), bnd_flux_dir_allsky(colS:colE,:,:), & @@ -7808,8 +7799,8 @@ subroutine UPDATE_EXPORT(IM,JM,LM, RC) integer :: iseg, ibbeg, ibend, jb, kb, kb_start, kb_used_last logical :: sfirst, ofirst - ! band wavenumber bounds (m-1) - real :: wn1, wn2 + ! band wavenumber bounds (m-1) + real :: wn1, wn2 Iam = trim(COMP_NAME)//"SolarUpdateExport" @@ -8317,7 +8308,7 @@ subroutine UPDATE_EXPORT(IM,JM,LM, RC) where (aCLDT > 0.) aTAUT = (aTAUL*aCLDL + aTAUM*aCLDM + aTAUH*aCLDH) / aCLDT if (associated(TAUX)) TAUX = aTAUT if (associated(COTT)) then - COTT = MAPL_UNDEF + COTT = MAPL_UNDEF where (aCLDT > 0.) COTT = aTAUT end if if (associated(COTNT)) COTNT = aCLDT * aTAUT @@ -8594,7 +8585,7 @@ subroutine UPDATE_EXPORT(IM,JM,LM, RC) else ! USE_RRTMGP ! get RRTMGP wavenumbers - if (.not. have_rrtmgp_wavenums) then + if (.not. have_rrtmgp_wavenums) then ! access RRTMGP internal state from the GC if (.not. rrtmgp_state_set) then @@ -8602,7 +8593,7 @@ subroutine UPDATE_EXPORT(IM,JM,LM, RC) VERIFY_(status) rrtmgp_state => wrap%ptr rrtmgp_state_set = .true. - end if + end if ! helper for testing RRTMGP error status on return; ! allows line number reporting cf. original call method @@ -8611,7 +8602,7 @@ subroutine UPDATE_EXPORT(IM,JM,LM, RC) ! initialize k-distribution if not already done ! remember: its possible to have UPDATE_FIRST if (.not. rrtmgp_state%initialized) then - call MAPL_GetResource( & + call MAPL_GetResource( & MAPL, k_dist_file, "RRTMGP_GAS_SW:", & DEFAULT='rrtmgp-gas-sw-g112.nc',__RC__) ! gas_concs needed only to access required gas names @@ -8659,7 +8650,7 @@ subroutine UPDATE_EXPORT(IM,JM,LM, RC) if (USE_RRTMGP) then ! get RRTMGP wavenumbers - if (.not. have_rrtmgp_wavenums) then + if (.not. have_rrtmgp_wavenums) then ! access RRTMGP internal state from the GC if (.not. rrtmgp_state_set) then @@ -8667,7 +8658,7 @@ subroutine UPDATE_EXPORT(IM,JM,LM, RC) VERIFY_(status) rrtmgp_state => wrap%ptr rrtmgp_state_set = .true. - end if + end if ! helper for testing RRTMGP error status on return; ! allows line number reporting cf. original call method @@ -8676,7 +8667,7 @@ subroutine UPDATE_EXPORT(IM,JM,LM, RC) ! initialize k-distribution if not already done ! remember: its possible to have UPDATE_FIRST if (.not. rrtmgp_state%initialized) then - call MAPL_GetResource( & + call MAPL_GetResource( & MAPL, k_dist_file, "RRTMGP_GAS_SW:", & DEFAULT='rrtmgp-gas-sw-g112.nc',__RC__) ! gas_concs needed only to access required gas names