      subroutine scale(xmin,xmax,n,xminp,xmaxp,del)
      implicit double precision (a-h,o-z)
c
c     this routine determines the 'optimal' scale to use for the plot of
c some output variable.
c
c
c  adapted from algorithm 463 of 'collected algorithms of the cacm'
c
c spice version 2g.6  sccsid=knstnt 3/15/83
      common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok,
     1   gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox,
     2   pivtol,pivrel
      integer xxor
      dimension vint(5)
      data vint / 1.0d0,2.0d0,5.0d0,10.0d0,20.0d0 /
      data eps / 1.0d-12 /
c
c
c...  trap too-small data spread
c***********************************************************
c  temporily check 'equality' this way
      if(xmin.eq.0.0d0.and.xmax.eq.0.0d0) go to 4
      if(dabs((xmax-xmin)/dmax1(dabs(xmin),dabs(xmax))).ge.1.0d-4)
     1  go to 10
    4 continue
      if (xmin.ge.0.0d0) go to 5
      xmax=0.5d0*xmin+eps
      xmin=1.5d0*xmin-eps
      go to 10
    5 xmax=1.5d0*xmin+eps
      xmin=0.5d0*xmin-eps
c...  find approximate interval size, normalized to [1,10]
   10 a=(xmax-xmin)/dble(n)
      nal=idint(dlog10(a))
      if (a.lt.1.0d0) nal=nal-1
      xfact=dexp(xlog10*dble(nal))
      b=a/xfact
c...  find closest permissible interval size
      do 20 i=1,3
      if (b.lt.(vint(i)+eps)) go to 30
   20 continue
      i=4
c...  compute interval size
   30 del=vint(i)*xfact
      fm1=xmin/del
      m1=fm1
      if (fm1.lt.0.0d0) m1=m1-1
      if (dabs(dble(m1)+1.0d0-fm1).lt.eps) m1=m1+1
c...  compute new maximum and minimum limits
      xminp=del*dble(m1)
      fm2=xmax/del
      m2=fm2+1.0d0
      if (fm2.lt.(-1.0d0)) m2=m2-1
      if (dabs(fm2+1.0d0-dble(m2)).lt.eps) m2=m2-1
      xmaxp=del*dble(m2)
      np=m2-m1
c...  check whether another loop required
      if (np.le.n) go to 40
      i=i+1
      go to 30
c...  do final adjustments and correct for roundoff error(s)
   40 nx=(n-np)/2
      xminp=dmin1(xmin,xminp-dble(nx)*del)
      xmaxp=dmax1(xmax,xminp+dble(n)*del)
      return
      end
      subroutine second(t1)
      implicit double precision (a-h,o-z)
      integer bintime(2)
      call ifxbinarytime(bintime)
      t1=dble (bintime(1))/100.0d0
      return
      end
      subroutine sencal
      implicit double precision (a-h,o-z)
c
c     this routine computes the dc sensitivities of circuit elements
c with respect to user specified outputs.
c
c spice version 2g.6  sccsid=tabinf 3/15/83
      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,nsnod,nsmat,nsval,icnod,icmat,icval,
     6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt,
     7   irowno,jcolno,nttbr,nttar,lvntmp
c spice version 2g.6  sccsid=cirdat 3/15/83
      common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
     1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc
c spice version 2g.6  sccsid=status 3/15/83
      common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
     1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon,
     2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile
c spice version 2g.6  sccsid=miscel 3/15/83
      common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
     1  defas,rstats(50),iwidth,lwidth,nopage
c spice version 2g.6  sccsid=flags 3/15/83
      common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
     1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof
c spice version 2g.6  sccsid=dc 3/15/83
      common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop,
     1   kinel,kidin,kovar,kidout
c spice version 2g.6  sccsid=blank 3/15/83
      common /blank/ value(50000)
      integer nodplc(64)
      complex cvalue(32)
      equivalence (value(1),nodplc(1),cvalue(1))
c
c
      dimension string(5),sentit(4)
      data alsrs,alsis,alsn,alsrb,alsrc,alsre / 2hrs,2his,1hn,2hrb,2hrc,
     1   2hre /
      data alsbf,alsise,alsbr,alsisc,alsne,alsnc,alsik,alsikr,alsva,alsvb
     1   / 2hbf,3hise,2hbr,3hisc,2hne,2hnc,3hikf,3hikr,3hvaf,3hvar/
      data alsjs /2hjs/
      data sentit / 8hdc sensi, 8htivity a, 8hnalysis , 8h         /
      data ablnk / 1h  /
c
c
      if (kinel.ne.0) go to 8
    4 call dcdcmp
c
c
    8 do 1000 n=1,nsens
c
c  prepare adjoint excitation vector
c
      call zero8(value(lvn+1),nstop)
      locs=nodplc(isens+n)
      ioutyp=nodplc(locs+5)
      if (ioutyp.ne.0) go to 10
c...  voltage output
      ivolts=1
      noposo=nodplc(locs+2)
      nonego=nodplc(locs+3)
      value(lvn+noposo)=-1.0d0
      value(lvn+nonego)=+1.0d0
      go to 20
c...  current output (through voltage source)
   10 iptro=nodplc(locs+2)
      ivolts=0
      iptro=nodplc(iptro+6)
      value(lvn+iptro)=-1.0d0
c
c  obtain adjoint solution by doing forward/backward substitution on
c  the transpose of the y matrix
c
   20 call asol
      value(lvn+1)=0.0d0
c
c  real solution in lvnim1;  adjoint solution in lvn ...
c
      call title(0,lwidth,1,sentit)
      ipos=1
      call outnam(locs,1,string,ipos)
      call move(string,ipos,ablnk,1,7)
      jstop=(ipos+6)/8
      write (iofile,36) (string(j),j=1,jstop)
   36 format('0dc sensitivities of output ',5a8)
      if(ivolts.ne.0) write (iofile,41)
      if(ivolts.eq.0) write(iofile,42)
   41 format(1h0,8x,'element',9x,'element',7x,'element',7x,'normalized'/
     1   10x,'name',12x,'value',6x,'sensitivity    sensitivity'/35x,
     2   ' (volts/unit) (volts/percent)'/)
   42 format(1h0,8x,'element',9x,'element',7x,'element',7x,'normalized'/
     1   10x,'name',12x,'value',6x,'sensitivity    sensitivity'/35x,
     2   '  (amps/unit)  (amps/percent)'/)
c
c  resistors
c
      loc=locate(1)
  100 if ((loc.eq.0).or.(nodplc(loc+8).ne.0)) go to 110
      locv=nodplc(loc+1)
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      val=1.0d0/value(locv+1)
      sens=-(value(lvnim1+node1)-value(lvnim1+node2))*
     1      (value(lvn   +node1)-value(lvn   +node2))/(val*val)
      sensn=val*sens/100.0d0
      write (iofile,101) value(locv),val,sens,sensn
  101 format(10x,a8,4x,1pd10.3,5x,d10.3,5x,d10.3)
  105 loc=nodplc(loc)
      go to 100
c
c  voltage sources
c
  110 loc=locate(9)
  140 if ((loc.eq.0).or.(nodplc(loc+11).ne.0)) go to 150
      locv=nodplc(loc+1)
      val=value(locv+1)
      iptrv=nodplc(loc+6)
      sens=-value(lvn+iptrv)
      sensn=val*sens/100.0d0
      write (iofile,101) value(locv),val,sens,sensn
  145 loc=nodplc(loc)
      go to 140
c
c  current sources
c
  150 loc=locate(10)
  160 if ((loc.eq.0).or.(nodplc(loc+6).ne.0)) go to 170
      locv=nodplc(loc+1)
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      val=value(locv+1)
      sens=value(lvn+node1)-value(lvn+node2)
      sensn=val*sens/100.0d0
      write (iofile,101) value(locv),val,sens,sensn
  165 loc=nodplc(loc)
      go to 160
c
c  diodes
c
  170 loc=locate(11)
  180 if ((loc.eq.0).or.(nodplc(loc+16).ne.0)) go to 210
      locv=nodplc(loc+1)
      write (iofile,181) value(locv)
  181 format(1x,a8)
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      node3=nodplc(loc+4)
      locm=nodplc(loc+5)
      locm=nodplc(locm+1)
      area=value(locv+1)
c
c  series resistance (rs)
c
      val=value(locm+2)*area
      if (val.ne.0.0d0) go to 190
      write (iofile,186) alsrs
  186 format(10x,a8,5x,2h0.,13x,2h0.,13x,2h0.)
      go to 200
  190 val=1.0d0/val
      sens=-(value(lvnim1+node1)-value(lvnim1+node3))*
     1      (value(lvn   +node1)-value(lvn   +node3))/(val*val)
      sensn=val*sens/100.0d0
      write (iofile,101) alsrs,val,sens,sensn
