Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap1_198111 - decus/20-0025/agamm.for
There is 1 other file named agamm.for in the archive. Click here to see a list.
00010	C   AGAMM.SRC   HFW   JULY 15, 1969   36
00020	C   EVALUATE THE INCOMPLETE GAMMA FUNCTION
00030	C   NEEDS GAMXX*
00040	      FUNCTION AGAMM(X,A)
00050	      F=0.
00060	      IF(X)4,2,6
00070	2     F=1.
00080	4     AGAMM=F
00090	      RETURN
00100	6     F=EXP(-X+A*ALOG(X))
00110	      ROLD=0.
00120	      T=0.
00130	      AL=0.
00140	      BL=1.
00150	      AR=1.
00160	      BR=X
00170	      DO 10 N=1,20
00180	      DO 8 M=1,5
00190	      T=T+1.
00200	      TM=T-A
00210	      AL=AL*TM+AR
00220	      BL=BL*TM+BR
00230	      AR=AR*T+AL*X
00240	      BR=BR*T+BL*X
00250	      RNEW=AR/BR
00260	      IF(ABS((ROLD/RNEW)-1.)-.000007)12,12,8
00270	8     ROLD=RNEW
00280	      BIG=AMAX1(ABS(AL),ABS(BL),ABS(AR),ABS(BR))
00290	      AL=AL/BIG
00300	      BL=BL/BIG
00310	      AR=AR/BIG
00320	10    BR=BR/BIG
00330	12    F=F*RNEW
00340	      F=1.-F/GAM(A)
00350	      GO TO 4
00360	      END