INTEGER TOT,RIEN,W
DOUBLE PRECISION FP,Z,AI
DOUBLE PRECISION R,RR,RRR,Y,HY,X,HX,T,B,C,E,F,FF,TP,CP,RP
DOUBLE PRECISION
1 L,LL,HL,HLL,LP,HLP,AM,SM
DOUBLE PRECISION
1 S(0/3000),BOB(0/19),DIX(10),HDIX(10),ZD,RD,YD,HYD,YOYO
DOUBLE PRECISION A(0/3000)
INTEGER MAN
COMMON S,A,L,LL,R,RR,RRR,Y,HY,YD,HYD,HL,HLL,X,HX,I,J,M,MAN,T,B,C,E
1,F,FF,FRACTION,SOMME,TP,CP,LP,HLP,RP,MI,W,AM,SM
HYD=HY=-(Y=YD=1.E10); Z=ZD=1.E-2 ; YOYO=1.E11
999 READ(5,20)M
READ(5,20)MORT
20 FORMAT(I)
MI=(M=10+10*(M/10))-1 ; K=M*10; A(0)=S(0)=3.2E10
12 FORMAT(1H1,50X,'CALCUL DE PI AVEC ',I,'DECIMALES'////)
DO 21 I=1,MI
21 S(I)=A(I)=0.E0 ; W=1 ; AM=SM=0.E0
HL=3.E0 ; HX=-15625.E0 ; X=15625.E0 ; T=-25.E0 ; TP=25.E0
23 IF(A(W-1).EQ.0.E0) W=W+1
89 IF((MAN=((LP=-(HLP=(HLL=-(LL=(L=-(HL=HL-6.E0))+2.E0))-2.E0))+19.E0
1)/10.E0).GE.M) GO TO 200
R=Y*(HX*(AI=A(W-1)=AINT((E=A(W-1))/X))+E)
RR=Y*(HL*(B=AINT(AI/L))+AI)
RRR=Y*(HLL*(C=AINT(AI/LL))+AI)
RP=Y*(HLP*(CP=AINT(AI/LP))+AI)
S(W-1)=S(W-1)+(T*B+C)*TP-CP
DO 7 I=W,MAN
R=Y*(HX*(A(I)=AI=AINT((E=A(I)+R)/X))+E)
RR=Y*(HL*(B=AINT((F=AI+RR)/L))+F)
RRR=Y* (HLL*(C=AINT((FF=AI+RRR)/LL))+FF)
RP=Y*(HLP*(CP=AINT((FP=AI+RP)/LP))+FP)
7 S(I)=S(I)+(T*B+C)*TP-CP
DO 70 I=MAN+1,MI
RR=Y*(HL*(B=AINT(RR/L))+RR)
RRR=Y*(HLL*(C=AINT(RRR/LL))+RRR)
RP=Y*(HLP*(CP=AINT(RP/LP))+RP)
70 S(I)=S(I)+(T*B+C)*TP-CP
C=AINT( RRR /LL) ; CP=AINT( RP /LP)
S M =S M +(T*AINT( RR /L)+C)*TP-CP
236 IF(A(W-1).EQ.0.E0) W=W+1
896 IF((MAN=((LP=-(HLP=(HLL=-(LL=(L=-(HL=HL-6.E0))+2.E0))-2.E0))+19.E0
1)/10.E0).GE.M) GO TO 201
R=Y*(HX*(AI=A(W-1)=AINT((E=A(W-1))/X))+E)
RR=Y*(HL*(B=AINT(AI/L))+AI)
RRR=Y*(HLL*(C=AINT(AI/LL))+AI)
RP=Y*(HLP*(CP=AINT(AI/LP))+AI)
S(W-1)=S(W-1)+(T*B+C)*T+CP
DO 76 I=W,MAN
R=Y*(HX*(A(I)=AI=AINT((E=A(I)+R)/X))+E)
RR=Y*(HL*(B=AINT((F=AI+RR)/L))+F)
RRR=Y* (HLL*(C=AINT((FF=AI+RRR)/LL))+FF)
RP=Y*(HLP*(CP=AINT((FP=AI+RP)/LP))+FP)
76 S(I)=S(I)+(T*B+C)*T+CP
DO 760 I=MAN+1,MI
RR=Y*(HL*(B=AINT(RR/L))+RR)
RRR=Y*(HLL*(C=AINT(RRR/LL))+RRR)
RP=Y*(HLP*(CP=AINT(RP/LP))+RP)
760 S(I)=S(I)+(T*B+C)*T+CP
C=AINT( RRR /LL) ; CP=AINT( RP /LP)
S M =S M +(T*AINT( RR /L)+C)*T+CP
GO TO 23
200 R=Y*(HX*(AI=A(W-1)=AINT((E=A(W-1))/X))+E)
RR=Y*(HL*(B=AINT(AI/L))+AI)
RRR=Y*(HLL*(C=AINT(AI/LL))+AI)
RP=Y*(HLP*(CP=AINT(AI/LP))+AI)
S(W-1)=S(W-1)+(T*B+C)*TP-CP
DO 701 I=W,MI
R=Y* (HX*(A(I)=AI=AINT((E=A(I)+R)/X))+E)
RR=Y* (HL*(B=AINT((F=AI+RR)/L))+F)
RRR=Y* (HLL*(C=AINT((FF=AI+RRR)/LL))+FF)
RP=Y*(HLP*(CP=AINT((FP=AI+RP)/LP))+FP)
701 S(I)=S(I)+(T*B+C)*TP-CP
C=AINT(((AM =AINT((A M +R)/X))+RRR)/LL) ; CP=AINT((AM+RP)/LP)
S M =S M +(T*AINT((AM+RR)/L)+C)*TP-CP
300 IF(A(W-1).NE.0.E0) GO TO 890
IF(W.EQ.M) GO TO 2500
W=W+1
890 HLP=-(LP=( LL=-(HLL=(HL=-(L=L+6.E0))-
12.E0))+2.E0)
201 R=Y*(HX*(AI=A(W-1)=AINT((E=A(W-1))/X))+E)
RR=Y*(HL*(B=AINT(AI/L))+AI)
RRR=Y*(HLL*(C=AINT(AI/LL))+AI)
RP=Y*(HLP*(CP=AINT(AI/LP))+AI)
S(W-1)=S(W-1)+(T*B+C)*T+CP
DO 7016 I=W,MI
R=Y* (HX*(A(I)=AI=AINT((E=A(I)+R)/X))+E)
RR=Y* (HL*(B=AINT((F=AI+RR)/L))+F)
RRR=Y* (HLL*(C=AINT((FF=AI+RRR)/LL))+FF)
RP=Y*(HLP*(CP=AINT((FP=AI+RP)/LP))+FP)
7016 S(I)=S(I)+(T*B+C)*T+CP
C=AINT(((AM =AINT((A M +R)/X))+RRR)/LL) ; CP=AINT((AM+RP)/LP)
S M =S M +(T*AINT((AM+RR)/L)+C)*T+CP
3006 IF(A(W-1).NE.0.E0) GO TO 8906
IF(W.EQ.M) GO TO 2510
W=W+1
8906 HLP=-(LP=( LL=-(HLL=(HL=-(L=L+6.E0))-
12.E0))+2.E0)
GO TO 200
2500 LP=(LL=(L=L+6.E0)+2.E0)+2.E0
C=AINT((AM =AINT(A M /X))/LL) ; CP=AINT(AM/LP)
S M =S M +(T*AINT(AM/L)+C)*T+CP
2501 IF(AM.EQ.0.E0)GO TO 25
LP=(LL=(L=L+6.E0)+2.E0)+2.E0
C=AINT((AM =AINT(A M /X))/LL) ; CP=AINT(AM/LP)
S M =S M +(T*AINT(AM/L)+C)*TP-CP
IF(AM.EQ.0.E0)GO TO 25
LP=(LL=(L=L+6.E0)+2.E0)+2.E0
C=AINT((AM =AINT(A M /X))/LL) ; CP=AINT(AM/LP)
S M =S M +(T*AINT(AM/L)+C)*T+CP
GO TO 2501
2510 LP=(LL=(L=L+6.E0)+2.E0)+2.E0
C=AINT((AM =AINT(A M /X))/LL) ; CP=AINT(AM/LP)
S M =S M +(T*AINT(AM/L)+C)*TP-CP
2511 IF(AM.EQ.0.E0) GO TO 25
LP=(LL=(L=L+6.E0)+2.E0)+2.E0
C=AINT((AM =AINT(A M /X))/LL) ; CP=AINT(AM/LP)
S M =S M +(T*AINT(AM/L)+C)*T+CP
IF(AM.EQ.0.E0)GO TO 25
LP=(LL=(L=L+6.E0)+2.E0)+2.E0
C=AINT((AM =AINT(A M /X))/LL) ; CP=AINT(AM/LP)
S M =S M +(T*AINT(AM/L)+C)*TP-CP
GO TO 2511
9200 S M =S M +AINT((AM=AINT(A M /X))/L)
9201 IF(AM.EQ.0.E0)GO TO 92
L=L+2.E0
S M =S M -AINT((AM=AINT(A M /X))/L)
IF(AM.EQ.0.E0)GO TO 92
L=L+2.E0
S M =S M +AINT((AM=AINT(A M /X))/L)
GO TO 9201
9210 S M =S M -AINT((AM=AINT(A M /X))/L)
9211 IF(AM.EQ.0.E0)GO TO 92
L=L+2.E0
S M =S M +AINT((AM=AINT(A M /X))/L)
IF(AM.EQ.0.E0)GO TO 92
L=L+2.E0
S M =S M -AINT((AM=AINT(A M /X))/L)
GO TO 9211
25 R=4.E10; HX=-239.E0 ; X=239.E0
DO 502 I=0,MI
R=Y*(HX*(A(I)=AINT(R/X))+R)
502 S(I)=S(I)-A(I)
S M =S M -(A M =AINT(R/X))
L=1.E0 ; HX=-57121.E0 ; X=57121.E0 ; W=1
10 HL=-(L=L+2.E0)
30 IF(A(W-1).NE.0.E0) GO TO 91
IF(W.EQ.M) GO TO 9200
W=W+1
91 R=Y*(HX*(A(W-1)=AI=AINT((E=A(W-1))/X))+E)
RR=Y*(HL*(B=AINT(AI/L))+AI)
S(W-1)=S(W-1)+B
DO 1000 I=W,MI
R=Y* (HX*(A(I)=AI=AINT((E=A(I)+R)/X))+E)
RR=Y*(HL*(B=AINT((F=A I +RR)/L))+F)
1000 S(I)=S(I)+B
S M =S M +AINT(((A M =AINT((A M +R)/X))+RR)/L)
HL=-(L=L+2.E0)
1 IF(A(W-1).NE.0.E0) GO TO 2
IF(W.EQ.M) GO TO 9210
W=W+1
2 R=Y*(HX*(A(W-1)=AI=AINT((E=A(W-1))/X))+E)
RR=Y*(HL*(B=AINT(AI/L))+AI)
S(W-1)=S(W-1)-B
DO 1001 I=W,MI
R=Y* (HX*(A(I)=AI=AINT((E=A(I)+R)/X))+E)
RR=Y* (HL*(B=AINT((F=AI+RR)/L))+F)
1001 S(I)=S(I)-B
S M =S M -AINT(((A M =AINT((A M +R)/X))+RR)/L)
GO TO 10
92 S(I=M)=SM ; M=MI
35 IF(S(I).LT.0.E0)GO TO 37
S(I)=(RD=AINT(S(I)/YD))*HYD+S(I)
IF((I=I-1).LT.0)GO TO 42
S(I)=S(I)+RD ; GO TO 35
37 S(I)=YD*(RD=AINT(1+(S(I)/HYD)))+S(I)
IF((I=I-1).LT.0)GO TO 42
S(I)=S(I)-RD ; GO TO 35
42 DO 10002 JIN=1,MORT
WRITE(6,12)K
DO 810 KIM=0, 9
810 BOB(KIM)=S(KIM)+YOYO
WRITE(6,49)RD,(BOB(KOM),KOM=0, 9)
49 FORMAT(13X,I1,1H,,10(I10,1X))
DO 52 I=10,M,10
DO811KIM=0, 9
811 BOB(KIM )=S(I+KIM)+YOYO
WRITE(6,53)(BOB(KOM),KOM=0, 9)
53 FORMAT(15X,10(I10,1X))
52 CONTINUE
10002 CONTINUE
GO TO 999
END
Copyright © Jean-François COLONNA, 2022-2024.
Copyright © CMAP (Centre de Mathématiques APpliquées) UMR CNRS 7641 / École polytechnique, Institut Polytechnique de Paris, 2022-2024.