Skip to content
Snippets Groups Projects
Commit ca502e4d authored by Kyle's avatar Kyle
Browse files

Compiled with check if variable is desired

parent cb30d639
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
.gitignore
+ 1
− 0
View file @ ca502e4d
......@@ -3,3 +3,4 @@ build/cmake/build
build/summa
build/summa-sundials
.vscode/settings.json
.DS_Store
bin/caf-application.conf 0 → 100644
+ 3
− 0
View file @ ca502e4d
caf {
max-threads = 2
}
\ No newline at end of file
build/source/actors/file_access_actor/fortran_code/output_structure.f90
+ 19
− 19
View file @ ca502e4d
......@@ -181,67 +181,67 @@ subroutine initOutputStructure(handle_forcFileInfo, maxSteps, num_gru, err) bind
select case(trim(structInfo(iStruct)%structName))
case('time')
call alloc_outputStruc(time_meta,outputStructure(1)%timeStruct(1)%gru(iGRU)%hru(iHRU), &
maxSteps,err=err,message=message) ! model forcing data
maxSteps,err=err,message=message) ! model forcing data
case('forc')
! Structure
call alloc_outputStruc(forc_meta,outputStructure(1)%forcStruct(1)%gru(iGRU)%hru(iHRU), &
maxSteps,nSnow,nSoil,err,message); ! model forcing data
maxSteps,nSnow,nSoil,err,message); ! model forcing data
! Statistics
call alloc_outputStruc(statForc_meta(:)%var_info,outputStructure(1)%forcStat(1)%gru(iGRU)%hru(iHRU), &
maxSteps,nSnow,nSoil,err,message); ! model forcing data
maxSteps,nSnow,nSoil,err,message); ! model forcing data
case('attr')
call alloc_outputStruc(attr_meta,outputStructure(1)%attrStruct(1)%gru(iGRU)%hru(iHRU), &
maxSteps,nSnow,nSoil,err,message); ! local attributes for each HRU
maxSteps,nSnow,nSoil,err,message); ! local attributes for each HRU
case('type')
call alloc_outputStruc(type_meta,outputStructure(1)%typeStruct(1)%gru(iGRU)%hru(iHRU), &
maxSteps,nSnow,nSoil,err,message); ! classification of soil veg etc.
maxSteps,nSnow,nSoil,err,message); ! classification of soil veg etc.
case('id' )
call alloc_outputStruc(id_meta,outputStructure(1)%idStruct(1)%gru(iGRU)%hru(iHRU), &
maxSteps,nSnow,nSoil,err,message); ! local values of hru gru IDs
maxSteps,nSnow,nSoil,err,message); ! local values of hru gru IDs
case('mpar') ! model parameters
call alloc_outputStruc(mpar_meta,outputStructure(1)%mparStruct(1)%gru(iGRU)%hru(iHRU), &
maxSteps,nSnow,nSoil,err,message);
maxSteps,nSnow,nSoil,err,message);
call alloc_outputStruc(mpar_meta, outputStructure(1)%dparStruct(1)%gru(iGRU)%hru(iHRU), &
maxSteps,err=err,message=message)
maxSteps,err=err,message=message)
case('indx')
! Structure
call alloc_outputStruc(indx_meta,outputStructure(1)%indxStruct(1)%gru(iGRU)%hru(iHRU), &
maxSteps,nSnow,nSoil,err,message); ! model variables
maxSteps,nSnow,nSoil,err,message); ! model variables
! Statistics
call alloc_outputStruc(statIndx_meta(:)%var_info,outputStructure(1)%indxStat(1)%gru(iGRU)%hru(1), &
maxSteps,nSnow,nSoil,err,message); ! index vars
maxSteps,nSnow,nSoil,err,message); ! index vars
case('prog')
! Structure
call alloc_outputStruc(prog_meta,outputStructure(1)%progStruct(1)%gru(iGRU)%hru(iHRU), &
maxSteps,nSnow,nSoil,err,message); ! model prognostic (state) variables
maxSteps,nSnow,nSoil,err,message); ! model prognostic (state) variables
! Statistics
call alloc_outputStruc(statProg_meta(:)%var_info,outputStructure(1)%progStat(1)%gru(iGRU)%hru(iHRU), &
maxSteps,nSnow,nSoil,err,message); ! model prognostic
maxSteps,nSnow,nSoil,err,message); ! model prognostic
case('diag')
! Structure
call alloc_outputStruc(diag_meta,outputStructure(1)%diagStruct(1)%gru(iGRU)%hru(iHRU), &
maxSteps,nSnow,nSoil,err,message); ! model diagnostic variables
maxSteps,nSnow,nSoil,err,message); ! model diagnostic variables
! Statistics
call alloc_outputStruc(statDiag_meta(:)%var_info,outputStructure(1)%diagStat(1)%gru(iGRU)%hru(iHRU), &
maxSteps,nSnow,nSoil,err,message); ! model diagnostic
maxSteps,nSnow,nSoil,err,message); ! model diagnostic
case('flux')
! Structure
call alloc_outputStruc(flux_meta,outputStructure(1)%fluxStruct(1)%gru(iGRU)%hru(iHRU), &
maxSteps,nSnow,nSoil,err,message); ! model fluxes
maxSteps,nSnow,nSoil,err,message); ! model fluxes
! Statistics
call alloc_outputStruc(statFlux_meta(:)%var_info,outputStructure(1)%fluxStat(1)%gru(iGRU)%hru(iHRU), &
maxSteps,nSnow,nSoil,err,message); ! model fluxes
maxSteps,nSnow,nSoil,err,message); ! model fluxes
case('bpar')
call alloc_outputStruc(bpar_meta,outputStructure(1)%bparStruct(1)%gru(iGRU), &
maxSteps,nSnow=0,nSoil=0,err=err,message=message); ! basin-average params
maxSteps,nSnow=0,nSoil=0,err=err,message=message); ! basin-average params
case('bvar')
! Structure
call alloc_outputStruc(bvar_meta,outputStructure(1)%bvarStruct(1)%gru(iGRU)%hru(iHRU), &
maxSteps,nSnow=0,nSoil=0,err=err,message=message); ! basin-average variables
maxSteps,nSnow=0,nSoil=0,err=err,message=message); ! basin-average variables
! Statistics
call alloc_outputStruc(statBvar_meta(:)%var_info,outputStructure(1)%bvarStat(1)%gru(iGRU)%hru(iHRU), &
maxSteps,nSnow=0,nSoil=0,err=err,message=message); ! basin-average variables
maxSteps,nSnow=0,nSoil=0,err=err,message=message); ! basin-average variables
case('deriv'); cycle
case('lookup'); cycle
case default; err=20; message='unable to find structure name: '//trim(structInfo(iStruct)%structName)
......
build/source/dshare/data_types.f90
+ 0
− 4
View file @ ca502e4d
......@@ -63,10 +63,6 @@ MODULE data_types
real(rkind), dimension (:,:), allocatable :: dataFromFile
end type forcingFileData
type,public :: outputData
real(rkind), dimension(:,:), allocatable :: outputToFile
end type outputData
type,public :: var_forc
type(forcingFileData), allocatable :: var(:) ! var(:)%dataFromFile(:,:)
character(len=256) :: refTimeString
......
build/source/engine/alloc_fileAccess.f90
+ 141
− 114
View file @ ca502e4d
......@@ -10,6 +10,7 @@ USE data_types,only:var_d
USE data_types,only:var_i
USE data_types,only:var_dlength
USE data_types,only:var_info
USE globalData,only:integerMissing
USE globalData,only:nBand ! number of spectral bands
USE globalData,only:nTimeDelay ! number of timesteps in the time delay histogram
USE var_lookup,only:maxvarFreq ! allocation dimension (output frequency)
......@@ -21,9 +22,26 @@ private
public::alloc_outputStruc
public::allocateDat_rkind
public::allocateDat_int
! public::allocateDat_flag
private::is_var_desired
contains
logical function is_var_desired(metaStruct, iVar)
implicit none
type(var_info),intent(in) :: metaStruct(:)
integer(i4b),intent(in) :: iVar
! local
integer(i4b) :: iFreq
! initalize error control
is_var_desired=.false.
do iFreq=1,maxvarFreq
if(metaStruct(iVar)%statIndex(iFreq) /= integerMissing)then
is_var_desired=.true.
exit
end if
end do
end function is_var_desired
subroutine alloc_outputStruc(metaStruct,dataStruct,nSteps,nSnow,nSoil,err,message)
implicit none
type(var_info),intent(in) :: metaStruct(:)
......@@ -40,118 +58,130 @@ subroutine alloc_outputStruc(metaStruct,dataStruct,nSteps,nSnow,nSoil,err,messag
integer(i4b) :: nVars ! number of variables in the metadata structure
integer(i4b) :: nLayers ! total number of layers
integer(i4b) :: iVar
integer(i4b) :: iStat ! checks if we want this variable
character(len=256) :: cmessage ! error message of the downwind routine
! initalize error control
message='alloc_outputStruc'
nVars = size(metaStruct)
if(present(nSnow) .or. present(nSoil))then
! check both are present
if(.not.present(nSoil))then; err=20; message=trim(message)//'expect nSoil to be present when nSnow is present'; return; end if
if(.not.present(nSnow))then; err=20; message=trim(message)//'expect nSnow to be present when nSoil is present'; return; end if
nLayers = nSnow+nSoil
! It is possible that nSnow and nSoil are actually needed here, so we return an error if the optional arguments are missing when needed
else
select type(dataStruct)
! class is (var_flagVec); err=20
class is (var_time_ilength); err=20
class is (var_time_dlength); err=20
end select
if(err/=0)then; message=trim(message)//'expect nSnow and nSoil to be present for variable-length data structures'; return; end if
end if
check=.false.
! allocate the dimension for model variables
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_time_ilength); err=20
class is (var_time_dlength); err=20
end select
if(err/=0)then; message=trim(message)//'expect nSnow and nSoil to be present for variable-length data structures'; return; end if
end if
class is (var_time_i)
if(allocated(dataStruct%var))then
check=.true.
else
allocate(dataStruct%var(nVars),stat=err)
end if
do iVar=1, nVars
allocate(dataStruct%var(iVar)%tim(nSteps))
end do
return
class is (var_time_i8)
if(allocated(dataStruct%var))then
check=.true.
else
allocate(dataStruct%var(nVars),stat=err)
end if
do iVar=1, nVars
allocate(dataStruct%var(iVar)%tim(nSteps))
end do
return
class is (var_time_d)
if(allocated(dataStruct%var))then
check=.true.
else
allocate(dataStruct%var(nVars),stat=err)
end if
do iVar=1, nVars
allocate(dataStruct%var(iVar)%tim(nSteps))
end do
return
class is (var_d)
if(allocated(dataStruct%var))then
check=.true.
else
allocate(dataStruct%var(nVars),stat=err)
end if
return
class is (var_i)
if(allocated(dataStruct%var))then
check=.true.
else
allocate(dataStruct%var(nVars),stat=err)
end if
return
class is (var_i8)
if(allocated(dataStruct%var))then
check=.true.
else
allocate(dataStruct%var(nVars), stat=err)
end if
return
class is (var_dlength)
if(allocated(dataStruct%var))then
check=.true.
else
allocate(dataStruct%var(nVars),stat=err)
end if
! class is (var_flagVec); if(allocated(dataStruct%var))then; check=.true.; else; allocate(dataStruct%var(nVars),stat=err); end if
class is (var_time_ilength)
if(allocated(dataStruct%var))then
check=.true.
else
allocate(dataStruct%var(nVars),stat=err)
end if
do iVar=1, nVars
allocate(dataStruct%var(iVar)%tim(nSteps))
end do
class is (var_time_dlength)
if(allocated(dataStruct%var))then
check=.true.
else
allocate(dataStruct%var(nVars),stat=err)
end if
do iVar=1, nVars
allocate(dataStruct%var(iVar)%tim(nSteps))
end do
class default; err=20; message=trim(message)//'unable to identify derived data type for the variable dimension'; return
check=.false.
! allocate the space for the variables and thier time steps in the output structure
select type(dataStruct)
! ****************************************************
class is (var_time_i)
if(allocated(dataStruct%var))then
check=.true.
else
allocate(dataStruct%var(nVars),stat=err)
end if
do iVar=1, nVars
! Check if this variable is desired within any timeframe
if(is_var_desired(metaStruct,iVar))then
allocate(dataStruct%var(iVar)%tim(nSteps))
end if
end do
return
! ****************************************************
class is (var_time_i8)
if(allocated(dataStruct%var))then
check=.true.
else
allocate(dataStruct%var(nVars),stat=err)
end if
do iVar=1, nVars
! Check if this variable is desired within any timeframe
if(is_var_desired(metaStruct,iVar))then
allocate(dataStruct%var(iVar)%tim(nSteps))
end if
end do
return
! ****************************************************
class is (var_time_d)
if(allocated(dataStruct%var))then
check=.true.
else
allocate(dataStruct%var(nVars),stat=err)
end if
do iVar=1, nVars
! Check if this variable is desired within any timeframe
if(is_var_desired(metaStruct,iVar))then
allocate(dataStruct%var(iVar)%tim(nSteps))
end if
end do
return
! ****************************************************
class is (var_d)
if(allocated(dataStruct%var))then
check=.true.
else
allocate(dataStruct%var(nVars),stat=err)
end if
return
! ****************************************************
class is (var_i)
if(allocated(dataStruct%var))then
check=.true.
else
allocate(dataStruct%var(nVars),stat=err)
end if
return
! ****************************************************
class is (var_i8)
if(allocated(dataStruct%var))then
check=.true.
else
allocate(dataStruct%var(nVars), stat=err)
end if
return
! ****************************************************
class is (var_dlength)
if(allocated(dataStruct%var))then
check=.true.
else
allocate(dataStruct%var(nVars),stat=err)
end if
! ****************************************************
class is (var_time_ilength)
if(allocated(dataStruct%var))then
check=.true.
else
allocate(dataStruct%var(nVars),stat=err)
end if
do iVar=1, nVars
! Check if this variable is desired within any timeframe
if(is_var_desired(metaStruct,iVar))then
allocate(dataStruct%var(iVar)%tim(nSteps))
end if
end do
! ****************************************************
class is (var_time_dlength)
if(allocated(dataStruct%var))then
check=.true.
else
allocate(dataStruct%var(nVars),stat=err)
end if
do iVar=1, nVars
! Check if this variable is desired within any timeframe
if(is_var_desired(metaStruct,iVar))then
allocate(dataStruct%var(iVar)%tim(nSteps))
end if
end do
! ****************************************************
class default; err=20; message=trim(message)//'unable to identify derived data type for the variable dimension'; return
end select
! check errors
if(check) then; err=20; message=trim(message)//'structure was unexpectedly allocated already'; return; end if
......@@ -159,18 +189,15 @@ subroutine alloc_outputStruc(metaStruct,dataStruct,nSteps,nSnow,nSoil,err,messag
! allocate the dimension for model data
select type(dataStruct)
! class is (var_flagVec); call allocateDat_flag(metaStruct,nSnow,nSoil,nLayers,dataStruct,err,cmessage)
class is (var_time_ilength); call allocateDat_int(metaStruct,dataStruct,nSnow,nSoil,nSteps,err,cmessage)
class is (var_time_dlength); call allocateDat_rkind_nSteps(metaStruct,dataStruct,nSnow,nSoil,nSteps,err,cmessage)
class is (var_dlength); call allocateDat_rkind(metaStruct,dataStruct,nSnow,nSoil,err,cmessage)
class default; err=20; message=trim(message)//'unable to identify derived data type for the data dimension'; return
! class is (var_flagVec); call allocateDat_flag(metaStruct,nSnow,nSoil,nLayers,dataStruct,err,cmessage)
class is (var_time_ilength); call allocateDat_int(metaStruct,dataStruct,nSnow,nSoil,nSteps,err,cmessage)
class is (var_time_dlength); call allocateDat_rkind_nSteps(metaStruct,dataStruct,nSnow,nSoil,nSteps,err,cmessage)
class is (var_dlength); call allocateDat_rkind(metaStruct,dataStruct,nSnow,nSoil,err,cmessage)
class default; err=20; message=trim(message)//'unable to identify derived data type for the data dimension'; return
end select
! check errors
if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
end subroutine
......
build/source/testing/passing_vectors/main deleted 100755 → 0
+ 0
− 0
View file @ cb30d639
File deleted
laugh_tests @ 01408c3c
Subproject commit 01408c3c915589eeb701e95a3fba1023a3d6523b
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment