Télécharger cherac.eso

Retour à la liste

Numérotation des lignes :

  1. C CHERAC SOURCE CHAT 11/05/24 21:15:03 6978
  2. subroutine cherac(mlreel,xraci,xva1,xva2)
  3. implicit real*8(a-h,o-z)
  4. implicit integer(i-n)
  5. -INC CCOPTIO
  6. -INC SMLREEL
  7. if( xva1.GT.xva2) then
  8. call erreur(21)
  9. return
  10. endif
  11. segact mlreel
  12. n= prog(/1)-1
  13. c1 = prog(1)
  14. da = (xva2-xva1) /10000.d0
  15. aa= xva1
  16. ab= aa
  17. do ib=1,n
  18. c2=c2 + ab * prog(1+ib)
  19. ab = ab * aa
  20. enddo
  21. zz=c2
  22. do 1 ia = 1, 10000
  23. c2 = c1
  24. aa=xva1+ ia * da
  25. ab=aa
  26. do ib=1,n
  27. c2 = c2 + ab *prog(1+ib)
  28. ab=ab*aa
  29. enddo
  30. if( c2*zz .lt. 0.d0) then
  31. * write(6,*) ' on a trouve une valeur entre ',(aa - da ),aa
  32. go to 2
  33. endif
  34. 1 continue
  35. xraci= -1234567.d0
  36. return
  37. * on recommence entrze aa-da et aa
  38. 2 continue
  39. do 10 itou=1,7
  40. xdep=aa-da
  41. dda = da / 10.D0
  42. do 3 ia = 0, 10
  43. c2 = c1
  44. aa=xdep+ ia * dda
  45. ab=aa
  46. do ib=1,n
  47. c2 = c2 + ab *prog(1+ib)
  48. ab=ab*aa
  49. enddo
  50. if( c2*zz.lt. 0.d0) then
  51. * write(6,*) ' on a trouve une valeur entre ',(aa - dda ),aa
  52. go to 4
  53. endif
  54. 3 continue
  55. write(6,*) ' pas de soultion trouvé pour deuxieme passage!'
  56. ierr=2
  57. return
  58. 4 continue
  59. da = dda
  60. 10 continue
  61. xraci = aa - dda / 2.d0
  62. return
  63. end
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  

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