Program perm
Use linked_list
Implicit None

TYPE (int_list), POINTER :: head, current, tail ! only pointers
Integer :: i, num, status, howmany

! add more elements to the list (ask user howmany)
write (*,10,ADVANCE='no') 'How many elements to permute?-> '
10 Format(A)
read (*,*) num
write (*,10,ADVANCE='no') 'How many perms to show?-> '
read (*,*) howmany

nullify(head) ! start with null list
do i = 1, num
   if (i == 1) then   ! create first element yourself
      allocate(head, stat=status)
      tail => head
      tail%value = i
      nullify(tail%next)
   else
     call tailappend_list(tail, i)
   end if
end do

do i = 1, howmany
call show_list(head)
call next_perm(num,head) ! generate a permutation
end do

contains


Subroutine findnext(head,ans)
  Implicit None
  TYPE (int_list), POINTER :: head, ans
  Type (int_list), POINTER :: nxt
  nxt => head%next
  do
     if (nxt%value <= head%value) exit  ! found first bigger
     ans => nxt
     if (.not. associated(nxt%next)) exit ! all are bigger
     nxt => nxt%next
  end do
End Subroutine findnext

Subroutine next_perm(n, hd)
  Implicit None
  TYPE (int_list), POINTER :: hd
  Integer, Intent(IN) :: n ! length of list
!local vars
  Integer :: current, previous, i, j, breakpos
  TYPE (int_list), POINTER :: tmp1, tmp2, last
  ! find the "break" point
  breakpos = 0
  current = nthelem(n,hd)
  do i = n-1, 1, -1
     previous = nthelem(i,hd)
!     write(*,*) 'Current = ', current, 'Prev = ', previous
     if (current < previous) then
         current = previous
     else ! we have found the break - i
         breakpos = i
         exit
     end if
  end do
!  Write(*,*) "Break Point is: ",breakpos
  if (breakpos == 0) then
     write(*,*) 'No next perm is possible'
  else
   call sublist(breakpos,hd,tmp1) !tmp1 points to change position
 !  call show_list(tmp1)
   call findnext(tmp1,tmp2) ! tmp2 has next bigger value
 !   call show_list(tmp2)
   ! swap the vals at tmp1 and tmp2
   j = tmp1%value
   tmp1%value = tmp2%value
   tmp2%value = j
   ! reverse the rest of the list after tmp1
   call revlist(tmp1%next,tmp2)
   call freeall(tmp1%next)
   tmp1%next => tmp2
  end if
End Subroutine next_perm

End Program perm
