C PRLAGU SOURCE CHAT 05/01/13 02:28:14 5004 subroutine prlagu(mlreel,mlreer,mlreei,iree,kerre) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC SMLREEL -INC CCOPTIO segment iroot complex roots(ndim) complex ad(ndim) complex a(ndim) endsegment epss=1.e-14 segact mlreel m=prog(/1)-1 ndim=prog(/1) segini iroot * write(6,*) 'prog' ,(prog(i),i=1,prog(/1)) do 1 i=1,m+1 a(i)=cmplx(prog(i),0.) roots(i)=cmplx(0.,0.) 1 continue do 36 io=m+1,1,-1 if(abs(a(io)).eq.0.d0) then * write(6,*) ' descente du degré d un cran' m=m-1 else goto 37 endif 36 continue 37 continue ndim=m+1 jg=m segadj iroot segini mlree1,mlree2 * write(6,*) ' appel a zroots' mm=m call zroots(a,mm,roots,ad,prog,mlree1.prog,mlree2.prog,kerre) if(kerre.ne.0) return if(iree.eq.1) then jg=0 do 20 i=1,m if( abs(mlree2.prog(i)).gt.epss*abs(mlree1.prog(i))) go to 20 jg=jg+1 mlree1.prog(jg)=mlree1.prog(i) 20 continue segadj mlree1 endif segdes mlree1,mlree2,mlreel mlreer=mlree1 mlreei=mlree2 segsup iroot return end