File:  [CSRG BSD Unix] / 3BSD / cmd / spice / setups.f
Revision 1.1.1.1 (vendor branch): download - view: text, annotated - select for diffs
Tue Apr 24 16:12:53 2018 UTC (8 years, 1 month ago) by root
Branches: MAIN, CSRG
CVS tags: HEAD, BSD3
BSD 3.0

      subroutine setup
      implicit double precision (a-h,o-z)
c
c
c     this routine drives the sparse matrix setup used 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 /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
     1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
      common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
     1  defas,rstats(50),iwidth,lwidth,nopage
      common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
     1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
      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 /blank/ value(1000)
      integer nodplc(64)
      complex*16 cvalue(32)
      equivalence (value(1),nodplc(1),cvalue(1))
c
c
      call second(t1)
      nstop=numnod+jelcnt(3)+jelcnt(6)+jelcnt(8)+jelcnt(9)+2*jelcnt(17)
c
c  reserve matrix locations for each element
c
      call matptr
      if (nogo.ne.0) go to 1000
c
c  reorder matrix pointers for minimal fill-in
c
      nttbr=0
      do 120 i=2,nstop
      loc=isr+i
  110 if (nodplc(loc).eq.0) go to 120
      loc=nodplc(loc)
      nttbr=nttbr+1
      go to 110
  120 continue
c...  add ground
      nttbr=nttbr+1
      call reordr
      if (nogo.ne.0) go to 1000
      nttar=nodplc(iur+nstop+1)-1+nodplc(ilc+nstop+1)-1+nstop
      ifill=nttar-nttbr
      perspa=100.0d0*(1.0d0-dfloat(nttar)/
     1  (dfloat(nstop)*dfloat(nstop)))
      iops=0
      do 130 i=2,nstop
      noffr=nodplc(iur+i+1)-nodplc(iur+i)
      noffc=nodplc(ilc+i+1)-nodplc(ilc+i)
      iops=iops+noffr+noffc*(noffr+2)+1
  130 continue
      rstats(20)=nstop
      rstats(21)=nttbr
      rstats(22)=nttar
      rstats(23)=ifill
      rstats(24)=0.0d0
      rstats(25)=nttar
      rstats(26)=iops
      rstats(27)=perspa
c
c  store matrix locations
c
      call matloc
      call clrmem(isr)
      call clrmem(iseq)
      call clrmem(iseq1)
      call clrmem(neqn)
      call clrmem(nodevs)
      call clrmem(ndiag)
      call clrmem(nmoffc)
      call clrmem(numoff)
      call clrmem(iequa)
      call clrmem(jmnode)
c
c  generate machine code
c
 1000 call second(t2)
      rstats(2)=rstats(2)+t2-t1
      return
      end
      subroutine matptr
      implicit double precision (a-h,o-z)
c
c     this routine (by calls to the routine reserve) establishes the
c nonzero-element structure of the circuit equation coefficient matrix.
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  allocate and initialize storage
c
      call getm4(isr,nstop+1)
      numvs=jelcnt(3)+jelcnt(6)+jelcnt(8)+jelcnt(9)+2*jelcnt(17)
      call getm4(iseq,numvs)
      call getm4(iseq1,numvs)
      call getm4(neqn,numvs)
      call getm4(nodevs,numnod)
      call getm4(ndiag,nstop)
      call getm4(nmoffc,nstop)
      call getm4(numoff,nstop)
      call crunch
c
      call zero4(nodplc(isr+1),nstop+1)
      call zero4(nodplc(iseq1+1),numvs)
      call zero4(nodplc(nodevs+1),numnod)
      call zero4(nodplc(ndiag+1),nstop)
      call zero4(nodplc(nmoffc+1),nstop)
      call zero4(nodplc(numoff+1),nstop)
c
      numvs=0
      nxtrm=0
      ndist=0
      ntlin=1
      ibr=numnod
c
c  resistors
c
      loc=locate(1)
  110 if (loc.eq.0) go to 120
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      call reserv(node1,node1)
      call reserv(node1,node2)
      call reserv(node2,node1)
      call reserv(node2,node2)
      loc=nodplc(loc)
      go to 110
c
c  capacitors
c
  120 loc=locate(2)
  130 if (loc.eq.0) go to 400
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      call reserv(node1,node2)
      call reserv(node2,node1)
      ntemp=nodplc(ndiag+node1)
      call reserv(node1,node1)
      nodplc(ndiag+node1)=ntemp
      ntemp=nodplc(ndiag+node2)
      call reserv(node2,node2)
      nodplc(ndiag+node2)=ntemp
      nodplc(loc+8)=nxtrm+1
      nxtrm=nxtrm+2
      loc=nodplc(loc)
      go to 130
