module globals
  logical                             :: DEBUG;
  real,allocatable                    :: stack(:),stackcpy(:);
  integer                             :: stacksize;
end module

program main

use globals;
implicit none;

character(255)                      :: input;
integer                             :: cnt;
real                                :: r,r1,r2;

!DEBUG=.true.;
DEBUG=.false.;

!! read from fortran fileunit 5 which is STDIN
read(5,'(A255)') input;

write(*,*)'Read: "',trim(input),'"';
cnt=0;         !! initialize, so we can do a +1 the fist time around
do
    !! truncate beginning of input line, so we can cycle to the next space.
    input=input(cnt+1:);   
    if (DEBUG) write(*,*)'input line reads: "',trim(input),'"';
   
    !! exit if input line ends.
    if (len_trim(input) <= 0) then
      if (DEBUG) write(*,*)'End of input line.';
      exit;
    end if
   
    !! search for first space in input line
    cnt=index(input, ' ');
   
    !! search for operators
    select case(input(:cnt));
      case('-')
       call pop(r1);
       call pop(r2);
       r = r2 - r1;
       if (DEBUG) write(*,*)'Evaluating ',r2, ' minus ',r1,', result:',r,'.'
       call push(r);
       cycle
     case('+')
       call pop(r1);
       call pop(r2);
       r = r2 + r1;
       if (DEBUG) write(*,*)'Evaluating ',r2, ' plus ',r1,', result:',r,'.'
       call push(r);
       cycle
     case('*')
       call pop(r1);
       call pop(r2);
       r = r2 * r1;
       if (DEBUG) write(*,*)'Evaluating ',r2, 'times ',r1,', result:',r,'.'
       call push(r);
       cycle
     case('/')
       call pop(r1);
       call pop(r2);
       if (r1 == 0) then
         write(*,*)'AIIEEE! Division by zero!';
         stop;
       end if
       r = r2 / r1;
       if (DEBUG) write(*,*)'Evaluating ',r2, ' by ',r1,', result:',r,'.'
       call push(r);
       cycle 
     case default
       !! okay, we have an number, push to stack
       !! we will get a runtime error if its not a number.
       read(input(:cnt),*)r;
       if (DEBUG) write(*,*)'Read r: ',r;
       call push(r);
       cycle;
   end select
   !! all valid cases should be considered above !!
   write(*,*)'Invalid character in input';
end do

!! all done, display result
write(*,*)'Program finished'
write(*,*)'Result: ',stack(stacksize);
end program

!! push r ontop of stack, play stupid allocation game
subroutine push(r)
    use globals;
    implicit none;
    real,intent(in)  :: r
   
    if (DEBUG) write(*,*)'Pushing ',r,' to stack';
    if (allocated(stackcpy)) deallocate(stackcpy);
    allocate(stackcpy(stacksize));
    stackcpy=stack;
    if (allocated(stack)) deallocate(stack);
    stacksize=stacksize+1;
    allocate(stack(stacksize));
    stack=stackcpy;
    stack(stacksize)=r;

    return
end subroutine

!! pop r from stack, play stupid allocation game again
subroutine pop(r)
    use globals;
    implicit none;
    real,intent(out)  :: r
   
    r=stack(stacksize);
    if (DEBUG) write(*,*)'Popping ',r,' from stack';
    stacksize=stacksize-1;
    if (allocated(stackcpy)) deallocate(stackcpy);
    allocate(stackcpy(stacksize));
    stackcpy=stack(:stacksize);
    deallocate(stack);
    allocate(stack(stacksize));
    stack=stackcpy;

    return
end subroutine