Trailing-Edge
-
PDP-10 Archives
-
decus_20tap3_198111
-
decus/20-0079/2spice.for
There are no other files named 2spice.for in the archive.
SUBROUTINE ERRCHK
COMMON NODPLC(800),YNL(2001),TSTORE(2001),TRACUR(1700),VN(401),
1 VNIM1(401),IORDER(401),IUR(402),IUC(800),MATLOC(1800)
COMMON/INDATA/NUMEL,NUNODS,NUMNOD,NOSTOP,JELCNT(20),LOCATE(21),
1 ICURNT(21),JUNODE(401),NAME(200),LOCAL(200),MNAME(200)
COMMON/PARAM/VALUE(200),SOURCE(150),SYMVAL(25,25)
COMMON/MODELS/NUMMOD,MODNAM(25),KIND(25)
COMMON/MISCEL/NOGO,IGOOF,NOPRNT,IACCT,JOBNAM(16),RTIMES(15)
C
C
DIMENSION ITABLE(1)
EQUIVALENCE (ITABLE(1),YNL(1))
DIMENSION NAME1(1),MNAME1(1),LOCAL1(1),IDNO(1),VALUE1(1)
EQUIVALENCE (NAME1(1),TSTORE(1)),(MNAME1(1),TSTORE(401)),
1 (LOCAL1(1),TSTORE(801)),(IDNO(1),TSTORE(1201)),
2 (VALUE1(1),TSTORE(1601))
DIMENSION NODPL1(1)
EQUIVALENCE (NODPL1(1),MATLOC(1))
DIMENSION NNODS(10),NINO(10)
DATA NNODS/2,2,2,2,4,2,3,2,3,4/
DATA NINO/0,0,3,0,0,3,3,1,2,2/
C* DATA ISHFT4,ICOMMA/100000000B,56000000B/
DATA ISHFT4,ICOMMA/"2000000000,"540000000/
C
C
CALL SECOND(T1)
IF (NUMEL.EQ.0) GO TO 610
IF (NUMEL.GE.400) GO TO 630
LOCAL1(NUMEL+1)=NOSTOP+1
C
C CONSTRUCT ORDERED LIST OF USER SPECIFIED NODES
C
NUNODS=1
DO 110 I=1,NUMEL
ID=IDNO(I)
IF (ID.GT.20) GO TO 110
JSTART=LOCAL1(I)
JSTOP=LOCAL1(I+1)-1
DO 100 J=JSTART,JSTOP
NODE1=NODPL1(J)
JKNT=0
60 JKNT=JKNT+1
IF (JKNT.GT.NUNODS) GO TO 70
IF (NODE1-JUNODE(JKNT)) 70,100,60
70 K=NUNODS+1
IF (K.GT.401) GO TO 620
80 IF (K.LE.JKNT) GO TO 90
JUNODE(K)=JUNODE(K-1)
K=K-1
GO TO 80
90 JUNODE(K)=NODE1
NUNODS=NUNODS+1
100 CONTINUE
110 CONTINUE
C
C TRANSFER NONMODEL NODES TO FINAL NODE LIST AND ASSIGN PROGRAM NODES
C
NOSTOP=0
DO 180 I=1,NUMEL
ID=IDNO(I)
IF (ID.GT.20) GO TO 180
LOC=LOCAL1(I)-1
JSTOP=LOCAL1(I+1)-LOC-1
IF ((NOSTOP+JSTOP).GT.800) GO TO 630
LOCAL1(I)=NOSTOP+1
DO 160 J=1,JSTOP
NODE1=NODPL1(LOC+J)
JKNT=0
150 JKNT=JKNT+1
IF (JKNT.GT.NUNODS) GO TO 620
IF (JUNODE(JKNT).NE.NODE1) GO TO 150
NODPLC(NOSTOP+J)=JKNT
160 CONTINUE
NOSTOP=NOSTOP+JSTOP
IF (ID.EQ.20) GO TO 180
JSTOP=NINO(ID)
IF (JSTOP.EQ.0) GO TO 180
IF ((NOSTOP+JSTOP).GT.800) GO TO 630
DO 170 J=1,JSTOP
170 NODPLC(NOSTOP+J)=0
NOSTOP=NOSTOP+JSTOP
180 CONTINUE
NUMNOD=NUNODS
C
C PROCESS EXTERNAL MODELS
C
IF (NUMMOD.EQ.0) GO TO 300
DO 250 I=1,NUMMOD
IF (KIND(I).NE.20) GO TO 250
JSTOP=SYMVAL(I,3)
DO 210 J=1,JSTOP
210 ITABLE(J)=SYMVAL(I,J+5)
LSTOP=JSTOP
JSTART=SYMVAL(I,1)
JSTOP=SYMVAL(I,2)
DO 240 J=JSTART,JSTOP
ID=IDNO(J)-20
LOC=LOCAL1(J)-1
KSTOP=NNODS(ID)
DO 230 K=1,KSTOP
NODE1=NODPL1(LOC+K)
IF (NODE1.EQ.0) GO TO 230
DO 220 L=1,LSTOP
IF (NODE1.NE.ITABLE(L)) GO TO 220
NODPL1(LOC+K)=L
GO TO 230
220 CONTINUE
LSTOP=LSTOP+1
ITABLE(LSTOP)=NODE1
NODPL1(LOC+K)=LSTOP
230 CONTINUE
240 CONTINUE
SYMVAL(I,4)=LSTOP
250 CONTINUE
C
C EXPLODE MODELS
C
300 IF (JELCNT(20).EQ.0) GO TO 500
DO 450 I=1,NUMEL
IF (IDNO(I).NE.20) GO TO 450
MNAM=MNAME1(I)
DO 310 J=1,NUMMOD
IF (MODNAM(J).NE.MNAM) GO TO 310
IF (KIND(J).NE.20) GO TO 310
MNAM=J
MNAME1(I)=J
GO TO 320
310 CONTINUE
NOGO=1
WRITE (6,311) MNAM
311 FORMAT (//5X,'---------- EXTERNAL MODEL ',R7,' HAS NOT BEEN '
1 'DEFINED PROPERLY'//)
GO TO 450
C
C CONSTRUCT NODE CORRESPONDANCE TABLE
C
320 ITEMP=VALUE1(I)
JSTOP=SYMVAL(MNAM,3)
IF (ITEMP.EQ.JSTOP) GO TO 340
NOGO=1
WRITE (6,321) NAME1(I),MODNAM(MNAM)
321 FORMAT (//5X,'---------- NUMBER OF NODES SPECIFIED FOR ',R7,
1 ' AND NUMBER OF NODES FOR MODEL ',R7,' DO NOT AGREE'//)
GO TO 450
340 LOC=LOCAL1(I)-1
DO 350 J=1,JSTOP
350 ITABLE(J)=NODPLC(LOC+J)
LSTART=JSTOP+1
LSTOP=SYMVAL(MNAM,4)
IF (LSTART.GT.LSTOP) GO TO 370
DO 360 L=LSTART,LSTOP
NUMNOD=NUMNOD+1
IF (NUMNOD.GT.401) GO TO 620
360 ITABLE(L)=NUMNOD
C
C INSERT ELEMENTS INTO TEMPORARY STACK
C
370 JSTART=SYMVAL(MNAM,1)
JSTOP=SYMVAL(MNAM,2)
DO 410 J=JSTART,JSTOP
ID=IDNO(J)-20
JELCNT(ID)=JELCNT(ID)+1
NUMEL=NUMEL+1
IF (NUMEL.GT.400) GO TO 630
IDNO(NUMEL)=ID
NAME1(NUMEL)=(NAME1(I)/ISHFT4)*ISHFT4+ICOMMA+NAME1(J)/ISHFT4
MNAME1(NUMEL)=MNAME1(J)
VALUE1(NUMEL)=VALUE1(J)
LOCAL1(NUMEL)=NOSTOP+1
KSTOP=NNODS(ID)
IF ((NOSTOP+KSTOP).GT.800) GO TO 630
LOC=LOCAL1(J)-1
DO 390 K=1,KSTOP
NODE1=NODPL1(LOC+K)
IF (NODE1.NE.0) GO TO 380
NODPLC(NOSTOP+K)=1
GO TO 390
380 NODPLC(NOSTOP+K)=ITABLE(NODE1)
390 CONTINUE
NOSTOP=NOSTOP+KSTOP
KSTOP=NINO(ID)
IF (KSTOP.EQ.0) GO TO 410
IF ((NOSTOP+KSTOP).GT.800) GO TO 630
DO 400 K=1,KSTOP
400 NODPLC(NOSTOP+K)=0
NOSTOP=NOSTOP+KSTOP
410 CONTINUE
450 CONTINUE
C
C ASSIGN LOCATIONS IN PERMANENT STORAGE
C
500 IF (NOGO.EQ.1) GO TO 1000
LOCATE(1)=1
DO 510 I=1,20
LOCATE(I+1)=LOCATE(I)+JELCNT(I)
510 JELCNT(I)=0
IF (LOCATE(21).GT.201) GO TO 630
C
C MOVE FINAL CIRCUIT DATA TO PERMANENT STACK
C
DO 520 I=1,NUMEL
ID=IDNO(I)
IF (ID.GT.20) GO TO 520
LOC=LOCATE(ID)+JELCNT(ID)
JELCNT(ID)=JELCNT(ID)+1
NAME(LOC)=NAME1(I)
LOCAL(LOC)=LOCAL1(I)
MNAME(LOC)=MNAME1(I)
VALUE(LOC)=VALUE1(I)
520 CONTINUE
NUMEL=LOCATE(21)-1
C
C ASSIGN USER NODE NUMBERS TO INTERNAL NODES
C
IF (NUMNOD.EQ.NUNODS) GO TO 540
NODE1=JUNODE(NUNODS)
ISTART=NUNODS+1
DO 530 I=ISTART,NUMNOD
NODE1=NODE1+1
530 JUNODE(I)=NODE1
NUNODS=NUMNOD
C
C ASSIGN TRACUR LOCATIONS
C
540 DO 550 I=1,20
550 ICURNT(I)=1
ICURNT(3)=1+2*JELCNT(2)
ICURNT(6)=ICURNT(3)+2*JELCNT(3)
ICURNT(7)=ICURNT(6)+2*JELCNT(6)
ICURNT(8)=ICURNT(7)+15*JELCNT(7)
ICURNT(9)=ICURNT(8)+5*JELCNT(8)
ICURNT(10)=ICURNT(9)+10*JELCNT(9)
ICURNT(11)=ICURNT(10)+15*JELCNT(10)
IF (ICURNT(11).GT.1700) GO TO 630
C
C CALL ROUTINES TO PRINT CIRCUIT DATA, CHECK MODELS, AND CHECK
C RUN CONTROL PARAMETERS
C
CALL ELPRNT
CALL MODCHK
CALL CIRCHK
IF (NUMNOD.GT.401) GO TO 620
GO TO 1000
C
C ERROR MESSAGES
C
610 NOGO=1
WRITE (6,611)
611 FORMAT (//5X,'---------- CIRCUIT HAS NO ELEMENTS'//)
GO TO 1000
620 NOGO=1
WRITE (6,621)
621 FORMAT (//5X,'---------- MAXIMUM NODE LIMIT EXCEEDED'//)
GO TO 1000
630 NOGO=1
WRITE (6,631)
631 FORMAT (//5X,'---------- MAXIMUM ELEMENT LIMIT EXCEEDED'//)
1000 CALL SECOND(T2)
RTIMES(1)=RTIMES(1)+T2-T1
RETURN
END
SUBROUTINE MODCHK
COMMON NODPLC(800),YNL(2001),TSTORE(2001),TRACUR(1700),VN(401),
1 VNIM1(401),IORDER(401),IUR(402),IUC(800),MATLOC(1800)
COMMON/INDATA/NUMEL,NUNODS,NUMNOD,NOSTOP,JELCNT(20),LOCATE(21),
1 ICURNT(21),JUNODE(401),NAME(200),LOCAL(200),MNAME(200)
COMMON/PARAM/VALUE(200),SOURCE(150),SYMVAL(25,25)
COMMON/MODELS/NUMMOD,MODNAM(25),KIND(25)
COMMON/MISCEL/NOGO,IGOOF,NOPRNT,IACCT,JOBNAM(16),RTIMES(15)
COMMON/KNSTNT/TWOPI,XLOG2,XLOG10,RAD,BOLTZ,CHARGE,VT
COMMON/TEMPER/TEMPS(6),NUMTEM,ITEMNO
COMMON/TBLOK/FNDATA(25,5)
C
C
DIMENSION MOTYP(6),MODEF(4),DEFEM(16),DEFGP(25),DEFD(7),DEFJ(10),
1 DEFM(15)
DATA MOTYP /7,7,8,8,9,10/
DATA MODEF /1,3,5,6/
DATA DEFEM /1.0,100.0,1.0,8*0.0,1.0E-14,2*1.0,0.0,1.11/
DATA DEFGP /1.0,100.0,1.0,8*0.0,1.0E-14,4*0.0,2.0,2*0.0,2.0,1.0,
1 0.5,1.0,0.5,1.11/
DATA DEFD /3*0.0,1.0E-14,2*1.0,1.11/
DATA SBDEG /0.69/
DATA DEFJ /1.0,-2.0,1.0E-4,5*0.0,1.0,1.0E-14/
DATA DEFM /-1.0,2.0,0.5,1.0E-4,9*0.0,1.0,1.0E-14/
C* DATA IBLNK,IDEF,JLETP,JLETN,LSJUN,LSSBD /55555555555555B,
C* 1 10H DEFAULT,1HP,1HN,3HD ,3HSBD/
DATA IBLNK,IDEF,JLETP,JLETN,LSJUN,LSSBD /"100402010040,
1 5HDEFLT,1HP,1HN,3HD ,3HSBD/
C
C ASSIGN MODEL NAMES
C
ID=6
5 ID=ID+1
IF (ID.GT.10) GO TO 60
IKNT=LOCATE(ID)-1
ISTOP=LOCATE(ID+1)-1
10 IKNT=IKNT+1
IF (IKNT.GT.ISTOP) GO TO 5
JKNT=0
20 JKNT=JKNT+1
IF (JKNT.GT.NUMMOD) GO TO 30
IF (MNAME(IKNT).NE.MODNAM(JKNT)) GO TO 20
MTYPE=KIND(JKNT)
IF (ID.NE.MOTYP(MTYPE)) GO TO 20
MNAME(IKNT)=JKNT
GO TO 10
30 IF (MNAME(IKNT).EQ.IBLNK) GO TO 40
WRITE (6,31) MNAME(IKNT)
31 FORMAT (//5X,'--- WARNING --- MODEL ',R7,' HAS NOT BEEN '
1 'DEFINED CORRECTLY'//)
40 IF (NUMMOD.GE.25) GO TO 55
NUMMOD=NUMMOD+1
MODNAM(NUMMOD)=MNAME(IKNT)
KIND(NUMMOD)=MODEF(ID-6)
MNAME(IKNT)=NUMMOD
DO 50 I=1,25
50 SYMVAL(NUMMOD,I)=0.0
GO TO 10
55 NOGO=1
WRITE (6,56)
56 FORMAT (//5X,'---------- MODEL LIMIT EXCEEDED'//)
GO TO 10
C
C PROCESS MODEL PARAMETERS
C
60 IF (NUMMOD.EQ.0) RETURN
IF (NOPRNT.EQ.1) GO TO 70
WRITE (6,61)
61 FORMAT (1H1)
70 IF (JELCNT(7).EQ.0) GO TO 100
C
C EBERS-MOLL MODELS
C
IPRINT=NOPRNT
DO 90 I=1,NUMMOD
IF (KIND(I).NE.1) GO TO 90
IF (IPRINT.EQ.1) GO TO 75
IPRINT=1
WRITE (6,71)
71 FORMAT (///1X,5H**** ,'EBERS-MOLL MODEL PARAMETERS'//1X,'NAME',
1 3X,'TYPE',4X,'BF',6X,'BR',6X,'RB',5X,'RC',4X,'RE',
2 5X,'CCS',6X,'TF',7X,'TR',7X,'CJE',6X,'CJC',6X,'IS',
3 6X,'PE',4X,'PC',5X,'VA',5X,'EG')
75 IF (SYMVAL(I,1).EQ.0.0) SYMVAL(I,1)=DEFEM(1)
DO 80 J=2,16
IF (SYMVAL(I,J).LE.0.0) SYMVAL(I,J)=DEFEM(J)
80 CONTINUE
IF (NOPRNT.EQ.1) GO TO 85
NAM=JLETN
IF (SYMVAL(I,1).EQ.-1.0) NAM=JLETP
MNAM=MODNAM(I)
IF (MNAM.EQ.IBLNK) MNAM=IDEF
WRITE (6,81) MNAM,NAM,(SYMVAL(I,J),J=2,16)
81 FORMAT (/1X,R7,2X,A1,2X,F7.2,1X,F7.3,1X,F6.1,1X,F6.1,1X,F5.1,
1 1X,1PE8.2,1X,E8.2,1X,E8.2,1X,E8.2,1X,E8.2,1X,E8.2,1X,
2 0PF5.2,1X,F5.2,1X,F7.2,1X,F5.2)
85 IF (SYMVAL(I,4).NE.0.0) SYMVAL(I,4)=1.0/SYMVAL(I,4)
IF (SYMVAL(I,5).NE.0.0) SYMVAL(I,5)=1.0/SYMVAL(I,5)
IF (SYMVAL(I,6).NE.0.0) SYMVAL(I,6)=1.0/SYMVAL(I,6)
IF (SYMVAL(I,13).LT.0.1) SYMVAL(I,13)=0.1
IF (SYMVAL(I,14).LT.0.1) SYMVAL(I,14)=0.1
IF (SYMVAL(I,15).NE.0.0) SYMVAL(I,15)=1.0/SYMVAL(I,15)
IF (SYMVAL(I,16).LT.0.1) SYMVAL(I,16)=0.1
90 CONTINUE
C
C GUMMEL-POON MODELS
C
IPRINT=NOPRNT
DO 490 I=1,NUMMOD
IF (KIND(I).NE.2) GO TO 490
IF (IPRINT.EQ.1) GO TO 475
IPRINT=1
WRITE (6,471)
471 FORMAT(////1X,5H**** ,'GUMMEL-POON MODEL PARAMETERS')
475 IF (SYMVAL(I,1).EQ.0.0) SYMVAL(I,1)=DEFGP(1)
DO 480 J=2,25
IF (SYMVAL(I,J).LE.0.0) SYMVAL(I,J)=DEFGP(J)
480 CONTINUE
IF (NOPRNT.EQ.1) GO TO 485
NAM=JLETN
IF (SYMVAL(I,1).EQ.-1.0) NAM=JLETP
MNAM=MODNAM(I)
IF (MNAM.EQ.IBLNK) MNAM=IDEF
WRITE (6,481) MNAM,NAM,(SYMVAL(I,J),J=2,25)
481 FORMAT (//1X,'NAME',3X,'TYPE',4X,'BFM',5X,'BRM',5X,'RB',5X,
1 'RC',4X,'RE',5X,'CCS',6X,'TF',7X,'TR',7X,'CJE',6X,'CJC',6X,
2 'IS',7X,'VA',6X,'VB'//1X,R7,2X,A1,2X,F7.2,1X,F7.3,1X,F6.1,1X,
3 F6.1,1X,F5.1,1X,1PE8.2,1X,E8.2,1X,E8.2,1X,E8.2,1X,E8.2,1X,
4 E8.2,1X,0PF7.2,1X,F7.2//16X,'C2',6X,'IK',6X,'NE',10X,
5 'C4',6X,'IKR',5X,'NC',14X,'PE',3X,'ME',7X,'PC',3X,'MC',
6 9X,'EG'//12X,1PE8.2,1X,E8.2,2X,0PF5.3,4X,1PE8.2,1X,E8.2,
7 2X,0PF5.3,10X,F5.2,1X,F5.3,3X,F5.2,1X,F5.3,5X,F5.2)
485 SYMVAL(I,2)=1.0/SYMVAL(I,2)
SYMVAL(I,3)=1.0/SYMVAL(I,3)
IF (SYMVAL(I,4).NE.0.0) SYMVAL(I,4)=1.0/SYMVAL(I,4)
IF (SYMVAL(I,5).NE.0.0) SYMVAL(I,5)=1.0/SYMVAL(I,5)
IF (SYMVAL(I,6).NE.0.0) SYMVAL(I,6)=1.0/SYMVAL(I,6)
IF (SYMVAL(I,21).LT.0.1) SYMVAL(I,21)=0.1
IF (SYMVAL(I,22).GT.0.9) SYMVAL(I,22)=0.9
IF (SYMVAL(I,23).LT.0.1) SYMVAL(I,23)=0.1
IF (SYMVAL(I,24).GT.0.9) SYMVAL(I,24)=0.9
IF (SYMVAL(I,13).NE.0.0) SYMVAL(I,13)=1.0/SYMVAL(I,13)
IF (SYMVAL(I,14).NE.0.0) SYMVAL(I,14)=1.0/SYMVAL(I,14)
IF (SYMVAL(I,16).NE.0.0) SYMVAL(I,16)=1.0/SYMVAL(I,16)
SYMVAL(I,17)=VT*SYMVAL(I,17)
IF (SYMVAL(I,19).NE.0.0) SYMVAL(I,19)=1.0/SYMVAL(I,19)
SYMVAL(I,20)=VT*SYMVAL(I,20)
IF (SYMVAL(I,25).LT.0.1) SYMVAL(I,25)=0.1
490 CONTINUE
C
C DIODES
C
100 IF (JELCNT(8).EQ.0) GO TO 130
IF (NOPRNT.EQ.1) GO TO 105
WRITE (6,101)
101 FORMAT (///1X,5H**** ,'DIODE MODEL PARAMETERS'//1X,'NAME',4X,
1 'TYPE',8X,'RS',7X,'TT',8X,'CJO',7X,'IS',8X,'N',5X,'PHI',
2 6X,'EG')
105 DO 120 I=1,NUMMOD
IF (KIND(I).EQ.3) GO TO 108
IF (KIND(I).NE.4) GO TO 120
IF (SYMVAL(I,7).EQ.0.0) SYMVAL(I,7)=SBDEG
108 DO 110 J=1,7
IF (SYMVAL(I,J).LE.0.0) SYMVAL(I,J)=DEFD(J)
110 CONTINUE
IF (NOPRNT.EQ.1) GO TO 115
MNAM=MODNAM(I)
IF (MNAM.EQ.IBLNK) MNAM=IDEF
NAM=LSJUN
IF (KIND(I).EQ.4) NAM=LSSBD
WRITE (6,111) MNAM,NAM,(SYMVAL(I,J),J=1,7)
111 FORMAT (/1X,R7,2X,A3,3X,F7.1,3X,1PE8.2,3X,E7.1,3X,E8.2,3X,0PF4.1,
1 3X,F5.2,3X,F5.2)
115 IF (SYMVAL(I,1).NE.0.0) SYMVAL(I,1)=1.0/SYMVAL(I,1)
SYMVAL(I,5)=SYMVAL(I,5)*VT
IF (SYMVAL(I,6).LT.0.1) SYMVAL(I,6)=0.1
120 CONTINUE
C
C JFETS
C
130 IF (JELCNT(9).EQ.0) GO TO 160
IF (NOPRNT.EQ.1) GO TO 135
WRITE (6,131)
131 FORMAT (///1X,5H**** ,'JFET MODEL PARAMETERS'//1X,'NAME',3X,
1 'TYPE',4X,'VTO',7X,'BETA',5X,'LAMBDA',8X,'RD',8X,'RS',7X,
2 'CGS',8X,'CGD',7X,'PB',7X,'IS')
135 DO 150 I=1,NUMMOD
IF (KIND(I).NE.5) GO TO 150
IF (SYMVAL(I,1).EQ.0.0) SYMVAL(I,1)=DEFJ(1)
IF (SYMVAL(I,2).EQ.0.0) SYMVAL(I,2)=DEFJ(2)
DO 140 J=3,10
IF (SYMVAL(I,J).LE.0.0) SYMVAL(I,J)=DEFJ(J)
140 CONTINUE
IF (NOPRNT.EQ.1) GO TO 145
NAM=JLETN
IF (SYMVAL(I,1).EQ.-1.0) NAM=JLETP
MNAM=MODNAM(I)
IF (MNAM.EQ.IBLNK) MNAM=IDEF
WRITE (6,141) MNAM,NAM,(SYMVAL(I,J),J=2,10)
141 FORMAT (/1X,R7,2X,A1,2X,F8.3,3X,1PE8.2,3X,E7.1,3X,0PF7.1,3X,
1 F7.1,3X,1PE8.2,3X,E8.2,3X,0PF5.2,3X,1PE8.2)
145 IF (SYMVAL(I,5).NE.0.0) SYMVAL(I,5)=1.0/SYMVAL(I,5)
IF (SYMVAL(I,6).NE.0.0) SYMVAL(I,6)=1.0/SYMVAL(I,6)
IF (SYMVAL(I,9).LT.0.1) SYMVAL(I,9)=0.1
150 CONTINUE
C
C MOSFETS
C
160 IF (JELCNT(10).EQ.0) GO TO 200
IF (NOPRNT.EQ.1) GO TO 165
WRITE (6,161)
161 FORMAT (///1X,5H**** ,'MOSFET MODEL PARAMETERS'//1X,'NAME',3X,
1 'TYPE',4X,'VTO',4X,'PHI',4X,'BETA',4X,'GAMMA',2X,'LAMBDA',6X,
2 'RD',6X,'RS',5X,'CGS',6X,'CGD',6X,'CGB',6X,'CBD',6X,'CBS',
3 5X,'PB',5X,'IS')
165 DO 180 I=1,NUMMOD
IF (KIND(I).NE.6) GO TO 180
IF (SYMVAL(I,1).EQ.0.0) SYMVAL(I,1)=DEFM(1)
IF (SYMVAL(I,2).EQ.0.0) SYMVAL(I,2)=DEFM(2)
DO 170 J=3,15
IF (SYMVAL(I,J).LE.0.0) SYMVAL(I,J)=DEFM(J)
170 CONTINUE
IF (NOPRNT.EQ.1) GO TO 175
NAM=JLETN
IF (SYMVAL(I,1).EQ.-1.0) NAM=JLETP
MNAM=MODNAM(I)
IF (MNAM.EQ.IBLNK) MNAM=IDEF
WRITE (6,171) MNAM,NAM,(SYMVAL(I,J),J=2,15)
171 FORMAT (/1X,R7,2X,A1,2X,F8.3,1X,F5.2,1X,1PE8.2,1X,E7.1,1X,
1 E7.1,1X,0PF7.1,1X,F7.1,1X,1PE8.2,1X,E8.2,1X,E8.2,1X,E8.2,1X,
2 E8.2,1X,0PF5.2,1X,1PE8.2)
175 IF (SYMVAL(I,7).NE.0.0) SYMVAL(I,7)=1.0/SYMVAL(I,7)
IF (SYMVAL(I,8).NE.0.0) SYMVAL(I,8)=1.0/SYMVAL(I,8)
IF (SYMVAL(I,3).LT.0.1) SYMVAL(I,3)=0.1
SYMVAL(I,2)=SYMVAL(I,2)-SYMVAL(I,5)*SQRT(SYMVAL(I,3))
IF (SYMVAL(I,14).LT.0.1) SYMVAL(I,14)=0.1
180 CONTINUE
C
C TEMPORARY PROCESSING OF FLICKER NOISE PARAMETERS
C
200 IFLAG=0
DO 1000 I=1,NUMMOD
IF (FNDATA(I,2).LT.0.1) FNDATA(I,2)=0.1
IF (FNDATA(I,1).LT.0.0) FNDATA(I,1)=0.0
IF (FNDATA(I,1).EQ.0.0) GO TO 1000
IFLAG=1
1000 CONTINUE
IF (IFLAG.EQ.0) GO TO 1030
WRITE (6,1011)
1011 FORMAT (///1X,5H**** ,'FLICKER NOISE PARAMETERS'//1X,'MODEL',
1 9X,'KFN',8X,'FNA')
WRITE (6,1021) (MODNAM(I),FNDATA(I,1),FNDATA(I,2),I=1,NUMMOD)
1021 FORMAT (/1X,R7,2X,1PE10.3,4X,0PF7.4)
C
C RESERVE ADDITIONAL NODES
C
C TRANSISTORS
C
1030 IF (NOGO.EQ.1) RETURN
ISTART=LOCATE(7)
ISTOP=LOCATE(8)-1
IF (ISTART.GT.ISTOP) GO TO 240
DO 230 I=ISTART,ISTOP
MNAM=MNAME(I)
LOC=LOCAL(I)
IF (SYMVAL(MNAM,4).EQ.0.0) GO TO 205
NUMNOD=NUMNOD+1
NODPLC(LOC+4)=NUMNOD
GO TO 210
205 NODPLC(LOC+4)=NODPLC(LOC+1)
210 IF (SYMVAL(MNAM,5).EQ.0.0) GO TO 215
NUMNOD=NUMNOD+1
NODPLC(LOC+3)=NUMNOD
GO TO 220
215 NODPLC(LOC+3)=NODPLC(LOC)
220 IF (SYMVAL(MNAM,6).EQ.0.0) GO TO 225
NUMNOD=NUMNOD+1
NODPLC(LOC+5)=NUMNOD
GO TO 230
225 NODPLC(LOC+5)=NODPLC(LOC+2)
230 CONTINUE
C
C DIODES
C
240 ISTART=LOCATE(8)
ISTOP=LOCATE(9)-1
IF (ISTART.GT.ISTOP) GO TO 260
DO 250 I=ISTART,ISTOP
MNAM=MNAME(I)
LOC=LOCAL(I)
IF (SYMVAL(MNAM,1).EQ.0.0) GO TO 245
NUMNOD=NUMNOD+1
NODPLC(LOC+2)=NUMNOD
GO TO 250
245 NODPLC(LOC+2)=NODPLC(LOC)
250 CONTINUE
C
C JFETS
C
260 ISTART=LOCATE(9)
ISTOP=LOCATE(10)-1
IF (ISTART.GT.ISTOP) GO TO 290
DO 280 I=ISTART,ISTOP
MNAM=MNAME(I)
LOC=LOCAL(I)
IF (SYMVAL(MNAM,5).EQ.0.0) GO TO 265
NUMNOD=NUMNOD+1
NODPLC(LOC+3)=NUMNOD
GO TO 270
265 NODPLC(LOC+3)=NODPLC(LOC)
270 IF (SYMVAL(MNAM,6).EQ.0.0) GO TO 275
NUMNOD=NUMNOD+1
NODPLC(LOC+4)=NUMNOD
GO TO 280
275 NODPLC(LOC+4)=NODPLC(LOC+2)
280 CONTINUE
C
C MOSFETS
C
290 ISTART=LOCATE(10)
ISTOP=LOCATE(11)-1
IF (ISTART.GT.ISTOP) RETURN
DO 310 I=ISTART,ISTOP
MNAM=MNAME(I)
LOC=LOCAL(I)
IF (SYMVAL(MNAM,7).EQ.0.0) GO TO 295
NUMNOD=NUMNOD+1
NODPLC(LOC+4)=NUMNOD
GO TO 300
295 NODPLC(LOC+4)=NODPLC(LOC)
300 IF (SYMVAL(MNAM,8).EQ.0.0) GO TO 305
NUMNOD=NUMNOD+1
NODPLC(LOC+5)=NUMNOD
GO TO 310
305 NODPLC(LOC+5)=NODPLC(LOC+2)
310 CONTINUE
RETURN
END
SUBROUTINE IDEN (KELNAM,KID,KELNO)
COMMON/INDATA/NUMEL,NUNODS,NUMNOD,NOSTOP,JELCNT(20),LOCATE(21),
1 ICURNT(21),JUNODE(401),NAME(200),LOCAL(200),MNAME(200)
C
C
DIMENSION ID1(10)
DATA ID1 /"122,"103,"114,"111,0,"126,"121,"104,"112,"115/
C* DATA ID1 /22B,3B,14B,11B,0,26B,21B,4B,12B,15B/
C* DATA ISHIFT /1000000000000B/
DATA ISHIFT /"40000/
C
C
ITEMP=KELNAM/ISHIFT
KID=0
10 KID=KID+1
IF (KID.GT.10) GO TO 50
IF (ITEMP.NE.ID1(KID)) GO TO 10
20 IKNT=LOCATE(KID)-1
ISTOP=LOCATE(KID+1)-1
30 IKNT=IKNT+1
IF (IKNT.GT.ISTOP) GO TO 60
IF (NAME(IKNT).NE.KELNAM) GO TO 30
KELNO=IKNT
40 IKNT=IKNT+1
IF (IKNT.GT.ISTOP) RETURN
IF (NAME(IKNT).NE.KELNAM) GO TO 40
50 KID=0
RETURN
60 IF (KID.NE.4) GO TO 50
KID=5
GO TO 20
END
SUBROUTINE SETUP
COMMON NODPLC(800),YNL(2001),TSTORE(2001),TRACUR(1700),VN(401),
1 VNIM1(401),IORDER(401),IUR(402),IUC(800),MATLOC(1800)
COMMON/INDATA/NUMEL,NUNODS,NUMNOD,NOSTOP,JELCNT(20),LOCATE(21),
1 ICURNT(21),JUNODE(401),NAME(200),LOCAL(200),MNAME(200)
COMMON/MISCEL/NOGO,IGOOF,NOPRNT,IACCT,JOBNAM(16),RTIMES(15)
COMMON/STATUS/MODE,OMEGA,TIMEE,DELTA,DELOLD,ICALC 7
COMMON/POINTS/IUS,ILS,MIRROR,NSTOP,NUMVS,LASTUT,LASTLT
C
C
DIMENSION JMNODE(1)
EQUIVALENCE (JMNODE(1),VN(1))
DIMENSION ITROW(1)
EQUIVALENCE (ITROW(1),YNL(1))
C
C INITIALIZE, ORDER GROUND NODE LAST
C
CALL SECOND(T1)
IGOOF=0
DO 10 I=1,NUMNOD
IUR(I)=0
10 JMNODE(I)=0
JMNODE(1)=NUMNOD
IORDER(NUMNOD)=1
NEXNOD=NUMNOD-1
C
C DETERMINE ORDER IN WHICH SOURCES (AND INDUCTORS IN DC ANALYSIS)
C MUST BE LOADED
C
NUMVS=JELCNT(6)
IF (MODE.GT.1) GO TO 20
NUMVS=NUMVS+JELCNT(3)
20 IF (NUMVS.EQ.0) GO TO 150
C
C IUR(I) TEMPORARILY CONTAINS THE NUMBER OF SOURCES CONNECTED TO
C NODE I
C
ID=6
30 ISTART=LOCATE(ID)
ISTOP=LOCATE(ID+1)-1
IF (ISTART.GT.ISTOP) GO TO 50
DO 40 I=ISTART,ISTOP
LOC=LOCAL(I)
NODE1=NODPLC(LOC)
NODE2=NODPLC(LOC+1)
IUR(NODE1)=IUR(NODE1)+1
IUR(NODE2)=IUR(NODE2)+1
NODPLC(LOC+2)=0
40 CONTINUE
50 IF (MODE.GT.1) GO TO 60
ID=ID-3
IF (ID.GT.0) GO TO 30
C
C SEARCH THROUGH SOURCES AND LOAD THOSE WITH A NODE THAT HAS NO
C OTHER SOURCES CONNECTED
C
60 ILOAD=1
70 IFLAG=0
ID=6
80 ISTART=LOCATE(ID)
ISTOP=LOCATE(ID+1)-1
IF (ISTART.GT.ISTOP) GO TO 130
DO 120 I=ISTART,ISTOP
LOC=LOCAL(I)
IF (NODPLC(LOC+2).NE.0) GO TO 120
NODE1=NODPLC(LOC)
ITRY=0
90 IF (NODE1.EQ.1) GO TO 110
IF (JMNODE(NODE1).GT.0) GO TO 110
IF (IUR(NODE1).GT.1) GO TO 110
JMNODE(NODE1)=NEXNOD
IORDER(NEXNOD)=NODE1
NEXNOD=NEXNOD-1
NODPLC(LOC+2)=1
IF (ITRY.EQ.0) GO TO 100
NODPLC(LOC+2)=-1
NODPLC(LOC+1)=NODPLC(LOC)
NODPLC(LOC)=NODE1
100 NODE2=NODPLC(LOC+1)
C
C AFTER A SOURCE HAS BEEN LOADED, IT IS DELETED FROM THE IUR COUNTER
C
IUR(NODE1)=IUR(NODE1)-1
IUR(NODE2)=IUR(NODE2)-1
IFLAG=1
MATLOC(ILOAD+800)=I
ILOAD=ILOAD+1
IF (ILOAD.GT.NUMVS) GO TO 150
GO TO 120
110 IF (ITRY.EQ.1) GO TO 120
ITRY=1
NODE1=NODPLC(LOC+1)
GO TO 90
120 CONTINUE
C
C IN DC ANALYSIS, CYCLE THROUGH INDUCTORS ALSO
C
130 IF (MODE.GT.1) GO TO 140
ID=ID-3
IF (ID.GT.0) GO TO 80
C
C IF NO ELEMENT WAS LOADED ON ABOVE SEARCH, THE CIRCUIT CONTAINS A
C LOOP OF SOURCES AND/OR INDUCTORS
C
140 IF (IFLAG.EQ.1) GO TO 70
NOGO=1
WRITE (6,141)
141 FORMAT (//5X,'---------- INPUT DATA CONTAINS A LOOP OF VOLTAGE '
1 'SOURCES AND/OR INDUCTORS'//)
GO TO 1100
C
C ORDER REMAINING NODES IN THE CIRCUIT ARBITRARILY
C
150 NEXNOD=1
DO 160 I=1,NUMNOD
160 IUR(I)=1
IUR(NUMNOD+1)=1
DO 170 I=2,NUMNOD
IF (JMNODE(I).NE.0) GO TO 170
JMNODE(I)=NEXNOD
IORDER(NEXNOD)=I
NEXNOD=NEXNOD+1
170 CONTINUE
NSTOP=NEXNOD-1
C
C RESERVE MATRIX LOCATIONS IN IUR,IUC
C
C RESISTORS, CAPACITORS, INDUCTORS
C
ISTOP=LOCATE(4)-1
IF (MODE.NE.1) GO TO 210
ISTOP=LOCATE(3)-1
210 IF (ISTOP.LT.1) GO TO 230
DO 220 I=1,ISTOP
LOC=LOCAL(I)
NODE1=NODPLC(LOC)
NODE2=NODPLC(LOC+1)
CALL RESERV(NODE1,NODE2)
220 CONTINUE
C
C VOLTAGE CONTROLLED CURRENT SOURCES
C
230 ISTART=LOCATE(5)
ISTOP=LOCATE(6)-1
IF (ISTART.GT.ISTOP) GO TO 250
DO 240 I=ISTART,ISTOP
LOC=LOCAL(I)
NODE1=NODPLC(LOC)
NODE2=NODPLC(LOC+1)
NODE3=NODPLC(LOC+2)
NODE4=NODPLC(LOC+3)
CALL RESERV(NODE1,NODE3)
CALL RESERV(NODE1,NODE4)
CALL RESERV(NODE2,NODE3)
CALL RESERV(NODE2,NODE4)
240 CONTINUE
C
C TRANSISTORS
C
250 ISTART=LOCATE(7)
ISTOP=LOCATE(8)-1
IF (ISTART.GT.ISTOP) GO TO 270
DO 260 I=ISTART,ISTOP
LOC=LOCAL(I)
NODE1=NODPLC(LOC)
NODE2=NODPLC(LOC+1)
NODE3=NODPLC(LOC+2)
NODE4=NODPLC(LOC+3)
NODE5=NODPLC(LOC+4)
NODE6=NODPLC(LOC+5)
CALL RESERV(NODE1,NODE4)
CALL RESERV(NODE2,NODE5)
CALL RESERV(NODE3,NODE6)
CALL RESERV(NODE4,NODE5)
CALL RESERV(NODE4,NODE6)
CALL RESERV(NODE5,NODE6)
260 CONTINUE
C
C DIODES
C
270 ISTART=LOCATE(8)
ISTOP=LOCATE(9)-1
IF (ISTART.GT.ISTOP) GO TO 290
DO 280 I=ISTART,ISTOP
LOC=LOCAL(I)
NODE1=NODPLC(LOC)
NODE2=NODPLC(LOC+1)
NODE3=NODPLC(LOC+2)
CALL RESERV(NODE1,NODE3)
CALL RESERV(NODE2,NODE3)
280 CONTINUE
C
C JFETS
C
290 ISTART=LOCATE(9)
ISTOP=LOCATE(10)-1
IF (ISTART.GT.ISTOP) GO TO 310
DO 300 I=ISTART,ISTOP
LOC=LOCAL(I)
NODE1=NODPLC(LOC)
NODE2=NODPLC(LOC+1)
NODE3=NODPLC(LOC+2)
NODE4=NODPLC(LOC+3)
NODE5=NODPLC(LOC+4)
CALL RESERV(NODE1,NODE4)
CALL RESERV(NODE2,NODE4)
CALL RESERV(NODE2,NODE5)
CALL RESERV(NODE3,NODE5)
CALL RESERV(NODE4,NODE5)
300 CONTINUE
C
C MOSFETS
C
310 ISTART=LOCATE(10)
ISTOP=LOCATE(11)-1
IF (ISTART.GT.ISTOP) GO TO 350
DO 320 I=ISTART,ISTOP
LOC=LOCAL(I)
NODE1=NODPLC(LOC)
NODE2=NODPLC(LOC+1)
NODE3=NODPLC(LOC+2)
NODE4=NODPLC(LOC+3)
NODE5=NODPLC(LOC+4)
NODE6=NODPLC(LOC+5)
CALL RESERV(NODE1,NODE5)
CALL RESERV(NODE2,NODE4)
CALL RESERV(NODE2,NODE5)
CALL RESERV(NODE2,NODE6)
CALL RESERV(NODE3,NODE6)
CALL RESERV(NODE4,NODE5)
CALL RESERV(NODE4,NODE6)
CALL RESERV(NODE5,NODE6)
320 CONTINUE
C
C SOURCE TERMS ... IF SOURCE HAS POSITIVE NODE N+ AND NEGATIVE NODE
C N-, THEN FOR EVERY (N+,I) TERM (WITH I LT N+) THAT EXISTS, RESERVE
C A (N-,I) TERM
C
350 IF (NUMVS.EQ.0) GO TO 400
DO 380 I=1,NUMVS
IELNUM=MATLOC(I+800)
LOC=LOCAL(IELNUM)
NODE1=NODPLC(LOC)
NODE2=NODPLC(LOC+1)
IF (NODE2.EQ.1) GO TO 380
JSTART=IUR(NODE1)
JSTOP=IUR(NODE1+1)-1
IF (JSTART.GT.JSTOP) GO TO 380
NTERMS=0
DO 360 J=JSTART,JSTOP
NTERMS=NTERMS+1
ITROW(NTERMS)=IUC(J)
360 CONTINUE
DO 370 J=1,NTERMS
CALL RESERV(NODE2,ITROW(J))
370 CONTINUE
380 CONTINUE
C
C CALL POINT TO REORDER NODES FOR MINIMAL FILLIN
C
400 IF (IGOOF.EQ.1) GO TO 1000
NTTB=IUR(NUMNOD+1)-1
CALL POINT
IF (IGOOF.EQ.1) GO TO 1000
C
C STORE MATRIX LOCATIONS FOR EACH DEVICE
C
IFIND=NUMVS+2*(JELCNT(1)+JELCNT(2)+JELCNT(3))+4*JELCNT(5)
1 +12*JELCNT(7)+4*JELCNT(8)+10*JELCNT(9)+16*JELCNT(10)
IF (IFIND.GT.1800) GO TO 1000
IF (NUMVS.EQ.0) GO TO 410
DO 405 I=1,NUMVS
405 MATLOC(I)=MATLOC(I+800)
410 IFIND=NUMVS
C
C RESISTORS, CAPACITORS, INDUCTORS
C
ISTOP=LOCATE(4)-1
IF (MODE.NE.1) GO TO 420
ISTOP=LOCATE(3)-1
420 IF (ISTOP.LT.1) GO TO 440
DO 430 I=1,ISTOP
LOC=LOCAL(I)
NODE1=NODPLC(LOC)
NODE2=NODPLC(LOC+1)
MATLOC(IFIND+1)=INDEX(NODE1,NODE2)
MATLOC(IFIND+2)=INDEX(NODE2,NODE1)
IFIND=IFIND+2
430 CONTINUE
C
C VOLTAGE DEPENDENT CURRENT SOURCES
C
440 ISTART=LOCATE(5)
ISTOP=LOCATE(6)-1
IF (ISTART.GT.ISTOP) GO TO 460
DO 450 I=ISTART,ISTOP
LOC=LOCAL(I)
NODE1=NODPLC(LOC)
NODE2=NODPLC(LOC+1)
NODE3=NODPLC(LOC+2)
NODE4=NODPLC(LOC+3)
MATLOC(IFIND+1)=INDEX(NODE1,NODE3)
MATLOC(IFIND+2)=INDEX(NODE1,NODE4)
MATLOC(IFIND+3)=INDEX(NODE2,NODE3)
MATLOC(IFIND+4)=INDEX(NODE2,NODE4)
IFIND=IFIND+4
450 CONTINUE
C
C TRANSISTORS
C
460 ISTART=LOCATE(7)
ISTOP=LOCATE(8)-1
IF (ISTART.GT.ISTOP) GO TO 480
DO 470 I=ISTART,ISTOP
LOC=LOCAL(I)
NODE1=NODPLC(LOC)
NODE2=NODPLC(LOC+1)
NODE3=NODPLC(LOC+2)
NODE4=NODPLC(LOC+3)
NODE5=NODPLC(LOC+4)
NODE6=NODPLC(LOC+5)
MATLOC(IFIND+1)=INDEX(NODE1,NODE4)
MATLOC(IFIND+2)=INDEX(NODE2,NODE5)
MATLOC(IFIND+3)=INDEX(NODE3,NODE6)
MATLOC(IFIND+4)=INDEX(NODE4,NODE1)
MATLOC(IFIND+5)=INDEX(NODE4,NODE5)
MATLOC(IFIND+6)=INDEX(NODE4,NODE6)
MATLOC(IFIND+7)=INDEX(NODE5,NODE2)
MATLOC(IFIND+8)=INDEX(NODE5,NODE4)
MATLOC(IFIND+9)=INDEX(NODE5,NODE6)
MATLOC(IFIND+10)=INDEX(NODE6,NODE3)
MATLOC(IFIND+11)=INDEX(NODE6,NODE4)
MATLOC(IFIND+12)=INDEX(NODE6,NODE5)
IFIND=IFIND+12
470 CONTINUE
C
C DIODES
C
480 ISTART=LOCATE(8)
ISTOP=LOCATE(9)-1
IF (ISTART.GT.ISTOP) GO TO 500
DO 490 I=ISTART,ISTOP
LOC=LOCAL(I)
NODE1=NODPLC(LOC)
NODE2=NODPLC(LOC+1)
NODE3=NODPLC(LOC+2)
MATLOC(IFIND+1)=INDEX(NODE1,NODE3)
MATLOC(IFIND+2)=INDEX(NODE2,NODE3)
MATLOC(IFIND+3)=INDEX(NODE3,NODE1)
MATLOC(IFIND+4)=INDEX(NODE3,NODE2)
IFIND=IFIND+4
490 CONTINUE
C
C JFETS
C
500 ISTART=LOCATE(9)
ISTOP=LOCATE(10)-1
IF (ISTART.GT.ISTOP) GO TO 520
DO 510 I=ISTART,ISTOP
LOC=LOCAL(I)
NODE1=NODPLC(LOC)
NODE2=NODPLC(LOC+1)
NODE3=NODPLC(LOC+2)
NODE4=NODPLC(LOC+3)
NODE5=NODPLC(LOC+4)
MATLOC(IFIND+1)=INDEX(NODE1,NODE4)
MATLOC(IFIND+2)=INDEX(NODE2,NODE4)
MATLOC(IFIND+3)=INDEX(NODE2,NODE5)
MATLOC(IFIND+4)=INDEX(NODE3,NODE5)
MATLOC(IFIND+5)=INDEX(NODE4,NODE1)
MATLOC(IFIND+6)=INDEX(NODE4,NODE2)
MATLOC(IFIND+7)=INDEX(NODE4,NODE5)
MATLOC(IFIND+8)=INDEX(NODE5,NODE2)
MATLOC(IFIND+9)=INDEX(NODE5,NODE3)
MATLOC(IFIND+10)=INDEX(NODE5,NODE4)
IFIND=IFIND+10
510 CONTINUE
C
C MOSFETS
C
520 ISTART=LOCATE(10)
ISTOP=LOCATE(11)-1
IF (ISTART.GT.ISTOP) GO TO 550
DO 530 I=ISTART,ISTOP
LOC=LOCAL(I)
NODE1=NODPLC(LOC)
NODE2=NODPLC(LOC+1)
NODE3=NODPLC(LOC+2)
NODE4=NODPLC(LOC+3)
NODE5=NODPLC(LOC+4)
NODE6=NODPLC(LOC+5)
MATLOC(IFIND+1)=INDEX(NODE1,NODE5)
MATLOC(IFIND+2)=INDEX(NODE2,NODE4)
MATLOC(IFIND+3)=INDEX(NODE2,NODE5)
MATLOC(IFIND+4)=INDEX(NODE2,NODE6)
MATLOC(IFIND+5)=INDEX(NODE3,NODE6)
MATLOC(IFIND+6)=INDEX(NODE4,NODE2)
MATLOC(IFIND+7)=INDEX(NODE4,NODE5)
MATLOC(IFIND+8)=INDEX(NODE4,NODE6)
MATLOC(IFIND+9)=INDEX(NODE5,NODE1)
MATLOC(IFIND+10)=INDEX(NODE5,NODE2)
MATLOC(IFIND+11)=INDEX(NODE5,NODE4)
MATLOC(IFIND+12)=INDEX(NODE5,NODE6)
MATLOC(IFIND+13)=INDEX(NODE6,NODE2)
MATLOC(IFIND+14)=INDEX(NODE6,NODE3)
MATLOC(IFIND+15)=INDEX(NODE6,NODE4)
MATLOC(IFIND+16)=INDEX(NODE6,NODE5)
IFIND=IFIND+16
530 CONTINUE
C
C VOLTAGE SOURCES (AND INDUCTORS IN DC ANALYSIS)
C
550 IF (NUMVS.EQ.0) GO TO 600
DO 560 I=1,NUMVS
IELNUM=MATLOC(I)
LOC=LOCAL(IELNUM)
NODE1=NODPLC(LOC)
NODE2=NODPLC(LOC+1)
NODPLC(LOC+3)=JMNODE(NODE1)
NODPLC(LOC+4)=JMNODE(NODE2)
560 CONTINUE
C
C FINISHED
C
600 LASTUT=IUS+IUR(NUMNOD+1)-2
LASTLT=LASTUT+MIRROR
IF (IACCT.EQ.0) GO TO 1100
NUTAR=IUR(NSTOP+1)-1
NSTERM=IUR(NUMNOD+1)-1-NUTAR
NUTBR=(NTTB-NSTERM)/2
IFILL=NUTAR-NUTBR
NTTERM=NUMNOD+2*(NUTAR+NSTERM)-1
NNODE=NUMNOD-1
PERSPA=100.0*(1.0-FLOAT(NTTERM)/FLOAT(NNODE*NNODE))
IOPS=0
IF (NSTOP.EQ.0) GO TO 620
DO 610 I=1,NSTOP
NOPS=IUR(I+1)-IUR(I)
IOPS=IOPS+NOPS*NOPS
610 CONTINUE
620 WRITE (6,621) NNODE,NSTOP,NUTBR,NUTAR,IFILL,NSTERM,NTTERM,IOPS,
1 PERSPA
621 FORMAT (//5X,'MATRIX STATISTICS'//6X,'NODES',3X,'NSTOP',3X,
1 'NUTBR',3X,'NUTAR',3X,'IFILL',2X,'NSTERM',2X,'NTTERM',3X,
2 'IOPS',4X,'PERSPA'//6X,8(I4,4X),F6.3)
GO TO 1100
1000 NOGO=1
WRITE (6,1001) IUR(NUMNOD+1),IFIND
1001 FORMAT (1H1,4X,'---------- PROGRAM ERROR ... SETUP'//
1 5X,'ARRAY SIZE EXCEEDED ... IUTOT = ',I4,3X,'IFIND = ',I4)
1100 CALL SECOND(T2)
RTIMES(2)=RTIMES(2)+T2-T1
RETURN
END
SUBROUTINE RESERV (NODE1,NODE2)
COMMON NODPLC(800),YNL(2001),TSTORE(2001),TRACUR(1700),VN(401),
1 VNIM1(401),IORDER(401),IUR(402),IUC(800),MATLOC(1800)
COMMON/INDATA/NUMEL,NUNODS,NUMNOD,NOSTOP,JELCNT(20),LOCATE(21),
1 ICURNT(21),JUNODE(401),NAME(200),LOCAL(200),MNAME(200)
COMMON/MISCEL/NOGO,IGOOF,NOPRNT,IACCT,JOBNAM(16),RTIMES(15)
COMMON/POINTS/IUS,ILS,MIRROR,NSTOP,NUMVS,LASTUT,LASTLT
C
C
DIMENSION JMNODE(1)
EQUIVALENCE (JMNODE(1),VN(1))
C
C
IF (NODE1.EQ.1) RETURN
IF (NODE2.EQ.1) RETURN
IF (NODE1.EQ.NODE2) RETURN
IF (JMNODE(NODE1).GT.JMNODE(NODE2)) GO TO 10
N1=NODE2
N2=NODE1
GO TO 20
10 N1=NODE1
N2=NODE2
C
C LOOKUP LOWER TRIANGLE (N1,N2) TERM
C
20 II=IUR(N1)
ISTOP=IUR(N1+1)-1
30 IF (II.GT.ISTOP) GO TO 40
IF (IUC(II).EQ.N2) RETURN
II=II+1
GO TO 30
C
C LOWER TRIANGLE TERM DOES NOT EXIST, RESERVE IT
C
40 JJ=IUR(NUMNOD+1)
IF (JJ.GT.1600) GO TO 1000
50 IF (JJ.LE.II) GO TO 60
IUC(JJ)=IUC(JJ-1)
JJ=JJ-1
GO TO 50
60 IUC(II)=N2
JJ=N1+1
JSTOP=NUMNOD+1
70 IF (JJ.GT.JSTOP) GO TO 100
IUR(JJ)=IUR(JJ)+1
JJ=JJ+1
GO TO 70
C
C RESERVE UPPER TRIANGLE (N2,N1) TERM ONLY IF N1 IS NOT A SOURCE NODE
C
100 IF (JMNODE(N1).GT.NSTOP) RETURN
II=IUR(N2+1)
JJ=IUR(NUMNOD+1)
IF (JJ.GT.1600) GO TO 1000
110 IF (JJ.LE.II) GO TO 120
IUC(JJ)=IUC(JJ-1)
JJ=JJ-1
GO TO 110
120 IUC(II)=N1
JJ=N2+1
130 IF (JJ.GT.JSTOP) RETURN
IUR(JJ)=IUR(JJ)+1
JJ=JJ+1
GO TO 130
1000 IGOOF=1
RETURN
END
FUNCTION INDEX(NODE1,NODE2)
COMMON NODPLC(800),YNL(2001),TSTORE(2001),TRACUR(1700),VN(401),
1 VNIM1(401),IORDER(401),IUR(402),IUC(800),MATLOC(1800)
COMMON/POINTS/IUS,ILS,MIRROR,NSTOP,NUMVS,LASTUT,LASTLT
C
C
DIMENSION JMNODE(1)
EQUIVALENCE (JMNODE(1),VN(1))
C
C IN THE FINAL POINTER SYSTEM, ONLY THE UPPER TRIANGLE TERMS ...
C (N1,N2) WITH N2 GT N1 ... ARE RETAINED IN THE IUC POINTERS, EXCEPT
C FOR SOURCE NODES, WHERE ONLY THE LOWER TRIANGLE TERMS ... (N2,N1)
C WITH N2 GT N1 ... ARE RETAINED
C
IF (NODE1.EQ.1) GO TO 100
IF (NODE2.EQ.1) GO TO 100
N1=JMNODE(NODE1)
N2=JMNODE(NODE2)
IF (N1-N2) 30,10,20
10 INDEX=NODE1
RETURN
20 ISPOT=ILS-1
IF (N1-NSTOP) 40,40,50
30 ISPOT=IUS-1
IF (N2-NSTOP) 50,50,40
40 ITEMP=N1
N1=N2
N2=ITEMP
50 ISTART=IUR(N1)
ISTOP=IUR(N1+1)-1
IF (ISTART.GT.ISTOP) GO TO 100
DO 60 I=ISTART,ISTOP
IF (IUC(I).NE.N2) GO TO 60
INDEX=ISPOT+I
RETURN
60 CONTINUE
100 INDEX=1
RETURN
END
SUBROUTINE POINT
COMMON NODPLC(800),YNL(2001),TSTORE(2001),TRACUR(1700),VN(401),
1 VNIM1(401),IORDER(401),IUR(402),IUC(800),MATLOC(1800)
COMMON/INDATA/NUMEL,NUNODS,NUMNOD,NOSTOP,JELCNT(20),LOCATE(21),
1 ICURNT(21),JUNODE(401),NAME(200),LOCAL(200),MNAME(200)
COMMON/MISCEL/NOGO,IGOOF,NOPRNT,IACCT,JOBNAM(16),RTIMES(15)
COMMON/POINTS/IUS,ILS,MIRROR,NSTOP,NUMVS,LASTUT,LASTLT
C
C
DIMENSION JMNODE(1),NUMOFF(1),NOTOLO(1),IURTMP(1),IUCTMP(1),
1 ITROW(1),ITCOL(1)
EQUIVALENCE (JMNODE(1),VN(1))
EQUIVALENCE (NUMOFF(1),IURTMP(1),YNL(1))
EQUIVALENCE (NOTOLO(1),IUCTMP(1),YNL(402))
EQUIVALENCE (ITROW(1),YNL(802))
EQUIVALENCE (ITCOL(1),YNL(1002))
C
C
IGOOF=0
NEXNOD=1
IF (NSTOP.LT.2) GO TO 300
C
C COMPUTE NUMBER OF OFF DIAGONAL TERMS FOR EACH ROW AND CONSTRUCT
C LIST OF ROWS WITH ONE OFF DIAGONAL TERM
C
NTERMS=0
DO 20 I=1,NUMNOD
NUMOFF(I)=IUR(I+1)-IUR(I)
IF (JMNODE(I).GT.NSTOP) GO TO 20
IF (NUMOFF(I).GT.1) GO TO 20
NTERMS=NTERMS+1
NOTOLO(NTERMS)=I
20 CONTINUE
C
C LOAD ROWS CONTAINED IN NOTOLO ARRAY. A ROW IS LOADED BY SWAPPING
C ITS IORDER AND JMNODE ENTRIES WITH THE ENTRIES CORRESPONDING TO
C ROW NEXNOD
C
50 ITERM=0
60 ITERM=ITERM+1
IF (ITERM.GT.NTERMS) GO TO 100
LOAD=NOTOLO(ITERM)
NODE=IORDER(NEXNOD)
IROW=JMNODE(LOAD)
JMNODE(NODE)=IROW
JMNODE(LOAD)=NEXNOD
IORDER(IROW)=NODE
IORDER(NEXNOD)=LOAD
NEXNOD=NEXNOD+1
IF (NEXNOD.GE.NSTOP) GO TO 300
C
C REDUCE THE NUMBER OF OFF DIAGONAL TERMS BY ONE FOR EACH COLUMN
C ELEMENT OF THE ROW JUST LOADED
C
JSTART=IUR(LOAD)
JSTOP=IUR(LOAD+1)-1
IF (JSTART.GT.JSTOP) GO TO 60
DO 70 J=JSTART,JSTOP
IROW=IUC(J)
IF (JMNODE(IROW).LT.NEXNOD) GO TO 70
NUMOFF(IROW)=NUMOFF(IROW)-1
C
C IF THIS SUBTRACTION CAUSES THE NUMBER OF OFF DIAGONAL TERMS IN IROW
C TO BE ONE, ADD IROW TO THE NOTOLO ARRAY
C
IF (NUMOFF(IROW).NE.1) GO TO 70
NTERMS=NTERMS+1
NOTOLO(NTERMS)=IROW
70 CONTINUE
GO TO 60
C
C ALL REMAINING ROWS HAVE AT LEAST TWO OFF DIAGONAL TERMS. DETERMINE
C THE ROW WHICH WILL CAUSE THE LEAST AMOUNT OF FILLIN. IF TWO OR MORE
C ROWS CAUSE THE SAME FILLIN, SELECT THE ONE WITH THE LARGEST NUMBER
C OF OFF DIAGONAL TERMS
C
100 IFILL=160000
LOAD=IORDER(NEXNOD)
DO 150 I=NEXNOD,NSTOP
IRFILL=0
NODE=IORDER(I)
C
C THE FILLIN IS DETERMINED BY A MOCK DECOMPOSITION OF EACH ROW
C ASSUMING IT IS LOADED NEXT
C
JSTART=IUR(NODE)
JSTOP=IUR(NODE+1)-1
DO 130 J=JSTART,JSTOP
JO=IUC(J)
IF (JMNODE(JO).LT.NEXNOD) GO TO 130
LSTART=IUR(JO)
LSTOP=IUR(JO+1)-1
K=J
110 K=K+1
IF (K.GT.JSTOP) GO TO 130
KO=IUC(K)
IF (JMNODE(KO).LT.NEXNOD) GO TO 110
C
C TEST FOR (JO,KO) MATRIX TERM. IF THIS TERM DOESNT EXIST, IT WILL
C BE CREATED IN DECOMPOSING THIS ROW
C
DO 120 L=LSTART,LSTOP
IF (IUC(L).EQ.KO) GO TO 110
120 CONTINUE
IRFILL=IRFILL+1
IF (IRFILL.GT.IFILL) GO TO 150
GO TO 110
130 CONTINUE
IF (IRFILL.LT.IFILL) GO TO 140
IF (NUMOFF(NODE).LE.NUMOFF(LOAD)) GO TO 150
140 LOAD=NODE
IFILL=IRFILL
IF (IFILL.EQ.0) GO TO 200
150 CONTINUE
C
C LOAD IS NOW THE ROW WHICH WILL CAUSE THE MINIMUM FILLIN. RESERVE
C THE FILLIN TERMS IN IUR AND IUC ARRAYS AND PUT LOAD IN LIST OF ROWS
C TO BE LOADED
C
200 NTERMS=1
NOTOLO(1)=LOAD
IF (IFILL.EQ.0) GO TO 50
IRFILL=0
JSTART=IUR(LOAD)
JSTOP=IUR(LOAD+1)-1
DO 230 J=JSTART,JSTOP
JO=IUC(J)
IF (JMNODE(JO).LT.NEXNOD) GO TO 230
LSTART=IUR(JO)
LSTOP=IUR(JO+1)-1
K=J
210 K=K+1
IF (K.GT.JSTOP) GO TO 230
KO=IUC(K)
IF (JMNODE(KO).LT.NEXNOD) GO TO 210
DO 220 L=LSTART,LSTOP
IF (IUC(L).EQ.KO) GO TO 210
220 CONTINUE
C
C ALL FILLIN TERMS ARE STORED TEMPORARILY TO AVOID ALTERING THE
C POINTERS IN THE MIDDLE OF THE MOCK DECOMPOSITION
C
IRFILL=IRFILL+1
IF (IRFILL.GT.200) GO TO 1000
ITROW(IRFILL)=JO
ITCOL(IRFILL)=KO
GO TO 210
230 CONTINUE
C
C NOW INSERT ALL FILLIN TERMS IN THE POINTERS
C
DO 240 I=1,IRFILL
JO=ITROW(I)
KO=ITCOL(I)
NUMOFF(JO)=NUMOFF(JO)+1
NUMOFF(KO)=NUMOFF(KO)+1
CALL RESERV(JO,KO)
240 CONTINUE
GO TO 50
C
C RELOAD IUR,IUC ARRAYS WITH USING THE REORDERED NODE NUMBERS. RETAIN
C ONLY THE UPPER TRIANGLE TERMS, EXCEPT FOR SOURCE NODES, WHERE ONLY
C THE LOWER TRIANGLE TERM IS RETAINED
C
300 IF (IGOOF.EQ.1) RETURN
IUTOT=0
IF (NSTOP.EQ.0) GO TO 350
DO 320 I=1,NSTOP
IURTMP(I)=IUTOT+1
NODE=IORDER(I)
JSTART=IUR(NODE)
JSTOP=IUR(NODE+1)-1
IF (JSTART.GT.JSTOP) GO TO 320
DO 310 J=JSTART,JSTOP
IROW=IUC(J)
LOAD=JMNODE(IROW)
IF (LOAD.LT.I) GO TO 310
IUTOT=IUTOT+1
IUCTMP(IUTOT)=LOAD
310 CONTINUE
320 CONTINUE
350 ISTART=NSTOP+1
IF (ISTART.GT.NUMNOD) GO TO 400
DO 370 I=ISTART,NUMNOD
IURTMP(I)=IUTOT+1
NODE=IORDER(I)
JSTART=IUR(NODE)
JSTOP=IUR(NODE+1)-1
IF (JSTART.GT.JSTOP) GO TO 370
DO 360 J=JSTART,JSTOP
IROW=IUC(J)
LOAD=JMNODE(IROW)
IUTOT=IUTOT+1
IUCTMP(IUTOT)=LOAD
360 CONTINUE
370 CONTINUE
400 IUR(NUMNOD+1)=IUTOT+1
IF (IUTOT.GT.800) GO TO 1000
DO 410 I=1,NUMNOD
410 IUR(I)=IURTMP(I)
IF (IUTOT.EQ.0) RETURN
DO 420 I=1,IUTOT
420 IUC(I)=IUCTMP(I)
RETURN
1000 IGOOF=1
RETURN
END
SUBROUTINE ITER8
COMMON NODPLC(800),YNL(2001),TSTORE(2001),TRACUR(1700),VN(401),
1 VNIM1(401),IORDER(401),IUR(402),IUC(800),MATLOC(1800)
COMMON/INDATA/NUMEL,NUNODS,NUMNOD,NOSTOP,JELCNT(20),LOCATE(21),
1 ICURNT(21),JUNODE(401),NAME(200),LOCAL(200),MNAME(200)
COMMON/PARAM/VALUE(200),SOURCE(150),SYMVAL(25,25)
COMMON/MISCEL/NOGO,IGOOF,NOPRNT,IACCT,JOBNAM(16),RTIMES(15)
COMMON/STATUS/MODE,OMEGA,TIMEE,DELTA,DELOLD,ICALC 8
COMMON/POINTS/IUS,ILS,MIRROR,NSTOP,NUMVS,LASTUT,LASTLT
COMMON/ITER/GMIN,PERTOL,VNTOL,IPASS1,IFINAL,ITERNO,IFIND
C
C
DIMENSION U(1),UL(1)
EQUIVALENCE (U(1),YNL(402)),(UL(1),YNL(1202))
C
C
LE=NSTOP-1
IF (IPASS1.NE.-1) GO TO 40
IF (LE) 220,175,155
40 IFINAL=1
ITERNO=0
50 NONCON=0
DO 60 I=1,NUMNOD
VN(I)=0.0
60 YNL(I)=0.0
DO 70 I=IUS,LASTUT
70 YNL(I)=0.0
DO 80 I=ILS,LASTLT
80 YNL(I)=0.0
CALL LOAD
IF (IGOOF.EQ.1) GO TO 1000
IF (LE) 220,175,90
C
C DECOMPOSITION
C
90 DO 150 L=1,LE
KK=IORDER(L)
IF (ABS(YNL(KK)).GT.GMIN) GO TO 130
YNL(KK)=GMIN
WRITE (6,121)
121 FORMAT (5X,'--- WARNING --- UNDERFLOW ENCOUNTERED')
130 IS=IUR(L)
IE=IUR(L+1)-1
IF (IS.GT.IE) GO TO 150
DO 140 IL=IS,IE
UL(IL)=UL(IL)/YNL(KK)
IO=IUC(IL)
IDIAG=IORDER(IO)
YNL(IDIAG)=YNL(IDIAG)-UL(IL)*U(IL)
DO 135 IU=IS,IE
JO=IUC(IU)
IF (IO-JO) 131,135,133
C
C FIND (IO,JO) MATRIX TERM (UPPER TRIANGLE)
C
131 J=IUR(IO+1)
JE=IUR(IO)
132 J=J-1
IF (J.LT.JE) GO TO 1000
IF (IUC(J).NE.JO) GO TO 132
U(J)=U(J)-UL(IL)*U(IU)
GO TO 135
C
C FIND (IO,JO) MATRIX TERM (LOWER TRIANGLE)
C
133 J=IUR(JO+1)
JE=IUR(JO)
134 J=J-1
IF (J.LT.JE) GO TO 1000
IF (IUC(J).NE.IO) GO TO 134
UL(J)=UL(J)-UL(IL)*U(IU)
135 CONTINUE
140 CONTINUE
150 CONTINUE
C
C FORWARD SUBSTITUTION
C
155 DO 170 J=1,LE
JCS=IUR(J)
JCE=IUR(J+1)-1
IF (JCE.LT.JCS) GO TO 170
JB=IORDER(J)
DO 160 I=JCS,JCE
II=IUC(I)
IB=IORDER(II)
VN(IB)=VN(IB)-VN(JB)*UL(I)
160 CONTINUE
170 CONTINUE
C
C BACK SUBSTITUTION
C
175 IO=IORDER(NSTOP)
IF (ABS(YNL(IO)).GT.GMIN) GO TO 178
YNL(IO)=GMIN
WRITE (6,121)
178 VN(IO)=VN(IO)/YNL(IO)
IF (LE.EQ.0) GO TO 220
DO 190 I=1,LE
IO=IORDER(NSTOP-I)
JS=IUR(NSTOP-I)
JE=IUR(NSTOP-I+1)-1
IF (JE.LT.JS) GO TO 185
DO 180 J=JS,JE
JJ=IUC(J)
JO=IORDER(JJ)
VN(IO)=VN(IO)-U(J)*VN(JO)
180 CONTINUE
185 VN(IO)=VN(IO)/YNL(IO)
190 CONTINUE
C
C SET SOURCE NODES TO THEIR VOLTAGE VALUE
C
220 VN(1)=0.0
IF (IPASS1.EQ.-1) RETURN
IF (NUMVS.EQ.0) GO TO 250
DO 240 I=1,NUMVS
IELNUM=MATLOC(NUMVS-I+1)
IF (IELNUM.LT.LOCATE(6)) GO TO 225
ISPOT=ICURNT(6)+2*(IELNUM-LOCATE(6))
MNAM=MNAME(IELNUM)
VAL=SOURCE(MNAM+MODE-1)
GO TO 230
225 VAL=0.0
ISPOT=ICURNT(3)+2*(IELNUM-LOCATE(3))
230 LOC=LOCAL(IELNUM)
NODE1=NODPLC(LOC)
NODE2=NODPLC(LOC+1)
SIGN=NODPLC(LOC+2)
TRACUR(ISPOT)=VN(NODE1)
VN(NODE1)=VN(NODE2)+SIGN*VAL
240 CONTINUE
C
C CHECK CONVERGENCE
C
250 ITERNO=ITERNO+1
IPASS1=0
IF (IFINAL.EQ.0) GO TO 265
DO 260 I=2,NUMNOD
TEMP1=ABS(VN(I))
IF (TEMP1.GT.1.0E20) IGOOF=1
TEMP2=ABS(VNIM1(I))
TEMP3=ABS(VN(I)-VNIM1(I))
VMIN=TEMP1
IF (TEMP2.LT.VMIN) VMIN=TEMP2
VMIN=VMIN*PERTOL
IF (VMIN.LT.VNTOL) VMIN=VNTOL
IF (TEMP3.GT.VMIN) NONCON=NONCON+1
VNIM1(I)=VN(I)
260 CONTINUE
IF (IGOOF.EQ.1) RETURN
IF (NONCON.GT.0) GO TO 275
RETURN
265 IFINAL=1
DO 270 I=2,NUMNOD
IF (ABS(VN(I)).GT.1.0E20) IGOOF=1
VNIM1(I)=VN(I)
270 CONTINUE
IF (IGOOF.EQ.1) RETURN
275 IF (ITERNO.LT.101) GO TO 50
IGOOF=1
RETURN
1000 IGOOF=1
WRITE (6,1001)
1001 FORMAT (//5X,'---------- PROGRAM ERROR IN MATRIX INVERSION'//)
RETURN
END
SUBROUTINE FOURAN
COMMON/MISCEL/NOGO,IGOOF,NOPRNT,IACCT,JOBNAM(16),RTIMES(15)
COMMON/STATUS/MODE,OMEGA,TIMEE,DELTA,DELOLD,ICALC 3
COMMON/KNSTNT/TWOPI,XLOG2,XLOG10,RAD,BOLTZ,CHARGE,VT
COMMON/OUTDAT/ROUT(101,10),FREQ(101),IONUM,IONAM(10),IOPND(10),
1 IONND(10),IOFLG(10),NUMOR(3),IOVAR(10,2),IACVAR(5)
COMMON/TRAN/JTRFLG,TSTEP,TSTOP,TSTART,NOTINT,STEPS(5),ENDPTS(5),
1 KFROUT,FORFRE,KFPTS
COMMON/TEMPER/TEMPS(6),NUMTEM,ITEMNO
C
C
DIMENSION SINCO(9),COSCO(9)
C
C
XN=KFPTS
DCCO=0.0
DO 10 I=1,9
SINCO(I)=0.0
10 COSCO(I)=0.0
ISTART=ICALC-KFPTS
IKNT=ISTART
20 IKNT=IKNT+1
IF (IKNT.GE.ICALC) GO TO 40
DCCO=DCCO+ROUT(IKNT,KFROUT)
DO 30 J=1,9
ARG=TWOPI*FLOAT(IKNT-ISTART)*FLOAT(J)/XN
SINCO(J)=SINCO(J)+ROUT(IKNT,KFROUT)*SIN(ARG)
COSCO(J)=COSCO(J)+ROUT(IKNT,KFROUT)*COS(ARG)
30 CONTINUE
GO TO 20
40 DCCO=(DCCO+0.5*(ROUT(ISTART,KFROUT)+ROUT(ICALC,KFROUT)))/XN
DO 50 J=1,9
SINCO(J)=2.0*SINCO(J)/XN
COSCO(J)=(2.0*COSCO(J)+ROUT(ISTART,KFROUT)+ROUT(ICALC,KFROUT))/XN
50 CONTINUE
WRITE (6,61) (JOBNAM(I),I=1,8),TEMPS(ITEMNO)
61 FORMAT (1H7/////1X,125(1H*)///1X,8A10,26X,'----- SPICE -----'
1 ///21X,'FOURIER ANALYSIS',40X,'TEMPERATURE ',F10.3,' DEG C'
2 ///1X,125(1H*)///)
IKNT=IOVAR(KFROUT,2)
WRITE (6,71) IONAM(IKNT),DCCO
71 FORMAT (5X,'FOURIER COMPONENTS OF TRANSIENT RESPONSE OF ',R7////
1 5X,'DC COMPONENT = ',1PE10.3//5X,'HARMONIC',9X,'FREQUENCY',
2 7X,'FOURIER',4X,'NORMALIZED',7X,'PHASE',6X,'NORMALIZED'/8X,
3 'NO',15X,'(HZ)',8X,'COMPONENT',4X,'COMPONENT',7X,'(DEG)',5X,
4 'PHASE (DEG)'//)
IKNT=1
FREQ1=FORFRE
XNORM=SQRT(SINCO(1)*SINCO(1)+COSCO(1)*COSCO(1))
XNHARM=1.0
IF (XNORM.LT.1.0E-20) GO TO 72
PNORM=RAD*ATAN2(COSCO(1),SINCO(1))
GO TO 75
72 PNORM=0.0
75 PHASEN=0.0
WRITE (6,81) IKNT,FREQ1,XNORM,XNHARM,PNORM,PHASEN
81 FORMAT (9X,I1,11X,1PE10.3,5X,E10.3,1X,0PF12.6,5X,F8.3,5X,F8.3/)
IF (XNORM.LT.1.0E-20) XNORM=1.0E-20
THD=0.0
90 IKNT=IKNT+1
IF (IKNT.GT.9) GO TO 100
FREQ1=FLOAT(IKNT)*FORFRE
HARM=SQRT(SINCO(IKNT)*SINCO(IKNT)+COSCO(IKNT)*COSCO(IKNT))
XNHARM=HARM/XNORM
IF (HARM.LT.1.0E-20) GO TO 92
PHASE=RAD*ATAN2(COSCO(IKNT),SINCO(IKNT))
GO TO 95
92 PHASE=0.0
95 PHASEN=PHASE-PNORM
THD=THD+XNHARM*XNHARM
WRITE (6,81) IKNT,FREQ1,HARM,XNHARM,PHASE,PHASEN
GO TO 90
100 THD=100.0*SQRT(THD)
WRITE (6,101) THD
101 FORMAT (//5X,'TOTAL HARMONIC DISTORTION = ',F12.6,' PERCENT')
RETURN
END
SUBROUTINE ASOL
COMMON NODPLC(800),YNL(2001),TSTORE(2001),TRACUR(1700),VN(401),
1 VNIM1(401),IORDER(401),IUR(402),IUC(800),MATLOC(1800)
COMMON/INDATA/NUMEL,NUNODS,NUMNOD,NOSTOP,JELCNT(20),LOCATE(21),
1 ICURNT(21),JUNODE(401),NAME(200),LOCAL(200),MNAME(200)
COMMON/PARAM/VALUE(200),SOURCE(150),SYMVAL(25,25)
COMMON/POINTS/IUS,ILS,MIRROR,NSTOP,NUMVS,LASTUT,LASTLT
C
C
DIMENSION U(1),UL(1)
EQUIVALENCE (U(1),YNL(402)),(UL(1),YNL(1202))
C
C LOAD VOLTAGE SOURCES IN ADJOINT EXCITATION VECTOR
C
IF (NUMVS.EQ.0) GO TO 100
DO 90 I=1,NUMVS
IELNUM=MATLOC(I)
LOC=LOCAL(IELNUM)
NODE1=NODPLC(LOC)
NODE2=NODPLC(LOC+1)
SIGN=NODPLC(LOC+2)
IPNOD=NODPLC(LOC+3)
IF (IELNUM.LT.LOCATE(6)) GO TO 10
VAL=SIGN*VALUE(IELNUM)
GO TO 20
10 VAL=0.0
20 VN(NODE2)=VN(NODE2)+VN(NODE1)-YNL(NODE1)*VAL
IF (VAL) 30,90,30
30 JSTART=IUR(IPNOD)
JSTOP=IUR(IPNOD+1)-1
IF (JSTART.GT.JSTOP) GO TO 90
DO 50 J=JSTART,JSTOP
JO=IUC(J)
NODE3=IORDER(JO)
VN(NODE3)=VN(NODE3)-UL(J)*VAL
50 CONTINUE
90 CONTINUE
C
C OBTAIN ADJOINT SOLUTION
C
100 LE=NSTOP-1
IF (LE) 200,110,120
110 IB=IORDER(1)
VN(IB)=VN(IB)/YNL(IB)
GO TO 200
C
C FORWARD SUBSTITUTION
C
120 DO 150 I=1,LE
L=IORDER(I)
VN(L)=VN(L)/YNL(L)
IUST=IUR(I)
IUE=IUR(I+1)-1
IF (IUST.GT.IUE) GO TO 150
DO 140 IU=IUST,IUE
II=IUC(IU)
IC=IORDER(II)
VN(IC)=VN(IC)-VN(L)*U(IU)
140 CONTINUE
150 CONTINUE
C
C BACK SUBSTITUTION
C
IB=IORDER(NSTOP)
VN(IB)=VN(IB)/YNL(IB)
DO 190 I=1,LE
IB=IORDER(NSTOP-I)
IUST=IUR(NSTOP-I)
IUE=IUR(NSTOP-I+1)-1
IF (IUST.GT.IUE) GO TO 190
DO 180 IU=IUST,IUE
JJ=IUC(IU)
JB=IORDER(JJ)
VN(IB)=VN(IB)-UL(IU)*VN(JB)
180 CONTINUE
190 CONTINUE
C
C SET SOURCES TO VOLTAGE VALUE
C
200 VN(1)=0.0
IF (NUMVS.EQ.0) RETURN
DO 240 I=1,NUMVS
IELNUM=MATLOC(NUMVS-I+1)
IF (IELNUM.LT.LOCATE(6)) GO TO 220
ISPOT=ICURNT(6)+2*(IELNUM-LOCATE(6))
VAL=VALUE(IELNUM)
GO TO 230
220 VAL=0.0
ISPOT=ICURNT(3)+2*(IELNUM-LOCATE(3))
230 LOC=LOCAL(IELNUM)
NODE1=NODPLC(LOC)
NODE2=NODPLC(LOC+1)
SIGN=NODPLC(LOC+2)
TRACUR(ISPOT)=VN(NODE1)
VN(NODE1)=VN(NODE2)+SIGN*VAL
240 CONTINUE
RETURN
END