c
c  inductors
c
  400 loc=locate(3)
  430 if (loc.eq.0) go to 440
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      ibr=ibr+1
      nodplc(loc+5)=ibr
      call reserv(node1,ibr)
      call reserv(node2,ibr)
      call reserv(ibr,node1)
      call reserv(ibr,node2)
      ntemp=nodplc(ndiag+ibr)
      call reserv(ibr,ibr)
      nodplc(ndiag+ibr)=ntemp
      numvs=numvs+1
      nodplc(iseq+numvs)=loc
      nodplc(neqn+numvs)=ibr
      nodplc(nodevs+node1)=nodplc(nodevs+node1)+1
      nodplc(nodevs+node2)=nodplc(nodevs+node2)+1
      nodplc(loc+11)=nxtrm+1
      nxtrm=nxtrm+2
      loc=nodplc(loc)
      go to 430
c
c  mutual inductors
c
  440 loc=locate(4)
  450 if (loc.eq.0) go to 460
      nl1=nodplc(loc+2)
      nl2=nodplc(loc+3)
      nl1=nodplc(nl1+5)
      nl2=nodplc(nl2+5)
      call reserv(nl1,nl2)
      call reserv(nl2,nl1)
      loc=nodplc(loc)
      go to 450
c
c  nonlinear voltage-controlled current sources
c
  460 loc=locate(5)
  462 if (loc.eq.0) go to 464
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      ndim=nodplc(loc+4)
      ndim2=ndim+ndim
      locn=nodplc(loc+6)
      do 463 i=1,ndim2
      node=nodplc(locn+i)
      call reserv(node1,node)
      call reserv(node2,node)
  463 continue
      nodplc(loc+12)=nxtrm+1
      nxtrm=nxtrm+1+ndim2
      loc=nodplc(loc)
      go to 462
c
c  nonlinear voltage controlled voltage sources
c
  464 loc=locate(6)
  466 if (loc.eq.0) go to 468
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      ibr=ibr+1
      nodplc(loc+6)=ibr
      call reserv(node1,ibr)
      call reserv(node2,ibr)
      call reserv(ibr,node1)
      call reserv(ibr,node2)
      numvs=numvs+1
      nodplc(iseq+numvs)=loc
      nodplc(neqn+numvs)=ibr
      nodplc(nodevs+node1)=nodplc(nodevs+node1)+1
      nodplc(nodevs+node2)=nodplc(nodevs+node2)+1
      ndim=nodplc(loc+4)
      ndim2=ndim+ndim
      locn=nodplc(loc+7)
      do 467 i=1,ndim2
      node=nodplc(locn+i)
      call reserv(ibr,node)
  467 continue
      nodplc(loc+13)=nxtrm+1
      nxtrm=nxtrm+2+ndim2
      loc=nodplc(loc)
      go to 466
c
c  voltage sources
c
  468 loc=locate(9)
  470 if (loc.eq.0) go to 472
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      ibr=ibr+1
      nodplc(loc+6)=ibr
      call reserv(node1,ibr)
      call reserv(node2,ibr)
      call reserv(ibr,node1)
      call reserv(ibr,node2)
      numvs=numvs+1
      nodplc(iseq+numvs)=loc
      nodplc(neqn+numvs)=ibr
      nodplc(nodevs+node1)=nodplc(nodevs+node1)+1
      nodplc(nodevs+node2)=nodplc(nodevs+node2)+1
      loc=nodplc(loc)
      go to 470
c
c  nonlinear current controlled current sources
c
  472 loc=locate(7)
  474 if (loc.eq.0) go to 476
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      ndim=nodplc(loc+4)
      locvs=nodplc(loc+6)
      do 475 i=1,ndim
      locvst=nodplc(locvs+i)
      kbr=nodplc(locvst+6)
      call reserv(node1,kbr)
      call reserv(node2,kbr)
  475 continue
      nodplc(loc+12)=nxtrm+1
      nxtrm=nxtrm+1+ndim+ndim
      loc=nodplc(loc)
      go to 474
c
c  nonlinear current controlled voltage sources
c
  476 loc=locate(8)
  478 if (loc.eq.0) go to 500
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      ibr=ibr+1
      nodplc(loc+6)=ibr
      call reserv(node1,ibr)
      call reserv(node2,ibr)
      call reserv(ibr,node1)
      call reserv(ibr,node2)
      numvs=numvs+1
      nodplc(iseq+numvs)=loc
      nodplc(neqn+numvs)=ibr
      nodplc(nodevs+node1)=nodplc(nodevs+node1)+1
      nodplc(nodevs+node2)=nodplc(nodevs+node2)+1
      ndim=nodplc(loc+4)
      locvs=nodplc(loc+7)
      do 479 i=1,ndim
      locvst=nodplc(locvs+i)
      kbr=nodplc(locvst+6)
      call reserv(ibr,kbr)
  479 continue
      nodplc(loc+13)=nxtrm+1
      nxtrm=nxtrm+2+ndim+ndim
      loc=nodplc(loc)
      go to 478
c
c  diodes
c
  500 loc=locate(11)
  510 if (loc.eq.0) go to 520
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      node3=nodplc(loc+4)
      call reserv(node1,node1)
      call reserv(node2,node2)
      call reserv(node3,node3)
      call reserv(node1,node3)
      call reserv(node2,node3)
      call reserv(node3,node1)
      call reserv(node3,node2)
      nodplc(loc+11)=nxtrm+1
      nxtrm=nxtrm+5
      nodplc(loc+12)=ndist+1
      ndist=ndist+7
      loc=nodplc(loc)
      go to 510
c
c  transistors
c
  520 loc=locate(12)
  530 if (loc.eq.0) go to 540
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      node3=nodplc(loc+4)
      node4=nodplc(loc+5)
      node5=nodplc(loc+6)
      node6=nodplc(loc+7)
      node7=nodplc(loc+30)
      call reserv(node1,node1)
      call reserv(node2,node2)
      call reserv(node3,node3)
      call reserv(node4,node4)
      call reserv(node5,node5)
      call reserv(node6,node6)
      call reserv(node1,node4)
      call reserv(node2,node5)
      call reserv(node3,node6)
      call reserv(node4,node5)
      call reserv(node4,node6)
      call reserv(node5,node6)
      call reserv(node4,node1)
      call reserv(node5,node2)
      call reserv(node6,node3)
      call reserv(node5,node4)
      call reserv(node6,node4)
      call reserv(node6,node5)
      call reserv(node7,node7)
      call reserv(node4,node7)
      call reserv(node7,node4)
      call reserv(node2,node4)
      call reserv(node4,node2)
      nodplc(loc+22)=nxtrm+1
      nxtrm=nxtrm+18
      nodplc(loc+23)=ndist+1
      ndist=ndist+21
      loc=nodplc(loc)
      go to 530
c
c  jfets
c
  540 loc=locate(13)
  550 if (loc.eq.0) go to 560
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      node3=nodplc(loc+4)
      node4=nodplc(loc+5)
      node5=nodplc(loc+6)
      call reserv(node1,node1)
      call reserv(node2,node2)
      call reserv(node3,node3)
      call reserv(node4,node4)
      call reserv(node5,node5)
      call reserv(node1,node4)
      call reserv(node2,node4)
      call reserv(node2,node5)
      call reserv(node3,node5)
      call reserv(node4,node5)
      call reserv(node4,node1)
      call reserv(node4,node2)
      call reserv(node5,node2)
      call reserv(node5,node3)
      call reserv(node5,node4)
      nodplc(loc+19)=nxtrm+1
      nxtrm=nxtrm+13
      loc=nodplc(loc)
      go to 550
c
c  mosfets
c
  560 loc=locate(14)
  570 if (loc.eq.0) go to 600
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      node3=nodplc(loc+4)
      node4=nodplc(loc+5)
      node5=nodplc(loc+6)
      node6=nodplc(loc+7)
      call reserv(node1,node1)
      call reserv(node2,node2)
      call reserv(node3,node3)
      call reserv(node4,node4)
      call reserv(node5,node5)
      call reserv(node6,node6)
      call reserv(node1,node5)
      call reserv(node2,node4)
      call reserv(node2,node5)
      call reserv(node2,node6)
      call reserv(node3,node6)
      call reserv(node4,node5)
      call reserv(node4,node6)
      call reserv(node5,node6)
      call reserv(node5,node1)
      call reserv(node4,node2)
      call reserv(node5,node2)
      call reserv(node6,node2)
      call reserv(node6,node3)
      call reserv(node5,node4)
      call reserv(node6,node4)
      call reserv(node6,node5)
      nodplc(loc+26)=nxtrm+1
      nxtrm=nxtrm+18
      loc=nodplc(loc)
      go to 570
c
c  transmission lines
c
  600 loc=locate(17)
  610 if (loc.eq.0) go to 1000
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      node3=nodplc(loc+4)
      node4=nodplc(loc+5)
      ni1=nodplc(loc+6)
      ni2=nodplc(loc+7)
      ibr1=ibr+1
      ibr2=ibr+2
      ibr=ibr+2
      nodplc(loc+8)=ibr1
      nodplc(loc+9)=ibr2
      call reserv(node1,node1)
      call reserv(node1,ni1)
      call reserv(node2,ibr1)
      call reserv(node3,node3)
      call reserv(node4,ibr2)
      call reserv(ni1,node1)
      call reserv(ni1,ni1)
      call reserv(ni1,ibr1)
      call reserv(ni2,ni2)
      call reserv(ni2,ibr2)
      call reserv(ibr1,node2)
      call reserv(ibr1,node3)
      call reserv(ibr1,node4)
      call reserv(ibr1,ni1)
      call reserv(ibr1,ibr2)
      call reserv(ibr2,node1)
      call reserv(ibr2,node2)
      call reserv(ibr2,node4)
      call reserv(ibr2,ni2)
      call reserv(ibr2,ibr1)
      call reserv(node3,ni2)
      call reserv(ni2,node3)
      numvs=numvs+1
      nodplc(iseq+numvs)=loc
      nodplc(iseq1+numvs)=1
      nodplc(neqn+numvs)=ibr1
      nodplc(nodevs+ni1)=nodplc(nodevs+ni1)+1
      nodplc(nodevs+node2)=nodplc(nodevs+node2)+1
      numvs=numvs+1
      nodplc(iseq+numvs)=loc
      nodplc(iseq1+numvs)=2
      nodplc(neqn+numvs)=ibr2
      nodplc(nodevs+ni2)=nodplc(nodevs+ni2)+1
      nodplc(nodevs+node4)=nodplc(nodevs+node4)+1
      nodplc(loc+30)=ntlin+1
      ntlin=ntlin+2
      loc=nodplc(loc)
      go to 610
c
c  finished
c
 1000 return
      end
      subroutine reserv (node1,node2)
      implicit double precision (a-h,o-z)
c
c     this routine records the fact that the (node1, node2) element of
c the circuit equation coefficient matrix is nonzero.
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 /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 300
c...  test for ground
      if (node1.eq.1) go to 300
      if (node2.eq.1) go to 300
c
c  test for (node1,node2) matrix element
c
      loc=isr+node1
  100 if (nodplc(loc).eq.0) go to 110
      loc=nodplc(loc)
      if (nodplc(loc+1).eq.node2) go to 300
      go to 100
c
c  reserve (node1,node2) matrix element
c
  110 nodplc(numoff+node1)=nodplc(numoff+node1)+1
      nodplc(nmoffc+node2)=nodplc(nmoffc+node2)+1
      call sizmem(numoff,isize)
      newloc=numoff+isize+1
      nodplc(loc)=newloc
      call extmem(numoff,2)
      nodplc(newloc)=0
      nodplc(newloc+1)=node2
c
c  mark diagonal
c
      if (node1.ne.node2) go to 300
      nodplc(ndiag+node1)=1
c
c  finished
c
  300 return
      end
      subroutine reordr
      implicit double precision (a-h,o-z)
c
c     this routine swaps rows in the coefficient matrix to eliminate
c singularity problems which can be recognized by examining the circuit
c topology.  it then reorders the unknowns to minimize fillin terms
c which occur during lu factorization. (to maximize sparsity).
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  allocate and initialize storage
c
      call getm4(iswap,nstop)
      call getm4(iequa,nstop)
      call getm4(iorder,nstop)
      call getm4(jmnode,nstop)
      call getm4(iur,nstop+1)
      call getm4(ilc,nstop+1)
      call getm4(iuc,0)
      call getm4(ilr,0)
c
      do 10 i=1,nstop
      nodplc(iswap+i)=i
   10 continue
      call copy4(nodplc(iswap+1),nodplc(iequa+1),nstop)
      call copy4(nodplc(iswap+1),nodplc(iorder+1),nstop)
      call copy4(nodplc(iswap+1),nodplc(jmnode+1),nstop)
c
c  swap current equations into admittance part of equation matrix
c
      nextv=1
c
c  find suitable voltage source
c
  100 if (nextv.gt.numvs) go to 150
      ix=0
      do 130 i=nextv,numvs
      loc=nodplc(iseq+i)
      node=nodplc(loc+2)
      nflag=nodplc(iseq1+i)
      if (nflag.eq.1) node=nodplc(loc+6)
      if (nflag.eq.2) node=nodplc(loc+7)
      if (node.eq.1) go to 110
      if (nodplc(nodevs+node).ge.2) go to 110
      if (nodplc(ndiag+node).eq.0) go to 140
      ix=i
      locx=loc
      nodex=node
  110 node=nodplc(loc+3)
      if (nflag.eq.2) node=nodplc(loc+5)
      if (node.eq.1) go to 130
      if (nodplc(nodevs+node).ge.2) go to 130
  120 if (nodplc(ndiag+node).eq.0) go to 140
      ix=i
      locx=loc
      nodex=node
  130 continue
      if (ix.eq.0) go to 590
      i=ix
      loc=locx
      node=nodex
c
c  resequence voltage sources
c
  140 nodplc(iseq+i)=nodplc(iseq+nextv)
      nodplc(iseq+nextv)=loc
      ltemp=nodplc(iseq1+i)
      nodplc(iseq1+i)=nodplc(iseq1+nextv)
      nodplc(iseq1+nextv)=ltemp
      ibr=nodplc(neqn+i)
      nodplc(neqn+i)=nodplc(neqn+nextv)
      nodplc(neqn+nextv)=ibr
      node1=nodplc(loc+2)
      if (ltemp.eq.1) node1=nodplc(loc+6)
      if (ltemp.eq.2) node1=nodplc(loc+7)
      node2=nodplc(loc+3)
      if (ltemp.eq.1) node2=nodplc(loc+3)
      if (ltemp.eq.2) node2=nodplc(loc+5)
      nodplc(nodevs+node1)=nodplc(nodevs+node1)-1
      nodplc(nodevs+node2)=nodplc(nodevs+node2)-1
c
c  set row swap indicators
c
      l=nodplc(iswap+ibr)
      j=nodplc(iequa+node)
      nodplc(iswap+j)=l
      nodplc(iequa+l)=j
      nodplc(iswap+ibr)=node
      nodplc(iequa+node)=ibr
      nextv=nextv+1
      go to 100
c
c  initialize matrix pointers
c
  150 nexnod=2
      nut=0
      nlt=0
  160 nodplc(iur+nexnod)=nut+1
      nodplc(ilc+nexnod)=nlt+1
      if (nexnod.ge.nstop) go to 500
c
c  select row for reordering
c
      load=nodplc(iorder+nexnod)
      ir=nodplc(iswap+load)
      imin=nodplc(numoff+ir)*nodplc(nmoffc+load)
      nstart=nexnod+1
      do 200 i=nstart,nstop
      lc=nodplc(iorder+i)
      ir=nodplc(iswap+lc)
      nrc=nodplc(numoff+ir)*nodplc(nmoffc+lc)
      if (nrc.ge.imin) go to 200
      imin=nrc
      load=lc
  200 continue
c
c  set reorder indicators
c
      ir=nodplc(iswap+load)
      nodplc(numoff+ir)=nodplc(numoff+ir)-1
      nodplc(nmoffc+load)=nodplc(nmoffc+load)-1
      lc=nodplc(iorder+nexnod)
      jr=nodplc(jmnode+load)
      nodplc(iorder+jr)=lc
      nodplc(jmnode+lc)=jr
      nodplc(iorder+nexnod)=load
      nodplc(jmnode+load)=nexnod
c
c  set pointers for upper triangle
c
      loc=isr+ir
  330 if (nodplc(loc).eq.0) go to 340
      loc=nodplc(loc)
      ic=nodplc(loc+1)
      jc=nodplc(jmnode+ic)
      if (jc.le.nexnod) go to 330
      nodplc(nmoffc+ic)=nodplc(nmoffc+ic)-1
      call extmem(iuc,1)
      nodplc(iuc+nut+1)=ic
      nut=nut+1
      go to 330
c
c  set pointers for lower triangle
c
  340 do 390 jr=nstart,nstop
      lc=nodplc(iorder+jr)
      ir=nodplc(iswap+lc)
      loc=isr+ir
  350 if (nodplc(loc).eq.0) go to 390
      loc=nodplc(loc)
      if (nodplc(loc+1).ne.load) go to 350
      nodplc(numoff+ir)=nodplc(numoff+ir)-1
      call extmem(ilr,1)
      nodplc(ilr+nlt+1)=lc
      nlt=nlt+1
c
c  check for fill-in terms
c
      nct=nodplc(iur+nexnod)
  360 if (nct.ge.(nut+1)) go to 390
      ic=nodplc(iuc+nct)
      call reserv(ir,ic)
      nct=nct+1
      go to 360
  390 continue
c
c
      nexnod=nexnod+1
      go to 160
c
c  reordering finished
c
  500 nodplc(iur+nstop+1)=nut+1
      nodplc(ilc+nstop+1)=nlt+1
      if (nut.eq.0) go to 515
      do 510 i=1,nut
      j=nodplc(iuc+i)
      nodplc(iuc+i)=nodplc(jmnode+j)
  510 continue
  515 if (nlt.eq.0) go to 600
      do 520 i=1,nlt
      j=nodplc(ilr+i)
      nodplc(ilr+i)=nodplc(jmnode+j)
  520 continue
      go to 600
c
c  error - voltage-source/inductor/transmission-line loop detected ...
c
  590 nogo=1
      write (6,591)
c...  loop should have been detected in topchk
  591 format('0*abort*:  spice internal error in reordr'/)
c
c  finished
c
  600 return
      end
      subroutine matloc
      implicit double precision (a-h,o-z)
