Trailing-Edge
-
PDP-10 Archives
-
decus_20tap1_198111
-
decus/20-0025/polyc.for
There is 1 other file named polyc.for in the archive. Click here to see a list.
00100 SUBROUTINE POLYC(RR,CR,NARG,A)
00110 DIMENSION RR(100),CR(100),A(3),B(3),Q(26)
00120 J=1
00130 IF (CR(J)) 10, 20, 10
00140 10 NA=3
00150 A(1)=RR(J)**2+CR(J)**2
00160 A(2)=-2.*RR(J)
00170 A(3)=1.
00180 J=J+2
00190 GO TO 29
00200 20 NA=2
00210 A(1)=-RR(J)
00220 A(2)=1.
00230 J=J+1
00240 29 IF (J-NARG) 30, 30, 1000
00250 30 IF (CR(J)) 40, 60, 40
00260 40 NB=3
00270 B(1)=RR(J)**2+CR(J)**2
00280 B(2)=-2.*RR(J)
00290 B(3)=1.
00300 J=J+2
00310 GO TO 80
00320 60 NB=2
00330 B(1)=-RR(J)
00340 B(2)=1.
00350 J=J+1
00360 80 NC=NA+NB-1
00370 DO 120 I=1,NC
00380 TEMP=0.0
00390 DO 110 JP=1,I
00400 IF (JP-NA) 90, 90, 110
00410 90 N2=I-JP+1
00420 IF (N2-NB) 100, 100, 110
00430 100 TEMP=TEMP+A(JP)*B(N2)
00440 110 CONTINUE
00450 Q(I)=TEMP
00460 120 CONTINUE
00470 NA=NA+NB-2
00480 NAPL1=NA+1
00490 DO 130 I=1,NAPL1
00500 130 A(I)=Q(I)
00510 IF (NA-NARG) 140, 1000, 1000
00520 140 NA=NA+1
00530 GO TO 30
00540 1000 END