1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54
| !=======================================================================
! subroutiune de bare d'avancement
!=======================================================================
subroutine WaitBardam(fin,cur,funit,fcount)
implicit none
integer, parameter :: ki=kind(1.d0) !dimenssionnement des rééls
real(ki), intent(in) :: fin,cur
integer, intent(in) :: fcount
integer,intent(in),dimension(fcount):: funit
integer i,fc,av,ios
integer, parameter :: longligne=78
open(unit=91,file="sortie.dat",status="old",position="append",action="write",iostat=ios)
do i=1,longligne !effacement de la ligne
do fc=1,fcount
write(funit(fc),'(a1,$)')char(8)
end do
enddo
do fc=1,fcount
write(funit(fc),'(a19,$)')"calcul en route : ["
end do
av=int(cur/fin*50) !curseur entier
if (av>50) av=50
!~ open(unit=92,file="deb.dat",status="old",position="append",action="write",iostat=ios)
!~ write(92,*)fin, cur, av
!~ close(92)
Do i=1,av !on remplit la bare
do fc=1,fcount
if (MOD(i,5)/=0) then
write(funit(fc),'(a1,$)')'.'
else
write(funit(fc),'(I1,$)')i/5
endif
end do
end do
if (av/=50) then
do i=av,49 !on remplit la fin avec des espaces
do fc=1,fcount
write(funit(fc),'(a1,$)')' '
end do
end do
end if
av=av*2
if (av<100) then !on est pas au bout:
do fc=1,fcount
write(funit(fc),'(a2,I3,a1,$)')"] ",av,"%"
end do
else
do fc=1,fcount
write(funit(fc),'(a9)')"] Terminé"
end do
end if
close(91)
end subroutine WaitBardam
!======================================================================= |