TreeClass.f90 Source File

module TreeClass
   use, intrinsic :: iso_fortran_env
   use ArrayClass
   implicit none

   type :: Nodep_
      type(Node_), pointer :: Nodep
   end type

   type :: Node_
      type(Node_), pointer    :: Parent
      type(Nodep_), allocatable :: Child(:)
      real(real64)         :: coord(3)
      real(real64)         :: vector(3)
      character*200   :: Name
      real(real64) :: fpval
      integer(int32)         :: intval
      integer(int32)         :: ID
   contains
      procedure, public :: Init => InitializeNode
      procedure, public :: create => CreateNode
   end type

   type :: Tree_
      type(Nodep_), allocatable :: Node(:)
      integer(int32) :: SortedUntil
   contains
      procedure, public :: Init => InitializeTree
      procedure, public :: Add => AddNodeInTree
      procedure, public :: cut => cutNodeInTree
      procedure, public :: show => showTree
      procedure, public :: NumOfTree => NumOfTree
      procedure, public :: parentNodeID => parentNodeIDTree
      procedure, public :: countIfParentIDis => countIfParentIDis
      procedure, public :: setVisualMap => setVisualMapTree
   end type

contains

! #######################################################
   subroutine InitializeNode(obj)
      class(Node_), intent(inout) :: obj

      allocate (obj%Child(1))
      obj%coord(:) = 0.0d0
      obj%vector(:) = 0.0d0

   end subroutine InitializeNode
! #######################################################

! #######################################################
   subroutine CreateNode(obj, parent, Name)
      class(Node_), target, intent(inout) :: obj
      class(Node_), target, optional, intent(inout) :: parent
      character(*), intent(in)    :: Name

      call obj%init()
      if (present(parent)) then
         obj%Parent => parent
      else
         obj%Parent => obj
      end if
      obj%Name = Name

   end subroutine
! #######################################################

! #######################################################
! #######################################################

! #######################################################
   subroutine InitializeTree(obj, NumOfNode)
      class(Tree_), intent(inout)::obj
      integer(int32), optional, intent(in)::NumOfNode
      integer(int32) :: i, n, num

      num = input(default=10000, option=NumOfNode)
      if (.not. allocated(obj%Node)) then
         allocate (obj%Node(num))
      end if

      obj%SortedUntil = 0

   end subroutine
! #######################################################

! #######################################################
   subroutine AddNodeInTree(obj, NodeObj)
      class(Tree_), intent(inout)::obj
      class(Node_), target, intent(in)::NodeObj

      obj%SortedUntil = obj%SortedUntil + 1
      obj%Node(obj%SortedUntil)%Nodep => NodeObj

      print *, "A Node is imported. now number of node is ", obj%SortedUntil &
         , "| Name = ", obj%Node(obj%SortedUntil)%Nodep%Name

   end subroutine
! #######################################################

! #######################################################
   subroutine cutNodeInTree(obj, NodeObj)
      class(Tree_), intent(inout)::obj
      class(Node_), target, intent(in)::NodeObj
      integer(int32) :: i, num

      num = obj%SortedUntil
      do i = 1, obj%SortedUntil
         if (obj%Node(i)%Nodep%Name == NodeObj%Name) then

            print *, "A Node is cut. now number of node is ", obj%SortedUntil &
               , "cut node is : ", obj%Node(i)%Nodep%Name, "Node id : ", i
            nullify (obj%Node(i)%Nodep)
            num = num - 1
         end if

      end do
      obj%SortedUntil = num

   end subroutine
! #######################################################

! #######################################################
   subroutine showTree(obj)
      class(Tree_), intent(in)::obj

      integer(int32) :: i, n
      real(real64) :: x, y, vx, vy

      print *, "Num of Tree = ", obj%NumOfTree()
      do i = 1, obj%NumOfTree()
         print *, "Parent Node ID = ", obj%parentNodeID(ParentID=i)
      end do
      call obj%setVisualMap()

      do i = 1, obj%SortedUntil
         print *, "child = ", obj%Node(i)%Nodep%Name &
            , " | parent = ", obj%Node(i)%Nodep%parent%Name
      end do

      do i = 1, obj%SortedUntil
         print *, obj%Node(i)%Nodep%coord(:), obj%Node(i)%Nodep%vector(:)
      end do

   end subroutine
! #######################################################

! #######################################################
   function NumOfTree(obj) result(num)
      class(Tree_), intent(in)::obj
      integer(int32) :: i, n, num

      num = 0
      do i = 1, obj%SortedUntil
         if (obj%Node(i)%Nodep%Name == obj%Node(i)%Nodep%parent%Name) then
            num = num + 1
         end if
      end do

   end function
! #######################################################

! #######################################################
   function countIfParentIDis(obj, ParentID) result(num)
      class(Tree_), intent(in)::obj
      integer(int32), intent(in)::ParentID
      integer(int32) :: i, n, num

      num = 0
      do i = 1, obj%SortedUntil
         if (obj%Node(ParentID)%Nodep%Name == obj%Node(i)%Nodep%parent%Name) then
            num = num + 1
         end if
      end do

   end function
! #######################################################

! #######################################################
   function parentNodeIDTree(obj, ParentID) result(NodeID)
      class(Tree_), intent(in)::obj
      integer(int32), optional, intent(in)::ParentID
      integer(int32) :: i, n, num, pid, NodeID

      pid = input(default=1, option=ParentID)
      num = 0
      do i = 1, obj%SortedUntil
         if (obj%Node(i)%Nodep%Name == obj%Node(i)%Nodep%parent%Name) then
            num = num + 1
            if (pid == num) then
               NodeID = i
               return
            end if
         end if
      end do
   end function
! #######################################################

! #######################################################
   subroutine setVisualMapTree(obj)
      class(Tree_), intent(in)::obj

      integer(int32) :: i, j, n, num, num_i, num_of_node
      real(real64) :: vec(3), pi, theta, dtheta
      real(real64), allocatable :: rotate(:, :)

      allocate (rotate(3, 3))

      num = 0
      pi = 3.14159d0
      do i = 1, obj%SortedUntil
         if (obj%Node(i)%Nodep%Name == obj%Node(i)%Nodep%parent%Name) then
            num = num + 1
            num_i = 0
            ! primary node
            ! set x(:)=0
            obj%Node(i)%Nodep%coord(:) = 0.0d0
            num_of_node = obj%countIfParentIDis(parentID=i)
            dtheta = pi/dble(num_of_node)/2.0d0
            rotate(:, :) = 0.0d0
            theta = 0.0d0
            do j = 1, obj%SortedUntil
               if (obj%Node(i)%Nodep%Name == obj%Node(j)%Nodep%parent%Name) then
                  theta = theta + dtheta
                  vec(:) = 0.0d0
                  vec(1) = 1.0d0
                  rotate(3, 3) = 1.0d0
                  rotate(1, 1) = cos(theta)
                  rotate(1, 2) = -sin(theta)
                  rotate(2, 1) = sin(theta)
                  rotate(2, 2) = cos(theta)
                  vec(:) = matmul(rotate, vec)
                  obj%Node(j)%Nodep%coord(:) = obj%Node(i)%Nodep%parent%coord(:) + vec(:)
                  obj%Node(j)%Nodep%vector(:) = vec(:)
               end if
            end do
         else
            cycle
         end if
      end do

   end subroutine
! #######################################################

end module