Skip to content

Commit

Permalink
Add print procedures
Browse files Browse the repository at this point in the history
  • Loading branch information
@femparadmin
femparadmin committed Oct 22, 2015
1 parent 74f300d commit 3a21748
Show file tree
Hide file tree
Showing 2 changed files with 70 additions and 28 deletions.
41 changes: 41 additions & 0 deletions src/lib/ParameterListEntry.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,7 @@ module ParameterListEntry
private
procedure :: ParameterListEntry_AddNode
procedure, public :: Free => ParameterListEntry_Free
procedure, public :: Print => ParameterListEntry_Print
procedure, public :: HasValue => ParameterListEntry_HasValue
procedure, public :: SetValue => ParameterListEntry_SetValue
procedure, public :: GetValue => ParameterListEntry_GetValue
Expand Down Expand Up @@ -153,4 +154,44 @@ subroutine ParameterListEntry_RemoveNode(this, Key)
end subroutine ParameterListEntry_RemoveNode


subroutine ParameterListEntry_Print(this, unit, prefix, iostat, iomsg)
!-----------------------------------------------------------------
!< Print the keys/value pair contained in the parameter list
!-----------------------------------------------------------------
class(ParameterListEntry_t), intent(IN), target :: this !< Parameter list
integer(I4P), intent(IN) :: unit !< Logic unit.
character(*), optional, intent(IN) :: prefix !< Prefixing string.
integer(I4P), optional, intent(OUT) :: iostat !< IO error.
character(*), optional, intent(OUT) :: iomsg !< IO error message.
character(len=:), allocatable :: prefd !< Prefixing string.
integer(I4P) :: iostatd !< IO error.
character(500) :: iomsgd !< Temporary variable for IO error message.
class(*), pointer :: Node !< Pointer for scanning the list.
class(*), pointer :: Next !< Pointer for scanning the list.
!-----------------------------------------------------------------
prefd = '' ; if (present(prefix)) prefd = prefix
Node => this
select type (Node)
class is (ParameterListEntry_t)
do while(Node%HasKey())
write(unit=unit,fmt='(A,$)',iostat=iostatd,iomsg=iomsgd)prefd//' Key = '//Node%GetKey()//', '
call Node%Value%Print(unit=unit)
if (Node%HasNext()) then
Next => Node%GetNext()
select type (Next)
class is (ParameterListEntry_t)
Node => Next
class Default
exit
end select
else
exit
endif
enddo
end select
if (present(iostat)) iostat = iostatd
if (present(iomsg)) iomsg = iomsgd
end subroutine ParameterListEntry_Print


end module ParameterListEntry
57 changes: 29 additions & 28 deletions src/lib/ParameterListEntryContainer.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -41,10 +41,10 @@ module ParameterListEntryContainer
procedure :: ParameterListEntryContainer_Set7D
procedure :: ParameterListEntryContainer_Get0D
procedure :: ParameterListEntryContainer_Get1D
procedure :: ParameterListEntryContainer_Clone1D
procedure :: Hash => ParameterListEntryContainer_Hash
procedure, public :: Init => ParameterListEntryContainer_Init
procedure, public :: Free => ParameterListEntryContainer_Free
procedure, public :: Print => ParameterListEntryContainer_Print
generic, public :: Set => ParameterListEntryContainer_Set0D, &
ParameterListEntryContainer_Set1D, &
ParameterListEntryContainer_Set2D, &
Expand All @@ -55,7 +55,6 @@ module ParameterListEntryContainer
ParameterListEntryContainer_Set7D
generic, public :: Get => ParameterListEntryContainer_Get0D, &
ParameterListEntryContainer_Get1D
generic, public :: Clone => ParameterListEntryContainer_Clone1D
! procedure, public :: isPresent => ParameterListEntryContainer_isPresent
! procedure, public :: isOfDataType => ParameterListEntryContainer_isOfDataType
! procedure, public :: isSubList => ParameterListEntryContainer_isSubList
Expand Down Expand Up @@ -344,32 +343,6 @@ subroutine ParameterListEntryContainer_Get1D(this,Key,Value)
end subroutine ParameterListEntryContainer_Get1D


subroutine ParameterListEntryContainer_Clone1D(this,Key,Value)
!-----------------------------------------------------------------
!< Return an I1P scalar Value given the Key
!-----------------------------------------------------------------
class(ParameterListEntryContainer_t), intent(IN) :: this !< Parameter List Entry Containter type
character(len=*), intent(IN) :: Key !< String Key
class(*), allocatable, intent(INOUT) :: Value(:)
class(*), pointer :: Node
class(WrapperFactory_t), pointer :: WrapperFactory
class(DimensionsWrapper_t), allocatable :: 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
call Wrapper%Print(unit=6)
WrapperFactory => this%WrapperFactoryList%GetFactory(Value=Value)
! if(associated(WrapperFactory)) call WrapperFactory%UnWrap(Wrapper=Wrapper, Value=Value)
endif
end select
end if
end subroutine ParameterListEntryContainer_Clone1D


function ParameterListEntryContainer_isPresent(this,Key) result(isPresent)
!-----------------------------------------------------------------
!< Check if a Key is present in the DataBase
Expand Down Expand Up @@ -411,4 +384,32 @@ function ParameterListEntryContainer_GetLength(this) result(Length)
end function ParameterListEntryContainer_GetLength


subroutine ParameterListEntryContainer_Print(this, unit, prefix, iostat, iomsg)
!-----------------------------------------------------------------
!< Print the content of the DataBase
!-----------------------------------------------------------------
class(ParameterListEntryContainer_t), intent(IN) :: this !< Linked List
integer(I4P), intent(IN) :: unit !< Logic unit.
character(*), optional, intent(IN) :: prefix !< Prefixing string.
integer(I4P), optional, intent(OUT) :: iostat !< IO error.
character(*), optional, intent(OUT) :: iomsg !< IO error message.
character(len=:), allocatable :: prefd !< Prefixing string.
integer(I4P) :: iostatd !< IO error.
character(500) :: iomsgd !< Temporary variable for IO error message.
integer(I4P) :: DBIter !< Database iterator
!-----------------------------------------------------------------
prefd = '' ; if (present(prefix)) prefd = prefix
write(*,fmt='(A)') prefd//' LINKED LIST KEYS:'
if (allocated(this%DataBase)) then
write(*,fmt='(A)') prefd//' PARAMETER LIST CONTENT:'
write(*,fmt='(A)') prefd//' -----------------------'
do DBIter=lbound(this%DataBase,dim=1), ubound(this%DataBase,dim=1)
call this%DataBase(DBIter)%print(unit=unit, prefix=prefd//" ",iostat=iostatd,iomsg=iomsgd)
enddo
endif
if (present(iostat)) iostat = iostatd
if (present(iomsg)) iomsg = iomsgd
end subroutine ParameterListEntryContainer_Print


end module ParameterListEntryContainer

0 comments on commit 3a21748

Please sign in to comment.