module module_sort
    implicit none
    interface sort
        module procedure int_heap_sort, real_heap_sort
    end interface

    contains

        subroutine int_heap_down(a,node,las)
            implicit none
            integer(8) a(*),x
            integer(8) node,par,ch1,ch2,las
            par = node
            x = a(par); ch1 = par*2
            do while(ch1 <= las)
                ch2 = ch1+1
                if(ch2 <= las .and. a(ch1) < a(ch2)) ch1 = ch2
                if(a(ch1) > x) then
                    a(par) = a(ch1); a(ch1) = x
                else 
                    exit
                endif
                par = ch1; ch1 = par*2
            enddo
        end subroutine int_heap_down

        subroutine int_heap_sort(a,n)
            implicit none
            integer(8) a(*),x
            integer(8) n,i
            do i = n/2, 1, -1
                call int_heap_down(a,i,n)
            enddo
            do i=n,2,-1
                x = a(i); a(i) = a(1); a(1) = x
                call int_heap_down(a,1_8,i-1)
            enddo
        end subroutine int_heap_sort

        subroutine real_heap_down(a,node,las)
            implicit none
            real a(*), x
            integer(8) node,par,ch1,ch2,las
            par = node
            x = a(par); ch1 = par*2
            do while(ch1 <= las)
                ch2 = ch1+1
                if(ch2 <= las .and. a(ch1) < a(ch2)) ch1 = ch2
                if(a(ch1) > x) then
                    a(par) = a(ch1); a(ch1) = x
                else 
                    exit
                endif
                par = ch1; ch1 = par*2
            enddo
        end subroutine real_heap_down

        subroutine real_heap_sort(a,n)
            implicit none
            real a(*),x
            integer(8) n,i
            do i = n/2, 1, -1
                call real_heap_down(a,i,n)
            enddo
            do i=n,2,-1
                x = a(i); a(i) = a(1); a(1) = x
                call real_heap_down(a,1_8,i-1)
            enddo
        end subroutine real_heap_sort

end module module_sort

module module_deque
    implicit none
    type node
        type(node) ,pointer:: prev => null(),next => null()
        integer(8) val
    end type node

    type deque
        type(node) ,pointer:: first => null(),last => null()
        integer(8):: size=0
        contains
            procedure:: push_back => deque_push_back
            procedure:: push_front => deque_push_front
            procedure:: pop_back => deque_pop_back
            procedure:: pop_front => deque_pop_front
    end type deque

    contains

        subroutine deque_push_back(self,val)
            class(deque)::self
            integer(8)::val
            if(self%size == 0) then
                allocate(self%first)
                self%last => self%first
                self%first%val = val
                self%size = 1
            else
                allocate(self%last%next)
                self%last%next%prev => self%last
                self%last => self%last%next
                self%last%val = val
                self%size = self%size+1
            endif
        end subroutine deque_push_back

        subroutine deque_push_front(self,val)
            class(deque)::self
            integer(8)::val
            if(self%size == 0) then
                allocate(self%first)
                self%last => self%first
                self%first%val = val
                self%size = 1
            else
                allocate(self%first%prev)
                self%first%prev%next => self%first
                self%first => self%first%prev
                self%first%val = val
                self%size = self%size+1
            endif
        end subroutine deque_push_front

        subroutine deque_pop_back(self)
            class(deque)::self
            if(self%size == 0) then
                return
            else if(self%size == 1) then
                self%size = 0
                deallocate(self%last)
                self%last => null(); self%first => null()
            else
                self%last => self%last%prev
                deallocate(self%last%next)
                self%last%next => null()
                self%size = self%size-1
            endif
        end subroutine deque_pop_back

        subroutine deque_pop_front(self)
            class(deque)::self
            if(self%size == 0) then
                return
            else if(self%size == 1) then
                self%size = 0
                deallocate(self%first)
                self%last => null(); self%first => null()
            else
                self%first => self%first%next
                deallocate(self%first%prev)
                self%first%prev => null()
                self%size = self%size-1
            endif
        end subroutine deque_pop_front

end module module_deque

module module_RedBlackTree
    implicit none
    integer(8),parameter :: red = 1,black = 0
    type RBT_KEY
        integer(8) :: k
    end type RBT_KEY
    type node
        type(node),pointer :: par=>null(), left => null(),right => null()
        type(RBT_KEY)      :: key
        integer(8)         :: val=0
        integer(8)         :: color=red
    end type node

    type(node) ,pointer,save:: nil

    type RedBlackTree
        type(node),pointer :: root => null()
        integer(8)         :: size = 0
        contains
            procedure:: insert  => RedBlackTree_Insert
            procedure:: get_val => RedBlackTree_Get
            procedure:: find    => RedBlackTree_Find
            procedure:: FixUp   => RedBlackTree_FixUp
            end type RedBlackTree

    contains

        subroutine RedBlackTree_Init()
            implicit none

            if(.not.associated(nil)) then
                allocate(nil)
                nil%color = black
            endif
        
        end subroutine  RedBlackTree_Init

        recursive function RedBlackTree_Get(self,key) result(val)
            implicit none
            class(RedBlackTree), intent(in) :: self
            type(RBT_KEY)                   :: key
            integer(8)                      :: val
            type(node),pointer              :: u

            u   => SearchTree(self%root,key)
            val = u%val
            return

        end function RedBlackTree_Get

        recursive function RedBlackTree_Find(self,key) result(res)
            implicit none
            class(RedBlackTree), intent(in) :: self
            type(RBT_KEY)                   :: key
            logical                         :: res
            type(node),pointer              :: u


            u   => SearchTree(self%root,key)
            res = (.not.associated(u,nil))
            return

        end function RedBlackTree_Find

        recursive function SearchTree(u,key) result(res)
            implicit none
            type(node), pointer  :: u,res
            type(RBT_KEY)        :: key

            if(associated(u,nil)) then
                res => nil
                return
            endif

            if(key%k < u%key%k) then
                res => SearchTree(u%left,key)
                return
            else if(key%k > u%key%k) then
                res => SearchTree(u%right,key)
                return
            else
                res => u
                return
            endif

        end function SearchTree

        subroutine RedBlackTree_Insert(self,key,val)
            implicit none
            class(RedBlackTree),intent(inout):: self
            type(RBT_KEY),intent(in)         :: key
            integer(8),intent(in)            :: val
            type(node),pointer,save          :: now, u

            !allocate new node
            allocate(u)
            u%key = key; u%val = val
            u%left => nil; u%right => nil

            !insert new node
            if(.not. associated(self%root)) then
                u%left => nil; u%right => nil; u%par => nil
                self%root => u
                self%root%color = black
                self%size = 1
                return
            else
                now => self%root
                if(.not.Insert_Node(u,now)) return
            endif

            !Fix Tree
            call self%FixUp(u)

            self%size = self%size+1
            
        end subroutine RedBlackTree_Insert

        recursive function Insert_Node(u,now) result(added) 
            implicit none
            type(node), pointer:: u,now
            logical            :: added
            
            if(u%key%k < now%key%k) then
                if(associated(now%left,nil)) then
                    now%left => u
                    u%par => now
                    added = .true.
                else
                    now => now%left
                    added = Insert_Node(u,now)
                endif
                return
            else if(u%key%k > now%key%k) then
                if(associated(now%right,nil)) then
                    now%right => u
                    u%par => now
                    added = .true.
                else
                    now => now%right
                    added = Insert_Node(u,now)
                endif
                return
            else
                added = .false.
                return
            endif

        end function Insert_Node 

        subroutine RedBlackTree_FixUp(self,u)
            implicit none
            class(RedBlackTree),intent(inout) :: self
            type(node),pointer,intent(inout)  :: u
            type(node),pointer                :: w,g

            nullify(w,g)
            do while(u%color == red)
                if(u%key%k == self%root%key%k) then
                    u%color = black
                    return
                endif
                w => u%par
                if(w%left%color == black) then
                    call FripLeft(w,self%root)
                    u => w
                    w => u%par
                endif
                if(w%color == black) return
                g => w%par
                if(g%right%color == black) then
                    call FripRight(g,self%root)
                    return
                else
                    call PushBlack(g)
                    u => g
                endif
            enddo
        
        end subroutine RedBlackTree_FixUp

        subroutine PushBlack(u)
            implicit none
            type(node), pointer:: u

            u%color = red; u%left%color = black; u%right%color = black; 

        end subroutine PushBlack

        subroutine PullBlack(u)
            implicit none
            type(node), pointer:: u

            u%color = black; u%left%color = red; u%right%color = red; 

        end subroutine PullBlack

        subroutine FripLeft(u,root)
            implicit none
            type(node), pointer, intent(inout) :: root
            type(node), pointer                :: u,w
            integer(8)                         :: tmp
            
            tmp = u%color; u%color = u%right%color; u%right%color = tmp

            w => u%right
            w%par => u%par
            if(.not.associated(u%par,nil)) then
                if(associated(w%par%left,u)) then
                     w%par%left=>w
                else 
                    w%par%right=>w
                endif
            endif
            u%right => w%left
            if(.not.associated(u%right,nil))u%right%par => u
            u%par => w
            w%left => u
            if(associated(u,root)) then
                root => w
                root%par => nil
            endif

        end subroutine FripLeft

        subroutine FripRight(u,root)
            implicit none
            type(node), pointer,intent(inout):: root
            type(node), pointer              :: u,w
            integer(8)                       :: tmp

            tmp = u%color; u%color = u%left%color; u%left%color = tmp

            w => u%left
            w%par => u%par
            if(.not.associated(u%par,nil)) then
                if(associated(w%par%left,u)) then
                    w%par%left=>w
                else 
                    w%par%right=>w
                endif
            endif
            u%left => w%right
            if(.not.associated(u%left,nil))u%left%par => u
            u%par => w
            w%right => u
            if(associated(u,root)) then
                root => w
                root%par => nil
            endif

        end subroutine FripRight

end module module_RedBlackTree

program main
    use module_sort
    use module_deque
    use module_RedBlackTree
    implicit none
    integer(8)::i,N
    type(RBT_KEY) a
    type(RedBlackTree) map

    call RedBlackTree_Init()

    read*,N 
    do i = 1,N 
        read *,a%k
        call map%insert(a,a%k)
    enddo

    print '(i0)',map%size
    
end program main


Measured memory_bytes: 768