program zeri ! The program computes the zeros of a polynomial implicit none real(16) :: x,a,b,x0 real(16), dimension(:), allocatable :: p integer :: n,k,ios,selettore character(7) :: nomefile="pol.dat" ! Apro il file pol.dat da cui leggo i dati open(unit=8,iostat=ios,file=nomefile,action="read") if (ios/=0) then write(*,'(a)') "Errore. Impossibile aprire il file ",nomefile stop end if ! Leggo il grado del polinomio e i suoi n+1 coefficienti read (8,*) n allocate (p(n+1)) do k=1,n+1 read (8,*) p(k) end do ! selettore sceglie l'esame da eseguire write(*,'(a)') "Scegli il metodo" write(*,'(a)') "1. Metodo della bisezione" write(*,'(a)') "2. Metodo delle secanti" write(*,'(a)') "3. Metodo di Newton" write(*,'(a)') "4. Metodo di Halley" read (*,*) selettore select case (selettore) case(1) write(*,'(a)',advance='no') "Inserisci gli estremi dell'intervallo " read (*,*) a,b call bisezione (n,p,a,b,x) case(2) write(*,'(a)',advance='no') "Inserisci gli estremi dell'intervallo " read (*,*) a,b call secanti (n,p,a,b,x) case(3) write(*,'(a)',advance='no') "Inserisci l'approssimazione iniziale " read (*,*) x0 call newton (n,p,x0) case(4) write(*,'(a)',advance='no') "Inserisci l'approssimazione iniziale " read (*,*) x0 call halley (n,p,x0) end select end program zeri subroutine bisezione (n,p,a,b,x) implicit none integer :: n,iter real(16) :: a,b,c,x,eps=1.q-32,fa,fb,fc,horner real(16),dimension(n) :: p fa=horner(n,p,a);fb=horner(n,p,b) if (fa*fb>0) then write(*,'(a,f7.3,a,f7.3,a)') "La funzione non ha zeri nell'intervallo [",a,",",b,"]" stop end if iter=0 do if (abs(b-a)=0) then a=c;fa=fc else b=c;fb=fc end if ! ! Stampo su schermo l'approssimazione al passo iter write (*,'(a,i3,a,f)') "Iterazione = ",iter," Radice = ",c end do x=c write (*,*) "Risultato con il metodo di bisezione" write (*,*) "Iterazioni = ",iter," Radice = ",x end subroutine bisezione subroutine secanti (n,p,a,b,x) implicit none integer :: n,iter real(16) :: a,b,c,x,eps=1.q-32,fa,fb,fc,horner real(16),dimension(n) :: p fa=horner(n,p,a);fb=horner(n,p,b) if (fa*fb>0) then write(*,'(a,f7.3,a,f7.3,a)') "La funzione non ha zeri nell'intervallo [",a,",",b,"]" stop end if iter=0 do if (abs(b-a)