Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

updates for ne3np4 scam #15

Merged
merged 1 commit into from
Nov 5, 2024
Merged

updates for ne3np4 scam #15

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
4 changes: 2 additions & 2 deletions src/biogeochem/SatellitePhenologyMod.F90
View file
Open in desktop
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
Open in desktop
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
Open in desktop
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
Loading