From 03f51f5cf9dcd1b7bb499109826e989fd9c8bd1c Mon Sep 17 00:00:00 2001
From: Kyle <kyle.c.klenk@gmail.com>
Date: Wed, 2 Nov 2022 21:12:23 +0000
Subject: [PATCH] cleaned up un-used code and ran tests
---
.../file_access_actor_subroutine_wrappers.hpp | 2 +-
build/makefile_sundials | 10 +-
.../cpp_code/file_access_actor.cpp | 7 +-
.../fortran_code/cppwrap_fileAccess.f90 | 20 --
.../fortran_code/read_forcing.f90 | 237 +++++++++++-
.../fortran_code}/init_hru_actor.f90 | 10 +-
build/source/driver/SummaActors_setup.f90 | 1 -
.../driver/summaActors_wOutputStruc.f90 | 336 ------------------
build/source/engine/access_forcing.f90 | 233 ------------
build/source/engine/access_write.f90 | 0
build/source/engine/alloc_file_access.f90 | 322 -----------------
build/source/engine/read_dimension.f90 | 127 -------
build/source/engine/read_paramActors.f90 | 84 -----
13 files changed, 244 insertions(+), 1145 deletions(-)
rename build/source/{driver => actors/hru_actor/fortran_code}/init_hru_actor.f90 (97%)
delete mode 100644 build/source/driver/summaActors_wOutputStruc.f90
delete mode 100644 build/source/engine/access_forcing.f90
delete mode 100644 build/source/engine/access_write.f90
delete mode 100644 build/source/engine/alloc_file_access.f90
delete mode 100755 build/source/engine/read_paramActors.f90
diff --git a/build/includes/file_access_actor/file_access_actor_subroutine_wrappers.hpp b/build/includes/file_access_actor/file_access_actor_subroutine_wrappers.hpp
index 68c20d0..1612cb4 100644
--- a/build/includes/file_access_actor/file_access_actor_subroutine_wrappers.hpp
+++ b/build/includes/file_access_actor/file_access_actor_subroutine_wrappers.hpp
@@ -37,7 +37,7 @@ extern "C" {
void resetOutputCounter(int* indxGRU);
- void FileAccessActor_ReadForcing(void* forcFileInfo, int* currentFile, int* stepsInFile,
+ void read_forcingFile(void* forcFileInfo, int* currentFile, int* stepsInFile,
int* startGRU, int* numGRU, int* err);
void FileAccessActor_DeallocateStructures(void* handle_forcFileInfo, void* handle_ncid);
diff --git a/build/makefile_sundials b/build/makefile_sundials
index 711a8ea..02c4621 100644
--- a/build/makefile_sundials
+++ b/build/makefile_sundials
@@ -163,6 +163,7 @@ INTERFACE = $(patsubst %, $(ACTORS_DIR)/global/%, $(SUMMA_INTERFACE))
SUMMA_FILEACCESS_INTERFACE = \
cppwrap_fileAccess.f90 \
read_attribute.f90 \
+ read_forcing.f90 \
read_param.f90 \
write_to_netcdf.f90
@@ -175,7 +176,9 @@ JOB_INTERFACE = $(patsubst %, $(JOB_ACTOR_DIR)/%, $(SUMMA_JOB_INTERFACE))
SUMMA_HRU_INTERFACE = \
cppwrap_hru.f90 \
- hru_actor.f90
+ hru_actor.f90 \
+ init_hru_actor.f90 \
+
HRU_INTERFACE = $(patsubst %, $(HRU_ACTOR_DIR)/%, $(SUMMA_HRU_INTERFACE))
@@ -192,14 +195,12 @@ SUMMA_PRELIM= \
sunGeomtry.f90 \
convE2Temp.f90 \
allocspaceActors.f90 \
- alloc_file_access.f90\
checkStruc.f90 \
childStruc.f90 \
ffile_info.f90 \
read_dimension.f90 \
read_pinit.f90 \
pOverwrite.f90 \
- read_paramActors.f90 \
paramCheck.f90 \
check_icondActors.f90 \
# allocspace.f90
@@ -223,8 +224,6 @@ SUMMA_MODRUN = \
sundials/updateVarsSundials.f90 \
var_derive.f90 \
read_forcingActors.f90 \
- access_forcing.f90\
- access_write.f90 \
derivforce.f90 \
snowAlbedo.f90 \
canopySnow.f90 \
@@ -257,7 +256,6 @@ SUMMA_DRIVER= \
summaActors_type.f90 \
summaActors_util.f90 \
summaActors_globalData.f90 \
- init_hru_actor.f90 \
SummaActors_setup.f90 \
summaActors_restart.f90 \
summaActors_forcing.f90 \
diff --git a/build/source/actors/file_access_actor/cpp_code/file_access_actor.cpp b/build/source/actors/file_access_actor/cpp_code/file_access_actor.cpp
index df36299..a88106d 100644
--- a/build/source/actors/file_access_actor/cpp_code/file_access_actor.cpp
+++ b/build/source/actors/file_access_actor/cpp_code/file_access_actor.cpp
@@ -75,7 +75,7 @@ behavior file_access_actor(stateful_actor<file_access_state>* self, int start_gr
self->state.file_access_timing.updateStartPoint("read_duration");
// Load the file
- FileAccessActor_ReadForcing(self->state.handle_forcing_file_info, ¤tFile,
+ read_forcingFile(self->state.handle_forcing_file_info, ¤tFile,
&self->state.stepsInCurrentFile, &self->state.start_gru,
&self->state.num_gru, &self->state.err);
if (self->state.err != 0) {
@@ -102,13 +102,12 @@ behavior file_access_actor(stateful_actor<file_access_state>* self, int start_gr
[=](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.forcing_file_list[currentFile - 1].isFileLoaded()) {
aout(self) << "File Loaded when shouldn't be \n";
}
self->state.file_access_timing.updateStartPoint("read_duration");
- FileAccessActor_ReadForcing(self->state.handle_forcing_file_info, ¤tFile,
+ read_forcingFile(self->state.handle_forcing_file_info, ¤tFile,
&self->state.stepsInCurrentFile, &self->state.start_gru,
&self->state.num_gru, &self->state.err);
if (self->state.err != 0) {
@@ -373,7 +372,7 @@ int readForcing(stateful_actor<file_access_state>* self, int currentFile) {
self->state.file_access_timing.updateStartPoint("read_duration");
// Load the file
- FileAccessActor_ReadForcing(self->state.handle_forcing_file_info, ¤tFile,
+ read_forcingFile(self->state.handle_forcing_file_info, ¤tFile,
&self->state.stepsInCurrentFile, &self->state.start_gru,
&self->state.num_gru, &self->state.err);
diff --git a/build/source/actors/file_access_actor/fortran_code/cppwrap_fileAccess.f90 b/build/source/actors/file_access_actor/fortran_code/cppwrap_fileAccess.f90
index 18d68a0..c32c833 100644
--- a/build/source/actors/file_access_actor/fortran_code/cppwrap_fileAccess.f90
+++ b/build/source/actors/file_access_actor/fortran_code/cppwrap_fileAccess.f90
@@ -11,7 +11,6 @@ module cppwrap_fileAccess
implicit none
public::initFailedHRUTracker
- public::FileAccessActor_ReadForcing
contains
@@ -114,25 +113,6 @@ subroutine resetOutputCounter(indxGRU) bind(C, name="resetOutputCounter")
end subroutine resetOutputCounter
-subroutine FileAccessActor_ReadForcing(handle_forcFileInfo, currentFile, stepsInFile, startGRU, numGRU, err) bind(C,name="FileAccessActor_ReadForcing")
- USE access_forcing_module,only:access_forcingFile
- implicit none
- type(c_ptr), intent(in), value :: handle_forcFileInfo
- integer(c_int), intent(in) :: currentFile ! the current forcing file we are on
- integer(c_int), intent(inout) :: stepsInFile
- integer(c_int), intent(in) :: startGRU
- integer(c_int), intent(in) :: numGRU
- integer(c_int), intent(inout) :: err
-
- type(file_info_array), pointer :: forcFileInfo
- character(len=256) :: message ! error message
-
- call c_f_pointer(handle_forcFileInfo, forcFileInfo)
-
- call access_forcingFile(forcFileInfo, currentFile, stepsInFile, startGRU, numGRU, err, message)
-
-end subroutine FileAccessActor_ReadForcing
-
subroutine FileAccessActor_DeallocateStructures(handle_forcFileInfo, handle_ncid) bind(C,name="FileAccessActor_DeallocateStructures")
USE netcdf_util_module,only:nc_file_close
USE globalData,only:structInfo ! information on the data structures
diff --git a/build/source/actors/file_access_actor/fortran_code/read_forcing.f90 b/build/source/actors/file_access_actor/fortran_code/read_forcing.f90
index 6c173fd..b5637cf 100644
--- a/build/source/actors/file_access_actor/fortran_code/read_forcing.f90
+++ b/build/source/actors/file_access_actor/fortran_code/read_forcing.f90
@@ -1,10 +1,235 @@
-! Module used by the file access actor for reading in the forcing data
-module read_forcing_module
- USE, intrinsic :: iso_c_binding
- USE nrtype
- implicit none
+! This module contains all the functions that are used to
+! access the forcing file and setup the forcing data
+! for the HRUs to read from
+module access_forcing_module
+USE, intrinsic :: iso_c_binding
+USE nrtype
+USE data_types,only:file_info
+USE data_types,only:file_info_array
-end module read_forcing_module
\ No newline at end of file
+USE globalData,only:gru_struc
+USE globalData,only:forcingDataStruct
+USE globalData,only:vecTime
+USE globalData,only:outputStructure
+USE globalData,only:time_meta,forc_meta ! metadata structures
+USE globalData,only:integerMissing ! integer missing value
+
+
+USE var_lookup,only:iLookTIME,iLookFORCE ! named variables to define structure elements
+
+
+USE summaActors_FileManager,only:FORCING_PATH ! path of the forcing data file
+USE netcdf_util_module,only:nc_file_close ! close netcdf file
+
+
+implicit none
+private
+public::read_forcingFile
+
+contains
+subroutine read_forcingFile(handle_forcFileInfo, iFile, stepsInFile, startGRU, numGRU, err) bind(C,name="read_forcingFile")
+ USE netcdf ! netcdf capability
+ USE netcdf_util_module,only:nc_file_open ! open netcdf file
+ implicit none
+ type(c_ptr), intent(in), value :: handle_forcFileInfo
+ integer(c_int),intent(in) :: iFile
+ integer(c_int),intent(inout) :: stepsInFile
+ integer(c_int),intent(in) :: startGRU
+ integer(c_int),intent(in) :: numGRU
+ integer(c_int),intent(inout) :: err
+ ! local varibles
+ type(file_info_array), pointer :: forcFileInfo
+ integer(i4b) :: iHRU_Global
+ integer(i4b) :: varId
+ integer(i4b) :: ncid
+ integer(i4b) :: nFiles
+ integer(i4b) :: nTimeSteps
+ integer(i4b) :: numHRU
+ integer(i4b) :: nVars
+ integer(i4b) :: iVar
+ integer(i4b) :: iNC
+ integer(i4b) :: attLen ! attribute length
+ character(len=256) :: infile
+ character(len=256) :: cmessage
+ character(len = nf90_max_name) :: varName ! dimenison name
+ logical(lgt),dimension(size(forc_meta)) :: checkForce ! flags to check forcing data variables exist
+ character(len=256) :: message ! error message
+
+ call c_f_pointer(handle_forcFileInfo, forcFileInfo)
+
+ ! Start Procedure here
+ err=0; message="read_forcing.f90 - read_forcingFile/"
+
+ nFiles=size(forcFileInfo%ffile_list(:))
+
+ nTimeSteps = sum(forcFileInfo%ffile_list(:)%nTimeSteps)
+
+ ! Allocate forcing data input Struct
+ if (.not.allocated(forcingDataStruct))then
+ allocate(forcingDataStruct(nFiles))
+ ! Allocate timing variables from forcing File
+ allocate(vecTime(nFiles))
+ endif
+
+ ! Files are assumed to be in the correct order
+ infile=trim(FORCING_PATH)//trim(forcFileInfo%ffile_list(iFile)%filenmData)
+ ! open netCDF file
+ call openForcingFile(forcFileInfo%ffile_list,iFile,trim(infile),ncid,err,cmessage)
+ if(err/=0)then; message=trim(message)//trim(cmessage);return; end if
+
+ err = nf90_inq_varid(ncid,'time',varId); if(err/=nf90_noerr)then; message=trim(message)//'cannot find time variable/'//trim(nf90_strerror(err)); return; endif
+ err = nf90_inquire_attribute(ncid,varId,'units',len = attLen); if(err/=nf90_noerr)then; message=trim(message)//'cannot find time units/'//trim(nf90_strerror(err)); return; endif
+ err = nf90_get_att(ncid,varid,'units',forcingDataStruct(iFile)%refTimeString);if(err/=nf90_noerr)then; message=trim(message)//'cannot read time units/'//trim(nf90_strerror(err)); return; endif
+
+
+ nTimeSteps = forcFileInfo%ffile_list(iFile)%nTimeSteps
+ forcingDataStruct(iFile)%nTimeSteps = nTimeSteps
+ stepsInFile = nTimeSteps
+ if(.not.allocated(vecTime(iFile)%dat))then
+ allocate(vecTime(iFile)%dat(nTimeSteps))
+ end if
+
+ ! Get Time Information
+ err = nf90_inq_varid(ncid,'time',varId);
+ if(err/=nf90_noerr)then; message=trim(message)//'trouble finding time variable/'//trim(nf90_strerror(err)); return; endif
+ err = nf90_get_var(ncid,varId,vecTime(iFile)%dat(:),start=(/1/),count=(/nTimeSteps/))
+ if(err/=nf90_noerr)then; message=trim(message)//'trouble reading time variable/'//trim(nf90_strerror(err)); return; endif
+
+ ! Need to loop through vars and add forcing data
+ nVars = forcFileInfo%ffile_list(iFile)%nVars
+ forcingDataStruct(iFile)%nVars = nVars
+ if (.not.allocated(forcingDataStruct(iFile)%var))then
+ allocate(forcingDataStruct(iFile)%var(nVars))
+ endif
+ if (.not.allocated(forcingDataStruct(iFile)%var_ix))then
+ allocate(forcingDataStruct(iFile)%var_ix(nVars))
+ endif
+ forcingDataStruct(iFile)%var_ix(:) = integerMissing
+
+ ! initialize flags for forcing data
+ checkForce(:) = .false.
+ checkForce(iLookFORCE%time) = .true. ! time is handled separately
+ do iNC=1,nVars
+ ! populate var_ix so HRUs can access the values
+ forcingDataStruct(iFile)%var_ix(iNC) = forcFileInfo%ffile_list(iFile)%var_ix(iNC)
+
+ ! check variable is desired
+ if(forcFileInfo%ffile_list(iFile)%var_ix(iNC)==integerMissing) cycle
+
+
+ iVar = forcFileInfo%ffile_list(iFile)%var_ix(iNC)
+ checkForce(iVar) = .true.
+ if (.not.allocated(forcingDataStruct(iFile)%var(iVar)%dataFromFile))then
+ allocate(forcingDataStruct(iFile)%var(iVar)%dataFromFile(numGRU,nTimeSteps))
+ endif
+
+ ! Get Forcing Data
+ ! get variable name for error reporting
+ err=nf90_inquire_variable(ncid,iNC,name=varName)
+ if(err/=nf90_noerr)then; message=trim(message)//'problem reading forcing variable name from netCDF: '//trim(nf90_strerror(err)); return; endif
+
+ ! define global HRU
+ iHRU_global = gru_struc(1)%hruInfo(1)%hru_nc
+ numHRU = sum(gru_struc(:)%hruCount)
+
+
+ err=nf90_get_var(ncid,forcFileInfo%ffile_list(iFile)%data_id(ivar),forcingDataStruct(iFile)%var(iVar)%dataFromFile, start=(/startGRU,1/),count=(/numHRU, nTimeSteps/))
+ if(err/=nf90_noerr)then; message=trim(message)//'problem reading forcing data: '//trim(varName)//'/'//trim(nf90_strerror(err)); return; endif
+
+
+ end do
+
+ call nc_file_close(ncid,err,message)
+ if(err/=0)then;message=trim(message)//trim(cmessage);return;end if
+
+
+end subroutine read_forcingFile
+
+! *************************************************************************
+! * open the NetCDF forcing file and get the time information
+! *************************************************************************
+subroutine openForcingFile(forcFileInfo,iFile,infile,ncId,err,message)
+ USE netcdf ! netcdf capability
+ USE netcdf_util_module,only:nc_file_open ! open netcdf file
+ USE time_utils_module,only:fracDay ! compute fractional day
+ USE time_utils_module,only:extractTime ! extract time info from units string
+ USE time_utils_module,only:compJulday ! convert calendar date to julian day
+ !USE globalData,only:tmZoneOffsetFracDay ! time zone offset in fractional days
+ USE globalData,only:ncTime ! time zone information from NetCDF file (timeOffset = longitude/15. - ncTimeOffset)
+ USE globalData,only:utcTime ! all times in UTC (timeOffset = longitude/15. hours)
+ USE globalData,only:localTime ! all times local (timeOffset = 0)
+ USE globalData,only:refJulday_data
+ USE summaActors_filemanager,only:NC_TIME_ZONE
+ ! dummy variables
+ type(file_info),intent(inout) :: forcFileInfo(:)
+ integer(i4b),intent(in) :: iFile ! index of current forcing file in forcing file list
+ character(*) ,intent(in) :: infile ! input file
+ integer(i4b) ,intent(out) :: ncId ! NetCDF ID
+ integer(i4b) ,intent(out) :: err ! error code
+ character(*) ,intent(out) :: message ! error message
+ ! local variables
+ character(len=256) :: cmessage ! error message for downwind routine
+ integer(i4b) :: iyyy,im,id,ih,imin ! date
+ integer(i4b) :: ih_tz,imin_tz ! time zone information
+ real(dp) :: dsec,dsec_tz ! seconds
+ integer(i4b) :: varId ! variable identifier
+ integer(i4b) :: mode ! netcdf file mode
+ integer(i4b) :: attLen ! attribute length
+ character(len=256) :: refTimeString ! reference time string
+
+ ! initialize error control
+ err=0; message='openForcingFile/'
+
+ ! open file
+ mode=nf90_NoWrite
+ call nc_file_open(trim(infile),mode,ncid,err,cmessage)
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
+
+ ! get definition of time data
+ err = nf90_inq_varid(ncid,'time',varId); if(err/=nf90_noerr)then; message=trim(message)//'cannot find time variable/'//trim(nf90_strerror(err)); return; endif
+ err = nf90_inquire_attribute(ncid,varId,'units',len = attLen); if(err/=nf90_noerr)then; message=trim(message)//'cannot find time units/'//trim(nf90_strerror(err)); return; endif
+ err = nf90_get_att(ncid,varid,'units',refTimeString); if(err/=nf90_noerr)then; message=trim(message)//'cannot read time units/'//trim(nf90_strerror(err)); return; endif
+
+ ! define the reference time for the model simulation
+ call extractTime(refTimeString, & ! input = units string for time data
+ iyyy,im,id,ih,imin,dsec, & ! output = year, month, day, hour, minute, second
+ ih_tz, imin_tz, dsec_tz, & ! output = time zone information (hour, minute, second)
+ err,cmessage) ! output = error code and error message
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
+
+ select case(trim(NC_TIME_ZONE))
+ case('ncTime'); forcingDataStruct(iFile)%tmZoneOffsetFracDay = sign(1, ih_tz) * fracDay(ih_tz, & ! time zone hour
+ imin_tz, & ! time zone minute
+ dsec_tz) ! time zone second
+ case('utcTime'); forcingDataStruct(iFile)%tmZoneOffsetFracDay = 0._dp
+ case('localTime'); forcingDataStruct(iFile)%tmZoneOffsetFracDay = 0._dp
+ case default; err=20; message=trim(message)//'unable to identify time zone info option'; return
+ end select ! (option time zone option)
+
+ call compjulday(iyyy,im,id,ih,imin,dsec, & ! output = year, month, day, hour, minute, second
+ refJulday_data,err,cmessage) ! output = julian day (fraction of day) + error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
+
+ ! get the time multiplier needed to convert time to units of days
+ select case( trim( refTimeString(1:index(refTimeString,' ')) ) )
+ case('seconds')
+ forcFileInfo(iFile)%convTime2Days=86400._dp
+ forcingDataStruct(iFile)%convTime2Days=86400._dp
+ case('minutes')
+ forcFileInfo(iFile)%convTime2Days=1440._dp
+ forcingDataStruct(iFile)%convTime2Days=1440._dp
+ case('hours')
+ forcFileInfo(iFile)%convTime2Days=24._dp
+ forcingDataStruct(iFile)%convTime2Days=24._dp
+ case('days')
+ forcFileInfo(iFile)%convTime2Days=1._dp
+ forcingDataStruct(iFile)%convTime2Days=1._dp
+ case default; message=trim(message)//'unable to identify time units'; err=20; return
+ end select
+
+ end subroutine openForcingFile
+
+end module access_forcing_module
\ No newline at end of file
diff --git a/build/source/driver/init_hru_actor.f90 b/build/source/actors/hru_actor/fortran_code/init_hru_actor.f90
similarity index 97%
rename from build/source/driver/init_hru_actor.f90
rename to build/source/actors/hru_actor/fortran_code/init_hru_actor.f90
index b8837de..4089ead 100755
--- a/build/source/driver/init_hru_actor.f90
+++ b/build/source/actors/hru_actor/fortran_code/init_hru_actor.f90
@@ -74,7 +74,6 @@ contains
! ---------------------------------------------------------------------------------------
! data types
USE nrtype ! variable types, etc.
- USE time_utils_module,only:elapsedSec ! calculate the elapsed time
! subroutines and functions: allocate space
USE allocspace_module,only:allocLocal
! timing variables
@@ -86,8 +85,9 @@ contains
USE globalData,only:gru_struc ! gru-hru mapping structures
USE globalData,only:structInfo ! information on the data structures
USE globalData,only:numtim
- USE var_lookup,only:maxvarFreq ! maximum number of output files
USE globalData,only:startTime,finshTime,refTime,oldTime
+
+ USE var_lookup,only:maxvarFreq ! maximum number of output files
implicit none
@@ -150,9 +150,9 @@ contains
! ---------------------------------------------------------------------------------------
! * Local Subroutine Variables
! ---------------------------------------------------------------------------------------
- character(LEN=256) :: message ! error message
- character(LEN=256) :: cmessage ! error message of downwind routine
- integer(i4b) :: iStruct ! looping variables
+ character(LEN=256) :: message ! error message
+ character(LEN=256) :: cmessage ! error message of downwind routine
+ integer(i4b) :: iStruct ! looping variables
! ---------------------------------------------------------------------------------------
! * Convert From C++ to Fortran
! ---------------------------------------------------------------------------------------
diff --git a/build/source/driver/SummaActors_setup.f90 b/build/source/driver/SummaActors_setup.f90
index 2552085..8f8b80a 100755
--- a/build/source/driver/SummaActors_setup.f90
+++ b/build/source/driver/SummaActors_setup.f90
@@ -96,7 +96,6 @@ subroutine setupHRUParam(&
! USE read_attribute_module,only:read_attribute ! module to read local attributes
USE paramCheck_module,only:paramCheck ! module to check consistency of model parameters
USE pOverwrite_module,only:pOverwrite ! module to overwrite default parameter values with info from the Noah tables
- USE read_param4chm_module,only:read_param ! module to read model parameter sets
USE ConvE2Temp_module,only:E2T_lookup ! module to calculate a look-up table for the temperature-enthalpy conversion
USE t2enthalpy_module,only:T2E_lookup ! module to calculate a look-up table for the temperature-enthalpy conversion
USE var_derive_module,only:fracFuture ! module to calculate the fraction of runoff in future time steps (time delay histogram)
diff --git a/build/source/driver/summaActors_wOutputStruc.f90 b/build/source/driver/summaActors_wOutputStruc.f90
deleted file mode 100644
index 1a3c76b..0000000
--- a/build/source/driver/summaActors_wOutputStruc.f90
+++ /dev/null
@@ -1,336 +0,0 @@
-module summaActors_writeOutputStruc
-
-USE data_types,only:&
- var_i, &
- var_i8, &
- var_d, &
- var_ilength, &
- var_dlength, &
- flagVec
-! named variables to define new output files
-USE netcdf
-USE netcdf_util_module,only:netcdf_err
-USE nrtype
-USE globalData,only:noNewFiles
-USE globalData,only:newFileEveryOct1
-USE globalData,only:chunkSize ! size of chunks to write
-USE globalData,only:outputPrecision ! data structure for output precision
-USE globalData,only:integerMissing ! missing integer
-! metadata
-USE globalData,only:time_meta ! metadata on the model time
-USE globalData,only:forc_meta ! metadata on the model forcing data
-USE globalData,only:diag_meta ! metadata on the model diagnostic variables
-USE globalData,only:prog_meta ! metadata on the model prognostic variables
-USE globalData,only:flux_meta ! metadata on the model fluxes
-USE globalData,only:indx_meta ! metadata on the model index variables
-USE globalData,only:bvar_meta ! metadata on basin-average variables
-USE globalData,only:bpar_meta ! basin parameter metadata structure
-USE globalData,only:mpar_meta ! local parameter metadata structure
-! child metadata for stats
-USE globalData,only:statForc_meta ! child metadata for stats
-USE globalData,only:statProg_meta ! child metadata for stats
-USE globalData,only:statDiag_meta ! child metadata for stats
-USE globalData,only:statFlux_meta ! child metadata for stats
-USE globalData,only:statIndx_meta ! child metadata for stats
-USE globalData,only:statBvar_meta ! child metadata for stats
-! index of the child data structure
-USE globalData,only:forcChild_map ! index of the child data structure: stats forc
-USE globalData,only:progChild_map ! index of the child data structure: stats prog
-USE globalData,only:diagChild_map ! index of the child data structure: stats diag
-USE globalData,only:fluxChild_map ! index of the child data structure: stats flux
-USE globalData,only:indxChild_map ! index of the child data structure: stats indx
-USE globalData,only:bvarChild_map ! index of the child data structure: stats bvar
-USE globalData,only:outFreq ! output frequencies
-! named variables
-USE var_lookup,only:maxvarFreq ! maximum number of output files
-USE var_lookup,only:iLookTIME ! named variables for time data structure
-USE var_lookup,only:iLookDIAG ! named variables for local column model diagnostic variables
-USE var_lookup,only:iLookPROG ! named variables for local column model prognostic variables
-USE var_lookup,only:iLookINDEX ! named variables for local column index variables
-USE var_lookup,only:iLookFreq ! named variables for the frequency structure
-USE get_ixname_module,only:get_freqName ! get name of frequency from frequency index
-
-
-implicit none
-private
-public::summaActors_writeToOutputStruc
-
-contains
-subroutine summaActors_writeToOutputStruc(&
- indxHRU, &
- indxGRU, &
- modelTimeStep, &
- ! statistics variables
- forcStat, & ! model forcing data
- progStat, & ! model prognostic (state) variables
- diagStat, & ! model diagnostic variables
- fluxStat, & ! model fluxes
- indxStat, & ! model indices
- bvarStat, & ! basin-average variables
- ! primary data structures (scalars)
- timeStruct, & ! x%var(:) -- model time data
- forcStruct, & ! x%var(:) -- model forcing data
- attrStruct, & ! x%var(:) -- local attributes for each HRU
- typeStruct, & ! x%var(:) -- local classification of soil veg etc. for each HRU
- ! primary data structures (variable length vectors)
- indxStruct, & ! x%var(:)%dat -- model indices
- mparStruct, & ! x%var(:)%dat -- model parameters
- progStruct, & ! x%var(:)%dat -- model prognostic (state) variables
- diagStruct, & ! x%var(:)%dat -- model diagnostic variables
- fluxStruct, & ! x%var(:)%dat -- model fluxes
- ! basin-average structures
- bparStruct, & ! x%var(:) -- basin-average parameters
- bvarStruct, & ! x%var(:)%dat -- basin-average variables
- ! local HRU data
- statCounter, & ! x%var(:)
- outputTimeStep, & ! x%var(:)
- resetStats, & ! x%var(:)
- finalizeStats, & ! x%var(:)
- finshTime, & ! x%var(:) -- end time for the model simulation
- oldTime, & ! x%var(:) -- time for the previous model time step
- outputStep, & ! index into the output Struc
- ! run time variables
- err, message)
- USE nrtype
- USE globalData,only:structInfo
- USE globalData,only:startWrite,endWrite
- USE globalData,only:maxLayers ! maximum number of layers
- USE globalData,only:maxSnowLayers ! maximum number of snow layers
-
- USE globalData,only:ixProgress ! define frequency to write progress
- USE globalData,only:ixRestart ! define frequency to write restart files
- USE globalData,only:gru_struc
-
- USE globalData,only:newOutputFile ! define option for new output files
- USE summa_alarms,only:summa_setWriteAlarms
- USE summaActors_FileManager,only:OUTPUT_PATH,OUTPUT_PREFIX ! define output file
- USE summaActors_FileManager,only:STATE_PATH ! optional path to state output files (defaults to OUTPUT_PATH)
- USE globalData,only:output_fileSuffix
-
- USE globalData,only:forc_meta,attr_meta,type_meta ! metaData structures
- USE output_stats,only:calcStats ! module for compiling output statistics
- USE outputStrucWrite_module,only:writeData,writeBasin ! module to write model output
- USE outputStrucWrite_module,only:writeTime ! module to write model time
- USE outputStrucWrite_module,only:writeRestart ! module to write model Restart
- USE outputStrucWrite_module,only:writeParm ! module to write model parameters
- USE time_utils_module,only:elapsedSec ! calculate the elapsed time
- USE globalData,only:elapsedWrite ! elapsed time to write data
- USE globalData,only:outputStructure
-
- implicit none
- integer(i4b),intent(in) :: indxHRU ! index of hru in GRU
- integer(i4b),intent(in) :: indxGRU ! index of the GRU
- integer(i4b),intent(in) :: modelTimeStep ! time step index
- ! statistics variables
- type(var_dlength),intent(inout) :: forcStat ! model forcing data
- type(var_dlength),intent(inout) :: progStat ! model prognostic (state) variables
- type(var_dlength),intent(inout) :: diagStat ! model diagnostic variables
- type(var_dlength),intent(inout) :: fluxStat ! model fluxes
- type(var_dlength),intent(inout) :: indxStat ! model indices
- type(var_dlength),intent(inout) :: bvarStat ! basin-average variabl
- ! primary data structures (scalars)
- type(var_i),intent(inout) :: timeStruct ! model time data
- type(var_d),intent(inout) :: forcStruct ! model forcing data
- type(var_d),intent(inout) :: attrStruct ! local attributes for each HRU
- type(var_i),intent(inout) :: typeStruct ! local classification of soil veg etc. for each HRU
- ! primary data structures (variable length vectors)
- type(var_ilength),intent(inout) :: indxStruct ! model indices
- type(var_dlength),intent(inout) :: mparStruct ! model parameters
- type(var_dlength),intent(inout) :: progStruct ! model prognostic (state) variables
- type(var_dlength),intent(inout) :: diagStruct ! model diagnostic variables
- type(var_dlength),intent(inout) :: fluxStruct ! model fluxes
- ! basin-average structures
- type(var_d),intent(inout) :: bparStruct ! basin-average parameters
- type(var_dlength),intent(inout) :: bvarStruct ! basin-average variables
- ! local HRU data
- type(var_i),intent(inout) :: statCounter ! time counter for stats
- type(var_i),intent(inout) :: outputTimeStep ! timestep in output files
- type(flagVec),intent(inout) :: resetStats ! flags to reset statistics
- type(flagVec),intent(inout) :: finalizeStats ! flags to finalize statistics
- type(var_i),intent(inout) :: finshTime ! end time for the model simulation
- type(var_i),intent(inout) :: oldTime !
- integer(i4b),intent(in) :: outputStep ! index into the outputStructure
- ! run time variables
- integer(i4b),intent(out) :: err
- character(*),intent(out) :: message
-
- ! local variables
- character(len=256) :: cmessage
- logical(lgt) :: defNewOutputFile=.false.
- logical(lgt) :: printRestart=.false.
- logical(lgt) :: printProgress=.false.
- character(len=256) :: restartFile ! restart file name
- character(len=256) :: timeString ! portion of restart file name that contains the write-out time
- integer(i4b) :: iStruct ! index of model structure
- integer(i4b) :: nGRU
- integer(i4b) :: nHRU
- integer(i4b) :: iFreq ! index of the output frequency
- integer(i4b) :: iGRU ! Temporary index for GRU
- integer(i4b) :: i
- integer(i4b) :: j
-
- nGRU = 1
- nHRU = 1
- iGRU = 1
-
-
- err=0; message='summa_manageOutputFiles/'
- ! identify the start of the writing
- call date_and_time(values=startWrite)
-
- ! initialize the statistics flags
- if(modelTimeStep==1)then
-
- ! initialize time step index
- allocate(statCounter%var(maxVarFreq))
- allocate(outputTimeStep%var(maxVarFreq))
- statCounter%var(1:maxVarFreq) = 1
- outputTimeStep%var(1:maxVarFreq) = 1
-
- allocate(resetStats%dat(maxVarFreq))
- allocate(finalizeStats%dat(maxVarFreq))
- ! initialize flags to reset/finalize statistics
- resetStats%dat(:) = .true. ! start by resetting statistics
- finalizeStats%dat(:) = .false. ! do not finalize stats on the first time step
-
- ! set stats flag for the timestep-level output
- finalizeStats%dat(iLookFreq%timestep)=.true.
- endif ! if the first time step
-
- ! Many variables get there values from summa4chm_util.f90:getCommandArguments()
- call summa_setWriteAlarms(oldTime%var, timeStruct%var, finshTime%var, & ! time vectors
- newOutputFile, defNewOutputFile, &
- ixRestart, printRestart, & ! flag to print the restart file
- ixProgress, printProgress, & ! flag to print simulation progress
- resetStats%dat, finalizeStats%dat, & ! flags to reset and finalize stats
- statCounter%var, & ! statistics counter
- err, cmessage) ! error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
-
- ! check the need to create a new output file
- if(modelTimeStep==1)then
- ! define summa output files
- ! initialize error control
- err=0; message='summaActors_defineOuputParm/'
- ! write parameters for the HRU
- 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
-
- ! re-initalize the indices for model writing
- outputTimeStep%var(:)=1
- end if ! if defining a new file
-
- ! If we do not do this looping we segfault - I am not sure why
- outputStructure(1)%finalizeStats(1)%gru(indxGRU)%hru(indxHRU)%tim(outputStep)%dat(:) = finalizeStats%dat(:)
- ! ****************************************************************************
- ! *** calculate output statistics
- ! ****************************************************************************
- do iStruct=1,size(structInfo)
- select case(trim(structInfo(iStruct)%structName))
- case('forc'); call calcStats(forcStat%var, forcStruct%var, statForc_meta, resetStats%dat, finalizeStats%dat, statCounter%var, err, cmessage)
- case('prog'); call calcStats(progStat%var, progStruct%var, statProg_meta, resetStats%dat, finalizeStats%dat, statCounter%var, err, cmessage)
- case('diag'); call calcStats(diagStat%var, diagStruct%var, statDiag_meta, resetStats%dat, finalizeStats%dat, statCounter%var, err, cmessage)
- case('flux'); call calcStats(fluxStat%var, fluxStruct%var, statFlux_meta, resetStats%dat, finalizeStats%dat, statCounter%var, err, cmessage)
- case('indx'); call calcStats(indxStat%var, indxStruct%var, statIndx_meta, resetStats%dat, finalizeStats%dat, statCounter%var, err, cmessage)
- end select
- if(err/=0)then; message=trim(message)//trim(cmessage)//'['//trim(structInfo(iStruct)%structName)//']'; return; endif
- end do ! (looping through structures)
-
- ! calc basin stats
- call calcStats(bvarStat%var(:), bvarStruct%var(:), statBvar_meta, resetStats%dat, finalizeStats%dat, statCounter%var, err, cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage)//'[bvar stats]'; return; endif
-
- ! write basin-average variables
- call writeBasin(indxGRU,indxHRU,outputStep,finalizeStats%dat, &
- outputTimeStep%var,bvar_meta,bvarStat%var,bvarStruct%var,bvarChild_map,err,cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage)//'[bvar]'; return; endif
-
- ! ****************************************************************************
- ! *** write data
- ! ****************************************************************************
- call writeTime(indxGRU,indxHRU,outputStep,finalizeStats%dat, &
- time_meta,timeStruct%var,err,message)
-
- ! write the model output to the OutputStructure
- ! Passes the full metadata structure rather than the stats metadata structure because
- ! we have the option to write out data of types other than statistics.
- ! Thus, we must also pass the stats parent->child maps from childStruct.
- do iStruct=1,size(structInfo)
- select case(trim(structInfo(iStruct)%structName))
- case('forc'); call writeData(indxGRU,indxHRU,outputStep,"forc",finalizeStats%dat,&
- maxLayers,forc_meta,forcStat,forcStruct,forcChild_map,indxStruct,err,cmessage)
- case('prog'); call writeData(indxGRU,indxHRU,outputStep,"prog",finalizeStats%dat,&
- maxLayers,prog_meta,progStat,progStruct,progChild_map,indxStruct,err,cmessage)
- case('diag'); call writeData(indxGRU,indxHRU,outputStep,"diag",finalizeStats%dat,&
- maxLayers,diag_meta,diagStat,diagStruct,diagChild_map,indxStruct,err,cmessage)
- case('flux'); call writeData(indxGRU,indxHRU,outputStep,"flux",finalizeStats%dat,&
- maxLayers,flux_meta,fluxStat,fluxStruct,fluxChild_map,indxStruct,err,cmessage)
- case('indx'); call writeData(indxGRU,indxHRU,outputStep,"indx",finalizeStats%dat,&
- maxLayers,indx_meta,indxStat,indxStruct,indxChild_map,indxStruct,err,cmessage)
- end select
- if(err/=0)then
- message=trim(message)//trim(cmessage)//'['//trim(structInfo(iStruct)%structName)//']'
- return
- endif
- end do ! (looping through structures)
- ! *****************************************************************************
- ! *** write restart file
- ! *****************************************************************************
-
- ! print a restart file if requested
- if(printRestart)then
- write(timeString,'(i4,3(i2.2))') timeStruct%var(iLookTIME%iyyy),timeStruct%var(iLookTIME%im),timeStruct%var(iLookTIME%id),timeStruct%var(iLookTIME%ih)
-
- if(STATE_PATH == '') then
- restartFile=trim(OUTPUT_PATH)//trim(OUTPUT_PREFIX)//'_restart_'//trim(timeString)//trim(output_fileSuffix)//'.nc'
- else
- restartFile=trim(STATE_PATH)//trim(OUTPUT_PREFIX)//'_restart_'//trim(timeString)//trim(output_fileSuffix)//'.nc'
- endif
-
- call writeRestart(restartFile,nGRU,nHRU,prog_meta,progStruct,bvar_meta,bvarStruct,maxLayers,maxSnowLayers,indx_meta,indxStruct,err,cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
- end if
-
- ! *****************************************************************************
- ! *** update counters
- ! *****************************************************************************
-
- ! increment output file timestep
- do iFreq = 1,maxvarFreq
- statCounter%var(iFreq) = statCounter%var(iFreq)+1
- if(finalizeStats%dat(iFreq)) outputTimeStep%var(iFreq) = outputTimeStep%var(iFreq) + 1
- end do
-
- ! if finalized stats, then reset stats on the next time step
- resetStats%dat(:) = finalizeStats%dat(:)
-
- ! save time vector
- oldTime%var(:) = timeStruct%var(:)
-
- ! *****************************************************************************
- ! *** finalize
- ! *****************************************************************************
-
- ! identify the end of the writing
- call date_and_time(values=endWrite)
-
- elapsedWrite = elapsedWrite + elapsedSec(startWrite, endWrite)
-
-
-
-end subroutine summaActors_writeToOutputStruc
-
-end module summaActors_writeOutputStruc
\ No newline at end of file
diff --git a/build/source/engine/access_forcing.f90 b/build/source/engine/access_forcing.f90
deleted file mode 100644
index 2e04300..0000000
--- a/build/source/engine/access_forcing.f90
+++ /dev/null
@@ -1,233 +0,0 @@
-
-! This module contains all the functions that are used to
-! access the forcing file and setup the forcing data
-! for the HRUs to read from
-module access_forcing_module
-
-USE nrtype
-
-USE data_types,only:file_info
-USE data_types,only:file_info_array
-
-USE globalData,only:gru_struc
-USE globalData,only:forcingDataStruct
-USE globalData,only:vecTime
-USE globalData,only:outputStructure
-USE globalData,only:time_meta,forc_meta ! metadata structures
-USE globalData,only:integerMissing ! integer missing value
-
-
-USE var_lookup,only:iLookTIME,iLookFORCE ! named variables to define structure elements
-
-
-USE summaActors_FileManager,only:FORCING_PATH ! path of the forcing data file
-USE netcdf_util_module,only:nc_file_close ! close netcdf file
-
-
-implicit none
-private
-public::access_forcingFile
-
-contains
-
-subroutine access_forcingFile(forcFileInfo, iFile, stepsInFile, startGRU, numGRU, err, message)
- USE netcdf ! netcdf capability
- USE netcdf_util_module,only:nc_file_open ! open netcdf file
- implicit none
- type(file_info_array),intent(inout) :: forcFileInfo
- integer(i4b),intent(in) :: iFile
- integer(i4b),intent(inout) :: stepsInFile
- integer(i4b),intent(in) :: startGRU
- integer(i4b),intent(in) :: numGRU
- integer(i4b),intent(inout) :: err
- character(*),intent(out) :: message
- ! local varibles
- integer(i4b) :: iHRU_Global
- integer(i4b) :: varId
- integer(i4b) :: ncid
- integer(i4b) :: nFiles
- integer(i4b) :: nTimeSteps
- integer(i4b) :: numHRU
- integer(i4b) :: nVars
- integer(i4b) :: iVar
- integer(i4b) :: iNC
- integer(i4b) :: attLen ! attribute length
- character(len=256) :: infile
- character(len=256) :: cmessage
- character(len = nf90_max_name) :: varName ! dimenison name
- logical(lgt),dimension(size(forc_meta)) :: checkForce ! flags to check forcing data variables exist
-
- ! Start Procedure here
- err=0; message="access_forcing/"
-
- nFiles=size(forcFileInfo%ffile_list(:))
-
- nTimeSteps = sum(forcFileInfo%ffile_list(:)%nTimeSteps)
-
- ! Allocate forcing data input Struct
- if (.not.allocated(forcingDataStruct))then
- allocate(forcingDataStruct(nFiles))
- ! Allocate timing variables from forcing File
- allocate(vecTime(nFiles))
- endif
-
- ! Files are assumed to be in the correct order
- ! do iFile=1,nFiles
- infile=trim(FORCING_PATH)//trim(forcFileInfo%ffile_list(iFile)%filenmData)
- ! open netCDF file
- call openForcingFile(forcFileInfo%ffile_list,iFile,trim(infile),ncid,err,cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage);return; end if
-
- err = nf90_inq_varid(ncid,'time',varId); if(err/=nf90_noerr)then; message=trim(message)//'cannot find time variable/'//trim(nf90_strerror(err)); return; endif
- err = nf90_inquire_attribute(ncid,varId,'units',len = attLen); if(err/=nf90_noerr)then; message=trim(message)//'cannot find time units/'//trim(nf90_strerror(err)); return; endif
- err = nf90_get_att(ncid,varid,'units',forcingDataStruct(iFile)%refTimeString);if(err/=nf90_noerr)then; message=trim(message)//'cannot read time units/'//trim(nf90_strerror(err)); return; endif
-
-
- nTimeSteps = forcFileInfo%ffile_list(iFile)%nTimeSteps
- forcingDataStruct(iFile)%nTimeSteps = nTimeSteps
- stepsInFile = nTimeSteps
- if(.not.allocated(vecTime(iFile)%dat))then
- allocate(vecTime(iFile)%dat(nTimeSteps))
- end if
-
- ! Get Time Information
- err = nf90_inq_varid(ncid,'time',varId);
- if(err/=nf90_noerr)then; message=trim(message)//'trouble finding time variable/'//trim(nf90_strerror(err)); return; endif
- err = nf90_get_var(ncid,varId,vecTime(iFile)%dat(:),start=(/1/),count=(/nTimeSteps/))
- if(err/=nf90_noerr)then; message=trim(message)//'trouble reading time variable/'//trim(nf90_strerror(err)); return; endif
-
- ! Need to loop through vars and add forcing data
- nVars = forcFileInfo%ffile_list(iFile)%nVars
- forcingDataStruct(iFile)%nVars = nVars
- if (.not.allocated(forcingDataStruct(iFile)%var))then
- allocate(forcingDataStruct(iFile)%var(nVars))
- endif
- if (.not.allocated(forcingDataStruct(iFile)%var_ix))then
- allocate(forcingDataStruct(iFile)%var_ix(nVars))
- endif
- forcingDataStruct(iFile)%var_ix(:) = integerMissing
-
- ! initialize flags for forcing data
- checkForce(:) = .false.
- checkForce(iLookFORCE%time) = .true. ! time is handled separately
- do iNC=1,nVars
- ! populate var_ix so HRUs can access the values
- forcingDataStruct(iFile)%var_ix(iNC) = forcFileInfo%ffile_list(iFile)%var_ix(iNC)
-
- ! check variable is desired
- if(forcFileInfo%ffile_list(iFile)%var_ix(iNC)==integerMissing) cycle
-
-
- iVar = forcFileInfo%ffile_list(iFile)%var_ix(iNC)
- checkForce(iVar) = .true.
- if (.not.allocated(forcingDataStruct(iFile)%var(iVar)%dataFromFile))then
- allocate(forcingDataStruct(iFile)%var(iVar)%dataFromFile(numGRU,nTimeSteps))
- endif
-
- ! Get Forcing Data
- ! get variable name for error reporting
- err=nf90_inquire_variable(ncid,iNC,name=varName)
- if(err/=nf90_noerr)then; message=trim(message)//'problem reading forcing variable name from netCDF: '//trim(nf90_strerror(err)); return; endif
-
- ! define global HRU
- iHRU_global = gru_struc(1)%hruInfo(1)%hru_nc
- numHRU = sum(gru_struc(:)%hruCount)
-
-
- err=nf90_get_var(ncid,forcFileInfo%ffile_list(iFile)%data_id(ivar),forcingDataStruct(iFile)%var(iVar)%dataFromFile, start=(/startGRU,1/),count=(/numHRU, nTimeSteps/))
- if(err/=nf90_noerr)then; message=trim(message)//'problem reading forcing data: '//trim(varName)//'/'//trim(nf90_strerror(err)); return; endif
-
-
- end do
-
- call nc_file_close(ncid,err,message)
- if(err/=0)then;message=trim(message)//trim(cmessage);return;end if
-
-
-end subroutine access_forcingFile
-
-! *************************************************************************
-! * open the NetCDF forcing file and get the time information
-! *************************************************************************
-subroutine openForcingFile(forcFileInfo,iFile,infile,ncId,err,message)
- USE netcdf ! netcdf capability
- USE netcdf_util_module,only:nc_file_open ! open netcdf file
- USE time_utils_module,only:fracDay ! compute fractional day
- USE time_utils_module,only:extractTime ! extract time info from units string
- USE time_utils_module,only:compJulday ! convert calendar date to julian day
- !USE globalData,only:tmZoneOffsetFracDay ! time zone offset in fractional days
- USE globalData,only:ncTime ! time zone information from NetCDF file (timeOffset = longitude/15. - ncTimeOffset)
- USE globalData,only:utcTime ! all times in UTC (timeOffset = longitude/15. hours)
- USE globalData,only:localTime ! all times local (timeOffset = 0)
- USE globalData,only:refJulday_data
- USE summaActors_filemanager,only:NC_TIME_ZONE
- ! dummy variables
- type(file_info),intent(inout) :: forcFileInfo(:)
- integer(i4b),intent(in) :: iFile ! index of current forcing file in forcing file list
- character(*) ,intent(in) :: infile ! input file
- integer(i4b) ,intent(out) :: ncId ! NetCDF ID
- integer(i4b) ,intent(out) :: err ! error code
- character(*) ,intent(out) :: message ! error message
- ! local variables
- character(len=256) :: cmessage ! error message for downwind routine
- integer(i4b) :: iyyy,im,id,ih,imin ! date
- integer(i4b) :: ih_tz,imin_tz ! time zone information
- real(dp) :: dsec,dsec_tz ! seconds
- integer(i4b) :: varId ! variable identifier
- integer(i4b) :: mode ! netcdf file mode
- integer(i4b) :: attLen ! attribute length
- character(len=256) :: refTimeString ! reference time string
-
- ! initialize error control
- err=0; message='openForcingFile/'
-
- ! open file
- mode=nf90_NoWrite
- call nc_file_open(trim(infile),mode,ncid,err,cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
-
- ! get definition of time data
- err = nf90_inq_varid(ncid,'time',varId); if(err/=nf90_noerr)then; message=trim(message)//'cannot find time variable/'//trim(nf90_strerror(err)); return; endif
- err = nf90_inquire_attribute(ncid,varId,'units',len = attLen); if(err/=nf90_noerr)then; message=trim(message)//'cannot find time units/'//trim(nf90_strerror(err)); return; endif
- err = nf90_get_att(ncid,varid,'units',refTimeString); if(err/=nf90_noerr)then; message=trim(message)//'cannot read time units/'//trim(nf90_strerror(err)); return; endif
-
- ! define the reference time for the model simulation
- call extractTime(refTimeString, & ! input = units string for time data
- iyyy,im,id,ih,imin,dsec, & ! output = year, month, day, hour, minute, second
- ih_tz, imin_tz, dsec_tz, & ! output = time zone information (hour, minute, second)
- err,cmessage) ! output = error code and error message
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
-
- select case(trim(NC_TIME_ZONE))
- case('ncTime'); forcingDataStruct(iFile)%tmZoneOffsetFracDay = sign(1, ih_tz) * fracDay(ih_tz, & ! time zone hour
- imin_tz, & ! time zone minute
- dsec_tz) ! time zone second
- case('utcTime'); forcingDataStruct(iFile)%tmZoneOffsetFracDay = 0._dp
- case('localTime'); forcingDataStruct(iFile)%tmZoneOffsetFracDay = 0._dp
- case default; err=20; message=trim(message)//'unable to identify time zone info option'; return
- end select ! (option time zone option)
-
- call compjulday(iyyy,im,id,ih,imin,dsec, & ! output = year, month, day, hour, minute, second
- refJulday_data,err,cmessage) ! output = julian day (fraction of day) + error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
-
- ! get the time multiplier needed to convert time to units of days
- select case( trim( refTimeString(1:index(refTimeString,' ')) ) )
- case('seconds')
- forcFileInfo(iFile)%convTime2Days=86400._dp
- forcingDataStruct(iFile)%convTime2Days=86400._dp
- case('minutes')
- forcFileInfo(iFile)%convTime2Days=1440._dp
- forcingDataStruct(iFile)%convTime2Days=1440._dp
- case('hours')
- forcFileInfo(iFile)%convTime2Days=24._dp
- forcingDataStruct(iFile)%convTime2Days=24._dp
- case('days')
- forcFileInfo(iFile)%convTime2Days=1._dp
- forcingDataStruct(iFile)%convTime2Days=1._dp
- case default; message=trim(message)//'unable to identify time units'; err=20; return
- end select
-
- end subroutine openForcingFile
-
-end module access_forcing_module
\ No newline at end of file
diff --git a/build/source/engine/access_write.f90 b/build/source/engine/access_write.f90
deleted file mode 100644
index e69de29..0000000
diff --git a/build/source/engine/alloc_file_access.f90 b/build/source/engine/alloc_file_access.f90
deleted file mode 100644
index 139982f..0000000
--- a/build/source/engine/alloc_file_access.f90
+++ /dev/null
@@ -1,322 +0,0 @@
-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_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
-
-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
- 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)
-
- class is (var_time_i)
- if(allocated(dataStruct%var))then
- check=.true.
- else
- allocate(dataStruct%var(nVars),stat=err)
- end if
-
- do iVar=1, nVars
- allocate(dataStruct%var(iVar)%tim(nSteps))
- end do
- return
-
- class is (var_time_i8)
- if(allocated(dataStruct%var))then
- check=.true.
- else
- allocate(dataStruct%var(nVars),stat=err)
- end if
- do iVar=1, nVars
- allocate(dataStruct%var(iVar)%tim(nSteps))
- end do
- return
-
- class is (var_time_d)
- if(allocated(dataStruct%var))then
- check=.true.
- else
- allocate(dataStruct%var(nVars),stat=err)
- end if
- do iVar=1, nVars
- allocate(dataStruct%var(iVar)%tim(nSteps))
- end do
- return
-
- class is (var_d)
- if(allocated(dataStruct%var))then
- check=.true.
- else
- allocate(dataStruct%var(nVars),stat=err)
- end if
- return
-
- class is (var_i)
- if(allocated(dataStruct%var))then
- check=.true.
- else
- allocate(dataStruct%var(nVars),stat=err)
- end if
- return
-
- class is (var_i8)
- if(allocated(dataStruct%var))then
- check=.true.
- else
- allocate(dataStruct%var(nVars), stat=err)
- end if
- return
-
- class is (var_dlength)
- if(allocated(dataStruct%var))then
- check=.true.
- else
- allocate(dataStruct%var(nVars),stat=err)
- end if
- ! class is (var_flagVec); if(allocated(dataStruct%var))then; check=.true.; else; allocate(dataStruct%var(nVars),stat=err); end if
-
- class is (var_time_ilength)
- if(allocated(dataStruct%var))then
- check=.true.
- else
- allocate(dataStruct%var(nVars),stat=err)
- end if
- do iVar=1, nVars
- allocate(dataStruct%var(iVar)%tim(nSteps))
- end do
-
- class is (var_time_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'
-
- 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'
-
- nVars = size(metaData)
- nLayers = nSnow+nSoil
- do iVar=1, nVars
- select case(metadata(iVar)%vartype)
- case(iLookVarType%scalarv); allocate(varData%var(iVar)%dat(1),stat=err)
- case(iLookVarType%wLength); allocate(varData%var(iVar)%dat(nBand),stat=err)
- case(iLookVarType%midSnow); allocate(varData%var(iVar)%dat(nSnow),stat=err)
- case(iLookVarType%midSoil); allocate(varData%var(iVar)%dat(nSoil),stat=err)
- case(iLookVarType%midToto); allocate(varData%var(iVar)%dat(nLayers),stat=err)
- case(iLookVarType%ifcSnow); allocate(varData%var(iVar)%dat(0:nSnow),stat=err)
- case(iLookVarType%ifcSoil); allocate(varData%var(iVar)%dat(0:nSoil),stat=err)
- case(iLookVarType%ifcToto); allocate(varData%var(iVar)%dat(0:nLayers),stat=err)
- case(iLookVarType%parSoil); allocate(varData%var(iVar)%dat(nSoil),stat=err)
- case(iLookVarType%routing); allocate(varData%var(iVar)%dat(nTimeDelay),stat=err)
- case(iLookVarType%outstat); allocate(varData%var(iVar)%dat(maxvarfreq*2),stat=err)
- case(iLookVarType%unknown); allocate(varData%var(iVar)%dat(0),stat=err)
- case default
- err=40; message=trim(message)//"1. unknownVariableType[name='"//trim(metadata(iVar)%varname)//"'; type='"//trim(get_varTypeName(metadata(iVar)%vartype))//"']"
- return
- end select
- end do
-
-end subroutine allocateDat_rkind
-
-subroutine allocateDat_int(metadata,varData,nSnow, nSoil, &
- nSteps,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
-
-
-end subroutine
-
-
-
-
-end module alloc_file_access
\ No newline at end of file
diff --git a/build/source/engine/read_dimension.f90 b/build/source/engine/read_dimension.f90
index 792e7f0..f8da759 100644
--- a/build/source/engine/read_dimension.f90
+++ b/build/source/engine/read_dimension.f90
@@ -224,131 +224,4 @@ subroutine read_dimension(numGRUs,numHRUs,startGRU,err) bind(C, name="readDimens
end subroutine read_dimension
-! subroutine read_attribute(indxHRU, indxGRU, attrStruct, typeStruct, idStruct, err, message)
-! USE netcdf
-! USE netcdf_util_module,only:nc_file_open ! open netcdf file
-! USE netcdf_util_module,only:nc_file_close ! close netcdf file
-! USE netcdf_util_module,only:netcdf_err ! netcdf error handling function
-! ! provide access to derived data types
-! USE data_types,only:var_d ! x%var(:) (i4b)
-! USE data_types,only:var_i ! x%var(:) integer(8)
-! USE data_types,only:var_i8 ! x%var(:) (dp)
-! ! provide access to global data
-! USE globalData,only:attr_meta,type_meta,id_meta ! metadata structures
-! USE get_ixname_module,only:get_ixAttr,get_ixType,get_ixId ! access function to find index of elements in structure
-! ! get the settings from the output stucture so we do not have to go to file
-! USE globalData,only:outputStructure
-! implicit none
-
-! integer(i4b),intent(in) :: indxHRU ! id of the HRU
-! integer(i4b),intent(in) :: indxGRU ! id of the parent GRU
-! ! io vars
-! type(var_d),intent(inout) :: attrStruct ! local attributes for each HRU
-! type(var_i),intent(inout) :: typeStruct ! local classification of soil veg etc. for each HRU
-! type(var_i8),intent(inout) :: idStruct !
-! integer(i4b),intent(out) :: err ! error code
-! character(*),intent(out) :: message ! error message
-
-! ! define local variables
-! integer(i4b) :: iVar ! loop through varibles in the netcdf file
-
-! ! check structures
-! integer(i4b) :: iCheck ! index of an attribute name
-! logical(lgt),allocatable :: checkType(:) ! vector to check if we have all desired categorical values
-! logical(lgt),allocatable :: checkId(:) ! vector to check if we have all desired IDs
-! logical(lgt),allocatable :: checkAttr(:) ! vector to check if we have all desired local attributes
-
-! ! netcdf variables
-! integer(i4b),parameter :: categorical=101 ! named variable to denote categorical data
-! integer(i4b),parameter :: numerical=102 ! named variable to denote numerical data
-! integer(i4b),parameter :: idrelated=103 ! named variable to denote ID related data
-
-! ! define mapping variables
-
-! ! Start procedure here
-! err=0; message="read_attribute.f90/"
-
-! ! **********************************************************************************************
-! ! (1) prepare check vectors
-! ! **********************************************************************************************
-! allocate(checkType(size(type_meta)),checkAttr(size(attr_meta)),checkId(size(id_meta)),stat=err)
-! if(err/=0)then
-! err=20
-! message=trim(message)//'problem allocating space for variable check vectors'
-! print*, message
-! return
-! endif
-
-! checkType(:) = .false.
-! checkAttr(:) = .false.
-! checkId(:) = .false.
-
-! ! Copy the attribute data that was filled in read_attribute_all_hru.f90
-
-! ! ** categorical data (typeStruct)
-! do iVar = 1, size(type_meta)
-! checkType(iVar) = .true.
-! typeStruct%var(iVar) = outputStructure(1)%typeStruct(1)%gru(indxGRU)%hru(indxHRU)%var(iVar)
-! end do
-
-! ! ** ID related data (idStruct)
-! do iVar=1, size(id_meta)
-! checkId(iVar) = .true.
-! idStruct%var(iVar) = outputStructure(1)%idStruct(1)%gru(indxGRU)%hru(indxHRU)%var(iVar)
-! end do
-
-! ! ** numerical data (attrStruct)
-! do iVar=1, size(attr_meta)
-! checkAttr(iVar) = .true.
-! attrStruct%var(iVar) = outputStructure(1)%attrStruct(1)%gru(indxGRU)%hru(indxHRU)%var(iVar)
-! end do
-
-! ! TODO: downkHRU can cause issues do not know how to hanlde yet
-! ! varIndx = get_ixTYPE('downkHRU')
-! ! checkType(varIndx) = .true.
-! ! typeStruct%var(varIndx) = 0
-
-! ! **********************************************************************************************
-! ! (4) check that we have all the desired varaibles
-! ! **********************************************************************************************
-! ! check that we have all desired categorical variables
-! if(any(.not.checkType))then
-! do iCheck = 1,size(type_meta)
-! if(.not.checkType(iCheck))then
-! err=20; message=trim(message)//'missing variable ['//trim(type_meta(iCheck)%varname)//'] in local attributes file'
-! print*, message
-! return
-! endif
-! end do
-! endif
-
-! ! check that we have all desired ID variables
-! if(any(.not.checkId))then
-! do iCheck = 1,size(id_meta)
-! if(.not.checkId(iCheck))then
-! err=20
-! message=trim(message)//'missing variable ['//trim(id_meta(iCheck)%varname)//'] in local attributes file'
-! print*, message
-! return
-! endif
-! end do
-! endif
-
-! ! check that we have all desired local attributes
-! if(any(.not.checkAttr))then
-! do iCheck = 1,size(attr_meta)
-! if(.not.checkAttr(iCheck))then
-! err=20
-! message=trim(message)//'missing variable ['//trim(attr_meta(iCheck)%varname)//'] in local attributes file'
-! return
-! endif
-! end do
-! endif
-
-! ! free memory
-! deallocate(checkType)
-! deallocate(checkId)
-! deallocate(checkAttr)
-
-! end subroutine read_attribute
end module read_dimension_module
diff --git a/build/source/engine/read_paramActors.f90 b/build/source/engine/read_paramActors.f90
deleted file mode 100755
index c6cb2dd..0000000
--- a/build/source/engine/read_paramActors.f90
+++ /dev/null
@@ -1,84 +0,0 @@
-! SUMMA - Structure for Unifying Multiple Modeling Alternatives
-! Copyright (C) 2014-2020 NCAR/RAL; University of Saskatchewan; University of Washington
-!
-! This file is part of SUMMA
-!
-! For more information see: http://www.ral.ucar.edu/projects/summa
-!
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-module read_param4chm_module
-
-! missing values
-USE globalData,only:integerMissing ! missing integer
-USE globalData,only:realMissing ! missing real number
-
-! runtime options
-USE globalData,only:iRunModeFull,iRunModeGRU,iRunModeHRU ! run modes
-
-! common modules
-USE nrtype
-USE netcdf
-USE netcdf_util_module,only:nc_file_close ! close netcdf file
-USE netcdf_util_module,only:nc_file_open ! open netcdf file
-USE netcdf_util_module,only:netcdf_err ! netcdf error handling function
-
-! data types
-USE data_types,only:var_d ! spatial double data type: x%gru(:)%var(:)
-USE data_types,only:var_i8 ! spatial integer data type: x%gru(:)%hru(:)%var(:)
-USE data_types,only:var_dlength ! spatial double data type: x%gru(:)%hru(:)%var(:)%dat(:)
-
-implicit none
-private
-public::read_param
-contains
-
-
-! ************************************************************************************************
-! public subroutine read_param4chm: read trial model parameter values
-! ************************************************************************************************
-subroutine read_param(indxHRU,indxGRU,mparStruct,bparStruct,dparStruct,err)
- USE globalData,only:outputStructure
- USE globalData,only:mpar_meta,bpar_meta
-
- implicit none
- ! define input
- integer(i4b),intent(in) :: indxHRU
- integer(i4b),intent(in) :: indxGRU
- ! define output
- type(var_dlength),intent(inout) :: mparStruct ! model parameters
- type(var_d),intent(inout) :: bparStruct ! basin parameters
- type(var_d),intent(inout) :: dparStruct ! default model parameters
- integer(i4b),intent(out) :: err ! error code
- !
- character(len=256) :: message ! error message
- integer(i4b) :: iVar !
-
- ! Start procedure here
- err=0; message="read_paramActors.f90/"
-
- dparStruct%var(:) = outputStructure(1)%dparStruct(1)%gru(indxGRU)%hru(indxHRU)%var(:)
-
- ! populate parameter structures
- do iVar=1, size(mpar_meta)
- mparStruct%var(iVar)%dat(:) = outputStructure(1)%mparStruct(1)%gru(indxGRU)%hru(indxHRU)%var(iVar)%dat(:)
- end do
-
- do iVar=1, size(bpar_meta)
- bparStruct%var(iVar) = outputStructure(1)%bparStruct(1)%gru(indxGRU)%var(iVar)
- end do
-
- end subroutine read_param
-
-end module read_param4chm_module
--
GitLab