3BSD/usr/src/cmd/spice/errchks.f
subroutine errchk
implicit double precision (a-h,o-z)
c
c
c this routine drives the pre-processing and general error-checking
c of input performed by spice.
c
common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
1 defas,rstats(50),iwidth,lwidth,nopage
common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
common /cje/ maxtim,itime,icost
common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
1 xmu,mode,modedc,icalc,initf,method,iord,maxord,noncon,iterno,
2 itemno,nosolv,ipostp,iscrch
common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok,
1 gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox
common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop,
1 kinel,kidin,kovar,kidout
common /ac/ fstart,fstop,fincr,skw2,refprl,spw2,jacflg,idfreq,
1 inoise,nosprt,nosout,nosin,idist,idprt
common /tran/ tstep,tstop,tstart,delmax,tdmax,forfre,jtrflg
common /outinf/ xincr,string(15),xstart,yvar(8),itab(8),itype(8),
1 ilogy(8),npoint,numout,kntr,numdgt
common /blank/ value(1000)
integer nodplc(64)
complex*16 cvalue(32)
equivalence (value(1),nodplc(1),cvalue(1))
c
c
dimension titlop(4)
dimension nnods(50),aname(2)
data aname / 4htrap, 4hgear /
data titlop / 8hoption s, 8hummary , 8h , 8h /
data ndefin / 2h.u /
data nnods / 2, 2, 2, 0, 2, 2, 2, 2, 2, 2,
1 2, 4, 3, 4, 0, 0, 4, 0, 1, 0,
2 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4 2, 2, 2, 0, 0, 0, 0, 0, 0, 0 /
data aelmt,amodel,aoutpt /7helement,5hmodel,6houtput/
data alsdc,alstr,alsac / 2hdc, 4htran, 2hac /
c
c
call second(t1)
do 60 id=1,50
loc=locate(id)
10 if (loc.eq.0) go to 60
if (nodplc(loc+2).ne.ndefin) go to 50
nogo=1
locv=nodplc(loc+1)
if (id.ge.21) go to 20
anam=aelmt
go to 40
20 if (id.ge.31) go to 30
anam=amodel
go to 40
30 anam=aoutpt
40 write (6,41) anam,value(locv)
41 format('0*error*: ',2a8,' has been referenced but not defined'/)
50 loc=nodplc(loc)
go to 10
60 continue
if (nogo.ne.0) go to 2000
c
c construct ordered list of user specified nodes
c
call getm4(junode,1)
nodplc(junode+1)=0
nunods=1
do 180 id=1,50
if (nnods(id).eq.0) go to 180
loc=locate(id)
110 if (loc.eq.0) go to 180
if (id.le.4) go to 120
if (id.le.8) go to 150
if (id.eq.19) go to 165
if (id.le.40) go to 120
if (id.le.43) go to 170
120 jstop=loc+nnods(id)-1
do 130 j=loc,jstop
call putnod(nodplc(j+2))
130 continue
go to 170
150 call putnod(nodplc(loc+2))
call putnod(nodplc(loc+3))
if (id.ge.7) go to 170
locp=nodplc(loc+id+1)
nssnod=2*nodplc(loc+4)
155 do 160 j=1,nssnod
call putnod(nodplc(locp+j))
160 continue
go to 170
165 locp=nodplc(loc+2)
call sizmem(nodplc(loc+2),nssnod)
go to 155
170 loc=nodplc(loc)
go to 110
180 continue
if (nogo.ne.0) go to 2000
ncnods=nunods
c
c assign program nodes
c
200 do 280 id=1,50
if (nnods(id).eq.0) go to 280
loc=locate(id)
210 if (loc.eq.0) go to 280
if (id.le.4) go to 220
if (id.le.8) go to 250
if (id.eq.19) go to 265
if (id.le.40) go to 220
if (id.le.43) go to 240
220 jstop=loc+nnods(id)-1
do 230 j=loc,jstop
call getnod(nodplc(j+2))
230 continue
go to 270
240 if (nodplc(loc+5).eq.0) go to 220
go to 270
250 call getnod(nodplc(loc+2))
call getnod(nodplc(loc+3))
if (id.ge.7) go to 270
locp=nodplc(loc+id+1)
nssnod=2*nodplc(loc+4)
255 do 260 j=1,nssnod
call getnod(nodplc(locp+j))
260 continue
go to 270
265 locp=nodplc(loc+2)
call sizmem(nodplc(loc+2),nssnod)
go to 255
270 loc=nodplc(loc)
go to 210
280 continue
c
c check and set .nodeset nodes to their internal values
c
call sizmem(nsnod,nic)
if(nic.eq.0) go to 300
do 290 i=1,nic
call getnod(nodplc(nsnod+i))
290 continue
c
c check and set .ic nodes to their internal values
c
300 call sizmem(icnod,nic)
if(nic.eq.0) go to 320
do 310 i=1,nic
call getnod(nodplc(icnod+i))
310 continue
320 if (nogo.ne.0) go to 2000
c
c expand subcircuit calls
c
call subckt
if (nogo.ne.0) go to 2000
if (ncnods.ge.2) go to 400
write (6,321)
321 format('0*error*: circuit has no nodes'/)
nogo=1
go to 2000
400 numnod=ncnods
c
c link unsatisfied references
c
call lnkref
if (nogo.ne.0) go to 2000
c
c generate subcircuit element names
c
if (jelcnt(19).eq.0) go to 530
do 520 id=1,24
loc=locate(id)
510 if (loc.eq.0) go to 520
call subnam(loc)
loc=nodplc(loc)
go to 510
520 continue
c
c translate node initial conditions to device initial conditions
c (capacitance, diode, bjt, and mosfet only
c
530 call sizmem(icnod,nic)
if(nic.eq.0) go to 600
call getm8(lvnim1,numnod)
call zero8(value(lvnim1+1),numnod)
do 535 i=1,nic
node=nodplc(icnod+i)
535 value(lvnim1+node)=value(icval+i)
loc=locate(2)
540 if(loc.eq.0) go to 550
locv=nodplc(loc+1)
if(value(locv+2).ne.0.0d0) go to 545
node1=nodplc(loc+2)
node2=nodplc(loc+3)
value(locv+2)=value(lvnim1+node1)-value(lvnim1+node2)
545 loc=nodplc(loc)
go to 540
550 loc=locate(11)
555 if(loc.eq.0) go to 565
locv=nodplc(loc+1)
if(value(locv+2).ne.0.0d0) go to 560
node1=nodplc(loc+2)
node2=nodplc(loc+3)
value(locv+2)=value(lvnim1+node1)-value(lvnim1+node2)
560 loc=nodplc(loc)
go to 555
565 loc=locate(12)
570 if(loc.eq.0) go to 580
locv=nodplc(loc+1)
node1=nodplc(loc+2)
node2=nodplc(loc+3)
node3=nodplc(loc+4)
if(value(locv+2).eq.0.0d0) value(locv+2)=value(lvnim1+node2)-
1 value(lvnim1+node3)
if(value(locv+3).eq.0.0d0) value(locv+3)=value(lvnim1+node1)-
1 value(lvnim1+node3)
loc=nodplc(loc)
go to 570
580 loc=locate(13)
585 if(loc.eq.0) go to 590
locv=nodplc(loc+1)
node1=nodplc(loc+2)
node2=nodplc(loc+3)
node3=nodplc(loc+4)
if(value(locv+2).eq.0.0d0) value(locv+2)=value(lvnim1+node1)-
1 value(lvnim1+node3)
if(value(locv+3).eq.0.0d0) value(locv+3)=value(lvnim1+node2)-
1 value(lvnim1+node3)
loc=nodplc(loc)
go to 585
590 loc=locate(14)
595 if(loc.eq.0) go to 598
locv=nodplc(loc+1)
node1=nodplc(loc+2)
node2=nodplc(loc+3)
node3=nodplc(loc+4)
node4=nodplc(loc+5)
if(value(locv+5).eq.0.0d0) value(locv+5)=value(lvnim1+node1)-
1 value(lvnim1+node3)
if(value(locv+6).eq.0.0d0) value(locv+6)=value(lvnim1+node2)-
1 value(lvnim1+node3)
if(value(locv+7).eq.0.0d0) value(locv+7)=value(lvnim1+node4)-
1 value(lvnim1+node3)
loc=nodplc(loc)
go to 595
598 call clrmem(lvnim1)
c
c process sources
c
600 if (jtrflg.eq.0) go to 700
do 690 id=9,10
loc=locate(id)
610 if (loc.eq.0) go to 690
locv=nodplc(loc+1)
locp=nodplc(loc+5)
jtype=nodplc(loc+4)+1
go to (680,620,630,640,650,675), jtype
620 value(locp+3)=dmax1(value(locp+3),0.0d0)
if (value(locp+4).le.0.0d0) value(locp+4)=tstep
if (value(locp+5).le.0.0d0) value(locp+5)=tstep
if (value(locp+6).le.0.0d0) value(locp+6)=tstop
if (value(locp+7).le.0.0d0) value(locp+7)=tstop
temp=value(locp+4)+value(locp+5)+value(locp+6)
value(locp+7)=dmax1(value(locp+7),temp)
value(locv+1)=value(locp+1)
go to 680
630 if (value(locp+3).le.0.0d0) value(locp+3)=1.0d0/tstop
value(locp+4)=dmax1(value(locp+4),0.0d0)
value(locv+1)=value(locp+1)
go to 680
640 value(locp+3)=dmax1(value(locp+3),0.0d0)
if (value(locp+4).le.0.0d0) value(locp+4)=tstep
if (value(locp+5).le.value(locp+3))
1 value(locp+5)=value(locp+3)+tstep
if (value(locp+6).le.0.0d0) value(locp+6)=tstep
value(locv+1)=value(locp+1)
go to 680
650 value(locp+1)=dmin1(dmax1(value(locp+1),0.0d0),tstop)
iknt=1
call sizmem(nodplc(loc+5),nump)
660 temp=value(locp+iknt)
if (value(locp+iknt+2).eq.0.0d0) go to 670
if (value(locp+iknt+2).ge.tstop) go to 670
value(locp+iknt+2)=dmax1(value(locp+iknt+2),temp)
if(temp.ne.value(locp+iknt+2)) go to 665
write(6,661) value(locv)
661 format('0*error*: element ',a8,' piecewise linear source table no
1t increasing in time')
nogo=1
665 iknt=iknt+2
if (iknt.lt.nump) go to 660
670 value(locp+iknt+2)=tstop
value(locv+1)=value(locp+2)
call relmem(nodplc(loc+5),nump-iknt-3)
go to 680
675 if (value(locp+3).le.0.0d0) value(locp+3)=1.0d0/tstop
if (value(locp+5).le.0.0d0) value(locp+5)=1.0d0/tstop
value(locv+1)=value(locp+1)
680 loc=nodplc(loc)
go to 610
690 continue
c
c use default values for mos device geometries if not specified
c
700 loc=locate(14)
710 if(loc.eq.0) go to 720
locv=nodplc(loc+1)
if(value(locv+1).le.0.0d0) value(locv+1)=defl
if(value(locv+2).le.0.0d0) value(locv+2)=defw
if(value(locv+3).le.0.0d0) value(locv+3)=defad
if(value(locv+4).le.0.0d0) value(locv+4)=defas
loc=nodplc(loc)
go to 710
c
c print listing of elements, process device models,
c and check topology
c
720 if (iprntl.eq.0) go to 730
call elprnt
730 call topchk
call modchk
if (nogo.ne.0) go to 2000
c
c invert resistance values
c
800 loc=locate(1)
810 if (loc.eq.0) go to 900
locv=nodplc(loc+1)
value(locv+1)=1.0d0/value(locv+2)
loc=nodplc(loc)
go to 810
c
c process mutual inductors
c
900 loc=locate(4)
910 if (loc.eq.0) go to 940
locv=nodplc(loc+1)
nl1=nodplc(loc+2)
call sizmem(nodplc(nl1+10),nparam)
if (nparam.ne.1) go to 920
ispot1=nodplc(nl1+1)
jspot=nodplc(nl1+10)
value(ispot1+1)=value(jspot+1)
if (value(ispot1+1).lt.0.0d0) go to 920
nl2=nodplc(loc+3)
call sizmem(nodplc(nl2+10),nparam)
if (nparam.ne.1) go to 920
ispot2=nodplc(nl2+1)
jspot=nodplc(nl2+10)
value(ispot2+1)=value(jspot+1)
if (value(ispot2+1).lt.0.0d0) go to 920
value(locv+1)=value(locv+1)*dsqrt(value(ispot1+1)*value(ispot2+1))
go to 930
920 write (6,921) value(locv)
921 format('0*error*: inductors coupled by ',a8,' are negative or non
1linear'/)
nogo=1
930 loc=nodplc(loc)
go to 910
940 if (nogo.ne.0) go to 2000
c
c limit delmax to minimum delay over 2 if transmission lines in circuit
c
if (jtrflg.eq.0) go to 1200
tdmax=0.0d0
loc=locate(17)
1010 if (loc.eq.0) go to 1200
locv=nodplc(loc+1)
delmax=dmin1(delmax,value(locv+2)/2.0d0)
tdmax=dmax1(tdmax,value(locv+2))
loc=nodplc(loc)
go to 1010
c
c process source parameters
c
1200 numbkp=0
if (jtrflg.eq.0) go to 1205
tol=1.0d-2*delmax
numbkp=2
call getm8(lsbkpt,numbkp)
value(lsbkpt+1)=0.0d0
value(lsbkpt+2)=tstop
1205 do 1290 id=9,10
loc=locate(id)
1210 if (loc.eq.0) go to 1290
locv=nodplc(loc+1)
locp=nodplc(loc+5)
temp=value(locv+3)/rad
value(locv+3)=value(locv+2)*dsin(temp)
value(locv+2)=value(locv+2)*dcos(temp)
if (jtrflg.eq.0) go to 1280
jtype=nodplc(loc+4)+1
go to (1280,1220,1230,1235,1240,1260), jtype
1220 value(locp+4)=value(locp+4)+value(locp+3)
temp=value(locp+5)
value(locp+5)=value(locp+4)+value(locp+6)
value(locp+6)=value(locp+5)+temp
time=0.0d0
1225 call extmem(lsbkpt,4)
value(lsbkpt+numbkp+1)=value(locp+3)+time
value(lsbkpt+numbkp+2)=value(locp+4)+time
value(lsbkpt+numbkp+3)=value(locp+5)+time
value(lsbkpt+numbkp+4)=value(locp+6)+time
numbkp=numbkp+4
time=time+value(locp+7)
if (time.ge.tstop) go to 1280
go to 1225
1230 value(locp+3)=value(locp+3)*twopi
call extmem(lsbkpt,1)
1231 value(lsbkpt+numbkp+1)=value(locp+4)
numbkp=numbkp+1
go to 1280
1235 call extmem(lsbkpt,2)
value(lsbkpt+numbkp+1)=value(locp+3)
value(lsbkpt+numbkp+2)=value(locp+5)
numbkp=numbkp+2
go to 1280
1240 iknt=1
call sizmem(nodplc(loc+5),nump)
1250 call extmem(lsbkpt,1)
value(lsbkpt+numbkp+1)=value(locp+iknt)
numbkp=numbkp+1
iknt=iknt+2
if (iknt.le.nump) go to 1250
go to 1280
1260 value(locp+3)=value(locp+3)*twopi
value(locp+5)=value(locp+5)*twopi
1280 loc=nodplc(loc)
go to 1210
1290 continue
1300 if (jtrflg.eq.0) go to 1600
call extmem(lsbkpt,1)
value(lsbkpt+numbkp+1)=tstop
numbkp=numbkp+1
call shlsrt(value(lsbkpt+1),numbkp)
nbkpt=1
do 1310 i=2,numbkp
if ((value(lsbkpt+i)-value(lsbkpt+nbkpt)).lt.tol) go to 1310
nbkpt=nbkpt+1
value(lsbkpt+nbkpt)=value(lsbkpt+i)
if (value(lsbkpt+nbkpt).ge.tstop) go to 1320
1310 continue
1320 call relmem(lsbkpt,numbkp-nbkpt)
numbkp=nbkpt
value(lsbkpt+numbkp)=dmax1(value(lsbkpt+numbkp),tstop)
c
c print option summary
c
1600 if (iprnto.eq.0) go to 1700
call title(0,lwidth,1,titlop)
write (6,1601) gmin,reltol,abstol,vntol,lvlcod,itl1,itl2
1601 format('0dc analysis -',/,
1 '0 gmin = ',1pd10.3,/,
2 ' reltol = ', d10.3,/,
3 ' abstol = ', d10.3,/,
4 ' vntol = ', d10.3,/,
5 ' lvlcod = ', i6,/,
6 ' itl1 = ', i6,/,
7 ' itl2 = ', i6,/)
write (6,1611) aname(method),maxord,chgtol,trtol,lvltim,xmu,
1 itl3,itl4,itl5
1611 format('0transient analysis -',/,
1 '0 method = ',a8,/,
2 ' maxord = ', i6,/,
3 ' chgtol = ',1pd10.3,/,
4 ' trtol = ', d10.3,/,
5 ' lvltim = ', i6,/,
6 ' mu = ',0pf10.3,/,
7 ' itl3 = ', i6,/,
8 ' itl4 = ', i6,/,
9 ' itl5 = ', i6,/)
write (6,1621) limpts,limtim,maxtim,numdgt,value(itemps+1),
1 defl,defw,defad,defas
1621 format('0miscellaneous -',/,
1 '0 limpts = ', i6,/,
2 ' limtim = ', i6,/,
3 ' cptime = ', i6,/,
4 ' numdgt = ', i6,/,
5 ' tnom = ',0pf10.3,/,
6 ' defl = ',1pe10.3,/,
7 ' defw = ',e10.3,/,
8 ' defad = ',e10.3,/,
9 ' defas = ',e10.3)
c
c miscellaneous error checking
c
1700 if (icvflg.eq.0) go to 1720
if (icvflg.le.limpts) go to 1710
icvflg=0
write (6,1701) limpts,alsdc
1701 format('0warning: more than ',i5,' points for ',a4,' analysis,',/
11x,'analysis omitted. this limit may be overridden using the ',/
21x,'limpts parameter on the .option card'/)
go to 1720
1710 if ((jelcnt(31)+jelcnt(36)).gt.0) go to 1720
if(ipostp.ne.0) go to 1720
icvflg=0
write (6,1711) alsdc
1711 format('0warning: no ',a4,' outputs specified .',
1 '.. analysis omitted'/)
1720 if (jtrflg.eq.0) go to 1740
if (method.eq.1) maxord=2
if ((method.eq.2).and.(maxord.ge.3)) lvltim=2
if (jtrflg.le.limpts) go to 1730
jtrflg=0
write (6,1701) limpts,alstr
go to 1740
1730 if ((jelcnt(32)+jelcnt(37)+nfour).gt.0) go to 1735
if(ipostp.ne.0) go to 1735
jtrflg=0
write (6,1711) alstr
go to 1740
1735 if (nfour.eq.0) go to 1740
forprd=1.0d0/forfre
if ((tstop-forprd).ge.(tstart-1.0d-12)) go to 1740
nfour=0
call clrmem(ifour)
write (6,1736)
1736 format('0warning: fourier analysis fundamental frequency is incom
1patible with'/11x'transient analysis print interval ... fourier an
2alysis omitted'/)
1740 if (jacflg.eq.0) go to 1800
if (jacflg.le.limpts) go to 1750
jacflg=0
write (6,1701) limpts,alsac
go to 1800
1750 if ((jelcnt(33)+jelcnt(34)+jelcnt(35)+jelcnt(38)+jelcnt(39)
1 +jelcnt(40)+idist+inoise).gt.0) go to 1800
if(ipostp.ne.0) go to 1800
jacflg=0
write (6,1711) alsac
c
c sequence through the output lists
c
1800 do 1820 id=41,45
if (id.le.43) numout=1
loc=locate(id)
1810 if (loc.eq.0) go to 1820
numout=numout+1
nodplc(loc+4)=numout
loc=nodplc(loc)
go to 1810
1820 continue
c
c increase number of .prints if too many outputs for output line-width
c
ifwdth=max0(numdgt-1,0)+9
noprln=min0(8,(lwidth-12)/ifwdth)
do 1860 id=31,35
loc=locate(id)
1830 if(loc.eq.0) go to 1860
noprex=nodplc(loc+3)-noprln
if(noprex.le.0) go to 1850
nodplc(loc+3)=noprln
call find(dfloat(jelcnt(id)),id,locnew,1)
nodplc(locnew+2)=nodplc(loc+2)
nodplc(locnew+3)=noprex
call copy4(nodplc(loc+2*noprln+4),nodplc(locnew+4),2*noprex)
1850 loc=nodplc(loc)
go to 1830
1860 continue
c
c exit
c
2000 call second(t2)
rstats(1)=rstats(1)+t2-t1
return
end
subroutine shlsrt(a,n)
implicit double precision (a-h,o-z)
c
c this routine sorts the array a using a shell sort algorithm.
c
dimension a(n)
integer h
c
c
c... compute best starting step size
h=1
10 h=3*h+1
if (h.lt.n) go to 10
c... back off two times
h=(h-1)/3
h=(h-1)/3
h=max0(h,1)
c
c shell sort
c
20 j=h+1
go to 60
30 i=j-h
c... ak = record key; ar = record
ak=a(j)
ar=ak
40 if (ak.ge.a(i)) go to 50
a(i+h)=a(i)
i=i-h
if (i.ge.1) go to 40
50 a(i+h)=ar
j=j+1
60 if (j.le.n) go to 30
h=(h-1)/3
if (h.ne.0) go to 20
return
end
subroutine putnod(node)
implicit double precision (a-h,o-z)
c
c this routine adds 'node' to the list of user input nodes in table
c junode.
c
common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
common /blank/ value(1000)
integer nodplc(64)
complex*16 cvalue(32)
equivalence (value(1),nodplc(1),cvalue(1))
c
c
jknt=0
10 jknt=jknt+1
if (jknt.gt.nunods) go to 20
if (node-nodplc(junode+jknt)) 20,100,10
20 k=nunods+1
call extmem(junode,1)
if (k.le.jknt) go to 30
call copy4(nodplc(junode+jknt),nodplc(junode+jknt+1),k-jknt)
k=jknt
30 nodplc(junode+k)=node
nunods=nunods+1
c
c finished
c
100 return
end
subroutine getnod(node)
implicit double precision (a-h,o-z)
c
c this routine converts from the user node number to the internal
c (compact) node number.
c
common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
common /blank/ value(1000)
integer nodplc(64)
complex*16 cvalue(32)
equivalence (value(1),nodplc(1),cvalue(1))
c
c
if (nogo.ne.0) go to 100
jknt=0
10 jknt=jknt+1
if (jknt.gt.nunods) go to 20
if (nodplc(junode+jknt).ne.node) go to 10
node=jknt
go to 100
c
c unknown node -- must be implied by .print and/or .plot
c
20 if (node.eq.0) go to 30
write (6,21) node
21 format('0warning: attempt to reference undefined node ',i5,
1 ' -- node reset to 0'/)
30 node=1
c
c finished
c
100 return
end
subroutine subckt
implicit double precision (a-h,o-z)
c
c this routine drives the expansion of subcircuit calls.
c
common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
common /blank/ value(1000)
integer nodplc(64)
complex*16 cvalue(32)
equivalence (value(1),nodplc(1),cvalue(1))
c
c
c... avoid 'call by value' problems, make inodi, inodx arrays
c... in routines which receive them as parameters !!!
locx=locate(19)
10 if (locx.eq.0) go to 300
locs=nodplc(locx+3)
asnam=value(iunsat+locs)
call fndnam(asnam,locx-1,locx+3,20)
if (nogo.ne.0) go to 300
locs=nodplc(locx+3)
c
c check for recursion
c
isbptr=nodplc(locx-1)
20 if (isbptr.eq.0) go to 30
if (locs.eq.nodplc(isbptr+3)) go to 260
isbptr=nodplc(isbptr-1)
go to 20
c
c
30 call sizmem(nodplc(locx+2),nxnod)
call sizmem(nodplc(locs+2),nssnod)
if (nxnod.ne.nssnod) go to 250
call getm4(inodx,nssnod)
call getm4(inodi,nssnod)
itemp=nodplc(locs+2)
call copy4(nodplc(itemp+1),nodplc(inodx+1),nssnod)
itemp=nodplc(locx+2)
call copy4(nodplc(itemp+1),nodplc(inodi+1),nxnod)
c
c add elements of subcircuit to nominal circuit
c
loc=nodplc(locs+3)
100 if (loc.eq.0) go to 200
id=nodplc(loc-1)
if (id.eq.20) go to 110
call find(dfloat(jelcnt(id)),id,loce,1)
nodplc(loce-1)=locx
call addelt(loce,loc,id,inodx,inodi,nxnod)
110 loc=nodplc(loc)
go to 100
c
c
200 call clrmem(inodx)
call clrmem(inodi)
locx=nodplc(locx)
go to 10
c
c errors
c
250 locv=nodplc(locx+1)
axnam=value(locv)
locv=nodplc(locs+1)
asnam=value(locv)
write (6,251) axnam,asnam
251 format('0*error*: ',a8,' has different number of nodes than ',a8/
1)
nogo=1
go to 300
260 locsv=nodplc(locs+1)
asnam=value(locsv)
write (6,261) asnam
261 format('0*error*: subcircuit ',a8,' is defined recursively'/)
nogo=1
c
c finished
c
300 return
end
subroutine fndnam(anam,jsbptr,ispot,id)
implicit double precision (a-h,o-z)
c
c this routine searches for an element with id 'id' by tracing back
c up the subcircuit definition list. if the element is not found, the
c nominal element list is searched.
c
common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
common /blank/ value(1000)
integer nodplc(64)
complex*16 cvalue(32)
equivalence (value(1),nodplc(1),cvalue(1))
integer xxor
c
c
isbptr=nodplc(jsbptr)
10 if (isbptr.eq.0) go to 50
isub=nodplc(isbptr+3)
loc=nodplc(isub+3)
20 if (loc.eq.0) go to 40
if (id.ne.nodplc(loc-1)) go to 30
locv=nodplc(loc+1)
if (xxor(anam,value(locv)).ne.0) go to 30
if (id.ne.20) go to 50
go to 65
30 loc=nodplc(loc)
go to 20
40 isbptr=nodplc(isbptr-1)
go to 10
c
50 loc=locate(id)
60 if (loc.eq.0) go to 90
if (nodplc(loc-1).ne.isbptr) go to 70
locv=nodplc(loc+1)
if (xxor(anam,value(locv)).ne.0) go to 70
65 nodplc(ispot)=loc
go to 100
70 loc=nodplc(loc)
go to 60
90 write (6,91) anam
91 format('0*error*: unable to find ',a8/)
nogo=1
100 return
end
subroutine newnod(nodold,nodnew,inodx,inodi,nnodi)
implicit double precision (a-h,o-z)
c
c this routine makes a new node number for an element which is about
c to be added to the circuit as a result of a subcircuit call.
c
common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
common /blank/ value(1000)
integer nodplc(64)
complex*16 cvalue(32)
equivalence (value(1),nodplc(1),cvalue(1))
c
c... inodx, inodi are arrays (see subckt)
dimension inodx(1),inodi(1)
c
if (nodold.ne.0) go to 5
nodnew=1
go to 20
5 do 10 i=1,nnodi
jnodx=inodx(1)
if (nodold.ne.nodplc(jnodx+i)) go to 10
jnodi=inodi(1)
nodnew=nodplc(jnodi+i)
go to 20
10 continue
c
call extmem(inodx(1),1)
call extmem(inodi(1),1)
call extmem(junode,1)
nnodi=nnodi+1
ncnods=ncnods+1
jnodx=inodx(1)
nodplc(jnodx+nnodi)=nodold
jnodi=inodi(1)
nodplc(jnodi+nnodi)=ncnods
nodplc(junode+ncnods)=nodplc(junode+ncnods-1)+1
nodnew=ncnods
20 return
end
subroutine addelt(loce,loc,id,inodx,inodi,nnodi)
implicit double precision (a-h,o-z)
c
c this routine adds an element to the nominal circuit definition
c lists.
c
common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
common /blank/ value(1000)
integer nodplc(64)
complex*16 cvalue(32)
equivalence (value(1),nodplc(1),cvalue(1))
c
c... inodx(1), inodi(1) are arrays (see subckt)
dimension inodx(1),inodi(1)
c
dimension lnod(50),lval(50),nnods(50)
data lnod / 9,13,15, 7,14,15,14,15,12, 7,
1 17,37,26,34, 7, 7,34, 0, 5, 5,
2 4, 4, 4, 4, 0, 0, 0, 0, 0, 0,
3 21,21,21,21,21,21,21,21,21,21,
4 8, 8, 8, 8, 8, 0, 0, 0, 0, 0 /
data lval / 5, 4, 4, 2, 1, 1, 1, 1, 4, 4,
1 3, 4, 4,13, 1, 1, 9, 0, 1, 1,
2 19,55,17,41, 0, 0, 0, 0, 0, 0,
3 1, 1, 1, 1, 1,17,17,17,17,17,
4 1, 1, 1, 1, 1, 0, 0, 0, 0, 0 /
data nnods / 2, 2, 2, 0, 2, 2, 2, 2, 2, 2,
1 2, 4, 3, 4, 4, 4, 4, 0, 1, 0,
2 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4 2, 2, 2, 0, 0, 0, 0, 0, 0, 0 /
c
c copy integer part
c
nword=lnod(id)-3
if (nword.le.0) go to 10
call copy4(nodplc(loc+2),nodplc(loce+2),nword)
c
c set nodes
c
10 if (id.ge.21) go to 100
if (nnods(id).eq.0) go to 100
if (id.le.4) go to 20
if (id.le.8) go to 40
if (id.eq.19) go to 70
20 jstop=nnods(id)
do 30 j=1,jstop
call newnod(nodplc(loc+j+1),nodplc(loce+j+1),inodx(1),
1 inodi(1),nnodi)
30 continue
go to 100
40 call newnod(nodplc(loc+2),nodplc(loce+2),inodx(1),inodi(1),nnodi)
call newnod(nodplc(loc+3),nodplc(loce+3),inodx(1),inodi(1),nnodi)
if (id.ge.7) go to 100
nlocp=loc+id+1
nssnod=2*nodplc(loc+4)
call getm4(nodplc(loce+id+1),nssnod)
nlocpe=loce+id+1
50 do 60 j=1,nssnod
locp=nodplc(nlocp)
nodold=nodplc(locp+j)
call newnod(nodold,nodnew,inodx(1),inodi(1),nnodi)
locpe=nodplc(nlocpe)
nodplc(locpe+j)=nodnew
60 continue
go to 100
70 nlocp=loc+2
call sizmem(nodplc(loc+2),nssnod)
call getm4(nodplc(loce+2),nssnod)
nlocpe=loce+2
go to 50
c
c copy real part
c
100 if (nogo.ne.0) go to 300
locv=nodplc(loc+1)
locve=nodplc(loce+1)
call copy8(value(locv),value(locve),lval(id))
c
c treat non-node tables specially
c
200 if (id.ge.11) go to 300
go to (300,210,220,300,230,240,230,240,260,260), id
210 call cpytb8(loc+7,loce+7)
go to 300
220 call cpytb8(loc+10,loce+10)
go to 300
230 itab=5
go to 250
240 itab=6
250 if (id.le.6) go to 255
call cpytb4(loc+itab+1,loce+itab+1)
255 call cpytb4(loc+itab+2,loce+itab+2)
call cpytb8(loc+itab+3,loce+itab+3)
call cpytb8(loc+itab+4,loce+itab+4)
call cpytb4(loc+itab+5,loce+itab+5)
call cpytb8(loc+itab+6,loce+itab+6)
go to 300
260 call cpytb8(loc+5,loce+5)
c
c
300 return
end
subroutine cpytb4(itabo,itabn)
implicit double precision (a-h,o-z)
c
c this routine copies a table. its use is made necessary by the
c fact that only one pointer is allowed per table.
c
common /blank/ value(1000)
integer nodplc(64)
complex*16 cvalue(32)
equivalence (value(1),nodplc(1),cvalue(1))
c
c
call sizmem(nodplc(itabo),isize)
call getm4(nodplc(itabn),isize)
loco=nodplc(itabo)
locn=nodplc(itabn)
call copy4(nodplc(loco+1),nodplc(locn+1),isize)
return
end
subroutine cpytb8(itabo,itabn)
implicit double precision (a-h,o-z)
c
c this routine copies a table. its use is made necessary by the
c fact that only one pointer is allowed per table.
c
common /blank/ value(1000)
integer nodplc(64)
complex*16 cvalue(32)
equivalence (value(1),nodplc(1),cvalue(1))
c
c
call sizmem(nodplc(itabo),isize)
call getm8(nodplc(itabn),isize)
loco=nodplc(itabo)
locn=nodplc(itabn)
call copy8(value(loco+1),value(locn+1),isize)
return
end
subroutine lnkref
implicit double precision (a-h,o-z)
c
c this routine resolves all unsatisfied name references.
c
common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
common /blank/ value(1000)
integer nodplc(64)
complex*16 cvalue(32)
equivalence (value(1),nodplc(1),cvalue(1))
c
c mutual inductors
c
loc=locate(4)
100 if (loc.eq.0) go to 200
iref=nodplc(loc+2)
call fndnam(value(iunsat+iref),loc-1,loc+2,3)
iref=nodplc(loc+3)
call fndnam(value(iunsat+iref),loc-1,loc+3,3)
loc=nodplc(loc)
go to 100
c
c current-controlled current source
c
200 loc=locate(7)
210 if (loc.eq.0) go to 300
nump=nodplc(loc+4)
locp=nodplc(loc+6)
do 220 i=1,nump
iref=nodplc(locp+i)
call fndnam(value(iunsat+iref),loc-1,locp+i,9)
220 continue
loc=nodplc(loc)
go to 210
c
c current-controlled voltage sources
c
300 loc=locate(8)
310 if (loc.eq.0) go to 400
nump=nodplc(loc+4)
locp=nodplc(loc+7)
do 320 i=1,nump
iref=nodplc(locp+i)
call fndnam(value(iunsat+iref),loc-1,locp+i,9)
320 continue
loc=nodplc(loc)
go to 310
c
c diodes
c
400 loc=locate(11)
410 if (loc.eq.0) go to 500
iref=nodplc(loc+5)
call fndnam(value(iunsat+iref),loc-1,loc+5,21)
loc=nodplc(loc)
go to 410
c
c bjts
c
500 loc=locate(12)
510 if (loc.eq.0) go to 600
iref=nodplc(loc+8)
call fndnam(value(iunsat+iref),loc-1,loc+8,22)
loc=nodplc(loc)
go to 510
c
c jfets
c
600 loc=locate(13)
610 if (loc.eq.0) go to 700
iref=nodplc(loc+7)
call fndnam(value(iunsat+iref),loc-1,loc+7,23)
loc=nodplc(loc)
go to 610
c
c mosfets
c
700 loc=locate(14)
710 if (loc.eq.0) go to 1000
iref=nodplc(loc+8)
call fndnam(value(iunsat+iref),loc-1,loc+8,24)
loc=nodplc(loc)
go to 710
c
c finished
c
1000 call clrmem(iunsat)
return
end
subroutine subnam(loce)
implicit double precision (a-h,o-z)
c
c this routine constructs the names of elements added as a result of
c subcircuit expansion. the full element names are of the form
c name.xn. --- xd.xc.xb.xa
c where 'name' is the nominal element name, and the 'x'*s denote the
c sequence of subcircuit calls (from top or circuit level down through
c nested subcircuit calls) which caused the particular element to be
c added. at present, spice restricts all element names to be 8 charac-
c ters or less. therefore, the name used consists of the leftmost 8
c characters of the full element name, with the rightmost character
c replaced by an asterisk ('*') if the full element name is longer than
c 8 characters.
c
common /blank/ value(1000)
integer nodplc(64)
complex*16 cvalue(32)
equivalence (value(1),nodplc(1),cvalue(1))
c
c
data ablank, aper, astk / 1h , 1h., 1h* /
c
c construct subcircuit element name
c
if (nodplc(loce-1).eq.0) go to 100
locve=nodplc(loce+1)
loc=loce
nchar=0
sname=ablank
achar=ablank
10 locv=nodplc(loc+1)
elname=value(locv)
do 20 ichar=1,8
call move(achar,1,elname,ichar,1)
if (achar.eq.ablank) go to 30
if (nchar.eq.8) go to 40
nchar=nchar+1
call move(sname,nchar,achar,1,1)
20 continue
30 loc=nodplc(loc-1)
if (loc.eq.0) go to 60
if (nchar.eq.8) go to 40
nchar=nchar+1
call move(sname,nchar,aper,1,1)
go to 10
c
c name is longer than 8 characters: flag with asterisk
c
40 call move(sname,8,astk,1,1)
60 value(locve)=sname
c
c finished
c
100 return
end
subroutine elprnt
implicit double precision (a-h,o-z)
c
c this routine prints a circuit element summary.
c
common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
1 defas,rstats(50),iwidth,lwidth,nopage
common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
common /tran/ tstep,tstop,tstart,delmax,tdmax,forfre,jtrflg
common /blank/ value(1000)
integer nodplc(64)
complex*16 cvalue(32)
equivalence (value(1),nodplc(1),cvalue(1))
c
c
dimension itab(25),astyp(6)
dimension eltitl(4)
data eltitl / 8hcircuit , 8helement , 8hsummary , 8h /
data astyp / 1h , 5hpulse, 3hsin, 3hexp, 3hpwl, 4hsffm /
data ablnk,aoff /1h ,3hoff/
c
c print listing of elements
c
call title(0,lwidth,1,eltitl)
c
c print resistors
c
if (jelcnt(1).eq.0) go to 50
ititle=0
21 format(//'0**** resistors'/'0 name nodes value
1 tc1 tc2'//)
loc=locate(1)
30 if (loc.eq.0) go to 50
if (ititle.eq.0) write (6,21)
ititle=1
locv=nodplc(loc+1)
node1=nodplc(loc+2)
node2=nodplc(loc+3)
write (6,31) value(locv),nodplc(junode+node1),
1 nodplc(junode+node2),value(locv+2),value(locv+3),value(locv+4)
31 format(6x,a8,2i5,1p3d11.2)
40 loc=nodplc(loc)
go to 30
c
c print capacitors and inductors
c
50 if ((jelcnt(2)+jelcnt(3)).eq.0) go to 80
ititle=0
51 format(//'0**** capacitors and inductors'/'0 name nodes
1 in cond value'//)
do 70 id=2,3
loc=locate(id)
60 if (loc.eq.0) go to 70
if (ititle.eq.0) write (6,51)
ititle=1
locv=nodplc(loc+1)
node1=nodplc(loc+2)
node2=nodplc(loc+3)
ltab=7
if (id.eq.3) ltab=10
call sizmem(nodplc(loc+ltab),nparam)
if (nparam.ge.2) go to 62
ispot=nodplc(loc+ltab)+1
write (6,31) value(locv),nodplc(junode+node1),
1 nodplc(junode+node2),value(locv+2),value(ispot)
go to 65
62 write (6,63) value(locv),nodplc(junode+node1),
1 nodplc(junode+node2),value(locv+2)
63 format(6x,a8,2i5,1pd11.2,' variable')
65 loc=nodplc(loc)
go to 60
70 continue
c
c print mutual inductors
c
80 if (jelcnt(4).eq.0) go to 100
ititle=0
81 format(//'0**** mutual inductors'/'0 name coupled induc
1tors value'//)
loc=locate(4)
90 if (loc.eq.0) go to 110
if (ititle.eq.0) write (6,81)
ititle=1
locv=nodplc(loc+1)
nl1=nodplc(loc+2)
nl1=nodplc(nl1+1)
nl2=nodplc(loc+3)
nl2=nodplc(nl2+1)
write (6,91) value(locv),value(nl1),value(nl2),value(locv+1)
91 format(6x,a8,4x,a8,2x,a8,1pd10.2)
95 loc=nodplc(loc)
go to 90
c
c print nonlinear voltage controlled sources
c
100 if (jelcnt(5).eq.0) go to 120
ititle=0
101 format(//'0**** voltage-controlled current sources'/'0 name
1 + - dimension function')
loc=locate(5)
110 if (loc.eq.0) go to 120
if (ititle.eq.0) write (6,101)
ititle=1
locv=nodplc(loc+1)
node1=nodplc(loc+2)
node2=nodplc(loc+3)
write (6,111) value(locv),nodplc(junode+node1),
1 nodplc(junode+node2),nodplc(loc+4)
111 format(6x,a8,2i5,i8,9x,'poly')
115 loc=nodplc(loc)
go to 110
c
c nonlinear voltage controlled voltage sources
c
120 if (jelcnt(6).eq.0) go to 140
ititle=0
121 format(//'0**** voltage-controlled voltage sources'/'0 name
1 + - dimension function')
loc=locate(6)
130 if (loc.eq.0) go to 140
if (ititle.eq.0) write (6,121)
ititle=1
locv=nodplc(loc+1)
node1=nodplc(loc+2)
node2=nodplc(loc+3)
write (6,111) value(locv),nodplc(junode+node1),
1 nodplc(junode+node2),nodplc(loc+4)
135 loc=nodplc(loc)
go to 130
c
c nonlinear current controlled current sources
c
140 if (jelcnt(7).eq.0) go to 160
ititle=0
141 format(//'0**** current-controlled current sources'/'0 name
1 + - dimension function')
loc=locate(7)
150 if (loc.eq.0) go to 160
if (ititle.eq.0) write (6,141)
ititle=1
locv=nodplc(loc+1)
node1=nodplc(loc+2)
node2=nodplc(loc+3)
write (6,111) value(locv),nodplc(junode+node1),
1 nodplc(junode+node2),nodplc(loc+4)
155 loc=nodplc(loc)
go to 150
c
c nonlinear current controlled voltage sources
c
160 if (jelcnt(8).eq.0) go to 170
ititle=0
161 format(//'0**** current-controlled voltage sources'/'0 name
1 + - dimension function')
loc=locate(8)
165 if (loc.eq.0) go to 170
if (ititle.eq.0) write (6,161)
ititle=1
locv=nodplc(loc+1)
node1=nodplc(loc+2)
node2=nodplc(loc+3)
write (6,111) value(locv),nodplc(junode+node1),
1 nodplc(junode+node2),nodplc(loc+4)
167 loc=nodplc(loc)
go to 165
c
c print independent sources
c
170 if ((jelcnt(9)+jelcnt(10)).eq.0) go to 250
ititle=0
171 format(//'0**** independent sources'/'0 name nodes dc
1 value ac value ac phase transient'//)
do 245 id=9,10
loc=locate(id)
180 if (loc.eq.0) go to 245
if (ititle.eq.0) write (6,171)
ititle=1
locv=nodplc(loc+1)
locp=nodplc(loc+5)
node1=nodplc(loc+2)
node2=nodplc(loc+3)
itype=nodplc(loc+4)+1
anam=astyp(itype)
write (6,181) value(locv),nodplc(junode+node1),
1 nodplc(junode+node2),value(locv+1),value(locv+2),
2 value(locv+3),anam
181 format(6x,a8,2i5,1p3d11.2,2x,a8)
if (jtrflg.eq.0) go to 240
jstart=locp+1
go to (240,190,200,210,220,230), itype
190 jstop=locp+7
write (6,191) (value(j),j=jstart,jstop)
191 format(1h0,42x,'initial value',1pd11.2,/,
1 43x,'pulsed value.', d11.2,/,
2 43x,'delay time...', d11.2,/,
3 43x,'risetime.....', d11.2,/,
4 43x,'falltime.....', d11.2,/,
5 43x,'width........', d11.2,/,
6 43x,'period.......', d11.2,/)
go to 240
200 jstop=locp+5
write (6,201) (value(j),j=jstart,jstop)
201 format(1h0,42x,'offset.......',1pd11.2,/,
1 43x,'amplitude....', d11.2,/,
2 43x,'frequency....', d11.2,/,
3 43x,'delay........', d11.2,/,
4 43x,'theta........', d11.2,/)
go to 240
210 jstop=locp+6
write (6,211) (value(j),j=jstart,jstop)
211 format(1h0,42x,'initial value',1pd11.2,/,
1 43x,'pulsed value.', d11.2,/,
2 43x,'rise delay...', d11.2,/,
3 43x,'rise tau.....', d11.2,/,
4 43x,'fall delay...', d11.2,/,
5 43x,'fall tau.....', d11.2,/)
go to 240
220 call sizmem(nodplc(loc+5),jstop)
jstop=locp+jstop
write (6,221) (value(j),j=jstart,jstop)
221 format(1h0,49x,'time value'//,(46x,1p2d11.2))
write (6,226)
226 format(1x)
go to 240
230 jstop=locp+5
write (6,231) (value(j),j=jstart,jstop)
231 format(1h0,42x,'offset.......',1pd11.2,/,
1 43x,'amplitude....', d11.2,/,
2 43x,'carrier freq.', d11.2,/,
3 43x,'modn index...', d11.2,/,
4 43x,'signal freq..', d11.2,/)
240 loc=nodplc(loc)
go to 180
245 continue
c
c print transmission lines
c
250 if (jelcnt(17).eq.0) go to 260
ititle=0
251 format(//'0**** transmission lines'/'0 name nodes
1 z0 td'//)
loc=locate(17)
253 if (loc.eq.0) go to 260
if (ititle.eq.0) write (6,251)
ititle=1
locv=nodplc(loc+1)
node1=nodplc(loc+2)
node2=nodplc(loc+3)
node3=nodplc(loc+4)
node4=nodplc(loc+5)
write (6,256) value(locv),nodplc(junode+node1),
1 nodplc(junode+node2),nodplc(junode+node3),
2 nodplc(junode+node4),value(locv+1),value(locv+2)
256 format(6x,a8,4i5,1p2d11.2)
258 loc=nodplc(loc)
go to 253
c
c print diodes
c
260 if (jelcnt(11).eq.0) go to 290
ititle=0
261 format(//'0**** diodes'/'0 name + - model are
1a'//)
loc=locate(11)
270 if (loc.eq.0) go to 290
if (ititle.eq.0) write (6,261)
ititle=1
locv=nodplc(loc+1)
node1=nodplc(loc+2)
node2=nodplc(loc+3)
locm=nodplc(loc+5)
locm=nodplc(locm+1)
aic=ablnk
if (nodplc(loc+6).eq.1) aic=aoff
write (6,271) value(locv),nodplc(junode+node1),
1 nodplc(junode+node2),value(locm),value(locv+1),aic
271 format(6x,a8,2i5,2x,a8,f8.3,2x,a8)
280 loc=nodplc(loc)
go to 270
c
c print transistors
c
290 if (jelcnt(12).eq.0) go to 320
ititle=0
291 format(//'0**** bipolar junction transistors'/'0 name c
1 b e s model area'//)
loc=locate(12)
300 if (loc.eq.0) go to 320
if (ititle.eq.0) write (6,291)
ititle=1
locv=nodplc(loc+1)
node1=nodplc(loc+2)
node2=nodplc(loc+3)
node3=nodplc(loc+4)
node4=nodplc(loc+5)
locm=nodplc(loc+8)
locm=nodplc(locm+1)
aic=ablnk
if (nodplc(loc+9).eq.1) aic=aoff
write (6,301) value(locv),nodplc(junode+node1),
1 nodplc(junode+node2),nodplc(junode+node3),nodplc(junode+node4),
2 value(locm),value(locv+1),aic
301 format(6x,a8,4i5,2x,a8,f8.3,2x,a8)
310 loc=nodplc(loc)
go to 300
c
c print jfets
c
320 if (jelcnt(13).eq.0) go to 350
ititle=0
321 format(//'0**** jfets'/'0 name d g s model
1 area'//)
loc=locate(13)
330 if (loc.eq.0) go to 350
if (ititle.eq.0) write (6,321)
ititle=1
locv=nodplc(loc+1)
node1=nodplc(loc+2)
node2=nodplc(loc+3)
node3=nodplc(loc+4)
locm=nodplc(loc+7)
locm=nodplc(locm+1)
aic=ablnk
if (nodplc(loc+8).eq.1) aic=aoff
write (6,331) value(locv),nodplc(junode+node1),
1 nodplc(junode+node2),nodplc(junode+node3),
2 value(locm),value(locv+1),aic
331 format(6x,a8,3i5,2x,a8,f8.3,2x,a8)
340 loc=nodplc(loc)
go to 330
c
c print mosfets
c
350 if (jelcnt(14).eq.0) go to 400
ititle=0
351 format(//'0**** mosfets',/,'0name d g s b model l
1 w ad as rd rs',//)
loc=locate(14)
360 if (loc.eq.0) go to 400
if (ititle.eq.0) write (6,351)
ititle=1
locv=nodplc(loc+1)
node1=nodplc(loc+2)
node2=nodplc(loc+3)
node3=nodplc(loc+4)
node4=nodplc(loc+5)
locm=nodplc(loc+8)
locm=nodplc(locm+1)
rd=value(locv+11)
if(rd.eq.0.0d0) rd=value(locm+6)
rs=value(locv+12)
if(rs.eq.0.0d0) rs=value(locm+7)
aic=ablnk
if (nodplc(loc+9).eq.1) aic=aoff
write (6,361) value(locv),nodplc(junode+node1),
1 nodplc(junode+node2),nodplc(junode+node3),
2 nodplc(junode+node4),value(locm),value(locv+1),value(locv+2),
3 value(locv+3),value(locv+4),rd,rs
361 format(1x,a8,4i4,1x,a8,1pd7.1,5d8.1)
if(aic.ne.ablnk) write(6,362)
362 format(1x,'above device specified to be *off* to aid dc solution',
1 /)
370 loc=nodplc(loc)
go to 360
c
c subcircuit calls
c
400 if (jelcnt(19).eq.0) go to 500
ititle=0
401 format(//'0**** subcircuit calls'/'0 name subcircuit ext
1ernal nodes'//)
loc=locate(19)
410 if (loc.eq.0) go to 500
if (ititle.eq.0) write (6,401)
ititle=1
locv=nodplc(loc+1)
locn=nodplc(loc+2)
call sizmem(nodplc(loc+2),nnodx)
locs=nodplc(loc+3)
locsv=nodplc(locs+1)
jstart=1
ndprln=(lwidth-28)/5
412 jstop=min0(nnodx,jstart+ndprln-1)
do 414 j=jstart,jstop
node=nodplc(locn+j)
itab(j-jstart+1)=nodplc(junode+node)
414 continue
if (jstart.eq.1)
1 write (6,416) value(locv),value(locsv),(itab(j),j=1,jstop)
416 format(6x,a8,2x,a8,4x,20i5)
if (jstart.ne.1)
1 write (6,418) (itab(j-jstart+1),j=jstart,jstop)
418 format(28x,20i5)
jstart=jstop+1
if (jstart.le.nnodx) go to 412
if (nnodx.le.ndprln) go to 420
write (6,226)
420 loc=nodplc(loc)
go to 410
c
c finished
c
500 return
end
subroutine modchk
implicit double precision (a-h,o-z)
c
c this routine performs one-time processing of device model para-
c meters and prints out a device model summary. it also reserves the
c additional nodes required by nonzero device extrinsic resistances.
c
common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
1 defas,rstats(50),iwidth,lwidth,nopage
common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
1 xmu,mode,modedc,icalc,initf,method,iord,maxord,noncon,iterno,
2 itemno,nosolv,ipostp,iscrch
common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok,
1 gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox
common /blank/ value(1000)
integer nodplc(64)
complex*16 cvalue(32)
equivalence (value(1),nodplc(1),cvalue(1))
c
c
dimension itab(50),atable(10)
dimension ifun(4)
dimension antype(4),aptype(4)
dimension ipar(6),ampar(120),defval(120),ifmt(120)
dimension titled(4),titleb(4),titlej(4),titlem(4)
data titled / 8hdiode mo, 8hdel para, 8hmeters , 8h /
data titleb / 8hbjt mode, 8hl parame, 8hters , 8h /
data titlej / 8hjfet mod, 8hel param, 8heters , 8h /
data titlem / 8hmosfet m, 8hodel par, 8hameters , 8h /
data ifun / 0, 0, 1, 1 /
data antype /1h ,3hnpn,3hnjf,4hnmos/
data aptype /1h ,3hpnp,3hpjf,4hpmos/
data agaas /5hga-as/
data ipar / 0, 14, 60, 72, 106, 119 /
data hndrd,hndrd2 /1.0d+02,1.0d+04/
data ampar /
1 6his ,6hrs ,6hn ,6htt ,6hcjo ,6hpb ,6hm ,
2 6heg ,6hpt ,6hkf ,6haf ,6hfc ,6hbv ,6hibv ,
1 6hjs ,6hbf ,6hnf ,6hvbf ,6hjbf ,6hjle ,6hnle ,
2 6hbr ,6hnr ,6hvbr ,6hjbr ,6hjlc ,6hnlc ,6h0 ,
3 6h0 ,6hrb ,6hjrb ,6hrbm ,6hre ,6hrc ,6hcje ,
4 6hvje ,6hmje ,6htf ,6hxtf ,6hvtf ,6hjtf ,6hptf ,
5 6hcjc ,6hvjc ,6hmjc ,6hcdis ,6htr ,6h0 ,6h0 ,
6 6h0 ,6h0 ,6hcjs ,6hvjs ,6hmjs ,6htb ,6heg ,
7 6hpt ,6hkf ,6haf ,6hfc ,
1 6hvto ,6hbeta ,6hlambda,6hrd ,6hrs ,6hcgs ,6hcgd ,
2 6hpb ,6his ,6hkf ,6haf ,6hfc ,
1 6hvto ,6hkp ,6hgamma ,6hphi ,6hlambda,6hrd ,6hrs ,
2 6hcgs ,6hcgd ,6hcgb ,6hcbd ,6hcbs ,6htox ,6hpb ,
3 6hjs ,6hnsub ,6hnss ,6hnfs ,6hxj ,6hld ,6hngate ,
4 6htps ,6huo ,6hucrit ,6huexp ,6hutra ,6hkf ,6haf ,
5 6hfc ,6hwd ,6hecrit ,6hetra ,6hvnorm ,6hdesat ,
1 6hvp ,6hvbr ,6hvbi ,6hvfwd ,6hnd ,6hkdso ,6hkdv ,
2 6hcdso ,6hczg ,6hgnoise,6hnexp ,6hkf ,6haf ,0.0d0 /
data defval /
1 1.0d-14, 0.0d0, 1.0d0, 2*0.0d0, 1.0d0, 0.5d0, 1.11d0,
2 3.0d0, 0.0d0, 1.0d0, 0.5d0, 0.0d0, 1.0d-3,
1 1.0d-16, 100.0d0, 1.0d0, 3*0.0d0, 1.5d0, 2*1.0d0, 3*0.0d0,
2 2.0d0, 0.0d0, 1.0d0, 0.0d0, 0.0d0, 4*0.0d0, 0.75d0,
3 0.33d0, 2*0.0d0, 2*0.0d0, 2*0.0d0, 0.75d0, 0.33d0, 1.0d0,
4 2*0.0d0, 2*0.0d0, 2*0.0d0, 0.75d0, 0.0d0, 0.0d0, 1.11d0,
5 3.0d0, 0.0d0, 1.0d0, 0.5d0,
1 -2.0d0, 1.0d-4, 5*0.0d0, 1.0d0,1.0d-14, 0.0d0, 1.0d0,
2 0.5d0,
1 3*0.0d0, 0.0d0, 8*0.0d0, 1.0d-7, 0.8d0, 1.0d-4,6*0.0d0,
2 1.0d0,700.0d0, 1.0d+4, 3*0.0d0, 1.0d0, 0.5d0, 0.0d0,
3 3*0.0d0,1.5d+9,
1 -2.1d0, 0.0d0, 0.8d0, 0.6d0, 1.0d17, 5.8d0 ,0.01d0,
2 2.0d-10, 0.0d0, 0.0d0, 1.0d0, 0.0d0, 1.0d0, 0.0d0 /
data ifmt /
1 2,1,1,2,2,1,1,1,1,2,1,1,2,2,
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,
a 1,1,2,0,0,0,0,2,1,1,2,1,1,2,2,2,
3 1,2,1,1,1,2,2,1,2,2,1,1,
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,
a 2,2,2,2,
5 1,1,1,1,2,2,2,2,2,2,1,2,1,0/
c
c
tnom=value(itemps+1)+ctok
xkt=boltz*tnom
vt=xkt/charge
egfet=1.16d0-(7.02d-04*tnom**2/(tnom+1108.0d0))
arg=-egfet/2.0d0/boltz/tnom+1.1151d0/boltz/2.0d0/(27.0d0+ctok)
xni=1.45d10*(tnom/(27.0d0+ctok))**1.5d0*dexp(charge*arg)
nummod=jelcnt(21)+jelcnt(22)+jelcnt(23)+jelcnt(24)
if (nummod.eq.0) go to 1000
c
c assign default values
c
kntlim=lwidth/11
do 390 id=1,4
if (jelcnt(id+20).eq.0) go to 390
iflag=ifun(id)
loc=locate(id+20)
10 if (loc.eq.0) go to 20
locv=nodplc(loc+1)
id1=id
c... special case of gaas
if(id.eq.4.and.nodplc(loc+2).eq.0) id1=5
locm=ipar(id1)
nopar=ipar(id1+1)-locm
do 18 i=1,nopar
itab(i)=ifmt(locm+i)
if (value(locv+i).eq.0.0d0) go to 16
if (iflag.eq.0) go to 14
if (i.eq.1) go to 18
if(i.eq.2.and.id1.eq.5) go to 18
14 if (value(locv+i).gt.0.0d0) go to 18
c.. let pt be negative for bjts (for now anyway!)
if(i.eq.43.and.id.eq.2) go to 18
c... nss, ld, wd, utra and tps for mosfet can be negative
if((i.eq.22.or.i.eq.17.or.i.eq.20.or.i.eq.30.or.i.eq.26)
1 .and.id.eq.4) go to 18
c... vbr for ga-as fets must be negative
16 value(locv+i)=defval(locm+i)
18 continue
loc=nodplc(loc)
go to 10
c
c limit model values
c
20 go to (30,40,50,60), id
c... diodes
30 loc=locate(21)
32 if (loc.eq.0) go to 100
locv=nodplc(loc+1)
value(locv+7)=dmin1(value(locv+7),0.9d0)
value(locv+8)=dmax1(value(locv+8),0.1d0)
value(locv+11)=dmax1(value(locv+11),0.1d0)
value(locv+12)=dmin1(value(locv+12),0.95d0)
loc=nodplc(loc)
go to 32
c... bipolar transistors
40 loc=locate(22)
42 if (loc.eq.0) go to 100
locv=nodplc(loc+1)
value(locv+23)=dmin1(value(locv+23),0.9d0)
if(value(locv+24).eq.0.0d0) value(locv+28)=0.0d0
value(locv+31)=dmin1(value(locv+31),0.9d0)
value(locv+32)=dmin1(value(locv+32),1.0d0)
value(locv+40)=dmin1(value(locv+40),0.9d0)
value(locv+42)=dmax1(value(locv+42),0.1d0)
value(locv+45)=dmax1(value(locv+45),0.1d0)
value(locv+46)=dmin1(value(locv+46),0.9999d0)
loc=nodplc(loc)
if(value(locv+18).eq.0.0d0) value(locv+18)=value(locv+16)
if(value(locv+16).ge.value(locv+18)) go to 42
write(6,44) value(locv)
44 format('0warning: minimum base resistance (rbm) is less than '
1 ,'total (rb) for model ',a8,/10x' rbm set equal to rb',/)
value(locv+18)=value(locv+16)
go to 42
c... jfets
50 loc=locate(23)
52 if (loc.eq.0) go to 100
locv=nodplc(loc+1)
value(locv+11)=dmax1(value(locv+11),0.1d0)
value(locv+12)=dmin1(value(locv+12),0.95d0)
loc=nodplc(loc)
go to 52
c... mosfets
60 loc=locate(24)
64 if (loc.eq.0) go to 100
locv=nodplc(loc+1)
if(nodplc(loc+2).eq.0) go to 70
c
c special preprocessing for mosfet models
c
type=nodplc(loc+2)
cox=epsox/value(locv+13)/hndrd
c... if kp not given, calculate it from cox and uo
if(value(locv+2).eq.0.0d0)
1 value(locv+2)=value(locv+23)*cox
value(locv+35)=0.0d0
c... nsub nonzero => calculate gamma, vto, phi unless specified
if (value(locv+16).le.0.0d0) go to 68
xnsub=value(locv+16)
if (xnsub.le.xni) go to 66
if (value(locv+4).le.0.0d0) value(locv+4)=2.0d0*vt*dlog(xnsub/xni)
if (value(locv+3).le.0.0d0)
1 value(locv+3)=dsqrt(2.0d0*epssil*charge*xnsub)/cox
fermis=type*0.5d0*value(locv+4)
wkfng=3.2d0
c... polysilicon gate ... calculate appropriate work function
if (value(locv+21).le.0.0d0) go to 65
fermig=type*value(locv+22)*vt*dlog(value(locv+21)/xni)
wkfng=3.25d0+0.5d0*egfet-fermig
65 wkfngs=wkfng-(3.25d0+0.5d0*egfet+fermis)
if(value(locv+1).eq.0.0d0)
1 value(locv+1)= wkfngs-value(locv+17)*charge/cox+
2 type*(value(locv+4)+value(locv+3)*dsqrt(value(locv+4)))
value(locv+35)=dsqrt((epssil+epssil)/(charge*xnsub))
go to 68
66 value(locv+16)=0.0d0
write (6,67) value(locv)
67 format('0*error*: nsub < ni in mosfet model ',a8,/)
nogo=1
c... set phi to default if still zero
68 if(value(locv+4).eq.0.0d0) value(locv+4)=0.6d0
value(locv+4)=dmax1(value(locv+4),0.1d0)
value(locv+28)=dmax1(value(locv+28),0.1d0)
value(locv+29)=dmin1(value(locv+29),0.95d0)
loc=nodplc(loc)
go to 64
c... ga-as fets
70 value(locv+1)=-dabs(value(locv+1))
if(value(locv+2).ne.0.0d0) value(locv+2)=-dabs(value(locv+2))
value(locv+2)=dmax1(value(locv+2),-200.0d0)
if(value(locv+9).eq.0.0d0)
1 value(locv+9)=2.49d-12*dsqrt(value(locv+5)/value(locv+3))
loc=nodplc(loc)
go to 64
c
c print model parameters
c
100 if (iprntm.eq.0) go to 390
locs=locate(id+20)
110 kntr=0
loc=locs
go to (120,130,140,150),id
120 call title(0,lwidth,1,titled)
go to 200
130 call title(0,lwidth,1,titleb)
go to 200
140 call title(0,lwidth,1,titlej)
go to 200
150 call title(0,lwidth,1,titlem)
200 if (loc.eq.0) go to 210
if (kntr.lt.kntlim) go to 220
210 locn=loc
go to 240
220 kntr=kntr+1
locv=nodplc(loc+1)
atable(kntr)=value(locv)
230 loc=nodplc(loc)
go to 200
240 write (6,241) (atable(k),k=1,kntr)
241 format(//11x,12(2x,a8))
if (id.eq.1) go to 300
kntr=0
loc=locs
250 if (loc.eq.0) go to 260
if (kntr.ge.kntlim) go to 260
kntr=kntr+1
atable(kntr)=antype(id)
if (nodplc(loc+2).eq.-1) atable(kntr)=aptype(id)
c... special type for ga-as (do not mix ga-as and mos!)
if(id.eq.4.and.nodplc(loc+2).eq.0) atable(kntr)=agaas
loc=nodplc(loc)
go to 250
260 write (6,261) (atable(k),k=1,kntr)
261 format('0type',4x,12(4x,a6))
300 do 340 i=1,nopar
if (itab(i).eq.0) go to 340
kntr=0
loc=locs
310 if (loc.eq.0) go to 320
if (kntr.ge.kntlim) go to 320
locv=nodplc(loc+1)
kntr=kntr+1
atable(kntr)=value(locv+i)
loc=nodplc(loc)
go to 310
320 if (itab(i).eq.2) go to 330
write (6,321) ampar(locm+i),(atable(k),k=1,kntr)
321 format(1h ,a8,12f10.3)
go to 340
330 write (6,331) ampar(locm+i),(atable(k),k=1,kntr)
331 format(1h ,a8,1p12d10.2)
340 continue
if (locn.eq.0) go to 390
locs=locn
go to 110
390 continue
c
c process model parameters
c
c diodes
c
400 loc=locate(21)
410 if (loc.eq.0) go to 420
locv=nodplc(loc+1)
if (value(locv+2).ne.0.0d0) value(locv+2)=1.0d0/value(locv+2)
pb=value(locv+6)
xm=value(locv+7)
fc=value(locv+12)
value(locv+12)=fc*pb
xfc=dlog(1.0d0-fc)
value(locv+15)=pb*(1.0d0-dexp((1.0d0-xm)*xfc))/(1.0d0-xm)
value(locv+16)=dexp((1.0d0+xm)*xfc)
value(locv+17)=1.0d0-fc*(1.0d0+xm)
csat=value(locv+1)
vte=value(locv+3)*vt
value(locv+18)=vte*dlog(vte/(root2*csat))
bv=value(locv+13)
if(bv.eq.0.0d0) go to 418
cbv=value(locv+14)
if(cbv.ge.csat*bv/vt) go to 412
cbv=csat*bv/vt
write(6,411) value(locv),cbv
411 format('0warning: in diode model ',a8,' ibv increased to ',
1 1pd10.3,/10x,'to resolve incompatibility with specified is',/)
xbv=bv
go to 416
412 tol=reltol*cbv
xbv=bv-vt*dlog(1.0d0+cbv/csat)
iter=0
413 xbv=bv-vt*dlog(cbv/csat+1.0d0-xbv/vt)
xcbv=csat*(dexp((bv-xbv)/vt)-1.0d0+xbv/vt)
if (dabs(xcbv-cbv).le.tol) go to 416
iter=iter+1
if (iter.lt.25) go to 413
write (6,415) xbv,xcbv
415 format('0warning: unable to match forward and reverse diode regio
1ns',/,11x,'bv = ',1pd10.3,' and ibv = ',d10.3,/)
416 value(locv+13)=xbv
418 loc=nodplc(loc)
go to 410
c
c bipolar transistor models
c
420 loc=locate(22)
430 if (loc.eq.0) go to 440
locv=nodplc(loc+1)
if(value(locv+4).ne.0.0d0) value(locv+4)=1.0d0/value(locv+4)
if(value(locv+5).ne.0.0d0) value(locv+5)=1.0d0/value(locv+5)
if(value(locv+10).ne.0.0d0) value(locv+10)=1.0d0/value(locv+10)
if(value(locv+11).ne.0.0d0) value(locv+11)=1.0d0/value(locv+11)
if(value(locv+19).ne.0.0d0) value(locv+19)=1.0d0/value(locv+19)
if(value(locv+20).ne.0.0d0) value(locv+20)=1.0d0/value(locv+20)
if(value(locv+26).ne.0.0d0) value(locv+26)=1.0d0/value(locv+26)
1 /1.44d0
value(locv+28)=value(locv+28)/rad*value(locv+24)
if(value(locv+35).ne.0.0d0) value(locv+35)=1.0d0/value(locv+35)
1 /1.44d0
pe=value(locv+22)
xme=value(locv+23)
pc=value(locv+30)
xmc=value(locv+31)
fc=value(locv+46)
value(locv+46)=fc*pe
xfc=dlog(1.0d0-fc)
value(locv+47)=pe*(1.0d0-dexp((1.0d0-xme)*xfc))/(1.0d0-xme)
value(locv+48)=dexp((1.0d0+xme)*xfc)
value(locv+49)=1.0d0-fc*(1.0d0+xme)
value(locv+50)=fc*pc
value(locv+51)=pc*(1.0d0-dexp((1.0d0-xmc)*xfc))/(1.0d0-xmc)
value(locv+52)=dexp((1.0d0+xmc)*xfc)
value(locv+53)=1.0d0-fc*(1.0d0+xmc)
csat=value(locv+1)
value(locv+54)=vt*dlog(vt/(root2*csat))
loc=nodplc(loc)
go to 430
c
c jfet models
c
440 loc=locate(23)
450 if (loc.eq.0) go to 460
locv=nodplc(loc+1)
if (value(locv+4).ne.0.0d0) value(locv+4)=1.0d0/value(locv+4)
if (value(locv+5).ne.0.0d0) value(locv+5)=1.0d0/value(locv+5)
pb=value(locv+8)
xm=0.5d0
fc=value(locv+12)
value(locv+12)=fc*pb
xfc=dlog(1.0d0-fc)
value(locv+13)=pb*(1.0d0-dexp((1.0d0-xm)*xfc))/(1.0d0-xm)
value(locv+14)=dexp((1.0d0+xm)*xfc)
value(locv+15)=1.0d0-fc*(1.0d0+xm)
csat=value(locv+9)
value(locv+16)=vt*dlog(vt/(root2*csat))
loc=nodplc(loc)
go to 450
c
c mosfet models
c
460 loc=locate(24)
470 if (loc.eq.0) go to 600
locv=nodplc(loc+1)
if(nodplc(loc+2).eq.0) go to 490
type=nodplc(loc+2)
c... check validiy of lambda
if(value(locv+5).lt.5.0d-6) go to 472
write(6,471) value(locv)
471 format('0warning: value for lambda unrealisticly large for model'
1 ,1x,a8,/'0this parameter has been re-defined. see latest users '
2 ,'guide.')
472 value(locv+5)=value(locv+5)*hndrd
value(locv+8)=value(locv+8)/hndrd
value(locv+9)=value(locv+9)/hndrd
value(locv+10)=value(locv+10)/hndrd
value(locv+11)=value(locv+11)/hndrd2
value(locv+12)=value(locv+12)/hndrd2
value(locv+13)=value(locv+13)*hndrd
value(locv+15)=value(locv+15)/hndrd2
value(locv+19)=value(locv+19)*hndrd
value(locv+20)=value(locv+20)*hndrd
c.. move the params wd-gleff out to positions 36-40
value(locv+36)=value(locv+30)*hndrd
value(locv+37)=value(locv+31)
value(locv+38)=value(locv+32)
value(locv+39)=value(locv+33)
value(locv+40)=value(locv+34)
if(value(locv+39).ne.0.0d0) value(locv+39)=1.0d0/value(locv+39)
if (value(locv+6).ne.0.0d0) value(locv+6)=1.0d0/value(locv+6)
if (value(locv+7).ne.0.0d0) value(locv+7)=1.0d0/value(locv+7)
if (value(locv+13).ne.0.0d0) value(locv+13)=epsox/value(locv+13)
value(locv+34)=value(locv+1)-
1 type*value(locv+3)*dsqrt(value(locv+4))
if (value(locv+13).ne.0.0d0)
1 value(locv+24)=value(locv+24)*epssil/value(locv+13)
pb=value(locv+14)
c... enter here from ga-as processing also
475 xm=0.5d0
fc=value(locv+29)
value(locv+29)=fc*pb
xfc=dlog(1.0d0-fc)
value(locv+30)=pb*(1.0d0-dexp((1.0d0-xm)*xfc))/(1.0d0-xm)
value(locv+31)=dexp((1.0d0+xm)*xfc)
value(locv+32)=1.0d0-fc*(1.0d0+xm)
value(locv+33)=-1.0d0
480 loc=nodplc(loc)
go to 470
c... ga-as processing
490 value(locv+24)=2.5d+05*dexp(value(locv+2)/1.3d0)
value(locv+25)=5.0d+06*dexp(-value(locv+4)/vt)
value(locv+26)=3.9d-12*dsqrt(value(locv+5)*(value(locv+3)-
1 value(locv+1)))
value(locv+28)=value(locv+26)*(1.0d0-dsqrt((value(locv+3)-
1 0.99999d0*value(locv+1))/(value(locv+3)-value(locv+1))))
value(locv+29)=0.5d0
pb=value(locv+3)
go to 475
c
c reserve additional nodes
c convert mosfet geometries to cm
c
c diodes
c
600 loc=locate(11)
610 if (loc.eq.0) go to 700
locm=nodplc(loc+5)
locm=nodplc(locm+1)
if (value(locm+2).eq.0.0d0) go to 620
numnod=numnod+1
nodplc(loc+4)=numnod
go to 630
620 nodplc(loc+4)=nodplc(loc+2)
630 loc=nodplc(loc)
go to 610
c
c transistors
c
700 loc=locate(12)
710 if (loc.eq.0) go to 800
c
c put substrate node into nodplc(loc+30)
c
nodplc(loc+30)=nodplc(loc+5)
locm=nodplc(loc+8)
locm=nodplc(locm+1)
if(value(locm+16).eq.0.0d0) go to 720
numnod=numnod+1
nodplc(loc+6)=numnod
go to 730
720 nodplc(loc+6)=nodplc(loc+3)
730 if (value(locm+20).eq.0.0d0) go to 740
numnod=numnod+1
nodplc(loc+5)=numnod
go to 750
740 nodplc(loc+5)=nodplc(loc+2)
750 if (value(locm+19).eq.0.0d0) go to 760
numnod=numnod+1
nodplc(loc+7)=numnod
go to 770
760 nodplc(loc+7)=nodplc(loc+4)
770 loc=nodplc(loc)
go to 710
c
c jfets
c
800 loc=locate(13)
810 if (loc.eq.0) go to 900
locm=nodplc(loc+7)
locm=nodplc(locm+1)
if (value(locm+4).eq.0.0d0) go to 820
numnod=numnod+1
nodplc(loc+5)=numnod
go to 830
820 nodplc(loc+5)=nodplc(loc+2)
830 if (value(locm+5).eq.0.0d0) go to 840
numnod=numnod+1
nodplc(loc+6)=numnod
go to 850
840 nodplc(loc+6)=nodplc(loc+4)
850 loc=nodplc(loc)
go to 810
c
c mosfets
c
900 loc=locate(14)
910 if (loc.eq.0) go to 1000
locm=nodplc(loc+8)
locv=nodplc(loc+1)
if(nodplc(locm+2).eq.0) go to 960
locm=nodplc(locm+1)
value(locv+1)=value(locv+1)*hndrd
value(locv+2)=value(locv+2)*hndrd
value(locv+3)=value(locv+3)*hndrd2
value(locv+4)=value(locv+4)*hndrd2
c... check that effective channel length is greater than zero
if((value(locv+1)-2.0d0*value(locm+20)).gt.0.0d0)
1 go to 914
write(6,913) value(locv),value(locm)
913 format('0*error*: effective channel length of ',a8,' less than ',
1 'zero.',/' check value of ld for model ',a8)
nogo=1
914 if((value(locv+2)-2.0d0*value(locm+36)).gt.0.0d0) go to 916
write(6,915) value(locv),value(locm)
915 format('0*error*: effective channel width of ',a8,' less than ',
1 'zero.',/' check value of wd for model ',a8)
nogo=1
916 if (value(locv+11).eq.0.0d0) go to 917
value(locv+11)=1.0d0/value(locv+11)
go to 918
917 if(value(locm+6).eq.0.0d0) go to 920
value(locv+11)=value(locm+6)
918 numnod=numnod+1
nodplc(loc+6)=numnod
go to 930
920 nodplc(loc+6)=nodplc(loc+2)
930 if (value(locv+12).eq.0.0d0) go to 931
value(locv+12)=1.0d0/value(locv+12)
go to 932
931 if(value(locm+7).eq.0.0d0) go to 940
value(locv+12)=value(locm+7)
932 numnod=numnod+1
nodplc(loc+7)=numnod
go to 950
940 nodplc(loc+7)=nodplc(loc+4)
950 loc=nodplc(loc)
go to 910
c.. special case for ga-as devices
c.. compute rd and rs if not specified on device card
c.. rd and rs are always non-zero.
960 locm=nodplc(locm+1)
req=1.25d+14/(value(locm+5)*value(locv+2))
if (value(locv+11).eq.0.0d0) value(locv+11)=req
value(locv+11)=1.0d0/value(locv+11)
numnod=numnod+1
nodplc(loc+6)=numnod
if (value(locv+12).eq.0.0d0) value(locv+12)=req
value(locv+12)=1.0d0/value(locv+12)
numnod=numnod+1
nodplc(loc+7)=numnod
loc=nodplc(loc)
go to 910
c
c transmission lines
c
1000 loc=locate(17)
1010 if (loc.eq.0) go to 2000
numnod=numnod+1
nodplc(loc+6)=numnod
numnod=numnod+1
nodplc(loc+7)=numnod
loc=nodplc(loc)
go to 1010
c
c finished
c
2000 return
end
subroutine topchk
implicit double precision (a-h,o-z)
c
c this routine constructs the element node table. it also checks
c for voltage source/inductor loops, current source/capacitor cutsets,
c and that every node has a dc (conductive) path to ground.
c
common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
1 defas,rstats(50),iwidth,lwidth,nopage
common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
common /blank/ value(1000)
integer nodplc(64)
complex*16 cvalue(32)
equivalence (value(1),nodplc(1),cvalue(1))
c
c
dimension atable(12),aide(20),nnods(20)
dimension idlist(4)
dimension toptit(4)
data toptit / 8helement , 8hnode tab, 8hle , 8h /
data idlist / 3, 6, 8, 9 /
data aide / 1hr,0.0d0,1hl,2*0.0d0,1he,0.0d0,1hh,1hv,0.0d0,1hd,
1 1hq,1hj,1hm,0.0d0,0.0d0,1ht,0.0d0,0.0d0,0.0d0 /
data nnods / 2,2,2,0,2,2,2,2,2,2,2,4,3,4,4,4,4,0,1,0 /
data ablnk /1h /
c
c allocate storage
c
call getm4(iorder,ncnods)
call getm4(iur,ncnods+1)
c
c construct node table
c
kntlim=lwidth/11
1300 call getm4(itable,0)
call getm4(itabid,0)
istop=ncnods+1
do 1310 i=1,istop
1310 nodplc(iur+i)=1
do 1370 id=1,19
if (nnods(id).eq.0) go to 1370
loc=locate(id)
1320 if (loc.eq.0) go to 1370
nloc=loc+1
jstop=nnods(id)
if (id.ne.19) go to 1330
nloc=nodplc(loc+2)
call sizmem(nodplc(loc+2),jstop)
1330 do 1360 j=1,jstop
node=nodplc(nloc+j)
ispot=nodplc(iur+node+1)
k=nodplc(iur+ncnods+1)
call extmem(itable,1)
call extmem(itabid,1)
if (k.le.ispot) go to 1340
call copy4(nodplc(itable+ispot),nodplc(itable+ispot+1),k-ispot)
call copy4(nodplc(itabid+ispot),nodplc(itabid+ispot+1),k-ispot)
1340 nodplc(itable+ispot)=loc
nodplc(itabid+ispot)=id
c... treat the substrate node of a mosfet as if it were a transmission
c... line node, i.e. let it dangle if desired
if(id.eq.14.and.j.eq.4) nodplc(itabid+ispot)=17
k=node
kstop=ncnods+1
1350 k=k+1
if (k.gt.kstop) go to 1360
nodplc(iur+k)=nodplc(iur+k)+1
go to 1350
1360 continue
loc=nodplc(loc)
go to 1320
1370 continue
c
c check that every node has a dc path to ground
c
call zero4(nodplc(iorder+1),ncnods)
nodplc(iorder+1)=1
1420 iflag=0
do 1470 i=2,ncnods
if (nodplc(iorder+i).eq.1) go to 1470
jstart=nodplc(iur+i)
jstop=nodplc(iur+i+1)-1
if (jstart.gt.jstop) go to 1470
do 1450 j=jstart,jstop
loc=nodplc(itable+j)
id=nodplc(itabid+j)
if (aide(id).eq.0.0d0) go to 1450
if (id.eq.17) go to 1445
kstop=loc+nnods(id)-1
do 1440 k=loc,kstop
node=nodplc(k+2)
if (nodplc(iorder+node).eq.1) go to 1460
1440 continue
go to 1450
1445 if (nodplc(loc+2).eq.i) node=nodplc(loc+3)
if (nodplc(loc+3).eq.i) node=nodplc(loc+2)
if (nodplc(loc+4).eq.i) node=nodplc(loc+5)
if (nodplc(loc+5).eq.i) node=nodplc(loc+4)
if (nodplc(iorder+node).eq.1) go to 1460
1450 continue
go to 1470
1460 nodplc(iorder+i)=1
iflag=1
1470 continue
if (iflag.eq.1) go to 1420
c
c print node table and topology error messages
c
if (iprntn.eq.0) go to 1510
call title(0,lwidth,1,toptit)
1510 do 1590 i=1,ncnods
jstart=nodplc(iur+i)
jstop=nodplc(iur+i+1)-1
if (iprntn.eq.0) go to 1550
if (jstart.le.jstop) go to 1520
write (6,1511) nodplc(junode+i)
1511 format(1h0,i7)
go to 1550
1520 kntr=0
jflag=1
do 1540 j=jstart,jstop
loc=nodplc(itable+j)
locv=nodplc(loc+1)
kntr=kntr+1
atable(kntr)=value(locv)
if (kntr.lt.kntlim) go to 1540
if (jflag.eq.0) go to 1525
jflag=0
write (6,1521) nodplc(junode+i),(atable(k),k=1,kntr)
1521 format(1h0,i7,3x,12(1x,a8))
go to 1530
1525 write (6,1526) (atable(k),k=1,kntr)
1526 format(11x,12(1x,a8))
1530 kntr=0
1540 continue
if (kntr.eq.0) go to 1550
if (jflag.eq.0) go to 1545
write (6,1521) nodplc(junode+i),(atable(k),k=1,kntr)
go to 1550
1545 write (6,1526) (atable(k),k=1,kntr)
1550 if (jstart-jstop) 1560,1552,1556
c
c allow node with only one connection iff element is a t-line
c
1552 if (nodplc(itabid+jstart).eq.17) go to 1560
1556 nogo=1
write (6,1557) nodplc(junode+i)
1557 format('0*error*: less than 2 connections at node ',i6/)
go to 1590
1560 if (nodplc(iorder+i).eq.1) go to 1590
nogo=1
write (6,1561) nodplc(junode+i)
1561 format('0*error*: no dc path to ground from node ',i6/)
1590 continue
c
c check for inductor/voltage source loops
c
do 1700 i=1,ncnods
call zero4(nodplc(iorder+1),ncnods)
nodplc(iorder+i)=-1
do 1690 idcntr=1,4
id=idlist(idcntr)
loc=locate(id)
1610 if (loc.eq.0) go to 1690
node1=nodplc(loc+2)
node2=nodplc(loc+3)
if (nodplc(iorder+node1)) 1620,1640,1630
1620 nodplc(iorder+node1)=loc
1630 node=node2
go to 1670
1640 if (nodplc(iorder+node2)) 1650,1680,1660
1650 nodplc(iorder+node2)=loc
1660 node=node1
1670 if (nodplc(iorder+node).ne.0) go to 1710
nodplc(iorder+node)=loc
1680 loc=nodplc(loc)
go to 1610
1690 continue
1700 continue
go to 1900
c ... loop found
1710 locv=nodplc(loc+1)
write (6,1711) value(locv)
1711 format('0*error*: inductor/voltage source loop found, containing
1',a8/)
nogo=1
c
c
1900 call clrmem(iorder)
call clrmem(iur)
call clrmem(itable)
call clrmem(itabid)
2000 return
end