c
c  intrinsic parameters
c
  200 csat=value(locm+1)*area
      xn=value(locm+3)
      vbe=value(lvnim1+node3)-value(lvnim1+node2)
      vte=xn*vt
      evbe=dexp(vbe/vte)
      vabe=value(lvn+node3)-value(lvn+node2)
c
c  saturation current (is)
c
      sens=vabe*(evbe-1.0d0)
      sensn=csat*sens/100.0d0
      write (iofile,101) alsis,csat,sens,sensn
c
c  ideality factor (n)
c
      sens=-vabe*(csat/xn)*(vbe/vte)*evbe
      if (dabs(sens).lt.1.0d-30) sens=0.0d0
      sensn=xn*sens/100.0d0
      write (iofile,101) alsn,xn,sens,sensn
  205 loc=nodplc(loc)
      go to 180
c
c  bipolar junction transistors
c
  210 loc=locate(12)
  220 if ((loc.eq.0).or.(nodplc(loc+36).ne.0)) go to 1000
      locv=nodplc(loc+1)
      write (iofile,181) value(locv)
      node1=nodplc(loc+2)
      node2=nodplc(loc+3)
      node3=nodplc(loc+4)
      node4=nodplc(loc+5)
      node5=nodplc(loc+6)
      node6=nodplc(loc+7)
      locm=nodplc(loc+8)
      type=nodplc(locm+2)
      locm=nodplc(locm+1)
      loct=lx0+nodplc(loc+22)
      area=value(locv+1)
c
c  base resistance (rb)
c
      val=value(loct+16)
      if (val.ne.0.0d0) go to 230
      write (iofile,186) alsrb
      go to 240
  230 val=1.0d0/val
      sens=-(value(lvnim1+node2)-value(lvnim1+node5))*
     1      (value(lvn   +node2)-value(lvn   +node5))/(val*val)
      sensn=val*sens/100.0d0
      write (iofile,101) alsrb,val,sens,sensn
c
c  collector resistance (rc)
c
  240 val=value(locm+20)*area
      if (val.ne.0.0d0) go to 250
      write (iofile,186) alsrc
      go to 260
  250 val=1.0d0/val
      sens=-(value(lvnim1+node1)-value(lvnim1+node4))*
     1      (value(lvn   +node1)-value(lvn   +node4))/(val*val)
      sensn=val*sens/100.0d0
      write (iofile,101) alsrc,val,sens,sensn
c
c  emitter resistance (re)
c
  260 val=value(locm+19)*area
      if (val.ne.0.0d0) go to 270
      write (iofile,186) alsre
      go to 280
  270 val=1.0d0/val
      sens=-(value(lvnim1+node3)-value(lvnim1+node6))*
     1      (value(lvn   +node3)-value(lvn   +node6))/(val*val)
      sensn=val*sens/100.0d0
      write (iofile,101) alsre,val,sens,sensn
c
c  intrinsic parameters
c
  280 bf=value(locm+2)
      br=value(locm+8)
      csat=value(locm+1)*area
      ova=value(locm+4)
      ovb=value(locm+10)
      oik=value(locm+5)/area
      ise=value(locm+6)*area
      xne=value(locm+7)
      vte=xne*vt
      oikr=value(locm+11)/area
      isc=value(locm+12)*area
      xnc=value(locm+13)
      vtc=xnc*vt
      vbe=type*(value(lvnim1+node5)-value(lvnim1+node6))
      vbc=type*(value(lvnim1+node5)-value(lvnim1+node4))
      vabe=type*(value(lvn+node5)-value(lvn+node6))
      vabc=type*(value(lvn+node5)-value(lvn+node4))
      vace=vabe-vabc
      if (vbe.le.-vt) go to 320
      evbe=dexp(vbe/vt/value(locm+3))
      cbe=csat*(evbe-1.0d0)
      gbe=csat*evbe/vt/value(locm+3)
      if (ise.ne.0.0d0) go to 310
      cben=0.0d0
      gben=0.0d0
      go to 350
  310 evben=dexp(vbe/vte)
      cben=ise     *(evben-1.0d0)
      gben=ise     *evben/vte
      go to 350
  320 gbe=-csat/vbe
      cbe=gbe*vbe
      gben=-ise/vbe
      cben=gben*vbe
  350 if (vbc.le.-vt) go to 370
      evbc=dexp(vbc/vt/value(locm+9))
      cbc=csat*(evbc-1.0d0)
      gbc=csat*evbc/vt/value(locm+9)
      if (isc.ne.0.0d0) go to 360
      cbcn=0.0d0
      gbcn=0.0d0
      go to 400
  360 evbcn=dexp(vbc/vtc)
      cbcn=isc     *(evbcn-1.0d0)
      gbcn=isc     *evbcn/vtc
      go to 400
  370 gbc=-csat/vbc
      cbc=gbc*vbc
      gbcn=-isc/vbc
      cbcn=gbcn*vbc
  400 q1=1.0d0/(1.0d0-ova*vbc-ovb*vbe)
      q2=oik*cbe+oikr*cbc
      sqarg=dsqrt(1.0d0+4.0d0*q2)
      qb=q1*(1.0d0+sqarg)/2.0d0
      dqb=(cbe-cbc)/(qb*qb)
      sqarg=dsqrt(1.0d0+4.0d0*q2)
      dq1=dqb*(1.0d0+sqarg)/2.0d0
      dq2=q1*dqb/sqarg
c
c  compute sensitivities
c
c...  bf
      sens=-vabe*cbe/bf/bf
      sensn=bf*sens/100.0d0
      write (iofile,101) alsbf,bf,sens,sensn
c...  ise
      if (ise.ne.0.0d0) go to 430
      write (iofile,186) alsise
      go to 440
  430 sens=vabe*cben/ise
      sensn=ise*sens/100.0d0
      write (iofile,101) alsise,ise,sens,sensn
c...  br
  440 sens=-vabc*cbc/br/br
      sensn=br*sens/100.0d0
      write (iofile,101) alsbr,br,sens,sensn
c...  isc
      if (isc.ne.0.0d0) go to 450
      write (iofile,186) alsisc
      go to 460
  450 sens=vabc*cbcn/isc
      sensn=isc*sens/100.0d0
      write (iofile,101) alsisc,isc,sens,sensn
c...  is
  460 sens=(vabe*(cbe/bf)+vabc*(cbc/br)
     1   +vace*(dqb*qb-dq2*q2))/csat
      sensn=csat*sens/100.0d0
      write (iofile,101) alsjs,csat,sens,sensn
c...  ne
      sens=-vabe*gben*vbe/xne
      sensn=xne*sens/100.0d0
      write (iofile,101) alsne,xne,sens,sensn
c...  nc
      sens=-vabc*gbcn*vbc/xnc
      sensn=xnc*sens/100.0d0
      write (iofile,101) alsnc,xnc,sens,sensn
c...  ik
      if (oik.ne.0.0d0) go to 470
      write (iofile,186) alsik
      go to 480
  470 val=1.0d0/oik
      sens=vace*dq2*cbe/(val*val)
      sensn=val*sens/100.0d0
      write (iofile,101) alsik,val,sens,sensn
c...  ikr
  480 if (oikr.ne.0.0d0) go to 490
      write (iofile,186) alsikr
      go to 500
  490 val=1.0d0/oikr
      sens=vace*dq2*cbc/(val*val)
      sensn=val*sens/100.0d0
      write (iofile,101) alsikr,val,sens,sensn
c...  va
  500 if (ova.ne.0.0d0) go to 510
      write (iofile,186) alsva
      go to 520
  510 va=1.0d0/ova
      sens=vace*q1*q1*dq1*vbc/(va*va)
      sensn=va*sens/100.0d0
      write (iofile,101) alsva,va,sens,sensn
c...  vb
  520 if (ovb.ne.0.0d0) go to 530
      write (iofile,186) alsvb
      go to 540
  530 vb=1.0d0/ovb
      sens=vace*q1*q1*dq1*vbe/(vb*vb)
      sensn=vb*sens/100.0d0
      write (iofile,101) alsvb,vb,sens,sensn
c
c
  540 loc=nodplc(loc)
      go to 220
c
c  finished
c
 1000 continue
      return
      end
      subroutine setmem(ipntr,ksize)
      implicit double precision (a-h,o-z)
c
c     this routine performs dynamic memory management.  it is used in
c     spice2, and useable in any program.
c
c     memory is managed within an array selected by the calling program.
c     one may either dimension this array to the 'maxmem' size, or more
c     desirably, find the address of the first available word of memory
c     above your program, and dimension your array to '1'.  passing the
c     address of the first data word available permits the manager to
c     use 'illegal' indices into the data area.
c
c     this routine must have access to an integer function called 'locf'
c     which returns the address of its argument.  addresses as used by this
c     program refer to 'integer' addresses, not byte addresses.
c
c entry points:
c      setmem - set initial memory
c      getm4  - get block for table of integers
c      getm8  - get block for table of floating point variables
c      getm16 - get block for table of complex variables
c      relmem - release part of block
c      extmem - extend size of existing block
c      sizmem - determine size of existing block
c      clrmem - release block
c      ptrmem - reset memory pointer
c      crunch - force memory compaction
c      avlm4  - amount of space available (integers)
c      avlm8  - amount of space available (real)
c      avlm16 - amount of space available (complex)
c
c calling sequences:
c      call setmem(imem(1),maxmem)
c      call setmem(imem(1),maxmem,kfamwa)  cdc machines running under
c                                          calidoscope kfamwa is the address
c                                          of the first available word
c      call getm4 (ipntr,blksiz)  where blksize is the number of entries
c      call getm8 (ipntr,blksiz)
c      call getm16(ipntr,blksiz)
c      call relmem(ipntr,relsiz)
c      call extmem(ipntr,extsiz)  extsiz is the number of entries to be added
c      call sizmem(ipntr,blksiz)
c      call clrmem(ipntr)
c      call ptrmem(ipntr1,ipntr2)
c      call avlm4(ispace)
c      call avlm8(ispace)
c      call avlm16(ispace)
c      call crunch
c      call slpmem(ipntr,slpsiz)  express desire for *slpsiz* extra entries
c
c
c general comments:
c      for each block which is allocated, a multi-word entry is maintained
c in a table kept in high memory, of the form
c
c        word      contents
c        ----      --------
c
c          1       index of imem(.) into origin of block
c                    i.e. contents of pointer (used for error check)
c          2       block size (in words)
c          3       number of words in use
c          4       address of variable containing block origin
c          5       number of words used per table entry
c          6       slop size (in words)
c
c      all allocated blocks are an 'even' (nxtevn) number of words in length,
c where a 'word' is the storage unit required for an 'integer' variable.
c      since block repositioning may be necessary, the convention that
c only one variable contain a block origin should be observed.
c      for *getmem*, *ipntr* is set such that *array(ipntr+1)* is the
c first word of the allocated block.  'ipntr' is set to address the first
c entry of the table when used with the appropriate variable type, i.e.,
c nodplc(ipntr+1), value(ipntr+1), or cvalue(ipntr+1).
c      for *clrmem*, *ipntr* is set to 'invalid' to enable rapid detection
c of an attempt to use a cleared block.
c      if any fatal errors are found, a message is printed and a flag
c set inhibiting further action until *setmem* is called.  (in this
c context, insufficient memory is considered a fatal error.)
c      throughout this routine, *ldval* always contains the subscript of
c the last addressable word of memory, *memavl* always contains the
c number of available words of memory, *numblk* always contains the
c number of allocated blocks, and istack(*loctab* +1) always contains
c the first word of the block table.
c
c spice version 2g.6  sccsid=blank 3/15/83
      common /blank/ value(50000)
c spice version 2g.6  sccsid=memmgr 3/15/83
      common /memmgr/ cpyknt,istack(1),lorg,icore,maxcor,maxuse,memavl,
     1   ldval,numblk,loctab,ltab,ifwa,nwoff,ntab,maxmem,memerr,nwd4,
     2   nwd8,nwd16
      dimension ipntr(1)
c
      logical memptr
      complex cvalue(32)
      equivalence (value(1),cvalue(1))
      external locf, locfr, locfc
c
c...  approximate time required to copy *nwords* integer values
c
c  nxtevn rounds the number up to the next 'even' value.  the value
c  used for this 'even' number is the smallest number into which one
c  can divide nwd4,nwd8,and nwd16.
c
c
c  nxtmem  returns next higher memory size
c
c
c
c***  setmem - set initial memory
c
      nwd4=1
      nwd8=locfr(value(2))-locfr(value(1))
      nwd16=locfc(cvalue(2))-locfc(cvalue(1))
      memerr=0
      nevn=nxtevn(1)
c     check that nxtevn function returns a number divisible by
c     nwd4, nwd8, nwd16; also check that the memory increment
c     nxtmem(.) is an integer multiple of nxtevn(1)
      icheck=mod(nevn,nwd4)+mod(nevn,nwd8)+mod(nevn,nwd16)+
     1  mod(nxtmem(1),nevn)
      if(icheck.eq.0) go to 2
      memerr=1
      call errmem(6,memerr,ipntr(1))
    2 cpyknt=0.0d0
      ifamwa=locf(ipntr(1))
      maxmem=ksize
      ntab=nxtevn(6)
c... add 'lorg' to an address and you get the 'istack' index to that word
      lorg=1-locf(istack(1))
      ifwa=ifamwa+lorg-1
      nwoff=locf(ipntr(1))+lorg-1
      icore=nxtmem(1)
c... don't take chances, back off from 'end of memory' by nxtevn(1)
      ldval=ifwa+nxtmem(1)-nxtevn(1)
      memavl=ldval-ntab-ifwa
      maxcor=0
      maxuse=0
      call memory
      if(memerr.ne.0) call errmem(6,memerr,ipntr(1))
      numblk=1
      loctab=ldval-ntab
      istack(loctab+1)=0
      istack(loctab+2)=memavl
      istack(loctab+3)=0
      istack(loctab+4)=-1
      istack(loctab+5)=1
      istack(loctab+6)=0
      return
      end
      subroutine setplt(loc)
      implicit double precision (a-h,o-z)
c
c     this routine generates the 'legend' subheading used to identify
c individual traces on multi-trace line-printer plots.
c
c spice version 2g.6  sccsid=tabinf 3/15/83
      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,nsnod,nsmat,nsval,icnod,icmat,icval,
     6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt,
     7   irowno,jcolno,nttbr,nttar,lvntmp
c spice version 2g.6  sccsid=status 3/15/83
      common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
     1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon,
     2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile
c spice version 2g.6  sccsid=miscel 3/15/83
      common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
     1  defas,rstats(50),iwidth,lwidth,nopage
c spice version 2g.6  sccsid=dc 3/15/83
      common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop,
     1   kinel,kidin,kovar,kidout
c spice version 2g.6  sccsid=ac 3/15/83
      common /ac/ fstart,fstop,fincr,skw2,refprl,spw2,jacflg,idfreq,
     1   inoise,nosprt,nosout,nosin,idist,idprt
c spice version 2g.6  sccsid=tran 3/15/83
      common /tran/ tstep,tstop,tstart,delmax,tdmax,forfre,jtrflg
c spice version 2g.6  sccsid=outinf 3/15/83
      common /outinf/ xincr,string(15),xstart,yvar(8),itab(8),itype(8),
     1   ilogy(8),npoint,numout,kntr,numdgt
c spice version 2g.6  sccsid=blank 3/15/83
      common /blank/ value(50000)
      integer nodplc(64)
      complex cvalue(32)
      equivalence (value(1),nodplc(1),cvalue(1))
c
      dimension logopt(6)
      data logopt / 2, 2, 1, 1, 1, 1 /
      data ablnk, atimex, afreq / 1h , 6h  time, 6h  freq /
      data pltsym / 8h*+=$0<>? /
c
c  set limits depending upon the analysis mode
c
      if (mode-2) 10,20,30
   10 xstart=tcstar(1)
      xincr=tcincr(1)
      npoint=icvflg
      itemp=itcelm(1)
      loce=nodplc(itemp+1)
      asweep=value(loce)
      go to 40
   20 xstart=tstart
      xincr=tstep
      npoint=jtrflg
      asweep=atimex
      go to 40
   30 xstart=fstart
      xincr=fincr
      npoint=icalc
      asweep=afreq
c
c  construct and print the output variables with corresponding plot
c    symbols
c
   40 loct=loc+2
      if (kntr.eq.1) go to 80
      write (iofile,41)
   41 format('0legend:'/)
      do 70 i=1,kntr
      loct=loct+2
      itab(i)=nodplc(loct)
      ioutyp=nodplc(loct+1)
      itype(i)=ioutyp
      ilogy(i)=1
      if (mode.le.2) go to 50
      ilogy(i)=logopt(ioutyp)
   50 ipos=1
      call outnam(itab(i),itype(i),string,ipos)
      call move(string,ipos,ablnk,1,7)
      jstop=(ipos+6)/8
      call move(achar,1,pltsym,i,1)
      write (iofile,61) achar,(string(j),j=1,jstop)
   61 format(1x,a1,2h: ,5a8)
   70 continue
   80 if (kntr.ge.2) go to 90
      itab(1)=nodplc(loc+4)
      ioutyp=nodplc(loc+5)
      itype(1)=ioutyp
      ilogy(1)=1
      if (mode.le.2) go to 90
      ilogy(1)=logopt(ioutyp)
   90 ipos=1
      call outnam(itab(1),itype(1),string,ipos)
      call move(string,ipos,ablnk,1,7)
      jstop=(ipos+6)/8
      write (iofile,101) asweep,(string(j),j=1,jstop)
  101 format(1hx/3x,a8,4x,5a8)
      return
      end
      subroutine setprn(loc)
      implicit double precision (a-h,o-z)
c
c     this routine formats the column headers for tabular listings of
c output variables.
c
c spice version 2g.6  sccsid=tabinf 3/15/83
      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,nsnod,nsmat,nsval,icnod,icmat,icval,
     6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt,
     7   irowno,jcolno,nttbr,nttar,lvntmp
c spice version 2g.6  sccsid=status 3/15/83
      common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
     1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon,
     2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile
c spice version 2g.6  sccsid=miscel 3/15/83
      common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
     1  defas,rstats(50),iwidth,lwidth,nopage
c spice version 2g.6  sccsid=dc 3/15/83
      common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop,
     1   kinel,kidin,kovar,kidout
c spice version 2g.6  sccsid=ac 3/15/83
      common /ac/ fstart,fstop,fincr,skw2,refprl,spw2,jacflg,idfreq,
     1   inoise,nosprt,nosout,nosin,idist,idprt
c spice version 2g.6  sccsid=tran 3/15/83
      common /tran/ tstep,tstop,tstart,delmax,tdmax,forfre,jtrflg
c spice version 2g.6  sccsid=outinf 3/15/83
      common /outinf/ xincr,string(15),xstart,yvar(8),itab(8),itype(8),
     1   ilogy(8),npoint,numout,kntr,numdgt
c spice version 2g.6  sccsid=blank 3/15/83
      common /blank/ value(50000)
      integer nodplc(64)
      complex cvalue(32)
      equivalence (value(1),nodplc(1),cvalue(1))
c
      data ablnk, atimex, afreq / 1h , 6h  time, 6h  freq /
c
c  set limits depending upon the analysis mode
c
      if (mode-2) 10,20,30
   10 xstart=tcstar(1)
      xincr=tcincr(1)
      npoint=icvflg
      itemp=itcelm(1)
      loce=nodplc(itemp+1)
      asweep=value(loce)
      go to 40
   20 xstart=tstart
      xincr=tstep
      npoint=jtrflg
      asweep=atimex
      go to 40
   30 xstart=fstart
      xincr=fincr
      npoint=icalc
      asweep=afreq
c
c  construct and print the output variable names
c
   40 loct=loc+2
      ipos=1
      npos=ipos+numdgt+8
      do 90 i=1,kntr
      loct=loct+2
      itab(i)=nodplc(loct)
      itype(i)=nodplc(loct+1)
      call outnam(itab(i),itype(i),string,ipos)
      if (ipos.ge.npos) go to 70
      do 60 j=ipos,npos
      call move(string,j,ablnk,1,1)
   60 continue
      ipos=npos
      go to 80
   70 call move(string,ipos,ablnk,1,1)
      ipos=ipos+1
   80 npos=npos+numdgt+8
   90 continue
      call move(string,ipos,ablnk,1,7)
      jstop=(ipos+6)/8
      write (iofile,91) asweep,(string(j),j=1,jstop)
   91 format(/3x,a8,5x,14a8,a4)
      write (iofile,101)
  101 format(1hx/1h )
      return
      end
c spice version 2g.6  sccsid=setup.ma 3/15/83
      subroutine setup
      implicit double precision (a-h,o-z)
c
c     this routine drives the sparse matrix setup used by spice.
c
c spice version 2g.6  sccsid=tabinf 3/15/83
      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,nsnod,nsmat,nsval,icnod,icmat,icval,
     6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt,
     7   irowno,jcolno,nttbr,nttar,lvntmp
c spice version 2g.6  sccsid=cirdat 3/15/83
      common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
     1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc
c spice version 2g.6  sccsid=miscel 3/15/83
      common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
     1  defas,rstats(50),iwidth,lwidth,nopage
c spice version 2g.6  sccsid=flags 3/15/83
      common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
     1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof
c spice version 2g.6  sccsid=dc 3/15/83
      common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop,
     1   kinel,kidin,kovar,kidout
c spice version 2g.6  sccsid=ac 3/15/83
      common /ac/ fstart,fstop,fincr,skw2,refprl,spw2,jacflg,idfreq,
     1   inoise,nosprt,nosout,nosin,idist,idprt
c spice version 2g.6  sccsid=blank 3/15/83
      common /blank/ value(50000)
      integer nodplc(64)
      complex cvalue(32)
      equivalence (value(1),nodplc(1),cvalue(1))
c
      logical memptr
c
      call second(t1)
      nstop=numnod+jelcnt(3)+jelcnt(6)+jelcnt(8)+jelcnt(9)+2*jelcnt(17)
c
c     clear old tables
c
      if (memptr(irpt)) call clrmem(irpt)
      if (memptr(jcpt)) call clrmem(jcpt)
      if (memptr(irowno)) call clrmem(irowno)
      if (memptr(jcolno)) call clrmem(jcolno)
c
c  reserve matrix locations for each element
c
      call matptr
      if (nogo.ne.0) go to 1000
c
c  reorder matrix pointers
c
      nttbr=0
      do 120 i=2,nstop
      loc=i
  110 if (nodplc(jcpt+loc).eq.0) go to 120
      loc=nodplc(jcpt+loc)
      nttbr=nttbr+1
      go to 110
  120 continue
c...  add ground
      nttar=nttbr
      call reordr
      if (nogo.ne.0) go to 1000
c
c  store matrix locations
c
      call matloc
c
c  .nodeset
c
  200 call sizmem(nsnod,nic)
      if(nic.eq.0) go to 220
      call getm4(nsmat,nic)
      do 210 i=1,nic
      node=nodplc(nsnod+i)
      nodplc(nsmat+i)=indxx(node,node)
  210 continue
c
c  transient initial conditions
c
  220 call sizmem(icnod,nic)
      if(nic.eq.0) go to 300
      call getm4(icmat,nic)
      do 230 i=1,nic
      node=nodplc(icnod+i)
      nodplc(icmat+i)=indxx(node,node)
  230 continue
c
  300 call clrmem(iseq)
      call clrmem(iseq1)
      call clrmem(neqn)
      call clrmem(nodevs)
      call clrmem(ndiag)
c
c  finished
c
 1000 call second(t2)
      rstats(2)=rstats(2)+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 sizmem(ipntr,ksize)
      implicit double precision (a-h,o-z)
      dimension ipntr(1)
c spice version 2g.6  sccsid=memmgr 3/15/83
      common /memmgr/ cpyknt,istack(1),lorg,icore,maxcor,maxuse,memavl,
     1   ldval,numblk,loctab,ltab,ifwa,nwoff,ntab,maxmem,memerr,nwd4,
     2   nwd8,nwd16
      logical memptr
c
c***  sizmem - determine size of existing block
c
c
c...  check for valid pointer
      if (memptr(ipntr(1))) go to 10
      memerr=5
      call errmem(7,memerr,ipntr(1))
   10 ksize=istack(ltab+3)/istack(ltab+5)
      return
      end
      subroutine slpmem(ipntr,ksize)
      implicit double precision (a-h,o-z)
c
c      this routine may be used to define a certain amount of `slop' to
c be associated with a particular table managed by the memory manager.
c this *slop* is defined as a number of entries in the table for which
c space is to be held ***if possible*** during compaction of the managed
c area of memory.  this feature can eliminate the overhead incurred by
c alternatively extending more than one table at a time.  (for example,
c if the program contains a code sequence
c
c                  do 100 i=1,500
c                     ...
c                  call extmem(table1,1)
c                     ...
c                  call extmem(table2,1)
c                     ...
c              100 continue
c
c then the overhead incurred by this memory manager can be reduced to
c essentially nothing if prior to the above code sequence the program
c executes
c
c                  call slpmem(table1,20)
c                  call slpmem(table2,20)
c
c where `20' is a typical number (for the above example, the memory-to-
c memory copying overhead of the memory manager would be reduced by a
c factor of 20).
c
c spice version 2g.6  sccsid=memmgr 3/15/83
      common /memmgr/ cpyknt,istack(1),lorg,icore,maxcor,maxuse,memavl,
     1   ldval,numblk,loctab,ltab,ifwa,nwoff,ntab,maxmem,memerr,nwd4,
     2   nwd8,nwd16
