Google
 

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