c
c     this routine stores the locations of the various matrix terms to
c which the different circuit elements contribute.
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  resistors
c
      loc=locate(1)
  690 if (loc.eq.0) go to 700
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      nodplc(loc+4)=indxx(node1,node2)
      nodplc(loc+5)=indxx(node2,node1)
      nodplc(loc+6)=indxx(node1,node1)
      nodplc(loc+7)=indxx(node2,node2)
      loc=nodplc(loc)
      go to 690
c
c  capacitors
c
  700 loc=locate(2)
  710 if (loc.eq.0) go to 720
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      nodplc(loc+5)=indxx(node1,node2)
      nodplc(loc+6)=indxx(node2,node1)
      nodplc(loc+10)=indxx(node1,node1)
      nodplc(loc+11)=indxx(node2,node2)
      loc=nodplc(loc)
      go to 710
c
c  inductors
c
  720 loc=locate(3)
  730 if (loc.eq.0) go to 740
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      ibr=nodplc(loc+5)
      nodplc(loc+6)=indxx(node1,ibr)
      nodplc(loc+7)=indxx(node2,ibr)
      nodplc(loc+8)=indxx(ibr,node1)
      nodplc(loc+9)=indxx(ibr,node2)
      nodplc(loc+13)=indxx(ibr,ibr)
      loc=nodplc(loc)
      go to 730
c
c  mutual inductances
c
  740 loc=locate(4)
  750 if (loc.eq.0) go to 760
      nl1=nodplc(loc+2)
      nl2=nodplc(loc+3)
      ibr1=nodplc(nl1+5)
      ibr2=nodplc(nl2+5)
      nodplc(loc+4)=indxx(ibr1,ibr2)
      nodplc(loc+5)=indxx(ibr2,ibr1)
      loc=nodplc(loc)
      go to 750
c
c  nonlinear voltage controlled current sources
c
  760 loc=locate(5)
  762 if (loc.eq.0) go to 764
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      ndim=nodplc(loc+4)
      lnod=nodplc(loc+6)
      lmat=nodplc(loc+7)
      do 763 i=1,ndim
      node3=nodplc(lnod+1)
      node4=nodplc(lnod+2)
      lnod=lnod+2
      nodplc(lmat+1)=indxx(node1,node3)
      nodplc(lmat+2)=indxx(node1,node4)
      nodplc(lmat+3)=indxx(node2,node3)
      nodplc(lmat+4)=indxx(node2,node4)
      lmat=lmat+4
  763 continue
      loc=nodplc(loc)
      go to 762
c
c  nonlinear voltage controlled voltage sources
c
  764 loc=locate(6)
  766 if (loc.eq.0) go to 768
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      ndim=nodplc(loc+4)
      ibr=nodplc(loc+6)
      lnod=nodplc(loc+7)
      lmat=nodplc(loc+8)
      nodplc(lmat+1)=indxx(node1,ibr)
      nodplc(lmat+2)=indxx(node2,ibr)
      nodplc(lmat+3)=indxx(ibr,node1)
      nodplc(lmat+4)=indxx(ibr,node2)
      lmat=lmat+4
      do 767 i=1,ndim
      node3=nodplc(lnod+1)
      node4=nodplc(lnod+2)
      lnod=lnod+2
      nodplc(lmat+1)=indxx(ibr,node3)
      nodplc(lmat+2)=indxx(ibr,node4)
      lmat=lmat+2
  767 continue
      loc=nodplc(loc)
      go to 766
c
c  nonlinear current controlled current sources
c
  768 loc=locate(7)
  770 if (loc.eq.0) go to 772
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      ndim=nodplc(loc+4)
      locvs=nodplc(loc+6)
      lmat=nodplc(loc+7)
      do 771 i=1,ndim
      locvst=nodplc(locvs+i)
      ibr=nodplc(locvst+6)
      nodplc(lmat+1)=indxx(node1,ibr)
      nodplc(lmat+2)=indxx(node2,ibr)
      lmat=lmat+2
  771 continue
      loc=nodplc(loc)
      go to 770
c
c  nonlinear current controlled voltage sources
c
  772 loc=locate(8)
  774 if (loc.eq.0) go to 780
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      ndim=nodplc(loc+4)
      ibr=nodplc(loc+6)
      locvs=nodplc(loc+7)
      lmat=nodplc(loc+8)
      nodplc(lmat+1)=indxx(node1,ibr)
      nodplc(lmat+2)=indxx(node2,ibr)
      nodplc(lmat+3)=indxx(ibr,node1)
      nodplc(lmat+4)=indxx(ibr,node2)
      lmat=lmat+4
      do 775 i=1,ndim
      locvst=nodplc(locvs+i)
      kbr=nodplc(locvst+6)
      nodplc(lmat+i)=indxx(ibr,kbr)
  775 continue
      loc=nodplc(loc)
      go to 774
