Skip to content
Snippets Groups Projects
Commit 415fe898 authored by Kyle Klenk's avatar Kyle Klenk
Browse files

implemented new subroutine read_param_all_hru

parent 2e246599
No related branches found
No related tags found
No related merge requests found
...@@ -33,4 +33,6 @@ extern "C" { ...@@ -33,4 +33,6 @@ extern "C" {
void Write_HRU_Param(void* handle_ncid, int* indxGRU, int* indxHRU, int* err); void Write_HRU_Param(void* handle_ncid, int* indxGRU, int* indxHRU, int* err);
void readAttributeFileAccessActor(int* num_gru, int* err); void readAttributeFileAccessActor(int* num_gru, int* err);
void readParamFileAccessActor(int* start_gru, int* num_gru, int* err);
} }
...@@ -144,7 +144,8 @@ SUMMA_FILEACCESS_INTERFACE = \ ...@@ -144,7 +144,8 @@ SUMMA_FILEACCESS_INTERFACE = \
initOutputStruc.f90 \ initOutputStruc.f90 \
deallocateOutputStruc.f90 \ deallocateOutputStruc.f90 \
cppwrap_fileAccess.f90 \ cppwrap_fileAccess.f90 \
read_attribute_all_hru.f90 read_attribute_all_hru.f90 \
read_param_all_hru.f90
FILEACCESS_INTERFACE = $(patsubst %, $(FILE_ACCESS_DIR)/%, $(SUMMA_FILEACCESS_INTERFACE)) FILEACCESS_INTERFACE = $(patsubst %, $(FILE_ACCESS_DIR)/%, $(SUMMA_FILEACCESS_INTERFACE))
......
...@@ -240,7 +240,7 @@ void initalizeFileAccessActor(stateful_actor<file_access_state>* self) { ...@@ -240,7 +240,7 @@ void initalizeFileAccessActor(stateful_actor<file_access_state>* self) {
Init_OutputStruct(self->state.handle_forcing_file_info, &self->state.outputStrucSize, Init_OutputStruct(self->state.handle_forcing_file_info, &self->state.outputStrucSize,
&self->state.numGRU, &self->state.err); &self->state.numGRU, &self->state.err);
// Read In all of the attribres for the number of GRUs in the run Domian // Read In all of the attribres for the number of GRUs in the run Domian
readAttributeFileAccessActor(&self->state.numGRU, &err); readAttributeFileAccessActor(&self->state.numGRU, &err);
if (err != 0) { if (err != 0) {
aout(self) << "ERROR: FILE_ACCESS_ACTOR readAttributeFilAccessActor() \n"; aout(self) << "ERROR: FILE_ACCESS_ACTOR readAttributeFilAccessActor() \n";
...@@ -250,6 +250,16 @@ void initalizeFileAccessActor(stateful_actor<file_access_state>* self) { ...@@ -250,6 +250,16 @@ void initalizeFileAccessActor(stateful_actor<file_access_state>* self) {
return; return;
} }
// Read in all of the parmeters for the number of GRUs in the run Domain
readParamFileAccessActor(&self->state.startGRU, &self->state.numGRU, &err);
if (err != 0) {
aout(self) << "ERROR: FILE_ACCESS_ACTOR readParamFileAccessActor() \n";
std::string function = "readParamFileAccessActor";
self->send(self->state.parent, file_access_actor_err_v, function);
self->quit();
return;
}
// Initalize the output manager // Initalize the output manager
self->state.output_manager = new OutputManager(self->state.num_vectors_in_output_manager, self->state.numGRU); self->state.output_manager = new OutputManager(self->state.num_vectors_in_output_manager, self->state.numGRU);
......
module read_param_all_hru
USE, intrinsic :: iso_c_binding
USE nrtype
implicit none
private
public::read_param_file_access_actor
contains
subroutine read_param_file_access_actor(startGRU,num_gru,err) bind(C, name="readParamFileAccessActor")
! used to read model initial conditions
USE summaActors_FileManager,only:SETTINGS_PATH ! path for metadata files
USE summaActors_FileManager,only:PARAMETER_TRIAL ! file with parameter trial values
USE get_ixname_module,only:get_ixparam,get_ixbpar ! access function to find index of elements in structure
USE globalData,only:index_map,gru_struc ! mapping from global HRUs to the elements in the data structures
USE var_lookup,only:iLookPARAM,iLookTYPE,iLookID ! named variables to index elements of the data vectors
USE globalData,only:integerMissing ! missing integer
USE globalData,only:realMissing ! missing real number
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
USE globalData,only:outputStructure
implicit none
! define input
integer(c_int),intent(in) :: startGRU ! starting Index of gru Batch
integer(c_int),intent(in) :: num_gru ! number of GRUs in the run_domain
integer(c_int),intent(out) :: err ! error code
! define local variables
character(len=256) :: message ! error message
character(len=1024) :: cmessage ! error message for downwind routine
character(LEN=1024) :: infile ! input filename
integer(i4b) :: localHRU_ix ! index of HRU within data structure
integer(i4b) :: ixParam ! index of the model parameter in the data structure
! indices/metadata in the NetCDF file
integer(i4b) :: ncid ! netcdf id
integer(i4b) :: nDims ! number of dimensions
integer(i4b) :: nVars ! number of variables
integer(i4b) :: idimid ! dimension index
integer(i4b) :: ivarid ! variable index
character(LEN=64) :: dimName ! dimension name
character(LEN=64) :: parName ! parameter name
integer(i4b) :: dimLength ! dimension length
integer(i4b) :: nHRU_file ! number of HRUs in the parafile
integer(i4b) :: nGRU_file ! number of GRUs in the parafile
integer(i4b) :: nSoil_file ! number of soil layers in the file
integer(i4b) :: idim_list(2) ! list of dimension ids
! data in the netcdf file
integer(i4b) :: parLength ! length of the parameter data
integer(8),allocatable :: hruId(:) ! HRU identifier in the file
real(dp),allocatable :: parVector(:) ! model parameter vector
logical :: fexist ! inquire whether the parmTrial file exists
integer(i4b) :: fHRU ! index of HRU in input file
integer(i4b) :: iGRU
integer(i4b) :: iHRU
err=0; message="read_param_all_hru.f90/"
! **********************************************************************************************
! * open files, etc.
! **********************************************************************************************
infile = trim(SETTINGS_PATH)//trim(PARAMETER_TRIAL) ! build filename
! check whether the user-specified file exists and warn if it does not
inquire(file=trim(infile),exist=fexist)
if (.not.fexist) then
write(*,'(A)') NEW_LINE('A')//'!! WARNING: trial parameter file not found; proceeding instead with other default parameters; check path in file manager input if this was not the desired behavior'//NEW_LINE('A')
return
endif
! open trial parameters file if it exists
call nc_file_open(trim(infile),nf90_nowrite,ncid,err,cmessage)
if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
! get the number of variables in the parameter file
err=nf90_inquire(ncid, nDimensions=nDims, nVariables=nVars)
call netcdf_err(err,message); if (err/=0) then; err=20; return; end if
! initialize the number of HRUs
nHRU_file=integerMissing
nGRU_file=integerMissing
! get the length of the dimensions
do idimid=1,nDims
! get the dimension name and length
err=nf90_inquire_dimension(ncid, idimid, name=dimName, len=dimLength)
if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
! get the number of HRUs
if(trim(dimName)=='hru') nHRU_file=dimLength
if(trim(dimName)=='gru') nGRU_file=dimLength
end do
! allocate hruID vector
allocate(hruId(nHRU_file))
! check HRU dimension exists
if(nHRU_file==integerMissing)then
message=trim(message)//'unable to identify HRU dimension in file '//trim(infile)
err=20; return
endif
! **********************************************************************************************
! * read the HRU index
! **********************************************************************************************
! loop through the parameters in the NetCDF file
do ivarid=1,nVars
! get the parameter name
err=nf90_inquire_variable(ncid, ivarid, name=parName)
call netcdf_err(err,message)
if (err/=0) then
err=20
print*, message
return
end if
! special case of the HRU id
if(trim(parName)=='hruIndex' .or. trim(parName)=='hruId')then
! read HRUs
err=nf90_get_var(ncid, ivarid, hruId)
if(err/=0)then
message=trim(message)//trim(cmessage)
print*, message
return
end if
endif ! if the HRU id
end do ! looping through variables in the file
! **********************************************************************************************
! * read the local parameters and the basin parameters
! **********************************************************************************************
do ivarid=1,nVars
! get the parameter name
err=nf90_inquire_variable(ncid, ivarid, name=parName)
call netcdf_err(err,message); if (err/=0) then; err=20; return; end if
! get the local parameters
ixParam = get_ixparam( trim(parName) )
if(ixParam/=integerMissing)then
! **********************************************************************************************
! * read the local parameters
! **********************************************************************************************
! get the variable shape
err=nf90_inquire_variable(ncid, ivarid, nDims=nDims, dimids=idim_list)
if(err/=0)then
message=trim(message)//trim(cmessage)
print*, message
return
end if
! get the length of the depth dimension (if it exists)
if(nDims==2)then
! get the information on the 2nd dimension for 2-d variables
err=nf90_inquire_dimension(ncid, idim_list(2), dimName, nSoil_file)
if(err/=0)then
message=trim(message)//trim(cmessage)
print*, message
return
end if
! check that it is the depth dimension
if(trim(dimName)/='depth')then
message=trim(message)//'expect 2nd dimension of 2-d variable to be depth (dimension name = '//trim(dimName)//')'
err=20; return
endif
! TODO: implement this check
! ! check that the dimension length is correct
! if(size(outputStructur(1)%mparStruct%var(ixParam)%dat) /= nSoil_file)then
! message=trim(message)//'unexpected number of soil layers in parameter file'
! err=20; return
! endif
! define parameter length
parLength = nSoil_file
else
parLength = 1
endif ! if two dimensions
! allocate space for model parameters
allocate(parVector(parLength),stat=err)
if(err/=0)then
message=trim(message)//'problem allocating space for parameter vector'
err=20; return
endif
! loop through all hrus
do iGRU=1, num_gru
do iHRU=1, gru_struc(iGRU)%hruCount
localHRU_ix=index_map(iHRU)%localHRU_ix
fHRU = gru_struc(iGRU)%hruInfo(localHRU_ix)%hru_nc
! read parameter data
select case(nDims)
case(1); err=nf90_get_var(ncid, ivarid, parVector, start=(/fHRU/), count=(/1/) )
case(2); err=nf90_get_var(ncid, ivarid, parVector, start=(/fHRU,1/), count=(/1,nSoil_file/) )
case default; err=20; message=trim(message)//'unexpected number of dimensions for parameter '//trim(parName)
end select
! error check for the parameter read
if(err/=0)then
message=trim(message)//trim(cmessage)
print*, message
return
end if
! populate parameter structures
select case(nDims)
case(1); outputStructure(1)%mparStruct(1)%gru(iGRU)%hru(localHRU_ix)%var(ixParam)%dat(:) = parVector(1) ! also distributes scalar across depth dimension
case(2); outputStructure(1)%mparStruct(1)%gru(iGRU)%hru(localHRU_ix)%var(ixParam)%dat(:) = parVector(:)
case default; err=20; message=trim(message)//'unexpected number of dimensions for parameter '//trim(parName)
end select
end do
end do
! deallocate space for model parameters
deallocate(parVector,stat=err)
if(err/=0)then
message=trim(message)//'problem deallocating space for parameter vector'
print*, message
err=20; return
endif
! **********************************************************************************************
! * read the basin parameters
! **********************************************************************************************
! get the basin parameters
else
! get the parameter index
ixParam = get_ixbpar( trim(parName) )
! allow extra variables in the file that are not used
if(ixParam==integerMissing) cycle
! allocate space for model parameters
allocate(parVector(nGRU_file),stat=err)
if(err/=0)then
message=trim(message)//'problem allocating space for parameter vector'
print*, message
err=20; return
endif
! read parameter data
err=nf90_get_var(ncid, ivarid, parVector )
if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
! populate parameter structures
do iGRU=1, num_gru
outputStructure(1)%bparStruct(1)%gru(1)%var(ixParam) = parVector(iGRU+startGRU-1)
end do
! deallocate space for model parameters
deallocate(parVector,stat=err)
if(err/=0)then
message=trim(message)//'problem deallocating space for parameter vector'
print*, message
err=20; return
endif
endif
end do ! (looping through the parameters in the NetCDF file)
! Now we must close the netcdf file
call nc_file_close(ncid,err,message)
if(err/=0)then;message=trim(message)//trim(cmessage);return;end if
end subroutine read_param_file_access_actor
end module read_param_all_hru
\ No newline at end of file
...@@ -94,7 +94,7 @@ contains ...@@ -94,7 +94,7 @@ contains
USE read_attribute_module,only:read_attribute ! module to read local attributes 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 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 pOverwrite_module,only:pOverwrite ! module to overwrite default parameter values with info from the Noah tables
USE read_param4chm_module,only:read_param4chm ! module to read model parameter sets 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 ConvE2Temp_module,only:E2T_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) USE var_derive_module,only:fracFuture ! module to calculate the fraction of runoff in future time steps (time delay histogram)
USE module_sf_noahmplsm,only:read_mp_veg_parameters ! module to read NOAH vegetation tables USE module_sf_noahmplsm,only:read_mp_veg_parameters ! module to read NOAH vegetation tables
...@@ -188,21 +188,12 @@ contains ...@@ -188,21 +188,12 @@ contains
! ***************************************************************************** ! *****************************************************************************
! *** read local attributes for each HRU ! *** read local attributes for each HRU
! ***************************************************************************** ! *****************************************************************************
! read local attributes for each HRU
call read_attribute(indxHRU,indxGRU,attrStruct,typeStruct,idStruct,err,cmessage) call read_attribute(indxHRU,indxGRU,attrStruct,typeStruct,idStruct,err,cmessage)
if(err/=0)then; message=trim(message)//trim(cmessage); return; endif if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
! *****************************************************************************
! *** read Noah vegetation and soil tables
! *****************************************************************************
! define monthly fraction of green vegetation ! define monthly fraction of green vegetation
greenVegFrac_monthly = (/0.01_dp, 0.02_dp, 0.03_dp, 0.07_dp, 0.50_dp, 0.90_dp, 0.95_dp, 0.96_dp, 0.65_dp, 0.24_dp, 0.11_dp, 0.02_dp/) greenVegFrac_monthly = (/0.01_dp, 0.02_dp, 0.03_dp, 0.07_dp, 0.50_dp, 0.90_dp, 0.95_dp, 0.96_dp, 0.65_dp, 0.24_dp, 0.11_dp, 0.02_dp/)
! define urban vegetation category ! define urban vegetation category
select case(trim(model_decisions(iLookDECISIONS%vegeParTbl)%cDecision)) select case(trim(model_decisions(iLookDECISIONS%vegeParTbl)%cDecision))
case('USGS'); urbanVegCategory = 1 case('USGS'); urbanVegCategory = 1
...@@ -236,7 +227,7 @@ contains ...@@ -236,7 +227,7 @@ contains
! ***************************************************************************** ! *****************************************************************************
! *** read trial model parameter values for each HRU, and populate initial data structures ! *** read trial model parameter values for each HRU, and populate initial data structures
! ***************************************************************************** ! *****************************************************************************
call read_param4chm(indxHRU,indxGRU,iRunMode,startGRU, & call read_param(indxHRU,indxGRU,iRunMode,startGRU, &
mparStruct,bparStruct,err,cmessage) mparStruct,bparStruct,err,cmessage)
if(err/=0)then; message=trim(message)//trim(cmessage); return; endif if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
! ***************************************************************************** ! *****************************************************************************
......
...@@ -36,236 +36,10 @@ implicit none ...@@ -36,236 +36,10 @@ implicit none
private private
! routines to make public ! routines to make public
! public::getCommandArguments4chm
public::stop_program public::stop_program
public::handle_err public::handle_err
contains contains
! **************************************************************************************************
! * obtain the command line arguments
! **************************************************************************************************
! subroutine getCommandArguments4chm(file_manager_path,summaFileManagerFile,err,message)
! ! data types
! USE summa4chm_type, only:summa4chm_type_dec ! master summa data type
! ! provide access to named parameters
! USE globalData,only:iRunModeFull,iRunModeGRU,iRunModeHRU
! USE globalData,only:ixProgress_it,ixProgress_im,ixProgress_id,ixProgress_ih,ixProgress_never
! USE globalData,only:ixRestart_iy,ixRestart_im,ixRestart_id,ixRestart_end,ixRestart_never
! USE globalData,only:noNewFiles,newFileEveryOct1
! ! provide access to runtime options
! USE globalData,only: startGRU ! index of the starting GRU for parallelization run
! USE globalData,only: checkHRU ! index of the HRU for a single HRU run
! USE globalData,only: iRunMode ! define the current running mode
! USE globalData,only: newOutputFile ! define option for new output file
! USE globalData,only: ixProgress ! define frequency to write progress
! USE globalData,only: ixRestart ! define frequency to write restart files
! USE globalData,only: output_fileSuffix ! suffix for the output file
! implicit none
! ! dummy variables
! character(len=256),intent(in) :: file_manager_path ! path/name of file defining directories and files
! character(len=256),intent(inout) :: summaFileManagerFile ! path/name of file defining directories and files
! integer(i4b),intent(out) :: err ! error code
! character(*),intent(out) :: message ! error message
! ! local variables
! integer(i4b) :: nGRU ! number of grouped response units
! integer(i4b) :: nHRU ! number of global hydrologic response units
! integer(i4b) :: iArgument ! index of command line argument
! integer(i4b) :: nArgument ! number of command line arguments
! character(len=256),allocatable :: argString(:) ! string to store command line arguments
! integer(i4b) :: nLocalArgument ! number of command line arguments to read for a switch
! character(len=70), parameter :: spaces = '' ! setting a blank string
! ! version information generated during compiling
! INCLUDE 'summaversion.inc'
! ! ---------------------------------------------------------------------------------------
! ! initialize error control
! err=0; message='getCommandArguments4chm/'
! nArgument = 6
! allocate(argString(nArgument))
! argString(1) = '-p'
! argString(2) = 'never'
! argString(3) = '-s'
! argString(4) = '_testSumma'
! argString(5) = '-m'
! argString(6) = file_manager_path
! ! initialize command line argument variables
! startGRU = integerMissing; checkHRU = integerMissing
! nGRU = integerMissing; nHRU = integerMissing
! newOutputFile = noNewFiles
! iRunMode = iRunModeFull
! ! loop through all command arguments
! nLocalArgument = 0
! do iArgument = 1,nArgument
! if (nLocalArgument>0) then; nLocalArgument = nLocalArgument -1; cycle; end if ! skip the arguments have been read
! select case (trim(argString(iArgument)))
! case ('-m', '--master')
! ! update arguments
! nLocalArgument = 1
! if (iArgument+nLocalArgument>nArgument)then
! message="missing argument file_suffix; type 'summa.exe --help' for correct usage"
! err=1; return
! endif
! ! get name of master control file
! summaFileManagerFile=trim(argString(iArgument+1))
! print "(A)", "file_master is '"//trim(summaFileManagerFile)//"'."
! ! define the formation of new output files
! case ('-n', '--newFile')
! ! check that the number of command line arguments is correct
! nLocalArgument = 1 ! expect just one argument for new output files
! if (iArgument+nLocalArgument>nArgument)then
! message="missing argument file_suffix; type 'summa.exe --help' for correct usage"
! err=1; return
! endif
! ! get the decision for the formation of new output files
! select case( trim(argString(iArgument+1)) )
! case('noNewFiles'); newOutputFile = noNewFiles
! case('newFileEveryOct1'); newOutputFile = newFileEveryOct1
! case default
! message='unknown option for new output file: expect "noNewFiles" or "newFileEveryOct1"'
! err=1; return
! end select
! case ('-s', '--suffix')
! ! define file suffix
! nLocalArgument = 1
! ! check if the number of command line arguments is correct
! if (iArgument+nLocalArgument>nArgument) then
! message="missing argument file_suffix; type 'summa.exe --help' for correct usage"
! err=1; return
! endif
! output_fileSuffix=trim(argString(iArgument+1))
! print "(A)", "file_suffix is '"//trim(output_fileSuffix)//"'."
! case ('-h', '--hru')
! ! define a single HRU run
! if (iRunMode == iRunModeGRU)then
! message="single-HRU run and GRU-parallelization run cannot be both selected."
! err=1; return
! endif
! iRunMode=iRunModeHRU
! nLocalArgument = 1
! ! check if the number of command line arguments is correct
! if (iArgument+nLocalArgument>nArgument) call handle_err(1,"missing argument checkHRU; type 'summa.exe --help' for correct usage")
! read(argString(iArgument+1),*) checkHRU ! read the index of the HRU for a single HRU run
! nHRU=1; nGRU=1 ! nHRU and nGRU are both one in this case
! ! examines the checkHRU is correct
! if (checkHRU<1) then
! message="illegal iHRU specification; type 'summa.exe --help' for correct usage"
! err=1; return
! else
! print '(A)',' Single-HRU run activated. HRU '//trim(argString(iArgument+1))//' is selected for simulation.'
! end if
! case ('-g','--gru')
! ! define a GRU parallelization run; get the starting GRU and countGRU
! if (iRunMode == iRunModeHRU)then
! message="single-HRU run and GRU-parallelization run cannot be both selected."
! err=1; return
! endif
! iRunMode=iRunModeGRU
! nLocalArgument = 2
! ! check if the number of command line arguments is correct
! if (iArgument+nLocalArgument>nArgument)then
! message="missing argument startGRU or countGRU; type 'summa.exe --help' for correct usage"
! err=1; return
! endif
! read(argString(iArgument+1),*) startGRU ! read the argument of startGRU
! read(argString(iArgument+2),*) nGRU ! read the argument of countGRU
! if (startGRU<1 .or. nGRU<1) then
! message='startGRU and countGRU must be larger than 1.'
! err=1; return
! else
! print '(A)', ' GRU-Parallelization run activated. '//trim(argString(iArgument+2))//' GRUs are selected for simulation.'
! end if
! case ('-p', '--progress')
! ! define the frequency to print progress
! nLocalArgument = 1
! ! check if the number of command line arguments is correct
! if (iArgument+nLocalArgument>nArgument)then
! message="missing argument freqProgress; type 'summa.exe --help' for correct usage"
! err=1; return
! endif
! select case (trim(argString(iArgument+1)))
! case ('t' , 'timestep'); ixProgress = ixProgress_it
! case ('h' , 'hour'); ixProgress = ixProgress_ih
! case ('d' , 'day'); ixProgress = ixProgress_id ! default
! case ('m' , 'month'); ixProgress = ixProgress_im
! case ('n' , 'never'); ixProgress = ixProgress_never
! case default
! message='unknown frequency to print progress'
! err=1; return
! end select
! case ('-r', '--restart')
! ! define the frequency to write restart files
! nLocalArgument = 1
! ! check if the number of command line arguments is correct
! if (iArgument+nLocalArgument>nArgument)then
! message="missing argument freqRestart; type 'summa.exe --help' for correct usage"
! err=1; return
! endif
! select case (trim(argString(iArgument+1)))
! case ('y' , 'year'); ixRestart = ixRestart_iy
! case ('m' , 'month'); ixRestart = ixRestart_im
! case ('d' , 'day'); ixRestart = ixRestart_id
! case ('e' , 'end'); ixRestart = ixRestart_end
! case ('n' , 'never'); ixRestart = ixRestart_never
! case default
! message='unknown frequency to write restart files'
! err=1; return
! end select
! ! do nothing
! case ('-v','--version')
! ! print help message
! case ('--help')
! call printCommandHelp
! case default
! call printCommandHelp
! message='unknown command line option'
! err=1; return
! end select
! end do ! looping through command line arguments
! ! check if master_file has been received.
! if (len(trim(summaFileManagerFile))==0)then
! message="master_file is not received; type 'summa.exe --help' for correct usage"
! err=1; return
! endif
! ! set startGRU for full run
! if (iRunMode==iRunModeFull) startGRU=1
! end subroutine getCommandArguments4chm
! **************************************************************************************************
! print the correct command line usage of SUMMA
! **************************************************************************************************
! subroutine printCommandHelp()
! implicit none
! ! command line usage
! print "(//A)",'Usage: summa.exe -m master_file [-s fileSuffix] [-g startGRU countGRU] [-h iHRU] [-r freqRestart] [-p freqProgress] [-c]'
! print "(A,/)", ' summa.exe summa executable'
! print "(A)", 'Running options:'
! print "(A)", ' -m --master Define path/name of master file (required)'
! print "(A)", ' -n --newFile Define frequency [noNewFiles,newFileEveryOct1] of new output files'
! print "(A)", ' -s --suffix Add fileSuffix to the output files'
! print "(A)", ' -g --gru Run a subset of countGRU GRUs starting from index startGRU'
! print "(A)", ' -h --hru Run a single HRU with index of iHRU'
! print "(A)", ' -r --restart Define frequency [y,m,d,e,never] to write restart files'
! print "(A)", ' -p --progress Define frequency [m,d,h,never] to print progress'
! print "(A)", ' -v --version Display version information of the current build'
! stop
! end subroutine printCommandHelp
! ************************************************************************************************** ! **************************************************************************************************
! error handler ! error handler
! ************************************************************************************************** ! **************************************************************************************************
......
...@@ -41,319 +41,299 @@ USE data_types,only:var_dlength ! spatial double data type: x%gru(:)%hru(: ...@@ -41,319 +41,299 @@ USE data_types,only:var_dlength ! spatial double data type: x%gru(:)%hru(:
implicit none implicit none
private private
public::read_param4chm public::read_param
contains contains
! ************************************************************************************************ ! ************************************************************************************************
! public subroutine read_param4chm: read trial model parameter values ! public subroutine read_param4chm: read trial model parameter values
! ************************************************************************************************ ! ************************************************************************************************
subroutine read_param4chm(indxHRU,indxGRU,iRunMode,startGRU,mparStruct,bparStruct,err,message) subroutine read_param(indxHRU,indxGRU,iRunMode,startGRU,mparStruct,bparStruct,err,message)
! used to read model initial conditions ! used to read model initial conditions
USE summaActors_FileManager,only:SETTINGS_PATH ! path for metadata files USE summaActors_FileManager,only:SETTINGS_PATH ! path for metadata files
USE summaActors_FileManager,only:PARAMETER_TRIAL ! file with parameter trial values USE summaActors_FileManager,only:PARAMETER_TRIAL ! file with parameter trial values
USE get_ixname_module,only:get_ixparam,get_ixbpar ! access function to find index of elements in structure USE get_ixname_module,only:get_ixparam,get_ixbpar ! access function to find index of elements in structure
USE globalData,only:index_map,gru_struc ! mapping from global HRUs to the elements in the data structures USE globalData,only:index_map,gru_struc ! mapping from global HRUs to the elements in the data structures
USE var_lookup,only:iLookPARAM,iLookTYPE,iLookID ! named variables to index elements of the data vectors USE var_lookup,only:iLookPARAM,iLookTYPE,iLookID ! named variables to index elements of the data vectors
implicit none implicit none
! define input ! define input
integer(i4b),intent(in) :: indxHRU integer(i4b),intent(in) :: indxHRU
integer(i4b),intent(in) :: indxGRU integer(i4b),intent(in) :: indxGRU
integer(i4b),intent(in) :: iRunMode ! run mode integer(i4b),intent(in) :: iRunMode ! run mode
integer(i4b),intent(in) :: startGRU ! index of single GRU if runMode = startGRU integer(i4b),intent(in) :: startGRU ! index of single GRU if runMode = startGRU
! type(var_i8),intent(in) :: idStruct ! local labels for hru and gru IDs ! type(var_i8),intent(in) :: idStruct ! local labels for hru and gru IDs
! define output ! define output
type(var_dlength),intent(inout) :: mparStruct ! model parameters type(var_dlength),intent(inout) :: mparStruct ! model parameters
type(var_d),intent(inout) :: bparStruct ! basin parameters type(var_d),intent(inout) :: bparStruct ! basin parameters
integer(i4b),intent(out) :: err ! error code integer(i4b),intent(out) :: err ! error code
character(*),intent(out) :: message ! error message character(*),intent(out) :: message ! error message
! define local variables ! define local variables
character(len=1024) :: cmessage ! error message for downwind routine character(len=1024) :: cmessage ! error message for downwind routine
character(LEN=1024) :: infile ! input filename character(LEN=1024) :: infile ! input filename
integer(i4b) :: localHRU_ix ! index of HRU within data structure integer(i4b) :: localHRU_ix ! index of HRU within data structure
integer(i4b) :: ixParam ! index of the model parameter in the data structure integer(i4b) :: ixParam ! index of the model parameter in the data structure
! indices/metadata in the NetCDF file ! indices/metadata in the NetCDF file
integer(i4b) :: ncid ! netcdf id integer(i4b) :: ncid ! netcdf id
integer(i4b) :: nDims ! number of dimensions integer(i4b) :: nDims ! number of dimensions
integer(i4b) :: nVars ! number of variables integer(i4b) :: nVars ! number of variables
integer(i4b) :: idimid ! dimension index integer(i4b) :: idimid ! dimension index
integer(i4b) :: ivarid ! variable index integer(i4b) :: ivarid ! variable index
character(LEN=64) :: dimName ! dimension name character(LEN=64) :: dimName ! dimension name
character(LEN=64) :: parName ! parameter name character(LEN=64) :: parName ! parameter name
integer(i4b) :: dimLength ! dimension length integer(i4b) :: dimLength ! dimension length
integer(i4b) :: nHRU_file ! number of HRUs in the parafile integer(i4b) :: nHRU_file ! number of HRUs in the parafile
integer(i4b) :: nGRU_file ! number of GRUs in the parafile integer(i4b) :: nGRU_file ! number of GRUs in the parafile
integer(i4b) :: nSoil_file ! number of soil layers in the file integer(i4b) :: nSoil_file ! number of soil layers in the file
integer(i4b) :: idim_list(2) ! list of dimension ids integer(i4b) :: idim_list(2) ! list of dimension ids
! data in the netcdf file ! data in the netcdf file
integer(i4b) :: parLength ! length of the parameter data integer(i4b) :: parLength ! length of the parameter data
integer(8),allocatable :: hruId(:) ! HRU identifier in the file integer(8),allocatable :: hruId(:) ! HRU identifier in the file
real(dp),allocatable :: parVector(:) ! model parameter vector real(dp),allocatable :: parVector(:) ! model parameter vector
logical :: fexist ! inquire whether the parmTrial file exists logical :: fexist ! inquire whether the parmTrial file exists
integer(i4b) :: fHRU ! index of HRU in input file integer(i4b) :: fHRU ! index of HRU in input file
! Start procedure here ! Start procedure here
err=0; message="read_param4chm/" err=0; message="read_param4chm/"
! **********************************************************************************************
! * open files, etc.
! **********************************************************************************************
! build filename
infile = trim(SETTINGS_PATH)//trim(PARAMETER_TRIAL)
! check whether the user-specified file exists and warn if it does not
inquire(file=trim(infile),exist=fexist)
if (.not.fexist) then
write(*,'(A)') NEW_LINE('A')//'!! WARNING: trial parameter file not found; proceeding instead with other default parameters; check path in file manager input if this was not the desired behavior'//NEW_LINE('A')
return
endif
! open trial parameters file if it exists
call nc_file_open(trim(infile),nf90_nowrite,ncid,err,cmessage)
if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
! get the number of variables in the parameter file
err=nf90_inquire(ncid, nDimensions=nDims, nVariables=nVars)
call netcdf_err(err,message); if (err/=0) then; err=20; return; end if
! initialize the number of HRUs
nHRU_file=integerMissing
nGRU_file=integerMissing
! get the length of the dimensions
do idimid=1,nDims
! get the dimension name and length
err=nf90_inquire_dimension(ncid, idimid, name=dimName, len=dimLength)
if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
! get the number of HRUs
if(trim(dimName)=='hru') nHRU_file=dimLength
if(trim(dimName)=='gru') nGRU_file=dimLength
end do
! allocate hruID vector
allocate(hruId(nHRU_file))
! check HRU dimension exists
if(nHRU_file==integerMissing)then
message=trim(message)//'unable to identify HRU dimension in file '//trim(infile)
err=20; return
endif
! check have the correct number of HRUs
! if ((irunMode==irunModeFull).and.(nHRU_file/=nHRU)) then
! message=trim(message)//'incorrect number of HRUs in file '//trim(infile)
! err=20; return
! endif
! if ((irunMode==irunModeHRU).and.(nHRU_file<checkHRU)) then
! message=trim(message)//'not enough HRUs in file '//trim(infile)
! err=20; return
! endif
! ! check have the correct number of GRUs
! if ((irunMode==irunModeGRU).and.(nGRU_file<startGRU).and.(nGRU_file/=integerMissing)) then
! message=trim(message)//'not enough GRUs in file '//trim(infile)
! err=20; return
! endif
! if ((irunMode==irunModeFull).and.(nGRU_file/=nGRU).and.(nGRU_file/=integerMissing)) then
! message=trim(message)//'incorrect number of GRUs in file '//trim(infile)
! err=20; return
! endif
! **********************************************************************************************
! * read the HRU index
! **********************************************************************************************
! loop through the parameters in the NetCDF file
do ivarid=1,nVars
! get the parameter name
err=nf90_inquire_variable(ncid, ivarid, name=parName)
call netcdf_err(err,message); if (err/=0) then; err=20; return; end if
! special case of the HRU id
if(trim(parName)=='hruIndex' .or. trim(parName)=='hruId')then
! read HRUs
err=nf90_get_var(ncid, ivarid, hruId)
if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
! check HRUs -- expect HRUs to be in the same order as the local attributes
! if (iRunMode==iRunModeFull) then
! !iGRU=index_map(indxHRU)%gru_ix
! localHRU_ix=index_map(indxHRU)%localHRU_ix
! if((hruId(indxHRU)>0).and.(hruId(indxHRU)/=idStruct%var(iLookID%hruId)))then
! write(message,'(a,i0,a,i0,a)') trim(message)//'mismatch for HRU ', idStruct%var(iLookID%hruId), '(param HRU = ', hruId(indxHRU), ')'
! err=20; return
! endif
! else if (iRunMode==iRunModeGRU) then
! ! do iHRU=1,nHRU
! !iGRU=index_map(indxHRU)%gru_ix
! localHRU_ix=index_map(indxHRU)%localHRU_ix
! fHRU = gru_struc(indxGRU)%hruInfo(localHRU_ix)%hru_nc
! if(hruId(fHRU)/=idStruct%var(iLookID%hruId))then
! write(message,'(a,i0,a,i0,a)') trim(message)//'mismatch for HRU ', idStruct%var(iLookID%hruId), '(param HRU = ', hruId(indxHRU), ')'
! err=20; return
! endif
! ! enddo
! else if (iRunMode==iRunModeHRU) then
! !iGRU=index_map(1)%gru_ix
! localHRU_ix=index_map(indxHRU)%localHRU_ix
! if(hruId(checkHRU)/=idStruct%var(iLookID%hruId))then
! write(message,'(a,i0,a,i0,a)') trim(message)//'mismatch for HRU ', idStruct%var(iLookID%hruId), '(param HRU = ', hruId(indxHRU), ')'
! err=20; return
! endif
! error check
! else
! err = 20; message = 'run mode not recognized'; return;
! end if
endif ! if the HRU id
end do ! looping through variables in the file
! **********************************************************************************************
! * read the local parameters and the basin parameters
! **********************************************************************************************
! loop through the parameters in the NetCDF file
do ivarid=1,nVars
! get the parameter name
err=nf90_inquire_variable(ncid, ivarid, name=parName)
call netcdf_err(err,message); if (err/=0) then; err=20; return; end if
! get the local parameters
ixParam = get_ixparam( trim(parName) )
if(ixParam/=integerMissing)then
! ********************************************************************************************** ! **********************************************************************************************
! * read the local parameters ! * open files, etc.
! ********************************************************************************************** ! **********************************************************************************************
! get the variable shape ! build filename
err=nf90_inquire_variable(ncid, ivarid, nDims=nDims, dimids=idim_list) infile = trim(SETTINGS_PATH)//trim(PARAMETER_TRIAL)
if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
! get the length of the depth dimension (if it exists)
if(nDims==2)then
! get the information on the 2nd dimension for 2-d variables
err=nf90_inquire_dimension(ncid, idim_list(2), dimName, nSoil_file)
if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
! check that it is the depth dimension
if(trim(dimName)/='depth')then
message=trim(message)//'expect 2nd dimension of 2-d variable to be depth (dimension name = '//trim(dimName)//')'
err=20; return
endif
! check that the dimension length is correct
if(size(mparStruct%var(ixParam)%dat) /= nSoil_file)then
message=trim(message)//'unexpected number of soil layers in parameter file'
err=20; return
endif
! define parameter length
parLength = nSoil_file
else
parLength = 1
endif ! if two dimensions
! allocate space for model parameters
allocate(parVector(parLength),stat=err)
if(err/=0)then
message=trim(message)//'problem allocating space for parameter vector'
err=20; return
endif
! map to the GRUs and HRUs
!iGRU=index_map(indxHRU)%gru_ix
localHRU_ix=index_map(indxHRU)%localHRU_ix
fHRU = gru_struc(indxGRU)%hruInfo(localHRU_ix)%hru_nc
! read parameter data
select case(nDims)
case(1); err=nf90_get_var(ncid, ivarid, parVector, start=(/fHRU/), count=(/1/) )
case(2); err=nf90_get_var(ncid, ivarid, parVector, start=(/fHRU,1/), count=(/1,nSoil_file/) )
case default; err=20; message=trim(message)//'unexpected number of dimensions for parameter '//trim(parName)
end select
! error check for the parameter read
if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
! populate parameter structures
select case(nDims)
case(1); mparStruct%var(ixParam)%dat(:) = parVector(1) ! also distributes scalar across depth dimension
case(2); mparStruct%var(ixParam)%dat(:) = parVector(:)
case default; err=20; message=trim(message)//'unexpected number of dimensions for parameter '//trim(parName)
end select
! end do ! looping through HRUs
! deallocate space for model parameters
deallocate(parVector,stat=err)
if(err/=0)then
message=trim(message)//'problem deallocating space for parameter vector'
err=20; return
endif
! **********************************************************************************************
! * read the basin parameters
! **********************************************************************************************
! get the basin parameters
else
! get the parameter index
ixParam = get_ixbpar( trim(parName) )
! allow extra variables in the file that are not used
if(ixParam==integerMissing) cycle
! allocate space for model parameters ! check whether the user-specified file exists and warn if it does not
allocate(parVector(nGRU_file),stat=err) inquire(file=trim(infile),exist=fexist)
if(err/=0)then if (.not.fexist) then
message=trim(message)//'problem allocating space for parameter vector' write(*,'(A)') NEW_LINE('A')//'!! WARNING: trial parameter file not found; proceeding instead with other default parameters; check path in file manager input if this was not the desired behavior'//NEW_LINE('A')
err=20; return return
endif endif
! read parameter data ! open trial parameters file if it exists
err=nf90_get_var(ncid, ivarid, parVector ) call nc_file_open(trim(infile),nf90_nowrite,ncid,err,cmessage)
if(err/=0)then; message=trim(message)//trim(cmessage); return; end if if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
! populate parameter structures ! get the number of variables in the parameter file
if (iRunMode==iRunModeGRU) then err=nf90_inquire(ncid, nDimensions=nDims, nVariables=nVars)
!do iGRU=1,nGRU call netcdf_err(err,message); if (err/=0) then; err=20; return; end if
bparStruct%var(ixParam) = parVector(indxGRU+startGRU-1)
!end do ! looping through GRUs ! initialize the number of HRUs
else if (iRunMode==iRunModeFull) then nHRU_file=integerMissing
!do iGRU=1,nGRU nGRU_file=integerMissing
bparStruct%var(ixParam) = parVector(indxGRU)
!end do ! looping through GRUs ! get the length of the dimensions
else if (iRunMode==iRunModeHRU) then do idimid=1,nDims
err = 20; message='checkHRU run mode not working'; return; ! get the dimension name and length
err=nf90_inquire_dimension(ncid, idimid, name=dimName, len=dimLength)
if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
! get the number of HRUs
if(trim(dimName)=='hru') nHRU_file=dimLength
if(trim(dimName)=='gru') nGRU_file=dimLength
end do
! allocate hruID vector
allocate(hruId(nHRU_file))
! check HRU dimension exists
if(nHRU_file==integerMissing)then
message=trim(message)//'unable to identify HRU dimension in file '//trim(infile)
err=20; return
endif endif
! deallocate space for model parameters ! **********************************************************************************************
deallocate(parVector,stat=err) ! * read the HRU index
if(err/=0)then ! **********************************************************************************************
message=trim(message)//'problem deallocating space for parameter vector' ! loop through the parameters in the NetCDF file
err=20; return do ivarid=1,nVars
endif
! get the parameter name
err=nf90_inquire_variable(ncid, ivarid, name=parName)
call netcdf_err(err,message); if (err/=0) then; err=20; return; end if
! special case of the HRU id
if(trim(parName)=='hruIndex' .or. trim(parName)=='hruId')then
! read HRUs
err=nf90_get_var(ncid, ivarid, hruId)
if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
! check HRUs -- expect HRUs to be in the same order as the local attributes
! if (iRunMode==iRunModeFull) then
! !iGRU=index_map(indxHRU)%gru_ix
! localHRU_ix=index_map(indxHRU)%localHRU_ix
! if((hruId(indxHRU)>0).and.(hruId(indxHRU)/=idStruct%var(iLookID%hruId)))then
! write(message,'(a,i0,a,i0,a)') trim(message)//'mismatch for HRU ', idStruct%var(iLookID%hruId), '(param HRU = ', hruId(indxHRU), ')'
! err=20; return
! endif
! else if (iRunMode==iRunModeGRU) then
! ! do iHRU=1,nHRU
! !iGRU=index_map(indxHRU)%gru_ix
! localHRU_ix=index_map(indxHRU)%localHRU_ix
! fHRU = gru_struc(indxGRU)%hruInfo(localHRU_ix)%hru_nc
! if(hruId(fHRU)/=idStruct%var(iLookID%hruId))then
! write(message,'(a,i0,a,i0,a)') trim(message)//'mismatch for HRU ', idStruct%var(iLookID%hruId), '(param HRU = ', hruId(indxHRU), ')'
! err=20; return
! endif
! ! enddo
! else if (iRunMode==iRunModeHRU) then
! !iGRU=index_map(1)%gru_ix
! localHRU_ix=index_map(indxHRU)%localHRU_ix
! if(hruId(checkHRU)/=idStruct%var(iLookID%hruId))then
! write(message,'(a,i0,a,i0,a)') trim(message)//'mismatch for HRU ', idStruct%var(iLookID%hruId), '(param HRU = ', hruId(indxHRU), ')'
! err=20; return
! endif
! error check
! else
! err = 20; message = 'run mode not recognized'; return;
! end if
endif ! if the HRU id
end do ! looping through variables in the file
endif ! reading the basin parameters ! **********************************************************************************************
! * read the local parameters and the basin parameters
! **********************************************************************************************
end do ! (looping through the parameters in the NetCDF file) ! loop through the parameters in the NetCDF file
do ivarid=1,nVars
! get the parameter name
err=nf90_inquire_variable(ncid, ivarid, name=parName)
call netcdf_err(err,message); if (err/=0) then; err=20; return; end if
! get the local parameters
ixParam = get_ixparam( trim(parName) )
if(ixParam/=integerMissing)then
! **********************************************************************************************
! * read the local parameters
! **********************************************************************************************
! get the variable shape
err=nf90_inquire_variable(ncid, ivarid, nDims=nDims, dimids=idim_list)
if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
! get the length of the depth dimension (if it exists)
if(nDims==2)then
! get the information on the 2nd dimension for 2-d variables
err=nf90_inquire_dimension(ncid, idim_list(2), dimName, nSoil_file)
if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
! check that it is the depth dimension
if(trim(dimName)/='depth')then
message=trim(message)//'expect 2nd dimension of 2-d variable to be depth (dimension name = '//trim(dimName)//')'
err=20; return
endif
! check that the dimension length is correct
if(size(mparStruct%var(ixParam)%dat) /= nSoil_file)then
message=trim(message)//'unexpected number of soil layers in parameter file'
err=20; return
endif
! define parameter length
parLength = nSoil_file
else
parLength = 1
endif ! if two dimensions
! allocate space for model parameters
allocate(parVector(parLength),stat=err)
if(err/=0)then
message=trim(message)//'problem allocating space for parameter vector'
err=20; return
endif
! map to the GRUs and HRUs
!iGRU=index_map(indxHRU)%gru_ix
localHRU_ix=index_map(indxHRU)%localHRU_ix
fHRU = gru_struc(indxGRU)%hruInfo(localHRU_ix)%hru_nc
! read parameter data
select case(nDims)
case(1); err=nf90_get_var(ncid, ivarid, parVector, start=(/fHRU/), count=(/1/) )
case(2); err=nf90_get_var(ncid, ivarid, parVector, start=(/fHRU,1/), count=(/1,nSoil_file/) )
case default; err=20; message=trim(message)//'unexpected number of dimensions for parameter '//trim(parName)
end select
! error check for the parameter read
if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
! populate parameter structures
select case(nDims)
case(1); mparStruct%var(ixParam)%dat(:) = parVector(1) ! also distributes scalar across depth dimension
case(2); mparStruct%var(ixParam)%dat(:) = parVector(:)
case default; err=20; message=trim(message)//'unexpected number of dimensions for parameter '//trim(parName)
end select
! end do ! looping through HRUs
! deallocate space for model parameters
deallocate(parVector,stat=err)
if(err/=0)then
message=trim(message)//'problem deallocating space for parameter vector'
err=20; return
endif
! Now we must close the netcdf file ! **********************************************************************************************
call nc_file_close(ncid,err,message) ! * read the basin parameters
if(err/=0)then;message=trim(message)//trim(cmessage);return;end if ! **********************************************************************************************
! get the basin parameters
else
end subroutine read_param4chm ! get the parameter index
ixParam = get_ixbpar( trim(parName) )
! allow extra variables in the file that are not used
if(ixParam==integerMissing) cycle
! allocate space for model parameters
allocate(parVector(nGRU_file),stat=err)
if(err/=0)then
message=trim(message)//'problem allocating space for parameter vector'
err=20; return
endif
! read parameter data
err=nf90_get_var(ncid, ivarid, parVector )
if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
! populate parameter structures
if (iRunMode==iRunModeGRU) then
!do iGRU=1,nGRU
bparStruct%var(ixParam) = parVector(indxGRU+startGRU-1)
!end do ! looping through GRUs
else if (iRunMode==iRunModeFull) then
!do iGRU=1,nGRU
bparStruct%var(ixParam) = parVector(indxGRU)
!end do ! looping through GRUs
else if (iRunMode==iRunModeHRU) then
err = 20; message='checkHRU run mode not working'; return;
endif
! deallocate space for model parameters
deallocate(parVector,stat=err)
if(err/=0)then
message=trim(message)//'problem deallocating space for parameter vector'
err=20; return
endif
endif ! reading the basin parameters
end do ! (looping through the parameters in the NetCDF file)
! Now we must close the netcdf file
call nc_file_close(ncid,err,message)
if(err/=0)then;message=trim(message)//trim(cmessage);return;end if
end subroutine read_param
end module read_param4chm_module end module read_param4chm_module
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment