diff --git a/src/lib/ParameterListEntry.f90 b/src/lib/ParameterListEntry.f90 index e02aa0b..9a83e7a 100644 --- a/src/lib/ParameterListEntry.f90 +++ b/src/lib/ParameterListEntry.f90 @@ -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 @@ -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 diff --git a/src/lib/ParameterListEntryContainer.f90 b/src/lib/ParameterListEntryContainer.f90 index 1706186..e137193 100644 --- a/src/lib/ParameterListEntryContainer.f90 +++ b/src/lib/ParameterListEntryContainer.f90 @@ -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, & @@ -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 @@ -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 @@ -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