Download prite1.eso

Back to the list

   1 : C PRITE1    SOURCE    BECC      09/11/18    21:15:09     6542           
   2 :       subroutine prite1(ncoef,Tmaxcv,acvtot,ether,t0,t,lognc,logipg)
   3 : c     
   4 :       integer i1, itmax, iter, ncoef
   5 :       real*8  Tmaxcv, acvtot(1:ncoef+1),  t0, t, ether, et0, deret0
   6 :      &       , epsi, puit, t1, t2, atot, dt, den
   7 :       parameter(epsi=1.0d-12,itmax=100)
   8 :       logical lognc, logcon, logipg
   9 : C
  10 : C     See conthe.eso
  11 : C
  12 :       logcon = .true.
  13 : c
  14 : c***  lognc, logipg deja initialize 
  15 : c
  16 :       t1 = t0
  17 :       iter = 0
  18 :       do while(logcon)
  19 : C        t2 = min (t1, Tmaxcv)
  20 :          t2 = 0.5d0 * ((t1 + Tmaxcv) - abs (t1 - Tmaxcv))
  21 :          deret0 = acvtot(1)
  22 :          et0 = deret0 * t2
  23 :          puit = 1.0d0
  24 :          do i1 = 2, ncoef+1, 1
  25 :             puit = puit * t2
  26 :             atot = acvtot(i1) * puit
  27 :             deret0 = deret0 + atot 
  28 :             atot = atot * t2 / i1
  29 :             et0 = et0 + atot
  30 :          enddo
  31 : C        t2 = max ((t1 - Tmaxcv),0)
  32 : C
  33 :          t2 = 0.5d0 * ((t1 - Tmaxcv) + abs (t1 - Tmaxcv))
  34 :          et0 = et0  + (deret0 * t2)
  35 : c
  36 : c******* anomalie si deret0 < 0
  37 : c        n.b. deret0 = cvtot
  38 : c     
  39 :          if(deret0 .le. 0.0d0)then
  40 :             logipg = .true.
  41 :             goto 9999
  42 :          endif
  43 :          den = ether - et0
  44 :          dt = den / deret0
  45 :          if((abs(dt) .le. (epsi * t1)) .and. 
  46 :      &      (abs(den) .le. (epsi * et0)))then
  47 :             logcon = .false.
  48 :             t = t1 + dt
  49 :          elseif(iter .gt. itmax)then
  50 :             lognc = .true.
  51 :             logcon = .false.
  52 :             t = t1 + dt
  53 :          else
  54 :             t1 = t1 + dt
  55 :             iter = iter + 1
  56 :          endif
  57 :       enddo
  58 : c
  59 : c**** visualisation des iterations 
  60 : c     on peut voir que la methode est tres efficace (3,4)
  61 : c      write(*,*) iter
  62 :  9999 continue
  63 :       return
  64 :       end
  65 :  

© Cast3M 2003 - All rights reserved.
Disclaimer