diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
deleted file mode 100644
index 2175fbf0f2ec3b99f397c11fc977a32d5499e94d..0000000000000000000000000000000000000000
--- a/.gitlab-ci.yml
+++ /dev/null
@@ -1,15 +0,0 @@
-# Define the stages of the CI pipeline
-stages:
- - build
- - test
-
-# Define the build job
-build:
- stage: build
- script:
- - echo "Building program"
- - cd build/cmake
- - mkdir build
- - cd build
- - cmake ..
- - make
\ No newline at end of file
diff --git a/build/source/actors/file_access_actor/fortran_code/output_structure.f90 b/build/source/actors/file_access_actor/fortran_code/output_structure.f90
index c22e95383fd3bc3546f2d94679250fef0f0475c3..dd2a8c4f229af3cb4508a3b0cd7d70da004979ad 100644
--- a/build/source/actors/file_access_actor/fortran_code/output_structure.f90
+++ b/build/source/actors/file_access_actor/fortran_code/output_structure.f90
@@ -1,15 +1,45 @@
module output_structure_module
USE nrtype
- USE data_types,only:summa_output_type
- 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:summa_output_type
+ USE data_types,only:&
+ ! final data vectors
+ dlength, & ! var%dat
+ ilength, & ! var%dat
+ ! no spatial dimension
+ var_i, & ! x%var(:) (i4b)
+ var_i8, & ! x%var(:) integer(8)
+ var_d, & ! x%var(:) (rkind)
+ var_flagVec, & ! x%var(:)%dat (logical)
+ var_ilength, & ! x%var(:)%dat (i4b)
+ var_dlength, & ! x%var(:)%dat (rkind)
+ ! gru dimension
+ gru_int, & ! x%gru(:)%var(:) (i4b)
+ gru_int8, & ! x%gru(:)%var(:) integer(8)
+ gru_double, & ! x%gru(:)%var(:) (rkind)
+ gru_intVec, & ! x%gru(:)%var(:)%dat (i4b)
+ gru_doubleVec, & ! x%gru(:)%var(:)%dat (rkind)
+ ! gru+hru dimension
+ gru_hru_int, & ! x%gru(:)%hru(:)%var(:) (i4b)
+ gru_hru_int8, & ! x%gru(:)%hru(:)%var(:) integer(8)
+ gru_hru_double, & ! x%gru(:)%hru(:)%var(:) (rkind)
+ gru_hru_intVec, & ! x%gru(:)%hru(:)%var(:)%dat (i4b)
+ gru_hru_doubleVec, & ! x%gru(:)%hru(:)%var(:)%dat (rkind)
+ ! gru+hru+z dimension
+ gru_hru_z_vLookup, & ! x%gru(:)%hru(:)%z(:)%var(:)%lookup (rkind)
+ ! structures that hold the time dimension
+ var_time_i8, & ! x%var(:)%tim(:) integer(8)
+ var_time_i, & ! x%var(:)%tim(:) (i4b)
+ var_time_d, & ! x%var(:)%tim(:) (rkind)
+ var_time_ilength, & ! x%var(:)%tim(:) (i4b)
+ var_time_dlength, & ! x%var(:)%tim(:) (rkind)
+ gru_hru_time_doublevec, & ! x%gru(:)%hru(:)%var(:)%tim(:)%dat (rkind)
+ gru_hru_time_int, & ! x%gru(:)%hru(:)%var(:)%tim(:) (i4b)
+ gru_hru_time_double, & ! x%gru(:)%hru(:)%var(:)%tim(:) (rkind)
+ gru_hru_time_intvec, & ! x%gru(:)%hru(:)%var(:)%tim(:)%dat (i4b)
+ gru_hru_time_flagvec
+
+
+
USE data_types,only:var_info
USE globalData,only:integerMissing
USE globalData,only:nBand ! number of spectral bands
@@ -27,6 +57,42 @@ module output_structure_module
public::allocateDat_rkind
public::allocateDat_int
private::is_var_desired
+
+ type, public :: summa_output_type
+ ! define the statistics structures
+ type(gru_hru_time_doubleVec),allocatable :: forcStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model forcing data
+ type(gru_hru_time_doubleVec),allocatable :: progStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model prognostic (state) variables
+ type(gru_hru_time_doubleVec),allocatable :: diagStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model diagnostic variables
+ type(gru_hru_time_doubleVec),allocatable :: fluxStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model fluxes
+ type(gru_hru_time_doubleVec),allocatable :: indxStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model indices
+ type(gru_hru_time_doubleVec),allocatable :: bvarStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- basin-average variabl
+
+ ! define the primary data structures (scalars)
+ type(gru_hru_time_int),allocatable :: timeStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:) -- model time data
+ type(gru_hru_time_double),allocatable :: forcStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:) -- model forcing data
+ type(gru_hru_double),allocatable :: attrStruct(:) ! x%gru(:)%hru(:)%var(:) -- local attributes for each HRU, DOES NOT CHANGE OVER TIMESTEPS
+ type(gru_hru_int),allocatable :: typeStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:) -- local classification of soil veg etc. for each HRU, DOES NOT CHANGE OVER TIMESTEPS
+ type(gru_hru_int8),allocatable :: idStruct(:) ! x%gru(:)%hru(:)%var(:)
+
+ ! define the primary data structures (variable length vectors)
+ type(gru_hru_time_intVec),allocatable :: indxStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model indices
+ type(gru_hru_doubleVec),allocatable :: mparStruct(:) ! x%gru(:)%hru(:)%var(:)%dat -- model parameters, DOES NOT CHANGE OVER TIMESTEPS TODO: MAYBE
+ type(gru_hru_time_doubleVec),allocatable :: progStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model prognostic (state) variables
+ type(gru_hru_time_doubleVec),allocatable :: diagStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model diagnostic variables
+ type(gru_hru_time_doubleVec),allocatable :: fluxStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model fluxes
+
+ ! define the basin-average structures
+ type(gru_double),allocatable :: bparStruct(:) ! x%gru(:)%var(:) -- basin-average parameters, DOES NOT CHANGE OVER TIMESTEPS
+ type(gru_hru_time_doubleVec),allocatable :: bvarStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- basin-average variables
+
+ ! define the ancillary data structures
+ type(gru_hru_double),allocatable :: dparStruct(:) ! x%gru(:)%hru(:)%var(:)
+
+ ! finalize stats structure
+ type(gru_hru_time_flagVec),allocatable :: finalizeStats(:) ! x%gru(:)%hru(:)%tim(:)%dat -- flags on when to write to file
+
+ integer(i4b) :: nTimeSteps
+ end type summa_output_type
type(summa_output_type),allocatable,save,public :: outputStructure(:) ! summa_OutputStructure(iFile)%struc%var(:)%dat(nTimeSteps)
diff --git a/build/source/actors/hru_actor/cpp_code/hru_actor.cpp b/build/source/actors/hru_actor/cpp_code/hru_actor.cpp
index 383cf4c8cca905c95d4f42f14dc80ee830418515..82bcb4c023fbe6bb50e91d39716dbd65f5c15b9e 100644
--- a/build/source/actors/hru_actor/cpp_code/hru_actor.cpp
+++ b/build/source/actors/hru_actor/cpp_code/hru_actor.cpp
@@ -303,12 +303,13 @@ int Run_HRU(stateful_actor<hru_state>* self) {
&self->state.iFile,
&self->state.err);
if (self->state.err != 0) {
- aout(self) << "Error: HRU_Actor - ReadForcingHRU - HRU = " << self->state.indxHRU <<
- " - indxGRU = " << self->state.indxGRU << " - refGRU = " << self->state.refGRU << std::endl;
- aout(self) << "Forcing Step = " << self->state.forcingStep << std::endl;
- aout(self) << "Timestep = " << self->state.timestep << std::endl;
- aout(self) << "iFile = " << self->state.iFile << std::endl;
- aout(self) << "Steps in Forcing File = " << self->state.stepsInCurrentFFile << std::endl;
+ aout(self) << "Error---HRU_Actor: ReadForcingHRU\n"
+ << " IndxGRU = " << self->state.indxGRU << "\n"
+ << " RefGRU = " << self->state.refGRU << "\n"
+ << " Forcing Step = " << self->state.forcingStep << "\n"
+ << " Timestep = " << self->state.timestep << "\n"
+ << " iFile = " << self->state.iFile << "\n"
+ << " Steps in Forcing File = " << self->state.stepsInCurrentFFile << "\n";
self->quit();
return -1;
}
@@ -319,28 +320,17 @@ int Run_HRU(stateful_actor<hru_state>* self) {
&self->state.yearLength,
&self->state.err);
if (self->state.err != 0) {
- aout(self) << "Error: HRU_Actor - ComputeTimeForcingHRU - HRU = " << self->state.indxHRU <<
- " - indxGRU = " << self->state.indxGRU << " - refGRU = " << self->state.refGRU << std::endl;
- aout(self) << "Forcing Step = " << self->state.forcingStep << std::endl;
- aout(self) << "Timestep = " << self->state.timestep << std::endl;
- aout(self) << "iFile = " << self->state.iFile << std::endl;
- aout(self) << "Steps in Forcing File = " << self->state.stepsInCurrentFFile << std::endl;
+ aout(self) << "Error---HRU_Actor - ComputeTimeForcingHRU\n"
+ << " IndxGRU = " << self->state.indxGRU << "\n"
+ << " RefGRU = " << self->state.refGRU << "\n"
+ << " Forcing Step = " << self->state.forcingStep << "\n"
+ << " Timestep = " << self->state.timestep << "\n"
+ << " iFile = " << self->state.iFile << "\n"
+ << " Steps in Forcing File = " << self->state.stepsInCurrentFFile << "\n";
self->quit();
return -1;
}
- if (self->state.err != 0) {
- aout(self) << "*********************************************************\n";
- aout(self) << "Error: Forcing - HRU = " << self->state.indxHRU <<
- " - indxGRU = " << self->state.indxGRU << " - refGRU = " << self->state.refGRU <<
- " - Timestep = " << self->state.timestep << "\n" <<
- " iFile = " << self->state.iFile << "\n" <<
- " forcing step" << self->state.forcingStep << "\n" <<
- " numSteps in forcing file" << self->state.stepsInCurrentFFile << "\n";
- aout(self) << "*********************************************************\n";
- return 10;
- }
-
if (self->state.hru_actor_settings.print_output &&
self->state.timestep % self->state.hru_actor_settings.output_frequency == 0) {
printOutput(self);
@@ -374,10 +364,10 @@ int Run_HRU(stateful_actor<hru_state>* self) {
&self->state.err);
if (self->state.err != 0) {
- aout(self) << "\033[1;31mError: RunPhysics - HRU = " << self->state.indxHRU
- << " - indxGRU = " << self->state.indxGRU
- << " - refGRU = " << self->state.refGRU
- << " - Timestep = " << self->state.timestep << "\033[0m" << std::endl;
+ aout(self) << "Error---RunPhysics:\n"
+ << " IndxGRU = " << self->state.indxGRU
+ << " RefGRU = " << self->state.refGRU
+ << " Timestep = " << self->state.timestep << "\n";
self->quit();
return 20;
}
@@ -387,7 +377,7 @@ int Run_HRU(stateful_actor<hru_state>* self) {
void printOutput(stateful_actor<hru_state>* self) {
- aout(self) << self->state.refGRU << " - Timestep = " << self->state.timestep << std::endl;
+ aout(self) << self->state.refGRU << " - Timestep = " << self->state.timestep << "\n";
}
}
\ No newline at end of file
diff --git a/build/source/actors/hru_actor/fortran_code/hru_init.f90 b/build/source/actors/hru_actor/fortran_code/hru_init.f90
index 4089ead9f5c2804099fb5ef57cc1345d7ed0dc11..09a63f8e1788f85c25dce3632a954cbe44276333 100755
--- a/build/source/actors/hru_actor/fortran_code/hru_init.f90
+++ b/build/source/actors/hru_actor/fortran_code/hru_init.f90
@@ -177,7 +177,7 @@ contains
! ---------------------------------------------------------------------------------------
! initialize error control
- err=0; message='summaActors_initialize/'
+ err=0; message='hru_init/'
! initialize the start of the initialization
call date_and_time(values=startInit)
@@ -233,7 +233,7 @@ contains
case('flux'); call allocLocal(flux_meta,fluxStruct,nSnow,nSoil,err,cmessage); ! model fluxes
case('bpar'); cycle ! set by file_access_actor
case('bvar'); call allocLocal(bvar_meta,bvarStruct,nSnow=0,nSoil=0,err=err,message=cmessage); ! basin-average variables
- case('lookup'); call allocLocal(lookup_meta,lookupStruct,err=err,message=cmessage) ! basin-average variables
+ case('lookup'); cycle ! allocated in t2enthalpy.f90
case('deriv'); cycle
case default; err=20; message='unable to find structure name: '//trim(structInfo(iStruct)%structName)
end select
diff --git a/build/source/actors/hru_actor/fortran_code/hru_modelRun.f90 b/build/source/actors/hru_actor/fortran_code/hru_modelRun.f90
index ee560bc77d92f6b3744ded11996dbf4066fc2a71..bb5476b6c5f849af1030ed92ada320b72b339eab 100644
--- a/build/source/actors/hru_actor/fortran_code/hru_modelRun.f90
+++ b/build/source/actors/hru_actor/fortran_code/hru_modelRun.f90
@@ -57,7 +57,6 @@ USE var_lookup,only:iLookINDEX ! look-up values for local column ind
USE var_lookup,only:iLookPROG ! look-up values for local column model prognostic (state) variables
USE var_lookup,only:iLookPARAM ! look-up values for local column model parameters
USE var_lookup,only:iLookDECISIONS ! look-up values for model decisions
-USE summa4chm_util,only:handle_err
! Noah-MP parameters
USE NOAHMP_VEG_PARAMETERS,only:SAIM,LAIM ! 2-d tables for stem area index and leaf area index (vegType,month)
@@ -392,10 +391,9 @@ subroutine runPhysics(&
bvarStruct%var(iLookBVAR%basin__TotalRunoff)%dat(1) = bvarStruct%var(iLookBVAR%basin__SurfaceRunoff)%dat(1) + bvarStruct%var(iLookBVAR%basin__ColumnOutflow)%dat(1)/totalArea + bvarStruct%var(iLookBVAR%basin__SoilDrainage)%dat(1)
endif
- call qOverland(&
- ! input
+ call qOverland(&! input
model_decisions(iLookDECISIONS%subRouting)%iDecision, & ! intent(in): index for routing method
- bvarStruct%var(iLookBVAR%basin__TotalRunoff)%dat(1), & ! intent(in): total runoff to the channel from all active components (m s-1)
+ bvarStruct%var(iLookBVAR%basin__TotalRunoff)%dat(1), & ! intent(in): total runoff to the channel from all active components (m s-1)
bvarStruct%var(iLookBVAR%routingFractionFuture)%dat, & ! intent(in): fraction of runoff in future time steps (m s-1)
bvarStruct%var(iLookBVAR%routingRunoffFuture)%dat, & ! intent(in): runoff in future time steps (m s-1)
! output
@@ -406,9 +404,6 @@ subroutine runPhysics(&
end associate
!************************************* End of run_oneGRU *****************************************
-
- ! check errors
- call handle_err(err, cmessage)
end subroutine runPhysics
diff --git a/build/source/driver/summa_globalData.f90 b/build/source/driver/summa_globalData.f90
deleted file mode 100755
index d3a6f327babc84cf5745a41b6d708fb015fd57b5..0000000000000000000000000000000000000000
--- a/build/source/driver/summa_globalData.f90
+++ /dev/null
@@ -1,174 +0,0 @@
-! SUMMA - Structure for Unifying Multiple Modeling Alternatives
-! Copyright (C) 2014-2020 NCAR/RAL; University of Saskatchewan; University of Washington
-!
-! This file is part of SUMMA
-!
-! For more information see: http://www.ral.ucar.edu/projects/summa
-!
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-module summa_globalData
-! used to declare and allocate global summa data structures
-USE, intrinsic :: iso_c_binding
-
-! access missing values
-USE globalData,only:integerMissing ! missing integer
-USE globalData,only:realMissing ! missing double precision number
-
-! size of data structures
-USE var_lookup,only:maxvarForc ! forcing data: maximum number variables
-USE var_lookup,only:maxvarProg ! prognostic variables: maximum number variables
-USE var_lookup,only:maxvarDiag ! diagnostic variables: maximum number variables
-USE var_lookup,only:maxvarFlux ! model fluxes: maximum number variables
-USE var_lookup,only:maxvarIndx ! model indices: maximum number variables
-USE var_lookup,only:maxvarBvar ! basin-average variables: maximum number variables
-
-! metadata structures
-USE globalData,only:time_meta,forc_meta,attr_meta,type_meta ! metadata structures
-USE globalData,only:prog_meta,diag_meta,flux_meta ! metadata structures
-USE globalData,only:mpar_meta,indx_meta ! metadata structures
-USE globalData,only:bpar_meta,bvar_meta ! metadata structures
-USE globalData,only:averageFlux_meta ! metadata for time-step average fluxes
-
-! statistics metadata structures
-USE globalData,only:statForc_meta ! child metadata for stats
-USE globalData,only:statProg_meta ! child metadata for stats
-USE globalData,only:statDiag_meta ! child metadata for stats
-USE globalData,only:statFlux_meta ! child metadata for stats
-USE globalData,only:statIndx_meta ! child metadata for stats
-USE globalData,only:statBvar_meta ! child metadata for stats
-
-! mapping from original to child structures
-USE globalData,only:forcChild_map ! index of the child data structure: stats forc
-USE globalData,only:progChild_map ! index of the child data structure: stats prog
-USE globalData,only:diagChild_map ! index of the child data structure: stats diag
-USE globalData,only:fluxChild_map ! index of the child data structure: stats flux
-USE globalData,only:indxChild_map ! index of the child data structure: stats indx
-USE globalData,only:bvarChild_map ! index of the child data structure: stats bvar
-
-USE globalData,only:startGRU
-! safety: set private unless specified otherwise
-implicit none
-private
-public::summa_defineGlobalData
-contains
-
-subroutine summa_defineGlobalData(start_gru_index, err) bind(C, name="defineGlobalData")
- ! ---------------------------------------------------------------------------------------
- ! * desired modules
- ! ---------------------------------------------------------------------------------------
- ! data types
- USE nrtype ! variable types, etc.
- ! subroutines and functions: initial priming
- USE,intrinsic :: ieee_arithmetic ! IEEE arithmetic (obviously)
- ! subroutines and functions: define metadata structures
- USE popMetadat_module,only:popMetadat ! module to populate metadata structures
- USE flxMapping_module,only:flxMapping ! module to map fluxes to states
- USE checkStruc_module,only:checkStruc ! module to check metadata structures
- USE childStruc_module,only:childStruc ! module to create a child data structure
- ! miscellaneous global data
- USE globalData,only:dNaN ! double precision NaN
- USE globalData,only:doJacobian ! flag to compute the Jacobian
- USE globalData,only:structInfo ! information on the data structures
- ! named variables that describe elements of child model structures
- USE var_lookup,only:iLookVarType ! look-up values for variable type structure
- USE var_lookup,only:childFLUX_MEAN ! look-up values for timestep-average model fluxes
- ! ---------------------------------------------------------------------------------------
- ! * variables
- ! ---------------------------------------------------------------------------------------
- implicit none
- ! dummy variables
- integer(c_int),intent(in) :: start_gru_index ! Index of the starting GRU (-g option from user)
- integer(c_int),intent(out) :: err ! error code
- ! local variables
- character(len=256) :: message ! error message
- character(LEN=256) :: cmessage ! error message of downwind routine
- logical(lgt), dimension(maxvarFlux) :: flux_mask ! mask defining desired flux variables
- logical(lgt), dimension(maxvarForc) :: statForc_mask ! mask defining forc stats
- logical(lgt), dimension(maxvarProg) :: statProg_mask ! mask defining prog stats
- logical(lgt), dimension(maxvarDiag) :: statDiag_mask ! mask defining diag stats
- logical(lgt), dimension(maxvarFlux) :: statFlux_mask ! mask defining flux stats
- logical(lgt), dimension(maxvarIndx) :: statIndx_mask ! mask defining indx stats
- logical(lgt), dimension(maxvarBvar) :: statBvar_mask ! mask defining bvar stats
- integer(i4b) :: iStruct ! index of data structure
- ! ---------------------------------------------------------------------------------------
- ! initialize error control
- err=0; message='summa_defineGlobalData/'
-
- ! initialize the Jacobian flag
- doJacobian=.false. ! initialize the Jacobian flag
-
- ! define double precision NaNs (shared in globalData)
- dNaN = ieee_value(1._dp, ieee_quiet_nan)
-
- ! populate metadata for all model variables
- call popMetadat(err,cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage); print*, message; return ;endif
-
- ! define mapping between fluxes and states
- call flxMapping(err,cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage); print*, message; return ;endif
-
- ! check data structures
- call checkStruc(err,cmessage)
- if(err/=0)then
- message=trim(message)//trim(cmessage)
- print*, message
- return
- endif
-
- ! define the mask to identify the subset of variables in the "child" data structure (just scalar variables)
- flux_mask = (flux_meta(:)%vartype==iLookVarType%scalarv)
-
- ! create the averageFlux metadata structure
- call childStruc(flux_meta, flux_mask, averageFlux_meta, childFLUX_MEAN, err, cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage); print*, message; return; endif
-
- ! child metadata structures - so that we do not carry full stats structures around everywhere
- ! only carry stats for variables with output frequency > model time step
- statForc_mask = (forc_meta(:)%vartype==iLookVarType%scalarv.and.forc_meta(:)%varDesire)
- statProg_mask = (prog_meta(:)%vartype==iLookVarType%scalarv.and.prog_meta(:)%varDesire)
- statDiag_mask = (diag_meta(:)%vartype==iLookVarType%scalarv.and.diag_meta(:)%varDesire)
- statFlux_mask = (flux_meta(:)%vartype==iLookVarType%scalarv.and.flux_meta(:)%varDesire)
- statIndx_mask = (indx_meta(:)%vartype==iLookVarType%scalarv.and.indx_meta(:)%varDesire)
- statBvar_mask = (bvar_meta(:)%vartype==iLookVarType%scalarv.and.bvar_meta(:)%varDesire)
-
- ! create the stats metadata structures
- do iStruct=1,size(structInfo)
- select case (trim(structInfo(iStruct)%structName))
- case('forc'); call childStruc(forc_meta,statForc_mask,statForc_meta,forcChild_map,err,cmessage)
- case('prog'); call childStruc(prog_meta,statProg_mask,statProg_meta,progChild_map,err,cmessage)
- case('diag'); call childStruc(diag_meta,statDiag_mask,statDiag_meta,diagChild_map,err,cmessage)
- case('flux'); call childStruc(flux_meta,statFlux_mask,statFlux_meta,fluxChild_map,err,cmessage)
- case('indx'); call childStruc(indx_meta,statIndx_mask,statIndx_meta,indxChild_map,err,cmessage)
- case('bvar'); call childStruc(bvar_meta,statBvar_mask,statBvar_meta,bvarChild_map,err,cmessage)
- end select
- ! check errors
- if(err/=0)then; message=trim(message)//trim(cmessage)//'[statistics for = '//trim(structInfo(iStruct)%structName)//']' ;print*, message ;return ;endif
- end do ! iStruct
-
- ! set all stats metadata to correct var types
- statForc_meta(:)%vartype = iLookVarType%outstat
- statProg_meta(:)%vartype = iLookVarType%outstat
- statDiag_meta(:)%vartype = iLookVarType%outstat
- statFlux_meta(:)%vartype = iLookVarType%outstat
- statIndx_meta(:)%vartype = iLookVarType%outstat
- statBvar_meta(:)%vartype = iLookVarType%outstat
-
- ! Set the startGRU
- startGRU = start_gru_index
-
-end subroutine summa_defineGlobalData
-
-end module summa_globalData
diff --git a/build/source/driver/summa_util.f90 b/build/source/driver/summa_util.f90
deleted file mode 100755
index 0b761071dc6c4ce7ebb79b7a75f61e157d373dd0..0000000000000000000000000000000000000000
--- a/build/source/driver/summa_util.f90
+++ /dev/null
@@ -1,165 +0,0 @@
-! SUMMA - Structure for Unifying Multiple Modeling Alternatives
-! Copyright (C) 2014-2020 NCAR/RAL; University of Saskatchewan; University of Washington
-!
-! This file is part of SUMMA
-!
-! For more information see: http://www.ral.ucar.edu/projects/summa
-!
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-module summa4chm_util
-! utilities to manage summa simulation
-
-! data types
-USE nrtype ! high-level data types
-
-! global data
-USE globalData,only:integerMissing ! missing integer value
-USE globalData,only:realMissing ! missing double precision value
-
-! provide access to file IDs
-USE globalData,only:ncid ! file id of netcdf output file
-
-! privacy
-implicit none
-private
-
-! routines to make public
-public::stop_program
-public::handle_err
-contains
-
- ! **************************************************************************************************
- ! error handler
- ! **************************************************************************************************
- ! TODO: will need to change how output files are closed
- subroutine handle_err(err,message)
- USE netcdf_util_module,only:nc_file_close ! module to handle netcdf stuff for inputs and outputs
- implicit none
- ! dummy variables
- integer(i4b),intent(in) :: err ! error code
- character(*),intent(in) :: message ! error message
- ! local variables
- integer(i4b) :: iFreq ! loop through output frequencies
- integer(i4b) :: nc_err ! error code of nc_close
- character(len=256) :: cmessage ! error message of the downwind routine
- ! ---------------------------------------------------------------------------------------
- ! return if A-OK
- if(err==0) return
-
- ! process error messages
- if (err>0) then
- write(*,'(//a/)') 'FATAL ERROR: '//trim(message)
- else
- write(*,'(//a/)') 'WARNING: '//trim(message); print*,'(can keep going, but stopping anyway)'
- endif
-
- ! close any remaining output files
- do iFreq = 1,size(ncid)
- if (ncid(iFreq)/=integerMissing) then
- call nc_file_close(ncid(iFreq),nc_err,cmessage)
- if(nc_err/=0) print*, trim(cmessage)
- end if
- end do
-
- stop 1
- end subroutine handle_err
-
- ! **************************************************************************************************
- ! stop_program: stop program execution
- ! **************************************************************************************************
- subroutine stop_program(err,message)
- ! used to stop program execution
- ! desired modules
- USE netcdf ! netcdf libraries
- USE time_utils_module,only:elapsedSec ! calculate the elapsed time
- ! global data
- USE globalData,only: nThreads ! number of threads
- USE globalData,only: startInit ! date/time for the start of the initialization
- USE globalData,only: elapsedInit ! elapsed time for the initialization
- USE globalData,only: elapsedSetup ! elapsed time for the parameter setup
- USE globalData,only: elapsedRestart ! elapsed time to read the restart data
- USE globalData,only: elapsedRead ! elapsed time for the data read
- USE globalData,only: elapsedWrite ! elapsed time for the stats/write
- USE globalData,only: elapsedPhysics ! elapsed time for the physics
- implicit none
- ! define dummy variables
- integer(i4b),intent(in) :: err ! error code
- character(*),intent(in) :: message ! error messgage
- ! define the local variables
- integer(i4b),parameter :: outunit=6 ! write to screen
- integer(i4b) :: endModelRun(8) ! final time
- integer(i4b) :: localErr ! local error code
- integer(i4b) :: iFreq ! loop through output frequencies
- real(dp) :: elpSec ! elapsed seconds
-
- ! close any remaining output files
- ! NOTE: use the direct NetCDF call with no error checking since the file may already be closed
- do iFreq = 1,size(ncid)
- if (ncid(iFreq)/=integerMissing) localErr = nf90_close(ncid(iFreq))
- end do
-
- ! get the final date and time
- call date_and_time(values=endModelRun)
- elpSec = elapsedSec(startInit,endModelRun)
-
- ! print initial and final date and time
- write(outunit,"(/,A,I4,'-',I2.2,'-',I2.2,2x,I2,':',I2.2,':',I2.2,'.',I3.3)") 'initial date/time = ',startInit(1:3), startInit(5:8)
- write(outunit,"(A,I4,'-',I2.2,'-',I2.2,2x,I2,':',I2.2,':',I2.2,'.',I3.3)") ' final date/time = ',endModelRun(1:3),endModelRun(5:8)
-
- ! print elapsed time for the initialization
- write(outunit,"(/,A,1PG15.7,A)") ' elapsed init = ', elapsedInit, ' s'
- write(outunit,"(A,1PG15.7)") ' fraction init = ', elapsedInit/elpSec
-
- ! print elapsed time for the parameter setup
- write(outunit,"(/,A,1PG15.7,A)") ' elapsed setup = ', elapsedSetup, ' s'
- write(outunit,"(A,1PG15.7)") ' fraction setup = ', elapsedSetup/elpSec
-
- ! print elapsed time to read the restart data
- write(outunit,"(/,A,1PG15.7,A)") ' elapsed restart = ', elapsedRestart, ' s'
- write(outunit,"(A,1PG15.7)") ' fraction restart = ', elapsedRestart/elpSec
-
- ! print elapsed time for the data read
- write(outunit,"(/,A,1PG15.7,A)") ' elapsed read = ', elapsedRead, ' s'
- write(outunit,"(A,1PG15.7)") ' fraction read = ', elapsedRead/elpSec
-
- ! print elapsed time for the data write
- write(outunit,"(/,A,1PG15.7,A)") ' elapsed write = ', elapsedWrite, ' s'
- write(outunit,"(A,1PG15.7)") ' fraction write = ', elapsedWrite/elpSec
-
- ! print elapsed time for the physics
- write(outunit,"(/,A,1PG15.7,A)") ' elapsed physics = ', elapsedPhysics, ' s'
- write(outunit,"(A,1PG15.7)") ' fraction physics = ', elapsedPhysics/elpSec
-
- ! print total elapsed time
- write(outunit,"(/,A,1PG15.7,A)") ' elapsed time = ', elpSec, ' s'
- write(outunit,"(A,1PG15.7,A)") ' or ', elpSec/60_dp, ' m'
- write(outunit,"(A,1PG15.7,A)") ' or ', elpSec/3600_dp, ' h'
- write(outunit,"(A,1PG15.7,A/)") ' or ', elpSec/86400_dp, ' d'
-
- ! print the number of threads
- write(outunit,"(A,i10,/)") ' number threads = ', nThreads
-
- ! stop with message
- if(err==0)then
- print*,'FORTRAN STOP: '//trim(message)
- stop
- else
- print*,'FATAL ERROR: '//trim(message)
- stop 1
- endif
-
- end subroutine
-
-end module summa4chm_util
diff --git a/build/source/dshare/data_types.f90 b/build/source/dshare/data_types.f90
index a21593b8e01b2fb9d9899637a3e4c5de0643b1d3..1fc4a54e686f11b23b38259d8f6eebf0a64720da 100755
--- a/build/source/dshare/data_types.f90
+++ b/build/source/dshare/data_types.f90
@@ -184,6 +184,7 @@ MODULE data_types
! ***********************************************************************************************************
! Define hierarchal derived data types
! ***********************************************************************************************************
+
! ** double precision type of variable length
type, public :: dlength
real(rkind),allocatable :: dat(:) ! dat(:)
@@ -451,43 +452,49 @@ MODULE data_types
type, public :: zLookup
type(vLookup),allocatable :: z(:) ! z(:)%var(:)%lookup(:)
endtype zLookup
-
- type, public :: summa_output_type
-
- ! define the statistics structures
- type(gru_hru_time_doubleVec),allocatable :: forcStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model forcing data
- type(gru_hru_time_doubleVec),allocatable :: progStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model prognostic (state) variables
- type(gru_hru_time_doubleVec),allocatable :: diagStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model diagnostic variables
- type(gru_hru_time_doubleVec),allocatable :: fluxStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model fluxes
- type(gru_hru_time_doubleVec),allocatable :: indxStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model indices
- type(gru_hru_time_doubleVec),allocatable :: bvarStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- basin-average variabl
-
- ! define the primary data structures (scalars)
- type(gru_hru_time_int),allocatable :: timeStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:) -- model time data
- type(gru_hru_time_double),allocatable :: forcStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:) -- model forcing data
- type(gru_hru_double),allocatable :: attrStruct(:) ! x%gru(:)%hru(:)%var(:) -- local attributes for each HRU, DOES NOT CHANGE OVER TIMESTEPS
- type(gru_hru_int),allocatable :: typeStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:) -- local classification of soil veg etc. for each HRU, DOES NOT CHANGE OVER TIMESTEPS
- type(gru_hru_int8),allocatable :: idStruct(:) ! x%gru(:)%hru(:)%var(:)
-
- ! define the primary data structures (variable length vectors)
- type(gru_hru_time_intVec),allocatable :: indxStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model indices
- type(gru_hru_doubleVec),allocatable :: mparStruct(:) ! x%gru(:)%hru(:)%var(:)%dat -- model parameters, DOES NOT CHANGE OVER TIMESTEPS TODO: MAYBE
- type(gru_hru_time_doubleVec),allocatable :: progStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model prognostic (state) variables
- type(gru_hru_time_doubleVec),allocatable :: diagStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model diagnostic variables
- type(gru_hru_time_doubleVec),allocatable :: fluxStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model fluxes
-
- ! define the basin-average structures
- type(gru_double),allocatable :: bparStruct(:) ! x%gru(:)%var(:) -- basin-average parameters, DOES NOT CHANGE OVER TIMESTEPS
- type(gru_hru_time_doubleVec),allocatable :: bvarStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- basin-average variables
-
- ! define the ancillary data structures
- type(gru_hru_double),allocatable :: dparStruct(:) ! x%gru(:)%hru(:)%var(:)
-
- ! finalize stats structure
- type(gru_hru_time_flagVec),allocatable :: finalizeStats(:) ! x%gru(:)%hru(:)%tim(:)%dat -- flags on when to write to file
-
- integer(i4b) :: nTimeSteps
- end type summa_output_type
+ type, public :: hru_z_vLookup
+ type(zLookup),allocatable :: hru(:) ! hru(:)%z(:)%var(:)%lookup(:)
+ endtype hru_z_vLookup
+ ! ** double precision type for a variable number of soil layers
+ type, public :: gru_hru_z_vLookup
+ type(hru_z_vLookup),allocatable :: gru(:) ! gru(:)%hru(:)%z(:)%var(:)%lookup(:)
+ endtype gru_hru_z_vLookup
+ ! type, public :: summa_output_type
+
+ ! ! define the statistics structures
+ ! type(gru_hru_time_doubleVec),allocatable :: forcStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model forcing data
+ ! type(gru_hru_time_doubleVec),allocatable :: progStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model prognostic (state) variables
+ ! type(gru_hru_time_doubleVec),allocatable :: diagStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model diagnostic variables
+ ! type(gru_hru_time_doubleVec),allocatable :: fluxStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model fluxes
+ ! type(gru_hru_time_doubleVec),allocatable :: indxStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model indices
+ ! type(gru_hru_time_doubleVec),allocatable :: bvarStat(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- basin-average variabl
+
+ ! ! define the primary data structures (scalars)
+ ! type(gru_hru_time_int),allocatable :: timeStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:) -- model time data
+ ! type(gru_hru_time_double),allocatable :: forcStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:) -- model forcing data
+ ! type(gru_hru_double),allocatable :: attrStruct(:) ! x%gru(:)%hru(:)%var(:) -- local attributes for each HRU, DOES NOT CHANGE OVER TIMESTEPS
+ ! type(gru_hru_int),allocatable :: typeStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:) -- local classification of soil veg etc. for each HRU, DOES NOT CHANGE OVER TIMESTEPS
+ ! type(gru_hru_int8),allocatable :: idStruct(:) ! x%gru(:)%hru(:)%var(:)
+
+ ! ! define the primary data structures (variable length vectors)
+ ! type(gru_hru_time_intVec),allocatable :: indxStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model indices
+ ! type(gru_hru_doubleVec),allocatable :: mparStruct(:) ! x%gru(:)%hru(:)%var(:)%dat -- model parameters, DOES NOT CHANGE OVER TIMESTEPS TODO: MAYBE
+ ! type(gru_hru_time_doubleVec),allocatable :: progStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model prognostic (state) variables
+ ! type(gru_hru_time_doubleVec),allocatable :: diagStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model diagnostic variables
+ ! type(gru_hru_time_doubleVec),allocatable :: fluxStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- model fluxes
+
+ ! ! define the basin-average structures
+ ! type(gru_double),allocatable :: bparStruct(:) ! x%gru(:)%var(:) -- basin-average parameters, DOES NOT CHANGE OVER TIMESTEPS
+ ! type(gru_hru_time_doubleVec),allocatable :: bvarStruct(:) ! x%gru(:)%hru(:)%var(:)%tim(:)%dat -- basin-average variables
+
+ ! ! define the ancillary data structures
+ ! type(gru_hru_double),allocatable :: dparStruct(:) ! x%gru(:)%hru(:)%var(:)
+
+ ! ! finalize stats structure
+ ! type(gru_hru_time_flagVec),allocatable :: finalizeStats(:) ! x%gru(:)%hru(:)%tim(:)%dat -- flags on when to write to file
+
+ ! integer(i4b) :: nTimeSteps
+ ! end type summa_output_type
END MODULE data_types
diff --git a/build/source/engine/allocspace.f90 b/build/source/engine/allocspace.f90
deleted file mode 100755
index 63dfe0327d28043edf88412198d7d37c8ccdc63a..0000000000000000000000000000000000000000
--- a/build/source/engine/allocspace.f90
+++ /dev/null
@@ -1,596 +0,0 @@
-! SUMMA - Structure for Unifying Multiple Modeling Alternatives
-! Copyright (C) 2014-2020 NCAR/RAL; University of Saskatchewan; University of Washington
-!
-! This file is part of SUMMA
-!
-! For more information see: http://www.ral.ucar.edu/projects/summa
-!
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-module allocspace_module
-
-! data types
-USE nrtype
-
-! provide access to the derived types to define the data structures
-USE data_types,only:&
- zLookup, &
- ! final data vectors
- dlength, & ! var%dat
- ilength, & ! var%dat
- ! no spatial dimension
- var_i, & ! x%var(:) (i4b)
- var_i8, & ! x%var(:) integer(8)
- var_d, & ! x%var(:) (dp)
- var_flagVec, & ! x%var(:)%dat (logical)
- var_ilength, & ! x%var(:)%dat (i4b)
- var_dlength, & ! x%var(:)%dat (dp)
- ! gru dimension
- gru_int, & ! x%gru(:)%var(:) (i4b)
- gru_int8, & ! x%gru(:)%var(:) integer(8)
- gru_double, & ! x%gru(:)%var(:) (dp)
- gru_intVec, & ! x%gru(:)%var(:)%dat (i4b)
- gru_doubleVec, & ! x%gru(:)%var(:)%dat (dp)
- ! gru+hru dimension
- gru_hru_int, & ! x%gru(:)%hru(:)%var(:) (i4b)
- gru_hru_int8, & ! x%gru(:)%hru(:)%var(:) integer(8)
- gru_hru_double, & ! x%gru(:)%hru(:)%var(:) (dp)
- gru_hru_intVec, & ! x%gru(:)%hru(:)%var(:)%dat (i4b)
- gru_hru_doubleVec ! x%gru(:)%hru(:)%var(:)%dat (dp)
-
-! metadata structure
-USE data_types,only:var_info ! data type for metadata
-
-! access missing values
-USE globalData,only:integerMissing ! missing integer
-USE globalData,only:realMissing ! missing double precision number
-
-USE globalData,only: nTimeDelay ! number of timesteps in the time delay histogram
-USE globalData,only: nBand ! number of spectral bands
-
-! access variable types
-USE var_lookup,only:iLookVarType ! look up structure for variable typed
-USE var_lookup,only:maxvarFreq ! allocation dimension (output frequency)
-
-! privacy
-implicit none
-private
-public::allocLocal
-public::resizeData
-
-! -----------------------------------------------------------------------------------------------------------------------------------
-contains
-
- ! ************************************************************************************************
- ! public subroutine allocLocal: allocate space for local data structures
- ! ************************************************************************************************
- subroutine allocLocal(metaStruct,dataStruct,nSnow,nSoil,err,message)
- implicit none
- ! input-output
- type(var_info),intent(in) :: metaStruct(:) ! metadata structure
- class(*),intent(inout) :: dataStruct ! data structure
- ! optional input
- integer(i4b),intent(in),optional :: nSnow ! number of snow layers
- integer(i4b),intent(in),optional :: nSoil ! number of soil layers
- ! output
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! local
- logical(lgt) :: check ! .true. if the variables are allocated
- integer(i4b) :: nVars ! number of variables in the metadata structure
- integer(i4b) :: nLayers ! total number of layers
- logical(lgt) :: spatial
- character(len=256) :: cmessage ! error message of the downwind routine
- ! initialize error control
- err=0; message='allocLocal/'
-
- ! get the number of variables in the metadata structure
- nVars = size(metaStruct)
-
- ! check if nSnow and nSoil are present
- if(present(nSnow) .or. present(nSoil))then
- ! check both are present
- if(.not.present(nSoil))then; err=20; message=trim(message)//'expect nSoil to be present when nSnow is present'; return; end if
- if(.not.present(nSnow))then; err=20; message=trim(message)//'expect nSnow to be present when nSoil is present'; return; end if
- nLayers = nSnow+nSoil
-
- ! It is possible that nSnow and nSoil are actually needed here, so we return an error if the optional arguments are missing when needed
- else
- select type(dataStruct)
- class is (var_flagVec); err=20
- class is (var_ilength); err=20
- class is (var_dlength); err=20
- end select
- if(err/=0)then; message=trim(message)//'expect nSnow and nSoil to be present for variable-length data structures'; return; end if
- end if
-
- ! initialize allocation check
- check=.false.
-
- ! allocate the dimension for model variables
- select type(dataStruct)
- class is (var_i); if(allocated(dataStruct%var))then; check=.true.; else; allocate(dataStruct%var(nVars),stat=err); end if; return
- class is (var_i8); if(allocated(dataStruct%var))then; check=.true.; else; allocate(dataStruct%var(nVars),stat=err); end if; return
- class is (var_d); if(allocated(dataStruct%var))then; check=.true.; else; allocate(dataStruct%var(nVars),stat=err); end if; return
- class is (var_flagVec); if(allocated(dataStruct%var))then; check=.true.; else; allocate(dataStruct%var(nVars),stat=err); end if
- class is (var_ilength); if(allocated(dataStruct%var))then; check=.true.; else; allocate(dataStruct%var(nVars),stat=err); end if
- class is (var_dlength); if(allocated(dataStruct%var))then; check=.true.; else; allocate(dataStruct%var(nVars),stat=err); end if
- class is (zLookup); spatial=.true.
- class default; err=20; message=trim(message)//'unable to identify derived data type for the variable dimension'; return
- end select
- ! check errors
- if(check) then; err=20; message=trim(message)//'structure was unexpectedly allocated already'; return; end if
- if(err/=0)then; err=20; message=trim(message)//'problem allocating'; return; end if
-
- ! allocate the dimension for model data
- select type(dataStruct)
- class is (var_flagVec); call allocateDat_flag(metaStruct,nSnow,nSoil,nLayers,dataStruct,err,cmessage)
- class is (var_ilength); call allocateDat_int( metaStruct,nSnow,nSoil,nLayers,dataStruct,err,cmessage)
- class is (var_dlength); call allocateDat_dp( metaStruct,nSnow,nSoil,nLayers,dataStruct,err,cmessage)
- class is (zLookup); spatial=.true.
- class default; err=20; message=trim(message)//'unable to identify derived data type for the data dimension'; return
- end select
-
- ! check errors
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
-
- end subroutine allocLocal
-
- ! ************************************************************************************************
- ! public subroutine resizeData: resize data structure
- ! ************************************************************************************************
- subroutine resizeData(metaStruct,dataStructOrig,dataStructNew,copy,err,message)
- implicit none
- ! input
- type(var_info),intent(in) :: metaStruct(:) ! metadata structure
- class(*) ,intent(in) :: dataStructOrig ! original data structure
- ! output
- class(*) ,intent(inout) :: dataStructNew ! new data structure
- ! control
- logical(lgt) ,intent(in) ,optional :: copy ! flag to copy data
- integer(i4b) ,intent(out) :: err ! error code
- character(*) ,intent(out) :: message ! error message
- ! local
- integer(i4b) :: iVar ! number of variables in the structure
- integer(i4b) :: nVars ! number of variables in the structure
- logical(lgt) :: isCopy ! flag to copy data (handles absence of optional argument)
- character(len=256) :: cmessage ! error message of the downwind routine
- ! initialize error control
- err=0; message='resizeData/'
-
- ! get the copy flag
- if(present(copy))then
- isCopy = copy
- else
- isCopy = .false.
- endif
-
- ! get the number of variables in the data structure
- nVars = size(metaStruct)
-
- ! check that the input data structure is allocated
- select type(dataStructOrig)
- class is (var_ilength); err=merge(0, 20, allocated(dataStructOrig%var))
- class is (var_dlength); err=merge(0, 20, allocated(dataStructOrig%var))
- class default; err=20; message=trim(message)//'unable to identify type of data structure'; return
- end select
- if(err/=0)then; message=trim(message)//'input data structure dataStructOrig%var'; return; end if
-
- ! allocate the dimension for model variables
- select type(dataStructNew)
- class is (var_ilength); if(.not.allocated(dataStructNew%var)) allocate(dataStructNew%var(nVars),stat=err)
- class is (var_dlength); if(.not.allocated(dataStructNew%var)) allocate(dataStructNew%var(nVars),stat=err)
- class default; err=20; message=trim(message)//'unable to identify derived data type for the variable dimension'; return
- end select
- if(err/=0)then; message=trim(message)//'problem allocating space for dataStructNew%var'; return; end if
-
- ! loop through variables
- do iVar=1,nVars
-
- ! resize and copy data structures
- select type(dataStructOrig)
-
- ! double precision
- class is (var_dlength)
- select type(dataStructNew)
- class is (var_dlength); call copyStruct_dp( dataStructOrig%var(iVar),dataStructNew%var(iVar),isCopy,err,cmessage)
- class default; err=20; message=trim(message)//'mismatch data structure for variable'//trim(metaStruct(iVar)%varname); return
- end select
-
- ! integer
- class is (var_ilength)
- select type(dataStructNew)
- class is (var_ilength); call copyStruct_i4b(dataStructOrig%var(iVar),dataStructNew%var(iVar),isCopy,err,cmessage)
- class default; err=20; message=trim(message)//'mismatch data structure for variable'//trim(metaStruct(iVar)%varname); return
- end select
-
- ! check
- class default; err=20; message=trim(message)//'unable to identify type of data structure'; return
- end select
- if(err/=0)then; message=trim(message)//trim(cmessage)//' ('//trim(metaStruct(iVar)%varname)//')'; return; end if
-
- end do ! looping through variables in the data structure
-
- end subroutine resizeData
-
- ! ************************************************************************************************
- ! private subroutine copyStruct_dp: copy a given data structure
- ! ************************************************************************************************
- subroutine copyStruct_dp(varOrig,varNew,copy,err,message)
- ! dummy variables
- type(dlength),intent(in) :: varOrig ! original data structure
- type(dlength),intent(inout) :: varNew ! new data structure
- logical(lgt) ,intent(in) :: copy ! flag to copy data
- integer(i4b) ,intent(out) :: err ! error code
- character(*) ,intent(out) :: message ! error message
- ! local
- logical(lgt) :: allocatedOrig ! flag to denote if a given variable in the original data structure is allocated
- logical(lgt) :: allocatedNew ! flag to denote if a given variable in the new data structure is allocated
- integer(i4b) :: lowerBoundOrig ! lower bound of a given variable in the original data structure
- integer(i4b) :: upperBoundOrig ! upper bound of a given variable in the original data structure
- integer(i4b) :: lowerBoundNew ! lower bound of a given variable in the new data structure
- integer(i4b) :: upperBoundNew ! upper bound of a given variable in the new data structure
- ! initialize error control
- err=0; message='copyStruct_dp/'
-
- ! get the information from the data structures
- call getVarInfo(varOrig,allocatedOrig,lowerBoundOrig,upperBoundOrig)
- call getVarInfo(varNew, allocatedNew, lowerBoundNew, upperBoundNew)
-
- ! check that the variable of the original data structure is allocated
- if(.not.allocatedOrig)then
- message=trim(message)//'variable in the original data structure is not allocated'
- err=20; return
- endif
-
- ! re-size data structure if necessary
- if(lowerBoundOrig/=lowerBoundNew .or. upperBoundOrig/=upperBoundNew .or. .not.allocatedNew)then
-
- ! deallocate space (if necessary)
- if(allocatedNew) deallocate(varNew%dat)
-
- ! allocate space
- allocate(varNew%dat(lowerBoundOrig:upperBoundOrig), stat=err)
- if(err/=0)then; message=trim(message)//'problem allocating'; return; endif
-
- endif ! if need to resize
-
- ! copy the data structure
- if(copy)then
- varNew%dat(:) = varOrig%dat(:)
-
- ! initialize the data structure to missing values
- else
- varNew%dat(:) = realMissing
- endif
-
- ! internal routines
- contains
-
- ! internal subroutine getVarInfo: get information from a given data structure
- subroutine getVarInfo(var,isAllocated,lowerBound,upperBound)
- ! input
- type(dlength),intent(in) :: var ! data vector for a given variable
- ! output
- logical(lgt),intent(out) :: isAllocated ! flag to denote if the data vector is allocated
- integer(i4b),intent(out) :: lowerBound ! lower bound
- integer(i4b),intent(out) :: upperBound ! upper bound
- ! local
- integer(i4b),dimension(1) :: lowerBoundVec ! lower bound vector
- integer(i4b),dimension(1) :: upperBoundVec ! upper bound vector
- ! initialize error control
- err=0; message='getVarInfo/'
-
- ! check that the input data structure is allocated
- isAllocated = allocated(var%dat)
-
- ! if allocated then get the bounds
- ! NOTE: also convert vector to scalar
- if(isAllocated)then
- lowerBoundVec=lbound(var%dat); lowerBound=lowerBoundVec(1)
- upperBoundVec=ubound(var%dat); upperBound=upperBoundVec(1)
-
- ! if not allocated then return zero bounds
- else
- lowerBound=0
- upperBound=0
- endif ! (check allocation)
-
- end subroutine getVarInfo
-
- end subroutine copyStruct_dp
-
- ! ************************************************************************************************
- ! private subroutine copyStruct_i4b: copy a given data structure
- ! ************************************************************************************************
- subroutine copyStruct_i4b(varOrig,varNew,copy,err,message)
- ! dummy variables
- type(ilength),intent(in) :: varOrig ! original data structure
- type(ilength),intent(inout) :: varNew ! new data structure
- logical(lgt) ,intent(in) :: copy ! flag to copy data
- integer(i4b) ,intent(out) :: err ! error code
- character(*) ,intent(out) :: message ! error message
- ! local
- logical(lgt) :: allocatedOrig ! flag to denote if a given variable in the original data structure is allocated
- logical(lgt) :: allocatedNew ! flag to denote if a given variable in the new data structure is allocated
- integer(i4b) :: lowerBoundOrig ! lower bound of a given variable in the original data structure
- integer(i4b) :: upperBoundOrig ! upper bound of a given variable in the original data structure
- integer(i4b) :: lowerBoundNew ! lower bound of a given variable in the new data structure
- integer(i4b) :: upperBoundNew ! upper bound of a given variable in the new data structure
- ! initialize error control
- err=0; message='copyStruct_i4b/'
-
- ! get the information from the data structures
- call getVarInfo(varOrig,allocatedOrig,lowerBoundOrig,upperBoundOrig)
- call getVarInfo(varNew, allocatedNew, lowerBoundNew, upperBoundNew)
-
- ! check that the variable of the original data structure is allocated
- if(.not.allocatedOrig)then
- message=trim(message)//'variable in the original data structure is not allocated'
- err=20; return
- endif
-
- ! re-size data structure if necessary
- if(lowerBoundOrig/=lowerBoundNew .or. upperBoundOrig/=upperBoundNew .or. .not.allocatedNew)then
-
- ! deallocate space (if necessary)
- if(allocatedNew) deallocate(varNew%dat)
-
- ! allocate space
- allocate(varNew%dat(lowerBoundOrig:upperBoundOrig), stat=err)
- if(err/=0)then; message=trim(message)//'problem allocating'; return; endif
-
- endif ! if need to resize
-
- ! copy the data structure
- if(copy)then
- varNew%dat(:) = varOrig%dat(:)
-
- ! initialize the data structure to missing values
- else
- varNew%dat(:) = integerMissing
- endif
-
- ! internal routines
- contains
-
- ! internal subroutine getVarInfo: get information from a given data structure
- subroutine getVarInfo(var,isAllocated,lowerBound,upperBound)
- ! input
- type(ilength),intent(in) :: var ! data vector for a given variable
- ! output
- logical(lgt),intent(out) :: isAllocated ! flag to denote if the data vector is allocated
- integer(i4b),intent(out) :: lowerBound ! lower bound
- integer(i4b),intent(out) :: upperBound ! upper bound
- ! local
- integer(i4b),dimension(1) :: lowerBoundVec ! lower bound vector
- integer(i4b),dimension(1) :: upperBoundVec ! upper bound vector
- ! initialize error control
- err=0; message='getVarInfo/'
-
- ! check that the input data structure is allocated
- isAllocated = allocated(var%dat)
-
- ! if allocated then get the bounds
- ! NOTE: also convert vector to scalar
- if(isAllocated)then
- lowerBoundVec=lbound(var%dat); lowerBound=lowerBoundVec(1)
- upperBoundVec=ubound(var%dat); upperBound=upperBoundVec(1)
-
- ! if not allocated then return zero bounds
- else
- lowerBound=0
- upperBound=0
- endif ! (check allocation)
-
- end subroutine getVarInfo
-
- end subroutine copyStruct_i4b
-
-
- ! ************************************************************************************************
- ! private subroutine allocateDat_dp: initialize data dimension of the data structures
- ! ************************************************************************************************
- subroutine allocateDat_dp(metadata,nSnow,nSoil,nLayers, & ! input
- varData,err,message) ! output
- ! access subroutines
- USE get_ixName_module,only:get_varTypeName ! to access type strings for error messages
-
- implicit none
- ! input variables
- type(var_info),intent(in) :: metadata(:) ! metadata structure
- integer(i4b),intent(in) :: nSnow ! number of snow layers
- integer(i4b),intent(in) :: nSoil ! number of soil layers
- integer(i4b),intent(in) :: nLayers ! total number of soil layers in the snow+soil domian (nSnow+nSoil)
- ! output variables
- type(var_dlength),intent(inout) :: varData ! model variables for a local HRU
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! local variables
- integer(i4b) :: iVar ! variable index
- integer(i4b) :: nVars ! number of variables in the metadata structure
-
-! initialize error control
- err=0; message='allocateDat_dp/'
-
- ! get the number of variables in the metadata structure
- nVars = size(metadata)
-
- ! loop through variables in the data structure
- do iVar=1,nVars
-
- ! check allocated
- if(allocated(varData%var(iVar)%dat))then
- message=trim(message)//'variable '//trim(metadata(iVar)%varname)//' is unexpectedly allocated'
- err=20; return
-
- ! allocate structures
- ! NOTE: maxvarFreq is the number of possible output frequencies
- ! -- however, this vector must store two values for the variance calculation, thus the *2 in this allocate
- ! (need enough space in the event that variance is the desired statistic for all output frequencies)
- else
- select case(metadata(iVar)%vartype)
- case(iLookVarType%scalarv); allocate(varData%var(iVar)%dat(1),stat=err)
- case(iLookVarType%wLength); allocate(varData%var(iVar)%dat(nBand),stat=err)
- case(iLookVarType%midSnow); allocate(varData%var(iVar)%dat(nSnow),stat=err)
- case(iLookVarType%midSoil); allocate(varData%var(iVar)%dat(nSoil),stat=err)
- case(iLookVarType%midToto); allocate(varData%var(iVar)%dat(nLayers),stat=err)
- case(iLookVarType%ifcSnow); allocate(varData%var(iVar)%dat(0:nSnow),stat=err)
- case(iLookVarType%ifcSoil); allocate(varData%var(iVar)%dat(0:nSoil),stat=err)
- case(iLookVarType%ifcToto); allocate(varData%var(iVar)%dat(0:nLayers),stat=err)
- case(iLookVarType%parSoil); allocate(varData%var(iVar)%dat(nSoil),stat=err)
- case(iLookVarType%routing); allocate(varData%var(iVar)%dat(nTimeDelay),stat=err)
- case(iLookVarType%outstat); allocate(varData%var(iVar)%dat(maxvarfreq*2),stat=err)
- case(iLookVarType%unknown); allocate(varData%var(iVar)%dat(0),stat=err) ! unknown = special (and valid) case that is allocated later (initialize with zero-length vector)
- case default
- err=40; message=trim(message)//"1. unknownVariableType[name='"//trim(metadata(iVar)%varname)//"'; type='"//trim(get_varTypeName(metadata(iVar)%vartype))//"']"
- return
- end select
- ! check error
- if(err/=0)then; err=20; message=trim(message)//'problem allocating variable '//trim(metadata(iVar)%varname); return; end if
- ! set to missing
- varData%var(iVar)%dat(:) = realMissing
- end if ! if not allocated
-
- end do ! looping through variables
-
- end subroutine allocateDat_dp
-
- ! ************************************************************************************************
- ! private subroutine allocateDat_int: initialize data dimension of the data structures
- ! ************************************************************************************************
- subroutine allocateDat_int(metadata,nSnow,nSoil,nLayers, & ! input
- varData,err,message) ! output
- USE get_ixName_module,only:get_varTypeName ! to access type strings for error messages
- implicit none
- ! input variables
- type(var_info),intent(in) :: metadata(:) ! metadata structure
- integer(i4b),intent(in) :: nSnow ! number of snow layers
- integer(i4b),intent(in) :: nSoil ! number of soil layers
- integer(i4b),intent(in) :: nLayers ! total number of soil layers in the snow+soil domian (nSnow+nSoil)
- ! output variables
- type(var_ilength),intent(inout) :: varData ! model variables for a local HRU
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! local variables
- integer(i4b) :: iVar ! variable index
- integer(i4b) :: nVars ! number of variables in the metadata structure
-
-! initialize error control
- err=0; message='allocateDat_int/'
-
- ! get the number of variables in the metadata structure
- nVars = size(metadata)
-
-! loop through variables in the data structure
- do iVar=1,nVars
-
- ! check allocated
- if(allocated(varData%var(iVar)%dat))then
- message=trim(message)//'variable '//trim(metadata(iVar)%varname)//' is unexpectedly allocated'
- err=20; return
-
- ! allocate structures
- ! NOTE: maxvarFreq is the number of possible output frequencies
- ! -- however, this vector must store two values for the variance calculation, thus the *2 in this allocate
- ! (need enough space in the event that variance is the desired statistic for all output frequencies)
- else
- select case(metadata(iVar)%vartype)
- case(iLookVarType%scalarv); allocate(varData%var(iVar)%dat(1),stat=err)
- case(iLookVarType%wLength); allocate(varData%var(iVar)%dat(nBand),stat=err)
- case(iLookVarType%midSnow); allocate(varData%var(iVar)%dat(nSnow),stat=err)
- case(iLookVarType%midSoil); allocate(varData%var(iVar)%dat(nSoil),stat=err)
- case(iLookVarType%midToto); allocate(varData%var(iVar)%dat(nLayers),stat=err)
- case(iLookVarType%ifcSnow); allocate(varData%var(iVar)%dat(0:nSnow),stat=err)
- case(iLookVarType%ifcSoil); allocate(varData%var(iVar)%dat(0:nSoil),stat=err)
- case(iLookVarType%ifcToto); allocate(varData%var(iVar)%dat(0:nLayers),stat=err)
- case(iLookVarType%routing); allocate(varData%var(iVar)%dat(nTimeDelay),stat=err)
- case(iLookVarType%outstat); allocate(varData%var(iVar)%dat(maxvarFreq*2),stat=err)
- case(iLookVarType%unknown); allocate(varData%var(iVar)%dat(0),stat=err) ! unknown=special (and valid) case that is allocated later (initialize with zero-length vector)
- case default; err=40; message=trim(message)//"unknownVariableType[name='"//trim(metadata(iVar)%varname)//"'; type='"//trim(get_varTypeName(metadata(iVar)%vartype))//"']"; return
- end select
- ! check error
- if(err/=0)then; err=20; message=trim(message)//'problem allocating variable '//trim(metadata(iVar)%varname); return; end if
- ! set to missing
- varData%var(iVar)%dat(:) = integerMissing
- end if ! if not allocated
-
- end do ! looping through variables
-
- end subroutine allocateDat_int
-
- ! ************************************************************************************************
- ! private subroutine allocateDat_flag: initialize data dimension of the data structures
- ! ************************************************************************************************
- subroutine allocateDat_flag(metadata,nSnow,nSoil,nLayers, & ! input
- varData,err,message) ! output
- USE get_ixName_module,only:get_varTypeName ! to access type strings for error messages
- implicit none
- ! input variables
- type(var_info),intent(in) :: metadata(:) ! metadata structure
- integer(i4b),intent(in) :: nSnow ! number of snow layers
- integer(i4b),intent(in) :: nSoil ! number of soil layers
- integer(i4b),intent(in) :: nLayers ! total number of soil layers in the snow+soil domian (nSnow+nSoil)
- ! output variables
- type(var_flagVec),intent(inout) :: varData ! model variables for a local HRU
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! local variables
- integer(i4b) :: iVar ! variable index
- integer(i4b) :: nVars ! number of variables in the metadata structure
-
-! initialize error control
- err=0; message='allocateDat_flag/'
-
- ! get the number of variables in the metadata structure
- nVars = size(metadata)
-
-! loop through variables in the data structure
- do iVar=1,nVars
-
- ! check allocated
- if(allocated(varData%var(iVar)%dat))then
- message=trim(message)//'variable '//trim(metadata(iVar)%varname)//' is unexpectedly allocated'
- err=20; return
-
- ! allocate structures
- ! NOTE: maxvarFreq is the number of possible output frequencies
- ! -- however, this vector must store two values for the variance calculation, thus the *2 in this allocate
- ! (need enough space in the event that variance is the desired statistic for all output frequencies)
- else
- select case(metadata(iVar)%vartype)
- case(iLookVarType%scalarv); allocate(varData%var(iVar)%dat(1),stat=err)
- case(iLookVarType%wLength); allocate(varData%var(iVar)%dat(nBand),stat=err)
- case(iLookVarType%midSnow); allocate(varData%var(iVar)%dat(nSnow),stat=err)
- case(iLookVarType%midSoil); allocate(varData%var(iVar)%dat(nSoil),stat=err)
- case(iLookVarType%midToto); allocate(varData%var(iVar)%dat(nLayers),stat=err)
- case(iLookVarType%ifcSnow); allocate(varData%var(iVar)%dat(0:nSnow),stat=err)
- case(iLookVarType%ifcSoil); allocate(varData%var(iVar)%dat(0:nSoil),stat=err)
- case(iLookVarType%ifcToto); allocate(varData%var(iVar)%dat(0:nLayers),stat=err)
- case(iLookVarType%routing); allocate(varData%var(iVar)%dat(nTimeDelay),stat=err)
- case(iLookVarType%outstat); allocate(varData%var(iVar)%dat(maxvarFreq*2),stat=err)
- case(iLookVarType%unknown); allocate(varData%var(iVar)%dat(0),stat=err) ! unknown=special (and valid) case that is allocated later (initialize with zero-length vector)
- case default; err=40; message=trim(message)//"unknownVariableType[name='"//trim(metadata(iVar)%varname)//"'; type='"//trim(get_varTypeName(metadata(iVar)%vartype))//"']"; return
- end select
- ! check error
- if(err/=0)then; err=20; message=trim(message)//'problem allocating variable '//trim(metadata(iVar)%varname); return; end if
- ! set to false
- varData%var(iVar)%dat(:) = .false.
- end if ! if not allocated
-
- end do ! looping through variables
-
- end subroutine allocateDat_flag
-
-end module allocspace_module