Commit b82343f7 authored by Ethan Coon's avatar Ethan Coon
Browse files

initial directory structure for kernels, working on structure for tests

parents
*.o
*.a
*.mod
*~
\ No newline at end of file
ELM Kernels
================
Kernels lifted from ELM, enucleated of their data structures, and then
re-wrapped in a variety of drivers.
ELM modules covered include:
CanopyHydrologyMod
--------------------
Kernels include:
* Interception: (rename me) partitions incoming precip into throughfall/precip
subroutine CanopyHydrologyKern1( dtime, &
qflx_prec_intr, frac_veg_nosno, dewmx, elai, esai, h2ocan, &
n_irrig_steps_left, qflx_irrig, qflx_prec_grnd, &
qflx_snwcp_liq, qflx_snwcp_ice, qflx_snow_grnd_patch, qflx_rain_grnd,irrig_rate, &
ltype, urbpoi, &
ctype, do_capsnow, forc_rain, forc_snow )
use shr_kind_mod, only : &
r8 => shr_kind_r8, &
i4 => shr_kind_i8, &
bool => shr_kind_bool
use column_varcon , only : icol_sunwall, icol_shadewall
use landunit_varcon , only : istcrop, istice, istwet, istsoil, istice_mec
implicit none
real(r8), intent(in) :: dtime
integer(i4), intent(in) :: ltype , ctype
integer(i4), intent(inout) :: n_irrig_steps_left
logical(bool), intent(in) :: urbpoi, do_capsnow
real(r8), intent(out) :: qflx_prec_intr
integer(i4), intent(in) :: frac_veg_nosno
real(r8), intent(in) :: forc_rain
real(r8), intent(in) :: forc_snow
real(r8), intent(in) :: dewmx
real(r8), intent(in) :: elai
real(r8), intent(in) :: esai
real(r8), intent(inout) :: h2ocan
real(r8), intent(out) :: qflx_irrig
real(r8), intent(out) :: qflx_prec_grnd
real(r8), intent(out) :: qflx_snwcp_liq, qflx_snwcp_ice, qflx_snow_grnd_patch, qflx_rain_grnd
real(r8), intent(in) :: irrig_rate
!local variables
real(r8) :: fpi, xrun, h2ocanmx
real(r8) :: qflx_candrip, qflx_through_snow, qflx_through_rain
real(r8) :: qflx_prec_grnd_snow
real(r8) :: qflx_prec_grnd_rain
real(r8) :: fracsnow
real(r8) :: fracrain
! Canopy interception and precipitation onto ground surface
! Add precipitation to leaf water
if (ltype==istsoil .or. ltype==istwet .or. urbpoi .or. &
ltype==istcrop) then
qflx_candrip = 0._r8 ! rate of canopy runoff
qflx_through_snow = 0._r8 ! rain precipitation direct through canopy
qflx_through_rain = 0._r8 ! snow precipitation direct through canopy
qflx_prec_intr = 0._r8 ! total intercepted precipitation
fracsnow = 0._r8 ! fraction of input precip that is snow
fracrain = 0._r8 ! fraction of input precip that is rain
if (ctype /= icol_sunwall .and. ctype /= icol_shadewall) then
if (frac_veg_nosno == 1 .and. (forc_rain + forc_snow) > 0._r8) then
! determine fraction of input precipitation that is snow and rain
fracsnow = forc_snow/(forc_snow + forc_rain)
fracrain = forc_rain/(forc_snow + forc_rain)
! The leaf water capacities for solid and liquid are different,
! generally double for snow, but these are of somewhat less
! significance for the water budget because of lower evap. rate at
! lower temperature. Hence, it is reasonable to assume that
! vegetation storage of solid water is the same as liquid water.
h2ocanmx = dewmx * (elai + esai)
! Coefficient of interception
! set fraction of potential interception to max 0.25
fpi = 0.25_r8*(1._r8 - exp(-0.5_r8*(elai + esai)))
! Direct throughfall
qflx_through_snow = forc_snow * (1._r8-fpi)
qflx_through_rain = forc_rain * (1._r8-fpi)
! Intercepted precipitation [mm/s]
qflx_prec_intr = (forc_snow + forc_rain) * fpi
! Water storage of intercepted precipitation and dew
h2ocan = max(0._r8, h2ocan + dtime*qflx_prec_intr)
! Initialize rate of canopy runoff and snow falling off canopy
qflx_candrip = 0._r8
! Excess water that exceeds the leaf capacity
xrun = (h2ocan - h2ocanmx)/dtime
! Test on maximum dew on leaf
! Note if xrun > 0 then h2ocan must be at least h2ocanmx
if (xrun > 0._r8) then
qflx_candrip = xrun
h2ocan = h2ocanmx
end if
end if
end if
else if (ltype==istice .or. ltype==istice_mec) then
h2ocan = 0._r8
qflx_candrip = 0._r8
qflx_through_snow = 0._r8
qflx_through_rain = 0._r8
qflx_prec_intr = 0._r8
fracsnow = 0._r8
fracrain = 0._r8
end if
! Precipitation onto ground (kg/(m2 s))
if (ctype /= icol_sunwall .and. ctype /= icol_shadewall) then
if (frac_veg_nosno == 0) then
qflx_prec_grnd_snow = forc_snow
qflx_prec_grnd_rain = forc_rain
else
qflx_prec_grnd_snow = qflx_through_snow + (qflx_candrip * fracsnow)
qflx_prec_grnd_rain = qflx_through_rain + (qflx_candrip * fracrain)
end if
! Urban sunwall and shadewall have no intercepted precipitation
else
qflx_prec_grnd_snow = 0.
qflx_prec_grnd_rain = 0.
end if
! Determine whether we're irrigating here; set qflx_irrig appropriately
if (n_irrig_steps_left > 0) then
qflx_irrig = irrig_rate
n_irrig_steps_left = n_irrig_steps_left - 1
else
qflx_irrig = 0._r8
end if
! Add irrigation water directly onto ground (bypassing canopy interception)
! Note that it's still possible that (some of) this irrigation water will runoff (as runoff is computed later)
qflx_prec_grnd_rain = qflx_prec_grnd_rain + qflx_irrig
! Done irrigation
qflx_prec_grnd = qflx_prec_grnd_snow + qflx_prec_grnd_rain
if (do_capsnow) then
qflx_snwcp_liq = qflx_prec_grnd_rain
qflx_snwcp_ice = qflx_prec_grnd_snow
qflx_snow_grnd_patch = 0._r8
qflx_rain_grnd = 0._r8
else
qflx_snwcp_liq = 0._r8
qflx_snwcp_ice = 0._r8
qflx_snow_grnd_patch = qflx_prec_grnd_snow ! ice onto ground (mm/s)
qflx_rain_grnd = qflx_prec_grnd_rain ! liquid water onto ground (mm/s)
end if
return
end subroutine CanopyHydrologyKern1
SRCDIR = .
OBJECT = .
default: all
include $(OBJECT)/config/Makefile.config
FCFLAGS += -I $(ELM_UTILS_DIR) -fbounds-check -g3
# Order is important due to .mod file creation
OBJS = \
$(ELM_UTILS_DIR)/shr_kind_mod.o \
$(ELM_UTILS_DIR)/shr_sys_mod.o \
$(ELM_UTILS_DIR)/shr_infnan_mod.o \
$(ELM_UTILS_DIR)/shr_strconvert_mod.o \
$(ELM_UTILS_DIR)/shr_assert_mod.o \
landunit_varcon.o \
column_varcon.o \
CanopyHydrologyKern1.o
all: $(OBJS)
$(AR) cr libelm.a $(OBJS)
clean:
@$(ELM_CLEAN)
allclean: clean
@cd $(ELM_UTILS_DIR); $(ELM_CLEAN)
This diff is collapsed.
This diff is collapsed.
MODULE shr_kind_mod
!----------------------------------------------------------------------------
! precision/kind constants add data public
!----------------------------------------------------------------------------
use ISO_C_BINDING, only: C_DOUBLE, C_INT, C_FLOAT, C_BOOL
public
integer,parameter :: SHR_KIND_R8 = C_DOUBLE ! 8 byte real
integer,parameter :: SHR_KIND_R4 = C_FLOAT ! 4 byte real
integer,parameter :: SHR_KIND_RN = kind(1.0) ! native real
integer,parameter :: SHR_KIND_I8 = selected_int_kind (13) ! 8 byte integer
integer,parameter :: SHR_KIND_I4 = C_INT ! 4 byte integer
integer,parameter :: SHR_KIND_IN = kind(1) ! native integer
integer,parameter :: SHR_KIND_CS = 80 ! short char
integer,parameter :: SHR_KIND_CM = 160 ! mid-sized char
integer,parameter :: SHR_KIND_CL = 256 ! long char
integer,parameter :: SHR_KIND_CX = 512 ! extra-long char
integer,parameter :: SHR_KIND_CXX= 4096 ! extra-extra-long char
integer,parameter :: SHR_KIND_BOOL = C_BOOL ! boolean
END MODULE shr_kind_mod
module shr_strconvert_mod
! This module defines toString, a generic function for creating character type
! representations of data, as implemented for the most commonly used intrinsic
! types:
!
! - 4 and 8 byte integer
! - 4 and 8 byte real
! - logical
!
! No toString implementation is provided for character input, but this may be
! added if some use case arises.
!
! Currently, only scalar inputs are supported. The return type of this function
! is character with deferred (allocatable) length.
!
! The functions for integers and reals allow an optional format_string argument,
! which can be used to control the padding and precision of output as with any
! write statement. However, the implementations internally must use a
! preallocated buffer, so a format_string that significantly increases the size
! of the output may cause a run-time error or undefined behavior in the program.
!
! Other modules may want to provide extensions of toString for their own derived
! types. In this case there are two guidelines to observe:
!
! - It is preferable to have only one mandatory argument, which is the object to
! produce a string from. There may be other formatting options, but the
! implementation should do something sensible without these.
!
! - Since the main purpose of toString is to provide a human-readable
! representation of a type, especially for documentation or debugging
! purposes, refrain from printing large array components in their entirety
! (instead consider printing only the shape, or statistics such as
! min/mean/max for arrays of numbers).
use shr_kind_mod, only: &
i4 => shr_kind_i4, &
i8 => shr_kind_i8, &
r4 => shr_kind_r4, &
r8 => shr_kind_r8, &
cs => shr_kind_cs
use shr_infnan_mod, only: &
isnan => shr_infnan_isnan
implicit none
private
! Human-readable representation of data.
public :: toString
interface toString
module procedure i4ToString
module procedure i8ToString
module procedure r4ToString
module procedure r8ToString
module procedure logicalToString
end interface toString
contains
pure function i4ToString(input, format_string) result(string)
integer(i4), intent(in) :: input
character(len=*), intent(in), optional :: format_string
character(len=:), allocatable :: string
character(len=cs) :: buffer
if (present(format_string)) then
write(buffer, format_string) input
else
! For most compilers, these two statements are equivalent to a format of
! '(I0)', but that's not technically in the standard.
write(buffer, '(I11)') input
buffer = adjustl(buffer)
end if
allocate(string, source=trim(buffer))
end function i4ToString
pure function i8ToString(input, format_string) result(string)
integer(i8), intent(in) :: input
character(len=*), intent(in), optional :: format_string
character(len=:), allocatable :: string
character(len=cs) :: buffer
if (present(format_string)) then
write(buffer, format_string) input
else
! For most compilers, these two statements are equivalent to a format of
! '(I0)', but that's not technically in the standard.
write(buffer, '(I20)') input
buffer = adjustl(buffer)
end if
allocate(string, source=trim(buffer))
end function i8ToString
pure function r4ToString(input, format_string) result(string)
real(r4), intent(in) :: input
character(len=*), intent(in), optional :: format_string
character(len=:), allocatable :: string
character(len=cs) :: buffer
if (present(format_string)) then
write(buffer, format_string) input
else
write(buffer, '(ES15.8 E2)') input
buffer = adjustl(buffer)
! Deal with the fact that the "+" sign is optional by simply adding it if
! it is not present, so that the default format is standardized across
! compilers.
! Assumes that compilers do not treat the sign bit on NaN values specially.
if (.not. isnan(input) .and. all(buffer(1:1) /= ["-", "+"])) then
buffer = "+" // trim(buffer)
end if
end if
allocate(string, source=trim(buffer))
end function r4ToString
pure function r8ToString(input, format_string) result(string)
real(r8), intent(in) :: input
character(len=*), intent(in), optional :: format_string
character(len=:), allocatable :: string
character(len=cs) :: buffer
if (present(format_string)) then
write(buffer, format_string) input
else
write(buffer, '(ES24.16 E3)') input
buffer = adjustl(buffer)
! Deal with the fact that the "+" sign is optional by simply adding it if
! it is not present, so that the default format is standardized across
! compilers.
! Assumes that compilers do not treat the sign bit on NaN values specially.
if (.not. isnan(input) .and. all(buffer(1:1) /= ["-", "+"])) then
buffer = "+" // trim(buffer)
end if
end if
allocate(string, source=trim(buffer))
end function r8ToString
pure function logicalToString(input) result(string)
logical, intent(in) :: input
character(len=:), allocatable :: string
! We could use a write statement, but this is easier.
allocate(character(len=1) :: string)
if (input) then
string = "T"
else
string = "F"
end if
end function logicalToString
end module shr_strconvert_mod
!
! Mocked cime shr_sys_mod
!
! NOTE this abort is simpler than CIME's real abort -- just die
! already and don't require too many other libraries.
!----------------------------------------------------------------
module shr_sys_mod
use shr_kind_mod, only : shr_kind_in, shr_kind_cx
implicit none
! PUBLIC: Public interfaces
private
! Imported from shr_abort_mod and republished with renames. Other code that wishes to
! use these routines should use these shr_sys names rather than directly using the
! routines from shr_abort_abort. (This is for consistency with older code, from when
! these routines were defined in shr_sys_mod.)
public :: shr_sys_abort ! abort a program
!===============================================================================
contains
!===============================================================================
!===============================================================================
subroutine shr_sys_abort(string,rc)
! Consistent stopping mechanism
!----- arguments -----
character(len=*) , intent(in), optional :: string ! error message string
integer(shr_kind_in), intent(in), optional :: rc ! error code
! Local version of the string.
! (Gets a default value if string is not present.)
character(len=shr_kind_cx) :: local_string
!-------------------------------------------------------------------------------
if (present(string)) then
local_string = trim(string)
else
local_string = "Unknown error submitted to shr_abort_abort."
end if
! A compiler's abort method may print a backtrace or do other nice
! things, but in fact we can rarely leverage this, because MPI_Abort
! usually sends SIGTERM to the process, and we don't catch that signal.
call abort()
end subroutine shr_sys_abort
end module shr_sys_mod
module column_varcon
!-----------------------------------------------------------------------
! !DESCRIPTION:
! Module containing landunit indices and associated variables and routines.
!
! Drastically simplified from the original version --etc
!-----------------------------------------------------------------------
use landunit_varcon, only : isturb_MIN
implicit none
save
private
!------------------------------------------------------------------
! Initialize column type constants
!------------------------------------------------------------------
! urban column types
integer, parameter, public :: icol_roof = isturb_MIN*10 + 1
integer, parameter, public :: icol_sunwall = isturb_MIN*10 + 2
integer, parameter, public :: icol_shadewall = isturb_MIN*10 + 3
integer, parameter, public :: icol_road_imperv = isturb_MIN*10 + 4
integer, parameter, public :: icol_road_perv = isturb_MIN*10 + 5
end module column_varcon
.SUFFIXES:
.SUFFIXES: .o .F .f .c .C .cc .cxx .F90
.F90.o:
$(FC) $(FCFLAGS) -c $< -o $@
.F.o:
$(F77) $(FFLAGS) -c $< -o $@
.f.o:
$(F77) $(FFLAGS) -c $< -o $@
.c.o:
$(CC) $(CFLAGS) $(CPPFLAGS) -c $< -o $@
.cxx.o:
$(CXX) $(CFLAGS) $(CPPFLAGS) -c $< -o $@
SHELL = /bin/sh
ELM_LIB = libelm.a
ELM_LIBS = -lelm
ELM_DIR = elm
ELM_LIB_DEPEND = $(PARFLOW_LIB_DIR)/libelm.a
ELM_UTILS_DIR = cime_utils
LIB_SUFFIX=.a
M4 =
RM = rm -fr
CP = cp
XARGS =
FC = gfortran
FCFLAGS = -Wall -Wunused -fimplicit-none -free -O2
AR = ar
######################################################################
# Rules used in all directories.
######################################################################
ELM_CLEAN=$(RM) *.o *.ii *.int.c *.log *.log.* stamp-* core core.* stats -r ti_files ii_files *.mod *.a
module landunit_varcon
!-----------------------------------------------------------------------
! !DESCRIPTION:
! Module containing landunit indices and associated variables and routines.
!
! Drastically simplifed from original --etc
! -----------------------------------------------------------------------
implicit none
save
private
!------------------------------------------------------------------
! Initialize landunit type constants
!------------------------------------------------------------------
integer, parameter, public :: istsoil = 1 !soil landunit type (natural vegetation)
integer, parameter, public :: istcrop = 2 !crop landunit type
integer, parameter, public :: istice = 3 !land ice landunit type (glacier)
integer, parameter, public :: istice_mec = 4 !land ice (multiple elevation classes) landunit type
integer, parameter, public :: istdlak = 5 !deep lake landunit type (now used for all lakes)
integer, parameter, public :: istwet = 6 !wetland landunit type (swamp, marsh, etc.)
integer, parameter, public :: isturb_MIN = 7 !minimum urban type index
integer, parameter, public :: isturb_tbd = 7 !urban tbd landunit type
integer, parameter, public :: isturb_hd = 8 !urban hd landunit type
integer, parameter, public :: isturb_md = 9 !urban md landunit type
integer, parameter, public :: isturb_MAX = 9 !maximum urban type index
integer, parameter, public :: max_lunit = 9 !maximum value that lun_pp%itype can have
!(i.e., largest value in the above list)
integer, parameter, public :: landunit_name_length = 40 ! max length of landunit names
character(len=landunit_name_length), public :: landunit_names(max_lunit) ! name of each landunit type
! parameters that depend on the above constants
integer, parameter, public :: numurbl = isturb_MAX - isturb_MIN + 1 ! number of urban landunits
end module landunit_varcon
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment