![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to errchks.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 3BSD / cmd / spice|
Return to errchks.f CVS log | Up to [CSRG BSD Unix] / 3BSD / cmd / spice |
1.1 root 1: subroutine errchk
2: implicit double precision (a-h,o-z)
3: c
4: c
5: c this routine drives the pre-processing and general error-checking
6: c of input performed by spice.
7: c
8: common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
9: 1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
10: 2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
11: 3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
12: 4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
13: 5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
14: common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
15: 1 defas,rstats(50),iwidth,lwidth,nopage
16: common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
17: 1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
18: common /cje/ maxtim,itime,icost
19: common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
20: 1 xmu,mode,modedc,icalc,initf,method,iord,maxord,noncon,iterno,
21: 2 itemno,nosolv,ipostp,iscrch
22: common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
23: 1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
24: common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok,
25: 1 gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox
26: common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop,
27: 1 kinel,kidin,kovar,kidout
28: common /ac/ fstart,fstop,fincr,skw2,refprl,spw2,jacflg,idfreq,
29: 1 inoise,nosprt,nosout,nosin,idist,idprt
30: common /tran/ tstep,tstop,tstart,delmax,tdmax,forfre,jtrflg
31: common /outinf/ xincr,string(15),xstart,yvar(8),itab(8),itype(8),
32: 1 ilogy(8),npoint,numout,kntr,numdgt
33: common /blank/ value(1000)
34: integer nodplc(64)
35: complex*16 cvalue(32)
36: equivalence (value(1),nodplc(1),cvalue(1))
37: c
38: c
39: dimension titlop(4)
40: dimension nnods(50),aname(2)
41: data aname / 4htrap, 4hgear /
42: data titlop / 8hoption s, 8hummary , 8h , 8h /
43: data ndefin / 2h.u /
44: data nnods / 2, 2, 2, 0, 2, 2, 2, 2, 2, 2,
45: 1 2, 4, 3, 4, 0, 0, 4, 0, 1, 0,
46: 2 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
47: 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
48: 4 2, 2, 2, 0, 0, 0, 0, 0, 0, 0 /
49: data aelmt,amodel,aoutpt /7helement,5hmodel,6houtput/
50: data alsdc,alstr,alsac / 2hdc, 4htran, 2hac /
51: c
52: c
53: call second(t1)
54: do 60 id=1,50
55: loc=locate(id)
56: 10 if (loc.eq.0) go to 60
57: if (nodplc(loc+2).ne.ndefin) go to 50
58: nogo=1
59: locv=nodplc(loc+1)
60: if (id.ge.21) go to 20
61: anam=aelmt
62: go to 40
63: 20 if (id.ge.31) go to 30
64: anam=amodel
65: go to 40
66: 30 anam=aoutpt
67: 40 write (6,41) anam,value(locv)
68: 41 format('0*error*: ',2a8,' has been referenced but not defined'/)
69: 50 loc=nodplc(loc)
70: go to 10
71: 60 continue
72: if (nogo.ne.0) go to 2000
73: c
74: c construct ordered list of user specified nodes
75: c
76: call getm4(junode,1)
77: nodplc(junode+1)=0
78: nunods=1
79: do 180 id=1,50
80: if (nnods(id).eq.0) go to 180
81: loc=locate(id)
82: 110 if (loc.eq.0) go to 180
83: if (id.le.4) go to 120
84: if (id.le.8) go to 150
85: if (id.eq.19) go to 165
86: if (id.le.40) go to 120
87: if (id.le.43) go to 170
88: 120 jstop=loc+nnods(id)-1
89: do 130 j=loc,jstop
90: call putnod(nodplc(j+2))
91: 130 continue
92: go to 170
93: 150 call putnod(nodplc(loc+2))
94: call putnod(nodplc(loc+3))
95: if (id.ge.7) go to 170
96: locp=nodplc(loc+id+1)
97: nssnod=2*nodplc(loc+4)
98: 155 do 160 j=1,nssnod
99: call putnod(nodplc(locp+j))
100: 160 continue
101: go to 170
102: 165 locp=nodplc(loc+2)
103: call sizmem(nodplc(loc+2),nssnod)
104: go to 155
105: 170 loc=nodplc(loc)
106: go to 110
107: 180 continue
108: if (nogo.ne.0) go to 2000
109: ncnods=nunods
110: c
111: c assign program nodes
112: c
113: 200 do 280 id=1,50
114: if (nnods(id).eq.0) go to 280
115: loc=locate(id)
116: 210 if (loc.eq.0) go to 280
117: if (id.le.4) go to 220
118: if (id.le.8) go to 250
119: if (id.eq.19) go to 265
120: if (id.le.40) go to 220
121: if (id.le.43) go to 240
122: 220 jstop=loc+nnods(id)-1
123: do 230 j=loc,jstop
124: call getnod(nodplc(j+2))
125: 230 continue
126: go to 270
127: 240 if (nodplc(loc+5).eq.0) go to 220
128: go to 270
129: 250 call getnod(nodplc(loc+2))
130: call getnod(nodplc(loc+3))
131: if (id.ge.7) go to 270
132: locp=nodplc(loc+id+1)
133: nssnod=2*nodplc(loc+4)
134: 255 do 260 j=1,nssnod
135: call getnod(nodplc(locp+j))
136: 260 continue
137: go to 270
138: 265 locp=nodplc(loc+2)
139: call sizmem(nodplc(loc+2),nssnod)
140: go to 255
141: 270 loc=nodplc(loc)
142: go to 210
143: 280 continue
144: c
145: c check and set .nodeset nodes to their internal values
146: c
147: call sizmem(nsnod,nic)
148: if(nic.eq.0) go to 300
149: do 290 i=1,nic
150: call getnod(nodplc(nsnod+i))
151: 290 continue
152: c
153: c check and set .ic nodes to their internal values
154: c
155: 300 call sizmem(icnod,nic)
156: if(nic.eq.0) go to 320
157: do 310 i=1,nic
158: call getnod(nodplc(icnod+i))
159: 310 continue
160: 320 if (nogo.ne.0) go to 2000
161: c
162: c expand subcircuit calls
163: c
164: call subckt
165: if (nogo.ne.0) go to 2000
166: if (ncnods.ge.2) go to 400
167: write (6,321)
168: 321 format('0*error*: circuit has no nodes'/)
169: nogo=1
170: go to 2000
171: 400 numnod=ncnods
172: c
173: c link unsatisfied references
174: c
175: call lnkref
176: if (nogo.ne.0) go to 2000
177: c
178: c generate subcircuit element names
179: c
180: if (jelcnt(19).eq.0) go to 530
181: do 520 id=1,24
182: loc=locate(id)
183: 510 if (loc.eq.0) go to 520
184: call subnam(loc)
185: loc=nodplc(loc)
186: go to 510
187: 520 continue
188: c
189: c translate node initial conditions to device initial conditions
190: c (capacitance, diode, bjt, and mosfet only
191: c
192: 530 call sizmem(icnod,nic)
193: if(nic.eq.0) go to 600
194: call getm8(lvnim1,numnod)
195: call zero8(value(lvnim1+1),numnod)
196: do 535 i=1,nic
197: node=nodplc(icnod+i)
198: 535 value(lvnim1+node)=value(icval+i)
199: loc=locate(2)
200: 540 if(loc.eq.0) go to 550
201: locv=nodplc(loc+1)
202: if(value(locv+2).ne.0.0d0) go to 545
203: node1=nodplc(loc+2)
204: node2=nodplc(loc+3)
205: value(locv+2)=value(lvnim1+node1)-value(lvnim1+node2)
206: 545 loc=nodplc(loc)
207: go to 540
208: 550 loc=locate(11)
209: 555 if(loc.eq.0) go to 565
210: locv=nodplc(loc+1)
211: if(value(locv+2).ne.0.0d0) go to 560
212: node1=nodplc(loc+2)
213: node2=nodplc(loc+3)
214: value(locv+2)=value(lvnim1+node1)-value(lvnim1+node2)
215: 560 loc=nodplc(loc)
216: go to 555
217: 565 loc=locate(12)
218: 570 if(loc.eq.0) go to 580
219: locv=nodplc(loc+1)
220: node1=nodplc(loc+2)
221: node2=nodplc(loc+3)
222: node3=nodplc(loc+4)
223: if(value(locv+2).eq.0.0d0) value(locv+2)=value(lvnim1+node2)-
224: 1 value(lvnim1+node3)
225: if(value(locv+3).eq.0.0d0) value(locv+3)=value(lvnim1+node1)-
226: 1 value(lvnim1+node3)
227: loc=nodplc(loc)
228: go to 570
229: 580 loc=locate(13)
230: 585 if(loc.eq.0) go to 590
231: locv=nodplc(loc+1)
232: node1=nodplc(loc+2)
233: node2=nodplc(loc+3)
234: node3=nodplc(loc+4)
235: if(value(locv+2).eq.0.0d0) value(locv+2)=value(lvnim1+node1)-
236: 1 value(lvnim1+node3)
237: if(value(locv+3).eq.0.0d0) value(locv+3)=value(lvnim1+node2)-
238: 1 value(lvnim1+node3)
239: loc=nodplc(loc)
240: go to 585
241: 590 loc=locate(14)
242: 595 if(loc.eq.0) go to 598
243: locv=nodplc(loc+1)
244: node1=nodplc(loc+2)
245: node2=nodplc(loc+3)
246: node3=nodplc(loc+4)
247: node4=nodplc(loc+5)
248: if(value(locv+5).eq.0.0d0) value(locv+5)=value(lvnim1+node1)-
249: 1 value(lvnim1+node3)
250: if(value(locv+6).eq.0.0d0) value(locv+6)=value(lvnim1+node2)-
251: 1 value(lvnim1+node3)
252: if(value(locv+7).eq.0.0d0) value(locv+7)=value(lvnim1+node4)-
253: 1 value(lvnim1+node3)
254: loc=nodplc(loc)
255: go to 595
256: 598 call clrmem(lvnim1)
257: c
258: c process sources
259: c
260: 600 if (jtrflg.eq.0) go to 700
261: do 690 id=9,10
262: loc=locate(id)
263: 610 if (loc.eq.0) go to 690
264: locv=nodplc(loc+1)
265: locp=nodplc(loc+5)
266: jtype=nodplc(loc+4)+1
267: go to (680,620,630,640,650,675), jtype
268: 620 value(locp+3)=dmax1(value(locp+3),0.0d0)
269: if (value(locp+4).le.0.0d0) value(locp+4)=tstep
270: if (value(locp+5).le.0.0d0) value(locp+5)=tstep
271: if (value(locp+6).le.0.0d0) value(locp+6)=tstop
272: if (value(locp+7).le.0.0d0) value(locp+7)=tstop
273: temp=value(locp+4)+value(locp+5)+value(locp+6)
274: value(locp+7)=dmax1(value(locp+7),temp)
275: value(locv+1)=value(locp+1)
276: go to 680
277: 630 if (value(locp+3).le.0.0d0) value(locp+3)=1.0d0/tstop
278: value(locp+4)=dmax1(value(locp+4),0.0d0)
279: value(locv+1)=value(locp+1)
280: go to 680
281: 640 value(locp+3)=dmax1(value(locp+3),0.0d0)
282: if (value(locp+4).le.0.0d0) value(locp+4)=tstep
283: if (value(locp+5).le.value(locp+3))
284: 1 value(locp+5)=value(locp+3)+tstep
285: if (value(locp+6).le.0.0d0) value(locp+6)=tstep
286: value(locv+1)=value(locp+1)
287: go to 680
288: 650 value(locp+1)=dmin1(dmax1(value(locp+1),0.0d0),tstop)
289: iknt=1
290: call sizmem(nodplc(loc+5),nump)
291: 660 temp=value(locp+iknt)
292: if (value(locp+iknt+2).eq.0.0d0) go to 670
293: if (value(locp+iknt+2).ge.tstop) go to 670
294: value(locp+iknt+2)=dmax1(value(locp+iknt+2),temp)
295: if(temp.ne.value(locp+iknt+2)) go to 665
296: write(6,661) value(locv)
297: 661 format('0*error*: element ',a8,' piecewise linear source table no
298: 1t increasing in time')
299: nogo=1
300: 665 iknt=iknt+2
301: if (iknt.lt.nump) go to 660
302: 670 value(locp+iknt+2)=tstop
303: value(locv+1)=value(locp+2)
304: call relmem(nodplc(loc+5),nump-iknt-3)
305: go to 680
306: 675 if (value(locp+3).le.0.0d0) value(locp+3)=1.0d0/tstop
307: if (value(locp+5).le.0.0d0) value(locp+5)=1.0d0/tstop
308: value(locv+1)=value(locp+1)
309: 680 loc=nodplc(loc)
310: go to 610
311: 690 continue
312: c
313: c use default values for mos device geometries if not specified
314: c
315: 700 loc=locate(14)
316: 710 if(loc.eq.0) go to 720
317: locv=nodplc(loc+1)
318: if(value(locv+1).le.0.0d0) value(locv+1)=defl
319: if(value(locv+2).le.0.0d0) value(locv+2)=defw
320: if(value(locv+3).le.0.0d0) value(locv+3)=defad
321: if(value(locv+4).le.0.0d0) value(locv+4)=defas
322: loc=nodplc(loc)
323: go to 710
324: c
325: c print listing of elements, process device models,
326: c and check topology
327: c
328: 720 if (iprntl.eq.0) go to 730
329: call elprnt
330: 730 call topchk
331: call modchk
332: if (nogo.ne.0) go to 2000
333: c
334: c invert resistance values
335: c
336: 800 loc=locate(1)
337: 810 if (loc.eq.0) go to 900
338: locv=nodplc(loc+1)
339: value(locv+1)=1.0d0/value(locv+2)
340: loc=nodplc(loc)
341: go to 810
342: c
343: c process mutual inductors
344: c
345: 900 loc=locate(4)
346: 910 if (loc.eq.0) go to 940
347: locv=nodplc(loc+1)
348: nl1=nodplc(loc+2)
349: call sizmem(nodplc(nl1+10),nparam)
350: if (nparam.ne.1) go to 920
351: ispot1=nodplc(nl1+1)
352: jspot=nodplc(nl1+10)
353: value(ispot1+1)=value(jspot+1)
354: if (value(ispot1+1).lt.0.0d0) go to 920
355: nl2=nodplc(loc+3)
356: call sizmem(nodplc(nl2+10),nparam)
357: if (nparam.ne.1) go to 920
358: ispot2=nodplc(nl2+1)
359: jspot=nodplc(nl2+10)
360: value(ispot2+1)=value(jspot+1)
361: if (value(ispot2+1).lt.0.0d0) go to 920
362: value(locv+1)=value(locv+1)*dsqrt(value(ispot1+1)*value(ispot2+1))
363: go to 930
364: 920 write (6,921) value(locv)
365: 921 format('0*error*: inductors coupled by ',a8,' are negative or non
366: 1linear'/)
367: nogo=1
368: 930 loc=nodplc(loc)
369: go to 910
370: 940 if (nogo.ne.0) go to 2000
371: c
372: c limit delmax to minimum delay over 2 if transmission lines in circuit
373: c
374: if (jtrflg.eq.0) go to 1200
375: tdmax=0.0d0
376: loc=locate(17)
377: 1010 if (loc.eq.0) go to 1200
378: locv=nodplc(loc+1)
379: delmax=dmin1(delmax,value(locv+2)/2.0d0)
380: tdmax=dmax1(tdmax,value(locv+2))
381: loc=nodplc(loc)
382: go to 1010
383: c
384: c process source parameters
385: c
386: 1200 numbkp=0
387: if (jtrflg.eq.0) go to 1205
388: tol=1.0d-2*delmax
389: numbkp=2
390: call getm8(lsbkpt,numbkp)
391: value(lsbkpt+1)=0.0d0
392: value(lsbkpt+2)=tstop
393: 1205 do 1290 id=9,10
394: loc=locate(id)
395: 1210 if (loc.eq.0) go to 1290
396: locv=nodplc(loc+1)
397: locp=nodplc(loc+5)
398: temp=value(locv+3)/rad
399: value(locv+3)=value(locv+2)*dsin(temp)
400: value(locv+2)=value(locv+2)*dcos(temp)
401: if (jtrflg.eq.0) go to 1280
402: jtype=nodplc(loc+4)+1
403: go to (1280,1220,1230,1235,1240,1260), jtype
404: 1220 value(locp+4)=value(locp+4)+value(locp+3)
405: temp=value(locp+5)
406: value(locp+5)=value(locp+4)+value(locp+6)
407: value(locp+6)=value(locp+5)+temp
408: time=0.0d0
409: 1225 call extmem(lsbkpt,4)
410: value(lsbkpt+numbkp+1)=value(locp+3)+time
411: value(lsbkpt+numbkp+2)=value(locp+4)+time
412: value(lsbkpt+numbkp+3)=value(locp+5)+time
413: value(lsbkpt+numbkp+4)=value(locp+6)+time
414: numbkp=numbkp+4
415: time=time+value(locp+7)
416: if (time.ge.tstop) go to 1280
417: go to 1225
418: 1230 value(locp+3)=value(locp+3)*twopi
419: call extmem(lsbkpt,1)
420: 1231 value(lsbkpt+numbkp+1)=value(locp+4)
421: numbkp=numbkp+1
422: go to 1280
423: 1235 call extmem(lsbkpt,2)
424: value(lsbkpt+numbkp+1)=value(locp+3)
425: value(lsbkpt+numbkp+2)=value(locp+5)
426: numbkp=numbkp+2
427: go to 1280
428: 1240 iknt=1
429: call sizmem(nodplc(loc+5),nump)
430: 1250 call extmem(lsbkpt,1)
431: value(lsbkpt+numbkp+1)=value(locp+iknt)
432: numbkp=numbkp+1
433: iknt=iknt+2
434: if (iknt.le.nump) go to 1250
435: go to 1280
436: 1260 value(locp+3)=value(locp+3)*twopi
437: value(locp+5)=value(locp+5)*twopi
438: 1280 loc=nodplc(loc)
439: go to 1210
440: 1290 continue
441: 1300 if (jtrflg.eq.0) go to 1600
442: call extmem(lsbkpt,1)
443: value(lsbkpt+numbkp+1)=tstop
444: numbkp=numbkp+1
445: call shlsrt(value(lsbkpt+1),numbkp)
446: nbkpt=1
447: do 1310 i=2,numbkp
448: if ((value(lsbkpt+i)-value(lsbkpt+nbkpt)).lt.tol) go to 1310
449: nbkpt=nbkpt+1
450: value(lsbkpt+nbkpt)=value(lsbkpt+i)
451: if (value(lsbkpt+nbkpt).ge.tstop) go to 1320
452: 1310 continue
453: 1320 call relmem(lsbkpt,numbkp-nbkpt)
454: numbkp=nbkpt
455: value(lsbkpt+numbkp)=dmax1(value(lsbkpt+numbkp),tstop)
456: c
457: c print option summary
458: c
459: 1600 if (iprnto.eq.0) go to 1700
460: call title(0,lwidth,1,titlop)
461: write (6,1601) gmin,reltol,abstol,vntol,lvlcod,itl1,itl2
462: 1601 format('0dc analysis -',/,
463: 1 '0 gmin = ',1pd10.3,/,
464: 2 ' reltol = ', d10.3,/,
465: 3 ' abstol = ', d10.3,/,
466: 4 ' vntol = ', d10.3,/,
467: 5 ' lvlcod = ', i6,/,
468: 6 ' itl1 = ', i6,/,
469: 7 ' itl2 = ', i6,/)
470: write (6,1611) aname(method),maxord,chgtol,trtol,lvltim,xmu,
471: 1 itl3,itl4,itl5
472: 1611 format('0transient analysis -',/,
473: 1 '0 method = ',a8,/,
474: 2 ' maxord = ', i6,/,
475: 3 ' chgtol = ',1pd10.3,/,
476: 4 ' trtol = ', d10.3,/,
477: 5 ' lvltim = ', i6,/,
478: 6 ' mu = ',0pf10.3,/,
479: 7 ' itl3 = ', i6,/,
480: 8 ' itl4 = ', i6,/,
481: 9 ' itl5 = ', i6,/)
482: write (6,1621) limpts,limtim,maxtim,numdgt,value(itemps+1),
483: 1 defl,defw,defad,defas
484: 1621 format('0miscellaneous -',/,
485: 1 '0 limpts = ', i6,/,
486: 2 ' limtim = ', i6,/,
487: 3 ' cptime = ', i6,/,
488: 4 ' numdgt = ', i6,/,
489: 5 ' tnom = ',0pf10.3,/,
490: 6 ' defl = ',1pe10.3,/,
491: 7 ' defw = ',e10.3,/,
492: 8 ' defad = ',e10.3,/,
493: 9 ' defas = ',e10.3)
494: c
495: c miscellaneous error checking
496: c
497: 1700 if (icvflg.eq.0) go to 1720
498: if (icvflg.le.limpts) go to 1710
499: icvflg=0
500: write (6,1701) limpts,alsdc
501: 1701 format('0warning: more than ',i5,' points for ',a4,' analysis,',/
502: 11x,'analysis omitted. this limit may be overridden using the ',/
503: 21x,'limpts parameter on the .option card'/)
504: go to 1720
505: 1710 if ((jelcnt(31)+jelcnt(36)).gt.0) go to 1720
506: if(ipostp.ne.0) go to 1720
507: icvflg=0
508: write (6,1711) alsdc
509: 1711 format('0warning: no ',a4,' outputs specified .',
510: 1 '.. analysis omitted'/)
511: 1720 if (jtrflg.eq.0) go to 1740
512: if (method.eq.1) maxord=2
513: if ((method.eq.2).and.(maxord.ge.3)) lvltim=2
514: if (jtrflg.le.limpts) go to 1730
515: jtrflg=0
516: write (6,1701) limpts,alstr
517: go to 1740
518: 1730 if ((jelcnt(32)+jelcnt(37)+nfour).gt.0) go to 1735
519: if(ipostp.ne.0) go to 1735
520: jtrflg=0
521: write (6,1711) alstr
522: go to 1740
523: 1735 if (nfour.eq.0) go to 1740
524: forprd=1.0d0/forfre
525: if ((tstop-forprd).ge.(tstart-1.0d-12)) go to 1740
526: nfour=0
527: call clrmem(ifour)
528: write (6,1736)
529: 1736 format('0warning: fourier analysis fundamental frequency is incom
530: 1patible with'/11x'transient analysis print interval ... fourier an
531: 2alysis omitted'/)
532: 1740 if (jacflg.eq.0) go to 1800
533: if (jacflg.le.limpts) go to 1750
534: jacflg=0
535: write (6,1701) limpts,alsac
536: go to 1800
537: 1750 if ((jelcnt(33)+jelcnt(34)+jelcnt(35)+jelcnt(38)+jelcnt(39)
538: 1 +jelcnt(40)+idist+inoise).gt.0) go to 1800
539: if(ipostp.ne.0) go to 1800
540: jacflg=0
541: write (6,1711) alsac
542: c
543: c sequence through the output lists
544: c
545: 1800 do 1820 id=41,45
546: if (id.le.43) numout=1
547: loc=locate(id)
548: 1810 if (loc.eq.0) go to 1820
549: numout=numout+1
550: nodplc(loc+4)=numout
551: loc=nodplc(loc)
552: go to 1810
553: 1820 continue
554: c
555: c increase number of .prints if too many outputs for output line-width
556: c
557: ifwdth=max0(numdgt-1,0)+9
558: noprln=min0(8,(lwidth-12)/ifwdth)
559: do 1860 id=31,35
560: loc=locate(id)
561: 1830 if(loc.eq.0) go to 1860
562: noprex=nodplc(loc+3)-noprln
563: if(noprex.le.0) go to 1850
564: nodplc(loc+3)=noprln
565: call find(dfloat(jelcnt(id)),id,locnew,1)
566: nodplc(locnew+2)=nodplc(loc+2)
567: nodplc(locnew+3)=noprex
568: call copy4(nodplc(loc+2*noprln+4),nodplc(locnew+4),2*noprex)
569: 1850 loc=nodplc(loc)
570: go to 1830
571: 1860 continue
572: c
573: c exit
574: c
575: 2000 call second(t2)
576: rstats(1)=rstats(1)+t2-t1
577: return
578: end
579: subroutine shlsrt(a,n)
580: implicit double precision (a-h,o-z)
581: c
582: c this routine sorts the array a using a shell sort algorithm.
583: c
584: dimension a(n)
585: integer h
586: c
587: c
588: c... compute best starting step size
589: h=1
590: 10 h=3*h+1
591: if (h.lt.n) go to 10
592: c... back off two times
593: h=(h-1)/3
594: h=(h-1)/3
595: h=max0(h,1)
596: c
597: c shell sort
598: c
599: 20 j=h+1
600: go to 60
601: 30 i=j-h
602: c... ak = record key; ar = record
603: ak=a(j)
604: ar=ak
605: 40 if (ak.ge.a(i)) go to 50
606: a(i+h)=a(i)
607: i=i-h
608: if (i.ge.1) go to 40
609: 50 a(i+h)=ar
610: j=j+1
611: 60 if (j.le.n) go to 30
612: h=(h-1)/3
613: if (h.ne.0) go to 20
614: return
615: end
616: subroutine putnod(node)
617: implicit double precision (a-h,o-z)
618: c
619: c this routine adds 'node' to the list of user input nodes in table
620: c junode.
621: c
622: common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
623: 1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
624: 2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
625: 3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
626: 4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
627: 5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
628: common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
629: 1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
630: common /blank/ value(1000)
631: integer nodplc(64)
632: complex*16 cvalue(32)
633: equivalence (value(1),nodplc(1),cvalue(1))
634: c
635: c
636: jknt=0
637: 10 jknt=jknt+1
638: if (jknt.gt.nunods) go to 20
639: if (node-nodplc(junode+jknt)) 20,100,10
640: 20 k=nunods+1
641: call extmem(junode,1)
642: if (k.le.jknt) go to 30
643: call copy4(nodplc(junode+jknt),nodplc(junode+jknt+1),k-jknt)
644: k=jknt
645: 30 nodplc(junode+k)=node
646: nunods=nunods+1
647: c
648: c finished
649: c
650: 100 return
651: end
652: subroutine getnod(node)
653: implicit double precision (a-h,o-z)
654: c
655: c this routine converts from the user node number to the internal
656: c (compact) node number.
657: c
658: common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
659: 1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
660: 2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
661: 3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
662: 4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
663: 5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
664: common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
665: 1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
666: common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
667: 1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
668: common /blank/ value(1000)
669: integer nodplc(64)
670: complex*16 cvalue(32)
671: equivalence (value(1),nodplc(1),cvalue(1))
672: c
673: c
674: if (nogo.ne.0) go to 100
675: jknt=0
676: 10 jknt=jknt+1
677: if (jknt.gt.nunods) go to 20
678: if (nodplc(junode+jknt).ne.node) go to 10
679: node=jknt
680: go to 100
681: c
682: c unknown node -- must be implied by .print and/or .plot
683: c
684: 20 if (node.eq.0) go to 30
685: write (6,21) node
686: 21 format('0warning: attempt to reference undefined node ',i5,
687: 1 ' -- node reset to 0'/)
688: 30 node=1
689: c
690: c finished
691: c
692: 100 return
693: end
694: subroutine subckt
695: implicit double precision (a-h,o-z)
696: c
697: c this routine drives the expansion of subcircuit calls.
698: c
699: common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
700: 1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
701: 2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
702: 3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
703: 4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
704: 5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
705: common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
706: 1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
707: common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
708: 1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
709: common /blank/ value(1000)
710: integer nodplc(64)
711: complex*16 cvalue(32)
712: equivalence (value(1),nodplc(1),cvalue(1))
713: c
714: c
715: c... avoid 'call by value' problems, make inodi, inodx arrays
716: c... in routines which receive them as parameters !!!
717: locx=locate(19)
718: 10 if (locx.eq.0) go to 300
719: locs=nodplc(locx+3)
720: asnam=value(iunsat+locs)
721: call fndnam(asnam,locx-1,locx+3,20)
722: if (nogo.ne.0) go to 300
723: locs=nodplc(locx+3)
724: c
725: c check for recursion
726: c
727: isbptr=nodplc(locx-1)
728: 20 if (isbptr.eq.0) go to 30
729: if (locs.eq.nodplc(isbptr+3)) go to 260
730: isbptr=nodplc(isbptr-1)
731: go to 20
732: c
733: c
734: 30 call sizmem(nodplc(locx+2),nxnod)
735: call sizmem(nodplc(locs+2),nssnod)
736: if (nxnod.ne.nssnod) go to 250
737: call getm4(inodx,nssnod)
738: call getm4(inodi,nssnod)
739: itemp=nodplc(locs+2)
740: call copy4(nodplc(itemp+1),nodplc(inodx+1),nssnod)
741: itemp=nodplc(locx+2)
742: call copy4(nodplc(itemp+1),nodplc(inodi+1),nxnod)
743: c
744: c add elements of subcircuit to nominal circuit
745: c
746: loc=nodplc(locs+3)
747: 100 if (loc.eq.0) go to 200
748: id=nodplc(loc-1)
749: if (id.eq.20) go to 110
750: call find(dfloat(jelcnt(id)),id,loce,1)
751: nodplc(loce-1)=locx
752: call addelt(loce,loc,id,inodx,inodi,nxnod)
753: 110 loc=nodplc(loc)
754: go to 100
755: c
756: c
757: 200 call clrmem(inodx)
758: call clrmem(inodi)
759: locx=nodplc(locx)
760: go to 10
761: c
762: c errors
763: c
764: 250 locv=nodplc(locx+1)
765: axnam=value(locv)
766: locv=nodplc(locs+1)
767: asnam=value(locv)
768: write (6,251) axnam,asnam
769: 251 format('0*error*: ',a8,' has different number of nodes than ',a8/
770: 1)
771: nogo=1
772: go to 300
773: 260 locsv=nodplc(locs+1)
774: asnam=value(locsv)
775: write (6,261) asnam
776: 261 format('0*error*: subcircuit ',a8,' is defined recursively'/)
777: nogo=1
778: c
779: c finished
780: c
781: 300 return
782: end
783: subroutine fndnam(anam,jsbptr,ispot,id)
784: implicit double precision (a-h,o-z)
785: c
786: c this routine searches for an element with id 'id' by tracing back
787: c up the subcircuit definition list. if the element is not found, the
788: c nominal element list is searched.
789: c
790: common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
791: 1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
792: 2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
793: 3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
794: 4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
795: 5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
796: common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
797: 1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
798: common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
799: 1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
800: common /blank/ value(1000)
801: integer nodplc(64)
802: complex*16 cvalue(32)
803: equivalence (value(1),nodplc(1),cvalue(1))
804: integer xxor
805: c
806: c
807: isbptr=nodplc(jsbptr)
808: 10 if (isbptr.eq.0) go to 50
809: isub=nodplc(isbptr+3)
810: loc=nodplc(isub+3)
811: 20 if (loc.eq.0) go to 40
812: if (id.ne.nodplc(loc-1)) go to 30
813: locv=nodplc(loc+1)
814: if (xxor(anam,value(locv)).ne.0) go to 30
815: if (id.ne.20) go to 50
816: go to 65
817: 30 loc=nodplc(loc)
818: go to 20
819: 40 isbptr=nodplc(isbptr-1)
820: go to 10
821: c
822: 50 loc=locate(id)
823: 60 if (loc.eq.0) go to 90
824: if (nodplc(loc-1).ne.isbptr) go to 70
825: locv=nodplc(loc+1)
826: if (xxor(anam,value(locv)).ne.0) go to 70
827: 65 nodplc(ispot)=loc
828: go to 100
829: 70 loc=nodplc(loc)
830: go to 60
831: 90 write (6,91) anam
832: 91 format('0*error*: unable to find ',a8/)
833: nogo=1
834: 100 return
835: end
836: subroutine newnod(nodold,nodnew,inodx,inodi,nnodi)
837: implicit double precision (a-h,o-z)
838: c
839: c this routine makes a new node number for an element which is about
840: c to be added to the circuit as a result of a subcircuit call.
841: c
842: common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
843: 1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
844: 2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
845: 3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
846: 4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
847: 5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
848: common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
849: 1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
850: common /blank/ value(1000)
851: integer nodplc(64)
852: complex*16 cvalue(32)
853: equivalence (value(1),nodplc(1),cvalue(1))
854: c
855: c... inodx, inodi are arrays (see subckt)
856: dimension inodx(1),inodi(1)
857: c
858: if (nodold.ne.0) go to 5
859: nodnew=1
860: go to 20
861: 5 do 10 i=1,nnodi
862: jnodx=inodx(1)
863: if (nodold.ne.nodplc(jnodx+i)) go to 10
864: jnodi=inodi(1)
865: nodnew=nodplc(jnodi+i)
866: go to 20
867: 10 continue
868: c
869: call extmem(inodx(1),1)
870: call extmem(inodi(1),1)
871: call extmem(junode,1)
872: nnodi=nnodi+1
873: ncnods=ncnods+1
874: jnodx=inodx(1)
875: nodplc(jnodx+nnodi)=nodold
876: jnodi=inodi(1)
877: nodplc(jnodi+nnodi)=ncnods
878: nodplc(junode+ncnods)=nodplc(junode+ncnods-1)+1
879: nodnew=ncnods
880: 20 return
881: end
882: subroutine addelt(loce,loc,id,inodx,inodi,nnodi)
883: implicit double precision (a-h,o-z)
884: c
885: c this routine adds an element to the nominal circuit definition
886: c lists.
887: c
888: common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
889: 1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
890: 2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
891: 3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
892: 4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
893: 5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
894: common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
895: 1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
896: common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
897: 1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
898: common /blank/ value(1000)
899: integer nodplc(64)
900: complex*16 cvalue(32)
901: equivalence (value(1),nodplc(1),cvalue(1))
902: c
903: c... inodx(1), inodi(1) are arrays (see subckt)
904: dimension inodx(1),inodi(1)
905: c
906: dimension lnod(50),lval(50),nnods(50)
907: data lnod / 9,13,15, 7,14,15,14,15,12, 7,
908: 1 17,37,26,34, 7, 7,34, 0, 5, 5,
909: 2 4, 4, 4, 4, 0, 0, 0, 0, 0, 0,
910: 3 21,21,21,21,21,21,21,21,21,21,
911: 4 8, 8, 8, 8, 8, 0, 0, 0, 0, 0 /
912: data lval / 5, 4, 4, 2, 1, 1, 1, 1, 4, 4,
913: 1 3, 4, 4,13, 1, 1, 9, 0, 1, 1,
914: 2 19,55,17,41, 0, 0, 0, 0, 0, 0,
915: 3 1, 1, 1, 1, 1,17,17,17,17,17,
916: 4 1, 1, 1, 1, 1, 0, 0, 0, 0, 0 /
917: data nnods / 2, 2, 2, 0, 2, 2, 2, 2, 2, 2,
918: 1 2, 4, 3, 4, 4, 4, 4, 0, 1, 0,
919: 2 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
920: 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
921: 4 2, 2, 2, 0, 0, 0, 0, 0, 0, 0 /
922: c
923: c copy integer part
924: c
925: nword=lnod(id)-3
926: if (nword.le.0) go to 10
927: call copy4(nodplc(loc+2),nodplc(loce+2),nword)
928: c
929: c set nodes
930: c
931: 10 if (id.ge.21) go to 100
932: if (nnods(id).eq.0) go to 100
933: if (id.le.4) go to 20
934: if (id.le.8) go to 40
935: if (id.eq.19) go to 70
936: 20 jstop=nnods(id)
937: do 30 j=1,jstop
938: call newnod(nodplc(loc+j+1),nodplc(loce+j+1),inodx(1),
939: 1 inodi(1),nnodi)
940: 30 continue
941: go to 100
942: 40 call newnod(nodplc(loc+2),nodplc(loce+2),inodx(1),inodi(1),nnodi)
943: call newnod(nodplc(loc+3),nodplc(loce+3),inodx(1),inodi(1),nnodi)
944: if (id.ge.7) go to 100
945: nlocp=loc+id+1
946: nssnod=2*nodplc(loc+4)
947: call getm4(nodplc(loce+id+1),nssnod)
948: nlocpe=loce+id+1
949: 50 do 60 j=1,nssnod
950: locp=nodplc(nlocp)
951: nodold=nodplc(locp+j)
952: call newnod(nodold,nodnew,inodx(1),inodi(1),nnodi)
953: locpe=nodplc(nlocpe)
954: nodplc(locpe+j)=nodnew
955: 60 continue
956: go to 100
957: 70 nlocp=loc+2
958: call sizmem(nodplc(loc+2),nssnod)
959: call getm4(nodplc(loce+2),nssnod)
960: nlocpe=loce+2
961: go to 50
962: c
963: c copy real part
964: c
965: 100 if (nogo.ne.0) go to 300
966: locv=nodplc(loc+1)
967: locve=nodplc(loce+1)
968: call copy8(value(locv),value(locve),lval(id))
969: c
970: c treat non-node tables specially
971: c
972: 200 if (id.ge.11) go to 300
973: go to (300,210,220,300,230,240,230,240,260,260), id
974: 210 call cpytb8(loc+7,loce+7)
975: go to 300
976: 220 call cpytb8(loc+10,loce+10)
977: go to 300
978: 230 itab=5
979: go to 250
980: 240 itab=6
981: 250 if (id.le.6) go to 255
982: call cpytb4(loc+itab+1,loce+itab+1)
983: 255 call cpytb4(loc+itab+2,loce+itab+2)
984: call cpytb8(loc+itab+3,loce+itab+3)
985: call cpytb8(loc+itab+4,loce+itab+4)
986: call cpytb4(loc+itab+5,loce+itab+5)
987: call cpytb8(loc+itab+6,loce+itab+6)
988: go to 300
989: 260 call cpytb8(loc+5,loce+5)
990: c
991: c
992: 300 return
993: end
994: subroutine cpytb4(itabo,itabn)
995: implicit double precision (a-h,o-z)
996: c
997: c this routine copies a table. its use is made necessary by the
998: c fact that only one pointer is allowed per table.
999: c
1000: common /blank/ value(1000)
1001: integer nodplc(64)
1002: complex*16 cvalue(32)
1003: equivalence (value(1),nodplc(1),cvalue(1))
1004: c
1005: c
1006: call sizmem(nodplc(itabo),isize)
1007: call getm4(nodplc(itabn),isize)
1008: loco=nodplc(itabo)
1009: locn=nodplc(itabn)
1010: call copy4(nodplc(loco+1),nodplc(locn+1),isize)
1011: return
1012: end
1013: subroutine cpytb8(itabo,itabn)
1014: implicit double precision (a-h,o-z)
1015: c
1016: c this routine copies a table. its use is made necessary by the
1017: c fact that only one pointer is allowed per table.
1018: c
1019: common /blank/ value(1000)
1020: integer nodplc(64)
1021: complex*16 cvalue(32)
1022: equivalence (value(1),nodplc(1),cvalue(1))
1023: c
1024: c
1025: call sizmem(nodplc(itabo),isize)
1026: call getm8(nodplc(itabn),isize)
1027: loco=nodplc(itabo)
1028: locn=nodplc(itabn)
1029: call copy8(value(loco+1),value(locn+1),isize)
1030: return
1031: end
1032: subroutine lnkref
1033: implicit double precision (a-h,o-z)
1034: c
1035: c this routine resolves all unsatisfied name references.
1036: c
1037: common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
1038: 1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
1039: 2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
1040: 3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
1041: 4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
1042: 5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
1043: common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
1044: 1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
1045: common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
1046: 1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
1047: common /blank/ value(1000)
1048: integer nodplc(64)
1049: complex*16 cvalue(32)
1050: equivalence (value(1),nodplc(1),cvalue(1))
1051: c
1052: c mutual inductors
1053: c
1054: loc=locate(4)
1055: 100 if (loc.eq.0) go to 200
1056: iref=nodplc(loc+2)
1057: call fndnam(value(iunsat+iref),loc-1,loc+2,3)
1058: iref=nodplc(loc+3)
1059: call fndnam(value(iunsat+iref),loc-1,loc+3,3)
1060: loc=nodplc(loc)
1061: go to 100
1062: c
1063: c current-controlled current source
1064: c
1065: 200 loc=locate(7)
1066: 210 if (loc.eq.0) go to 300
1067: nump=nodplc(loc+4)
1068: locp=nodplc(loc+6)
1069: do 220 i=1,nump
1070: iref=nodplc(locp+i)
1071: call fndnam(value(iunsat+iref),loc-1,locp+i,9)
1072: 220 continue
1073: loc=nodplc(loc)
1074: go to 210
1075: c
1076: c current-controlled voltage sources
1077: c
1078: 300 loc=locate(8)
1079: 310 if (loc.eq.0) go to 400
1080: nump=nodplc(loc+4)
1081: locp=nodplc(loc+7)
1082: do 320 i=1,nump
1083: iref=nodplc(locp+i)
1084: call fndnam(value(iunsat+iref),loc-1,locp+i,9)
1085: 320 continue
1086: loc=nodplc(loc)
1087: go to 310
1088: c
1089: c diodes
1090: c
1091: 400 loc=locate(11)
1092: 410 if (loc.eq.0) go to 500
1093: iref=nodplc(loc+5)
1094: call fndnam(value(iunsat+iref),loc-1,loc+5,21)
1095: loc=nodplc(loc)
1096: go to 410
1097: c
1098: c bjts
1099: c
1100: 500 loc=locate(12)
1101: 510 if (loc.eq.0) go to 600
1102: iref=nodplc(loc+8)
1103: call fndnam(value(iunsat+iref),loc-1,loc+8,22)
1104: loc=nodplc(loc)
1105: go to 510
1106: c
1107: c jfets
1108: c
1109: 600 loc=locate(13)
1110: 610 if (loc.eq.0) go to 700
1111: iref=nodplc(loc+7)
1112: call fndnam(value(iunsat+iref),loc-1,loc+7,23)
1113: loc=nodplc(loc)
1114: go to 610
1115: c
1116: c mosfets
1117: c
1118: 700 loc=locate(14)
1119: 710 if (loc.eq.0) go to 1000
1120: iref=nodplc(loc+8)
1121: call fndnam(value(iunsat+iref),loc-1,loc+8,24)
1122: loc=nodplc(loc)
1123: go to 710
1124: c
1125: c finished
1126: c
1127: 1000 call clrmem(iunsat)
1128: return
1129: end
1130: subroutine subnam(loce)
1131: implicit double precision (a-h,o-z)
1132: c
1133: c this routine constructs the names of elements added as a result of
1134: c subcircuit expansion. the full element names are of the form
1135: c name.xn. --- xd.xc.xb.xa
1136: c where 'name' is the nominal element name, and the 'x'*s denote the
1137: c sequence of subcircuit calls (from top or circuit level down through
1138: c nested subcircuit calls) which caused the particular element to be
1139: c added. at present, spice restricts all element names to be 8 charac-
1140: c ters or less. therefore, the name used consists of the leftmost 8
1141: c characters of the full element name, with the rightmost character
1142: c replaced by an asterisk ('*') if the full element name is longer than
1143: c 8 characters.
1144: c
1145: common /blank/ value(1000)
1146: integer nodplc(64)
1147: complex*16 cvalue(32)
1148: equivalence (value(1),nodplc(1),cvalue(1))
1149: c
1150: c
1151: data ablank, aper, astk / 1h , 1h., 1h* /
1152: c
1153: c construct subcircuit element name
1154: c
1155: if (nodplc(loce-1).eq.0) go to 100
1156: locve=nodplc(loce+1)
1157: loc=loce
1158: nchar=0
1159: sname=ablank
1160: achar=ablank
1161: 10 locv=nodplc(loc+1)
1162: elname=value(locv)
1163: do 20 ichar=1,8
1164: call move(achar,1,elname,ichar,1)
1165: if (achar.eq.ablank) go to 30
1166: if (nchar.eq.8) go to 40
1167: nchar=nchar+1
1168: call move(sname,nchar,achar,1,1)
1169: 20 continue
1170: 30 loc=nodplc(loc-1)
1171: if (loc.eq.0) go to 60
1172: if (nchar.eq.8) go to 40
1173: nchar=nchar+1
1174: call move(sname,nchar,aper,1,1)
1175: go to 10
1176: c
1177: c name is longer than 8 characters: flag with asterisk
1178: c
1179: 40 call move(sname,8,astk,1,1)
1180: 60 value(locve)=sname
1181: c
1182: c finished
1183: c
1184: 100 return
1185: end
1186: subroutine elprnt
1187: implicit double precision (a-h,o-z)
1188: c
1189: c this routine prints a circuit element summary.
1190: c
1191: common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
1192: 1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
1193: 2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
1194: 3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
1195: 4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
1196: 5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
1197: common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
1198: 1 defas,rstats(50),iwidth,lwidth,nopage
1199: common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
1200: 1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
1201: common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
1202: 1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
1203: common /tran/ tstep,tstop,tstart,delmax,tdmax,forfre,jtrflg
1204: common /blank/ value(1000)
1205: integer nodplc(64)
1206: complex*16 cvalue(32)
1207: equivalence (value(1),nodplc(1),cvalue(1))
1208: c
1209: c
1210: dimension itab(25),astyp(6)
1211: dimension eltitl(4)
1212: data eltitl / 8hcircuit , 8helement , 8hsummary , 8h /
1213: data astyp / 1h , 5hpulse, 3hsin, 3hexp, 3hpwl, 4hsffm /
1214: data ablnk,aoff /1h ,3hoff/
1215: c
1216: c print listing of elements
1217: c
1218: call title(0,lwidth,1,eltitl)
1219: c
1220: c print resistors
1221: c
1222: if (jelcnt(1).eq.0) go to 50
1223: ititle=0
1224: 21 format(//'0**** resistors'/'0 name nodes value
1225: 1 tc1 tc2'//)
1226: loc=locate(1)
1227: 30 if (loc.eq.0) go to 50
1228: if (ititle.eq.0) write (6,21)
1229: ititle=1
1230: locv=nodplc(loc+1)
1231: node1=nodplc(loc+2)
1232: node2=nodplc(loc+3)
1233: write (6,31) value(locv),nodplc(junode+node1),
1234: 1 nodplc(junode+node2),value(locv+2),value(locv+3),value(locv+4)
1235: 31 format(6x,a8,2i5,1p3d11.2)
1236: 40 loc=nodplc(loc)
1237: go to 30
1238: c
1239: c print capacitors and inductors
1240: c
1241: 50 if ((jelcnt(2)+jelcnt(3)).eq.0) go to 80
1242: ititle=0
1243: 51 format(//'0**** capacitors and inductors'/'0 name nodes
1244: 1 in cond value'//)
1245: do 70 id=2,3
1246: loc=locate(id)
1247: 60 if (loc.eq.0) go to 70
1248: if (ititle.eq.0) write (6,51)
1249: ititle=1
1250: locv=nodplc(loc+1)
1251: node1=nodplc(loc+2)
1252: node2=nodplc(loc+3)
1253: ltab=7
1254: if (id.eq.3) ltab=10
1255: call sizmem(nodplc(loc+ltab),nparam)
1256: if (nparam.ge.2) go to 62
1257: ispot=nodplc(loc+ltab)+1
1258: write (6,31) value(locv),nodplc(junode+node1),
1259: 1 nodplc(junode+node2),value(locv+2),value(ispot)
1260: go to 65
1261: 62 write (6,63) value(locv),nodplc(junode+node1),
1262: 1 nodplc(junode+node2),value(locv+2)
1263: 63 format(6x,a8,2i5,1pd11.2,' variable')
1264: 65 loc=nodplc(loc)
1265: go to 60
1266: 70 continue
1267: c
1268: c print mutual inductors
1269: c
1270: 80 if (jelcnt(4).eq.0) go to 100
1271: ititle=0
1272: 81 format(//'0**** mutual inductors'/'0 name coupled induc
1273: 1tors value'//)
1274: loc=locate(4)
1275: 90 if (loc.eq.0) go to 110
1276: if (ititle.eq.0) write (6,81)
1277: ititle=1
1278: locv=nodplc(loc+1)
1279: nl1=nodplc(loc+2)
1280: nl1=nodplc(nl1+1)
1281: nl2=nodplc(loc+3)
1282: nl2=nodplc(nl2+1)
1283: write (6,91) value(locv),value(nl1),value(nl2),value(locv+1)
1284: 91 format(6x,a8,4x,a8,2x,a8,1pd10.2)
1285: 95 loc=nodplc(loc)
1286: go to 90
1287: c
1288: c print nonlinear voltage controlled sources
1289: c
1290: 100 if (jelcnt(5).eq.0) go to 120
1291: ititle=0
1292: 101 format(//'0**** voltage-controlled current sources'/'0 name
1293: 1 + - dimension function')
1294: loc=locate(5)
1295: 110 if (loc.eq.0) go to 120
1296: if (ititle.eq.0) write (6,101)
1297: ititle=1
1298: locv=nodplc(loc+1)
1299: node1=nodplc(loc+2)
1300: node2=nodplc(loc+3)
1301: write (6,111) value(locv),nodplc(junode+node1),
1302: 1 nodplc(junode+node2),nodplc(loc+4)
1303: 111 format(6x,a8,2i5,i8,9x,'poly')
1304: 115 loc=nodplc(loc)
1305: go to 110
1306: c
1307: c nonlinear voltage controlled voltage sources
1308: c
1309: 120 if (jelcnt(6).eq.0) go to 140
1310: ititle=0
1311: 121 format(//'0**** voltage-controlled voltage sources'/'0 name
1312: 1 + - dimension function')
1313: loc=locate(6)
1314: 130 if (loc.eq.0) go to 140
1315: if (ititle.eq.0) write (6,121)
1316: ititle=1
1317: locv=nodplc(loc+1)
1318: node1=nodplc(loc+2)
1319: node2=nodplc(loc+3)
1320: write (6,111) value(locv),nodplc(junode+node1),
1321: 1 nodplc(junode+node2),nodplc(loc+4)
1322: 135 loc=nodplc(loc)
1323: go to 130
1324: c
1325: c nonlinear current controlled current sources
1326: c
1327: 140 if (jelcnt(7).eq.0) go to 160
1328: ititle=0
1329: 141 format(//'0**** current-controlled current sources'/'0 name
1330: 1 + - dimension function')
1331: loc=locate(7)
1332: 150 if (loc.eq.0) go to 160
1333: if (ititle.eq.0) write (6,141)
1334: ititle=1
1335: locv=nodplc(loc+1)
1336: node1=nodplc(loc+2)
1337: node2=nodplc(loc+3)
1338: write (6,111) value(locv),nodplc(junode+node1),
1339: 1 nodplc(junode+node2),nodplc(loc+4)
1340: 155 loc=nodplc(loc)
1341: go to 150
1342: c
1343: c nonlinear current controlled voltage sources
1344: c
1345: 160 if (jelcnt(8).eq.0) go to 170
1346: ititle=0
1347: 161 format(//'0**** current-controlled voltage sources'/'0 name
1348: 1 + - dimension function')
1349: loc=locate(8)
1350: 165 if (loc.eq.0) go to 170
1351: if (ititle.eq.0) write (6,161)
1352: ititle=1
1353: locv=nodplc(loc+1)
1354: node1=nodplc(loc+2)
1355: node2=nodplc(loc+3)
1356: write (6,111) value(locv),nodplc(junode+node1),
1357: 1 nodplc(junode+node2),nodplc(loc+4)
1358: 167 loc=nodplc(loc)
1359: go to 165
1360: c
1361: c print independent sources
1362: c
1363: 170 if ((jelcnt(9)+jelcnt(10)).eq.0) go to 250
1364: ititle=0
1365: 171 format(//'0**** independent sources'/'0 name nodes dc
1366: 1 value ac value ac phase transient'//)
1367: do 245 id=9,10
1368: loc=locate(id)
1369: 180 if (loc.eq.0) go to 245
1370: if (ititle.eq.0) write (6,171)
1371: ititle=1
1372: locv=nodplc(loc+1)
1373: locp=nodplc(loc+5)
1374: node1=nodplc(loc+2)
1375: node2=nodplc(loc+3)
1376: itype=nodplc(loc+4)+1
1377: anam=astyp(itype)
1378: write (6,181) value(locv),nodplc(junode+node1),
1379: 1 nodplc(junode+node2),value(locv+1),value(locv+2),
1380: 2 value(locv+3),anam
1381: 181 format(6x,a8,2i5,1p3d11.2,2x,a8)
1382: if (jtrflg.eq.0) go to 240
1383: jstart=locp+1
1384: go to (240,190,200,210,220,230), itype
1385: 190 jstop=locp+7
1386: write (6,191) (value(j),j=jstart,jstop)
1387: 191 format(1h0,42x,'initial value',1pd11.2,/,
1388: 1 43x,'pulsed value.', d11.2,/,
1389: 2 43x,'delay time...', d11.2,/,
1390: 3 43x,'risetime.....', d11.2,/,
1391: 4 43x,'falltime.....', d11.2,/,
1392: 5 43x,'width........', d11.2,/,
1393: 6 43x,'period.......', d11.2,/)
1394: go to 240
1395: 200 jstop=locp+5
1396: write (6,201) (value(j),j=jstart,jstop)
1397: 201 format(1h0,42x,'offset.......',1pd11.2,/,
1398: 1 43x,'amplitude....', d11.2,/,
1399: 2 43x,'frequency....', d11.2,/,
1400: 3 43x,'delay........', d11.2,/,
1401: 4 43x,'theta........', d11.2,/)
1402: go to 240
1403: 210 jstop=locp+6
1404: write (6,211) (value(j),j=jstart,jstop)
1405: 211 format(1h0,42x,'initial value',1pd11.2,/,
1406: 1 43x,'pulsed value.', d11.2,/,
1407: 2 43x,'rise delay...', d11.2,/,
1408: 3 43x,'rise tau.....', d11.2,/,
1409: 4 43x,'fall delay...', d11.2,/,
1410: 5 43x,'fall tau.....', d11.2,/)
1411: go to 240
1412: 220 call sizmem(nodplc(loc+5),jstop)
1413: jstop=locp+jstop
1414: write (6,221) (value(j),j=jstart,jstop)
1415: 221 format(1h0,49x,'time value'//,(46x,1p2d11.2))
1416: write (6,226)
1417: 226 format(1x)
1418: go to 240
1419: 230 jstop=locp+5
1420: write (6,231) (value(j),j=jstart,jstop)
1421: 231 format(1h0,42x,'offset.......',1pd11.2,/,
1422: 1 43x,'amplitude....', d11.2,/,
1423: 2 43x,'carrier freq.', d11.2,/,
1424: 3 43x,'modn index...', d11.2,/,
1425: 4 43x,'signal freq..', d11.2,/)
1426: 240 loc=nodplc(loc)
1427: go to 180
1428: 245 continue
1429: c
1430: c print transmission lines
1431: c
1432: 250 if (jelcnt(17).eq.0) go to 260
1433: ititle=0
1434: 251 format(//'0**** transmission lines'/'0 name nodes
1435: 1 z0 td'//)
1436: loc=locate(17)
1437: 253 if (loc.eq.0) go to 260
1438: if (ititle.eq.0) write (6,251)
1439: ititle=1
1440: locv=nodplc(loc+1)
1441: node1=nodplc(loc+2)
1442: node2=nodplc(loc+3)
1443: node3=nodplc(loc+4)
1444: node4=nodplc(loc+5)
1445: write (6,256) value(locv),nodplc(junode+node1),
1446: 1 nodplc(junode+node2),nodplc(junode+node3),
1447: 2 nodplc(junode+node4),value(locv+1),value(locv+2)
1448: 256 format(6x,a8,4i5,1p2d11.2)
1449: 258 loc=nodplc(loc)
1450: go to 253
1451: c
1452: c print diodes
1453: c
1454: 260 if (jelcnt(11).eq.0) go to 290
1455: ititle=0
1456: 261 format(//'0**** diodes'/'0 name + - model are
1457: 1a'//)
1458: loc=locate(11)
1459: 270 if (loc.eq.0) go to 290
1460: if (ititle.eq.0) write (6,261)
1461: ititle=1
1462: locv=nodplc(loc+1)
1463: node1=nodplc(loc+2)
1464: node2=nodplc(loc+3)
1465: locm=nodplc(loc+5)
1466: locm=nodplc(locm+1)
1467: aic=ablnk
1468: if (nodplc(loc+6).eq.1) aic=aoff
1469: write (6,271) value(locv),nodplc(junode+node1),
1470: 1 nodplc(junode+node2),value(locm),value(locv+1),aic
1471: 271 format(6x,a8,2i5,2x,a8,f8.3,2x,a8)
1472: 280 loc=nodplc(loc)
1473: go to 270
1474: c
1475: c print transistors
1476: c
1477: 290 if (jelcnt(12).eq.0) go to 320
1478: ititle=0
1479: 291 format(//'0**** bipolar junction transistors'/'0 name c
1480: 1 b e s model area'//)
1481: loc=locate(12)
1482: 300 if (loc.eq.0) go to 320
1483: if (ititle.eq.0) write (6,291)
1484: ititle=1
1485: locv=nodplc(loc+1)
1486: node1=nodplc(loc+2)
1487: node2=nodplc(loc+3)
1488: node3=nodplc(loc+4)
1489: node4=nodplc(loc+5)
1490: locm=nodplc(loc+8)
1491: locm=nodplc(locm+1)
1492: aic=ablnk
1493: if (nodplc(loc+9).eq.1) aic=aoff
1494: write (6,301) value(locv),nodplc(junode+node1),
1495: 1 nodplc(junode+node2),nodplc(junode+node3),nodplc(junode+node4),
1496: 2 value(locm),value(locv+1),aic
1497: 301 format(6x,a8,4i5,2x,a8,f8.3,2x,a8)
1498: 310 loc=nodplc(loc)
1499: go to 300
1500: c
1501: c print jfets
1502: c
1503: 320 if (jelcnt(13).eq.0) go to 350
1504: ititle=0
1505: 321 format(//'0**** jfets'/'0 name d g s model
1506: 1 area'//)
1507: loc=locate(13)
1508: 330 if (loc.eq.0) go to 350
1509: if (ititle.eq.0) write (6,321)
1510: ititle=1
1511: locv=nodplc(loc+1)
1512: node1=nodplc(loc+2)
1513: node2=nodplc(loc+3)
1514: node3=nodplc(loc+4)
1515: locm=nodplc(loc+7)
1516: locm=nodplc(locm+1)
1517: aic=ablnk
1518: if (nodplc(loc+8).eq.1) aic=aoff
1519: write (6,331) value(locv),nodplc(junode+node1),
1520: 1 nodplc(junode+node2),nodplc(junode+node3),
1521: 2 value(locm),value(locv+1),aic
1522: 331 format(6x,a8,3i5,2x,a8,f8.3,2x,a8)
1523: 340 loc=nodplc(loc)
1524: go to 330
1525: c
1526: c print mosfets
1527: c
1528: 350 if (jelcnt(14).eq.0) go to 400
1529: ititle=0
1530: 351 format(//'0**** mosfets',/,'0name d g s b model l
1531: 1 w ad as rd rs',//)
1532: loc=locate(14)
1533: 360 if (loc.eq.0) go to 400
1534: if (ititle.eq.0) write (6,351)
1535: ititle=1
1536: locv=nodplc(loc+1)
1537: node1=nodplc(loc+2)
1538: node2=nodplc(loc+3)
1539: node3=nodplc(loc+4)
1540: node4=nodplc(loc+5)
1541: locm=nodplc(loc+8)
1542: locm=nodplc(locm+1)
1543: rd=value(locv+11)
1544: if(rd.eq.0.0d0) rd=value(locm+6)
1545: rs=value(locv+12)
1546: if(rs.eq.0.0d0) rs=value(locm+7)
1547: aic=ablnk
1548: if (nodplc(loc+9).eq.1) aic=aoff
1549: write (6,361) value(locv),nodplc(junode+node1),
1550: 1 nodplc(junode+node2),nodplc(junode+node3),
1551: 2 nodplc(junode+node4),value(locm),value(locv+1),value(locv+2),
1552: 3 value(locv+3),value(locv+4),rd,rs
1553: 361 format(1x,a8,4i4,1x,a8,1pd7.1,5d8.1)
1554: if(aic.ne.ablnk) write(6,362)
1555: 362 format(1x,'above device specified to be *off* to aid dc solution',
1556: 1 /)
1557: 370 loc=nodplc(loc)
1558: go to 360
1559: c
1560: c subcircuit calls
1561: c
1562: 400 if (jelcnt(19).eq.0) go to 500
1563: ititle=0
1564: 401 format(//'0**** subcircuit calls'/'0 name subcircuit ext
1565: 1ernal nodes'//)
1566: loc=locate(19)
1567: 410 if (loc.eq.0) go to 500
1568: if (ititle.eq.0) write (6,401)
1569: ititle=1
1570: locv=nodplc(loc+1)
1571: locn=nodplc(loc+2)
1572: call sizmem(nodplc(loc+2),nnodx)
1573: locs=nodplc(loc+3)
1574: locsv=nodplc(locs+1)
1575: jstart=1
1576: ndprln=(lwidth-28)/5
1577: 412 jstop=min0(nnodx,jstart+ndprln-1)
1578: do 414 j=jstart,jstop
1579: node=nodplc(locn+j)
1580: itab(j-jstart+1)=nodplc(junode+node)
1581: 414 continue
1582: if (jstart.eq.1)
1583: 1 write (6,416) value(locv),value(locsv),(itab(j),j=1,jstop)
1584: 416 format(6x,a8,2x,a8,4x,20i5)
1585: if (jstart.ne.1)
1586: 1 write (6,418) (itab(j-jstart+1),j=jstart,jstop)
1587: 418 format(28x,20i5)
1588: jstart=jstop+1
1589: if (jstart.le.nnodx) go to 412
1590: if (nnodx.le.ndprln) go to 420
1591: write (6,226)
1592: 420 loc=nodplc(loc)
1593: go to 410
1594: c
1595: c finished
1596: c
1597: 500 return
1598: end
1599: subroutine modchk
1600: implicit double precision (a-h,o-z)
1601: c
1602: c this routine performs one-time processing of device model para-
1603: c meters and prints out a device model summary. it also reserves the
1604: c additional nodes required by nonzero device extrinsic resistances.
1605: c
1606: common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
1607: 1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
1608: 2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
1609: 3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
1610: 4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
1611: 5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
1612: common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
1613: 1 defas,rstats(50),iwidth,lwidth,nopage
1614: common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
1615: 1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
1616: common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
1617: 1 xmu,mode,modedc,icalc,initf,method,iord,maxord,noncon,iterno,
1618: 2 itemno,nosolv,ipostp,iscrch
1619: common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
1620: 1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
1621: common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok,
1622: 1 gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox
1623: common /blank/ value(1000)
1624: integer nodplc(64)
1625: complex*16 cvalue(32)
1626: equivalence (value(1),nodplc(1),cvalue(1))
1627: c
1628: c
1629: dimension itab(50),atable(10)
1630: dimension ifun(4)
1631: dimension antype(4),aptype(4)
1632: dimension ipar(6),ampar(120),defval(120),ifmt(120)
1633: dimension titled(4),titleb(4),titlej(4),titlem(4)
1634: data titled / 8hdiode mo, 8hdel para, 8hmeters , 8h /
1635: data titleb / 8hbjt mode, 8hl parame, 8hters , 8h /
1636: data titlej / 8hjfet mod, 8hel param, 8heters , 8h /
1637: data titlem / 8hmosfet m, 8hodel par, 8hameters , 8h /
1638: data ifun / 0, 0, 1, 1 /
1639: data antype /1h ,3hnpn,3hnjf,4hnmos/
1640: data aptype /1h ,3hpnp,3hpjf,4hpmos/
1641: data agaas /5hga-as/
1642: data ipar / 0, 14, 60, 72, 106, 119 /
1643: data hndrd,hndrd2 /1.0d+02,1.0d+04/
1644: data ampar /
1645: 1 6his ,6hrs ,6hn ,6htt ,6hcjo ,6hpb ,6hm ,
1646: 2 6heg ,6hpt ,6hkf ,6haf ,6hfc ,6hbv ,6hibv ,
1647: 1 6hjs ,6hbf ,6hnf ,6hvbf ,6hjbf ,6hjle ,6hnle ,
1648: 2 6hbr ,6hnr ,6hvbr ,6hjbr ,6hjlc ,6hnlc ,6h0 ,
1649: 3 6h0 ,6hrb ,6hjrb ,6hrbm ,6hre ,6hrc ,6hcje ,
1650: 4 6hvje ,6hmje ,6htf ,6hxtf ,6hvtf ,6hjtf ,6hptf ,
1651: 5 6hcjc ,6hvjc ,6hmjc ,6hcdis ,6htr ,6h0 ,6h0 ,
1652: 6 6h0 ,6h0 ,6hcjs ,6hvjs ,6hmjs ,6htb ,6heg ,
1653: 7 6hpt ,6hkf ,6haf ,6hfc ,
1654: 1 6hvto ,6hbeta ,6hlambda,6hrd ,6hrs ,6hcgs ,6hcgd ,
1655: 2 6hpb ,6his ,6hkf ,6haf ,6hfc ,
1656: 1 6hvto ,6hkp ,6hgamma ,6hphi ,6hlambda,6hrd ,6hrs ,
1657: 2 6hcgs ,6hcgd ,6hcgb ,6hcbd ,6hcbs ,6htox ,6hpb ,
1658: 3 6hjs ,6hnsub ,6hnss ,6hnfs ,6hxj ,6hld ,6hngate ,
1659: 4 6htps ,6huo ,6hucrit ,6huexp ,6hutra ,6hkf ,6haf ,
1660: 5 6hfc ,6hwd ,6hecrit ,6hetra ,6hvnorm ,6hdesat ,
1661: 1 6hvp ,6hvbr ,6hvbi ,6hvfwd ,6hnd ,6hkdso ,6hkdv ,
1662: 2 6hcdso ,6hczg ,6hgnoise,6hnexp ,6hkf ,6haf ,0.0d0 /
1663: data defval /
1664: 1 1.0d-14, 0.0d0, 1.0d0, 2*0.0d0, 1.0d0, 0.5d0, 1.11d0,
1665: 2 3.0d0, 0.0d0, 1.0d0, 0.5d0, 0.0d0, 1.0d-3,
1666: 1 1.0d-16, 100.0d0, 1.0d0, 3*0.0d0, 1.5d0, 2*1.0d0, 3*0.0d0,
1667: 2 2.0d0, 0.0d0, 1.0d0, 0.0d0, 0.0d0, 4*0.0d0, 0.75d0,
1668: 3 0.33d0, 2*0.0d0, 2*0.0d0, 2*0.0d0, 0.75d0, 0.33d0, 1.0d0,
1669: 4 2*0.0d0, 2*0.0d0, 2*0.0d0, 0.75d0, 0.0d0, 0.0d0, 1.11d0,
1670: 5 3.0d0, 0.0d0, 1.0d0, 0.5d0,
1671: 1 -2.0d0, 1.0d-4, 5*0.0d0, 1.0d0,1.0d-14, 0.0d0, 1.0d0,
1672: 2 0.5d0,
1673: 1 3*0.0d0, 0.0d0, 8*0.0d0, 1.0d-7, 0.8d0, 1.0d-4,6*0.0d0,
1674: 2 1.0d0,700.0d0, 1.0d+4, 3*0.0d0, 1.0d0, 0.5d0, 0.0d0,
1675: 3 3*0.0d0,1.5d+9,
1676: 1 -2.1d0, 0.0d0, 0.8d0, 0.6d0, 1.0d17, 5.8d0 ,0.01d0,
1677: 2 2.0d-10, 0.0d0, 0.0d0, 1.0d0, 0.0d0, 1.0d0, 0.0d0 /
1678: data ifmt /
1679: 1 2,1,1,2,2,1,1,1,1,2,1,1,2,2,
1680: 1 2,1,1,2,2,2,1,1,1,2,2,2,1,0,0,1,2,1,1,1,2,1,1,2,2,2,2,1,2,1,
1681: a 1,1,2,0,0,0,0,2,1,1,2,1,1,2,2,2,
1682: 3 1,2,1,1,1,2,2,1,2,2,1,1,
1683: 4 1,2,1,1,2,1,1,2,2,2,2,2,2,1,2,2,2,2,2,2,2,1,1,2,1,1,2,1,1,2,
1684: a 2,2,2,2,
1685: 5 1,1,1,1,2,2,2,2,2,2,1,2,1,0/
1686: c
1687: c
1688: tnom=value(itemps+1)+ctok
1689: xkt=boltz*tnom
1690: vt=xkt/charge
1691: egfet=1.16d0-(7.02d-04*tnom**2/(tnom+1108.0d0))
1692: arg=-egfet/2.0d0/boltz/tnom+1.1151d0/boltz/2.0d0/(27.0d0+ctok)
1693: xni=1.45d10*(tnom/(27.0d0+ctok))**1.5d0*dexp(charge*arg)
1694: nummod=jelcnt(21)+jelcnt(22)+jelcnt(23)+jelcnt(24)
1695: if (nummod.eq.0) go to 1000
1696: c
1697: c assign default values
1698: c
1699: kntlim=lwidth/11
1700: do 390 id=1,4
1701: if (jelcnt(id+20).eq.0) go to 390
1702: iflag=ifun(id)
1703: loc=locate(id+20)
1704: 10 if (loc.eq.0) go to 20
1705: locv=nodplc(loc+1)
1706: id1=id
1707: c... special case of gaas
1708: if(id.eq.4.and.nodplc(loc+2).eq.0) id1=5
1709: locm=ipar(id1)
1710: nopar=ipar(id1+1)-locm
1711: do 18 i=1,nopar
1712: itab(i)=ifmt(locm+i)
1713: if (value(locv+i).eq.0.0d0) go to 16
1714: if (iflag.eq.0) go to 14
1715: if (i.eq.1) go to 18
1716: if(i.eq.2.and.id1.eq.5) go to 18
1717: 14 if (value(locv+i).gt.0.0d0) go to 18
1718: c.. let pt be negative for bjts (for now anyway!)
1719: if(i.eq.43.and.id.eq.2) go to 18
1720: c... nss, ld, wd, utra and tps for mosfet can be negative
1721: if((i.eq.22.or.i.eq.17.or.i.eq.20.or.i.eq.30.or.i.eq.26)
1722: 1 .and.id.eq.4) go to 18
1723: c... vbr for ga-as fets must be negative
1724: 16 value(locv+i)=defval(locm+i)
1725: 18 continue
1726: loc=nodplc(loc)
1727: go to 10
1728: c
1729: c limit model values
1730: c
1731: 20 go to (30,40,50,60), id
1732: c... diodes
1733: 30 loc=locate(21)
1734: 32 if (loc.eq.0) go to 100
1735: locv=nodplc(loc+1)
1736: value(locv+7)=dmin1(value(locv+7),0.9d0)
1737: value(locv+8)=dmax1(value(locv+8),0.1d0)
1738: value(locv+11)=dmax1(value(locv+11),0.1d0)
1739: value(locv+12)=dmin1(value(locv+12),0.95d0)
1740: loc=nodplc(loc)
1741: go to 32
1742: c... bipolar transistors
1743: 40 loc=locate(22)
1744: 42 if (loc.eq.0) go to 100
1745: locv=nodplc(loc+1)
1746: value(locv+23)=dmin1(value(locv+23),0.9d0)
1747: if(value(locv+24).eq.0.0d0) value(locv+28)=0.0d0
1748: value(locv+31)=dmin1(value(locv+31),0.9d0)
1749: value(locv+32)=dmin1(value(locv+32),1.0d0)
1750: value(locv+40)=dmin1(value(locv+40),0.9d0)
1751: value(locv+42)=dmax1(value(locv+42),0.1d0)
1752: value(locv+45)=dmax1(value(locv+45),0.1d0)
1753: value(locv+46)=dmin1(value(locv+46),0.9999d0)
1754: loc=nodplc(loc)
1755: if(value(locv+18).eq.0.0d0) value(locv+18)=value(locv+16)
1756: if(value(locv+16).ge.value(locv+18)) go to 42
1757: write(6,44) value(locv)
1758: 44 format('0warning: minimum base resistance (rbm) is less than '
1759: 1 ,'total (rb) for model ',a8,/10x' rbm set equal to rb',/)
1760: value(locv+18)=value(locv+16)
1761: go to 42
1762: c... jfets
1763: 50 loc=locate(23)
1764: 52 if (loc.eq.0) go to 100
1765: locv=nodplc(loc+1)
1766: value(locv+11)=dmax1(value(locv+11),0.1d0)
1767: value(locv+12)=dmin1(value(locv+12),0.95d0)
1768: loc=nodplc(loc)
1769: go to 52
1770: c... mosfets
1771: 60 loc=locate(24)
1772: 64 if (loc.eq.0) go to 100
1773: locv=nodplc(loc+1)
1774: if(nodplc(loc+2).eq.0) go to 70
1775: c
1776: c special preprocessing for mosfet models
1777: c
1778: type=nodplc(loc+2)
1779: cox=epsox/value(locv+13)/hndrd
1780: c... if kp not given, calculate it from cox and uo
1781: if(value(locv+2).eq.0.0d0)
1782: 1 value(locv+2)=value(locv+23)*cox
1783: value(locv+35)=0.0d0
1784: c... nsub nonzero => calculate gamma, vto, phi unless specified
1785: if (value(locv+16).le.0.0d0) go to 68
1786: xnsub=value(locv+16)
1787: if (xnsub.le.xni) go to 66
1788: if (value(locv+4).le.0.0d0) value(locv+4)=2.0d0*vt*dlog(xnsub/xni)
1789: if (value(locv+3).le.0.0d0)
1790: 1 value(locv+3)=dsqrt(2.0d0*epssil*charge*xnsub)/cox
1791: fermis=type*0.5d0*value(locv+4)
1792: wkfng=3.2d0
1793: c... polysilicon gate ... calculate appropriate work function
1794: if (value(locv+21).le.0.0d0) go to 65
1795: fermig=type*value(locv+22)*vt*dlog(value(locv+21)/xni)
1796: wkfng=3.25d0+0.5d0*egfet-fermig
1797: 65 wkfngs=wkfng-(3.25d0+0.5d0*egfet+fermis)
1798: if(value(locv+1).eq.0.0d0)
1799: 1 value(locv+1)= wkfngs-value(locv+17)*charge/cox+
1800: 2 type*(value(locv+4)+value(locv+3)*dsqrt(value(locv+4)))
1801: value(locv+35)=dsqrt((epssil+epssil)/(charge*xnsub))
1802: go to 68
1803: 66 value(locv+16)=0.0d0
1804: write (6,67) value(locv)
1805: 67 format('0*error*: nsub < ni in mosfet model ',a8,/)
1806: nogo=1
1807: c... set phi to default if still zero
1808: 68 if(value(locv+4).eq.0.0d0) value(locv+4)=0.6d0
1809: value(locv+4)=dmax1(value(locv+4),0.1d0)
1810: value(locv+28)=dmax1(value(locv+28),0.1d0)
1811: value(locv+29)=dmin1(value(locv+29),0.95d0)
1812: loc=nodplc(loc)
1813: go to 64
1814: c... ga-as fets
1815: 70 value(locv+1)=-dabs(value(locv+1))
1816: if(value(locv+2).ne.0.0d0) value(locv+2)=-dabs(value(locv+2))
1817: value(locv+2)=dmax1(value(locv+2),-200.0d0)
1818: if(value(locv+9).eq.0.0d0)
1819: 1 value(locv+9)=2.49d-12*dsqrt(value(locv+5)/value(locv+3))
1820: loc=nodplc(loc)
1821: go to 64
1822: c
1823: c print model parameters
1824: c
1825: 100 if (iprntm.eq.0) go to 390
1826: locs=locate(id+20)
1827: 110 kntr=0
1828: loc=locs
1829: go to (120,130,140,150),id
1830: 120 call title(0,lwidth,1,titled)
1831: go to 200
1832: 130 call title(0,lwidth,1,titleb)
1833: go to 200
1834: 140 call title(0,lwidth,1,titlej)
1835: go to 200
1836: 150 call title(0,lwidth,1,titlem)
1837: 200 if (loc.eq.0) go to 210
1838: if (kntr.lt.kntlim) go to 220
1839: 210 locn=loc
1840: go to 240
1841: 220 kntr=kntr+1
1842: locv=nodplc(loc+1)
1843: atable(kntr)=value(locv)
1844: 230 loc=nodplc(loc)
1845: go to 200
1846: 240 write (6,241) (atable(k),k=1,kntr)
1847: 241 format(//11x,12(2x,a8))
1848: if (id.eq.1) go to 300
1849: kntr=0
1850: loc=locs
1851: 250 if (loc.eq.0) go to 260
1852: if (kntr.ge.kntlim) go to 260
1853: kntr=kntr+1
1854: atable(kntr)=antype(id)
1855: if (nodplc(loc+2).eq.-1) atable(kntr)=aptype(id)
1856: c... special type for ga-as (do not mix ga-as and mos!)
1857: if(id.eq.4.and.nodplc(loc+2).eq.0) atable(kntr)=agaas
1858: loc=nodplc(loc)
1859: go to 250
1860: 260 write (6,261) (atable(k),k=1,kntr)
1861: 261 format('0type',4x,12(4x,a6))
1862: 300 do 340 i=1,nopar
1863: if (itab(i).eq.0) go to 340
1864: kntr=0
1865: loc=locs
1866: 310 if (loc.eq.0) go to 320
1867: if (kntr.ge.kntlim) go to 320
1868: locv=nodplc(loc+1)
1869: kntr=kntr+1
1870: atable(kntr)=value(locv+i)
1871: loc=nodplc(loc)
1872: go to 310
1873: 320 if (itab(i).eq.2) go to 330
1874: write (6,321) ampar(locm+i),(atable(k),k=1,kntr)
1875: 321 format(1h ,a8,12f10.3)
1876: go to 340
1877: 330 write (6,331) ampar(locm+i),(atable(k),k=1,kntr)
1878: 331 format(1h ,a8,1p12d10.2)
1879: 340 continue
1880: if (locn.eq.0) go to 390
1881: locs=locn
1882: go to 110
1883: 390 continue
1884: c
1885: c process model parameters
1886: c
1887: c diodes
1888: c
1889: 400 loc=locate(21)
1890: 410 if (loc.eq.0) go to 420
1891: locv=nodplc(loc+1)
1892: if (value(locv+2).ne.0.0d0) value(locv+2)=1.0d0/value(locv+2)
1893: pb=value(locv+6)
1894: xm=value(locv+7)
1895: fc=value(locv+12)
1896: value(locv+12)=fc*pb
1897: xfc=dlog(1.0d0-fc)
1898: value(locv+15)=pb*(1.0d0-dexp((1.0d0-xm)*xfc))/(1.0d0-xm)
1899: value(locv+16)=dexp((1.0d0+xm)*xfc)
1900: value(locv+17)=1.0d0-fc*(1.0d0+xm)
1901: csat=value(locv+1)
1902: vte=value(locv+3)*vt
1903: value(locv+18)=vte*dlog(vte/(root2*csat))
1904: bv=value(locv+13)
1905: if(bv.eq.0.0d0) go to 418
1906: cbv=value(locv+14)
1907: if(cbv.ge.csat*bv/vt) go to 412
1908: cbv=csat*bv/vt
1909: write(6,411) value(locv),cbv
1910: 411 format('0warning: in diode model ',a8,' ibv increased to ',
1911: 1 1pd10.3,/10x,'to resolve incompatibility with specified is',/)
1912: xbv=bv
1913: go to 416
1914: 412 tol=reltol*cbv
1915: xbv=bv-vt*dlog(1.0d0+cbv/csat)
1916: iter=0
1917: 413 xbv=bv-vt*dlog(cbv/csat+1.0d0-xbv/vt)
1918: xcbv=csat*(dexp((bv-xbv)/vt)-1.0d0+xbv/vt)
1919: if (dabs(xcbv-cbv).le.tol) go to 416
1920: iter=iter+1
1921: if (iter.lt.25) go to 413
1922: write (6,415) xbv,xcbv
1923: 415 format('0warning: unable to match forward and reverse diode regio
1924: 1ns',/,11x,'bv = ',1pd10.3,' and ibv = ',d10.3,/)
1925: 416 value(locv+13)=xbv
1926: 418 loc=nodplc(loc)
1927: go to 410
1928: c
1929: c bipolar transistor models
1930: c
1931: 420 loc=locate(22)
1932: 430 if (loc.eq.0) go to 440
1933: locv=nodplc(loc+1)
1934: if(value(locv+4).ne.0.0d0) value(locv+4)=1.0d0/value(locv+4)
1935: if(value(locv+5).ne.0.0d0) value(locv+5)=1.0d0/value(locv+5)
1936: if(value(locv+10).ne.0.0d0) value(locv+10)=1.0d0/value(locv+10)
1937: if(value(locv+11).ne.0.0d0) value(locv+11)=1.0d0/value(locv+11)
1938: if(value(locv+19).ne.0.0d0) value(locv+19)=1.0d0/value(locv+19)
1939: if(value(locv+20).ne.0.0d0) value(locv+20)=1.0d0/value(locv+20)
1940: if(value(locv+26).ne.0.0d0) value(locv+26)=1.0d0/value(locv+26)
1941: 1 /1.44d0
1942: value(locv+28)=value(locv+28)/rad*value(locv+24)
1943: if(value(locv+35).ne.0.0d0) value(locv+35)=1.0d0/value(locv+35)
1944: 1 /1.44d0
1945: pe=value(locv+22)
1946: xme=value(locv+23)
1947: pc=value(locv+30)
1948: xmc=value(locv+31)
1949: fc=value(locv+46)
1950: value(locv+46)=fc*pe
1951: xfc=dlog(1.0d0-fc)
1952: value(locv+47)=pe*(1.0d0-dexp((1.0d0-xme)*xfc))/(1.0d0-xme)
1953: value(locv+48)=dexp((1.0d0+xme)*xfc)
1954: value(locv+49)=1.0d0-fc*(1.0d0+xme)
1955: value(locv+50)=fc*pc
1956: value(locv+51)=pc*(1.0d0-dexp((1.0d0-xmc)*xfc))/(1.0d0-xmc)
1957: value(locv+52)=dexp((1.0d0+xmc)*xfc)
1958: value(locv+53)=1.0d0-fc*(1.0d0+xmc)
1959: csat=value(locv+1)
1960: value(locv+54)=vt*dlog(vt/(root2*csat))
1961: loc=nodplc(loc)
1962: go to 430
1963: c
1964: c jfet models
1965: c
1966: 440 loc=locate(23)
1967: 450 if (loc.eq.0) go to 460
1968: locv=nodplc(loc+1)
1969: if (value(locv+4).ne.0.0d0) value(locv+4)=1.0d0/value(locv+4)
1970: if (value(locv+5).ne.0.0d0) value(locv+5)=1.0d0/value(locv+5)
1971: pb=value(locv+8)
1972: xm=0.5d0
1973: fc=value(locv+12)
1974: value(locv+12)=fc*pb
1975: xfc=dlog(1.0d0-fc)
1976: value(locv+13)=pb*(1.0d0-dexp((1.0d0-xm)*xfc))/(1.0d0-xm)
1977: value(locv+14)=dexp((1.0d0+xm)*xfc)
1978: value(locv+15)=1.0d0-fc*(1.0d0+xm)
1979: csat=value(locv+9)
1980: value(locv+16)=vt*dlog(vt/(root2*csat))
1981: loc=nodplc(loc)
1982: go to 450
1983: c
1984: c mosfet models
1985: c
1986: 460 loc=locate(24)
1987: 470 if (loc.eq.0) go to 600
1988: locv=nodplc(loc+1)
1989: if(nodplc(loc+2).eq.0) go to 490
1990: type=nodplc(loc+2)
1991: c... check validiy of lambda
1992: if(value(locv+5).lt.5.0d-6) go to 472
1993: write(6,471) value(locv)
1994: 471 format('0warning: value for lambda unrealisticly large for model'
1995: 1 ,1x,a8,/'0this parameter has been re-defined. see latest users '
1996: 2 ,'guide.')
1997: 472 value(locv+5)=value(locv+5)*hndrd
1998: value(locv+8)=value(locv+8)/hndrd
1999: value(locv+9)=value(locv+9)/hndrd
2000: value(locv+10)=value(locv+10)/hndrd
2001: value(locv+11)=value(locv+11)/hndrd2
2002: value(locv+12)=value(locv+12)/hndrd2
2003: value(locv+13)=value(locv+13)*hndrd
2004: value(locv+15)=value(locv+15)/hndrd2
2005: value(locv+19)=value(locv+19)*hndrd
2006: value(locv+20)=value(locv+20)*hndrd
2007: c.. move the params wd-gleff out to positions 36-40
2008: value(locv+36)=value(locv+30)*hndrd
2009: value(locv+37)=value(locv+31)
2010: value(locv+38)=value(locv+32)
2011: value(locv+39)=value(locv+33)
2012: value(locv+40)=value(locv+34)
2013: if(value(locv+39).ne.0.0d0) value(locv+39)=1.0d0/value(locv+39)
2014: if (value(locv+6).ne.0.0d0) value(locv+6)=1.0d0/value(locv+6)
2015: if (value(locv+7).ne.0.0d0) value(locv+7)=1.0d0/value(locv+7)
2016: if (value(locv+13).ne.0.0d0) value(locv+13)=epsox/value(locv+13)
2017: value(locv+34)=value(locv+1)-
2018: 1 type*value(locv+3)*dsqrt(value(locv+4))
2019: if (value(locv+13).ne.0.0d0)
2020: 1 value(locv+24)=value(locv+24)*epssil/value(locv+13)
2021: pb=value(locv+14)
2022: c... enter here from ga-as processing also
2023: 475 xm=0.5d0
2024: fc=value(locv+29)
2025: value(locv+29)=fc*pb
2026: xfc=dlog(1.0d0-fc)
2027: value(locv+30)=pb*(1.0d0-dexp((1.0d0-xm)*xfc))/(1.0d0-xm)
2028: value(locv+31)=dexp((1.0d0+xm)*xfc)
2029: value(locv+32)=1.0d0-fc*(1.0d0+xm)
2030: value(locv+33)=-1.0d0
2031: 480 loc=nodplc(loc)
2032: go to 470
2033: c... ga-as processing
2034: 490 value(locv+24)=2.5d+05*dexp(value(locv+2)/1.3d0)
2035: value(locv+25)=5.0d+06*dexp(-value(locv+4)/vt)
2036: value(locv+26)=3.9d-12*dsqrt(value(locv+5)*(value(locv+3)-
2037: 1 value(locv+1)))
2038: value(locv+28)=value(locv+26)*(1.0d0-dsqrt((value(locv+3)-
2039: 1 0.99999d0*value(locv+1))/(value(locv+3)-value(locv+1))))
2040: value(locv+29)=0.5d0
2041: pb=value(locv+3)
2042: go to 475
2043: c
2044: c reserve additional nodes
2045: c convert mosfet geometries to cm
2046: c
2047: c diodes
2048: c
2049: 600 loc=locate(11)
2050: 610 if (loc.eq.0) go to 700
2051: locm=nodplc(loc+5)
2052: locm=nodplc(locm+1)
2053: if (value(locm+2).eq.0.0d0) go to 620
2054: numnod=numnod+1
2055: nodplc(loc+4)=numnod
2056: go to 630
2057: 620 nodplc(loc+4)=nodplc(loc+2)
2058: 630 loc=nodplc(loc)
2059: go to 610
2060: c
2061: c transistors
2062: c
2063: 700 loc=locate(12)
2064: 710 if (loc.eq.0) go to 800
2065: c
2066: c put substrate node into nodplc(loc+30)
2067: c
2068: nodplc(loc+30)=nodplc(loc+5)
2069: locm=nodplc(loc+8)
2070: locm=nodplc(locm+1)
2071: if(value(locm+16).eq.0.0d0) go to 720
2072: numnod=numnod+1
2073: nodplc(loc+6)=numnod
2074: go to 730
2075: 720 nodplc(loc+6)=nodplc(loc+3)
2076: 730 if (value(locm+20).eq.0.0d0) go to 740
2077: numnod=numnod+1
2078: nodplc(loc+5)=numnod
2079: go to 750
2080: 740 nodplc(loc+5)=nodplc(loc+2)
2081: 750 if (value(locm+19).eq.0.0d0) go to 760
2082: numnod=numnod+1
2083: nodplc(loc+7)=numnod
2084: go to 770
2085: 760 nodplc(loc+7)=nodplc(loc+4)
2086: 770 loc=nodplc(loc)
2087: go to 710
2088: c
2089: c jfets
2090: c
2091: 800 loc=locate(13)
2092: 810 if (loc.eq.0) go to 900
2093: locm=nodplc(loc+7)
2094: locm=nodplc(locm+1)
2095: if (value(locm+4).eq.0.0d0) go to 820
2096: numnod=numnod+1
2097: nodplc(loc+5)=numnod
2098: go to 830
2099: 820 nodplc(loc+5)=nodplc(loc+2)
2100: 830 if (value(locm+5).eq.0.0d0) go to 840
2101: numnod=numnod+1
2102: nodplc(loc+6)=numnod
2103: go to 850
2104: 840 nodplc(loc+6)=nodplc(loc+4)
2105: 850 loc=nodplc(loc)
2106: go to 810
2107: c
2108: c mosfets
2109: c
2110: 900 loc=locate(14)
2111: 910 if (loc.eq.0) go to 1000
2112: locm=nodplc(loc+8)
2113: locv=nodplc(loc+1)
2114: if(nodplc(locm+2).eq.0) go to 960
2115: locm=nodplc(locm+1)
2116: value(locv+1)=value(locv+1)*hndrd
2117: value(locv+2)=value(locv+2)*hndrd
2118: value(locv+3)=value(locv+3)*hndrd2
2119: value(locv+4)=value(locv+4)*hndrd2
2120: c... check that effective channel length is greater than zero
2121: if((value(locv+1)-2.0d0*value(locm+20)).gt.0.0d0)
2122: 1 go to 914
2123: write(6,913) value(locv),value(locm)
2124: 913 format('0*error*: effective channel length of ',a8,' less than ',
2125: 1 'zero.',/' check value of ld for model ',a8)
2126: nogo=1
2127: 914 if((value(locv+2)-2.0d0*value(locm+36)).gt.0.0d0) go to 916
2128: write(6,915) value(locv),value(locm)
2129: 915 format('0*error*: effective channel width of ',a8,' less than ',
2130: 1 'zero.',/' check value of wd for model ',a8)
2131: nogo=1
2132: 916 if (value(locv+11).eq.0.0d0) go to 917
2133: value(locv+11)=1.0d0/value(locv+11)
2134: go to 918
2135: 917 if(value(locm+6).eq.0.0d0) go to 920
2136: value(locv+11)=value(locm+6)
2137: 918 numnod=numnod+1
2138: nodplc(loc+6)=numnod
2139: go to 930
2140: 920 nodplc(loc+6)=nodplc(loc+2)
2141: 930 if (value(locv+12).eq.0.0d0) go to 931
2142: value(locv+12)=1.0d0/value(locv+12)
2143: go to 932
2144: 931 if(value(locm+7).eq.0.0d0) go to 940
2145: value(locv+12)=value(locm+7)
2146: 932 numnod=numnod+1
2147: nodplc(loc+7)=numnod
2148: go to 950
2149: 940 nodplc(loc+7)=nodplc(loc+4)
2150: 950 loc=nodplc(loc)
2151: go to 910
2152: c.. special case for ga-as devices
2153: c.. compute rd and rs if not specified on device card
2154: c.. rd and rs are always non-zero.
2155: 960 locm=nodplc(locm+1)
2156: req=1.25d+14/(value(locm+5)*value(locv+2))
2157: if (value(locv+11).eq.0.0d0) value(locv+11)=req
2158: value(locv+11)=1.0d0/value(locv+11)
2159: numnod=numnod+1
2160: nodplc(loc+6)=numnod
2161: if (value(locv+12).eq.0.0d0) value(locv+12)=req
2162: value(locv+12)=1.0d0/value(locv+12)
2163: numnod=numnod+1
2164: nodplc(loc+7)=numnod
2165: loc=nodplc(loc)
2166: go to 910
2167: c
2168: c transmission lines
2169: c
2170: 1000 loc=locate(17)
2171: 1010 if (loc.eq.0) go to 2000
2172: numnod=numnod+1
2173: nodplc(loc+6)=numnod
2174: numnod=numnod+1
2175: nodplc(loc+7)=numnod
2176: loc=nodplc(loc)
2177: go to 1010
2178: c
2179: c finished
2180: c
2181: 2000 return
2182: end
2183: subroutine topchk
2184: implicit double precision (a-h,o-z)
2185: c
2186: c this routine constructs the element node table. it also checks
2187: c for voltage source/inductor loops, current source/capacitor cutsets,
2188: c and that every node has a dc (conductive) path to ground.
2189: c
2190: common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
2191: 1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
2192: 2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
2193: 3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
2194: 4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
2195: 5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
2196: common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
2197: 1 defas,rstats(50),iwidth,lwidth,nopage
2198: common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
2199: 1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
2200: common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
2201: 1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
2202: common /blank/ value(1000)
2203: integer nodplc(64)
2204: complex*16 cvalue(32)
2205: equivalence (value(1),nodplc(1),cvalue(1))
2206: c
2207: c
2208: dimension atable(12),aide(20),nnods(20)
2209: dimension idlist(4)
2210: dimension toptit(4)
2211: data toptit / 8helement , 8hnode tab, 8hle , 8h /
2212: data idlist / 3, 6, 8, 9 /
2213: data aide / 1hr,0.0d0,1hl,2*0.0d0,1he,0.0d0,1hh,1hv,0.0d0,1hd,
2214: 1 1hq,1hj,1hm,0.0d0,0.0d0,1ht,0.0d0,0.0d0,0.0d0 /
2215: data nnods / 2,2,2,0,2,2,2,2,2,2,2,4,3,4,4,4,4,0,1,0 /
2216: data ablnk /1h /
2217: c
2218: c allocate storage
2219: c
2220: call getm4(iorder,ncnods)
2221: call getm4(iur,ncnods+1)
2222: c
2223: c construct node table
2224: c
2225: kntlim=lwidth/11
2226: 1300 call getm4(itable,0)
2227: call getm4(itabid,0)
2228: istop=ncnods+1
2229: do 1310 i=1,istop
2230: 1310 nodplc(iur+i)=1
2231: do 1370 id=1,19
2232: if (nnods(id).eq.0) go to 1370
2233: loc=locate(id)
2234: 1320 if (loc.eq.0) go to 1370
2235: nloc=loc+1
2236: jstop=nnods(id)
2237: if (id.ne.19) go to 1330
2238: nloc=nodplc(loc+2)
2239: call sizmem(nodplc(loc+2),jstop)
2240: 1330 do 1360 j=1,jstop
2241: node=nodplc(nloc+j)
2242: ispot=nodplc(iur+node+1)
2243: k=nodplc(iur+ncnods+1)
2244: call extmem(itable,1)
2245: call extmem(itabid,1)
2246: if (k.le.ispot) go to 1340
2247: call copy4(nodplc(itable+ispot),nodplc(itable+ispot+1),k-ispot)
2248: call copy4(nodplc(itabid+ispot),nodplc(itabid+ispot+1),k-ispot)
2249: 1340 nodplc(itable+ispot)=loc
2250: nodplc(itabid+ispot)=id
2251: c... treat the substrate node of a mosfet as if it were a transmission
2252: c... line node, i.e. let it dangle if desired
2253: if(id.eq.14.and.j.eq.4) nodplc(itabid+ispot)=17
2254: k=node
2255: kstop=ncnods+1
2256: 1350 k=k+1
2257: if (k.gt.kstop) go to 1360
2258: nodplc(iur+k)=nodplc(iur+k)+1
2259: go to 1350
2260: 1360 continue
2261: loc=nodplc(loc)
2262: go to 1320
2263: 1370 continue
2264: c
2265: c check that every node has a dc path to ground
2266: c
2267: call zero4(nodplc(iorder+1),ncnods)
2268: nodplc(iorder+1)=1
2269: 1420 iflag=0
2270: do 1470 i=2,ncnods
2271: if (nodplc(iorder+i).eq.1) go to 1470
2272: jstart=nodplc(iur+i)
2273: jstop=nodplc(iur+i+1)-1
2274: if (jstart.gt.jstop) go to 1470
2275: do 1450 j=jstart,jstop
2276: loc=nodplc(itable+j)
2277: id=nodplc(itabid+j)
2278: if (aide(id).eq.0.0d0) go to 1450
2279: if (id.eq.17) go to 1445
2280: kstop=loc+nnods(id)-1
2281: do 1440 k=loc,kstop
2282: node=nodplc(k+2)
2283: if (nodplc(iorder+node).eq.1) go to 1460
2284: 1440 continue
2285: go to 1450
2286: 1445 if (nodplc(loc+2).eq.i) node=nodplc(loc+3)
2287: if (nodplc(loc+3).eq.i) node=nodplc(loc+2)
2288: if (nodplc(loc+4).eq.i) node=nodplc(loc+5)
2289: if (nodplc(loc+5).eq.i) node=nodplc(loc+4)
2290: if (nodplc(iorder+node).eq.1) go to 1460
2291: 1450 continue
2292: go to 1470
2293: 1460 nodplc(iorder+i)=1
2294: iflag=1
2295: 1470 continue
2296: if (iflag.eq.1) go to 1420
2297: c
2298: c print node table and topology error messages
2299: c
2300: if (iprntn.eq.0) go to 1510
2301: call title(0,lwidth,1,toptit)
2302: 1510 do 1590 i=1,ncnods
2303: jstart=nodplc(iur+i)
2304: jstop=nodplc(iur+i+1)-1
2305: if (iprntn.eq.0) go to 1550
2306: if (jstart.le.jstop) go to 1520
2307: write (6,1511) nodplc(junode+i)
2308: 1511 format(1h0,i7)
2309: go to 1550
2310: 1520 kntr=0
2311: jflag=1
2312: do 1540 j=jstart,jstop
2313: loc=nodplc(itable+j)
2314: locv=nodplc(loc+1)
2315: kntr=kntr+1
2316: atable(kntr)=value(locv)
2317: if (kntr.lt.kntlim) go to 1540
2318: if (jflag.eq.0) go to 1525
2319: jflag=0
2320: write (6,1521) nodplc(junode+i),(atable(k),k=1,kntr)
2321: 1521 format(1h0,i7,3x,12(1x,a8))
2322: go to 1530
2323: 1525 write (6,1526) (atable(k),k=1,kntr)
2324: 1526 format(11x,12(1x,a8))
2325: 1530 kntr=0
2326: 1540 continue
2327: if (kntr.eq.0) go to 1550
2328: if (jflag.eq.0) go to 1545
2329: write (6,1521) nodplc(junode+i),(atable(k),k=1,kntr)
2330: go to 1550
2331: 1545 write (6,1526) (atable(k),k=1,kntr)
2332: 1550 if (jstart-jstop) 1560,1552,1556
2333: c
2334: c allow node with only one connection iff element is a t-line
2335: c
2336: 1552 if (nodplc(itabid+jstart).eq.17) go to 1560
2337: 1556 nogo=1
2338: write (6,1557) nodplc(junode+i)
2339: 1557 format('0*error*: less than 2 connections at node ',i6/)
2340: go to 1590
2341: 1560 if (nodplc(iorder+i).eq.1) go to 1590
2342: nogo=1
2343: write (6,1561) nodplc(junode+i)
2344: 1561 format('0*error*: no dc path to ground from node ',i6/)
2345: 1590 continue
2346: c
2347: c check for inductor/voltage source loops
2348: c
2349: do 1700 i=1,ncnods
2350: call zero4(nodplc(iorder+1),ncnods)
2351: nodplc(iorder+i)=-1
2352: do 1690 idcntr=1,4
2353: id=idlist(idcntr)
2354: loc=locate(id)
2355: 1610 if (loc.eq.0) go to 1690
2356: node1=nodplc(loc+2)
2357: node2=nodplc(loc+3)
2358: if (nodplc(iorder+node1)) 1620,1640,1630
2359: 1620 nodplc(iorder+node1)=loc
2360: 1630 node=node2
2361: go to 1670
2362: 1640 if (nodplc(iorder+node2)) 1650,1680,1660
2363: 1650 nodplc(iorder+node2)=loc
2364: 1660 node=node1
2365: 1670 if (nodplc(iorder+node).ne.0) go to 1710
2366: nodplc(iorder+node)=loc
2367: 1680 loc=nodplc(loc)
2368: go to 1610
2369: 1690 continue
2370: 1700 continue
2371: go to 1900
2372: c ... loop found
2373: 1710 locv=nodplc(loc+1)
2374: write (6,1711) value(locv)
2375: 1711 format('0*error*: inductor/voltage source loop found, containing
2376: 1',a8/)
2377: nogo=1
2378: c
2379: c
2380: 1900 call clrmem(iorder)
2381: call clrmem(iur)
2382: call clrmem(itable)
2383: call clrmem(itabid)
2384: 2000 return
2385: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.