From 177d8a4a8f50ee1e70ec21d2b5137b86ab544de3 Mon Sep 17 00:00:00 2001
From: Kyle Klenk <kyle.c.klenk@gmail.com>
Date: Thu, 25 Aug 2022 19:46:17 +0000
Subject: [PATCH] adjusted read_attribute for HRU

---
 build/source/engine/read_attribute.f90 | 280 ++++++++++---------------
 1 file changed, 113 insertions(+), 167 deletions(-)

diff --git a/build/source/engine/read_attribute.f90 b/build/source/engine/read_attribute.f90
index c3329f2..93b935d 100644
--- a/build/source/engine/read_attribute.f90
+++ b/build/source/engine/read_attribute.f90
@@ -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)
-- 
GitLab