program extrairresultados
    implicit none
    !SCALARS VARIABLES
    real(kind=8) :: fmin,ftol,timemin,tau,taufin
    integer :: ntab,num_lines,i,j,k,allocerr,sizepf,indtau,countgeral,exitpf,ncomp
    logical :: tableftol, outpfgnuplot
    character(len=2000) :: line

    !ARRAYS VARIABLES
    real(kind=8), dimension(:), allocatable :: gama,gamaprev
    real(kind=8), dimension(:,:), allocatable :: time,f,g
    character(10), dimension(:,:), allocatable :: problem
    character(11), dimension(:), allocatable :: namesalg
    integer, dimension(:), allocatable :: indpf,cont
    integer, dimension(:,:), allocatable :: sc,ierr,totit,fcnt,gcnt,hcnt,n,vec
    logical, dimension(:), allocatable :: ignore,comparable

    tableftol = .true.
    outpfgnuplot = .true. 

    write(*,*)
    write(*,*) '================================='
    write(*,*) ' Which comparison do you want?'
    write(*,*) '---------------------------------'
    write(*,*) ' 1 - Algorithm P vs Algorithm T'
    write(*,*) ' 2 - Algorithm P vs Gencan'
    write(*,*) '================================='
    write(*,*)
    read(*,*) ncomp
    
    if ( ncomp .eq. 1 ) then 
        ntab = 2
        open(11, file='table-algp.txt', status='old')
        open(12, file='table-algt.txt', status='old')

        allocate(namesalg(ntab), cont(ntab), stat=allocerr)
        if ( allocerr .ne. 0 ) then
            write(*,*) 'Allocation error.'
            stop
        end if

        namesalg(1) = 'Algorithm P'
        namesalg(2) = 'Algorithm T'
    else if ( ncomp .eq. 2 ) then 
        ntab = 2
        open(11, file='table-algp.txt', status='old')
        open(12, file='table-gencan3.txt', status='old')

        allocate(namesalg(ntab), cont(ntab), stat=allocerr)
        if ( allocerr .ne. 0 ) then
            write(*,*) 'Allocation error.'
            stop
        end if

        namesalg(1) = 'Algorithm P'
        namesalg(2) = 'Gencan 3'
    end if
    do i = 1, 33
        do j = 1, ntab
            read(10 + j,*)
        end do
    end do

    num_lines = 0
    do
        read(11, *, iostat=i)
        if (i /= 0) exit
        num_lines = num_lines + 1
    end do

    do j = 1, ntab
        rewind(10 + j)
    end do

    do i = 1, 33
        do j = 1, ntab
            read(10 + j,*)
        end do
    end do

    allocate(problem(num_lines,ntab),sc(num_lines, ntab),ierr(num_lines, ntab), &
        time(num_lines, ntab),n(num_lines,ntab),f(num_lines, ntab),g(num_lines, ntab),&
        fcnt(num_lines, ntab),gcnt(num_lines, ntab),hcnt(num_lines, ntab), &
        indpf(num_lines),gama(ntab),gamaprev(ntab), totit(num_lines,ntab),&
        ignore(num_lines),comparable(num_lines),&
        vec(0:13,ntab),stat=allocerr)
    if ( allocerr .ne. 0 ) then
        write(*,*) 'Allocation error.'
        stop
    end if

    ignore(1:num_lines) = .false. 
    comparable(1:num_lines) = .false.

    do i = 1, num_lines
        do j = 1, ntab
            read(10 + j,'(A)') line
            read(line,*) problem(i,j),sc(i,j),ierr(i,j),time(i,j)
            if ( line(32:46) .eq. 'no information' ) then
                n(i,j) = 0
                f(i,j)= huge( 1.0d0 )
                g(i,j) = huge( 1.0d0 )
                totit(i,j) = 0
                fcnt(i,j) = 0
                gcnt(i,j) = 0
                hcnt(i,j) = 0
            else
                read(line, 8000) problem(i,j), sc(i,j), ierr(i,j), time(i,j), n(i,j), &
                f(i, j), g(i, j), totit(i, j), fcnt(i,j), gcnt(i,j), hcnt(i,j) 
            end if
            if (isnan(f(i, j))) then 
                f(i,j) = huge(1.0d0)
            end if 
        end do
    end do

    do j = 1, ntab
        close(10 + j)
    end do 

    do k = 1, ntab 
        do i = 1,num_lines
            do j = k+1,ntab
                if ( problem(i,k) .ne. problem(i,j) ) then
                    write(*,*) 'Error in the input file in problem: ', i, problem(i,k), problem(i,j)
                    stop
                end if
            end do
        end do 
    end do

    vec(0:13,1:ntab) = 0
    do i = 1, num_lines
        do j = 1,ntab
            if ( .not. ignore(i) ) then
                if ( sc(i,j) .eq. 99 ) then
                    vec(13,j) = vec(13,j) + 1
                else if ( sc(i,j) .eq. 20 ) then
                    vec(12,j) = vec(12,j) + 1
                else
                    if ( sc(i,j) .lt. 0 .or. sc(i,j) .gt. 11 ) then
                        write(*,*) 'Error: In problem ',problem(i,j),' istop = ',sc(i,j)
                    else
                        vec(sc(i,j),j) = vec(sc(i,j),j) + 1
                    end if
                end if
            end if
        end do
    end do

    cont(1:ntab) = 0
    do i = 1,num_lines
        do j = 1, ntab 
            if ( f(i,j) .le. - 1.0d+12 .and. sc(i,j) .ne. 0 .and. .not. ignore(i)) then 
                cont(j) = cont(j) + 1 
            end if
        end do
    end do

    write(*,*)
    write(*,*)
    write(*,*) 'Considering the ', num_lines, ' problems'
    write(*,*) namesalg(1),' and ', namesalg(2), ' stopped at the CPU time limit in', vec(13,1), ' and ', vec(13,2), ' problems'
    write(*,*) 'found a function value less than or equal to $-10^{12}$ in', cont(1), ' and ', cont(2), ' problems'
    write(*,*) 'and found a point with a gradient sup-norm less than or equal to 10^{-8} in ', vec(0,1),' and ', vec(0,2), &
    '  problems, respectively'
 
    write(*,*)
    write(*,*)
    write(*,*) 'Number of solutions equivalent to the best solution found by Algorithms~P and~T,'
    write(*,*) 'as a function of the tolerance $\ftol \in \{10^{-1}, 10^{-2} ,\dots,10^{-8}\}$, considering all'
    write(*,*) 'the 475 unconstrained problems and bound-constrained problems from the CUTest collection. '
    write(*,*)
    write(*,*) '            0.1  10^{-2}  10^{-3}  10^{-4}  10^{-5}  10^{-6}  10^{-7}  10^{-8}'

    if ( tableftol ) then 
        vec(0:13,1:ntab) = 0
        ftol = 0.1d0
        do k = 1, 8
            cont(1:ntab) = 0 
            countgeral    = 0
            do i = 1, num_lines
                fmin = minval ( f(i,1:ntab) )
                countgeral = countgeral + 1
                do j = 1, ntab
                    if ( (f(i,j) .LE. fmin + ftol * max(1.0d0, abs(fmin))) .or. f(i,j) .le. - 1.0d+12 ) then
                        cont(j) = cont(j) + 1
                    end if 
                end do 
            end do 

            do j = 1, ntab
                vec(k,j) = cont(j)
            end do
            ftol = ftol * 0.1d0 
        end do 

        do j = 1, ntab
            write(*,*)
            write(*,'(A11,2X)',advance='no') trim(namesalg(j))
            do k = 1,8
                if ( k .eq. 1 ) then 
                    write(*,'(I3,4X)',advance='no') vec(k,j)
                else
                    write(*,'(I3,6X)',advance='no') vec(k,j)
                end if
            end do
        end do
    end if

    if ( outpfgnuplot ) then 

    ftol = 0.1D0
    sizepf = 0
    do i = 1, num_lines
        cont(1:ntab) = 0
        fmin = minval ( f(i,1:ntab) )
        do j = 1, ntab
            if ( f(i,j) .LE. fmin + ftol * max( 1.0d0, abs(fmin) ) .or. f(i,j) .le. - 1.0d+12 ) then
                cont(j) = cont(j) + 1
            end if 
        end do

        if ( sum( cont(1:ntab) ) .eq. ntab ) then
        sizepf = sizepf + 1
        indpf(sizepf) = i
        end if    
    end do 

    write(*,*)
    write(*,*)
    write(*,*) 'Creating performance profile with ftol = ', ftol
    write(*,*) 'The number of problems considered for the performance profile is: ', sizepf

    if ( ncomp .eq. 1 ) then
        open(300,file='bgm2025fig1.dat')
    else if ( ncomp .eq. 2 ) then 
        open(300,file='bgm2025fig2.dat')
    end if

    indtau = 1
    tau = 1.0d0
    gama(1:ntab) = huge(1.0d0)
    exitpf = 0

    do while (.TRUE. .and. sizepf .gt. 0)
        cont(1:ntab) = 0

        do i=1,sizepf
            k = indpf(i)
            timemin = minval( time(k,1:ntab) )

            do j = 1, ntab
                if (time(k,j) .LE. tau*timemin) then 
                    cont(j) = cont(j) + 1
                end if 
            end do
        end do 

        gamaprev(1:ntab) = gama(1:ntab)
        gama(1:ntab) = cont(1:ntab) / real(sizepf,8)

        if ( all ( gama(1:ntab) .eq. gamaprev(1:ntab) ) ) then 
            countgeral = countgeral + 1 
        else
            countgeral = 0 
        end if

        if ( countgeral .le. 10 ) write(300,200) tau, gama(1:ntab)
        if ( all ( gama(1:ntab) .eq. gamaprev(1:ntab) ) ) then 
            exitpf = exitpf + 1 
        else
            exitpf = 0 
        end if
    
        if ( maxval( ( 1.0d0 - gama(1:ntab) ) ) .LT. 1.0d-4 .or. exitpf .GE. 1000000) then 
            exit 
        end if
        indtau = indtau + 1
        tau = tau + 0.1d0
    end do 
    taufin = tau + ( tau / 10.0d0 ) * 3 

    write(300,200) taufin, gama(1:ntab)
    close(300)

    if ( ncomp .eq. 1 ) then
        write(*,*)
        write(*,*) 'bgm2025fig1.dat created!'
    else if ( ncomp .eq. 2 ) then 
        write(*,*)
        write(*,*) 'bgm2025fig2.dat created!'
    end if
end if

    deallocate(namesalg,cont,problem,sc,ierr,time,n,f,g,fcnt,gcnt,hcnt,indpf,gama,gamaprev,totit,&
    ignore,comparable,vec,stat=allocerr)
    if ( allocerr .ne. 0 ) then
        write(*,*) 'deallocate error'
    end if
 
   200 format(F10.2,16(1X,F10.6))
   8000 format(1X,A10,1X,I2,1X,I3,0P,F12.6,1X,I6,1X,1P,D24.16,1X,1P,D7.1,4(1X,I8))

  end program extrairresultados