PDP-10 Archive: decus/20-0025/errlt.for from decuslib20-01

Trailing-Edge - PDP-10 Archives - decuslib20-01 - decus/20-0025/errlt.for

There is 1 other file named errlt.for in the archive. Click here to see a list.

C ***PROGRAM TO EVALUATE THE ERROR FUNCTION AND ITS COMPLEMENT
      FUNCTION ERR(W)
      DIMENSION A(25),B(30)
      M=24
      A(1)=16443152242714E-13
      A(2)=-9049760497548E-13
      A(3)= 0643570883797E-13
      A(4)= 0196418177368E-13
      A(5)=-0001244215694E-13
      A(6)=-0009101941905E-13
      A(7)=-0001796219835E-13
      A(8)= 0000139836786E-13
      A(9)=     164789417E-13
      A(10)=     39009267E-13
      A(11)=-   00893145E-13
      A(12)=-   03747896E-13
      A(13)=-   01298818E-13
      A(14)=-00136773E-13
      A(15)=     00077107E-13
      A(16)=     00046810E-13
      A(17)=     00011844E-13
      A(18)=-       0005E-13
      A(19)=-       1384E-13
      A(20)=-       0652E-13
      A(21)=         0145E-13
      A(22)=         0010E-13
      A(23)=         0024E-13
      A(24)=         0011E-13
      A(25)=         0002E-13
      X=ABS (W)
      IF (ABS (X)-.01)  1, 2, 2
1     XERR=2.0/(3.0*1.77245385)*X*(3.0-X**2)
      GO TO 6
2     Z=(X-1.0)/(X+1.0)
      DO 3 I=1,30
      B(I)=0.
3     CONTINUE
      DO 4 I=1,M
      M1=(M+1)-I
      B(M1)=2.0*Z*B(M1+1)-B(M1+2)+A(M1+1)
4     CONTINUE
      F=-B(2)+Z*B(1)+.5*A(1)
      XERR=1.0-(1.0/1.77245385)*(EXP (-(X**2)))*F
      IF (ABS (X)-.01)  6, 7, 7
6     CERR=1.0-XERR
      GO TO 5
7     CERR=(1.0/1.77245385)*(EXP (-(X**2)))*F
5     IF (W)  9, 8, 8
8     ERR=XERR
      GO TO 13
9     ERR=CERR
13	RETURN
	END