c
c  voltage sources
c
  780 loc=locate(9)
  790 if (loc.eq.0) go to 800
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      iptr=nodplc(loc+6)
      nodplc(loc+7)=indxx(node1,iptr)
      nodplc(loc+8)=indxx(node2,iptr)
      nodplc(loc+9)=indxx(iptr,node1)
      nodplc(loc+10)=indxx(iptr,node2)
      loc=nodplc(loc)
      go to 790
c
c  diodes
c
  800 loc=locate(11)
  810 if (loc.eq.0) go to 820
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      node3=nodplc(loc+4)
      nodplc(loc+7)=indxx(node1,node3)
      nodplc(loc+8)=indxx(node2,node3)
      nodplc(loc+9)=indxx(node3,node1)
      nodplc(loc+10)=indxx(node3,node2)
      nodplc(loc+13)=indxx(node1,node1)
      nodplc(loc+14)=indxx(node2,node2)
      nodplc(loc+15)=indxx(node3,node3)
      loc=nodplc(loc)
      go to 810
c
c  transistors
c
  820 loc=locate(12)
  830 if (loc.eq.0) go to 840
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      node3=nodplc(loc+4)
      node4=nodplc(loc+5)
      node5=nodplc(loc+6)
      node6=nodplc(loc+7)
      node7=nodplc(loc+30)
      nodplc(loc+10)=indxx(node1,node4)
      nodplc(loc+11)=indxx(node2,node5)
      nodplc(loc+12)=indxx(node3,node6)
      nodplc(loc+13)=indxx(node4,node1)
      nodplc(loc+14)=indxx(node4,node5)
      nodplc(loc+15)=indxx(node4,node6)
      nodplc(loc+16)=indxx(node5,node2)
      nodplc(loc+17)=indxx(node5,node4)
      nodplc(loc+18)=indxx(node5,node6)
      nodplc(loc+19)=indxx(node6,node3)
      nodplc(loc+20)=indxx(node6,node4)
      nodplc(loc+21)=indxx(node6,node5)
      nodplc(loc+24)=indxx(node1,node1)
      nodplc(loc+25)=indxx(node2,node2)
      nodplc(loc+26)=indxx(node3,node3)
      nodplc(loc+27)=indxx(node4,node4)
      nodplc(loc+28)=indxx(node5,node5)
      nodplc(loc+29)=indxx(node6,node6)
      nodplc(loc+31)=indxx(node7,node7)
      nodplc(loc+32)=indxx(node4,node7)
      nodplc(loc+33)=indxx(node7,node4)
      nodplc(loc+34)=indxx(node2,node4)
      nodplc(loc+35)=indxx(node4,node2)
      loc=nodplc(loc)
      go to 830
c
c  jfets
c
  840 loc=locate(13)
  850 if (loc.eq.0) go to 860
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      node3=nodplc(loc+4)
      node4=nodplc(loc+5)
      node5=nodplc(loc+6)
      nodplc(loc+9)=indxx(node1,node4)
      nodplc(loc+10)=indxx(node2,node4)
      nodplc(loc+11)=indxx(node2,node5)
      nodplc(loc+12)=indxx(node3,node5)
      nodplc(loc+13)=indxx(node4,node1)
      nodplc(loc+14)=indxx(node4,node2)
      nodplc(loc+15)=indxx(node4,node5)
      nodplc(loc+16)=indxx(node5,node2)
      nodplc(loc+17)=indxx(node5,node3)
      nodplc(loc+18)=indxx(node5,node4)
      nodplc(loc+20)=indxx(node1,node1)
      nodplc(loc+21)=indxx(node2,node2)
      nodplc(loc+22)=indxx(node3,node3)
      nodplc(loc+23)=indxx(node4,node4)
      nodplc(loc+24)=indxx(node5,node5)
      loc=nodplc(loc)
      go to 850
c
c  mosfets
c
  860 loc=locate(14)
  870 if (loc.eq.0) go to 900
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      node3=nodplc(loc+4)
      node4=nodplc(loc+5)
      node5=nodplc(loc+6)
      node6=nodplc(loc+7)
      nodplc(loc+10)=indxx(node1,node5)
      nodplc(loc+11)=indxx(node2,node4)
      nodplc(loc+12)=indxx(node2,node5)
      nodplc(loc+13)=indxx(node2,node6)
      nodplc(loc+14)=indxx(node3,node6)
      nodplc(loc+15)=indxx(node4,node2)
      nodplc(loc+16)=indxx(node4,node5)
      nodplc(loc+17)=indxx(node4,node6)
      nodplc(loc+18)=indxx(node5,node1)
      nodplc(loc+19)=indxx(node5,node2)
      nodplc(loc+20)=indxx(node5,node4)
      nodplc(loc+21)=indxx(node5,node6)
      nodplc(loc+22)=indxx(node6,node2)
      nodplc(loc+23)=indxx(node6,node3)
      nodplc(loc+24)=indxx(node6,node4)
      nodplc(loc+25)=indxx(node6,node5)
      nodplc(loc+27)=indxx(node1,node1)
      nodplc(loc+28)=indxx(node2,node2)
      nodplc(loc+29)=indxx(node3,node3)
      nodplc(loc+30)=indxx(node4,node4)
      nodplc(loc+31)=indxx(node5,node5)
      nodplc(loc+32)=indxx(node6,node6)
      loc=nodplc(loc)
      go to 870