c spice version 2g.6  sccsid=flags 3/15/83
      common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
     1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof
      dimension ipntr(1)
      islp=nxtevn(ksize)
      call extmem(ipntr,islp)
      islp=islp*istack(ltab+5)
      istack(ltab+3)=istack(ltab+3)-islp
      memavl=memavl+istack(ltab+6)
      istack(ltab+6)=islp
      return
      end
      subroutine sorstp(itlim)
      implicit double precision (a-h,o-z)
c
c     this routine uses the source stepping method to solve the dc
c     operating point
c
c spice version 2g.6  sccsid=knstnt 3/15/83
      common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok,
     1   gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox,
     2   pivtol,pivrel
c spice version 2g.6  sccsid=cirdat 3/15/83
      common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
     1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc
c spice version 2g.6  sccsid=status 3/15/83
      common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
     1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon,
     2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile
c spice version 2g.6  sccsid=miscel 3/15/83
      common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
     1  defas,rstats(50),iwidth,lwidth,nopage
c spice version 2g.6  sccsid=flags 3/15/83
      common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
     1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof
c spice version 2g.6  sccsid=blank 3/15/83
      common /blank/ value(50000)
      integer nodplc(64)
      complex cvalue(32)
      equivalence (value(1),nodplc(1),cvalue(1))
c
      bound=1.0d0/64
      fractn=1.0d0/16
c
c  step down sources
c
   10 fractn=fractn*2.0d0
      sfactr=sfactr*fractn
      if (sfactr.lt.bound) go to 100
      initf=2
      call iter8(itlim)
      rstats(6)=rstats(6)+iterno
      if (igoof.ne.0) go to 10
      fractn=2.0d0
c
c  step up sources
c
   20 sfactr=sfactr*fractn
      if (sfactr.le.1.0d0) go to 30
      sfactr=1.0d0
   30 initf=3
      call iter8(itlim)
      rstats(6)=rstats(6)+iterno
      if ((igoof.eq.0).and.(sfactr.eq.1.0d0)) go to 200
      if (igoof.eq.0) go to 20
c
c  step down if step up failed
c
   40 fractn=dsqrt(fractn)
      if (fractn.lt.1.0001d0) go to 100
      sfactr=sfactr/fractn
      initf=3
      call iter8(itlim)
      rstats(6)=rstats(6)+iterno
      if (igoof.ne.0) go to 40
      go to 20
c
c   finish with source stepping method
c
  100 igoof=1
      write(iofile,110)
  110 format('0 source stepping method failed')
  200 initf=2
      return
      end
      subroutine sorupd
      implicit double precision (a-h,o-z)
c
c     this routine updates the independent voltage and current sources
c used in the circuit.  it also updates the ltd table (which contains
c previous (delayed) values of the sources used to model transmission
c lines).
c
c spice version 2g.6  sccsid=tabinf 3/15/83
      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,nsnod,nsmat,nsval,icnod,icmat,icval,
     6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt,
     7   irowno,jcolno,nttbr,nttar,lvntmp
c spice version 2g.6  sccsid=cirdat 3/15/83
      common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
     1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc
c spice version 2g.6  sccsid=status 3/15/83
      common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
     1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon,
     2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile
c spice version 2g.6  sccsid=flags 3/15/83
      common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
     1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof
c spice version 2g.6  sccsid=blank 3/15/83
      common /blank/ value(50000)
      integer nodplc(64)
      complex cvalue(32)
      equivalence (value(1),nodplc(1),cvalue(1))
c
c
      do 500 id=9,10
      loc=locate(id)
   10 if (loc.eq.0) go to 500
      if ((id.eq.9).and.(nodplc(loc+11).ne.0)) go to 500
      if ((id.eq.10).and.(nodplc(loc+6).ne.0)) go to 500
      locv=nodplc(loc+1)
      locp=nodplc(loc+5)
      itype=nodplc(loc+4)+1
      go to (490,100,200,300,400,450), itype
c
c  pulse source
c
  100 v1=value(locp+1)
      v2=value(locp+2)
      t1=value(locp+3)
      t2=value(locp+4)
      t3=value(locp+5)
      t4=value(locp+6)
      period=value(locp+7)
      time1=time
      if (time1.le.0.0d0) go to 160
  110 if (time1.lt.t1+period) go to 120
      time1=time1-period
      go to 110
  120 if (time1.lt.t4) go to 130
      value(locv+1)=v1
      go to 490
  130 if (time1.lt.t3) go to 140
      value(locv+1)=v2+(time1-t3)*(v1-v2)/(t4-t3)
      go to 490
  140 if (time1.lt.t2) go to 150
      value(locv+1)=v2
      go to 490
  150 if (time1.lt.t1) go to 160
      value(locv+1)=v1+(time1-t1)*(v2-v1)/(t2-t1)
      go to 490
  160 value(locv+1)=v1
      go to 490
c
c  sinusoidal source
c
  200 v1=value(locp+1)
      v2=value(locp+2)
      omeg=value(locp+3)
      t1=value(locp+4)
      theta=value(locp+5)
      time1=time-t1
      if (time1.gt.0.0d0) go to 210
      value(locv+1)=v1
      go to 490
  210 if (theta.ne.0.0d0) go to 220
      value(locv+1)=v1+v2*dsin(omeg*time1)
      go to 490
  220 value(locv+1)=v1+v2*dsin(omeg*time1)*dexp(-time1*theta)
      go to 490
c
c  exponential source
c
  300 v1=value(locp+1)
      v2=value(locp+2)
      t1=value(locp+3)
      tau1=value(locp+4)
      t2=value(locp+5)
      tau2=value(locp+6)
      time1=time
      if (time1.gt.t1) go to 310
      value(locv+1)=v1
      go to 490
  310 if (time1.gt.t2) go to 320
      value(locv+1)=v1+(v2-v1)*(1.0d0-dexp((t1-time1)/tau1))
      go to 490
  320 value(locv+1)=v1+(v2-v1)*(1.0d0-dexp((t1-time1)/tau1))
     1   +(v1-v2)*(1.0d0-dexp((t2-time1)/tau2))
      go to 490
c
c  piecewise-linear source
c
  400 t1=value(locp+1)
      v1=value(locp+2)
      t2=value(locp+3)
      v2=value(locp+4)
      iknt=4
  410 if (time.le.t2) go to 420
      t1=t2
      v1=v2
      t2=value(locp+iknt+1)
      v2=value(locp+iknt+2)
      iknt=iknt+2
      go to 410
  420 value(locv+1)=v1+((time-t1)/(t2-t1))*(v2-v1)
      go to 490
c
c  single-frequency fm
c
  450 v1=value(locp+1)
      v2=value(locp+2)
      omegc=value(locp+3)
      xmod=value(locp+4)
      omegs=value(locp+5)
      value(locv+1)=v1+v2*dsin(omegc*time+xmod*dsin(omegs*time))
  490 loc=nodplc(loc)
      go to 10
  500 continue
c
c  update transmission line sources
c
      if (jelcnt(17).eq.0) go to 1000
      if (mode.ne.2) go to 1000
      call sizmem(ltd,ltdsiz)
      numtd=ltdsiz/ntlin
      if (numtd.lt.3) go to 900
      loc=locate(17)
  610 if (loc.eq.0) go to 1000
      locv=nodplc(loc+1)
      td=value(locv+2)
      baktim=time-td
      if (baktim.lt.0.0d0) go to 640
      ltdptr=nodplc(loc+30)
      icntr=2
      l1=ltd
      l2=l1+ntlin
      l3=l2+ntlin
      t1=value(l1+1)
      t2=value(l2+1)
  620 t3=value(l3+1)
      icntr=icntr+1
      if (baktim.le.t3) go to 630
      if (icntr.eq.numtd) go to 900
      l1=l2
      l2=l3
      l3=l2+ntlin
      t1=t2
      t2=t3
      go to 620
  630 dt1t2=t1-t2
      dt1t3=t1-t3
      dt2t3=t2-t3
      tdnom1=1.0d0/(dt1t2*dt1t3)
      tdnom2=-1.0d0/(dt1t2*dt2t3)
      tdnom3=1.0d0/(dt2t3*dt1t3)
      dtt1=baktim-t1
      dtt2=baktim-t2
      dtt3=baktim-t3
      tfact1=dtt2*dtt3*tdnom1
      tfact2=dtt1*dtt3*tdnom2
      tfact3=dtt1*dtt2*tdnom3
      value(locv+3)=value(l1+ltdptr+0)*tfact1+value(l2+ltdptr+0)*tfact2
     1   +value(l3+ltdptr+0)*tfact3
      value(locv+4)=value(l1+ltdptr+1)*tfact1+value(l2+ltdptr+1)*tfact2
     1   +value(l3+ltdptr+1)*tfact3
  640 loc=nodplc(loc)
      go to 610
