Skip to content

Commit

Permalink
Ported RRTMGP development from release repo. LW is working.
Browse files Browse the repository at this point in the history
  • Loading branch information
@dustinswales
dustinswales committed Mar 21, 2019
1 parent e5a3481 commit 8240092
Show file tree
Hide file tree
Showing 7 changed files with 2,398 additions and 0 deletions.
804 changes: 804 additions & 0 deletions physics/rrtmgp_lw_cloud_optics.F90
View file

Large diffs are not rendered by default.

1,168 changes: 1,168 additions & 0 deletions physics/rrtmgp_lw_main.F90
View file

Large diffs are not rendered by default.

102 changes: 102 additions & 0 deletions physics/rrtmgp_lw_post.F90
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,102 @@
!>\file rrtmgp_lw_post
!!This file contains
module rrtmgp_lw_post
contains

!>\defgroup rrtmgp_lw_post GFS RRTMGP scheme post
!! @{
!> \section arg_table_rrtmgp_lw_post_init Argument Table
!!
subroutine rrtmgp_lw_post_init()
end subroutine rrtmgp_lw_post_init

! PGI compiler does not accept lines longer than 264 characters, remove during pre-processing
#ifndef __PGI
!> \section arg_table_rrtmgp_lw_post_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 |
!! | Grid | GFS_grid_type_instance | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | in | F |
!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS fields targetted for diagnostic output | DDT | 0 | GFS_radtend_type | | inout | F |
!! | Coupling | GFS_coupling_type_instance | Fortran DDT containing FV3-GFS fields to/from coupling with other components | DDT | 0 | GFS_coupling_type | | inout | F |
!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F |
!! | ltp | extra_top_layer | extra top layers | none | 0 | integer | | in | F |
!! | lm | vertical_layer_dimension_for_radiation | number of vertical layers for radiation calculation | count | 0 | integer | | in | F |
!! | kd | vertical_index_difference_between_inout_and_local | vertical index difference between in/out and local | index | 0 | integer | | in | F |
!! | tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | in | F |
!! | htlwc | tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step | total sky heating rate due to longwave radiation | K s-1 | 2 | real | kind_phys | in | F |
!! | htlw0 | tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step | clear sky heating rate due to longwave radiation | K s-1 | 2 | real | kind_phys | 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 |
!!
#endif
subroutine rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, &
im, ltp, lm, kd, tsfa, htlwc, htlw0, errmsg, errflg)

use machine, only: kind_phys
use GFS_typedefs, only: GFS_coupling_type, &
GFS_control_type, &
GFS_grid_type, &
GFS_radtend_type
implicit none
type(GFS_control_type), intent(in) :: Model
type(GFS_coupling_type), intent(inout) :: Coupling
type(GFS_grid_type), intent(in) :: Grid
type(GFS_radtend_type), intent(inout) :: Radtend
integer, intent(in) :: im, ltp, LM, kd
real(kind=kind_phys), dimension(size(Grid%xlon,1), Model%levr+LTP), intent(in) :: htlwc
real(kind=kind_phys), dimension(size(Grid%xlon,1), Model%levr+LTP), intent(in) :: htlw0
real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: tsfa
character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg
! local variables
integer :: k1, k

! Initialize CCPP error handling variables
errmsg = ''
errflg = 0

if (Model%lslwr) then
!> -# Save calculation results
!> - Save surface air temp for diurnal adjustment at model t-steps

Radtend%tsflw (:) = tsfa(:)

do k = 1, LM
k1 = k + kd
Radtend%htrlw(1:im,k) = htlwc(1:im,k1)
enddo
! --- repopulate the points above levr
if (lm < Model%levs) then
do k = lm,Model%levs
Radtend%htrlw (1:im,k) = Radtend%htrlw (1:im,LM)
enddo
endif

if (Model%lwhtr) then
do k = 1, lm
k1 = k + kd
Radtend%lwhc(1:im,k) = htlw0(1:im,k1)
enddo
! --- repopulate the points above levr
if (lm < Model%levs) then
do k = lm,Model%levs
Radtend%lwhc(1:im,k) = Radtend%lwhc(1:im,LM)
enddo
endif
endif

! --- radiation fluxes for other physics processes
Coupling%sfcdlw(:) = Radtend%sfcflw(:)%dnfxc

endif ! end_if_lslwr

end subroutine rrtmgp_lw_post_run

!> \section arg_table_rrtmgp_lw_post_finalize Argument Table
!!
subroutine rrtmgp_lw_post_finalize ()
end subroutine rrtmgp_lw_post_finalize

!! @}
end module rrtmgp_lw_post
150 changes: 150 additions & 0 deletions physics/rrtmgp_lw_post.xml
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,150 @@
<?xml version='1.0' encoding='utf-8'?>
<scheme module="rrtmgp_lw_post">
<subroutine name="rrtmgp_lw_post_init" />
<subroutine name="rrtmgp_lw_post_finalize" />
<subroutine name="rrtmgp_lw_post_run">
<variable name="GFS_control_type_instance">
<standard_name>GFS_control_type_instance</standard_name>
<long_name>Fortran DDT containing FV3-GFS model control parameters</long_name>
<units>DDT</units>
<local_name>Model</local_name>
<type>GFS_control_type</type>
<rank />
<intent>in</intent>
<optional>F</optional>
<container>MODULE_rrtmgp_lw_post SCHEME_rrtmgp_lw_post SUBROUTINE_rrtmgp_lw_post_run</container>
</variable>
<variable name="GFS_grid_type_instance">
<standard_name>GFS_grid_type_instance</standard_name>
<long_name>Fortran DDT containing FV3-GFS grid and interpolation related data</long_name>
<units>DDT</units>
<local_name>Grid</local_name>
<type>GFS_grid_type</type>
<rank />
<intent>in</intent>
<optional>F</optional>
<container>MODULE_rrtmgp_lw_post SCHEME_rrtmgp_lw_post SUBROUTINE_rrtmgp_lw_post_run</container>
</variable>
<variable name="GFS_radtend_type_instance">
<standard_name>GFS_radtend_type_instance</standard_name>
<long_name>Fortran DDT containing FV3-GFS fields targetted for diagnostic output</long_name>
<units>DDT</units>
<local_name>Radtend</local_name>
<type>GFS_radtend_type</type>
<rank />
<intent>inout</intent>
<optional>F</optional>
<container>MODULE_rrtmgp_lw_post SCHEME_rrtmgp_lw_post SUBROUTINE_rrtmgp_lw_post_run</container>
</variable>
<variable name="GFS_coupling_type_instance">
<standard_name>GFS_coupling_type_instance</standard_name>
<long_name>Fortran DDT containing FV3-GFS fields to/from coupling with other components</long_name>
<units>DDT</units>
<local_name>Coupling</local_name>
<type>GFS_coupling_type</type>
<rank />
<intent>inout</intent>
<optional>F</optional>
<container>MODULE_rrtmgp_lw_post SCHEME_rrtmgp_lw_post SUBROUTINE_rrtmgp_lw_post_run</container>
</variable>
<variable name="horizontal_loop_extent">
<standard_name>horizontal_loop_extent</standard_name>
<long_name>horizontal loop extent</long_name>
<units>count</units>
<local_name>im</local_name>
<type>integer</type>
<rank />
<intent>in</intent>
<optional>F</optional>
<container>MODULE_rrtmgp_lw_post SCHEME_rrtmgp_lw_post SUBROUTINE_rrtmgp_lw_post_run</container>
</variable>
<variable name="extra_top_layer">
<standard_name>extra_top_layer</standard_name>
<long_name>extra top layers</long_name>
<units>none</units>
<local_name>ltp</local_name>
<type>integer</type>
<rank />
<intent>in</intent>
<optional>F</optional>
<container>MODULE_rrtmgp_lw_post SCHEME_rrtmgp_lw_post SUBROUTINE_rrtmgp_lw_post_run</container>
</variable>
<variable name="vertical_layer_dimension_for_radiation">
<standard_name>vertical_layer_dimension_for_radiation</standard_name>
<long_name>number of vertical layers for radiation calculation</long_name>
<units>count</units>
<local_name>lm</local_name>
<type>integer</type>
<rank />
<intent>in</intent>
<optional>F</optional>
<container>MODULE_rrtmgp_lw_post SCHEME_rrtmgp_lw_post SUBROUTINE_rrtmgp_lw_post_run</container>
</variable>
<variable name="vertical_index_difference_between_inout_and_local">
<standard_name>vertical_index_difference_between_inout_and_local</standard_name>
<long_name>vertical index difference between in/out and local</long_name>
<units>index</units>
<local_name>kd</local_name>
<type>integer</type>
<rank />
<intent>in</intent>
<optional>F</optional>
<container>MODULE_rrtmgp_lw_post SCHEME_rrtmgp_lw_post SUBROUTINE_rrtmgp_lw_post_run</container>
</variable>
<variable name="surface_air_temperature_for_radiation">
<standard_name>surface_air_temperature_for_radiation</standard_name>
<long_name>lowest model layer air temperature for radiation</long_name>
<units>K</units>
<local_name>tsfa</local_name>
<type>real</type>
<rank>(:)</rank>
<intent>in</intent>
<optional>F</optional>
<container>MODULE_rrtmgp_lw_post SCHEME_rrtmgp_lw_post SUBROUTINE_rrtmgp_lw_post_run</container>
</variable>
<variable name="tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step">
<standard_name>tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step</standard_name>
<long_name>total sky heating rate due to longwave radiation</long_name>
<units>K s-1</units>
<local_name>htlwc</local_name>
<type>real</type>
<rank>(:,:)</rank>
<intent>in</intent>
<optional>F</optional>
<container>MODULE_rrtmgp_lw_post SCHEME_rrtmgp_lw_post SUBROUTINE_rrtmgp_lw_post_run</container>
</variable>
<variable name="tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step">
<standard_name>tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step</standard_name>
<long_name>clear sky heating rate due to longwave radiation</long_name>
<units>K s-1</units>
<local_name>htlw0</local_name>
<type>real</type>
<rank>(:,:)</rank>
<intent>in</intent>
<optional>F</optional>
<container>MODULE_rrtmgp_lw_post SCHEME_rrtmgp_lw_post SUBROUTINE_rrtmgp_lw_post_run</container>
</variable>
<variable name="ccpp_error_message">
<standard_name>ccpp_error_message</standard_name>
<long_name>error message for error handling in CCPP</long_name>
<units>none</units>
<local_name>errmsg</local_name>
<type>character</type>
<rank />
<intent>out</intent>
<optional>F</optional>
<container>MODULE_rrtmgp_lw_post SCHEME_rrtmgp_lw_post SUBROUTINE_rrtmgp_lw_post_run</container>
</variable>
<variable name="ccpp_error_flag">
<standard_name>ccpp_error_flag</standard_name>
<long_name>error flag for error handling in CCPP</long_name>
<units>flag</units>
<local_name>errflg</local_name>
<type>integer</type>
<rank />
<intent>out</intent>
<optional>F</optional>
<container>MODULE_rrtmgp_lw_post SCHEME_rrtmgp_lw_post SUBROUTINE_rrtmgp_lw_post_run</container>
</variable>
</subroutine>
</scheme>
67 changes: 67 additions & 0 deletions physics/rrtmgp_lw_pre.F90
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,67 @@
!>\file rrtmgp_lw_pre.f90
!! This file contains a call to module_radiation_surface::setemis() to
!! setup surface emissivity for LW radiation.
module rrtmgp_lw_pre
contains

