mirror of
https://github.com/LCPQ/quantum_package
synced 2024-06-19 19:52:15 +02:00
78 lines
1.9 KiB
Fortran
78 lines
1.9 KiB
Fortran
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
|
|
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
|
|
call alarm(progress_timeout,run_progress)
|
|
endif
|
|
|
|
end
|
|
|
|
|