Commit 70c27cb2 authored by Ethan Coon's avatar Ethan Coon
Browse files

deals with rename of fortran source that resulted in deleted files in last commit

parent 1ce6a711
#ifndef ELM_CANOPY_HYDROLOGY_INTERFACE_HH_
#define ELM_CANOPY_HYDROLOGY_INTERFACE_HH_
namespace ELM {
void CanopyHydrologyKern1(double dtime,
const double& forc_rain, const double& forc_snow, const double& irrig_rate,
const int& ltype, const int& ctype,
const bool& urbpoi, const bool& do_capsnow,
const double& elai, const double& esai,
const double& dewmx, const double& frac_veg_nosno,
double& h2ocan,
int& n_irrig_steps_left,
double& qflx_prec_intr,
double& qflx_irrig,
double& qflx_prec_grnd,
double& qflx_snwcp_liq,
double& qflx_snwcp_ice,
double& qflx_snow_grnd_patch,
double& qflx_rain_grnd);
} // namespace
#endif
#ifndef ELM_CANOPY_HYDROLOGY_INTERFACE_PRIVATE_HH_
#define ELM_CANOPY_HYDROLOGY_INTERFACE_PRIVATE_HH_
extern "C" {
void canopyhydrologykern1_(const double* dtime,
const double* forc_rain,
const double* forc_snow,
const double* irrig_rate,
const int* ltype,
const int* ctype,
const bool* urbpoi,
const bool* do_capsnow,
const double* elai,
const double* esai,
const double* dewmx,
const int* frac_veg_nosno,
const double* h2ocan,
const int* n_irrig_steps_left,
const double* qflx_prec_intr,
const double* qflx_irrig,
const double* qflx_prec_grnd,
const double* qflx_snwcp_liq,
const double* qflx_snwcp_ice,
const double* qflx_snow_grnd_patch,
const double* qflx_rain_grnd);
}
#endif
subroutine CanopyHydrologyKern1( dtime, &
forc_rain, forc_snow, irrig_rate, &
ltype, ctype, urbpoi, do_capsnow, &
elai, esai, dewmx, frac_veg_nosno, &
h2ocan, n_irrig_steps_left, &
qflx_prec_intr, qflx_irrig, qflx_prec_grnd, &
qflx_snwcp_liq, qflx_snwcp_ice, qflx_snow_grnd_patch, qflx_rain_grnd)
use shr_kind_mod, only : &
r8 => shr_kind_r8, &
i4 => shr_kind_i4, &
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
subroutine CanopyHydrologyKern2( dtime, oldfflag, newnode, &
ctype, qflx_floodc, qflx_snow_h2osfc, snow_depth, snl, &
swe_old, h2osoi_liq, h2osoi_ice, dz, z, zi, &
t_soisno, frac_iceold, &
do_capsnow, frac_h2osfc, qflx_snow_grnd_col, frac_sno, int_snow, forc_t, &
h2osno,qflx_snow_melt, n_melt, frac_sno_eff, t_grnd, &
qflx_floodg, &
ltype, urbpoi) bind(C)
use shr_kind_mod, only : &
r8 => shr_kind_r8, &
i4 => shr_kind_i4, &
bool => shr_kind_bool
use column_varcon , only : icol_sunwall, icol_shadewall
use landunit_varcon , only : istcrop, istice, istwet, istsoil, istice_mec
use clm_varpar , only : nlevsno
!use column_varcon , only : icol_sunwall, icol_shadewall
!use landunit_varcon , only : istcrop, istice, istwet, istsoil, istice_mec
!use clm_varcon , only : zlnd, rpi, tfrz
use clm_varctl , only : subgridflag
implicit none
real(r8), parameter :: rpi=4.0d0*atan(1.0d0)
real(r8), parameter :: tfrz=273.15
real(r8) :: zlnd = 0.01_r8
real(r8), intent(in) :: dtime
integer, intent(in) :: oldfflag, ctype , ltype
integer, intent(inout) :: snl
integer, intent(out) :: newnode
real(r8), intent(out) :: qflx_floodc
real(r8), intent(in) :: qflx_floodg
real(r8), intent(out) :: qflx_snow_h2osfc
real(r8), intent(out), dimension(-nlevsno+1:0) :: swe_old
real(r8), intent(inout) :: snow_depth , h2osno
real(r8), intent(inout), dimension(-nlevsno+1:0) :: h2osoi_liq, h2osoi_ice
real(r8), intent(inout), dimension(-nlevsno+1:0) :: dz
real(r8), intent(out), dimension(-nlevsno+1:0) :: z, zi
real(r8), intent(out), dimension(-nlevsno+1:0) :: t_soisno, frac_iceold
logical, intent(in) :: do_capsnow, urbpoi
real(r8), intent(in) :: frac_h2osfc, qflx_snow_grnd_col, forc_t , qflx_snow_melt, n_melt
real(r8), intent(out) :: int_snow, frac_sno_eff, frac_sno
real(r8), intent(in) :: t_grnd
! local variables
real(r8) :: temp_intsnow, temp_snow_depth, z_avg, fmelt, dz_snowf, snowmelt
real(r8) :: newsnow, bifall, fsnow_new, accum_factor, fsno_new, smr
integer :: j
! apply gridcell flood water flux to non-lake columns
if (ctype /= icol_sunwall .and. ctype /= icol_shadewall) then
qflx_floodc = qflx_floodg
else
qflx_floodc = 0._r8
endif
! Determine snow height and snow water
! Use Alta relationship, Anderson(1976); LaChapelle(1961),
! U.S.Department of Agriculture Forest Service, Project F,
! Progress Rep. 1, Alta Avalanche Study Center:Snow Layer Densification.
qflx_snow_h2osfc = 0._r8
! set temporary variables prior to updating
temp_snow_depth=snow_depth
! save initial snow content
do j= -nlevsno+1,snl
swe_old(j) = 0.0_r8
end do
do j= snl+1,0
swe_old(j)=h2osoi_liq(j)+h2osoi_ice(j)
enddo
if (do_capsnow) then
dz_snowf = 0._r8
newsnow = (1._r8 - frac_h2osfc) * qflx_snow_grnd_col * dtime
frac_sno=1._r8
int_snow = 5.e2_r8
else
if (forc_t > tfrz + 2._r8) then
bifall=50._r8 + 1.7_r8*(17.0_r8)**1.5_r8
else if (forc_t > tfrz - 15._r8) then
bifall=50._r8 + 1.7_r8*(forc_t - tfrz + 15._r8)**1.5_r8
else
bifall=50._r8
end if
! newsnow is all snow that doesn't fall on h2osfc
newsnow = (1._r8 - frac_h2osfc) * qflx_snow_grnd_col * dtime
! update int_snow
int_snow = max(int_snow,h2osno) !h2osno could be larger due to frost
! snowmelt from previous time step * dtime
snowmelt = qflx_snow_melt * dtime
! set shape factor for accumulation of snow
accum_factor=0.1
if (h2osno > 0.0) then
!====================== FSCA PARAMETERIZATIONS ======================
! fsca parameterization based on *changes* in swe
! first compute change from melt during previous time step
if(snowmelt > 0._r8) then
smr=min(1._r8,(h2osno)/(int_snow))
frac_sno = 1. - (acos(min(1._r8,(2.*smr - 1._r8)))/rpi)**(n_melt)
endif
! update fsca by new snow event, add to previous fsca
if (newsnow > 0._r8) then
fsno_new = 1._r8 - (1._r8 - tanh(accum_factor*newsnow))*(1._r8 - frac_sno)
frac_sno = fsno_new
! reset int_snow after accumulation events
temp_intsnow= (h2osno + newsnow) &
/ (0.5*(cos(rpi*(1._r8-max(frac_sno,1e-6_r8))**(1./n_melt))+1._r8))
int_snow = min(1.e8_r8,temp_intsnow)
endif
!====================================================================
! for subgrid fluxes
if (subgridflag ==1 .and. .not. urbpoi) then
if (frac_sno > 0._r8)then
snow_depth=snow_depth + newsnow/(bifall * frac_sno)
else
snow_depth=0._r8
end if
else
! for uniform snow cover
snow_depth=snow_depth+newsnow/bifall
endif
! use original fsca formulation (n&y 07)
if (oldfflag == 1) then
! snow cover fraction in Niu et al. 2007
if(snow_depth > 0.0_r8) then
frac_sno = tanh(snow_depth/(2.5_r8*zlnd* &
(min(800._r8,(h2osno+ newsnow)/snow_depth)/100._r8)**1._r8) )
endif
if(h2osno < 1.0_r8) then
frac_sno=min(frac_sno,h2osno)
endif
endif
else !h2osno == 0
! initialize frac_sno and snow_depth when no snow present initially
if (newsnow > 0._r8) then
z_avg = newsnow/bifall
fmelt=newsnow
frac_sno = tanh(accum_factor*newsnow)
! make int_snow consistent w/ new fsno, h2osno
int_snow = 0. !reset prior to adding newsnow below
temp_intsnow= (h2osno + newsnow) &
/ (0.5*(cos(rpi*(1._r8-max(frac_sno,1e-6_r8))**(1./n_melt))+1._r8))
int_snow = min(1.e8_r8,temp_intsnow)
! update snow_depth and h2osno to be consistent with frac_sno, z_avg
if (subgridflag ==1 .and. .not. urbpoi) then
snow_depth=z_avg/frac_sno
else
snow_depth=newsnow/bifall
endif
! use n&y07 formulation
if (oldfflag == 1) then
! snow cover fraction in Niu et al. 2007
if(snow_depth > 0.0_r8) then
frac_sno = tanh(snow_depth/(2.5_r8*zlnd* &
(min(800._r8,newsnow/snow_depth)/100._r8)**1._r8) )
endif
endif
else
z_avg = 0._r8
snow_depth = 0._r8
frac_sno = 0._r8
endif
endif ! end of h2osno > 0
! snow directly falling on surface water melts, increases h2osfc
qflx_snow_h2osfc = frac_h2osfc*qflx_snow_grnd_col
! update h2osno for new snow
h2osno = h2osno + newsnow
int_snow = int_snow + newsnow
! update change in snow depth
dz_snowf = (snow_depth - temp_snow_depth) / dtime
end if !end of do_capsnow construct
! set frac_sno_eff variable
if (ltype == istsoil .or. ltype == istcrop) then
if (subgridflag ==1) then
frac_sno_eff = frac_sno
else
frac_sno_eff = 1._r8
endif
else
frac_sno_eff = 1._r8
endif
if (ltype==istwet .and. t_grnd>tfrz) then
h2osno=0._r8
snow_depth=0._r8
end if
! When the snow accumulation exceeds 10 mm, initialize snow layer
! Currently, the water temperature for the precipitation is simply set
! as the surface air temperature
newnode = 0 ! flag for when snow node will be initialized
if (snl == 0 .and. qflx_snow_grnd_col > 0.0_r8 .and. frac_sno*snow_depth >= 0.01_r8) then
newnode = 1
snl = -1
dz(0) = snow_depth ! meter
z(0) = -0.5_r8*dz(0)
zi(-1) = -dz(0)
t_soisno(0) = min(tfrz, forc_t) ! K
h2osoi_ice(0) = h2osno ! kg/m2
h2osoi_liq(0) = 0._r8 ! kg/m2
frac_iceold(0) = 1._r8
end if
! The change of ice partial density of surface node due to precipitation.
! Only ice part of snowfall is added here, the liquid part will be added
! later.
if (snl < 0 .and. newnode == 0) then
h2osoi_ice(snl+1) = h2osoi_ice(snl+1)+newsnow
dz(snl+1) = dz(snl+1)+dz_snowf*dtime
end if
end subroutine CanopyHydrologyKern2
OBJECT = ../
default: all
include $(OBJECT)/config/Makefile.config
FCFLAGS += -I$(ELM_UTILS_DIR)
# 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 \
clm_varpar.o \
clm_varctl.o \
CanopyHydrologyKern1.o \
CanopyHydrologyKern2.o
all: $(OBJS)
$(AR) cr libelm.a $(OBJS)
clean:
@$(ELM_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)