Télécharger prlagu.eso

Retour à la liste

Numérotation des lignes :

  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
  38. call zroots(a,mm,roots,ad,prog,mlree1.prog,mlree2.prog,kerre)
  39. if(kerre.ne.0) return
  40. if(iree.eq.1) then
  41. jg=0
  42. do 20 i=1,m
  43. if( abs(mlree2.prog(i)).gt.epss*abs(mlree1.prog(i))) go to 20
  44. jg=jg+1
  45. mlree1.prog(jg)=mlree1.prog(i)
  46. 20 continue
  47. segadj mlree1
  48. endif
  49. segdes mlree1,mlree2,mlreel
  50. mlreer=mlree1
  51. mlreei=mlree2
  52. segsup iroot
  53. return
  54. end
  55.  
  56.  
  57.  
  58.  
  59.  
  60.  
  61.  
  62.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales