COMPLEX CMPLX,VALUE,ZDEL,Z1(25),VO(5),VB(25),Z(10,10),ZT(10,10) COMPLEX CN(10),VALD,P,VN(10),CNS(10),V(25),Z2(25) INTEGER A(25,2),LRC(25),KOL(25),S(10),AT(10,10),KOR(25) INTEGER BT(10,10),O(5),O6,O7,CHAR,TAB(12) REAL FMT1(5),FMT2(5),FMT3(5),FMT4(3),FMT5(4),FMT6(4) BYTE BUF(72) LOGICAL ERROR,BRANC,LOOP,ST(25) COMMON /BUFFER/ BUF(72) /BRANCH/ NB /TREE/ NO,A(25,2) DATA Z/100*(0.0,0.0)/,VN/10*(0.0,0.0)/,Z1/25*(0.0,0.0)/ DATA CNS/10*(0.0,0.0)/,V/25*(0.0,0.0)/,ZT/100*(0.0,0.0)/ DATA S/10*0/,AT/100*0/,BT/100*0/,LI/0/,ID/0/,IF/-1/,O6/0/ DATA IV/0/,IB/1/,I/0/,O/5*0/,LC/0/,LRC/25*0/ DATA TAB/'S','T','M','K','F','D','O','E','V','C','R','L'/ DATA ST/25*.FALSE./ DATA FMT1 /'(A1,','I2,I','2,I2',',F10','.0) '/ DATA FMT2 /'(A1,','I2,F','10.0',',F10','.0) '/ DATA FMT3 /'(I2,','I2,F','10.0',',F10','.0) '/ DATA FMT4 /'(I2,','F10.','0) '/ DATA FMT5 /'(F10','.0,F','10.0',') '/ DATA FMT6 /'(I2,','I2,I','2,I2',') '/ CALL SETERR(6,-1) CALL SETERR(3,-1) 100 WRITE (5,4000) 4000 FORMAT (10(' *'),' ECAP',10(' *'),/' ENTER OPTION',/' ') 101 CALL ALINE(FMT1) DECODE (3,FMT1,BUF) CHAR,NB IF (ERROR(L)) GO TO 101 102 IF (CHAR.EQ.'N') GO TO 104 WRITE (5,9000) 9000 FORMAT (' ***ERROR*** NETWORK OPTION MUST BE USED FIRST',/' ') GO TO 101 104 IF (NB.GT.0.AND.NB.LE.25) GO TO 103 WRITE (5,8900) 8900 FORMAT (' ***ERROR*** ILLEGAL NUMBER OF BRANCHES',/' ') GO TO 101 103 WRITE (5,9100) 9100 FORMAT (' NETWORK OPTION',/' ') ASSIGN 131 TO JUMP 105 I=I+1 110 CALL ALINE (FMT1) DECODE (17,FMT1,BUF) CHAR,L1,K3,K4,VAL1 IF (ERROR(L)) GO TO 110 133 IF (BRANC(L1)) GO TO 110 114 IF (K3.GT.0.AND.K4.GT.0.AND.K3.LE.10.AND.K4.LE.10) GO TO 111 WRITE (5,9900) 9900 FORMAT (' ***ERROR*** ILLEGAL NODE NUMBER',/' ') GO TO 110 111 DO 112 J=1,3 IF (TAB(J+9).EQ.CHAR) GO TO (115,120,125),J 112 CONTINUE WRITE (6,9200) 9200 FORMAT (' ***ERROR*** ONLY L R C CAN BE USED',/' ') GO TO 110 115 VALUE=CMPLX(0.0,-1.0E+2/VAL1) GO TO 126 120 VALUE=CMPLX(1.0E+3*VAL1,0.0) IF (LRC(L1).NE.0) LC=LC-1 GO TO 130 125 VALUE=CMPLX(0.0,VAL1*1.0E+1) 126 IF (LRC(L1).EQ.0) LC=LC+1 130 LRC(L1)=J-2 GO TO JUMP 131 Z1(L1)=VALUE A(L1,1)=K3 A(L1,2)=K4 IF (I.LT.NB) GO TO 105 NO=0 175 NO=NO+1 BT(NO,NO)=1 AT(NO,A(IB,1))=1 AT(NO,A(IB,2))=-1 S(A(IB,1))=1 S(A(IB,2))=1 KOR(NO)=IB LOOP=.FALSE. GO TO 185 180 LI=LI+1 KOL(LI)=IB 185 ST(IB)=.TRUE. 170 IB=IB+1 IF (NB.GE.IB) GO TO 171 IF (LOOP) GO TO 203 IF (NB.LE.NO+LI) GO TO 190 LOOP=.TRUE. IB=2 171 IF (ST(IB)) GO TO 170 IF (S(A(IB,1))+S(A(IB,2))-1) 170,175,180 190 DO 270 I=1,NO 195 IF (AT(I,I)) 215,200,230 200 K=I 202 K=K+1 IF (NO.GE.K) GO TO 201 203 WRITE (5,9500) 9500 FORMAT (' ***ERROR*** FATAL TOPOLOGICAL ERROR') GO TO 420 201 IF (AT(K,I).EQ.0) GO TO 202 DO 205 J=1,NO AT(I,J)=AT(I,J)+AT(K,J) 205 BT(I,J)=BT(I,J)+BT(K,J) GO TO 195 215 DO 220 J=1,NO AT(I,J)=-AT(I,J) 220 BT(I,J)=-BT(I,J) 230 DO 265 J=1,NO IF (I.EQ.J) GO TO 265 L=AT(J,I) DO 240 K=1,NO AT(J,K)=AT(J,K)-AT(I,K)*L 240 BT(J,K)=BT(J,K)-BT(I,K)*L 265 CONTINUE 270 CONTINUE DO 305 I=1,NO DO 305 J=1,NO DO 300 K=1,NO IF (BT(I,K)*BT(J,K)) 290,300,295 290 Z(I,J)=Z(I,J)-Z1(KOR(K)) GO TO 300 295 Z(I,J)=Z(I,J)+Z1(KOR(K)) 300 CONTINUE 305 CONTINUE 315 IF (LI.LE.0) GO TO 10 L1=KOL(LI) CALL UPDATE (L1,L1,Z1(L1),Z) LI=LI-1 GO TO 315 140 WRITE (5,4600) 4600 FORMAT (' SOURCE OPTION',/' ') 148 I=I+1 IF (I.GT.K1) GO TO 10 142 CALL ALINE (FMT2) DECODE (23,FMT2,BUF) CHAR,L1,P IF (ERROR(L)) GO TO 142 141 IF (BRANC(L1)) GO TO 142 143 DO 144 J=1,2 IF (TAB(J+8).EQ.CHAR) GO TO (146,145),J 144 CONTINUE WRITE (5,10000) 10000 FORMAT (' ***ERROR*** ONLY V C CAN BE USED',/' ') GO TO 142 146 V(L1)=V(L1)+P GO TO 148 145 CNS(A(L1,2))=CNS(A(L1,2))+P CNS(A(L1,1))=CNS(A(L1,1))-P GO TO 148 10 I=0 WRITE (5,9300) 9300 FORMAT (' ENTER OPTION',/' ') 11 CALL ALINE (FMT2) DECODE (3,FMT2,BUF) CHAR,K1 IF (ERROR(L)) GO TO 11 12 DO 15 J=1,9 IF (CHAR.EQ.TAB(J)) GO TO (140,325,350,420,390,410,430,600,370),J 15 CONTINUE WRITE (5,9400) 9400 FORMAT (' ***ERROR*** OPTION CHARACTER NOT VALID',/' ') GO TO 11 325 WRITE (5,4900) 4900 FORMAT (' TRANSISTOR OPTION',/' ') 330 I=I+1 IF (I.GT.K1) GO TO 10 331 CALL ALINE (FMT3) DECODE (14,FMT3,BUF) L1,L2,VAL1 IF (ERROR(L)) GO TO 331 332 IF (BRANC(L1).OR.BRANC(L2)) GO TO 331 333 CALL UPDATE (L1,L2,CMPLX(1.0/VAL1,0.0),Z) GO TO 330 350 WRITE (5,8300) 8300 FORMAT (' MODIFY OPTION',/' ') ASSIGN 356 TO JUMP 355 IF (I.GE.K1) GO TO 10 GO TO 105 356 CALL UPDATE (L1,L1,VALUE*Z1(L1)/(Z1(L1)-VALUE),Z) Z1(L1)=VALUE GO TO 355 370 WRITE (5,8400) 8400 FORMAT (' VARIABLE PARAMETER OPTION',/' ') 371 CALL ALINE (FMT4) DECODE (12,FMT4,BUF) IVB,BASE IF (ERROR(L)) GO TO 371 372 IF (BRANC(IVB)) GO TO 371 373 IV=K1 BASE=EXP(2.30258/BASE) GO TO 10 390 WRITE (5,5200) 5200 FORMAT (' FREQUENCY OPTION',/' ') 391 CALL ALINE (FMT5) DECODE (20,FMT5,BUF) FS,DELW IF (ERROR(L)) GO TO 391 DELW=EXP(2.30258/DELW) IF=K1 GO TO 10 410 WRITE (5,8600) 8600 FORMAT (' DESIGN OPTION',/' ') 411 CALL ALINE (FMT3) DECODE (24,FMT3,BUF) ID,IDV,VALD IF (ERROR(L)) GO TO 411 IF (ID.EQ.0) GO TO 10 IF (BRANC(ID).OR.BRANC(IDV)) GO TO 411 GO TO 10 420 WRITE (5,5400) 5400 FORMAT (' ECAP DONE',/'1') STOP 430 WRITE (5,5000) 5000 FORMAT (' OUTPUT OPTION',/' ') 433 CALL ALINE (FMT6) DECODE (8,FMT6,BUF) O(1),O(2),O(3),O(4) IF (ERROR(L)) GO TO 433 434 DO 435 J=1,5 IF (O(J).EQ.0) GO TO 440 IF (BRANC(O(J))) GO TO 433 435 CONTINUE 440 O6=J-1 O7=K1 GO TO 10 600 IF (O6.GT.0) GO TO 601 WRITE (5,8800) 8800 FORMAT (' ***ERROR*** OUTPUT OPTION HAS NOT BEEN SPECIFIED',/' ') GO TO 10 601 IF (LC.LE.0.OR.IF.GE.0) GO TO 602 WRITE (5,8700) 8700 FORMAT (' ***ERROR*** FREQUENCY OPTION HAS NOT BEEN SPECIFIED', 1/' ') GO TO 10 602 IFN=IF IF (IFN.LT.0) GO TO 606 F=FS 610 WRITE (6,5100) F 5100 FORMAT (' ',15X,'FREQUENCY=',1PE9.2) 606 DO 611 I=1,NO CN(I)=CNS(I) DO 611 J=1,NO 611 ZT(I,J)=Z(I,J) ASSIGN 651 TO JUMP ILC=0 612 DO 617 L1=1,NB IF (LRC(L1)) 607,608,613 607 Z2(L1)=CMPLX(0.0,AIMAG(Z1(L1))*1591.54/F) GO TO 614 608 Z2(L1)=Z1(L1) GO TO 618 613 Z2(L1)=CMPLX(0.0,AIMAG(Z1(L1))*F/1591.54) 614 IF (IFN.LT.0.OR.ABS(F-1591.54).LT.1.0) GO TO 618 ZDEL=Z1(L1)*Z2(L1)/(Z1(L1)-Z2(L1)) ILC=ILC+1 IF (ILC.LT.LC.OR.ID.GT.0.OR.IV.GT.0) GO TO 616 IVB=L1 ASSIGN 680 TO JUMP P=V(L1)/Z1(L1) GO TO 615 616 CALL UPDATE (L1,L1,ZDEL,ZT) 618 P=V(L1)/Z2(L1) 615 CN(A(L1,1))=CN(A(L1,1))+P 617 CN(A(L1,2))=CN(A(L1,2))-P 635 DO 640 I=1,NO VN(I)=(0.0,0.0) DO 640 J=1,NO 640 VN(I)=ZT(I,J)*CN(J)+VN(I) DO 650 I=1,NB 650 VB(I)=VN(A(I,1))-VN(A(I,2)) GO TO JUMP 651 DO 652 I=1,O6 652 VO(I)=VB(O(I)) ASSIGN 744 TO JUMP GO TO 742 744 I=0 ASSIGN 660 TO JUMP 660 I=I+1 IF(I.GT.IV) GO TO 690 IF(LRC(IVB)) 665,670,675 665 VAL1=-BASE**I*1.0E+2/AIMAG(Z1(IVB)) WRITE (6,5600) VAL1 5600 FORMAT (' VARIABLE PARAMETER=',1PE9.2,' MICF') Z2(IVB)=CMPLX(0.0,-159154.0/(F*VAL1)) ZDEL=CMPLX(0.0,-159154.0*BASE**I/(F*VAL1*(BASE**I-1.0))) GO TO 685 670 VAL1=REAL(Z1(IVB))*BASE**I*1.0E-3 WRITE (6,5610) VAL1 5610 FORMAT (' VARIABLE PARAMETER=',1PE9.2,' KOHMS') Z2(IVB)=CMPLX(VAL1*1.0E+3,0.0) ZDEL=CMPLX(VAL1*1.0E+3/(1.0-BASE**I),0.0) GO TO 685 675 VAL1=AIMAG(Z1(IVB))*BASE**I*1.0E-1 WRITE (6,5620) VAL1 5620 FORMAT (' VARIABLE PARAMETER=',1PE9.2,' MILH') Z2(IVB)=CMPLX(0.0,F*VAL1/159.154) ZDEL=CMPLX(0.0,F*VAL1/(159.154*(1.0-BASE**I))) GO TO 685 680 ASSIGN 780 TO JUMP 685 P=(VB(IVB)-V(IVB))/(ZDEL+ZT(A(IVB,1),A(IVB,1))+ZT(A(IVB,2),A(IVB 1,2))-ZT(A(IVB,1),A(IVB,2))-ZT(A(IVB,2),A(IVB,1))) IVV=IVB GO TO 740 690 IF (ID.EQ.0) GO TO 780 P=(VB(ID)-VALD)/(ZT(A(ID,1),A(IDV,1))-ZT(A(ID,1),A(IDV,2))-ZT(A(ID 1,2),A(IDV,1))+ZT(A(ID,2),A(IDV,2))) ZDEL=(VB(IDV)-V(IDV))/P-ZT(A(IDV,1),A(IDV,1))+ZT(A(IDV,1),A(IDV,2) 1)+ZT(A(IDV,2),A(IDV,1))-ZT(A(IDV,2),A(IDV,2)) Z2(IDV)=ZDEL*Z2(IDV)/(ZDEL+Z2(IDV)) WRITE (6,6500) Z2(IDV) 6500 FORMAT (' IMPEDANCE SHOULD BE (',1PE9.2,',',1PE9.2,')') IVV=IDV ASSIGN 780 TO JUMP 740 DO 741 J=1,O6 741 VO(J)=VB(O(J))-P*(ZT(A(O(J),1),A(IVV,1))-ZT(A(O(J),1),A(IVV,2))- 1ZT(A(O(J),2),A(IVV,1))+ZT(A(O(J),2),A(IVV,2))) 742 IF (O7-1) 745,750,755 750 DO 751 J=1,O6 751 VO(J)=(VO(J)-V(O(J)))/Z2(O(J)) GO TO 745 755 DO 756 J=1,O6 VO(J)=VO(J)-V(O(J)) 756 VO(J)=CMPLX(REAL(VO(J))**2+AIMAG(VO(J))**2,0.0)/Z2(O(J)) 745 WRITE (6,5500) (VO(J),J=1,O6) 5500 FORMAT (' ',4(1X,1PE9.2,1PE9.2,1X)) DO 746 J=1,O6 746 VO(J)=CMPLX(CABS(VO(J)),57.296*ATAN2(AIMAG(VO(J)),REAL(VO(J)))) WRITE (6,5500) (VO(J),J=1,O6) GO TO JUMP 780 IF (IFN.LE.0) GO TO 10 F=F*DELW IFN=IFN-1 GO TO 610 END SUBROUTINE ALINE (FMT) BYTE LINE(72),BUF(72),FMT(32) INTEGER FMTP,LINEP,LINEC,BUFP,FIELD COMMON /BUFFER/ BUF(72) DO 10 I=1,72 10 BUF(I)=32 WRITE (5,100) 100 FORMAT('$#') READ (5,200) LINE 200 FORMAT (72A1) LINE(72)=32 FMTP=1 LINEP=0 BUFP=1 15 FIELD=0 FMTP=FMTP+2 20 IF (48.GT.FMT(FMTP)) GO TO 25 FIELD=FIELD*10+FMT(FMTP)-48 FMTP=FMTP+1 GO TO 20 25 LINEP=LINEP+1 IF (LINEP.GT.72) RETURN IF (32.EQ.LINE(LINEP)) GO TO 25 LINEC=LINEP 30 LINEP=LINEP+1 IF (32.NE.LINE(LINEP).AND.LINEC+FIELD.NE.LINEP) GO TO 30 35 BUFP=BUFP+FIELD LINEC=LINEP-LINEC DO 40 I=1,LINEC 40 BUF(BUFP-I)=LINE(LINEP-I) 45 IF (44.EQ.FMT(FMTP)) GO TO 15 IF (41.EQ.FMT(FMTP)) RETURN FMTP=FMTP+1 GO TO 45 END SUBROUTINE UPDATE (L1,L2,ZDEL,Z) COMPLEX ZDEL,P,Z(10,10),ZT(10,10) INTEGER A(25,2) COMMON /TREE/ NO,A(25,2) DATA ZT/100*(0.0,0.0)/ DO 5 I=1,NO DO 5 J=1,NO 5 ZT(I,J)=Z(I,J) P=(1.0,0.0)/(ZDEL+ZT(A(L1,1),A(L2,1))-ZT(A(L1,1),A(L2,2)) 1-ZT(A(L1,2),A(L2,1))+ZT(A(L1,2),A(L2,2))) DO 10 I=1,NO DO 10 J=1,NO 10 Z(I,J)=Z(I,J)-P*(ZT(I,A(L2,1))-ZT(I,A(L2,2)))*(ZT(A(L1,1),J) 1-ZT(A(L1,2),J)) RETURN END LOGICAL FUNCTION ERROR(IDUM) CALL TSTERR(6,IDUM) ERROR=IDUM.LE.1 IF (.NOT.ERROR) RETURN WRITE (5,100) 100 FORMAT (' ***ERROR*** INCORRECT FORMAT RE-ENTER LINE',/' ') RETURN END LOGICAL FUNCTION BRANC(I) COMMON /BRANCH/ NB BRANC=I.LE.0.OR.I.GT.NB IF (.NOT.BRANC) RETURN WRITE (5,100) 100 FORMAT (' ***ERROR*** ILLEGAL BRANCH NUMBER RE-ENTER LINE',/' ') RETURN END