Download primi0.eso

Back to the list

   1 : C PRIMI0    SOURCE    CHAT      05/01/13    02:27:02     5004           
   2 :       subroutine primi0
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8(A-H,O-Z)
   5 : -INC CCOPTIO
   6 : -INC SMLREEL
   7 : -INC SMEVOLL
   7 :       call lirobj('EVOLUTIO',mevol1,1,iret)
   8 :       if(ierr.ne.0) return
   9 :       segini,mevoll=mevol1
  10 :       n=ievoll(/1)
  11 :       do 1 i=1,n
  12 :       kevol1 = ievoll(i)
  13 :       segini,kevoll=kevol1
  14 :       ievoll(i)=kevoll
  15 :       if(typx.ne.'LISTREEL'.or.typy.ne.'LISTREEL')  go to 1
  16 :       mlreel=iprogx
  17 :       mlree1=iprogy
  18 :       segini,mlree2=mlreel
  19 :       segini,mlree3=mlree1
  20 :       iprogx=mlree2
  21 :       iprogy=mlree3
  22 :       b=mlree2.prog(1)
  23 :       S = 0.d0
  24 :       do 2 j=2,mlree2.prog(/1)
  25 :       a= mlree2.prog(j)
  26 :       if(B.gt.a) go to 1000
  27 :       sp=(mlree3.prog(j)+mlree3.prog(j-1))*(a-b)/2.d0
  28 :       mlree3.prog(j-1)=s
  29 :       s = s + sp
  30 :       b = a 
  31 :     2 continue
  32 :       mlree3.prog(mlree3.prog(/1))=s
  33 :       segdes mlree2,mlree3, kevoll
  34 :     1 continue
  35 :       segdes mevoll
  35 :       call ecrobj('EVOLUTIO',mevoll)
  36 :       return
  36 :  1000 call erreur(872)
  37 :       segdes mevoll,kevoll,mlree2,mlree3
  38 :       return
  39 :       end 
  40 :  
  41 :  

© Cast3M 2003 - All rights reserved.
Disclaimer