Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap1_198111 - decus/20-0025/dvalg.for
There is 1 other file named dvalg.for in the archive. Click here to see a list.
00100	      SUBROUTINE DVALG(AARG,NAARG,BARG,NBARG,QARG,R,NRARG,TE
00110	     + ST)
00120		DIMENSION AARG(100),BARG(100),QARG(100)
00121		DIMENSION A(26),B(26),Q(25),R(100)
00122	C	DIVISION OF POLYNOMIAL A BY POLYNOMIAL B
00130	1     NA=NAARG
00140	      NB=NBARG
00150	      NAPL1=NA+1
00160	      NBPL1=NB+1
00170	      DO 21 J1=1,NAPL1
00180	21    A(J1)=AARG(J1)
00190	      DO 41 J1=1,NBPL1
00200	41    B(J1)=BARG(J1)
00210		NU = NA - NB + 1
00220		DO 61 J1 = 1,NU
00230	61    Q(J1)=0.
00250		DO 391 KK = 1,NU
00260	      K=KK-1
00270	201   TEMP=0.
00280	      IF (K-1)  301, 211, 211
00290	211   DO 291 JJ=1,K
00300	      J=JJ-1
00310	      I1=NB-K+J
00320	      IF (I1)  291, 221, 221
00330	221   I2=NA-NB-J
00340	      TEMP=TEMP+B(I1+1)*Q(I2+1)
00350	291   CONTINUE
00360	301   I1=NA-NB-K
00370	      I2=NA-K
00380	      Q(I1+1)=(A(I2+1)-TEMP)/B(NB+1)
00390	391   CONTINUE
00400	C	COMPUTE RESIDUALS
00410		DO 691 KK = 1,NB
00420		K = KK - 1
00430		TEMP = 0.
00440		DO 591 JJ = 1,KK
00450		J = JJ - 1
00460		I1 = K - J
00470		IF(I1 - (NA-NB))511,511,591
00480	  511	TEMP = TEMP + B(J+1)*Q(I1+1)
00490	  591	CONTINUE
00500		R(K+1) = A(K+1) - TEMP
00510	  691	CONTINUE
00520	C	DEGREE OF REMAINDER
00530		RMAX = 0.
00540		DO 721 J1 = 1,NB
00550	  721	RMAX = AMAX1(RMAX,ABS(R(J1)))
00560		IF(RMAX-TEST)731,731,761
00570	  731	DO 741 J1 = 1,NB
00580	  741	R(J1) = 0.
00590	  761	NR = 0
00600		DO 781 J1 = 1,NB
00610		IF(ABS(R(J1))-TEST)781,771,771
00620	  771	NR = J1
00630	  781	CONTINUE
00640		NRARG = MAX0(NR-1,0)
00650		DO 821 J1 = 1,NU
00660	  821	QARG(J1) = Q(J1)
00670		RETURN
00680		END