mirror of
https://github.com/LCPQ/quantum_package
synced 2024-10-05 15:56:09 +02:00
80 lines
1.9 KiB
FortranFixed
80 lines
1.9 KiB
FortranFixed
|
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
|
||
|
|
||
|
|