Skip to content

Commit

Permalink
Merge pull request #737 from pjpegion/new_stochy
Browse files Browse the repository at this point in the history 
code updates for CA_global
  • Loading branch information
@climbfuji
climbfuji authored Sep 30, 2021
2 parents e22fd68 + 34ac0f1 commit 3c23577
Show file tree
Hide file tree
Showing 4 changed files with 106 additions and 88 deletions.
70 changes: 42 additions & 28 deletions physics/GFS_stochastics.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,43 @@ module GFS_stochastics

contains

subroutine GFS_stochastics_init ()
!> \section arg_table_GFS_stochastics_init Argument Table
!! \htmlinclude GFS_stochastics_init.html
!!
!>\section gfs_stochy_general GFS_stochastics_init General Algorithm
!! This is the GFS stochastic physics initialization.
!! -# define vertical tapering for CA global
subroutine GFS_stochastics_init (si,vfact_ca,km,do_ca,ca_global, errmsg, errflg)

use machine, only: kind_phys

implicit none
real(kind_phys), dimension(:), intent(in) :: si
real(kind_phys), dimension(:), intent(inout) :: vfact_ca
integer, intent(in) :: km
logical, intent(in) :: do_ca
logical, intent(in) :: ca_global
character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg
integer :: k,nz

errmsg = ''
errflg = 0
if (do_ca .and. ca_global) then
nz=min(km,size(vfact_ca))
vfact_ca(:)=0.0
do k=1,nz
if (si(k) .lt. 0.1 .and. si(k) .gt. 0.025) then
vfact_ca(k) = (si(k)-0.025)/(0.1-0.025)
else if (si(k) .lt. 0.025) then
vfact_ca(k) = 0.0
else
vfact_ca(k) = 1.0
endif
enddo
vfact_ca(2)=vfact_ca(3)*0.5
vfact_ca(1)=0.0
endif
end subroutine GFS_stochastics_init

subroutine GFS_stochastics_finalize()
Expand All @@ -26,10 +62,9 @@ end subroutine GFS_stochastics_finalize
!! -# interpolates coefficients for prognostic ozone calculation
!! -# performs surface data cycling via the GFS gcycle routine
subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblck, &
do_shum ,do_skeb, do_ca,ca_global,ca1,si,vfact_ca, &
do_shum ,do_skeb, do_ca,ca_global,ca1,vfact_ca, &
zmtnblck, sppt_wts, skebu_wts, skebv_wts, shum_wts,&
sppt_wts_inv, skebu_wts_inv, skebv_wts_inv, &
shum_wts_inv, diss_est, ugrs, vgrs, tgrs, qgrs_wv, &
diss_est, ugrs, vgrs, tgrs, qgrs_wv, &
qgrs_cw, qgrs_rw, qgrs_sw, qgrs_iw, qgrs_gl, &
gu0, gv0, gt0, gq0_wv, dtdtnp, &
gq0_cw, gq0_rw, gq0_sw, gq0_iw, gq0_gl, &
Expand Down Expand Up @@ -62,11 +97,6 @@ subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblc
real(kind_phys), dimension(:,:), intent(in) :: skebv_wts
! shum_wts only allocated if do_shum == .true.
real(kind_phys), dimension(:,:), intent(in) :: shum_wts
! inverse/flipped weights are always allocated
real(kind_phys), dimension(:,:), intent(inout) :: sppt_wts_inv
real(kind_phys), dimension(:,:), intent(inout) :: skebu_wts_inv
real(kind_phys), dimension(:,:), intent(inout) :: skebv_wts_inv
real(kind_phys), dimension(:,:), intent(inout) :: shum_wts_inv
real(kind_phys), dimension(:,:), intent(in) :: diss_est
real(kind_phys), dimension(:,:), intent(in) :: ugrs
real(kind_phys), dimension(:,:), intent(in) :: vgrs
Expand Down Expand Up @@ -106,8 +136,7 @@ subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblc
! drain_cpl, dsnow_cpl only allocated if cplflx == .true. or cplchm == .true.
real(kind_phys), dimension(:), intent(in) :: drain_cpl
real(kind_phys), dimension(:), intent(in) :: dsnow_cpl
real(kind_phys), dimension(:), intent(in) :: si
real(kind_phys), dimension(:), intent(inout) :: vfact_ca
real(kind_phys), dimension(:), intent(in) :: vfact_ca
real(kind_phys), dimension(:), intent(in) :: ca1
character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg
Expand Down Expand Up @@ -144,7 +173,6 @@ subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblc
if (use_zmtnblck)then
sppt_wts(i,k)=(sppt_wts(i,k)-1)*sppt_vwt+1.0
endif
sppt_wts_inv(i,k)=sppt_wts(i,k)

upert = (gu0(i,k) - ugrs(i,k)) * sppt_wts(i,k)
vpert = (gv0(i,k) - vgrs(i,k)) * sppt_wts(i,k)
Expand Down Expand Up @@ -225,19 +253,8 @@ subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblc

if (do_ca .and. ca_global) then

if(kdt == 1)then
do k=1,km
if (si(k) .lt. 0.1 .and. si(k) .gt. 0.025) then
vfact_ca(k) = (si(k)-0.025)/(0.1-0.025)
else if (si(k) .lt. 0.025) then
vfact_ca(k) = 0.0
else
vfact_ca(k) = 1.0
endif
enddo
vfact_ca(2)=vfact_ca(3)*0.5
vfact_ca(1)=0.0
endif
!if(kdt == 1)then
!endif

do k = 1,km
do i = 1,im
Expand Down Expand Up @@ -340,16 +357,13 @@ subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblc
if (do_shum) then
do k=1,km
gq0_wv(:,k) = gq0_wv(:,k)*(1.0 + shum_wts(:,k))
shum_wts_inv(:,k) = shum_wts(:,k)
end do
endif

if (do_skeb) then
do k=1,km
gu0(:,k) = gu0(:,k)+skebu_wts(:,k)*(diss_est(:,k))
gv0(:,k) = gv0(:,k)+skebv_wts(:,k)*(diss_est(:,k))
skebu_wts_inv(:,k) = skebu_wts(:,k)
skebv_wts_inv(:,k) = skebv_wts(:,k)
enddo
endif

Expand Down
109 changes: 63 additions & 46 deletions physics/GFS_stochastics.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,68 @@
type = scheme
dependencies = machine.F

