subroutine start_progress(max,title,progress_init)
  implicit none
  integer, intent(in) :: max
  double precision, intent(in) :: progress_init
  character*(*), intent(in) :: title
  BEGIN_DOC
! Starts the progress bar
  END_DOC

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

end

subroutine stop_progress
  implicit none
  BEGIN_DOC
! Stop the progress bar
  END_DOC
  progress_active = .False.
end

 BEGIN_PROVIDER [ real, progress_bar, (2) ]
&BEGIN_PROVIDER [ integer, progress_timeout ]
&BEGIN_PROVIDER [ logical, progress_active ]
&BEGIN_PROVIDER [ double precision, progress_value ]
&BEGIN_PROVIDER [ character*(20) , progress_title ]
 implicit none
 BEGIN_DOC
 ! Current status for displaying progress bars. Global variable.
 END_DOC
 progress_bar     = 0
 progress_value   = 0.d0
 progress_title   = ''
 progress_active  = .False.
 progress_timeout = 1
 open (unit=0, carriagecontrol='fortran')

END_PROVIDER

recursive subroutine run_progress
  use ifport
  implicit none
  BEGIN_DOC
! Display a progress bar with documentation of what is happening
  END_DOC
  character(75), parameter       :: bar0=                            &
  ' ---                      : ---                |                     | ---%'
  character(75)                  :: bar
  integer                        :: prog


  bar = bar0
  if (.not.progress_active) then
    call stop_progress
    write(unit=0,fmt="(a1,a1,a70)") '+',char(13), bar
  else
    prog = int( progress_bar(1)*100./progress_bar(2) )
    write(bar(1:25),'(A)'),progress_title
    write(bar(29:47),'(G17.10)'),progress_value
    write(bar(72:74),'(i3)') prog
   
    integer :: k,j
    j = int( progress_bar(1)*20./progress_bar(2) )
    do k=1, j
      bar(49+k:49+k)="="
    enddo
    write(unit=0,fmt="(a1,a1,a75)") '+',char(13), bar
    integer :: istat
    istat = alarm(progress_timeout,run_progress)
  endif

end


