From eb790908315e8757e74112591e477dd848d03ac0 Mon Sep 17 00:00:00 2001
From: Kyle Klenk <kyle.c.klenk@gmail.com>
Date: Thu, 25 Aug 2022 18:36:40 +0000
Subject: [PATCH] file_access_actor can read in all attribute data for HRU
---
.../file_access_actor_subroutine_wrappers.hpp | 2 +
build/makefile | 5 +-
.../file_access_actor/file_access_actor.cpp | 10 +
.../file_access_actor/initOutputStruc.f90 | 263 ++++++++--------
.../read_attribute_all_hru.f90 | 291 ++++++++++++++++++
build/source/driver/SummaActors_setup.f90 | 2 +-
.../source/driver/summaActors_globalData.f90 | 30 +-
build/source/dshare/data_types.f90 | 3 +-
build/source/engine/alloc_file_access.f90 | 188 +++++------
.../celia1990/verification_data/runinfo.txt | 2 +-
10 files changed, 567 insertions(+), 229 deletions(-)
create mode 100644 build/source/actors/file_access_actor/read_attribute_all_hru.f90
diff --git a/build/includes/file_access_actor/file_access_actor_subroutine_wrappers.hpp b/build/includes/file_access_actor/file_access_actor_subroutine_wrappers.hpp
index 9df2799..ade26ec 100644
--- a/build/includes/file_access_actor/file_access_actor_subroutine_wrappers.hpp
+++ b/build/includes/file_access_actor/file_access_actor_subroutine_wrappers.hpp
@@ -31,4 +31,6 @@ extern "C" {
void def_output(void* handle_ncid, int* startGRU, int* numGRU, int* numHRU, int* err);
void Write_HRU_Param(void* handle_ncid, int* indxGRU, int* indxHRU, int* err);
+
+ void readAttributeFileAccessActor(int* num_gru, int* err);
}
diff --git a/build/makefile b/build/makefile
index 94a5a62..3d6283a 100644
--- a/build/makefile
+++ b/build/makefile
@@ -143,7 +143,8 @@ INTERFACE = $(patsubst %, $(ACTORS_DIR)/global/%, $(SUMMA_INTERFACE))
SUMMA_FILEACCESS_INTERFACE = \
initOutputStruc.f90 \
deallocateOutputStruc.f90 \
- cppwrap_fileAccess.f90
+ cppwrap_fileAccess.f90 \
+ read_attribute_all_hru.f90
FILEACCESS_INTERFACE = $(patsubst %, $(FILE_ACCESS_DIR)/%, $(SUMMA_FILEACCESS_INTERFACE))
@@ -158,7 +159,7 @@ SUMMA_HRU_INTERFACE = \
HRU_INTERFACE = $(patsubst %, $(HRU_ACTOR_DIR)/%, $(SUMMA_HRU_INTERFACE))
SUMMA_GRU_INTERFACE = \
- gru_actor.f90
+ gru_actor.f90 \
GRU_INTERFACE = $(patsubst %, $(GRU_ACTOR_DIR)/%, $(SUMMA_GRU_INTERFACE))
diff --git a/build/source/actors/file_access_actor/file_access_actor.cpp b/build/source/actors/file_access_actor/file_access_actor.cpp
index dad7a63..560dfdf 100644
--- a/build/source/actors/file_access_actor/file_access_actor.cpp
+++ b/build/source/actors/file_access_actor/file_access_actor.cpp
@@ -240,6 +240,16 @@ void initalizeFileAccessActor(stateful_actor<file_access_state>* self) {
Init_OutputStruct(self->state.handle_forcing_file_info, &self->state.outputStrucSize,
&self->state.numGRU, &self->state.err);
+ // Read In all of the attribres for the number of GRUs in the run Domian
+ readAttributeFileAccessActor(&self->state.numGRU, &err);
+ if (err != 0) {
+ aout(self) << "ERROR: FILE_ACCESS_ACTOR readAttributeFilAccessActor() \n";
+ std::string function = "readAttributeFileAccessActor";
+ self->send(self->state.parent, file_access_actor_err_v, function);
+ self->quit();
+ return;
+ }
+
// Initalize the output manager
self->state.output_manager = new OutputManager(self->state.num_vectors_in_output_manager, self->state.numGRU);
diff --git a/build/source/actors/file_access_actor/initOutputStruc.f90 b/build/source/actors/file_access_actor/initOutputStruc.f90
index 111ad6a..cc2090a 100644
--- a/build/source/actors/file_access_actor/initOutputStruc.f90
+++ b/build/source/actors/file_access_actor/initOutputStruc.f90
@@ -32,6 +32,7 @@ subroutine initalizeOutput(forcFileInfo, maxSteps, nGRU, err)
! local variables
integer(i4b) :: nVars
integer(i4b) :: iGRU
+ integer(i4b) :: iHRU
integer(i4b) :: iStep
integer(i4b) :: nSnow
integer(i4b) :: nSoil
@@ -42,39 +43,33 @@ subroutine initalizeOutput(forcFileInfo, maxSteps, nGRU, err)
if (.not.allocated(outputStructure))then
allocate(outputStructure(1))
end if
+
! Statistics Structures
allocate(outputStructure(1)%forcStat(1))
- allocate(outputStructure(1)%forcStat(1)%gru(nGRU))
-
allocate(outputStructure(1)%progStat(1))
- allocate(outputStructure(1)%progStat(1)%gru(nGRU))
-
allocate(outputStructure(1)%diagStat(1))
- allocate(outputStructure(1)%diagStat(1)%gru(nGRU))
-
allocate(outputStructure(1)%fluxStat(1))
- allocate(outputStructure(1)%fluxStat(1)%gru(nGRU))
-
allocate(outputStructure(1)%indxStat(1))
- allocate(outputStructure(1)%indxStat(1)%gru(nGRU))
-
allocate(outputStructure(1)%bvarStat(1))
+ allocate(outputStructure(1)%forcStat(1)%gru(nGRU))
+ allocate(outputStructure(1)%progStat(1)%gru(nGRU))
+ allocate(outputStructure(1)%diagStat(1)%gru(nGRU))
+ allocate(outputStructure(1)%fluxStat(1)%gru(nGRU))
+ allocate(outputStructure(1)%indxStat(1)%gru(nGRU))
allocate(outputStructure(1)%bvarStat(1)%gru(nGRU))
+
! Primary Data Structures (scalars)
allocate(outputStructure(1)%timeStruct(1))
- allocate(outputStructure(1)%timeStruct(1)%gru(nGRU))
-
allocate(outputStructure(1)%forcStruct(1))
- allocate(outputStructure(1)%forcStruct(1)%gru(nGRU))
-
allocate(outputStructure(1)%attrStruct(1))
- allocate(outputStructure(1)%attrStruct(1)%gru(nGRU))
-
allocate(outputStructure(1)%typeStruct(1))
- allocate(outputStructure(1)%typeStruct(1)%gru(nGRU))
-
allocate(outputStructure(1)%idStruct(1))
+ allocate(outputStructure(1)%timeStruct(1)%gru(nGRU))
+ allocate(outputStructure(1)%forcStruct(1)%gru(nGRU))
+ allocate(outputStructure(1)%attrStruct(1)%gru(nGRU))
+ allocate(outputStructure(1)%typeStruct(1)%gru(nGRU))
allocate(outputStructure(1)%idStruct(1)%gru(nGRU))
+
! Primary Data Structures (variable length vectors)
allocate(outputStructure(1)%indxStruct(1))
allocate(outputStructure(1)%mparStruct(1))
@@ -86,132 +81,140 @@ subroutine initalizeOutput(forcFileInfo, maxSteps, nGRU, err)
allocate(outputStructure(1)%progStruct(1)%gru(nGRU))
allocate(outputStructure(1)%diagStruct(1)%gru(nGRU))
allocate(outputStructure(1)%fluxStruct(1)%gru(nGRU))
+
! Basin-Average structures
allocate(outputStructure(1)%bparStruct(1))
allocate(outputStructure(1)%bvarStruct(1))
allocate(outputStructure(1)%bparStruct(1)%gru(nGRU))
allocate(outputStructure(1)%bvarStruct(1)%gru(nGRU))
+
! Finalize Stats for writing
allocate(outputStructure(1)%finalizeStats(1))
allocate(outputStructure(1)%finalizeStats(1)%gru(nGRU))
- !
- ! Allocate space for HRUs
- !
+
+
do iGRU = 1, nGRU
+ ! Statistics Structures
+ allocate(outputStructure(1)%forcStat(1)%gru(iGRU)%hru(gru_struc(iGRU)%hruCount))
+ allocate(outputStructure(1)%progStat(1)%gru(iGRU)%hru(gru_struc(iGRU)%hruCount))
+ allocate(outputStructure(1)%diagStat(1)%gru(iGRU)%hru(gru_struc(iGRU)%hruCount))
+ allocate(outputStructure(1)%fluxStat(1)%gru(iGRU)%hru(gru_struc(iGRU)%hruCount))
+ allocate(outputStructure(1)%indxStat(1)%gru(iGRU)%hru(gru_struc(iGRU)%hruCount))
+ allocate(outputStructure(1)%bvarStat(1)%gru(iGRU)%hru(gru_struc(iGRU)%hruCount))
+
+ ! Primary Data Structures (scalars)
+ allocate(outputStructure(1)%timeStruct(1)%gru(iGRU)%hru(gru_struc(iGRU)%hruCount))
+ allocate(outputStructure(1)%forcStruct(1)%gru(iGRU)%hru(gru_struc(iGRU)%hruCount))
+ allocate(outputStructure(1)%attrStruct(1)%gru(iGRU)%hru(gru_struc(iGRU)%hruCount))
+ allocate(outputStructure(1)%typeStruct(1)%gru(iGRU)%hru(gru_struc(iGRU)%hruCount))
+ allocate(outputStructure(1)%idStruct(1)%gru(iGRU)%hru(gru_struc(iGRU)%hruCount))
+
+ ! Primary Data Structures (variable length vectors)
+ allocate(outputStructure(1)%indxStruct(1)%gru(iGRU)%hru(gru_struc(iGRU)%hruCount))
+ allocate(outputStructure(1)%mparStruct(1)%gru(iGRU)%hru(gru_struc(iGRU)%hruCount))
+ allocate(outputStructure(1)%progStruct(1)%gru(iGRU)%hru(gru_struc(iGRU)%hruCount))
+ allocate(outputStructure(1)%diagStruct(1)%gru(iGRU)%hru(gru_struc(iGRU)%hruCount))
+ allocate(outputStructure(1)%fluxStruct(1)%gru(iGRU)%hru(gru_struc(iGRU)%hruCount))
+
+ ! Basin-Average structures
+ allocate(outputStructure(1)%bvarStruct(1)%gru(iGRU)%hru(gru_struc(iGRU)%hruCount))
+
+ ! Finalize Stats for writing
+ allocate(outputStructure(1)%finalizeStats(1)%gru(iGRU)%hru(gru_struc(iGRU)%hruCount))
- ! Get the maximum number of steps needed to initalize the output structure
- nVars = maxval(forcFileInfo%ffile_list(:)%nVars)
- nSnow = gru_struc(iGRU)%hruInfo(1)%nSnow
- nSoil = gru_struc(iGRU)%hruInfo(1)%nSoil
-
- do iStruct=1,size(structInfo)
- ! allocate space structures
- select case(trim(structInfo(iStruct)%structName))
- case('time')
- allocate(outputStructure(1)%timeStruct(1)%gru(iGRU)%hru(1))
- call alloc_outputStruc(time_meta,outputStructure(1)%timeStruct(1)%gru(iGRU)%hru(1), &
+ end do
+
+ do iGRU=1,nGRU
+ do iHRU=1,gru_struc(iGRU)%hruCount
+
+ ! Get the maximum number of steps needed to initalize the output structure
+ nVars = maxval(forcFileInfo%ffile_list(:)%nVars)
+ nSnow = gru_struc(iGRU)%hruInfo(iHRU)%nSnow
+ nSoil = gru_struc(iGRU)%hruInfo(iHRU)%nSoil
+
+ do iStruct=1,size(structInfo)
+ ! allocate space structures
+ select case(trim(structInfo(iStruct)%structName))
+ case('time')
+ call alloc_outputStruc(time_meta,outputStructure(1)%timeStruct(1)%gru(iGRU)%hru(iHRU), &
maxSteps,err=err,message=message) ! model forcing data
- case('forc')
- allocate(outputStructure(1)%forcStruct(1)%gru(iGRU)%hru(1))
- call alloc_outputStruc(forc_meta,outputStructure(1)%forcStruct(1)%gru(iGRU)%hru(1), &
- maxSteps,nSnow,nSoil,err,message); ! model forcing data
- case('attr')
- allocate(outputStructure(1)%attrStruct(1)%gru(iGRU)%hru(1))
- call alloc_outputStruc(attr_meta,outputStructure(1)%attrStruct(1)%gru(iGRU)%hru(1), &
- maxSteps,nSnow,nSoil,err,message); ! local attributes for each HRU
- case('type')
- allocate(outputStructure(1)%typeStruct(1)%gru(iGRU)%hru(1))
- call alloc_outputStruc(type_meta,outputStructure(1)%typeStruct(1)%gru(iGRU)%hru(1), &
- maxSteps,nSnow,nSoil,err,message); ! classification of soil veg etc.
- case('id' )
- allocate(outputStructure(1)%idStruct(1)%gru(iGRU)%hru(1))
- call alloc_outputStruc(id_meta,outputStructure(1)%idStruct(1)%gru(iGRU)%hru(1), &
- maxSteps,nSnow,nSoil,err,message); ! local values of hru and gru IDs
- case('mpar')
- allocate(outputStructure(1)%mparStruct(1)%gru(iGRU)%hru(1))
- call alloc_outputStruc(mpar_meta,outputStructure(1)%mparStruct(1)%gru(iGRU)%hru(1), &
- maxSteps,nSnow,nSoil,err,message); ! model parameters
- case('indx')
- allocate(outputStructure(1)%indxStruct(1)%gru(iGRU)%hru(1))
- call alloc_outputStruc(indx_meta,outputStructure(1)%indxStruct(1)%gru(iGRU)%hru(1), &
- maxSteps,nSnow,nSoil,err,message); ! model variables
- case('prog')
- allocate(outputStructure(1)%progStruct(1)%gru(iGRU)%hru(1))
- call alloc_outputStruc(prog_meta,outputStructure(1)%progStruct(1)%gru(iGRU)%hru(1), &
- maxSteps,nSnow,nSoil,err,message); ! model prognostic (state) variables
- case('diag')
- allocate(outputStructure(1)%diagStruct(1)%gru(iGRU)%hru(1))
- call alloc_outputStruc(diag_meta,outputStructure(1)%diagStruct(1)%gru(iGRU)%hru(1), &
- maxSteps,nSnow,nSoil,err,message); ! model diagnostic variables
- case('flux')
- allocate(outputStructure(1)%fluxStruct(1)%gru(iGRU)%hru(1))
- call alloc_outputStruc(flux_meta,outputStructure(1)%fluxStruct(1)%gru(iGRU)%hru(1), &
- maxSteps,nSnow,nSoil,err,message); ! model fluxes
- case('bpar')
- call alloc_outputStruc(bpar_meta,outputStructure(1)%bparStruct(1)%gru(iGRU), &
- maxSteps,nSnow=0,nSoil=0,err=err,message=message); ! basin-average params
- case('bvar')
- allocate(outputStructure(1)%bvarStruct(1)%gru(iGRU)%hru(1))
- call alloc_outputStruc(bvar_meta,outputStructure(1)%bvarStruct(1)%gru(iGRU)%hru(1), &
- maxSteps,nSnow=0,nSoil=0,err=err,message=message); ! basin-average variables
- case('deriv'); cycle
- case default; err=20; message='unable to find structure name: '//trim(structInfo(iStruct)%structName)
- end select
- ! check errors
- if(err/=0)then
- message=trim(message)//'[structure = '//trim(structInfo(iStruct)%structName)//']'
- return
- endif
- end do ! looping through data structures
-
- do iStruct=1,size(structInfo)
-
- ! allocate space for statistics structures
- select case(trim(structInfo(iStruct)%structName))
- case('forc')
- allocate(outputStructure(1)%forcStat(1)%gru(iGRU)%hru(1))
- call alloc_outputStruc(statForc_meta(:)%var_info,outputStructure(1)%forcStat(1)%gru(iGRU)%hru(1), &
- maxSteps,nSnow,nSoil,err,message); ! model forcing data
- case('prog')
- allocate(outputStructure(1)%progStat(1)%gru(iGRU)%hru(1))
- call alloc_outputStruc(statProg_meta(:)%var_info,outputStructure(1)%progStat(1)%gru(iGRU)%hru(1), &
- maxSteps,nSnow,nSoil,err,message); ! model prognostic
- case('diag')
- allocate(outputStructure(1)%diagStat(1)%gru(iGRU)%hru(1))
- call alloc_outputStruc(statDiag_meta(:)%var_info,outputStructure(1)%diagStat(1)%gru(iGRU)%hru(1), &
- maxSteps,nSnow,nSoil,err,message); ! model diagnostic
- case('flux')
- allocate(outputStructure(1)%fluxStat(1)%gru(iGRU)%hru(1))
- call alloc_outputStruc(statFlux_meta(:)%var_info,outputStructure(1)%fluxStat(1)%gru(iGRU)%hru(1), &
- maxSteps,nSnow,nSoil,err,message); ! model fluxes
- case('indx')
- allocate(outputStructure(1)%indxStat(1)%gru(iGRU)%hru(1))
- call alloc_outputStruc(statIndx_meta(:)%var_info,outputStructure(1)%indxStat(1)%gru(iGRU)%hru(1), &
- maxSteps,nSnow,nSoil,err,message); ! index vars
- case('bvar')
- allocate(outputStructure(1)%bvarStat(1)%gru(iGRU)%hru(1))
- call alloc_outputStruc(statBvar_meta(:)%var_info,outputStructure(1)%bvarStat(1)%gru(iGRU)%hru(1), &
- maxSteps,nSnow=0,nSoil=0,err=err,message=message); ! basin-average variables
- case default; cycle
- end select
+ case('forc')
+ ! Structure
+ call alloc_outputStruc(forc_meta,outputStructure(1)%forcStruct(1)%gru(iGRU)%hru(iHRU), &
+ maxSteps,nSnow,nSoil,err,message); ! model forcing data
+ ! Statistics
+ call alloc_outputStruc(statForc_meta(:)%var_info,outputStructure(1)%forcStat(1)%gru(iGRU)%hru(iHRU), &
+ maxSteps,nSnow,nSoil,err,message); ! model forcing data
+ case('attr')
+ call alloc_outputStruc(attr_meta,outputStructure(1)%attrStruct(1)%gru(iGRU)%hru(iHRU), &
+ maxSteps,nSnow,nSoil,err,message); ! local attributes for each HRU
+ case('type')
+ call alloc_outputStruc(type_meta,outputStructure(1)%typeStruct(1)%gru(iGRU)%hru(iHRU), &
+ maxSteps,nSnow,nSoil,err,message); ! classification of soil veg etc.
+ case('id' )
+ call alloc_outputStruc(id_meta,outputStructure(1)%idStruct(1)%gru(iGRU)%hru(iHRU), &
+ maxSteps,nSnow,nSoil,err,message); ! local values of hru gru IDs
+ case('mpar')
+ call alloc_outputStruc(mpar_meta,outputStructure(1)%mparStruct(1)%gru(iGRU)%hru(iHRU), &
+ maxSteps,nSnow,nSoil,err,message); ! model parameters
+ case('indx')
+ ! Structure
+ call alloc_outputStruc(indx_meta,outputStructure(1)%indxStruct(1)%gru(iGRU)%hru(iHRU), &
+ maxSteps,nSnow,nSoil,err,message); ! model variables
+ ! Statistics
+ call alloc_outputStruc(statIndx_meta(:)%var_info,outputStructure(1)%indxStat(1)%gru(iGRU)%hru(1), &
+ maxSteps,nSnow,nSoil,err,message); ! index vars
+ case('prog')
+ ! Structure
+ call alloc_outputStruc(prog_meta,outputStructure(1)%progStruct(1)%gru(iGRU)%hru(iHRU), &
+ maxSteps,nSnow,nSoil,err,message); ! model prognostic (state) variables
+ ! Statistics
+ call alloc_outputStruc(statProg_meta(:)%var_info,outputStructure(1)%progStat(1)%gru(iGRU)%hru(iHRU), &
+ maxSteps,nSnow,nSoil,err,message); ! model prognostic
+ case('diag')
+ ! Structure
+ call alloc_outputStruc(diag_meta,outputStructure(1)%diagStruct(1)%gru(iGRU)%hru(iHRU), &
+ maxSteps,nSnow,nSoil,err,message); ! model diagnostic variables
+ ! Statistics
+ call alloc_outputStruc(statDiag_meta(:)%var_info,outputStructure(1)%diagStat(1)%gru(iGRU)%hru(iHRU), &
+ maxSteps,nSnow,nSoil,err,message); ! model diagnostic
+ case('flux')
+ ! Structure
+ call alloc_outputStruc(flux_meta,outputStructure(1)%fluxStruct(1)%gru(iGRU)%hru(iHRU), &
+ maxSteps,nSnow,nSoil,err,message); ! model fluxes
+ ! Statistics
+ call alloc_outputStruc(statFlux_meta(:)%var_info,outputStructure(1)%fluxStat(1)%gru(iGRU)%hru(iHRU), &
+ maxSteps,nSnow,nSoil,err,message); ! model fluxes
+ case('bpar')
+ call alloc_outputStruc(bpar_meta,outputStructure(1)%bparStruct(1)%gru(iGRU), &
+ maxSteps,nSnow=0,nSoil=0,err=err,message=message); ! basin-average params
+ case('bvar')
+ ! Structure
+ call alloc_outputStruc(bvar_meta,outputStructure(1)%bvarStruct(1)%gru(iGRU)%hru(iHRU), &
+ maxSteps,nSnow=0,nSoil=0,err=err,message=message); ! basin-average variables
+ ! Statistics
+ call alloc_outputStruc(statBvar_meta(:)%var_info,outputStructure(1)%bvarStat(1)%gru(iGRU)%hru(iHRU), &
+ maxSteps,nSnow=0,nSoil=0,err=err,message=message); ! basin-average variables
+ case('deriv'); cycle
+ case default; err=20; message='unable to find structure name: '//trim(structInfo(iStruct)%structName)
+ end select
+
+ ! check errors
+ if(err/=0)then
+ message=trim(message)//'initOutputStruc.f90 - [structure = '//trim(structInfo(iStruct)%structName)//']'
+ return
+ endif
+ end do ! looping through data structures
- ! check errors
- if(err/=0)then
- message=trim(message)//'[statistics for = '//trim(structInfo(iStruct)%structName)//']'
- return
- endif
-
- end do ! iStruct
- ! Finalize stats structure for writing to output file
- allocate(outputStructure(1)%finalizeStats(1)%gru(iGRU)%hru(1))
- allocate(outputStructure(1)%finalizeStats(1)%gru(iGRU)%hru(1)%tim(maxSteps))
- do iStep = 1, maxSteps
- allocate(outputStructure(1)%finalizeStats(1)%gru(iGRU)%hru(1)%tim(iStep)%dat(1:maxVarFreq))
- end do ! timeSteps
- end do ! Looping through GRUs
+ ! Finalize stats structure for writing to output file
+ allocate(outputStructure(1)%finalizeStats(1)%gru(iGRU)%hru(iHRU)%tim(maxSteps))
+ do iStep = 1, maxSteps
+ allocate(outputStructure(1)%finalizeStats(1)%gru(iGRU)%hru(iHRU)%tim(iStep)%dat(1:maxVarFreq))
+ end do ! timeSteps
+ end do ! Looping through GRUs
+ end do
end subroutine initalizeOutput
-
end module
\ No newline at end of file
diff --git a/build/source/actors/file_access_actor/read_attribute_all_hru.f90 b/build/source/actors/file_access_actor/read_attribute_all_hru.f90
new file mode 100644
index 0000000..f0912a6
--- /dev/null
+++ b/build/source/actors/file_access_actor/read_attribute_all_hru.f90
@@ -0,0 +1,291 @@
+module read_attribute_all_hru
+ USE, intrinsic :: iso_c_binding
+ USE nrtype
+ implicit none
+ private
+ public::read_attribute_file_access_actor
+contains
+subroutine read_attribute_file_access_actor(num_gru,err) bind(C, name="readAttributeFileAccessActor")
+ USE globalData,only:outputStructure ! Using the output structure as global input for the attribute data. This is so we can hrus can setup params in parallel.
+ 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
+ ! Attribute File
+ 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
+
+ integer(c_int),intent(in) :: num_gru ! id of the HRU
+ integer(c_int),intent(out) :: err ! error code
+
+ ! Local Variables
+ character(len=256) :: message ! error message
+ 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
+
+ integer(i4b) :: iGRU
+ integer(i4b) :: iHRU
+ ! attribute file
+ character(len=256) :: attrFile ! attributes file name
+
+
+ ! define mapping variables
+
+ ! Start procedure here
+ err=0; message="read_attriute_all_hru "
+
+ attrFile = trim(SETTINGS_PATH)//trim(LOCAL_ATTRIBUTES)
+
+
+ ! **********************************************************************************************
+ ! (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
+ 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)
+ print*, message
+ return
+ endif
+
+ ! get number of variables total in netcdf file
+ err = nf90_inquire(ncID,nvariables=nVar)
+ call netcdf_err(err,message)
+ if (err/=0) then
+ message=trim(message)//'problem with nf90_inquire'
+ return
+ endif
+ ! **********************************************************************************************
+ ! (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));
+ print*, message
+ 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';
+ print*, message
+ return;
+ endif
+
+
+ do iGRU=1,num_gru
+ do iHRU = 1,gru_struc(iGRU)%hruCount
+ err = nf90_get_var(ncID,iVar,categorical_var,start=(/gru_struc(iGRU)%hruInfo(iHRU)%hru_nc/),count=(/1/))
+ if(err/=nf90_noerr)then
+ message=trim(message)//'problem reading: '//trim(varName)
+ print*, message
+ return
+ end if
+ outputStructure(1)%typeStruct(1)%gru(iGRU)%hru(iHRU)%var(varIndx) = categorical_var(1)
+ end do
+ end do
+
+ ! ** 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'
+ print*, message
+ return
+ endif
+
+ ! get data from netcdf file and store in vector
+ do iGRU=1,num_gru
+ do iHRU = 1,gru_struc(iGRU)%hruCount
+ err = nf90_get_var(ncID,iVar,idrelated_var,start=(/gru_struc(iGRU)%hruInfo(iHRU)%hru_nc/),count=(/1/))
+ if(err/=nf90_noerr)then
+ message=trim(message)//'problem reading: '//trim(varName)
+ print*, message
+ return
+ end if
+ outputStructure(1)%idStruct(1)%gru(iGRU)%hru(iHRU)%var(varIndx) = idrelated_var(1)
+ end do
+ end do
+
+ ! ** numerical data
+ case('latitude','longitude','elevation','tan_slope','contourLength','HRUarea','mHeight')
+
+ ! get the index of the variable
+ varType = numerical
+ varIndx = get_ixAttr(varName)
+ checkAttr(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'
+ print*, message
+ return
+ endif
+ ! get data from netcdf file and store in vector
+
+ do iGRU=1,num_gru
+ do iHRU = 1,gru_struc(iGRU)%hruCount
+ err = nf90_get_var(ncID,iVar,numeric_var,start=(/gru_struc(iGRU)%hruInfo(iHRU)%hru_nc/),count=(/1/))
+ if(err/=nf90_noerr)then
+ message=trim(message)//'problem reading: '//trim(varName)
+ print*, message
+ return
+ end if
+ outputStructure(1)%attrStruct(1)%gru(iGRU)%hru(iHRU)%var(varIndx) = numeric_var(1)
+ end do
+ end do
+
+ ! for mapping varibles, do nothing (information read above)
+ case('hru2gruId','gruId'); cycle
+
+ ! check that variables are what we expect
+ case default
+ message=trim(message)//'unknown variable ['//trim(varName)//'] in local attributes file'
+ print*,message
+ err=20
+ return
+
+ end select ! select variable
+
+ end do ! (looping through netcdf local attribute file)
+
+ ! ** 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')
+ do iGRU=1,num_gru
+ do iHRU = 1, gru_struc(iGRU)%hruCount
+ outputStructure(1)%attrStruct(1)%gru(iGRU)%hru(iHRU)%var(varIndx) = nr_realMissing ! populate variable with out-of-range value, used later
+ end do
+ end do
+ checkAttr(varIndx) = .true.
+ endif
+
+ ! TODO: find out why this is here, probably for the lateral flows
+ varIndx = get_ixTYPE('downkHRU')
+ checkType(varIndx) = .true.
+ ! outputStructure(1)%typeStruct(1)%gru(iGRU)%hru(iHRU)%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'
+ 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'
+ 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'
+ print*, message
+ 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)
+ deallocate(checkAttr)
+
+end subroutine
+
+
+end module
\ No newline at end of file
diff --git a/build/source/driver/SummaActors_setup.f90 b/build/source/driver/SummaActors_setup.f90
index 801be8f..3917cf0 100755
--- a/build/source/driver/SummaActors_setup.f90
+++ b/build/source/driver/SummaActors_setup.f90
@@ -146,7 +146,7 @@ contains
integer(i4b) :: iVar ! looping variables
! ---------------------------------------------------------------------------------------
! initialize error control
- err=0; message='summa4chm_paramSetup/'
+ err=0; message='hru_paramSetup/'
! initialize the start of the initialization
call date_and_time(values=startSetup)
diff --git a/build/source/driver/summaActors_globalData.f90 b/build/source/driver/summaActors_globalData.f90
index 509cb9a..efd6b18 100755
--- a/build/source/driver/summaActors_globalData.f90
+++ b/build/source/driver/summaActors_globalData.f90
@@ -114,22 +114,38 @@ subroutine summa_defineGlobalData(start_gru_index, err) bind(C, name="defineGlob
! populate metadata for all model variables
call popMetadat(err,cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+ if(err/=0)then
+ message=trim(message)//trim(cmessage)
+ print*, message
+ return
+ endif
! define mapping between fluxes and states
call flxMapping(err,cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+ if(err/=0)then
+ message=trim(message)//trim(cmessage)
+ print*, message
+ return
+ endif
! check data structures
call checkStruc(err,cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+ if(err/=0)then
+ message=trim(message)//trim(cmessage)
+ print*, message
+ return
+ endif
! define the mask to identify the subset of variables in the "child" data structure (just scalar variables)
flux_mask = (flux_meta(:)%vartype==iLookVarType%scalarv)
! create the averageFlux metadata structure
call childStruc(flux_meta, flux_mask, averageFlux_meta, childFLUX_MEAN, err, cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+ if(err/=0)then
+ message=trim(message)//trim(cmessage)
+ print*, message
+ return
+ endif
! child metadata structures - so that we do not carry full stats structures around everywhere
! only carry stats for variables with output frequency > model time step
@@ -151,7 +167,11 @@ subroutine summa_defineGlobalData(start_gru_index, err) bind(C, name="defineGlob
case('bvar'); call childStruc(bvar_meta,statBvar_mask,statBvar_meta,bvarChild_map,err,cmessage)
end select
! check errors
- if(err/=0)then; message=trim(message)//trim(cmessage)//'[statistics for = '//trim(structInfo(iStruct)%structName)//']'; return; endif
+ if(err/=0)then
+ message=trim(message)//trim(cmessage)//'[statistics for = '//trim(structInfo(iStruct)%structName)//']'
+ print*, message
+ return
+ endif
end do ! iStruct
! set all stats metadata to correct var types
diff --git a/build/source/dshare/data_types.f90 b/build/source/dshare/data_types.f90
index c2551e0..0cf403a 100755
--- a/build/source/dshare/data_types.f90
+++ b/build/source/dshare/data_types.f90
@@ -427,7 +427,8 @@ type(gru_hru_time_int),allocatable :: timeStruct(:)
type(gru_hru_time_double),allocatable :: forcStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:) -- model forcing data
type(gru_hru_double),allocatable :: attrStruct(:) ! x%gru(:)%hru(:)%var(:) -- local attributes for each HRU, DOES NOT CHANGE OVER TIMESTEPS
type(gru_hru_int),allocatable :: typeStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:) -- local classification of soil veg etc. for each HRU, DOES NOT CHANGE OVER TIMESTEPS
-type(gru_hru_time_int8),allocatable :: idStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:) --
+! type(gru_hru_time_int8),allocatable :: idStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:) --
+type(gru_hru_int8),allocatable :: idStruct(:) ! x%gru(:)%hru(:)%var(:)
! define the primary data structures (variable length vectors)
type(gru_hru_time_intVec),allocatable :: indxStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model indices
diff --git a/build/source/engine/alloc_file_access.f90 b/build/source/engine/alloc_file_access.f90
index 5a83a89..139982f 100644
--- a/build/source/engine/alloc_file_access.f90
+++ b/build/source/engine/alloc_file_access.f90
@@ -5,6 +5,7 @@ USE data_types,only:var_time_ilength
USE data_types,only:var_time_i
USE data_types,only:var_time_d
USE data_types,only:var_time_i8
+USE data_types,only:var_i8
USE data_types,only:var_d
USE data_types,only:var_i
USE data_types,only:var_dlength
@@ -41,105 +42,114 @@ subroutine alloc_outputStruc(metaStruct,dataStruct,nSteps,nSnow,nSoil,err,messag
integer(i4b) :: iVar
character(len=256) :: cmessage ! error message of the downwind routine
! initalize error control
- err=0; message='alloc_outputStruc'
+ message='alloc_outputStruc'
nVars = size(metaStruct)
- if(present(nSnow) .or. present(nSoil))then
- ! check both are present
- if(.not.present(nSoil))then; err=20; message=trim(message)//'expect nSoil to be present when nSnow is present'; return; end if
- if(.not.present(nSnow))then; err=20; message=trim(message)//'expect nSnow to be present when nSoil is present'; return; end if
- nLayers = nSnow+nSoil
+ if(present(nSnow) .or. present(nSoil))then
+ ! check both are present
+ if(.not.present(nSoil))then; err=20; message=trim(message)//'expect nSoil to be present when nSnow is present'; return; end if
+ if(.not.present(nSnow))then; err=20; message=trim(message)//'expect nSnow to be present when nSoil is present'; return; end if
+ nLayers = nSnow+nSoil
- ! It is possible that nSnow and nSoil are actually needed here, so we return an error if the optional arguments are missing when needed
- else
- select type(dataStruct)
- ! class is (var_flagVec); err=20
- class is (var_time_ilength); err=20
- class is (var_time_dlength); err=20
- end select
- if(err/=0)then; message=trim(message)//'expect nSnow and nSoil to be present for variable-length data structures'; return; end if
- end if
+ ! It is possible that nSnow and nSoil are actually needed here, so we return an error if the optional arguments are missing when needed
+ else
+ select type(dataStruct)
+ ! class is (var_flagVec); err=20
+ class is (var_time_ilength); err=20
+ class is (var_time_dlength); err=20
+ end select
+ if(err/=0)then; message=trim(message)//'expect nSnow and nSoil to be present for variable-length data structures'; return; end if
+ end if
- check=.false.
+ check=.false.
! allocate the dimension for model variables
- select type(dataStruct)
+ select type(dataStruct)
- class is (var_time_i)
- if(allocated(dataStruct%var))then
- check=.true.
- else
- allocate(dataStruct%var(nVars),stat=err)
- end if
- do iVar=1, nVars
- allocate(dataStruct%var(iVar)%tim(nSteps))
- end do
- return
+ class is (var_time_i)
+ if(allocated(dataStruct%var))then
+ check=.true.
+ else
+ allocate(dataStruct%var(nVars),stat=err)
+ end if
+
+ do iVar=1, nVars
+ allocate(dataStruct%var(iVar)%tim(nSteps))
+ end do
+ return
- class is (var_time_i8)
- if(allocated(dataStruct%var))then
- check=.true.
- else
- allocate(dataStruct%var(nVars),stat=err)
- end if
- do iVar=1, nVars
- allocate(dataStruct%var(iVar)%tim(nSteps))
- end do
- return
+ class is (var_time_i8)
+ if(allocated(dataStruct%var))then
+ check=.true.
+ else
+ allocate(dataStruct%var(nVars),stat=err)
+ end if
+ do iVar=1, nVars
+ allocate(dataStruct%var(iVar)%tim(nSteps))
+ end do
+ return
- class is (var_time_d)
- if(allocated(dataStruct%var))then
- check=.true.
- else
- allocate(dataStruct%var(nVars),stat=err)
- end if
- do iVar=1, nVars
- allocate(dataStruct%var(iVar)%tim(nSteps))
- end do
- return
-
- class is (var_d)
- if(allocated(dataStruct%var))then
- check=.true.
- else
- allocate(dataStruct%var(nVars),stat=err)
- end if
- return
-
- class is (var_i)
- if(allocated(dataStruct%var))then
- check=.true.
- else
- allocate(dataStruct%var(nVars),stat=err)
- end if
- return
-
- class is (var_dlength)
- if(allocated(dataStruct%var))then
- check=.true.
- else
- allocate(dataStruct%var(nVars),stat=err)
- end if
- ! class is (var_flagVec); if(allocated(dataStruct%var))then; check=.true.; else; allocate(dataStruct%var(nVars),stat=err); end if
+ class is (var_time_d)
+ if(allocated(dataStruct%var))then
+ check=.true.
+ else
+ allocate(dataStruct%var(nVars),stat=err)
+ end if
+ do iVar=1, nVars
+ allocate(dataStruct%var(iVar)%tim(nSteps))
+ end do
+ return
+
+ class is (var_d)
+ if(allocated(dataStruct%var))then
+ check=.true.
+ else
+ allocate(dataStruct%var(nVars),stat=err)
+ end if
+ return
+
+ class is (var_i)
+ if(allocated(dataStruct%var))then
+ check=.true.
+ else
+ allocate(dataStruct%var(nVars),stat=err)
+ end if
+ return
+
+ class is (var_i8)
+ if(allocated(dataStruct%var))then
+ check=.true.
+ else
+ allocate(dataStruct%var(nVars), stat=err)
+ end if
+ return
+
+ class is (var_dlength)
+ if(allocated(dataStruct%var))then
+ check=.true.
+ else
+ allocate(dataStruct%var(nVars),stat=err)
+ end if
+ ! class is (var_flagVec); if(allocated(dataStruct%var))then; check=.true.; else; allocate(dataStruct%var(nVars),stat=err); end if
- class is (var_time_ilength)
- if(allocated(dataStruct%var))then
- check=.true.
- else
- allocate(dataStruct%var(nVars),stat=err)
- end if
- do iVar=1, nVars
- allocate(dataStruct%var(iVar)%tim(nSteps))
- end do
+ class is (var_time_ilength)
+ if(allocated(dataStruct%var))then
+ check=.true.
+ else
+ allocate(dataStruct%var(nVars),stat=err)
+ end if
+ do iVar=1, nVars
+ allocate(dataStruct%var(iVar)%tim(nSteps))
+ end do
- class is (var_time_dlength)
- if(allocated(dataStruct%var))then
- check=.true.
- else
- allocate(dataStruct%var(nVars),stat=err)
- end if
- do iVar=1, nVars
- allocate(dataStruct%var(iVar)%tim(nSteps))
- end do
+ class is (var_time_dlength)
+ if(allocated(dataStruct%var))then
+ check=.true.
+ else
+ allocate(dataStruct%var(nVars),stat=err)
+ end if
+ do iVar=1, nVars
+ allocate(dataStruct%var(iVar)%tim(nSteps))
+ end do
class default; err=20; message=trim(message)//'unable to identify derived data type for the variable dimension'; return
end select
diff --git a/utils/laugh_tests/celia1990/verification_data/runinfo.txt b/utils/laugh_tests/celia1990/verification_data/runinfo.txt
index a4397e2..35a4527 100644
--- a/utils/laugh_tests/celia1990/verification_data/runinfo.txt
+++ b/utils/laugh_tests/celia1990/verification_data/runinfo.txt
@@ -1 +1 @@
- Run start time on system: ccyy=2022 - mm=08 - dd=15 - hh=02 - mi=49 - ss=51.739
+ Run start time on system: ccyy=2022 - mm=08 - dd=24 - hh=02 - mi=58 - ss=32.515
--
GitLab