Trailing-Edge
-
PDP-10 Archives
-
decuslib10-01
-
43,50144/dvalg.f4
There are no other files named dvalg.f4 in the archive.
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