Skip to content

Commit

Permalink
updates for ne3np4 scam
Browse files Browse the repository at this point in the history
  • Loading branch information
@jtruesdal
jtruesdal committed Nov 4, 2024
1 parent 8dc7355 commit 87afe5c
Show file tree
Hide file tree
Showing 4 changed files with 88 additions and 91 deletions.
4 changes: 2 additions & 2 deletions src/biogeochem/SatellitePhenologyMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,7 @@ module SatellitePhenologyMod
use shr_log_mod , only : errMsg => shr_log_errMsg
use decompMod , only : bounds_type
use abortutils , only : endrun
use clm_varctl , only : iulog, use_lai_streams
use clm_varctl , only : iulog, use_lai_streams, single_column
use perf_mod , only : t_startf, t_stopf
use spmdMod , only : masterproc, mpicom, iam
use laiStreamMod , only : lai_init, lai_advance, lai_interp
Expand Down Expand Up @@ -311,7 +311,7 @@ subroutine readAnnualVegetation (bounds, canopystate_inst)
call ncd_pio_openfile (ncid, trim(locfn), 0)
call ncd_inqfdims (ncid, isgrid2d, ni, nj, ns)

if (ldomain%ns /= ns .or. ldomain%ni /= ni .or. ldomain%nj /= nj) then
if (.not. single_column .and. (ldomain%ns /= ns .or. ldomain%ni /= ni .or. ldomain%nj /= nj)) then
write(iulog,*)trim(subname), 'ldomain and input file do not match dims '
write(iulog,*)trim(subname), 'ldomain%ni,ni,= ',ldomain%ni,ni
write(iulog,*)trim(subname), 'ldomain%nj,nj,= ',ldomain%nj,nj
Expand Down
120 changes: 58 additions & 62 deletions src/biogeophys/UrbanParamsType.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,9 +9,9 @@ module UrbanParamsType
use shr_log_mod , only : errMsg => shr_log_errMsg
use abortutils , only : endrun
use decompMod , only : bounds_type, subgrid_level_gridcell, subgrid_level_landunit
use clm_varctl , only : iulog, fsurdat
use clm_varctl , only : iulog, fsurdat, single_column
use clm_varcon , only : grlnd, spval
use LandunitType , only : lun
use LandunitType , only : lun
!
implicit none
save
Expand All @@ -26,21 +26,21 @@ module UrbanParamsType
!
! !PRIVATE TYPE
type urbinp_type
real(r8), pointer :: canyon_hwr (:,:)
real(r8), pointer :: wtlunit_roof (:,:)
real(r8), pointer :: wtroad_perv (:,:)
real(r8), pointer :: em_roof (:,:)
real(r8), pointer :: em_improad (:,:)
real(r8), pointer :: em_perroad (:,:)
real(r8), pointer :: em_wall (:,:)
real(r8), pointer :: alb_roof_dir (:,:,:)
real(r8), pointer :: alb_roof_dif (:,:,:)
real(r8), pointer :: alb_improad_dir (:,:,:)
real(r8), pointer :: alb_improad_dif (:,:,:)
real(r8), pointer :: alb_perroad_dir (:,:,:)
real(r8), pointer :: alb_perroad_dif (:,:,:)
real(r8), pointer :: alb_wall_dir (:,:,:)
real(r8), pointer :: alb_wall_dif (:,:,:)
real(r8), pointer :: canyon_hwr (:,:)
real(r8), pointer :: wtlunit_roof (:,:)
real(r8), pointer :: wtroad_perv (:,:)
real(r8), pointer :: em_roof (:,:)
real(r8), pointer :: em_improad (:,:)
real(r8), pointer :: em_perroad (:,:)
real(r8), pointer :: em_wall (:,:)
real(r8), pointer :: alb_roof_dir (:,:,:)
real(r8), pointer :: alb_roof_dif (:,:,:)
real(r8), pointer :: alb_improad_dir (:,:,:)
real(r8), pointer :: alb_improad_dif (:,:,:)
real(r8), pointer :: alb_perroad_dir (:,:,:)
real(r8), pointer :: alb_perroad_dif (:,:,:)
real(r8), pointer :: alb_wall_dir (:,:,:)
real(r8), pointer :: alb_wall_dif (:,:,:)
real(r8), pointer :: ht_roof (:,:)
real(r8), pointer :: wind_hgt_canyon (:,:)
real(r8), pointer :: tk_wall (:,:,:)
Expand Down Expand Up @@ -92,14 +92,14 @@ module UrbanParamsType
real(r8), pointer :: eflx_traffic_factor (:) ! lun multiplicative traffic factor for sensible heat flux from urban traffic (-)
contains