[ccpp-arg-table]
name = GFS_stochastics_init
type = scheme
[km]
standard_name = vertical_dimension_for_radiation
long_name = number of vertical levels for radiation calculations
units = count
dimensions = ()
type = integer
intent = in
optional = F
[do_ca]
standard_name = flag_for_cellular_automata
long_name = cellular automata main switch
units = flag
dimensions = ()
type = logical
intent = in
optional = F
[ca_global]
standard_name = flag_for_global_cellular_automata
long_name = switch for global ca
units = flag
dimensions = ()
type = logical
intent = in
optional = F
[si]
standard_name = sigma_pressure_hybrid_vertical_coordinate
long_name = vertical sigma coordinate for radiation initialization
units = none
dimensions = (vertical_interface_dimension_for_radiation)
type = real
kind = kind_phys
intent = in
optional = F
[vfact_ca]
standard_name = cellular_automata_vertical_weight
long_name = vertical weight for ca
units = frac
dimensions = (vertical_layer_dimension)
type = real
kind = kind_phys
intent = inout
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 = GFS_stochastics_run
Expand Down Expand Up @@ -105,23 +167,14 @@
kind = kind_phys
intent = in
optional = F
[si]
standard_name = sigma_pressure_hybrid_vertical_coordinate
long_name = vertical sigma coordinate for radiation initialization
units = none
dimensions = (vertical_interface_dimension_for_radiation)
type = real
kind = kind_phys
intent = in
optional = F
[vfact_ca]
standard_name = cellular_automata_vertical_weight
long_name = vertical weight for ca
units = frac
dimensions = (vertical_layer_dimension)
type = real
kind = kind_phys
intent = inout
intent = in
optional = F
[zmtnblck]
standard_name = level_of_dividing_streamline
Expand Down Expand Up @@ -168,42 +221,6 @@
kind = kind_phys
intent = in
optional = F
[sppt_wts_inv]
standard_name = weights_for_stochastic_sppt_perturbation_flipped
long_name = weights for stochastic sppt perturbation, flipped
units = none
dimensions = (horizontal_loop_extent,vertical_layer_dimension)
type = real
kind = kind_phys
intent = inout
optional = F
[skebu_wts_inv]
standard_name = weights_for_stochastic_skeb_perturbation_of_x_wind_flipped
long_name = weights for stochastic skeb perturbation of x wind, flipped
units = none
dimensions = (horizontal_loop_extent,vertical_layer_dimension)
type = real
kind = kind_phys
intent = inout
optional = F
[skebv_wts_inv]
standard_name = weights_for_stochastic_skeb_perturbation_of_y_wind_flipped
long_name = weights for stochastic skeb perturbation of y wind, flipped
units = none
dimensions = (horizontal_loop_extent,vertical_layer_dimension)
type = real
kind = kind_phys
intent = inout
optional = F
[shum_wts_inv]
standard_name = weights_for_stochastic_shum_perturbation_flipped
long_name = weights for stochastic shum perturbation, flipped
units = none
dimensions = (horizontal_loop_extent,vertical_layer_dimension)
type = real
kind = kind_phys
intent = inout
optional = F
[diss_est]
standard_name = dissipation_estimate_of_air_temperature_at_model_layers
long_name = dissipation estimate model layer mean temperature
Expand Down
6 changes: 1 addition & 5 deletions physics/GFS_surface_generic.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc,
sigmaf, soiltyp, vegtype, slopetyp, work3, zlvl, &
drain_cpl, dsnow_cpl, rain_cpl, snow_cpl, lndp_type, n_var_lndp, sfc_wts, &
lndp_var_list, lndp_prt_list, &
z01d, zt1d, bexp1d, xlai1d, vegf1d, lndp_vgf, sfc_wts_inv, &
z01d, zt1d, bexp1d, xlai1d, vegf1d, lndp_vgf, &
cplflx, flag_cice, islmsk_cice, slimskin_cpl, &
wind, u1, v1, cnvwind, smcwlt2, smcref2, errmsg, errflg)

Expand Down Expand Up @@ -66,7 +66,6 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc,
real(kind=kind_phys), dimension(:), intent(out) :: xlai1d
real(kind=kind_phys), dimension(:), intent(out) :: vegf1d
real(kind=kind_phys), intent(out) :: lndp_vgf
real(kind=kind_phys), dimension(:,:), intent(inout) :: sfc_wts_inv

logical, intent(in) :: cplflx
real(kind=kind_phys), dimension(:), intent(in) :: slimskin_cpl
Expand Down Expand Up @@ -99,9 +98,6 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc,
! Turn vegetation fraction pattern into percentile pattern
lndp_vgf=-999.

if (lndp_type>0) then
sfc_wts_inv(:,:)=sfc_wts(:,:)
endif
if (lndp_type==1) then
do k =1,n_var_lndp
select case(lndp_var_list(k))
Expand Down
9 changes: 0 additions & 9 deletions physics/GFS_surface_generic.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -312,15 +312,6 @@
kind = kind_phys
intent = out
optional = F
[sfc_wts_inv]
standard_name = weights_for_stochastic_surface_physics_perturbation_flipped
long_name = weights for stochastic surface physics perturbation, flipped
units = none
dimensions = (horizontal_loop_extent,number_of_perturbed_land_surface_variables)
type = real
kind = kind_phys
intent = inout
optional = F
[cplflx]
standard_name = flag_for_surface_flux_coupling
long_name = flag controlling cplflx collection (default off)
Expand Down

0 comments on commit 3c23577

Please sign in to comment.