Skip to content

Commit

Permalink
Add getters for all dimensions.
Browse files Browse the repository at this point in the history 
Fix node removing in parameterlist
  • Loading branch information
@femparadmin
femparadmin committed Oct 22, 2015
1 parent 1b8409d commit 5ac62fc
Show file tree
Hide file tree
Showing 2 changed files with 190 additions and 29 deletions.
27 changes: 13 additions & 14 deletions src/lib/ParameterListEntry.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -124,26 +124,25 @@ subroutine ParameterListEntry_RemoveNode(this, Key)
character(len=*), intent(IN) :: Key !< String Key
class(ParameterListEntry_t), pointer :: CurrentNode !< Pointer to the current Wrapper Factory List
class(ParameterListEntry_t), pointer :: NextNode !< Pointer to a next Wrapper Factory List
class(*), pointer :: AuxPointer !< Aux pointer
!-----------------------------------------------------------------
nullify(NextNode)
CurrentNode => this
do while(associated(CurrentNode))
select type (AuxPointer => CurrentNode%GetNext())
type is (ParameterListEntry_t)
NextNode => AuxPointer
class Default
Nullify(NextNode)
end select
if (CurrentNode%HasKey()) then
if (CurrentNode%GetKey()==Key) then
if (CurrentNode%HasNext()) then
if (NextNode%HasKey()) then
call CurrentNode%SetKey(Key=NextNode%GetKey())
else
call CurrentNode%DeallocateKey()
endif
if (NextNode%HasValue()) then
allocate(CurrentNode%Value, source=NextNode%Value)
else
deallocate(CurrentNode%Value)
endif
call CurrentNode%SetNext(Next=NextNode%GetNext())
call CurrentNode%DeallocateKey()
if (CurrentNode%HasValue()) deallocate(CurrentNode%Value)
if (associated(NextNode)) then
if (NextNode%HasKey()) call CurrentNode%SetKey(Key=NextNode%GetKey())
if (NextNode%HasValue()) call CurrentNode%SetValue(Value=NextNode%Value)
else
call CurrentNode%DeallocateKey()
if (CurrentNode%HasValue()) deallocate(CurrentNode%Value)
call CurrentNode%NullifyNext()
endif
exit
Expand Down
192 changes: 177 additions & 15 deletions src/lib/ParameterListEntryContainer.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -41,6 +41,12 @@ module ParameterListEntryContainer
procedure :: ParameterListEntryContainer_Set7D
procedure :: ParameterListEntryContainer_Get0D
procedure :: ParameterListEntryContainer_Get1D
procedure :: ParameterListEntryContainer_Get2D
procedure :: ParameterListEntryContainer_Get3D
procedure :: ParameterListEntryContainer_Get4D
procedure :: ParameterListEntryContainer_Get5D
procedure :: ParameterListEntryContainer_Get6D
procedure :: ParameterListEntryContainer_Get7D
procedure :: Hash => ParameterListEntryContainer_Hash
procedure, public :: Init => ParameterListEntryContainer_Init
procedure, public :: Free => ParameterListEntryContainer_Free
Expand All @@ -54,7 +60,13 @@ module ParameterListEntryContainer
ParameterListEntryContainer_Set6D, &
ParameterListEntryContainer_Set7D
generic, public :: Get => ParameterListEntryContainer_Get0D, &
ParameterListEntryContainer_Get1D
ParameterListEntryContainer_Get1D, &
ParameterListEntryContainer_Get2D, &
ParameterListEntryContainer_Get3D, &
ParameterListEntryContainer_Get4D, &
ParameterListEntryContainer_Get5D, &
ParameterListEntryContainer_Get6D, &
ParameterListEntryContainer_Get7D
! procedure, public :: isPresent => ParameterListEntryContainer_isPresent
! procedure, public :: isOfDataType => ParameterListEntryContainer_isOfDataType
! procedure, public :: isSubList => ParameterListEntryContainer_isSubList
Expand Down Expand Up @@ -292,14 +304,14 @@ end subroutine ParameterListEntryContainer_Set7D

subroutine ParameterListEntryContainer_Get0D(this,Key,Value)
!-----------------------------------------------------------------
!< Return an I1P scalar Value given the Key
!< Return a scalar Value given the Key
!-----------------------------------------------------------------
class(ParameterListEntryContainer_t), intent(IN) :: this !< Parameter List Entry Containter type
character(len=*), intent(IN) :: Key !< String Key
class(*), intent(INOUT) :: Value
class(*), pointer :: Node
class(WrapperFactory_t), pointer :: WrapperFactory
class(DimensionsWrapper_t), allocatable :: Wrapper
class(ParameterListEntryContainer_t), intent(IN) :: this !< Parameter List Entry Containter
character(len=*), intent(IN) :: Key !< String Key
class(*), intent(INOUT) :: Value !< Returned value
class(*), pointer :: Node !< Pointer to a Parameter List
class(WrapperFactory_t), pointer :: WrapperFactory !< Wrapper factory
class(DimensionsWrapper_t), allocatable :: Wrapper !< Wrapper
!-----------------------------------------------------------------
Node => this%DataBase(this%Hash(Key=Key))%GetNode(Key=Key)
if(associated(Node)) then
Expand All @@ -317,14 +329,14 @@ end subroutine ParameterListEntryContainer_Get0D