c
c  internal logic error:  less than 3 entries in ltd
c
  900 nogo=1
      write (iofile,901) numtd,icntr
  901 format('0*abort*:  internal spice error:  sorupd:  ',2i5/)
c
c  finished
c
 1000 return
      end
c spice version 2g.6  sccsid=root.ma 3/15/83
      program spice
c...  cray notes:
c.. change data filnam to 5lspice
c.. change call overlay .. remove last zero
c.. change ??????program to subroutine in all but this overlay
c.. delete overlay spice,0,0 card below
c..
      implicit double precision (a-h,o-z)
c
c
c spice version 2g.6  sccsid=root.ma 3/15/83
c
c     spice is an electronic circuit simulation program that was deve-
c loped by the integrated circuits group of the electronics research
c laboratory and the department of electrical engineering and computer
c sciences at the university of california, berkeley, california.  the
c program spice is available free of charge to any interested party.
c the sale, resale, or use of this program for profit without the
c express written consent of the department of electrical engineering
c and computer sciences, university of california, berkeley, california,
c is forbidden.
c
c
c     the present version is based on the spice2 program versions 2e.3
c and 2f.1 developed at the university of california berkeley and the
c hewlett-packard spice version 2.7.
c     this version is designed to be transportable on most computers
c with an ansi fortran compiler and enough memory space for code and
c data. the memory manager uses the function 'locf' to find the
c address of a pointer; this function must be provided.
c
c
c implementation notes:
c
c     subroutines mclock and mdate return the time (as hh:mm:ss) and
c the date (as dd mmm yy), respectively.  subroutine getcje returns in
c common block /cje/ various attributes of the current job environment.
c spice expects getcje to set /cje/ variables maxtim, itime, and icost.
c maxtim is the maximum cpu time in seconds, itime is the elapsed cpu
c time in seconds, and icost is the job cost in cents.
c subroutine memory is used to change the number of memory words
c allocated to spice.  if the amount of memory allocated to a jobstep
c is fixed, subroutine memory need not be changed.
c     subroutine second(t) returns the time in seconds and is used
c for timing purposes. it must be provided where not available.
c     ifamwa (set in a data statement below) should be set to the
c address of the first available word of memory (following overlays, if
c any).  the proper value should be easily obtainable from any load map.
c ifamwa is used only on computers where the program (spice) can change
c the allocated memory dynamically at run time according to circuit size.
c (see also comments under subroutine setmem).
c     all berkeley spice2.f release versions do not implement the ifamwa
c feature due to its dependence on operating system.
c     with the exception of most flags, all data in spice are stored in
c the form of managed tables allocated in the /blank/ array value().
c array value() can be redimensioned in the main program according to
c memory availability at each user site. it should be noted again that
c the program dynamically manages its data within the bounds of array
c value().
c     the vax release versions assume the virtual memory feature and
c dimension value() to 200,000 double precision words.
c     the cdc and ibm versions dimension value() to 20000 real or
c real*8 words, respectively.
c     spice is particularly well-suited to being run using a one-level
c overlay structure beginning with routines spice (the overlay root),
c readin, errchk, setup, dctran, dcop, acan, and ovtpvt.  the order of
c the routines in this listing corresponds to that structure.  note
c that if cdc explicit overlaying is to be used, an overlay directive
c card must be inserted before the first line of each of the just-named
c routines.
c
c
c spice version 2g.6  sccsid=tabinf 3/15/83
      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,nsnod,nsmat,nsval,icnod,icmat,icval,
     6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt,
     7   irowno,jcolno,nttbr,nttar,lvntmp
c spice version 2g.6  sccsid=miscel 3/15/83
      common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
     1  defas,rstats(50),iwidth,lwidth,nopage
c spice version 2g.6  sccsid=line 3/15/83
      common /line/ achar,afield(15),oldlin(15),kntrc,kntlim
c spice version 2g.6  sccsid=cirdat 3/15/83
      common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
     1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc
c spice version 2g.6  sccsid=mosarg 3/15/83
      common /mosarg/ vto,beta,gamma,phi,phib,cox,xnsub,xnfs,xd,xj,xld,
     1   xlamda,uo,uexp,vbp,utra,vmax,xneff,xl,xw,vbi,von,vdsat,qspof,
     2   beta0,beta1,cdrain,xqco,xqc,fnarrw,fshort,lev
c spice version 2g.6  sccsid=status 3/15/83
      common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
     1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon,
     2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile
c spice version 2g.6  sccsid=flags 3/15/83
      common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
     1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof
c spice version 2g.6  sccsid=knstnt 3/15/83
      common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok,
     1   gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox,
     2   pivtol,pivrel
c spice version 2g.6  sccsid=memmgr 3/15/83
      common /memmgr/ cpyknt,istack(1),lorg,icore,maxcor,maxuse,memavl,
     1   ldval,numblk,loctab,ltab,ifwa,nwoff,ntab,maxmem,memerr,nwd4,
     2   nwd8,nwd16
c spice version 2g.6  sccsid=dc 3/15/83
      common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop,
     1   kinel,kidin,kovar,kidout
c spice version 2g.6  sccsid=ac 3/15/83
      common /ac/ fstart,fstop,fincr,skw2,refprl,spw2,jacflg,idfreq,
     1   inoise,nosprt,nosout,nosin,idist,idprt
c spice version 2g.6  sccsid=tran 3/15/83
      common /tran/ tstep,tstop,tstart,delmax,tdmax,forfre,jtrflg
c spice version 2g.6  sccsid=outinf 3/15/83
      common /outinf/ xincr,string(15),xstart,yvar(8),itab(8),itype(8),
     1   ilogy(8),npoint,numout,kntr,numdgt
c spice version 2g.6  sccsid=cje 3/15/83
      common /cje/ maxtim,itime,icost
c spice version 2g.6  sccsid=debug 3/15/83
      common/debug/ idebug(20)
c spice version 2g.6  sccsid=blank 3/15/83
      common /blank/ value(50000)
      integer nodplc(64)
      complex cvalue(32)
      equivalence (value(1),nodplc(1),cvalue(1))
c
c
c
      dimension acctit(4)
      dimension remain(4)
      data ablnk /1h  /
      data acctit / 8hjob stat, 8histics s, 8hummary  , 8h         /
      data ahdr1,ahdr2,ahdr3 / 8h  spice ,8h2g.6    ,8h3/15/83     /
c
c
      ipostp=0
c     check if a raw data file should be written 
c     open file if so required
c     if  (iargc().gt.0) ipostp=iopraw()
      maxmem=2*50000
      maxtim=1e8
      icost=0
      iofile=50
c
c  initialization
c
      aprog(1)=ahdr1
      aprog(2)=ahdr2
      aprog(3)=ahdr3
      achar=ablnk
      keof=0
      call xxtime(atime)
      call xxdate(adate)
      boltz=1.3806226d-23
      charge=1.6021918d-19
      ctok=273.15d0
      eps0=8.854214871d-12
      epssil=11.7d0*eps0
      epsox=3.9d0*eps0
      twopi=8.0d0*datan2(1.0d0,1.0d0)
      rad=360.0d0/twopi
      xlog2=dlog(2.0d0)
      xlog10=dlog(10.0d0)
      root2=dsqrt(2.0d0)
      nodata=1
c
c  begin job
c
   10 if (keof.eq.1) go to 1000
      call getcje
      call second(time1)
      icost1=icost
      igoof=0
      mode=0
      nogo=0
      call setmem(nodplc(1),maxmem)
      if (nogo.ne.0) go to 1000
      call zero8(rstats,50)
c
c  read remainder of data deck and check for input errors
c
      call readin
      if (nogo.ne.0) go to 300
      if (keof.eq.1) go to 1000
      nodata=0
   50 call errchk
      if (nogo.ne.0) go to 300
      call setup
      if (nogo.ne.0) go to 300
c
c  change parameters and re-analisis
c
      if (numcyc.eq.0) go to 90
   70 if (numcyc.ge.numalt) go to 310
      numcyc=numcyc+1
      call alter
      if (nogo.ne.0) go to 305
