From 77da49e0ef86694fdba9a7fb17f457e3d5626d9c Mon Sep 17 00:00:00 2001 From: vsande Date: Fri, 6 Nov 2015 10:11:53 +0100 Subject: [PATCH] New example to show to extend FPL. Some minor changes. --- src/examples/CMakeLists.txt | 21 +-- src/examples/extend_wrappers/CMakeLists.txt | 17 ++ src/examples/extend_wrappers/Circle.f90 | 56 +++++++ .../extend_wrappers/CircleWrapper.f90 | 145 ++++++++++++++++ .../extend_wrappers/CircleWrapperFactory.f90 | 157 ++++++++++++++++++ .../extend_wrappers/ExtendWrappers.f90 | 47 ++++++ .../Wrapper/WrapperFactory/WrapperFactory.f90 | 16 -- src/lib/Wrapper/WrapperFactoryList.f90 | 70 ++++---- .../Wrapper/WrapperFactoryListSingleton.f90 | 16 +- 9 files changed, 468 insertions(+), 77 deletions(-) create mode 100644 src/examples/extend_wrappers/CMakeLists.txt create mode 100644 src/examples/extend_wrappers/Circle.f90 create mode 100644 src/examples/extend_wrappers/CircleWrapper.f90 create mode 100644 src/examples/extend_wrappers/CircleWrapperFactory.f90 create mode 100644 src/examples/extend_wrappers/ExtendWrappers.f90 diff --git a/src/examples/CMakeLists.txt b/src/examples/CMakeLists.txt index e3fdc6d..aec240e 100644 --- a/src/examples/CMakeLists.txt +++ b/src/examples/CMakeLists.txt @@ -2,12 +2,9 @@ # EXAMPLES ################################################################# -FILE(GLOB_RECURSE EXAMPLES_SRC *.f90 *.F90) +FILE(GLOB EXAMPLES_SRC *.f90 *.F90) SET(EXAMPLES_SRC ${EXAMPLES_SRC} PARENT_SCOPE) - -################################################################# -# EXTERNAL LIBRARIES -################################################################# +SET(EXTEND_WRAPPERS_EXAMPLE_PATH ${EXAMPLES_PATH}/extend_wrappers) FOREACH(EXAMPLE_SRC ${EXAMPLES_SRC}) GET_FILENAME_COMPONENT(EXE_NAME ${EXAMPLE_SRC} NAME_WE) @@ -19,19 +16,7 @@ FOREACH(EXAMPLE_SRC ${EXAMPLES_SRC}) ENDIF() ENDFOREACH() - IF(${PROJECT_NAME}_ENABLE_MPI) - TARGET_LINK_LIBRARIES(${EXE_NAME} ${MPI_Fortran_LIBRARIES}) - ENDIF() - - IF(${PROJECT_NAME}_ENABLE_HDF5) - TARGET_LINK_LIBRARIES(${EXE_NAME} ${HDF5_Fortran_HL_LIBRARIES}) - TARGET_LINK_LIBRARIES(${EXE_NAME} ${HDF5_HL_LIBRARIES}) - TARGET_LINK_LIBRARIES(${EXE_NAME} ${HDF5_Fortran_LIBRARIES}) - TARGET_LINK_LIBRARIES(${EXE_NAME} ${HDF5_LIBRARIES}) - ENDIF() - ADD_TEST(${EXE_NAME}_TEST ${EXECUTABLE_OUTPUT_PATH}/${EXE_NAME}) ENDFOREACH() - - +ADD_SUBDIRECTORY(${EXTEND_WRAPPERS_EXAMPLE_PATH}) diff --git a/src/examples/extend_wrappers/CMakeLists.txt b/src/examples/extend_wrappers/CMakeLists.txt new file mode 100644 index 0000000..9c1e532 --- /dev/null +++ b/src/examples/extend_wrappers/CMakeLists.txt @@ -0,0 +1,17 @@ +################################################################# +# EXTEND WRAPPERS EXAMPLE +################################################################# + +FILE(GLOB EXTEND_WRAPPERS_EXAMPLE_SRC *.f90 *.F90) +SET(EXTEND_WRAPPERS_EXAMPLE_SRC ${EXTEND_WRAPPERS_EXAMPLE_SRC} PARENT_SCOPE) + +SET(EXE_NAME ParameterList_Extend_Wrappers_Example) +ADD_EXECUTABLE(${EXE_NAME} ${EXTEND_WRAPPERS_EXAMPLE_SRC}) +TARGET_LINK_LIBRARIES(${EXE_NAME} ${LIB}) +FOREACH (EXT_LIB ${EXT_LIBS}) + IF(DEFINED ${PROJECT_NAME}_ENABLE_${EXT_LIB} AND ${PROJECT_NAME}_ENABLE_${EXT_LIB} AND ${EXT_LIB}_FOUND) + TARGET_LINK_LIBRARIES(${EXE_NAME} ${${EXT_LIB}_LIBRARIES}) + ENDIF() +ENDFOREACH() + +ADD_TEST(${EXE_NAME}_TEST ${EXECUTABLE_OUTPUT_PATH}/${EXE_NAME}) diff --git a/src/examples/extend_wrappers/Circle.f90 b/src/examples/extend_wrappers/Circle.f90 new file mode 100644 index 0000000..b7e0167 --- /dev/null +++ b/src/examples/extend_wrappers/Circle.f90 @@ -0,0 +1,56 @@ +module Circle + +implicit none +private + + type :: Circle_t + private + real :: Radius + contains + private + procedure :: Circle_Assign + procedure, public :: SetRadius => Circle_SetRadius + procedure, public :: GetRadius => Circle_GetRadius + generic, public :: assignment(=) => Circle_Assign + end type Circle_t + +public :: Circle_t + +contains + + subroutine Circle_Assign(A,B) + !----------------------------------------------------------------- + !< Assignment overloading + !----------------------------------------------------------------- + + class(Circle_t), intent(OUT) :: A + class(Circle_t), intent(IN) :: B + real :: Radius + !----------------------------------------------------------------- + call B%GetRadius(Radius=Radius) + call A%SetRadius(Radius=Radius) + end subroutine + + subroutine Circle_SetRadius(this, Radius) + !----------------------------------------------------------------- + !< Set the radius of the Circle + !----------------------------------------------------------------- + + class(Circle_t), intent(INOUT) :: this + real, intent(IN) :: Radius + !----------------------------------------------------------------- + this%Radius = Radius + end subroutine + + subroutine Circle_GetRadius(this, Radius) + !----------------------------------------------------------------- + !< Return the radius of the circle + !----------------------------------------------------------------- + + class(Circle_t), intent(IN) :: this + real, intent(OUT) :: Radius + !----------------------------------------------------------------- + Radius = this%Radius + end subroutine + +end module diff --git a/src/examples/extend_wrappers/CircleWrapper.f90 b/src/examples/extend_wrappers/CircleWrapper.f90 new file mode 100644 index 0000000..22487f4 --- /dev/null +++ b/src/examples/extend_wrappers/CircleWrapper.f90 @@ -0,0 +1,145 @@ +module CircleWrapper + +USE Circle !< USE the data type to store +USE DimensionsWrapper0D !< USE the DimensionsWrapper0D abstract class +USE ErrorMessages !< USE the ErrorMessages for printing error messages +USE IR_Precision, only: I4P, str !< USE I4P data type and str for string conversion + +implicit none +private + + type, extends(DimensionsWrapper0D_t) :: CircleWrapper_t !< Extends from DimensionsWrapper0D_t (scalar value) + type(Circle_T), allocatable :: Value !< Value stores a copy of the input data by assignment + contains + private + procedure, public :: Set => CircleWrapper_Set !< Sets the Value into the Wrapper + procedure, public :: Get => CircleWrapper_Get !< Gets the Value from the Wrapper + procedure, public :: GetShape => CircleWrapper_GetShape !< Return the shape of the stored Value (0, scalar value) + procedure, public :: GetPointer => CircleWrapper_GetPointer !< Return an unlimited polymorphic pointer to the Value + procedure, public :: isOfDataType => CircleWrapper_isOfDataType !< Check if the data type of a input Mold is Circle_t + procedure, public :: Free => CircleWrapper_Free !< Free the Wrapper + procedure, public :: Print => CircleWrapper_Print !< Print the Wrapper content + end type + +public :: CircleWrapper_t + +contains + + subroutine CircleWrapper_Set(this, Value) + !----------------------------------------------------------------- + !< Set Circle Wrapper Value + !----------------------------------------------------------------- + class(CircleWrapper_t), intent(INOUT) :: this + class(*), intent(IN) :: Value + integer :: err + !----------------------------------------------------------------- + select type (Value) + type is (Circle_t) + allocate(this%Value, stat=err) + this%Value = Value + if(err/=0) & + call msg%Error(txt='Setting Value: Allocation error ('//& + str(no_sign=.true.,n=err)//')', & + file=__FILE__, line=__LINE__ ) + class Default + call msg%Warn(txt='Setting value: Expected data type (Circle)',& + file=__FILE__, line=__LINE__ ) + end select + end subroutine + + + subroutine CircleWrapper_Get(this, Value) + !----------------------------------------------------------------- + !< Get Circle Wrapper Value + !----------------------------------------------------------------- + class(CircleWrapper_t), intent(IN) :: this + class(*), intent(OUT) :: Value + !----------------------------------------------------------------- + select type (Value) + type is (Circle_t) + Value = this%Value + class Default + call msg%Warn(txt='Getting value: Expected data type (Circle)',& + file=__FILE__, line=__LINE__ ) + end select + end subroutine + + function CircleWrapper_GetShape(this) result(ValueShape) + !----------------------------------------------------------------- + !< Return the shape of the Wrapper Value + !----------------------------------------------------------------- + class(CircleWrapper_t), intent(IN) :: this + integer(I4P), allocatable :: ValueShape(:) + !----------------------------------------------------------------- + allocate(ValueShape(1)) + ValueShape = 0 + end function + + + function CircleWrapper_GetPointer(this) result(Value) + !----------------------------------------------------------------- + !< Get Unlimited Polymorphic pointer to Wrapper Value + !----------------------------------------------------------------- + class(CircleWrapper_t), target, intent(IN) :: this + class(*), pointer :: Value + !----------------------------------------------------------------- + Value => this%Value + end function + + + subroutine CircleWrapper_Free(this) + !----------------------------------------------------------------- + !< Free a CircleWrapper0D + !----------------------------------------------------------------- + class(CircleWrapper_t), intent(INOUT) :: this + integer :: err + !----------------------------------------------------------------- + if(allocated(this%Value)) then + deallocate(this%Value, stat=err) + if(err/=0) call msg%Error(txt='Freeing Value: Deallocation error ('// & + str(no_sign=.true.,n=err)//')', & + file=__FILE__, line=__LINE__ ) + endif + end subroutine + + + function CircleWrapper_isOfDataType(this, Mold) result(isOfDataType) + !----------------------------------------------------------------- + !< Check if Mold and Value are of the same datatype + !----------------------------------------------------------------- + class(CircleWrapper_t), intent(IN) :: this !< Circle wrapper 0D + class(*), intent(IN) :: Mold !< Mold for data type comparison + logical :: isOfDataType !< Boolean flag to check if Value is of the same data type as Mold + !----------------------------------------------------------------- + isOfDataType = .false. + select type (Mold) + type is (Circle_t) + isOfDataType = .true. + end select + end function CircleWrapper_isOfDataType + + + subroutine CircleWrapper_Print(this, unit, prefix, iostat, iomsg) + !----------------------------------------------------------------- + !< Print Wrapper + !----------------------------------------------------------------- + class(CircleWrapper_t), intent(IN) :: this !< CircleWrapper + 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. + real :: Radius !< Circle radius + !----------------------------------------------------------------- + prefd = '' ; if (present(prefix)) prefd = prefix + call this%Value%GetRadius(Radius=Radius) + write(unit=unit,fmt='(A)',iostat=iostatd,iomsg=iomsgd) prefd//' Data Type = Circle'//& + ', Radius = '//str(no_sign=.true., n=Radius) + if (present(iostat)) iostat = iostatd + if (present(iomsg)) iomsg = iomsgd + end subroutine CircleWrapper_Print + + +end module CircleWrapper diff --git a/src/examples/extend_wrappers/CircleWrapperFactory.f90 b/src/examples/extend_wrappers/CircleWrapperFactory.f90 new file mode 100644 index 0000000..a59c7db --- /dev/null +++ b/src/examples/extend_wrappers/CircleWrapperFactory.f90 @@ -0,0 +1,157 @@ +module CircleWrapperFactory + +USE Circle !< USE the data type to store +USE CircleWrapper !< USE the corresponding Wrapper +USE DimensionsWrapper !< USE the DimensionsWrapper abstract class +USE WrapperFactory !< USE the WrapperFactory abstract class +USE ErrorMessages !< USE the ErrorMessages for printing error messages +USE IR_Precision, only: I1P !< USE I1P data type + +implicit none +private + + type, extends(WrapperFactory_t) :: CircleWrapperFactory_t + private + + contains + procedure :: Wrap0D => CircleWrapperFactory_Wrap0D !< Wraps scalar Circles + procedure :: Wrap1D => CircleWrapperFactory_Wrap1D !< Wraps 1D arrays of Circles + procedure :: Wrap2D => CircleWrapperFactory_Wrap2D !< Wraps 2D arrays of Circles + procedure :: Wrap3D => CircleWrapperFactory_Wrap3D !< Wraps 3D arrays of Circles + procedure :: Wrap4D => CircleWrapperFactory_Wrap4D !< Wraps 4D arrays of Circles + procedure :: Wrap5D => CircleWrapperFactory_Wrap5D !< Wraps 5D arrays of Circles + procedure :: Wrap6D => CircleWrapperFactory_Wrap6D !< Wraps 6D arrays of Circles + procedure :: Wrap7D => CircleWrapperFactory_Wrap7D !< Wraps 7D arrays of Circles + procedure, public :: hasSameType => CircleWrapperFactory_hasSameType !< Check if the data type of a input Mold is Circle_t + end type + + type(CircleWrapperFactory_t), public :: WrapperFactoryCircle !< Public Wrapper Factory (singleton) + +contains + + function CircleWrapperFactory_hasSameType(this, Value) result(hasSameType) + !----------------------------------------------------------------- + !< Check if Value type agrees with wrapper type + !----------------------------------------------------------------- + class(CircleWrapperFactory_t), intent(IN) :: this + class(*), intent(IN) :: Value + logical :: hasSameType + !----------------------------------------------------------------- + hasSameType = .false. + select type(Value) + type is (Circle_t) + hasSameType = .true. + end select + end function CircleWrapperFactory_hasSameType + + + function CircleWrapperFactory_Wrap0D(this, Value) result(Wrapper) + !----------------------------------------------------------------- + !< Create Circle 0D Wrapper + !----------------------------------------------------------------- + class(CircleWrapperFactory_t), intent(IN) :: this + class(*), intent(IN) :: Value + class(DimensionsWrapper_t), pointer :: Wrapper + !----------------------------------------------------------------- + if(this%hasSameType(Value)) then + allocate(CircleWrapper_t::Wrapper) + call Wrapper%SetDimensions(Dimensions=0_I1P) + select type (Wrapper) + type is(CircleWrapper_t) + call Wrapper%Set(Value=Value) + end select + endif + end function CircleWrapperFactory_Wrap0D + + + function CircleWrapperFactory_Wrap1D(this, Value) result(Wrapper) + !----------------------------------------------------------------- + !< Create Circle 1D Wrapper + !----------------------------------------------------------------- + class(CircleWrapperFactory_t), intent(IN) :: this + class(*), intent(IN) :: Value(1:) + class(DimensionsWrapper_t), pointer :: Wrapper + !----------------------------------------------------------------- + call msg%Error(txt='Setting Value: Only scalar circle data type allowed', & + file=__FILE__, line=__LINE__ ) + end function CircleWrapperFactory_Wrap1D + + + function CircleWrapperFactory_Wrap2D(this, Value) result(Wrapper) + !----------------------------------------------------------------- + !< Create Circle 2D Wrapper + !----------------------------------------------------------------- + class(CircleWrapperFactory_t), intent(IN) :: this + class(*), intent(IN) :: Value(1:,1:) + class(DimensionsWrapper_t), pointer :: Wrapper + !----------------------------------------------------------------- + call msg%Error(txt='Setting Value: Only scalar circle data type allowed', & + file=__FILE__, line=__LINE__ ) + end function CircleWrapperFactory_Wrap2D + + + function CircleWrapperFactory_Wrap3D(this, Value) result(Wrapper) + !----------------------------------------------------------------- + !< Create Circle 3D Wrapper + !----------------------------------------------------------------- + class(CircleWrapperFactory_t), intent(IN) :: this + class(*), intent(IN) :: Value(1:,1:,1:) + class(DimensionsWrapper_t), pointer :: Wrapper + !----------------------------------------------------------------- + call msg%Error(txt='Setting Value: Only scalar circle data type allowed', & + file=__FILE__, line=__LINE__ ) + end function CircleWrapperFactory_Wrap3D + + + function CircleWrapperFactory_Wrap4D(this, Value) result(Wrapper) + !----------------------------------------------------------------- + !< Create Circle 4D Wrapper + !----------------------------------------------------------------- + class(CircleWrapperFactory_t), intent(IN) :: this + class(*), intent(IN) :: Value(1:,1:,1:,1:) + class(DimensionsWrapper_t), pointer :: Wrapper + !----------------------------------------------------------------- + call msg%Error(txt='Setting Value: Only scalar circle data type allowed', & + file=__FILE__, line=__LINE__ ) + end function CircleWrapperFactory_Wrap4D + + + function CircleWrapperFactory_Wrap5D(this, Value) result(Wrapper) + !----------------------------------------------------------------- + !< Create Circle 5D Wrapper + !----------------------------------------------------------------- + class(CircleWrapperFactory_t), intent(IN) :: this + class(*), intent(IN) :: Value(1:,1:,1:,1:,1:) + class(DimensionsWrapper_t), pointer :: Wrapper + !----------------------------------------------------------------- + call msg%Error(txt='Setting Value: Only scalar circle data type allowed', & + file=__FILE__, line=__LINE__ ) + end function CircleWrapperFactory_Wrap5D + + + function CircleWrapperFactory_Wrap6D(this, Value) result(Wrapper) + !----------------------------------------------------------------- + !< Create Circle 6D Wrapper + !----------------------------------------------------------------- + class(CircleWrapperFactory_t), intent(IN) :: this + class(*), intent(IN) :: Value(1:,1:,1:,1:,1:,1:) + class(DimensionsWrapper_t), pointer :: Wrapper + !----------------------------------------------------------------- + call msg%Error(txt='Setting Value: Only scalar circle data type allowed', & + file=__FILE__, line=__LINE__ ) + end function CircleWrapperFactory_Wrap6D + + + function CircleWrapperFactory_Wrap7D(this, Value) result(Wrapper) + !----------------------------------------------------------------- + !< Create Circle 7D Wrapper + !----------------------------------------------------------------- + class(CircleWrapperFactory_t), intent(IN) :: this + class(*), intent(IN) :: Value(1:,1:,1:,1:,1:,1:,1:) + class(DimensionsWrapper_t), pointer :: Wrapper + !----------------------------------------------------------------- + call msg%Error(txt='Setting Value: Only scalar circle data type allowed', & + file=__FILE__, line=__LINE__ ) + end function CircleWrapperFactory_Wrap7D + +end module CircleWrapperFactory diff --git a/src/examples/extend_wrappers/ExtendWrappers.f90 b/src/examples/extend_wrappers/ExtendWrappers.f90 new file mode 100644 index 0000000..22b7fe6 --- /dev/null +++ b/src/examples/extend_wrappers/ExtendWrappers.f90 @@ -0,0 +1,47 @@ +program main + +USE FPL +USE Circle +USE CircleWrapperFactory +USE iso_fortran_env, only: OUTPUT_UNIT + +type(Circle_t) :: MyCircle +type(ParameterList_t) :: MyList +type(ParameterList_t), pointer :: CircleList +integer :: FPLError + +!< Initialize FPL with the default WrapperFactories +call FPL_Init() + +!< Add the new WrapperFactory to the list of factories +call TheWrapperFactoryList%AddWrapperFactory(Key='CircleFactory', WrapperFactory=WrapperFactoryCircle) + +!< Sets the default size of the Dictionary +call myList%Init() + +!< Add parameters to the list +FPLError = MyList%Set(Key='NumberOfCircles',Value=5) + +!< Add a SubList to the list +CircleList => MyList%NewSubList(Key='Circles') + +!< Add parameters to the Cicles SubList +call myCircle%SetRadius(Radius=1.0); FPLError = CircleList%Set(Key='Circle_1',Value=myCircle) +call myCircle%SetRadius(Radius=2.0); FPLError = CircleList%Set(Key='Circle_2',Value=myCircle) +call myCircle%SetRadius(Radius=3.0); FPLError = CircleList%Set(Key='Circle_3',Value=myCircle) +call myCircle%SetRadius(Radius=4.0); FPLError = CircleList%Set(Key='Circle_4',Value=myCircle) +call myCircle%SetRadius(Radius=5.0); FPLError = CircleList%Set(Key='Circle_5',Value=myCircle) + +!< Print the content of MyList +call MyList%Print() + +!< Print the content of CircleList +call CircleList%Print() + +!< Free MyList +call MyList%Free() + +!< Finalize FPL and free TheWrapperFactoryList +call FPL_Finalize() + +end program diff --git a/src/lib/Wrapper/WrapperFactory/WrapperFactory.f90 b/src/lib/Wrapper/WrapperFactory/WrapperFactory.f90 index f90760d..d732a25 100644 --- a/src/lib/Wrapper/WrapperFactory/WrapperFactory.f90 +++ b/src/lib/Wrapper/WrapperFactory/WrapperFactory.f90 @@ -18,14 +18,6 @@ module WrapperFactory procedure(WrapperFactory_Wrap5D), deferred :: Wrap5D procedure(WrapperFactory_Wrap6D), deferred :: Wrap6D procedure(WrapperFactory_Wrap7D), deferred :: Wrap7D - procedure(WrapperFactory_UnWrap0D), deferred :: UnWrap0D - procedure(WrapperFactory_UnWrap1D), deferred :: UnWrap1D - procedure(WrapperFactory_UnWrap2D), deferred :: UnWrap2D - procedure(WrapperFactory_UnWrap3D), deferred :: UnWrap3D - procedure(WrapperFactory_UnWrap4D), deferred :: UnWrap4D - procedure(WrapperFactory_UnWrap5D), deferred :: UnWrap5D - procedure(WrapperFactory_UnWrap6D), deferred :: UnWrap6D - procedure(WrapperFactory_UnWrap7D), deferred :: UnWrap7D procedure(WrapperFactory_hasSameType), public, deferred :: hasSameType generic, public :: Wrap => Wrap0D, & Wrap1D, & @@ -35,14 +27,6 @@ module WrapperFactory Wrap5D, & Wrap6D, & Wrap7D - generic, public :: UnWrap => UnWrap0D, & - UnWrap1D, & - UnWrap2D, & - UnWrap3D, & - UnWrap4D, & - UnWrap5D, & - UnWrap6D, & - UnWrap7D end type abstract interface diff --git a/src/lib/Wrapper/WrapperFactoryList.f90 b/src/lib/Wrapper/WrapperFactoryList.f90 index 446104e..bb3f154 100644 --- a/src/lib/Wrapper/WrapperFactoryList.f90 +++ b/src/lib/Wrapper/WrapperFactoryList.f90 @@ -33,37 +33,37 @@ module WrapperFactoryList class(WrapperFactoryList_t), public, pointer :: Next => null() contains private - procedure, public :: HasNext => WrapperFactoryList_HasNext - procedure, public :: SetNext => WrapperFactoryList_SetNext - procedure, public :: GetNext => WrapperFactoryList_GetNext - procedure, public :: NullifyNext => WrapperFactoryList_NullifyNext - procedure, public :: HasKey => WrapperFactoryList_HasKey - procedure, public :: SetKey => WrapperFactoryList_SetKey - procedure, public :: GetKey => WrapperFactoryList_GetKey - procedure, public :: DeallocateKey => WrapperFactoryList_DeallocateKey - procedure, public :: HasValue => WrapperFactoryList_HasValue - procedure, public :: SetValue => WrapperFactoryList_SetValue - procedure, public :: GetValue => WrapperFactoryList_GetValue - procedure, public :: Free => WrapperFactoryList_Free - procedure, public :: AddNode => WrapperFactoryList_AddNode - procedure, public :: Print => WrapperFactoryList_Print - procedure :: WrapperFactoryList_GetFactory0D - procedure :: WrapperFactoryList_GetFactory1D - procedure :: WrapperFactoryList_GetFactory2D - procedure :: WrapperFactoryList_GetFactory3D - procedure :: WrapperFactoryList_GetFactory4D - procedure :: WrapperFactoryList_GetFactory5D - procedure :: WrapperFactoryList_GetFactory6D - procedure :: WrapperFactoryList_GetFactory7D - generic, public :: GetFactory => WrapperFactoryList_GetFactory0D, & - WrapperFactoryList_GetFactory1D, & - WrapperFactoryList_GetFactory2D, & - WrapperFactoryList_GetFactory3D, & - WrapperFactoryList_GetFactory4D, & - WrapperFactoryList_GetFactory5D, & - WrapperFactoryList_GetFactory6D, & - WrapperFactoryList_GetFactory7D - final :: WrapperFactoryList_Finalize + procedure, public :: HasNext => WrapperFactoryList_HasNext + procedure, public :: SetNext => WrapperFactoryList_SetNext + procedure, public :: GetNext => WrapperFactoryList_GetNext + procedure, public :: NullifyNext => WrapperFactoryList_NullifyNext + procedure, public :: HasKey => WrapperFactoryList_HasKey + procedure, public :: SetKey => WrapperFactoryList_SetKey + procedure, public :: GetKey => WrapperFactoryList_GetKey + procedure, public :: DeallocateKey => WrapperFactoryList_DeallocateKey + procedure, public :: HasValue => WrapperFactoryList_HasValue + procedure, public :: SetValue => WrapperFactoryList_SetValue + procedure, public :: GetValue => WrapperFactoryList_GetValue + procedure, public :: Free => WrapperFactoryList_Free + procedure, public :: AddWrapperFactory => WrapperFactoryList_AddWrapperFactory + procedure, public :: Print => WrapperFactoryList_Print + procedure :: WrapperFactoryList_GetFactory0D + procedure :: WrapperFactoryList_GetFactory1D + procedure :: WrapperFactoryList_GetFactory2D + procedure :: WrapperFactoryList_GetFactory3D + procedure :: WrapperFactoryList_GetFactory4D + procedure :: WrapperFactoryList_GetFactory5D + procedure :: WrapperFactoryList_GetFactory6D + procedure :: WrapperFactoryList_GetFactory7D + generic, public :: GetFactory => WrapperFactoryList_GetFactory0D, & + WrapperFactoryList_GetFactory1D, & + WrapperFactoryList_GetFactory2D, & + WrapperFactoryList_GetFactory3D, & + WrapperFactoryList_GetFactory4D, & + WrapperFactoryList_GetFactory5D, & + WrapperFactoryList_GetFactory6D, & + WrapperFactoryList_GetFactory7D + final :: WrapperFactoryList_Finalize end type WrapperFactoryList_t contains @@ -220,7 +220,7 @@ recursive subroutine WrapperFactoryList_Finalize(this) end subroutine WrapperFactoryList_Finalize - recursive subroutine WrapperFactoryList_AddNode(this,Key, WrapperFactory) + recursive subroutine WrapperFactoryList_AddWrapperFactory(this,Key, WrapperFactory) !----------------------------------------------------------------- !< Add a new Node if key does not Exist !----------------------------------------------------------------- @@ -234,12 +234,12 @@ recursive subroutine WrapperFactoryList_AddNode(this,Key, WrapperFactory) allocate(WrapperFactoryList_t::this%Next) select type (Next => this%Next) type is (WrapperFactoryList_t) - call Next%AddNode(Key=Key, WrapperFactory=WrapperFactory) + call Next%AddWrapperFactory(Key=Key, WrapperFactory=WrapperFactory) end select else select type (Next => this%Next) type is (WrapperFactoryList_t) - call Next%AddNode(Key=Key, WrapperFactory=WrapperFactory) + call Next%AddWrapperFactory(Key=Key, WrapperFactory=WrapperFactory) end select endif else @@ -249,7 +249,7 @@ recursive subroutine WrapperFactoryList_AddNode(this,Key, WrapperFactory) call this%SetKey(Key=Key) call this%SetValue(Value=WrapperFactory) endif - end subroutine WrapperFactoryList_AddNode + end subroutine WrapperFactoryList_AddWrapperFactory recursive function WrapperFactoryList_GetFactory0D(this, Value) result(WrapperFactory) diff --git a/src/lib/Wrapper/WrapperFactoryListSingleton.f90 b/src/lib/Wrapper/WrapperFactoryListSingleton.f90 index e7063a2..131cdf7 100644 --- a/src/lib/Wrapper/WrapperFactoryListSingleton.f90 +++ b/src/lib/Wrapper/WrapperFactoryListSingleton.f90 @@ -45,14 +45,14 @@ subroutine TheWrapperFactoryList_Init() !< Set the dimensions of the Value contained in the wrapper !----------------------------------------------------------------- ! Add some Wrapper Factories to the list - call TheWrapperFactoryList%AddNode(key='I1P', WrapperFactory=WrapperFactoryI1P) - call TheWrapperFactoryList%AddNode(key='I2P', WrapperFactory=WrapperFactoryI2P) - call TheWrapperFactoryList%AddNode(key='I4P', WrapperFactory=WrapperFactoryI4P) - call TheWrapperFactoryList%AddNode(key='I8P', WrapperFactory=WrapperFactoryI8P) - call TheWrapperFactoryList%AddNode(key='R4P', WrapperFactory=WrapperFactoryR4P) - call TheWrapperFactoryList%AddNode(key='R8P', WrapperFactory=WrapperFactoryR8P) - call TheWrapperFactoryList%AddNode(key='L', WrapperFactory=WrapperFactoryL) - call TheWrapperFactoryList%AddNode(key='DLCA', WrapperFactory=WrapperFactoryDLCA) + call TheWrapperFactoryList%AddWrapperFactory(key='I1P', WrapperFactory=WrapperFactoryI1P) + call TheWrapperFactoryList%AddWrapperFactory(key='I2P', WrapperFactory=WrapperFactoryI2P) + call TheWrapperFactoryList%AddWrapperFactory(key='I4P', WrapperFactory=WrapperFactoryI4P) + call TheWrapperFactoryList%AddWrapperFactory(key='I8P', WrapperFactory=WrapperFactoryI8P) + call TheWrapperFactoryList%AddWrapperFactory(key='R4P', WrapperFactory=WrapperFactoryR4P) + call TheWrapperFactoryList%AddWrapperFactory(key='R8P', WrapperFactory=WrapperFactoryR8P) + call TheWrapperFactoryList%AddWrapperFactory(key='L', WrapperFactory=WrapperFactoryL) + call TheWrapperFactoryList%AddWrapperFactory(key='DLCA', WrapperFactory=WrapperFactoryDLCA) end subroutine TheWrapperFactoryList_Init end module WrapperFactoryListSingleton