program divisione di polinomi implicit none double precision p0(0:100), p1(0:100), p2(0: 100), pq(0:100) integer gp0, gp1, gp2, gpq, cont, ginz integer sign, sign1, sign2, sign3, sign4, i, j integer v1, v2, v3, v4, s1, s2, s3, s4 gp0 = 8 ginz = gp0 gp1 = gp0 - 1 gp2 = gp0 - 2 gpq = gp0 - 2 if(gp0 .gt. 100)then write(6,*) 'Internal error: si sta\' provando con un grado troppo' write(6,*) 'ELEVATO' endif write(6,*) 'Programma per la divisione di polinomi:' call initPol(p0, gp0) call derivataPrima(p0,gp0, p1) call altroDividi(p0, gp0, p1, gp1, p2, gp2) return stop end subroutine altroDividi(p0, g0, p1, g1, p3, g3 ) implicit none integer g0, g1, g3, i, j double precision p0(0:100), p1(0:100), p2(0:100), p3(0:100) integer g2 if(g0 .ne. g1+1) then write(6,*) '@L50 suspcious number' g1 = g0 - 1 endif g2 = g0-g1 g3 = g0 do i=0, g0 P3(i) = p0(i) enddo do i=0, g2 p2(i) = 0 enddo do i=g2, 0, -1 if(p1(g1) .ne. 0) then p2(i) = p3(g3)/p1(g1) DO J = g1, 0, -1 p3(i+j) = p3(i+j) - p2(i)*p1(j) enddo g3 = g3 - 1 endif enddo call autotest(p0, g0, p1, g1, p2, g2, p3, g3) end subroutine copiaPol(pi, po, g) implicit none integer g,i double precision pi(0:g), po(0:g) do i=0, g po(i)=pi(i) enddo return end subroutine derivataPrima(pol, gp, der) implicit none integer gp,i double precision pol(0:gp), der(0: gp-1) do i=0,gp-1 der(i) = pol(i+1)*(i+1) enddo return end subroutine autotest(p1,l1, p2,l2, p3,l3, p4,l4) implicit none integer l1,l2,l3,l4 double precision p1(0:l1), p2(0:l2), p3(0:l3), p4(0:l4) double precision t(0:l1) integer i,j do i=0,l1 t(i) = 0. enddo do i=0,l2 doj=0,l3 t(i+j) = t(i+j)+p2(i)*p3(j) enddo enddo do i=0, l4 t(i) = t(i)+p4(i) enddo write(6,*) '\np(1) =' call stampaPol(p1, l1) write(6,*) '\np2 = ' call stampaPol(p2,l2) write(6,*) '\np1(1)/p2(2) = p(3) =' call stampaPol(p3, l3) write(6,*) '\nresto = p4 = ' call stampaPol(p4,l4) write(6,*) '\npol rifatto per prova ' write(6,*) 'p(2) * p(3) + p(4) = \n' call stampaPol(t,l1) return end subroutine stampaPol(p,g) implicit none integer g,i double precision p(0:g) do i=g,0,-1 write(6,*)'x^', i, p(i) enddo return end subroutine initPol(pol1, gp) implicit none integer i,gp double precision pol1(0:gp) open(5, file = 'polinomio.dat', status = 'old') do i=gp, 0, -1 read(5,*) pol1(i) enddo close(5) return end