!>\defgroup rrtmgp_lw_pre GFS RRTMGP scheme pre
!! @{
!> \section arg_table_rrtmgp_lw_pre_init Argument Table
!!
subroutine rrtmgp_lw_pre_init ()
end subroutine rrtmgp_lw_pre_init

!> \section arg_table_rrtmgp_lw_pre_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 |
!! | Grid | GFS_grid_type_instance | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | in | F |
!! | Sfcprop | GFS_sfcprop_type_instance | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_sfcprop_type | | in | F |
!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | inout | F |
!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F |
!! | tsfg | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | in | F |
!! | tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | 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 |
!!
subroutine rrtmgp_lw_pre_run (Model, Grid, Sfcprop, Radtend, im, tsfg, tsfa, errmsg, errflg)

use machine, only: kind_phys

use GFS_typedefs, only: GFS_control_type, &
GFS_grid_type, &
GFS_radtend_type, &
GFS_sfcprop_type
use module_radiation_surface, only: setemis

implicit none
type(GFS_control_type), intent(in) :: Model
type(GFS_radtend_type), intent(inout) :: Radtend
type(GFS_sfcprop_type), intent(in) :: Sfcprop
type(GFS_grid_type), intent(in) :: Grid
integer, intent(in) :: im
real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: tsfa, tsfg
character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg

! Initialize CCPP error handling variables
errmsg = ''
errflg = 0

if (Model%lslwr) then
!> - Call module_radiation_surface::setemis(),to setup surface
!! emissivity for LW radiation.
call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs
Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, &
tsfg, tsfa, Sfcprop%hprim, IM, &
Radtend%semis) ! --- outputs
endif

end subroutine rrtmgp_lw_pre_run

!> \section arg_table_rrtmgp_lw_pre_finalize Argument Table
!!
subroutine rrtmgp_lw_pre_finalize ()
end subroutine rrtmgp_lw_pre_finalize
!! @}
end module rrtmgp_lw_pre
Loading

0 comments on commit 8240092

Please sign in to comment.