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.