From fe3b3dc419a9e1a5fc8a6addc9bce6f410aabcb6 Mon Sep 17 00:00:00 2001
From: Kyle Klenk <kyle.c.klenk@gmail.com>
Date: Fri, 26 Aug 2022 20:04:11 +0000
Subject: [PATCH] parameters can be read into outputStructure with no issues
---
.../file_access_actor_subroutine_wrappers.hpp | 2 +
.../file_access_actor/file_access_actor.cpp | 10 +
.../file_access_actor/initOutputStruc.f90 | 98 +++--
.../file_access_actor/read_param_all_hru.f90 | 55 ++-
build/source/driver/SummaActors_setup.f90 | 412 ++++++++++--------
build/source/dshare/data_types.f90 | 64 +--
build/source/dshare/globalData.f90 | 2 +-
build/source/engine/read_paramActors.f90 | 297 +------------
.../celia1990/verification_data/runinfo.txt | 2 +-
.../summa_celia1990_G1-1_timestep.nc | Bin 8758079 -> 8758079 bytes
10 files changed, 396 insertions(+), 546 deletions(-)
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 a510b92..2b63382 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
@@ -33,6 +33,8 @@ extern "C" {
void Write_HRU_Param(void* handle_ncid, int* indxGRU, int* indxHRU, int* err);
void readAttributeFileAccessActor(int* num_gru, int* err);
+
+ void overwriteParam(int* num_gru, int* err);
void readParamFileAccessActor(int* start_gru, int* num_gru, int* err);
}
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 7086276..de07700 100644
--- a/build/source/actors/file_access_actor/file_access_actor.cpp
+++ b/build/source/actors/file_access_actor/file_access_actor.cpp
@@ -250,6 +250,16 @@ void initalizeFileAccessActor(stateful_actor<file_access_state>* self) {
return;
}
+ overwriteParam(&self->state.numGRU, &err);
+ if (err != 0) {
+ aout(self) << "ERROR: FILE_ACCESS_ACTOR overwriteParam() \n";
+ std::string function = "overwriteParam";
+ self->send(self->state.parent, file_access_actor_err_v, function);
+ self->quit();
+ return;
+ }
+
+
// Read in all of the parmeters for the number of GRUs in the run Domain
readParamFileAccessActor(&self->state.startGRU, &self->state.numGRU, &err);
if (err != 0) {
diff --git a/build/source/actors/file_access_actor/initOutputStruc.f90 b/build/source/actors/file_access_actor/initOutputStruc.f90
index cc2090a..dfed3e0 100644
--- a/build/source/actors/file_access_actor/initOutputStruc.f90
+++ b/build/source/actors/file_access_actor/initOutputStruc.f90
@@ -4,7 +4,7 @@ module summaActors_initOutputStruct
public::initalizeOutput
contains
-subroutine initalizeOutput(forcFileInfo, maxSteps, nGRU, err)
+subroutine initalizeOutput(forcFileInfo, maxSteps, num_gru, err)
USE globalData,only:outputStructure
USE globalData,only:time_meta,forc_meta,attr_meta,type_meta ! metadata structures
USE globalData,only:prog_meta,diag_meta,flux_meta,id_meta ! metadata structures
@@ -26,7 +26,7 @@ subroutine initalizeOutput(forcFileInfo, maxSteps, nGRU, err)
implicit none
type(file_info_array), pointer :: forcFileInfo
integer(i4b), intent(in) :: maxSteps
- integer(i4b), intent(in) :: nGRU
+ integer(i4b), intent(in) :: num_gru
integer(i4b), intent(inout) :: err
! local variables
@@ -38,6 +38,7 @@ subroutine initalizeOutput(forcFileInfo, maxSteps, nGRU, err)
integer(i4b) :: nSoil
integer(i4b) :: iStruct
character(len=256) :: message
+ integer(i4b) :: num_hru
! Allocate structure to hold output files
if (.not.allocated(outputStructure))then
@@ -51,12 +52,12 @@ subroutine initalizeOutput(forcFileInfo, maxSteps, nGRU, err)
allocate(outputStructure(1)%fluxStat(1))
allocate(outputStructure(1)%indxStat(1))
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))
+ allocate(outputStructure(1)%forcStat(1)%gru(num_gru))
+ allocate(outputStructure(1)%progStat(1)%gru(num_gru))
+ allocate(outputStructure(1)%diagStat(1)%gru(num_gru))
+ allocate(outputStructure(1)%fluxStat(1)%gru(num_gru))
+ allocate(outputStructure(1)%indxStat(1)%gru(num_gru))
+ allocate(outputStructure(1)%bvarStat(1)%gru(num_gru))
! Primary Data Structures (scalars)
allocate(outputStructure(1)%timeStruct(1))
@@ -64,11 +65,11 @@ subroutine initalizeOutput(forcFileInfo, maxSteps, nGRU, err)
allocate(outputStructure(1)%attrStruct(1))
allocate(outputStructure(1)%typeStruct(1))
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))
+ allocate(outputStructure(1)%timeStruct(1)%gru(num_gru))
+ allocate(outputStructure(1)%forcStruct(1)%gru(num_gru))
+ allocate(outputStructure(1)%attrStruct(1)%gru(num_gru))
+ allocate(outputStructure(1)%typeStruct(1)%gru(num_gru))
+ allocate(outputStructure(1)%idStruct(1)%gru(num_gru))
! Primary Data Structures (variable length vectors)
allocate(outputStructure(1)%indxStruct(1))
@@ -76,55 +77,63 @@ subroutine initalizeOutput(forcFileInfo, maxSteps, nGRU, err)
allocate(outputStructure(1)%progStruct(1))
allocate(outputStructure(1)%diagStruct(1))
allocate(outputStructure(1)%fluxStruct(1))
- allocate(outputStructure(1)%indxStruct(1)%gru(nGRU))
- allocate(outputStructure(1)%mparStruct(1)%gru(nGRU))
- allocate(outputStructure(1)%progStruct(1)%gru(nGRU))
- allocate(outputStructure(1)%diagStruct(1)%gru(nGRU))
- allocate(outputStructure(1)%fluxStruct(1)%gru(nGRU))
+ allocate(outputStructure(1)%indxStruct(1)%gru(num_gru))
+ allocate(outputStructure(1)%mparStruct(1)%gru(num_gru))
+ allocate(outputStructure(1)%progStruct(1)%gru(num_gru))
+ allocate(outputStructure(1)%diagStruct(1)%gru(num_gru))
+ allocate(outputStructure(1)%fluxStruct(1)%gru(num_gru))
! 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))
+ allocate(outputStructure(1)%bparStruct(1)%gru(num_gru))
+ allocate(outputStructure(1)%bvarStruct(1)%gru(num_gru))
+
+ ! define the ancillary data structures
+ allocate(outputStructure(1)%dparStruct(1))
+ allocate(outputStructure(1)%dparStruct(1)%gru(num_gru))
! Finalize Stats for writing
allocate(outputStructure(1)%finalizeStats(1))
- allocate(outputStructure(1)%finalizeStats(1)%gru(nGRU))
+ allocate(outputStructure(1)%finalizeStats(1)%gru(num_gru))
- do iGRU = 1, nGRU
+ do iGRU = 1, num_gru
+ num_hru = gru_struc(iGRU)%hruCount
! 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))
+ allocate(outputStructure(1)%forcStat(1)%gru(iGRU)%hru(num_hru))
+ allocate(outputStructure(1)%progStat(1)%gru(iGRU)%hru(num_hru))
+ allocate(outputStructure(1)%diagStat(1)%gru(iGRU)%hru(num_hru))
+ allocate(outputStructure(1)%fluxStat(1)%gru(iGRU)%hru(num_hru))
+ allocate(outputStructure(1)%indxStat(1)%gru(iGRU)%hru(num_hru))
+ allocate(outputStructure(1)%bvarStat(1)%gru(iGRU)%hru(num_hru))
! 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))
+ allocate(outputStructure(1)%timeStruct(1)%gru(iGRU)%hru(num_hru))
+ allocate(outputStructure(1)%forcStruct(1)%gru(iGRU)%hru(num_hru))
+ allocate(outputStructure(1)%attrStruct(1)%gru(iGRU)%hru(num_hru))
+ allocate(outputStructure(1)%typeStruct(1)%gru(iGRU)%hru(num_hru))
+ allocate(outputStructure(1)%idStruct(1)%gru(iGRU)%hru(num_hru))
! 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))
+ allocate(outputStructure(1)%indxStruct(1)%gru(iGRU)%hru(num_hru))
+ allocate(outputStructure(1)%mparStruct(1)%gru(iGRU)%hru(num_hru))
+ allocate(outputStructure(1)%progStruct(1)%gru(iGRU)%hru(num_hru))
+ allocate(outputStructure(1)%diagStruct(1)%gru(iGRU)%hru(num_hru))
+ allocate(outputStructure(1)%fluxStruct(1)%gru(iGRU)%hru(num_hru))
! Basin-Average structures
- allocate(outputStructure(1)%bvarStruct(1)%gru(iGRU)%hru(gru_struc(iGRU)%hruCount))
+ allocate(outputStructure(1)%bvarStruct(1)%gru(iGRU)%hru(num_hru))
+
+ ! define the ancillary data structures
+ allocate(outputStructure(1)%dparStruct(1)%gru(iGRU)%hru(num_hru))
! Finalize Stats for writing
- allocate(outputStructure(1)%finalizeStats(1)%gru(iGRU)%hru(gru_struc(iGRU)%hruCount))
+ allocate(outputStructure(1)%finalizeStats(1)%gru(iGRU)%hru(num_hru))
end do
- do iGRU=1,nGRU
+ do iGRU=1,num_gru
do iHRU=1,gru_struc(iGRU)%hruCount
! Get the maximum number of steps needed to initalize the output structure
@@ -154,9 +163,12 @@ subroutine initalizeOutput(forcFileInfo, maxSteps, nGRU, err)
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')
+ case('mpar') ! model parameters
call alloc_outputStruc(mpar_meta,outputStructure(1)%mparStruct(1)%gru(iGRU)%hru(iHRU), &
- maxSteps,nSnow,nSoil,err,message); ! model parameters
+ maxSteps,nSnow,nSoil,err,message);
+
+ call alloc_outputStruc(mpar_meta, outputStructure(1)%dparStruct(1)%gru(iGRU)%hru(iHRU), &
+ maxSteps,err=err,message=message)
case('indx')
! Structure
call alloc_outputStruc(indx_meta,outputStructure(1)%indxStruct(1)%gru(iGRU)%hru(iHRU), &
diff --git a/build/source/actors/file_access_actor/read_param_all_hru.f90 b/build/source/actors/file_access_actor/read_param_all_hru.f90
index 31ff21b..10bc4b3 100644
--- a/build/source/actors/file_access_actor/read_param_all_hru.f90
+++ b/build/source/actors/file_access_actor/read_param_all_hru.f90
@@ -4,7 +4,53 @@ module read_param_all_hru
implicit none
private
public::read_param_file_access_actor
+ public::overwriteParam
contains
+subroutine overwriteParam(num_gru, err) bind(C, name="overwriteParam")
+ USE globalData,only:outputStructure
+ USE pOverwrite_module,only:pOverwrite ! module to overwrite default parameter values with info from the Noah tables
+ USE globalData,only:gru_struc
+ USE globalData,only:localParFallback ! local column default parameters
+ USE globalData,only:basinParFallback ! basin-average default parameter
+ USE var_lookup,only:iLookTYPE ! look-up values for classification of veg, soils etc.
+
+ implicit none
+ integer(c_int),intent(in) :: num_gru ! number of GRUs in the run_domain
+ integer(c_int),intent(out) :: err ! error code
+
+ ! local
+ integer(i4b) :: iGRU
+ integer(i4b) :: iHRU
+ integer(i4b) :: iVar
+ integer(i4b) :: iDat
+ character(len=256) :: message
+
+ err=0; message="overwriteParam"
+
+ ! Need to set the basin parameters with the default values for when we copy
+ do iGRU=1,num_gru
+ do iHRU=1,gru_struc(iGRU)%hruCount
+ do iVar=1, size(localParFallback)
+ outputStructure(1)%dparStruct(1)%gru(iGRU)%hru(iHRU)%var(iVar) = localParFallback(iVar)%default_val
+ end do
+ ! overwrite default model parameters with information from the Noah-MP tables
+ call pOverwrite(outputStructure(1)%typeStruct(1)%gru(iGRU)%hru(iHRU)%var(iLookTYPE%vegTypeIndex), & ! vegetation category
+ outputStructure(1)%typeStruct(1)%gru(iGRU)%hru(iHRU)%var(iLookTYPE%soilTypeIndex), & ! soil category
+ outputStructure(1)%dparStruct(1)%gru(iGRU)%hru(iHRU)%var(:), & ! default model parameters
+ err,message)
+
+ do iVar=1, size(localParFallback)
+ do iDat=1, size(outputStructure(1)%mparStruct(1)%gru(iGRU)%hru(iHRU)%var(iVar)%dat)
+ outputStructure(1)%mparStruct(1)%gru(iGRU)%hru(iHRU)%var(iVar)%dat(iDat) = outputStructure(1)%dparStruct(1)%gru(iGRU)%hru(iHRU)%var(iVar)
+ end do
+ end do
+ end do
+ do iVar=1,size(basinParFallback)
+ outputStructure(1)%bparStruct(1)%gru(iGRU)%var(iVar) = basinParFallback(iVar)%default_val
+ end do
+ end do
+
+end subroutine
subroutine read_param_file_access_actor(startGRU,num_gru,err) bind(C, name="readParamFileAccessActor")
! used to read model initial conditions
USE summaActors_FileManager,only:SETTINGS_PATH ! path for metadata files
@@ -56,10 +102,9 @@ subroutine read_param_file_access_actor(startGRU,num_gru,err) bind(C, name="read
integer(i4b) :: fHRU ! index of HRU in input file
integer(i4b) :: iGRU
integer(i4b) :: iHRU
+ integer(i4b) :: iVar
- err=0; message="read_param_all_hru.f90/"
-
-
+ err=0; message="read_param_all_hru.f90/"
! **********************************************************************************************
! * open files, etc.
! **********************************************************************************************
@@ -234,7 +279,7 @@ subroutine read_param_file_access_actor(startGRU,num_gru,err) bind(C, name="read
! get the basin parameters
else
- ! get the parameter index
+ ! get the parameter index
ixParam = get_ixbpar( trim(parName) )
! allow extra variables in the file that are not used
@@ -254,7 +299,7 @@ subroutine read_param_file_access_actor(startGRU,num_gru,err) bind(C, name="read
! populate parameter structures
do iGRU=1, num_gru
- outputStructure(1)%bparStruct(1)%gru(1)%var(ixParam) = parVector(iGRU+startGRU-1)
+ outputStructure(1)%bparStruct(1)%gru(iGRU)%var(ixParam) = parVector(iGRU+startGRU-1)
end do
! deallocate space for model parameters
diff --git a/build/source/driver/SummaActors_setup.f90 b/build/source/driver/SummaActors_setup.f90
index 7789608..52fbfe9 100755
--- a/build/source/driver/SummaActors_setup.f90
+++ b/build/source/driver/SummaActors_setup.f90
@@ -64,8 +64,8 @@ public::setupHRUParam
public::SOIL_VEG_GEN_PARM
contains
- ! initializes parameter data structures (e.g. vegetation and soil parameters).
- subroutine setupHRUParam(&
+! initializes parameter data structures (e.g. vegetation and soil parameters).
+subroutine setupHRUParam(&
indxHRU, & ! ID of hru
indxGRU, & ! Index of the parent GRU of the HRU
! primary data structures (scalars)
@@ -83,201 +83,229 @@ contains
! miscellaneous variables
upArea, & ! area upslope of each HRU,
err) bind(C, name='setupHRUParam')
- ! ---------------------------------------------------------------------------------------
- ! * desired modules
- ! ---------------------------------------------------------------------------------------
- USE nrtype ! variable types, etc.
- ! subroutines and functions
- use time_utils_module,only:elapsedSec ! calculate the elapsed time
- USE mDecisions_module,only:mDecisions ! module to read model decisions
- USE ffile_info_module,only:ffile_info ! module to read information on forcing datafile
- USE read_attribute_module,only:read_attribute ! module to read local attributes
- USE paramCheck_module,only:paramCheck ! module to check consistency of model parameters
- USE pOverwrite_module,only:pOverwrite ! module to overwrite default parameter values with info from the Noah tables
- USE read_param4chm_module,only:read_param ! module to read model parameter sets
- USE ConvE2Temp_module,only:E2T_lookup ! module to calculate a look-up table for the temperature-enthalpy conversion
- USE var_derive_module,only:fracFuture ! module to calculate the fraction of runoff in future time steps (time delay histogram)
- USE module_sf_noahmplsm,only:read_mp_veg_parameters ! module to read NOAH vegetation tables
- ! global data structures
- USE globalData,only:gru_struc ! gru-hru mapping structures
- USE globalData,only:localParFallback ! local column default parameters
- USE globalData,only:basinParFallback ! basin-average default parameters
- USE globalData,only:model_decisions ! model decision structure
- USE globalData,only:greenVegFrac_monthly ! fraction of green vegetation in each month (0-1)
- ! USE globalData,only:numtim ! number of time steps in the simulation
- ! run time options
- USE globalData,only:startGRU ! index of the starting GRU for parallelization run
- USE globalData,only:iRunMode ! define the current running mode
- ! output constraints
- USE globalData,only:maxLayers ! maximum number of layers
- USE globalData,only:maxSnowLayers ! maximum number of snow layers
- ! timing variables
- USE globalData,only:startSetup,endSetup ! date/time for the start and end of the parameter setup
- USE globalData,only:elapsedSetup ! elapsed time for the parameter setup
- ! Noah-MP parameters
- USE NOAHMP_VEG_PARAMETERS,only:SAIM,LAIM ! 2-d tables for stem area index and leaf area index (vegType,month)
- USE NOAHMP_VEG_PARAMETERS,only:HVT,HVB ! height at the top and bottom of vegetation (vegType)
-
- ! USE globalData,only:startTime
-
- ! ---------------------------------------------------------------------------------------
- ! * variables
- ! ---------------------------------------------------------------------------------------
- implicit none
- ! dummy variables
- ! calling variables
- integer(c_int),intent(in) :: indxGRU ! Index of the parent GRU of the HRU
- integer(c_int),intent(in) :: indxHRU ! ID to locate correct HRU from netcdf file
- type(c_ptr), intent(in), value :: handle_attrStruct ! local attributes for each HRU
- type(c_ptr), intent(in), value :: handle_typeStruct ! local classification of soil veg etc. for each HRU
- type(c_ptr), intent(in), value :: handle_idStruct !
- type(c_ptr), intent(in), value :: handle_mparStruct ! model parameters
- type(c_ptr), intent(in), value :: handle_bparStruct ! basin-average parameters
- type(c_ptr), intent(in), value :: handle_bvarStruct ! basin-average variables
- type(c_ptr), intent(in), value :: handle_dparStruct ! default model parameters
- type(c_ptr), intent(in), value :: handle_startTime ! start time for the model simulation
- type(c_ptr), intent(in), value :: handle_oldTime ! time for the previous model time step
- real(c_double),intent(inout) :: upArea
- integer(c_int),intent(inout) :: err
+ ! ---------------------------------------------------------------------------------------
+ ! * desired modules
+ ! ---------------------------------------------------------------------------------------
+ USE nrtype ! variable types, etc.
+ ! subroutines and functions
+ use time_utils_module,only:elapsedSec ! calculate the elapsed time
+ USE mDecisions_module,only:mDecisions ! module to read model decisions
+ USE ffile_info_module,only:ffile_info ! module to read information on forcing datafile
+ USE read_attribute_module,only:read_attribute ! module to read local attributes
+ USE paramCheck_module,only:paramCheck ! module to check consistency of model parameters
+ USE pOverwrite_module,only:pOverwrite ! module to overwrite default parameter values with info from the Noah tables
+ USE read_param4chm_module,only:read_param ! module to read model parameter sets
+ USE ConvE2Temp_module,only:E2T_lookup ! module to calculate a look-up table for the temperature-enthalpy conversion
+ USE var_derive_module,only:fracFuture ! module to calculate the fraction of runoff in future time steps (time delay histogram)
+ USE module_sf_noahmplsm,only:read_mp_veg_parameters ! module to read NOAH vegetation tables
+ ! global data structures
+ USE globalData,only:gru_struc ! gru-hru mapping structures
+ USE globalData,only:localParFallback ! local column default parameters
+ USE globalData,only:basinParFallback ! basin-average default parameters
+ USE globalData,only:model_decisions ! model decision structure
+ USE globalData,only:greenVegFrac_monthly ! fraction of green vegetation in each month (0-1)
+ ! USE globalData,only:numtim ! number of time steps in the simulation
+ ! run time options
+ USE globalData,only:startGRU ! index of the starting GRU for parallelization run
+ USE globalData,only:iRunMode ! define the current running mode
+ ! output constraints
+ USE globalData,only:maxLayers ! maximum number of layers
+ USE globalData,only:maxSnowLayers ! maximum number of snow layers
+ ! timing variables
+ USE globalData,only:startSetup,endSetup ! date/time for the start and end of the parameter setup
+ USE globalData,only:elapsedSetup ! elapsed time for the parameter setup
+ ! Noah-MP parameters
+ USE NOAHMP_VEG_PARAMETERS,only:SAIM,LAIM ! 2-d tables for stem area index and leaf area index (vegType,month)
+ USE NOAHMP_VEG_PARAMETERS,only:HVT,HVB ! height at the top and bottom of vegetation (vegType)
+
+ ! USE globalData,only:startTime
+
+ ! ---------------------------------------------------------------------------------------
+ ! * variables
+ ! ---------------------------------------------------------------------------------------
+ implicit none
+ ! dummy variables
+ ! calling variables
+ integer(c_int),intent(in) :: indxGRU ! Index of the parent GRU of the HRU
+ integer(c_int),intent(in) :: indxHRU ! ID to locate correct HRU from netcdf file
+ type(c_ptr), intent(in), value :: handle_attrStruct ! local attributes for each HRU
+ type(c_ptr), intent(in), value :: handle_typeStruct ! local classification of soil veg etc. for each HRU
+ type(c_ptr), intent(in), value :: handle_idStruct !
+ type(c_ptr), intent(in), value :: handle_mparStruct ! model parameters
+ type(c_ptr), intent(in), value :: handle_bparStruct ! basin-average parameters
+ type(c_ptr), intent(in), value :: handle_bvarStruct ! basin-average variables
+ type(c_ptr), intent(in), value :: handle_dparStruct ! default model parameters
+ type(c_ptr), intent(in), value :: handle_startTime ! start time for the model simulation
+ type(c_ptr), intent(in), value :: handle_oldTime ! time for the previous model time step
+ real(c_double),intent(inout) :: upArea
+ integer(c_int),intent(inout) :: err
- ! local variables
- type(var_d),pointer :: attrStruct ! local attributes for each HRU
- type(var_i),pointer :: typeStruct ! local classification of soil veg etc. for each HRU
- type(var_i8),pointer :: idStruct !
- type(var_dlength),pointer :: mparStruct ! model parameters
- type(var_d),pointer :: bparStruct ! basin-average parameters
- type(var_dlength),pointer :: bvarStruct ! basin-average variables
- type(var_d),pointer :: dparStruct ! default model parameters
- type(var_i),pointer :: startTime ! start time for the model simulation
- type(var_i),pointer :: oldTime ! time for the previous model time step
- character(len=256) :: message ! error message
- character(len=256) :: cmessage ! error message of downwind routine
- integer(i4b) :: iVar ! looping variables
- ! ---------------------------------------------------------------------------------------
- ! initialize error control
- err=0; message='setupHRUParam/'
- ! initialize the start of the initialization
- call date_and_time(values=startSetup)
-
- ! convert to fortran pointer from C++ pointer
- call c_f_pointer(handle_attrStruct, attrStruct)
- call c_f_pointer(handle_typeStruct, typeStruct)
- call c_f_pointer(handle_idStruct, idStruct)
- call c_f_pointer(handle_mparStruct, mparStruct)
- call c_f_pointer(handle_bparStruct, bparStruct)
- call c_f_pointer(handle_bvarStruct, bvarStruct)
- call c_f_pointer(handle_dparStruct, dparStruct)
- call c_f_pointer(handle_startTime, startTime)
- call c_f_pointer(handle_oldTime, oldTime)
-
- ! ffile_info and mDecisions moved to their own seperate subroutine call
-
- !numTimeSteps = numtim
- oldTime%var(:) = startTime%var(:)
-
- ! get the maximum number of snow layers
- select case(model_decisions(iLookDECISIONS%snowLayers)%iDecision)
- case(sameRulesAllLayers); maxSnowLayers = 100
- case(rulesDependLayerIndex); maxSnowLayers = 5
- case default; err=20; message=trim(message)//'unable to identify option to combine/sub-divide snow layers'; return
- end select ! (option to combine/sub-divide snow layers)
-
- ! get the maximum number of layers
- maxLayers = gru_struc(1)%hruInfo(1)%nSoil + maxSnowLayers
-
- ! *****************************************************************************
- ! *** read local attributes for each HRU
- ! *****************************************************************************
- call read_attribute(indxHRU,indxGRU,attrStruct,typeStruct,idStruct,err,cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
-
- ! define monthly fraction of green vegetation
- greenVegFrac_monthly = (/0.01_dp, 0.02_dp, 0.03_dp, 0.07_dp, 0.50_dp, 0.90_dp, 0.95_dp, 0.96_dp, 0.65_dp, 0.24_dp, 0.11_dp, 0.02_dp/)
-
- ! define urban vegetation category
- select case(trim(model_decisions(iLookDECISIONS%vegeParTbl)%cDecision))
- case('USGS'); urbanVegCategory = 1
- case('MODIFIED_IGBP_MODIS_NOAH'); urbanVegCategory = 13
- case('plumberCABLE'); urbanVegCategory = -999
- case('plumberCHTESSEL'); urbanVegCategory = -999
- case('plumberSUMMA'); urbanVegCategory = -999
- case default; message=trim(message)//'unable to identify vegetation category'; return
- end select
-
- ! set default model parameters
- ! set parmameters to their default value
- dparStruct%var(:) = localParFallback(:)%default_val ! x%var(:)
- ! overwrite default model parameters with information from the Noah-MP tables
- call pOverwrite(typeStruct%var(iLookTYPE%vegTypeIndex), & ! vegetation category
- typeStruct%var(iLookTYPE%soilTypeIndex), & ! soil category
- dparStruct%var, & ! default model parameters
- err,cmessage) ! error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+ ! local variables
+ type(var_d),pointer :: attrStruct ! local attributes for each HRU
+ type(var_i),pointer :: typeStruct ! local classification of soil veg etc. for each HRU
+ type(var_i8),pointer :: idStruct !
+ type(var_dlength),pointer :: mparStruct ! model parameters
+ type(var_d),pointer :: bparStruct ! basin-average parameters
+ type(var_dlength),pointer :: bvarStruct ! basin-average variables
+ type(var_d),pointer :: dparStruct ! default model parameters
+ type(var_i),pointer :: startTime ! start time for the model simulation
+ type(var_i),pointer :: oldTime ! time for the previous model time step
+ character(len=256) :: message ! error message
+ character(len=256) :: cmessage ! error message of downwind routine
+ integer(i4b) :: iVar ! looping variables
+ ! ---------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message='setupHRUParam/'
+ ! initialize the start of the initialization
+ call date_and_time(values=startSetup)
+
+ ! convert to fortran pointer from C++ pointer
+ call c_f_pointer(handle_attrStruct, attrStruct)
+ call c_f_pointer(handle_typeStruct, typeStruct)
+ call c_f_pointer(handle_idStruct, idStruct)
+ call c_f_pointer(handle_mparStruct, mparStruct)
+ call c_f_pointer(handle_bparStruct, bparStruct)
+ call c_f_pointer(handle_bvarStruct, bvarStruct)
+ call c_f_pointer(handle_dparStruct, dparStruct)
+ call c_f_pointer(handle_startTime, startTime)
+ call c_f_pointer(handle_oldTime, oldTime)
+
+ ! ffile_info and mDecisions moved to their own seperate subroutine call
+
+ !numTimeSteps = numtim
+ oldTime%var(:) = startTime%var(:)
+
+ ! get the maximum number of snow layers
+ select case(model_decisions(iLookDECISIONS%snowLayers)%iDecision)
+ case(sameRulesAllLayers); maxSnowLayers = 100
+ case(rulesDependLayerIndex); maxSnowLayers = 5
+ case default; err=20;
+ message=trim(message)//'unable to identify option to combine/sub-divide snow layers'
+ print*, message
+ return
+ end select ! (option to combine/sub-divide snow layers)
+
+ ! get the maximum number of layers
+ maxLayers = gru_struc(1)%hruInfo(1)%nSoil + maxSnowLayers
+
+ ! *****************************************************************************
+ ! *** read local attributes for each HRU
+ ! *****************************************************************************
+ call read_attribute(indxHRU,indxGRU,attrStruct,typeStruct,idStruct,err,cmessage)
+ if(err/=0)then
+ message=trim(message)//trim(cmessage)
+ print*, message
+ return
+ endif
+
+ ! define monthly fraction of green vegetation
+ greenVegFrac_monthly = (/0.01_dp, 0.02_dp, 0.03_dp, 0.07_dp, 0.50_dp, 0.90_dp, 0.95_dp, 0.96_dp, 0.65_dp, 0.24_dp, 0.11_dp, 0.02_dp/)
+
+ ! define urban vegetation category
+ select case(trim(model_decisions(iLookDECISIONS%vegeParTbl)%cDecision))
+ case('USGS'); urbanVegCategory = 1
+ case('MODIFIED_IGBP_MODIS_NOAH'); urbanVegCategory = 13
+ case('plumberCABLE'); urbanVegCategory = -999
+ case('plumberCHTESSEL'); urbanVegCategory = -999
+ case('plumberSUMMA'); urbanVegCategory = -999
+ case default
+ message=trim(message)//'unable to identify vegetation category'
+ print*, message
+ return
+ end select
+
+ ! set default model parameters
+ ! ! set parmameters to their default value
+ ! dparStruct%var(:) = localParFallback(:)%default_val ! x%var(:)
+ ! ! overwrite default model parameters with information from the Noah-MP tables
+ ! call pOverwrite(typeStruct%var(iLookTYPE%vegTypeIndex), & ! vegetation category
+ ! typeStruct%var(iLookTYPE%soilTypeIndex), & ! soil category
+ ! dparStruct%var, & ! default model parameters
+ ! err,cmessage) ! error control
+ ! if(err/=0)then
+ ! message=trim(message)//trim(cmessage)
+ ! print*, message
+ ! return
+ ! endif
- ! copy over to the parameter structure
- ! NOTE: constant for the dat(:) dimension (normally depth)
- do ivar=1,size(localParFallback)
- mparStruct%var(ivar)%dat(:) = dparStruct%var(ivar)
- end do ! looping through variables
+ ! ! copy over to the parameter structure
+ ! ! NOTE: constant for the dat(:) dimension (normally depth)
+ ! do ivar=1,size(localParFallback)
+ ! mparStruct%var(ivar)%dat(:) = dparStruct%var(ivar)
+ ! end do ! looping through variables
- ! set default for basin-average parameters
- bparStruct%var(:) = basinParFallback(:)%default_val
+ ! set default for basin-average parameters
+ ! bparStruct%var(:) = basinParFallback(:)%default_val ! moved to read_param
- ! *****************************************************************************
- ! *** read trial model parameter values for each HRU, and populate initial data structures
- ! *****************************************************************************
- call read_param(indxHRU,indxGRU,iRunMode,startGRU, &
- mparStruct,bparStruct,err,cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
- ! *****************************************************************************
- ! *** compute derived model variables that are pretty much constant for the basin as a whole
- ! *****************************************************************************
- ! calculate the fraction of runoff in future time steps
- call fracFuture(bparStruct%var, & ! vector of basin-average model parameters
- bvarStruct, & ! data structure of basin-average variables
- err,cmessage) ! error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
-
- ! check that the parameters are consistent
- call paramCheck(mparStruct,err,cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
-
- ! calculate a look-up table for the temperature-enthalpy conversion
- call E2T_lookup(mparStruct,err,cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
-
- ! overwrite the vegetation height
- HVT(typeStruct%var(iLookTYPE%vegTypeIndex)) = mparStruct%var(iLookPARAM%heightCanopyTop)%dat(1)
- HVB(typeStruct%var(iLookTYPE%vegTypeIndex)) = mparStruct%var(iLookPARAM%heightCanopyBottom)%dat(1)
-
- ! overwrite the tables for LAI and SAI
- if(model_decisions(iLookDECISIONS%LAI_method)%iDecision == specified)then
- SAIM(typeStruct%var(iLookTYPE%vegTypeIndex),:) = mparStruct%var(iLookPARAM%winterSAI)%dat(1)
- LAIM(typeStruct%var(iLookTYPE%vegTypeIndex),:) = mparStruct%var(iLookPARAM%summerLAI)%dat(1)*greenVegFrac_monthly
- endif
-
- ! compute total area of the upstream HRUS that flow into each HRU
- upArea = 0._dp
- ! Check if lateral flows exists within the HRU
- if(typeStruct%var(iLookTYPE%downHRUindex)==typeStruct%var(iLookID%hruId))then
- upArea = upArea + attrStruct%var(iLookATTR%HRUarea)
- endif
-
-
- ! identify the total basin area for a GRU (m2)
- associate(totalArea => bvarStruct%var(iLookBVAR%basin__totalArea)%dat(1) )
- totalArea = 0._dp
- totalArea = totalArea + attrStruct%var(iLookATTR%HRUarea)
- end associate
-
- ! identify the end of the initialization
- call date_and_time(values=endSetup)
-
- ! aggregate the elapsed time for the initialization
- elapsedSetup = elapsedSec(startSetup, endSetup)
-
- end subroutine setupHRUParam
+ ! *****************************************************************************
+ ! *** read trial model parameter values for each HRU, and populate initial data structures
+ ! *****************************************************************************
+ call read_param(indxHRU,indxGRU,mparStruct,bparStruct,dparStruct,err)
+ if(err/=0)then
+ message=trim(message)//trim(cmessage)
+ return
+ endif
+ ! *****************************************************************************
+ ! *** compute derived model variables that are pretty much constant for the basin as a whole
+ ! *****************************************************************************
+ ! calculate the fraction of runoff in future time steps
+ call fracFuture(bparStruct%var, & ! vector of basin-average model parameters
+ bvarStruct, & ! data structure of basin-average variables
+ err,cmessage) ! error control
+ if(err/=0)then
+ message=trim(message)//trim(cmessage)
+ print*, message
+ return
+ endif
+
+ ! check that the parameters are consistent
+ call paramCheck(mparStruct,err,cmessage)
+ if(err/=0)then
+ message=trim(message)//trim(cmessage)
+ print*, message
+ return
+ endif
+
+ ! calculate a look-up table for the temperature-enthalpy conversion
+ call E2T_lookup(mparStruct,err,cmessage)
+ if(err/=0)then
+ message=trim(message)//trim(cmessage)
+ print*, message
+ return
+ endif
+
+ ! overwrite the vegetation height
+ HVT(typeStruct%var(iLookTYPE%vegTypeIndex)) = mparStruct%var(iLookPARAM%heightCanopyTop)%dat(1)
+ HVB(typeStruct%var(iLookTYPE%vegTypeIndex)) = mparStruct%var(iLookPARAM%heightCanopyBottom)%dat(1)
+
+ ! overwrite the tables for LAI and SAI
+ if(model_decisions(iLookDECISIONS%LAI_method)%iDecision == specified)then
+ SAIM(typeStruct%var(iLookTYPE%vegTypeIndex),:) = mparStruct%var(iLookPARAM%winterSAI)%dat(1)
+ LAIM(typeStruct%var(iLookTYPE%vegTypeIndex),:) = mparStruct%var(iLookPARAM%summerLAI)%dat(1)*greenVegFrac_monthly
+ endif
+
+ ! compute total area of the upstream HRUS that flow into each HRU
+ upArea = 0._dp
+ ! Check if lateral flows exists within the HRU
+ if(typeStruct%var(iLookTYPE%downHRUindex)==typeStruct%var(iLookID%hruId))then
+ upArea = upArea + attrStruct%var(iLookATTR%HRUarea)
+ endif
+
+
+ ! identify the total basin area for a GRU (m2)
+ associate(totalArea => bvarStruct%var(iLookBVAR%basin__totalArea)%dat(1) )
+ totalArea = 0._dp
+ totalArea = totalArea + attrStruct%var(iLookATTR%HRUarea)
+ end associate
+
+ ! identify the end of the initialization
+ call date_and_time(values=endSetup)
+
+ ! aggregate the elapsed time for the initialization
+ elapsedSetup = elapsedSec(startSetup, endSetup)
+
+end subroutine setupHRUParam
! =================================================================================================
diff --git a/build/source/dshare/data_types.f90 b/build/source/dshare/data_types.f90
index 0cf403a..1d5d224 100755
--- a/build/source/dshare/data_types.f90
+++ b/build/source/dshare/data_types.f90
@@ -414,37 +414,39 @@ endtype var_time_ilength
type, public :: summa_output_type
-! define the statistics structures
-type(gru_hru_time_doubleVec),allocatable :: forcStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model forcing data
-type(gru_hru_time_doubleVec),allocatable :: progStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model prognostic (state) variables
-type(gru_hru_time_doubleVec),allocatable :: diagStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model diagnostic variables
-type(gru_hru_time_doubleVec),allocatable :: fluxStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model fluxes
-type(gru_hru_time_doubleVec),allocatable :: indxStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model indices
-type(gru_hru_time_doubleVec),allocatable :: bvarStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- basin-average variabl
-
-! define the primary data structures (scalars)
-type(gru_hru_time_int),allocatable :: timeStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:) -- model time data
-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_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
-type(gru_hru_doubleVec),allocatable :: mparStruct(:) ! x%gru(:)%hru(:)%var(:)%dat -- model parameters, DOES NOT CHANGE OVER TIMESTEPS TODO: MAYBE
-type(gru_hru_time_doubleVec),allocatable :: progStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model prognostic (state) variables
-type(gru_hru_time_doubleVec),allocatable :: diagStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model diagnostic variables
-type(gru_hru_time_doubleVec),allocatable :: fluxStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model fluxes
-
-! define the basin-average structures
-type(gru_double),allocatable :: bparStruct(:) ! x%gru(:)%var(:) -- basin-average parameters, DOES NOT CHANGE OVER TIMESTEPS
-type(gru_hru_time_doubleVec),allocatable :: bvarStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- basin-average variables
-
-! finalize stats structure
-type(gru_hru_time_flagVec),allocatable :: finalizeStats(:) ! x%gru(:)%hru(:)%tim(:)%dat -- flags on when to write to file
-
-integer(i4b) :: nTimeSteps
+ ! define the statistics structures
+ type(gru_hru_time_doubleVec),allocatable :: forcStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model forcing data
+ type(gru_hru_time_doubleVec),allocatable :: progStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model prognostic (state) variables
+ type(gru_hru_time_doubleVec),allocatable :: diagStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model diagnostic variables
+ type(gru_hru_time_doubleVec),allocatable :: fluxStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model fluxes
+ type(gru_hru_time_doubleVec),allocatable :: indxStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model indices
+ type(gru_hru_time_doubleVec),allocatable :: bvarStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- basin-average variabl
+
+ ! define the primary data structures (scalars)
+ type(gru_hru_time_int),allocatable :: timeStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:) -- model time data
+ 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_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
+ type(gru_hru_doubleVec),allocatable :: mparStruct(:) ! x%gru(:)%hru(:)%var(:)%dat -- model parameters, DOES NOT CHANGE OVER TIMESTEPS TODO: MAYBE
+ type(gru_hru_time_doubleVec),allocatable :: progStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model prognostic (state) variables
+ type(gru_hru_time_doubleVec),allocatable :: diagStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model diagnostic variables
+ type(gru_hru_time_doubleVec),allocatable :: fluxStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model fluxes
+
+ ! define the basin-average structures
+ type(gru_double),allocatable :: bparStruct(:) ! x%gru(:)%var(:) -- basin-average parameters, DOES NOT CHANGE OVER TIMESTEPS
+ type(gru_hru_time_doubleVec),allocatable :: bvarStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- basin-average variables
+
+ ! define the ancillary data structures
+ type(gru_hru_double),allocatable :: dparStruct(:) ! x%gru(:)%hru(:)%var(:)
+
+ ! finalize stats structure
+ type(gru_hru_time_flagVec),allocatable :: finalizeStats(:) ! x%gru(:)%hru(:)%tim(:)%dat -- flags on when to write to file
+
+ integer(i4b) :: nTimeSteps
end type summa_output_type
END MODULE data_types
diff --git a/build/source/dshare/globalData.f90 b/build/source/dshare/globalData.f90
index eb26ac3..b1dc1ee 100755
--- a/build/source/dshare/globalData.f90
+++ b/build/source/dshare/globalData.f90
@@ -150,7 +150,7 @@ MODULE globalData
! define summary information on all data structures
integer(i4b),parameter :: nStruct=13 ! number of data structures
type(struct_info),parameter,public,dimension(nStruct) :: structInfo=(/&
- struct_info('time', 'TIME' , maxvarTime ), & ! the time data structure
+ struct_info('time', 'TIME' , maxvarTime ), & ! the time data structure
struct_info('forc', 'FORCE', maxvarForc ), & ! the forcing data structure
struct_info('attr', 'ATTR' , maxvarAttr ), & ! the attribute data structure
struct_info('type', 'TYPE' , maxvarType ), & ! the type data structure
diff --git a/build/source/engine/read_paramActors.f90 b/build/source/engine/read_paramActors.f90
index 93f4a95..661ffe6 100755
--- a/build/source/engine/read_paramActors.f90
+++ b/build/source/engine/read_paramActors.f90
@@ -48,291 +48,42 @@ contains
! ************************************************************************************************
! public subroutine read_param4chm: read trial model parameter values
! ************************************************************************************************
-subroutine read_param(indxHRU,indxGRU,iRunMode,startGRU,mparStruct,bparStruct,err,message)
- ! used to read model initial conditions
- USE summaActors_FileManager,only:SETTINGS_PATH ! path for metadata files
- USE summaActors_FileManager,only:PARAMETER_TRIAL ! file with parameter trial values
- USE get_ixname_module,only:get_ixparam,get_ixbpar ! access function to find index of elements in structure
- USE globalData,only:index_map,gru_struc ! mapping from global HRUs to the elements in the data structures
- USE var_lookup,only:iLookPARAM,iLookTYPE,iLookID ! named variables to index elements of the data vectors
+subroutine read_param(indxHRU,indxGRU,mparStruct,bparStruct,dparStruct,err)
+ USE globalData,only:outputStructure
+ USE globalData,only:mpar_meta,bpar_meta
+ USE globalData,only:localParFallback ! local column default parameters
+
implicit none
! define input
integer(i4b),intent(in) :: indxHRU
integer(i4b),intent(in) :: indxGRU
- integer(i4b),intent(in) :: iRunMode ! run mode
- integer(i4b),intent(in) :: startGRU ! index of single GRU if runMode = startGRU
- ! type(var_i8),intent(in) :: idStruct ! local labels for hru and gru IDs
! define output
type(var_dlength),intent(inout) :: mparStruct ! model parameters
type(var_d),intent(inout) :: bparStruct ! basin parameters
+ type(var_d),intent(inout) :: dparStruct ! default model parameters
integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! define local variables
- character(len=1024) :: cmessage ! error message for downwind routine
- character(LEN=1024) :: infile ! input filename
- integer(i4b) :: localHRU_ix ! index of HRU within data structure
- integer(i4b) :: ixParam ! index of the model parameter in the data structure
- ! indices/metadata in the NetCDF file
- integer(i4b) :: ncid ! netcdf id
- integer(i4b) :: nDims ! number of dimensions
- integer(i4b) :: nVars ! number of variables
- integer(i4b) :: idimid ! dimension index
- integer(i4b) :: ivarid ! variable index
- character(LEN=64) :: dimName ! dimension name
- character(LEN=64) :: parName ! parameter name
- integer(i4b) :: dimLength ! dimension length
- integer(i4b) :: nHRU_file ! number of HRUs in the parafile
- integer(i4b) :: nGRU_file ! number of GRUs in the parafile
- integer(i4b) :: nSoil_file ! number of soil layers in the file
- integer(i4b) :: idim_list(2) ! list of dimension ids
- ! data in the netcdf file
- integer(i4b) :: parLength ! length of the parameter data
- integer(8),allocatable :: hruId(:) ! HRU identifier in the file
- real(dp),allocatable :: parVector(:) ! model parameter vector
- logical :: fexist ! inquire whether the parmTrial file exists
- integer(i4b) :: fHRU ! index of HRU in input file
+ !
+ character(len=256) :: message ! error message
+ integer(i4b) :: iVar !
! Start procedure here
- err=0; message="read_param4chm/"
-
- ! **********************************************************************************************
- ! * open files, etc.
- ! **********************************************************************************************
-
- ! build filename
- infile = trim(SETTINGS_PATH)//trim(PARAMETER_TRIAL)
-
- ! check whether the user-specified file exists and warn if it does not
- inquire(file=trim(infile),exist=fexist)
- if (.not.fexist) then
- write(*,'(A)') NEW_LINE('A')//'!! WARNING: trial parameter file not found; proceeding instead with other default parameters; check path in file manager input if this was not the desired behavior'//NEW_LINE('A')
- return
- endif
-
- ! open trial parameters file if it exists
- call nc_file_open(trim(infile),nf90_nowrite,ncid,err,cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
-
- ! get the number of variables in the parameter file
- err=nf90_inquire(ncid, nDimensions=nDims, nVariables=nVars)
- call netcdf_err(err,message); if (err/=0) then; err=20; return; end if
-
- ! initialize the number of HRUs
- nHRU_file=integerMissing
- nGRU_file=integerMissing
-
- ! get the length of the dimensions
- do idimid=1,nDims
- ! get the dimension name and length
- err=nf90_inquire_dimension(ncid, idimid, name=dimName, len=dimLength)
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
- ! get the number of HRUs
- if(trim(dimName)=='hru') nHRU_file=dimLength
- if(trim(dimName)=='gru') nGRU_file=dimLength
+ err=0; message="read_paramActors.f90/"
+ ! do iVar=1, size(mpar_meta)
+ dparStruct%var(:) = outputStructure(1)%dparStruct(1)%gru(indxGRU)%hru(indxHRU)%var(:)
+ ! end do
+
+ ! do iVar=1, size(localParFallback)
+ ! mparStruct%var(iVar)%dat(:) = dparStruct%var(iVar)
+ ! end do
+
+ ! populate parameter structures
+ do iVar=1, size(mpar_meta)
+ mparStruct%var(iVar)%dat(:) = outputStructure(1)%mparStruct(1)%gru(indxGRU)%hru(indxHRU)%var(iVar)%dat(:)
end do
- ! allocate hruID vector
- allocate(hruId(nHRU_file))
-
- ! check HRU dimension exists
- if(nHRU_file==integerMissing)then
- message=trim(message)//'unable to identify HRU dimension in file '//trim(infile)
- err=20; return
- endif
-
-
- ! **********************************************************************************************
- ! * read the HRU index
- ! **********************************************************************************************
- ! loop through the parameters in the NetCDF file
- do ivarid=1,nVars
-
- ! get the parameter name
- err=nf90_inquire_variable(ncid, ivarid, name=parName)
- call netcdf_err(err,message); if (err/=0) then; err=20; return; end if
-
- ! special case of the HRU id
- if(trim(parName)=='hruIndex' .or. trim(parName)=='hruId')then
-
- ! read HRUs
- err=nf90_get_var(ncid, ivarid, hruId)
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
-
- ! check HRUs -- expect HRUs to be in the same order as the local attributes
- ! if (iRunMode==iRunModeFull) then
- ! !iGRU=index_map(indxHRU)%gru_ix
- ! localHRU_ix=index_map(indxHRU)%localHRU_ix
- ! if((hruId(indxHRU)>0).and.(hruId(indxHRU)/=idStruct%var(iLookID%hruId)))then
- ! write(message,'(a,i0,a,i0,a)') trim(message)//'mismatch for HRU ', idStruct%var(iLookID%hruId), '(param HRU = ', hruId(indxHRU), ')'
- ! err=20; return
- ! endif
-
- ! else if (iRunMode==iRunModeGRU) then
- ! ! do iHRU=1,nHRU
- ! !iGRU=index_map(indxHRU)%gru_ix
- ! localHRU_ix=index_map(indxHRU)%localHRU_ix
- ! fHRU = gru_struc(indxGRU)%hruInfo(localHRU_ix)%hru_nc
- ! if(hruId(fHRU)/=idStruct%var(iLookID%hruId))then
- ! write(message,'(a,i0,a,i0,a)') trim(message)//'mismatch for HRU ', idStruct%var(iLookID%hruId), '(param HRU = ', hruId(indxHRU), ')'
- ! err=20; return
- ! endif
- ! ! enddo
-
- ! else if (iRunMode==iRunModeHRU) then
- ! !iGRU=index_map(1)%gru_ix
- ! localHRU_ix=index_map(indxHRU)%localHRU_ix
- ! if(hruId(checkHRU)/=idStruct%var(iLookID%hruId))then
- ! write(message,'(a,i0,a,i0,a)') trim(message)//'mismatch for HRU ', idStruct%var(iLookID%hruId), '(param HRU = ', hruId(indxHRU), ')'
- ! err=20; return
- ! endif
-
- ! error check
- ! else
- ! err = 20; message = 'run mode not recognized'; return;
- ! end if
-
- endif ! if the HRU id
-
- end do ! looping through variables in the file
-
- ! **********************************************************************************************
- ! * read the local parameters and the basin parameters
- ! **********************************************************************************************
-
- ! loop through the parameters in the NetCDF file
- do ivarid=1,nVars
-
- ! get the parameter name
- err=nf90_inquire_variable(ncid, ivarid, name=parName)
- call netcdf_err(err,message); if (err/=0) then; err=20; return; end if
-
- ! get the local parameters
- ixParam = get_ixparam( trim(parName) )
- if(ixParam/=integerMissing)then
-
- ! **********************************************************************************************
- ! * read the local parameters
- ! **********************************************************************************************
-
- ! get the variable shape
- err=nf90_inquire_variable(ncid, ivarid, nDims=nDims, dimids=idim_list)
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
-
- ! get the length of the depth dimension (if it exists)
- if(nDims==2)then
-
- ! get the information on the 2nd dimension for 2-d variables
- err=nf90_inquire_dimension(ncid, idim_list(2), dimName, nSoil_file)
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
-
- ! check that it is the depth dimension
- if(trim(dimName)/='depth')then
- message=trim(message)//'expect 2nd dimension of 2-d variable to be depth (dimension name = '//trim(dimName)//')'
- err=20; return
- endif
-
- ! check that the dimension length is correct
- if(size(mparStruct%var(ixParam)%dat) /= nSoil_file)then
- message=trim(message)//'unexpected number of soil layers in parameter file'
- err=20; return
- endif
-
- ! define parameter length
- parLength = nSoil_file
-
- else
- parLength = 1
- endif ! if two dimensions
-
- ! allocate space for model parameters
- allocate(parVector(parLength),stat=err)
- if(err/=0)then
- message=trim(message)//'problem allocating space for parameter vector'
- err=20; return
- endif
-
- ! map to the GRUs and HRUs
- !iGRU=index_map(indxHRU)%gru_ix
- localHRU_ix=index_map(indxHRU)%localHRU_ix
- fHRU = gru_struc(indxGRU)%hruInfo(localHRU_ix)%hru_nc
-
- ! read parameter data
- select case(nDims)
- case(1); err=nf90_get_var(ncid, ivarid, parVector, start=(/fHRU/), count=(/1/) )
- case(2); err=nf90_get_var(ncid, ivarid, parVector, start=(/fHRU,1/), count=(/1,nSoil_file/) )
- case default; err=20; message=trim(message)//'unexpected number of dimensions for parameter '//trim(parName)
- end select
-
- ! error check for the parameter read
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
-
- ! populate parameter structures
- select case(nDims)
- case(1); mparStruct%var(ixParam)%dat(:) = parVector(1) ! also distributes scalar across depth dimension
- case(2); mparStruct%var(ixParam)%dat(:) = parVector(:)
- case default; err=20; message=trim(message)//'unexpected number of dimensions for parameter '//trim(parName)
- end select
-
- ! end do ! looping through HRUs
-
- ! deallocate space for model parameters
- deallocate(parVector,stat=err)
- if(err/=0)then
- message=trim(message)//'problem deallocating space for parameter vector'
- err=20; return
- endif
-
- ! **********************************************************************************************
- ! * read the basin parameters
- ! **********************************************************************************************
-
- ! get the basin parameters
- else
-
- ! get the parameter index
- ixParam = get_ixbpar( trim(parName) )
-
- ! allow extra variables in the file that are not used
- if(ixParam==integerMissing) cycle
-
- ! allocate space for model parameters
- allocate(parVector(nGRU_file),stat=err)
- if(err/=0)then
- message=trim(message)//'problem allocating space for parameter vector'
- err=20; return
- endif
-
- ! read parameter data
- err=nf90_get_var(ncid, ivarid, parVector )
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
-
- ! populate parameter structures
- if (iRunMode==iRunModeGRU) then
- !do iGRU=1,nGRU
- bparStruct%var(ixParam) = parVector(indxGRU+startGRU-1)
- !end do ! looping through GRUs
- else if (iRunMode==iRunModeFull) then
- !do iGRU=1,nGRU
- bparStruct%var(ixParam) = parVector(indxGRU)
- !end do ! looping through GRUs
- else if (iRunMode==iRunModeHRU) then
- err = 20; message='checkHRU run mode not working'; return;
- endif
-
- ! deallocate space for model parameters
- deallocate(parVector,stat=err)
- if(err/=0)then
- message=trim(message)//'problem deallocating space for parameter vector'
- err=20; return
- endif
-
- endif ! reading the basin parameters
-
- end do ! (looping through the parameters in the NetCDF file)
-
- ! Now we must close the netcdf file
- call nc_file_close(ncid,err,message)
- if(err/=0)then;message=trim(message)//trim(cmessage);return;end if
+ do iVar=1, size(bpar_meta)
+ bparStruct%var(iVar) = outputStructure(1)%bparStruct(1)%gru(indxGRU)%var(iVar)
+ end do
end subroutine read_param
diff --git a/utils/laugh_tests/celia1990/verification_data/runinfo.txt b/utils/laugh_tests/celia1990/verification_data/runinfo.txt
index 35a4527..574fdb5 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=24 - hh=02 - mi=58 - ss=32.515
+ Run start time on system: ccyy=2022 - mm=08 - dd=26 - hh=18 - mi=33 - ss=52.626
diff --git a/utils/laugh_tests/celia1990/verification_data/summa_celia1990_G1-1_timestep.nc b/utils/laugh_tests/celia1990/verification_data/summa_celia1990_G1-1_timestep.nc
index e1319892d362595775ea3f6668ad8dd00667cf1e..cd79685a54999fab4f36ba2dc1327cbe8781f026 100644
GIT binary patch
delta 587
zcmWm8+fs}H007{TKk0}z6>2Su9HLsvwvo<Gp$HuuDk_zdr6dxq#sf6tR*zuD1$SLE
zV`gW1i{8PtuZ!>gTmSn#Sm$SHIM~|U==@a{{ucy)vhsec7Dv}Y9m(-X^Xyn8Ru`#>
zC#vI#+E^+b{g#gIAcLI*WU`Aac9TsGx#W>g0ejfXJ_-p@#D0n?p_Bt0<Pc?)6Xq}x
zj&PLi%Q22~f(lM@iqo8-lCzwnifU?zah?m*QpZK&)RUlrOI)UrD>Tte3$3)#P6t=H
z#&vFRlTL1Nn>%#T&0X%%!+jp`kY4)eXMjgM<_S+3WQbv&@thGx8RG@xOfbnyrkLgx
mGrT6r8{RU@9PgOtJqvu`Ba3`uiO+mtnG|1tr=u%#OaB4C!}pH>
delta 587
zcmWm8NmtAP008h;{adsMt!j*6NK|T4MuW&!Xd$6xN<|x~v|3wK&j;|Hvyb3C2gh#S
zn~&q-+^@s${@eTeBiQ3tc{rF(A8G#`3jYs+e`U$!_tNOkqOSS5NZZO(B-R{hXiPM<
zBx3RHRP<XannpSq1Z0v$HaQ$3mpt+*;4p<8;V8!_qL>m&DWja@R8UEX6NEWQgj1a6
z;BtnuRB?`K&U1kpYN_KQ^)wKpkxMku%w^(Sp@jrjxyE%`xxr1^xW#SmaF=_u)4_cn
z@Q_Zr=%$B9Jf@c?^zoEuJg1)l1{osBFeAKRlrhG6$txz9WQu8Kc+DGTdCMI0Ebxv+
imRM$mRn~aV2R`zN&wOE>4K~^0E8Fb+Nkw;8H}(O<7xp{=
--
GitLab