subroutine ParameterListEntryContainer_Get1D(this,Key,Value)
!-----------------------------------------------------------------
!< Return an I1P scalar Value given the Key
!< Return a vector Value given the Key
!-----------------------------------------------------------------
class(ParameterListEntryContainer_t), intent(IN) :: this !< Parameter List Entry Containter type
character(len=*), intent(IN) :: Key !< String Key
class(*), intent(INOUT) :: Value(:)
class(*), pointer :: Node
class(WrapperFactory_t), pointer :: WrapperFactory
class(DimensionsWrapper_t), allocatable :: Wrapper
class(ParameterListEntryContainer_t), intent(IN) :: this !< Parameter List Entry Containter
character(len=*), intent(IN) :: Key !< String Key
class(*), intent(INOUT) :: Value(:) !< Returned value
class(*), pointer :: Node !< Pointer to a Parameter List
class(WrapperFactory_t), pointer :: WrapperFactory !< Wrapper factory
class(DimensionsWrapper_t), allocatable :: Wrapper !< Wrapper
!-----------------------------------------------------------------
Node => this%DataBase(this%Hash(Key=Key))%GetNode(Key=Key)
if(associated(Node)) then
Expand All @@ -340,6 +352,156 @@ subroutine ParameterListEntryContainer_Get1D(this,Key,Value)
end subroutine ParameterListEntryContainer_Get1D


subroutine ParameterListEntryContainer_Get2D(this,Key,Value)
!-----------------------------------------------------------------
!< Return a 2D array Value given the Key
!-----------------------------------------------------------------
class(ParameterListEntryContainer_t), intent(IN) :: this !< Parameter List Entry Containter
character(len=*), intent(IN) :: Key !< String Key
class(*), intent(INOUT) :: Value(:,:) !< Returned value
class(*), pointer :: Node !< Pointer to a Parameter List
class(WrapperFactory_t), pointer :: WrapperFactory !< Wrapper factory
class(DimensionsWrapper_t), allocatable :: Wrapper !< Wrapper
!-----------------------------------------------------------------
Node => this%DataBase(this%Hash(Key=Key))%GetNode(Key=Key)
if(associated(Node)) then
select type(Node)
type is (ParameterListEntry_t)
call Node%GetValue(Value=Wrapper)
if(allocated(Wrapper)) then
WrapperFactory => this%WrapperFactoryList%GetFactory(Value=Value)
if(associated(WrapperFactory)) call WrapperFactory%UnWrap(Wrapper=Wrapper, Value=Value)
endif
end select
end if
end subroutine ParameterListEntryContainer_Get2D


subroutine ParameterListEntryContainer_Get3D(this,Key,Value)
!-----------------------------------------------------------------
!< Return a 3D array Value given the Key
!-----------------------------------------------------------------
class(ParameterListEntryContainer_t), intent(IN) :: this !< Parameter List Entry Containter type
character(len=*), intent(IN) :: Key !< String Key
class(*), intent(INOUT) :: Value(:,:,:) !< Returned value
class(*), pointer :: Node !< Pointer to a Parameter List
class(WrapperFactory_t), pointer :: WrapperFactory !< Wrapper factory
class(DimensionsWrapper_t), allocatable :: Wrapper !< Wrapper
!-----------------------------------------------------------------
Node => this%DataBase(this%Hash(Key=Key))%GetNode(Key=Key)
if(associated(Node)) then
select type(Node)
type is (ParameterListEntry_t)
call Node%GetValue(Value=Wrapper)
if(allocated(Wrapper)) then
WrapperFactory => this%WrapperFactoryList%GetFactory(Value=Value)
if(associated(WrapperFactory)) call WrapperFactory%UnWrap(Wrapper=Wrapper, Value=Value)
endif
end select
end if
end subroutine ParameterListEntryContainer_Get3D


