Skip to content

Commit

Permalink
Added calls to compute_bc() in LW and SW gas_optics. Small bug found …
Browse files Browse the repository at this point in the history 
…in mo_compute_bc. Work in progress.
  • Loading branch information
@dustinswales
dustinswales committed Jun 12, 2019
1 parent 044c880 commit c9a357a
Show file tree
Hide file tree
Showing 5 changed files with 102 additions and 69 deletions.
45 changes: 28 additions & 17 deletions physics/GFS_rrtmgp_pre.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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: &
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
12 changes: 5 additions & 7 deletions physics/GFS_rrtmgp_setup.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,6 @@ module GFS_rrtmgp_setup
& iswcliq, &
& kind_phys

use radcons, only: ltp, lextop

implicit none

Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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!'
Expand Down
66 changes: 40 additions & 26 deletions physics/rrtmgp_lw_gas_optics.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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) :: &
Expand Down Expand Up @@ -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 = ''
Expand All @@ -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

! #########################################################################################
Expand Down
Loading

0 comments on commit c9a357a

Please sign in to comment.