Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-01 - decus/20-0025/gauss.for
There are 3 other files named gauss.for in the archive. Click here to see a list.
C	THE PROGRAM GAUSSD.F4 IS A SAMPLE PROGRAM, WHEN USED IN
C	CONJUNCTION WITH GAUSS(LOADED AND SAVED AS GAUSSD.SAV)
C	WILL PRODUCE A RUNNING EXAMPLE OF THE USE OF GAUSS.
	FUNCTION GAUSSQ(NARG,FUNC,A,B)
          DIMENSION U(19),H(19),IV(19),TCEL(8)
1	N=MAX0(2,MIN0(8,NARG))
          GOTO (5001,22,23,24,25,26,27,28),N
22	IV(2)=1
          IV(3)=2
          U(1)=.28867513
          H(1)=.5
          GO TO 101
23	IV(3)=2
          IV(4)=4
          U(2)=0.
          U(3)=.38729833
          H(2)=.44444445
          H(3)=.27777778
          GO TO 101
24	IV(4)=4
          IV(5)=6
          U(4)=.16999052
          U(5)=.43056816
          H(4)=.32607258
          H(5)=.17392742
          GOTO 101
25	IV(5)=6
          IV(6)=9
          U(6)=0.
          U(7)=.26923466
          U(8)=.45308992
          H(6)=.28444444
          H(7)=.23931434
          H(8)=.11846344
          GO TO 101
26	IV(6)=9
          IV(7)=12
          U(9)=.11930959
          U(10)=.33060469
          U(11)=.46623476
          H(9)=.23395697
          H(10)=.18038079
          H(11)=.08566225
          GOTO 101
27	IV(7)=12
          IV(8)=16
          U(12)=0.
          U(13)=.20292258
          U(14)=.37076559
          U(15)=.47455396
          H(12)=.20897959
          H(13)=.19091503
          H(14)=.13985270
          H(15)=.06474248
          GOTO 101
28	IV(8)=16
          IV(9)=20
          U(16)=.09171732
          U(17)=.26276620
          U(18)=.39833324
          U(19)=.48014493
          H(16)=.18134189
          H(17)=.15685332
          H(18)=.11119052
          H(19)=.05061427
101	M1=IV(N)
          M2=IV(N+1)-1
201	I=1
          J=M1
221	V=U(J)
241	T=(B-A)*V+(A+B)/2.0
          TCEL(I)=FUNC(T)
          IF (I-N) 251,401,401
251	I=I+1
          IF (V) 261,261,256
256	V=-V
          GOTO 241
261	J=J+1
          GOTO 221
401	IF (U(M1)) 5001,441,421
421	S=H(M1)* (TCEL(1)+TCEL(2))
          J=3
          IF (J-N) 461,461,491
441	S=H(M1)*TCEL(1)
          J=2
461	I=M1+1
          DO 481 J1=I,M2
          S=S+H(J1)*(TCEL(J)+TCEL(J+1))
481	J=J+2
491	GAUSSQ=(B-A)*S
5001	RETURN
           END