From fe69fe8efacfb5a3a352d599ab503942bf122995 Mon Sep 17 00:00:00 2001
From: KyleKlenk <kyle.c.klenk@gmail.com>
Date: Wed, 13 Apr 2022 14:06:34 -0600
Subject: [PATCH] Made changes to output File Creation and Parameter Writing No
more booleans are requried to ensure files have been created and HRUs have
had their pamarameters written
---
build/source/actors/FileAccessActor.h | 110 ++--
build/source/actors/HRUActor.h | 18 +-
build/source/actors/messageAtoms.h | 1 +
build/source/dshare/data_types.f90 | 3 -
build/source/engine/alloc_file_access.f90 | 562 +++++++++---------
.../file_access_actor/cppwrap_fileAccess.f90 | 175 ++++--
.../deallocateOutputStruc.f90 | 2 -
.../fileAccess_subroutine_wrappers.h | 8 +-
.../file_access_actor/initOutputStruc.f90 | 13 -
.../interface/hru_actor/cppwrap_hru.f90 | 65 +-
.../hru_actor/hru_subroutine_wrappers.h | 5 +
build/source/netcdf/outputStrucWrite.f90 | 30 +-
utils/netcdf/compareOutput.py | 6 +-
13 files changed, 574 insertions(+), 424 deletions(-)
diff --git a/build/source/actors/FileAccessActor.h b/build/source/actors/FileAccessActor.h
index 387728f..d805659 100644
--- a/build/source/actors/FileAccessActor.h
+++ b/build/source/actors/FileAccessActor.h
@@ -8,7 +8,6 @@ void initalizeFileAccessActor(stateful_actor<file_access_state>* self);
int writeOutput(stateful_actor<file_access_state>* self, int indxGRU, int indxHRU, int numStepsToWrite);
int readForcing(stateful_actor<file_access_state>* self, int currentFile);
-
behavior file_access_actor(stateful_actor<file_access_state>* self, int startGRU, int numGRU,
int outputStrucSize, actor parent) {
// Set File_Access_Actor variables
@@ -24,46 +23,79 @@ behavior file_access_actor(stateful_actor<file_access_state>* self, int startGRU
&self->state.numGRU, &self->state.err);
},
- [=](access_forcing, int currentFile, caf::actor refToRespondTo) {
+ [=](write_param, int indxGRU, int indxHRU) {
int err;
- // Check if this file is greater than what we expect
- if (currentFile > self->state.numFiles) {
- aout(self) << "\nERROR: FILE_ACCESS_ACTOR - Current File is Larger than the Number of Files\n";
- } else {
-
- err = readForcing(self, currentFile);
- if (err != 0)
- aout(self) << "\nERROR: FILE_ACCESS_ACTOR - READING_FORCING FAILED\n";
-
+ err = 0;
+ Write_HRU_Param(self->state.handle_ncid, &indxGRU, &indxHRU, &err);
+ if (err != 0) {
+ aout(self) << "ERROR: Write_HRU_PARAM -- For HRU = " << indxHRU << "\n";
}
+ },
- // Check if we have loaded all forcing files, if no read more data
- if(self->state.filesLoaded != self->state.numFiles) {
- self->send(self, access_forcing_internal_v, currentFile + 1);
+ [=](access_forcing, int currentFile, caf::actor refToRespondTo) {
+ // aout(self) << "Received Current FIle = " << currentFile << std::endl;
+ if (currentFile <= self->state.numFiles) {
+ if(self->state.forcFileList[currentFile - 1].isFileLoaded()) { // C++ starts at 0 Fortran starts at 1
+ // aout(self) << "ForcingFile Already Loaded \n";
+ self->send(refToRespondTo, run_hru_v,
+ self->state.forcFileList[currentFile - 1].getNumSteps());
+
+ } else {
+ self->state.readStart = std::chrono::high_resolution_clock::now();
+
+ // Load the file
+ FileAccessActor_ReadForcing(self->state.handle_forcFileInfo, ¤tFile,
+ &self->state.stepsInCurrentFile, &self->state.startGRU,
+ &self->state.numGRU, &self->state.err);
+ if (self->state.err != 0) {
+ aout(self) << "ERROR: Reading Forcing" << std::endl;
+ }
+ self->state.filesLoaded += 1;
+ self->state.forcFileList[currentFile - 1].updateNumSteps(self->state.stepsInCurrentFile);
+
+ self->state.readEnd = std::chrono::high_resolution_clock::now();
+ self->state.readDuration += calculateTime(self->state.readStart, self->state.readEnd);
+ // Check if we have loaded all forcing files
+ if(self->state.filesLoaded <= self->state.numFiles) {
+ self->send(self, access_forcing_internal_v, currentFile + 1);
+ }
+
+ self->send(refToRespondTo, run_hru_v,
+ self->state.forcFileList[currentFile - 1].getNumSteps());
+ }
+ } else {
+ aout(self) << currentFile << "is larger than expected" << std::endl;
}
-
- // Respond to HRU
- self->send(refToRespondTo, run_hru_v,
- self->state.forcFileList[currentFile - 1].getNumSteps());
-
+
},
[=](access_forcing_internal, int currentFile) {
-
if (self->state.filesLoaded <= self->state.numFiles &&
currentFile <= self->state.numFiles) {
+ // aout(self) << "Loading in background, File:" << currentFile << "\n";
+ if (self->state.forcFileList[currentFile - 1].isFileLoaded()) {
+ aout(self) << "File Loaded when shouldn't be \n";
+ }
+ self->state.readStart = std::chrono::high_resolution_clock::now();
+ FileAccessActor_ReadForcing(self->state.handle_forcFileInfo, ¤tFile,
+ &self->state.stepsInCurrentFile, &self->state.startGRU,
+ &self->state.numGRU, &self->state.err);
+ if (self->state.err != 0) {
+ aout(self) << "ERROR: Reading Forcing" << std::endl;
+ }
+ self->state.filesLoaded += 1;
+ self->state.forcFileList[currentFile - 1].updateNumSteps(self->state.stepsInCurrentFile);
- readForcing(self, currentFile);
+ self->state.readEnd = std::chrono::high_resolution_clock::now();
+ self->state.readDuration += calculateTime(self->state.readStart, self->state.readEnd);
self->send(self, access_forcing_internal_v, currentFile + 1);
} else {
- if (debug)
- aout(self) << "All Forcing Files Loaded \n";
+ aout(self) << "All Forcing Files Loaded \n";
}
-
-
},
+
[=](write_output, int indxGRU, int indxHRU, int numStepsToWrite,
caf::actor refToRespondTo) {
int err;
@@ -95,7 +127,6 @@ behavior file_access_actor(stateful_actor<file_access_state>* self, int startGRU
self->state.forcFileList[currentFile - 1].getNumSteps());
},
-
[=](deallocate_structures) {
aout(self) << "Deallocating Structure" << std::endl;
FileAccessActor_DeallocateStructures(self->state.handle_forcFileInfo, self->state.handle_ncid);
@@ -132,11 +163,20 @@ void initalizeFileAccessActor(stateful_actor<file_access_state>* self) {
self->quit();
}
- aout(self) << "\n\nNumber of timesteps for the simulation = " << self->state.num_steps << "\n";
-
read_pinit_C(&err);
+ if (err != 0) {
+ aout(self) << "ERROR: read_pinit_C\n";
+ }
read_vegitationTables(&err);
+ if (err != 0) {
+ aout(self) << "ERROR: read_vegitationTables\n";
+ }
+
+ Create_Output_File(self->state.handle_ncid, &self->state.numGRU, &self->state.startGRU, &err);
+ if (err != 0) {
+ aout(self) << "ERROR: Create_OutputFile\n";
+ }
// initalize vector for knowing if HRU output has init'd
@@ -154,14 +194,11 @@ void initalizeFileAccessActor(stateful_actor<file_access_state>* self) {
int writeOutput(stateful_actor<file_access_state>* self, int indxGRU, int indxHRU,
int numStepsToWrite) {
-
- int err = 0;
- bool hruInit = self->state.outputFileInitHRU[indxGRU - 1];
self->state.writeStart = std::chrono::high_resolution_clock::now();
- FileAccessActor_WriteOutput(self->state.handle_ncid, &self->state.outputFileExists,
- &numStepsToWrite, &self->state.startGRU, &self->state.numGRU,
- &hruInit, &indxGRU, &indxHRU, &err);
- self->state.outputFileInitHRU[indxGRU - 1] = true;
+ int err = 0;
+
+ FileAccessActor_WriteOutput(self->state.handle_ncid,
+ &numStepsToWrite, &indxGRU, &indxHRU, &err);
self->state.writeEnd = std::chrono::high_resolution_clock::now();
self->state.writeDuration += calculateTime(self->state.writeStart, self->state.writeEnd);
@@ -203,4 +240,7 @@ int readForcing(stateful_actor<file_access_state>* self, int currentFile) {
}
}
+
+
+
#endif
\ No newline at end of file
diff --git a/build/source/actors/HRUActor.h b/build/source/actors/HRUActor.h
index ca94bad..bd0b999 100644
--- a/build/source/actors/HRUActor.h
+++ b/build/source/actors/HRUActor.h
@@ -61,7 +61,20 @@ behavior hru_actor(stateful_actor<hru_state>* self, int refGRU, int indxGRU,
// Starts the HRU and tells it to ask for data from the file_access_actor
[=](start_hru) {
self->state.start = std::chrono::high_resolution_clock::now();
-
+
+ int err;
+
+ err = 0;
+ // Write Paramaters to OutputStruc
+ Write_Param_C(&self->state.indxGRU, &self->state.indxHRU,
+ self->state.handle_attrStruct, self->state.handle_typeStruct,
+ self->state.handle_mparStruct, self->state.handle_bparStruct,
+ &err);
+
+ // ask file_access_actor to write paramaters
+ self->send(self->state.file_access_actor, write_param_v, self->state.indxGRU, self->state.indxHRU);
+
+
self->send(self->state.file_access_actor, access_forcing_v, self->state.iFile, self);
self->state.end = std::chrono::high_resolution_clock::now();
self->state.duration += calculateTime(self->state.start, self->state.end);
@@ -113,7 +126,7 @@ behavior hru_actor(stateful_actor<hru_state>* self, int refGRU, int indxGRU,
self->state.outputStep += 1;
self->state.forcingStep += 1;
- keepRunning = check_HRU(self, err);
+ keepRunning = check_HRU(self, err); // check if we are done, need to write
}
@@ -205,7 +218,6 @@ void Initialize_HRU(stateful_actor<hru_state>* self) {
return;
}
- // aout(self) << "Setup Param" << std::endl;
SetupParam(&self->state.indxGRU,
&self->state.indxHRU,
self->state.handle_attrStruct,
diff --git a/build/source/actors/messageAtoms.h b/build/source/actors/messageAtoms.h
index 7b25bf6..f31f319 100644
--- a/build/source/actors/messageAtoms.h
+++ b/build/source/actors/messageAtoms.h
@@ -29,6 +29,7 @@ CAF_BEGIN_TYPE_ID_BLOCK(summa, first_custom_type_id)
CAF_ADD_ATOM(summa, update_failed)
CAF_ADD_ATOM(summa, reset_outputCounter)
CAF_ADD_ATOM(summa, read_and_write)
+ CAF_ADD_ATOM(summa, write_param)
// HRU Actor
CAF_ADD_ATOM(summa, run_hru)
CAF_ADD_ATOM(summa, start_hru)
diff --git a/build/source/dshare/data_types.f90 b/build/source/dshare/data_types.f90
index 1c34efd..c2551e0 100755
--- a/build/source/dshare/data_types.f90
+++ b/build/source/dshare/data_types.f90
@@ -440,9 +440,6 @@ type(gru_hru_time_doubleVec),allocatable :: fluxStruct(:)
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_time_double),allocatable :: dparStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:) -- default model parameters
-
! finalize stats structure
type(gru_hru_time_flagVec),allocatable :: finalizeStats(:) ! x%gru(:)%hru(:)%tim(:)%dat -- flags on when to write to file
diff --git a/build/source/engine/alloc_file_access.f90 b/build/source/engine/alloc_file_access.f90
index e73bb01..7a9a024 100644
--- a/build/source/engine/alloc_file_access.f90
+++ b/build/source/engine/alloc_file_access.f90
@@ -1,310 +1,310 @@
module alloc_file_access
- 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_d
- USE data_types,only:var_i
- USE data_types,only:var_dlength
- USE data_types,only:var_info
- 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 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_d
+USE data_types,only:var_i
+USE data_types,only:var_dlength
+USE data_types,only:var_info
+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
- implicit none
- private
- public::alloc_outputStruc
- public::allocateDat_rkind
- public::allocateDat_int
- ! public::allocateDat_flag
- contains
+implicit none
+private
+public::alloc_outputStruc
+public::allocateDat_rkind
+public::allocateDat_int
+! public::allocateDat_flag
+contains
- subroutine alloc_outputStruc(metaStruct,dataStruct,nSteps,nSnow,nSoil,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
- ! 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
- character(len=256) :: cmessage ! error message of the downwind routine
- ! initalize error control
- err=0; message='alloc_outputStruc'
+subroutine alloc_outputStruc(metaStruct,dataStruct,nSteps,nSnow,nSoil,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
+ ! 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
+ character(len=256) :: cmessage ! error message of the downwind routine
+ ! initalize error control
+ err=0; message='alloc_outputStruc'
- nVars = size(metaStruct)
- if(present(nSnow) .or. present(nSoil))then
- ! check both are present
- if(.not.present(nSoil))then; err=20; message=trim(message)//'expect nSoil to be present when nSnow is present'; return; end if
- if(.not.present(nSnow))then; err=20; message=trim(message)//'expect nSnow to be present when nSoil is present'; return; end if
- nLayers = nSnow+nSoil
-
- ! It is possible that nSnow and nSoil are actually needed here, so we return an error if the optional arguments are missing when needed
- else
- select type(dataStruct)
- ! class is (var_flagVec); err=20
- class is (var_time_ilength); err=20
- class is (var_time_dlength); err=20
- end select
- if(err/=0)then; message=trim(message)//'expect nSnow and nSoil to be present for variable-length data structures'; return; end if
- end if
-
- check=.false.
- ! allocate the dimension for model variables
- select type(dataStruct)
+ nVars = size(metaStruct)
+ if(present(nSnow) .or. present(nSoil))then
+ ! check both are present
+ if(.not.present(nSoil))then; err=20; message=trim(message)//'expect nSoil to be present when nSnow is present'; return; end if
+ if(.not.present(nSnow))then; err=20; message=trim(message)//'expect nSnow to be present when nSoil is present'; return; end if
+ nLayers = nSnow+nSoil
- class is (var_time_i)
- if(allocated(dataStruct%var))then
- check=.true.
- else
- allocate(dataStruct%var(nVars),stat=err)
- end if
- do iVar=1, nVars
- allocate(dataStruct%var(iVar)%tim(nSteps))
- end do
- return
+ ! It is possible that nSnow and nSoil are actually needed here, so we return an error if the optional arguments are missing when needed
+ else
+ select type(dataStruct)
+ ! class is (var_flagVec); err=20
+ class is (var_time_ilength); err=20
+ class is (var_time_dlength); err=20
+ end select
+ if(err/=0)then; message=trim(message)//'expect nSnow and nSoil to be present for variable-length data structures'; return; end if
+ end if
- class is (var_time_i8)
- if(allocated(dataStruct%var))then
- check=.true.
- else
- allocate(dataStruct%var(nVars),stat=err)
- end if
- do iVar=1, nVars
- allocate(dataStruct%var(iVar)%tim(nSteps))
- end do
- return
+ check=.false.
+ ! allocate the dimension for model variables
+ select type(dataStruct)
- class is (var_time_d)
- if(allocated(dataStruct%var))then
- check=.true.
- else
- allocate(dataStruct%var(nVars),stat=err)
- end if
- do iVar=1, nVars
- allocate(dataStruct%var(iVar)%tim(nSteps))
- end do
- return
-
- class is (var_d)
- if(allocated(dataStruct%var))then
- check=.true.
- else
- allocate(dataStruct%var(nVars),stat=err)
- end if
- return
-
- class is (var_i)
- if(allocated(dataStruct%var))then
- check=.true.
- else
- allocate(dataStruct%var(nVars),stat=err)
- end if
- return
-
- class is (var_dlength)
- if(allocated(dataStruct%var))then
- check=.true.
- else
- allocate(dataStruct%var(nVars),stat=err)
- end if
- ! class is (var_flagVec); if(allocated(dataStruct%var))then; check=.true.; else; allocate(dataStruct%var(nVars),stat=err); end if
+ class is (var_time_i)
+ if(allocated(dataStruct%var))then
+ check=.true.
+ else
+ allocate(dataStruct%var(nVars),stat=err)
+ end if
+ do iVar=1, nVars
+ allocate(dataStruct%var(iVar)%tim(nSteps))
+ end do
+ return
- class is (var_time_ilength)
- if(allocated(dataStruct%var))then
- check=.true.
- else
- allocate(dataStruct%var(nVars),stat=err)
- end if
- do iVar=1, nVars
- allocate(dataStruct%var(iVar)%tim(nSteps))
- end do
+ class is (var_time_i8)
+ if(allocated(dataStruct%var))then
+ check=.true.
+ else
+ allocate(dataStruct%var(nVars),stat=err)
+ end if
+ do iVar=1, nVars
+ allocate(dataStruct%var(iVar)%tim(nSteps))
+ end do
+ return
- class is (var_time_dlength)
- if(allocated(dataStruct%var))then
- check=.true.
- else
- allocate(dataStruct%var(nVars),stat=err)
- end if
- do iVar=1, nVars
- allocate(dataStruct%var(iVar)%tim(nSteps))
- end do
-
- class default; err=20; message=trim(message)//'unable to identify derived data type for the variable dimension'; return
- end select
- ! 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
+ class is (var_time_d)
+ if(allocated(dataStruct%var))then
+ check=.true.
+ else
+ allocate(dataStruct%var(nVars),stat=err)
+ end if
+ do iVar=1, nVars
+ allocate(dataStruct%var(iVar)%tim(nSteps))
+ end do
+ return
+
+ class is (var_d)
+ if(allocated(dataStruct%var))then
+ check=.true.
+ else
+ allocate(dataStruct%var(nVars),stat=err)
+ end if
+ return
+
+ class is (var_i)
+ if(allocated(dataStruct%var))then
+ check=.true.
+ else
+ allocate(dataStruct%var(nVars),stat=err)
+ end if
+ return
+
+ class is (var_dlength)
+ if(allocated(dataStruct%var))then
+ check=.true.
+ else
+ allocate(dataStruct%var(nVars),stat=err)
+ end if
+ ! class is (var_flagVec); if(allocated(dataStruct%var))then; check=.true.; else; allocate(dataStruct%var(nVars),stat=err); end if
- ! 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_time_ilength); call allocateDat_int(metaStruct,dataStruct,nSnow,nSoil,nSteps,err,cmessage)
- class is (var_time_dlength); call allocateDat_rkind_nSteps(metaStruct,dataStruct,nSnow,nSoil,nSteps,err,cmessage)
- class is (var_dlength); call allocateDat_rkind(metaStruct,dataStruct,nSnow,nSoil,err,cmessage)
- class default; err=20; message=trim(message)//'unable to identify derived data type for the data dimension'; return
- end select
+ class is (var_time_ilength)
+ if(allocated(dataStruct%var))then
+ check=.true.
+ else
+ allocate(dataStruct%var(nVars),stat=err)
+ end if
+ do iVar=1, nVars
+ allocate(dataStruct%var(iVar)%tim(nSteps))
+ end do
- ! check errors
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
+ class is (var_time_dlength)
+ if(allocated(dataStruct%var))then
+ check=.true.
+ else
+ allocate(dataStruct%var(nVars),stat=err)
+ end if
+ do iVar=1, nVars
+ allocate(dataStruct%var(iVar)%tim(nSteps))
+ end do
+
+ class default; err=20; message=trim(message)//'unable to identify derived data type for the variable dimension'; return
+ end select
+ ! 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_time_ilength); call allocateDat_int(metaStruct,dataStruct,nSnow,nSoil,nSteps,err,cmessage)
+ class is (var_time_dlength); call allocateDat_rkind_nSteps(metaStruct,dataStruct,nSnow,nSoil,nSteps,err,cmessage)
+ class is (var_dlength); call allocateDat_rkind(metaStruct,dataStruct,nSnow,nSoil,err,cmessage)
+ 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
- subroutine allocateDat_rkind_nSteps(metadata,varData,nSnow, nSoil, &
- nSteps,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) :: nSteps
- 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) :: iStep
- integer(i4b) :: nVars
- integer(i4b) :: iVar
- integer(i4b) :: nLayers
- message='allocateDat_rkindAccessActor'
+end subroutine
- nVars = size(metaData)
- nLayers = nSnow+nSoil
- do iStep=1, nSteps
- do iVar=1, nVars
- 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
- end do
-
- end subroutine allocateDat_rkind_nSteps
- subroutine allocateDat_rkind(metadata,varData,nSnow,nSoil,err,message)
+subroutine allocateDat_rkind_nSteps(metadata,varData,nSnow, nSoil, &
+ nSteps,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) :: nSteps
+ 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) :: iStep
+ integer(i4b) :: nVars
+ integer(i4b) :: iVar
+ integer(i4b) :: nLayers
+ message='allocateDat_rkindAccessActor'
+
+ nVars = size(metaData)
+ nLayers = nSnow+nSoil
+ do iStep=1, nSteps
+ do iVar=1, nVars
+ 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
+ end do
+
+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'
+ 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
+ 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
+end subroutine allocateDat_rkind
- subroutine allocateDat_int(metadata,varData,nSnow, nSoil, &
- nSteps,err,message)
- USE get_ixName_module,only:get_varTypeName ! to access type strings for error messages
+subroutine allocateDat_int(metadata,varData,nSnow, nSoil, &
+ nSteps,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) :: nSteps
- 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) :: iStep
- integer(i4b) :: nVars
- integer(i4b) :: iVar
- integer(i4b) :: nLayers
- message='allocateDat_rkindAccessActor'
-
- nVars = size(metaData)
- nLayers = nSnow+nSoil
- do iStep=1, nSteps
- do iVar=1, nVars
- 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
- end do
+ 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) :: nSteps
+ 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) :: iStep
+ integer(i4b) :: nVars
+ integer(i4b) :: iVar
+ integer(i4b) :: nLayers
+ message='allocateDat_rkindAccessActor'
+
+ nVars = size(metaData)
+ nLayers = nSnow+nSoil
+ do iStep=1, nSteps
+ do iVar=1, nVars
+ 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
+ end do
- end subroutine
+end subroutine
diff --git a/build/source/interface/file_access_actor/cppwrap_fileAccess.f90 b/build/source/interface/file_access_actor/cppwrap_fileAccess.f90
index 1c7592c..1f51add 100644
--- a/build/source/interface/file_access_actor/cppwrap_fileAccess.f90
+++ b/build/source/interface/file_access_actor/cppwrap_fileAccess.f90
@@ -14,6 +14,7 @@ module cppwrap_fileAccess
public::mDecisions_C
public::Init_OutputStruct
public::FileAccessActor_ReadForcing
+ public::Create_Output_File
public::FileAccessActor_WriteOutput
contains
@@ -184,13 +185,118 @@ subroutine FileAccessActor_ReadForcing(handle_forcFileInfo, currentFile, stepsIn
end subroutine FileAccessActor_ReadForcing
+subroutine Create_Output_File(&
+ handle_ncid, & ! ncid of the output file
+ numGRU, & ! number of GRUs assigned to this job
+ startGRU, & ! Starting GRU indx for the job
+ err) bind(C, name="Create_Output_File")
+ USE globalData,only:fileout
+ USE summaActors_FileManager,only:OUTPUT_PATH,OUTPUT_PREFIX ! define output file
+ USE def_output_module,only:def_output ! module to define model output
+ USE globalData,only:gru_struc
+ USE var_lookup,only:maxVarFreq ! number of available output frequencies
+ USE globalData,only:outputTimeStep
+ USE globalData,only:finalizeStats
+ USE var_lookup,only:iLookFreq ! named variables for the frequency structure
+
+
+ implicit none
+ type(c_ptr),intent(in), value :: handle_ncid ! ncid of the output file
+ integer(c_int),intent(in) :: numGRU ! numGRUs for the entire job (for file creation)
+ integer(c_int),intent(in) :: startGRU ! startGRU for the entire job (for file creation)
+ integer(c_int),intent(inout) :: err ! Error code
+
+ ! local variables
+ type(var_i),pointer :: ncid ! ncid of the output file
+ character(LEN=256) :: startGRUString ! String Variable to convert startGRU
+ character(LEN=256) :: numGRUString ! String Varaible to convert numGRU
+ character(LEN=256) :: message
+ character(LEN=256) :: cmessage
+ integer(i4b) :: iGRU
+ integer(i4b) :: iStruct
+ integer(i4b) :: iStep
+ integer(i4b) :: iFreq
+
+ call c_f_pointer(handle_ncid, ncid)
+
+ ! allocate space for the output file ID array
+ allocate(ncid%var(maxVarFreq))
+ ncid%var(:) = integerMissing
+
+ ! initialize finalizeStats for testing purposes
+ allocate(outputTimeStep(numGRU))
+ do iGRU = 1, numGRU
+ allocate(outputTimeStep(iGRU)%dat(maxVarFreq))
+ outputTimeStep(iGRU)%dat(:) = 1
+ end do
+
+ finalizeStats(:) = .false.
+ finalizeStats(iLookFreq%timestep) = .true.
+ ! initialize number of hru and gru in global data
+ nGRUrun = numGRU
+ nHRUrun = numGRU
+
+ write(unit=startGRUString,fmt=*)startGRU
+ write(unit=numGRUString,fmt=*) numGRU
+ fileout = trim(OUTPUT_PATH)//trim(OUTPUT_PREFIX)//"GRU"&
+ //trim(adjustl(startGRUString))//"-"//trim(adjustl(numGRUString))
+
+ ! def_output call will need to change to allow for numHRUs in future
+ ! NA_Domain numGRU = numHRU, this is why we pass numGRU twice
+ call def_output("summaVersion","buildTime","gitBranch","gitHash",numGRU,numGRU,&
+ gru_struc(1)%hruInfo(1)%nSoil,fileout,ncid,err,cmessage)
+ print*, "Creating Output File "//trim(fileout)
+end subroutine Create_Output_File
+
+subroutine Write_HRU_Param(&
+ handle_ncid, &
+ indxGRU, &
+ indxHRU, &
+ err) bind(C, name="Write_HRU_Param")
+
+ USE globalData,only:attr_meta,type_meta,mpar_meta,bpar_meta ! meta structures
+ USE globalData,only:gru_struc
+ USE globalData,only:outputStructure
+ USE writeOutput_module,only:writeParm
+
+ implicit none
+ ! dummy variables
+ type(c_ptr), intent(in), value :: handle_ncid ! ncid of the output file
+ integer(c_int),intent(in) :: indxGRU ! index of GRU in outputStructure
+ integer(c_int),intent(in) :: indxHRU ! index of HRU in outputStructure
+ integer(c_int),intent(inout) :: err ! err value for error control
+
+ ! local variables
+ type(var_i),pointer :: ncid
+ integer(i4b) :: iStruct
+ character(LEN=256) :: cmessage
+ character(LEN=256) :: message
+
+ call c_f_pointer(handle_ncid, ncid)
+
+ do iStruct=1,size(structInfo)
+ select case(trim(structInfo(iStruct)%structName))
+ case('attr'); call writeParm(ncid,gru_struc(indxGRU)%hruInfo(indxHRU)%hru_ix, &
+ outputStructure(1)%attrStruct(1)%gru(indxGRU)%hru(indxHRU),attr_meta,err,cmessage)
+ case('type'); call writeParm(ncid,gru_struc(indxGRU)%hruInfo(indxHRU)%hru_ix, &
+ outputStructure(1)%typeStruct(1)%gru(indxGRU)%hru(indxHRU),type_meta,err,cmessage)
+ case('mpar'); call writeParm(ncid,gru_struc(indxGRU)%hruInfo(indxHRU)%hru_ix, &
+ outputStructure(1)%mparStruct(1)%gru(indxGRU)%hru(indxHRU),mpar_meta,err,cmessage)
+ end select
+ if(err/=0)then; message=trim(message)//trim(cmessage)//'['//trim(structInfo(iStruct)%structName)//']'; return; endif
+ end do
+
+ ! write GRU parameters
+ call writeParm(ncid,indxGRU,outputStructure(1)%bparStruct(1)%gru(indxGRU),bpar_meta,err,cmessage)
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+
+ ! set the outputTimestep variable so it is not reset every time we need to write to a file
+ outputTimeStep(indxGRU)%dat(:) = 1
+end subroutine
+
subroutine FileAccessActor_WriteOutput(&
handle_ncid, & ! ncid of the output file
- outputFileExists, & ! flag to check if the output file exsists
nSteps, & ! number of steps to write
- startGRU, & ! startGRU for the entire job (for file creation)
- numGRU, & ! numGRUs for the entire job (for file creation)
- hruFileInit, & ! flag to check if specific hru params have been written
indxGRU, & ! index of GRU we are currently writing for
indxHRU, & ! index of HRU we are currently writing for
err) bind(C, name="FileAccessActor_WriteOutput")
@@ -218,11 +324,7 @@ subroutine FileAccessActor_WriteOutput(&
implicit none
! dummy variables
type(c_ptr),intent(in), value :: handle_ncid ! ncid of the output file
- logical(c_bool),intent(inout) :: outputFileExists ! flag to check if the output file exsists
integer(c_int),intent(in) :: nSteps ! number of steps to write
- integer(c_int),intent(in) :: startGRU ! startGRU for the entire job (for file creation)
- integer(c_int),intent(in) :: numGRU ! numGRUs for the entire job (for file creation)
- logical(c_bool),intent(inout) :: hruFileInit ! flag to check if specific hru params have been written
integer(c_int),intent(in) :: indxGRU ! index of GRU we are currently writing for
integer(c_int),intent(in) :: indxHRU ! index of HRU we are currently writing for
integer(c_int),intent(inout) :: err ! Error code
@@ -239,63 +341,6 @@ subroutine FileAccessActor_WriteOutput(&
integer(i4b) :: iFreq
call c_f_pointer(handle_ncid, ncid)
-
-
- ! check if we have created the file, if no create it
- if(.not.outputFileExists)then
- ! allocate space for the output file ID array
- allocate(ncid%var(maxVarFreq))
- ncid%var(:) = integerMissing
-
- ! initialize finalizeStats for testing purposes
- allocate(outputTimeStep(numGRU))
- do iGRU = 1, numGRU
- allocate(outputTimeStep(iGRU)%dat(maxVarFreq))
- outputTimeStep(iGRU)%dat(:) = 1
- end do
- ! outputTimeStep(1:maxvarFreq) = 1
- finalizeStats(:) = .false.
- finalizeStats(iLookFreq%timestep) = .true.
- ! initialize number of hru and gru in global data
- nGRUrun = numGRU
- nHRUrun = numGRU
-
- write(unit=startGRUString,fmt=*)startGRU
- write(unit=numGRUString,fmt=*) numGRU
- fileout = trim(OUTPUT_PATH)//trim(OUTPUT_PREFIX)//"GRU"&
- //trim(adjustl(startGRUString))//"-"//trim(adjustl(numGRUString))
-
- ! def_output call will need to change to allow for numHRUs in future
- ! NA_Domain numGRU = numHRU, this is why we pass numGRU twice
- call def_output("summaVersion","buildTime","gitBranch","gitHash",numGRU,numGRU,&
- gru_struc(1)%hruInfo(1)%nSoil,fileout,ncid,err,cmessage)
- print*, "Creating Output File "//trim(fileout)
- outputFileExists = .true.
- endif
-
- ! Write Parameters for each HRU
- if (.not.hruFileInit)then
- do iStruct=1,size(structInfo)
- select case(trim(structInfo(iStruct)%structName))
- case('attr'); call writeParm(ncid,gru_struc(indxGRU)%hruInfo(indxHRU)%hru_ix, &
- outputStructure(1)%attrStruct(1)%gru(indxGRU)%hru(indxHRU),attr_meta,err,cmessage)
- case('type'); call writeParm(ncid,gru_struc(indxGRU)%hruInfo(indxHRU)%hru_ix, &
- outputStructure(1)%typeStruct(1)%gru(indxGRU)%hru(indxHRU),type_meta,err,cmessage)
- case('mpar'); call writeParm(ncid,gru_struc(indxGRU)%hruInfo(indxHRU)%hru_ix, &
- outputStructure(1)%mparStruct(1)%gru(indxGRU)%hru(indxHRU),mpar_meta,err,cmessage)
- end select
- if(err/=0)then; message=trim(message)//trim(cmessage)//'['//trim(structInfo(iStruct)%structName)//']'; return; endif
- end do
- hruFileInit = .true.
-
- ! write GRU parameters
- call writeParm(ncid,iGRU,outputStructure(1)%bparStruct(1)%gru(indxGRU),bpar_meta,err,cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
-
- ! set the outputTimestep variable so it is not reset every time we need to write to a file
- outputTimeStep(indxGRU)%dat(:) = 1
- endif
-
! ****************************************************************************
! *** write data
! ****************************************************************************
diff --git a/build/source/interface/file_access_actor/deallocateOutputStruc.f90 b/build/source/interface/file_access_actor/deallocateOutputStruc.f90
index 65e6883..091c8ca 100644
--- a/build/source/interface/file_access_actor/deallocateOutputStruc.f90
+++ b/build/source/interface/file_access_actor/deallocateOutputStruc.f90
@@ -40,8 +40,6 @@ subroutine deallocateOutputStruc(err)
call deallocateData_output(outputStructure(1)%mparStruct(1)); deallocate(outputStructure(1)%mparStruct)
! bpar
call deallocateData_output(outputStructure(1)%bparStruct(1)); deallocate(outputStructure(1)%bparStruct)
- ! dpar
- call deallocateData_output(outputStructure(1)%dparStruct(1)); deallocate(outputStructure(1)%dparStruct)
! finalize stats
call deallocateData_output(outputStructure(1)%finalizeStats(1)); deallocate(outputStructure(1)%finalizeStats)
diff --git a/build/source/interface/file_access_actor/fileAccess_subroutine_wrappers.h b/build/source/interface/file_access_actor/fileAccess_subroutine_wrappers.h
index 3c59b3d..4f743e3 100644
--- a/build/source/interface/file_access_actor/fileAccess_subroutine_wrappers.h
+++ b/build/source/interface/file_access_actor/fileAccess_subroutine_wrappers.h
@@ -19,12 +19,14 @@ extern "C" {
void FileAccessActor_ReadForcing(void* forcFileInfo, int* currentFile, int* stepsInFile,
int* startGRU, int* numGRU, int* err);
- void FileAccessActor_WriteOutput(void* handle_ncid, bool* fileExists,
- int* stepsInCurrentFile, int* startGru, int* numGRUs,
- bool* outputFileInitHRU, int*indxGRU, int*indxHRU, int* err);
+ void FileAccessActor_WriteOutput(void* handle_ncid,
+ int* stepsInCurrentFile, int*indxGRU, int*indxHRU, int* err);
void FileAccessActor_DeallocateStructures(void* handle_forcFileInfo, void* handle_ncid);
+ void Create_Output_File(void* handle_ncid, int* numGRU, int* startGRU, int* err);
+
+ void Write_HRU_Param(void* handle_ncid, int* indxGRU, int* indxHRU, int* err);
}
diff --git a/build/source/interface/file_access_actor/initOutputStruc.f90 b/build/source/interface/file_access_actor/initOutputStruc.f90
index 765b41f..29895e7 100644
--- a/build/source/interface/file_access_actor/initOutputStruc.f90
+++ b/build/source/interface/file_access_actor/initOutputStruc.f90
@@ -95,9 +95,6 @@ subroutine initalizeOutput(forcFileInfo, maxSteps, nGRU, err)
allocate(outputStructure(1)%bvarStruct(1))
allocate(outputStructure(1)%bparStruct(1)%gru(nGRU))
allocate(outputStructure(1)%bvarStruct(1)%gru(nGRU))
- ! Ancillary Data Structures
- allocate(outputStructure(1)%dparStruct(1))
- allocate(outputStructure(1)%dparStruct(1)%gru(nGRU))
! Finalize Stats for writing
allocate(outputStructure(1)%finalizeStats(1))
allocate(outputStructure(1)%finalizeStats(1)%gru(nGRU))
@@ -171,16 +168,6 @@ subroutine initalizeOutput(forcFileInfo, maxSteps, nGRU, err)
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
- allocate(outputStructure(1)%dparStruct(1)%gru(iGRU)%hru(1))
- call alloc_outputStruc(mpar_meta,outputStructure(1)%dparStruct(1)%gru(iGRU)%hru(1), &
- maxSteps,nSnow,nSoil,err,message); ! default model parameters
- if(err/=0)then
- message=trim(message)//' [problem allocating dparStruct]'
- return
- endif
-
do iStruct=1,size(structInfo)
! allocate space for statistics structures
diff --git a/build/source/interface/hru_actor/cppwrap_hru.f90 b/build/source/interface/hru_actor/cppwrap_hru.f90
index b6909fb..87587d0 100644
--- a/build/source/interface/hru_actor/cppwrap_hru.f90
+++ b/build/source/interface/hru_actor/cppwrap_hru.f90
@@ -12,6 +12,7 @@ public::Restart
public::Forcing
public::RunPhysics
public::DeallocateStructures
+public::Write_Param_C
contains
@@ -191,7 +192,6 @@ subroutine Initialize(&
end subroutine Initialize
-
! **********************************************************************************************************
! public subroutine SetupParam: initializes parameter data structures (e.g. vegetation and soil parameters).
! **********************************************************************************************************
@@ -975,5 +975,68 @@ subroutine DeallocateData(metaStruct, dataStruct, err)
end subroutine DeallocateData
+! **********************************************************************************************************
+! public Subroutine write_param_c: called from C to call the fortran subroutine
+! **********************************************************************************************************
+subroutine Write_Param_C(&
+ indxGRU, &
+ indxHRU, &
+ handle_attrStruct, &
+ handle_typeStruct, &
+ handle_mparStruct, &
+ handle_bparStruct, &
+ err) bind(C, name="Write_Param_C")
+
+ USE outputStrucWrite_module,only:writeParm ! module to write model parameters
+ USE globalData,only:attr_meta,type_meta,mpar_meta,bpar_meta ! meta structures needed for writeParam Call
+ USE globalData,only:structInfo
+ USE globalData,only:gru_struc
+ implicit none
+
+ ! Dummy Variables
+ integer(c_int), intent(in) :: indxGRU
+ integer(c_int), intent(in) :: indxHRU
+ type(c_ptr), intent(in), value :: handle_attrStruct
+ type(c_ptr), intent(in), value :: handle_typeStruct
+ type(c_ptr), intent(in), value :: handle_mparStruct
+ type(c_ptr), intent(in), value :: handle_bparStruct
+ integer(c_int) :: err
+
+ ! local variables
+ type(var_d), pointer :: attrStruct
+ type(var_i), pointer :: typeStruct
+ type(var_dlength),pointer :: mparStruct
+ type(var_d), pointer :: bparStruct
+
+ integer(i4b) :: iStruct
+ character(len=256) :: message
+ character(len=256) :: cmessage
+
+ call c_f_pointer(handle_attrStruct, attrStruct)
+ call c_f_pointer(handle_typeStruct, typeStruct)
+ call c_f_pointer(handle_mparStruct, mparStruct)
+ call c_f_pointer(handle_bparStruct, bparStruct)
+
+ ! Error Control
+ err=0; message="cppwrap_Write_Param_C"
+ do iStruct=1,size(structInfo)
+ select case(trim(structInfo(iStruct)%structName))
+ case('attr'); call writeParm(indxGRU,indxHRU,gru_struc(indxGRU)%hruInfo(indxHRU)%hru_ix, &
+ attrStruct,attr_meta,'attr',err,cmessage)
+ case('type'); call writeParm(indxGRU,indxHRU,gru_struc(indxGRU)%hruInfo(indxHRU)%hru_ix, &
+ typeStruct,type_meta,'type',err,cmessage)
+ case('mpar'); call writeParm(indxGRU,indxHRU,gru_struc(indxGRU)%hruInfo(indxHRU)%hru_ix, &
+ mparStruct,mpar_meta,'mpar',err,cmessage)
+ end select
+ if(err/=0)then; message=trim(message)//trim(cmessage)//'['//trim(structInfo(iStruct)%structName)//']'; return; endif
+ end do ! (looping through structures)
+
+ ! write GRU parameters
+ call writeParm(indxGRU,indxHRU,integerMissing,bparStruct,bpar_meta,'bpar',err,cmessage)
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+
+
+
+end subroutine
end module cppwrap_hru
\ No newline at end of file
diff --git a/build/source/interface/hru_actor/hru_subroutine_wrappers.h b/build/source/interface/hru_actor/hru_subroutine_wrappers.h
index 4ff9cef..638580d 100644
--- a/build/source/interface/hru_actor/hru_subroutine_wrappers.h
+++ b/build/source/interface/hru_actor/hru_subroutine_wrappers.h
@@ -92,6 +92,11 @@ extern "C" {
void* handle_resetStats,
void* handle_finalizeStats,
int* err);
+
+ void Write_Param_C(
+ int* indxGRU, int* indxHRU,
+ void* handle_attrStruct, void* handle_typeStruct, void* handle_mparStruct, void* handle_bparStruct,
+ int* err);
}
diff --git a/build/source/netcdf/outputStrucWrite.f90 b/build/source/netcdf/outputStrucWrite.f90
index 2859d94..ce67959 100755
--- a/build/source/netcdf/outputStrucWrite.f90
+++ b/build/source/netcdf/outputStrucWrite.f90
@@ -151,12 +151,12 @@ contains
message="writeParm/"
end do ! looping through local column model parameters
- end subroutine writeParm
+end subroutine writeParm
! **************************************************************************************
! public subroutine writeData: write model time-dependent data
! **************************************************************************************
- subroutine writeData(indxGRU,indxHRU,iStep,structName,finalizeStats, &
+subroutine writeData(indxGRU,indxHRU,iStep,structName,finalizeStats, &
maxLayers,meta,stat,dat,map,indx,err,message)
USE data_types,only:var_info ! metadata type
USE var_lookup,only:maxVarStat ! index into stats structure
@@ -307,12 +307,12 @@ contains
end do ! iVar
end do ! iFreq
- end subroutine writeData
+end subroutine writeData
- ! **************************************************************************************
- ! public subroutine writeBasin: write basin-average variables
- ! **************************************************************************************
- subroutine writeBasin(indxGRU,indxHRU,iStep,finalizeStats,&
+! **************************************************************************************
+! public subroutine writeBasin: write basin-average variables
+! **************************************************************************************
+subroutine writeBasin(indxGRU,indxHRU,iStep,finalizeStats,&
outputTimestep,meta,stat,dat,map,err,message)
USE data_types,only:var_info ! metadata type
USE var_lookup,only:maxVarStat ! index into stats structure
@@ -381,12 +381,12 @@ contains
end do ! iVar
end do ! iFreq
- end subroutine writeBasin
+end subroutine writeBasin
! **************************************************************************************
! public subroutine writeTime: write current time to all files
! **************************************************************************************
- subroutine writeTime(indxGRU,indxHRU,iStep,finalizeStats,meta,dat,err,message)
+subroutine writeTime(indxGRU,indxHRU,iStep,finalizeStats,meta,dat,err,message)
USE data_types,only:var_info ! metadata type
USE var_lookup,only:iLookStat ! index into stat structure
implicit none
@@ -426,12 +426,12 @@ contains
end do ! iVar
end do ! iFreq
- end subroutine writeTime
+end subroutine writeTime
- ! *********************************************************************************************************
- ! public subroutine printRestartFile: print a re-start file
- ! *********************************************************************************************************
- subroutine writeRestart(filename, & ! intent(in): name of restart file
+! *********************************************************************************************************
+! public subroutine printRestartFile: print a re-start file
+! *********************************************************************************************************
+subroutine writeRestart(filename, & ! intent(in): name of restart file
nGRU, & ! intent(in): number of GRUs
nHRU, & ! intent(in): number of HRUs
prog_meta, & ! intent(in): prognostics metadata
@@ -699,6 +699,6 @@ contains
! cleanup
deallocate(ncVarID)
- end subroutine writeRestart
+end subroutine writeRestart
end module outputStrucWrite_module
diff --git a/utils/netcdf/compareOutput.py b/utils/netcdf/compareOutput.py
index 6846820..399bf81 100644
--- a/utils/netcdf/compareOutput.py
+++ b/utils/netcdf/compareOutput.py
@@ -3,7 +3,7 @@ from os.path import isfile, join
from pathlib import Path
import xarray as xr
-numHRU = 1
+numHRU = 10
time = 'time'
scalarSWE = 'scalarSWE'
@@ -28,8 +28,8 @@ varList = [time, scalarSWE, scalarCanopyWat, scalarAquiferStorage, scalarTotalSo
scalarTotalET, scalarTotalRunoff, scalarNetRadiation]
filename = "out.txt"
-originalPath = Path('/u1/kck540/output/SummaOriginal/Apr-1-2022/SummaOriginal_G000001-000001_timestep.nc')
-actorsPath = Path('/u1/kck540/output/SummaActors/Apr-1-2022/SummaActorsGRU1-1_timestep.nc')
+originalPath = Path('/u1/kck540/output/SummaOriginal/Apr-13-2022/SummaOriginal_G000001-000010_timestep.nc')
+actorsPath = Path('/u1/kck540/output/SummaActors/Apr-13-2022/SummaActorsGRU1-10_timestep.nc')
originalDataset = xr.open_dataset(originalPath)
actorsDataset = xr.open_dataset(actorsPath)
--
GitLab