Esope source files

   1 : C PRLAGU    SOURCE    CHAT      05/01/13    02:28:14     5004           
   2 :       subroutine prlagu(mlreel,mlreer,mlreei,iree,kerre)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : -INC SMLREEL
   6 : -INC CCOPTIO
   7 :       segment iroot
   8 :          complex roots(ndim)
   9 :          complex ad(ndim)
  10 :          complex  a(ndim) 
  11 :       endsegment 
  12 :       epss=1.e-14    
  13 :       segact mlreel
  14 :       m=prog(/1)-1
  15 :       ndim=prog(/1)
  16 :       segini iroot
  17 : *      write(6,*) 'prog' ,(prog(i),i=1,prog(/1))
  18 : 
  19 :       do 1 i=1,m+1     
  20 :       a(i)=cmplx(prog(i),0.)
  21 :       roots(i)=cmplx(0.,0.)
  22 :    1  continue
  23 :       do 36 io=m+1,1,-1
  24 :       if(abs(a(io)).eq.0.d0) then
  25 : *      write(6,*) ' descente du degré d un cran'
  26 :        m=m-1
  27 :        else
  28 :         goto 37
  29 :       endif
  30 :    36 continue
  31 :    37 continue
  32 :       ndim=m+1
  33 :       jg=m
  34 :       segadj iroot
  35 :       segini mlree1,mlree2  
  36 : *       write(6,*) ' appel a zroots' 
  37 :       mm=m    
  37 :       call zroots(a,mm,roots,ad,prog,mlree1.prog,mlree2.prog,kerre)
  38 :       if(kerre.ne.0) return
  39 :       if(iree.eq.1) then
  40 :       jg=0
  41 :       do 20 i=1,m
  42 :         if( abs(mlree2.prog(i)).gt.epss*abs(mlree1.prog(i))) go to 20
  43 :         jg=jg+1
  44 :         mlree1.prog(jg)=mlree1.prog(i)
  45 :    20 continue
  46 :       segadj mlree1
  47 :       endif        
  48 :       segdes mlree1,mlree2,mlreel
  49 :       mlreer=mlree1
  50 :       mlreei=mlree2
  51 :       segsup iroot
  52 :       return
  53 :       end
  54 : 
  55 :        
  56 : 
  57 : 
  58 :  
  59 :  
  60 :