c
c  transmission lines
c
  900 loc=locate(17)
  910 if (loc.eq.0) go to 1000
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      node3=nodplc(loc+4)
      node4=nodplc(loc+5)
      ni1=nodplc(loc+6)
      ni2=nodplc(loc+7)
      ibr1=nodplc(loc+8)
      ibr2=nodplc(loc+9)
      nodplc(loc+10)=indxx(node1,node1)
      nodplc(loc+11)=indxx(node1,ni1)
      nodplc(loc+12)=indxx(node2,ibr1)
      nodplc(loc+13)=indxx(node3,node3)
      nodplc(loc+14)=indxx(node4,ibr2)
      nodplc(loc+15)=indxx(ni1,node1)
      nodplc(loc+16)=indxx(ni1,ni1)
      nodplc(loc+17)=indxx(ni1,ibr1)
      nodplc(loc+18)=indxx(ni2,ni2)
      nodplc(loc+19)=indxx(ni2,ibr2)
      nodplc(loc+20)=indxx(ibr1,node2)
      nodplc(loc+21)=indxx(ibr1,node3)
      nodplc(loc+22)=indxx(ibr1,node4)
      nodplc(loc+23)=indxx(ibr1,ni1)
      nodplc(loc+24)=indxx(ibr1,ibr2)
      nodplc(loc+25)=indxx(ibr2,node1)
      nodplc(loc+26)=indxx(ibr2,node2)
      nodplc(loc+27)=indxx(ibr2,node4)
      nodplc(loc+28)=indxx(ibr2,ni2)
      nodplc(loc+29)=indxx(ibr2,ibr1)
      nodplc(loc+31)=indxx(node3,ni2)
      nodplc(loc+32)=indxx(ni2,node3)
      loc=nodplc(loc)
      go to 910
c
c  .nodeset
c
 1000 call sizmem(nsnod,nic)
      if(nic.eq.0) go to 1020
      call getm4(nsmat,nic)
      do 1010 i=1,nic
      node=nodplc(nsnod+i)
      nodplc(nsmat+i)=indxx(node,node)
 1010 continue
c
c  transient initial conditions
c
 1020 call sizmem(icnod,nic)
      if(nic.eq.0) go to 1100
      call getm4(icmat,nic)
      do 1030 i=1,nic
      node=nodplc(icnod+i)
      nodplc(icmat+i)=indxx(node,node)
 1030 continue
c
c  finished
c
 1100 return
      end
      integer function indxx(node1,node2)
      implicit double precision (a-h,o-z)
c
c     this routine maps a (row, column) matrix term specification into
c the offset from the origin of the matrix storage at which the term is
c actually located.
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  check for ground
c
      if (node1.eq.1) go to 400
      if (node2.eq.1) go to 400
c
      n1=nodplc(iequa+node1)
      n1=nodplc(jmnode+n1)
      n2=nodplc(jmnode+node2)
c
c
      if (n1-n2) 100,200,300
c
c  upper triangle
c
  100 ns=nodplc(iur+n1)
      ne=nodplc(iur+n1+1)
  110 if (ns.ge.ne) go to 400
      if (nodplc(iuc+ns).eq.n2) go to 120
      ns=ns+1
      go to 110
  120 indxx=nstop+ns
      go to 500
c
c  diagonal
c
  200 indxx=node2
      go to 500
c
c  lower triangle
c
  300 ns=nodplc(ilc+n2)
      ne=nodplc(ilc+n2+1)
  310 if (ns.ge.ne) go to 400
      if (nodplc(ilr+ns).eq.n1) go to 320
      ns=ns+1
      go to 310
  320 indxx=nstop+nut+ns
      go to 500
c
c  unused location
c
  400 indxx=1
c
c  finished
c
  500 return
      end
      subroutine codgen
      implicit double precision (a-h,o-z)
c
c     this routine generates machine instructions (for the cdc 6400) to
c lu-factor and solve the set of circuit equations.
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 /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))
      return
      end

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.