c
c  cycle through temperatures
c
   90 itemno=1
      if (numtem.eq.1) go to 110
  100 if (itemno.eq.numtem) go to 70
      itemno=itemno+1
      call tmpupd
c
c  dc transfer curves
c
  110 if (icvflg.eq.0) go to 150
c...  see routine *dctran* for explanation of *mode*, etc.
      mode=1
      modedc=3
      call dctran
      call ovtpvt
      if (nogo.ne.0) go to 300
c
c  small signal operating point
c
  150 if (kssop.gt.0) go to 170
      if (jacflg.ne.0) go to 170
      if ((icvflg+jtrflg).gt.0) go to 250
  170 mode=1
      modedc=1
      call dctran
      if (nogo.ne.0) go to 300
      call dcop
      if (nogo.ne.0) go to 300
c
c  ac small signal analysis
c
  200 if (jacflg.eq.0) go to 250
      mode=3
      call acan
      call ovtpvt
      if (nogo.ne.0) go to 300
c
c  transient analysis
c
  250 if (jtrflg.eq.0) go to 100
      mode=1
      modedc=2
      call dctran
      if (nogo.ne.0) go to 300
      call dcop
      if (nogo.ne.0) go to 300
      mode=2
      call dctran
      call ovtpvt
      if (nogo.ne.0) go to 300
      go to 100
c
c  job concluded
c
  300 write (iofile,301)
  301 format(1h0,9x,'***** job aborted')
      nodata=0
      go to 320
  305 write (iofile,306)
  306 format (1h0,9x,'***** this parameter change is illegal')
  310 write (iofile,311)
  311 format(1h0,/,9x,'job concluded')
c
c  job accounting
c
  320 continue
      numel=0
      do 360 i=1,18
  360 numel=numel+jelcnt(i)
      numtem=max0(numtem-1,1)
      idist=min0(idist,1)
      if (iprnta.eq.0) go to 800
      call title(-1,lwidth,1,acctit)
      write (iofile,361) nunods,ncnods,numnod,numel,(jelcnt(i),i=11,14)
  361 format('   nunods ncnods numnod numel  diodes  bjts  jfets  mfets'
     1   //,i9,2i7,i6,i8,i6,2i7)
      write (iofile,371) numtem,icvflg,jtrflg,jacflg,inoise,idist,nogo
  371 format(/'0  numtem icvflg jtrflg jacflg inoise  idist   nogo'/,
     1   2h0 ,7i7)
      write (iofile,381) rstats(20),rstats(21),rstats(22),rstats(23),
     1   rstats(26),rstats(27)
  381 format(/'0  nstop   nttbr   nttar   ifill    iops    perspa'//,
     1   1x,5f8.0,f9.3)
      write (iofile,391) rstats(30),rstats(31),rstats(32),maxmem,maxuse,
     1   cpyknt
  391 format(/'0  numttp  numrtp  numnit  maxmem  memuse  copyknt',//,
     1   2x,3f8.0,2x,i6,2x,i6,2x,f8.0)
      write (iofile,401) (rstats(i),i=1,6),rstats(50),rstats(49),
     1   rstats(46),(rstats(i),i=7,11)
  401 format(/,
     1   1h0,9x,'readin  ',12x,f10.2/,
     2   1h0,9x,'setup   ',12x,f10.2/,
     3   1h0,9x,'trcurv  ',12x,f10.2,10x,f6.0/,
     4   1h0,9x,'dcan    ',12x,f10.2,10x,f6.0/,
     5   1h0,9x,'dcdcmp  ',12x,f10.3,10x,f6.0/,
     6   1h0,9x,'dcsol   ',12x,f10.3/,
     7   1h0,9x,'acan    ',12x,f10.2,10x,f6.0/,
     8   1h0,9x,'tranan  ',12x,f10.2,10x,f6.0/,
     9   1h0,9x,'output  ',12x,f10.2)
      write (iofile,402) rstats(45),rstats(48),rstats(47),rstats(44),
     1   rstats(43)
  402 format(
     1   1h0,9x,'load    ',12x,f10.3/,
     2   1h0,9x,'codgen  ',12x,f10.3,10x,f6.0/,
     3   1h0,9x,'codexc  ',12x,f10.3/,
     4   1h0,9x,'macins  ',12x,f10.3)
  800 call getcje
      call second(time2)
      et=time2-time1
      tcost=dble(icost-icost1)/100.0d0
      if (iprnta.eq.0) go to 810
      ohead=et-(rstats(1)+rstats(2)+rstats(3)+rstats(5)+rstats(7)
     1   +rstats(9)+rstats(11))
      write (iofile,801) ohead
  801 format(1h0,9x,'overhead',12x,f10.2)
  810 write (iofile,811) et
  811 format(1h0,9x,'total job time      ',f10.2)
      rstats(33)=cpyknt
      rstats(34)=et
      rstats(35)=tcost
      rstats(36)=ohead
  900 if ((maxtim-itime).ge.limtim) go to 10
      write (iofile,901)
  901 format('1warning:  further analysis stopped due to cpu time limit'
     1/)
 1000 if(nodata.ne.0) write(iofile,1001)
 1001 format(/1x,'input deck (file) contains no data.')
      stop
      end
      subroutine sstf
      implicit double precision (a-h,o-z)
c
c     this routine computes the value of the small-signal transfer
c function specified by the user.
c
c spice version 2g.6  sccsid=tabinf 3/15/83
      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,nsnod,nsmat,nsval,icnod,icmat,icval,
     6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt,
     7   irowno,jcolno,nttbr,nttar,lvntmp
c spice version 2g.6  sccsid=cirdat 3/15/83
      common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
     1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc
c spice version 2g.6  sccsid=status 3/15/83
      common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
     1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon,
     2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile
c spice version 2g.6  sccsid=flags 3/15/83
      common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
     1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof
c spice version 2g.6  sccsid=dc 3/15/83
      common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop,
     1   kinel,kidin,kovar,kidout
c spice version 2g.6  sccsid=blank 3/15/83
      common /blank/ value(50000)
      integer nodplc(64)
      complex cvalue(32)
      equivalence (value(1),nodplc(1),cvalue(1))
c
c
      dimension string(5),save(3)
      data aslash, ablnk / 1h/, 1h  /
c
c  setup current vector for input resistance and transfer function
c
      call zero8(value(lvn+1),nstop)
      if (kidin.eq.10) go to 5
c...  voltage source input
      iptri=nodplc(kinel+6)
      value(lvn+iptri)=+1.0d0
      go to 20
c...  current source input
    5 noposi=nodplc(kinel+2)
      nonegi=nodplc(kinel+3)
      value(lvn+noposi)=-1.0d0
      value(lvn+nonegi)=+1.0d0
c
c  lu decompose and solve the system of circuit equations
c
c...  reorder the right-hand side
   20 call dcdcmp
      call dcsol
      value(lvn+1)=0.0d0
      do 25 i=1,nstop
      j=nodplc(icswpr+i)
      k=nodplc(irswpf+j)
      value(lvntmp+i)=value(lvn+k)
   25 continue
      call copy8(value(lvntmp+1),value(lvn+1),nstop)
c
c  evaluate transfer function
c
      if (nodplc(kovar+5).ne.0) go to 30
c...  voltage output
      noposo=nodplc(kovar+2)
      nonego=nodplc(kovar+3)
      trfn=value(lvn+noposo)-value(lvn+nonego)
      go to 40
c...  current output (through voltage source)
   30 iptro=nodplc(kovar+2)
      iptro=nodplc(iptro+6)
      trfn=value(lvn+iptro)
c
c  evaluate input resistance
c
   40 if (kidin.eq.9) go to 50
c...  current source input
      zin=value(lvn+nonegi)-value(lvn+noposi)
      go to 70
c...  voltage source input
   50 creal=value(lvn+iptri)
      if (dabs(creal).ge.1.0d-20) go to 60
      zin=1.0d20
      go to 70
   60 zin=-1.0d0/creal
c
c  setup current vector for output resistance
c
   70 call zero8(value(lvn+1),nstop)
      if (nodplc(kovar+5).ne.0) go to 80
c...  voltage output
      value(lvn+noposo)=-1.0d0
      value(lvn+nonego)=+1.0d0
      go to 90
   80 if (nodplc(kovar+2).ne.kinel) go to 85
      zout=zin
      go to 200
c...  current output (through voltage source)
   85 value(lvn+iptro)=+1.0d0
c
c  perform new forward and backward substitution
c
c...  reorder the right-hand side
   90 call dcsol
      value(lvn+1)=0.0d0
      do 95 i=1,nstop
      j=nodplc(icswpr+i)
      k=nodplc(irswpf+j)
      value(lvntmp+i)=value(lvn+k)
   95 continue
      call copy8(value(lvntmp+1),value(lvn+1),nstop)
c
c  evaluate output resistance
c
  100 if (nodplc(kovar+5).ne.0) go to 110
c...  voltage output
      zout=value(lvn+nonego)-value(lvn+noposo)
      go to 200
c...  current output (through voltage source)
  110 creal=value(lvn+iptro)
      if (dabs(creal).ge.1.0d-20) go to 120
      zout=1.0d20
      go to 200
  120 zout=-1.0d0/creal
c
c  print results
c
  200 do 210 i=1,5
      string(i)=ablnk
  210 continue
      ipos=1
      call outnam(kovar,1,string,ipos)
      call copy8(string,save,3)
      call move(string,ipos,aslash,1,1)
      ipos=ipos+1
      locv=nodplc(kinel+1)
      anam=value(locv)
      call move(string,ipos,anam,1,8)
      write (iofile,231) string,trfn,anam,zin,save,zout
  231 format(////,'0****     small-signal characteristics'//,
     1   1h0,5x,5a8,3h = ,1pd10.3,/,
     2   1h0,5x,'input resistance at ',a8,12x,3h = ,d10.3,/,
     3   1h0,5x,'output resistance at ',2a8,a3,3h = ,d10.3)
      return
      end
      subroutine subckt
      implicit double precision (a-h,o-z)
c
c     this routine drives the expansion of subcircuit calls.
c
c spice version 2g.6  sccsid=tabinf 3/15/83
      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,nsnod,nsmat,nsval,icnod,icmat,icval,
     6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt,
     7   irowno,jcolno,nttbr,nttar,lvntmp
c spice version 2g.6  sccsid=cirdat 3/15/83
      common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
     1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc
c spice version 2g.6  sccsid=flags 3/15/83
      common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
     1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof
c spice version 2g.6  sccsid=blank 3/15/83
      common /blank/ value(50000)
c spice version 2g.6  sccsid=status 3/15/83
      common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
     1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon,
     2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile
      integer nodplc(64)
      complex 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(dble(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 (iofile,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 (iofile,261) asnam
  261 format('0*error*:  subcircuit ',a8,' is defined recursively'/)
      nogo=1
c
c  finished
c
  300 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
c spice version 2g.6  sccsid=blank 3/15/83
      common /blank/ value(50000)
      integer nodplc(64)
      complex 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 swapij(i1,i2,j1,j2)
      implicit double precision (a-h,o-z)
c spice version 2g.6  sccsid=tabinf 3/15/83
      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,nsnod,nsmat,nsval,icnod,icmat,icval,
     6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt,
     7   irowno,jcolno,nttbr,nttar,lvntmp
c spice version 2g.6  sccsid=blank 3/15/83
      common /blank/ value(50000)
      integer nodplc(64)
      complex cvalue(32)
      equivalence (value(1),nodplc(1),cvalue(1))
c
c     swap rows i1 and i2
c
      loc1=nodplc(jcpt+i1)
      loc2=nodplc(jcpt+i2)
      nodplc(jcpt+i1)=loc2
      nodplc(jcpt+i2)=loc1
c
c     check if end of row
c
    5 if (loc1.le.0.and.loc2.le.0) go to 80
c
c     check swap type
c
      if (loc1.eq.0) go to 20
      if (loc2.eq.0) go to 10
      if (nodplc(jcolno+loc1)-nodplc(jcolno+loc2)) 10,15,20
   10 ktype=-1
      j=nodplc(jcolno+loc1)
      go to 25
   15 ktype=0
      j=nodplc(jcolno+loc1)
      go to 25
   20 ktype=1
      j=nodplc(jcolno+loc2)
c
c     find pointer to entry (i1,j)
c
   25 loc=j
   30 lsav1=loc
      loc=nodplc(irpt+loc)
      if (loc.eq.0) go to 40
      if ((nodplc(irowno+loc)-i1).lt.0) go to 30
c
c     find pointer to entry (i2,j)
c
   40 loc=j
   45 lsav2=loc
      loc=nodplc(irpt+loc)
      if (loc.eq.0) go to 55
      if ((nodplc(irowno+loc)-i2).lt.0) go to 45
c
c     branch for col j in row i1, in both row i1 and i2, or in row i2
c
   55 if (ktype) 60,70,75
c
c     entry (i1,j)
c
   60 if (lsav1.eq.lsav2) go to 65
      loc=nodplc(irpt+lsav2)
      nodplc(irpt+lsav2)=loc1
      nodplc(irpt+lsav1)=nodplc(irpt+loc1)
      nodplc(irpt+loc1)=loc
   65 nodplc(irowno+loc1)=i2
      loc1=nodplc(jcpt+loc1)
      go to 5
c
c     entries (i1,j) and (i2,j)
c
   70 nodplc(irpt+lsav1)=loc2
      nodplc(irpt+lsav2)=loc1
      loc=nodplc(irpt+loc1)
      nodplc(irpt+loc1)=nodplc(irpt+loc2)
      nodplc(irpt+loc2)=loc
      nodplc(irowno+loc1)=i2
      nodplc(irowno+loc2)=i1
      loc1=nodplc(jcpt+loc1)
      loc2=nodplc(jcpt+loc2)
      go to 5
c
c     entry (i2,j)
c
   75 if (lsav1.eq.lsav2) go to 78
      loc=nodplc(irpt+lsav1)
      nodplc(irpt+lsav1)=loc2
      nodplc(irpt+lsav2)=nodplc(irpt+loc2)
      nodplc(irpt+loc2)=loc
   78 nodplc(irowno+loc2)=i1
      loc2=nodplc(jcpt+loc2)
      go to 5
c
c     swap columns j1 and j2
c
   80 loc1=nodplc(irpt+j1)
      loc2=nodplc(irpt+j2)
      nodplc(irpt+j1)=loc2
      nodplc(irpt+j2)=loc1
c
c     check for end of column
c
   85 if (loc1.le.0.and.loc2.le.0) go to 160
c
c     check swap type
c
      if (loc1.eq.0) go to 100
      if (loc2.eq.0) go to 90
      if (nodplc(irowno+loc1)-nodplc(irowno+loc2)) 90,95,100
   90 ktype=-1
      i=nodplc(irowno+loc1)
      go to 105
   95 ktype=0
      i=nodplc(irowno+loc1)
      go to 105
  100 ktype=1
      i=nodplc(irowno+loc2)
c
c     find pointer to entry (i,j1)
c
  105 loc=i
  110 lsav1=loc
      loc=nodplc(jcpt+loc)
      if (loc.eq.0) go to 120
      if ((nodplc(jcolno+loc)-j1).lt.0) go to 110
c
c     find pointer to entry (i,j2)
c
  120 loc=i
  125 lsav2=loc
      loc=nodplc(jcpt+loc)
      if(loc.eq.0) go to 135
      if ((nodplc(jcolno+loc)-j2).lt.0) go to 125
c
c     branch for row i in col j1, in both col"s j1 and j2, or in col j2
c
  135 if (ktype) 140,150,155
c
c     entry (i,j1)
c
  140 if (lsav1.eq.lsav2) go to 145
      loc=nodplc(jcpt+lsav2)
      nodplc(jcpt+lsav2)=loc1
      nodplc(jcpt+lsav1)=nodplc(jcpt+loc1)
      nodplc(jcpt+loc1)=loc
  145 nodplc(jcolno+loc1)=j2
      loc1=nodplc(irpt+loc1)
      go to 85
c
c     entries (i1,j) and (i2,j)
c
  150 nodplc(jcpt+lsav1)=loc2
      nodplc(jcpt+lsav2)=loc1
      loc=nodplc(jcpt+loc1)
      nodplc(jcpt+loc1)=nodplc(jcpt+loc2)
      nodplc(jcpt+loc2)=loc
      nodplc(jcolno+loc1)=j2
      nodplc(jcolno+loc2)=j1
      loc1=nodplc(irpt+loc1)
      loc2=nodplc(irpt+loc2)
      go to 85
c
c     entry (i,j2)
c
  155 if (lsav1.eq.lsav2) go to 158
      loc=nodplc(jcpt+lsav1)
      nodplc(jcpt+lsav1)=loc2
      nodplc(jcpt+lsav2)=nodplc(jcpt+loc2)
      nodplc(jcpt+loc2)=loc
  158 nodplc(jcolno+loc2)=j1
      loc2=nodplc(irpt+loc2)
      go to 85
  160 return
      end
