all tasks

Task/Stack/Fortran/stack.f

@@ -0,0 +1,84 @@
+module stack
+
+  public
+
+  ! Define the data-structure to hold the data
+  type stack_var
+     integer, allocatable :: data(:)
+     integer              :: size = 0
+  end type stack_var
+
+  ! Set the size of allocated memory blocks
+  integer, parameter, private :: block_size = 10
+
+contains
+
+  ! Push ----------------------------------------------------------------------
+  subroutine push(s, e)
+    type(stack_var), intent(inout) :: s
+    integer, intent(in)            :: e
+    integer, allocatable :: wk(:)
+    if (.not. allocated(s%data)) then
+       ! Allocate space if not yet done
+       allocate(s%data(block_size))
+
+    elseif (s%size == size(s%data)) then
+       ! Grow the allocated space
+       allocate(wk(size(s%data)+block_size))
+       wk(1:s%size) = s%data
+       call move_alloc(wk,s%data)
+
+    end if
+
+    ! Store the data in the stack
+    s%size = s%size + 1
+    s%data(s%size) = e
+  end subroutine push
+
+  ! Pop -----------------------------------------------------------------------
+  function pop(s)
+    integer :: pop
+    type(stack_var), intent(inout) :: s
+    if (s%size == 0 .or. .not. allocated(s%data)) then
+       pop = 0
+       return
+    end if
+    pop = s%data(s%size)
+    s%size = s%size - 1
+  end function pop
+
+  ! Peek ----------------------------------------------------------------------
+  integer function peek(s)
+    type(stack_var), intent(inout) :: s
+    if (s%size == 0 .or. .not. allocated(s%data)) then
+       peek = 0
+       return
+    end if
+    peek = s%data(s%size)
+  end function peek
+
+  ! Empty ---------------------------------------------------------------------
+  logical function empty(s)
+    type(stack_var), intent(inout) :: s
+    empty = (s%size == 0 .or. .not. allocated(s%data))
+  end function empty
+
+end module stack
+
+program tstack
+  use stack
+  implicit none
+  type(stack_var) :: s
+  integer         :: v
+
+  call push(s,1)
+  call push(s,2)
+  call push(s,3)
+  call push(s,4)
+
+  do
+     if (empty(s)) exit
+     v = pop(s)
+     write(*,'(a,i0)') 'Popped value off stack = ',v
+  end do
+end program tstack