Progress monitor in Fortran

progress.f90

module progress
  implicit none

  ! A value you want to monitor (like a running average for instance)
  real*8           :: progress_value    = huge(1.d0)

  ! the 1st index will contain the current loop count, and the 2nd index the
  ! total loop count. The ratio ``dble(progress_bar(1))/dble(progress_bar(2))``
  ! will give you the current percentage of progress.
  integer          :: progress_bar(2)   = (/ 1, 1 /)

  ! A time interval in seconds between each refresh
  integer          :: progress_refresh  = 2

  ! A unit number for the file in which you will write the info
  integer          :: progress_unit     = 66

  ! .True. when you are monitoring, .False. otherwise.
  logical          :: progress_active   = .False.

  ! Lets you identify what you are monitoring.
  character*(64)   :: progress_title    = "UNDEFINED"

  ! Name of the file in which you will store the progress
  character*(128)  :: progress_filename = "/tmp/progress"

end module

subroutine start_progress(max,title,progress_init)
  use progress
  implicit none

  ! Max value of the loop count
  integer, intent(in)          :: max

  ! Title of what you monitor
  character*(*), intent(in)    :: title

  !  Initial value of the progress_value
  double precision, intent(in) :: progress_init

  progress_bar(1) = 0
  progress_bar(2) = max
  progress_title = title
  progress_active = .True.
  progress_value = progress_init
  call run_progress()
end

subroutine write_progress()
  use progress
  implicit none
  open(unit=progress_unit,file=progress_filename)
  write(progress_unit,'(A)') progress_title
  write(progress_unit,'(F5.1,X,A)') dble(100*progress_bar(1))/dble(progress_bar(2)), '%'
  write(progress_unit,*) progress_value
  close(unit=progress_unit)
end

subroutine stop_progress()
  use progress
  implicit none
  progress_active = .False.
  call write_progress()
end


recursive subroutine run_progress()
  use progress
  implicit none
  call write_progress()
  if (progress_active) then
    call alarm(progress_refresh,run_progress)
  endif
end


program test
  use progress
  implicit none

  integer :: i
  integer, parameter :: nmax = 10

  double precision :: s

  s = 0.d0
  call start_progress(nmax, "Dummy loop", s)
  do i=1,nmax
    call sleep(1)
    s = s+1.d0
    progress_value  = s
    progress_bar(1) = i
  enddo
  call stop_progress()
end