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