Skip to content

Commit

Permalink
Merge pull request #526 from grantfirl/fix_scm_sfc_flux_spec
Browse files Browse the repository at this point in the history
Fix specified surface flux "scheme" (CCPP-SCM only!!!)
  • Loading branch information
grantfirl committed Dec 8, 2020
2 parents d076cc2 + 9ccc52f commit 176ea9a
Show file tree
Hide file tree
Showing 2 changed files with 67 additions and 5 deletions.
24 changes: 19 additions & 5 deletions physics/gmtb_scm_sfc_flux_spec.F90
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,18 @@ module gmtb_scm_sfc_flux_spec
CONTAINS
!*******************************************************************************************

subroutine gmtb_scm_sfc_flux_spec_init()
subroutine gmtb_scm_sfc_flux_spec_init(lheatstrg, errmsg, errflg)

logical, intent(in) :: lheatstrg

character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg

if (lheatstrg) then
errmsg = 'Using specified surface fluxes is not compatible with canopy heat storage (lheatstrg) being true. Stopping.'
errflg = 1
return
end if
end subroutine gmtb_scm_sfc_flux_spec_init

subroutine gmtb_scm_sfc_flux_spec_finalize()
Expand All @@ -38,16 +49,17 @@ end subroutine gmtb_scm_sfc_flux_spec_finalize
!! -# Calculate the surface drag coefficient for heat and moisture.
!! -# Calculate the u and v wind at 10m.
subroutine gmtb_scm_sfc_flux_spec_run (u1, v1, z1, t1, q1, p1, roughness_length, spec_sh_flux, spec_lh_flux, &
exner_inverse, T_surf, cp, grav, hvap, rd, fvirt, vonKarman, sh_flux, lh_flux, u_star, sfc_stress, cm, ch, &
exner_inverse, T_surf, cp, grav, hvap, rd, fvirt, vonKarman, sh_flux, lh_flux, sh_flux_chs, lh_flux_chs, u_star, sfc_stress, cm, ch, &
fm, fh, rb, u10m, v10m, wind1, qss, t2m, q2m, errmsg, errflg)

use machine, only: kind_phys

real(kind=kind_phys), intent(in) :: u1(:), v1(:), z1(:), t1(:), q1(:), p1(:), roughness_length(:), &
spec_sh_flux(:), spec_lh_flux(:), exner_inverse(:), T_surf(:)
real(kind=kind_phys), intent(in) :: cp, grav, hvap, rd, fvirt, vonKarman
real(kind=kind_phys), intent(out) :: sh_flux(:), lh_flux(:), u_star(:), sfc_stress(:), &
cm(:), ch(:), fm(:), fh(:), rb(:), u10m(:), v10m(:), wind1(:), qss(:), t2m(:), q2m(:)
cm(:), ch(:), fm(:), fh(:), rb(:), u10m(:), v10m(:), wind1(:), qss(:), t2m(:), q2m(:), &
sh_flux_chs(:), lh_flux_chs(:)

character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg
Expand All @@ -60,12 +72,14 @@ subroutine gmtb_scm_sfc_flux_spec_run (u1, v1, z1, t1, q1, p1, roughness_length,
! Initialize CCPP error handling variables
errmsg = ''
errflg = 0

! !--- set control properties (including namelist read)
!calculate u_star from wind profiles (need roughness length, and wind and height at lowest model level)
do i=1, size(z1)
sh_flux(i) = spec_sh_flux(i)
lh_flux(i) = spec_lh_flux(i)
sh_flux_chs(i) = sh_flux(i)
lh_flux_chs(i) = lh_flux(i)

roughness_length_m = 0.01*roughness_length(i)

Expand Down
48 changes: 48 additions & 0 deletions physics/gmtb_scm_sfc_flux_spec.meta
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,36 @@
dependencies = machine.F

########################################################################
[ccpp-arg-table]
name = gmtb_scm_sfc_flux_spec_init
type = scheme
[lheatstrg]
standard_name = flag_for_canopy_heat_storage
long_name = flag for canopy heat storage parameterization
units = flag
dimensions = ()
type = logical
intent = in
optional = F
[errmsg]
standard_name = ccpp_error_message
long_name = error message for error handling in CCPP
units = none
dimensions = ()
type = character
kind = len=*
intent = out
optional = F
[errflg]
standard_name = ccpp_error_flag
long_name = error flag for error handling in CCPP
units = flag
dimensions = ()
type = integer
intent = out
optional = F

#################################
[ccpp-arg-table]
name = gmtb_scm_sfc_flux_spec_run
type = scheme
Expand Down Expand Up @@ -178,6 +208,24 @@
kind = kind_phys
intent = out
optional = F
[sh_flux_chs]
standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness
long_name = kinematic surface upward sensible heat flux reduced by surface roughness
units = K m s-1
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = out
optional = F
[lh_flux_chs]
standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness
long_name = kinematic surface upward latent heat flux reduced by surface roughness
units = kg kg-1 m s-1
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = out
optional = F
[u_star]
standard_name = surface_friction_velocity
long_name = boundary layer parameter
Expand Down

0 comments on commit 176ea9a

Please sign in to comment.