Skip to content
Snippets Groups Projects
Commit 177d8a4a authored by Kyle Klenk's avatar Kyle Klenk
Browse files

adjusted read_attribute for HRU

parent eff939bd
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
build/source/engine/read_attribute.f90
+ 113
− 167
View file @ 177d8a4a
......@@ -43,6 +43,7 @@ subroutine read_dimension(numGRUs,numHRUs,startGRU,err) bind(C, name="readDimens
USE summaActors_FileManager,only:SETTINGS_PATH ! define path to settings files (e.g., parameters, soil and veg. tables)
USE summaActors_FileManager,only:LOCAL_ATTRIBUTES ! name of model initial attributes file
implicit none
! Dummy Variables
......@@ -159,192 +160,137 @@ subroutine read_dimension(numGRUs,numHRUs,startGRU,err) bind(C, name="readDimens
end subroutine read_dimension
subroutine read_attribute(indxHRU, indxGRU, attrFile, attrStruct, typeStruct, idStruct, err, message)
USE netcdf
USE netcdf_util_module,only:nc_file_open ! open netcdf file
USE netcdf_util_module,only:nc_file_close ! close netcdf file
USE netcdf_util_module,only:netcdf_err ! netcdf error handling function
! provide access to derived data types
USE data_types,only:var_d ! x%var(:) (i4b)
USE data_types,only:var_i ! x%var(:) integer(8)
USE data_types,only:var_i8 ! x%var(:) (dp)
! provide access to global data
USE globalData,only:gru_struc ! gru-hru mapping structure
USE globalData,only:attr_meta,type_meta,id_meta ! metadata structures
USE get_ixname_module,only:get_ixAttr,get_ixType,get_ixId ! access function to find index of elements in structure
implicit none
integer(i4b),intent(in) :: indxHRU ! id of the HRU
integer(i4b),intent(in) :: indxGRU ! id of the parent GRU
! io vars
character(*) :: attrFile ! input filename
type(var_d),intent(inout) :: attrStruct ! local attributes for each HRU
type(var_i),intent(inout) :: typeStruct ! local classification of soil veg etc. for each HRU
type(var_i8),intent(inout) :: idStruct !
integer(i4b),intent(out) :: err ! error code
character(*),intent(out) :: message ! error message
! define local variables
character(len=256) :: cmessage ! error message for downwind routine
integer(i4b) :: iVar ! loop through varibles in the netcdf file
integer(i4b) :: varType ! type of variable (categorica, numerical, idrelated)
integer(i4b) :: varIndx ! index of variable within its data structure
! check structures
integer(i4b) :: iCheck ! index of an attribute name
logical(lgt),allocatable :: checkType(:) ! vector to check if we have all desired categorical values
logical(lgt),allocatable :: checkId(:) ! vector to check if we have all desired IDs
logical(lgt),allocatable :: checkAttr(:) ! vector to check if we have all desired local attributes
! netcdf variables
integer(i4b) :: ncID ! netcdf file id
character(LEN=nf90_max_name) :: varName ! character array of netcdf variable name
integer(i4b) :: nVar ! number of variables in netcdf local attribute file
integer(i4b),parameter :: categorical=101 ! named variable to denote categorical data
integer(i4b),parameter :: numerical=102 ! named variable to denote numerical data
integer(i4b),parameter :: idrelated=103 ! named variable to denote ID related data
integer(i4b) :: categorical_var(1) ! temporary categorical variable from local attributes netcdf file
real(dp) :: numeric_var(1) ! temporary numeric variable from local attributes netcdf file
integer(8) :: idrelated_var(1) ! temporary ID related variable from local attributes netcdf file
! define mapping variables
! Start procedure here
err=0; message="read_attrb4chm/"
! **********************************************************************************************
! (1) prepare check vectors
! **********************************************************************************************
allocate(checkType(size(type_meta)),checkAttr(size(attr_meta)),checkId(size(id_meta)),stat=err)
if(err/=0)then; err=20; message=trim(message)//'problem allocating space for variable check vectors'; return; endif
checkType(:) = .false.
checkAttr(:) = .false.
checkId(:) = .false.
! **********************************************************************************************
! (2) open netcdf file
! **********************************************************************************************
! open file
call nc_file_open(trim(attrFile),nf90_noWrite,ncID,err,cmessage)
if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
! get number of variables total in netcdf file
err = nf90_inquire(ncID,nvariables=nVar)
call netcdf_err(err,message); if (err/=0) return
! **********************************************************************************************
! (3) read local attributes
! **********************************************************************************************
! loop through variables in netcdf file and pull out local attributes
iCheck = 1
do iVar = 1,nVar
! inqure about current variable name, type, number of dimensions
err = nf90_inquire_variable(ncID,iVar,name=varName)
if(err/=nf90_noerr)then; message=trim(message)//'problem inquiring variable: '//trim(varName)//'/'//trim(nf90_strerror(err)); return; endif
! find attribute name
select case(trim(varName))
! ** categorical data
case('vegTypeIndex','soilTypeIndex','slopeTypeIndex','downHRUindex')
! get the index of the variable
varType = categorical
varIndx = get_ixType(varName)
checkType(varIndx) = .true.
! check that the variable could be identified in the data structure
if(varIndx < 1)then; err=20; message=trim(message)//'unable to find variable ['//trim(varName)//'] in data structure'; return; endif
! get data from netcdf file and store in vector
err = nf90_get_var(ncID,iVar,categorical_var,start=(/gru_struc(indxGRU)%hruInfo(indxHRU)%hru_nc/),count=(/1/))
if(err/=nf90_noerr)then; message=trim(message)//'problem reading: '//trim(varName); return; end if
typeStruct%var(varIndx) = categorical_var(1)
! ** ID related data
case('hruId')
! get the index of the variable
varType = idrelated
varIndx = get_ixId(varName)
checkId(varIndx) = .true.
! check that the variable could be identified in the data structure
if(varIndx < 1)then; err=20; message=trim(message)//'unable to find variable ['//trim(varName)//'] in data structure'; return; endif
! get data from netcdf file and store in vector
err = nf90_get_var(ncID,iVar,idrelated_var,start=(/gru_struc(indxGRU)%hruInfo(indxHRU)%hru_nc/),count=(/1/))
if(err/=nf90_noerr)then; message=trim(message)//'problem reading: '//trim(varName); return; end if
idStruct%var(varIndx) = idrelated_var(1)
USE netcdf
USE netcdf_util_module,only:nc_file_open ! open netcdf file
USE netcdf_util_module,only:nc_file_close ! close netcdf file
USE netcdf_util_module,only:netcdf_err ! netcdf error handling function
! provide access to derived data types
USE data_types,only:var_d ! x%var(:) (i4b)
USE data_types,only:var_i ! x%var(:) integer(8)
USE data_types,only:var_i8 ! x%var(:) (dp)
! provide access to global data
USE globalData,only:gru_struc ! gru-hru mapping structure
USE globalData,only:attr_meta,type_meta,id_meta ! metadata structures
USE get_ixname_module,only:get_ixAttr,get_ixType,get_ixId ! access function to find index of elements in structure
! get the settings from the output stucture so we do not have to go to file
USE globalData,only:outputStructure
implicit none
! ** numerical data
case('latitude','longitude','elevation','tan_slope','contourLength','HRUarea','mHeight')
integer(i4b),intent(in) :: indxHRU ! id of the HRU
integer(i4b),intent(in) :: indxGRU ! id of the parent GRU
! io vars
character(*) :: attrFile ! input filename
type(var_d),intent(inout) :: attrStruct ! local attributes for each HRU
type(var_i),intent(inout) :: typeStruct ! local classification of soil veg etc. for each HRU
type(var_i8),intent(inout) :: idStruct !
integer(i4b),intent(out) :: err ! error code
character(*),intent(out) :: message ! error message
! get the index of the variable
varType = numerical
varIndx = get_ixAttr(varName)
checkAttr(varIndx) = .true.
! define local variables
character(len=256) :: cmessage ! error message for downwind routine
integer(i4b) :: iVar ! loop through varibles in the netcdf file
integer(i4b) :: varType ! type of variable (categorica, numerical, idrelated)
integer(i4b) :: varIndx ! index of variable within its data structure
! check structures
integer(i4b) :: iCheck ! index of an attribute name
logical(lgt),allocatable :: checkType(:) ! vector to check if we have all desired categorical values
logical(lgt),allocatable :: checkId(:) ! vector to check if we have all desired IDs
logical(lgt),allocatable :: checkAttr(:) ! vector to check if we have all desired local attributes
! netcdf variables
integer(i4b) :: ncID ! netcdf file id
character(LEN=nf90_max_name) :: varName ! character array of netcdf variable name
integer(i4b) :: nVar ! number of variables in netcdf local attribute file
integer(i4b),parameter :: categorical=101 ! named variable to denote categorical data
integer(i4b),parameter :: numerical=102 ! named variable to denote numerical data
integer(i4b),parameter :: idrelated=103 ! named variable to denote ID related data
integer(i4b) :: categorical_var(1) ! temporary categorical variable from local attributes netcdf file
real(dp) :: numeric_var(1) ! temporary numeric variable from local attributes netcdf file
integer(8) :: idrelated_var(1) ! temporary ID related variable from local attributes netcdf file
! define mapping variables
! Start procedure here
err=0; message="read_attribute.f90/"
! check that the variable could be identified in the data structure
if(varIndx < 1)then; err=20; message=trim(message)//'unable to find variable ['//trim(varName)//'] in data structure'; return; endif
! get data from netcdf file and store in vector
err = nf90_get_var(ncID,iVar,numeric_var,start=(/gru_struc(indxGRU)%hruInfo(indxHRU)%hru_nc/),count=(/1/))
if(err/=nf90_noerr)then; message=trim(message)//'problem reading: '//trim(varName); return; end if
attrStruct%var(varIndx) = numeric_var(1)
! **********************************************************************************************
! (1) prepare check vectors
! **********************************************************************************************
allocate(checkType(size(type_meta)),checkAttr(size(attr_meta)),checkId(size(id_meta)),stat=err)
if(err/=0)then
err=20
message=trim(message)//'problem allocating space for variable check vectors'
print*, message
return
endif
! for mapping varibles, do nothing (information read above)
case('hru2gruId','gruId'); cycle
checkType(:) = .false.
checkAttr(:) = .false.
checkId(:) = .false.
! Copy the attribute data that was filled in read_attribute_all_hru.f90
! check that variables are what we expect
case default; message=trim(message)//'unknown variable ['//trim(varName)//'] in local attributes file'; err=20; return
! ** categorical data (typeStruct)
do iVar = 1, size(type_meta)
checkType(iVar) = .true.
typeStruct%var(iVar) = outputStructure(1)%typeStruct(1)%gru(indxGRU)%hru(indxHRU)%var(iVar)
end do
end select ! select variable
! ** ID related data (idStruct)
do iVar=1, size(id_meta)
checkId(iVar) = .true.
idStruct%var(iVar) = outputStructure(1)%idStruct(1)%gru(indxGRU)%hru(indxHRU)%var(iVar)
end do
end do ! (looping through netcdf local attribute file)
! ** numerical data (attrStruct)
do iVar=1, size(attr_meta)
checkAttr(iVar) = .true.
attrStruct%var(iVar) = outputStructure(1)%attrStruct(1)%gru(indxGRU)%hru(indxHRU)%var(iVar)
end do
! ** now handle the optional aspect variable if it's missing
varIndx = get_ixAttr('aspect')
! check that the variable was not found in the attribute file
if(.not. checkAttr(varIndx)) then
! write(*,*) NEW_LINE('A')//'INFO: aspect not found in the input attribute file, continuing ...'//NEW_LINE('A')
attrStruct%var(varIndx) = nr_realMissing ! populate variable with out-of-range value, used later
checkAttr(varIndx) = .true.
endif
varIndx = get_ixTYPE('downkHRU')
checkType(varIndx) = .true.
typeStruct%var(varIndx) = 0
! TODO: downkHRU can cause issues do not know how to hanlde yet
! varIndx = get_ixTYPE('downkHRU')
! checkType(varIndx) = .true.
! typeStruct%var(varIndx) = 0
! **********************************************************************************************
! (4) check that we have all the desired varaibles
! **********************************************************************************************
! check that we have all desired categorical variables
if(any(.not.checkType))then
do iCheck = 1,size(type_meta)
if(.not.checkType(iCheck))then; err=20; message=trim(message)//'missing variable ['//trim(type_meta(iCheck)%varname)//'] in local attributes file'; return; endif
end do
if(any(.not.checkType))then
do iCheck = 1,size(type_meta)
if(.not.checkType(iCheck))then
err=20; message=trim(message)//'missing variable ['//trim(type_meta(iCheck)%varname)//'] in local attributes file'
print*, message
return
endif
end do
endif
! check that we have all desired ID variables
if(any(.not.checkId))then
do iCheck = 1,size(id_meta)
if(.not.checkId(iCheck))then; err=20; message=trim(message)//'missing variable ['//trim(id_meta(iCheck)%varname)//'] in local attributes file'; return; endif
end do
endif
! check that we have all desired ID variables
if(any(.not.checkId))then
do iCheck = 1,size(id_meta)
if(.not.checkId(iCheck))then
err=20
message=trim(message)//'missing variable ['//trim(id_meta(iCheck)%varname)//'] in local attributes file'
print*, message
return
endif
end do
endif
! check that we have all desired local attributes
if(any(.not.checkAttr))then
do iCheck = 1,size(attr_meta)
if(.not.checkAttr(iCheck))then; err=20; message=trim(message)//'missing variable ['//trim(attr_meta(iCheck)%varname)//'] in local attributes file'; return; endif
end do
if(any(.not.checkAttr))then
do iCheck = 1,size(attr_meta)
if(.not.checkAttr(iCheck))then
err=20
message=trim(message)//'missing variable ['//trim(attr_meta(iCheck)%varname)//'] in local attributes file'
return
endif
end do
endif
! **********************************************************************************************
! (5) close netcdf file
! **********************************************************************************************
call nc_file_close(ncID,err,cmessage)
if (err/=0)then; message=trim(message)//trim(cmessage); return; end if
! free memory
deallocate(checkType)
deallocate(checkId)
......
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