subroutine ParameterListEntryContainer_Get4D(this,Key,Value)
!-----------------------------------------------------------------
!< Return a 4D array Value given the Key
!-----------------------------------------------------------------
class(ParameterListEntryContainer_t), intent(IN) :: this !< Parameter List Entry Containter type
character(len=*), intent(IN) :: Key !< String Key
class(*), intent(INOUT) :: Value(:,:,:,:) !< Returned value
class(*), pointer :: Node !< Pointer to a Parameter List
class(WrapperFactory_t), pointer :: WrapperFactory !< Wrapper factory
class(DimensionsWrapper_t), allocatable :: Wrapper !< Wrapper
!-----------------------------------------------------------------
Node => this%DataBase(this%Hash(Key=Key))%GetNode(Key=Key)
if(associated(Node)) then
select type(Node)
type is (ParameterListEntry_t)
call Node%GetValue(Value=Wrapper)
if(allocated(Wrapper)) then
WrapperFactory => this%WrapperFactoryList%GetFactory(Value=Value)
if(associated(WrapperFactory)) call WrapperFactory%UnWrap(Wrapper=Wrapper, Value=Value)
endif
end select
end if
end subroutine ParameterListEntryContainer_Get4D


subroutine ParameterListEntryContainer_Get5D(this,Key,Value)
!-----------------------------------------------------------------
!< Return a 5D array Value given the Key
!-----------------------------------------------------------------
class(ParameterListEntryContainer_t), intent(IN) :: this !< Parameter List Entry Containter type
character(len=*), intent(IN) :: Key !< String Key
class(*), intent(INOUT) :: Value(:,:,:,:,:) !< Returned value
class(*), pointer :: Node !< Pointer to a Parameter List
class(WrapperFactory_t), pointer :: WrapperFactory !< Wrapper factory
class(DimensionsWrapper_t), allocatable :: Wrapper !< Wrapper
!-----------------------------------------------------------------
Node => this%DataBase(this%Hash(Key=Key))%GetNode(Key=Key)
if(associated(Node)) then
select type(Node)
type is (ParameterListEntry_t)
call Node%GetValue(Value=Wrapper)
if(allocated(Wrapper)) then
WrapperFactory => this%WrapperFactoryList%GetFactory(Value=Value)
if(associated(WrapperFactory)) call WrapperFactory%UnWrap(Wrapper=Wrapper, Value=Value)
endif
end select
end if
end subroutine ParameterListEntryContainer_Get5D


subroutine ParameterListEntryContainer_Get6D(this,Key,Value)
!-----------------------------------------------------------------
!< Return a 6D array Value given the Key
!-----------------------------------------------------------------
class(ParameterListEntryContainer_t), intent(IN) :: this !< Parameter List Entry Containter type
character(len=*), intent(IN) :: Key !< String Key
class(*), intent(INOUT) :: Value(:,:,:,:,:,:) !< Returned value
class(*), pointer :: Node !< Pointer to a Parameter List
class(WrapperFactory_t), pointer :: WrapperFactory !< Wrapper factory
class(DimensionsWrapper_t), allocatable :: Wrapper !< Wrapper
!-----------------------------------------------------------------
Node => this%DataBase(this%Hash(Key=Key))%GetNode(Key=Key)
if(associated(Node)) then
select type(Node)
type is (ParameterListEntry_t)
call Node%GetValue(Value=Wrapper)
if(allocated(Wrapper)) then
WrapperFactory => this%WrapperFactoryList%GetFactory(Value=Value)
if(associated(WrapperFactory)) call WrapperFactory%UnWrap(Wrapper=Wrapper, Value=Value)
endif
end select
end if
end subroutine ParameterListEntryContainer_Get6D


subroutine ParameterListEntryContainer_Get7D(this,Key,Value)
!-----------------------------------------------------------------
!< Return a 7D array Value given the Key
!-----------------------------------------------------------------
class(ParameterListEntryContainer_t), intent(IN) :: this !< Parameter List Entry Containter type
character(len=*), intent(IN) :: Key !< String Key
class(*), intent(INOUT) :: Value(:,:,:,:,:,:,:) !< Returned value
class(*), pointer :: Node !< Pointer to a Parameter List
class(WrapperFactory_t), pointer :: WrapperFactory !< Wrapper factory
class(DimensionsWrapper_t), allocatable :: Wrapper !< Wrapper
!-----------------------------------------------------------------
Node => this%DataBase(this%Hash(Key=Key))%GetNode(Key=Key)
if(associated(Node)) then
select type(Node)
type is (ParameterListEntry_t)
call Node%GetValue(Value=Wrapper)
if(allocated(Wrapper)) then
WrapperFactory => this%WrapperFactoryList%GetFactory(Value=Value)
if(associated(WrapperFactory)) call WrapperFactory%UnWrap(Wrapper=Wrapper, Value=Value)
endif
end select
end if
end subroutine ParameterListEntryContainer_Get7D


function ParameterListEntryContainer_isPresent(this,Key) result(isPresent)
!-----------------------------------------------------------------
!< Check if a Key is present in the DataBase
Expand Down

0 comments on commit 5ac62fc

Please sign in to comment.