Skip to content
Merged
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
79 changes: 51 additions & 28 deletions sorc/chgres_cube.fd/program_setup.f90
Original file line number Diff line number Diff line change
@@ -1,15 +1,12 @@
!> @file
!! @brief Set up program execution
!!
!! @author gayno NCEP/EMC
!! @author George Gayno NCEP/EMC
!!
!! Set up program execution
!!
!! Public variables:
!!
!! - atm_files_input_grid - File names of input atmospheric data.
!! Not used for "grib2" or "restart"
!! input types.
!! - atm_core_files_input_grid - File names of input atmospheric restart
!! core files. Only used for 'restart'
!! input type.
Expand Down Expand Up @@ -100,7 +97,7 @@
!! MP climatological tracers. False,
!! when 'thomp_mp_climo_file' is NULL.
!! - vcoord_file_target_grid - Vertical coordinate definition file
!! - wltsmc_input/target - Wilting point soil moisture content
!! - wltsmc_input/target - Plant wilting point soil moisture content
!! input/target grids
!! - nsoill_out - Number of soil levels desired in the output data.
!! chgres_cube can interpolate from 9 input to 4 output
Expand Down Expand Up @@ -158,7 +155,10 @@ module program_setup
private

character(len=500), public :: varmap_file = "NULL"
character(len=500), public :: atm_files_input_grid(6) = "NULL"
character(len=500), public :: atm_files_input_grid(6) = "NULL" !< File names of input
!< atmospheric data. Not used
!< for "grib2" or "restart"
!< input types.
character(len=500), public :: atm_core_files_input_grid(7) = "NULL"
character(len=500), public :: atm_tracer_files_input_grid(6) = "NULL"
character(len=500), public :: data_dir_input_grid = "NULL"
Expand Down Expand Up @@ -234,10 +234,9 @@ module program_setup

contains

!> @brief Reads configuration namelist.
!!
!! @author gayno NCEP/EMC
!> Reads program configuration namelist.
!!
!! @author George Gayno NCEP/EMC
subroutine read_setup_namelist

implicit none
Expand Down Expand Up @@ -412,6 +411,11 @@ subroutine read_setup_namelist

end subroutine read_setup_namelist

!> Reads the variable mapping table, which is
!! required for initializing with GRIB2 data.
!!
!! @author Larissa Reames
!! @author Jeff Beck
subroutine read_varmap

implicit none
Expand Down Expand Up @@ -469,16 +473,24 @@ subroutine read_varmap
endif
end subroutine read_varmap

! ----------------------------------------------------------------------------------------
! Find conditions for handling missing variables from varmap arrays
! ----------------------------------------------------------------------------------------

!> Search the variable mapping table to find conditions for handling
!! missing variables. Only applicable when using GRIB2 data as
!! input.
!!
!! @param [in] var_name table variable name to search for
!! @param [out] this_miss_var_method the method used to replace missing data
!! @param [out] this_miss_var_value the value used to replace missing data
!! @param [out] this_field_var_name name of variable in output file. not
!! currently implemented.
!! @param [out] loc variable table location index
!! @author Larissa Reames
!! @author Jeff Beck
subroutine get_var_cond(var_name,this_miss_var_method,this_miss_var_value, &
this_field_var_name, loc)
use esmf

implicit none
character(len=20) :: var_name
character(len=20), intent(in) :: var_name

character(len=20), optional, intent(out) :: this_miss_var_method, &
this_field_var_name
Expand Down Expand Up @@ -512,10 +524,11 @@ subroutine get_var_cond(var_name,this_miss_var_method,this_miss_var_value, &

end subroutine get_var_cond

!> @brief Compute soil parameters.
!!
!! @author gayno NCEP/EMC
!> Driver routine to compute soil parameters for each
!! soil type. Works for Zobler and STATSGO soil categories.
!!
!! @param [in] localpet ESMF local persistent execution thread
!! @author George Gayno NCEP/EMC
subroutine calc_soil_params_driver(localpet)

implicit none
Expand Down Expand Up @@ -545,7 +558,6 @@ subroutine calc_soil_params_driver(localpet)

real, allocatable :: bb(:)
real :: smlow, smhigh
real, allocatable :: f11(:)
real, allocatable :: satdk(:)
real, allocatable :: satpsi(:)
real, allocatable :: satdw(:)
Expand Down Expand Up @@ -600,7 +612,6 @@ subroutine calc_soil_params_driver(localpet)
allocate(satdk(num_soil_cats))
allocate(satpsi(num_soil_cats))
allocate(satdw(num_soil_cats))
allocate(f11(num_soil_cats))

select case (trim(input_type))
case ("gfs_sigio")
Expand All @@ -620,9 +631,9 @@ subroutine calc_soil_params_driver(localpet)
end select

call calc_soil_params(num_soil_cats, smlow, smhigh, satdk, maxsmc_input, &
bb, satpsi, satdw, f11, refsmc_input, drysmc_input, wltsmc_input)
bb, satpsi, satdw, refsmc_input, drysmc_input, wltsmc_input)

deallocate(bb, satdk, satpsi, satdw, f11)
deallocate(bb, satdk, satpsi, satdw)

if (localpet == 0) print*,'maxsmc input grid ',maxsmc_input
if (localpet == 0) print*,'wltsmc input grid ',wltsmc_input
Expand All @@ -643,7 +654,6 @@ subroutine calc_soil_params_driver(localpet)
allocate(satpsi_target(num_soil_cats))
allocate(satdk(num_soil_cats))
allocate(satdw(num_soil_cats))
allocate(f11(num_soil_cats))

smlow = smlow_statsgo
smhigh = smhigh_statsgo
Expand All @@ -653,17 +663,33 @@ subroutine calc_soil_params_driver(localpet)
satpsi_target = satpsi_statsgo

call calc_soil_params(num_soil_cats, smlow, smhigh, satdk, maxsmc_target, &
bb_target, satpsi_target, satdw, f11, refsmc_target, drysmc_target, wltsmc_target)
bb_target, satpsi_target, satdw, refsmc_target, drysmc_target, wltsmc_target)

deallocate(satdk, satdw, f11)
deallocate(satdk, satdw)

if (localpet == 0) print*,'maxsmc target grid ',maxsmc_target
if (localpet == 0) print*,'wltsmc input grid ',wltsmc_target

end subroutine calc_soil_params_driver

!> Compute soil parameters. Will be used to rescale soil moisture
!! differences in soil type between the input grid and target
!! model grid.
!!
!! @param [in] num_soil_cats number of soil type categories
!! @param [in] smlow reference parameter for wltsmc
!! @param [in] smhigh reference parameter for refsmc
!! @param [in] satdk saturated soil moisture hydraulic conductivity
!! @param [in] maxsmc maximum soil moisture (porosity)
!! @param [in] bb soil 'b' parameter
!! @param [in] satpsi saturated soil potential
!! @param [out] satdw saturated soil diffusivity/conductivity coefficient
!! @param [out] refsmc onset of soil moisture stress (field capacity)
!! @param [out] drysmc air dry soil moisture limit
!! @param [out] wltsmc plant soil moisture wilting point
!! @author George Gayno NCEP/EMC
subroutine calc_soil_params(num_soil_cats, smlow, smhigh, satdk, &
maxsmc, bb, satpsi, satdw, f11, refsmc, drysmc, wltsmc)
maxsmc, bb, satpsi, satdw, refsmc, drysmc, wltsmc)

implicit none

Expand All @@ -675,7 +701,6 @@ subroutine calc_soil_params(num_soil_cats, smlow, smhigh, satdk, &
real, intent(in) :: satdk(num_soil_cats)
real, intent(in) :: satpsi(num_soil_cats)

real, intent(out) :: f11(num_soil_cats)
real, intent(out) :: satdw(num_soil_cats)
real, intent(out) :: refsmc(num_soil_cats)
real, intent(out) :: drysmc(num_soil_cats)
Expand All @@ -687,7 +712,6 @@ subroutine calc_soil_params(num_soil_cats, smlow, smhigh, satdk, &
real :: wltsmc1

satdw = 0.0
f11 = 0.0
refsmc = 0.0
wltsmc = 0.0
drysmc = 0.0
Expand All @@ -697,7 +721,6 @@ subroutine calc_soil_params(num_soil_cats, smlow, smhigh, satdk, &
if (maxsmc(i) > 0.0) then

SATDW(I) = BB(I)*SATDK(I)*(SATPSI(I)/MAXSMC(I))
F11(I) = ALOG10(SATPSI(I)) + BB(I)*ALOG10(MAXSMC(I)) + 2.0
REFSMC1 = MAXSMC(I)*(5.79E-9/SATDK(I)) **(1.0/(2.0*BB(I)+3.0))
REFSMC(I) = REFSMC1 + (MAXSMC(I)-REFSMC1) / SMHIGH
WLTSMC1 = MAXSMC(I) * (200.0/SATPSI(I))**(-1.0/BB(I))
Expand Down