Sources Esope | Cast3M

cherac
C CHERAC    SOURCE    CHAT      11/05/24    21:15:03     6978
      subroutine cherac(mlreel,xraci,xva1,xva2)
      implicit real*8(a-h,o-z)
      implicit integer(i-n)
 
-INC PPARAM
-INC CCOPTIO
-INC SMLREEL
      if( xva1.GT.xva2) then
        call erreur(21)
        return
      endif
      segact mlreel
      n= prog(/1)-1
      c1 = prog(1)
      da = (xva2-xva1) /10000.d0
      aa= xva1
      ab= aa
      c2=c1
      do ib=1,n
        c2=c2 + ab * prog(1+ib)
        ab = ab * aa
      enddo
      zz=c2
      do 1 ia = 1, 10000
        c2 = c1
        aa=xva1+ ia * da
        ab=aa
        do ib=1,n
          c2 = c2 +  ab *prog(1+ib)
          ab=ab*aa
        enddo
        if( c2*zz .lt. 0.d0) then
*          write(6,*) ' on a trouve une valeur entre ',(aa - da ),aa
          go to 2
        endif
    1 continue
       xraci= -1234567.d0
      return
* on recommence entrze aa-da et aa
    2 continue
      do 10 itou=1,7
      xdep=aa-da
      dda = da / 10.D0
      do 3 ia = 0, 10
        c2 = c1
        aa=xdep+ ia * dda
        ab=aa
        do ib=1,n
          c2 = c2 +  ab *prog(1+ib)
          ab=ab*aa
        enddo
        if( c2*zz.lt. 0.d0) then
*          write(6,*) ' on a trouve une valeur entre ',(aa - dda ),aa
          go to 4
        endif
    3 continue
      write(6,*) ' pas de soultion trouvé pour deuxieme passage!'
      ierr=2
      return
   4  continue
      da = dda
   10 continue
      xraci = aa - dda / 2.d0
      return
      end