! Program Example from "Essential Fortran 90 & 95" by Loren P. Meissner
! Copyright 1996. Copying for sale requires permission from the author.
! Otherwise, distribution is permitted if these three lines are included.

!  Example 7.8. GENERIC STACK implementation.
   program H08
      use H08M
      implicit none
      type (Node_Type1), pointer :: StackA_NP1, StackB_NP1
      type (Node_Type2), pointer :: Stack_NP2
      type (Node_Type3), pointer :: Stack_NP3
      character (len = 12) :: Item1
      integer :: Item2
      type (Info_Type) :: Item3
!  start program H08
      call Create( StackA_NP1 )
      call Create( StackB_NP1 )
      call Create( Stack_NP2 )
      call Create( Stack_NP3 )
      call Push( StackA_NP1, "ABCDEFGHIJKL" )
      call Push( StackA_NP1, "opqrstuvwxyz" )
      call Push( Stack_NP2, 1 )
      call Push( Stack_NP2, 2 )
      call Push( Stack_NP3, Info_Type( 11, "abcdefghijkl") )
      call Push( Stack_NP3, Info_Type( 22, "OPQRSTUVWXYZ") )
      call Push( StackB_NP1, "Hello world." )
      call Push( StackB_NP1, "Bye cruel wo" )
      call Pop( StackA_NP1, Item1 )
      write (unit = *, fmt = *) " 1 1: ", Item1
      call Pop( Stack_NP2, Item2 )
      write (unit = *, fmt = *) " 2 1: ", Item2
      call Pop( Stack_NP3, Item3 )
      write (unit = *, fmt = *) " 3 1: ", Item3
      call Pop( StackB_NP1, Item1 )
      write (unit = *, fmt = *) " 4 1: ", Item1
      call Peek( StackA_NP1, Item1 )
      write (unit = *, fmt = *) " 1 2: ", Item1
      call Peek( Stack_NP2, Item2 )
      write (unit = *, fmt = *) " 2 2: ", Item2
      call Peek( Stack_NP3, Item3 )
      write (unit = *, fmt = *) " 3 2: ", Item3
      call Peek( StackB_NP1, Item1 )
      write (unit = *, fmt = *) " 4 2: ", Item1
      call Pop( StackB_NP1, Item1 )
      write (unit = *, fmt = *) " 4 3: ", Item1
      write (unit = *, fmt = *) " 1 Empty? ", Is_Empty(StackA_NP1)
      write (unit = *, fmt = *) " 2 Empty? ", Is_Empty(Stack_NP2)
      write (unit = *, fmt = *) " 3 Empty? ", Is_Empty(Stack_NP3)
      write (unit = *, fmt = *) " 4 Empty? ", Is_Empty(StackB_NP1)
      stop
  end program H08

