diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
deleted file mode 100644
index 2175fbf0f2ec3b99f397c11fc977a32d5499e94d..0000000000000000000000000000000000000000
--- a/.gitlab-ci.yml
+++ /dev/null
@@ -1,15 +0,0 @@
-# Define the stages of the CI pipeline
-stages:
- - build
- - test
-
-# Define the build job
-build:
- stage: build
- script:
- - echo "Building program"
- - cd build/cmake
- - mkdir build
- - cd build
- - cmake ..
- - make
\ No newline at end of file
diff --git a/build/includes/file_access_actor/file_access_actor.hpp b/build/includes/file_access_actor/file_access_actor.hpp
index 7bffc19830faec90e1566500b9928ade4ac3f969..7a4e21cfc46599cf9c5a8df87ab3c22dee24a377 100644
--- a/build/includes/file_access_actor/file_access_actor.hpp
+++ b/build/includes/file_access_actor/file_access_actor.hpp
@@ -21,6 +21,8 @@ struct netcdf_gru_actor_info {
int state_var_id; // The success of the GRU 1 = pass, 0 = fail
int num_attempts_var_id;
+ int rel_tol_var_id;
+ int abs_tol_var_id;
};
@@ -92,20 +94,12 @@ struct file_access_state {
behavior file_access_actor(stateful_actor<file_access_state>* self, int startGRU, int numGRU,
File_Access_Actor_Settings file_access_actor_settings, actor parent);
-// Call Fortran functions that require file access and intialize the ffile_info structure
-void initalizeFileAccessActor(stateful_actor<file_access_state>* self);
-
-// Read in the attributes for all HRUs that are in the run-domain
-void readAttributes(stateful_actor<file_access_state>* self);
-
-// read in the parameters for all HRUs that are in the run-domain
-void readParameters(stateful_actor<file_access_state>* self);
-
-// Read in the inital conditions for all the HRUs that are in the run-domain
-void readInitConditions(stateful_actor<file_access_state>* self);
void initalizeOutputHandles(stateful_actor<file_access_state>* self);
+/* Setup and call the fortran routine that writes the output */
+void writeOutput(stateful_actor<file_access_state>* self, Output_Partition* partition);
+
void deallocateOutputHandles(stateful_actor<file_access_state>* self);
} // end namespace
\ No newline at end of file
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 d4240f270aea69cc23a19f623efe62215ce1f776..002e4c97cb8de6ea6f787fd6d0ea2364866c29ff 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
@@ -3,47 +3,20 @@
extern "C" {
// initalizeFileAccessActor
- void ffile_info(int* indxGRU, void* forcFileInfo, int* numFiles, int* err);
- void mDecisions_C(int* numSteps, int* err);
- void read_pinit_C(int* err);
- void read_vegitationTables(int* err);
- void initFailedHRUTracker(int* numGRU);
- void def_output(void* handle_ncid, int* startGRU, int* numGRU, int* numHRU,
- netcdf_gru_actor_info* actor_info, int* err);
+ void fileAccessActor_init_fortran(void* handle_forcing_file_info,
+ int* num_forcing_files,
+ int* num_timesteps,
+ int* num_timesteps_output_buffer,
+ void* handle_output_ncid,
+ int* startGRU,
+ int* numGRU,
+ int* numHRU,
+ netcdf_gru_actor_info* actor_info,
+ int* err);
// OutputStructure and Output functions
- void initOutputStructure(void* handle_forcFileInfo, int* max_steps, int* numGRU, int* err);
void deallocateOutputStructure(int* err);
- void writeOutput(void* handle_ncid, int* num_steps, int* start_gru, int* max_gru, int* err);
- void initOutputTimeStep(int* num_gru, int* err);
-
- // Attributes Files- called inside initalizeFileAccessActor
- void allocateAttributeStructures(int* index_gru, int* index_hru, void* handle_attr_struct,
- void* handle_type_struct, void* handle_id_struct, int* err);
- void openAttributeFile(int* att_ncid, int* err);
- void getNumVarAttr(int* attr_ncid, int* num_var_attr, int* err);
- void closeAttributeFile(int* attr_ncid, int* err);
- void readAttributeFromNetCDF(int* attr_ncid, int* index_gru, int* index_hru, int* num_var,
- void* attr_array, void* type_array, void* id_array, int* err);
-
- // Parameters File - called inside initalizeFileAccessActor
- void allocateParamStructures(int* index_gru, int* index_hru, void* handle_dpar_struct,
- void* handle_mpar_struct, void* handle_bpar_struct, int* err);
- void openParamFile(int* param_ncid, bool* param_file_exists, int* err);
- void getNumVarParam(int* param_ncid, int* num_var_param, int* err);
- void closeParamFile(int* param_ncid, int* err);
- void getParamSizes(int* dpar_array_size, int* bpar_array_size, int* type_array_size);
- void overwriteParam(int* index_gru, int* index_hru,
- void* handle_type_struct, void* handle_dpar_struct, void* handle_mpar_struct,
- void* handle_bpar_struct, int* err);
- void readParamFromNetCDF(int* param_ncid, int* index_gru, int* index_hru, int* start_index_gru,
- int* num_var_param, void* handle_mpar_struct, void* _handle_bpar_struct, int* err);
-
- // Set up global initial conditions
- void openInitCondFile(int* init_cond_ncid, int* err);
- void closeInitCondFile(int* init_cond_ncid, int* err);
- void readInitCond_prog(int* init_cond_ncid, int* start_gru, int* num_gru, int* err);
- void readInitCond_bvar(int* init_cond_ncid, int* start_gru, int* num_gru, int* err);
+ void writeOutput_fortran(void* handle_ncid, int* num_steps, int* start_gru, int* max_gru, int* err);
void updateFailed(int* indxHRU);
diff --git a/build/includes/global/global.hpp b/build/includes/global/global.hpp
index 4730894760407f87809ef64543ac5ce299d95ea8..c5ac1a0be125b03bd2b2dc87fe4933a304e25875 100644
--- a/build/includes/global/global.hpp
+++ b/build/includes/global/global.hpp
@@ -17,6 +17,9 @@ struct serializable_netcdf_gru_actor_info {
int successful; // 0 = false, 1 = true
int num_attempts;
+
+ double rel_tol;
+ double abs_tol;
};
template<class Inspector>
@@ -27,7 +30,9 @@ bool inspect(Inspector& f, serializable_netcdf_gru_actor_info& x) {
f.field("run_physics_duration", x.run_physics_duration),
f.field("write_output_duration", x.write_output_duration),
f.field("successful", x.successful),
- f.field("num_attempts", x.num_attempts));
+ f.field("num_attempts", x.num_attempts),
+ f.field("rel_tol", x.rel_tol),
+ f.field("abs_tol", x.abs_tol));
}
diff --git a/build/includes/global/message_atoms.hpp b/build/includes/global/message_atoms.hpp
index 7306095c077fbb3098adac1b822673a52bba0172..aa5cd4dc50a8cbf801d342f7743ea46ca012a040 100644
--- a/build/includes/global/message_atoms.hpp
+++ b/build/includes/global/message_atoms.hpp
@@ -16,6 +16,7 @@ enum class hru_error : uint8_t {
enum class file_access_error : uint8_t {
writing_error = 1,
+ unhandleable_error = 2,
};
// HRU Errors
@@ -76,18 +77,6 @@ CAF_BEGIN_TYPE_ID_BLOCK(summa, first_custom_type_id)
// Sender:
// Reciever:
// Summary:
- CAF_ADD_ATOM(summa, done_file_access_actor_init)
- // Sender:
- // Reciever:
- // Summary:
- CAF_ADD_ATOM(summa, file_access_actor_done)
- // Sender:
- // Reciever:
- // Summary:
- CAF_ADD_ATOM(summa, file_access_actor_err)
- // Sender:
- // Reciever:
- // Summary:
CAF_ADD_ATOM(summa, access_forcing)
// Sender:
// Reciever:
@@ -193,6 +182,10 @@ CAF_BEGIN_TYPE_ID_BLOCK(summa, first_custom_type_id)
// Reciever:
// Summary:
CAF_ADD_ATOM(summa, get_num_output_steps)
+ // Sender:
+ // Reciever:
+ // Summary:
+ CAF_ADD_ATOM(summa, finalize)
// Struct Types
CAF_ADD_TYPE_ID(summa, (Distributed_Settings))
@@ -216,6 +209,17 @@ CAF_BEGIN_TYPE_ID_BLOCK(summa, first_custom_type_id)
CAF_ADD_TYPE_ID(summa, (std::vector<std::tuple<caf::actor, std::string>>))
CAF_ADD_TYPE_ID(summa, (std::vector<serializable_netcdf_gru_actor_info>))
+ // GRU Parameter/Attribute Vectors
+ CAF_ADD_TYPE_ID(summa, (std::tuple<std::vector<double>,
+ std::vector<int>,
+ std::vector<long int>,
+ std::vector<double>,
+ std::vector<double>,
+ std::vector<std::vector<double>>>))
+
+ // File_Access_Actor Read/Write times
+ CAF_ADD_TYPE_ID(summa, (std::tuple<double, double>))
+
CAF_ADD_TYPE_ID(summa, (std::optional<caf::strong_actor_ptr>))
// error types
diff --git a/build/includes/global/settings_functions.hpp b/build/includes/global/settings_functions.hpp
index 706b7cfb383972b7b1931bf25877030a667b7e9e..1b9f05ae87148791650a9a784ea124f609a528f3 100644
--- a/build/includes/global/settings_functions.hpp
+++ b/build/includes/global/settings_functions.hpp
@@ -96,13 +96,29 @@ bool inspect(Inspector& inspector, Job_Actor_Settings& job_actor_settings) {
Job_Actor_Settings readJobActorSettings(std::string json_settings_file);
// ####################################################################
-// SUMMA Actor Settings
+// HRU Actor Settings
// ####################################################################
struct HRU_Actor_Settings {
bool print_output;
int output_frequency;
int dt_init_factor; // factor to multiply the initial timestep by
+ double rel_tol;
+ double abs_tol;
+ double relTolTempCas;
+ double absTolTempCas;
+ double relTolTempVeg;
+ double absTolTempVeg;
+ double relTolWatVeg;
+ double absTolWatVeg;
+ double relTolTempSoilSnow;
+ double absTolTempSoilSnow;
+ double relTolWatSnow;
+ double absTolWatSnow;
+ double relTolMatric;
+ double absTolMatric;
+ double relTolAquifr;
+ double absTolAquifr;
};
template<class Inspector>
@@ -110,7 +126,9 @@ bool inspect(Inspector& inspector, HRU_Actor_Settings& hru_actor_settings) {
return inspector.object(hru_actor_settings).fields(
inspector.field("print_output", hru_actor_settings.print_output),
inspector.field("output_frequency", hru_actor_settings.output_frequency),
- inspector.field("dt_init_factor", hru_actor_settings.dt_init_factor));
+ inspector.field("dt_init_factor", hru_actor_settings.dt_init_factor),
+ inspector.field("rel_tol", hru_actor_settings.rel_tol),
+ inspector.field("abs_tol", hru_actor_settings.abs_tol));
}
HRU_Actor_Settings readHRUActorSettings(std::string json_settings_file);
diff --git a/build/includes/global/timing_info.hpp b/build/includes/global/timing_info.hpp
index e246a6ca2593eacf94254e8306ebc62354b379da..9244428facaf9cfd19218ef53e7552d651b3a399 100644
--- a/build/includes/global/timing_info.hpp
+++ b/build/includes/global/timing_info.hpp
@@ -2,6 +2,7 @@
#include <chrono>
#include <optional>
#include <vector>
+#include <string>
using chrono_time = std::chrono::time_point<std::chrono::system_clock>;
/**
diff --git a/build/includes/hru_actor/hru_actor_subroutine_wrappers.hpp b/build/includes/hru_actor/hru_actor_subroutine_wrappers.hpp
index df1dab9b323fe50ebef3de6f7c4e006eae48af90..5a1656efb72b766a563b0cb62ce663691eb231d0 100644
--- a/build/includes/hru_actor/hru_actor_subroutine_wrappers.hpp
+++ b/build/includes/hru_actor/hru_actor_subroutine_wrappers.hpp
@@ -7,11 +7,13 @@ extern "C" {
// Statistics Structures
void* forcStat, void* progStat, void* diagStat, void* fluxStat, void* indxStat, void* bvarStat,
// Primary Data Structures (scalars)
- void* timeStruct, void* forcStruct,
+ void* timeStruct, void* forcStruct, void* attrStruct, void* typeStruct, void* idStruct,
// primary data structures (variable length vectors)
- void* indxStruct, void* progStruct, void* diagStruct, void* fluxStruct,
+ void* indxStruct, void* mparStruct, void* progStruct, void* diagStruct, void* fluxStruct,
// basin-average structures
- void* bvarStruct,
+ void* bvarStruct, void* bparStruct,
+ // ancillary data structures
+ void* dparStruct,
// local HRU data
void* startTime, void* finshTime, void* refTime, void* oldTime, int* err);
@@ -23,7 +25,7 @@ extern "C" {
// primary data structures (scalars)
void* attrStruct, void* typeStruct, void* idStruct,
// primary data structures (variable length vectors)
- void* mparStruct, void* bparStruct, void* bvarStruct, void* dparStruct,
+ void* indexStruct, void* mparStruct, void* progStruct, void* bparStruct, void* bvarStruct, void* dparStruct,
// lookup tables
void* lookupStruct,
// local HRU data
@@ -88,5 +90,20 @@ extern "C" {
void computeTimeForcingHRU(void* handle_timeStruct, void* handle_forcStruct, double* fracJulDay,
int* yearLength, int* err);
+ void setIDATolerances(void* handle_mparStruct,
+ double* relTolTempCas,
+ double* absTolTempCas,
+ double* relTolTempVeg,
+ double* absTolTempVeg,
+ double* relTolWatVeg,
+ double* absTolWatVeg,
+ double* relTolTempSoilSnow,
+ double* absTolTempSoilSnow,
+ double* relTolWatSnow,
+ double* absTolWatSnow,
+ double* relTolMatric,
+ double* absTolMatric,
+ double* relTolAquifr,
+ double* absTolAquifr);
}
\ No newline at end of file
diff --git a/build/includes/job_actor/GRU.hpp b/build/includes/job_actor/GRU.hpp
index 8123f21d9627e4f52a6fd6947e72940f8541b96d..3c33f51d0afd520b43a230c2fd370f3f7a846959 100644
--- a/build/includes/job_actor/GRU.hpp
+++ b/build/includes/job_actor/GRU.hpp
@@ -13,9 +13,7 @@ enum class gru_state {
succeeded
};
-auto success = [](const gru_state& state) -> int {
- return(state == gru_state::succeeded) ? 1 : 0;
-};
+int is_success(const gru_state& state);
/**
* Class that holds information about the running GRUs. This class is held by the job actor
@@ -29,6 +27,8 @@ class GRU {
// Modifyable Parameters
int dt_init_factor; // The initial dt for the GRU
+ double rel_tol; // The relative tolerance for the GRU
+ double abs_tol; // The absolute tolerance for the GRU
// Status Information
int attempts_left; // The number of attempts left for the GRU to succeed
@@ -44,7 +44,8 @@ class GRU {
public:
// Constructor
- GRU(int global_gru_index, int local_gru_index, caf::actor gru_actor, int dt_init_factor, int max_attempts);
+ GRU(int global_gru_index, int local_gru_index, caf::actor gru_actor, int dt_init_factor,
+ double rel_tol, double abs_tol, int max_attempts);
// Deconstructor
~GRU();
@@ -60,12 +61,16 @@ class GRU {
double getRunPhysicsDuration();
double getWriteOutputDuration();
+ double getRelTol();
+ double getAbsTol();
+
double getAttemptsLeft();
gru_state getStatus();
bool isFailed();
+
// Setters
void setRunTime(double run_time);
void setInitDuration(double init_duration);
@@ -73,6 +78,9 @@ class GRU {
void setRunPhysicsDuration(double run_physics_duration);
void setWriteOutputDuration(double write_output_duration);
+ void setRelTol(double rel_tol);
+ void setAbsTol(double abs_tol);
+
void setSuccess();
void setFailed();
void setRunning();
diff --git a/build/includes/job_actor/job_actor.hpp b/build/includes/job_actor/job_actor.hpp
index e92a7a1f15ab3601090057a106436b2654255177..47fa10ba4328ee7b337c65c05cd7be36c62bc18d 100644
--- a/build/includes/job_actor/job_actor.hpp
+++ b/build/includes/job_actor/job_actor.hpp
@@ -11,6 +11,8 @@
namespace caf {
using chrono_time = std::chrono::time_point<std::chrono::system_clock>;
+
+// Holds information about the GRUs
struct GRU_Container {
std::vector<GRU*> gru_list;
chrono_time gru_start_time; // Vector of start times for each GRU
@@ -55,21 +57,18 @@ struct job_state {
};
+/** The Job Actor */
+behavior job_actor(stateful_actor<job_state>* self,
+ int start_gru, int num_gru,
+ File_Access_Actor_Settings file_access_actor_settings,
+ Job_Actor_Settings job_actor_settings,
+ HRU_Actor_Settings hru_actor_settings,
+ actor parent);
-behavior job_actor(stateful_actor<job_state>* self, int start_gru, int num_gru,
- File_Access_Actor_Settings file_access_actor_settings, Job_Actor_Settings job_actor_settings,
- HRU_Actor_Settings hru_actor_settings, actor parent);
-
-/*
- * Start all of the GRU actors and set up their container class
-*/
-void initGRUs(stateful_actor<job_state>* self);
-
-/**
- * Get the information for the GRUs that will be written to the netcdf file
-*/
-std::vector<serializable_netcdf_gru_actor_info> getGruNetcdfInfo(int max_run_attempts, std::vector<GRU*> &gru_list);
-void handleGRUError(stateful_actor<job_state>* self, const error& err, caf::actor src);
+/** Get the information for the GRUs that will be written to the netcdf file */
+std::vector<serializable_netcdf_gru_actor_info> getGruNetcdfInfo(int max_run_attempts,
+ std::vector<GRU*> &gru_list);
+void handleGRUError(stateful_actor<job_state>* self, caf::actor src);
} // end namespace
\ No newline at end of file
diff --git a/build/includes/job_actor/job_actor_subroutine_wrappers.hpp b/build/includes/job_actor/job_actor_subroutine_wrappers.hpp
index 07622122f95a06bd0d06a57628f922ef82c5d1e6..a0073c98cc95008f485b335dc29da20b543d11d5 100644
--- a/build/includes/job_actor/job_actor_subroutine_wrappers.hpp
+++ b/build/includes/job_actor/job_actor_subroutine_wrappers.hpp
@@ -1,15 +1,11 @@
#pragma once
extern "C" {
- void setTimesDirsAndFiles(char const* file_manager, int* err);
-
- void defineGlobalData(int* start_gru_index, int* err);
-
- void readDimension(int* num_gru, int* num_hru, int* start_gru_index, int* err);
-
- void readIcondNLayers(int* num_gru, int* err);
-
- void allocateTimeStructure(int* err);
+ void job_init_fortran(char const* file_manager,
+ int* start_gru_index,
+ int* num_gru,
+ int* num_hru,
+ int* err);
void deallocateJobActor(int* err);
diff --git a/build/source/actors/file_access_actor/cpp_code/file_access_actor.cpp b/build/source/actors/file_access_actor/cpp_code/file_access_actor.cpp
index 62ef5d24c3be21088dc3ac6e6b2471484183df0e..567b8b4258898d5d5dfdb2706b97011e229f4bf5 100644
--- a/build/source/actors/file_access_actor/cpp_code/file_access_actor.cpp
+++ b/build/source/actors/file_access_actor/cpp_code/file_access_actor.cpp
@@ -30,15 +30,45 @@ behavior file_access_actor(stateful_actor<file_access_state>* self, int start_gr
self->state.num_output_steps = self->state.file_access_actor_settings.num_timesteps_in_output_buffer;
-
- initalizeFileAccessActor(self);
+
+ fileAccessActor_init_fortran(self->state.handle_forcing_file_info,
+ &self->state.numFiles,
+ &self->state.num_steps,
+ &self->state.file_access_actor_settings.num_timesteps_in_output_buffer,
+ self->state.handle_ncid,
+ &self->state.start_gru,
+ &self->state.num_gru,
+ &self->state.num_gru, // Filler for num_hrus
+ &self->state.gru_actor_stats,
+ &self->state.err);
+ if (self->state.err != 0) {
+ aout(self) << "ERROR: File Access Actor - File_Access_init_Fortran\n";
+ self->send(self->state.parent, file_access_error::unhandleable_error, self);
+ return {};
+ }
+
+ aout(self) << "Simluations Steps: " << self->state.num_steps << "\n";
+
+
+ // Inital Files Have Been Loaded - Send Message to Job_Actor to Start Simulation
+ self->send(self->state.parent, init_gru_v);
+ // initalize the forcingFile array
+ self->state.filesLoaded = 0;
+ for (int i = 1; i <= self->state.numFiles; i++) {
+ self->state.forcing_file_list.push_back(Forcing_File_Info(i));
+ }
+
+ // Check that the number of timesteps in the output buffer is not greater than the number of timesteps in the simulation
+ if (self->state.num_steps < self->state.file_access_actor_settings.num_timesteps_in_output_buffer) {
+ self->state.num_output_steps = self->state.num_steps;
+ self->state.file_access_actor_settings.num_timesteps_in_output_buffer = self->state.num_steps;
+ }
// Set up the output container
- self->state.output_container = new Output_Container(
- self->state.file_access_actor_settings.num_partitions_in_output_buffer,
- self->state.num_gru,
- self->state.file_access_actor_settings.num_timesteps_in_output_buffer,
- self->state.num_steps);
+ self->state.output_container = new Output_Container(self->state.file_access_actor_settings.num_partitions_in_output_buffer,
+ self->state.num_gru,
+ self->state.file_access_actor_settings.num_timesteps_in_output_buffer,
+ self->state.num_steps);
return {
[=](write_param, int index_gru, int index_hru, std::vector<double> attr_struct,
@@ -57,10 +87,11 @@ behavior file_access_actor(stateful_actor<file_access_state>* self, int start_gr
set_var_d(bpar_struct, params->handle_bpar_struct);
// write the populated data to netCDF
writeParamToNetCDF(self->state.handle_ncid, &index_gru, &index_hru,
- params->handle_attr_struct,
- params->handle_type_struct,
- params->handle_mpar_struct,
- params->handle_bpar_struct, &err);
+ params->handle_attr_struct,
+ params->handle_type_struct,
+ params->handle_mpar_struct,
+ params->handle_bpar_struct,
+ &err);
self->state.file_access_timing.updateEndPoint("write_duration");
@@ -132,8 +163,9 @@ behavior file_access_actor(stateful_actor<file_access_state>* self, int start_gr
}
},
- [=] (get_attributes_params, int index_gru, caf::actor actor_to_respond) {
+ [=] (get_attributes_params, int index_gru) {
// From Attributes File
+
std::vector<double> attr_struct_to_send = self->state.attr_structs_for_hrus[index_gru-1];
std::vector<int> type_struct_to_send = self->state.type_structs_for_hrus[index_gru-1];
std::vector<long int> id_struct_to_send = self->state.id_structs_for_hrus[index_gru-1];
@@ -143,15 +175,15 @@ behavior file_access_actor(stateful_actor<file_access_state>* self, int start_gr
std::vector<double> dpar_struct_to_send = self->state.dpar_structs_for_hrus[index_gru-1];
std::vector<std::vector<double>> mpar_struct_to_send = self->state.mpar_structs_for_hrus[index_gru-1];
- self->send(actor_to_respond, get_attributes_params_v, attr_struct_to_send,
- type_struct_to_send, id_struct_to_send, bpar_struct_to_send,
- dpar_struct_to_send, mpar_struct_to_send);
-
+ return std::make_tuple(attr_struct_to_send,
+ type_struct_to_send,
+ id_struct_to_send,
+ bpar_struct_to_send,
+ dpar_struct_to_send,
+ mpar_struct_to_send);
},
- [=] (get_num_output_steps, caf::actor hru) {
- self->send(hru, num_steps_before_write_v, self->state.num_output_steps);
- },
+ [=] (get_num_output_steps) { return self->state.num_output_steps; },
[=](write_output, int index_gru, int index_hru, caf::actor hru_actor) {
self->state.file_access_timing.updateStartPoint("write_duration");
@@ -160,27 +192,8 @@ behavior file_access_actor(stateful_actor<file_access_state>* self, int start_gr
output_partition->setGRUReadyToWrite(hru_actor);
-
if (output_partition->isReadyToWrite()) {
- int num_timesteps_to_write = output_partition->getNumStoredTimesteps();
- int start_gru = output_partition->getStartGRUIndex();
- int max_gru = output_partition->getMaxGRUIndex();
-
- writeOutput(self->state.handle_ncid, &num_timesteps_to_write,
- &start_gru, &max_gru, &self->state.err);
-
- output_partition->updateTimeSteps();
-
- int num_steps_before_next_write = output_partition->getNumStoredTimesteps();
-
- std::vector<caf::actor> hrus_to_update = output_partition->getReadyToWriteList();
-
- for (int i = 0; i < hrus_to_update.size(); i++) {
- self->send(hrus_to_update[i], num_steps_before_write_v, num_steps_before_next_write);
- self->send(hrus_to_update[i], run_hru_v);
- }
-
- output_partition->resetReadyToWriteList();
+ writeOutput(self, output_partition);
}
self->state.file_access_timing.updateEndPoint("write_duration");
@@ -191,42 +204,26 @@ behavior file_access_actor(stateful_actor<file_access_state>* self, int start_gr
},
[=](run_failure, int local_gru_index) {
+ self->state.file_access_timing.updateStartPoint("write_duration");
+
Output_Partition *output_partition = self->state.output_container->getOutputPartition(local_gru_index);
output_partition->addFailedGRUIndex(local_gru_index);
- int active_grus = output_partition->getNumActiveGRUs();
-
- if (output_partition->isReadyToWrite() && active_grus > 0) {
- int num_timesteps_to_write = output_partition->getNumStoredTimesteps();
- int start_gru = output_partition->getMaxGRUIndex();
- int max_gru = output_partition->getStartGRUIndex();
-
- writeOutput(self->state.handle_ncid, &num_timesteps_to_write,
- &start_gru, &max_gru, &self->state.err);
-
- output_partition->updateTimeSteps();
-
- int num_steps_before_next_write = output_partition->getNumStoredTimesteps();
-
- std::vector<caf::actor> hrus_to_update = output_partition->getReadyToWriteList();
-
- for (int i = 0; i < hrus_to_update.size(); i++) {
- self->send(hrus_to_update[i], num_steps_before_write_v, num_steps_before_next_write);
- self->send(hrus_to_update[i], run_hru_v);
- }
-
- output_partition->resetReadyToWriteList();
-
+ if (output_partition->isReadyToWrite()) {
+ writeOutput(self, output_partition);
}
-
+ self->state.file_access_timing.updateEndPoint("write_duration");
},
- [=](deallocate_structures, std::vector<serializable_netcdf_gru_actor_info> &netcdf_gru_info) {
+ [=](finalize, std::vector<serializable_netcdf_gru_actor_info> &netcdf_gru_info) {
int num_gru = netcdf_gru_info.size();
- WriteGRUStatistics(self->state.handle_ncid, &self->state.gru_actor_stats,
- netcdf_gru_info.data(), &num_gru, &self->state.err);
+ WriteGRUStatistics(self->state.handle_ncid,
+ &self->state.gru_actor_stats,
+ netcdf_gru_info.data(),
+ &num_gru,
+ &self->state.err);
// call output_container deconstructor
@@ -240,230 +237,36 @@ behavior file_access_actor(stateful_actor<file_access_state>* self, int start_gr
aout(self) << "Total Read Duration = " << self->state.file_access_timing.getDuration("read_duration").value_or(-1.0) << " Seconds\n";
aout(self) << "Total Write Duration = " << self->state.file_access_timing.getDuration("write_duration").value_or(-1.0) << " Seconds\n";
- self->send(self->state.parent,
- file_access_actor_done_v,
- self->state.file_access_timing.getDuration("read_duration").value_or(-1.0),
- self->state.file_access_timing.getDuration("write_duration").value_or(-1.0));
self->quit();
+ return std::make_tuple(self->state.file_access_timing.getDuration("read_duration").value_or(-1.0),
+ self->state.file_access_timing.getDuration("write_duration").value_or(-1.0));
},
};
}
-void initalizeFileAccessActor(stateful_actor<file_access_state>* self) {
- int indx = 1;
- int err = 0;
-
- // read information on model forcing files
- ffile_info(&indx,
- self->state.handle_forcing_file_info, &self->state.numFiles, &err);
- if (err != 0) {
- aout(self) << "Error: ffile_info_C - File_Access_Actor \n";
- std::string function = "ffile_info_C";
- self->send(self->state.parent, file_access_actor_err_v, function);
- self->quit();
- return;
- }
-
- // save model decisions as named integers
- mDecisions_C(&self->state.num_steps, &err);
- if (err != 0) {
- aout(self) << "\033[31mFile_Access_Actor: Error in mDecisions\033[0m\n";
- std::string function = "mDecisions";
- self->send(self->state.parent, file_access_actor_err_v, function);
- self->quit();
- return;
- }
- aout(self) << "Simluations Steps: " << self->state.num_steps << "\n";
- // Check that the number of timesteps in the output buffer is not greater than the number of timesteps in the simulation
- if (self->state.num_steps < self->state.file_access_actor_settings.num_timesteps_in_output_buffer) {
- self->state.num_output_steps = self->state.num_steps;
- self->state.file_access_actor_settings.num_timesteps_in_output_buffer = self->state.num_steps;
- }
-
- read_pinit_C(&err);
- if (err != 0) {
- aout(self) << "ERROR: read_pinit_C\n";
- std::string function = "read_pinit_C";
- self->send(self->state.parent, file_access_actor_err_v, function);
- self->quit();
- return;
- }
-
- read_vegitationTables(&err);
- if (err != 0) {
- aout(self) << "ERROR: read_vegitationTables\n";
- std::string function = "read_vegitationTables";
- self->send(self->state.parent, file_access_actor_err_v, function);
- self->quit();
- return;
- }
-
- initFailedHRUTracker(&self->state.num_gru);
-
- def_output(self->state.handle_ncid, &self->state.start_gru, &self->state.num_gru,
- &self->state.num_gru, &self->state.gru_actor_stats, &err);
- if (err != 0) {
- aout(self) << "ERROR: Create_OutputFile\n";
- std::string function = "def_output";
- self->send(self->state.parent, file_access_actor_err_v, function);
- self->quit();
- return;
- }
-
- // Initalize the output Structure
- aout(self) << "Initalizing Output Structure" << std::endl;
- initOutputStructure(self->state.handle_forcing_file_info,
- &self->state.file_access_actor_settings.num_timesteps_in_output_buffer,
- &self->state.num_gru, &self->state.err);
- if (self->state.err != 0) {
- aout(self) << "ERROR: Init_OutputStruct\n";
- std::string function = "Init_OutputStruct";
- self->send(self->state.parent, file_access_actor_err_v, function);
- self->quit();
- return;
- }
-
- initOutputTimeStep(&self->state.num_gru, &self->state.err);
- if (self->state.err != 0) {
- aout(self) << "ERROR: Init_OutputTimeStep\n";
- std::string function = "Init_OutputTimeStep";
- self->send(self->state.parent, file_access_actor_err_v, function);
- self->quit();
- return;
- }
-
- // Read in the attribute and parameter information for the HRUs to request
- readAttributes(self);
- readParameters(self);
-
- // read in the inital conditions for the grus/hrus
- readInitConditions(self);
-
- // Inital Files Have Been Loaded - Send Message to Job_Actor to Start Simulation
- self->send(self->state.parent, init_gru_v);
- // initalize the forcingFile array
- self->state.filesLoaded = 0;
- for (int i = 1; i <= self->state.numFiles; i++) {
- self->state.forcing_file_list.push_back(Forcing_File_Info(i));
- }
-}
-
-void readAttributes(stateful_actor<file_access_state>* self) {
-
- int err = 0;
- openAttributeFile(&self->state.attribute_ncid, &err);
+void writeOutput(stateful_actor<file_access_state>* self, Output_Partition* partition) {
+
+ int num_timesteps_to_write = partition->getNumStoredTimesteps();
+ int start_gru = partition->getStartGRUIndex();
+ int max_gru = partition->getMaxGRUIndex();
- getNumVarAttr(&self->state.attribute_ncid, &self->state.num_var_in_attributes_file, &err);
+ writeOutput_fortran(self->state.handle_ncid, &num_timesteps_to_write,
+ &start_gru, &max_gru, &self->state.err);
- for (int index_gru = 1; index_gru < self->state.num_gru + 1; index_gru++) {
-
- void* handle_attr_struct = new_handle_var_d();
- void* handle_type_struct = new_handle_var_i();
- void* handle_id_struct = new_handle_var_i8();
- int index_hru = 1;
-
- allocateAttributeStructures(&index_gru, &index_hru, handle_attr_struct, handle_type_struct,
- handle_id_struct, &err);
-
- readAttributeFromNetCDF(&self->state.attribute_ncid, &index_gru, &index_hru,
- &self->state.num_var_in_attributes_file, handle_attr_struct, handle_type_struct,
- handle_id_struct, &err);
-
- // attr struct
- std::vector<double> attr_struct_to_push = get_var_d(handle_attr_struct);
- self->state.attr_structs_for_hrus.push_back(attr_struct_to_push);
- delete_handle_var_d(handle_attr_struct);
- // type struct
- std::vector<int> type_struct_to_push = get_var_i(handle_type_struct);
- self->state.type_structs_for_hrus.push_back(type_struct_to_push);
- delete_handle_var_i(handle_type_struct);
- // id struct
- std::vector<long int> id_struct_to_push = get_var_i8(handle_id_struct);
- self->state.id_structs_for_hrus.push_back(id_struct_to_push);
- delete_handle_var_i8(handle_id_struct);
- }
-
- closeAttributeFile(&self->state.attribute_ncid, &err);
-}
+ partition->updateTimeSteps();
-void readParameters(stateful_actor<file_access_state>* self) {
+ int num_steps_before_next_write = partition->getNumStoredTimesteps();
- int err = 0;
- int index_hru = 1;
-
- openParamFile(&self->state.param_ncid, &self->state.param_file_exists,
- &err);
-
- getParamSizes(&self->state.dpar_array_size, &self->state.bpar_array_size,
- &self->state.type_array_size);
-
-
- if (self->state.param_file_exists) {
- getNumVarParam(&self->state.param_ncid, &self->state.num_var_in_param_file,
- &err);
- } else {
- self->state.num_var_in_param_file = self->state.type_array_size;
- }
-
- for (int index_gru = 1; index_gru < self->state.num_gru + 1; index_gru++) {
-
- std::vector<double> dpar_array(self->state.dpar_array_size);
- void* handle_type_struct = new_handle_var_i();
- void* handle_dpar_struct = new_handle_var_d();
- void* handle_mpar_struct = new_handle_var_dlength();
- void* handle_bpar_struct = new_handle_var_d();
- std::vector<double> bpar_array(self->state.dpar_array_size);
-
- allocateParamStructures(&index_gru, &index_hru, handle_dpar_struct,
- handle_mpar_struct, handle_bpar_struct, &err);
-
- // need to convert attr_struct to FORTRAN format
- set_var_i(self->state.type_structs_for_hrus[index_gru-1], handle_type_struct);
+ std::vector<caf::actor> hrus_to_update = partition->getReadyToWriteList();
- overwriteParam(&index_gru, &index_hru,
- handle_type_struct,
- handle_dpar_struct,
- handle_mpar_struct,
- handle_bpar_struct,
- &err);
-
- if (self->state.param_file_exists) {
- readParamFromNetCDF(&self->state.param_ncid, &index_gru, &index_hru,
- &self->state.start_gru,
- &self->state.num_var_in_param_file,
- handle_mpar_struct,
- handle_bpar_struct,
- &err);
- }
-
- // type_struct
- delete_handle_var_i(handle_type_struct);
-
- // dpar_struct
- std::vector<double> dpar_struct_to_push = get_var_d(handle_dpar_struct);
- self->state.dpar_structs_for_hrus.push_back(dpar_struct_to_push);
- delete_handle_var_d(handle_dpar_struct);
- // mpar_struct
- std::vector<std::vector<double>> mpar_struct_to_push = get_var_dlength(handle_mpar_struct);
- self->state.mpar_structs_for_hrus.push_back(mpar_struct_to_push);
- delete_handle_var_dlength(handle_mpar_struct);
- // bpar_struct
- std::vector<double> bpar_struct_to_push = get_var_d(handle_bpar_struct);
- self->state.bpar_structs_for_hrus.push_back(bpar_struct_to_push);
- delete_handle_var_d(handle_bpar_struct);
+ for (int i = 0; i < hrus_to_update.size(); i++) {
+ self->send(hrus_to_update[i], num_steps_before_write_v, num_steps_before_next_write);
+ self->send(hrus_to_update[i], run_hru_v);
}
- closeParamFile(&self->state.param_ncid, &err);
-}
-
-void readInitConditions(stateful_actor<file_access_state>* self) {
- int err;
- openInitCondFile(&self->state.init_cond_ncid, &err);
- readInitCond_prog(&self->state.init_cond_ncid, &self->state.start_gru, &self->state.num_gru, &err);
- readInitCond_bvar(&self->state.init_cond_ncid, &self->state.start_gru, &self->state.num_gru, &err);
- closeInitCondFile(&self->state.init_cond_ncid, &err);
+ partition->resetReadyToWriteList();
}
} // end namespace
\ No newline at end of file
diff --git a/build/source/actors/file_access_actor/fortran_code/cppwrap_fileAccess.f90 b/build/source/actors/file_access_actor/fortran_code/cppwrap_fileAccess.f90
index de44faf9c506f9b085b94fdebc8c98843e9bb1fd..f4b881f01c25e8d51dc9aee20628405f5f207324 100644
--- a/build/source/actors/file_access_actor/fortran_code/cppwrap_fileAccess.f90
+++ b/build/source/actors/file_access_actor/fortran_code/cppwrap_fileAccess.f90
@@ -6,104 +6,376 @@ module cppwrap_fileAccess
USE nrtype
USE data_types
USE globalData
+ USE globalData,only:integerMissing ! missing integer value
+ USE globalData,only:realMissing ! missing double precision value
+
USE var_lookup,only:maxvarFreq ! maximum number of output files
implicit none
- public::mDecisions_C
- public::read_pinit_C
- public::read_vegitationTables
+ public::fileAccessActor_init_fortran
public::FileAccessActor_DeallocateStructures
- public::initFailedHRUTracker
contains
-subroutine mDecisions_C(num_steps, err) bind(C, name='mDecisions_C')
+! Call the fortran routines that read data in and are associtated with the forcing structure
+subroutine fileAccessActor_init_fortran(& ! Variables for forcing
+ handle_forcFileInfo,&
+ num_forcing_files,&
+ num_timesteps,&
+ num_timesteps_output_buffer,&
+ ! Variables for output
+ handle_output_ncid,&
+ start_gru,&
+ num_gru,&
+ num_hru,&
+ actor_stats,&
+ err) bind(C, name="fileAccessActor_init_fortran")
+ USE ffile_info_actors_module,only:ffile_info
USE mDecisions_module,only:mDecisions ! module to read model decisions
+ USE read_pinit_module,only:read_pinit ! module to read initial model parameter values
+ USE SummaActors_setup,only:SOIL_VEG_GEN_PARM
+ USE module_sf_noahmplsm,only:read_mp_veg_parameters ! module to read NOAH vegetation tables
+ USE def_output_actors_module,only:def_output ! module to define output variables
+ USE output_structure_module,only:initOutputStructure ! module to initialize output structure
+ USE output_structure_module,only:initOutputTimeStep ! module to initialize output timestep structure (tracks GRUs timestep for output)
+ USE read_attrb_module,only:read_attrb ! module to read local attributes
+ USE read_param_module,only:read_param ! module to read model parameter sets
+ USE pOverwrite_module,only:pOverwrite ! module to overwrite default parameter values with info from the Noah tables
+ USE var_derive_module,only:fracFuture ! module to calculate the fraction of runoff in future time steps (time delay histogram)
+ USE paramCheck_module,only:paramCheck ! module to check consistency of model parameters
+ USE read_icond_module,only:read_icond ! module to read initial conditions
+ USE check_icond_module,only:check_icond ! module to check initial conditions
+
+ USE mDecisions_module,only:&
+ sameRulesAllLayers, & ! SNTHERM option: same combination/sub-dividion rules applied to all layers
+ rulesDependLayerIndex ! CLM option: combination/sub-dividion rules depend on layer index
+ USE globalData,only:localParFallback ! local column default parameters
+ USE globalData,only:basinParFallback ! basin-average default parameters
+ USE summaFileManager,only:LOCALPARAM_INFO,BASINPARAM_INFO ! files defining the default values and constraints for model parameters
+ USE globalData,only:mpar_meta,bpar_meta ! parameter metadata structures
+ USE summaFileManager,only:SETTINGS_PATH ! define path to settings files (e.g., parameters, soil and veg. tables)
+ USE summaFileManager,only:LOCAL_ATTRIBUTES ! name of model initial attributes file
+ USE summaFileManager,only:GENPARM,VEGPARM,SOILPARM,MPTABLE ! files defining the noah tables
+ USE summaFileManager,only:MODEL_INITCOND ! name of model initial conditions file
+ USE summaFileManager,only:STATE_PATH ! optional path to state/init. condition files (defaults to SETTINGS_PATH)
+ USE globalData,only:model_decisions ! model decision structure
+ USE var_lookup,only:iLookDECISIONS ! look-up values for model decisions
+ USE var_lookup,only:iLookTYPE ! look-up values for model types
+ USE var_lookup,only:iLookID ! look-up values for model IDs
+ USE var_lookup,only:iLookPARAM
+ USE var_lookup,only:iLookATTR ! look-up values for model attributes
+ USE var_lookup,only:iLookBVAR ! look-up values for basin-average variables
+ USE output_structure_module,only:outputStructure ! output structure
+ USE globalData,only:failedHRUs ! Flag for file access actor to know which GRUs have failed
- ! Read in number of Time Steps after the call to mDecisions
- USE globalData,only:numtim ! number of time steps in the simulation
+ USE globalData,only:iRunModeFull,iRunModeGRU,iRunModeHRU
+ USE globalData,only:iRunMode ! define the current running mode
+ USE globalData,only:checkHRU ! index of the HRU for a single HRU run
+
+ ! look-up values for the choice of heat capacity computation
+ USE mDecisions_module,only: &
+ enthalpyFD ! heat capacity using enthalpy
+ USE mDecisions_module,only:&
+ monthlyTable,& ! LAI/SAI taken directly from a monthly table for different vegetation classes
+ specified ! LAI/SAI computed from green vegetation fraction and winterSAI and summerLAI parameters
- implicit none
- integer(c_int),intent(out) :: num_steps
- integer(c_int),intent(out) :: err ! error code
- character(len=256) :: message ! error message
+ USE ConvE2Temp_module,only:E2T_lookup ! module to calculate a look-up table for the temperature-enthalpy conversion
+ USE t2enthalpy_module,only:T2E_lookup ! module to calculate a look-up table for the temperature-enthalpy conversion
- call mDecisions(err,message)
- if(err/=0)then; print*, char(27),'[33m',message,char(27),'[0m'; return; endif
+ 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)
- num_steps = numtim
-end subroutine mDecisions_C
+ USE globalData,only:numtim ! number of time steps in the simulation
+ implicit none
-! Read in the inital parameters, from the txt files that are give to summa as input LocalParamInfo.txt BasinParamInfo.txt
-subroutine read_pinit_C(err) bind(C, name='read_pinit_C')
- USE globalData,only:localParFallback ! local column default parameters
- USE globalData,only:basinParFallback ! basin-average default parameters
- USE summaFileManager,only:LOCALPARAM_INFO,BASINPARAM_INFO ! files defining the default values and constraints for model parameters
- USE globalData,only:mpar_meta,bpar_meta ! parameter metadata structures
- USE read_pinit_module,only:read_pinit ! module to read initial model parameter values
+ type(c_ptr), intent(in), value :: handle_forcFileInfo
+ integer(c_int),intent(out) :: num_forcing_files
+ integer(c_int),intent(out) :: num_timesteps
+ integer(c_int),intent(in) :: num_timesteps_output_buffer
+ type(c_ptr),intent(in), value :: handle_output_ncid
+ integer(c_int),intent(out) :: start_gru
+ integer(c_int),intent(out) :: num_gru
+ integer(c_int),intent(out) :: num_hru
+ type(netcdf_gru_actor_info),intent(out):: actor_stats ! netcdf actor information
+ integer(c_int),intent(out) :: err
+
+
+ ! local Variables
+ type(file_info_array),pointer :: forcFileInfo
+ type(var_i),pointer :: output_ncid ! id of output file
+ integer(i4b) :: iGRU ! counter for GRUs
+ integer(i4b) :: iHRU ! counter for HRUs
+ integer(i4b) :: jHRU,kHRU ! HRU indices
+ integer(i4b) :: ivar ! counter for variables
+ character(len=256) :: attrFile ! attributes file name
+ character(LEN=256) :: restartFile ! restart file name
+ integer(i4b) :: indxGRU=1
+ character(len=256) :: message ! error message for downwind routine
+
+
+ err=0; message="fileAccessActor_init_fortran/"
-
- implicit none
- integer(c_int),intent(inout) :: err ! Error Code
+ call c_f_pointer(handle_forcFileInfo, forcFileInfo)
+ call c_f_pointer(handle_output_ncid, output_ncid)
- character(LEN=256) :: message ! error message of downwind routine
- character(LEN=256) :: cmessage ! error message of downwind routine
+ ! Get the initial forcing file information
+ call ffile_info(indxGRU, forcFileInfo, num_forcing_files, err, message)
+ if(err/=0)then; print*, trim(message); return; endif
+ ! Get and save the model decisions as integers
+ call mDecisions(err,message)
+ if(err/=0)then; print*,trim(message); return; endif
+ num_timesteps = numtim
- ! *****************************************************************************
- ! *** read default model parameters
- ! *****************************************************************************
+ ! 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)
- ! read default values and constraints for model parameters (local column)
- call read_pinit(LOCALPARAM_INFO,.TRUE., mpar_meta,localParFallback,err,cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
- ! read default values and constraints for model parameters (basin-average)
- call read_pinit(BASINPARAM_INFO,.FALSE.,bpar_meta,basinParFallback,err,cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
-end subroutine read_pinit_C
+ maxLayers = gru_struc(1)%hruInfo(1)%nSoil + maxSnowLayers
-subroutine read_vegitationTables(err) bind(C, name="read_vegitationTables")
- USE SummaActors_setup,only:SOIL_VEG_GEN_PARM
- USE module_sf_noahmplsm,only:read_mp_veg_parameters ! module to read NOAH vegetation tables
- USE summaFileManager,only:SETTINGS_PATH ! define path to settings files (e.g., parameters, soil and veg. tables)
- USE summaFileManager,only:GENPARM,VEGPARM,SOILPARM,MPTABLE ! files defining the noah tables
- USE globalData,only:model_decisions ! model decision structure
- USE var_lookup,only:iLookDECISIONS ! look-up values for model decisions
+ ! *****************************************************************************
+ ! *** read default model parameters
+ ! *****************************************************************************
+ ! read default values and constraints for model parameters (local column)
+ call read_pinit(LOCALPARAM_INFO,.TRUE., mpar_meta,localParFallback,err,message)
+ if(err/=0)then; print*,trim(message); return; endif
- implicit none
+ ! read default values and constraints for model parameters (basin-average)
+ call read_pinit(BASINPARAM_INFO,.FALSE.,bpar_meta,basinParFallback,err,message)
+ if(err/=0)then; print*,trim(message); return; endif
- integer(c_int),intent(inout) :: err ! Error Code
- err = 0
+
+ ! *****************************************************************************
+ ! *** read Noah vegetation and soil tables
+ ! *****************************************************************************
+
+ 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/)
- ! read Noah soil and vegetation tables
+
+ ! read Noah soil and vegetation tables
call soil_veg_gen_parm(trim(SETTINGS_PATH)//trim(VEGPARM), & ! filename for vegetation table
- trim(SETTINGS_PATH)//trim(SOILPARM), & ! filename for soils table
- trim(SETTINGS_PATH)//trim(GENPARM), & ! filename for general table
- trim(model_decisions(iLookDECISIONS%vegeParTbl)%cDecision), & ! classification system used for vegetation
- trim(model_decisions(iLookDECISIONS%soilCatTbl)%cDecision)) ! classification system used for soils
+ trim(SETTINGS_PATH)//trim(SOILPARM), & ! filename for soils table
+ trim(SETTINGS_PATH)//trim(GENPARM), & ! filename for general table
+ trim(model_decisions(iLookDECISIONS%vegeParTbl)%cDecision), & ! classification system used for vegetation
+ trim(model_decisions(iLookDECISIONS%soilCatTbl)%cDecision)) ! classification system used for soils
+ if(err/=0)then; print*,trim(message); return; endif
! read Noah-MP vegetation tables
call read_mp_veg_parameters(trim(SETTINGS_PATH)//trim(MPTABLE), & ! filename for Noah-MP table
- trim(model_decisions(iLookDECISIONS%vegeParTbl)%cDecision)) ! classification system used for vegetation
+ trim(model_decisions(iLookDECISIONS%vegeParTbl)%cDecision)) ! classification system used for vegetation
+ if(err/=0)then; print*,trim(message); return; endif
+
+ ! 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
+
+ ! *****************************************************************************
+ ! *** Initalize failed HRU tracker
+ ! *****************************************************************************
+ if (allocated(failedHRUs))then; deallocate(failedHRUs); endif;
+ allocate(failedHRUs(num_gru), stat=err)
+ if(err/=0)then; print*,trim(message); return; endif
+ failedHRUs(:) = .false.
+
+ ! *****************************************************************************
+ ! *** Define Output Files
+ ! *****************************************************************************
+ call def_output(output_ncid,start_gru,num_gru,num_hru,actor_stats,err,message)
+ if(err/=0)then; print*,trim(message); return; endif
+
+ ! *****************************************************************************
+ ! *** Initialize output structure
+ ! *****************************************************************************
+ call initOutputStructure(forcFileInfo, num_timesteps_output_buffer, num_gru, err)
+ if(err/=0)then; print*,trim(message); return; endif
+
+ ! *****************************************************************************
+ ! *** Initialize output time step
+ ! *****************************************************************************
+ call initOutputTimeStep(num_gru, err)
+ if(err/=0)then; print*,trim(message); return; endif
+
+
+ ! *****************************************************************************
+ ! *** Read Attributes
+ ! *****************************************************************************
+
+ attrFile = trim(SETTINGS_PATH)//trim(LOCAL_ATTRIBUTES)
+ call read_attrb(trim(attrFile),num_gru,outputStructure(1)%attrStruct,&
+ outputStructure(1)%typeStruct,outputStructure(1)%idStruct,err,message)
+ if(err/=0)then; print*,trim(message); return; endif
+
+
+ ! set default model parameters
+ do iGRU=1, num_gru
+ do iHRU=1, gru_struc(iGRU)%hruCount
+ ! set parmameters to their default value
+ outputStructure(1)%dparStruct%gru(iGRU)%hru(iHRU)%var(:) = localParFallback(:)%default_val ! x%hru(:)%var(:)
+
+ ! overwrite default model parameters with information from the Noah-MP tables
+ call pOverwrite(outputStructure(1)%typeStruct%gru(iGRU)%hru(iHRU)%var(iLookTYPE%vegTypeIndex), & ! vegetation category
+ outputStructure(1)%typeStruct%gru(iGRU)%hru(iHRU)%var(iLookTYPE%soilTypeIndex), & ! soil category
+ outputStructure(1)%dparStruct%gru(iGRU)%hru(iHRU)%var, & ! default model parameters
+ err,message) ! error control
+ if(err/=0)then; print*, trim(message); return; endif
+
+
+ ! copy over to the parameter structure
+ ! NOTE: constant for the dat(:) dimension (normally depth)
+ do ivar=1,size(localParFallback)
+ outputStructure(1)%mparStruct%gru(iGRU)%hru(iHRU)%var(ivar)%dat(:) = outputStructure(1)%dparStruct%gru(iGRU)%hru(iHRU)%var(ivar)
+ end do ! looping through variables
+
+ end do ! looping through HRUs
+
+ ! set default for basin-average parameters
+ outputStructure(1)%bparStruct%gru(iGRU)%var(:) = basinParFallback(:)%default_val
+
+ end do ! looping through GRUs
+
+
+ ! *****************************************************************************
+ ! *** Read Parameters
+ ! *****************************************************************************
+ checkHRU = integerMissing
+ call read_param(iRunMode,checkHRU,start_gru,num_hru,num_gru,outputStructure(1)%idStruct,&
+ outputStructure(1)%mparStruct,outputStructure(1)%bparStruct,err,message)
+ if(err/=0)then; print*,trim(message); return; endif
+
+ ! *****************************************************************************
+ ! *** compute derived model variables that are pretty much constant for the basin as a whole
+ ! *****************************************************************************
+ ! ! loop through GRUs
+ do iGRU=1,num_gru
+ ! calculate the fraction of runoff in future time steps
+ call fracFuture(outputStructure(1)%bparStruct%gru(iGRU)%var, & ! vector of basin-average model parameters
+ outputStructure(1)%bvarStruct_init%gru(iGRU), & ! data structure of basin-average variables
+ err,message) ! error control
+ if(err/=0)then; print*, trim(message); return; endif
+
+ ! loop through local HRUs
+ do iHRU=1,gru_struc(iGRU)%hruCount
+
+
+ kHRU=0
+ ! check the network topology (only expect there to be one downslope HRU)
+ do jHRU=1,gru_struc(iGRU)%hruCount
+ if(outputStructure(1)%typeStruct%gru(iGRU)%hru(iHRU)%var(iLookTYPE%downHRUindex) == outputStructure(1)%idStruct%gru(iGRU)%hru(jHRU)%var(iLookID%hruId))then
+ if(kHRU==0)then ! check there is a unique match
+ kHRU=jHRU
+ else
+ message=trim(message)//'only expect there to be one downslope HRU'; print*, message; return
+ end if ! (check there is a unique match)
+ end if ! (if identified a downslope HRU)
+ end do
+
+
+ ! check that the parameters are consistent
+ call paramCheck(outputStructure(1)%mparStruct%gru(iGRU)%hru(iHRU),err,message)
+ if(err/=0)then; print*, message; return; endif
+
+
+ ! calculate a look-up table for the temperature-enthalpy conversion: snow
+ ! NOTE1: this should eventually be replaced by the more general routine below
+ ! NOTE2: this does not actually need to be called for each HRU and GRU
+ call E2T_lookup(outputStructure(1)%mparStruct%gru(iGRU)%hru(iHRU),err,message)
+ if(err/=0)then; print*,message; return; endif
+
+ ! calculate a lookup table to compute enthalpy from temperature, only for enthalpyFD
+ if(model_decisions(iLookDECISIONS%howHeatCap)%iDecision == enthalpyFD)then
+ call T2E_lookup(gru_struc(iGRU)%hruInfo(iHRU)%nSoil, & ! intent(in): number of soil layers
+ outputStructure(1)%mparStruct%gru(iGRU)%hru(iHRU), & ! intent(in): parameter data structure
+ outputStructure(1)%lookupStruct%gru(iGRU)%hru(iHRU), & ! intent(inout): lookup table data structure
+ err,message) ! intent(out): error control
+ if(err/=0)then; print*, message; return; endif
+ endif
+
+ ! overwrite the vegetation height
+ HVT(outputStructure(1)%typeStruct%gru(iGRU)%hru(iHRU)%var(iLookTYPE%vegTypeIndex)) = outputStructure(1)%mparStruct%gru(iGRU)%hru(iHRU)%var(iLookPARAM%heightCanopyTop)%dat(1)
+ HVB(outputStructure(1)%typeStruct%gru(iGRU)%hru(iHRU)%var(iLookTYPE%vegTypeIndex)) = outputStructure(1)%mparStruct%gru(iGRU)%hru(iHRU)%var(iLookPARAM%heightCanopyBottom)%dat(1)
+
+ ! overwrite the tables for LAI and SAI
+ if(model_decisions(iLookDECISIONS%LAI_method)%iDecision == specified)then
+ SAIM(outputStructure(1)%typeStruct%gru(iGRU)%hru(iHRU)%var(iLookTYPE%vegTypeIndex),:) = outputStructure(1)%mparStruct%gru(iGRU)%hru(iHRU)%var(iLookPARAM%winterSAI)%dat(1)
+ LAIM(outputStructure(1)%typeStruct%gru(iGRU)%hru(iHRU)%var(iLookTYPE%vegTypeIndex),:) = outputStructure(1)%mparStruct%gru(iGRU)%hru(iHRU)%var(iLookPARAM%summerLAI)%dat(1)*greenVegFrac_monthly
+ endif
+
+ end do ! HRU
+
+ ! compute total area of the upstream HRUS that flow into each HRU
+ do iHRU=1,gru_struc(iGRU)%hruCount
+ outputStructure(1)%upArea%gru(iGRU)%hru(iHRU) = 0._rkind
+ do jHRU=1,gru_struc(iGRU)%hruCount
+ ! check if jHRU flows into iHRU; assume no exchange between GRUs
+ if(outputStructure(1)%typeStruct%gru(iGRU)%hru(jHRU)%var(iLookTYPE%downHRUindex)==outputStructure(1)%typeStruct%gru(iGRU)%hru(iHRU)%var(iLookID%hruId))then
+ outputStructure(1)%upArea%gru(iGRU)%hru(iHRU) = outputStructure(1)%upArea%gru(iGRU)%hru(iHRU) + outputStructure(1)%attrStruct%gru(iGRU)%hru(jHRU)%var(iLookATTR%HRUarea)
+ endif ! (if jHRU is an upstream HRU)
+ end do ! jHRU
+ end do ! iHRU
-end subroutine
+ ! identify the total basin area for a GRU (m2)
+ outputStructure(1)%bvarStruct_init%gru(iGRU)%var(iLookBVAR%basin__totalArea)%dat(1) = 0._rkind
+ do iHRU=1,gru_struc(iGRU)%hruCount
+ outputStructure(1)%bvarStruct_init%gru(iGRU)%var(iLookBVAR%basin__totalArea)%dat(1) = &
+ outputStructure(1)%bvarStruct_init%gru(iGRU)%var(iLookBVAR%basin__totalArea)%dat(1) + outputStructure(1)%attrStruct%gru(iGRU)%hru(iHRU)%var(iLookATTR%HRUarea)
+ end do
+
+ end do ! GRU
-! allocate the failedHRU logical array and intialize it with all false values
-subroutine initFailedHRUTracker(numGRU) bind(C, name="initFailedHRUTracker")
- USE globalData,only:failedHRUs
- implicit none
- integer(c_int), intent(in) :: numGRU
- if (allocated(failedHRUs))then; deallocate(failedHRUs); endif;
- allocate(failedHRUs(numGRU))
- failedHRUs(:) = .false.
-end subroutine
+
+ ! *****************************************************************************
+ ! Restart File
+ ! *****************************************************************************
+ ! define restart file path/name
+ if(STATE_PATH == '') then
+ restartFile = trim(SETTINGS_PATH)//trim(MODEL_INITCOND)
+ else
+ restartFile = trim(STATE_PATH)//trim(MODEL_INITCOND)
+ endif
+
+ ! read initial conditions
+ call read_icond(restartFile, & ! intent(in): name of initial conditions file
+ num_gru, & ! intent(in): number of response units
+ outputStructure(1)%mparStruct, & ! intent(in): model parameters
+ outputStructure(1)%progStruct_init, & ! intent(inout): model prognostic variables
+ outputStructure(1)%bvarStruct_init, & ! intent(inout): model basin (GRU) variables
+ outputStructure(1)%indxStruct_init, & ! intent(inout): model indices
+ err,message) ! intent(out): error control
+ if(err/=0)then; print*, message; return; endif
+
+ call check_icond(num_gru, &
+ outputStructure(1)%progStruct_init, & ! intent(inout): model prognostic variables
+ outputStructure(1)%mparStruct, & ! intent(in): model parameters
+ outputStructure(1)%indxStruct_init, & ! intent(inout): model indices
+ err,message) ! intent(out): error control
+ if(err/=0)then; print*, message; return; endif
+
+
+
+
+
+
+
+
+end subroutine fileAccessActor_init_fortran
+
+
subroutine updateFailed(indxHRU) bind(C, name="updateFailed")
USE globalData,only:failedHRUs
@@ -129,8 +401,6 @@ subroutine FileAccessActor_DeallocateStructures(handle_forcFileInfo, handle_ncid
USE globalData,only:forcingDataStruct
USE globalData,only:vectime
USE globalData,only:outputTimeStep
- USE globalData,only:init_cond_prog
- USE globalData,only:init_cond_bvar
implicit none
type(c_ptr),intent(in), value :: handle_forcFileInfo
type(c_ptr),intent(in), value :: handle_ncid
@@ -158,8 +428,6 @@ subroutine FileAccessActor_DeallocateStructures(handle_forcFileInfo, handle_ncid
deallocate(ncid)
deallocate(failedHRUs)
deallocate(outputTimeStep)
- deallocate(init_cond_prog)
- if (allocated(init_cond_bvar))then; deallocate(init_cond_bvar); endif;
end subroutine FileAccessActor_DeallocateStructures
diff --git a/build/source/actors/file_access_actor/fortran_code/output_structure.f90 b/build/source/actors/file_access_actor/fortran_code/output_structure.f90
index 8f0da6c06f27c25cadca4f8c771c559ccd5aa113..c1e85b115115a8455257afd42c3ff28e6ed9283f 100644
--- a/build/source/actors/file_access_actor/fortran_code/output_structure.f90
+++ b/build/source/actors/file_access_actor/fortran_code/output_structure.f90
@@ -1,24 +1,118 @@
module output_structure_module
USE nrtype
- USE data_types,only:summa_output_type
+ ! USE data_types,only:summa_output_type
+ USE data_types,only:&
+ ! final data vectors
+ dlength, & ! var%dat
+ ilength, & ! var%dat
+ ! no spatial dimension
+ var_i, & ! x%var(:) (i4b)
+ var_i8, & ! x%var(:) integer(8)
+ var_d, & ! x%var(:) (rkind)
+ var_flagVec, & ! x%var(:)%dat (logical)
+ var_ilength, & ! x%var(:)%dat (i4b)
+ var_dlength, & ! x%var(:)%dat (rkind)
+ ! gru dimension
+ gru_d, & ! x%gru(:)%var(:) (rkind)
+ gru_int, & ! x%gru(:)%var(:) (i4b)
+ gru_int8, & ! x%gru(:)%var(:) integer(8)
+ gru_double, & ! x%gru(:)%var(:) (rkind)
+ gru_intVec, & ! x%gru(:)%var(:)%dat (i4b)
+ gru_doubleVec, & ! x%gru(:)%var(:)%dat (rkind)
+ ! gru+hru dimension
+ gru_hru_int, & ! x%gru(:)%hru(:)%var(:) (i4b)
+ gru_hru_int8, & ! x%gru(:)%hru(:)%var(:) integer(8)
+ gru_hru_double, & ! x%gru(:)%hru(:)%var(:) (rkind)
+ gru_hru_intVec, & ! x%gru(:)%hru(:)%var(:)%dat (i4b)
+ gru_hru_doubleVec, & ! x%gru(:)%hru(:)%var(:)%dat (rkind)
+ ! gru+hru+z dimension
+ gru_hru_z_vLookup, & ! x%gru(:)%hru(:)%z(:)%var(:)%lookup (rkind)
+ ! structures that hold the time dimension
+ var_time_i8, & ! x%var(:)%tim(:) integer(8)
+ var_time_i, & ! x%var(:)%tim(:) (i4b)
+ var_time_d, & ! x%var(:)%tim(:) (rkind)
+ var_time_ilength, & ! x%var(:)%tim(:) (i4b)
+ var_time_dlength, & ! x%var(:)%tim(:) (rkind)
+ gru_hru_time_doublevec, & ! x%gru(:)%hru(:)%var(:)%tim(:)%dat (rkind)
+ gru_hru_time_int, & ! x%gru(:)%hru(:)%var(:)%tim(:) (i4b)
+ gru_hru_time_double, & ! x%gru(:)%hru(:)%var(:)%tim(:) (rkind)
+ gru_hru_time_intvec, & ! x%gru(:)%hru(:)%var(:)%tim(:)%dat (i4b)
+ gru_hru_time_flagvec
+
+
+
+ USE data_types,only:var_info
+ USE globalData,only:integerMissing
+ USE globalData,only:nBand ! number of spectral bands
+ USE globalData,only:nTimeDelay ! number of timesteps in the time delay histogram
+ USE var_lookup,only:maxvarFreq ! allocation dimension (output frequency)
+ USE var_lookup,only:iLookVarType ! look up structure for variable typed
+ USE var_lookup,only:iLookINDEX
USE, intrinsic :: iso_c_binding
implicit none
public::initOutputTimeStep
public::initOutputStructure
public::deallocateOutputStructure
public::deallocateData_output
+ public::alloc_outputStruc
+ public::allocateDat_rkind
+ public::allocateDat_int
+ private::is_var_desired
+
+ type, public :: summa_output_type
+ type(gru_hru_z_vLookup) :: lookupStruct ! x%gru(:)%hru(:)%z(:)%var(:)%lookup(:) -- lookup tables
+
+ ! define the statistics structures
+ type(gru_hru_time_doubleVec) :: forcStat ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model forcing data
+ type(gru_hru_time_doubleVec) :: progStat ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model prognostic (state) variables
+ type(gru_hru_time_doubleVec) :: diagStat ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model diagnostic variables
+ type(gru_hru_time_doubleVec) :: fluxStat ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model fluxes
+ type(gru_hru_time_doubleVec) :: indxStat ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model indices
+ type(gru_hru_time_doubleVec) :: bvarStat ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- basin-average variabl
+
+ ! define the primary data structures (scalars)
+ type(gru_hru_time_int) :: timeStruct ! x%gru(:)%hru(:)%var(:)%tim(:) -- model time data
+ type(gru_hru_time_double) :: forcStruct ! x%gru(:)%hru(:)%var(:)%tim(:) -- model forcing data
+ type(gru_hru_double) :: attrStruct ! x%gru(:)%hru(:)%var(:) -- local attributes for each HRU, DOES NOT CHANGE OVER TIMESTEPS
+ type(gru_hru_int) :: typeStruct ! x%gru(:)%hru(:)%var(:) -- local classification of soil veg etc. for each HRU, DOES NOT CHANGE OVER TIMESTEPS
+ type(gru_hru_int8) :: idStruct ! x%gru(:)%hru(:)%var(:)
+
+ ! define the primary data structures (variable length vectors)
+ type(gru_hru_time_intVec) :: indxStruct ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model indices
+ type(gru_hru_intVec) :: indxStruct_init ! x%gru(:)%hru(:)%var(:)%dat -- model indices
+ type(gru_hru_doubleVec) :: mparStruct ! x%gru(:)%hru(:)%var(:)%dat -- model parameters, DOES NOT CHANGE OVER TIMESTEPS TODO: MAYBE
+ type(gru_hru_time_doubleVec) :: progStruct ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model prognostic (state) variables
+ type(gru_hru_doubleVec) :: progStruct_init ! x%gru(:)%hru(:)%var(:)%dat -- model prognostic (state) variables
+ type(gru_hru_time_doubleVec) :: diagStruct ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model diagnostic variables
+ type(gru_hru_time_doubleVec) :: fluxStruct ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model fluxes
+
+ ! define the basin-average structures
+ type(gru_double) :: bparStruct ! x%gru(:)%var(:) -- basin-average parameters, DOES NOT CHANGE OVER TIMESTEPS
+ type(gru_hru_time_doubleVec) :: bvarStruct ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- basin-average variables
+ type(gru_doubleVec) :: bvarStruct_init ! x%gru(:)%hru(:)%var(:)%dat -- basin-average variables
+ ! define the ancillary data structures
+ type(gru_hru_double) :: dparStruct ! x%gru(:)%hru(:)%var(:)
+
+ ! finalize stats structure
+ type(gru_hru_time_flagVec) :: finalizeStats ! x%gru(:)%hru(:)%tim(:)%dat -- flags on when to write to file
+
+
+ type(gru_d) :: upArea
+
+ integer(i4b) :: nTimeSteps
+ end type summa_output_type
- type(summa_output_type),allocatable,save,public :: outputStructure(:) ! summa_OutputStructure(iFile)%struc%var(:)%dat(nTimeSteps)
+ type(summa_output_type),allocatable,save,public :: outputStructure(:) ! summa_OutputStructure(1)%struc%var(:)%dat(nTimeSteps)
contains
-subroutine initOutputTimeStep(num_gru, err) bind(C, name="initOutputTimeStep")
+subroutine initOutputTimeStep(num_gru, err)
USE globalData,only:outputTimeStep
USE var_lookup,only:maxvarFreq ! maximum number of output files
implicit none
- integer(c_int), intent(in) :: num_gru
- integer(c_int), intent(out) :: err
+ integer(i4b), intent(in) :: num_gru
+ integer(i4b), intent(out) :: err
! local variables
integer(i4b) :: iGRU
@@ -33,11 +127,12 @@ subroutine initOutputTimeStep(num_gru, err) bind(C, name="initOutputTimeStep")
end subroutine initOutputTimeStep
-subroutine initOutputStructure(handle_forcFileInfo, maxSteps, num_gru, err) bind(C, name="initOutputStructure")
+subroutine initOutputStructure(forcFileInfo, maxSteps, num_gru, err)
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
USE globalData,only:mpar_meta,indx_meta ! metadata structures
USE globalData,only:bpar_meta,bvar_meta ! metadata structures
+ USE globalData,only:lookup_meta
USE globalData,only:statForc_meta ! child metadata for stats
USE globalData,only:statProg_meta ! child metadata for stats
USE globalData,only:statDiag_meta ! child metadata for stats
@@ -46,19 +141,19 @@ subroutine initOutputStructure(handle_forcFileInfo, maxSteps, num_gru, err) bind
USE globalData,only:statBvar_meta ! child metadata for stats
USE globalData,only:gru_struc
USE globalData,only:structInfo ! information on the data structures
- USE alloc_outputStructure,only:alloc_outputStruc
- USE multiconst,only:secprday ! number of seconds in a day
+ USE multiconst,only:secprday ! number of seconds in a day
USE data_types,only:file_info_array
- USE var_lookup,only:maxvarFreq ! maximum number of output files
+ USE var_lookup,only:maxvarFreq ! maximum number of output files
+
+ USE allocspace_module,only:allocGlobal ! module to allocate space for global data structures
implicit none
- type(c_ptr), intent(in), value :: handle_forcFileInfo
- integer(c_int), intent(in) :: maxSteps
- integer(c_int), intent(in) :: num_gru
- integer(c_int), intent(out) :: err
+ type(file_info_array),intent(in) :: forcFileInfo
+ integer(i4b), intent(in) :: maxSteps
+ integer(i4b), intent(in) :: num_gru
+ integer(i4b), intent(out) :: err
! local variables
- type(file_info_array), pointer :: forcFileInfo
integer(i4b) :: nVars
integer(i4b) :: iGRU
@@ -70,104 +165,98 @@ subroutine initOutputStructure(handle_forcFileInfo, maxSteps, num_gru, err) bind
character(len=256) :: message
integer(i4b) :: num_hru
- call c_f_pointer(handle_forcFileInfo, forcFileInfo)
! Allocate structure to hold output files
if (.not.allocated(outputStructure))then
allocate(outputStructure(1))
else
- print*, "Already Allocated"
- return;
+ print*, "Already Allocated"; return;
end if
- ! Statistics Structures
- allocate(outputStructure(1)%forcStat(1))
- allocate(outputStructure(1)%progStat(1))
- allocate(outputStructure(1)%diagStat(1))
- allocate(outputStructure(1)%fluxStat(1))
- allocate(outputStructure(1)%indxStat(1))
- allocate(outputStructure(1)%bvarStat(1))
- 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))
+ ! LookupStructure
+ ! Statistics Structures
+ allocate(outputStructure(1)%forcStat%gru(num_gru))
+ allocate(outputStructure(1)%progStat%gru(num_gru))
+ allocate(outputStructure(1)%diagStat%gru(num_gru))
+ allocate(outputStructure(1)%fluxStat%gru(num_gru))
+ allocate(outputStructure(1)%indxStat%gru(num_gru))
+ allocate(outputStructure(1)%bvarStat%gru(num_gru))
! Primary Data Structures (scalars)
- allocate(outputStructure(1)%timeStruct(1))
- allocate(outputStructure(1)%forcStruct(1))
- allocate(outputStructure(1)%attrStruct(1))
- allocate(outputStructure(1)%typeStruct(1))
- allocate(outputStructure(1)%idStruct(1))
- 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))
-
+ allocate(outputStructure(1)%timeStruct%gru(num_gru))
+ allocate(outputStructure(1)%forcStruct%gru(num_gru))
! Primary Data Structures (variable length vectors)
- allocate(outputStructure(1)%indxStruct(1))
- allocate(outputStructure(1)%mparStruct(1))
- allocate(outputStructure(1)%progStruct(1))
- allocate(outputStructure(1)%diagStruct(1))
- allocate(outputStructure(1)%fluxStruct(1))
- 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))
-
+ allocate(outputStructure(1)%indxStruct%gru(num_gru))
+ allocate(outputStructure(1)%progStruct%gru(num_gru))
+ allocate(outputStructure(1)%diagStruct%gru(num_gru))
+ allocate(outputStructure(1)%fluxStruct%gru(num_gru))
! Basin-Average structures
- allocate(outputStructure(1)%bparStruct(1))
- allocate(outputStructure(1)%bvarStruct(1))
- 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))
-
+ allocate(outputStructure(1)%bvarStruct%gru(num_gru))
! Finalize Stats for writing
- allocate(outputStructure(1)%finalizeStats(1))
- allocate(outputStructure(1)%finalizeStats(1)%gru(num_gru))
+ allocate(outputStructure(1)%finalizeStats%gru(num_gru))
+ ! Extras
+ allocate(outputStructure(1)%upArea%gru(num_gru))
do iGRU = 1, num_gru
num_hru = gru_struc(iGRU)%hruCount
! Statistics Structures
- 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))
+ allocate(outputStructure(1)%forcStat%gru(iGRU)%hru(num_hru))
+ allocate(outputStructure(1)%progStat%gru(iGRU)%hru(num_hru))
+ allocate(outputStructure(1)%diagStat%gru(iGRU)%hru(num_hru))
+ allocate(outputStructure(1)%fluxStat%gru(iGRU)%hru(num_hru))
+ allocate(outputStructure(1)%indxStat%gru(iGRU)%hru(num_hru))
+ allocate(outputStructure(1)%bvarStat%gru(iGRU)%hru(num_hru))
! Primary Data Structures (scalars)
- 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))
-
+ allocate(outputStructure(1)%timeStruct%gru(iGRU)%hru(num_hru))
+ allocate(outputStructure(1)%forcStruct%gru(iGRU)%hru(num_hru))
+
! Primary Data Structures (variable length vectors)
- 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))
+ allocate(outputStructure(1)%indxStruct%gru(iGRU)%hru(num_hru))
+ allocate(outputStructure(1)%progStruct%gru(iGRU)%hru(num_hru))
+ allocate(outputStructure(1)%diagStruct%gru(iGRU)%hru(num_hru))
+ allocate(outputStructure(1)%fluxStruct%gru(iGRU)%hru(num_hru))
! Basin-Average structures
- allocate(outputStructure(1)%bvarStruct(1)%gru(iGRU)%hru(num_hru))
+ allocate(outputStructure(1)%bvarStruct%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(num_hru))
+ allocate(outputStructure(1)%finalizeStats%gru(iGRU)%hru(num_hru))
+
+ allocate(outputStructure(1)%upArea%gru(iGRU)%hru(num_hru))
end do
+
+ ! Allocate variables that do not require time
+ do iStruct=1,size(structInfo)
+ select case(trim(structInfo(iStruct)%structName))
+ case('time'); cycle;
+ case('forc'); cycle;
+ case('attr'); call allocGlobal(attr_meta, outputStructure(1)%attrStruct, err, message)
+ case('type'); call allocGlobal(type_meta, outputStructure(1)%typeStruct, err, message)
+ case('id' ); call allocGlobal(id_meta, outputStructure(1)%idStruct, err, message)
+ case('mpar'); call allocGlobal(mpar_meta, outputStructure(1)%mparStruct, err, message);
+ case('indx'); call allocGlobal(indx_meta, outputStructure(1)%indxStruct_init, err, message);
+ case('prog'); call allocGlobal(prog_meta, outputStructure(1)%progStruct_init, err, message);
+ case('diag'); cycle;
+ case('flux'); cycle;
+ case('bpar'); call allocGlobal(bpar_meta,outputStructure(1)%bparStruct ,err, message); ! basin-average params
+ case('bvar'); call allocGlobal(bvar_meta,outputStructure(1)%bvarStruct_init,err,message); ! basin-average variables
+ case('deriv'); cycle;
+ case('lookup'); call allocGlobal(lookup_meta,outputStructure(1)%lookupStruct,err, message);
+ end select
+ end do
+
+
+ call allocGlobal(mpar_meta,outputStructure(1)%dparStruct,err,message);
+
+
+
do iGRU=1,num_gru
do iHRU=1,gru_struc(iGRU)%hruCount
@@ -180,70 +269,58 @@ subroutine initOutputStructure(handle_forcFileInfo, maxSteps, num_gru, err) bind
! allocate space structures
select case(trim(structInfo(iStruct)%structName))
case('time')
- call alloc_outputStruc(time_meta,outputStructure(1)%timeStruct(1)%gru(iGRU)%hru(iHRU), &
+ call alloc_outputStruc(time_meta,outputStructure(1)%timeStruct%gru(iGRU)%hru(iHRU), &
nSteps=maxSteps,err=err,message=message) ! model forcing data
case('forc')
! Structure
- call alloc_outputStruc(forc_meta,outputStructure(1)%forcStruct(1)%gru(iGRU)%hru(iHRU), &
+ call alloc_outputStruc(forc_meta,outputStructure(1)%forcStruct%gru(iGRU)%hru(iHRU), &
nSteps=maxSteps,nSnow=nSnow,nSoil=nSoil,err=err,message=message); ! model forcing data
! Statistics
- call alloc_outputStruc(statForc_meta(:)%var_info,outputStructure(1)%forcStat(1)%gru(iGRU)%hru(iHRU), &
+ call alloc_outputStruc(statForc_meta(:)%var_info,outputStructure(1)%forcStat%gru(iGRU)%hru(iHRU), &
nSteps=maxSteps,nSnow=nSnow,nSoil=nSoil,err=err,message=message); ! model forcing data
- case('attr')
- call alloc_outputStruc(attr_meta,outputStructure(1)%attrStruct(1)%gru(iGRU)%hru(iHRU), &
- nSteps=maxSteps,nSnow=nSnow,nSoil=nSoil,err=err,message=message); ! local attributes for each HRU
- case('type')
- call alloc_outputStruc(type_meta,outputStructure(1)%typeStruct(1)%gru(iGRU)%hru(iHRU), &
- nSteps=maxSteps,nSnow=nSnow,nSoil=nSoil,err=err,message=message); ! classification of soil veg etc.
- case('id' )
- call alloc_outputStruc(id_meta,outputStructure(1)%idStruct(1)%gru(iGRU)%hru(iHRU), &
- nSteps=maxSteps,nSnow=nSnow,nSoil=nSoil,err=err,message=message); ! local values of hru gru IDs
- case('mpar') ! model parameters
- call alloc_outputStruc(mpar_meta,outputStructure(1)%mparStruct(1)%gru(iGRU)%hru(iHRU), &
- nSteps=maxSteps,nSnow=nSnow,nSoil=nSoil,err=err,message=message);
-
- call alloc_outputStruc(mpar_meta, outputStructure(1)%dparStruct(1)%gru(iGRU)%hru(iHRU), &
- nSteps=maxSteps,err=err,message=message)
+ case('attr'); cycle;
+ ! call allocGlobal(attr_meta, outputStructure(1)%attrStruct(1)%gru(iGRU)%hru(iHRU), err, message)
+ case('type'); cycle;
+ case('id' ); cycle;
+ case('mpar'); cycle;
case('indx')
! Structure
- call alloc_outputStruc(indx_meta,outputStructure(1)%indxStruct(1)%gru(iGRU)%hru(iHRU), &
+ call alloc_outputStruc(indx_meta,outputStructure(1)%indxStruct%gru(iGRU)%hru(iHRU), &
nSteps=maxSteps,nSnow=nSnow,nSoil=nSoil,err=err,str_name='indx',message=message); ! model variables
! Statistics
- call alloc_outputStruc(statIndx_meta(:)%var_info,outputStructure(1)%indxStat(1)%gru(iGRU)%hru(1), &
+ call alloc_outputStruc(statIndx_meta(:)%var_info,outputStructure(1)%indxStat%gru(iGRU)%hru(1), &
nSteps=maxSteps,nSnow=nSnow,nSoil=nSoil,err=err,message=message); ! index vars
case('prog')
! Structure
- call alloc_outputStruc(prog_meta,outputStructure(1)%progStruct(1)%gru(iGRU)%hru(iHRU), &
+ call alloc_outputStruc(prog_meta,outputStructure(1)%progStruct%gru(iGRU)%hru(iHRU), &
nSteps=maxSteps,nSnow=nSnow,nSoil=nSoil,err=err,message=message); ! model prognostic (state) variables
! Statistics
- call alloc_outputStruc(statProg_meta(:)%var_info,outputStructure(1)%progStat(1)%gru(iGRU)%hru(iHRU), &
+ call alloc_outputStruc(statProg_meta(:)%var_info,outputStructure(1)%progStat%gru(iGRU)%hru(iHRU), &
nSteps=maxSteps,nSnow=nSnow,nSoil=nSoil,err=err,message=message); ! model prognostic
case('diag')
! Structure
- call alloc_outputStruc(diag_meta,outputStructure(1)%diagStruct(1)%gru(iGRU)%hru(iHRU), &
+ call alloc_outputStruc(diag_meta,outputStructure(1)%diagStruct%gru(iGRU)%hru(iHRU), &
nSteps=maxSteps,nSnow=nSnow,nSoil=nSoil,err=err,message=message); ! model diagnostic variables
! Statistics
- call alloc_outputStruc(statDiag_meta(:)%var_info,outputStructure(1)%diagStat(1)%gru(iGRU)%hru(iHRU), &
+ call alloc_outputStruc(statDiag_meta(:)%var_info,outputStructure(1)%diagStat%gru(iGRU)%hru(iHRU), &
nSteps=maxSteps,nSnow=nSnow,nSoil=nSoil,err=err,message=message); ! model diagnostic
case('flux')
! Structure
- call alloc_outputStruc(flux_meta,outputStructure(1)%fluxStruct(1)%gru(iGRU)%hru(iHRU), &
+ call alloc_outputStruc(flux_meta,outputStructure(1)%fluxStruct%gru(iGRU)%hru(iHRU), &
nSteps=maxSteps,nSnow=nSnow,nSoil=nSoil,err=err,message=message); ! model fluxes
! Statistics
- call alloc_outputStruc(statFlux_meta(:)%var_info,outputStructure(1)%fluxStat(1)%gru(iGRU)%hru(iHRU), &
+ call alloc_outputStruc(statFlux_meta(:)%var_info,outputStructure(1)%fluxStat%gru(iGRU)%hru(iHRU), &
nSteps=maxSteps,nSnow=nSnow,nSoil=nSoil,err=err,message=message); ! model fluxes
- case('bpar')
- call alloc_outputStruc(bpar_meta,outputStructure(1)%bparStruct(1)%gru(iGRU), &
- nSteps=maxSteps,nSnow=0,nSoil=0,err=err,message=message); ! basin-average params
+ case('bpar'); cycle;
case('bvar')
! Structure
- call alloc_outputStruc(bvar_meta,outputStructure(1)%bvarStruct(1)%gru(iGRU)%hru(iHRU), &
+ call alloc_outputStruc(bvar_meta,outputStructure(1)%bvarStruct%gru(iGRU)%hru(iHRU), &
nSteps=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), &
+ call alloc_outputStruc(statBvar_meta(:)%var_info,outputStructure(1)%bvarStat%gru(iGRU)%hru(iHRU), &
nSteps=maxSteps,nSnow=0,nSoil=0,err=err,message=message); ! basin-average variables
case('deriv'); cycle
- case('lookup'); cycle
+ case('lookup'); cycle ! lookup tables
case default; err=20; message='unable to find structure name: '//trim(structInfo(iStruct)%structName)
end select
@@ -256,14 +333,15 @@ subroutine initOutputStructure(handle_forcFileInfo, maxSteps, num_gru, err) bind
end do ! looping through data structures
! Finalize stats structure for writing to output file
- allocate(outputStructure(1)%finalizeStats(1)%gru(iGRU)%hru(iHRU)%tim(maxSteps))
+ allocate(outputStructure(1)%finalizeStats%gru(iGRU)%hru(iHRU)%tim(maxSteps))
do iStep = 1, maxSteps
- allocate(outputStructure(1)%finalizeStats(1)%gru(iGRU)%hru(iHRU)%tim(iStep)%dat(1:maxVarFreq))
+ allocate(outputStructure(1)%finalizeStats%gru(iGRU)%hru(iHRU)%tim(iStep)%dat(1:maxVarFreq))
end do ! timeSteps
end do ! Looping through GRUs
end do
+
end subroutine initOutputStructure
subroutine deallocateOutputStructure(err) bind(C, name="deallocateOutputStructure")
@@ -271,39 +349,7 @@ subroutine deallocateOutputStructure(err) bind(C, name="deallocateOutputStructur
integer(i4b), intent(inout) :: err
err = 0
- ! Time
deallocate(outputStructure)
- ! call deallocateData_output(outputStructure(1)%timeStruct(1)); deallocate(outputStructure(1)%timeStruct)
- ! ! Forc
- ! call deallocateData_output(outputStructure(1)%forcStat(1)); deallocate(outputStructure(1)%forcStat)
- ! call deallocateData_output(outputStructure(1)%forcStruct(1)); deallocate(outputStructure(1)%forcStruct)
- ! ! prog
- ! call deallocateData_output(outputStructure(1)%progStat(1)); deallocate(outputStructure(1)%progStat)
- ! call deallocateData_output(outputStructure(1)%progStruct(1)); deallocate(outputStructure(1)%progStruct)
- ! ! diag
- ! call deallocateData_output(outputStructure(1)%diagStat(1)); deallocate(outputStructure(1)%diagStat)
- ! call deallocateData_output(outputStructure(1)%diagStruct(1)); deallocate(outputStructure(1)%diagStruct)
- ! ! flux
- ! call deallocateData_output(outputStructure(1)%fluxStat(1)); deallocate(outputStructure(1)%fluxStat)
- ! call deallocateData_output(outputStructure(1)%fluxStruct(1)); deallocate(outputStructure(1)%fluxStruct)
- ! ! indx
- ! call deallocateData_output(outputStructure(1)%indxStat(1)); deallocate(outputStructure(1)%indxStat)
- ! call deallocateData_output(outputStructure(1)%indxStruct(1)); deallocate(outputStructure(1)%indxStruct)
- ! ! bvar
- ! call deallocateData_output(outputStructure(1)%bvarStat(1)); deallocate(outputStructure(1)%bvarStat)
- ! call deallocateData_output(outputStructure(1)%bvarStruct(1)); deallocate(outputStructure(1)%bvarStruct)
- ! ! id
- ! call deallocateData_output(outputStructure(1)%idStruct(1)); deallocate(outputStructure(1)%idStruct)
- ! ! attr
- ! call deallocateData_output(outputStructure(1)%attrStruct(1)); deallocate(outputStructure(1)%attrStruct)
- ! ! type
- ! call deallocateData_output(outputStructure(1)%typeStruct(1)); deallocate(outputStructure(1)%typeStruct)
- ! ! mpar
- ! call deallocateData_output(outputStructure(1)%mparStruct(1)); deallocate(outputStructure(1)%mparStruct)
- ! ! bpar
- ! call deallocateData_output(outputStructure(1)%bparStruct(1)); deallocate(outputStructure(1)%bparStruct)
- ! ! finalize stats
- ! call deallocateData_output(outputStructure(1)%finalizeStats(1)); deallocate(outputStructure(1)%finalizeStats)
end subroutine deallocateOutputStructure
@@ -433,5 +479,303 @@ subroutine deallocateData_output(dataStruct)
end subroutine
+logical function is_var_desired(metaStruct, iVar)
+ implicit none
+ type(var_info),intent(in) :: metaStruct(:)
+ integer(i4b),intent(in) :: iVar
+ ! local
+ integer(i4b) :: iFreq
+ ! initalize error control
+ is_var_desired=.false.
+ do iFreq=1,maxvarFreq
+ if(metaStruct(iVar)%statIndex(iFreq) /= integerMissing)then
+ is_var_desired=.true.
+ exit
+ end if
+ end do
+
+end function is_var_desired
+
+subroutine alloc_outputStruc(metaStruct,dataStruct,nSteps,nSnow,nSoil,str_name,err,message)
+ implicit none
+ type(var_info),intent(in) :: metaStruct(:)
+ class(*),intent(inout) :: dataStruct
+ ! optional input
+ integer(i4b),intent(in),optional :: nSteps
+ integer(i4b),intent(in),optional :: nSnow ! number of snow layers
+ integer(i4b),intent(in),optional :: nSoil ! number of soil layers
+ character(len=*),intent(in),optional :: str_name ! name of the structure to allocate
+ ! output
+ integer(i4b),intent(inout) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! local
+ logical(lgt) :: check ! .true. if the variables are allocated
+ integer(i4b) :: nVars ! number of variables in the metadata structure
+ integer(i4b) :: nLayers ! total number of layers
+ integer(i4b) :: iVar
+ integer(i4b) :: iStat ! checks if we want this variable
+ character(len=256) :: cmessage ! error message of the downwind routine
+ ! initalize error control
+ 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'; print*,message; return; end if
+ if(.not.present(nSnow))then; err=20; message=trim(message)//'expect nSnow to be present when nSoil is present'; print*,message; 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_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'; print*,message; return; end if
+ end if
+
+ check=.false.
+ ! allocate the space for the variables and thier time steps in the output structure
+ 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
+ ! Check if this variable is desired within any timeframe
+ if(is_var_desired(metaStruct,iVar))then
+ allocate(dataStruct%var(iVar)%tim(nSteps))
+ end if
+ 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
+ ! Check if this variable is desired within any timeframe
+ if(is_var_desired(metaStruct,iVar))then
+ allocate(dataStruct%var(iVar)%tim(nSteps))
+ end if
+ 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
+ ! Check if this variable is desired within any timeframe
+ if(is_var_desired(metaStruct,iVar))then
+ allocate(dataStruct%var(iVar)%tim(nSteps))
+ end if
+ 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)
+ call allocateDat_rkind(metaStruct,dataStruct,nSnow,nSoil,err,cmessage)
+ 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
+ ! Check if this variable is desired within any timeframe
+ if(is_var_desired(metaStruct,iVar) .or. (present(str_name) .and. &
+ ((iVar == iLookINDEX%nLayers) .or. (iVar == iLookINDEX%nSnow) .or. (iVar == iLookINDEX%nSoil)) ))then
+ allocate(dataStruct%var(iVar)%tim(nSteps))
+ call allocateDat_int(metaStruct,dataStruct,nSnow,nSoil,nSteps,iVar,err,cmessage)
+ end if
+ 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
+ ! Check if this variable is desired within any timeframe
+ if(is_var_desired(metaStruct,iVar))then
+ allocate(dataStruct%var(iVar)%tim(nSteps))
+ call allocateDat_rkind_nSteps(metaStruct,dataStruct,nSnow,nSoil,nSteps,iVar,err,cmessage)
+ end if
+ end do
+ ! ****************************************************
+ class default; err=20; message=trim(message)//'unable to identify derived data type for the variable dimension'; print*,message;return
+ end select
+ ! check errors
+ if(check) then; err=20; message=trim(message)//'structure was unexpectedly allocated already'; print*,message; return; end if
+ if(err/=0)then; err=20; message=trim(message)//'problem allocating'; print*,message; return; end if
+
+ ! check errors
+ if(err/=0)then; message=trim(message)//trim(cmessage); print*, message; return; end if
+end subroutine
+
+subroutine allocateDat_rkind_nSteps(metadata,varData,nSnow, nSoil, &
+ nSteps,iVar,err,message)
+
+ USE get_ixName_module,only:get_varTypeName ! to access type strings for error messages
+
+ implicit none
+ type(var_info),intent(in) :: metadata(:)
+ ! output variables
+ type(var_time_dlength),intent(inout) :: varData ! model variables for a local HRU
+ integer(i4b),intent(in) :: nSnow
+ integer(i4b),intent(in) :: nSoil
+ integer(i4b),intent(in) :: nSteps
+ integer(i4b),intent(in) :: iVar
+ integer(i4b),intent(inout) :: err ! error code
+ character(*),intent(inout) :: message ! error message
+
+ ! local variables
+ integer(i4b) :: iStep
+ integer(i4b) :: nLayers
+ message='allocateDat_rkindAccessActor'
+
+ nLayers = nSnow+nSoil
+ do iStep=1, nSteps
+ select case(metadata(iVar)%vartype)
+ case(iLookVarType%scalarv); allocate(varData%var(iVar)%tim(iStep)%dat(1),stat=err)
+ case(iLookVarType%wLength); allocate(varData%var(iVar)%tim(iStep)%dat(nBand),stat=err)
+ case(iLookVarType%midSnow); allocate(varData%var(iVar)%tim(iStep)%dat(nSnow),stat=err)
+ case(iLookVarType%midSoil); allocate(varData%var(iVar)%tim(iStep)%dat(nSoil),stat=err)
+ case(iLookVarType%midToto); allocate(varData%var(iVar)%tim(iStep)%dat(nLayers),stat=err)
+ case(iLookVarType%ifcSnow); allocate(varData%var(iVar)%tim(iStep)%dat(0:nSnow),stat=err)
+ case(iLookVarType%ifcSoil); allocate(varData%var(iVar)%tim(iStep)%dat(0:nSoil),stat=err)
+ case(iLookVarType%ifcToto); allocate(varData%var(iVar)%tim(iStep)%dat(0:nLayers),stat=err)
+ case(iLookVarType%parSoil); allocate(varData%var(iVar)%tim(iStep)%dat(nSoil),stat=err)
+ case(iLookVarType%routing); allocate(varData%var(iVar)%tim(iStep)%dat(nTimeDelay),stat=err)
+ case(iLookVarType%outstat); allocate(varData%var(iVar)%tim(iStep)%dat(maxvarfreq*2),stat=err)
+ case(iLookVarType%unknown); allocate(varData%var(iVar)%tim(iStep)%dat(0),stat=err)
+ case default
+ err=40; message=trim(message)//"1. unknownVariableType[name='"//trim(metadata(iVar)%varname)//"'; type='"//trim(get_varTypeName(metadata(iVar)%vartype))//"']"
+ return
+ end select
+ end do ! (iStep)
+
+end subroutine allocateDat_rkind_nSteps
+
+subroutine allocateDat_rkind(metadata,varData,nSnow,nSoil,err,message)
+ USE get_ixName_module,only:get_varTypeName ! to access type strings for error messages
+ implicit none
+ type(var_info),intent(in) :: metadata(:)
+ ! output variables
+ type(var_dlength),intent(inout) :: varData ! model variables for a local HRU
+ integer(i4b),intent(in) :: nSnow
+ integer(i4b),intent(in) :: nSoil
+
+ integer(i4b),intent(inout) :: err ! error code
+ character(*),intent(inout) :: message ! error message
+
+ ! local variables
+ integer(i4b) :: nVars
+ integer(i4b) :: iVar
+ integer(i4b) :: nLayers
+ message='allocateDat_rkindAccessActor'
+
+ nVars = size(metaData)
+ nLayers = nSnow+nSoil
+ do iVar=1, nVars
+ select case(metadata(iVar)%vartype)
+ case(iLookVarType%scalarv); allocate(varData%var(iVar)%dat(1),stat=err)
+ case(iLookVarType%wLength); allocate(varData%var(iVar)%dat(nBand),stat=err)
+ case(iLookVarType%midSnow); allocate(varData%var(iVar)%dat(nSnow),stat=err)
+ case(iLookVarType%midSoil); allocate(varData%var(iVar)%dat(nSoil),stat=err)
+ case(iLookVarType%midToto); allocate(varData%var(iVar)%dat(nLayers),stat=err)
+ case(iLookVarType%ifcSnow); allocate(varData%var(iVar)%dat(0:nSnow),stat=err)
+ case(iLookVarType%ifcSoil); allocate(varData%var(iVar)%dat(0:nSoil),stat=err)
+ case(iLookVarType%ifcToto); allocate(varData%var(iVar)%dat(0:nLayers),stat=err)
+ case(iLookVarType%parSoil); allocate(varData%var(iVar)%dat(nSoil),stat=err)
+ case(iLookVarType%routing); allocate(varData%var(iVar)%dat(nTimeDelay),stat=err)
+ case(iLookVarType%outstat); allocate(varData%var(iVar)%dat(maxvarfreq*2),stat=err)
+ case(iLookVarType%unknown); allocate(varData%var(iVar)%dat(0),stat=err)
+ case default
+ err=40; message=trim(message)//"1. unknownVariableType[name='"//trim(metadata(iVar)%varname)//"'; type='"//trim(get_varTypeName(metadata(iVar)%vartype))//"']"
+ return
+ end select
+ end do
+
+end subroutine allocateDat_rkind
+
+subroutine allocateDat_int(metadata,varData,nSnow, nSoil, &
+ nSteps,iVar,err,message)
+ USE get_ixName_module,only:get_varTypeName ! to access type strings for error messages
+
+ implicit none
+ type(var_info),intent(in) :: metadata(:)
+ ! output variables
+ type(var_time_ilength),intent(inout) :: varData ! model variables for a local HRU
+ integer(i4b),intent(in) :: nSnow
+ integer(i4b),intent(in) :: nSoil
+ integer(i4b),intent(in) :: nSteps
+ integer(i4b),intent(in) :: iVar
+ integer(i4b),intent(inout) :: err ! error code
+ character(*),intent(inout) :: message ! error message
+ ! local variables
+ integer(i4b) :: iStep
+ integer(i4b) :: nLayers
+ message='allocateDat_rkindAccessActor'
+
+ nLayers = nSnow+nSoil
+ do iStep=1, nSteps
+ select case(metadata(iVar)%vartype)
+ case(iLookVarType%scalarv); allocate(varData%var(iVar)%tim(iStep)%dat(1),stat=err)
+ case(iLookVarType%wLength); allocate(varData%var(iVar)%tim(iStep)%dat(nBand),stat=err)
+ case(iLookVarType%midSnow); allocate(varData%var(iVar)%tim(iStep)%dat(nSnow),stat=err)
+ case(iLookVarType%midSoil); allocate(varData%var(iVar)%tim(iStep)%dat(nSoil),stat=err)
+ case(iLookVarType%midToto); allocate(varData%var(iVar)%tim(iStep)%dat(nLayers),stat=err)
+ case(iLookVarType%ifcSnow); allocate(varData%var(iVar)%tim(iStep)%dat(0:nSnow),stat=err)
+ case(iLookVarType%ifcSoil); allocate(varData%var(iVar)%tim(iStep)%dat(0:nSoil),stat=err)
+ case(iLookVarType%ifcToto); allocate(varData%var(iVar)%tim(iStep)%dat(0:nLayers),stat=err)
+ case(iLookVarType%parSoil); allocate(varData%var(iVar)%tim(iStep)%dat(nSoil),stat=err)
+ case(iLookVarType%routing); allocate(varData%var(iVar)%tim(iStep)%dat(nTimeDelay),stat=err)
+ case(iLookVarType%outstat); allocate(varData%var(iVar)%tim(iStep)%dat(maxvarfreq*2),stat=err)
+ case(iLookVarType%unknown); allocate(varData%var(iVar)%tim(iStep)%dat(0),stat=err)
+ case default
+ err=40; message=trim(message)//"1. unknownVariableType[name='"//trim(metadata(iVar)%varname)//"'; type='"//trim(get_varTypeName(metadata(iVar)%vartype))//"']"
+ return
+ end select
+ end do ! loop through time steps
+end subroutine
+
end module output_structure_module
\ No newline at end of file
diff --git a/build/source/actors/file_access_actor/fortran_code/read_attrb.f90 b/build/source/actors/file_access_actor/fortran_code/read_attrb.f90
deleted file mode 100644
index 7c58fabe9f92c8bfe986aac057a2f6d6a6dd25c3..0000000000000000000000000000000000000000
--- a/build/source/actors/file_access_actor/fortran_code/read_attrb.f90
+++ /dev/null
@@ -1,356 +0,0 @@
-module read_attrb_module
-USE, intrinsic :: iso_c_binding
-USE nrtype
-
-implicit none
-private
-public::allocateAttributeStructures
-public::openAttributeFile
-public::getNumVarAttr
-public::closeAttributeFile
-public::readAttributeFromNetCDF
-
-contains
-
-subroutine allocateAttributeStructures(index_gru, index_hru, & ! indexes into gru_struc
- handle_attr_struct, handle_type_struct, handle_id_struct, err) bind(C, name="allocateAttributeStructures")
- USE data_types,only:var_d, var_i, var_i8
- USE globalData,only:gru_struc
- USE globalData,only:attr_meta,type_meta,id_meta
- USE allocspace_module,only:allocLocal
- implicit none
- integer(c_int),intent(in) :: index_gru
- integer(c_int),intent(in) :: index_hru
- type(c_ptr), intent(in), value :: handle_attr_struct
- type(c_ptr), intent(in), value :: handle_type_struct
- type(c_ptr), intent(in), value :: handle_id_struct
- integer(c_int), intent(out) :: err
- type(var_d), pointer :: attr_struct
- type(var_i), pointer :: type_struct
- type(var_i8), pointer :: id_struct
- integer(i4b) :: nSoil
- integer(i4b) :: nSnow
- character(len=256) :: message
- ! ---------------------------------------------------------------------------------------
- ! * Convert From C++ to Fortran
- ! ---------------------------------------------------------------------------------------
- call c_f_pointer(handle_attr_struct, attr_struct)
- call c_f_pointer(handle_type_struct, type_struct)
- call c_f_pointer(handle_id_struct, id_struct)
- ! Start subroutine
- err=0; message="read_attrb.f90 - allocateAttributeStructures"
-
- nSnow = gru_struc(index_gru)%hruInfo(index_hru)%nSnow
- nSoil = gru_struc(index_gru)%hruInfo(index_hru)%nSoil
-
- call allocLocal(attr_meta,attr_struct,nSnow,nSoil,err,message);
- call allocLocal(type_meta,type_struct,nSnow,nSoil,err,message);
- call allocLocal(id_meta,id_struct,nSnow,nSoil,err,message);
- if(err/=0)then; message=trim(message); print*, message; return; endif;
-
-end subroutine allocateAttributeStructures
-
-
-subroutine openAttributeFile(attr_ncid, err) bind(C, name="openAttributeFile")
- USE netcdf
- USE netcdf_util_module,only:nc_file_open ! open netcdf file
- ! Attribute File
- USE summaFileManager,only:SETTINGS_PATH ! define path to settings files (e.g., parameters, soil and veg. tables)
- USE summaFileManager,only:LOCAL_ATTRIBUTES ! name of model initial attributes file
- implicit none
- integer(c_int),intent(out) :: attr_ncid
- integer(c_int),intent(out) :: err
-
- ! local variables
- character(len=256) :: message ! error message
- character(len=256) :: attrFile ! attributes file name
-
- err=0; message="read_attrb.f90 - openAttributesFile"
- attrFile = trim(SETTINGS_PATH)//trim(LOCAL_ATTRIBUTES)
-
- call nc_file_open(trim(attrFile),nf90_noWrite,attr_ncid,err,message)
- if(err/=0)then
- message=trim(message)
- print*, message
- return
- endif
-
-end subroutine
-
-subroutine getNumVarAttr(attr_ncid, num_var, err) bind(C, name="getNumVarAttr")
- USE netcdf
- USE netcdf_util_module,only:netcdf_err ! netcdf error handling function
- implicit none
- integer(c_int),intent(in) :: attr_ncid
- integer(c_int),intent(out) :: num_var
- integer(c_int),intent(out) :: err
-
- ! local variables
- character(len=256) :: message ! error message
- err=0; message="read_attrb.f90 - getNumVar"
- ! get number of variables total in netcdf file
- err = nf90_inquire(attr_ncid,nvariables=num_var)
- call netcdf_err(err,message)
- if (err/=0) then
- message=trim(message)//'problem with nf90_inquire'
- return
- endif
-
-end subroutine getNumVarAttr
-
-subroutine closeAttributeFile(attr_ncid, err) bind(C, name="closeAttributeFile")
- USE netcdf_util_module,only:nc_file_close
- implicit none
- integer(c_int),intent(in) :: attr_ncid
- integer(c_int),intent(out) :: err
- ! local variables
- character(len=256) :: message
- err=0; message="read_attrb.f90 - closeAttributeFile"
-
- call nc_file_close(attr_ncid,err,message)
- if (err/=0)then
- message=trim(message)
- return
- end if
-
-end subroutine closeAttributeFile
-
-
-
-! Read in the local attributes for an HRU
-subroutine readAttributeFromNetCDF(ncid, index_gru, index_hru, num_var, &
- handle_attr_struct, handle_type_struct, handle_id_struct, err) bind(C, name="readAttributeFromNetCDF")
- ! netcdf utilities
- 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 nr_utility_module ,only:arth
- ! needed global data structures and metadata
- 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
- ! Information to make up the attributes file
- USE summaFileManager,only:SETTINGS_PATH ! define path to settings files (e.g., parameters, soil and veg. tables)
- USE summaFileManager,only:LOCAL_ATTRIBUTES ! name of model initial attributes file
- ! Fortran Data Type Structures
- USE data_types,only:var_d, var_i, var_i8
- implicit none
- ! indexes into gru_struc
- integer(c_int), intent(in) :: ncid
- integer(c_int), intent(in) :: index_gru
- integer(c_int), intent(in) :: index_hru
- ! number of variables from the netCDF file
- integer(c_int), intent(in) :: num_var
- ! data structures to populate
- type(c_ptr), intent(in), value :: handle_attr_struct
- type(c_ptr), intent(in), value :: handle_type_struct
- type(c_ptr), intent(in), value :: handle_id_struct
- ! error control
- integer(c_int), intent(out) :: err
- ! local variables
- 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
- ! Fortran structures
- type(var_d), pointer :: attr_struct
- type(var_i), pointer :: type_struct
- type(var_i8), pointer :: id_struct
- ! check structures - to verify input
- 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
- character(LEN=nf90_max_name) :: varName ! character array of netcdf variable name
- 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(rkind) :: 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
- character(len=256) :: attr_file ! attributes file name
- character(len=256) :: message
- ! ---------------------------------------------------------------------------------------
- ! * Convert From C++ to Fortran
- ! ---------------------------------------------------------------------------------------
- call c_f_pointer(handle_attr_struct, attr_struct)
- call c_f_pointer(handle_type_struct, type_struct)
- call c_f_pointer(handle_id_struct, id_struct)
-
- err=0; message="read_attrb_file_access_actor - read_attrb.f90"
-
- attr_file= 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.
-
- iCheck = 1
- do iVar = 1,num_var
- ! 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
-
-
- err = nf90_get_var(ncID,iVar,categorical_var,start=(/gru_struc(index_gru)%hruInfo(index_hru)%hru_nc/),count=(/1/))
- if(err/=nf90_noerr)then
- message=trim(message)//'problem reading: '//trim(varName)
- print*, message
- return
- end if
- type_struct%var(varIndx) = categorical_var(1)
-
- ! ** ID related data
- case('hruId')
- ! get the index of the variable
- varType = idrelated
- varIndx = get_ixId(varName)
- checkId(varIndx) = .true.
-
- ! check that the variable could be identified in the data structure
- if(varIndx < 1)then
- err=20
- message=trim(message)//'unable to find variable ['//trim(varName)//'] in data structure'
- print*, message
- return
- endif
-
- ! get data from netcdf file and store in vector
-
- err = nf90_get_var(ncID,iVar,idrelated_var,start=(/gru_struc(index_gru)%hruInfo(index_hru)%hru_nc/),count=(/1/))
- if(err/=nf90_noerr)then
- message=trim(message)//'problem reading: '//trim(varName)
- print*, message
- return
- end if
- id_struct%var(varIndx) = idrelated_var(1)
-
-
- ! ** 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
-
- err = nf90_get_var(ncID,iVar,numeric_var,start=(/gru_struc(index_gru)%hruInfo(index_hru)%hru_nc/),count=(/1/))
- if(err/=nf90_noerr)then
- message=trim(message)//'problem reading: '//trim(varName)
- print*, message
- return
- end if
- attr_struct%var(varIndx) = numeric_var(1)
-
-
- ! 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
- if (index_gru == 1) then
- write(*,*) NEW_LINE('A')//'INFO: aspect not found in the input attribute file, continuing ...'//NEW_LINE('A')
- endif
- attr_struct%var(varIndx) = nr_realMissing ! populate variable with out-of-range value, used later
- checkAttr(varIndx) = .true.
- endif
-
- ! **********************************************************************************************
- ! (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
-
- ! free memory
- deallocate(checkType)
- deallocate(checkId)
- deallocate(checkAttr)
-end subroutine readAttributeFromNetCDF
-end module read_attrb_module
diff --git a/build/source/actors/file_access_actor/fortran_code/read_icondFromStructure.f90 b/build/source/actors/file_access_actor/fortran_code/read_icondFromStructure.f90
deleted file mode 100644
index 6eabadd6706558e8b8c79cdee7978d90cdb1edc5..0000000000000000000000000000000000000000
--- a/build/source/actors/file_access_actor/fortran_code/read_icondFromStructure.f90
+++ /dev/null
@@ -1,280 +0,0 @@
-module read_icondFromStructure_module
-USE, intrinsic :: iso_c_binding
-USE nrtype
-
-
-implicit none
-private
-public :: openInitCondFile
-public :: closeInitCondFile
-public :: readInitCond_prog
-public :: readInitCond_bvar
-
-! define single HRU restart file
-integer(i4b), parameter :: singleHRU=1001
-integer(i4b), parameter :: multiHRU=1002
-integer(i4b), parameter :: restartFileType=multiHRU
-contains
-
-subroutine openInitCondFile(init_cond_ncid, err) bind(C, name="openInitCondFile")
- USE netcdf_util_module,only:nc_file_open ! open netcdf file
- USE netcdf
- ! file paths
- USE summaFileManager,only:SETTINGS_PATH ! path to settings files (e.g., Noah vegetation tables)
- USE summaFileManager,only:STATE_PATH ! optional path to state/init. condition files (defaults to SETTINGS_PATH)
- USE summaFileManager,only:MODEL_INITCOND ! name of model initial conditions file
- implicit none
-
- integer(c_int),intent(out) :: init_cond_ncid
- integer(c_int),intent(out) :: err
-
- character(len=256) :: init_cond_fileName
- character(len=256) :: message ! error message
- character(len=1024) :: cmessage ! error message for downwind routine
- ! --------------------------------------------------------------------------------------------------------
-
- ! define restart file path/name
- if(STATE_PATH == '') then
- init_cond_fileName = trim(SETTINGS_PATH)//trim(MODEL_INITCOND)
- else
- init_cond_fileName = trim(STATE_PATH)//trim(MODEL_INITCOND)
- endif
-
- call nc_file_open(init_cond_fileName,nf90_nowrite,init_cond_ncid,err,cmessage)
- if (err/=0) then
- message=trim(message)//trim(cmessage)
- print(message)
- return
- end if
-
-end subroutine openInitCondFile
-
-subroutine closeInitCondFile(init_cond_ncid,err) bind(C, name="closeInitCondFile")
- USE netcdf_util_module,only:nc_file_close
- implicit none
-
- integer(c_int),intent(out) :: init_cond_ncid
- integer(c_int),intent(out) :: err
-
- ! local variables
- character(len=256) :: message
- ! --------------------------------------------------------------------------------------------------------
- err=0; message="read_icondFromStructure.f90 - closeInitCondFile/"
-
- call nc_file_close(init_cond_ncid,err,message)
- if (err/=0) then
- message=trim(message)
- print(message)
- return
- end if
-
-end subroutine closeInitCondFile
-
-subroutine readInitCond_prog(init_cond_ncid, start_gru, num_gru, err) bind(C, name="readInitCond_prog")
- ! Structures to populate
- USE globalData,only:init_cond_prog
- ! Netcdf
- USE netcdf
- USE netcdf_util_module,only:nc_file_close ! close netcdf file
- USE netcdf_util_module,only:netcdf_err ! netcdf error handling
-
- ! metadata
- USE globalData,only:prog_meta ! metadata for prognostic variables
- USE globalData,only:bvar_meta ! metadata for basin (GRU) variables
- ! var_lookup
- USE var_lookup,only:iLookVarType ! variable lookup structure
- USE var_lookup,only:iLookPROG ! variable lookup structure
- USE var_lookup,only:iLookPARAM ! variable lookup structure
- USE var_lookup,only:iLookINDEX ! variable lookup structure
- ! access type string
- USE get_ixName_module,only:get_varTypeName ! to access type strings for error messages
- implicit none
-
- integer(c_int), intent(in) :: init_cond_ncid
- integer(c_int), intent(in) :: start_gru
- integer(c_int), intent(in) :: num_gru
- integer(c_int), intent(out) :: err
-
- ! local variables
- integer(i4b) :: iVar
- integer(i4b) :: dimID ! varible dimension ids
- integer(i4b) :: ncVarID ! variable ID in netcdf file
- integer(i4b) :: dimLen ! data dimensions
- character(256) :: dimName ! not used except as a placeholder in call to inq_dim function
- integer(i4b) :: fileHRU ! number of HRUs in file
-
- character(LEN=256) :: icond_file ! restart/icond_file file name
- character(len=256) :: message
- character(len=256) :: cmessage
-
- character(len=32),parameter :: scalDimName ='scalarv' ! dimension name for scalar data
- character(len=32),parameter :: midSoilDimName='midSoil' ! dimension name for soil-only layers
- character(len=32),parameter :: midTotoDimName='midToto' ! dimension name for layered varaiables
- character(len=32),parameter :: ifcTotoDimName='ifcToto' ! dimension name for layered varaiables
- ! --------------------------------------------------------------------------------------------------------
-
- err=0; message="read_icondFromStructure.f90 - readInitCond_prog"
-
- ! get number of HRUs in file
- err = nf90_inq_dimid(init_cond_ncid,"hru",dimID);
- if(err/=nf90_noerr)then; message=trim(message)//'problem finding hru dimension/'//trim(nf90_strerror(err)); return; end if
- err = nf90_inquire_dimension(init_cond_ncid,dimID,len=fileHRU);
- if(err/=nf90_noerr)then; message=trim(message)//'problem reading hru dimension/'//trim(nf90_strerror(err)); return; end if
-
- allocate(init_cond_prog(size(prog_meta)))
-
- ! loop through prognostic variables
- do iVar = 1,size(prog_meta)
- ! skip variables that are computed later
- if(prog_meta(iVar)%varName=='scalarCanopyWat' .or. &
- prog_meta(iVar)%varName=='spectralSnowAlbedoDiffuse' .or. &
- prog_meta(iVar)%varName=='scalarSurfaceTemp' .or. &
- prog_meta(iVar)%varName=='mLayerVolFracWat' .or. &
- prog_meta(iVar)%varName=='mLayerHeight' )then
- cycle
- endif
-
- ! get variable id
- err = nf90_inq_varid(init_cond_ncid,trim(prog_meta(iVar)%varName),ncVarID); call netcdf_err(err,message)
- if(err/=0)then
- message=trim(message)//': problem with getting variable id, var='//trim(prog_meta(iVar)%varName)
- print*,message
- return
- endif
-
- ! get variable dimension IDs
- select case (prog_meta(iVar)%varType)
- case (iLookVarType%scalarv); err = nf90_inq_dimid(init_cond_ncid,trim(scalDimName) ,dimID)
- call netcdf_err(err,message)
- case (iLookVarType%midSoil); err = nf90_inq_dimid(init_cond_ncid,trim(midSoilDimName),dimID)
- call netcdf_err(err,message)
- case (iLookVarType%midToto); err = nf90_inq_dimid(init_cond_ncid,trim(midTotoDimName),dimID)
- call netcdf_err(err,message)
- case (iLookVarType%ifcToto); err = nf90_inq_dimid(init_cond_ncid,trim(ifcTotoDimName),dimID)
- call netcdf_err(err,message)
- case default
- message=trim(message)//"unexpectedVariableType[name='"//trim(prog_meta(iVar)%varName)//"';type='"//trim(get_varTypeName(prog_meta(iVar)%varType))//"']"
- print*, message
- err=20; return
- end select
-
- ! check errors
- if(err/=0)then
- message=trim(message)//': problem with dimension ids, var='//trim(prog_meta(iVar)%varName)
- print*, message
- return
- endif
-
- ! get the dimension length
- err = nf90_inquire_dimension(init_cond_ncid,dimID,dimName,dimLen); call netcdf_err(err,message)
- if(err/=0)then;message=trim(message)//': problem getting the dimension length';print*, message;return;endif
-
- ! initialize the variable data
- allocate(init_cond_prog(iVar)%var_data(num_gru,dimLen),stat=err)
- if(err/=0)then;message=trim(message)//'problem allocating HRU variable data';print*, message;return;endif
-
- ! get data
- err = nf90_get_var(init_cond_ncid,ncVarID,init_cond_prog(iVar)%var_data, start=(/start_gru,1/),count=(/num_gru,dimLen/))
- call netcdf_err(err,message)
- if(err/=0)then; message=trim(message)//': problem getting the data for variable '//trim(prog_meta(iVar)%varName); return; endif
-
- end do
-
-end subroutine readInitCond_prog
-
-subroutine readInitCond_bvar(init_cond_ncid, start_gru, num_gru, err) bind(C, name="readInitCond_bvar")
- USE globalData,only:init_cond_bvar
- USE globalData,only: nTimeDelay ! number of hours in the time delay histogram
- ! var_lookup
- USE var_lookup,only:iLookBVAR ! variable lookup structure
- ! metadata structures
- USE globalData,only:bvar_meta ! metadata for basin (GRU) variables
- ! netcdf
- USE netcdf
- USE netcdf_util_module,only:netcdf_err ! netcdf error handling
- implicit none
-
- integer(c_int), intent(in) :: init_cond_ncid
- integer(c_int), intent(in) :: start_gru
- integer(c_int), intent(in) :: num_gru
- integer(c_int), intent(out) :: err
-
- ! local variables
- integer(i4b) :: nTDH ! number of points in time-delay histogram
- integer(i4b) :: dimID ! varible dimension ids
- integer(i4b) :: fileGRU ! number of GRUs in file
- integer(i4b) :: i
- integer(i4b) :: iVar
- integer(i4b) :: dimLen ! data dimensions
- character(256) :: dimName ! not used except as a placeholder in call to inq_dim function
- integer(i4b) :: ncVarID ! variable ID in netcdf file
- integer(i4b),dimension(1) :: ndx ! intermediate array of loop indices
-
-
- character(len=256) :: message
-
- character(len=32),parameter :: tdhDimName ='tdh' ! dimension name for time-delay basin variables
-
- ! --------------------------------------------------------------------------------------------------------
- err = 0; message="read_icondFromStructure.f90 - readInitCond_bvar/"
- if(restartFileType/=singleHRU)then
- ! get dimension of time delay histogram (TDH) from initial conditions file
- err = nf90_inq_dimid(init_cond_ncid,"tdh",dimID);
-
- if(err/=nf90_noerr)then
- write(*,*) 'WARNING: routingRunoffFuture is not in the initial conditions file ... using zeros' ! previously created in var_derive.f90
- err=nf90_noerr ! reset this err
-
- else
- ! the state file *does* have the basin variable(s), so process them
- err = nf90_inquire_dimension(init_cond_ncid,dimID,len=nTDH);
- if(err/=nf90_noerr)then
- message=trim(message)//'problem reading tdh dimension from initial condition file/'//trim(nf90_strerror(err))
- print*, message
- return
- end if
-
- ! get number of GRUs in file
- err = nf90_inq_dimid(init_cond_ncid,"gru",dimID); if(err/=nf90_noerr)then; message=trim(message)//'problem finding gru dimension/'//trim(nf90_strerror(err)); return; end if
- err = nf90_inquire_dimension(init_cond_ncid,dimID,len=fileGRU); if(err/=nf90_noerr)then; message=trim(message)//'problem reading gru dimension/'//trim(nf90_strerror(err)); return; end if
-
- ! check vs hardwired value set in globalData.f90
- if(nTDH /= nTimeDelay)then
- write(*,*) 'tdh=',nTDH,' nTimeDelay=',nTimeDelay
- message=trim(message)//': state file time delay dimension tdh does not match summa expectation of nTimeDelay set in globalData()'
- return
- endif
-
- ndx = (/iLookBVAR%routingRunoffFuture/) ! array of desired variable indices
- allocate(init_cond_bvar(size(ndx)))
- do i = 1, size(ndx)
- iVar = ndx(i)
- ! get tdh dimension Id in file (should be 'tdh')
- err = nf90_inq_dimid(init_cond_ncid,trim(tdhDimName), dimID);
- if(err/=0)then;message=trim(message)//': problem with dimension ids for tdh vars';print*,message;return;endif
-
- ! get the tdh dimension length (dimName and dimLen are outputs of this call)
- err = nf90_inquire_dimension(init_cond_ncid,dimID,dimName,dimLen); call netcdf_err(err,message)
- if(err/=0)then;message=trim(message)//': problem getting the dimension length for tdh vars';print*,message;return;endif
-
- ! get tdh-based variable id
- err = nf90_inq_varid(init_cond_ncid,trim(bvar_meta(iVar)%varName),ncVarID); call netcdf_err(err,message)
- if(err/=0)then; message=trim(message)//': problem with getting basin variable id, var='//trim(bvar_meta(iVar)%varName); return; endif
-
- allocate(init_cond_bvar(i)%var_data(num_gru,dimLen),stat=err)
- if(err/=0)then; print*, 'err= ',err; message=trim(message)//'problem allocating GRU variable data'; return; endif
-
- ! get data
- err = nf90_get_var(init_cond_ncid,ncVarID,init_cond_bvar(i)%var_data, start=(/start_gru,1/),count=(/num_gru,dimLen/)); call netcdf_err(err,message)
- if(err/=0)then; message=trim(message)//': problem getting the data'; return; endif
- end do
- endif
- endif
-
-
-end subroutine readInitCond_bvar
-
-
-
-
-end module read_icondFromStructure_module
\ No newline at end of file
diff --git a/build/source/actors/file_access_actor/fortran_code/read_param.f90 b/build/source/actors/file_access_actor/fortran_code/read_param.f90
deleted file mode 100644
index e8d8c6784f1caff7919c2d2f1021747431b74713..0000000000000000000000000000000000000000
--- a/build/source/actors/file_access_actor/fortran_code/read_param.f90
+++ /dev/null
@@ -1,401 +0,0 @@
-module read_param_module
- USE, intrinsic :: iso_c_binding
- USE nrtype
- implicit none
- private
- public::allocateParamStructures
- public::openParamFile
- public::getNumVarParam
- public::closeParamFile
- public::getParamSizes
- public::overwriteParam
- public::readParamFromNetCDF
- contains
-subroutine allocateParamStructures(index_gru, index_hru, handle_dpar_struct, &
- handle_mpar_struct, handle_bpar_struct, err) bind(C, name="allocateParamStructures")
-
- USE globalData,only:mpar_meta,bpar_meta
- USE globalData,only:gru_struc
- USE data_types,only:var_dlength,var_d
- USE allocspace_module,only:allocLocal
-
- implicit none
- integer(c_int),intent(in) :: index_gru
- integer(c_int),intent(in) :: index_hru
- type(c_ptr),intent(in),value :: handle_dpar_struct
- type(c_ptr),intent(in),value :: handle_mpar_struct
- type(c_ptr),intent(in),value :: handle_bpar_struct
- integer(c_int),intent(out) :: err
-
- type(var_d), pointer :: dpar_struct
- type(var_dlength), pointer :: mpar_struct
- type(var_d), pointer :: bpar_struct
-
- integer(i4b) :: nSnow
- integer(i4b) :: nSoil
-
- character(len=256) :: message
-
- ! ---------------------------------------------------------------------------------------
- ! * Convert From C++ to Fortran
- ! ---------------------------------------------------------------------------------------
- call c_f_pointer(handle_dpar_struct, dpar_struct)
- call c_f_pointer(handle_mpar_struct, mpar_struct)
- call c_f_pointer(handle_bpar_struct, bpar_struct)
- ! start of subroutine
- err=0; message="read_attrb.f90 - allocateAttributeStructures"
-
- nSnow = gru_struc(index_gru)%hruInfo(index_hru)%nSnow
- nSoil = gru_struc(index_gru)%hruInfo(index_hru)%nSoil
-
- ! initalize the structure with allocatable components
- call allocLocal(mpar_meta,dpar_struct,nSnow,nSoil,err,message);
- call allocLocal(mpar_meta,mpar_struct,nSnow,nSoil,err,message);
- call allocLocal(bpar_meta,bpar_struct,nSnow=0,nSoil=0,err=err,message=message);
- if(err/=0)then; message=trim(message); print*, message; return; endif;
-end subroutine
-
-subroutine openParamFile(param_ncid, param_file_exists, err) bind(C, name="openParamFile")
- USE netcdf
- USE netcdf_util_module,only:nc_file_open
- ! Parameters File
- USE summaFileManager,only:SETTINGS_PATH ! path for metadata files
- USE summaFileManager,only:PARAMETER_TRIAL ! file with parameter trial values
-
- implicit none
- integer(c_int),intent(out) :: param_ncid
- logical(c_bool),intent(out) :: param_file_exists
- integer(c_int),intent(out) :: err
-
- ! local variables
- character(LEN=1024) :: infile ! input filename
- character(len=256) :: message ! error message
- character(len=1024) :: cmessage ! error message for downwind routine
- err=0; message="read_param.f90 - openParamFile"
- ! **********************************************************************************************
- ! * open files, etc.
- ! **********************************************************************************************
-
- infile = trim(SETTINGS_PATH)//trim(PARAMETER_TRIAL) ! build filename
-
- ! check whether the user-specified file exists and warn if it does not
- inquire(file=trim(infile),exist=param_file_exists)
- if (.not.param_file_exists) 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,param_ncid,err,cmessage)
- if(err/=0)then
- message=trim(message)//trim(cmessage)
- print*, message
- return
- end if
-
-end subroutine openParamFile
-
-subroutine getNumVarParam(param_ncid, num_var, err) bind(C, name="getNumVarParam")
- USE netcdf
- USE netcdf_util_module,only:netcdf_err ! netcdf error handling function
- implicit none
- integer(c_int),intent(in) :: param_ncid
- integer(c_int),intent(out) :: num_var
- integer(c_int),intent(out) :: err
-
- ! local variables
- character(len=256) :: message ! error message
-
- err=0; message="read_param.f90 - getNumVarAndDims/"
- ! get the number of variables in the parameter file
- err=nf90_inquire(param_ncid, nVariables=num_var)
- call netcdf_err(err,message)
- if (err/=0) then
- err=20
- print*, message
- return
- end if
-
-end subroutine getNumVarParam
-
-subroutine closeParamFile(param_ncid, err) bind(C, name="closeParamFile")
- USE netcdf_util_module,only:nc_file_close
- implicit none
- integer(c_int),intent(in) :: param_ncid
- integer(c_int),intent(out) :: err
- ! local variables
- character(len=256) :: message
- ! --------------------------------------------------------------------------------------------------------
-
- err=0; message="read_param.f90 - closeParamFile/"
-
- call nc_file_close(param_ncid,err,message)
- if(err/=0)then
- message=trim(message)
- print*, message
- return
- end if
-
-end subroutine closeParamFile
-
-! get the sizes of the arrays for dpar_array bpar_array
-subroutine getParamSizes(dpar_array_size, bpar_array_size, type_array_size) bind(C, name="getParamSizes")
- USE var_lookup,only:maxvarMpar ! model parameters: maximum number variables
- USE var_lookup,only:maxvarBpar ! model parameters: maximum number variables
- USE var_lookup,only:maxvarType
-
- implicit none
- integer(c_int),intent(out) :: dpar_array_size
- integer(c_int),intent(out) :: bpar_array_size
- integer(c_int),intent(out) :: type_array_size
-
-
- dpar_array_size = maxvarMpar
- bpar_array_size = maxvarBpar
- type_array_size = maxvarType
-
-
-end subroutine getParamSizes
-
-subroutine overwriteParam(index_gru, index_hru, handle_type_struct, &
- handle_dpar_struct, handle_mpar_struct, handle_bpar_struct, err) bind(C, name="overwriteParam")
- USE var_lookup,only:maxvarMpar ! model parameters: maximum number variables
- USE var_lookup,only:maxvarBpar ! model parameters: maximum number variables
- USE var_lookup,only:iLookTYPE ! named variables to index elements of the data vectors
- ! global data
- USE globalData,only:gru_struc
- USE globalData,only:localParFallback ! local column default parameters
- USE globalData,only:basinParFallback ! basin-average default parameter
- USE data_types,only:var_dlength,var_i,var_d
-
- USE pOverwrite_module,only:pOverwrite ! module to overwrite default parameter values with info from the Noah tables
- USE allocspace_module,only:allocLocal
- implicit none
- integer(c_int),intent(in) :: index_gru
- integer(c_int),intent(in) :: index_hru
- ! structures
- type(c_ptr),intent(in),value :: handle_type_struct
- type(c_ptr),intent(in),value :: handle_dpar_struct
- type(c_ptr),intent(in),value :: handle_mpar_struct
- type(c_ptr),intent(in),value :: handle_bpar_struct
-
- ! error control
- integer(c_int), intent(out) :: err
-
- ! local variables
- type(var_i),pointer :: type_struct ! model parameters
- type(var_d),pointer :: dpar_struct ! model parameters
- type(var_dlength),pointer :: mpar_struct ! model parameters
- type(var_d),pointer :: bpar_struct ! model parameters
-
- integer(i4b) :: iVar
- integer(i4b) :: iDat
-
- character(len=256) :: message
- ! ---------------------------------------------------------------------------------------
- ! * Convert From C++ to Fortran
- ! ---------------------------------------------------------------------------------------
- call c_f_pointer(handle_type_struct, type_struct)
- call c_f_pointer(handle_dpar_struct, dpar_struct)
- call c_f_pointer(handle_mpar_struct, mpar_struct)
- call c_f_pointer(handle_bpar_struct, bpar_struct)
- ! Start subroutine
- err=0; message="read_param.f90 - overwriteParam"
-
- ! Set the basin parameters with the default values
- do ivar=1, size(localParFallback)
- dpar_struct%var(iVar) = localParFallback(iVar)%default_val
- end do
-
- call pOverwrite(type_struct%var(iLookTYPE%vegTypeIndex), & ! vegetation category
- type_struct%var(iLookTYPE%soilTypeIndex),& ! soil category
- dpar_struct%var(:),err,message) ! default model parameters
-
- do ivar=1, size(localParFallback)
- do iDat=1, size(mpar_struct%var(iVar)%dat)
- mpar_struct%var(iVar)%dat(iDat) = dpar_struct%var(iVar)
- end do
- end do
-
- do iVar=1, size(basinParFallback)
- bpar_struct%var(iVar) = basinParFallback(iVar)%default_val
- end do
-
-end subroutine overwriteParam
-
-
-subroutine readParamFromNetCDF(param_ncid, index_gru, index_hru, start_index_gru, &
- num_vars, handle_mpar_struct, handle_bpar_struct, err) bind(C, name="readParamFromNetCDF")
- USE netcdf
- USE netcdf_util_module,only:netcdf_err ! netcdf error handling function
-
- USE data_types,only:var_dlength,var_d
- 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 globalData,only:integerMissing ! missing integer
-
- implicit none
- ! dummy variables
- integer(c_int),intent(in) :: param_ncid
- integer(c_int),intent(in) :: index_gru
- integer(c_int),intent(in) :: index_hru
- integer(c_int),intent(in) :: start_index_gru
- integer(c_int),intent(in) :: num_vars
- type(c_ptr),intent(in),value :: handle_mpar_struct
- type(c_ptr),intent(in),value :: handle_bpar_struct
- integer(c_int), intent(out) :: err
- ! define local variables
- type(var_dlength),pointer :: mpar_struct ! model parameters
- type(var_d),pointer :: bpar_struct ! model parameters
-
- character(len=256) :: message ! error message
- character(len=1024) :: cmessage ! error message for downwind routine
- 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) :: num_dims ! number of dimensions
-
- integer(i4b) :: ivarid ! variable index
- character(LEN=64) :: dimName ! dimension name
-
- character(LEN=64) :: parName ! parameter name
- 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
- real(dp),allocatable :: parVector(:) ! model parameter vector
- integer(i4b) :: fHRU ! index of HRU in input file
- integer(i4b) :: netcdf_index
-
- ! ---------------------------------------------------------------------------------------
- ! * Convert From C++ to Fortran
- ! ---------------------------------------------------------------------------------------
- call c_f_pointer(handle_mpar_struct, mpar_struct)
- call c_f_pointer(handle_bpar_struct, bpar_struct)
- err=0; message="read_param.f90 - readParamFromNetCDF/"
-
-
- ! **********************************************************************************************
- ! * read the local parameters and the basin parameters
- ! **********************************************************************************************
- do ivarid=1,num_vars
- ! get the parameter name
- err=nf90_inquire_variable(param_ncid, ivarid, name=parName)
- call netcdf_err(err,message)
- if (err/=0) then
- err=20
- print*,message
- 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(param_ncid, ivarid, nDims=num_dims, dimids=idim_list)
- if(err/=0)then
- message=trim(message)//trim(cmessage)
- print*, message
- return
- end if
-
- ! get the length of the depth dimension (if it exists)
- if(num_dims==2)then
- ! get the information on the 2nd dimension for 2-d variables
- err=nf90_inquire_dimension(param_ncid, idim_list(2), dimName, nSoil_file)
- if(err/=0)then
- message=trim(message)//trim(cmessage)
- print*, message
- 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(mpar_struct%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
-
-
- localHRU_ix=index_map(index_hru)%localHRU_ix
- fHRU = gru_struc(index_gru)%hruInfo(localHRU_ix)%hru_nc
- ! read parameter data
- select case(num_dims)
- case(1); err=nf90_get_var(param_ncid, ivarid, parVector, start=(/fHRU/), count=(/1/) )
- case(2); err=nf90_get_var(param_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)
- print*, message
- return
- end if
-
- ! populate parameter structures
- select case(num_dims)
- case(1); mpar_struct%var(ixParam)%dat(:) = parVector(1) ! also distributes scalar across depth dimension
- case(2); mpar_struct%var(ixParam)%dat(:) = parVector(:)
- case default; err=20; message=trim(message)//'unexpected number of dimensions for parameter '//trim(parName)
- end select
-
- ! deallocate space for model parameters
- deallocate(parVector,stat=err)
- if(err/=0)then
- message=trim(message)//'problem deallocating space for parameter vector'
- print*, message
- 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
-
- ! read parameter data
- netcdf_index = start_index_gru + index_gru - 1
- err=nf90_get_var(param_ncid, ivarid, bpar_struct%var(ixParam), start=(/netcdf_index/))
- if(err/=0)then
- message=trim(message)//trim(cmessage)
- print*, message
- return
- end if
- endif
-
- end do ! (looping through the parameters in the NetCDF file)
-
-end subroutine readParamFromNetCDF
-
-
-end module read_param_module
\ No newline at end of file
diff --git a/build/source/actors/file_access_actor/fortran_code/writeOutputFromOutputStructure.f90 b/build/source/actors/file_access_actor/fortran_code/writeOutputFromOutputStructure.f90
index 484e90eca739ea682d29a57b9939b9b7e0c1ca56..364d14537077dde693c61e89a9237a351175c6ee 100644
--- a/build/source/actors/file_access_actor/fortran_code/writeOutputFromOutputStructure.f90
+++ b/build/source/actors/file_access_actor/fortran_code/writeOutputFromOutputStructure.f90
@@ -75,7 +75,7 @@ USE var_lookup, only: maxvarStat ! number of statistics
implicit none
private
-public::writeOutput
+public::writeOutput_fortran
public::writeParm
public::writeData
public::writeBasin
@@ -89,7 +89,7 @@ contains
! **********************************************************************************************************
! public subroutine writeParm: write model parameters
! **********************************************************************************************************
-subroutine writeOutput(handle_ncid, num_steps, start_gru, max_gru, err) bind(C, name="writeOutput")
+subroutine writeOutput_fortran(handle_ncid, num_steps, start_gru, max_gru, err) bind(C, name="writeOutput_fortran")
USE var_lookup,only:maxVarFreq ! # of available output frequencies
USE globalData,only:structInfo
USE globalData,only:bvarChild_map,forcChild_map,progChild_map,diagChild_map,fluxChild_map,indxChild_map ! index of the child data structure: stats bvar
@@ -126,7 +126,7 @@ subroutine writeOutput(handle_ncid, num_steps, start_gru, max_gru, err) bind(C,
stepCounter(:) = outputTimeStep(iGRU)%dat(:) ! We want to avoid updating outputTimeStep
do iStep=1, num_steps
call writeTime(ncid,outputTimeStep(iGRU)%dat(:),iStep,time_meta, &
- outputStructure(1)%timeStruct(1)%gru(iGRU)%hru(indxHRU)%var,err,cmessage)
+ outputStructure(1)%timeStruct%gru(iGRU)%hru(indxHRU)%var,err,cmessage)
end do ! istep
end do ! iGRU
@@ -137,7 +137,7 @@ subroutine writeOutput(handle_ncid, num_steps, start_gru, max_gru, err) bind(C,
! ****************************************************************************
call writeBasin(ncid,outputTimeStep(start_gru)%dat(:),outputTimeStepUpdate,num_steps,&
start_gru, max_gru, numGRU, &
- bvar_meta,outputStructure(1)%bvarStat(1),outputStructure(1)%bvarStruct(1), &
+ bvar_meta,outputStructure(1)%bvarStat,outputStructure(1)%bvarStruct, &
bvarChild_map,err,cmessage)
! ****************************************************************************
@@ -148,28 +148,28 @@ subroutine writeOutput(handle_ncid, num_steps, start_gru, max_gru, err) bind(C,
case('forc')
call writeData(ncid,outputTimeStep(start_gru)%dat(:),outputTimestepUpdate,maxLayers,num_steps,&
start_gru, max_gru, numGRU, &
- forc_meta,outputStructure(1)%forcStat(1),outputStructure(1)%forcStruct(1),'forc', &
- forcChild_map,outputStructure(1)%indxStruct(1),err,cmessage)
+ forc_meta,outputStructure(1)%forcStat,outputStructure(1)%forcStruct,'forc', &
+ forcChild_map,outputStructure(1)%indxStruct,err,cmessage)
case('prog')
call writeData(ncid,outputTimeStep(start_gru)%dat(:),outputTimestepUpdate,maxLayers,num_steps,&
start_gru, max_gru, numGRU, &
- prog_meta,outputStructure(1)%progStat(1),outputStructure(1)%progStruct(1),'prog', &
- progChild_map,outputStructure(1)%indxStruct(1),err,cmessage)
+ prog_meta,outputStructure(1)%progStat,outputStructure(1)%progStruct,'prog', &
+ progChild_map,outputStructure(1)%indxStruct,err,cmessage)
case('diag')
call writeData(ncid,outputTimeStep(start_gru)%dat(:),outputTimestepUpdate,maxLayers,num_steps,&
start_gru, max_gru, numGRU, &
- diag_meta,outputStructure(1)%diagStat(1),outputStructure(1)%diagStruct(1),'diag', &
- diagChild_map,outputStructure(1)%indxStruct(1),err,cmessage)
+ diag_meta,outputStructure(1)%diagStat,outputStructure(1)%diagStruct,'diag', &
+ diagChild_map,outputStructure(1)%indxStruct,err,cmessage)
case('flux')
call writeData(ncid,outputTimeStep(start_gru)%dat(:),outputTimestepUpdate,maxLayers,num_steps,&
start_gru, max_gru, numGRU, &
- flux_meta,outputStructure(1)%fluxStat(1),outputStructure(1)%fluxStruct(1),'flux', &
- fluxChild_map,outputStructure(1)%indxStruct(1),err,cmessage)
+ flux_meta,outputStructure(1)%fluxStat,outputStructure(1)%fluxStruct,'flux', &
+ fluxChild_map,outputStructure(1)%indxStruct,err,cmessage)
case('indx')
call writeData(ncid,outputTimeStep(start_gru)%dat(:),outputTimestepUpdate,maxLayers,num_steps,&
start_gru, max_gru, numGRU, &
- indx_meta,outputStructure(1)%indxStat(1),outputStructure(1)%indxStruct(1),'indx', &
- indxChild_map,outputStructure(1)%indxStruct(1),err,cmessage)
+ indx_meta,outputStructure(1)%indxStat,outputStructure(1)%indxStruct,'indx', &
+ indxChild_map,outputStructure(1)%indxStruct,err,cmessage)
end select
if(err/=0)then; message=trim(message)//trim(cmessage)//'['//trim(structInfo(iStruct)%structName)//']'; return; endif
end do ! (looping through structures)
@@ -179,7 +179,7 @@ subroutine writeOutput(handle_ncid, num_steps, start_gru, max_gru, err) bind(C,
outputTimeStep(start_gru)%dat(iFreq) = outputTimeStep(start_gru)%dat(iFreq) + outputTimeStepUpdate(iFreq)
end do ! ifreq
-end subroutine writeOutput
+end subroutine writeOutput_fortran
! **********************************************************************************************************
@@ -325,9 +325,9 @@ subroutine writeData(ncid,outputTimestep,outputTimestepUpdate,maxLayers,nSteps,
do iStep = 1, nSteps
! check if we want this timestep
- if(.not.outputStructure(1)%finalizeStats(1)%gru(verifiedGRUIndex)%hru(1)%tim(iStep)%dat(iFreq)) cycle
+ if(.not.outputStructure(1)%finalizeStats%gru(verifiedGRUIndex)%hru(1)%tim(iStep)%dat(iFreq)) cycle
stepCounter = stepCounter+1
- timeVec(stepCounter) = outputStructure(1)%forcStruct(1)%gru(verifiedGRUIndex)%hru(1)%var(iVar)%tim(iStep)
+ timeVec(stepCounter) = outputStructure(1)%forcStruct%gru(verifiedGRUIndex)%hru(1)%var(iVar)%tim(iStep)
end do ! iStep
err = nf90_put_var(ncid%var(iFreq),ncVarID,timeVec(1:stepCounter),start=(/outputTimestep(iFreq)/),count=(/stepCounter/))
call netcdf_err(err,message); if (err/=0)then; print*, "err"; return; endif
@@ -380,9 +380,9 @@ subroutine writeScalar(ncid, outputTimestep, outputTimestepUpdate, nSteps, minGR
character(*) ,intent(inout) :: message
! local variables
- integer(i4b) :: gruCounter ! counter for the realVecs
- integer(i4b) :: iStep ! counter for looping over nSteps
- integer(i4b) :: stepCounter ! counter for the realVec
+ integer(i4b) :: gruCounter=0 ! counter for the realVecs
+ integer(i4b) :: iStep=1 ! counter for looping over nSteps
+ integer(i4b) :: stepCounter=0 ! counter for the realVec
integer(i4b) :: iGRU
! output array
real(rkind) :: realVec(numGRU, nSteps)! real vector for all HRUs in the run domain
@@ -396,22 +396,24 @@ subroutine writeScalar(ncid, outputTimestep, outputTimestepUpdate, nSteps, minGR
stepCounter = 0
gruCounter = gruCounter + 1
do iStep = 1, nSteps
- if(.not.outputStructure(1)%finalizeStats(1)%gru(iGRU)%hru(1)%tim(iStep)%dat(iFreq)) cycle
+ if(.not.outputStructure(1)%finalizeStats%gru(iGRU)%hru(1)%tim(iStep)%dat(iFreq)) cycle
stepCounter = stepCounter + 1
realVec(gruCounter, stepCounter) = stat%gru(iGRU)%hru(1)%var(map(iVar))%tim(iStep)%dat(iFreq)
outputTimeStepUpdate(iFreq) = stepCounter
end do ! iStep
- end do ! iGRU
-
- err = nf90_put_var(ncid%var(iFreq),meta(iVar)%ncVarID(iFreq),realVec(1:gruCounter, 1:stepCounter),start=(/minGRU,outputTimestep(iFreq)/),count=(/numGRU,stepCounter/))
+ end do ! iGRU
+
if (outputTimeStepUpdate(iFreq) /= stepCounter ) then
print*, "ERROR Missmatch in Steps - stat doubleVec"
print*, " outputTimeStepUpdate(iFreq) = ", outputTimeStepUpdate(iFreq)
print*, " stepCounter = ", stepCounter
print*, " iFreq = ", iFreq
-
+ print*, " minGRU = ", minGRU
+ print*, " maxGRU = ", maxGRU
+ err = 20
return
endif
+ err = nf90_put_var(ncid%var(iFreq),meta(iVar)%ncVarID(iFreq),realVec(1:gruCounter, 1:stepCounter),start=(/minGRU,outputTimestep(iFreq)/),count=(/numGRU,stepCounter/))
class default; err=20; message=trim(message)//'stats must be scalarv and of type gru_hru_doubleVec'; return
end select ! stat
@@ -489,11 +491,11 @@ subroutine writeVector(ncid, outputTimestep, maxLayers, nSteps, minGRU, maxGRU,
! get the data vectors
select type (dat)
class is (gru_hru_time_doubleVec)
- if(.not.outputStructure(1)%finalizeStats(1)%gru(iGRU)%hru(1)%tim(iStep)%dat(iFreq)) cycle
+ if(.not.outputStructure(1)%finalizeStats%gru(iGRU)%hru(1)%tim(iStep)%dat(iFreq)) cycle
realArray(gruCounter,1:datLength) = dat%gru(iGRU)%hru(1)%var(iVar)%tim(iStep)%dat(:)
class is (gru_hru_time_intVec)
- if(.not.outputStructure(1)%finalizeStats(1)%gru(iGRU)%hru(1)%tim(iStep)%dat(iFreq)) cycle
+ if(.not.outputStructure(1)%finalizeStats%gru(iGRU)%hru(1)%tim(iStep)%dat(iFreq)) cycle
intArray(gruCounter,1:datLength) = dat%gru(iGRU)%hru(1)%var(iVar)%tim(iStep)%dat(:)
class default; err=20; message=trim(message)//'data must not be scalarv and either of type gru_hru_doubleVec or gru_hru_intVec'; return
end select
@@ -564,6 +566,7 @@ subroutine writeBasin(ncid,outputTimestep,outputTimestepUpdate,nSteps,&
! initialize error control
err=0;message="f-writeBasin/"
+
! loop through output frequencies
do iFreq=1,maxvarFreq
@@ -629,7 +632,7 @@ subroutine writeTime(ncid,outputTimestep,iStep,meta,dat,err,message)
do iFreq=1,maxvarFreq
! check that we have finalized statistics for a given frequency
- if(.not.outputStructure(1)%finalizeStats(1)%gru(1)%hru(1)%tim(iStep)%dat(iFreq)) cycle
+ if(.not.outputStructure(1)%finalizeStats%gru(1)%hru(1)%tim(iStep)%dat(iFreq)) cycle
! loop through model variables
do iVar = 1,size(meta)
diff --git a/build/source/actors/file_access_actor/fortran_code/write_to_netcdf.f90 b/build/source/actors/file_access_actor/fortran_code/write_to_netcdf.f90
index dc51f1f264bfb0bab5a8c0226473b7e5bdc5ae91..4dc4668b296fbb897b3ddffcb270583e2f16e481 100644
--- a/build/source/actors/file_access_actor/fortran_code/write_to_netcdf.f90
+++ b/build/source/actors/file_access_actor/fortran_code/write_to_netcdf.f90
@@ -8,9 +8,6 @@ USE data_types
implicit none
public::writeParamToNetCDF
-public::writeDataToNetCDF
-public::writeBasinToNetCDF
-public::writeTimeToNetCDF
public::writeGRUStatistics
contains
@@ -84,7 +81,7 @@ subroutine writeParamToNetCDF(handle_ncid, &
end subroutine writeParamToNetCDF
-subroutine writeDataToNetCDF(handle_ncid, &
+subroutine writeDataToNetCDF(handle_ncid, &
index_gru, &
index_hru, &
handle_finalize_stats, &
@@ -199,88 +196,6 @@ subroutine writeDataToNetCDF(handle_ncid, &
end do ! (looping through structures)
end subroutine writeDataToNetCDF
-! subroutine setOutputStructure(index_gru, index_timestep,
-! handle_finalize_stats, handle_output_timestep, handle_output_timestep, )
-
-! end subroutine setOutputStructure
-
-subroutine writeBasinToNetCDF(handle_ncid, index_gru, handle_finalize_stats, &
- handle_output_timestep, handle_bvar_stat, handle_bvar_struct, err) bind(C, name="writeBasinToNetCDF")
- USE modelwrite_module,only:writeBasin
- USE globalData,only:bvar_meta ! metadata on basin-average variables
- USE globalData,only:bvarChild_map ! index of the child data structure: stats bvar
-
- implicit none
- ! dummy variables
- type(c_ptr), intent(in), value :: handle_ncid
- integer(c_int), intent(in) :: index_gru
- type(c_ptr), intent(in), value :: handle_finalize_stats
- type(c_ptr), intent(in), value :: handle_output_timestep
- type(c_ptr), intent(in), value :: handle_bvar_stat
- type(c_ptr), intent(in), value :: handle_bvar_struct
- integer(c_int), intent(out) :: err
- ! local pointers for dummy variables
- type(var_i), pointer :: ncid
- type(flagVec), pointer :: finalize_stats
- type(var_i),pointer :: output_timestep
- type(var_dlength),pointer :: bvar_stat
- type(var_dlength),pointer :: bvar_struct
- ! local Variables
- character(len=256) :: message
- ! ---------------------------------------------------------------------------------------
- ! * Convert From C++ to Fortran
- ! ---------------------------------------------------------------------------------------
- call c_f_pointer(handle_ncid, ncid)
- call c_f_pointer(handle_finalize_stats, finalize_stats)
- call c_f_pointer(handle_output_timestep, output_timestep)
- call c_f_pointer(handle_bvar_stat, bvar_stat)
- call c_f_pointer(handle_bvar_struct, bvar_struct)
- message="file_access_actor.f90 - writeBasinToNetCDF"
-
-
- call writeBasin(ncid,index_gru,finalize_stats%dat(:),output_timestep%var(:),&
- bvar_meta, bvar_stat%var, bvar_struct%var, bvarChild_map, err, message)
- if(err/=0)then
- message=trim(message)//'[bvar]'
- print*, message
- return
- endif
-
-end subroutine writeBasinToNetCDF
-
-subroutine writeTimeToNetCDF(handle_ncid, handle_finalize_stats, handle_output_timestep, &
- handle_time_struct, err) bind(C, name="writeTimeToNetCDF")
- USE modelwrite_module,only:writeTime
- USE globalData,only:time_meta
-
- implicit none
- type(c_ptr), intent(in), value :: handle_ncid
- type(c_ptr), intent(in), value :: handle_finalize_stats
- type(c_ptr), intent(in), value :: handle_output_timestep
- type(c_ptr), intent(in), value :: handle_time_struct
- integer(c_int), intent(out) :: err
-
- type(var_i), pointer :: ncid
- type(flagVec), pointer :: finalize_stats
- type(var_i),pointer :: output_timestep
- type(var_i),pointer :: time_struct
- character(len=256) :: message
-
- call c_f_pointer(handle_ncid, ncid)
- call c_f_pointer(handle_finalize_stats, finalize_stats)
- call c_f_pointer(handle_output_timestep, output_timestep)
- call c_f_pointer(handle_time_struct, time_struct)
- message="file_access_actor.f90 - writeTimeToNetCDF"
-
- call writeTime(ncid, finalize_stats%dat(:),output_timestep%var(:),&
- time_meta, time_struct%var,err,message)
- if(err/=0)then
- message=trim(message)//'writeTime'
- print*, message
- return
- endif
-
-end subroutine writeTimeToNetCDF
subroutine writeGRUStatistics(handle_ncid, &
gru_var_ids, &
@@ -305,7 +220,8 @@ subroutine writeGRUStatistics(handle_ncid, &
real(c_double), dimension(num_gru) :: forcing_time_array
real(c_double), dimension(num_gru) :: run_physics_time_array
real(c_double), dimension(num_gru) :: write_output_time_array
-
+ real(c_double), dimension(num_gru) :: rel_tol_array
+ real(c_double), dimension(num_gru) :: abs_tol_array
integer(c_int), dimension(num_gru) :: successful_array
integer(c_int), dimension(num_gru) :: num_attempts_array
@@ -322,6 +238,8 @@ subroutine writeGRUStatistics(handle_ncid, &
forcing_time_array(i) = gru_stats_vector(i)%forcing_duration
run_physics_time_array(i) = gru_stats_vector(i)%run_physics_duration
write_output_time_array(i) = gru_stats_vector(i)%write_output_duration
+ rel_tol_array(i) = gru_stats_vector(i)%rel_tol
+ abs_tol_array(i) = gru_stats_vector(i)%abs_tol
successful_array(i) = gru_stats_vector(i)%successful
num_attempts_array(i) = gru_stats_vector(i)%num_attempts
end do
@@ -335,6 +253,8 @@ subroutine writeGRUStatistics(handle_ncid, &
err = nf90_put_var(ncid%var(iFreq), gru_var_ids%write_output_duration_var_id, write_output_time_array)
err = nf90_put_var(ncid%var(iFreq), gru_var_ids%state_var_id, successful_array)
err = nf90_put_var(ncid%var(iFreq), gru_var_ids%num_attempts_var_id, num_attempts_array)
+ err = nf90_put_var(ncid%var(iFreq), gru_var_ids%rel_tol_var_id, rel_tol_array)
+ err = nf90_put_var(ncid%var(iFreq), gru_var_ids%abs_tol_var_id, abs_tol_array)
end do
end subroutine writeGRUStatistics
diff --git a/build/source/actors/global/settings_functions.cpp b/build/source/actors/global/settings_functions.cpp
index ad69d90eda8ce8b36dd7b9fb03398177abbc1502..e09fbb4006ed3e18501fa86c4a822fa59f764aa9 100644
--- a/build/source/actors/global/settings_functions.cpp
+++ b/build/source/actors/global/settings_functions.cpp
@@ -116,6 +116,77 @@ HRU_Actor_Settings readHRUActorSettings(std::string json_settings_file) {
hru_actor_settings.dt_init_factor = getSettings(json_settings_file, parent_key,
"dt_init_factor", hru_actor_settings.dt_init_factor).value_or(1);
+
+ /*
+ Set Tolerances
+ ---------------
+ We can use rel_tol and abs_tol to set the tolerances for all the state variables.
+ If we set rel_tol and abs_tol in the config.json file then we just don't include
+ the other tolerance values and they will be set to the value of rtol and atol.
+ */
+ hru_actor_settings.rel_tol = getSettings(json_settings_file, parent_key,
+ "rel_tol", hru_actor_settings.rel_tol).value_or(-9999);
+
+ hru_actor_settings.abs_tol = getSettings(json_settings_file, parent_key,
+ "abs_tol", hru_actor_settings.abs_tol).value_or(-9999);
+
+ double local_rtol;
+ double local_atol;
+
+ if (hru_actor_settings.rel_tol > 0) {
+ local_rtol = hru_actor_settings.rel_tol;
+ } else {
+ local_rtol = 1e-6;
+ }
+
+ if (hru_actor_settings.abs_tol > 0) {
+ local_atol = hru_actor_settings.abs_tol;
+ } else {
+ local_atol = 1e-6;
+ }
+
+ hru_actor_settings.relTolTempCas = getSettings(json_settings_file, parent_key,
+ "relTolTempCas", hru_actor_settings.relTolTempCas).value_or(local_rtol);
+
+ hru_actor_settings.absTolTempCas = getSettings(json_settings_file, parent_key,
+ "absTolTempCas", hru_actor_settings.absTolTempCas).value_or(local_atol);
+
+ hru_actor_settings.relTolTempVeg = getSettings(json_settings_file, parent_key,
+ "relTolTempVeg", hru_actor_settings.relTolTempVeg).value_or(local_rtol);
+
+ hru_actor_settings.absTolTempVeg = getSettings(json_settings_file, parent_key,
+ "absTolTempVeg", hru_actor_settings.absTolTempVeg).value_or(local_atol);
+
+ hru_actor_settings.relTolWatVeg = getSettings(json_settings_file, parent_key,
+ "relTolWatVeg", hru_actor_settings.relTolWatVeg).value_or(local_rtol);
+
+ hru_actor_settings.absTolWatVeg = getSettings(json_settings_file, parent_key,
+ "absTolWatVeg", hru_actor_settings.absTolWatVeg).value_or(local_atol);
+
+ hru_actor_settings.relTolTempSoilSnow = getSettings(json_settings_file, parent_key,
+ "relTolTempSoilSnow", hru_actor_settings.relTolTempSoilSnow).value_or(local_rtol);
+
+ hru_actor_settings.absTolTempSoilSnow = getSettings(json_settings_file, parent_key,
+ "absTolTempSoilSnow", hru_actor_settings.absTolTempSoilSnow).value_or(local_atol);
+
+ hru_actor_settings.relTolWatSnow = getSettings(json_settings_file, parent_key,
+ "relTolWatSnow", hru_actor_settings.relTolWatSnow).value_or(local_rtol);
+
+ hru_actor_settings.absTolWatSnow = getSettings(json_settings_file, parent_key,
+ "absTolWatSnow", hru_actor_settings.absTolWatSnow).value_or(local_atol);
+
+ hru_actor_settings.relTolMatric = getSettings(json_settings_file, parent_key,
+ "relTolMatric", hru_actor_settings.relTolMatric).value_or(local_rtol);
+
+ hru_actor_settings.absTolMatric = getSettings(json_settings_file, parent_key,
+ "absTolMatric", hru_actor_settings.absTolMatric).value_or(local_atol);
+
+ hru_actor_settings.relTolAquifr = getSettings(json_settings_file, parent_key,
+ "relTolAquifr", hru_actor_settings.relTolAquifr).value_or(local_rtol);
+
+ hru_actor_settings.absTolAquifr = getSettings(json_settings_file, parent_key,
+ "absTolAquifr", hru_actor_settings.absTolAquifr).value_or(local_atol);
+
return hru_actor_settings;
}
@@ -125,27 +196,39 @@ void check_settings_from_json(Distributed_Settings &distributed_settings,
Summa_Actor_Settings &summa_actor_settings, File_Access_Actor_Settings &file_access_actor_settings,
Job_Actor_Settings &job_actor_settings, HRU_Actor_Settings &hru_actor_settings) {
- std::cout << "************ DISTRIBUTED_SETTINGS ************\n";
- std::cout << distributed_settings.distributed_mode << "\n";
+ std::cout << "************ DISTRIBUTED_SETTINGS ************\n"
+ << distributed_settings.distributed_mode << "\n";
for (auto& host : distributed_settings.servers_list) {
std::cout << host << "\n";
}
- std::cout << distributed_settings.port << "\n";
- std::cout << distributed_settings.total_hru_count << "\n";
- std::cout << distributed_settings.num_hru_per_batch << "\n";
-
- std::cout << "************ SUMMA_ACTOR_SETTINGS ************\n";
- std::cout << summa_actor_settings.max_gru_per_job << "\n\n\n";
-
- std::cout << "************ FILE_ACCESS_ACTOR_SETTINGS ************\n";
- std::cout << file_access_actor_settings.num_partitions_in_output_buffer << "\n";
- std::cout << file_access_actor_settings.num_timesteps_in_output_buffer << "\n\n\n";
-
- std::cout << "************ JOB_ACTOR_SETTINGS ************\n";
- std::cout << job_actor_settings.file_manager_path << "\n";
-
- std::cout << "************ HRU_ACTOR_SETTINGS ************\n";
- std::cout << hru_actor_settings.print_output << "\n";
- std::cout << hru_actor_settings.output_frequency << "\n\n\n";
+ std::cout << distributed_settings.port << "\n"
+ << distributed_settings.total_hru_count << "\n"
+ << distributed_settings.num_hru_per_batch << "\n"
+ << "************ SUMMA_ACTOR_SETTINGS ************\n"
+ << summa_actor_settings.max_gru_per_job << "\n\n\n"
+ << "************ FILE_ACCESS_ACTOR_SETTINGS ************\n"
+ << file_access_actor_settings.num_partitions_in_output_buffer << "\n"
+ << file_access_actor_settings.num_timesteps_in_output_buffer << "\n\n\n"
+ << "************ JOB_ACTOR_SETTINGS ************\n"
+ << job_actor_settings.file_manager_path << "\n"
+ << "************ HRU_ACTOR_SETTINGS ************\n"
+ << hru_actor_settings.print_output << "\n"
+ << hru_actor_settings.output_frequency << "\n"
+ << "rel_tol: " << hru_actor_settings.rel_tol << "\n"
+ << "abs_tol: " << hru_actor_settings.abs_tol << "\n"
+ << "relTolTempCas: " << hru_actor_settings.relTolTempCas << "\n"
+ << "absTolTempCas: " << hru_actor_settings.absTolTempCas << "\n"
+ << "relTolTempVeg: " << hru_actor_settings.relTolTempVeg << "\n"
+ << "absTolTempVeg: " << hru_actor_settings.absTolTempVeg << "\n"
+ << "relTolWatVeg: " << hru_actor_settings.relTolWatVeg << "\n"
+ << "absTolWatVeg: " << hru_actor_settings.absTolWatVeg << "\n"
+ << "relTolTempSoilSnow: " << hru_actor_settings.relTolTempSoilSnow << "\n"
+ << "absTolTempSoilSnow: " << hru_actor_settings.absTolTempSoilSnow << "\n"
+ << "relTolWatSnow: " << hru_actor_settings.relTolWatSnow << "\n"
+ << "absTolWatSnow: " << hru_actor_settings.absTolWatSnow << "\n"
+ << "relTolMatric: " << hru_actor_settings.relTolMatric << "\n"
+ << "absTolMatric: " << hru_actor_settings.absTolMatric << "\n"
+ << "relTolAquifr: " << hru_actor_settings.relTolAquifr << "\n"
+ << "absTolAquifr: " << hru_actor_settings.absTolAquifr << "\n\n\n";
}
\ No newline at end of file
diff --git a/build/source/actors/hru_actor/cpp_code/hru_actor.cpp b/build/source/actors/hru_actor/cpp_code/hru_actor.cpp
index 9a66514301dd3e8f802ad7941d264162c01bd481..38a39d2d811126119a244e1a153cd4ddc5b21820 100644
--- a/build/source/actors/hru_actor/cpp_code/hru_actor.cpp
+++ b/build/source/actors/hru_actor/cpp_code/hru_actor.cpp
@@ -10,7 +10,9 @@
namespace caf {
behavior hru_actor(stateful_actor<hru_state>* self, int refGRU, int indxGRU,
- HRU_Actor_Settings hru_actor_settings, caf::actor file_access_actor, caf::actor parent) {
+ HRU_Actor_Settings hru_actor_settings,
+ caf::actor file_access_actor,
+ caf::actor parent) {
// Actor References
self->state.file_access_actor = file_access_actor;
@@ -29,28 +31,85 @@ behavior hru_actor(stateful_actor<hru_state>* self, int refGRU, int indxGRU,
self->state.dt_init_factor = hru_actor_settings.dt_init_factor;
- initHRU(&self->state.indxGRU, &self->state.num_steps, self->state.handle_lookupStruct, self->state.handle_forcStat,
- self->state.handle_progStat, self->state.handle_diagStat, self->state.handle_fluxStat, self->state.handle_indxStat,
- self->state.handle_bvarStat, self->state.handle_timeStruct, self->state.handle_forcStruct, self->state.handle_indxStruct,
- self->state.handle_progStruct, self->state.handle_diagStruct, self->state.handle_fluxStruct,
- self->state.handle_bvarStruct, self->state.handle_startTime, self->state.handle_finshTime,
- self->state.handle_refTime,self->state.handle_oldTime, &self->state.err);
+ initHRU(&self->state.indxGRU,
+ &self->state.num_steps,
+ self->state.handle_lookupStruct,
+ self->state.handle_forcStat,
+ self->state.handle_progStat,
+ self->state.handle_diagStat,
+ self->state.handle_fluxStat,
+ self->state.handle_indxStat,
+ self->state.handle_bvarStat,
+ self->state.handle_timeStruct,
+ self->state.handle_forcStruct,
+ self->state.handle_attrStruct,
+ self->state.handle_typeStruct,
+ self->state.handle_idStruct,
+ self->state.handle_indxStruct,
+ self->state.handle_mparStruct,
+ self->state.handle_progStruct,
+ self->state.handle_diagStruct,
+ self->state.handle_fluxStruct,
+ self->state.handle_bparStruct,
+ self->state.handle_bvarStruct,
+ self->state.handle_dparStruct,
+ self->state.handle_startTime,
+ self->state.handle_finshTime,
+ self->state.handle_refTime,
+ self->state.handle_oldTime,
+ &self->state.err);
+
+
if (self->state.err != 0) {
- aout(self) << "Error: HRU_Actor - Initialize - HRU = " << self->state.indxHRU <<
- " - indxGRU = " << self->state.indxGRU << " - refGRU = "<< self->state.refGRU << std::endl;
- aout(self) << "Error = " << self->state.err << "\n";
+ aout(self) << "Error: HRU_Actor - Initialize - HRU = " << self->state.indxHRU
+ << " - indxGRU = " << self->state.indxGRU
+ << " - refGRU = "<< self->state.refGRU
+ << "\nError Code = " << self->state.err << "\n";
self->quit();
}
- // Initialize flags taht are used for the output
- initStatisticsFlags(self->state.handle_statCounter, self->state.handle_outputTimeStep,
- self->state.handle_resetStats, self->state.handle_finalizeStats, &self->state.err);
-
-
- self->send(self->state.file_access_actor, get_num_output_steps_v, self);
-
- // Get attributes
- self->send(self->state.file_access_actor, get_attributes_params_v, self->state.indxGRU, self);
+ // Initialize flags that are used for the output
+ initStatisticsFlags(self->state.handle_statCounter,
+ self->state.handle_outputTimeStep,
+ self->state.handle_resetStats,
+ self->state.handle_finalizeStats,
+ &self->state.err);
+
+ // Get the number of timesteps required until needing to write
+ self->request(self->state.file_access_actor,
+ caf::infinite,
+ get_num_output_steps_v)
+ .await([=](int num_steps){
+ self->state.num_steps_until_write = num_steps;
+ self->state.output_structure_step_index = 1;
+ Initialize_HRU(self);
+ self->send(self, start_hru_v);
+ });
+
+
+
+ // // Get the attributes and parameters for the HRU
+ // self->request(self->state.file_access_actor,
+ // caf::infinite,
+ // get_attributes_params_v,
+ // self->state.indxGRU)
+ // .await([=](std::tuple<std::vector<double>,
+ // std::vector<int>,
+ // std::vector<long int>,
+ // std::vector<double>,
+ // std::vector<double>,
+ // std::vector<std::vector<double>>> attr_and_params) {
+ // int err = 0;
+ // set_var_d(std::get<0>(attr_and_params), self->state.handle_attrStruct);
+ // set_var_i(std::get<1>(attr_and_params), self->state.handle_typeStruct);
+ // set_var_i8(std::get<2>(attr_and_params), self->state.handle_idStruct);
+ // set_var_d(std::get<3>(attr_and_params), self->state.handle_bparStruct);
+ // set_var_d(std::get<4>(attr_and_params), self->state.handle_dparStruct);
+ // set_var_dlength(std::get<5>(attr_and_params), self->state.handle_mparStruct);
+
+ // Initialize_HRU(self);
+
+ // self->send(self, start_hru_v); });
return {
@@ -65,33 +124,21 @@ behavior hru_actor(stateful_actor<hru_state>* self, int refGRU, int indxGRU,
std::vector<double> bpar_struct_array = get_var_d(self->state.handle_bparStruct);
// ask file_access_actor to write parameters
- self->send(self->state.file_access_actor, write_param_v,
- self->state.indxGRU, self->state.indxHRU, attr_struct_array,
- type_struct_array, mpar_struct_array, bpar_struct_array);
+ self->send(self->state.file_access_actor,
+ write_param_v,
+ self->state.indxGRU,
+ self->state.indxHRU,
+ attr_struct_array,
+ type_struct_array,
+ mpar_struct_array,
+ bpar_struct_array);
// ask file_access_actor for forcing data
- self->send(self->state.file_access_actor, access_forcing_v, self->state.iFile, self);
-
- },
-
- // Starts the HRU and tells it to ask for data from the file_access_actor
- [=](get_attributes_params, std::vector<double> attr_struct, std::vector<int> type_struct,
- std::vector<long int> id_struct, std::vector<double> bpar_struct,
- std::vector<double> dpar_struct, std::vector<std::vector<double>> mpar_struct) {
-
- int err = 0;
- set_var_d(attr_struct, self->state.handle_attrStruct);
- set_var_i(type_struct, self->state.handle_typeStruct);
- set_var_i8(id_struct, self->state.handle_idStruct);
- set_var_d(bpar_struct, self->state.handle_bparStruct);
- set_var_d(dpar_struct, self->state.handle_dparStruct);
- set_var_dlength(mpar_struct, self->state.handle_mparStruct);
-
- Initialize_HRU(self);
-
- self->send(self, start_hru_v);
+ self->send(self->state.file_access_actor,
+ access_forcing_v,
+ self->state.iFile,
+ self);
},
-
[=](num_steps_before_write, int num_steps) {
self->state.num_steps_until_write = num_steps;
self->state.output_structure_step_index = 1;
@@ -124,34 +171,35 @@ behavior hru_actor(stateful_actor<hru_state>* self, int refGRU, int indxGRU,
return;
}
- writeHRUToOutputStructure(&self->state.indxHRU, &self->state.indxGRU,
- &self->state.output_structure_step_index,
- self->state.handle_forcStat,
- self->state.handle_progStat,
- self->state.handle_diagStat,
- self->state.handle_fluxStat,
- self->state.handle_indxStat,
- self->state.handle_bvarStat,
- self->state.handle_timeStruct,
- self->state.handle_forcStruct,
- self->state.handle_indxStruct,
- self->state.handle_mparStruct,
- self->state.handle_progStruct,
- self->state.handle_diagStruct,
- self->state.handle_fluxStruct,
- self->state.handle_bparStruct,
- self->state.handle_bvarStruct,
- self->state.handle_statCounter,
- self->state.handle_outputTimeStep,
- self->state.handle_resetStats,
- self->state.handle_finalizeStats,
- self->state.handle_finshTime,
- self->state.handle_oldTime,
- &err);
+ writeHRUToOutputStructure(&self->state.indxHRU,
+ &self->state.indxGRU,
+ &self->state.output_structure_step_index,
+ self->state.handle_forcStat,
+ self->state.handle_progStat,
+ self->state.handle_diagStat,
+ self->state.handle_fluxStat,
+ self->state.handle_indxStat,
+ self->state.handle_bvarStat,
+ self->state.handle_timeStruct,
+ self->state.handle_forcStruct,
+ self->state.handle_indxStruct,
+ self->state.handle_mparStruct,
+ self->state.handle_progStruct,
+ self->state.handle_diagStruct,
+ self->state.handle_fluxStruct,
+ self->state.handle_bparStruct,
+ self->state.handle_bvarStruct,
+ self->state.handle_statCounter,
+ self->state.handle_outputTimeStep,
+ self->state.handle_resetStats,
+ self->state.handle_finalizeStats,
+ self->state.handle_finshTime,
+ self->state.handle_oldTime,
+ &err);
if (err != 0) {
- aout(self) << "Error: HRU_Actor - writeHRUToOutputStructure - HRU = " << self->state.indxHRU <<
- " - indxGRU = " << self->state.indxGRU << " - refGRU = "<< self->state.refGRU << std::endl;
- aout(self) << "Error = " << err << "\n";
+ aout(self) << "Error: HRU_Actor - writeHRUToOutputStructure - HRU = " << self->state.indxHRU
+ << " - indxGRU = " << self->state.indxGRU << " - refGRU = " << self->state.refGRU
+ << "\nError = " << err << "\n";
self->send(self->state.parent, hru_error::run_physics_unhandleable, self);
self->quit();
return;
@@ -204,41 +252,64 @@ behavior hru_actor(stateful_actor<hru_state>* self, int refGRU, int indxGRU,
void Initialize_HRU(stateful_actor<hru_state>* self) {
- setupHRUParam(&self->state.indxHRU,
- &self->state.indxGRU,
- self->state.handle_attrStruct,
- self->state.handle_typeStruct,
- self->state.handle_idStruct,
- self->state.handle_mparStruct,
- self->state.handle_bparStruct,
- self->state.handle_bvarStruct,
- self->state.handle_dparStruct,
- self->state.handle_lookupStruct,
- self->state.handle_startTime,
- self->state.handle_oldTime,
- &self->state.upArea, &self->state.err);
+ setupHRUParam(&self->state.indxGRU,
+ &self->state.indxHRU,
+ self->state.handle_attrStruct,
+ self->state.handle_typeStruct,
+ self->state.handle_idStruct,
+ self->state.handle_indxStruct,
+ self->state.handle_mparStruct,
+ self->state.handle_progStruct,
+ self->state.handle_bparStruct,
+ self->state.handle_bvarStruct,
+ self->state.handle_dparStruct,
+ self->state.handle_lookupStruct,
+ self->state.handle_startTime,
+ self->state.handle_oldTime,
+ &self->state.upArea,
+ &self->state.err);
if (self->state.err != 0) {
- aout(self) << "Error: HRU_Actor - SetupHRUParam - HRU = " << self->state.indxHRU <<
- " - indxGRU = " << self->state.indxGRU << " - refGRU = " << self->state.refGRU << std::endl;
+ aout(self) << "Error: HRU_Actor - SetupHRUParam - HRU = " << self->state.indxHRU
+ << " - indxGRU = " << self->state.indxGRU
+ << " - refGRU = " << self->state.refGRU << "\n";
self->quit();
return;
}
summa_readRestart(&self->state.indxGRU,
- &self->state.indxHRU,
- self->state.handle_indxStruct,
- self->state.handle_mparStruct,
- self->state.handle_progStruct,
- self->state.handle_diagStruct,
- self->state.handle_fluxStruct,
- self->state.handle_bvarStruct,
- &self->state.dt_init, &self->state.err);
+ &self->state.indxHRU,
+ self->state.handle_indxStruct,
+ self->state.handle_mparStruct,
+ self->state.handle_progStruct,
+ self->state.handle_diagStruct,
+ self->state.handle_fluxStruct,
+ self->state.handle_bvarStruct,
+ &self->state.dt_init,
+ &self->state.err);
if (self->state.err != 0) {
- aout(self) << "Error: HRU_Actor - summa_readRestart - HRU = " << self->state.indxHRU <<
- " - indxGRU = " << self->state.indxGRU << " - refGRU = " << self->state.refGRU << std::endl;
+ aout(self) << "Error: HRU_Actor - summa_readRestart - HRU = " << self->state.indxHRU
+ << " - indxGRU = " << self->state.indxGRU
+ << " - refGRU = " << self->state.refGRU << "\n";
self->quit();
return;
}
+
+ // Set HRU Tolerances
+ setIDATolerances(self->state.handle_mparStruct,
+ &self->state.hru_actor_settings.relTolTempCas,
+ &self->state.hru_actor_settings.absTolTempCas,
+ &self->state.hru_actor_settings.relTolTempVeg,
+ &self->state.hru_actor_settings.absTolTempVeg,
+ &self->state.hru_actor_settings.relTolWatVeg,
+ &self->state.hru_actor_settings.absTolWatVeg,
+ &self->state.hru_actor_settings.relTolTempSoilSnow,
+ &self->state.hru_actor_settings.absTolTempSoilSnow,
+ &self->state.hru_actor_settings.relTolWatSnow,
+ &self->state.hru_actor_settings.absTolWatSnow,
+ &self->state.hru_actor_settings.relTolMatric,
+ &self->state.hru_actor_settings.absTolMatric,
+ &self->state.hru_actor_settings.relTolAquifr,
+ &self->state.hru_actor_settings.absTolAquifr);
}
@@ -255,12 +326,13 @@ int Run_HRU(stateful_actor<hru_state>* self) {
&self->state.iFile,
&self->state.err);
if (self->state.err != 0) {
- aout(self) << "Error: HRU_Actor - ReadForcingHRU - HRU = " << self->state.indxHRU <<
- " - indxGRU = " << self->state.indxGRU << " - refGRU = " << self->state.refGRU << std::endl;
- aout(self) << "Forcing Step = " << self->state.forcingStep << std::endl;
- aout(self) << "Timestep = " << self->state.timestep << std::endl;
- aout(self) << "iFile = " << self->state.iFile << std::endl;
- aout(self) << "Steps in Forcing File = " << self->state.stepsInCurrentFFile << std::endl;
+ aout(self) << "Error---HRU_Actor: ReadForcingHRU\n"
+ << " IndxGRU = " << self->state.indxGRU << "\n"
+ << " RefGRU = " << self->state.refGRU << "\n"
+ << " Forcing Step = " << self->state.forcingStep << "\n"
+ << " Timestep = " << self->state.timestep << "\n"
+ << " iFile = " << self->state.iFile << "\n"
+ << " Steps in Forcing File = " << self->state.stepsInCurrentFFile << "\n";
self->quit();
return -1;
}
@@ -271,28 +343,17 @@ int Run_HRU(stateful_actor<hru_state>* self) {
&self->state.yearLength,
&self->state.err);
if (self->state.err != 0) {
- aout(self) << "Error: HRU_Actor - ComputeTimeForcingHRU - HRU = " << self->state.indxHRU <<
- " - indxGRU = " << self->state.indxGRU << " - refGRU = " << self->state.refGRU << std::endl;
- aout(self) << "Forcing Step = " << self->state.forcingStep << std::endl;
- aout(self) << "Timestep = " << self->state.timestep << std::endl;
- aout(self) << "iFile = " << self->state.iFile << std::endl;
- aout(self) << "Steps in Forcing File = " << self->state.stepsInCurrentFFile << std::endl;
+ aout(self) << "Error---HRU_Actor - ComputeTimeForcingHRU\n"
+ << " IndxGRU = " << self->state.indxGRU << "\n"
+ << " RefGRU = " << self->state.refGRU << "\n"
+ << " Forcing Step = " << self->state.forcingStep << "\n"
+ << " Timestep = " << self->state.timestep << "\n"
+ << " iFile = " << self->state.iFile << "\n"
+ << " Steps in Forcing File = " << self->state.stepsInCurrentFFile << "\n";
self->quit();
return -1;
}
- if (self->state.err != 0) {
- aout(self) << "*********************************************************\n";
- aout(self) << "Error: Forcing - HRU = " << self->state.indxHRU <<
- " - indxGRU = " << self->state.indxGRU << " - refGRU = " << self->state.refGRU <<
- " - Timestep = " << self->state.timestep << "\n" <<
- " iFile = " << self->state.iFile << "\n" <<
- " forcing step" << self->state.forcingStep << "\n" <<
- " numSteps in forcing file" << self->state.stepsInCurrentFFile << "\n";
- aout(self) << "*********************************************************\n";
- return 10;
- }
-
if (self->state.hru_actor_settings.print_output &&
self->state.timestep % self->state.hru_actor_settings.output_frequency == 0) {
printOutput(self);
@@ -326,10 +387,10 @@ int Run_HRU(stateful_actor<hru_state>* self) {
&self->state.err);
if (self->state.err != 0) {
- aout(self) << "\033[1;31mError: RunPhysics - HRU = " << self->state.indxHRU
- << " - indxGRU = " << self->state.indxGRU
- << " - refGRU = " << self->state.refGRU
- << " - Timestep = " << self->state.timestep << "\033[0m" << std::endl;
+ aout(self) << "Error---RunPhysics:\n"
+ << " IndxGRU = " << self->state.indxGRU
+ << " RefGRU = " << self->state.refGRU
+ << " Timestep = " << self->state.timestep << "\n";
self->quit();
return 20;
}
@@ -339,7 +400,7 @@ int Run_HRU(stateful_actor<hru_state>* self) {
void printOutput(stateful_actor<hru_state>* self) {
- aout(self) << self->state.refGRU << " - Timestep = " << self->state.timestep << std::endl;
+ aout(self) << self->state.refGRU << " - Timestep = " << self->state.timestep << "\n";
}
}
\ No newline at end of file
diff --git a/build/source/actors/hru_actor/fortran_code/hru_actor.f90 b/build/source/actors/hru_actor/fortran_code/hru_actor.f90
index 3b815dd092a3280720cc1216e0f8c1ca95310f6e..1ad1316f05ba551d03e2d51deee2a0a98bcf3b66 100644
--- a/build/source/actors/hru_actor/fortran_code/hru_actor.f90
+++ b/build/source/actors/hru_actor/fortran_code/hru_actor.f90
@@ -14,6 +14,7 @@ public::getFirstTimestep
public::setTimeZoneOffset
public::prepareOutput
public::updateCounters
+public::setIDATolerances
real(dp),parameter :: verySmall=1e-3_rkind ! tiny number
real(dp),parameter :: smallOffset=1.e-8_rkind ! small offset (units=days) to force ih=0 at the start of the day
@@ -549,4 +550,65 @@ subroutine updateCounters(handle_timeStruct, handle_statCounter, handle_outputTi
elapsedWrite = elapsedWrite + elapsedSec(startWrite, endWrite)
end subroutine updateCounters
+! Set the HRU's relative and absolute tolerances
+subroutine setIDATolerances(handle_mparStruct, &
+ relTolTempCas, &
+ absTolTempCas, &
+ relTolTempVeg, &
+ absTolTempVeg, &
+ relTolWatVeg, &
+ absTolWatVeg, &
+ relTolTempSoilSnow, &
+ absTolTempSoilSnow, &
+ relTolWatSnow, &
+ absTolWatSnow, &
+ relTolMatric, &
+ absTolMatric, &
+ relTolAquifr, &
+ absTolAquifr) bind(C, name="setIDATolerances")
+ USE data_types,only:var_dlength
+ USE var_lookup,only:iLookPARAM
+
+ implicit none
+
+ type(c_ptr), intent(in), value :: handle_mparStruct ! model parameters
+ real(c_double),intent(in) :: relTolTempCas
+ real(c_double),intent(in) :: absTolTempCas
+ real(c_double),intent(in) :: relTolTempVeg
+ real(c_double),intent(in) :: absTolTempVeg
+ real(c_double),intent(in) :: relTolWatVeg
+ real(c_double),intent(in) :: absTolWatVeg
+ real(c_double),intent(in) :: relTolTempSoilSnow
+ real(c_double),intent(in) :: absTolTempSoilSnow
+ real(c_double),intent(in) :: relTolWatSnow
+ real(c_double),intent(in) :: absTolWatSnow
+ real(c_double),intent(in) :: relTolMatric
+ real(c_double),intent(in) :: absTolMatric
+ real(c_double),intent(in) :: relTolAquifr
+ real(c_double),intent(in) :: absTolAquifr
+ ! local variables
+ type(var_dlength),pointer :: mparStruct ! model parameters
+
+ call c_f_pointer(handle_mparStruct, mparStruct)
+
+ mparStruct%var(iLookPARAM%relTolTempCas)%dat(1) = relTolTempCas
+ mparStruct%var(iLookPARAM%absTolTempCas)%dat(1) = absTolTempCas
+ mparStruct%var(iLookPARAM%relTolTempVeg)%dat(1) = relTolTempVeg
+ mparStruct%var(iLookPARAM%absTolTempVeg)%dat(1) = absTolTempVeg
+ mparStruct%var(iLookPARAM%relTolWatVeg)%dat(1) = relTolWatVeg
+ mparStruct%var(iLookPARAM%absTolWatVeg)%dat(1) = absTolWatVeg
+ mparStruct%var(iLookPARAM%relTolTempSoilSnow)%dat(1) = relTolTempSoilSnow
+ mparStruct%var(iLookPARAM%absTolTempSoilSnow)%dat(1) = absTolTempSoilSnow
+ mparStruct%var(iLookPARAM%relTolWatSnow)%dat(1) = relTolWatSnow
+ mparStruct%var(iLookPARAM%absTolWatSnow)%dat(1) = absTolWatSnow
+ mparStruct%var(iLookPARAM%relTolMatric)%dat(1) = relTolMatric
+ mparStruct%var(iLookPARAM%absTolMatric)%dat(1) = absTolMatric
+ mparStruct%var(iLookPARAM%relTolAquifr)%dat(1) = relTolAquifr
+ mparStruct%var(iLookPARAM%absTolAquifr)%dat(1) = absTolAquifr
+
+
+
+
+end subroutine setIDATolerances
+
end module hru_actor
\ No newline at end of file
diff --git a/build/source/actors/hru_actor/fortran_code/hru_init.f90 b/build/source/actors/hru_actor/fortran_code/hru_init.f90
index 4089ead9f5c2804099fb5ef57cc1345d7ed0dc11..f8ac820e1d66f229bd2b2ecd5d3ccad8e4a2f00e 100755
--- a/build/source/actors/hru_actor/fortran_code/hru_init.f90
+++ b/build/source/actors/hru_actor/fortran_code/hru_init.f90
@@ -55,13 +55,20 @@ contains
! primary data structures (scalars)
handle_timeStruct, & ! model time data
handle_forcStruct, & ! model forcing data
+ handle_attrStruct, & ! model attribute data
+ handle_typeStruct, & ! model type data
+ handle_idStruct, & ! model id data
! primary data structures (variable length vectors)
handle_indxStruct, & ! model indices
+ handle_mparStruct, & ! model parameters
handle_progStruct, & ! model prognostic (state) variables
handle_diagStruct, & ! model diagnostic variables
handle_fluxStruct, & ! model fluxes
! basin-average structures
+ handle_bparStruct, & ! basin-average variables
handle_bvarStruct, & ! basin-average variables
+ ! ancillary data structures
+ handle_dparStruct, & ! default model parameters
! local HRU data structures
handle_startTime, & ! start time for the model simulation
handle_finshTime, & ! end time for the model simulation
@@ -108,14 +115,20 @@ contains
! primary data structures (scalars)
type(c_ptr), intent(in), value :: handle_timeStruct ! model time data
type(c_ptr), intent(in), value :: handle_forcStruct ! model forcing data
+ type(c_ptr), intent(in), value :: handle_attrStruct ! model attribute data
+ type(c_ptr), intent(in), value :: handle_typeStruct ! model type data
+ type(c_ptr), intent(in), value :: handle_idStruct ! model id data
! primary data structures (variable length vectors)
type(c_ptr), intent(in), value :: handle_indxStruct ! model indices
+ type(c_ptr), intent(in), value :: handle_mparStruct ! model parameters
type(c_ptr), intent(in), value :: handle_progStruct ! model prognostic (state) variables
type(c_ptr), intent(in), value :: handle_diagStruct ! model diagnostic variables
type(c_ptr), intent(in), value :: handle_fluxStruct ! model fluxes
! basin-average structures
+ type(c_ptr), intent(in), value :: handle_bparStruct ! basin-average variables
type(c_ptr), intent(in), value :: handle_bvarStruct ! basin-average variables
! ancillary data structures
+ type(c_ptr), intent(in), value :: handle_dparStruct ! ancillary data structures
! local hru data structures
type(c_ptr), intent(in), value :: handle_startTime ! start time for the model simulation
type(c_ptr), intent(in), value :: handle_finshTime ! end time for the model simulation
@@ -125,23 +138,29 @@ contains
! ---------------------------------------------------------------------------------------
! * Fortran Variables For Conversion
! ---------------------------------------------------------------------------------------
- type(zLookup),pointer :: lookupStruct ! z(:)%var(:)%lookup(:) -- lookup tables
- type(var_dlength),pointer :: forcStat ! model forcing data
- type(var_dlength),pointer :: progStat ! model prognostic (state) variables
- type(var_dlength),pointer :: diagStat ! model diagnostic variables
- type(var_dlength),pointer :: fluxStat ! model fluxes
- type(var_dlength),pointer :: indxStat ! model indices
- type(var_dlength),pointer :: bvarStat ! basin-average variabl
+ type(zLookup),pointer :: lookupStruct ! z(:)%var(:)%lookup(:) -- lookup tables
+ type(var_dlength),pointer :: forcStat ! model forcing data
+ type(var_dlength),pointer :: progStat ! model prognostic (state) variables
+ type(var_dlength),pointer :: diagStat ! model diagnostic variables
+ type(var_dlength),pointer :: fluxStat ! model fluxes
+ type(var_dlength),pointer :: indxStat ! model indices
+ type(var_dlength),pointer :: bvarStat ! basin-average variabl
! primary data structures (scalars)
- type(var_i),pointer :: timeStruct ! model time data
- type(var_d),pointer :: forcStruct ! model forcing data
+ type(var_i),pointer :: timeStruct ! model time data
+ type(var_d),pointer :: forcStruct ! model forcing data
+ type(var_d),pointer :: attrStruct ! model attribute data
+ type(var_i),pointer :: typeStruct ! model type data
+ type(var_i8),pointer :: idStruct ! model id data
! primary data structures (variable length vectors)
- type(var_ilength),pointer :: indxStruct ! model indices
- type(var_dlength),pointer :: progStruct ! model prognostic (state) variables
- type(var_dlength),pointer :: diagStruct ! model diagnostic variables
- type(var_dlength),pointer :: fluxStruct ! model fluxes
+ type(var_ilength),pointer :: indxStruct ! model indices
+ type(var_dlength),pointer :: mparStruct ! model parameters
+ type(var_dlength),pointer :: progStruct ! model prognostic (state) variables
+ type(var_dlength),pointer :: diagStruct ! model diagnostic variables
+ type(var_dlength),pointer :: fluxStruct ! model fluxes
! basin-average structures
- type(var_dlength),pointer :: bvarStruct ! basin-average variables
+ type(var_d),pointer :: bparStruct ! basin-average variables
+ type(var_dlength),pointer :: bvarStruct ! basin-average variables
+ type(var_d),pointer :: dparStruct ! default model parameters
! local HRU data structures
type(var_i),pointer :: startTime_hru ! start time for the model simulation
type(var_i),pointer :: finishTime_hru ! end time for the model simulation
@@ -165,11 +184,17 @@ contains
call c_f_pointer(handle_bvarStat, bvarStat)
call c_f_pointer(handle_timeStruct, timeStruct)
call c_f_pointer(handle_forcStruct, forcStruct)
+ 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_indxStruct, indxStruct)
+ call c_f_pointer(handle_mparStruct, mparStruct)
call c_f_pointer(handle_progStruct, progStruct)
call c_f_pointer(handle_diagStruct, diagStruct)
call c_f_pointer(handle_fluxStruct, fluxStruct)
+ 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_hru)
call c_f_pointer(handle_finshTime, finishTime_hru)
call c_f_pointer(handle_refTime, refTime_hru)
@@ -177,7 +202,7 @@ contains
! ---------------------------------------------------------------------------------------
! initialize error control
- err=0; message='summaActors_initialize/'
+ err=0; message='hru_init/'
! initialize the start of the initialization
call date_and_time(values=startInit)
@@ -221,19 +246,19 @@ contains
do iStruct=1,size(structInfo)
! allocate space
select case(trim(structInfo(iStruct)%structName))
- case('time'); call allocLocal(time_meta,timeStruct,err=err,message=cmessage) ! model forcing data
+ case('time'); call allocLocal(time_meta,timeStruct,err=err,message=cmessage) ! model time data
case('forc'); call allocLocal(forc_meta,forcStruct,nSnow,nSoil,err,cmessage); ! model forcing data
- case('attr'); cycle ! set by file_access_actor
- case('type'); cycle ! set by file_access_actor
- case('id' ); cycle ! set by file_access_actor
- case('mpar'); cycle ! set by file_access_actor
+ case('attr'); call allocLocal(attr_meta,attrStruct,nSnow,nSoil,err,cmessage); ! model attribute data
+ case('type'); call allocLocal(type_meta,typeStruct,nSnow,nSoil,err,cmessage); ! model type data
+ case('id' ); call allocLocal(id_meta,idStruct,nSnow,nSoil,err,cmessage); ! model id data
+ case('mpar'); call allocLocal(mpar_meta,mparStruct,nSnow,nSoil,err,cmessage); ! model parameters
case('indx'); call allocLocal(indx_meta,indxStruct,nSnow,nSoil,err,cmessage); ! model variables
case('prog'); call allocLocal(prog_meta,progStruct,nSnow,nSoil,err,cmessage); ! model prognostic (state) variables
case('diag'); call allocLocal(diag_meta,diagStruct,nSnow,nSoil,err,cmessage); ! model diagnostic variables
case('flux'); call allocLocal(flux_meta,fluxStruct,nSnow,nSoil,err,cmessage); ! model fluxes
- case('bpar'); cycle ! set by file_access_actor
+ case('bpar'); call allocLocal(bpar_meta,bparStruct,nSnow=0,nSoil=0,err=err,message=cmessage); ! basin-average variables
case('bvar'); call allocLocal(bvar_meta,bvarStruct,nSnow=0,nSoil=0,err=err,message=cmessage); ! basin-average variables
- case('lookup'); call allocLocal(lookup_meta,lookupStruct,err=err,message=cmessage) ! basin-average variables
+ case('lookup'); cycle ! allocated in t2enthalpy.f90
case('deriv'); cycle
case default; err=20; message='unable to find structure name: '//trim(structInfo(iStruct)%structName)
end select
@@ -245,6 +270,12 @@ contains
endif
end do ! looping through data structures
+ ! allocate space for default model parameters
+ ! NOTE: This is done here, rather than in the loop above, because dpar is not one of the "standard" data structures
+ call allocLocal(mpar_meta,dparStruct,nSnow,nSoil,err,cmessage); ! default model parameters
+ if(err/=0)then; message=trim(message)//trim(cmessage)//' [problem allocating dparStruct]'; print*,message;return;endif
+
+
! *****************************************************************************
! *** allocate space for output statistics data structures
diff --git a/build/source/actors/hru_actor/fortran_code/hru_modelRun.f90 b/build/source/actors/hru_actor/fortran_code/hru_modelRun.f90
index 63bcf611f1ae496514aa7a622f86bdc3fe861aec..bb5476b6c5f849af1030ed92ada320b72b339eab 100644
--- a/build/source/actors/hru_actor/fortran_code/hru_modelRun.f90
+++ b/build/source/actors/hru_actor/fortran_code/hru_modelRun.f90
@@ -57,7 +57,6 @@ USE var_lookup,only:iLookINDEX ! look-up values for local column ind
USE var_lookup,only:iLookPROG ! look-up values for local column model prognostic (state) variables
USE var_lookup,only:iLookPARAM ! look-up values for local column model parameters
USE var_lookup,only:iLookDECISIONS ! look-up values for model decisions
-USE summa4chm_util,only:handle_err
! Noah-MP parameters
USE NOAHMP_VEG_PARAMETERS,only:SAIM,LAIM ! 2-d tables for stem area index and leaf area index (vegType,month)
@@ -223,7 +222,7 @@ subroutine runPhysics(&
notUsed_canopyDepth, & ! intent(out): NOT USED: canopy depth (m)
notUsed_exposedVAI, & ! intent(out): NOT USED: exposed vegetation area index (m2 m-2)
err,cmessage) ! intent(out): error control
- if(err/=0)then;message=trim(message)//trim(cmessage); print*, char(27),'[33m',message,char(27),'[0m'; return; endif
+ if(err/=0)then;message=trim(message)//trim(cmessage); print*, message; return; endif
! save the flag for computing the vegetation fluxes
@@ -275,7 +274,7 @@ subroutine runPhysics(&
! get height at bottom of each soil layer, negative downwards (used in Noah MP)
allocate(zSoilReverseSign(nSoil),stat=err)
- if(err/=0)then; message=trim(message)//'problem allocating space for zSoilReverseSign'; print*, char(27),'[33m',message,char(27),'[0m'; return; endif
+ if(err/=0)then; message=trim(message)//'problem allocating space for zSoilReverseSign'; print*, message; return; endif
zSoilReverseSign(:) = -progStruct%var(iLookPROG%iLayerHeight)%dat(nSnow+1:nLayers)
@@ -291,7 +290,7 @@ subroutine runPhysics(&
! deallocate height at bottom of each soil layer(used in Noah MP)
deallocate(zSoilReverseSign,stat=err)
- if(err/=0)then;message=trim(message)//'problem deallocating space for zSoilReverseSign'; print*, char(27),'[33m',message,char(27),'[0m'; return; endif
+ if(err/=0)then;message=trim(message)//'problem deallocating space for zSoilReverseSign'; print*, message; return; endif
! overwrite the minimum resistance
@@ -318,7 +317,7 @@ subroutine runPhysics(&
fluxStruct, & ! data structure of model fluxes
tmZoneOffsetFracDay,& ! time zone offset in fractional days
err,cmessage) ! error control
- if(err/=0)then;err=20; message=trim(message)//cmessage; print*, char(27),'[33m',message,char(27),'[0m'; return; endif
+ if(err/=0)then;err=20; message=trim(message)//cmessage; print*, message; return; endif
! initialize the number of flux calls
diagStruct%var(iLookDIAG%numFluxCalls)%dat(1) = 0._dp
@@ -346,7 +345,7 @@ subroutine runPhysics(&
fluxStruct, & ! intent(inout): model fluxes for a local HRU
! error control
err,cmessage) ! intent(out): error control
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); print*, char(27),'[33m',message,char(27),'[0m'; return; endif;
+ if(err/=0)then; err=20; message=trim(message)//trim(cmessage); print*, message; return; endif;
!************************************* End of run_oneHRU *****************************************
@@ -380,7 +379,7 @@ subroutine runPhysics(&
! compute water balance for the basin aquifer
if(model_decisions(iLookDECISIONS%spatial_gw)%iDecision == singleBasin)then
message=trim(message)//'multi_driver/bigBucket groundwater code not transferred from old code base yet'
- err=20; print*, char(27),'[33m',message,char(27),'[0m'; return
+ err=20; print*, message; return
end if
! calculate total runoff depending on whether aquifer is connected
@@ -392,23 +391,19 @@ subroutine runPhysics(&
bvarStruct%var(iLookBVAR%basin__TotalRunoff)%dat(1) = bvarStruct%var(iLookBVAR%basin__SurfaceRunoff)%dat(1) + bvarStruct%var(iLookBVAR%basin__ColumnOutflow)%dat(1)/totalArea + bvarStruct%var(iLookBVAR%basin__SoilDrainage)%dat(1)
endif
- call qOverland(&
- ! input
+ call qOverland(&! input
model_decisions(iLookDECISIONS%subRouting)%iDecision, & ! intent(in): index for routing method
- bvarStruct%var(iLookBVAR%basin__TotalRunoff)%dat(1), & ! intent(in): total runoff to the channel from all active components (m s-1)
+ bvarStruct%var(iLookBVAR%basin__TotalRunoff)%dat(1), & ! intent(in): total runoff to the channel from all active components (m s-1)
bvarStruct%var(iLookBVAR%routingFractionFuture)%dat, & ! intent(in): fraction of runoff in future time steps (m s-1)
bvarStruct%var(iLookBVAR%routingRunoffFuture)%dat, & ! intent(in): runoff in future time steps (m s-1)
! output
bvarStruct%var(iLookBVAR%averageInstantRunoff)%dat(1), & ! intent(out): instantaneous runoff (m s-1)
bvarStruct%var(iLookBVAR%averageRoutedRunoff)%dat(1), & ! intent(out): routed runoff (m s-1)
err,message) ! intent(out): error control
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); print*, char(27),'[33m',message,char(27),'[0m'; return; endif;
+ if(err/=0)then; err=20; message=trim(message)//trim(cmessage); print*, message; return; endif;
end associate
!************************************* End of run_oneGRU *****************************************
-
- ! check errors
- call handle_err(err, cmessage)
end subroutine runPhysics
diff --git a/build/source/actors/hru_actor/fortran_code/hru_modelwrite.f90 b/build/source/actors/hru_actor/fortran_code/hru_modelwrite.f90
index a71f284c1aa12e48119083f928956e95ba743c38..96c95688dc159e3527bf898de4f190044ca7278d 100755
--- a/build/source/actors/hru_actor/fortran_code/hru_modelwrite.f90
+++ b/build/source/actors/hru_actor/fortran_code/hru_modelwrite.f90
@@ -116,17 +116,17 @@ subroutine writeParm(indxGRU,indxHRU,ispatial,struct,meta,structName,err,message
select type (struct)
class is (var_i)
if (structName == "type")then
- outputStructure(1)%typeStruct(1)%gru(indxGRU)%hru(indxHRU)%var(iVar) = struct%var(iVar)
+ outputStructure(1)%typeStruct%gru(indxGRU)%hru(indxHRU)%var(iVar) = struct%var(iVar)
end if
class is (var_i8)
class is (var_d)
if (structName == "attr")then
- outputStructure(1)%attrStruct(1)%gru(indxGRU)%hru(indxHRU)%var(iVar) = struct%var(iVar)
+ outputStructure(1)%attrStruct%gru(indxGRU)%hru(indxHRU)%var(iVar) = struct%var(iVar)
end if
class is (var_dlength)
if (structName == "mpar")then
- outputStructure(1)%mparStruct(1)%gru(indxGRU)%hru(indxHRU)%var(iVar) = struct%var(iVar)
+ outputStructure(1)%mparStruct%gru(indxGRU)%hru(indxHRU)%var(iVar) = struct%var(iVar)
end if
class default; err=20; message=trim(message)//'unknown variable type (with HRU)'; return
@@ -138,7 +138,7 @@ subroutine writeParm(indxGRU,indxHRU,ispatial,struct,meta,structName,err,message
select type (struct)
class is (var_d)
if (structName == "bpar")then
- outputStructure(1)%bparStruct(1)%gru(indxGRU)%var(iVar) = struct%var(iVar) ! this will overwrite data
+ outputStructure(1)%bparStruct%gru(indxGRU)%var(iVar) = struct%var(iVar) ! this will overwrite data
print*, "bpar"
end if
class is (var_i8)
@@ -213,7 +213,7 @@ subroutine writeData(indxGRU,indxHRU,iStep,structName,finalizeStats, &
! Write the time step values
select type(dat) ! forcStruc
class is (var_d) ! x%var(:)
- outputStructure(1)%forcStruct(1)%gru(indxGRU)%hru(indxHRU)%var(iVar)%tim(iStep) = dat%var(iVar)
+ outputStructure(1)%forcStruct%gru(indxGRU)%hru(indxHRU)%var(iVar)%tim(iStep) = dat%var(iVar)
class default; err=20; message=trim(message)//'time variable must be of type var_d (forcing data structure)'; return
end select
end if ! id time
@@ -230,15 +230,15 @@ subroutine writeData(indxGRU,indxHRU,iStep,structName,finalizeStats, &
class is (var_dlength)
select case(trim(structName))
case('forc')
- outputStructure(1)%forcStat(1)%gru(indxGRU)%hru(indxHRU)%var(map(iVar))%tim(iStep)%dat(iFreq) = stat%var(map(iVar))%dat(iFreq)
+ outputStructure(1)%forcStat%gru(indxGRU)%hru(indxHRU)%var(map(iVar))%tim(iStep)%dat(iFreq) = stat%var(map(iVar))%dat(iFreq)
case('prog')
- outputStructure(1)%progStat(1)%gru(indxGRU)%hru(indxHRU)%var(map(iVar))%tim(iStep)%dat(iFreq) = stat%var(map(iVar))%dat(iFreq)
+ outputStructure(1)%progStat%gru(indxGRU)%hru(indxHRU)%var(map(iVar))%tim(iStep)%dat(iFreq) = stat%var(map(iVar))%dat(iFreq)
case('diag')
- outputStructure(1)%diagStat(1)%gru(indxGRU)%hru(indxHRU)%var(map(iVar))%tim(iStep)%dat(iFreq) = stat%var(map(iVar))%dat(iFreq)
+ outputStructure(1)%diagStat%gru(indxGRU)%hru(indxHRU)%var(map(iVar))%tim(iStep)%dat(iFreq) = stat%var(map(iVar))%dat(iFreq)
case('flux')
- outputStructure(1)%fluxStat(1)%gru(indxGRU)%hru(indxHRU)%var(map(iVar))%tim(iStep)%dat(iFreq) = stat%var(map(iVar))%dat(iFreq)
+ outputStructure(1)%fluxStat%gru(indxGRU)%hru(indxHRU)%var(map(iVar))%tim(iStep)%dat(iFreq) = stat%var(map(iVar))%dat(iFreq)
case('indx')
- outputStructure(1)%indxStat(1)%gru(indxGRU)%hru(indxHRU)%var(map(iVar))%tim(iStep)%dat(iFreq) = stat%var(map(iVar))%dat(iFreq)
+ outputStructure(1)%indxStat%gru(indxGRU)%hru(indxHRU)%var(map(iVar))%tim(iStep)%dat(iFreq) = stat%var(map(iVar))%dat(iFreq)
case default
err=21; message=trim(message)//"Stats structure not found"; return
end select
@@ -250,11 +250,11 @@ subroutine writeData(indxGRU,indxHRU,iStep,structName,finalizeStats, &
! get the model layers
nSoil = indx%var(iLookIndex%nSoil)%dat(1)
- outputStructure(1)%indxStruct(1)%gru(indxGRU)%hru(indxHRU)%var(iLookIndex%nSoil)%tim(iStep)%dat(1) = nSoil
+ outputStructure(1)%indxStruct%gru(indxGRU)%hru(indxHRU)%var(iLookIndex%nSoil)%tim(iStep)%dat(1) = nSoil
nSnow = indx%var(iLookIndex%nSnow)%dat(1)
- outputStructure(1)%indxStruct(1)%gru(indxGRU)%hru(indxHRU)%var(iLookIndex%nSnow)%tim(iStep)%dat(1) = nSnow
+ outputStructure(1)%indxStruct%gru(indxGRU)%hru(indxHRU)%var(iLookIndex%nSnow)%tim(iStep)%dat(1) = nSnow
nLayers = indx%var(iLookIndex%nLayers)%dat(1)
- outputStructure(1)%indxStruct(1)%gru(indxGRU)%hru(indxHRU)%var(iLookIndex%nLayers)%tim(iStep)%dat(1) = nLayers
+ outputStructure(1)%indxStruct%gru(indxGRU)%hru(indxHRU)%var(iLookIndex%nLayers)%tim(iStep)%dat(1) = nLayers
! get the length of each data vector
select case (meta(iVar)%varType)
@@ -273,16 +273,16 @@ subroutine writeData(indxGRU,indxHRU,iStep,structName,finalizeStats, &
class is (var_dlength)
select case(trim(structName))
case('prog')
- outputStructure(1)%progStruct(1)%gru(indxGRU)%hru(indxHRU)%var(iVar)%tim(iStep)%dat(:) = dat%var(iVar)%dat(:)
+ outputStructure(1)%progStruct%gru(indxGRU)%hru(indxHRU)%var(iVar)%tim(iStep)%dat(:) = dat%var(iVar)%dat(:)
case('diag')
- outputStructure(1)%diagStruct(1)%gru(indxGRU)%hru(indxHRU)%var(iVar)%tim(iStep)%dat(:) = dat%var(iVar)%dat(:)
+ outputStructure(1)%diagStruct%gru(indxGRU)%hru(indxHRU)%var(iVar)%tim(iStep)%dat(:) = dat%var(iVar)%dat(:)
case('flux')
- outputStructure(1)%fluxStruct(1)%gru(indxGRU)%hru(indxHRU)%var(iVar)%tim(iStep)%dat(:) = dat%var(iVar)%dat(:)
+ outputStructure(1)%fluxStruct%gru(indxGRU)%hru(indxHRU)%var(iVar)%tim(iStep)%dat(:) = dat%var(iVar)%dat(:)
case default
err=21; message=trim(message)//'data structure not found for output'
end select
class is (var_ilength)
- outputStructure(1)%indxStruct(1)%gru(indxGRU)%hru(indxHRU)%var(iVar)%tim(iStep)%dat(:) = dat%var(iVar)%dat(:)
+ outputStructure(1)%indxStruct%gru(indxGRU)%hru(indxHRU)%var(iVar)%tim(iStep)%dat(:) = dat%var(iVar)%dat(:)
class default; err=20; message=trim(message)//'data must not be scalarv and either of type var_dlength or var_ilength'; return
end select
@@ -362,10 +362,10 @@ subroutine writeBasin(indxGRU,indxHRU,iStep,finalizeStats,&
select case (meta(iVar)%varType)
case (iLookVarType%scalarv)
- outputStructure(1)%bvarStat(1)%gru(indxGRU)%hru(indxHRU)%var(map(iVar))%tim(iStep)%dat(iFreq) = stat(map(iVar))%dat(iFreq)
+ outputStructure(1)%bvarStat%gru(indxGRU)%hru(indxHRU)%var(map(iVar))%tim(iStep)%dat(iFreq) = stat(map(iVar))%dat(iFreq)
case (iLookVarType%routing)
if (iFreq==1 .and. outputTimestep(iFreq)==1) then
- outputStructure(1)%bvarStruct(1)%gru(indxGRU)%hru(indxHRU)%var(iVar)%tim(iStep)%dat(iFreq) = dat(iVar)%dat(iFreq)
+ outputStructure(1)%bvarStruct%gru(indxGRU)%hru(indxHRU)%var(iVar)%tim(iStep)%dat(iFreq) = dat(iVar)%dat(iFreq)
end if
case default
@@ -417,7 +417,7 @@ subroutine writeTime(indxGRU,indxHRU,iStep,finalizeStats,meta,dat,err,message)
if (meta(iVar)%statIndex(iFreq)/=iLookStat%inst) cycle
! add to outputStructure
- outputStructure(1)%timeStruct(1)%gru(indxGRU)%hru(indxHRU)%var(iVar)%tim(iStep) = dat(iVar)
+ outputStructure(1)%timeStruct%gru(indxGRU)%hru(indxHRU)%var(iVar)%tim(iStep) = dat(iVar)
if (err/=0) message=trim(message)//trim(meta(iVar)%varName)
if (err/=0) then; err=20; return; end if
diff --git a/build/source/actors/hru_actor/fortran_code/hru_restart.f90 b/build/source/actors/hru_actor/fortran_code/hru_restart.f90
index c7ea33740a92eee470cd836ecf758c7b93f8fa0a..cc604d0448875cd52fcb9b4edc162d5bff8cc912 100644
--- a/build/source/actors/hru_actor/fortran_code/hru_restart.f90
+++ b/build/source/actors/hru_actor/fortran_code/hru_restart.f90
@@ -69,8 +69,8 @@ subroutine summa_readRestart(&
USE nrtype ! variable types, etc.
! functions and subroutines
USE time_utils_module,only:elapsedSec ! calculate the elapsed time
- USE read_icond_gru_hru_module,only:read_icond ! module to read initial conditions
- USE check_icond4chm_module,only:check_icond4chm ! module to check initial conditions
+ ! USE read_icond_module,only:read_icond ! module to read initial conditions
+ ! USE check_icond4chm_module,only:check_icond4chm ! module to check initial conditions
USE var_derive_module,only:calcHeight ! module to calculate height at layer interfaces and layer mid-point
USE var_derive_module,only:v_shortcut ! module to calculate "short-cut" variables
USE var_derive_module,only:rootDensty ! module to calculate the vertical distribution of roots
@@ -131,31 +131,6 @@ subroutine summa_readRestart(&
! initialize error control
err=0; message='hru_actor_readRestart/'
- nGRU = 1
-
- ! *****************************************************************************
- ! *** read/check initial conditions
- ! *****************************************************************************
- ! read initial conditions
- call read_icond(&
- indxGRU, & ! intent(in): index of GRU in gru_struc
- indxHRU, & ! intent(in): index of HRU in gru_struc
- mparStruct, & ! intent(in): model parameters
- progStruct, & ! intent(inout): model prognostic variables
- bvarStruct, & ! intent(inout): model basin (GRU) variables
- indxStruct, & ! intent(inout): model indices
- err,cmessage) ! intent(out): error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
-
- ! check initial conditions
- call check_icond4chm(&
- indxGRU, & ! intent(in): index of GRU in gru_struc
- indxHRU, & ! intent(in): index of HRU in gru_struc
- progStruct, & ! intent(in): model prognostic (state) variables
- mparStruct, & ! intent(in): model parameters
- indxStruct, & ! intent(in): layer indexes
- err,cmessage) ! intent(out): error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
! *****************************************************************************
diff --git a/build/source/actors/hru_actor/fortran_code/hru_setup.f90 b/build/source/actors/hru_actor/fortran_code/hru_setup.f90
index 60e5fc7e8c25a58037c689b0af12bfe7b027e7e0..c9edd4c1c34105cf5b1cec374711b15c9743d902 100644
--- a/build/source/actors/hru_actor/fortran_code/hru_setup.f90
+++ b/build/source/actors/hru_actor/fortran_code/hru_setup.f90
@@ -49,9 +49,7 @@ USE globalData,only:urbanVegCategory ! vegetation categor
USE globalData,only:mpar_meta,bpar_meta ! parameter metadata structures
! named variables to define the decisions for snow layers
-USE mDecisions_module,only:&
- sameRulesAllLayers, & ! SNTHERM option: same combination/sub-dividion rules applied to all layers
- rulesDependLayerIndex ! CLM option: combination/sub-dividion rules depend on layer index
+
! named variables to define LAI decisions
USE mDecisions_module,only:&
@@ -74,7 +72,9 @@ subroutine setupHRUParam(&
handle_typeStruct, & ! local classification of soil veg etc. for each HRU
handle_idStruct, & ! local classification of soil veg etc. for each HRU
! primary data structures (variable length vectors)
+ handle_indxStruct, & ! model indices
handle_mparStruct, & ! model parameters
+ handle_progStruct, & ! model prognostic (state) variables
handle_bparStruct, & ! basin-average parameters
handle_bvarStruct, & ! basin-average variables
handle_dparStruct, & ! default model parameters
@@ -89,11 +89,10 @@ subroutine setupHRUParam(&
! * desired modules
! ---------------------------------------------------------------------------------------
USE nrtype ! variable types, etc.
+ USE output_structure_module,only:outputStructure
! 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_attrb_module,only:read_attrb ! 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 ConvE2Temp_module,only:E2T_lookup ! module to calculate a look-up table for the temperature-enthalpy conversion
@@ -126,7 +125,9 @@ subroutine setupHRUParam(&
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_indxStruct ! model indices
type(c_ptr), intent(in), value :: handle_mparStruct ! model parameters
+ type(c_ptr), intent(in), value :: handle_progStruct ! model prognostic (state) variables
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
@@ -140,13 +141,18 @@ subroutine setupHRUParam(&
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_ilength),pointer :: indxStruct ! model indices
type(var_dlength),pointer :: mparStruct ! model parameters
+ type(var_dlength),pointer :: progStruct ! model prognostic (state) variables
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(zLookup),pointer :: lookupStruct ! 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
+
+ integer(i4b) :: ivar ! loop counter
+ integer(i4b) :: i_z ! loop counter
character(len=256) :: message ! error message
character(len=256) :: cmessage ! error message of downwind routine
@@ -158,7 +164,9 @@ subroutine setupHRUParam(&
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_indxStruct, indxStruct)
call c_f_pointer(handle_mparStruct, mparStruct)
+ call c_f_pointer(handle_progStruct, progStruct)
call c_f_pointer(handle_bparStruct, bparStruct)
call c_f_pointer(handle_bvarStruct, bvarStruct)
call c_f_pointer(handle_dparStruct, dparStruct)
@@ -170,81 +178,39 @@ subroutine setupHRUParam(&
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
-
- ! 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
-
- ! *****************************************************************************
- ! *** 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
-
- ! calculate a lookup table to compute enthalpy from temperature
- call T2E_lookup(gru_struc(indxGRU)%hruInfo(1)%nSoil, & ! intent(in): number of soil layers
- mparStruct, & ! intent(in): parameter data structure
- lookupStruct, & ! intent(inout): lookup table data structure
- err,cmessage) ! intent(out): error control
- 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)
+ ! Copy the attrStruct
+ attrStruct%var(:) = outputStructure(1)%attrStruct%gru(indxGRU)%hru(indxHRU)%var(:)
+ ! Copy the typeStruct
+ typeStruct%var(:) = outputStructure(1)%typeStruct%gru(indxGRU)%hru(indxHRU)%var(:)
+ ! Copy the idStruct
+ idStruct%var(:) = outputStructure(1)%idStruct%gru(indxGRU)%hru(indxHRU)%var(:)
+
+ ! Copy the mparStruct
+ mparStruct%var(:) = outputStructure(1)%mparStruct%gru(indxGRU)%hru(indxHRU)%var(:)
+ ! Copy the bparStruct
+ bparStruct%var(:) = outputStructure(1)%bparStruct%gru(indxGRU)%var(:)
+ ! Copy the dparStruct
+ dparStruct%var(:) = outputStructure(1)%dparStruct%gru(indxGRU)%hru(indxHRU)%var(:)
+ ! Copy the bvarStruct
+ do ivar=1, size(outputStructure(1)%bvarStruct_init%gru(indxGRU)%var(:))
+ bvarStruct%var(ivar)%dat(:) = outputStructure(1)%bvarStruct_init%gru(indxGRU)%var(ivar)%dat(:)
+ enddo
+ ! Copy the lookup Struct if its allocated
+ if (allocated(outputStructure(1)%lookupStruct%gru(indxGRU)%hru(indxHRU)%z)) then
+ do i_z=1, size(outputStructure(1)%lookupStruct%gru(indxGRU)%hru(indxHRU)%z(:))
+ do iVar=1, size(outputStructure(1)%lookupStruct%gru(indxGRU)%hru(indxHRU)%z(i_z)%var(:))
+ lookupStruct%z(i_z)%var(ivar)%lookup(:) = outputStructure(1)%lookupStruct%gru(indxGRU)%hru(indxHRU)%z(i_z)%var(iVar)%lookup(:)
+ end do
+ end do
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
+ ! Copy the progStruct_init
+ do ivar=1, size(outputStructure(1)%progStruct_init%gru(indxGRU)%hru(indxHRU)%var(:))
+ progStruct%var(ivar)%dat(:) = outputStructure(1)%progStruct_init%gru(indxGRU)%hru(indxHRU)%var(ivar)%dat(:)
+ enddo
+ ! copy the indexStruct_init
+ do ivar=1, size(outputStructure(1)%indxStruct_init%gru(indxGRU)%hru(indxHRU)%var(:))
+ indxStruct%var(ivar)%dat(:) = outputStructure(1)%indxStruct_init%gru(indxGRU)%hru(indxHRU)%var(ivar)%dat(:)
+ enddo
end subroutine setupHRUParam
diff --git a/build/source/actors/hru_actor/fortran_code/hru_writeOutput.f90 b/build/source/actors/hru_actor/fortran_code/hru_writeOutput.f90
index 3fd07dae1aecf20350d8131a72b70e24dbadd087..91f9d6794903a301c98ee7227bb07277d28d35e5 100644
--- a/build/source/actors/hru_actor/fortran_code/hru_writeOutput.f90
+++ b/build/source/actors/hru_actor/fortran_code/hru_writeOutput.f90
@@ -265,7 +265,7 @@ subroutine writeHRUToOutputStructure(&
if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
! If we do not do this looping we segfault - I am not sure why
- outputStructure(1)%finalizeStats(1)%gru(indxGRU)%hru(indxHRU)%tim(outputStep)%dat(:) = finalizeStats%dat(:)
+ outputStructure(1)%finalizeStats%gru(indxGRU)%hru(indxHRU)%tim(outputStep)%dat(:) = finalizeStats%dat(:)
! ****************************************************************************
! *** calculate output statistics
diff --git a/build/source/actors/job_actor/GRU.cpp b/build/source/actors/job_actor/GRU.cpp
index 520c36d973425ab5225bed179d3db4303731cd8c..3f81ab2d39ca9e0d1b8f3711fd1c4aef7485b82e 100644
--- a/build/source/actors/job_actor/GRU.cpp
+++ b/build/source/actors/job_actor/GRU.cpp
@@ -4,12 +4,20 @@
#include <fstream>
+int is_success(const gru_state& state) {
-GRU::GRU(int global_gru_index, int local_gru_index, caf::actor gru_actor, int dt_init_factor, int max_attempt) {
+ return(state == gru_state::succeeded) ? 1 : 0;
+}
+
+
+GRU::GRU(int global_gru_index, int local_gru_index, caf::actor gru_actor,
+ int dt_init_factor, double rel_tol, double abs_tol, int max_attempt) {
this->global_gru_index = global_gru_index;
this->local_gru_index = local_gru_index;
this->gru_actor = gru_actor;
this->dt_init_factor = dt_init_factor;
+ this->rel_tol = rel_tol;
+ this->abs_tol = abs_tol;
this->attempts_left = max_attempt;
this->state = gru_state::running;
}
@@ -48,6 +56,14 @@ double GRU::getWriteOutputDuration() {
return this->write_output_duration;
}
+double GRU::getRelTol() {
+ return this->rel_tol;
+}
+
+double GRU::getAbsTol() {
+ return this->abs_tol;
+}
+
double GRU::getAttemptsLeft() {
return this->attempts_left;
}
@@ -77,6 +93,13 @@ void GRU::setWriteOutputDuration(double write_output_duration) {
this->write_output_duration = write_output_duration;
}
+void GRU::setRelTol(double rel_tol) {
+ this->rel_tol = rel_tol;
+}
+void GRU::setAbsTol(double abs_tol) {
+ this->abs_tol = abs_tol;
+}
+
void GRU::setSuccess() {
this->state = gru_state::succeeded;
}
diff --git a/build/source/actors/job_actor/job_actor.cpp b/build/source/actors/job_actor/job_actor.cpp
index af8df6d67ca95d6c7547b1087a9d68640c55067d..d62b22830fcadaf5436056442db3e39f56a458df 100644
--- a/build/source/actors/job_actor/job_actor.cpp
+++ b/build/source/actors/job_actor/job_actor.cpp
@@ -15,9 +15,12 @@ using chrono_time = std::chrono::time_point<std::chrono::system_clock>;
namespace caf {
// First Actor that is spawned that is not the Coordinator Actor.
-behavior job_actor(stateful_actor<job_state>* self, int start_gru, int num_gru,
- File_Access_Actor_Settings file_access_actor_settings, Job_Actor_Settings job_actor_settings,
- HRU_Actor_Settings hru_actor_settings, caf::actor parent) {
+behavior job_actor(stateful_actor<job_state>* self,
+ int start_gru, int num_gru,
+ File_Access_Actor_Settings file_access_actor_settings,
+ Job_Actor_Settings job_actor_settings,
+ HRU_Actor_Settings hru_actor_settings,
+ caf::actor parent) {
self->set_down_handler([=](const down_msg& dm) {
aout(self) << "\n\n ********** DOWN HANDLER ********** \n";
@@ -55,191 +58,205 @@ behavior job_actor(stateful_actor<job_state>* self, int start_gru, int num_gru,
gethostname(host, HOST_NAME_MAX);
self->state.hostname = host;
- // Initalize global variables
+ // Initalize global variables calling Fortran Routines
int err = 0;
- setTimesDirsAndFiles(self->state.job_actor_settings.file_manager_path.c_str(), &err);
- if (err != 0) {
- aout(self) << "ERROR: Job_Actor - setTimesDirsAndFiles\n";
- return {}; // Failure
- }
- defineGlobalData(&self->state.start_gru, &err);
- if (err != 0) {
- aout(self) << "ERROR: Job_Actor - defineGlobalData\n";
- return {}; // Failure
- }
- readDimension(&self->state.num_gru, &self->state.num_hru, &self->state.start_gru, &err);
- if (err != 0) {
- aout(self) << "ERROR: Job_Actor - readDimension\n";
- return {}; // Failure
- }
- readIcondNLayers(&self->state.num_gru, &err);
- if (err != 0) {
- aout(self) << "ERROR: Job_Actor - readIcondNLayers\n";
- return {}; // Failure
- }
- allocateTimeStructure(&err);
- if (err != 0) {
- aout(self) << "ERROR: Job_Actor - allocateTimeStructure\n";
- return {}; // Failure
- }
+
+
+ /*
+ Calls:
+ - summa_SetTimesDirsAndFiles()
+ - summa_defineGlobalData()
+ - read_icond_nlayers()
+ - Allocates time structures
+ */
+ job_init_fortran(self->state.job_actor_settings.file_manager_path.c_str(),
+ &self->state.start_gru,
+ &self->state.num_gru,
+ &self->state.num_hru,
+ &err);
+ if (err != 0) { aout(self) << "\nERROR: Job_Actor - job_init_fortran\n"; return {}; }
+
// Spawn the file_access_actor. This will return the number of forcing files we are working with
- self->state.file_access_actor = self->spawn(file_access_actor, self->state.start_gru, self->state.num_gru,
- self->state.file_access_actor_settings, self);
+ self->state.file_access_actor = self->spawn(file_access_actor,
+ self->state.start_gru,
+ self->state.num_gru,
+ self->state.file_access_actor_settings,
+ self);
- aout(self) << "Job Actor Initalized \n";
+ aout(self) << "Job Actor Initialized \n";
return {
[=](init_gru) {
- initGRUs(self);
- },
+ auto& gru_container = self->state.gru_container;
+
+ gru_container.gru_start_time = std::chrono::high_resolution_clock::now();
+ gru_container.run_attempts_left = self->state.max_run_attempts;
+ gru_container.run_attempts_left--;
+
+
+ // Spawn the GRUs
+ for(int i = 0; i < gru_container.num_gru_in_run_domain; i++) {
+ auto global_gru_index = gru_container.gru_list.size() + self->state.start_gru;
+ auto local_gru_index = gru_container.gru_list.size() + 1; // Fortran reference starts at 1
+
+ auto gru = self->spawn(hru_actor,
+ global_gru_index,
+ local_gru_index,
+ self->state.hru_actor_settings,
+ self->state.file_access_actor,
+ self);
+
+ // Create the GRU object (Job uses this to keep track of GRU status)
+ gru_container.gru_list.push_back(new GRU(global_gru_index,
+ local_gru_index,
+ gru,
+ self->state.dt_init_start_factor,
+ self->state.hru_actor_settings.rel_tol,
+ self->state.hru_actor_settings.abs_tol,
+ self->state.max_run_attempts));
+ }
+ }, // end init_gru
[=](done_hru, int local_gru_index) {
- chrono_time end_point = std::chrono::high_resolution_clock::now();
- double total_duration = std::chrono::duration_cast<std::chrono::seconds>(end_point -
- self->state.gru_container.gru_start_time).count();
-
- aout(self) << "\nJob_Actor: GRU Finished: \n" <<
- " global_gru_index = " <<
- self->state.gru_container.gru_list[local_gru_index-1]->getGlobalGRUIndex() << "\n" <<
- " local_gru_index = " << local_gru_index << "\n" <<
- " total_duration = " << total_duration << "\n\n";
+ auto& gru_container = self->state.gru_container;
+ using namespace std::chrono;
+
+ chrono_time end_point = high_resolution_clock::now();
+ double total_duration = duration_cast<seconds>(end_point - gru_container.gru_start_time).count();
+
+ aout(self) << "\nJob_Actor: GRU Finished: \n"
+ << " global_gru_index = "
+ << gru_container.gru_list[local_gru_index-1]->getGlobalGRUIndex() << "\n"
+ << " local_gru_index = " << local_gru_index << "\n"
+ << " total_duration = " << total_duration << "\n\n";
// Update Timing
- self->state.gru_container.gru_list[local_gru_index-1]->setRunTime(total_duration);
- self->state.gru_container.gru_list[local_gru_index-1]->setInitDuration(-1);
- self->state.gru_container.gru_list[local_gru_index-1]->setForcingDuration(-1);
- self->state.gru_container.gru_list[local_gru_index-1]->setRunPhysicsDuration(-1);
- self->state.gru_container.gru_list[local_gru_index-1]->setWriteOutputDuration(-1);
+ gru_container.gru_list[local_gru_index-1]->setRunTime(total_duration);
+ gru_container.gru_list[local_gru_index-1]->setInitDuration(-1);
+ gru_container.gru_list[local_gru_index-1]->setForcingDuration(-1);
+ gru_container.gru_list[local_gru_index-1]->setRunPhysicsDuration(-1);
+ gru_container.gru_list[local_gru_index-1]->setWriteOutputDuration(-1);
- self->state.gru_container.gru_list[local_gru_index-1]->setSuccess();
+ gru_container.gru_list[local_gru_index-1]->setSuccess();
- self->state.gru_container.num_gru_done++;
+ gru_container.num_gru_done++;
- // Check if we have finished all active GRUs
- if (self->state.gru_container.num_gru_done >= self->state.gru_container.num_gru_in_run_domain) {
-
+
+ // Check if all GRUs are finished
+ if (gru_container.num_gru_done >= gru_container.num_gru_in_run_domain) {
// Check for failures
- if(self->state.gru_container.num_gru_failed == 0 || self->state.gru_container.run_attempts_left == 0) {
- //TODO: RENAME DEALLOCATE_STURCTURES this is more of a finalize
- std::vector<serializable_netcdf_gru_actor_info> netcdf_gru_info = getGruNetcdfInfo(
- self->state.max_run_attempts,
- self->state.gru_container.gru_list);
- self->send(self->state.file_access_actor, deallocate_structures_v, netcdf_gru_info);
-
+ if(self->state.gru_container.num_gru_failed == 0 || self->state.max_run_attempts == 1) {
+ self->send(self, finalize_v);
} else {
- aout(self) << "Job_Actor: Restarting GRUs that Failed\n";
- self->state.gru_container.num_gru_done = 0;
- self->state.gru_container.num_gru_in_run_domain = self->state.gru_container.num_gru_failed;
- self->state.gru_container.num_gru_failed = 0;
- self->send(self->state.file_access_actor, restart_failures_v);
-
- for(auto GRU : self->state.gru_container.gru_list) {
- if(GRU->isFailed()) {
- GRU->setRunning();
- GRU->decrementAttemptsLeft();
- self->state.hru_actor_settings.dt_init_factor *= 2;
- auto global_gru_index = GRU->getGlobalGRUIndex();
- auto local_gru_index = GRU->getLocalGRUIndex();
- auto gru_actor = self->spawn(hru_actor,
- global_gru_index,
- local_gru_index,
- self->state.hru_actor_settings,
- self->state.file_access_actor,
- self);
- self->state.gru_container.gru_list[local_gru_index-1]->setGRUActor(gru_actor);
- }
- }
-
-
+ self->send(self, restart_failures_v);
}
}
- },
- [=](const error& err, caf::actor src) {
- aout(self) << "\n\n ********** ERROR HANDLER \n";
- switch(err.category()) {
- case type_id_v<hru_error>:
- aout(self) << "HRU Error: " << to_string(err) << "\n";
- handleGRUError(self, err, src);
- break;
- case type_id_v<file_access_error>:
- aout(self) << "File Access Error: " << to_string(err) << "\n";
- break;
- default:
- aout(self) << "Unknown Error: " << to_string(err) << "\n";
- break;
- }
},
-
- [=](file_access_actor_done, double read_duration, double write_duration) {
- int err = 0;
- // Delete GRUs
- for (auto GRU : self->state.gru_container.gru_list) {
- delete GRU;
+ [=](restart_failures) {
+ aout(self) << "Job_Actor: Restarting GRUs that Failed\n";
+
+ self->state.gru_container.num_gru_done = 0;
+ self->state.gru_container.num_gru_in_run_domain = self->state.gru_container.num_gru_failed;
+ self->state.gru_container.num_gru_failed = 0;
+
+ self->send(self->state.file_access_actor, restart_failures_v); // notify file_access_actor
+
+ for(auto GRU : self->state.gru_container.gru_list) {
+ if(GRU->isFailed()) {
+ GRU->setRunning();
+ GRU->decrementAttemptsLeft();
+ self->state.hru_actor_settings.dt_init_factor *= 2;
+ auto global_gru_index = GRU->getGlobalGRUIndex();
+ auto local_gru_index = GRU->getLocalGRUIndex();
+ auto gru_actor = self->spawn(hru_actor,
+ global_gru_index,
+ local_gru_index,
+ self->state.hru_actor_settings,
+ self->state.file_access_actor,
+ self);
+ self->state.gru_container.gru_list[local_gru_index-1]->setGRUActor(gru_actor);
}
- self->state.gru_container.gru_list.clear();
-
-
- self->state.job_timing.updateEndPoint("total_duration");
-
- aout(self) << "\n________________PRINTING JOB_ACTOR TIMING INFO RESULTS________________\n";
- aout(self) << "Total Duration = " << self->state.job_timing.getDuration("total_duration").value_or(-1.0) << " Seconds\n";
- aout(self) << "Total Duration = " << self->state.job_timing.getDuration("total_duration").value_or(-1.0) / 60 << " Minutes\n";
- aout(self) << "Total Duration = " << (self->state.job_timing.getDuration("total_duration").value_or(-1.0) / 60) / 60 << " Hours\n\n";
-
- deallocateJobActor(&err);
- // Tell Parent we are done
- self->send(self->state.parent,
- done_job_v,
- self->state.num_gru_failed,
- self->state.job_timing.getDuration("total_duration").value_or(-1.0),
- read_duration, write_duration);
- self->quit();
+ }
},
+ [=](finalize) {
+
+ std::vector<serializable_netcdf_gru_actor_info>
+ netcdf_gru_info = getGruNetcdfInfo(self->state.max_run_attempts,self->state.gru_container.gru_list);
+
+
+
+ self->state.num_gru_failed = std::count_if(netcdf_gru_info.begin(), netcdf_gru_info.end(), [](auto& gru_info) {
+ return !gru_info.successful;
+ });
+
+ self->request(self->state.file_access_actor,
+ infinite,
+ finalize_v, netcdf_gru_info)
+ .await(
+ [=](std::tuple<double, double> read_write_duration) {
+
+ int err = 0;
+
+
+ for (auto GRU : self->state.gru_container.gru_list) {
+ delete GRU;
+ }
+ self->state.gru_container.gru_list.clear();
+
+ self->state.job_timing.updateEndPoint("total_duration");
+
+ aout(self) << "\n________________PRINTING JOB_ACTOR TIMING INFO RESULTS________________\n"
+ << "Total Duration = " << self->state.job_timing.getDuration("total_duration").value_or(-1.0) << " Seconds\n"
+ << "Total Duration = " << self->state.job_timing.getDuration("total_duration").value_or(-1.0) / 60 << " Minutes\n"
+ << "Total Duration = " << (self->state.job_timing.getDuration("total_duration").value_or(-1.0) / 60) / 60 << " Hours\n"
+ << "________________________________________________________________________\n\n";
+
+ deallocateJobActor(&err);
+
+ // Tell Parent we are done
+ self->send(self->state.parent,
+ done_job_v,
+ self->state.num_gru_failed,
+ self->state.job_timing.getDuration("total_duration").value_or(-1.0),
+ std::get<0>(read_write_duration),
+ std::get<1>(read_write_duration));
+ self->quit();
+
+ });
+ },
- [=](file_access_actor_err, const std::string& err) {
- aout(self) << "\n\033[31mJob_Actor: Error Handling for File_Access_Actor error: " <<
- err << " not implemented\033[0m\n";
- self->quit();
- }
-
-
-
-
-
+ [=](const error& err, caf::actor src) {
+
+ aout(self) << "\n\n ********** ERROR HANDLER \n";
+
+ switch(err.category()) {
+
+ case type_id_v<hru_error>:
+ aout(self) << "HRU Error: " << to_string(err) << "\n";
+ handleGRUError(self, src);
+
+ break;
+ case type_id_v<file_access_error>:
+ aout(self) << "File Access Error: " << to_string(err) << "No Handling Implemented\n";
+ for (auto GRU : self->state.gru_container.gru_list) {
+ self->send_exit(GRU->getGRUActor(), exit_reason::user_shutdown);
+ }
+ self->quit();
+ break;
+ default:
+ aout(self) << "Unknown Error: " << to_string(err) << "\n";
+ break;
+ }
+ },
};
}
-void initGRUs(stateful_actor<job_state>* self) {
- self->state.gru_container.gru_start_time = std::chrono::high_resolution_clock::now();
- self->state.gru_container.run_attempts_left = self->state.max_run_attempts;
- self->state.gru_container.run_attempts_left--;
- for(int i = 0; i < self->state.gru_container.num_gru_in_run_domain; i++) {
- // Spawn the GRU Actor
- auto global_gru_index = self->state.gru_container.gru_list.size() + self->state.start_gru;
- auto local_gru_index = self->state.gru_container.gru_list.size() + 1; // Fortran reference starts at 1
- auto gru = self->spawn(hru_actor,
- global_gru_index,
- local_gru_index,
- self->state.hru_actor_settings,
- self->state.file_access_actor,
- self);
-
- // Create the GRU object
- self->state.gru_container.gru_list.push_back(
- new GRU(global_gru_index,
- local_gru_index,
- gru,
- self->state.dt_init_start_factor,
- self->state.max_run_attempts));
- }
-}
-
std::vector<serializable_netcdf_gru_actor_info> getGruNetcdfInfo(int max_run_attempts, std::vector<GRU*> &gru_list) {
std::vector<serializable_netcdf_gru_actor_info> gru_netcdf_info;
@@ -253,7 +270,9 @@ std::vector<serializable_netcdf_gru_actor_info> getGruNetcdfInfo(int max_run_att
gru_info.write_output_duration = gru->getWriteOutputDuration();
gru_info.num_attempts = max_run_attempts - gru->getAttemptsLeft() + 1;
- gru_info.successful = success(gru->getStatus());
+ gru_info.successful = is_success(gru->getStatus());
+ gru_info.rel_tol = gru->getRelTol();
+ gru_info.abs_tol = gru->getAbsTol();
gru_netcdf_info.push_back(gru_info);
@@ -261,57 +280,35 @@ std::vector<serializable_netcdf_gru_actor_info> getGruNetcdfInfo(int max_run_att
return gru_netcdf_info;
}
-void handleGRUError(stateful_actor<job_state>* self, const error& err, caf::actor src) {
- // Find the GRU that failed
- for(auto GRU : self->state.gru_container.gru_list) {
- if (GRU->getGRUActor() == src) {
- GRU->setFailed();
- GRU->decrementAttemptsLeft();
- self->state.gru_container.num_gru_done++;
- self->state.gru_container.num_gru_failed++;
- self->send(self->state.file_access_actor, run_failure_v, GRU->getLocalGRUIndex());
-
- // Check if we have finished all active GRUs
- if (self->state.gru_container.num_gru_done >= self->state.gru_container.num_gru_in_run_domain) {
- // Check for failures
- if(self->state.gru_container.num_gru_failed == 0 || self->state.max_run_attempts == 1) {
- //TODO: RENAME DEALLOCATE_STURCTURES this is more of a finalize
- std::vector<serializable_netcdf_gru_actor_info> netcdf_gru_info = getGruNetcdfInfo(
- self->state.max_run_attempts,
- self->state.gru_container.gru_list);
- self->send(self->state.file_access_actor, deallocate_structures_v, netcdf_gru_info);
-
- } else {
- aout(self) << "Job_Actor: Restarting GRUs that Failed\n";
- self->send(self->state.file_access_actor, restart_failures_v);
- self->state.gru_container.num_gru_done = 0;
- self->state.gru_container.num_gru_in_run_domain = self->state.gru_container.num_gru_failed;
- self->state.gru_container.num_gru_failed = 0;
- for(auto GRU : self->state.gru_container.gru_list) {
- if(GRU->isFailed()) {
- GRU->setRunning();
- GRU->decrementAttemptsLeft();
- self->state.hru_actor_settings.dt_init_factor *= 2;
- auto global_gru_index = GRU->getGlobalGRUIndex();
- auto local_gru_index = GRU->getLocalGRUIndex();
- auto gru_actor = self->spawn(hru_actor,
- global_gru_index,
- local_gru_index,
- self->state.hru_actor_settings,
- self->state.file_access_actor,
- self);
- self->state.gru_container.gru_list[local_gru_index-1]->setGRUActor(gru_actor);
- }
- }
- }
- }
- break;
- }
- }
+void handleGRUError(stateful_actor<job_state>* self, caf::actor src) {
+ auto it = std::find_if(self->state.gru_container.gru_list.begin(),
+ self->state.gru_container.gru_list.end(),
+ [src](auto& gru) {
+ return gru->getGRUActor() == src;
+ });
+ if (it != self->state.gru_container.gru_list.end()) {
+ (*it)->setFailed();
+ (*it)->decrementAttemptsLeft();
+ self->state.gru_container.num_gru_done++;
+ self->state.gru_container.num_gru_failed++;
+ self->send(self->state.file_access_actor, run_failure_v, (*it)->getLocalGRUIndex());
+ } else {
+ aout(self) << "ERROR: Job_Actor: Could not find GRU in GRU_Container\n";
+ }
+
+ // Check if all GRUs are finished
+ if (self->state.gru_container.num_gru_done >= self->state.gru_container.num_gru_in_run_domain) {
+ // Check for failures
+ if(self->state.gru_container.num_gru_failed == 0 || self->state.max_run_attempts == 1) {
+ self->send(self, finalize_v);
+ } else {
+ self->send(self, restart_failures_v);
+ }
+ }
}
diff --git a/build/source/actors/job_actor/job_actor.f90 b/build/source/actors/job_actor/job_actor.f90
index 18f5fb7c0c3756e31888054ef3ba8566e1fb69af..bee10b60c47b3d8ed26dd5327ed6887802a4f7df 100644
--- a/build/source/actors/job_actor/job_actor.f90
+++ b/build/source/actors/job_actor/job_actor.f90
@@ -1,29 +1,116 @@
module job_actor
- USE, intrinsic :: iso_c_binding
+ USE, intrinsic :: iso_c_binding
+
+ ! global data
+ USE globalData,only:integerMissing ! missing integer value
+ USE globalData,only:realMissing ! missing double precision value
- implicit none
- public::allocateTimeStructure
- public::deallocateJobActor
+ implicit none
+ public::job_init_fortran
+ public::deallocateJobActor
contains
-subroutine allocateTimeStructure(err) bind(C, name="allocateTimeStructure")
- USE globalData,only:startTime,finshTime,refTime,oldTime
- USE allocspace_module,only:allocLocal
- USE globalData,only:time_meta
+subroutine job_init_fortran(file_manager, start_gru, num_gru,&
+ num_hru, err) bind(C, name="job_init_fortran")
+ USE nrtype ! variable types, etc.
+
+ USE summaFileManager,only:summa_SetTimesDirsAndFiles ! sets directories and filenames
+ USE summa_globalData,only:summa_defineGlobalData ! used to define global summa data structures
+
+ USE cppwrap_auxiliary,only:c_f_string ! Convert C String to Fortran String
+
+ ! provide access to file paths
+ USE summaFileManager,only:SETTINGS_PATH ! define path to settings files (e.g., parameters, soil and veg. tables)
+ USE summaFileManager,only:STATE_PATH ! optional path to state/init. condition files (defaults to SETTINGS_PATH)
+ USE summaFileManager,only:MODEL_INITCOND ! name of model initial conditions file
+ USE summaFileManager,only:LOCAL_ATTRIBUTES ! name of model initial attributes file
+
+ ! subroutines and functions: read dimensions (NOTE: NetCDF)
+ USE read_attrb_module,only:read_dimension ! module to read dimensions of GRU and HRU
+ USE read_icond_module,only:read_icond_nlayers ! module to read initial condition dimensions
+
+ USE globalData,only:indx_meta ! metadata structures
+ USE globalData,only:startTime,finshTime,refTime,oldTime
+ USE allocspace_module,only:allocLocal
+ USE globalData,only:time_meta
+
+ ! Variables that were set by getCommandArguments()
+ USE globalData,only: startGRU ! index of the starting GRU for parallelization run
+ USE globalData,only: checkHRU ! index of the HRU for a single HRU run
+ USE globalData,only: iRunMode ! define the current running mode
+ USE globalData,only:iRunModeFull, iRunModeGRU, iRunModeHRU ! define the running modes
+
+ implicit none
+
+ ! dummy variables
+ character(kind=c_char,len=1),intent(in) :: file_manager
+ integer(c_int),intent(inout) :: start_gru
+ integer(c_int),intent(inout) :: num_gru
+ integer(c_int),intent(inout) :: num_hru
+ integer(c_int),intent(out) :: err
+
+ ! local variables
+ character(len=256) :: summaFileManagerIn
+ character(len=256) :: restartFile ! restart file name
+ character(len=256) :: attrFile ! attributes file name
+ integer(i4b) :: fileGRU ! [used for filenames] number of GRUs in the input file
+ integer(i4b) :: fileHRU ! [used for filenames] number of HRUs in the input file
+
+
+ character(len=256) :: message
+
+ ! Convert C Variables to Fortran Variables
+ call c_f_string(file_manager, summaFileManagerIn, 256)
+ summaFileManagerIn = trim(summaFileManagerIn)
+
+
+ ! Set variables that were previosuly set by getCommandArguments()
+ startGRU=start_gru
+ iRunMode=iRunModeGRU
+ checkHRU=integerMissing
+
+ call summa_SetTimesDirsAndFiles(summaFileManagerIn,err,message)
+ if(err/=0)then; print*, trim(message); return; endif
+
+ call summa_defineGlobalData(err, message)
+ if(err/=0)then; print*, trim(message); return; endif
+
+ ! *****************************************************************************
+ ! *** read the number of GRUs and HRUs
+ ! *****************************************************************************
+ ! obtain the HRU and GRU dimensions in the LocalAttribute file
+ attrFile = trim(SETTINGS_PATH)//trim(LOCAL_ATTRIBUTES)
+ select case (iRunMode)
+ case(iRunModeFull); err=20; message='iRunModeFull not implemented for Actors Code'
+ case(iRunModeGRU ); call read_dimension(trim(attrFile),fileGRU,fileHRU,num_gru,num_hru,err,message,startGRU=start_gru)
+ case(iRunModeHRU ); err=20; message='iRunModeHRU not implemented for Actors Code'
+ end select
+ if(err/=0)then; print*, trim(message); return; endif
+
+ ! *****************************************************************************
+ ! *** read the number of snow and soil layers
+ ! *****************************************************************************
+ ! set restart filename and read the number of snow and soil layers from the initial conditions (restart) file
+ if(STATE_PATH == '') then
+ restartFile = trim(SETTINGS_PATH)//trim(MODEL_INITCOND)
+ else
+ restartFile = trim(STATE_PATH)//trim(MODEL_INITCOND)
+ endif
+ call read_icond_nlayers(trim(restartFile),num_gru,indx_meta,err,message)
+ if(err/=0)then; print*, trim(message); return; endif
+
+
+ ! Allocate the time structures
+ call allocLocal(time_meta, startTime, err=err, message=message)
+ call allocLocal(time_meta, finshTime, err=err, message=message)
+ call allocLocal(time_meta, refTime, err=err, message=message)
+ call allocLocal(time_meta, oldTime, err=err, message=message)
+ if(err/=0)then; print*, trim(message); return; endif
+
+end subroutine job_init_fortran
- implicit none
- ! dummy variables
- integer(c_int),intent(inout) :: err
- ! local variables
- character(len=256) :: cmessage
-
- call allocLocal(time_meta, startTime, err=err, message=cmessage)
- call allocLocal(time_meta, finshTime, err=err, message=cmessage)
- call allocLocal(time_meta, refTime, err=err, message=cmessage)
- call allocLocal(time_meta, oldTime, err=err, message=cmessage)
-end subroutine
subroutine deallocateJobActor(err) bind(C, name="deallocateJobActor")
USE globalData,only:structInfo ! information on the data structures
diff --git a/build/source/actors/main.cpp b/build/source/actors/main.cpp
index ca5b8eea2d3ef962c2f380d95c349d46f6a599bd..058c18f8c357a17cd0abf7369f3820335e3ef60a 100644
--- a/build/source/actors/main.cpp
+++ b/build/source/actors/main.cpp
@@ -72,8 +72,8 @@ void run_client(actor_system& system, const config& cfg, Distributed_Settings di
}
void run_server(actor_system& system, const config& cfg, Distributed_Settings distributed_settings,
- Summa_Actor_Settings summa_actor_settings, File_Access_Actor_Settings file_access_actor_settings,
- Job_Actor_Settings job_actor_settings, HRU_Actor_Settings hru_actor_settings) {
+ Summa_Actor_Settings summa_actor_settings, File_Access_Actor_Settings file_access_actor_settings,
+ Job_Actor_Settings job_actor_settings, HRU_Actor_Settings hru_actor_settings) {
scoped_actor self{system};
int err;
@@ -85,18 +85,23 @@ void run_server(actor_system& system, const config& cfg, Distributed_Settings di
// Check if we have are the backup server
if (cfg.backup_server) {
auto server = system.spawn(summa_backup_server_init,
- distributed_settings,summa_actor_settings,file_access_actor_settings,
- job_actor_settings,hru_actor_settings);
+ distributed_settings,
+ summa_actor_settings,
+ file_access_actor_settings,
+ job_actor_settings,
+ hru_actor_settings);
+
publish_server(server, distributed_settings.port);
connect_client(server, distributed_settings.servers_list[0], distributed_settings.port);
- // self->send(server, connect_as_backup_v);
} else {
- auto server = system.spawn(summa_server_init, distributed_settings,
- summa_actor_settings,
- file_access_actor_settings,
- job_actor_settings,
- hru_actor_settings);
+ auto server = system.spawn(summa_server_init,
+ distributed_settings,
+ summa_actor_settings,
+ file_access_actor_settings,
+ job_actor_settings,
+ hru_actor_settings);
+
publish_server(server, distributed_settings.port);
}
@@ -109,8 +114,8 @@ void caf_main(actor_system& sys, const config& cfg) {
struct stat file_to_check;
// Check if config file exists
if (stat(cfg.config_file.c_str(), &file_to_check) != 0) {
- aout(self) << "Config File Path Does Not Exist\n";
- aout(self) << "EXAMPLE: ./summa_actors -g 1 -n 10 -c location/of/config \n";
+ aout(self) << "Config File Path Does Not Exist\n"
+ << "EXAMPLE: ./summa_actors -g 1 -n 10 -c location/of/config \n";
return;
}
@@ -122,43 +127,56 @@ void caf_main(actor_system& sys, const config& cfg) {
aout(self) << "Printing Settings For SUMMA Simulation\n";
check_settings_from_json(distributed_settings,
- summa_actor_settings,
- file_access_actor_settings,
- job_actor_settings,
- hru_actor_settings);
+ summa_actor_settings,
+ file_access_actor_settings,
+ job_actor_settings,
+ hru_actor_settings);
if (distributed_settings.distributed_mode) {
// only command line arguments needed are config_file and server-mode
if (cfg.server_mode) {
- run_server(sys, cfg, distributed_settings, summa_actor_settings,
- file_access_actor_settings, job_actor_settings, hru_actor_settings);
+ run_server(sys,
+ cfg,
+ distributed_settings,
+ summa_actor_settings,
+ file_access_actor_settings,
+ job_actor_settings,
+ hru_actor_settings);
} else {
- run_client(sys, cfg, distributed_settings);
+ run_client(sys,
+ cfg,
+ distributed_settings);
}
} else {
// Configure command line arguments
if (cfg.startGRU == -1) {
- aout(self) << "Starting GRU was not defined!! " <<
- "startGRU is set with the \"-g\" option\n";
- aout(self) << "EXAMPLE: ./summaMain -g 1 -n 10 -c location/of/config \n";
+ aout(self) << "Starting GRU was not defined!! "
+ << "startGRU is set with the \"-g\" option\n"
+ << "EXAMPLE: ./summaMain -g 1 -n 10 -c location/of/config \n";
return;
}
if (cfg.countGRU == -1) {
- aout(self) << "Number of GRUs was not defined!! " <<
- "countGRU is set with the \"-n\" option\n";
- aout(self) << "EXAMPLE: ./summaMain -g 1 -n 10 -c location/of/config \n";
+ aout(self) << "Number of GRUs was not defined!! "
+ << "countGRU is set with the \"-n\" option\n"
+ << "EXAMPLE: ./summaMain -g 1 -n 10 -c location/of/config \n";
return;
}
if (cfg.config_file == "") {
- aout(self) << "File Manager was not defined!! " <<
- "fileManger is set with the \"-c\" option\n";
- aout(self) << "EXAMPLE: ./summaMain -g 1 -n 10 -c location/of/config \n";
+ aout(self) << "File Manager was not defined!! "
+ << "fileManger is set with the \"-c\" option\n"
+ << "EXAMPLE: ./summaMain -g 1 -n 10 -c location/of/config \n";
return;
}
- auto summa = sys.spawn(summa_actor, cfg.startGRU, cfg.countGRU, summa_actor_settings,
- file_access_actor_settings, job_actor_settings, hru_actor_settings, self);
+ auto summa = sys.spawn(summa_actor,
+ cfg.startGRU,
+ cfg.countGRU,
+ summa_actor_settings,
+ file_access_actor_settings,
+ job_actor_settings,
+ hru_actor_settings,
+ self);
}
}
diff --git a/build/source/actors/summa_actor/summa_actor.cpp b/build/source/actors/summa_actor/summa_actor.cpp
index e69812ab8512766458546c8348f85f97e61f16e8..3af72090a65a2df4455c5f1f7d75cb2cd0c0cf3f 100644
--- a/build/source/actors/summa_actor/summa_actor.cpp
+++ b/build/source/actors/summa_actor/summa_actor.cpp
@@ -37,45 +37,55 @@ behavior summa_actor(stateful_actor<summa_actor_state>* self, int startGRU, int
return {
[=](done_job, int numFailed, double job_duration, double read_duration, double write_duration) {
+ auto& timing_info = self->state.timing_info_for_jobs;
+
+
self->state.numFailed += numFailed;
- self->state.timing_info_for_jobs.job_duration.push_back(job_duration);
- self->state.timing_info_for_jobs.job_read_duration.push_back(read_duration);
- self->state.timing_info_for_jobs.job_write_duration.push_back(write_duration);
+ timing_info.job_duration.push_back(job_duration);
+ timing_info.job_read_duration.push_back(read_duration);
+ timing_info.job_write_duration.push_back(write_duration);
if (self->state.numGRU <= 0) {
self->state.summa_actor_timing.updateEndPoint("total_duration");
- for (std::vector<int>::size_type i = 0; i < self->state.timing_info_for_jobs.job_duration.size(); i++) {
- aout(self) << "\n________________Job " << i + 1 << " Info_______________\n";
- aout(self) << "Job Duration = " << self->state.timing_info_for_jobs.job_duration[i] << "\n";
- aout(self) << "Job Read Duration = " << self->state.timing_info_for_jobs.job_read_duration[i] << "\n";
- aout(self) << "Job Write Duration = " << self->state.timing_info_for_jobs.job_write_duration[i] << "\n";
+
+
+ for (size_t i = 0; i < timing_info.job_duration.size(); ++i) {
+
+
+ aout(self) << "\n________________Job " << i + 1 << " Info_____________\n"
+ << "Job Duration = " << timing_info.job_duration[i] << "\n"
+ << "Job Read Duration = " << timing_info.job_read_duration[i] << "\n"
+ << "Job Write Duration = " << timing_info.job_write_duration[i] << "\n"
+ << "_____________________________________________________\n\n";
}
+ double total_read_duration = std::accumulate(timing_info.job_read_duration.begin(),
+ timing_info.job_read_duration.end(),
+ 0.0);
+ double total_write_duration = std::accumulate(timing_info.job_write_duration.begin(),
+ timing_info.job_write_duration.end(),
+ 0.0);
- aout(self) << "\n________________SUMMA_ACTOR TIMING INFO________________\n";
- aout(self) << "Total Duration = " << self->state.summa_actor_timing.getDuration("total_duration").value_or(-1.0) << " Seconds\n";
- aout(self) << "Total Duration = " << self->state.summa_actor_timing.getDuration("total_duration").value_or(-1.0) / 60 << " Minutes\n";
- aout(self) << "Total Duration = " << (self->state.summa_actor_timing.getDuration("total_duration").value_or(-1.0) / 60) / 60 << " Hours\n\n";
- double total_read_duration = std::accumulate(self->state.timing_info_for_jobs.job_read_duration.begin(),
- self->state.timing_info_for_jobs.job_read_duration.end(),
- 0.0);
- aout(self) << "Total Read Duration = " << total_read_duration << "Seconds \n";
- double total_write_duration = std::accumulate(self->state.timing_info_for_jobs.job_write_duration.begin(),
- self->state.timing_info_for_jobs.job_write_duration.end(),
- 0.0);
- aout(self) << "Total Write Duration = " << total_write_duration << "Seconds \n";
- aout(self) << "Program Finished \n";
+ aout(self) << "\n________________SUMMA INFO________________\n"
+ << "Total Duration = " << self->state.summa_actor_timing.getDuration("total_duration").value_or(-1.0) << " Seconds\n"
+ << "Total Duration = " << self->state.summa_actor_timing.getDuration("total_duration").value_or(-1.0) / 60 << " Minutes\n"
+ << "Total Duration = " << (self->state.summa_actor_timing.getDuration("total_duration").value_or(-1.0) / 60) / 60 << " Hours\n"
+ << "Total Read Duration = " << total_read_duration << "Seconds\n"
+ << "Total Write Duration = " << total_write_duration << "Seconds\n"
+ << "Num Failed = " << self->state.numFailed << "\n"
+ << "___________________Program Finished__________________\n";
+
+
self->send(self->state.parent, done_batch_v,
- self->state.summa_actor_timing.getDuration("total_duration").value_or(-1.0),
- total_read_duration,
- total_write_duration);
+ self->state.summa_actor_timing.getDuration("total_duration").value_or(-1.0),
+ total_read_duration,
+ total_write_duration);
} else {
- // spawn a new job
spawnJob(self);
}
},
@@ -94,8 +104,8 @@ void spawnJob(stateful_actor<summa_actor_state>* self) {
// spawn the job actor
aout(self) << "\n Starting Job with startGRU = " << self->state.startGRU << "\n";
self->state.currentJob = self->spawn(job_actor, self->state.startGRU, self->state.summa_actor_settings.max_gru_per_job,
- self->state.file_access_actor_settings, self->state.job_actor_settings,
- self->state.hru_actor_settings, self);
+ self->state.file_access_actor_settings, self->state.job_actor_settings,
+ self->state.hru_actor_settings, self);
// Update GRU count
self->state.numGRU = self->state.numGRU - self->state.summa_actor_settings.max_gru_per_job;
@@ -104,8 +114,8 @@ void spawnJob(stateful_actor<summa_actor_state>* self) {
} else {
self->state.currentJob = self->spawn(job_actor, self->state.startGRU, self->state.numGRU,
- self->state.file_access_actor_settings, self->state.job_actor_settings,
- self->state.hru_actor_settings, self);
+ self->state.file_access_actor_settings, self->state.job_actor_settings,
+ self->state.hru_actor_settings, self);
self->state.numGRU = 0;
}
}
diff --git a/build/source/driver/summa_globalData.f90 b/build/source/driver/summa_globalData.f90
deleted file mode 100755
index efd6b18169b19d2c698843770dc5074a0bd6e894..0000000000000000000000000000000000000000
--- a/build/source/driver/summa_globalData.f90
+++ /dev/null
@@ -1,190 +0,0 @@
-! SUMMA - Structure for Unifying Multiple Modeling Alternatives
-! Copyright (C) 2014-2020 NCAR/RAL; University of Saskatchewan; University of Washington
-!
-! This file is part of SUMMA
-!
-! For more information see: http://www.ral.ucar.edu/projects/summa
-!
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-module summa_globalData
-! used to declare and allocate global summa data structures
-USE, intrinsic :: iso_c_binding
-
-! access missing values
-USE globalData,only:integerMissing ! missing integer
-USE globalData,only:realMissing ! missing double precision number
-
-! size of data structures
-USE var_lookup,only:maxvarForc ! forcing data: maximum number variables
-USE var_lookup,only:maxvarProg ! prognostic variables: maximum number variables
-USE var_lookup,only:maxvarDiag ! diagnostic variables: maximum number variables
-USE var_lookup,only:maxvarFlux ! model fluxes: maximum number variables
-USE var_lookup,only:maxvarIndx ! model indices: maximum number variables
-USE var_lookup,only:maxvarBvar ! basin-average variables: maximum number variables
-
-! metadata structures
-USE globalData,only:time_meta,forc_meta,attr_meta,type_meta ! metadata structures
-USE globalData,only:prog_meta,diag_meta,flux_meta ! metadata structures
-USE globalData,only:mpar_meta,indx_meta ! metadata structures
-USE globalData,only:bpar_meta,bvar_meta ! metadata structures
-USE globalData,only:averageFlux_meta ! metadata for time-step average fluxes
-
-! statistics metadata structures
-USE globalData,only:statForc_meta ! child metadata for stats
-USE globalData,only:statProg_meta ! child metadata for stats
-USE globalData,only:statDiag_meta ! child metadata for stats
-USE globalData,only:statFlux_meta ! child metadata for stats
-USE globalData,only:statIndx_meta ! child metadata for stats
-USE globalData,only:statBvar_meta ! child metadata for stats
-
-! mapping from original to child structures
-USE globalData,only:forcChild_map ! index of the child data structure: stats forc
-USE globalData,only:progChild_map ! index of the child data structure: stats prog
-USE globalData,only:diagChild_map ! index of the child data structure: stats diag
-USE globalData,only:fluxChild_map ! index of the child data structure: stats flux
-USE globalData,only:indxChild_map ! index of the child data structure: stats indx
-USE globalData,only:bvarChild_map ! index of the child data structure: stats bvar
-
-USE globalData,only:startGRU
-! safety: set private unless specified otherwise
-implicit none
-private
-public::summa_defineGlobalData
-contains
-
-subroutine summa_defineGlobalData(start_gru_index, err) bind(C, name="defineGlobalData")
- ! ---------------------------------------------------------------------------------------
- ! * desired modules
- ! ---------------------------------------------------------------------------------------
- ! data types
- USE nrtype ! variable types, etc.
- ! subroutines and functions: initial priming
- USE,intrinsic :: ieee_arithmetic ! IEEE arithmetic (obviously)
- ! subroutines and functions: define metadata structures
- USE popMetadat_module,only:popMetadat ! module to populate metadata structures
- USE flxMapping_module,only:flxMapping ! module to map fluxes to states
- USE checkStruc_module,only:checkStruc ! module to check metadata structures
- USE childStruc_module,only:childStruc ! module to create a child data structure
- ! miscellaneous global data
- USE globalData,only:dNaN ! double precision NaN
- USE globalData,only:doJacobian ! flag to compute the Jacobian
- USE globalData,only:structInfo ! information on the data structures
- ! named variables that describe elements of child model structures
- USE var_lookup,only:iLookVarType ! look-up values for variable type structure
- USE var_lookup,only:childFLUX_MEAN ! look-up values for timestep-average model fluxes
- ! ---------------------------------------------------------------------------------------
- ! * variables
- ! ---------------------------------------------------------------------------------------
- implicit none
- ! dummy variables
- integer(c_int),intent(in) :: start_gru_index ! Index of the starting GRU (-g option from user)
- integer(c_int),intent(out) :: err ! error code
- ! local variables
- character(len=256) :: message ! error message
- character(LEN=256) :: cmessage ! error message of downwind routine
- logical(lgt), dimension(maxvarFlux) :: flux_mask ! mask defining desired flux variables
- logical(lgt), dimension(maxvarForc) :: statForc_mask ! mask defining forc stats
- logical(lgt), dimension(maxvarProg) :: statProg_mask ! mask defining prog stats
- logical(lgt), dimension(maxvarDiag) :: statDiag_mask ! mask defining diag stats
- logical(lgt), dimension(maxvarFlux) :: statFlux_mask ! mask defining flux stats
- logical(lgt), dimension(maxvarIndx) :: statIndx_mask ! mask defining indx stats
- logical(lgt), dimension(maxvarBvar) :: statBvar_mask ! mask defining bvar stats
- integer(i4b) :: iStruct ! index of data structure
- ! ---------------------------------------------------------------------------------------
- ! initialize error control
- err=0; message='summa_defineGlobalData/'
-
- ! initialize the Jacobian flag
- doJacobian=.false. ! initialize the Jacobian flag
-
- ! define double precision NaNs (shared in globalData)
- dNaN = ieee_value(1._dp, ieee_quiet_nan)
-
- ! populate metadata for all model variables
- call popMetadat(err,cmessage)
- 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)
- print*, message
- return
- endif
-
- ! check data structures
- call checkStruc(err,cmessage)
- 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)
- 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
- statForc_mask = (forc_meta(:)%vartype==iLookVarType%scalarv.and.forc_meta(:)%varDesire)
- statProg_mask = (prog_meta(:)%vartype==iLookVarType%scalarv.and.prog_meta(:)%varDesire)
- statDiag_mask = (diag_meta(:)%vartype==iLookVarType%scalarv.and.diag_meta(:)%varDesire)
- statFlux_mask = (flux_meta(:)%vartype==iLookVarType%scalarv.and.flux_meta(:)%varDesire)
- statIndx_mask = (indx_meta(:)%vartype==iLookVarType%scalarv.and.indx_meta(:)%varDesire)
- statBvar_mask = (bvar_meta(:)%vartype==iLookVarType%scalarv.and.bvar_meta(:)%varDesire)
-
- ! create the stats metadata structures
- do iStruct=1,size(structInfo)
- select case (trim(structInfo(iStruct)%structName))
- case('forc'); call childStruc(forc_meta,statForc_mask,statForc_meta,forcChild_map,err,cmessage)
- case('prog'); call childStruc(prog_meta,statProg_mask,statProg_meta,progChild_map,err,cmessage)
- case('diag'); call childStruc(diag_meta,statDiag_mask,statDiag_meta,diagChild_map,err,cmessage)
- case('flux'); call childStruc(flux_meta,statFlux_mask,statFlux_meta,fluxChild_map,err,cmessage)
- case('indx'); call childStruc(indx_meta,statIndx_mask,statIndx_meta,indxChild_map,err,cmessage)
- 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)//']'
- print*, message
- return
- endif
- end do ! iStruct
-
- ! set all stats metadata to correct var types
- statForc_meta(:)%vartype = iLookVarType%outstat
- statProg_meta(:)%vartype = iLookVarType%outstat
- statDiag_meta(:)%vartype = iLookVarType%outstat
- statFlux_meta(:)%vartype = iLookVarType%outstat
- statIndx_meta(:)%vartype = iLookVarType%outstat
- statBvar_meta(:)%vartype = iLookVarType%outstat
-
- ! Set the startGRU
- startGRU = start_gru_index
-
-end subroutine summa_defineGlobalData
-
-end module summa_globalData
diff --git a/build/source/driver/summa_type.f90 b/build/source/driver/summa_type.f90
deleted file mode 100755
index 960064b727c9a466b04a88cb8fc69c33c4367cd9..0000000000000000000000000000000000000000
--- a/build/source/driver/summa_type.f90
+++ /dev/null
@@ -1,24 +0,0 @@
-
-MODULE summa4chm_type
-! used to define master summa data structure
-! *****************************************************************************
-! * higher-level derived data types
-! *****************************************************************************
-USE nrtype ! variable types, etc.
-USE data_types,only:&
- ! no spatial dimension
- var_i, & ! x%var(:) (i4b)
- var_i8, & ! x%var(:) (i8b)
- var_d, & ! x%var(:) (dp)
- var_ilength, & ! x%var(:)%dat (i4b)
- var_dlength, & ! x%var(:)%dat (dp)
- gru_hru_doubleVec
-implicit none
-private
-
-! ************************************************************************
-! * master summa data type
-! *****************************************************************************
-
-
-END MODULE summa4chm_type
diff --git a/build/source/driver/summa_util.f90 b/build/source/driver/summa_util.f90
deleted file mode 100755
index 0b761071dc6c4ce7ebb79b7a75f61e157d373dd0..0000000000000000000000000000000000000000
--- a/build/source/driver/summa_util.f90
+++ /dev/null
@@ -1,165 +0,0 @@
-! SUMMA - Structure for Unifying Multiple Modeling Alternatives
-! Copyright (C) 2014-2020 NCAR/RAL; University of Saskatchewan; University of Washington
-!
-! This file is part of SUMMA
-!
-! For more information see: http://www.ral.ucar.edu/projects/summa
-!
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-module summa4chm_util
-! utilities to manage summa simulation
-
-! data types
-USE nrtype ! high-level data types
-
-! global data
-USE globalData,only:integerMissing ! missing integer value
-USE globalData,only:realMissing ! missing double precision value
-
-! provide access to file IDs
-USE globalData,only:ncid ! file id of netcdf output file
-
-! privacy
-implicit none
-private
-
-! routines to make public
-public::stop_program
-public::handle_err
-contains
-
- ! **************************************************************************************************
- ! error handler
- ! **************************************************************************************************
- ! TODO: will need to change how output files are closed
- subroutine handle_err(err,message)
- USE netcdf_util_module,only:nc_file_close ! module to handle netcdf stuff for inputs and outputs
- implicit none
- ! dummy variables
- integer(i4b),intent(in) :: err ! error code
- character(*),intent(in) :: message ! error message
- ! local variables
- integer(i4b) :: iFreq ! loop through output frequencies
- integer(i4b) :: nc_err ! error code of nc_close
- character(len=256) :: cmessage ! error message of the downwind routine
- ! ---------------------------------------------------------------------------------------
- ! return if A-OK
- if(err==0) return
-
- ! process error messages
- if (err>0) then
- write(*,'(//a/)') 'FATAL ERROR: '//trim(message)
- else
- write(*,'(//a/)') 'WARNING: '//trim(message); print*,'(can keep going, but stopping anyway)'
- endif
-
- ! close any remaining output files
- do iFreq = 1,size(ncid)
- if (ncid(iFreq)/=integerMissing) then
- call nc_file_close(ncid(iFreq),nc_err,cmessage)
- if(nc_err/=0) print*, trim(cmessage)
- end if
- end do
-
- stop 1
- end subroutine handle_err
-
- ! **************************************************************************************************
- ! stop_program: stop program execution
- ! **************************************************************************************************
- subroutine stop_program(err,message)
- ! used to stop program execution
- ! desired modules
- USE netcdf ! netcdf libraries
- USE time_utils_module,only:elapsedSec ! calculate the elapsed time
- ! global data
- USE globalData,only: nThreads ! number of threads
- USE globalData,only: startInit ! date/time for the start of the initialization
- USE globalData,only: elapsedInit ! elapsed time for the initialization
- USE globalData,only: elapsedSetup ! elapsed time for the parameter setup
- USE globalData,only: elapsedRestart ! elapsed time to read the restart data
- USE globalData,only: elapsedRead ! elapsed time for the data read
- USE globalData,only: elapsedWrite ! elapsed time for the stats/write
- USE globalData,only: elapsedPhysics ! elapsed time for the physics
- implicit none
- ! define dummy variables
- integer(i4b),intent(in) :: err ! error code
- character(*),intent(in) :: message ! error messgage
- ! define the local variables
- integer(i4b),parameter :: outunit=6 ! write to screen
- integer(i4b) :: endModelRun(8) ! final time
- integer(i4b) :: localErr ! local error code
- integer(i4b) :: iFreq ! loop through output frequencies
- real(dp) :: elpSec ! elapsed seconds
-
- ! close any remaining output files
- ! NOTE: use the direct NetCDF call with no error checking since the file may already be closed
- do iFreq = 1,size(ncid)
- if (ncid(iFreq)/=integerMissing) localErr = nf90_close(ncid(iFreq))
- end do
-
- ! get the final date and time
- call date_and_time(values=endModelRun)
- elpSec = elapsedSec(startInit,endModelRun)
-
- ! print initial and final date and time
- write(outunit,"(/,A,I4,'-',I2.2,'-',I2.2,2x,I2,':',I2.2,':',I2.2,'.',I3.3)") 'initial date/time = ',startInit(1:3), startInit(5:8)
- write(outunit,"(A,I4,'-',I2.2,'-',I2.2,2x,I2,':',I2.2,':',I2.2,'.',I3.3)") ' final date/time = ',endModelRun(1:3),endModelRun(5:8)
-
- ! print elapsed time for the initialization
- write(outunit,"(/,A,1PG15.7,A)") ' elapsed init = ', elapsedInit, ' s'
- write(outunit,"(A,1PG15.7)") ' fraction init = ', elapsedInit/elpSec
-
- ! print elapsed time for the parameter setup
- write(outunit,"(/,A,1PG15.7,A)") ' elapsed setup = ', elapsedSetup, ' s'
- write(outunit,"(A,1PG15.7)") ' fraction setup = ', elapsedSetup/elpSec
-
- ! print elapsed time to read the restart data
- write(outunit,"(/,A,1PG15.7,A)") ' elapsed restart = ', elapsedRestart, ' s'
- write(outunit,"(A,1PG15.7)") ' fraction restart = ', elapsedRestart/elpSec
-
- ! print elapsed time for the data read
- write(outunit,"(/,A,1PG15.7,A)") ' elapsed read = ', elapsedRead, ' s'
- write(outunit,"(A,1PG15.7)") ' fraction read = ', elapsedRead/elpSec
-
- ! print elapsed time for the data write
- write(outunit,"(/,A,1PG15.7,A)") ' elapsed write = ', elapsedWrite, ' s'
- write(outunit,"(A,1PG15.7)") ' fraction write = ', elapsedWrite/elpSec
-
- ! print elapsed time for the physics
- write(outunit,"(/,A,1PG15.7,A)") ' elapsed physics = ', elapsedPhysics, ' s'
- write(outunit,"(A,1PG15.7)") ' fraction physics = ', elapsedPhysics/elpSec
-
- ! print total elapsed time
- write(outunit,"(/,A,1PG15.7,A)") ' elapsed time = ', elpSec, ' s'
- write(outunit,"(A,1PG15.7,A)") ' or ', elpSec/60_dp, ' m'
- write(outunit,"(A,1PG15.7,A)") ' or ', elpSec/3600_dp, ' h'
- write(outunit,"(A,1PG15.7,A/)") ' or ', elpSec/86400_dp, ' d'
-
- ! print the number of threads
- write(outunit,"(A,i10,/)") ' number threads = ', nThreads
-
- ! stop with message
- if(err==0)then
- print*,'FORTRAN STOP: '//trim(message)
- stop
- else
- print*,'FATAL ERROR: '//trim(message)
- stop 1
- endif
-
- end subroutine
-
-end module summa4chm_util
diff --git a/build/source/dshare/data_types.f90 b/build/source/dshare/data_types.f90
index bdf57bc5195e31862f8663bc53e8ff6efc8d300e..db1a758418f48a121d463cfe60941b839fc21388 100755
--- a/build/source/dshare/data_types.f90
+++ b/build/source/dshare/data_types.f90
@@ -21,60 +21,60 @@
MODULE data_types
USE, intrinsic :: iso_c_binding
- ! used to define model data structures
- USE nrtype, integerMissing=>nr_integerMissing
- USE var_lookup,only:maxvarFreq
- USE var_lookup,only:maxvarStat
- implicit none
- ! constants necessary for variable defs
- private
-
- ! ***********************************************************************************************************
- ! Define the model decisions
- ! ***********************************************************************************************************
- ! the model decision structure
- type,public :: model_options
- character(len=64) :: cOption = 'notPopulatedYet'
- character(len=64) :: cDecision = 'notPopulatedYet'
- integer(i4b) :: iDecision = integerMissing
- end type model_options
-
- ! ***********************************************************************************************************
- ! Define metadata for model forcing datafile
- ! ***********************************************************************************************************
- ! define a derived type for the data in the file
- type,public :: file_info
- character(len=256) :: filenmData='notPopulatedYet' ! name of data file
- integer(i4b) :: nVars ! number of variables in the file
- integer(i4b) :: nTimeSteps ! number of timesteps in the file
- integer(i4b),allocatable :: var_ix(:) ! index of each forcing data variable in the data structure
- integer(i4b),allocatable :: data_id(:) ! netcdf variable id for each forcing data variable
- character(len=256),allocatable :: varName(:) ! netcdf variable name for each forcing data variable
- real(rkind) :: firstJulDay ! first julian day in forcing file
- real(rkind) :: convTime2Days ! factor to convert time to days
- end type file_info
-
- ! ***********************************************************************************************************
- ! Wrapping of file_info (prevents a segmentation fault)
- ! ***********************************************************************************************************
- type,public :: file_info_array
- type(file_info), allocatable :: ffile_list(:)
- end type file_info_array
-
- type,public :: forcingFileData
- real(rkind), dimension (:,:), allocatable :: dataFromFile
- end type forcingFileData
-
- type,public :: var_forc
- type(forcingFileData), allocatable :: var(:) ! var(:)%dataFromFile(:,:)
- character(len=256) :: refTimeString
- real(rkind) :: convTime2Days
- integer(i4b) :: nVars
- integer(i4b),allocatable :: var_ix(:)
- real(rkind) :: tmZoneOffsetFracDay
- real(rkind) :: refJulDay_data
- integer(i4b) :: nTimeSteps ! Number of Timesteps in the file
- end type var_forc
+ ! used to define model data structures
+ USE nrtype, integerMissing=>nr_integerMissing
+ USE var_lookup,only:maxvarFreq
+ USE var_lookup,only:maxvarStat
+ implicit none
+ ! constants necessary for variable defs
+ private
+
+ ! ***********************************************************************************************************
+ ! Define the model decisions
+ ! ***********************************************************************************************************
+ ! the model decision structure
+ type,public :: model_options
+ character(len=64) :: cOption = 'notPopulatedYet'
+ character(len=64) :: cDecision = 'notPopulatedYet'
+ integer(i4b) :: iDecision = integerMissing
+ end type model_options
+
+ ! ***********************************************************************************************************
+ ! Define metadata for model forcing datafile
+ ! ***********************************************************************************************************
+ ! define a derived type for the data in the file
+ type,public :: file_info
+ character(len=256) :: filenmData='notPopulatedYet' ! name of data file
+ integer(i4b) :: nVars ! number of variables in the file
+ integer(i4b) :: nTimeSteps ! number of timesteps in the file
+ integer(i4b),allocatable :: var_ix(:) ! index of each forcing data variable in the data structure
+ integer(i4b),allocatable :: data_id(:) ! netcdf variable id for each forcing data variable
+ character(len=256),allocatable :: varName(:) ! netcdf variable name for each forcing data variable
+ real(rkind) :: firstJulDay ! first julian day in forcing file
+ real(rkind) :: convTime2Days ! factor to convert time to days
+ end type file_info
+
+ ! ***********************************************************************************************************
+ ! Wrapping of file_info (prevents a segmentation fault)
+ ! ***********************************************************************************************************
+ type,public :: file_info_array
+ type(file_info), allocatable :: ffile_list(:)
+ end type file_info_array
+
+ type,public :: forcingFileData
+ real(rkind), dimension (:,:), allocatable :: dataFromFile
+ end type forcingFileData
+
+ type,public :: var_forc
+ type(forcingFileData), allocatable :: var(:) ! var(:)%dataFromFile(:,:)
+ character(len=256) :: refTimeString
+ real(rkind) :: convTime2Days
+ integer(i4b) :: nVars
+ integer(i4b),allocatable :: var_ix(:)
+ real(rkind) :: tmZoneOffsetFracDay
+ real(rkind) :: refJulDay_data
+ integer(i4b) :: nTimeSteps ! Number of Timesteps in the file
+ end type var_forc
! ***********************************************************************************************************
! Define GRU_Actor var_id structure
@@ -87,6 +87,8 @@ MODULE data_types
integer(C_INT) :: write_output_duration_var_id
integer(C_INT) :: state_var_id
integer(C_INT) :: num_attempts_var_id
+ integer(C_INT) :: rel_tol_var_id
+ integer(C_INT) :: abs_tol_var_id
end type netcdf_gru_actor_info
type,public,bind(C) :: serializable_netcdf_gru_actor_info
@@ -97,397 +99,590 @@ MODULE data_types
real(C_DOUBLE) :: write_output_duration
integer(C_INT) :: successful
integer(C_INT) :: num_attempts
+ real(C_DOUBLE) :: rel_tol
+ real(C_DOUBLE) :: abs_tol
end type serializable_netcdf_gru_actor_info
- ! ***********************************************************************************************************
- ! Define metadata on model parameters
- ! ***********************************************************************************************************
- ! define a data type to store model parameter information
- type,public :: par_info
- real(rkind) :: default_val ! default parameter value
- real(rkind) :: lower_limit ! lower bound
- real(rkind) :: upper_limit ! upper bound
- endtype par_info
-
- ! ***********************************************************************************************************
- ! Define variable metadata
- ! ***********************************************************************************************************
- ! define derived type for model variables, including name, description, and units
- type,public :: var_info
- character(len=64) :: varname = 'empty' ! variable name
- character(len=128) :: vardesc = 'empty' ! variable description
- character(len=64) :: varunit = 'empty' ! variable units
- integer(i4b) :: vartype = integerMissing ! variable type
- integer(i4b),dimension(maxvarFreq) :: ncVarID = integerMissing ! netcdf variable id (missing if frequency is not desired)
- integer(i4b),dimension(maxvarFreq) :: statIndex = integerMissing ! index of desired statistic for temporal aggregation
- logical(lgt) :: varDesire = .false. ! flag to denote if the variable is desired for model output
- endtype var_info
-
- ! define extended data type (include indices to map onto parent data type)
- type,extends(var_info),public :: extended_info
- integer(i4b) :: ixParent ! index in the parent data structure
- endtype extended_info
-
- ! define extended data type (includes named variables for the states affected by each flux)
- type,extends(var_info),public :: flux2state
- integer(i4b) :: state1 ! named variable of the 1st state affected by the flux
- integer(i4b) :: state2 ! named variable of the 2nd state affected by the flux
- endtype flux2state
-
- ! ***********************************************************************************************************
- ! Define summary of data structures
- ! ***********************************************************************************************************
- ! data structure information
- type,public :: struct_info
- character(len=32) :: structName ! name of the data structure
- character(len=32) :: lookName ! name of the look-up variables
- integer(i4b) :: nVar ! number of variables in each data structure
- end type struct_info
-
- ! ***********************************************************************************************************
- ! Define data types to map between GRUs and HRUs
- ! ***********************************************************************************************************
-
- ! hru info data structure
- type, public :: hru_info
- integer(i4b) :: hru_nc ! index of the hru in the netcdf file
- integer(i4b) :: hru_ix ! index of the hru in the run domain
- integer(8) :: hru_id ! id (non-sequential number) of the hru
- integer(i4b) :: nSnow ! number of snow layers
- integer(i4b) :: nSoil ! number of soil layers
- endtype hru_info
-
- ! define mapping from GRUs to the HRUs
- type, public :: gru2hru_map
- integer(8) :: gru_id ! id of the gru
- integer(i4b) :: hruCount ! total number of hrus in the gru
- type(hru_info), allocatable :: hruInfo(:) ! basic information of HRUs within the gru
- integer(i4b) :: gru_nc ! index of gru in the netcdf file
- endtype gru2hru_map
-
- ! define the mapping from the HRUs to the GRUs
- type, public :: hru2gru_map
- integer(i4b) :: gru_ix ! index of gru which the hru belongs to
- integer(i4b) :: localHRU_ix ! index of a hru within a gru (start from 1 per gru)
- endtype hru2gru_map
-
-
- ! define type for init_cond
+ ! ***********************************************************************************************************
+ ! Define metadata on model parameters
+ ! ***********************************************************************************************************
+ ! define a data type to store model parameter information
+ type,public :: par_info
+ real(rkind) :: default_val ! default parameter value
+ real(rkind) :: lower_limit ! lower bound
+ real(rkind) :: upper_limit ! upper bound
+ endtype par_info
+
+ ! ***********************************************************************************************************
+ ! Define variable metadata
+ ! ***********************************************************************************************************
+ ! define derived type for model variables, including name, description, and units
+ type,public :: var_info
+ character(len=64) :: varname = 'empty' ! variable name
+ character(len=128) :: vardesc = 'empty' ! variable description
+ character(len=64) :: varunit = 'empty' ! variable units
+ integer(i4b) :: vartype = integerMissing ! variable type
+ integer(i4b),dimension(maxvarFreq) :: ncVarID = integerMissing ! netcdf variable id (missing if frequency is not desired)
+ integer(i4b),dimension(maxvarFreq) :: statIndex = integerMissing ! index of desired statistic for temporal aggregation
+ logical(lgt) :: varDesire = .false. ! flag to denote if the variable is desired for model output
+ endtype var_info
+
+ ! define extended data type (include indices to map onto parent data type)
+ type,extends(var_info),public :: extended_info
+ integer(i4b) :: ixParent ! index in the parent data structure
+ endtype extended_info
+
+ ! define extended data type (includes named variables for the states affected by each flux)
+ type,extends(var_info),public :: flux2state
+ integer(i4b) :: state1 ! named variable of the 1st state affected by the flux
+ integer(i4b) :: state2 ! named variable of the 2nd state affected by the flux
+ endtype flux2state
+
+ ! ***********************************************************************************************************
+ ! Define summary of data structures
+ ! ***********************************************************************************************************
+ ! data structure information
+ type,public :: struct_info
+ character(len=32) :: structName ! name of the data structure
+ character(len=32) :: lookName ! name of the look-up variables
+ integer(i4b) :: nVar ! number of variables in each data structure
+ end type struct_info
+
+ ! ***********************************************************************************************************
+ ! Define data types to map between GRUs and HRUs
+ ! ***********************************************************************************************************
+
+ ! hru info data structure
+ type, public :: hru_info
+ integer(i4b) :: hru_nc ! index of the hru in the netcdf file
+ integer(i4b) :: hru_ix ! index of the hru in the run domain
+ integer(8) :: hru_id ! id (non-sequential number) of the hru
+ integer(i4b) :: nSnow ! number of snow layers
+ integer(i4b) :: nSoil ! number of soil layers
+ endtype hru_info
+
+ ! define mapping from GRUs to the HRUs
+ type, public :: gru2hru_map
+ integer(8) :: gru_id ! id of the gru
+ integer(i4b) :: hruCount ! total number of hrus in the gru
+ type(hru_info), allocatable :: hruInfo(:) ! basic information of HRUs within the gru
+ integer(i4b) :: gru_nc ! index of gru in the netcdf file
+ endtype gru2hru_map
+
+ ! define the mapping from the HRUs to the GRUs
+ type, public :: hru2gru_map
+ integer(i4b) :: gru_ix ! index of gru which the hru belongs to
+ integer(i4b) :: localHRU_ix ! index of a hru within a gru (start from 1 per gru)
+ endtype hru2gru_map
+
+
+ ! define type for init_cond
type, public :: init_cond
real(rkind), allocatable :: var_data(:,:) ! initial condition data
endtype init_cond
- ! ***********************************************************************************************************
- ! Define hierarchal derived data types
- ! ***********************************************************************************************************
- ! define derived types to hold multivariate data for a single variable (different variables have different length)
- ! NOTE: use derived types here to facilitate adding the "variable" dimension
- ! ** double precision type
- type, public :: dlength
- real(rkind),allocatable :: dat(:) ! dat(:)
- endtype dlength
- ! ** integer type (4 byte)
- type, public :: ilength
- integer(i4b),allocatable :: dat(:) ! dat(:)
- endtype ilength
- ! ** integer type (8 byte)
- type, public :: i8length
- integer(8),allocatable :: dat(:) ! dat(:)
- endtype i8length
- ! ** logical type
- type, public :: flagVec
- logical(lgt),allocatable :: dat(:) ! dat(:)
- endtype flagVec
-
- type, public :: time_dlength
- type(dlength),allocatable :: tim(:) ! tim(:)%dat
- endtype time_dlength
+ ! ***********************************************************************************************************
+ ! Define hierarchal derived data types
+ ! ***********************************************************************************************************
+
+ ! ** double precision type of variable length
+ type, public :: dlength
+ real(rkind),allocatable :: dat(:) ! dat(:)
+ endtype dlength
+ ! ** integer type (4 byte)
+ type, public :: ilength
+ integer(i4b),allocatable :: dat(:) ! dat(:)
+ endtype ilength
+ ! ** integer type (8 byte)
+ type, public :: i8length
+ integer(8),allocatable :: dat(:) ! dat(:)
+ endtype i8length
+ ! ** logical type
+ type, public :: flagVec
+ logical(lgt),allocatable :: dat(:) ! dat(:)
+ endtype flagVec
- type, public :: time_ilength
- type(ilength),allocatable :: tim(:) ! tim(:)%dat
- endtype time_ilength
-
- type, public :: time_d
- real(rkind),allocatable :: tim(:) ! tim(:)
- endtype time_d
-
- type, public :: time_i
- integer(i4b),allocatable :: tim(:) ! tim(:)
- endtype time_i
-
- type, public :: time_flagVec
+ ! ** double precision type of for time series
+ type, public :: time_dlength
+ type(dlength),allocatable :: tim(:) ! tim(:)%dat
+ endtype time_dlength
+ ! ** integer type of for time series
+ type, public :: time_ilength
+ type(ilength),allocatable :: tim(:) ! tim(:)%dat
+ endtype time_ilength
+ ! ** double prcision type for time series of fixed length
+ type, public :: time_d
+ real(rkind),allocatable :: tim(:) ! tim(:)
+ endtype time_d
+ ! ** integer type for time series of fixed length
+ type, public :: time_i
+ integer(i4b),allocatable :: tim(:) ! tim(:)
+ endtype time_i
+ ! ** logical type for time series
+ type, public :: time_flagVec
type(flagVec),allocatable :: tim(:) ! tim(:)%dat
- end type time_flagVec
-
-
+ end type time_flagVec
! define derived types to hold data for multiple variables
! NOTE: use derived types here to facilitate adding extra dimensions (e.g., spatial)
! ** double precision type of variable length
- type, public :: var_dlength
- type(dlength),allocatable :: var(:) ! var(:)%dat
- endtype var_dlength
- ! ** integer type of variable length (4 byte)
- type, public :: var_ilength
- type(ilength),allocatable :: var(:) ! var(:)%dat
- endtype var_ilength
- ! ** integer type of variable length (8 byte)
- type, public :: var_i8length
- type(i8length),allocatable :: var(:) ! var(:)%dat
- endtype var_i8length
- ! ** logical type of variable length
- type, public :: var_flagVec
- type(flagVec),allocatable :: var(:) ! var(:)%dat
- endtype var_flagVec
-
- ! ** double precision type of variable length with storage
- ! for each time_step
- type, public :: var_time_dlength
- type(time_dlength),allocatable :: var(:) ! var(:)%tim(:)%dat
- endtype var_time_dlength
-
-! ** integer type of variable length with storage
-! for each time_step
-type, public :: var_time_ilength
- type(time_ilength),allocatable :: var(:) ! var(:)%tim(:)%dat
-endtype var_time_ilength
-
- ! ** double precision type of fixed length
- type, public :: var_d
- real(rkind),allocatable :: var(:) ! var(:)
- endtype var_d
- ! ** integer type of fixed length (4 byte)
- type, public :: var_i
- integer(i4b),allocatable :: var(:) ! var(:)
- endtype var_i
- ! ** integer type of fixed length (8 byte)
- type, public :: var_i8
- integer(8),allocatable :: var(:) ! var(:)
- endtype var_i8
- ! this needs to be here to compile on Graham
- type, public :: time_i8
- type(var_i8),allocatable :: tim(:) ! tim(:)
- endtype time_i8
-
- type, public :: var_time_d
- type(time_d),allocatable :: var(:) ! var(:)%tim
- endtype var_time_d
-
- type, public :: var_time_i
- type(time_i),allocatable :: var(:) ! var(:)%tim
- endtype var_time_i
-
- type, public :: var_time_i8
- type(time_i8),allocatable :: var(:) ! var(:)%tim
- endtype var_time_i8
-
- ! ** double precision type of fixed length
- type, public :: hru_d
- real(rkind),allocatable :: hru(:) ! hru(:)
- endtype hru_d
- ! ** integer type of fixed length (4 byte)
- type, public :: hru_i
- integer(i4b),allocatable :: hru(:) ! hru(:)
- endtype hru_i
- ! ** integer type of fixed length (8 byte)
- type, public :: hru_i8
- integer(8),allocatable :: hru(:) ! hru(:)
- endtype hru_i8
-
-
- ! ***********************************************************************************************************
- ! Type for handling lateral-flows
- ! ***********************************************************************************************************
- type,public :: var_dlength_array
- type(var_dlength), allocatable :: struc(:) ! struc(:)var(:)%dat
- end type var_dlength_array
-
- ! define derived types to hold JUST the HRU dimension
- ! ** double precision type of variable length
- type, public :: hru_doubleVec
- type(var_dlength),allocatable :: hru(:) ! hru(:)%var(:)%dat
- endtype hru_doubleVec
- ! ** integer type of variable length (4 byte)
- type, public :: hru_intVec
- type(var_ilength),allocatable :: hru(:) ! hru(:)%var(:)%dat
- endtype hru_intVec
- ! ** integer type of variable length (8 byte)
- type, public :: hru_int8Vec
- type(var_i8length),allocatable :: hru(:) ! hru(:)%var(:)%dat
- endtype hru_int8Vec
- ! ** double precision type of fixed length
- type, public :: hru_double
- type(var_d),allocatable :: hru(:) ! hru(:)%var(:)
- endtype hru_double
- ! ** integer type of fixed length (4 byte)
- type, public :: hru_int
- type(var_i),allocatable :: hru(:) ! hru(:)%var(:)
- endtype hru_int
- ! ** integer type of fixed length (8 byte)
- type, public :: hru_int8
- type(var_i8),allocatable :: hru(:) ! hru(:)%var(:)
- endtype hru_int8
-
-
- type, public :: hru_time_double
- type(var_time_d),allocatable :: hru(:) ! hru(:)%tim(:)%var
- endtype hru_time_double
-
- type, public :: hru_time_int
- type(var_time_i),allocatable :: hru(:) ! hru(:)%tim(:)%var
- endtype hru_time_int
-
- type, public :: hru_time_int8
- type(var_time_i8),allocatable :: hru(:) ! hru(:)%tim(:)%var
- endtype hru_time_int8
-
- ! ** double precission type of timestep variable length
- type, public :: hru_time_doubleVec
- type(var_time_dlength), allocatable :: hru(:)
- endtype hru_time_doubleVec
-
- type, public :: hru_time_intVec
- type(var_time_ilength), allocatable :: hru(:)
- endtype hru_time_intVec
-
- type, public :: hru_time_flagVec
- type(time_flagVec),allocatable :: hru(:) ! hru(:)%tim(:)%dat
- endtype hru_time_flagVec
-
- ! define derived types to hold JUST the HRU dimension
- ! ** double precision type of variable length
- type, public :: gru_doubleVec
- type(var_dlength),allocatable :: gru(:) ! gru(:)%var(:)%dat
- endtype gru_doubleVec
- ! ** integer type of variable length (4 byte)
- type, public :: gru_intVec
- type(var_ilength),allocatable :: gru(:) ! gru(:)%var(:)%dat
- endtype gru_intVec
- ! ** integer type of variable length (8 byte)
- type, public :: gru_int8Vec
- type(var_i8length),allocatable :: gru(:) ! gru(:)%var(:)%dat
- endtype gru_int8Vec
- ! ** double precision type of fixed length
- type, public :: gru_double
- type(var_d),allocatable :: gru(:) ! gru(:)%var(:)
- endtype gru_double
- ! ** integer type of variable length (4 byte)
- type, public :: gru_int
- type(var_i),allocatable :: gru(:) ! gru(:)%var(:)
- endtype gru_int
- ! ** integer type of variable length (8 byte)
- type, public :: gru_int8
- type(var_i8),allocatable :: gru(:) ! gru(:)%var(:)
- endtype gru_int8
-
- type,public :: gru_hru_time_flagVec
- type(hru_time_flagVec),allocatable :: gru(:) ! gru(:)%hru(:)%tim(:)%dat(:)
- endtype gru_hru_time_flagVec
-
- type, public :: gru_hru_time_double
- type(hru_time_double),allocatable :: gru(:)
- endtype gru_hru_time_double
-
- type, public :: gru_hru_time_int
- type(hru_time_int), allocatable :: gru(:)
- endtype gru_hru_time_int
-
- type, public :: gru_hru_time_int8
- type(hru_time_int8), allocatable :: gru(:)
- endtype gru_hru_time_int8
-
- ! define derived types to hold BOTH the GRU and HRU dimension
- ! ** double precision type of variable length
- type, public :: gru_hru_doubleVec
- type(hru_doubleVec),allocatable :: gru(:) ! gru(:)%hru(:)%var(:)%dat
- endtype gru_hru_doubleVec
- ! ** integer type of variable length (4 byte)
- type, public :: gru_hru_intVec
- type(hru_intVec),allocatable :: gru(:) ! gru(:)%hru(:)%var(:)%dat
- endtype gru_hru_intVec
- ! ** integer type of variable length (8 byte)
- type, public :: gru_hru_int8Vec
- type(hru_int8Vec),allocatable :: gru(:) ! gru(:)%hru(:)%var(:)%dat
- endtype gru_hru_int8Vec
- ! ** double precision type of fixed length
- type, public :: gru_hru_double
- type(hru_double),allocatable :: gru(:) ! gru(:)%hru(:)%var(:)
- endtype gru_hru_double
- ! ** integer type of variable length (4 byte)
- type, public :: gru_hru_int
- type(hru_int),allocatable :: gru(:) ! gru(:)%hru(:)%var(:)
- endtype gru_hru_int
- ! ** integer type of variable length (8 byte)
- type, public :: gru_hru_int8
- type(hru_int8),allocatable :: gru(:) ! gru(:)%hru(:)%var(:)
- endtype gru_hru_int8
- ! ** double precision type of fixed length
- type, public :: gru_d
- type(hru_d),allocatable :: gru(:) ! gru(:)%hru(:)
- endtype gru_d
- ! ** integer type of fixed length
- type, public :: gru_i
- type(hru_i),allocatable :: gru(:) ! gru(:)%hru(:)
- endtype gru_i
-
- type, public :: gru_hru_time_doubleVec
- type(hru_time_doubleVec),allocatable :: gru(:)
- endtype gru_hru_time_doubleVec
-
- type, public :: gru_hru_time_intVec
- type(hru_time_intVec),allocatable :: gru(:)
- endtype gru_hru_time_intVec
-
- ! Sundials lookup table type
- type, public :: dLookup
- real(rkind),allocatable :: lookup(:) ! lookup(:)
- endtype dLookup
- ! ** double precision type for a variable number of soil layers; variable length
- type, public :: vLookup
- type(dLookup),allocatable :: var(:) ! var(:)%lookup(:)
- endtype vLookup
- type, public :: zLookup
- type(vLookup),allocatable :: z(:) ! z(:)%var(:)%lookup(:)
- endtype zLookup
-
- 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_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
+ type, public :: var_dlength
+ type(dlength),allocatable :: var(:) ! var(:)%dat
+ endtype var_dlength
+ ! ** integer type of variable length (4 byte)
+ type, public :: var_ilength
+ type(ilength),allocatable :: var(:) ! var(:)%dat
+ endtype var_ilength
+ ! ** integer type of variable length (8 byte)
+ type, public :: var_i8length
+ type(i8length),allocatable :: var(:) ! var(:)%dat
+ endtype var_i8length
+ ! ** logical type of variable length
+ type, public :: var_flagVec
+ type(flagVec),allocatable :: var(:) ! var(:)%dat
+ endtype var_flagVec
+
+ ! ** double precision type of variable length with storage
+ ! for each time_step
+ type, public :: var_time_dlength
+ type(time_dlength),allocatable :: var(:) ! var(:)%tim(:)%dat
+ endtype var_time_dlength
+
+ ! ** integer type of variable length with storage
+ ! for each time_step
+ type, public :: var_time_ilength
+ type(time_ilength),allocatable :: var(:) ! var(:)%tim(:)%dat
+ endtype var_time_ilength
+
+ ! ** double precision type of fixed length
+ type, public :: var_d
+ real(rkind),allocatable :: var(:) ! var(:)
+ endtype var_d
+ ! ** integer type of fixed length (4 byte)
+ type, public :: var_i
+ integer(i4b),allocatable :: var(:) ! var(:)
+ endtype var_i
+ ! ** integer type of fixed length (8 byte)
+ type, public :: var_i8
+ integer(8),allocatable :: var(:) ! var(:)
+ endtype var_i8
+ ! this needs to be here to compile on Graham
+ type, public :: time_i8
+ type(var_i8),allocatable :: tim(:) ! tim(:)
+ endtype time_i8
+
+ type, public :: var_time_d
+ type(time_d),allocatable :: var(:) ! var(:)%tim
+ endtype var_time_d
+
+ type, public :: var_time_i
+ type(time_i),allocatable :: var(:) ! var(:)%tim
+ endtype var_time_i
+
+ type, public :: var_time_i8
+ type(time_i8),allocatable :: var(:) ! var(:)%tim
+ endtype var_time_i8
+
+ ! ** double precision type of fixed length
+ type, public :: hru_d
+ real(rkind),allocatable :: hru(:) ! hru(:)
+ endtype hru_d
+ ! ** integer type of fixed length (4 byte)
+ type, public :: hru_i
+ integer(i4b),allocatable :: hru(:) ! hru(:)
+ endtype hru_i
+ ! ** integer type of fixed length (8 byte)
+ type, public :: hru_i8
+ integer(8),allocatable :: hru(:) ! hru(:)
+ endtype hru_i8
+ ! ***********************************************************************************************************
+ ! Type for handling lateral-flows
+ ! ***********************************************************************************************************
+ type,public :: var_dlength_array
+ type(var_dlength), allocatable :: struc(:) ! struc(:)var(:)%dat
+ end type var_dlength_array
+
+ ! define derived types to hold JUST the HRU dimension
+ ! ** double precision type of variable length
+ type, public :: hru_doubleVec
+ type(var_dlength),allocatable :: hru(:) ! hru(:)%var(:)%dat
+ endtype hru_doubleVec
+ ! ** integer type of variable length (4 byte)
+ type, public :: hru_intVec
+ type(var_ilength),allocatable :: hru(:) ! hru(:)%var(:)%dat
+ endtype hru_intVec
+ ! ** integer type of variable length (8 byte)
+ type, public :: hru_int8Vec
+ type(var_i8length),allocatable :: hru(:) ! hru(:)%var(:)%dat
+ endtype hru_int8Vec
+ ! ** double precision type of fixed length
+ type, public :: hru_double
+ type(var_d),allocatable :: hru(:) ! hru(:)%var(:)
+ endtype hru_double
+ ! ** integer type of fixed length (4 byte)
+ type, public :: hru_int
+ type(var_i),allocatable :: hru(:) ! hru(:)%var(:)
+ endtype hru_int
+ ! ** integer type of fixed length (8 byte)
+ type, public :: hru_int8
+ type(var_i8),allocatable :: hru(:) ! hru(:)%var(:)
+ endtype hru_int8
+
+ ! ** double precision type of variable length with timestep storage
+ type, public :: hru_time_double
+ type(var_time_d),allocatable :: hru(:) ! hru(:)%tim(:)%var
+ endtype hru_time_double
+ ! ** integer type of variable length with timestep storage
+ type, public :: hru_time_int
+ type(var_time_i),allocatable :: hru(:) ! hru(:)%tim(:)%var
+ endtype hru_time_int
+ ! ** integer type of variable length with timestep storage
+ type, public :: hru_time_int8
+ type(var_time_i8),allocatable :: hru(:) ! hru(:)%tim(:)%var
+ endtype hru_time_int8
+
+ ! ** double precission type of timestep variable length
+ type, public :: hru_time_doubleVec
+ type(var_time_dlength), allocatable :: hru(:)
+ endtype hru_time_doubleVec
+
+ type, public :: hru_time_intVec
+ type(var_time_ilength), allocatable :: hru(:)
+ endtype hru_time_intVec
+
+ type, public :: hru_time_flagVec
+ type(time_flagVec),allocatable :: hru(:) ! hru(:)%tim(:)%dat
+ endtype hru_time_flagVec
+
+ ! define derived types to hold JUST the HRU dimension
+ ! ** double precision type of variable length
+ type, public :: gru_doubleVec
+ type(var_dlength),allocatable :: gru(:) ! gru(:)%var(:)%dat
+ endtype gru_doubleVec
+ ! ** integer type of variable length (4 byte)
+ type, public :: gru_intVec
+ type(var_ilength),allocatable :: gru(:) ! gru(:)%var(:)%dat
+ endtype gru_intVec
+ ! ** integer type of variable length (8 byte)
+ type, public :: gru_int8Vec
+ type(var_i8length),allocatable :: gru(:) ! gru(:)%var(:)%dat
+ endtype gru_int8Vec
+ ! ** double precision type of fixed length
+ type, public :: gru_double
+ type(var_d),allocatable :: gru(:) ! gru(:)%var(:)
+ endtype gru_double
+ ! ** integer type of variable length (4 byte)
+ type, public :: gru_int
+ type(var_i),allocatable :: gru(:) ! gru(:)%var(:)
+ endtype gru_int
+ ! ** integer type of variable length (8 byte)
+ type, public :: gru_int8
+ type(var_i8),allocatable :: gru(:) ! gru(:)%var(:)
+ endtype gru_int8
+
+ type,public :: gru_hru_time_flagVec
+ type(hru_time_flagVec),allocatable :: gru(:) ! gru(:)%hru(:)%tim(:)%dat(:)
+ endtype gru_hru_time_flagVec
+
+ type, public :: gru_hru_time_double
+ type(hru_time_double),allocatable :: gru(:)
+ endtype gru_hru_time_double
+
+ type, public :: gru_hru_time_int
+ type(hru_time_int), allocatable :: gru(:)
+ endtype gru_hru_time_int
+
+ type, public :: gru_hru_time_int8
+ type(hru_time_int8), allocatable :: gru(:)
+ endtype gru_hru_time_int8
+
+ ! define derived types to hold BOTH the GRU and HRU dimension
+ ! ** double precision type of variable length
+ type, public :: gru_hru_doubleVec
+ type(hru_doubleVec),allocatable :: gru(:) ! gru(:)%hru(:)%var(:)%dat
+ endtype gru_hru_doubleVec
+ ! ** integer type of variable length (4 byte)
+ type, public :: gru_hru_intVec
+ type(hru_intVec),allocatable :: gru(:) ! gru(:)%hru(:)%var(:)%dat
+ endtype gru_hru_intVec
+ ! ** integer type of variable length (8 byte)
+ type, public :: gru_hru_int8Vec
+ type(hru_int8Vec),allocatable :: gru(:) ! gru(:)%hru(:)%var(:)%dat
+ endtype gru_hru_int8Vec
+ ! ** double precision type of fixed length
+ type, public :: gru_hru_double
+ type(hru_double),allocatable :: gru(:) ! gru(:)%hru(:)%var(:)
+ endtype gru_hru_double
+ ! ** integer type of variable length (4 byte)
+ type, public :: gru_hru_int
+ type(hru_int),allocatable :: gru(:) ! gru(:)%hru(:)%var(:)
+ endtype gru_hru_int
+ ! ** integer type of variable length (8 byte)
+ type, public :: gru_hru_int8
+ type(hru_int8),allocatable :: gru(:) ! gru(:)%hru(:)%var(:)
+ endtype gru_hru_int8
+ ! ** double precision type of fixed length
+ type, public :: gru_d
+ type(hru_d),allocatable :: gru(:) ! gru(:)%hru(:)
+ endtype gru_d
+ ! ** integer type of fixed length
+ type, public :: gru_i
+ type(hru_i),allocatable :: gru(:) ! gru(:)%hru(:)
+ endtype gru_i
+
+ type, public :: gru_hru_time_doubleVec
+ type(hru_time_doubleVec),allocatable :: gru(:)
+ endtype gru_hru_time_doubleVec
+
+ type, public :: gru_hru_time_intVec
+ type(hru_time_intVec),allocatable :: gru(:)
+ endtype gru_hru_time_intVec
+
+ ! Sundials lookup table type
+ type, public :: dLookup
+ real(rkind),allocatable :: lookup(:) ! lookup(:)
+ endtype dLookup
+ ! ** double precision type for a variable number of soil layers; variable length
+ type, public :: vLookup
+ type(dLookup),allocatable :: var(:) ! var(:)%lookup(:)
+ endtype vLookup
+ type, public :: zLookup
+ type(vLookup),allocatable :: z(:) ! z(:)%var(:)%lookup(:)
+ endtype zLookup
+ type, public :: hru_z_vLookup
+ type(zLookup),allocatable :: hru(:) ! hru(:)%z(:)%var(:)%lookup(:)
+ endtype hru_z_vLookup
+ ! ** double precision type for a variable number of soil layers
+ type, public :: gru_hru_z_vLookup
+ type(hru_z_vLookup),allocatable :: gru(:) ! gru(:)%hru(:)%z(:)%var(:)%lookup(:)
+ endtype gru_hru_z_vLookup
+
+
+ ! define derived types used to simplify passing subroutine arguments
+ ! ** vegNrgFlux
+ type, public :: in_type_vegNrgFlux ! derived type for intent(in) arguments in vegNrgFlux call
+ logical(lgt) :: firstSubStep ! intent(in): flag to indicate if we are processing the first sub-step
+ logical(lgt) :: firstFluxCall ! intent(in): flag to indicate if we are processing the first flux call
+ logical(lgt) :: computeVegFlux ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ logical(lgt) :: checkLWBalance ! intent(in): flag to check longwave balance
+ real(rkind) :: upperBoundTemp ! intent(in): temperature of the upper boundary (K) --> NOTE: use air temperature
+ real(rkind) :: scalarCanairTempTrial ! intent(in): trial value of the canopy air space temperature (K)
+ real(rkind) :: scalarCanopyTempTrial ! intent(in): trial value of canopy temperature (K)
+ real(rkind) :: mLayerTempTrial_1 ! intent(in): trial value of ground temperature (K)
+ real(rkind) :: scalarCanopyIceTrial ! intent(in): trial value of mass of ice on the vegetation canopy (kg m-2)
+ real(rkind) :: scalarCanopyLiqTrial ! intent(in): trial value of mass of liquid water on the vegetation canopy (kg m-2)
+ real(rkind) :: dCanLiq_dTcanopy ! intent(in): derivative in canopy liquid storage w.r.t. canopy temperature (kg m-2 K-1)
+ end type in_type_vegNrgFlux
+
+ type, public :: out_type_vegNrgFlux ! derived type for intent(out) arguments in vegNrgFlux call
+ real(rkind) :: scalarCanopyTranspiration ! intent(out): canopy transpiration (kg m-2 s-1)
+ real(rkind) :: scalarCanopyEvaporation ! intent(out): canopy evaporation/condensation (kg m-2 s-1)
+ real(rkind) :: scalarGroundEvaporation ! intent(out): ground evaporation/condensation -- below canopy or non-vegetated (kg m-2 s-1)
+ real(rkind) :: scalarCanairNetNrgFlux ! intent(out): net energy flux for the canopy air space (W m-2)
+ real(rkind) :: scalarCanopyNetNrgFlux ! intent(out): net energy flux for the vegetation canopy (W m-2)
+ real(rkind) :: scalarGroundNetNrgFlux ! intent(out): net energy flux for the ground surface (W m-2)
+ real(rkind) :: dCanairNetFlux_dCanairTemp ! intent(out): derivative in net canopy air space flux w.r.t. canopy air temperature (W m-2 K-1)
+ real(rkind) :: dCanairNetFlux_dCanopyTemp ! intent(out): derivative in net canopy air space flux w.r.t. canopy temperature (W m-2 K-1)
+ real(rkind) :: dCanairNetFlux_dGroundTemp ! intent(out): derivative in net canopy air space flux w.r.t. ground temperature (W m-2 K-1)
+ real(rkind) :: dCanopyNetFlux_dCanairTemp ! intent(out): derivative in net canopy flux w.r.t. canopy air temperature (W m-2 K-1)
+ real(rkind) :: dCanopyNetFlux_dCanopyTemp ! intent(out): derivative in net canopy flux w.r.t. canopy temperature (W m-2 K-1)
+ real(rkind) :: dCanopyNetFlux_dGroundTemp ! intent(out): derivative in net canopy flux w.r.t. ground temperature (W m-2 K-1)
+ real(rkind) :: dGroundNetFlux_dCanairTemp ! intent(out): derivative in net ground flux w.r.t. canopy air temperature (W m-2 K-1)
+ real(rkind) :: dGroundNetFlux_dCanopyTemp ! intent(out): derivative in net ground flux w.r.t. canopy temperature (W m-2 K-1)
+ real(rkind) :: dGroundNetFlux_dGroundTemp ! intent(out): derivative in net ground flux w.r.t. ground temperature (W m-2 K-1)
+ real(rkind) :: dCanopyEvaporation_dCanWat ! intent(out): derivative in canopy evaporation w.r.t. canopy total water content (s-1)
+ real(rkind) :: dCanopyEvaporation_dTCanair ! intent(out): derivative in canopy evaporation w.r.t. canopy air temperature (kg m-2 s-1 K-1)
+ real(rkind) :: dCanopyEvaporation_dTCanopy ! intent(out): derivative in canopy evaporation w.r.t. canopy temperature (kg m-2 s-1 K-1)
+ real(rkind) :: dCanopyEvaporation_dTGround ! intent(out): derivative in canopy evaporation w.r.t. ground temperature (kg m-2 s-1 K-1)
+ real(rkind) :: dGroundEvaporation_dCanWat ! intent(out): derivative in ground evaporation w.r.t. canopy total water content (s-1)
+ real(rkind) :: dGroundEvaporation_dTCanair ! intent(out): derivative in ground evaporation w.r.t. canopy air temperature (kg m-2 s-1 K-1)
+ real(rkind) :: dGroundEvaporation_dTCanopy ! intent(out): derivative in ground evaporation w.r.t. canopy temperature (kg m-2 s-1 K-1)
+ real(rkind) :: dGroundEvaporation_dTGround ! intent(out): derivative in ground evaporation w.r.t. ground temperature (kg m-2 s-1 K-1)
+ real(rkind) :: dCanopyTrans_dCanWat ! intent(out): derivative in canopy transpiration w.r.t. canopy total water content (s-1)
+ real(rkind) :: dCanopyTrans_dTCanair ! intent(out): derivative in canopy transpiration w.r.t. canopy air temperature (kg m-2 s-1 K-1)
+ real(rkind) :: dCanopyTrans_dTCanopy ! intent(out): derivative in canopy transpiration w.r.t. canopy temperature (kg m-2 s-1 K-1)
+ real(rkind) :: dCanopyTrans_dTGround ! intent(out): derivative in canopy transpiration w.r.t. ground temperature (kg m-2 s-1 K-1)
+ real(rkind) :: dCanopyNetFlux_dCanWat ! intent(out): derivative in net canopy fluxes w.r.t. canopy total water content (J kg-1 s-1)
+ real(rkind) :: dGroundNetFlux_dCanWat ! intent(out): derivative in net ground fluxes w.r.t. canopy total water content (J kg-1 s-1)
+ integer(i4b) :: err ! intent(out): error code
+ character(:),allocatable :: cmessage ! intent(out): error message
+ end type out_type_vegNrgFlux
+ ! ** end vegNrgFlux
+
+ ! ** ssdNrgFlux
+ type, public :: in_type_ssdNrgFlux ! derived type for intent(in) arguments in ssdNrgFlux call
+ logical(lgt) :: scalarSolution ! intent(in): flag to denote if implementing the scalar solution
+ real(rkind) :: scalarGroundNetNrgFlux ! intent(in): net energy flux for the ground surface (W m-2)
+ real(rkind), allocatable :: iLayerLiqFluxSnow(:) ! intent(in): liquid flux at the interface of each snow layer (m s-1)
+ real(rkind), allocatable :: iLayerLiqFluxSoil(:) ! intent(in): liquid flux at the interface of each soil layer (m s-1)
+ real(rkind), allocatable :: mLayerTempTrial(:) ! intent(in): temperature in each layer at the current iteration (m)
+ real(rkind), allocatable :: dThermalC_dWatAbove(:) ! intent(in): derivative in the thermal conductivity w.r.t. water state in the layer above
+ real(rkind), allocatable :: dThermalC_dWatBelow(:) ! intent(in): derivative in the thermal conductivity w.r.t. water state in the layer above
+ real(rkind), allocatable :: dThermalC_dTempAbove(:) ! intent(in): derivative in the thermal conductivity w.r.t. energy state in the layer above
+ real(rkind), allocatable :: dThermalC_dTempBelow(:) ! intent(in): derivative in the thermal conductivity w.r.t. energy state in the layer above
+ end type in_type_ssdNrgFlux
+
+ type, public :: io_type_ssdNrgFlux ! derived type for intent(inout) arguments in ssdNrgFlux call
+ real(rkind) :: dGroundNetFlux_dGroundTemp ! intent(inout): derivative in net ground flux w.r.t. ground temperature (W m-2 K-1)
+ end type io_type_ssdNrgFlux
+
+ type, public :: out_type_ssdNrgFlux ! derived type for intent(inout) arguments in ssdNrgFlux call
+ real(rkind), allocatable :: iLayerNrgFlux(:) ! intent(out): energy flux at the layer interfaces (W m-2)
+ real(rkind), allocatable :: dNrgFlux_dTempAbove(:) ! intent(out): derivatives in the flux w.r.t. temperature in the layer above (J m-2 s-1 K-1)
+ real(rkind), allocatable :: dNrgFlux_dTempBelow(:) ! intent(out): derivatives in the flux w.r.t. temperature in the layer below (J m-2 s-1 K-1)
+ real(rkind), allocatable :: dNrgFlux_dWatAbove(:) ! intent(out): derivatives in the flux w.r.t. water state in the layer above (J m-2 s-1 K-1)
+ real(rkind), allocatable :: dNrgFlux_dWatBelow(:) ! intent(out): derivatives in the flux w.r.t. water state in the layer below (J m-2 s-1 K-1)
+ integer(i4b) :: err ! intent(out): error code
+ character(:),allocatable :: cmessage ! intent(out): error message
+ end type out_type_ssdNrgFlux
+ ! ** end ssdNrgFlux
+
+ ! ** vegLiqFlux
+ type, public :: in_type_vegLiqFlux ! derived type for intent(in) arguments in vegLiqFlux call
+ logical(lgt) :: computeVegFlux ! intent(in): flag to denote if computing energy flux over vegetation
+ real(rkind) :: scalarCanopyLiqTrial ! intent(in): trial mass of liquid water on the vegetation canopy at the current iteration (kg m-2)
+ real(rkind) :: scalarRainfall ! intent(in): rainfall rate (kg m-2 s-1)
+ end type in_type_vegLiqFlux
+
+ type, public :: out_type_vegLiqFlux ! derived type for intent(out) arguments in vegLiqFlux call
+ real(rkind) :: scalarThroughfallRain ! intent(out): rain that reaches the ground without ever touching the canopy (kg m-2 s-1)
+ real(rkind) :: scalarCanopyLiqDrainage ! intent(out): drainage of liquid water from the vegetation canopy (kg m-2 s-1)
+ real(rkind) :: scalarThroughfallRainDeriv ! intent(out): derivative in throughfall w.r.t. canopy liquid water (s-1)
+ real(rkind) :: scalarCanopyLiqDrainageDeriv ! intent(out): derivative in canopy drainage w.r.t. canopy liquid water (s-1)
+ integer(i4b) :: err ! intent(out): error code
+ character(:),allocatable :: cmessage ! intent(out): error message
+ end type out_type_vegLiqFlux
+ ! ** end vegLiqFlux
+
+ ! ** snowLiqFlx
+ type, public :: in_type_snowLiqFlx ! derived type for intent(in) arguments in snowLiqFlx call
+ integer(i4b) :: nSnow ! intent(in): number of snow layers
+ logical(lgt) :: firstFluxCall ! intent(in): the first flux call (compute variables that are constant over the iterations)
+ logical(lgt) :: scalarSolution ! intent(in): flag to indicate the scalar solution
+ real(rkind) :: scalarThroughfallRain ! intent(in): rain that reaches the snow surface without ever touching vegetation (kg m-2 s-1)
+ real(rkind) :: scalarCanopyLiqDrainage ! intent(in): liquid drainage from the vegetation canopy (kg m-2 s-1)
+ real(rkind), allocatable :: mLayerVolFracLiqTrial(:) ! intent(in): trial value of volumetric fraction of liquid water at the current iteration (-)
+ end type in_type_snowLiqFlx
+
+ type, public :: io_type_snowLiqFlx ! derived type for intent(inout) arguments in snowLiqFlx call
+ real(rkind), allocatable :: iLayerLiqFluxSnow(:) ! intent(inout): vertical liquid water flux at layer interfaces (m s-1)
+ real(rkind), allocatable :: iLayerLiqFluxSnowDeriv(:) ! intent(inout): derivative in vertical liquid water flux at layer interfaces (m s-1)
+ end type io_type_snowLiqFlx
+
+ type, public :: out_type_snowLiqFlx ! derived type for intent(out) arguments in snowLiqFlx call
+ integer(i4b) :: err ! intent(out): error code
+ character(:),allocatable :: cmessage ! intent(out): error message
+ end type out_type_snowLiqFlx
+ ! ** end snowLiqFlx
+
+ ! ** soilLiqFlx
+ type, public :: in_type_soilLiqFlx ! derived type for intent(in) arguments in soilLiqFlx call
+ integer(i4b) :: nSoil ! intent(in): number of soil layers
+ logical(lgt) :: firstSplitOper ! intent(in): flag indicating first flux call in a splitting operation
+ logical(lgt) :: scalarSolution ! intent(in): flag to indicate the scalar solution
+ logical(lgt) :: deriv_desired ! intent(in): flag indicating if derivatives are desired
+ real(rkind), allocatable :: mLayerTempTrial(:) ! intent(in): trial temperature at the current iteration (K)
+ real(rkind), allocatable :: mLayerMatricHeadTrial(:) ! intent(in): matric potential (m)
+ real(rkind), allocatable :: mLayerMatricHeadLiqTrial(:) ! intent(in): liquid water matric potential (m)
+ real(rkind), allocatable :: mLayerVolFracLiqTrial(:) ! intent(in): volumetric fraction of liquid water (-)
+ real(rkind), allocatable :: mLayerVolFracIceTrial(:) ! intent(in): volumetric fraction of ice (-)
+ real(rkind), allocatable :: mLayerdTheta_dTk(:) ! intent(in): derivative in volumetric liquid water content w.r.t. temperature (K-1)
+ real(rkind), allocatable :: dPsiLiq_dTemp(:) ! intent(in): derivative in liquid water matric potential w.r.t. temperature (m K-1)
+ real(rkind) :: dCanopyTrans_dCanWat ! intent(in): derivative in canopy transpiration w.r.t. canopy total water content (s-1)
+ real(rkind) :: dCanopyTrans_dTCanair ! intent(in): derivative in canopy transpiration w.r.t. canopy air temperature (kg m-2 s-1 K-1)
+ real(rkind) :: dCanopyTrans_dTCanopy ! intent(in): derivative in canopy transpiration w.r.t. canopy temperature (kg m-2 s-1 K-1)
+ real(rkind) :: dCanopyTrans_dTGround ! intent(in): derivative in canopy transpiration w.r.t. ground temperature (kg m-2 s-1 K-1)
+ real(rkind) :: above_soilLiqFluxDeriv ! intent(in): derivative in layer above soil (canopy or snow) liquid flux w.r.t. liquid water
+ real(rkind) :: above_soildLiq_dTk ! intent(in): derivative of layer above soil (canopy or snow) liquid flux w.r.t. temperature
+ real(rkind) :: above_soilFracLiq ! intent(in): fraction of liquid water layer above soil (canopy or snow) (-)
+ real(rkind) :: scalarCanopyTranspiration ! intent(in): canopy transpiration (kg m-2 s-1)
+ real(rkind) :: scalarGroundEvaporation ! intent(in): ground evaporation (kg m-2 s-1)
+ real(rkind) :: scalarRainPlusMelt ! intent(in): rain plus melt (m s-1)
+ end type in_type_soilLiqFlx
+
+ type, public :: io_type_soilLiqFlx ! derived type for intent(inout) arguments in soilLiqFlx call
+ real(rkind) :: scalarMaxInfilRate ! intent(inout): maximum infiltration rate (m s-1)
+ real(rkind) :: scalarInfilArea ! intent(inout): fraction of unfrozen area where water can infiltrate (-)
+ real(rkind) :: scalarFrozenArea ! intent(inout): fraction of area that is considered impermeable due to soil ice (-)
+ real(rkind) :: scalarSurfaceRunoff ! intent(inout): surface runoff (m s-1)
+ real(rkind), allocatable :: mLayerdTheta_dPsi(:) ! intent(inout): derivative in the soil water characteristic w.r.t. psi (m-1)
+ real(rkind), allocatable :: mLayerdPsi_dTheta(:) ! intent(inout): derivative in the soil water characteristic w.r.t. theta (m)
+ real(rkind), allocatable :: dHydCond_dMatric(:) ! intent(inout): derivative in hydraulic conductivity w.r.t matric head (s-1)
+ real(rkind) :: scalarInfiltration ! intent(inout): surface infiltration rate (m s-1) -- controls on infiltration only computed for iter==1
+ real(rkind), allocatable :: iLayerLiqFluxSoil(:) ! intent(inout): liquid fluxes at layer interfaces (m s-1)
+ real(rkind), allocatable :: mLayerTranspire(:) ! intent(inout): transpiration loss from each soil layer (m s-1)
+ real(rkind), allocatable :: mLayerHydCond(:) ! intent(inout): hydraulic conductivity in each layer (m s-1)
+ real(rkind), allocatable :: dq_dHydStateAbove(:) ! intent(inout): derivatives in the flux w.r.t. matric head in the layer above (s-1)
+ real(rkind), allocatable :: dq_dHydStateBelow(:) ! intent(inout): derivatives in the flux w.r.t. matric head in the layer below (s-1)
+ real(rkind), allocatable :: dq_dHydStateLayerSurfVec(:) ! intent(inout): derivative in surface infiltration w.r.t. hydrology state in above soil snow or canopy and every soil layer (m s-1 or s-1)
+ real(rkind), allocatable :: dq_dNrgStateAbove(:) ! intent(inout): derivatives in the flux w.r.t. temperature in the layer above (m s-1 K-1)
+ real(rkind), allocatable :: dq_dNrgStateBelow(:) ! intent(inout): derivatives in the flux w.r.t. temperature in the layer below (m s-1 K-1)
+ real(rkind), allocatable :: dq_dNrgStateLayerSurfVec(:) ! intent(inout): derivative in surface infiltration w.r.t. energy state in above soil snow or canopy and every soil layer (m s-1 K-1)
+ real(rkind), allocatable :: mLayerdTrans_dTCanair(:) ! intent(inout): derivatives in the soil layer transpiration flux w.r.t. canopy air temperature
+ real(rkind), allocatable :: mLayerdTrans_dTCanopy(:) ! intent(inout): derivatives in the soil layer transpiration flux w.r.t. canopy temperature
+ real(rkind), allocatable :: mLayerdTrans_dTGround(:) ! intent(inout): derivatives in the soil layer transpiration flux w.r.t. ground temperature
+ real(rkind), allocatable :: mLayerdTrans_dCanWat(:) ! intent(inout): derivatives in the soil layer transpiration flux w.r.t. canopy total water
+ end type io_type_soilLiqFlx
+
+ type, public :: out_type_soilLiqFlx ! derived type for intent(out) arguments in soilLiqFlx call
+ integer(i4b) :: err ! intent(out): error code
+ character(:),allocatable :: cmessage ! intent(out): error message
+ end type out_type_soilLiqFlx
+ ! ** end soilLiqFlx
+
+ ! ** groundwatr
+ type, public :: in_type_groundwatr ! derived type for intent(in) arguments in groundwatr call
+ integer(i4b) :: nSnow ! intent(in): number of snow layers
+ integer(i4b) :: nSoil ! intent(in): number of soil layers
+ integer(i4b) :: nLayers ! intent(in): total number of layers
+ logical(lgt) :: firstFluxCall ! intent(in): logical flag to compute index of the lowest saturated layer
+ real(rkind), allocatable :: mLayerdTheta_dPsi(:) ! intent(in): derivative in the soil water characteristic w.r.t. matric head in each layer (m-1)
+ real(rkind), allocatable :: mLayerMatricHeadLiqTrial(:) ! intent(in): liquid water matric potential (m)
+ real(rkind), allocatable :: mLayerVolFracLiqTrial(:) ! intent(in): volumetric fraction of liquid water (-)
+ real(rkind), allocatable :: mLayerVolFracIceTrial(:) ! intent(in): volumetric fraction of ice (-)
+ end type in_type_groundwatr
+
+ type, public :: io_type_groundwatr ! derived type for intent(io) arguments in groundwatr call
+ integer(i4b) :: ixSaturation ! intent(inout): index of lowest saturated layer (NOTE: only computed on the first iteration)
+ end type io_type_groundwatr
+
+ type, public :: out_type_groundwatr ! derived type for intent(out) arguments in groundwatr call
+ real(rkind), allocatable :: mLayerBaseflow(:) ! intent(out): baseflow from each soil layer (m s-1)
+ real(rkind), allocatable :: dBaseflow_dMatric(:,:) ! intent(out): derivative in baseflow w.r.t. matric head (s-1)
+ integer(i4b) :: err ! intent(out): error code
+ character(:),allocatable :: cmessage ! intent(out): error message
+ end type out_type_groundwatr
+ ! ** end groundwatr
+
+ ! ** bigAquifer
+ type, public :: in_type_bigAquifer ! derived type for intent(in) arguments in bigAquifer call
+ real(rkind) :: scalarAquiferStorageTrial ! intent(in): trial value of aquifer storage (m)
+ real(rkind) :: scalarCanopyTranspiration ! intent(in): canopy transpiration (kg m-2 s-1)
+ real(rkind) :: scalarSoilDrainage ! intent(in): soil drainage (m s-1)
+ real(rkind) :: dCanopyTrans_dCanWat ! intent(in): derivative in canopy transpiration w.r.t. canopy total water content (s-1)
+ real(rkind) :: dCanopyTrans_dTCanair ! intent(in): derivative in canopy transpiration w.r.t. canopy air temperature (kg m-2 s-1 K-1)
+ real(rkind) :: dCanopyTrans_dTCanopy ! intent(in): derivative in canopy transpiration w.r.t. canopy temperature (kg m-2 s-1 K-1)
+ real(rkind) :: dCanopyTrans_dTGround ! intent(in): derivative in canopy transpiration w.r.t. ground temperature (kg m-2 s-1 K-1)
+ end type in_type_bigAquifer
+
+ type, public :: io_type_bigAquifer ! derived type for intent(inout) arguments in bigAquifer call
+ real(rkind) :: dAquiferTrans_dTCanair ! intent(inout): derivatives in the aquifer transpiration flux w.r.t. canopy air temperature
+ real(rkind) :: dAquiferTrans_dTCanopy ! intent(inout): derivatives in the aquifer transpiration flux w.r.t. canopy temperature
+ real(rkind) :: dAquiferTrans_dTGround ! intent(inout): derivatives in the aquifer transpiration flux w.r.t. ground temperature
+ real(rkind) :: dAquiferTrans_dCanWat ! intent(inout): derivatives in the aquifer transpiration flux w.r.t. canopy total water
+ end type io_type_bigAquifer
+
+ type, public :: out_type_bigAquifer ! derived type for intent(out) arguments in bigAquifer call
+ real(rkind) :: scalarAquiferTranspire ! intent(out): transpiration loss from the aquifer (m s-1)
+ real(rkind) :: scalarAquiferRecharge ! intent(out): recharge to the aquifer (m s-1)
+ real(rkind) :: scalarAquiferBaseflow ! intent(out): total baseflow from the aquifer (m s-1)
+ real(rkind) :: dBaseflow_dAquifer ! intent(out): change in baseflow flux w.r.t. aquifer storage (s-1)
+ integer(i4b) :: err ! intent(out): error code
+ character(:),allocatable :: cmessage ! intent(out): error message
+ end type out_type_bigAquifer
+ ! ** end bigAquifer
END MODULE data_types
diff --git a/build/source/engine/alloc_fileAccess.f90 b/build/source/engine/alloc_fileAccess.f90
deleted file mode 100644
index 238f447c09e6bcf62aff901cbe60099280649001..0000000000000000000000000000000000000000
--- a/build/source/engine/alloc_fileAccess.f90
+++ /dev/null
@@ -1,331 +0,0 @@
-module alloc_outputStructure
-USE nrtype
-USE data_types,only:var_time_dlength
-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
-USE data_types,only:var_info
-USE globalData,only:integerMissing
-USE globalData,only:nBand ! number of spectral bands
-USE globalData,only:nTimeDelay ! number of timesteps in the time delay histogram
-USE var_lookup,only:maxvarFreq ! allocation dimension (output frequency)
-USE var_lookup,only:iLookVarType ! look up structure for variable typed
-USE var_lookup,only:iLookINDEX
-
-
-implicit none
-private
-public::alloc_outputStruc
-public::allocateDat_rkind
-public::allocateDat_int
-private::is_var_desired
-contains
-
-logical function is_var_desired(metaStruct, iVar)
- implicit none
- type(var_info),intent(in) :: metaStruct(:)
- integer(i4b),intent(in) :: iVar
- ! local
- integer(i4b) :: iFreq
- ! initalize error control
- is_var_desired=.false.
- do iFreq=1,maxvarFreq
- if(metaStruct(iVar)%statIndex(iFreq) /= integerMissing)then
- is_var_desired=.true.
- exit
- end if
- end do
-
-end function is_var_desired
-
-subroutine alloc_outputStruc(metaStruct,dataStruct,nSteps,nSnow,nSoil,str_name,err,message)
- implicit none
- type(var_info),intent(in) :: metaStruct(:)
- class(*),intent(inout) :: dataStruct
- ! optional input
- integer(i4b),intent(in),optional :: nSteps
- integer(i4b),intent(in),optional :: nSnow ! number of snow layers
- integer(i4b),intent(in),optional :: nSoil ! number of soil layers
- character(len=*),intent(in),optional :: str_name ! name of the structure to allocate
- ! output
- integer(i4b),intent(inout) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! local
- logical(lgt) :: check ! .true. if the variables are allocated
- integer(i4b) :: nVars ! number of variables in the metadata structure
- integer(i4b) :: nLayers ! total number of layers
- integer(i4b) :: iVar
- integer(i4b) :: iStat ! checks if we want this variable
- character(len=256) :: cmessage ! error message of the downwind routine
- ! initalize error control
- 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'; print*,message; return; end if
- if(.not.present(nSnow))then; err=20; message=trim(message)//'expect nSnow to be present when nSoil is present'; print*,message; 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_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'; print*,message; return; end if
- end if
-
- check=.false.
- ! allocate the space for the variables and thier time steps in the output structure
- 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
- ! Check if this variable is desired within any timeframe
- if(is_var_desired(metaStruct,iVar))then
- allocate(dataStruct%var(iVar)%tim(nSteps))
- end if
- 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
- ! Check if this variable is desired within any timeframe
- if(is_var_desired(metaStruct,iVar))then
- allocate(dataStruct%var(iVar)%tim(nSteps))
- end if
- 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
- ! Check if this variable is desired within any timeframe
- if(is_var_desired(metaStruct,iVar))then
- allocate(dataStruct%var(iVar)%tim(nSteps))
- end if
- 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)
- call allocateDat_rkind(metaStruct,dataStruct,nSnow,nSoil,err,cmessage)
- 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
- ! Check if this variable is desired within any timeframe
- if(is_var_desired(metaStruct,iVar) .or. (present(str_name) .and. &
- ((iVar == iLookINDEX%nLayers) .or. (iVar == iLookINDEX%nSnow) .or. (iVar == iLookINDEX%nSoil)) ))then
- allocate(dataStruct%var(iVar)%tim(nSteps))
- call allocateDat_int(metaStruct,dataStruct,nSnow,nSoil,nSteps,iVar,err,cmessage)
- end if
- 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
- ! Check if this variable is desired within any timeframe
- if(is_var_desired(metaStruct,iVar))then
- allocate(dataStruct%var(iVar)%tim(nSteps))
- call allocateDat_rkind_nSteps(metaStruct,dataStruct,nSnow,nSoil,nSteps,iVar,err,cmessage)
- end if
- end do
- ! ****************************************************
- class default; err=20; message=trim(message)//'unable to identify derived data type for the variable dimension'; print*,message;return
- end select
- ! check errors
- if(check) then; err=20; message=trim(message)//'structure was unexpectedly allocated already'; print*,message; return; end if
- if(err/=0)then; err=20; message=trim(message)//'problem allocating'; print*,message; return; end if
-
- ! check errors
- if(err/=0)then; message=trim(message)//trim(cmessage); print*, message; return; end if
-end subroutine
-
-
-subroutine allocateDat_rkind_nSteps(metadata,varData,nSnow, nSoil, &
- nSteps,iVar,err,message)
-
- USE get_ixName_module,only:get_varTypeName ! to access type strings for error messages
-
- implicit none
- type(var_info),intent(in) :: metadata(:)
- ! output variables
- type(var_time_dlength),intent(inout) :: varData ! model variables for a local HRU
- integer(i4b),intent(in) :: nSnow
- integer(i4b),intent(in) :: nSoil
- integer(i4b),intent(in) :: nSteps
- integer(i4b),intent(in) :: iVar
- integer(i4b),intent(inout) :: err ! error code
- character(*),intent(inout) :: message ! error message
-
- ! local variables
- integer(i4b) :: iStep
- integer(i4b) :: nLayers
- message='allocateDat_rkindAccessActor'
-
- nLayers = nSnow+nSoil
- do iStep=1, nSteps
- select case(metadata(iVar)%vartype)
- case(iLookVarType%scalarv); allocate(varData%var(iVar)%tim(iStep)%dat(1),stat=err)
- case(iLookVarType%wLength); allocate(varData%var(iVar)%tim(iStep)%dat(nBand),stat=err)
- case(iLookVarType%midSnow); allocate(varData%var(iVar)%tim(iStep)%dat(nSnow),stat=err)
- case(iLookVarType%midSoil); allocate(varData%var(iVar)%tim(iStep)%dat(nSoil),stat=err)
- case(iLookVarType%midToto); allocate(varData%var(iVar)%tim(iStep)%dat(nLayers),stat=err)
- case(iLookVarType%ifcSnow); allocate(varData%var(iVar)%tim(iStep)%dat(0:nSnow),stat=err)
- case(iLookVarType%ifcSoil); allocate(varData%var(iVar)%tim(iStep)%dat(0:nSoil),stat=err)
- case(iLookVarType%ifcToto); allocate(varData%var(iVar)%tim(iStep)%dat(0:nLayers),stat=err)
- case(iLookVarType%parSoil); allocate(varData%var(iVar)%tim(iStep)%dat(nSoil),stat=err)
- case(iLookVarType%routing); allocate(varData%var(iVar)%tim(iStep)%dat(nTimeDelay),stat=err)
- case(iLookVarType%outstat); allocate(varData%var(iVar)%tim(iStep)%dat(maxvarfreq*2),stat=err)
- case(iLookVarType%unknown); allocate(varData%var(iVar)%tim(iStep)%dat(0),stat=err)
- case default
- err=40; message=trim(message)//"1. unknownVariableType[name='"//trim(metadata(iVar)%varname)//"'; type='"//trim(get_varTypeName(metadata(iVar)%vartype))//"']"
- return
- end select
- end do ! (iStep)
-
-end subroutine allocateDat_rkind_nSteps
-
-subroutine allocateDat_rkind(metadata,varData,nSnow,nSoil,err,message)
- USE get_ixName_module,only:get_varTypeName ! to access type strings for error messages
- implicit none
- type(var_info),intent(in) :: metadata(:)
- ! output variables
- type(var_dlength),intent(inout) :: varData ! model variables for a local HRU
- integer(i4b),intent(in) :: nSnow
- integer(i4b),intent(in) :: nSoil
-
- integer(i4b),intent(inout) :: err ! error code
- character(*),intent(inout) :: message ! error message
-
- ! local variables
- integer(i4b) :: nVars
- integer(i4b) :: iVar
- integer(i4b) :: nLayers
- message='allocateDat_rkindAccessActor'
-
- nVars = size(metaData)
- nLayers = nSnow+nSoil
- do iVar=1, nVars
- select case(metadata(iVar)%vartype)
- case(iLookVarType%scalarv); allocate(varData%var(iVar)%dat(1),stat=err)
- case(iLookVarType%wLength); allocate(varData%var(iVar)%dat(nBand),stat=err)
- case(iLookVarType%midSnow); allocate(varData%var(iVar)%dat(nSnow),stat=err)
- case(iLookVarType%midSoil); allocate(varData%var(iVar)%dat(nSoil),stat=err)
- case(iLookVarType%midToto); allocate(varData%var(iVar)%dat(nLayers),stat=err)
- case(iLookVarType%ifcSnow); allocate(varData%var(iVar)%dat(0:nSnow),stat=err)
- case(iLookVarType%ifcSoil); allocate(varData%var(iVar)%dat(0:nSoil),stat=err)
- case(iLookVarType%ifcToto); allocate(varData%var(iVar)%dat(0:nLayers),stat=err)
- case(iLookVarType%parSoil); allocate(varData%var(iVar)%dat(nSoil),stat=err)
- case(iLookVarType%routing); allocate(varData%var(iVar)%dat(nTimeDelay),stat=err)
- case(iLookVarType%outstat); allocate(varData%var(iVar)%dat(maxvarfreq*2),stat=err)
- case(iLookVarType%unknown); allocate(varData%var(iVar)%dat(0),stat=err)
- case default
- err=40; message=trim(message)//"1. unknownVariableType[name='"//trim(metadata(iVar)%varname)//"'; type='"//trim(get_varTypeName(metadata(iVar)%vartype))//"']"
- return
- end select
- end do
-
-end subroutine allocateDat_rkind
-
-subroutine allocateDat_int(metadata,varData,nSnow, nSoil, &
- nSteps,iVar,err,message)
- USE get_ixName_module,only:get_varTypeName ! to access type strings for error messages
-
- implicit none
- type(var_info),intent(in) :: metadata(:)
- ! output variables
- type(var_time_ilength),intent(inout) :: varData ! model variables for a local HRU
- integer(i4b),intent(in) :: nSnow
- integer(i4b),intent(in) :: nSoil
- integer(i4b),intent(in) :: nSteps
- integer(i4b),intent(in) :: iVar
- integer(i4b),intent(inout) :: err ! error code
- character(*),intent(inout) :: message ! error message
- ! local variables
- integer(i4b) :: iStep
- integer(i4b) :: nLayers
- message='allocateDat_rkindAccessActor'
-
- nLayers = nSnow+nSoil
- do iStep=1, nSteps
- select case(metadata(iVar)%vartype)
- case(iLookVarType%scalarv); allocate(varData%var(iVar)%tim(iStep)%dat(1),stat=err)
- case(iLookVarType%wLength); allocate(varData%var(iVar)%tim(iStep)%dat(nBand),stat=err)
- case(iLookVarType%midSnow); allocate(varData%var(iVar)%tim(iStep)%dat(nSnow),stat=err)
- case(iLookVarType%midSoil); allocate(varData%var(iVar)%tim(iStep)%dat(nSoil),stat=err)
- case(iLookVarType%midToto); allocate(varData%var(iVar)%tim(iStep)%dat(nLayers),stat=err)
- case(iLookVarType%ifcSnow); allocate(varData%var(iVar)%tim(iStep)%dat(0:nSnow),stat=err)
- case(iLookVarType%ifcSoil); allocate(varData%var(iVar)%tim(iStep)%dat(0:nSoil),stat=err)
- case(iLookVarType%ifcToto); allocate(varData%var(iVar)%tim(iStep)%dat(0:nLayers),stat=err)
- case(iLookVarType%parSoil); allocate(varData%var(iVar)%tim(iStep)%dat(nSoil),stat=err)
- case(iLookVarType%routing); allocate(varData%var(iVar)%tim(iStep)%dat(nTimeDelay),stat=err)
- case(iLookVarType%outstat); allocate(varData%var(iVar)%tim(iStep)%dat(maxvarfreq*2),stat=err)
- case(iLookVarType%unknown); allocate(varData%var(iVar)%tim(iStep)%dat(0),stat=err)
- case default
- err=40; message=trim(message)//"1. unknownVariableType[name='"//trim(metadata(iVar)%varname)//"'; type='"//trim(get_varTypeName(metadata(iVar)%vartype))//"']"
- return
- end select
- end do ! loop through time steps
-end subroutine
-
-
-
-
-end module alloc_outputStructure
\ No newline at end of file
diff --git a/build/source/engine/allocspace.f90 b/build/source/engine/allocspace.f90
deleted file mode 100755
index 63dfe0327d28043edf88412198d7d37c8ccdc63a..0000000000000000000000000000000000000000
--- a/build/source/engine/allocspace.f90
+++ /dev/null
@@ -1,596 +0,0 @@
-! SUMMA - Structure for Unifying Multiple Modeling Alternatives
-! Copyright (C) 2014-2020 NCAR/RAL; University of Saskatchewan; University of Washington
-!
-! This file is part of SUMMA
-!
-! For more information see: http://www.ral.ucar.edu/projects/summa
-!
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-module allocspace_module
-
-! data types
-USE nrtype
-
-! provide access to the derived types to define the data structures
-USE data_types,only:&
- zLookup, &
- ! final data vectors
- dlength, & ! var%dat
- ilength, & ! var%dat
- ! no spatial dimension
- var_i, & ! x%var(:) (i4b)
- var_i8, & ! x%var(:) integer(8)
- var_d, & ! x%var(:) (dp)
- var_flagVec, & ! x%var(:)%dat (logical)
- var_ilength, & ! x%var(:)%dat (i4b)
- var_dlength, & ! x%var(:)%dat (dp)
- ! gru dimension
- gru_int, & ! x%gru(:)%var(:) (i4b)
- gru_int8, & ! x%gru(:)%var(:) integer(8)
- gru_double, & ! x%gru(:)%var(:) (dp)
- gru_intVec, & ! x%gru(:)%var(:)%dat (i4b)
- gru_doubleVec, & ! x%gru(:)%var(:)%dat (dp)
- ! gru+hru dimension
- gru_hru_int, & ! x%gru(:)%hru(:)%var(:) (i4b)
- gru_hru_int8, & ! x%gru(:)%hru(:)%var(:) integer(8)
- gru_hru_double, & ! x%gru(:)%hru(:)%var(:) (dp)
- gru_hru_intVec, & ! x%gru(:)%hru(:)%var(:)%dat (i4b)
- gru_hru_doubleVec ! x%gru(:)%hru(:)%var(:)%dat (dp)
-
-! metadata structure
-USE data_types,only:var_info ! data type for metadata
-
-! access missing values
-USE globalData,only:integerMissing ! missing integer
-USE globalData,only:realMissing ! missing double precision number
-
-USE globalData,only: nTimeDelay ! number of timesteps in the time delay histogram
-USE globalData,only: nBand ! number of spectral bands
-
-! access variable types
-USE var_lookup,only:iLookVarType ! look up structure for variable typed
-USE var_lookup,only:maxvarFreq ! allocation dimension (output frequency)
-
-! privacy
-implicit none
-private
-public::allocLocal
-public::resizeData
-
-! -----------------------------------------------------------------------------------------------------------------------------------
-contains
-
- ! ************************************************************************************************
- ! public subroutine allocLocal: allocate space for local data structures
- ! ************************************************************************************************
- subroutine allocLocal(metaStruct,dataStruct,nSnow,nSoil,err,message)
- implicit none
- ! input-output
- type(var_info),intent(in) :: metaStruct(:) ! metadata structure
- class(*),intent(inout) :: dataStruct ! data structure
- ! optional input
- integer(i4b),intent(in),optional :: nSnow ! number of snow layers
- integer(i4b),intent(in),optional :: nSoil ! number of soil layers
- ! output
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! local
- logical(lgt) :: check ! .true. if the variables are allocated
- integer(i4b) :: nVars ! number of variables in the metadata structure
- integer(i4b) :: nLayers ! total number of layers
- logical(lgt) :: spatial
- character(len=256) :: cmessage ! error message of the downwind routine
- ! initialize error control
- err=0; message='allocLocal/'
-
- ! get the number of variables in the metadata structure
- nVars = size(metaStruct)
-
- ! check if nSnow and nSoil are present
- 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_ilength); err=20
- class is (var_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
-
- ! initialize allocation check
- check=.false.
-
- ! allocate the dimension for model variables
- select type(dataStruct)
- 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_d); if(allocated(dataStruct%var))then; check=.true.; else; allocate(dataStruct%var(nVars),stat=err); end if; return
- class is (var_flagVec); if(allocated(dataStruct%var))then; check=.true.; else; allocate(dataStruct%var(nVars),stat=err); end if
- class is (var_ilength); if(allocated(dataStruct%var))then; check=.true.; else; allocate(dataStruct%var(nVars),stat=err); end if
- class is (var_dlength); if(allocated(dataStruct%var))then; check=.true.; else; allocate(dataStruct%var(nVars),stat=err); end if
- class is (zLookup); spatial=.true.
- class default; err=20; message=trim(message)//'unable to identify derived data type for the variable dimension'; return
- end select
- ! check errors
- if(check) then; err=20; message=trim(message)//'structure was unexpectedly allocated already'; return; end if
- if(err/=0)then; err=20; message=trim(message)//'problem allocating'; return; end if
-
- ! allocate the dimension for model data
- select type(dataStruct)
- class is (var_flagVec); call allocateDat_flag(metaStruct,nSnow,nSoil,nLayers,dataStruct,err,cmessage)
- class is (var_ilength); call allocateDat_int( metaStruct,nSnow,nSoil,nLayers,dataStruct,err,cmessage)
- class is (var_dlength); call allocateDat_dp( metaStruct,nSnow,nSoil,nLayers,dataStruct,err,cmessage)
- class is (zLookup); spatial=.true.
- class default; err=20; message=trim(message)//'unable to identify derived data type for the data dimension'; return
- end select
-
- ! check errors
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
-
- end subroutine allocLocal
-
- ! ************************************************************************************************
- ! public subroutine resizeData: resize data structure
- ! ************************************************************************************************
- subroutine resizeData(metaStruct,dataStructOrig,dataStructNew,copy,err,message)
- implicit none
- ! input
- type(var_info),intent(in) :: metaStruct(:) ! metadata structure
- class(*) ,intent(in) :: dataStructOrig ! original data structure
- ! output
- class(*) ,intent(inout) :: dataStructNew ! new data structure
- ! control
- logical(lgt) ,intent(in) ,optional :: copy ! flag to copy data
- integer(i4b) ,intent(out) :: err ! error code
- character(*) ,intent(out) :: message ! error message
- ! local
- integer(i4b) :: iVar ! number of variables in the structure
- integer(i4b) :: nVars ! number of variables in the structure
- logical(lgt) :: isCopy ! flag to copy data (handles absence of optional argument)
- character(len=256) :: cmessage ! error message of the downwind routine
- ! initialize error control
- err=0; message='resizeData/'
-
- ! get the copy flag
- if(present(copy))then
- isCopy = copy
- else
- isCopy = .false.
- endif
-
- ! get the number of variables in the data structure
- nVars = size(metaStruct)
-
- ! check that the input data structure is allocated
- select type(dataStructOrig)
- class is (var_ilength); err=merge(0, 20, allocated(dataStructOrig%var))
- class is (var_dlength); err=merge(0, 20, allocated(dataStructOrig%var))
- class default; err=20; message=trim(message)//'unable to identify type of data structure'; return
- end select
- if(err/=0)then; message=trim(message)//'input data structure dataStructOrig%var'; return; end if
-
- ! allocate the dimension for model variables
- select type(dataStructNew)
- class is (var_ilength); if(.not.allocated(dataStructNew%var)) allocate(dataStructNew%var(nVars),stat=err)
- class is (var_dlength); if(.not.allocated(dataStructNew%var)) allocate(dataStructNew%var(nVars),stat=err)
- class default; err=20; message=trim(message)//'unable to identify derived data type for the variable dimension'; return
- end select
- if(err/=0)then; message=trim(message)//'problem allocating space for dataStructNew%var'; return; end if
-
- ! loop through variables
- do iVar=1,nVars
-
- ! resize and copy data structures
- select type(dataStructOrig)
-
- ! double precision
- class is (var_dlength)
- select type(dataStructNew)
- class is (var_dlength); call copyStruct_dp( dataStructOrig%var(iVar),dataStructNew%var(iVar),isCopy,err,cmessage)
- class default; err=20; message=trim(message)//'mismatch data structure for variable'//trim(metaStruct(iVar)%varname); return
- end select
-
- ! integer
- class is (var_ilength)
- select type(dataStructNew)
- class is (var_ilength); call copyStruct_i4b(dataStructOrig%var(iVar),dataStructNew%var(iVar),isCopy,err,cmessage)
- class default; err=20; message=trim(message)//'mismatch data structure for variable'//trim(metaStruct(iVar)%varname); return
- end select
-
- ! check
- class default; err=20; message=trim(message)//'unable to identify type of data structure'; return
- end select
- if(err/=0)then; message=trim(message)//trim(cmessage)//' ('//trim(metaStruct(iVar)%varname)//')'; return; end if
-
- end do ! looping through variables in the data structure
-
- end subroutine resizeData
-
- ! ************************************************************************************************
- ! private subroutine copyStruct_dp: copy a given data structure
- ! ************************************************************************************************
- subroutine copyStruct_dp(varOrig,varNew,copy,err,message)
- ! dummy variables
- type(dlength),intent(in) :: varOrig ! original data structure
- type(dlength),intent(inout) :: varNew ! new data structure
- logical(lgt) ,intent(in) :: copy ! flag to copy data
- integer(i4b) ,intent(out) :: err ! error code
- character(*) ,intent(out) :: message ! error message
- ! local
- logical(lgt) :: allocatedOrig ! flag to denote if a given variable in the original data structure is allocated
- logical(lgt) :: allocatedNew ! flag to denote if a given variable in the new data structure is allocated
- integer(i4b) :: lowerBoundOrig ! lower bound of a given variable in the original data structure
- integer(i4b) :: upperBoundOrig ! upper bound of a given variable in the original data structure
- integer(i4b) :: lowerBoundNew ! lower bound of a given variable in the new data structure
- integer(i4b) :: upperBoundNew ! upper bound of a given variable in the new data structure
- ! initialize error control
- err=0; message='copyStruct_dp/'
-
- ! get the information from the data structures
- call getVarInfo(varOrig,allocatedOrig,lowerBoundOrig,upperBoundOrig)
- call getVarInfo(varNew, allocatedNew, lowerBoundNew, upperBoundNew)
-
- ! check that the variable of the original data structure is allocated
- if(.not.allocatedOrig)then
- message=trim(message)//'variable in the original data structure is not allocated'
- err=20; return
- endif
-
- ! re-size data structure if necessary
- if(lowerBoundOrig/=lowerBoundNew .or. upperBoundOrig/=upperBoundNew .or. .not.allocatedNew)then
-
- ! deallocate space (if necessary)
- if(allocatedNew) deallocate(varNew%dat)
-
- ! allocate space
- allocate(varNew%dat(lowerBoundOrig:upperBoundOrig), stat=err)
- if(err/=0)then; message=trim(message)//'problem allocating'; return; endif
-
- endif ! if need to resize
-
- ! copy the data structure
- if(copy)then
- varNew%dat(:) = varOrig%dat(:)
-
- ! initialize the data structure to missing values
- else
- varNew%dat(:) = realMissing
- endif
-
- ! internal routines
- contains
-
- ! internal subroutine getVarInfo: get information from a given data structure
- subroutine getVarInfo(var,isAllocated,lowerBound,upperBound)
- ! input
- type(dlength),intent(in) :: var ! data vector for a given variable
- ! output
- logical(lgt),intent(out) :: isAllocated ! flag to denote if the data vector is allocated
- integer(i4b),intent(out) :: lowerBound ! lower bound
- integer(i4b),intent(out) :: upperBound ! upper bound
- ! local
- integer(i4b),dimension(1) :: lowerBoundVec ! lower bound vector
- integer(i4b),dimension(1) :: upperBoundVec ! upper bound vector
- ! initialize error control
- err=0; message='getVarInfo/'
-
- ! check that the input data structure is allocated
- isAllocated = allocated(var%dat)
-
- ! if allocated then get the bounds
- ! NOTE: also convert vector to scalar
- if(isAllocated)then
- lowerBoundVec=lbound(var%dat); lowerBound=lowerBoundVec(1)
- upperBoundVec=ubound(var%dat); upperBound=upperBoundVec(1)
-
- ! if not allocated then return zero bounds
- else
- lowerBound=0
- upperBound=0
- endif ! (check allocation)
-
- end subroutine getVarInfo
-
- end subroutine copyStruct_dp
-
- ! ************************************************************************************************
- ! private subroutine copyStruct_i4b: copy a given data structure
- ! ************************************************************************************************
- subroutine copyStruct_i4b(varOrig,varNew,copy,err,message)
- ! dummy variables
- type(ilength),intent(in) :: varOrig ! original data structure
- type(ilength),intent(inout) :: varNew ! new data structure
- logical(lgt) ,intent(in) :: copy ! flag to copy data
- integer(i4b) ,intent(out) :: err ! error code
- character(*) ,intent(out) :: message ! error message
- ! local
- logical(lgt) :: allocatedOrig ! flag to denote if a given variable in the original data structure is allocated
- logical(lgt) :: allocatedNew ! flag to denote if a given variable in the new data structure is allocated
- integer(i4b) :: lowerBoundOrig ! lower bound of a given variable in the original data structure
- integer(i4b) :: upperBoundOrig ! upper bound of a given variable in the original data structure
- integer(i4b) :: lowerBoundNew ! lower bound of a given variable in the new data structure
- integer(i4b) :: upperBoundNew ! upper bound of a given variable in the new data structure
- ! initialize error control
- err=0; message='copyStruct_i4b/'
-
- ! get the information from the data structures
- call getVarInfo(varOrig,allocatedOrig,lowerBoundOrig,upperBoundOrig)
- call getVarInfo(varNew, allocatedNew, lowerBoundNew, upperBoundNew)
-
- ! check that the variable of the original data structure is allocated
- if(.not.allocatedOrig)then
- message=trim(message)//'variable in the original data structure is not allocated'
- err=20; return
- endif
-
- ! re-size data structure if necessary
- if(lowerBoundOrig/=lowerBoundNew .or. upperBoundOrig/=upperBoundNew .or. .not.allocatedNew)then
-
- ! deallocate space (if necessary)
- if(allocatedNew) deallocate(varNew%dat)
-
- ! allocate space
- allocate(varNew%dat(lowerBoundOrig:upperBoundOrig), stat=err)
- if(err/=0)then; message=trim(message)//'problem allocating'; return; endif
-
- endif ! if need to resize
-
- ! copy the data structure
- if(copy)then
- varNew%dat(:) = varOrig%dat(:)
-
- ! initialize the data structure to missing values
- else
- varNew%dat(:) = integerMissing
- endif
-
- ! internal routines
- contains
-
- ! internal subroutine getVarInfo: get information from a given data structure
- subroutine getVarInfo(var,isAllocated,lowerBound,upperBound)
- ! input
- type(ilength),intent(in) :: var ! data vector for a given variable
- ! output
- logical(lgt),intent(out) :: isAllocated ! flag to denote if the data vector is allocated
- integer(i4b),intent(out) :: lowerBound ! lower bound
- integer(i4b),intent(out) :: upperBound ! upper bound
- ! local
- integer(i4b),dimension(1) :: lowerBoundVec ! lower bound vector
- integer(i4b),dimension(1) :: upperBoundVec ! upper bound vector
- ! initialize error control
- err=0; message='getVarInfo/'
-
- ! check that the input data structure is allocated
- isAllocated = allocated(var%dat)
-
- ! if allocated then get the bounds
- ! NOTE: also convert vector to scalar
- if(isAllocated)then
- lowerBoundVec=lbound(var%dat); lowerBound=lowerBoundVec(1)
- upperBoundVec=ubound(var%dat); upperBound=upperBoundVec(1)
-
- ! if not allocated then return zero bounds
- else
- lowerBound=0
- upperBound=0
- endif ! (check allocation)
-
- end subroutine getVarInfo
-
- end subroutine copyStruct_i4b
-
-
- ! ************************************************************************************************
- ! private subroutine allocateDat_dp: initialize data dimension of the data structures
- ! ************************************************************************************************
- subroutine allocateDat_dp(metadata,nSnow,nSoil,nLayers, & ! input
- varData,err,message) ! output
- ! access subroutines
- USE get_ixName_module,only:get_varTypeName ! to access type strings for error messages
-
- implicit none
- ! input variables
- type(var_info),intent(in) :: metadata(:) ! metadata structure
- integer(i4b),intent(in) :: nSnow ! number of snow layers
- integer(i4b),intent(in) :: nSoil ! number of soil layers
- integer(i4b),intent(in) :: nLayers ! total number of soil layers in the snow+soil domian (nSnow+nSoil)
- ! output variables
- type(var_dlength),intent(inout) :: varData ! model variables for a local HRU
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! local variables
- integer(i4b) :: iVar ! variable index
- integer(i4b) :: nVars ! number of variables in the metadata structure
-
-! initialize error control
- err=0; message='allocateDat_dp/'
-
- ! get the number of variables in the metadata structure
- nVars = size(metadata)
-
- ! loop through variables in the data structure
- do iVar=1,nVars
-
- ! check allocated
- if(allocated(varData%var(iVar)%dat))then
- message=trim(message)//'variable '//trim(metadata(iVar)%varname)//' is unexpectedly allocated'
- err=20; return
-
- ! allocate structures
- ! NOTE: maxvarFreq is the number of possible output frequencies
- ! -- however, this vector must store two values for the variance calculation, thus the *2 in this allocate
- ! (need enough space in the event that variance is the desired statistic for all output frequencies)
- else
- select case(metadata(iVar)%vartype)
- case(iLookVarType%scalarv); allocate(varData%var(iVar)%dat(1),stat=err)
- case(iLookVarType%wLength); allocate(varData%var(iVar)%dat(nBand),stat=err)
- case(iLookVarType%midSnow); allocate(varData%var(iVar)%dat(nSnow),stat=err)
- case(iLookVarType%midSoil); allocate(varData%var(iVar)%dat(nSoil),stat=err)
- case(iLookVarType%midToto); allocate(varData%var(iVar)%dat(nLayers),stat=err)
- case(iLookVarType%ifcSnow); allocate(varData%var(iVar)%dat(0:nSnow),stat=err)
- case(iLookVarType%ifcSoil); allocate(varData%var(iVar)%dat(0:nSoil),stat=err)
- case(iLookVarType%ifcToto); allocate(varData%var(iVar)%dat(0:nLayers),stat=err)
- case(iLookVarType%parSoil); allocate(varData%var(iVar)%dat(nSoil),stat=err)
- case(iLookVarType%routing); allocate(varData%var(iVar)%dat(nTimeDelay),stat=err)
- case(iLookVarType%outstat); allocate(varData%var(iVar)%dat(maxvarfreq*2),stat=err)
- case(iLookVarType%unknown); allocate(varData%var(iVar)%dat(0),stat=err) ! unknown = special (and valid) case that is allocated later (initialize with zero-length vector)
- case default
- err=40; message=trim(message)//"1. unknownVariableType[name='"//trim(metadata(iVar)%varname)//"'; type='"//trim(get_varTypeName(metadata(iVar)%vartype))//"']"
- return
- end select
- ! check error
- if(err/=0)then; err=20; message=trim(message)//'problem allocating variable '//trim(metadata(iVar)%varname); return; end if
- ! set to missing
- varData%var(iVar)%dat(:) = realMissing
- end if ! if not allocated
-
- end do ! looping through variables
-
- end subroutine allocateDat_dp
-
- ! ************************************************************************************************
- ! private subroutine allocateDat_int: initialize data dimension of the data structures
- ! ************************************************************************************************
- subroutine allocateDat_int(metadata,nSnow,nSoil,nLayers, & ! input
- varData,err,message) ! output
- USE get_ixName_module,only:get_varTypeName ! to access type strings for error messages
- implicit none
- ! input variables
- type(var_info),intent(in) :: metadata(:) ! metadata structure
- integer(i4b),intent(in) :: nSnow ! number of snow layers
- integer(i4b),intent(in) :: nSoil ! number of soil layers
- integer(i4b),intent(in) :: nLayers ! total number of soil layers in the snow+soil domian (nSnow+nSoil)
- ! output variables
- type(var_ilength),intent(inout) :: varData ! model variables for a local HRU
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! local variables
- integer(i4b) :: iVar ! variable index
- integer(i4b) :: nVars ! number of variables in the metadata structure
-
-! initialize error control
- err=0; message='allocateDat_int/'
-
- ! get the number of variables in the metadata structure
- nVars = size(metadata)
-
-! loop through variables in the data structure
- do iVar=1,nVars
-
- ! check allocated
- if(allocated(varData%var(iVar)%dat))then
- message=trim(message)//'variable '//trim(metadata(iVar)%varname)//' is unexpectedly allocated'
- err=20; return
-
- ! allocate structures
- ! NOTE: maxvarFreq is the number of possible output frequencies
- ! -- however, this vector must store two values for the variance calculation, thus the *2 in this allocate
- ! (need enough space in the event that variance is the desired statistic for all output frequencies)
- else
- select case(metadata(iVar)%vartype)
- case(iLookVarType%scalarv); allocate(varData%var(iVar)%dat(1),stat=err)
- case(iLookVarType%wLength); allocate(varData%var(iVar)%dat(nBand),stat=err)
- case(iLookVarType%midSnow); allocate(varData%var(iVar)%dat(nSnow),stat=err)
- case(iLookVarType%midSoil); allocate(varData%var(iVar)%dat(nSoil),stat=err)
- case(iLookVarType%midToto); allocate(varData%var(iVar)%dat(nLayers),stat=err)
- case(iLookVarType%ifcSnow); allocate(varData%var(iVar)%dat(0:nSnow),stat=err)
- case(iLookVarType%ifcSoil); allocate(varData%var(iVar)%dat(0:nSoil),stat=err)
- case(iLookVarType%ifcToto); allocate(varData%var(iVar)%dat(0:nLayers),stat=err)
- case(iLookVarType%routing); allocate(varData%var(iVar)%dat(nTimeDelay),stat=err)
- case(iLookVarType%outstat); allocate(varData%var(iVar)%dat(maxvarFreq*2),stat=err)
- case(iLookVarType%unknown); allocate(varData%var(iVar)%dat(0),stat=err) ! unknown=special (and valid) case that is allocated later (initialize with zero-length vector)
- case default; err=40; message=trim(message)//"unknownVariableType[name='"//trim(metadata(iVar)%varname)//"'; type='"//trim(get_varTypeName(metadata(iVar)%vartype))//"']"; return
- end select
- ! check error
- if(err/=0)then; err=20; message=trim(message)//'problem allocating variable '//trim(metadata(iVar)%varname); return; end if
- ! set to missing
- varData%var(iVar)%dat(:) = integerMissing
- end if ! if not allocated
-
- end do ! looping through variables
-
- end subroutine allocateDat_int
-
- ! ************************************************************************************************
- ! private subroutine allocateDat_flag: initialize data dimension of the data structures
- ! ************************************************************************************************
- subroutine allocateDat_flag(metadata,nSnow,nSoil,nLayers, & ! input
- varData,err,message) ! output
- USE get_ixName_module,only:get_varTypeName ! to access type strings for error messages
- implicit none
- ! input variables
- type(var_info),intent(in) :: metadata(:) ! metadata structure
- integer(i4b),intent(in) :: nSnow ! number of snow layers
- integer(i4b),intent(in) :: nSoil ! number of soil layers
- integer(i4b),intent(in) :: nLayers ! total number of soil layers in the snow+soil domian (nSnow+nSoil)
- ! output variables
- type(var_flagVec),intent(inout) :: varData ! model variables for a local HRU
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! local variables
- integer(i4b) :: iVar ! variable index
- integer(i4b) :: nVars ! number of variables in the metadata structure
-
-! initialize error control
- err=0; message='allocateDat_flag/'
-
- ! get the number of variables in the metadata structure
- nVars = size(metadata)
-
-! loop through variables in the data structure
- do iVar=1,nVars
-
- ! check allocated
- if(allocated(varData%var(iVar)%dat))then
- message=trim(message)//'variable '//trim(metadata(iVar)%varname)//' is unexpectedly allocated'
- err=20; return
-
- ! allocate structures
- ! NOTE: maxvarFreq is the number of possible output frequencies
- ! -- however, this vector must store two values for the variance calculation, thus the *2 in this allocate
- ! (need enough space in the event that variance is the desired statistic for all output frequencies)
- else
- select case(metadata(iVar)%vartype)
- case(iLookVarType%scalarv); allocate(varData%var(iVar)%dat(1),stat=err)
- case(iLookVarType%wLength); allocate(varData%var(iVar)%dat(nBand),stat=err)
- case(iLookVarType%midSnow); allocate(varData%var(iVar)%dat(nSnow),stat=err)
- case(iLookVarType%midSoil); allocate(varData%var(iVar)%dat(nSoil),stat=err)
- case(iLookVarType%midToto); allocate(varData%var(iVar)%dat(nLayers),stat=err)
- case(iLookVarType%ifcSnow); allocate(varData%var(iVar)%dat(0:nSnow),stat=err)
- case(iLookVarType%ifcSoil); allocate(varData%var(iVar)%dat(0:nSoil),stat=err)
- case(iLookVarType%ifcToto); allocate(varData%var(iVar)%dat(0:nLayers),stat=err)
- case(iLookVarType%routing); allocate(varData%var(iVar)%dat(nTimeDelay),stat=err)
- case(iLookVarType%outstat); allocate(varData%var(iVar)%dat(maxvarFreq*2),stat=err)
- case(iLookVarType%unknown); allocate(varData%var(iVar)%dat(0),stat=err) ! unknown=special (and valid) case that is allocated later (initialize with zero-length vector)
- case default; err=40; message=trim(message)//"unknownVariableType[name='"//trim(metadata(iVar)%varname)//"'; type='"//trim(get_varTypeName(metadata(iVar)%vartype))//"']"; return
- end select
- ! check error
- if(err/=0)then; err=20; message=trim(message)//'problem allocating variable '//trim(metadata(iVar)%varname); return; end if
- ! set to false
- varData%var(iVar)%dat(:) = .false.
- end if ! if not allocated
-
- end do ! looping through variables
-
- end subroutine allocateDat_flag
-
-end module allocspace_module
diff --git a/build/source/engine/ffile_info.f90 b/build/source/engine/ffile_info.f90
index 02f598c1feb85c0f92b7bb1089dbe62be78a4545..6c776cb56860634bece8f7361b355e2eec30ebfd 100755
--- a/build/source/engine/ffile_info.f90
+++ b/build/source/engine/ffile_info.f90
@@ -18,8 +18,7 @@
! You should have received a copy of the GNU General Public License
! along with this program. If not, see <http://www.gnu.org/licenses/>.
-module ffile_info_module
-USE, intrinsic :: iso_c_binding
+module ffile_info_actors_module
USE nrtype
USE netcdf
USE data_types
@@ -38,7 +37,7 @@ contains
! ************************************************************************************************
! public subroutine ffile_info: read information on model forcing files
! ************************************************************************************************
-subroutine ffile_info(indxGRU,handle_forcFileInfo,num_forcing_files,err) bind(C, name='ffile_info')
+subroutine ffile_info(indxGRU,forcFileInfo,num_forcing_files,err,message)
! used to read metadata on the forcing data file
USE ascii_util_module,only:file_open
USE ascii_util_module,only:linewidth
@@ -61,42 +60,41 @@ subroutine ffile_info(indxGRU,handle_forcFileInfo,num_forcing_files,err) bind(C,
implicit none
! define input & output
- integer(c_int),intent(in) :: indxGRU
- type(c_ptr), intent(in), value :: handle_forcFileInfo
- integer(c_int),intent(out) :: num_forcing_files
- integer(c_int),intent(out) :: err ! error code
+ integer(i4b),intent(in) :: indxGRU
+ type(file_info_array),pointer,intent(in) :: forcFileInfo
+ integer(i4b),intent(out) :: num_forcing_files
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(inout) :: message ! error message
! define local variables
- type(file_info_array),pointer :: forcFileInfo
+
! netcdf file i/o related
- integer(i4b) :: ncid ! netcdf file id
- integer(i4b) :: mode ! netCDF file open mode
- integer(i4b) :: dimId ! netcdf dimension id
- character(LEN=nf90_max_name) :: varName ! character array of netcdf variable name
- integer(i4b) :: iNC ! index of a variable in netcdf file
- integer(i4b) :: nvar ! number of variables in netcdf local attribute file
+ integer(i4b) :: ncid ! netcdf file id
+ integer(i4b) :: mode ! netCDF file open mode
+ integer(i4b) :: dimId ! netcdf dimension id
+ character(LEN=nf90_max_name) :: varName ! character array of netcdf variable name
+ integer(i4b) :: iNC ! index of a variable in netcdf file
+ integer(i4b) :: nvar ! number of variables in netcdf local attribute file
! the rest
- character(LEN=linewidth),allocatable :: dataLines(:) ! vector of lines of information (non-comment lines)
- character(len=256) :: message ! error message for downwind routine
- character(len=256) :: cmessage ! error message for downwind routine
- character(LEN=256) :: infile ! input filename
- integer(i4b) :: unt ! file unit (free unit output from file_open)
- integer(i4b) :: ivar ! index of model variable
- integer(i4b) :: iFile ! counter for forcing files
- integer(i4b) :: nFile ! number of forcing files in forcing file list
- integer(i4b) :: totalFiles ! total number of forcing files defiend in the forcing file list
- integer(i4b) :: startIndx ! total number of forcing files defiend in the forcing file list
- integer(i4b) :: file_nHRU ! number of HRUs in current forcing file
- integer(i4b) :: nForcing ! number of forcing variables
- real(dp) :: dataStep_iFile ! data step for a given forcing data file
- logical(lgt) :: xist ! .TRUE. if the file exists
+ character(LEN=linewidth),allocatable :: dataLines(:) ! vector of lines of information (non-comment lines)
+ character(len=256) :: cmessage ! error message for downwind routine
+ character(LEN=256) :: infile ! input filename
+ integer(i4b) :: unt ! file unit (free unit output from file_open)
+ integer(i4b) :: ivar ! index of model variable
+ integer(i4b) :: iFile ! counter for forcing files
+ integer(i4b) :: nFile ! number of forcing files in forcing file list
+ integer(i4b) :: totalFiles ! total number of forcing files defiend in the forcing file list
+ integer(i4b) :: startIndx ! total number of forcing files defiend in the forcing file list
+ integer(i4b) :: file_nHRU ! number of HRUs in current forcing file
+ integer(i4b) :: nForcing ! number of forcing variables
+ real(dp) :: dataStep_iFile ! data step for a given forcing data file
+ logical(lgt) :: xist ! .TRUE. if the file exists
! Time Variables
- type(var_i) :: startTime
- type(var_i) :: forcingStart
- type(var_i) :: finishTime
- real(rkind) :: dsec,dsec_tz
- integer(i4b) :: ffinfo_index
+ type(var_i) :: startTime
+ type(var_i) :: forcingStart
+ type(var_i) :: finishTime
+ real(rkind) :: dsec,dsec_tz
+ integer(i4b) :: ffinfo_index
- call c_f_pointer(handle_forcFileInfo, forcFileInfo)
! Start procedure here
err=0; message="ffile_info/"
! ------------------------------------------------------------------------------------------------------------------
@@ -369,7 +367,7 @@ subroutine setHRUID(ncid,indxGRU,varName,inFile,err,message)
USE netCDF
implicit none
integer(i4b),intent(in) :: ncid
- integer(c_int),intent(in) :: indxGRU
+ integer(i4b),intent(in) :: indxGRU
character(*),intent(in) :: varName
character(*),intent(in) :: inFile ! file that populated dataLines
integer(i4b),intent(out) :: err
@@ -399,4 +397,4 @@ subroutine setHRUID(ncid,indxGRU,varName,inFile,err,message)
end subroutine
-end module ffile_info_module
+end module ffile_info_actors_module
diff --git a/build/source/engine/read_attrb.f90 b/build/source/engine/read_attrb.f90
deleted file mode 100644
index 459484b2c9cd9952db624b0adcc89b570c55d2b8..0000000000000000000000000000000000000000
--- a/build/source/engine/read_attrb.f90
+++ /dev/null
@@ -1,227 +0,0 @@
-! SUMMA - Structure for Unifying Multiple Modeling Alternatives
-! Copyright (C) 2014-2020 NCAR/RAL; University of Saskatchewan; University of Washington
-!
-! This file is part of SUMMA
-!
-! For more information see: http://www.ral.ucar.edu/projects/summa
-!
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-module read_attrb_module
-USE, intrinsic :: iso_c_binding
-USE nrtype
-implicit none
-private
-public::read_dimension
-! public::read_attribute
-contains
-
-! ************************************************************************************************
-! public subroutine read_dimension: read HRU and GRU dimension information on local attributes
-! ************************************************************************************************
-subroutine read_dimension(numGRUs,numHRUs,startGRU,err) bind(C, name="readDimension")
-
- 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 nr_utility_module ,only:arth
- ! provide access to global data
- USE globalData,only:gru_struc ! gru->hru mapping structure
- USE globalData,only:index_map ! hru->gru mapping structure
- ! file paths for attribute file
- USE summaFileManager,only:SETTINGS_PATH ! define path to settings files (e.g., parameters, soil and veg. tables)
- USE summaFileManager,only:LOCAL_ATTRIBUTES ! name of model initial attributes file
-
-
- implicit none
-
- ! Dummy Variables
-
- integer(c_int),intent(in) :: numGRUs ! number of GRUs for the run domain
- integer(c_int),intent(out) :: numHRUs ! number of HRUs for the run domain (value filled in this subroutine)
- integer(c_int),intent(in) :: startGRU ! Index of the starting GRU
- integer(c_int),intent(out) :: err ! error code
-
- ! Local Variables
- character(len=256) :: attrFile ! name of attributed file
- integer(i4b) :: fileGRU ! number of GRUs in the input file
- integer(i4b) :: fileHRU ! number of HRUs in the input file
- integer(i4b) :: iHRU ! HRU couinting index
- integer(i4b) :: iGRU ! GRU loop index
- integer(8),allocatable :: gru_id(:),hru_id(:)! read gru/hru IDs in from attributes file
- integer(8),allocatable :: hru2gru_id(:) ! read hru->gru mapping in from attributes file
- integer(i4b),allocatable :: hru_ix(:) ! hru index for search
- character(len=256) :: message ! error message
-
-
- ! define variables for NetCDF file operation
- integer(i4b) :: ncID ! NetCDF file ID
- integer(i4b) :: varID ! NetCDF variable ID
- integer(i4b) :: gruDimId ! variable id of GRU dimension from netcdf file
- integer(i4b) :: hruDimId ! variable id of HRU dimension from netcdf file
- character(len=256) :: cmessage ! error message for downwind routine
-
- err=0; message="read_dimension/"
- attrFile = trim(SETTINGS_PATH)//trim(LOCAL_ATTRIBUTES)
-
- ! open nc file
- call nc_file_open(trim(attrFile),nf90_noWrite,ncID,err,cmessage)
- if(err/=0)then
- message=trim(message)//trim(cmessage)
- print*, message
- print*, attrFile
- return
- end if
-
- ! *********************************************************************************************
- ! read and set GRU dimensions
- ! **********************************************************************************************
- ! get gru dimension of whole file
- err = nf90_inq_dimid(ncID,"gru",gruDimId)
- if(err/=nf90_noerr)then
- message=trim(message)//'problem finding gru dimension/'//trim(nf90_strerror(err))
- print*, message
- return
- end if
-
- err = nf90_inquire_dimension(ncID, gruDimId, len = fileGRU)
- if(err/=nf90_noerr)then;
- message=trim(message)//'problem reading gru dimension/'//trim(nf90_strerror(err))
- print*, message
- return
- end if
-
- ! get hru dimension of whole file
- err = nf90_inq_dimid(ncID,"hru",hruDimId)
- if(err/=nf90_noerr)then
- message=trim(message)//'problem finding hru dimension/'//trim(nf90_strerror(err))
- print*, message
- return
- end if
-
- err = nf90_inquire_dimension(ncID, hruDimId, len = fileHRU)
- if(err/=nf90_noerr)then
- message=trim(message)//'problem reading hru dimension/'//trim(nf90_strerror(err))
- print*, message
- return
- end if
-
- ! check dimensions
- if(numGRUs > fileGRU .or. numGRUs < 1) then;
- err=20
- message=trim(message)//"numGRUs is out of range"
- print*, message
- return
- end if
-
- ! *********************************************************************************************
- ! read mapping vectors and populate mapping structures
- ! **********************************************************************************************
- ! allocate space for GRU indices and HRU indices
- allocate(gru_id(fileGRU))
- allocate(hru_ix(fileHRU),hru_id(fileHRU),hru2gru_id(fileHRU))
-
- ! read gru_id from netcdf file
- err = nf90_inq_varid(ncID,"gruId",varID)
- if (err/=0) then
- message=trim(message)//'problem finding gruId'
- print*, message
- return
- end if
-
- err = nf90_get_var(ncID,varID,gru_id)
- if (err/=0) then
- message=trim(message)//'problem reading gruId'
- print*, message
- return
- end if
-
- ! read hru_id from netcdf file
- err = nf90_inq_varid(ncID,"hruId",varID)
- if (err/=0) then
- message=trim(message)//'problem finding hruId'
- print*, message
- return
- end if
-
- err = nf90_get_var(ncID,varID,hru_id)
- if (err/=0) then
- message=trim(message)//'problem reading hruId'
- print*, message
- return
- end if
-
- ! read hru2gru_id from netcdf file
- err = nf90_inq_varid(ncID,"hru2gruId",varID)
- if (err/=0) then
- message=trim(message)//'problem finding hru2gruId'
- print*, message
- return
- end if
-
- err = nf90_get_var(ncID,varID,hru2gru_id)
- if (err/=0) then
- message=trim(message)//'problem reading hru2gruId'
- print*, message
- return
- end if
-
- ! array from 1 to total # of HRUs in attributes file
- hru_ix=arth(1,1,fileHRU)
-
- ! check that the mappings are not alreaday allocated
- if (allocated(gru_struc)) then
- deallocate(gru_struc)
- endif
-
- if (allocated(index_map)) then
- deallocate(index_map)
- endif
-
- ! allocate first level of gru to hru mapping
- allocate(gru_struc(numGRUs))
-
- ! allocate space for the run
- iHRU = 1
- do iGRU = 1,numGRUs
- if (count(hru2gru_Id == gru_id(iGRU+startGRU-1)) < 1) then; err=20; message=trim(message)//'problem finding HRUs belonging to GRU'; return; end if
- gru_struc(iGRU)%hruCount = count(hru2gru_Id == gru_id(iGRU+startGRU-1)) ! number of HRUs in each GRU
- gru_struc(iGRU)%gru_id = gru_id(iGRU+startGRU-1) ! set gru id
- gru_struc(iGRU)%gru_nc = iGRU+startGRU-1 ! set gru index in the netcdf file
-
- allocate(gru_struc(iGRU)%hruInfo(gru_struc(iGRU)%hruCount)) ! allocate second level of gru to hru map
- gru_struc(iGRU)%hruInfo(:)%hru_nc = pack(hru_ix,hru2gru_id == gru_struc(iGRU)%gru_id) ! set hru id in attributes netcdf file
- gru_struc(iGRU)%hruInfo(:)%hru_ix = arth(iHRU,1,gru_struc(iGRU)%hruCount) ! set index of hru in run domain
- gru_struc(iGRU)%hruInfo(:)%hru_id = hru_id(gru_struc(iGRU)%hruInfo(:)%hru_nc) ! set id of hru
- iHRU = iHRU + gru_struc(iGRU)%hruCount
- end do ! iGRU = 1,nGRU
-
- ! set hru to gru mapping
- numHRUs = sum(gru_struc%hruCount) ! Total number of HRUs
- allocate(index_map(numHRUs)) ! allocate first level of hru to gru mapping
-
- do iGRU = 1, numGRUs
- index_map(gru_struc(iGRU)%hruInfo(:)%hru_ix)%gru_ix = iGRU ! index of gru in run domain to which the hru belongs
- index_map(gru_struc(iGRU)%hruInfo(:)%hru_ix)%localHRU_ix = hru_ix(1:gru_struc(iGRU)%hruCount)! index of hru within the gru
- end do ! iGRU =1, numGRUs
-
-
- deallocate(gru_id, hru_ix, hru_id, hru2gru_id)
- ! close netcdf file
- call nc_file_close(ncID,err,cmessage)
- if (err/=0) then; message=trim(message)//trim(cmessage); return; end if
-
-end subroutine read_dimension
-
-end module read_attrb_module
diff --git a/build/source/hookup/summaFileManager.f90 b/build/source/hookup/summaFileManager.f90
deleted file mode 100755
index 161e8496a1cd77750b0d057fdff936e21647ffb9..0000000000000000000000000000000000000000
--- a/build/source/hookup/summaFileManager.f90
+++ /dev/null
@@ -1,183 +0,0 @@
-! SUMMA - Structure for Unifying Multiple Modeling Alternatives
-! Copyright (C) 2014-2020 NCAR/RAL; University of Saskatchewan; University of Washington
-!
-! This file is part of SUMMA
-!
-! For more information see: http://www.ral.ucar.edu/projects/summa
-!
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-!******************************************************************
-! Original version based on:
-! (C) Copyright 2009-2010 --- Dmitri Kavetski and Martyn Clark --- All rights reserved
-!******************************************************************
-MODULE summaFileManager
- USE, intrinsic :: iso_c_binding
- use nrtype
- implicit none
- public
- ! summa-wide pathlength
- integer(i4b),parameter :: summaPathLen=4096
- ! defines the time of the run
- CHARACTER(LEN=summaPathLen) :: CONTROL_VRS = 'SUMMA_FILE_MANAGER_V3.0.0' ! control version
- CHARACTER(LEN=summaPathLen) :: SIM_START_TM = '2000-01-01 00:00' ! simulation start time
- CHARACTER(LEN=summaPathLen) :: SIM_END_TM = '2000-01-01 00:00' ! simulation end time
- CHARACTER(LEN=summaPathLen) :: NC_TIME_ZONE = 'utcTime' ! time zone info
- ! defines the path for data files (and default values)
- CHARACTER(LEN=summaPathLen) :: SETTINGS_PATH = 'settings/' ! settings dir path
- CHARACTER(LEN=summaPathLen) :: STATE_PATH = '' ! state file / init. cond. dir path (if omitted, defaults
- ! to SETTINGS_PATH for input, OUTPATH for output)
- CHARACTER(LEN=summaPathLen) :: FORCING_PATH = 'forcing/default/' ! input_dir_path
- CHARACTER(LEN=summaPathLen) :: OUTPUT_PATH = 'output/default/' ! output_dir_path
- ! define name of control files (and default values)
- CHARACTER(LEN=summaPathLen) :: M_DECISIONS = 'summa_zDecisions.txt' ! definition of model decisions
- CHARACTER(LEN=summaPathLen) :: OUTPUT_CONTROL = 'summa_zLocalModelVarMeta.txt' ! metadata for model variables
- CHARACTER(LEN=summaPathLen) :: LOCAL_ATTRIBUTES = 'summa_zLocalAttributes.txt' ! local attributes
- CHARACTER(LEN=summaPathLen) :: LOCALPARAM_INFO = 'summa_zLocalParamInfo.txt' ! default values and constraints for local model parameters
- CHARACTER(LEN=summaPathLen) :: BASINPARAM_INFO = 'summa_zBasinParamInfo.txt' ! default values and constraints for basin model parameters
- CHARACTER(LEN=summaPathLen) :: VEGPARM = 'VEGPARM.TBL' ! noah vegetation parameter table
- CHARACTER(LEN=summaPathLen) :: SOILPARM = 'SOILPARM.TBL' ! noah soil parameter table
- CHARACTER(LEN=summaPathLen) :: GENPARM = 'GENPARM.TBL' ! noah general parameter table
- CHARACTER(LEN=summaPathLen) :: MPTABLE = 'MPTABLE.TBL' ! noah mp parameter table
- CHARACTER(LEN=summaPathLen) :: FORCING_FILELIST = 'summa_zForcingFileList.txt' ! list of focing files for each HRU
- CHARACTER(LEN=summaPathLen) :: MODEL_INITCOND = 'summa_zInitialCond.txt' ! model initial conditions
- CHARACTER(LEN=summaPathLen) :: PARAMETER_TRIAL = 'summa_zParamTrial.txt' ! trial values for model parameters
- CHARACTER(LEN=summaPathLen) :: OUTPUT_PREFIX = 'summa_output_' ! prefix for the output file
-
- contains
-
-! **************************************************************************************************
-! public subroutine summa_SetTimesDirsAndFiles: Sets times, directories and filenames for summa run
-! **************************************************************************************************
-subroutine summa_SetTimesDirsAndFiles(file_manager,err) bind(C, name="setTimesDirsAndFiles")
- ! Purpose: Sets run times, directories and filenames for summa.
- ! ---
- USE ascii_util_module,only:file_open ! function to open file
- USE ascii_util_module,only:linewidth ! max character number for one line
- USE ascii_util_module,only:get_vlines ! function to get a vector of non-comment lines
-
- USE cppwrap_auxiliary,only:c_f_string
-
-
- implicit none
-
- ! input/output vars
- character(kind=c_char,len=1),intent(in) :: file_manager
- integer(c_int),intent(out) :: err
- ! local vars
- character(len=256) :: summaFileManagerIn
- character(len=256) :: message
- character(*),parameter :: summaFileManagerHeader='SUMMA_FILE_MANAGER_V3.0.0'
- integer(i4b),parameter :: runinfo_fileunit=67 ! file unit for run time information
- character(len=8) :: cdate
- character(len=10) :: ctime
- character(len=256) :: cmessage ! error message for downwind routine
- integer(i4b) :: unt ! file unit (free unit output from file_open)
- character(LEN=linewidth),allocatable :: charline(:) ! vector of character strings
- integer(i4b) :: iControl, nControl ! number of model info
- character(len=summaPathLen) :: varEntry ! name of model info
- character(len=32) :: option ! option for model info
-
- err=0; message="summa_SetTimesDirsAndFiles/"
-
- call c_f_string(file_manager, summaFileManagerIn, 256)
- summaFileManagerIn = trim(summaFileManagerIn)
-
-
- ! read information from model control file, and populate model control structure
- ! populates global control information structure
-
- ! open file, read non-comment lines, close file
- call file_open(trim(summaFileManagerIn),unt,err,cmessage)
- if(err/=0) then
- message=trim(message)//trim(cmessage)//"/Failed to open control file [''"//trim(summaFileManagerIn)//"']"
- print*, message
- err=-10
- return
- end if
- call get_vlines(unt,charline,err,cmessage) ! 'charline' is a list of strings from non-comment lines
- if(err/=0) then
- message=trim(message)//trim(cmessage)//"/Control file read issue in get_vlines()"
- print*, message
- return
- end if
- close(unt)
-
- ! get the number of model control file entries
- nControl = size(charline)
-
- ! populate the model control info structure
- do iControl=1,nControl
- ! extract name of decision and the decision selected
- read(charline(iControl),*,iostat=err) option, varEntry
- if (err/=0) then
- err=30; message=trim(message)//"error reading charline array";
- print*, message
- return
- end if
- ! get the index of the control file entry in the data structure
-
- ! assign entries from control file to module public variables; add checking as needed
- select case(trim(option))
- case('controlVersion' );
- CONTROL_VRS = trim(varEntry);
- if(trim(varEntry)/=trim(summaFileManagerHeader)) then
- message=trim(message)//"unknown control file version in '"//trim(summaFileManagerIn)//" looking for "//trim(summaFileManagerHeader)
- err=20
- return
- end if
- case('simStartTime' ); SIM_START_TM = trim(varEntry) ! start simulation time
- case('simEndTime' ); SIM_END_TM = trim(varEntry) ! end simulation time
- case('tmZoneInfo' ); NC_TIME_ZONE = trim(varEntry) ! time zone info
- case('settingsPath' ); SETTINGS_PATH = trim(varEntry) ! settings directory
- case('forcingPath' ); FORCING_PATH = trim(varEntry) ! input forcing directory
- case('outputPath' ); OUTPUT_PATH = trim(varEntry) ! output directory
- case('statePath' ); STATE_PATH = trim(varEntry) ! state file input/output directory
- case('decisionsFile' ); M_DECISIONS = trim(varEntry) ! model decisions file
- case('outputControlFile' ); OUTPUT_CONTROL = trim(varEntry) ! output control file
- case('globalHruParamFile' ); LOCALPARAM_INFO = trim(varEntry) ! default/global hru-level param file
- case('globalGruParamFile' ); BASINPARAM_INFO = trim(varEntry) ! default/global gru-level param file
- case('attributeFile' ); LOCAL_ATTRIBUTES = trim(varEntry) ! attribute file
- case('trialParamFile' ); PARAMETER_TRIAL = trim(varEntry) ! trial parameters file (hru and/or gru)
- case('vegTableFile' ); VEGPARM = trim(varEntry) ! vegetation parameter table
- case('soilTableFile' ); SOILPARM = trim(varEntry) ! soil parameter table
- case('generalTableFile' ); GENPARM = trim(varEntry) ! general parameter table
- case('noahmpTableFile' ); MPTABLE = trim(varEntry) ! noah mp parameter table
- case('forcingListFile' ); FORCING_FILELIST = trim(varEntry) ! file listing forcing filenames
- case('initConditionFile' ); MODEL_INITCOND = trim(varEntry) ! initial conditions file (cold State)
- case('outFilePrefix' ); OUTPUT_PREFIX = trim(varEntry) ! filename root for output files
- ! get to here if cannot find the variable
- case default
- err=10
- message=trim(message)//"unknown control file option: "//trim(option)
- print*, message
- return
- end select
- end do
-
- ! before embarking on a run, check that the output directory is writable; write system date and time to a log file there
- open(runinfo_fileunit,file=trim(OUTPUT_PATH)//"runinfo.txt",iostat=err)
- if(err/=0)then
- err=10; message=trim(message)//"cannot write to output directory '"//trim(OUTPUT_PATH)//"'"
- print*, message
- return
- end if
- call date_and_time(cdate,ctime)
- write(runinfo_fileunit,*) 'Run start time on system: ccyy='//cdate(1:4)//' - mm='//cdate(5:6)//' - dd='//cdate(7:8), &
- ' - hh='//ctime(1:2)//' - mi='//ctime(3:4)//' - ss='//ctime(5:10)
- close(runinfo_fileunit)
-
-end subroutine summa_SetTimesDirsAndFiles
-
-END MODULE summaFileManager
diff --git a/build/source/netcdf/def_output.f90 b/build/source/netcdf/def_output.f90
index 97f9328a9d542c816827ac8c416f1714601ea4af..73df9a12f8ce3d9a852e4ea79c3d5a71b9546876 100755
--- a/build/source/netcdf/def_output.f90
+++ b/build/source/netcdf/def_output.f90
@@ -18,9 +18,8 @@
! You should have received a copy of the GNU General Public License
! along with this program. If not, see <http://www.gnu.org/licenses/>.
-module def_output_module
+module def_output_actors_module
-USE, intrinsic :: iso_c_binding
USE data_types,only:var_i,netcdf_gru_actor_info
USE netcdf
USE netcdf_util_module,only:netcdf_err ! netcdf error handling function
@@ -72,7 +71,7 @@ contains
! **********************************************************************************************************
! public subroutine def_output: define model output file
! **********************************************************************************************************
-subroutine def_output(handle_ncid,startGRU,nGRU,nHRU,actor_info,err) bind(C, name='def_output')
+subroutine def_output(ncid,startGRU,nGRU,nHRU,actor_info,err,message)
USE globalData,only:structInfo ! information on the data structures
USE globalData,only:forc_meta,attr_meta,type_meta ! metaData structures
USE globalData,only:prog_meta,diag_meta,flux_meta,deriv_meta ! metaData structures
@@ -93,22 +92,19 @@ subroutine def_output(handle_ncid,startGRU,nGRU,nHRU,actor_info,err) bind(C, nam
USE globalData,only:outputTimeStep ! output time step
! ---------------------------------------------------------------------------------------
- ! * variables from C++
+ ! * Dummy Variables
! ---------------------------------------------------------------------------------------
- type(c_ptr),intent(in), value :: handle_ncid ! ncid of the output file
- integer(c_int),intent(in) :: startGRU ! startGRU for the entire job (for file creation)
- integer(c_int),intent(in) :: nGRU ! number of GRUs
- integer(c_int),intent(in) :: nHRU ! number of HRUs
+ type(var_i),pointer :: ncid ! id of output file
+ integer(i4b),intent(in) :: startGRU ! startGRU for the entire job (for file creation)
+ integer(i4b),intent(in) :: nGRU ! number of GRUs
+ integer(i4b),intent(in) :: nHRU ! number of HRUs
type(netcdf_gru_actor_info),intent(out):: actor_info ! netcdf actor information
- integer(c_int),intent(out) :: err ! error code
- ! ---------------------------------------------------------------------------------------
- ! * Fortran Variables For Conversion
- ! ---------------------------------------------------------------------------------------
- type(var_i),pointer :: ncid ! id of output file
+ character(*),intent(out) :: message ! error message
+ integer(i4b),intent(out) :: err ! error code
+
! ---------------------------------------------------------------------------------------
! * Local Subroutine Variables
! ---------------------------------------------------------------------------------------
- character(len=256) :: message ! error message
integer(i4b) :: ivar ! loop through model decisions
integer(i4b) :: iFreq ! loop through output frequencies
integer(i4b) :: iStruct ! loop through structure types
@@ -117,10 +113,6 @@ subroutine def_output(handle_ncid,startGRU,nGRU,nHRU,actor_info,err) bind(C, nam
integer(i4b) :: iGRU
character(LEN=256) :: startGRUString ! String Variable to convert startGRU
character(LEN=256) :: numGRUString ! String Varaible to convert numGRU
- ! ---------------------------------------------------------------------------------------
- ! * Convert From C++ to Fortran
- ! ---------------------------------------------------------------------------------------
- call c_f_pointer(handle_ncid, ncid)
! initialize errors
@@ -171,11 +163,7 @@ subroutine def_output(handle_ncid,startGRU,nGRU,nHRU,actor_info,err) bind(C, nam
fstring = get_freqName(iFreq)
fname = trim(fileout)//'_'//trim(fstring)//'.nc'
call ini_create(nGRU,nHRU,gru_struc(1)%hruInfo(1)%nSoil,trim(fname),ncid%var(iFreq),err,cmessage)
- if(err/=0)then
- message=trim(message)//trim(cmessage)
- print*, message
- return
- end if
+ if(err/=0)then; message=trim(message)//trim(cmessage); print*, message; return; end if
! define model decisions
do iVar = 1,size(model_decisions)
@@ -233,11 +221,9 @@ subroutine def_output(handle_ncid,startGRU,nGRU,nHRU,actor_info,err) bind(C, nam
err = nf90_def_var(ncid%var(iFreq),"write_output_duration",outputPrecision,(/gru_DimID/),actor_info%write_output_duration_var_id)
err = nf90_def_var(ncid%var(iFreq),"successful",nf90_int,(/gru_DimID/),actor_info%state_var_id)
err = nf90_def_var(ncid%var(iFreq),"num_attempts",nf90_int,(/gru_DimID/),actor_info%num_attempts_var_id)
- if(err/=0) then
- message=trim(message)//trim(cmessage)
- print*, message
- return
- end if
+ err = nf90_def_var(ncid%var(iFreq),"rel_tol",outputPrecision,(/gru_DimID/),actor_info%rel_tol_var_id)
+ err = nf90_def_var(ncid%var(iFreq),"abs_tol",outputPrecision,(/gru_DimID/),actor_info%abs_tol_var_id)
+ if(err/=0) then; message=trim(message)//trim(cmessage); print*, message; return; end if
end do
end subroutine def_output
@@ -549,4 +535,4 @@ subroutine ini_create(nGRU,nHRU,nSoil,infile,ncid,err,message)
end subroutine
-end module def_output_module
+end module def_output_actors_module
diff --git a/build/source/netcdf/modelwrite.f90 b/build/source/netcdf/modelwrite.f90
index 36a5900ecd0dbca7e2c43a5999361c4590b94f84..a4f45e6de0844d8132e6005d0cbc7048f42ac331 100644
--- a/build/source/netcdf/modelwrite.f90
+++ b/build/source/netcdf/modelwrite.f90
@@ -205,32 +205,21 @@ subroutine writeData(ncid, finalize_stats, output_timestep, max_layers, index_gr
! get variable index
err = nf90_inq_varid(ncid%var(iFreq),trim(meta(iVar)%varName),ncVarID)
call netcdf_err(err,message)
- if (err/=0) then
- print*, message
- return
+ if (err/=0) then; print*, message; return
endif
select type(dat)
class is(var_d)
err = nf90_put_var(ncid%var(iFreq),ncVarID,dat%var(iVar),start=(/output_timestep(iFreq)/))
call netcdf_err(err,message)
- if (err/=0) then
- print*, message
- return
- endif
+ if (err/=0) then; print*, message; return; endif
cycle
- class default
- err=20
- message=trim(message)//'time variable must be of type var_dlength (forcing data structure)'
- print*, message
- return
+ class default
+ err=20;message=trim(message)//'time variable must be of type var_dlength (forcing data structure)';print*, message;return
end select
call netcdf_err(err,message)
- if (err/=0) then
- print*, message
- return
- endif
+ if (err/=0) then; print*, message;return;endif
endif
! define the statistics index
@@ -245,17 +234,10 @@ subroutine writeData(ncid, finalize_stats, output_timestep, max_layers, index_gr
class is (var_dlength)
realVec(1) = stat%var(map(iVar))%dat(iFreq)
err = nf90_put_var(ncid%var(iFreq),meta(iVar)%ncVarID(iFreq),realVec,start=(/index_gru,output_timestep(iFreq)/),count=(/num_gru,1/))
- if (err/=0) then
- print*, message
- return
- endif
+ if (err/=0) then; print*, message; return; endif
class default
- err=20
- message=trim(message)//'stats must be scalarv and of type var_dlength'
- print*, message
- return
+ err=20; message=trim(message)//'stats must be scalarv and of type var_dlength'; print*, message; return
end select ! stat
-
else
! Write the data
@@ -366,15 +348,19 @@ subroutine writeBasin(ncid,iGRU,finalizeStats,outputTimestep,meta,stat,dat,map,e
! initialize error control
err=0;message="f-writeBasin/"
+ print*, "WE should see this"
+
! loop through output frequencies
do iFreq=1,maxvarFreq
! skip frequencies that are not needed
+ print*, "Before outputFreq"
if(.not.outFreq(iFreq)) cycle
-
+ print*, "After outputFreq"
! check that we have finalized statistics for a given frequency
+ print*, "Before stats"
if(.not.finalizeStats(iFreq)) cycle
-
+ print*, "After stats"
! loop through model variables
do iVar = 1,size(meta)
@@ -388,6 +374,7 @@ subroutine writeBasin(ncid,iGRU,finalizeStats,outputTimestep,meta,stat,dat,map,e
select case (meta(iVar)%varType)
case (iLookVarType%scalarv)
+ print*, "output", stat(map(iVar))%dat(iFreq)
err = nf90_put_var(ncid%var(iFreq),meta(iVar)%ncVarID(iFreq),(/stat(map(iVar))%dat(iFreq)/),start=(/iGRU,outputTimestep(iFreq)/),count=(/1,1/))
case (iLookVarType%routing)
diff --git a/build/source/netcdf/read_icond.f90 b/build/source/netcdf/read_icond.f90
deleted file mode 100644
index e3f3e01a8624bb56e07c9369ba7b52a024517b7a..0000000000000000000000000000000000000000
--- a/build/source/netcdf/read_icond.f90
+++ /dev/null
@@ -1,360 +0,0 @@
-! SUMMA - Structure for Unifying Multiple Modeling Alternatives
-! Copyright (C) 2014-2020 NCAR/RAL; University of Saskatchewan; University of Washington
-!
-! This file is part of SUMMA
-!
-! For more information see: http://www.ral.ucar.edu/projects/summa
-!
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-module read_icond_gru_hru_module
-USE, intrinsic :: iso_c_binding
-USE nrtype
-USE netcdf
-USE globalData,only: ixHRUfile_min,ixHRUfile_max
-USE globalData,only: nTimeDelay ! number of hours in the time delay histogram
-implicit none
-private
-public::read_icond
-public::read_icond_nlayers
-! define single HRU restart file
-integer(i4b), parameter :: singleHRU=1001
-integer(i4b), parameter :: multiHRU=1002
-integer(i4b), parameter :: restartFileType=multiHRU
-contains
-
- ! ************************************************************************************************
- ! public subroutine read_icond_nlayers: read model initial conditions file for number of snow/soil layers
- ! ************************************************************************************************
-subroutine read_icond_nlayers(nGRU,err) bind(C, name="readIcondNLayers")
- ! --------------------------------------------------------------------------------------------------------
- ! modules
- USE nrtype
- USE var_lookup,only:iLookIndex ! variable lookup structure
- USE globalData,only:gru_struc ! gru-hru mapping structures
- USE netcdf_util_module,only:nc_file_close ! close netcdf file
- USE netcdf_util_module,only:nc_file_open ! close netcdf file
- USE netcdf_util_module,only:netcdf_err ! netcdf error handling
- USE data_types,only:gru_hru_intVec ! actual data
- USE data_types,only:var_info ! metadata
-
- USE globalData,only:indx_meta
-
- ! file paths
- USE summaFileManager,only:STATE_PATH ! optional path to state/init. condition files (defaults to SETTINGS_PATH)
- USE summaFileManager,only:SETTINGS_PATH ! define path to settings files (e.g., parameters, soil and veg. tables)
- USE summaFileManager,only:MODEL_INITCOND ! name of model initial conditions file
-
- implicit none
-
- ! --------------------------------------------------------------------------------------------------------
- ! variable declarations
- ! dummies
- integer(c_int) ,intent(in) :: nGRU ! total # of GRUs in run domain
- integer(c_int) ,intent(out) :: err ! error code
-
- ! locals
- integer(i4b) :: ncID ! netcdf file id
- integer(i4b) :: dimID ! netcdf file dimension id
- integer(i4b) :: fileHRU ! number of HRUs in netcdf file
- integer(i4b) :: snowID, soilID ! netcdf variable ids
- integer(i4b) :: iGRU, iHRU ! loop indexes
- integer(i4b) :: iHRU_global ! index of HRU in the netcdf file
- integer(i4b),allocatable :: snowData(:) ! number of snow layers in all HRUs
- integer(i4b),allocatable :: soilData(:) ! number of soil layers in all HRUs
-
- character(len=256) :: iconFile ! restart file name
-
-
- character(len=256) :: message ! returned error message
- character(len=256) :: cmessage ! downstream error message
-
- ! --------------------------------------------------------------------------------------------------------
- ! initialize error message
- err=0
- message = 'read_icond_nlayers/'
-
- if(STATE_PATH == '') then
- iconFile = trim(SETTINGS_PATH)//trim(MODEL_INITCOND)
- else
- iconFile = trim(STATE_PATH)//trim(MODEL_INITCOND)
- endif
-
- ! open netcdf file
- call nc_file_open(iconFile,nf90_nowrite,ncid,err,cmessage);
- if (err/=0) then; message=trim(message)//trim(cmessage); return; end if
-
-
- ! get number of HRUs in file (the GRU variable(s), if present, are processed at the end)
- err = nf90_inq_dimid(ncID,"hru",dimId); if(err/=nf90_noerr)then; message=trim(message)//'problem finding hru dimension/'//trim(nf90_strerror(err)); return; end if
- err = nf90_inquire_dimension(ncID,dimId,len=fileHRU); if(err/=nf90_noerr)then; message=trim(message)//'problem reading hru dimension/'//trim(nf90_strerror(err)); return; end if
-
- ! allocate storage for reading from file (allocate entire file size, even when doing subdomain run)
- allocate(snowData(fileHRU))
- allocate(soilData(fileHRU))
- snowData = 0
- soilData = 0
-
- ! get netcdf ids for the variables holding number of snow and soil layers in each hru
- err = nf90_inq_varid(ncid,trim(indx_meta(iLookIndex%nSnow)%varName),snowid); call netcdf_err(err,message)
- err = nf90_inq_varid(ncid,trim(indx_meta(iLookIndex%nSoil)%varName),soilid); call netcdf_err(err,message)
-
- ! get nSnow and nSoil data (reads entire state file)
- err = nf90_get_var(ncid,snowid,snowData); call netcdf_err(err,message)
- err = nf90_get_var(ncid,soilid,soilData); call netcdf_err(err,message)
-
- ixHRUfile_min=huge(1)
- ixHRUfile_max=0
- ! find the min and max hru indices in the state file
- do iGRU = 1,nGRU
- do iHRU = 1,gru_struc(iGRU)%hruCount
- if(gru_struc(iGRU)%hruInfo(iHRU)%hru_nc < ixHRUfile_min) ixHRUfile_min = gru_struc(iGRU)%hruInfo(iHRU)%hru_nc
- if(gru_struc(iGRU)%hruInfo(iHRU)%hru_nc > ixHRUfile_max) ixHRUfile_max = gru_struc(iGRU)%hruInfo(iHRU)%hru_nc
- end do
- end do
-
-
- ! loop over grus in current run to update snow/soil layer information
- do iGRU = 1,nGRU
- do iHRU = 1,gru_struc(iGRU)%hruCount
- iHRU_global = gru_struc(iGRU)%hruInfo(iHRU)%hru_nc
-
- ! single HRU (Note: 'restartFileType' is hardwired above to multiHRU)
- if(restartFileType==singleHRU) then
- gru_struc(iGRU)%hruInfo(iHRU)%nSnow = snowData(1)
- gru_struc(iGRU)%hruInfo(iHRU)%nSoil = soilData(1)
-
- ! multi HRU
- else
- gru_struc(iGRU)%hruInfo(iHRU)%nSnow = snowData(iHRU_global)
- gru_struc(iGRU)%hruInfo(iHRU)%nSoil = soilData(iHRU_global)
- endif
-
- end do
- end do
-
-
- ! close file
- call nc_file_close(ncid,err,cmessage)
- if(err/=0)then;message=trim(message)//trim(cmessage);return;end if
-
- ! cleanup
- deallocate(snowData,soilData)
-
-end subroutine read_icond_nlayers
-
-
-! ************************************************************************************************
-! public subroutine read_icond: read model initial conditions
-! ************************************************************************************************
-subroutine read_icond(&
- indxGRU, & ! intent(in): Index of GRU in gru_struc
- indxHRU, & ! intent(in): Index of HRU in gru_struc
- mparData, & ! intent(in): model parameters
- progData, & ! intent(inout): model prognostic variables
- bvarData, & ! intent(inout): model basin (GRU) variables
- indxData, & ! intent(inout): model indices
- err,message) ! intent(out): error control
- ! --------------------------------------------------------------------------------------------------------
- ! modules
- USE nrtype
- USE var_lookup,only:iLookVarType ! variable lookup structure
- USE var_lookup,only:iLookPROG ! variable lookup structure
- USE var_lookup,only:iLookPARAM ! variable lookup structure
- USE var_lookup,only:iLookBVAR ! variable lookup structure
- USE var_lookup,only:iLookINDEX ! variable lookup structure
- USE globalData,only:prog_meta ! metadata for prognostic variables
- USE globalData,only:bvar_meta ! metadata for basin (GRU) variables
- USE globalData,only:gru_struc ! gru-hru mapping structures
- USE globaldata,only:iname_soil,iname_snow ! named variables to describe the type of layer
- USE data_types,only:var_ilength ! full integer structure
- USE data_types,only:var_dlength ! double precision structure for a single HRU
- USE data_types,only:var_info ! metadata
- USE get_ixName_module,only:get_varTypeName ! to access type strings for error messages
- USE updatState_module,only:updateSoil ! update soil states
-
- USE netcdf
-
- USE globalData,only:init_cond_prog
- USE globalData,only:init_cond_bvar
-
-
- implicit none
-
- ! --------------------------------------------------------------------------------------------------------
- ! variable declarations
- ! dummies
- integer(i4b) ,intent(in) :: indxGRU ! index of GRU in gru_struc
- integer(i4b) ,intent(in) :: indxHRU ! index of HRU in hru_struc
- type(var_dlength),intent(in) :: mparData ! model parameters
- type(var_dlength),intent(inout) :: progData ! model prognostic variables
- type(var_dlength),intent(inout) :: bvarData ! model basin (GRU) variables
- type(var_ilength),intent(inout) :: indxData ! model indices
- integer(i4b) ,intent(out) :: err ! error code
- character(*) ,intent(out) :: message ! returned error message
-
- ! locals
- character(len=256) :: cmessage ! downstream error message
- integer(i4b) :: fileHRU ! number of HRUs in file
- integer(i4b) :: fileGRU ! number of GRUs in file
- integer(i4b) :: iVar, i ! loop indices
- integer(i4b),dimension(1) :: ndx ! intermediate array of loop indices
- integer(i4b) :: dimID ! varible dimension ids
- integer(i4b) :: ncVarID ! variable ID in netcdf file
- character(256) :: dimName ! not used except as a placeholder in call to inq_dim function
- integer(i4b) :: dimLen ! data dimensions
- integer(i4b) :: ncID ! netcdf file ID
- integer(i4b) :: ixFile ! index in file
- integer(i4b) :: nSoil, nSnow, nToto ! # layers
- integer(i4b) :: nTDH ! number of points in time-delay histogram
- integer(i4b) :: iLayer,jLayer ! layer indices
- integer(i4b),parameter :: nBand=2 ! number of spectral bands
-
- character(len=32),parameter :: scalDimName ='scalarv' ! dimension name for scalar data
- character(len=32),parameter :: midSoilDimName='midSoil' ! dimension name for soil-only layers
- character(len=32),parameter :: midTotoDimName='midToto' ! dimension name for layered varaiables
- character(len=32),parameter :: ifcTotoDimName='ifcToto' ! dimension name for layered varaiables
- character(len=32),parameter :: tdhDimName ='tdh' ! dimension name for time-delay basin variables
-
- ! --------------------------------------------------------------------------------------------------------
-
- ! Start procedure here
- err=0; message="read_icondActors.f90 - read_icond/"
-
- ! loop through prognostic variables
- do iVar = 1,size(prog_meta)
-
- ! skip variables that are computed later
- if(prog_meta(iVar)%varName=='scalarCanopyWat' .or. &
- prog_meta(iVar)%varName=='spectralSnowAlbedoDiffuse' .or. &
- prog_meta(iVar)%varName=='scalarSurfaceTemp' .or. &
- prog_meta(iVar)%varName=='mLayerVolFracWat' .or. &
- prog_meta(iVar)%varName=='mLayerHeight' ) cycle
-
-
- ! get the number of layers
- nSnow = gru_struc(indxGRU)%hruInfo(indxHRU)%nSnow
- nSoil = gru_struc(indxGRU)%hruInfo(indxHRU)%nSoil
- nToto = nSnow + nSoil
-
- ! put the data into data structures and check that none of the values are set to nf90_fill_double
- select case (prog_meta(iVar)%varType)
- case (iLookVarType%scalarv)
- progData%var(iVar)%dat(1) = init_cond_prog(iVar)%var_data(indxGRU,1)
- if(abs(progData%var(iVar)%dat(1) - nf90_fill_double) < epsilon(init_cond_prog(iVar)%var_data))then; err=20; endif
- case (iLookVarType%midSoil)
- progData%var(iVar)%dat(1:nSoil) = init_cond_prog(iVar)%var_data(indxGRU,1:nSoil)
- if(any(abs(progData%var(iVar)%dat(1:nSoil) - nf90_fill_double) < epsilon(init_cond_prog(iVar)%var_data)))then; err=20; endif
- case (iLookVarType%midToto)
- progData%var(iVar)%dat(1:nToto) = init_cond_prog(iVar)%var_data(indxGRU,1:nToto)
- if(any(abs(progData%var(iVar)%dat(1:nToto) - nf90_fill_double) < epsilon(init_cond_prog(iVar)%var_data)))then; err=20; endif
- case (iLookVarType%ifcToto)
- progData%var(iVar)%dat(0:nToto) = init_cond_prog(iVar)%var_data(indxGRU,1:nToto+1)
- if(any(abs(progData%var(iVar)%dat(0:nToto) - nf90_fill_double) < epsilon(init_cond_prog(iVar)%var_data)))then; err=20; endif
- case default
- message=trim(message)//"unexpectedVariableType[name='"//trim(prog_meta(iVar)%varName)//"';type='"//trim(get_varTypeName(prog_meta(iVar)%varType))//"']"
- print*,message
- err=20; return
- end select
-
- if(err==20)then;
- message=trim(message)//"data set to the fill value (name='"//trim(prog_meta(iVar)%varName)//"')";
- print*, message
- return;
- endif
-
- ! fix the snow albedo
- if(progData%var(iLookPROG%scalarSnowAlbedo)%dat(1) < 0._dp)then
- progData%var(iLookPROG%scalarSnowAlbedo)%dat(1) = mparData%var(iLookPARAM%albedoMax)%dat(1)
- endif
-
- ! make sure canopy water is positive
- if(progData%var(iLookPROG%scalarCanopyliq)%dat(1) < 0.0001_rkind)then
- progData%var(iLookPROG%scalarCanopyliq)%dat(1) = 0.0001_rkind
- endif
-
- ! initialize the spectral albedo
- progData%var(iLookPROG%spectralSnowAlbedoDiffuse)%dat(1:nBand) = progData%var(iLookPROG%scalarSnowAlbedo)%dat(1)
-
- end do ! end looping through prognostic variables (iVar)
-
- ! --------------------------------------------------------------------------------------------------------
- ! (2) set number of layers
- ! --------------------------------------------------------------------------------------------------------
-
- ! save the number of layers
- indxData%var(iLookINDEX%nSnow)%dat(1) = gru_struc(indxGRU)%hruInfo(indxHRU)%nSnow
- indxData%var(iLookINDEX%nSoil)%dat(1) = gru_struc(indxGRU)%hruInfo(indxHRU)%nSoil
- indxData%var(iLookINDEX%nLayers)%dat(1) = gru_struc(indxGRU)%hruInfo(indxHRU)%nSnow + gru_struc(indxGRU)%hruInfo(indxHRU)%nSoil
-
- ! set layer type
- indxData%var(iLookINDEX%layerType)%dat(1:gru_struc(indxGRU)%hruInfo(indxHRU)%nSnow) = iname_snow
- indxData%var(iLookINDEX%layerType)%dat((gru_struc(indxGRU)%hruInfo(indxHRU)%nSnow+1):(gru_struc(indxGRU)%hruInfo(indxHRU)%nSnow+gru_struc(indxGRU)%hruInfo(indxHRU)%nSoil)) = iname_soil
-
-
- ! --------------------------------------------------------------------------------------------------------
- ! (3) update soil layers (diagnostic variables)
- ! --------------------------------------------------------------------------------------------------------
- ! loop through soil layers
- do iLayer = 1,indxData%var(iLookINDEX%nSoil)%dat(1)
-
- ! get layer in the total vector
- jLayer = iLayer+indxData%var(iLookINDEX%nSnow)%dat(1)
-
- ! update soil layers
- call updateSoil(&
- ! input
- progData%var(iLookPROG%mLayerTemp )%dat(jLayer),& ! intent(in): temperature vector (K)
- progData%var(iLookPROG%mLayerMatricHead )%dat(iLayer),& ! intent(in): matric head (m)
- mparData%var(iLookPARAM%vGn_alpha )%dat(iLayer),& ! intent(in): van Genutchen "alpha" parameter
- mparData%var(iLookPARAM%vGn_n )%dat(iLayer),& ! intent(in): van Genutchen "n" parameter
- mparData%var(iLookPARAM%theta_sat )%dat(iLayer),& ! intent(in): soil porosity (-)
- mparData%var(iLookPARAM%theta_res )%dat(iLayer),& ! intent(in): soil residual volumetric water content (-)
- 1._dp - 1._dp/mparData%var(iLookPARAM%vGn_n)%dat(iLayer),& ! intent(in): van Genutchen "m" parameter (-)
- ! output
- progData%var(iLookPROG%mLayerVolFracWat )%dat(jLayer),& ! intent(out): volumetric fraction of total water (-)
- progData%var(iLookPROG%mLayerVolFracLiq )%dat(jLayer),& ! intent(out): volumetric fraction of liquid water (-)
- progData%var(iLookPROG%mLayerVolFracIce )%dat(jLayer),& ! intent(out): volumetric fraction of ice (-)
- err,message) ! intent(out): error control
- if (err/=0) then; message=trim(message)//trim(cmessage); return; end if
-
- end do ! looping through soil layers
-
- ! --------------------------------------------------------------------------------------------------------
- ! (2) now get the basin variable(s)
- ! --------------------------------------------------------------------------------------------------------
-
- ! get the index in the file: single HRU
- if(allocated(init_cond_bvar))then
-
- ! loop through specific basin variables (currently 1 but loop provided to enable inclusion of others)
- ndx = (/iLookBVAR%routingRunoffFuture/) ! array of desired variable indices
- do i = 1,size(ndx)
- iVar = ndx(i)
-
- ! store data in basin var (bvar) structure
-
- ! put the data into data structures
- bvarData%var(iVar)%dat(1:nTDH) = init_cond_bvar(i)%var_data(indxGRU,1:nTDH)
- ! check whether the first values is set to nf90_fill_double
- if(any(abs(bvarData%var(iVar)%dat(1:nTDH) - nf90_fill_double) < epsilon(init_cond_bvar(i)%var_data)))then; err=20; endif
- if(err==20)then; message=trim(message)//"data set to the fill value (name='"//trim(bvar_meta(iVar)%varName)//"')"; return; endif
-
- end do ! end looping through basin variables
- endif ! end if case for not being a singleHRU run - gaurded by the structure not being allocated
-
-
-end subroutine read_icond
-
-end module read_icond_gru_hru_module
diff --git a/build/source/testing/class_vs_actor/Makefile b/build/source/testing/class_vs_actor/Makefile
new file mode 100644
index 0000000000000000000000000000000000000000..5f79edbe63dd59c40dad811f918c339231f82431
--- /dev/null
+++ b/build/source/testing/class_vs_actor/Makefile
@@ -0,0 +1,19 @@
+CC = g++ # C++
+INCLUDES=-I/usr/local/include
+LIBRARIES=-L/usr/local/lib -lcaf_core -lcaf_io
+FLAGS = -g -O3 -Wfatal-errors -std=c++17
+
+GRU_CLASS_INCLUDES = -I/u1/kck540/Projects/hydrology/Summa-Sundials-Actors/Summa-Actors/build/includes/job_actor/
+GRU_CLASS_SOURCE =/u1/kck540/Projects/hydrology/Summa-Sundials-Actors/Summa-Actors/build/source/actors/job_actor/GRU.cpp
+
+
+all: compile link clean
+
+compile:
+ $(CC) $(FLAGS) -c main.cpp $(INCLUDES) $(GRU_CLASS_INCLUDES) $(GRU_CLASS_SOURCE)
+
+link:
+ $(CC) $(FLAGS) -Wl,-rpath='/usr/local/lib' -o main *.o $(LIBRARIES)
+
+clean:
+ rm *.o
\ No newline at end of file
diff --git a/build/source/testing/class_vs_actor/README.md b/build/source/testing/class_vs_actor/README.md
new file mode 100644
index 0000000000000000000000000000000000000000..522b1b5459406e5ffb94ffd6a984a7b1b7b3eaad
--- /dev/null
+++ b/build/source/testing/class_vs_actor/README.md
@@ -0,0 +1,11 @@
+Test to investigate if calling an actor for the information we want is faster than calling a class for the same information.
+
+We will use the GRU class as the example:
+
+When running with 10000 GRUs:
+- Actor time = 1.4335s
+- Class time = 0.2429s
+
+When running with 100000 GRUs:
+- Actor time = 14.7135s
+- Class time = 2.074549s
diff --git a/build/source/testing/class_vs_actor/main.cpp b/build/source/testing/class_vs_actor/main.cpp
new file mode 100644
index 0000000000000000000000000000000000000000..d9ecf6144244849e44ef970e385e787e1aec55eb
--- /dev/null
+++ b/build/source/testing/class_vs_actor/main.cpp
@@ -0,0 +1,135 @@
+#include "caf/all.hpp"
+#include "GRU.hpp"
+#include <chrono>
+
+
+using namespace caf;
+CAF_BEGIN_TYPE_ID_BLOCK(summa_test, first_custom_type_id)
+ CAF_ADD_ATOM(summa_test, start_gru)
+ CAF_ADD_ATOM(summa_test, get_info)
+ CAF_ADD_TYPE_ID(summa_test, (std::tuple<int, int, double, double, double, double, double>))
+CAF_END_TYPE_ID_BLOCK(summa_test)
+
+struct gru_state_test {
+ int global_gru_index;
+ int local_gru_index;
+ int dt_init_factor;
+ int attempts_left;
+ double run_time;
+ double init_duration;
+ double forcing_duration;
+ double run_physics_duration;
+ double write_output_duration;
+};
+
+
+behavior gru_actor(stateful_actor<gru_state_test>* self, int global_gru_index, int local_gru_index) {
+ self->state.global_gru_index = global_gru_index;
+ self->state.local_gru_index = local_gru_index;
+ self->state.run_time = 0.0;
+ self->state.init_duration = 0.0;
+ self->state.forcing_duration = 0.0;
+ self->state.run_physics_duration = 0.0;
+ self->state.write_output_duration = 0.0;
+
+ return {
+ [=](get_info) {
+
+ return std::make_tuple(self->state.global_gru_index,
+ self->state.local_gru_index,
+ self->state.run_time,
+ self->state.init_duration,
+ self->state.forcing_duration,
+ self->state.run_physics_duration,
+ self->state.write_output_duration);
+ },
+
+ };
+
+}
+
+
+
+
+void caf_main(actor_system& sys) {
+ scoped_actor self{sys};
+ int num_actors = 100000;
+
+ auto gru_list = std::vector<actor>{};
+ auto container_list = std::vector<GRU*>{};
+
+ for (int i = 0; i < num_actors; ++i) {
+ gru_list.push_back(sys.spawn(gru_actor, i, i));
+
+ container_list.push_back(new GRU(i, i, gru_list[i], 1, 1));
+
+ }
+
+ // Retreive the information from the GRU actors
+
+ std::chrono::time_point<std::chrono::system_clock> actor_start, actor_end;
+
+ actor_start = std::chrono::system_clock::now();
+ for (auto& actor : gru_list) {
+ self->request(actor, infinite, get_info_v).receive(
+ [&](std::tuple<int, int, double, double, double, double, double> info) {
+ // aout(self) << "Recieved\n";
+ int global_gru_index = std::get<0>(info);
+ int local_gru_index = std::get<1>(info);
+ double run_time = std::get<2>(info);
+ double init_duration = std::get<3>(info);
+ double forcing_duration = std::get<4>(info);
+ double run_physics_duration = std::get<5>(info);
+ double write_output_duration = std::get<6>(info);
+
+ aout(self) << "global_gru_index = " << global_gru_index
+ << "local_gru_index = " << local_gru_index
+ << "run_time = " << run_time
+ << "init_duration = " << init_duration
+ << "forcing_duration = " << forcing_duration
+ << "run_physics_duration = " << run_physics_duration
+ << "write_output_duration = " << write_output_duration << "\n";
+
+ self->send_exit(actor, exit_reason::user_shutdown);
+ },
+ [&](error& err) {
+ aout(self) << to_string(err) << std::endl;
+ });
+ }
+ actor_end = std::chrono::system_clock::now();
+
+ std::chrono::time_point<std::chrono::system_clock> class_start, class_end;
+
+ class_start = std::chrono::system_clock::now();
+ for(auto& gru : container_list) {
+ int global_gru_index = gru->getGlobalGRUIndex();
+ int local_gru_index = gru->getLocalGRUIndex();
+ double run_time = gru->getRunTime();
+ double init_duration = gru->getInitDuration();
+ double forcing_duration = gru->getForcingDuration();
+ double run_physics_duration = gru->getRunPhysicsDuration();
+ double write_output_duration = gru->getWriteOutputDuration();
+
+ aout(self) << "global_gru_index = " << global_gru_index
+ << "local_gru_index = " << local_gru_index
+ << "run_time = " << run_time
+ << "init_duration = " << init_duration
+ << "forcing_duration = " << forcing_duration
+ << "run_physics_duration = " << run_physics_duration
+ << "write_output_duration = " << write_output_duration << "\n";
+ delete gru;
+ }
+ class_end = std::chrono::system_clock::now();
+
+ std::chrono::duration<double> elapsed_seconds_actor = actor_end - actor_start;
+ aout(self) << "Actor Elapsed time: " << elapsed_seconds_actor.count() << "s\n";
+
+ std::chrono::duration<double> elapsed_seconds_class = class_end - class_start;
+ aout(self) << "Class Elapsed time: " << elapsed_seconds_class.count() << "s\n";
+
+
+
+
+}
+
+CAF_MAIN(id_block::summa_test)
\ No newline at end of file
diff --git a/utils/build_scripts/build_actors.sh b/utils/build_scripts/build_actors.sh
new file mode 100755
index 0000000000000000000000000000000000000000..df3b1a7a911d1e524eae77dd68d87d45b8d408c7
--- /dev/null
+++ b/utils/build_scripts/build_actors.sh
@@ -0,0 +1,15 @@
+#!/bin/bash
+
+# build on Mac, from cmake directory run this as ./build_actors.mac.bash
+
+# Mac Example using MacPorts:
+export FC=gfortran # Fortran compiler family
+export LINK_DIRS='/usr/local/lib;/usr/lib' # Link directories for cmake
+export INCLUDES_DIRS='/usr/local/include;/usr/include' # directories for INCLUDES cmake variable (cmake uses semicolons as separators)
+export LIBRARY_LINKS='-llapack;-lgfortran;-lnetcdff;-lnetcdf' # list of library links (cmake uses semicolons as separators)
+#export FLAGS_OPT="-flto=1" # -flto=1 is slow to compile, but might want to use
+
+export SUNDIALS_PATH="/usr/local/sundials/v6.6"
+export ACTOR_FRAMEWORK_PATH="/usr/local"
+cmake -B ../cmake_build -S . -DCMAKE_BUILD_TYPE=Sundials_Actors_Debug
+cmake --build ../cmake_build --target all
diff --git a/utils/build_scripts/build_cluster.bash b/utils/build_scripts/build_cluster.bash
new file mode 100755
index 0000000000000000000000000000000000000000..19e63063079e788342297f366fae8375c8bdbd05
--- /dev/null
+++ b/utils/build_scripts/build_cluster.bash
@@ -0,0 +1,14 @@
+#!/bin/bash
+
+# build on Copernicus or Graham, from cmake directory run this as ./build_actors.cluster.bash
+# for Summa
+module load gcc/9.3.0
+module load netcdf-fortran
+module load openblas
+module load caf
+
+export SUNDIALS_PATH="/globalhome/kck540/HPC/Libraries/sundials/instdir"
+
+cmake -B ../cmake_build -S . -DCMAKE_BUILD_TYPE=Actors_Sundials_Cluster
+cmake --build ../cmake_build --target all
+
diff --git a/utils/containers/apptainer.def b/utils/containers/apptainer.def
new file mode 100644
index 0000000000000000000000000000000000000000..aa1f124096ac21f42cfc8536cd2eb65bf113f07a
--- /dev/null
+++ b/utils/containers/apptainer.def
@@ -0,0 +1,49 @@
+Bootstrap: docker
+From: ubuntu:22.04
+
+%post
+ apt-get update -y
+ apt-get install locales -y
+ locale-gen en_CA.UTF-8
+ apt-get upgrade -y
+
+ # Install dependencies
+ DEBIAN_FRONTEND="noninteractive" apt-get install -y software-properties-common \
+ libnetcdf-dev \
+ libnetcdff-dev \
+ liblapack-dev \
+ libopenblas-dev \
+ cmake \
+ g++ \
+ git \
+ libssl-dev \
+ make \
+ gfortran \
+ wget \
+ python3-pip \
+ valgrind \
+ gdb &&\
+ apt-get autoclean
+
+ # Install Sundials v6.6
+ cd /opt
+ wget https://github.com/LLNL/sundials/releases/download/v6.6.0/sundials-6.6.0.tar.gz
+ tar -xzf sundials-6.6.0.tar.gz
+ mkdir /usr/local/sundials/
+ mkdir /usr/local/sundials/v6.6
+ cd sundials-6.6.0
+ mkdir build
+ cd build
+ cmake .. -DBUILD_FORTRAN_MODULE_INTERFACE=ON -DCMAKE_Fortran_COMPILER=gfortran -DCMAKE_INSTALL_PREFIX=/usr/local/sundials/v6.6 -DEXAMPLES_INSTALL_PATH=/usr/local/sundials/v6.6/examples
+ make
+ make install
+
+ # Install C++ Actor Framework
+ cd /opt
+ wget https://github.com/actor-framework/actor-framework/archive/refs/tags/0.18.6.tar.gz
+ tar -xzf 0.18.6.tar.gz
+ cd actor-framework-0.18.6
+ ./configure
+ cd build
+ make
+ make install
\ No newline at end of file