Attribute.F90 Source File

#include "MAPL_ErrLog.h"
#include "unused_dummy.H"

module pFIO_AttributeMod

! limit the dimesion to 0 or 1
!
   use pFIO_UnlimitedEntityMod
   use MAPL_ExceptionHandling

   implicit none
   private

   public :: Attribute
   public :: StringWrap
   public :: Attribute_deserialize

   type,extends(UnlimitedEntity) :: Attribute
   contains
      generic :: operator(==) => equal_attr
      generic :: operator(/=) => not_equal_attr
      procedure :: equal_attr
      procedure :: not_equal_attr
   end type Attribute

   interface Attribute
      module procedure new_Attribute_empty ! HUGE or undef
      module procedure new_Attribute_0d ! scalar constructor
      module procedure new_Attribute_1d ! vector constructor
   end interface Attribute

contains

   function new_Attribute_empty() result(attr)
      type (Attribute) :: attr
      attr%UnlimitedEntity = UnlimitedEntity()
   end function new_Attribute_empty
   

   function new_Attribute_0d(value, rc) result(attr)
      type (Attribute) :: attr
      integer, optional, intent(out) :: rc
      integer :: status
      class (*), intent(in) :: value
      attr%UnlimitedEntity = UnlimitedEntity(value, status)
      _VERIFY(status)
      _RETURN(_SUCCESS)
   end function new_Attribute_0d
   
   function new_Attribute_1d(values, rc) result(attr)
      type (Attribute) :: attr
      integer, optional, intent(out) :: rc
      integer :: status
      class (*), intent(in) :: values(:)

      attr%UnlimitedEntity = UnlimitedEntity(values,status)
      _VERIFY(status)
      _RETURN(_SUCCESS)

   end function new_Attribute_1d

   logical function equal_attr(a, b)
      class (Attribute), target, intent(in) :: a
      type (Attribute),  target, intent(in) :: b
    
      equal_attr = (a%UnlimitedEntity == b%UnlimitedEntity)

   end function equal_attr

   logical function not_equal_attr(a, b)

      class (Attribute), target, intent(in) :: a
      type (Attribute),  target, intent(in) :: b
    
      not_equal_attr = .not. (a == b)

   end function not_equal_attr

   subroutine Attribute_deserialize(buffer, this, rc)
      integer, intent(in) :: buffer(:)
      type (Attribute), intent(inout) :: this
      integer, optional, intent(out) :: rc
      integer :: status

      call UnlimitedEntity_deserialize(buffer, this%UnlimitedEntity, rc=status)
      _VERIFY(status)
      _RETURN(_SUCCESS)
   end subroutine Attribute_deserialize

end module pFIO_AttributeMod

! The following module defines an FTL map (associative array) with keys that are deferred
! length strings and values that are Attributes.

module pFIO_StringAttributeMapMod
   use pFIO_AttributeMod
   
#include "types/key_deferredLengthString.inc"   
#define _value type (Attribute)
#define _value_equal_defined

#define _map StringAttributeMap
#define _iterator StringAttributeMapIterator

#define _alt
#include "templates/map.inc"
   
end module pFIO_StringAttributeMapMod

module pFIO_StringAttributeMapUtilMod
   use pFIO_UtilitiesMod
   use pFIO_AttributeMod
   use pFIO_StringAttributeMapMod
   use MAPL_ExceptionHandling
   implicit none
   private

   public :: StringAttributeMap_serialize
   public :: StringAttributeMap_deserialize

contains

    subroutine StringAttributeMap_serialize(map,buffer, rc)
       type (StringAttributeMap), target, intent(in):: map
       integer, allocatable,intent(inout) :: buffer(:)
       integer, optional, intent(out) :: rc

       type (StringAttributeMapIterator) :: iter
       character(len=:),pointer :: key
       type(Attribute),pointer :: attr_ptr
       integer :: length
       integer, allocatable :: tmp_buffer(:)

       if (allocated(buffer)) deallocate(buffer)
       allocate(buffer(0))
       iter = map%begin()
       do while (iter /= map%end())
          key => iter%key()
          buffer=[buffer,serialize_intrinsic(key)]
          attr_ptr => iter%value()
          call attr_ptr%serialize(tmp_buffer)
          buffer = [buffer, tmp_buffer]
          deallocate(tmp_buffer)
          call iter%next()
       enddo
       length = serialize_buffer_length(length)+size(buffer)
       buffer = [serialize_intrinsic(length),buffer]
       _RETURN(_SUCCESS)
    end subroutine StringAttributeMap_serialize

    subroutine StringAttributeMap_deserialize(buffer, map, rc)
       integer, intent(in) :: buffer(:)
       type (StringAttributeMap), intent(inout) :: map
       integer, optional, intent(out) :: rc

       character(len=:),allocatable :: key
       integer :: length,n,n0,n1,n2
       type (Attribute) :: attr
       integer :: status

       n = 1
       call deserialize_intrinsic(buffer(n:),length)
       _ASSERT(length == size(buffer), "length does not match")

       n0 = serialize_buffer_length(length)
       n = n + n0
       length = length - n0

       map = StringAttributeMap()
       do while (length > 0)
          call deserialize_intrinsic(buffer(n:),key)
          n1 = serialize_buffer_length(key)
          n = n + n1
          !allocate(attr)
          call deserialize_intrinsic(buffer(n:),n2)
          call Attribute_deserialize(buffer(n:n+n2-1), attr, status)
          _VERIFY(status)
          n = n + n2
          length = length - n1 - n2
          call map%insert(key,attr)
          deallocate(key)
          !deallocate(attr)
       enddo
       _RETURN(_SUCCESS)
    end subroutine StringAttributeMap_deserialize

end module pFIO_StringAttributeMapUtilMod