projects / unix-history / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
BSD 3 development
[unix-history] / usr / src / cmd / spice / errchks.f
CommitLineData
7316c58a
D		 1 subroutine errchk
2 implicit double precision (a-h,o-z)
3c
4c
5c this routine drives the pre-processing and general error-checking
6c of input performed by spice.
7c
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))
37c
38c
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 /
51c
52c
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
73c
74c construct ordered list of user specified nodes
75c
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
110c
111c assign program nodes
112c
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
144c
145c check and set .nodeset nodes to their internal values
146c
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
152c
153c check and set .ic nodes to their internal values
154c
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
161c
162c expand subcircuit calls
163c
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
172c
173c link unsatisfied references
174c
175 call lnkref
176 if (nogo.ne.0) go to 2000
177c
178c generate subcircuit element names
179c
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
188c
189c translate node initial conditions to device initial conditions
190c (capacitance, diode, bjt, and mosfet only
191c
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)
257c
258c process sources
259c
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
312c
313c use default values for mos device geometries if not specified
314c
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
324c
325c print listing of elements, process device models,
326c and check topology
327c
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
333c
334c invert resistance values
335c
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
342c
343c process mutual inductors
344c
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
371c
372c limit delmax to minimum delay over 2 if transmission lines in circuit
373c
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
383c
384c process source parameters
385c
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)
456c
457c print option summary
458c
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)
494c
495c miscellaneous error checking
496c
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
542c
543c sequence through the output lists
544c
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
554c
555c increase number of .prints if too many outputs for output line-width
556c
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
572c
573c exit
574c
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)
581c
582c this routine sorts the array a using a shell sort algorithm.
583c
584 dimension a(n)
585 integer h
586c
587c
588c... compute best starting step size
589 h=1
590 10 h=3*h+1
591 if (h.lt.n) go to 10
592c... back off two times
593 h=(h-1)/3
594 h=(h-1)/3
595 h=max0(h,1)
596c
597c shell sort
598c
599 20 j=h+1
600 go to 60
601 30 i=j-h
602c... 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)
618c
619c this routine adds 'node' to the list of user input nodes in table
620c junode.
621c
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))
634c
635c
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
647c
648c finished
649c
650 100 return
651 end
652 subroutine getnod(node)
653 implicit double precision (a-h,o-z)
654c
655c this routine converts from the user node number to the internal
656c (compact) node number.
657c
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))
672c
673c
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
681c
682c unknown node -- must be implied by .print and/or .plot
683c
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
689c
690c finished
691c
692 100 return
693 end
694 subroutine subckt
695 implicit double precision (a-h,o-z)
696c
697c this routine drives the expansion of subcircuit calls.
698c
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))
713c
714c
715c... avoid 'call by value' problems, make inodi, inodx arrays
716c... 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)
724c
725c check for recursion
726c
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
732c
733c
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)
743c
744c add elements of subcircuit to nominal circuit
745c
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
755c
756c
757 200 call clrmem(inodx)
758 call clrmem(inodi)
759 locx=nodplc(locx)
760 go to 10
761c
762c errors
763c
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
778c
779c finished
780c
781 300 return
782 end
783 subroutine fndnam(anam,jsbptr,ispot,id)
784 implicit double precision (a-h,o-z)
785c
786c this routine searches for an element with id 'id' by tracing back
787c up the subcircuit definition list. if the element is not found, the
788c nominal element list is searched.
789c
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
805c
806c
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
821c
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)
838c
839c this routine makes a new node number for an element which is about
840c to be added to the circuit as a result of a subcircuit call.
841c
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))
854c
855c... inodx, inodi are arrays (see subckt)
856 dimension inodx(1),inodi(1)
857c
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
868c
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)
884c
885c this routine adds an element to the nominal circuit definition
886c lists.
887c
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))
902c
903c... inodx(1), inodi(1) are arrays (see subckt)
904 dimension inodx(1),inodi(1)
905c
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 /
922c
923c copy integer part
924c
925 nword=lnod(id)-3
926 if (nword.le.0) go to 10
927 call copy4(nodplc(loc+2),nodplc(loce+2),nword)
928c
929c set nodes
930c
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
962c
963c copy real part
964c
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))
969c
970c treat non-node tables specially
971c
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)
990c
991c
992 300 return
993 end
994 subroutine cpytb4(itabo,itabn)
995 implicit double precision (a-h,o-z)
996c
997c this routine copies a table. its use is made necessary by the
998c fact that only one pointer is allowed per table.
999c
1000 common /blank/ value(1000)
1001 integer nodplc(64)
1002 complex*16 cvalue(32)
1003 equivalence (value(1),nodplc(1),cvalue(1))
1004c
1005c
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)
1015c
1016c this routine copies a table. its use is made necessary by the
1017c fact that only one pointer is allowed per table.
1018c
1019 common /blank/ value(1000)
1020 integer nodplc(64)
1021 complex*16 cvalue(32)
1022 equivalence (value(1),nodplc(1),cvalue(1))
1023c
1024c
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)
1034c
1035c this routine resolves all unsatisfied name references.
1036c
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))
1051c
1052c mutual inductors
1053c
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
1062c
1063c current-controlled current source
1064c
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
1075c
1076c current-controlled voltage sources
1077c
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
1088c
1089c diodes
1090c
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
1097c
1098c bjts
1099c
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
1106c
1107c jfets
1108c
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
1115c
1116c mosfets
1117c
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
1124c
1125c finished
1126c
1127 1000 call clrmem(iunsat)
1128 return
1129 end
1130 subroutine subnam(loce)
1131 implicit double precision (a-h,o-z)
1132c
1133c this routine constructs the names of elements added as a result of
1134c subcircuit expansion. the full element names are of the form
1135c name.xn. --- xd.xc.xb.xa
1136c where 'name' is the nominal element name, and the 'x'*s denote the
1137c sequence of subcircuit calls (from top or circuit level down through
1138c nested subcircuit calls) which caused the particular element to be
1139c added. at present, spice restricts all element names to be 8 charac-
1140c ters or less. therefore, the name used consists of the leftmost 8
1141c characters of the full element name, with the rightmost character
1142c replaced by an asterisk ('*') if the full element name is longer than
1143c 8 characters.
1144c
1145 common /blank/ value(1000)
1146 integer nodplc(64)
1147 complex*16 cvalue(32)
1148 equivalence (value(1),nodplc(1),cvalue(1))
1149c
1150c
1151 data ablank, aper, astk / 1h , 1h., 1h* /
1152c
1153c construct subcircuit element name
1154c
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
1176c
1177c name is longer than 8 characters: flag with asterisk
1178c
1179 40 call move(sname,8,astk,1,1)
1180 60 value(locve)=sname
1181c
1182c finished
1183c
1184 100 return
1185 end
1186 subroutine elprnt
1187 implicit double precision (a-h,o-z)
1188c
1189c this routine prints a circuit element summary.
1190c
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))
1208c
1209c
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/
1215c
1216c print listing of elements
1217c
1218 call title(0,lwidth,1,eltitl)
1219c
1220c print resistors
1221c
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
1238c
1239c print capacitors and inductors
1240c
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
1267c
1268c print mutual inductors
1269c
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
1287c
1288c print nonlinear voltage controlled sources
1289c
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
1306c
1307c nonlinear voltage controlled voltage sources
1308c
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
1324c
1325c nonlinear current controlled current sources
1326c
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
1342c
1343c nonlinear current controlled voltage sources
1344c
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
1360c
1361c print independent sources
1362c
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
1429c
1430c print transmission lines
1431c
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
1451c
1452c print diodes
1453c
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
1474c
1475c print transistors
1476c
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
1500c
1501c print jfets
1502c
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
1525c
1526c print mosfets
1527c
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
1559c
1560c subcircuit calls
1561c
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
1594c
1595c finished
1596c
1597 500 return
1598 end
1599 subroutine modchk
1600 implicit double precision (a-h,o-z)
1601c
1602c this routine performs one-time processing of device model para-
1603c meters and prints out a device model summary. it also reserves the
1604c additional nodes required by nonzero device extrinsic resistances.
1605c
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))
1627c
1628c
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/
1686c
1687c
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
1696c
1697c assign default values
1698c
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
1707c... 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
1718c.. let pt be negative for bjts (for now anyway!)
1719 if(i.eq.43.and.id.eq.2) go to 18
1720c... 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
1723c... 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
1728c
1729c limit model values
1730c
1731 20 go to (30,40,50,60), id
1732c... 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
1742c... 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
1762c... 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
1770c... 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
1775c
1776c special preprocessing for mosfet models
1777c
1778 type=nodplc(loc+2)
1779 cox=epsox/value(locv+13)/hndrd
1780c... 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
1784c... 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
1793c... 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
1807c... 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
1814c... 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
1822c
1823c print model parameters
1824c
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)
1856c... 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
1884c
1885c process model parameters
1886c
1887c diodes
1888c
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
1928c
1929c bipolar transistor models
1930c
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
1963c
1964c jfet models
1965c
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
1983c
1984c mosfet models
1985c
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)
1991c... 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
2007c.. 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)
2022c... 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
2033c... 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
2043c
2044c reserve additional nodes
2045c convert mosfet geometries to cm
2046c
2047c diodes
2048c
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
2060c
2061c transistors
2062c
2063 700 loc=locate(12)
2064 710 if (loc.eq.0) go to 800
2065c
2066c put substrate node into nodplc(loc+30)
2067c
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
2088c
2089c jfets
2090c
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
2107c
2108c mosfets
2109c
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
2120c... 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
2152c.. special case for ga-as devices
2153c.. compute rd and rs if not specified on device card
2154c.. 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
2167c
2168c transmission lines
2169c
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
2178c
2179c finished
2180c
2181 2000 return
2182 end
2183 subroutine topchk
2184 implicit double precision (a-h,o-z)
2185c
2186c this routine constructs the element node table. it also checks
2187c for voltage source/inductor loops, current source/capacitor cutsets,
2188c and that every node has a dc (conductive) path to ground.
2189c
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))
2206c
2207c
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 /
2217c
2218c allocate storage
2219c
2220 call getm4(iorder,ncnods)
2221 call getm4(iur,ncnods+1)
2222c
2223c construct node table
2224c
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
2251c... treat the substrate node of a mosfet as if it were a transmission
2252c... 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
2264c
2265c check that every node has a dc path to ground
2266c
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
2297c
2298c print node table and topology error messages
2299c
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
2333c
2334c allow node with only one connection iff element is a t-line
2335c
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
2346c
2347c check for inductor/voltage source loops
2348c
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
2372c ... 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
2378c
2379c
2380 1900 call clrmem(iorder)
2381 call clrmem(iur)
2382 call clrmem(itable)
2383 call clrmem(itabid)
2384 2000 return
2385 end
Continuous source code history from original PDP-7 UNIX to FreeBSD 2, the first fully unencumbered FreeBSD release.