diff --git a/build/source/actors/FileAccessActor.h b/build/source/actors/FileAccessActor.h index 387728fe0d80048a0f9c447dd31bca13844df177..d805659f60158d6c6fb1b4bd3d143e4e7cbe8bd8 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 ca94bade532993401632837096123f372b19019f..bd0b999a04691f39fe4d4532ad7f65c28dc4593b 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 7b25bf6cf535e85f1ff11993c28311965151efc5..f31f3196c9ea81f802903022df69def99d0d33e6 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 1c34efd45f23720ca0418a5c453db322e4a5e8da..c2551e0720aa5c601999e6c7af6a9d299e33c52e 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 e73bb015890ec60a6e51d5d8279870a6d654ea66..7a9a024159412becd21f0aadae7cd71e5aed2f81 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 1c7592c37ddc25a9b098cc7e816e42e9e8b255a3..1f51addfcf9429a802f11428c213b81be31b34e3 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 65e6883e231b1d35a85c789c369522167db2f67e..091c8ca591c576529d0e06b9a593203291a5c693 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 3c59b3d87ee93708aec315f9fd659d7df07bd623..4f743e346a8ac6dd79e12a7bcf1032271ff7c4ef 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 765b41f43b40bbf5334954f93b8cfe612113ea11..29895e7c39e39d71c6fb0f9c7dd20aa6a6713438 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 b6909fb604286a605fc24ace76df7e8fdd1efa57..87587d061b4773e5f6d12eea0a4cedcc33ae1b22 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 4ff9cef9def7b75d6ad2aa73522209606d907fdf..638580d57a68f5e2d3dad9d891b2fb6b55c4bb46 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 2859d94662c3e0adf054841d98a83eb766184cdc..ce67959febff75b78f30c4aa003ed7f9d765cf64 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 6846820346fbb4973e0df80917c7acb470c40423..399bf813df17d649aae4f0f92c7455036aadeed7 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)