Sources Esope | Cast3M

prlagu
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 PPARAM
-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