procedure, public :: Init
procedure, public :: Init

end type urbanparams_type
!
! !Urban control variables
character(len= *), parameter, public :: urban_hac_off = 'OFF'
character(len= *), parameter, public :: urban_hac_on = 'ON'
character(len= *), parameter, public :: urban_wasteheat_on = 'ON_WASTEHEAT'
character(len= *), parameter, public :: urban_hac_off = 'OFF'
character(len= *), parameter, public :: urban_hac_on = 'ON'
character(len= *), parameter, public :: urban_wasteheat_on = 'ON_WASTEHEAT'
character(len= 16), public :: urban_hac = urban_hac_off
logical, public :: urban_explicit_ac = .true. ! whether to use explicit, time-varying AC adoption rate
logical, public :: urban_traffic = .false. ! urban traffic fluxes
Expand All @@ -112,7 +112,7 @@ module UrbanParamsType

character(len=*), parameter, private :: sourcefile = &
__FILE__
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------

contains

Expand All @@ -132,11 +132,11 @@ subroutine Init(this, bounds)
!
! !ARGUMENTS:
class(urbanparams_type) :: this
type(bounds_type) , intent(in) :: bounds
type(bounds_type) , intent(in) :: bounds
!
! !LOCAL VARIABLES:
integer :: j,l,c,p,g ! indices
integer :: nc,fl,ib ! indices
integer :: nc,fl,ib ! indices
integer :: dindx ! urban density type index
integer :: ier ! error status
real(r8) :: sumvf ! sum of view factors for wall or road
Expand Down Expand Up @@ -182,12 +182,12 @@ subroutine Init(this, bounds)
allocate(this%em_perroad (begl:endl)) ; this%em_perroad (:) = nan
allocate(this%em_wall (begl:endl)) ; this%em_wall (:) = nan
allocate(this%alb_roof_dir (begl:endl,numrad)) ; this%alb_roof_dir (:,:) = nan
allocate(this%alb_roof_dif (begl:endl,numrad)) ; this%alb_roof_dif (:,:) = nan
allocate(this%alb_improad_dir (begl:endl,numrad)) ; this%alb_improad_dir (:,:) = nan
allocate(this%alb_perroad_dir (begl:endl,numrad)) ; this%alb_perroad_dir (:,:) = nan
allocate(this%alb_improad_dif (begl:endl,numrad)) ; this%alb_improad_dif (:,:) = nan
allocate(this%alb_perroad_dif (begl:endl,numrad)) ; this%alb_perroad_dif (:,:) = nan
allocate(this%alb_wall_dir (begl:endl,numrad)) ; this%alb_wall_dir (:,:) = nan
allocate(this%alb_roof_dif (begl:endl,numrad)) ; this%alb_roof_dif (:,:) = nan
allocate(this%alb_improad_dir (begl:endl,numrad)) ; this%alb_improad_dir (:,:) = nan
allocate(this%alb_perroad_dir (begl:endl,numrad)) ; this%alb_perroad_dir (:,:) = nan
allocate(this%alb_improad_dif (begl:endl,numrad)) ; this%alb_improad_dif (:,:) = nan
allocate(this%alb_perroad_dif (begl:endl,numrad)) ; this%alb_perroad_dif (:,:) = nan
allocate(this%alb_wall_dir (begl:endl,numrad)) ; this%alb_wall_dir (:,:) = nan
allocate(this%alb_wall_dif (begl:endl,numrad)) ; this%alb_wall_dif (:,:) = nan
allocate(this%eflx_traffic_factor (begl:endl)) ; this%eflx_traffic_factor (:) = nan

Expand Down Expand Up @@ -261,7 +261,7 @@ subroutine Init(this, bounds)
! | \ vsr / | | r | | \ vww / s
! | \ / | h o w | \ / k
! wall | \ / | wall | a | | \ / y
! |vwr \ / vwr| | d | |vrw \ / vsw
! |vwr \ / vwr| | d | |vrw \ / vsw
! ------\/------ - - |-----\/-----
! road wall |
! <----- w ----> |
Expand All @@ -272,20 +272,20 @@ subroutine Init(this, bounds)
! vsw = view factor of sky for wall
! vsr + vwr + vwr = 1 vrw + vww + vsw = 1
!
! Source: Masson, V. (2000) A physically-based scheme for the urban energy budget in
! Source: Masson, V. (2000) A physically-based scheme for the urban energy budget in
! atmospheric models. Boundary-Layer Meteorology 94:357-397
!
! - Calculate urban land unit aerodynamic constants using Macdonald (1998) as used in
! Grimmond and Oke (1999)
! ---------------------------------------------------------------------------------------
! road -- sky view factor -> 1 as building height -> 0

! road -- sky view factor -> 1 as building height -> 0
! and -> 0 as building height -> infinity

this%vf_sr(l) = sqrt(lun%canyon_hwr(l)**2 + 1._r8) - lun%canyon_hwr(l)
this%vf_wr(l) = 0.5_r8 * (1._r8 - this%vf_sr(l))

! one wall -- sky view factor -> 0.5 as building height -> 0
! one wall -- sky view factor -> 0.5 as building height -> 0
! and -> 0 as building height -> infinity

this%vf_sw(l) = 0.5_r8 * (lun%canyon_hwr(l) + 1._r8 - sqrt(lun%canyon_hwr(l)**2+1._r8)) / lun%canyon_hwr(l)
Expand All @@ -311,7 +311,7 @@ subroutine Init(this, bounds)
! Grimmond and Oke (1999)
!----------------------------------------------------------------------------------

! Calculate plan area index
! Calculate plan area index
plan_ai = lun%canyon_hwr(l)/(lun%canyon_hwr(l) + 1._r8)

! Building shape shortside/longside ratio (e.g. 1 = square )
Expand Down Expand Up @@ -344,7 +344,7 @@ subroutine Init(this, bounds)
(1 - lun%z_d_town(l) / lun%ht_roof(l)) * frontal_ai)**(-0.5_r8))
end if

else ! Not urban point
else ! Not urban point

this%eflx_traffic_factor(l) = spval
this%t_building_min(l) = spval
Expand All @@ -366,7 +366,7 @@ end subroutine Init
!-----------------------------------------------------------------------
subroutine UrbanInput(begg, endg, mode)
!
! !DESCRIPTION:
! !DESCRIPTION:
! Allocate memory and read in urban input data
!
! !USES:
Expand All @@ -375,7 +375,7 @@ subroutine UrbanInput(begg, endg, mode)
use fileutils , only : getavu, relavu, getfil, opnfil
use spmdMod , only : masterproc
use domainMod , only : ldomain
use ncdio_pio , only : file_desc_t, ncd_io, ncd_inqvdlen, ncd_inqfdims
use ncdio_pio , only : file_desc_t, ncd_io, ncd_inqvdlen, ncd_inqfdims
use ncdio_pio , only : ncd_pio_openfile, ncd_pio_closefile, ncd_inqdid, ncd_inqdlen
!
! !ARGUMENTS:
Expand All @@ -392,7 +392,7 @@ subroutine UrbanInput(begg, endg, mode)
integer :: numrad_i ! input grid: number of solar bands (VIS/NIR)
integer :: numurbl_i ! input grid: number of urban landunits
integer :: ier,ret ! error status
logical :: isgrid2d ! true => file is 2d
logical :: isgrid2d ! true => file is 2d
logical :: readvar ! true => variable is on dataset
logical :: has_numurbl ! true => numurbl dimension is on dataset
character(len=32) :: subname = 'UrbanInput' ! subroutine name
Expand All @@ -403,11 +403,11 @@ subroutine UrbanInput(begg, endg, mode)
if (mode == 'initialize') then

