356 lines
15 KiB
Fortran
356 lines
15 KiB
Fortran
module UrbanInputMod
|
|
|
|
!-----------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !MODULE: UrbanInputMod
|
|
!
|
|
! !DESCRIPTION:
|
|
! Read in input urban data - fill in data structure urbinp
|
|
!
|
|
! !USES:
|
|
use shr_kind_mod, only : r8 => shr_kind_r8
|
|
use abortutils , only : endrun
|
|
use shr_sys_mod , only : shr_sys_flush
|
|
!
|
|
! !PUBLIC TYPES:
|
|
implicit none
|
|
save
|
|
|
|
private
|
|
!
|
|
! !PUBLIC MEMBER FUNCTIONS:
|
|
public :: UrbanInput ! Read in urban input data
|
|
|
|
type urbinp_t
|
|
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(:,:)
|
|
real(r8), pointer :: tk_roof(:,:)
|
|
real(r8), pointer :: tk_improad(:,:)
|
|
real(r8), pointer :: cv_wall(:,:)
|
|
real(r8), pointer :: cv_roof(:,:)
|
|
real(r8), pointer :: cv_improad(:,:)
|
|
real(r8), pointer :: thick_wall(:)
|
|
real(r8), pointer :: thick_roof(:)
|
|
integer, pointer :: nlev_improad(:)
|
|
real(r8), pointer :: t_building_min(:)
|
|
real(r8), pointer :: t_building_max(:)
|
|
end type urbinp_t
|
|
public urbinp_t
|
|
|
|
type (urbinp_t) , public :: urbinp ! urban input derived type
|
|
!
|
|
!EOP
|
|
!-----------------------------------------------------------------------
|
|
|
|
contains
|
|
|
|
!-----------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: UrbanInput
|
|
!
|
|
! !INTERFACE:
|
|
subroutine UrbanInput(mode)
|
|
!
|
|
! !DESCRIPTION:
|
|
! Allocate memory and read in urban input data
|
|
!
|
|
! !USES:
|
|
use clm_varpar, only : numrad, nlevurb, numsolar
|
|
use clm_varctl, only : iulog, fsurdat, single_column
|
|
use fileutils , only : getavu, relavu, getfil, opnfil
|
|
use spmdMod , only : masterproc
|
|
use clmtype
|
|
use decompMod , only : get_proc_bounds
|
|
use domainMod , only : ldomain
|
|
use ncdio_pio , only : file_desc_t, ncd_pio_openfile, ncd_io, ncd_inqfdims, ncd_pio_closefile, ncd_inqdid, ncd_inqdlen
|
|
!
|
|
! !ARGUMENTS:
|
|
implicit none
|
|
character(len=*), intent(in) :: mode
|
|
!
|
|
! !CALLED FROM:
|
|
! subroutine initialize
|
|
!
|
|
! !REVISION HISTORY:
|
|
! Created by Mariana Vertenstein July 2004
|
|
! Revised by Keith Oleson for netcdf input Jan 2008
|
|
!
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!EOP
|
|
character(len=256) :: locfn ! local file name
|
|
type(file_desc_t) :: ncid ! netcdf id
|
|
integer :: dimid,varid ! netCDF id's
|
|
integer :: begg,endg ! start/stop gridcells
|
|
integer :: nw,n,k,i,j,ni,nj,ns ! indices
|
|
integer :: nlevurb_i ! input grid: number of urban vertical levels
|
|
integer :: numsolar_i ! input grid: number of solar type (DIR/DIF)
|
|
integer :: numrad_i ! input grid: number of solar bands (VIS/NIR)
|
|
integer :: ier,ret ! error status
|
|
logical :: isgrid2d ! true => file is 2d
|
|
logical :: readvar ! true => variable is on dataset
|
|
real(r8), pointer :: arrayl3d(:,:,:) ! generic global array
|
|
character(len=32) :: subname = 'UrbanInput' ! subroutine name
|
|
!-----------------------------------------------------------------------
|
|
|
|
call get_proc_bounds(begg,endg)
|
|
|
|
if (mode == 'initialize') then
|
|
|
|
! Allocate dynamic memory
|
|
allocate(urbinp%canyon_hwr(begg:endg), &
|
|
urbinp%wtlunit_roof(begg:endg), &
|
|
urbinp%wtroad_perv(begg:endg), &
|
|
urbinp%em_roof(begg:endg), &
|
|
urbinp%em_improad(begg:endg), &
|
|
urbinp%em_perroad(begg:endg), &
|
|
urbinp%em_wall(begg:endg), &
|
|
urbinp%alb_roof_dir(begg:endg,numrad), &
|
|
urbinp%alb_roof_dif(begg:endg,numrad), &
|
|
urbinp%alb_improad_dir(begg:endg,numrad), &
|
|
urbinp%alb_perroad_dir(begg:endg,numrad), &
|
|
urbinp%alb_improad_dif(begg:endg,numrad), &
|
|
urbinp%alb_perroad_dif(begg:endg,numrad), &
|
|
urbinp%alb_wall_dir(begg:endg,numrad), &
|
|
urbinp%alb_wall_dif(begg:endg,numrad), &
|
|
urbinp%ht_roof(begg:endg), &
|
|
urbinp%wind_hgt_canyon(begg:endg), &
|
|
urbinp%tk_wall(begg:endg,nlevurb), &
|
|
urbinp%tk_roof(begg:endg,nlevurb), &
|
|
urbinp%tk_improad(begg:endg,nlevurb), &
|
|
urbinp%cv_wall(begg:endg,nlevurb), &
|
|
urbinp%cv_roof(begg:endg,nlevurb), &
|
|
urbinp%cv_improad(begg:endg,nlevurb), &
|
|
urbinp%thick_wall(begg:endg), &
|
|
urbinp%thick_roof(begg:endg), &
|
|
urbinp%nlev_improad(begg:endg), &
|
|
urbinp%t_building_min(begg:endg), &
|
|
urbinp%t_building_max(begg:endg), &
|
|
stat=ier)
|
|
if (ier /= 0) then
|
|
write(iulog,*)'initUrbanInput: allocation error '; call endrun()
|
|
endif
|
|
|
|
! 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)
|
|
|
|
if (masterproc) then
|
|
write(iulog,*) subname,trim(fsurdat)
|
|
end if
|
|
|
|
call ncd_inqfdims (ncid, isgrid2d, ni, nj, ns)
|
|
if (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
|
|
write(iulog,*)trim(subname), 'ldomain%ns,ns,= ',ldomain%ns,ns
|
|
call endrun()
|
|
end if
|
|
|
|
call ncd_inqdid(ncid, 'nlevurb', dimid)
|
|
call ncd_inqdlen(ncid, dimid, nlevurb_i)
|
|
if (nlevurb_i /= nlevurb) then
|
|
write(iulog,*)trim(subname)// ': parameter nlevurb= ',nlevurb, &
|
|
'does not equal input dataset nlevurb= ',nlevurb_i
|
|
call endrun
|
|
endif
|
|
|
|
call ncd_inqdid(ncid, 'numsolar', dimid)
|
|
call ncd_inqdlen(ncid, dimid, numsolar_i)
|
|
if (numsolar_i /= numsolar) then
|
|
write(iulog,*)trim(subname)// ': parameter numsolar= ',numsolar, &
|
|
'does not equal input dataset numsolar= ',numsolar_i
|
|
call endrun
|
|
endif
|
|
|
|
call ncd_inqdid(ncid, 'numrad', dimid)
|
|
call ncd_inqdlen(ncid, dimid, numrad_i)
|
|
if (numrad_i /= numrad) then
|
|
write(iulog,*)trim(subname)// ': parameter numrad= ',numrad, &
|
|
'does not equal input dataset numrad= ',numrad_i
|
|
call endrun
|
|
endif
|
|
|
|
call ncd_io(ncid=ncid, varname='CANYON_HWR', flag='read', data=urbinp%canyon_hwr,&
|
|
dim1name=grlnd, readvar=readvar)
|
|
if (.not. readvar) call endrun( trim(subname)//' ERROR: CANYON_HWR NOT on fsurdat file' )
|
|
|
|
call ncd_io(ncid=ncid, varname='WTLUNIT_ROOF', flag='read', data=urbinp%wtlunit_roof, &
|
|
dim1name=grlnd, readvar=readvar)
|
|
if (.not. readvar) call endrun( trim(subname)//' ERROR: WTLUNIT_ROOF NOT on fsurdat file' )
|
|
|
|
call ncd_io(ncid=ncid, varname='WTROAD_PERV', flag='read', data=urbinp%wtroad_perv, &
|
|
dim1name=grlnd, readvar=readvar)
|
|
if (.not. readvar) call endrun( trim(subname)//' ERROR: WTROAD_PERV NOT on fsurdat file' )
|
|
|
|
call ncd_io(ncid=ncid, varname='EM_ROOF', flag='read', data=urbinp%em_roof, &
|
|
dim1name=grlnd, readvar=readvar)
|
|
if (.not. readvar) call endrun( trim(subname)//' ERROR: EM_ROOF NOT on fsurdat file' )
|
|
|
|
call ncd_io(ncid=ncid, varname='EM_IMPROAD', flag='read', data=urbinp%em_improad, &
|
|
dim1name=grlnd, readvar=readvar)
|
|
if (.not. readvar) call endrun( trim(subname)//' ERROR: EM_IMPROAD NOT on fsurdat file' )
|
|
|
|
call ncd_io(ncid=ncid, varname='EM_PERROAD', flag='read', data=urbinp%em_perroad, &
|
|
dim1name=grlnd, readvar=readvar)
|
|
if (.not. readvar) call endrun( trim(subname)//' ERROR: EM_PERROAD NOT on fsurdat file' )
|
|
|
|
call ncd_io(ncid=ncid, varname='EM_WALL', flag='read', data=urbinp%em_wall, &
|
|
dim1name=grlnd, readvar=readvar)
|
|
if (.not. readvar) call endrun( trim(subname)//' ERROR: EM_WALL NOT on fsurdat file' )
|
|
|
|
call ncd_io(ncid=ncid, varname='HT_ROOF', flag='read', data=urbinp%ht_roof, &
|
|
dim1name=grlnd, readvar=readvar)
|
|
if (.not. readvar) call endrun( trim(subname)//' ERROR: HT_ROOF NOT on fsurdat file' )
|
|
|
|
call ncd_io(ncid=ncid, varname='WIND_HGT_CANYON', flag='read', data=urbinp%wind_hgt_canyon, &
|
|
dim1name=grlnd, readvar=readvar)
|
|
if (.not. readvar) call endrun( trim(subname)//' ERROR: WIND_HGT_CANYON NOT on fsurdat file' )
|
|
|
|
call ncd_io(ncid=ncid, varname='THICK_WALL', flag='read', data=urbinp%thick_wall, &
|
|
dim1name=grlnd, readvar=readvar)
|
|
if (.not. readvar) call endrun( trim(subname)//' ERROR: THICK_WALL NOT on fsurdat file' )
|
|
|
|
call ncd_io(ncid=ncid, varname='THICK_ROOF', flag='read', data=urbinp%thick_roof, &
|
|
dim1name=grlnd, readvar=readvar)
|
|
if (.not. readvar) call endrun( trim(subname)//' ERROR: THICK_ROOF NOT on fsurdat file' )
|
|
|
|
call ncd_io(ncid=ncid, varname='NLEV_IMPROAD', flag='read', data=urbinp%nlev_improad, &
|
|
dim1name=grlnd, readvar=readvar)
|
|
if (.not. readvar) call endrun( trim(subname)//' ERROR: NLEV_IMPROAD NOT on fsurdat file' )
|
|
|
|
call ncd_io(ncid=ncid, varname='T_BUILDING_MIN', flag='read', data=urbinp%t_building_min, &
|
|
dim1name=grlnd, readvar=readvar)
|
|
if (.not. readvar) call endrun( trim(subname)//' ERROR: T_BUILDING_MIN NOT on fsurdat file' )
|
|
|
|
call ncd_io(ncid=ncid, varname='T_BUILDING_MAX', flag='read', data=urbinp%t_building_max, &
|
|
dim1name=grlnd, readvar=readvar)
|
|
if (.not. readvar) call endrun( trim(subname)//' ERROR: T_BUILDING_MAX NOT on fsurdat file' )
|
|
|
|
allocate(arrayl3d(begg:endg,numrad,numsolar))
|
|
|
|
call ncd_io(ncid=ncid, varname='ALB_IMPROAD', flag='read', data=arrayl3d, &
|
|
dim1name=grlnd, readvar=readvar)
|
|
if (.not.readvar) call endrun( trim(subname)//' ERROR: ALB_IMPROAD NOT on fsurdat file' )
|
|
urbinp%alb_improad_dir(begg:endg,:) = arrayl3d(begg:endg,:,1)
|
|
urbinp%alb_improad_dif(begg:endg,:) = arrayl3d(begg:endg,:,2)
|
|
|
|
call ncd_io(ncid=ncid, varname='ALB_PERROAD', flag='read',data=arrayl3d, &
|
|
dim1name=grlnd, readvar=readvar)
|
|
if (.not. readvar) call endrun( trim(subname)//' ERROR: ALB_PERROAD NOT on fsurdat file' )
|
|
urbinp%alb_perroad_dir(begg:endg,:) = arrayl3d(begg:endg,:,1)
|
|
urbinp%alb_perroad_dif(begg:endg,:) = arrayl3d(begg:endg,:,2)
|
|
|
|
call ncd_io(ncid=ncid, varname='ALB_ROOF', flag='read', data=arrayl3d, &
|
|
dim1name=grlnd, readvar=readvar)
|
|
if (.not. readvar) call endrun( trim(subname)//' ERROR: ALB_ROOF NOT on fsurdat file' )
|
|
urbinp%alb_roof_dir(begg:endg,:) = arrayl3d(begg:endg,:,1)
|
|
urbinp%alb_roof_dif(begg:endg,:) = arrayl3d(begg:endg,:,2 )
|
|
|
|
call ncd_io(ncid=ncid, varname='ALB_WALL', flag='read', data=arrayl3d, &
|
|
dim1name=grlnd, readvar=readvar)
|
|
if (.not. readvar) call endrun( trim(subname)//' ERROR: ALB_WALL NOT on fsurdat file' )
|
|
urbinp%alb_wall_dir(begg:endg,:) = arrayl3d(begg:endg,:,1)
|
|
urbinp%alb_wall_dif(begg:endg,:) = arrayl3d(begg:endg,:,2)
|
|
|
|
deallocate (arrayl3d)
|
|
|
|
call ncd_io(ncid=ncid, varname='TK_IMPROAD', flag='read', data=urbinp%tk_improad, &
|
|
dim1name=grlnd, readvar=readvar)
|
|
if (.not. readvar) call endrun( trim(subname)//' ERROR: TK_IMPROAD NOT on fsurdat file' )
|
|
|
|
call ncd_io(ncid=ncid, varname='TK_ROOF', flag='read', data=urbinp%tk_roof, &
|
|
dim1name=grlnd, readvar=readvar)
|
|
if (.not. readvar) call endrun( trim(subname)//' ERROR: TK_ROOF NOT on fsurdat file' )
|
|
|
|
call ncd_io(ncid=ncid, varname='TK_WALL', flag='read', data=urbinp%tk_wall, &
|
|
dim1name=grlnd, readvar=readvar)
|
|
if (.not. readvar) call endrun( trim(subname)//' ERROR: TK_WALL NOT on fsurdat file' )
|
|
|
|
call ncd_io(ncid=ncid, varname='CV_IMPROAD', flag='read', data=urbinp%cv_improad, &
|
|
dim1name=grlnd, readvar=readvar)
|
|
if (.not. readvar) call endrun( trim(subname)//' ERROR: CV_IMPROAD NOT on fsurdat file' )
|
|
|
|
call ncd_io(ncid=ncid, varname='CV_ROOF', flag='read', data=urbinp%cv_roof, &
|
|
dim1name=grlnd, readvar=readvar)
|
|
if (.not. readvar) call endrun( trim(subname)//' ERROR: CV_ROOF NOT on fsurdat file' )
|
|
|
|
call ncd_io(ncid=ncid, varname='CV_WALL', flag='read', data=urbinp%cv_wall, &
|
|
dim1name=grlnd, readvar=readvar)
|
|
if (.not. readvar) call endrun( trim(subname)//' ERROR: CV_WALL NOT on fsurdat file' )
|
|
|
|
call ncd_pio_closefile(ncid)
|
|
if (masterproc) then
|
|
write(iulog,*)' Sucessfully read urban input data'
|
|
write(iulog,*)
|
|
end if
|
|
|
|
else if (mode == 'finalize') then
|
|
|
|
deallocate(urbinp%canyon_hwr, &
|
|
urbinp%wtlunit_roof, &
|
|
urbinp%wtroad_perv, &
|
|
urbinp%em_roof, &
|
|
urbinp%em_improad, &
|
|
urbinp%em_perroad, &
|
|
urbinp%em_wall, &
|
|
urbinp%alb_roof_dir, &
|
|
urbinp%alb_roof_dif, &
|
|
urbinp%alb_improad_dir, &
|
|
urbinp%alb_perroad_dir, &
|
|
urbinp%alb_improad_dif, &
|
|
urbinp%alb_perroad_dif, &
|
|
urbinp%alb_wall_dir, &
|
|
urbinp%alb_wall_dif, &
|
|
urbinp%ht_roof, &
|
|
urbinp%wind_hgt_canyon, &
|
|
urbinp%tk_wall, &
|
|
urbinp%tk_roof, &
|
|
urbinp%tk_improad, &
|
|
urbinp%cv_wall, &
|
|
urbinp%cv_roof, &
|
|
urbinp%cv_improad, &
|
|
urbinp%thick_wall, &
|
|
urbinp%thick_roof, &
|
|
urbinp%nlev_improad, &
|
|
urbinp%t_building_min, &
|
|
urbinp%t_building_max, &
|
|
stat=ier)
|
|
if (ier /= 0) then
|
|
write(iulog,*)'initUrbanInput: deallocation error '; call endrun()
|
|
endif
|
|
|
|
else
|
|
write(iulog,*)'initUrbanInput error: mode ',trim(mode),' not supported '
|
|
call endrun()
|
|
end if
|
|
|
|
end subroutine UrbanInput
|
|
|
|
end module UrbanInputMod
|
|
|