Esope source files

   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
   7 :         call erreur(21)
   8 :         return
   9 :       endif
  10 :       segact mlreel 
  11 :       n= prog(/1)-1
  12 :       c1 = prog(1)
  13 :       da = (xva2-xva1) /10000.d0
  14 :       aa= xva1
  15 :       ab= aa
  16 :       c2=c1
  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 :