diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 1b37044b5..95d404283 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -18,13 +18,9 @@ module GFS_rrtmgp_pre eps => con_eps, & ! Rd/Rv epsm1 => con_epsm1, & ! Rd/Rv-1 fvirt => con_fvirt, & ! Rv/Rd-1 - rog => con_rog, & ! Rd/g - rocp => con_rocp ! Rd/cp + rog => con_rog ! Rd/g use radcons, only: & - itsfc, & ! Flag for LW sfc. temp. - ltp, & ! 1-add extra-top layer; 0-no extra layer - lextop, & ! ltp > 0 - qmin,qme5, qme6, epsq ! Minimum vlaues for varius calculations + qmin, epsq ! Minimum vlaues for varius calculations use funcphys, only: & fpvs ! Function ot compute sat. vapor pressure over liq. use module_radiation_astronomy,only: & @@ -165,7 +161,7 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, errmsg ! Error message integer, intent(out) :: & errflg ! Error flag - real(kind_phys), dimension(ncol,Model%levr+LTP),intent(out) :: & + real(kind_phys), dimension(ncol,Model%levr),intent(out) :: & cld_frac, & ! Total cloud fraction cld_lwp, & ! Cloud liquid water path cld_reliq, & ! Cloud liquid effective radius @@ -222,24 +218,39 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, ! ####################################################################################### ! Compute some fields needed by RRTMGP ! ####################################################################################### - ! Copy state fields over for use in RRTMGP - p_lev(1:NCOL,iSFC:iTOA) = Statein%prsi(1:NCOL,1:Model%levs) - p_lev(1:NCOL,iTOA+1) = spread(lw_gas_props%get_press_min(),dim=1, ncopies=NCOL) - p_lay(1:NCOL,iSFC:iTOA) = Statein%prsl(1:NCOL,1:Model%levs) - t_lay(1:NCOL,iSFC:iTOA) = Statein%tgrs(1:NCOL,1:Model%levs) - - ! Compute layer pressure thicknes - deltaP = p_lev(:,iSFC:iTOA)-p_lev(:,iSFC+1:iTOA+1) - ! Compute temperature at layer-interfaces + ! Pressure at layer-interface + p_lev(1:NCOL,iSFC:iTOA+1) = Statein%prsi(1:NCOL,1:Model%levs+1) + ! + ! Pressure at layer-center + p_lay(1:NCOL,iSFC:iTOA) = Statein%prsl(1:NCOL,1:Model%levs) + ! + ! Temperature at layer-center + t_lay(1:NCOL,iSFC:iTOA) = Statein%tgrs(1:NCOL,1:Model%levs) + ! + ! Temperature at layer-interfaces t_lev(1:NCOL,iSFC) = Sfcprop%tsfc(1:NCOL) do iCol=1,NCOL do iLay=iSFC+1,iTOA t_lev(iCol,iLay) = (t_lay(iCol,iLay)+t_lay(iCol,iLay-1))/2._kind_phys enddo - t_lev(iCol,iTOA+1) = lw_gas_props%get_temp_min() + t_lev(iCol,iTOA+1) = t_lev(iCol,iTOA) + (p_lev(iCol,iTOA+1)-p_lev(iCOL,iTOA))*& + (t_lev(iCol,iTOA)-t_lay(iCOL,iTOA))/(p_lev(iCol,iTOA)-p_lay(iCOL,iTOA)) enddo + ! Guard against case when model uppermost model layer higher than rrtmgp allows. + where(p_lev(1:nCol,iTOA+1) .lt. lw_gas_props%get_press_min()) + ! Set to RRTMGP min(pressure/temperature) + p_lev(1:nCol,iTOA+1) = spread(lw_gas_props%get_press_min(),dim=1,ncopies=ncol) + t_lev(1:nCol,iTOA+1) = spread(lw_gas_props%get_temp_min(),dim=1,ncopies=ncol) + ! Recompute layer pressure/temperature. + p_lay(1:NCOL,iTOA) = 0.5_kind_phys*(p_lev(1:NCOL,iTOA) + p_lev(1:NCOL,iTOA+1)) + t_lay(1:NCOL,iTOA) = 0.5_kind_phys*(t_lev(1:NCOL,iTOA) + t_lev(1:NCOL,iTOA+1)) + end where + + ! Compute layer pressure thicknes + deltaP = p_lev(:,iSFC:iTOA)-p_lev(:,iSFC+1:iTOA+1) + ! Compute a bunch of thermodynamic fields needed by the macrophysics schemes. Relative humidity, ! saturation mixing-ratio, vapor mixing-ratio, virtual temperature, layer thickness,... do iCol=1,NCOL diff --git a/physics/GFS_rrtmgp_setup.F90 b/physics/GFS_rrtmgp_setup.F90 index 6b7ada945..8307d1aa8 100644 --- a/physics/GFS_rrtmgp_setup.F90 +++ b/physics/GFS_rrtmgp_setup.F90 @@ -10,7 +10,6 @@ module GFS_rrtmgp_setup & iswcliq, & & kind_phys - use radcons, only: ltp, lextop implicit none @@ -227,9 +226,9 @@ subroutine GFS_rrtmgp_setup_init ( & integer, intent(out) :: errflg ! For consistency checks - real(kind_phys), dimension(im,levr+ltp,NBDLW,NF_AELW) :: faerlw_check - real(kind_phys), dimension(im,levr+ltp,NBDSW,NF_AESW) :: faersw_check - real(kind_phys), dimension(im,NSPC1) :: aerodp_check + real(kind_phys), dimension(im,levr,NBDLW,NF_AELW) :: faerlw_check + real(kind_phys), dimension(im,levr,NBDSW,NF_AESW) :: faersw_check + real(kind_phys), dimension(im,NSPC1) :: aerodp_check ! End for consistency checks ! Initialize the CCPP error handling variables @@ -244,7 +243,7 @@ subroutine GFS_rrtmgp_setup_init ( & if (size(faerlw(1,:,:,:)).ne.size(faerlw_check(1,:,:,:))) then write(errmsg,"(3a,4i4,a,4i4)") & "Runtime error: dimension mismatch for faerlw,", & - " check definitions of levr, ltp, nbdlw, nf_aelw:", & + " check definitions of Model%levs, nbdlw, nf_aelw:", & " expected shape ", shape(faerlw_check(:,:,:,:)), & " but got ", shape(faerlw(:,:,:,:)) errflg = 1 @@ -253,7 +252,7 @@ subroutine GFS_rrtmgp_setup_init ( & if (size(faersw(1,:,:,:)).ne.size(faersw_check(1,:,:,:))) then write(errmsg,"(3a,4i4,a,4i4)") & "Runtime error: dimension mismatch for faersw,", & - " check definitions of levr, ltp, nbdsw, nf_aesw:", & + " check definitions of Model%levs, nbdsw, nf_aesw:", & " expected shape ", shape(faersw_check(:,:,:,:)), & " but got ", shape(faersw(:,:,:,:)) errflg = 1 @@ -592,7 +591,6 @@ subroutine radinit( si, NLAY, imp_physics, me ) ! write(0,*)' IVFLIP=',ivflip,' IOVRSW=',iovrsw,' IOVRLW=',iovrlw,& ! & ' ISUBCSW=',isubcsw,' ISUBCLW=',isubclw print *,' LCRICK=',lcrick,' LCNORM=',lcnorm,' LNOPREC=',lnoprec - print *,' LTP =',ltp,', add extra top layer =',lextop if ( ictmflg==0 .or. ictmflg==-2 ) then print *,' Data usage is limited by initial condition!' diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index 29e5d203b..da88f4f53 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -6,6 +6,7 @@ module rrtmgp_lw_gas_optics use mo_gas_concentrations, only: ty_gas_concs use mo_source_functions, only: ty_source_func_lw use mo_optical_props, only: ty_optical_props_1scl + use mo_compute_bc, only: compute_bc use rrtmgp_aux, only: check_error_msg use netcdf @@ -422,26 +423,27 @@ end subroutine rrtmgp_lw_gas_optics_init ! function and gas_optics() here. ! ######################################################################################### !! \section arg_table_rrtmgp_lw_gas_optics_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------------|----------------------------------------------|--------------------------------------------------------------------|-------|------|-----------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | -!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | in | F | -!! | lw_gas_props | coefficients_for_lw_gas_optics | DDT containing spectral information for RRTMGP LW radiation scheme | DDT | 0 | ty_gas_optics_rrtmgp | | in | F | -!! | ncol | horizontal_loop_extent | horizontal dimension | count | 0 | integer | | in | F | -!! | p_lay | air_pressure_at_layer_for_RRTMGP_in_hPa | air pressure layer | hPa | 2 | real | kind_phys | in | F | -!! | p_lev | air_pressure_at_interface_for_RRTMGP_in_hPa | air pressure level | hPa | 2 | real | kind_phys | in | F | -!! | t_lay | air_temperature_at_layer_for_RRTMGP | air temperature layer | K | 2 | real | kind_phys | in | F | -!! | t_lev | air_temperature_at_interface_for_RRTMGP | air temperature level | K | 2 | real | kind_phys | in | F | -!! | skt | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | in | F | -!! | gas_concentrations | Gas_concentrations_for_RRTMGP_suite | DDT containing gas concentrations for RRTMGP radiation scheme | DDT | 0 | ty_gas_concs | | in | F | -!! | lslwr | flag_to_calc_lw | flag to calculate LW irradiances | flag | 0 | logical | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | -!! | optical_props_clrsky | longwave_optical_properties_for_clear_sky | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_1scl | | out | F | -!! | sources_LW | longwave_source_function | Fortran DDT containing RRTMGP source functions | DDT | 0 | ty_source_func_lw | | out | F | +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |----------------------|------------------------------------------------------------------------|--------------------------------------------------------------------|-------|------|-----------------------|-----------|--------|----------| +!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | +!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | in | F | +!! | lw_gas_props | coefficients_for_lw_gas_optics | DDT containing spectral information for RRTMGP LW radiation scheme | DDT | 0 | ty_gas_optics_rrtmgp | | in | F | +!! | ncol | horizontal_loop_extent | horizontal dimension | count | 0 | integer | | in | F | +!! | p_lay | air_pressure_at_layer_for_RRTMGP_in_hPa | air pressure layer | hPa | 2 | real | kind_phys | in | F | +!! | p_lev | air_pressure_at_interface_for_RRTMGP_in_hPa | air pressure level | hPa | 2 | real | kind_phys | in | F | +!! | t_lay | air_temperature_at_layer_for_RRTMGP | air temperature layer | K | 2 | real | kind_phys | in | F | +!! | t_lev | air_temperature_at_interface_for_RRTMGP | air temperature level | K | 2 | real | kind_phys | in | F | +!! | skt | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | in | F | +!! | gas_concentrations | Gas_concentrations_for_RRTMGP_suite | DDT containing gas concentrations for RRTMGP radiation scheme | DDT | 0 | ty_gas_concs | | in | F | +!! | lslwr | flag_to_calc_lw | flag to calculate LW irradiances | flag | 0 | logical | | in | F | +!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | +!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! | optical_props_clrsky | longwave_optical_properties_for_clear_sky | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_1scl | | out | F | +!! | sources_LW | longwave_source_function | Fortran DDT containing RRTMGP source functions | DDT | 0 | ty_source_func_lw | | out | F | +!! | toa_src | incident_terrestrial_irradiance_at_top_of_atmosphere_by_spectral_point | top of atmosphere incident terrestrial flux in each spectral point | | 2 | real | kind_phys | out | F | !! subroutine rrtmgp_lw_gas_optics_run(Model, Radtend, lw_gas_props, ncol, p_lay, p_lev, t_lay, t_lev, skt, & - gas_concentrations, lslwr, optical_props_clrsky, sources_LW, errmsg, errflg) + gas_concentrations, lslwr, optical_props_clrsky, sources_LW, toa_src, errmsg, errflg) ! Inputs type(GFS_control_type), intent(in) :: & @@ -475,6 +477,8 @@ subroutine rrtmgp_lw_gas_optics_run(Model, Radtend, lw_gas_props, ncol, p_lay, p optical_props_clrsky ! type(ty_source_func_lw),intent(out) :: & sources_LW + real(kind_phys),dimension(ncol,lw_gas_props%get_ngpt()),intent(out) :: & + toa_src ! Initialize CCPP error handling variables errmsg = '' @@ -487,18 +491,28 @@ subroutine rrtmgp_lw_gas_optics_run(Model, Radtend, lw_gas_props, ncol, p_lay, p call check_error_msg('rrtmgp_lw_gas_optics_run',sources_LW%init(lw_gas_props)) call check_error_msg('rrtmgp_lw_gas_optics_run',sources_LW%alloc(ncol, Model%levs)) + ! Compute boundary-condition (Only do for low-ceiling models) + !call check_error_msg('rrtmgp_lw_gas_optics_run',compute_bc(& + ! lw_gas_props, & ! IN - + ! p_lay, & ! IN - + ! p_lev, & ! IN - + ! t_lay, & ! IN - + ! gas_concentrations, & ! IN - + ! toa_src)) ! OUT - + ! Gas-optics (djs asks pincus: I think it makes sense to have a generic gas_optics interface in ! ty_gas_optics_rrtmgp, just as in ty_gas_optics. call check_error_msg('rrtmgp_lw_gas_optics_run',lw_gas_props%gas_optics_int(& - p_lay, & ! - p_lev, & ! - t_lay, & ! - skt, & ! - gas_concentrations, & ! - optical_props_clrsky, & ! - sources_LW, & ! - tlev=t_lev)) ! + p_lay, & ! IN - + p_lev, & ! IN - + t_lay, & ! IN - + skt, & ! IN - + gas_concentrations, & ! IN - + optical_props_clrsky, & ! OUT - + sources_LW, & ! OUT - + tlev=t_lev)) ! IN - + print*,'END LW_GAS_OPTICS:' end subroutine rrtmgp_lw_gas_optics_run ! ######################################################################################### diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index 20ef531b2..b25ce53fb 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -6,6 +6,7 @@ module rrtmgp_sw_gas_optics use mo_gas_concentrations, only: ty_gas_concs use rrtmgp_aux, only: check_error_msg use mo_optical_props, only: ty_optical_props_2str + use mo_compute_bc, only: compute_bc use netcdf contains @@ -419,22 +420,22 @@ end subroutine rrtmgp_sw_gas_optics_init ! function and gas_optics() here. ! ######################################################################################### !! \section arg_table_rrtmgp_sw_gas_optics_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------------|----------------------------------------------|--------------------------------------------------------------------|-------|------|-----------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | -!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | in | F | -!! | sw_gas_props | coefficients_for_sw_gas_optics | DDT containing spectral information for RRTMGP SW radiation scheme | DDT | 0 | ty_gas_optics_rrtmgp | | in | F | -!! | ncol | horizontal_loop_extent | horizontal dimension | count | 0 | integer | | in | F | -!! | p_lay | air_pressure_at_layer_for_RRTMGP_in_hPa | air pressure layer | hPa | 2 | real | kind_phys | in | F | -!! | p_lev | air_pressure_at_interface_for_RRTMGP_in_hPa | air pressure level | hPa | 2 | real | kind_phys | in | F | -!! | t_lay | air_temperature_at_layer_for_RRTMGP | air temperature layer | K | 2 | real | kind_phys | in | F | -!! | t_lev | air_temperature_at_interface_for_RRTMGP | air temperature level | K | 2 | real | kind_phys | in | F | -!! | gas_concentrations | Gas_concentrations_for_RRTMGP_suite | DDT containing gas concentrations for RRTMGP radiation scheme | DDT | 0 | ty_gas_concs | | in | F | -!! | lsswr | flag_to_calc_sw | flag to calculate SW irradiances | flag | 0 | logical | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | -!! | optical_props_clrsky | shortwave_optical_properties_for_clear_sky | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_2str | | out | F | -!! | toa_src | Incoming_solar_irradiance_by_spectral_point | top of atmosphere incident solar flux in each spectral point | | 2 | real | kind_phys | out | F | +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |----------------------|------------------------------------------------------------------|--------------------------------------------------------------------|-------|------|-----------------------|-----------|--------|----------| +!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | +!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | in | F | +!! | sw_gas_props | coefficients_for_sw_gas_optics | DDT containing spectral information for RRTMGP SW radiation scheme | DDT | 0 | ty_gas_optics_rrtmgp | | in | F | +!! | ncol | horizontal_loop_extent | horizontal dimension | count | 0 | integer | | in | F | +!! | p_lay | air_pressure_at_layer_for_RRTMGP_in_hPa | air pressure layer | hPa | 2 | real | kind_phys | in | F | +!! | p_lev | air_pressure_at_interface_for_RRTMGP_in_hPa | air pressure level | hPa | 2 | real | kind_phys | in | F | +!! | t_lay | air_temperature_at_layer_for_RRTMGP | air temperature layer | K | 2 | real | kind_phys | in | F | +!! | t_lev | air_temperature_at_interface_for_RRTMGP | air temperature level | K | 2 | real | kind_phys | in | F | +!! | gas_concentrations | Gas_concentrations_for_RRTMGP_suite | DDT containing gas concentrations for RRTMGP radiation scheme | DDT | 0 | ty_gas_concs | | in | F | +!! | lsswr | flag_to_calc_sw | flag to calculate SW irradiances | flag | 0 | logical | | in | F | +!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | +!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! | optical_props_clrsky | shortwave_optical_properties_for_clear_sky | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_2str | | out | F | +!! | toa_src | incident_solar_irradiance_at_top_of_atmosphere_by_spectral_point | top of atmosphere incident solar flux in each spectral point | | 2 | real | kind_phys | out | F | !! subroutine rrtmgp_sw_gas_optics_run(Model, Radtend, sw_gas_props, ncol, p_lay, p_lev, t_lay, t_lev, & gas_concentrations, lsswr, optical_props_clrsky, toa_src, errmsg, errflg) @@ -470,7 +471,6 @@ subroutine rrtmgp_sw_gas_optics_run(Model, Radtend, sw_gas_props, ncol, p_lay, p real(kind_phys),dimension(ncol,sw_gas_props%get_ngpt()),intent(out) :: & toa_src - ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -488,7 +488,17 @@ subroutine rrtmgp_sw_gas_optics_run(Model, Radtend, sw_gas_props, ncol, p_lay, p t_lay, & ! gas_concentrations, & ! optical_props_clrsky, & ! - toa_src)) ! + toa_src)) ! + + ! Compute boundary-condition (only for low ceiling models, set in GFS_typedefs.F90) + !call check_error_msg('rrtmgp_sw_gas_optics_run',compute_bc(& + ! sw_gas_props, & ! IN - + ! p_lay, & ! IN - + ! p_lev, & ! IN - + ! t_lay, & ! IN - + ! gas_concentrations, & ! IN - + ! toa_src, & ! OUT - + ! mu0 = Radtend%coszen)) end subroutine rrtmgp_sw_gas_optics_run diff --git a/physics/rrtmgp_sw_rte.F90 b/physics/rrtmgp_sw_rte.F90 index 000469093..35977d5e0 100644 --- a/physics/rrtmgp_sw_rte.F90 +++ b/physics/rrtmgp_sw_rte.F90 @@ -44,7 +44,7 @@ end subroutine rrtmgp_sw_rte_init !! | lsswr | flag_to_calc_sw | flag to calculate SW irradiances | flag | 0 | logical | | in | F | !! | nday | daytime_points_dimension | daytime points dimension | count | 0 | integer | | in | F | !! | idxday | daytime_points | daytime points | index | 1 | integer | | in | F | -!! | toa_src | Incoming_solar_irradiance_by_spectral_point | top of atmosphere incident solar flux in each spectral point | | 2 | real | kind_phys | in | F | +!! | toa_src | incident_solar_irradiance_at_top_of_atmosphere_by_spectral_point | top of atmosphere incident solar flux in each spectral point | | 2 | real | kind_phys | in | F | !! | hsw0 | tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step | shortwave clear sky heating rate | K s-1 | 2 | real | kind_phys | inout | T | !! | hswb | sw_heating_rate_spectral | shortwave total sky heating rate (spectral) | K s-1 | 3 | real | kind_phys | inout | T | !! | scmpsw | components_of_surface_downward_shortwave_fluxes | derived type for special components of surface downward shortwave fluxes | W m-2 | 1 | cmpfsw_type | | inout | T |