! Read urban data

if (masterproc) then
write(iulog,*)' Reading in urban input data from fsurdat file ...'
end if

call getfil (fsurdat, locfn, 0)
call ncd_pio_openfile (ncid, locfn, 0)

Expand All @@ -428,20 +428,20 @@ subroutine UrbanInput(begg, endg, mode)
if ( nlevurb == 0 ) return

! Allocate dynamic memory
allocate(urbinp%canyon_hwr(begg:endg, numurbl), &
urbinp%wtlunit_roof(begg:endg, numurbl), &
allocate(urbinp%canyon_hwr(begg:endg, numurbl), &
urbinp%wtlunit_roof(begg:endg, numurbl), &
urbinp%wtroad_perv(begg:endg, numurbl), &
urbinp%em_roof(begg:endg, numurbl), &
urbinp%em_improad(begg:endg, numurbl), &
urbinp%em_perroad(begg:endg, numurbl), &
urbinp%em_wall(begg:endg, numurbl), &
urbinp%alb_roof_dir(begg:endg, numurbl, numrad), &
urbinp%alb_roof_dif(begg:endg, numurbl, numrad), &
urbinp%alb_improad_dir(begg:endg, numurbl, numrad), &
urbinp%alb_perroad_dir(begg:endg, numurbl, numrad), &
urbinp%alb_improad_dif(begg:endg, numurbl, numrad), &
urbinp%alb_perroad_dif(begg:endg, numurbl, numrad), &
urbinp%alb_wall_dir(begg:endg, numurbl, numrad), &
urbinp%em_roof(begg:endg, numurbl), &
urbinp%em_improad(begg:endg, numurbl), &
urbinp%em_perroad(begg:endg, numurbl), &
urbinp%em_wall(begg:endg, numurbl), &
urbinp%alb_roof_dir(begg:endg, numurbl, numrad), &
urbinp%alb_roof_dif(begg:endg, numurbl, numrad), &
urbinp%alb_improad_dir(begg:endg, numurbl, numrad), &
urbinp%alb_perroad_dir(begg:endg, numurbl, numrad), &
urbinp%alb_improad_dif(begg:endg, numurbl, numrad), &
urbinp%alb_perroad_dif(begg:endg, numurbl, numrad), &
urbinp%alb_wall_dir(begg:endg, numurbl, numrad), &
urbinp%alb_wall_dif(begg:endg, numurbl, numrad), &
urbinp%ht_roof(begg:endg, numurbl), &
urbinp%wind_hgt_canyon(begg:endg, numurbl), &
Expand All @@ -461,7 +461,7 @@ subroutine UrbanInput(begg, endg, mode)
endif

call ncd_inqfdims (ncid, isgrid2d, ni, nj, ns)
if (ldomain%ns /= ns .or. ldomain%ni /= ni .or. ldomain%nj /= nj) then
if (.not. single_column .and. (ldomain%ns /= ns .or. ldomain%ni /= ni .or. ldomain%nj /= nj)) then
write(iulog,*)trim(subname), 'ldomain and input file do not match dims '
write(iulog,*)trim(subname), 'ldomain%ni,ni,= ',ldomain%ni,ni
write(iulog,*)trim(subname), 'ldomain%nj,nj,= ',ldomain%nj,nj
Expand Down Expand Up @@ -655,7 +655,7 @@ subroutine UrbanInput(begg, endg, mode)

call ncd_pio_closefile(ncid)
if (masterproc) then
write(iulog,*)' Sucessfully read urban input data'
write(iulog,*)' Sucessfully read urban input data'
write(iulog,*)
end if

Expand Down Expand Up @@ -955,7 +955,3 @@ end function IsProgBuildTemp
!-----------------------------------------------------------------------

end module UrbanParamsType




37 changes: 19 additions & 18 deletions src/main/ncdio_pio.F90.in
View file
Original file line number Diff line number Diff line change
Expand Up @@ -541,14 +541,6 @@ contains
character(len=32) :: subname = 'ncd_inqfdims' ! subroutine name
!-----------------------------------------------------------------------

if (single_column) then
ni = 1
nj = 1
ns = 1
isgrid2d = .true.
RETURN
end if

ni = 0
nj = 0

Expand Down Expand Up @@ -1683,6 +1675,8 @@ contains
type(var_desc_t) :: vardesc
integer :: oldhandle ! previous value of pio_error_handle
character(len=*),parameter :: subname='ncd_io_1d_{TYPE}' ! subroutine name
integer :: ni,nj,ns
logical :: isgrid2d
!-----------------------------------------------------------------------

start(:) = 0
Expand Down Expand Up @@ -1710,18 +1704,19 @@ contains
if (single_column) then
start(:) = 1 ; count(:) = 1
call scam_field_offsets(ncid,subgrid_level_name,vardesc,start,count)
if (trim(subgrid_level_name) == grlnd) then
n=2
if (present(nt)) then
start(3) = nt ; count(3) = 1
n=3
end if
else
call ncd_inqfdims(ncid, isgrid2d, ni, nj, ns)
if (isgrid2d) then
n=1
if (present(nt)) then
n=2
start(2) = nt ; count(2) = 1
end if
else
n=2
if (present(nt)) then
start(3) = nt ; count(3) = 1
n=3
end if
end if
call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle)
#if ({ITYPE}==TYPELOGICAL)
Expand Down Expand Up @@ -1867,6 +1862,8 @@ contains
type(iodesc_plus_type) , pointer :: iodesc_plus
type(var_desc_t) :: vardesc
character(len=*),parameter :: subname='ncd_io_2d_{TYPE}' ! subroutine name
integer :: ni,nj,ns
logical :: isgrid2d
!-----------------------------------------------------------------------

start(:)=0
Expand Down Expand Up @@ -1905,7 +1902,8 @@ contains
if (single_column) then
start(:) = 1 ; count(:) = 1
call scam_field_offsets(ncid, subgrid_level_name, vardesc, start, count)
if (trim(subgrid_level_name) == grlnd) then
call ncd_inqfdims(ncid, isgrid2d, ni, nj, ns)
if (isgrid2d) then
count(3) = size(data,dim=2)
n=3
if (present(nt)) then
Expand Down Expand Up @@ -2100,6 +2098,8 @@ contains
type(iodesc_plus_type) , pointer :: iodesc_plus
type(var_desc_t) :: vardesc
character(len=*),parameter :: subname='ncd_io_3d_{TYPE}' ! subroutine name
integer :: ni,nj,ns
logical :: isgrid2d
!-----------------------------------------------------------------------

subgrid_level_name = dim1name
Expand All @@ -2116,7 +2116,8 @@ contains
start(:) = 1
count(:) = 1
call scam_field_offsets(ncid, subgrid_level_name, vardesc, start, count)
if (trim(subgrid_level_name) == grlnd) then
call ncd_inqfdims(ncid, isgrid2d, ni, nj, ns)
if (isgrid2d) then
count(3) = size(data,dim=2);
count(4) = size(data,dim=3)
n=4
Expand Down Expand Up @@ -2435,7 +2436,7 @@ contains
if ( trim(dimname)=='nj'.or. trim(dimname)=='lat'.or. trim(dimname)=='lsmlat') then
start(i)=latidx
count(i)=1
else if ( trim(dimname)=='ni'.or. trim(dimname)=='lon'.or. trim(dimname)=='lsmlon') then
else if ( trim(dimname)=='ni'.or. trim(dimname)=='lon'.or. trim(dimname)=='lsmlon'.or. trim(dimname)=='gridcell') then
start(i)=lonidx
count(i)=1
else if ( trim(dimname)=='column') then
Expand Down
Loading

0 comments on commit 87afe5c

Please sign in to comment.