spice.f

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)
      REAL TIME1, TIME2
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(1000000)
      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
      IF  (IARGC().GT.0) IPOSTP=IOPRAW()
      MAXMEM=2*1000000
      MAXTIM=1E8
      ICOST=0
      IOFILE=6
C
C  INITIALIZATION
C
      APROG(1)=AHDR1
      APROG(2)=AHDR2
      APROG(3)=AHDR3
      ACHAR=ABLNK
      KEOF=0
      CALL XTIME(ATIME)
      CALL XDATE(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(1H ,9X,'***** JOB ABORTED')
      NODATA=0
      GO TO 320
  305 WRITE (IOFILE,306)
  306 FORMAT (1H ,9X,'***** THIS PARAMETER CHANGE IS ILLEGAL')
  310 WRITE (IOFILE,311)
  311 FORMAT(1H ,/,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(/'   NUMTEM ICVFLG JTRFLG JACFLG INOISE  IDIST   NOGO'/,
     1   2H  ,7I7)
      WRITE (IOFILE,381) RSTATS(20),RSTATS(21),RSTATS(22),RSTATS(23),
     1   RSTATS(26),RSTATS(27)
  381 FORMAT(/'   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(/'   NUMTTP  NUMRTP  NUMNIT  MAXMEM  MEMUSE  COPYKNT',//,
     1   2X,3F8.0,1X,I7,1X,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   1H ,9X,'READIN  ',12X,F10.2/,
     2   1H ,9X,'SETUP   ',12X,F10.2/,
     3   1H ,9X,'TRCURV  ',12X,F10.2,10X,F8.0/,
     4   1H ,9X,'DCAN    ',12X,F10.2,10X,F8.0/,
     5   1H ,9X,'DCDCMP  ',12X,F10.3,10X,F8.0/,
     6   1H ,9X,'DCSOL   ',12X,F10.3/,
     7   1H ,9X,'ACAN    ',12X,F10.2,10X,F8.0/,
     8   1H ,9X,'TRANAN  ',12X,F10.2,10X,F8.0/,
     9   1H ,9X,'OUTPUT  ',12X,F10.2)
      WRITE (IOFILE,402) RSTATS(45),RSTATS(48),RSTATS(47),RSTATS(44),
     1   RSTATS(43)
  402 FORMAT(
     1   1H ,9X,'LOAD    ',12X,F10.3/,
     2   1H ,9X,'CODGEN  ',12X,F10.3,10X,F8.0/,
     3   1H ,9X,'CODEXC  ',12X,F10.3/,
     4   1H ,9X,'MACINS  ',12X,F10.3)
  800 CALL GETCJE
      CALL SECOND(TIME2)
      ET=TIME2-TIME1
      TCOST=DFLOAT(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(1H ,9X,'OVERHEAD',12X,F10.2)
  810 WRITE (IOFILE,811) ET
  811 FORMAT(1H ,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('WARNING:  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.')
      IF (IPOSTP.NE.0) CALL CLSRAW
      STOP
      END
      SUBROUTINE TMPUPD
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE UPDATES THE TEMPERATURE-DEPENDENT PARAMETERS IN THE
C DEVICE MODELS.  IT ALSO UPDATES THE VALUES OF TEMPERATURE-DEPENDENT
C RESISTORS.  THE UPDATED VALUES ARE PRINTED.
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=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=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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C
      DIMENSION TMPTIT(4)
      DATA TMPTIT / 8HTEMPERAT, 8HURE-ADJU, 8HSTED VAL, 8HUES      /
C
C
      REFTMP=27.0D0+CTOK
      TEMP1=VALUE(ITEMPS+ITEMNO-1)+CTOK
      TEMP2=VALUE(ITEMPS+ITEMNO)+CTOK
      XKT=BOLTZ*TEMP2
      OLDVT=VT
      VT=XKT/CHARGE
      OLDEG=EGFET
      EGFET=1.16D0-(7.02D-4*TEMP2*TEMP2)/(TEMP2+1108.0D0)
      ARG=-EGFET/(XKT+XKT)+1.1150877D0/(BOLTZ*(REFTMP+REFTMP))
      RATIO=TEMP2/TEMP1
      RATLOG=DLOG(RATIO)
      RATIO1=RATIO-1.0D0
      DTEMP=TEMP2-REFTMP
      DELT=VALUE(ITEMPS+ITEMNO)-VALUE(ITEMPS+1)
      DELTSQ=DELT*DELT
      FACT2=TEMP2/REFTMP
      XNI=1.45D16*FACT2*DSQRT(FACT2)*DEXP(CHARGE*ARG)
      PBFACT=-2*VT*(1.5D0*DLOG(FACT2)+CHARGE*ARG)
      XKT1=BOLTZ*TEMP1
      VT1=XKT1/CHARGE
      EGFET1=1.16D0-(7.02D-4*TEMP1*TEMP1)/(TEMP1+1108.0D0)
      ARG1=-EGFET1/(XKT1+XKT1)+1.1150877D0/(BOLTZ*(REFTMP+REFTMP))
      FACT1=TEMP1/REFTMP
      PBFAT1=-2*VT1*(1.5D0*DLOG(FACT1)+CHARGE*ARG1)
    5 CALL TITLE(0,LWIDTH,1,TMPTIT)
C
C  RESISTORS
C
      LOC=LOCATE(1)
      ITITLE=0
   10 IF (LOC.EQ.0) GO TO 100
      LOCV=NODPLC(LOC+1)
      TC1=VALUE(LOCV+3)
      TC2=VALUE(LOCV+4)
      IF (TC1.NE.0.0D0) GO TO 20
      IF (TC2.EQ.0.0D0) GO TO 40
   20 IF (ITITLE.NE.0) GO TO 30
      WRITE (IOFILE,21)
   21 FORMAT(//'**** RESISTORS',/,'NAME',8X,'VALUE',//)
      ITITLE=1
   30 RNEW=VALUE(LOCV+2)*(1.0D0+TC1*DELT+TC2*DELTSQ)
      VALUE(LOCV+1)=1.0D0/RNEW
      WRITE (IOFILE,31) VALUE(LOCV),RNEW
   31 FORMAT(1X,A8,1P6D11.3)
   40 LOC=NODPLC(LOC)
      GO TO 10
C
C  DIODE MODEL
C
  100 LOC=LOCATE(21)
      IF (LOC.EQ.0) GO TO 200
      WRITE (IOFILE,101)
  101 FORMAT(//'**** DIODE MODEL PARAMETERS',/,'NAME',9X,'IS',9X,'VJ',
     1   8X,'CJO',//)
  110 IF (LOC.EQ.0) GO TO 200
      LOCV=NODPLC(LOC+1)
C...  IS(T2)=IS(T1)*DEXP(EG/(N*VT)*(T2/T1-1))*(T2/T1)**(XTI/N)
      XN=VALUE(LOCV+3)
      FACTOR=RATIO1*VALUE(LOCV+8)/(XN*VT)+VALUE(LOCV+9)/XN*RATLOG
      FACTOR=DEXP(FACTOR)
      VALUE(LOCV+1)=VALUE(LOCV+1)*FACTOR
      OLDPB=VALUE(LOCV+6)
      PBO=(VALUE(LOCV+6)-PBFAT1)/FACT1
      GMAOLD=(OLDPB-PBO)/PBO
      VALUE(LOCV+5)=VALUE(LOCV+5)/(1.0D0+VALUE(LOCV+7)
     1     *(400.0D-6*(TEMP1-REFTMP)-GMAOLD))
  120 VALUE(LOCV+6)=FACT2*PBO+PBFACT
      GMANEW=(VALUE(LOCV+6)-PBO)/PBO
      VALUE(LOCV+5)=VALUE(LOCV+5)
     1   *(1.0D0+VALUE(LOCV+7)*(400.0D-6*DTEMP-GMANEW))
      PBRAT=VALUE(LOCV+6)/OLDPB
      VALUE(LOCV+12)=VALUE(LOCV+12)*PBRAT
      VALUE(LOCV+15)=VALUE(LOCV+15)*PBRAT
      VTE=VALUE(LOCV+3)*VT
      VALUE(LOCV+18)=VTE*DLOG(VTE/(ROOT2*VALUE(LOCV+1)))
      WRITE (IOFILE,31) VALUE(LOCV),VALUE(LOCV+1),VALUE(LOCV+6),
     1                  VALUE(LOCV+5)
      LOC=NODPLC(LOC)
      GO TO 110
C
C  BIPOLAR TRANSISTOR MODEL
C
  200 LOC=LOCATE(22)
      IF (LOC.EQ.0) GO TO 300
      WRITE (IOFILE,201)
  201 FORMAT(//'**** BJT MODEL PARAMETERS',/,'NAME',9X,'JS',8X,'BF ',
     1   7X,'ISE',7X,'BR ',7X,'ISC',7X,'VJE',7X,'CJE',7X,'VJC',
     2   7X,'CJC',//)
  210 IF (LOC.EQ.0) GO TO 300
      LOCV=NODPLC(LOC+1)
C...  IS(T2)=IS(T1)*DEXP(EG/VT*(T2/T1-1))*(T2/T1)**XTI
      FACTLN=RATIO1*VALUE(LOCV+42)/VT+VALUE(LOCV+43)*RATLOG
      FACTOR=DEXP(FACTLN)
      VALUE(LOCV+1)=VALUE(LOCV+1)*FACTOR
      TB=VALUE(LOCV+41)
      BFACTR=DEXP(TB*RATLOG)
      VALUE(LOCV+2)=VALUE(LOCV+2)*BFACTR
      VALUE(LOCV+8)=VALUE(LOCV+8)*BFACTR
      VALUE(LOCV+6)=VALUE(LOCV+6)*DEXP(FACTLN/VALUE(LOCV+7))/BFACTR
      VALUE(LOCV+12)=VALUE(LOCV+12)*DEXP(FACTLN/VALUE(LOCV+13))
     1               /BFACTR
      OLDPB=VALUE(LOCV+22)
      PBO=(VALUE(LOCV+22)-PBFAT1)/FACT1
      GMAOLD=(OLDPB-PBO)/PBO
      VALUE(LOCV+21)=VALUE(LOCV+21)/(1.0D0+VALUE(LOCV+23)
     1     *(400.0D-6*(TEMP1-REFTMP)-GMAOLD))
  220 VALUE(LOCV+22)=FACT2*PBO+PBFACT
      GMANEW=(VALUE(LOCV+22)-PBO)/PBO
      VALUE(LOCV+21)=VALUE(LOCV+21)
     1   *(1.0D0+VALUE(LOCV+23)*(400.0D-6*DTEMP-GMANEW))
      PBRAT=VALUE(LOCV+22)/OLDPB
      VALUE(LOCV+46)=VALUE(LOCV+46)*PBRAT
      VALUE(LOCV+47)=VALUE(LOCV+47)*PBRAT
      OLDPB=VALUE(LOCV+30)
      PBO=(VALUE(LOCV+30)-PBFAT1)/FACT1
      GMAOLD=(OLDPB-PBO)/PBO
      VALUE(LOCV+29)=VALUE(LOCV+29)/(1.0D0+VALUE(LOCV+31)
     1     *(400.0D-6*(TEMP1-REFTMP)-GMAOLD))
  230 VALUE(LOCV+30)=FACT2*PBO+PBFACT
      GMANEW=(VALUE(LOCV+30)-PBO)/PBO
      VALUE(LOCV+29)=VALUE(LOCV+29)
     1   *(1.0D0+VALUE(LOCV+31)*(400.0D-6*DTEMP-GMANEW))
      PBRAT=VALUE(LOCV+30)/OLDPB
      VALUE(LOCV+50)=VALUE(LOCV+50)*PBRAT
      VALUE(LOCV+51)=VALUE(LOCV+51)*PBRAT
      VALUE(LOCV+54)=VT*DLOG(VT/(ROOT2*VALUE(LOCV+1)))
      WRITE (IOFILE,211) VALUE(LOCV),VALUE(LOCV+1),VALUE(LOCV+2),
     1   VALUE(LOCV+6),VALUE(LOCV+8),VALUE(LOCV+12),VALUE(LOCV+22),
     2   VALUE(LOCV+21),VALUE(LOCV+30),VALUE(LOCV+29)
  211 FORMAT(1X,A8,1P9D10.3)
      LOC=NODPLC(LOC)
      GO TO 210
C
C  JFET MODEL
C
  300 LOC=LOCATE(23)
      IF (LOC.EQ.0) GO TO 400
      WRITE (IOFILE,301)
  301 FORMAT(//'**** JFET MODEL PARAMETERS',/,'NAME',9X,'IS',9X,'PB',
     1   8X,'CGS',8X,'CGD',//)
  310 IF (LOC.EQ.0) GO TO 400
      LOCV=NODPLC(LOC+1)
      VALUE(LOCV+9)=VALUE(LOCV+9)*DEXP(RATIO1*1.11D0/VT)
      OLDPB=VALUE(LOCV+8)
      PBO=(VALUE(LOCV+8)-PBFAT1)/FACT1
      GMAOLD=(OLDPB-PBO)/PBO
      OLDCJF=1.0D0+0.5D0*(400.0D-6*(TEMP1-REFTMP)-GMAOLD)
      VALUE(LOCV+6)=VALUE(LOCV+6)/OLDCJF
      VALUE(LOCV+7)=VALUE(LOCV+7)/OLDCJF
  320 VALUE(LOCV+8)=FACT2*PBO+PBFACT
      GMANEW=(VALUE(LOCV+8)-PBO)/PBO
      CJFACT=1.0D0+0.5D0*(400.0D-6*DTEMP-GMANEW)
      VALUE(LOCV+6)=VALUE(LOCV+6)*CJFACT
      VALUE(LOCV+7)=VALUE(LOCV+7)*CJFACT
      PBRAT=VALUE(LOCV+8)/OLDPB
      VALUE(LOCV+12)=VALUE(LOCV+12)*PBRAT
      VALUE(LOCV+13)=VALUE(LOCV+13)*PBRAT
      VALUE(LOCV+16)=VT*DLOG(VT/(ROOT2*VALUE(LOCV+9)))
      WRITE (IOFILE,31) VALUE(LOCV),VALUE(LOCV+9),VALUE(LOCV+8),
     1   VALUE(LOCV+6),VALUE(LOCV+7)
      LOC=NODPLC(LOC)
      GO TO 310
C
C  MOSFET MODEL
C
  400 LOC=LOCATE(24)
      IPRNT=1
  410 IF (LOC.EQ.0) GO TO 1000
      LOCV=NODPLC(LOC+1)
      TYPE=NODPLC(LOC+2)
      IF(IPRNT.NE.0) WRITE (IOFILE,401)
  401 FORMAT(//'**** MOSFET MODEL PARAMETERS',/,'NAME',8X,'VTO',8X,
     1   'PHI',9X,'PB',7X,'IS(JS)',7X,'KP',9X,'UO'//)
      IPRNT=0
      RATIO4=RATIO*DSQRT(RATIO)
      VALUE(LOCV+3)=VALUE(LOCV+3)/RATIO4
      VALUE(LOCV+29)=VALUE(LOCV+29)/RATIO4
      OLDPHI=VALUE(LOCV+5)
      PHIO=(VALUE(LOCV+5)-PBFAT1)/FACT1
  415 VALUE(LOCV+5)=FACT2*PHIO+PBFACT
      PHI=VALUE(LOCV+5)
      VFB=VALUE(LOCV+44)-TYPE*0.5D0*OLDPHI
      VFB=VFB+0.5D0*(OLDEG-EGFET)
      VALUE(LOCV+44)=VFB+TYPE*0.5D0*PHI
      VALUE(LOCV+2)=VALUE(LOCV+44)+TYPE*VALUE(LOCV+4)*DSQRT(PHI)
      VALUE(LOCV+11)=VALUE(LOCV+11)*DEXP(-EGFET/VT+OLDEG/OLDVT)
      VALUE(LOCV+21)=VALUE(LOCV+21)*DEXP(-EGFET/VT+OLDEG/OLDVT)
      OLDPB=VALUE(LOCV+12)
      PBO=(VALUE(LOCV+12)-PBFAT1)/FACT1
      GMAOLD=(OLDPB-PBO)/PBO
      COEOLD=1.0D0+VALUE(LOCV+18)*(400.0D-6*(TEMP1-REFTMP)-GMAOLD)
      VALUE(LOCV+9)=VALUE(LOCV+9)/COEOLD
      VALUE(LOCV+10)=VALUE(LOCV+10)/COEOLD
      VALUE(LOCV+17)=VALUE(LOCV+17)/COEOLD
      VALUE(LOCV+19)=VALUE(LOCV+19)/(1.0D0+VALUE(LOCV+20)
     1     *(400.0D-6*(TEMP1-REFTMP)-GMAOLD))
  420 VALUE(LOCV+12)=FACT2*PBO+PBFACT
      GMANEW=(VALUE(LOCV+12)-PBO)/PBO
      COENEW=1.0D0+VALUE(LOCV+18)*(400.0D-6*DTEMP-GMANEW)
      VALUE(LOCV+9)=VALUE(LOCV+9)*COENEW
      VALUE(LOCV+10)=VALUE(LOCV+10)*COENEW
      VALUE(LOCV+17)=VALUE(LOCV+17)*COENEW
      VALUE(LOCV+19)=VALUE(LOCV+19)*
     1   (1.0D0+VALUE(LOCV+20)*(400.0D-6*DTEMP-GMANEW))
      PBRAT=VALUE(LOCV+12)/OLDPB
      VALUE(LOCV+37)=VALUE(LOCV+37)*PBRAT
      VALUE(LOCV+38)=VALUE(LOCV+38)*PBRAT
      CSAT=DMAX1(VALUE(LOCV+11),VALUE(LOCV+21))
      WRITE (IOFILE,31) VALUE(LOCV),VALUE(LOCV+2),VALUE(LOCV+5),
     1   VALUE(LOCV+12),CSAT,VALUE(LOCV+3),VALUE(LOCV+29)
  430 LOC=NODPLC(LOC)
      GO TO 410
C
C  FINISHED
C
 1000 RETURN
      END
      SUBROUTINE FIND(ANAME,ID,LOC,IFORCE)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE SEARCHES THE LIST WITH NUMBER 'ID' FOR AN ELEMENT
C WITH NAME 'ANAME'.  LOC IS SET TO POINT TO THE ELEMENT.  IF IFORCE IS
C NONZERO, THEN FIND EXPECTS TO HAVE TO ADD THE ELEMENT TO THE LIST, AND
C REPORTS A FATAL ERROR IF THE ELEMENT IS FOUND.  IF SUBCIRCUIT DEFINI-
C TION IS IN PROGRESS (NONZERO VALUE FOR NSBCKT), THEN FIND SEARCHES THE
C CURRENT SUBCIRCUIT DEFINITION LIST RATHER THAN THE NOMINAL ELEMENT
C LIST.
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=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=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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C  INDEX TO THE CONTENTS OF THE VARIOUS LISTS:
C
C        LIST      CONTENTS
C        ----      --------
C
C          1       RESISTORS
C          2       NONLINEAR CAPACITORS
C          3       NONLINEAR INDUCTORS
C          4       MUTUAL INDUCTORS
C          5       NONLINEAR VOLTAGE CONTROLLED CURRENT SOURCES
C          6       NONLINEAR VOLTAGE CONTROLLED VOLTAGE SOURCES
C          7       NONLINEAR CURRENT CONTROLLED CURRENT SOURCES
C          8       NONLINEAR CURRENT CONTROLLED VOLTAGE SOURCES
C          9       INDEPENDENT VOLTAGE SOURCES
C         10       INDEPENDENT CURRENT SOURCES
C         11       DIODES
C         12       BIPOLAR JUNCTION TRANSISTORS
C         13       JUNCTION FIELD-EFFECT TRANSISTORS (JFETS)
C         14       METAL-OXIDE-SEMICONDUCTOR JUNCTION FETS (MOSFETS)
C         15       S-PARAMETER 2-PORT NETWORK
C         16       Y-PARAMETER 2-PORT NETWORK
C         17       TRANSMISSION LINES
C         18       USED FOR TEMPERATURE SWEEPING
C         19       SUBCIRCUIT CALLS
C         20       SUBCIRCUIT DEFINITIONS
C         21       DIODE MODEL
C         22       BJT MODEL
C         23       JFET MODEL
C         24       MOSFET MODEL
C      25-30       <UNUSED>
C         31       .PRINT DC
C         32       .PRINT TRAN
C         33       .PRINT AC
C         34       .PRINT NOISE
C         35       .PRINT DISTORTION
C         36       .PLOT DC
C         37       .PLOT TR
C         38       .PLOT AC
C         39       .PLOT NOISE
C         40       .PLOT DISTORTION
C         41       OUTPUTS FOR DC
C         42       OUTPUTS FOR TRANSIENT
C         43       OUTPUTS FOR AC
C         44       OUTPUTS FOR NOISE
C         45       OUTPUTS FOR DISTORTION
C      46-50       <UNUSED>
C
      INTEGER XXOR
      DIMENSION LNOD(50),LVAL(50)
      DATA LNOD /10,14,16, 8,15,16,15,16,13, 8,
     1           18,38,27,35, 8, 8,35, 5, 5, 5,
     2            5, 5, 5, 5, 0, 0, 0, 0, 0, 0,
     3           21,21,21,21,21,21,21,21,21,21,
     4            8, 8, 8, 8, 8, 0, 0, 0, 0, 0 /
      DATA LVAL / 5, 4, 4, 2, 1, 1, 1, 1, 4, 4,
     1            3, 4, 4,16, 1, 1, 9, 2, 1, 1,
     2           19,55,17,46, 0, 0, 0, 0, 0, 0,
     3            1, 1, 1, 1, 1,17,17,17,17,17,
     4            1, 1, 1, 1, 1, 0, 0, 0, 0, 0 /
      DATA NDEFIN /2H.U/
C
C
      ANAM=ANAME
      CALL SIZMEM(IELMNT,ISIZE)
      LOCN=IELMNT+ISIZE+2
      IF (NSBCKT.EQ.0) GO TO 10
      LOCT=NODPLC(ISBCKT+NSBCKT)
      LOC=NODPLC(LOCT+3)
      IF (LOC.NE.0) GO TO 20
      NODPLC(LOCT+3)=LOCN
      GO TO 60
   10 LOC=LOCATE(ID)
      IF (LOC.NE.0) GO TO 20
      LOCATE(ID)=LOCN
      GO TO 50
C
C  SEARCH LIST FOR A NAME MATCH
C
   20 LOCV=NODPLC(LOC+1)
      IF (XXOR(ANAM,VALUE(LOCV)).NE.0) GO TO 30
      IF (NUMALT.NE.0) GO TO 30
      IF (NSBCKT.EQ.0) GO TO 25
      IF (NODPLC(LOC-1).NE.ID) GO TO 30
   25 IF (NODPLC(LOC+2).EQ.NDEFIN) GO TO 200
      IF (IFORCE.EQ.0) GO TO 200
      WRITE (IOFILE,26) ANAM
   26 FORMAT('*ERROR*:  ABOVE LINE ATTEMPTS TO REDEFINE ',A8/)
      NOGO=1
   30 IF (NODPLC(LOC).EQ.0) GO TO 40
      LOC=NODPLC(LOC)
      GO TO 20
C
C  RESERVE SPACE FOR THIS ELEMENT
C
   40 NODPLC(LOC)=LOCN
      IF (NSBCKT.NE.0) GO TO 60
   50 IF (NUMALT.EQ.0) JELCNT(ID)=JELCNT(ID)+1
   60 LOC=LOCN
      ITEMP=LOC+LNOD(ID)*NWD4-1
      LOCV=NXTEVN(ITEMP-1)+1
      ITEMP=LOCV-ITEMP
      KTMP=LNOD(ID)*NWD4+LVAL(ID)*NWD8+ITEMP
      CALL EXTMEM(IELMNT,KTMP)
      LOCV=(LOCV-1)/NWD8+1
      IPTR=0
      IF (NSBCKT.EQ.0) GO TO 80
      IPTR=ID
   80 IF (ID.LE.24) NODPLC(LOC+LNOD(ID)-2)=NUMALT
      NODPLC(LOC-1)=IPTR
      NODPLC(LOC)=0
      NODPLC(LOC+1)=LOCV
      VALUE(LOCV)=ANAM
C
C  BACKGROUND STORAGE
C
  100 NODPLC(LOC+2)=NDEFIN
      NWORD=LNOD(ID)-4
      IF (ID.LE.24) NWORD=NWORD-1
      IF (NWORD.LT.1) GO TO 120
      CALL ZERO4(NODPLC(LOC+3),NWORD)
  120 NWORD=LVAL(ID)-1
      IF (NWORD.LT.1) GO TO 200
      CALL ZERO8(VALUE(LOCV+1),NWORD)
      IF ((ID.GE.21).AND.(ID.LE.24)) CALL UNDEFI(VALUE(LOCV+1),NWORD)
C
C  EXIT
C
  200 RETURN
      END
      SUBROUTINE ALTER
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE CHANGES THE ELEMENT OR DEVICE PARAMETERS
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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
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))
      LOGICAL MEMPTR
C
      INTEGER XXOR
      DIMENSION LNOD(50),LVAL(50)
      DIMENSION CHTITL(4)
      DATA CHTITL / 8HCHANGE F,8HOLLOWING,8H PARAMET,8HERS     /
      DATA LNOD /10,14,16, 8,15,16,15,16,13, 8,
     1           18,38,27,35, 8, 8,35, 5, 5, 5,
     2            5, 5, 5, 5, 0, 0, 0, 0, 0, 0,
     3           21,21,21,21,21,21,21,21,21,21,
     4            8, 8, 8, 8, 8, 0, 0, 0, 0, 0 /
      DATA LVAL / 5, 4, 4, 2, 1, 1, 1, 1, 4, 4,
     1            3, 4, 4,16, 1, 1, 9, 2, 1, 1,
     2           19,55,17,46, 0, 0, 0, 0, 0, 0,
     3            1, 1, 1, 1, 1,17,17,17,17,17,
     4            1, 1, 1, 1, 1, 0, 0, 0, 0, 0 /
C
      CALL TITLE (0,LWIDTH,1,CHTITL)
      DO 350 ID=1,24
      LOC=LOCATE(ID)
   10 IF (LOC.EQ.0) GO TO 350
      IF (NODPLC(LOC+LNOD(ID)-2).NE.NUMCYC) GO TO 300
      LOCV=NODPLC(LOC+1)
      LOC1=LOCATE(ID)
   50 IF (LOC1.EQ.0) GO TO 400
      IF (NODPLC(LOC1+LNOD(ID)-2).NE.0) GO TO 400
      LOCV1=NODPLC(LOC1+1)
      IF (XXOR(VALUE(LOCV),VALUE(LOCV1)).EQ.0) GO TO 100
      LOC1=NODPLC(LOC1)
      GO TO 50
C
C  COPY CHANGED VALUES TO THE ORIGINAL TABLES
C
C  COPY REAL PART
C
  100 CALL COPY8(VALUE(LOCV),VALUE(LOCV1),LVAL(ID))
      WRITE (IOFILE,110) VALUE(LOCV1)
  110 FORMAT ('********      ',A8,'      ********')
C
C  TREAT NON-NODE TABLES SPECIALLY
C
  200 IF (ID.GE.11) GO TO 300
      GO TO (300,210,220,300,230,240,230,240,260,260), ID
  210 IF (NODPLC(LOC+4).EQ.1) GO TO 300
      IF (MEMPTR(NODPLC(LOC1+7))) CALL CLRMEM(NODPLC(LOC1+7))
      CALL CPYTB8(LOC+7,LOC1+7)
      GO TO 300
  220 IF (NODPLC(LOC+4).EQ.1) GO TO 300
      IF (MEMPTR(NODPLC(LOC1+10))) CALL CLRMEM(NODPLC(LOC1+10))
      CALL CPYTB8(LOC+10,LOC1+10)
      GO TO 300
  230 ITAB=5
      GO TO 250
  240 ITAB=6
  250 IF (ID.LE.6) GO TO 255
      IF (MEMPTR(NODPLC(LOC1+ITAB+1))) CALL CLRMEM(NODPLC(LOC1+ITAB+1))
      CALL CPYTB4(LOC+ITAB+1,LOC1+ITAB+1)
  255 IF (MEMPTR(NODPLC(LOC1+ITAB+2))) CALL CLRMEM(NODPLC(LOC1+ITAB+2))
      CALL CPYTB4(LOC+ITAB+2,LOC1+ITAB+2)
      IF (MEMPTR(NODPLC(LOC1+ITAB+3))) CALL CLRMEM(NODPLC(LOC1+ITAB+3))
      CALL CPYTB8(LOC+ITAB+3,LOC1+ITAB+3)
      IF (MEMPTR(NODPLC(LOC1+ITAB+4))) CALL CLRMEM(NODPLC(LOC1+ITAB+4))
      CALL CPYTB8(LOC+ITAB+4,LOC1+ITAB+4)
      IF (MEMPTR(NODPLC(LOC1+ITAB+5))) CALL CLRMEM(NODPLC(LOC1+ITAB+5))
      CALL CPYTB4(LOC+ITAB+5,LOC1+ITAB+5)
      IF (MEMPTR(NODPLC(LOC1+ITAB+6))) CALL CLRMEM(NODPLC(LOC1+ITAB+6))
      CALL CPYTB8(LOC+ITAB+6,LOC1+ITAB+6)
      GO TO 300
  260 IF (MEMPTR(NODPLC(LOC1+5))) CALL CLRMEM(NODPLC(LOC1+5))
      CALL CPYTB8(LOC+5,LOC1+5)
C
  300 LOC=NODPLC(LOC)
      GO TO 10
  350 CONTINUE
      WRITE (IOFILE,360)
  360 FORMAT (//)
      GO TO 500
C
  400 WRITE (IOFILE,401) VALUE(NODPLC(LOC1+1))
  401 FORMAT ('*ERROR*:  PARAMETER CHANGE FAILED',/,
     1        '*******:  ',A8,' IS NOT IN THE ORIGINAL CIRCUIT')
      NOGO=1
C
  500 RETURN
      END
      SUBROUTINE TITLE(IFOLD,LEN,ICOM,COMENT)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE WRITES A TITLE ON THE OUTPUT FILE.  IFOLD INDICATES
C WHETHER THE PAGE EJECT SHOULD BE TO THE NEXT CONCAVE, CONVEX, OR ANY
C PAGE FOLD DEPENDING ON WHETHER ITS VALUE IS <0, >0, OR =0.  THE PAGE
C EJECT IS SUPPRESSED (AS IS MUCH OF THE HEADING) IF THE VARIABLE NOPAGE
C IS NONZERO.
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=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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C
      DIMENSION COMENT(4)
C
C
      IF(NOPAGE.EQ.1) GO TO 150
C
   30 IF (LEN.LE.80) GO TO 100
      WRITE (IOFILE,31) ADATE,APROG,ATIME,(ATITLE(I),I=1,10)
   31 FORMAT(15(1H*),1X,A8,1X,24(1H*),3A8,24(1H*),1X,A8,1X,
     1   15(1H*),//,15A8/)
      IF (ICOM.EQ.0) GO TO 40
      WRITE (IOFILE,36) COMENT,VALUE(ITEMPS+ITEMNO)
   36 FORMAT(5H*****,17X,4A8,21X,'TEMPERATURE =',F9.3,' DEG C'/)
   40 WRITE (IOFILE,41)
   41 FORMAT(1H*,121(1H*)//)
      GO TO 200
C
C
  100 WRITE (IOFILE,101) ADATE,APROG,ATIME,(ATITLE(I),I=1,10)
  101 FORMAT(8(1H*),1X,A8,1X,8(1H*),3A8,8(1H*),1X,A8,1X,4(1H*)//10A8/)
      IF (ICOM.EQ.0) GO TO 110
      WRITE (IOFILE,106) COMENT,VALUE(ITEMPS+ITEMNO)
  106 FORMAT(10H*****     ,4A8,' TEMPERATURE =',F9.3,' DEG C'/)
  110 WRITE (IOFILE,111)
  111 FORMAT(1H*,71(1H*)//)
      GO TO 200
C
C
  150 IF (ICOM.EQ.0) GO TO 160
      WRITE (IOFILE,106) COMENT,VALUE(ITEMPS+ITEMNO)
      GO TO 200
  160 WRITE (IOFILE,161) APROG
  161 FORMAT(1X,3A8,/)
C
C  FINISHED
C
  200 RETURN
      END
      SUBROUTINE DCDCMP
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      REAL T1, T2
C
C     THIS ROUTINE SWAPS ROWS AND COLUMNS IN THE COEFFICIENT MATRIX ACCOR-
C DING TO THE NUMERICAL PIVOTING AND MINIMUM FILLIN TERMS.IT THEN PERFORMS
C AN IN-PLACE LU FACTORIZATION OF THE COEFFICIENT MATRIX.
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=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=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=DEBUG 3/15/83
      COMMON/DEBUG/ IDEBUG(20)
C SPICE VERSION 2G.6  SCCSID=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
      CALL SECOND(T1)
      IF (IPIV.LE.0) GO TO 12
      IF (IDEBUG(11).LE.0) GO TO  3
      CALL DMPMAT(6HDCDCMP)
      IDEBUG(11)=IDEBUG(11)-1
    3 DO 10 I=2,NSTOP
      NO=0
      LOC=NODPLC(JCPT+I)
    5 IF (LOC.EQ.0) GO TO 7
      NO=NO+1
      LOC=NODPLC(JCPT+LOC)
      GO TO 5
    7 NODPLC(NUMOFF+I)=NO
      NO=0
      LOC=NODPLC(IRPT+I)
    8 IF (LOC.EQ.0) GO TO 9
      NO=NO+1
      LOC=NODPLC(IRPT+LOC)
      GO TO 8
    9 NODPLC(NMOFFC+I)=NO
   10 CONTINUE
   12 N=1
C
C     FIND NEXT PIVOT
C
   15 N=N+1
      IF (IPIV.GT.0) GO TO 20
      IF (IDEBUG(13).LE.0) GO TO 17
      CALL DMPMAT(6HDCDCM2)
      IDEBUG(13)=IDEBUG(13)-1
   17 IF (IDEBUG(14).LE.0) GO TO 18
      IF (MODE.NE.2) GO TO 18
      CALL DMPMAT(6HDCDCM3)
      IDEBUG(14)=IDEBUG(14)-1
   18 IF (IDEBUG(15).LE.0.OR.ICALC.LE.10) GO TO 19
      CALL DMPMAT(6HDCDCM4)
      IDEBUG(15)=IDEBUG(15)-1
   19 NXTI=N
      NXTJ=N
      GO TO 120
C
C     SEARCH THE CORESPONDING COLUMN FOR MAX ENTRY
C
   20 VMAX=0.0D0
      LOCI=N
   25 LOCI=NODPLC(IRPT+LOCI)
      IF (LOCI.EQ.0) GO TO 50
      I=NODPLC(IROWNO+LOCI)
      IF (I.LT.N) GO TO 25
   30 IF (DABS(VALUE(LVN+LOCI)).LE.VMAX) GO TO 25
      VMAX=DABS(VALUE(LVN+LOCI))
      GO TO 25
   50 IF (VMAX.GT.PIVTOL) GO TO 60
      WRITE(IOFILE,51) N,VMAX
   51 FORMAT('*ERROR*:  MAXIMUM ENTRY IN THIS COLUMN AT STEP ',I4,' (',
     1   1PD13.6,') IS LESS THAN PIVTOL')
      IGOOF=1
      RETURN
   60 EPSREL=DMAX1(PIVREL*VMAX,PIVTOL)
      IF (N.GE.NSTOP) GO TO 200
      IF (IPIV.LE.0) GO TO 120
C
C     PIVOTING ON THE DIAGONAL
C
      MINOP=100000
      NXTI=0
      DO 70 I=N,NSTOP
      I1=NODPLC(IRSWPF+I)
      J1=NODPLC(ICSWPF+I)
      ISPOT=INDXX(I1,J1)
      IF (ISPOT.EQ.1) GO TO 70
      IF (DABS(VALUE(LVN+ISPOT)).LT.EPSREL) GO TO 70
      NOP=(NODPLC(NUMOFF+I)-1)*(NODPLC(NMOFFC+I)-1)
      IF (NOP.GE.MINOP) GO TO 70
      MINOP=NOP
      NXTI=I
      NXTJ=I
      IF (MINOP.LE.0) GO TO 95
   70 CONTINUE
      IF (NXTI.LE.0) GO TO 75
      IF (NXTI-N) 120,120,100
C
C     PIVOTING ON THE ENTIRE MATRIX
C
   75 DO 90 I=N,NSTOP
      LOC=I
   80 LOC=NODPLC(JCPT+LOC)
      IF (LOC.EQ.0) GO TO 90
      J=NODPLC(JCOLNO+LOC)
      IF (J.LT.N) GO TO 80
      IF (DABS(VALUE(LVN+LOC)).LT.EPSREL) GO TO 80
      NOP=(NODPLC(NUMOFF+I)-1)*(NODPLC(NMOFFC+J)-1)
      IF (NOP.GE.MINOP) GO TO 80
      MINOP=NOP
      NXTI=I
      NXTJ=J
      IF (MINOP.LE.0) GO TO 95
   90 CONTINUE
      IF (NXTI.GT.0) GO TO 95
      WRITE (IOFILE,92)
   92 FORMAT('*ABORT*:  PIVOT NOT IN DCDCMP')
      IGOOF=1
      GO TO 200
   95 IF (NXTI.EQ.N.AND.NXTJ.EQ.N) GO TO 120
      IF (NXTI.EQ.N) GO TO 105
C
C     A PIVOT HAS BEEN FOUND
C
  100 LOAD=NODPLC(IRSWPF+NXTI)
      LR=NODPLC(IRSWPF+N)
      NODPLC(IRSWPF+NXTI)=LR
      NODPLC(IRSWPR+LR)=NXTI
      NODPLC(IRSWPF+N)=LOAD
      NODPLC(IRSWPR+LOAD)=N
      NOFF=NODPLC(NUMOFF+NXTI)
      NODPLC(NUMOFF+NXTI)=NODPLC(NUMOFF+N)
      NODPLC(NUMOFF+N)=NOFF
      IF (NXTJ.EQ.N) GO TO 110
  105 LOAD=NODPLC(ICSWPF+NXTJ)
      LC=NODPLC(ICSWPF+N)
      NODPLC(ICSWPF+NXTJ)=LC
      NODPLC(ICSWPR+LC)=NXTJ
      NODPLC(ICSWPF+N)=LOAD
      NODPLC(ICSWPR+LOAD)=N
      NOFF=NODPLC(NMOFFC+NXTJ)
      NODPLC(NMOFFC+NXTJ)=NODPLC(NMOFFC+N)
      NODPLC(NMOFFC+N)=NOFF
  110 CALL SWAPIJ(NXTI,N,NXTJ,N)
      NXTI=N
      NXTJ=N
C
C     CALCULATE CONTRIBUTION FROM NXTI, NXTJ AND FIND FILL-INS
C
  120 IF (N.GE.NSTOP) GO TO 200
      N1=NODPLC(IRSWPF+NXTI)
      N2=NODPLC(ICSWPF+NXTJ)
      LOCNN=INDXX(N1,N2)
      IF (IPIV.LE.0 .AND. DABS(VALUE(LVN+LOCNN)).LT.PIVTOL) GO TO 220
C
C     DOWN COL J
C
      LOCR=NODPLC(IRPT+LOCNN)
  125 IF (LOCR.EQ.0) GO TO 180
      I=NODPLC(IROWNO+LOCR)
      VALUE(LVN+LOCR)=VALUE(LVN+LOCR)/VALUE(LVN+LOCNN)
      LOCC=NODPLC(JCPT+LOCNN)
C
C     FOR EACH COLUMN ELEMENT LOOK UP ROW NXTI
C
  130 IF (LOCC.EQ.0) GO TO 170
      J=NODPLC(JCOLNO+LOCC)
C
C     CHECK FOR FILL-IN (I,J)
C
      IF (IPIV.LE.0) GO TO 135
      CALL SIZMEM(JCPT,ISIZE1)
      CALL RESERV(I,J)
      CALL SIZMEM(JCPT,ISIZE2)
      IF (ISIZE1.EQ.ISIZE2) GO TO 135
      CALL EXTMEM(LVN,1)
      NTTBR=NTTBR+1
      VALUE(LVN+NSTOP+NTTBR)=0.0D0
C
C     LOCATE ELEMENT (I,J)
C
  135 IF (J.LT.I) GO TO 145
      LOCIJ=LOCC
  140 LOCIJ=NODPLC(IRPT+LOCIJ)
      IF (NODPLC(IROWNO+LOCIJ).EQ.I) GO TO 155
      GO TO 140
  145 LOCIJ=LOCR
  150 LOCIJ=NODPLC(JCPT+LOCIJ)
      IF (NODPLC(JCOLNO+LOCIJ).EQ.J) GO TO 155
      GO TO 150
  155 VALUE(LVN+LOCIJ)=VALUE(LVN+LOCIJ)-
     1                  VALUE(LVN+LOCC)*VALUE(LVN+LOCR)
  160 LOCC=NODPLC(JCPT+LOCC)
      GO TO 130
  170 LOCR=NODPLC(IRPT+LOCR)
      IF (IPIV.LE.0) GO TO 125
      NODPLC(NUMOFF+I)=NODPLC(NUMOFF+I)-1
      GO TO 125
C
C     REDUCE NMOFFC FOR EACH ELEMENT IN COL NXTI
C
  180 IF (IPIV.LE.0) GO TO 15
      LOCC=NODPLC(JCPT+LOCNN)
  185 IF (LOCC.EQ.0) GO TO 15
      J=NODPLC(JCOLNO+LOCC)
      NODPLC(NMOFFC+J)=NODPLC(NMOFFC+J)-1
      LOCC=NODPLC(JCPT+LOCC)
      GO TO 185
C
C     DONE
C
  200 IF (IPIV.EQ.0) GO TO 210
      IF (IDEBUG(17).LE.0) GO TO 202
      CALL DMPMAT(6HDCDCM5)
      IDEBUG(17)=IDEBUG(17)-1
  202 CALL MATLOC
      RSTATS(49)=RSTATS(49)+1.0D0
      IPIV=0
      IF (LVLCOD.EQ.2) LVLCOD=3
      IFILL=NTTBR-NTTAR
      PERSPA=100.0D0*(1.0D0-DFLOAT(NTTBR)/DFLOAT(NSTOP*NSTOP))
C
C  CALCULATION OF OPERATION COUNT (OPERATION := `*' or `/'):
C
C     NOFFR := OFF-DIAGONAL ELEMENTS IN ROW, NOT INCLUDING DIAGONAL,
C                COUNTING ONLY THOSE ELEMENTS IN THE REMAINDER MATRIX
C     NOFFC := OFF-DIAGONAL ELEMENTS IN COLUMN, NOT INCLUDING DIAGONAL,
C                COUNTING ONLY THOSE ELEMENTS IN THE REMAINDER MATRIX
C
C     THEN WE HAVE
C
C        LU DECOMPOSITION     REQUIRES SIGMA(2,NSTOP-1) {NOFFC + NOFFC*NOFFR}
C        FORWARD SUBSTITUTION          SIGMA(2,NSTOP-1) {NOFFC + 1}   +   1
C        BACKWARD SUBSTITUTION         SIGMA(2,NSTOP-1) {NOFFR}
C
C     WHICH SUMS TO
C
C               SIGMA(2,NSTOP-1) {NOFFC + NOFFC*NOFFR + (NOFFC+1) + NOFFR} + 1
C         OR
C               SIGMA(2,NSTOP-1) {NOFFC*(NOFFR+2) + NOFFR + 1}   +   1
C
      IOPS=1
      NSTOP1=NSTOP-1
      DO 205 I=2,NSTOP1
      NOFFR=NODPLC(NUMOFF+I)-1
      NOFFC=NODPLC(NMOFFC+I)-1
      IOPS=IOPS+NOFFR+NOFFC*(NOFFR+2)+1
  205 CONTINUE
      RSTATS(20)=NSTOP
      RSTATS(21)=NTTAR
      RSTATS(22)=NTTBR
      RSTATS(23)=IFILL
      RSTATS(24)=0.0D0
      RSTATS(25)=NTTBR
      RSTATS(26)=IOPS
      RSTATS(27)=PERSPA
      GO TO 215
  210 IF (IDEBUG(18).LE.0) GO TO 212
      CALL DMPMAT(6HDCDCM6)
      IDEBUG(18)=IDEBUG(18)-1
  212 IF (IDEBUG(19).LE.0.OR.ICALC.LE.10) GO TO 215
      CALL DMPMAT(6HDCDCM7)
      IDEBUG(19)=IDEBUG(19)-1
  215 CALL SECOND(T2)
      RSTATS(50)=RSTATS(50)+T2-T1
       RETURN
  220 IPIV=1
      WRITE(IOFILE,221) N,NXTI,NXTJ,ITERNO,TIME
  221 FORMAT(' PIVOT CHANGE ON FLY: N= ',I5,' NXTI= ',I5,' NXTJ= ',
     1       I5,' ITERNO= ',I5,' TIME= ',1PD12.5)
      RSTATS(49)=RSTATS(49)+1.0D0
      GO TO 20
      END
      SUBROUTINE DCSOL
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      REAL T1, T2
C
C     THIS ROUTINE SOLVES THE SYSTEM OF CIRCUIT EQUATIONS BY PERFORMING
C A FORWARD AND BACKWARD SUBSTITUTION STEP USING THE PREVIOUSLY-COMPUTED
C LU FACTORS.
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=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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C  FORWARD SUBSTITUTION
C
      CALL SECOND(T1)
      DO 20 I=2,NSTOP
      LOC=I
      IORD=NODPLC(IRSWPF+I)
   10 LOC=NODPLC(JCPT+LOC)
      IF (NODPLC(JCOLNO+LOC).GE.I) GO TO 20
      J=NODPLC(JCOLNO+LOC)
      JORD=NODPLC(IRSWPF+J)
      VALUE(LVN+IORD)=VALUE(LVN+IORD)-
     1           VALUE(LVN+LOC)*VALUE(LVN+JORD)
      GO TO 10
   20 CONTINUE
C
C     BACK SUBSTITUTION
C
      I=NSTOP
      IORD=NODPLC(IRSWPF+I)
      JORD=NODPLC(ICSWPF+I)
      LOCNN=INDXX(IORD,JORD)
   30 VALUE(LVN+IORD)=VALUE(LVN+IORD)/VALUE(LVN+LOCNN)
      I=I-1
      IF (I.LE.1) GO TO 100
      IORD=NODPLC(IRSWPF+I)
      LOC=I
   35 LOC=NODPLC(JCPT+LOC)
   40 IF (NODPLC(JCOLNO+LOC).NE.I) GO TO 35
      LOCNN=LOC
   50 LOC=NODPLC(JCPT+LOC)
      IF (LOC.EQ.0) GO TO 30
      J=NODPLC(JCOLNO+LOC)
      JORD=NODPLC(IRSWPF+J)
      VALUE(LVN+IORD)=VALUE(LVN+IORD)-
     1           VALUE(LVN+LOC)*VALUE(LVN+JORD)
      GO TO 50
  100 CALL SECOND(T2)
      RSTATS(46)=RSTATS(46)+T2-T1
      RETURN
      END
      SUBROUTINE DMPMAT(ANAM)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C      THIS ROUTINE DUMPS OUT THE MATRIX AND ASSOCIATED POINTERS.
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(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C
      WRITE (IOFILE,10) ANAM,MODE,MODEDC,
     1 TIME,DELTA,ICALC,ITERNO,INITF,IPIV,IORD,NONCON,IGOOF,NOGO
   10 FORMAT('*DEBUG*:  DMPMT CALLED BY ',A8,/,
     1   ' *DEBUG*:  MODE, MDC, TIME, DELTA, ICALC, ITR#, INITF,',
     2             ' PIV, ORD, NCON, IGOOF, NOGO =',/,
     3   ' *DEBUG*:  ',2I5,1P2D10.2,8I5)
      CALL DMPMEM(5HDMPMT)
C
C  DUMP OUT THE *WHOLE* THING
C
      CALL SIZMEM(IRPT,IRPTS)
      WRITE (IOFILE,16) NSTOP,NTTBR,IRPTS
   16 FORMAT(' *DEBUG*:  NSTOP, NTTBR, SIZE(IRPT) = ',3I6,/,
     1   ' *DEBUG*:   INDEX  IRPT  IROW  JCOL  JCPT       VALUE',
     2          10X,' INDEX  IRPT  IROW  JCOL  JCPT       VALUE')
      J=(IRPTS+1)/2
      ISTOP=J
      DO 30 I=1,ISTOP
      J=J+1
      WRITE (IOFILE,26)
     1   I,NODPLC(IRPT+I),NODPLC(IROWNO+I),NODPLC(JCOLNO+I),
     2   NODPLC(JCPT+I),VALUE(LVN+I),
     3   J,NODPLC(IRPT+J),NODPLC(IROWNO+J),NODPLC(JCOLNO+J),
     4   NODPLC(JCPT+J),VALUE(LVN+J)
   26 FORMAT(' *DEBUG*:  ',5I6,1PD12.4,10X,5I6,1PD12.4)
   30 CONTINUE
CC 51 FORMAT(" *DEBUG*:  IRPT   = ",18I6)
CC    WRITE (IOFILE,56) (NODPLC(IROWNO+I),I=1,IRPTS)
CC 56 FORMAT(" *DEBUG*:  IROWNO = ",18I6)
CC    WRITE (IOFILE,61) (NODPLC(JCOLNO+I),I=1,IRPTS)
CC 61 FORMAT(" *DEBUG*:  JCOLNO = ",18I6)
CC    WRITE (IOFILE,66) (NODPLC(JCPT  +I),I=1,IRPTS)
CC 66 FORMAT(" *DEBUG*:  JCPT   = ",18I6)
      WRITE (IOFILE,71) (NODPLC(IRSWPF+I),I=1,NSTOP)
   71 FORMAT(' *DEBUG*:  IRSWPF = ',18I6)
      WRITE (IOFILE,76) (NODPLC(IRSWPR+I),I=1,NSTOP)
   76 FORMAT(' *DEBUG*:  IRSWPR = ',18I6)
      WRITE (IOFILE,81) (NODPLC(ICSWPF+I),I=1,NSTOP)
   81 FORMAT(' *DEBUG*:  ICSWPF = ',18I6)
      WRITE (IOFILE,86) (NODPLC(ICSWPR+I),I=1,NSTOP)
   86 FORMAT(' *DEBUG*:  ICSWPR = ',18I6)
C
C
  500 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
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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
      IF (NODE1.EQ.1) GO TO 100
      IF (NODE2.EQ.1) GO TO 100
C
      N1=NODPLC(IRSWPR+NODE1)
      N2=NODPLC(ICSWPR+NODE2)
      IF (N1-N2) 10,10,30
C
C     SEARCH COL N2
C
   10 LOC=N2
   15 LOC=NODPLC(IRPT+LOC)
      IF (LOC.EQ.0) GO TO 100
      IF (NODPLC(IROWNO+LOC)-N1) 15,20,15
   20 INDXX=LOC
      RETURN
C
C     SEARCH ROW N1
C
   30 LOC=N1
   35 LOC=NODPLC(JCPT+LOC)
      IF (LOC.EQ.0) GO TO 100
      IF (NODPLC(JCOLNO+LOC)-N2) 35,40,35
   40 INDXX=LOC
      RETURN
C
C     UNUSED LOCATION
C
  100 INDXX=1
      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(1000000)
      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
      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
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=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(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
      LOGICAL MEMPTR
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     RESERVE (NODE1,NODE2) IN ROW NODE1 AT COL POSN NODE2
C
      LOC=NODE1
   10 LOCJ=LOC
      LOC=NODPLC(JCPT+LOC)
      IF (LOC.EQ.0) GO TO 20
      IF (NODPLC(JCOLNO+LOC)-NODE2) 10,300,20
   20 CALL SIZMEM(JCPT,ISIZE)
      NEWLOC=ISIZE+1
      NODPLC(NUMOFF+NODE1)=NODPLC(NUMOFF+NODE1)+1
      NODPLC(NMOFFC+NODE2)=NODPLC(NMOFFC+NODE2)+1
      CALL EXTMEM(JCPT,1)
      CALL EXTMEM(JCOLNO,1)
      NODPLC(JCPT+LOCJ)=NEWLOC
      NODPLC(JCPT+NEWLOC)=LOC
      NODPLC(JCOLNO+NEWLOC)=NODE2
C
C     RESERVE (NODE1,NODE2) IN COL NODE2 AT ROW POSN NODE1
C
      LOC=NODE2
   30 LOCI=LOC
      LOC=NODPLC(IRPT+LOC)
      IF (LOC.EQ.0) GO TO 40
      IF (NODPLC(IROWNO+LOC)-NODE1) 30,300,40
   40 CALL EXTMEM(IRPT,1)
      CALL EXTMEM(IROWNO,1)
      NODPLC(IRPT+LOCI)=NEWLOC
      NODPLC(IRPT+NEWLOC)=LOC
      NODPLC(IROWNO+NEWLOC)=NODE1
C
C     MARK DIAGONAL
C
      IF (NODE1.NE.NODE2) GO TO 300
      IF (MEMPTR(NDIAG)) NODPLC(NDIAG+NODE1)=1
C
C     FINISHED
C
  300 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
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=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(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C  RESISTORS
C
      LOC=LOCATE(1)
  690 IF ((LOC.EQ.0).OR.(NODPLC(LOC+8).NE.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).OR.(NODPLC(LOC+12).NE.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).OR.(NODPLC(LOC+14).NE.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).OR.(NODPLC(LOC+6).NE.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).OR.(NODPLC(LOC+13).NE.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).OR.(NODPLC(LOC+14).NE.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).OR.(NODPLC(LOC+13).NE.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).OR.(NODPLC(LOC+14).NE.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).OR.(NODPLC(LOC+11).NE.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).OR.(NODPLC(LOC+16).NE.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).OR.(NODPLC(LOC+36).NE.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).OR.(NODPLC(LOC+25).NE.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).OR.(NODPLC(LOC+33).NE.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).OR.(NODPLC(LOC+33).NE.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  FINISHED
C
 1000 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
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=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=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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
      LOGICAL MEMPTR
      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(1000000)
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))
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=LOCF(VALUE(2))-LOCF(VALUE(1))
      NWD16=LOCF(CVALUE(2))-LOCF(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
      INTEGER FUNCTION LOCF(IVAR)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
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
      DIMENSION IVAR(1)
      IABSA=LOC(IVAR)
      LOCF=IABSA/8
      IF (IABSA.EQ.8*LOCF) RETURN
      WRITE(IOFILE,100) IABSA
  100 FORMAT ('*ERROR*: SYSTEM ERROR, ADDRESS ',I10,
     1   ' IS NOT ON 8-BYTE BOUNDARY')
      RETURN
      END
      SUBROUTINE GETM4(IPNTR,KSIZE)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
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)
      IWSIZE=NWD4
      CALL GETMX(IPNTR(1),KSIZE,IWSIZE)
      RETURN
      END
      SUBROUTINE GETM8(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
      IWSIZE=NWD8
      CALL GETMX(IPNTR(1),KSIZE,IWSIZE)
      RETURN
      END
      SUBROUTINE GETM16(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
      IWSIZE=NWD16
      CALL GETMX(IPNTR(1),KSIZE,IWSIZE)
      RETURN
      END
      SUBROUTINE GETMX(IPNTR,KSIZE,IWSIZE)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
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
      DIMENSION IPNTR(1)
C
C***  GETMEM - GET BLOCK
C
C
      ISIZE=KSIZE*IWSIZE
C...  CHECK FOR VALID SIZE
      IF (ISIZE.GE.0) GO TO 5
      MEMERR=2
      CALL ERRMEM(3,MEMERR,IPNTR(1))
C...  CHECK FOR ATTEMPT TO REALLOCATE EXISTING BLOCK
    5 IF (.NOT.MEMPTR(IPNTR(1))) GO TO 8
      MEMERR=3
      CALL ERRMEM(3,MEMERR,IPNTR(1))
    8 JSIZE=NXTEVN(ISIZE)
      CALL COMPRS(0,LDVAL)
C...  CHECK IF ENOUGH SPACE ALREADY THERE
      NEED=JSIZE+NTAB-MEMAVL
      IF (NEED.LE.0) GO TO 10
C...  INSUFFICIENT SPACE -- BUMP MEMORY SIZE
      NEED=NXTMEM(NEED)
      ICORE=ICORE+NEED
      CALL MEMORY
      IF(MEMERR.NE.0) CALL ERRMEM(3,MEMERR,IPNTR(1))
      LTAB1=LDVAL-NTAB
      ISTACK(LTAB1+2)=ISTACK(LTAB1+2)+NEED
C...  RELOCATE BLOCK ENTRY TABLE
      NWORDS=NUMBLK*NTAB
      CPYKNT=CPYKNT+DFLOAT(NWORDS)
      CALL COPY4(ISTACK(LOCTAB+1),ISTACK(LOCTAB+NEED+1),NWORDS)
      LOCTAB=LOCTAB+NEED
      LDVAL=LDVAL+NEED
      MEMAVL=MEMAVL+NEED
C...  A BLOCK LARGE ENOUGH NOW EXISTS -- ALLOCATE IT
   10 LTAB1=LDVAL-NTAB
      MORG=ISTACK(LTAB1+1)
      MSIZ=ISTACK(LTAB1+2)
      MUSE=ISTACK(LTAB1+3)
      MUSE=NXTEVN(MUSE)
      MADR=ISTACK(LTAB1+4)
C...  CONSTRUCT NEW TABLE ENTRY
   15 ISTACK(LTAB1+2)=MUSE
      LOCTAB=LOCTAB-NTAB
      NWORDS=NUMBLK*NTAB
      CPYKNT=CPYKNT+DFLOAT(NWORDS)
      CALL COPY4(ISTACK(LOCTAB+NTAB+1),ISTACK(LOCTAB+1),NWORDS)
      NUMBLK=NUMBLK+1
      MEMAVL=MEMAVL-NTAB
      ISTACK(LTAB1+1)=MORG+MUSE
      ISTACK(LTAB1+2)=MSIZ-MUSE-NTAB
C...  SET USER SIZE INTO TABLE ENTRY FOR THIS BLOCK
   20 ISTACK(LTAB1+3)=ISIZE
      ISTACK(LTAB1+4)=LOCF(IPNTR(1))
      ISTACK(LTAB1+5)=IWSIZE
      ISTACK(LTAB1+6)=0
      MEMAVL=MEMAVL-JSIZE
      IPNTR(1)=ISTACK(LTAB1+1)/IWSIZE
      CALL MEMADJ
      RETURN
      END
      SUBROUTINE AVLM4(IAVL)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
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
      IAVL=((MAXMEM-ICORE)/NXTMEM(1))*NXTMEM(1)-NTAB+MEMAVL
      IAVL=IAVL/NWD4
      RETURN
      END
      SUBROUTINE AVLM8(IAVL)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
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
      IAVL=((MAXMEM-ICORE)/NXTMEM(1))*NXTMEM(1)-NTAB+MEMAVL
      IAVL=IAVL/NWD8
      RETURN
      END
      SUBROUTINE AVLM16(IAVL)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
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
      IAVL=((MAXMEM-ICORE)/NXTMEM(1))*NXTMEM(1)-NTAB+MEMAVL
      IAVL=IAVL/NWD16
      RETURN
      END
      SUBROUTINE RELMEM(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***  RELMEM - RELEASE PART OF BLOCK
C
C
C...  CHECK FOR VALID POINTER
      IF (MEMPTR(IPNTR(1))) GO TO 10
      MEMERR=5
      CALL ERRMEM(5,MEMERR,IPNTR(1))
   10 ISIZE=KSIZE*ISTACK(LTAB+5)
C...  CHECK FOR VALID SIZE
      IF (ISIZE.GE.0) GO TO 20
      MEMERR=2
      CALL ERRMEM(5,MEMERR,IPNTR(1))
   20 JSIZE=ISTACK(LTAB+3)
      IF (ISIZE.LE.JSIZE) GO TO 30
      MEMERR=6
      CALL ERRMEM(5,MEMERR,IPNTR(1))
   30 ISTACK(LTAB+3)=ISTACK(LTAB+3)-ISIZE
      MEMAVL=MEMAVL+(NXTEVN(JSIZE)-NXTEVN(ISTACK(LTAB+3)))
      CALL MEMADJ
      RETURN
      END
      SUBROUTINE EXTMEM(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***  EXTMEM - EXTEND SIZE OF EXISTING BLOCK
C
C
C...  CHECK FOR VALID POINTER
      IF (MEMPTR(IPNTR(1))) GO TO 10
      MEMERR=5
      CALL ERRMEM(2,MEMERR,IPNTR(1))
   10 ISIZE=KSIZE*ISTACK(LTAB+5)
C...  CHECK FOR VALID SIZE
      IF (ISIZE.GE.0) GO TO 20
      MEMERR=2
      CALL ERRMEM(2,MEMERR,IPNTR(1))
C...  CHECK IF ENOUGH SPACE ALREADY THERE
   20 IF ((ISTACK(LTAB+2)-ISTACK(LTAB+3)).GE.ISIZE) GO TO 40
      NEED=NXTEVN(ISIZE)-MEMAVL
      IF (NEED.LE.0) GO TO 30
C...  INSUFFICIENT SPACE -- BUMP MEMORY SIZE
      NEED=NXTMEM(NEED)
      ICORE=ICORE+NEED
      CALL MEMORY
      IF(MEMERR.NE.0) CALL ERRMEM(2,MEMERR,IPNTR(1))
      LTAB1=LDVAL-NTAB
      ISTACK(LTAB1+2)=ISTACK(LTAB1+2)+NEED
C...  RELOCATE BLOCK ENTRY TABLE
      NWORDS=NUMBLK*NTAB
      CPYKNT=CPYKNT+DFLOAT(NWORDS)
      CALL COPY4(ISTACK(LOCTAB+1),ISTACK(LOCTAB+NEED+1),NWORDS)
      LOCTAB=LOCTAB+NEED
      LDVAL=LDVAL+NEED
      MEMAVL=MEMAVL+NEED
      LTAB=LTAB+NEED
C...  MOVE BLOCKS TO MAKE SPACE
   30 CONTINUE
      CALL COMPRS(0,LTAB)
      CALL COMPRS(1,LTAB)
   40 JSIZE=ISTACK(LTAB+3)
      ISTACK(LTAB+3)=ISTACK(LTAB+3)+ISIZE
      MEMAVL=MEMAVL-(NXTEVN(ISTACK(LTAB+3))-NXTEVN(JSIZE))
      CALL MEMADJ
      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 CLRMEM(IPNTR)
      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***  CLRMEM - RELEASE BLOCK
C
C
C...  CHECK THAT POINTER IS VALID
      IF (MEMPTR(IPNTR(1))) GO TO 10
      MEMERR=5
      CALL ERRMEM(1,MEMERR,IPNTR(1))
   10 MSIZ=ISTACK(LTAB+2)
      MUSE=ISTACK(LTAB+3)
      MEMAVL=MEMAVL+NXTEVN(MUSE)+ISTACK(LTAB+6)
C...  ASSUMPTION:  FIRST ALLOCATED BLOCK IS NEVER CLEARED.
      LTAB1=LTAB-NTAB
      ISTACK(LTAB1+2)=ISTACK(LTAB1+2)+MSIZ
C...  REPOSITION THE BLOCK TABLE
      NWORDS=LTAB-LOCTAB
      CPYKNT=CPYKNT+DFLOAT(NWORDS)
      CALL COPY4(ISTACK(LOCTAB+1),ISTACK(LOCTAB+NTAB+1),NWORDS)
      NUMBLK=NUMBLK-1
      LOCTAB=LOCTAB+NTAB
      MEMAVL=MEMAVL+NTAB
      LTAB1=LDVAL-NTAB
      ISTACK(LTAB1+2)=ISTACK(LTAB1+2)+NTAB
      IPNTR(1)=2**30-1
      CALL MEMADJ
      RETURN
      END
      SUBROUTINE PTRMEM(IPNTR,IPNTR2)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION IPNTR(1),IPNTR2(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***  PTRMEM - RESET MEMORY POINTER
C
C...  VERIFY THAT POINTER IS VALID
      IF (MEMPTR(IPNTR(1))) GO TO 10
      MEMERR=5
      CALL ERRMEM(4,MEMERR,IPNTR(1))
C...  RESET BLOCK POINTER TO BE *IPNTR2*
   10 IPNTR2(1)=IPNTR(1)
      ISTACK(LTAB+4)=LOCF(IPNTR2(1))
      CALL MEMADJ
      RETURN
      END
      SUBROUTINE CRUNCH
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
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
      CALL COMPRS(0,LDVAL)
      CALL MEMADJ
      RETURN
      END
      SUBROUTINE ERRMEM(INAM,IERROR,IPNTR)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION IPNTR(1)
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=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 ERRNAM(7)
      DATA ERRNAM /6HCLRMEM,6HEXTMEM,6HGETMEM,6HPTRMEM,6HRELMEM,
     1   6HSETMEM,6HSIZMEM/
C
      GO TO (200,410,420,300,510,530),IERROR
C
C*** ERROR(S) FOUND ***
C
C.. NXTEVN AND/OR NXTMEM INCOMPATIBLE WITH NWD4, NWD8, AND NWD16
C
  200 WRITE(IOFILE,201)
  201 FORMAT('MEMORY MANAGER VARIABLES NWD4-8-16 INCOMPATIBLE WITH NXTE
     1VN AND NXTMEM')
      GO TO 900
C
C...  MEMORY NEEDS EXCEED MAXIMUM AVAILABLE SPACE
  300 WRITE (IOFILE,301) MAXMEM,MAXMEM
  301 FORMAT('*ERROR*:  MEMORY REQUIREMENT EXCEEDS MACHINE CAPACITY',
     1 /' MEMORY NEEDS EXCEED',I6,'(',O6,'B)'/)
      GO TO 900
C...    *ISIZE* < 0
  410 WRITE(IOFILE,411)
  411 FORMAT('SIZE PARAMETER NEGATIVE')
      GO TO 900
C...  GETMEM:  ATTEMPT TO REALLOCATE EXISTING BLOCK
  420 WRITE(IOFILE,421)
  421 FORMAT('ATTEMPT TO REALLOCATE EXISTING TABLE')
      GO TO 900
C...    *IPNTR* INVALID
  510 WRITE(IOFILE,511)
  511 FORMAT('TABLE POINTER INVALID')
      GO TO 900
C...  RELMEM:  *ISIZE* LARGER THAN INDICATED BLOCK
  530 WRITE(IOFILE,531)
  531 FORMAT('ATTEMPT TO RELEASE MORE THAN TOTAL TABLE')
C...  ISSUE ERROR MESSAGE
  900 WRITE (IOFILE,901) ERRNAM(INAM)
  901 FORMAT('*ABORT*:  INTERNAL MEMORY MANAGER ERROR AT ENTRY ',
     1  A7)
  950 CALL DMPMEM(IPNTR(1))
 1000 STOP
      END
      SUBROUTINE MEMADJ
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
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
   50 MAXUSE=MAX0(MAXUSE,(LDVAL-MEMAVL-IFWA))
      MEMDEC=2*NXTMEM(1)
      IF (MEMAVL.LT.MEMDEC) RETURN
C...  COMPRESS CURRENT ALLOCATIONS OF MEMORY
      CALL COMPRS(0,LDVAL)
C...  ADJUST MEMORY SIZE
      MEMDEL=0
   60 ICORE=ICORE-MEMDEC
      MEMDEL=MEMDEL+MEMDEC
      MEMAVL=MEMAVL-MEMDEC
      IF (MEMAVL.GE.MEMDEC) GO TO 60
      LTAB1=LDVAL-NTAB
      ISTACK(LTAB1+2)=ISTACK(LTAB1+2)-MEMDEL
C...  RELOCATE BLOCK ENTRY TABLE
      NWORDS=NUMBLK*NTAB
      CPYKNT=CPYKNT+DFLOAT(NWORDS)
      CALL COPY4(ISTACK(LOCTAB+1),ISTACK(LOCTAB-MEMDEL+1),NWORDS)
      LOCTAB=LOCTAB-MEMDEL
      LDVAL=LDVAL-MEMDEL
      CALL MEMORY
      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
      INTEGER FUNCTION NXTEVN(N)
C
C.. FUNCTION RETURNS THE SMALLEST VALUE NXTEVN GREATER THAN OR EQUAL TO
C.. N WHICH IS EVENLY DIVISIBLE BY 'NWD4, NWD8, AND NWD16' AS DEFINED
C.. IN SETMEM
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      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      NXTEVN=((N+3)/4)*4
      NXTEVN = ((N+(NWD16-1))/NWD16)*NWD16
      RETURN
      END
      INTEGER FUNCTION NXTMEM(MEMWDS)
C
C.. FUNCTION RETURNS THE IN NXTMEM THE NEXT AVAILABLE MEMORY SIZE
C.. (WHICH MUST BE EVENLY DIVISIBLE BY 'NWD4, NWD8, AND NWD16' AS
C.. DEFINED IN SETMEM
C
      NXTMEM=((MEMWDS+1999)/2000)*2000
      RETURN
      END
      SUBROUTINE COMPRS(ICODE,LIMIT)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C      THIS ROUTINE COMPRESSES ALL AVAILABLE MEMORY INTO A SINGLE BLOCK.
C IF *ICODE* IS ZERO, COMPRESSION OF MEMORY FROM WORD 1 TO *LIMIT* IS
C DONE;  OTHERWISE, COMPRESSION FROM *LDVAL* DOWN TO *LIMIT* IS DONE.
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
      IF (ICODE.NE.0) GO TO 100
      NBLK=NUMBLK
      LTAB2=LOCTAB
   10 LTAB1=LTAB2
      IF (LTAB1.GE.LIMIT) GO TO 200
      IF (NBLK.EQ.1) GO TO 200
      NBLK=NBLK-1
      LTAB2=LTAB1+NTAB
      MORG=ISTACK(LTAB1+1)
      MSIZ=ISTACK(LTAB1+2)
      MUSE=NXTEVN(ISTACK(LTAB1+3))
      MSLP=ISTACK(LTAB1+6)
      IF ((MSIZ-MUSE).LE.MSLP) GO TO 10
      MUSE=MUSE+MSLP
C...  MOVE SUCCEEDING BLOCK DOWN
      MORG2=ISTACK(LTAB2+1)
      MUSE2=ISTACK(LTAB2+3)
      MADR2=ISTACK(LTAB2+4)
      IWSIZE=ISTACK(LTAB2+5)
      IF (MADR2.NE.0) GO TO 15
      IF (MUSE2.EQ.0) GO TO 20
   15 CPYKNT=CPYKNT+DFLOAT(MUSE2)
      CALL COPY4(ISTACK(NWOFF+MORG2+1),ISTACK(NWOFF+MORG+MUSE+1),MUSE2)
      ISTACK(LORG+MADR2)=(MORG+MUSE)/IWSIZE
   20 ISTACK(LTAB1+2)=MUSE
      ISTACK(LTAB2+1)=MORG+MUSE
      ISTACK(LTAB2+2)=ISTACK(LTAB2+2)+(MSIZ-MUSE)
      GO TO 10
C
C
  100 NBLK=NUMBLK
      LTAB2=LDVAL-NTAB
  110 LTAB1=LTAB2
      IF (LTAB1.LE.LIMIT) GO TO 200
      IF (NBLK.EQ.1) GO TO 200
      NBLK=NBLK-1
      LTAB2=LTAB1-NTAB
      MORG=ISTACK(LTAB1+1)
      MSIZ=ISTACK(LTAB1+2)
      MUSER=ISTACK(LTAB1+3)
      MUSE=NXTEVN(MUSER)
      MADR=ISTACK(LTAB1+4)
      IWSIZE=ISTACK(LTAB1+5)
      MSLP=ISTACK(LTAB1+6)
      IF ((MSIZ-MUSE).LE.MSLP) GO TO 110
      MUSE=MUSE+MSLP
      MSPC=MSIZ-MUSE
      CPYKNT=CPYKNT+DFLOAT(MUSER)
      CALL COPY4(ISTACK(NWOFF+MORG+1),ISTACK(NWOFF+MORG+MSPC+1),MUSER)
      ISTACK(LTAB1+1)=MORG+MSPC
      ISTACK(LTAB1+2)=MUSE
      ISTACK(LTAB2+2)=ISTACK(LTAB2+2)+MSPC
      IF (MADR.EQ.0) GO TO 110
      ISTACK(LORG+MADR)=(MORG+MSPC)/IWSIZE
      GO TO 110
C...  ALL DONE
  200 RETURN
      END
      LOGICAL FUNCTION MEMPTR(IPNTR)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C      THIS ROUTINE CHECKS WHETHER *IPNTR* IS A VALID BLOCK POINTER.
C IF IT IS VALID, *LTAB* IS SET TO POINT TO THE CORRESPONDING ENTRY IN
C THE BLOCK TABLE.
C
C... IPNTR IS AN ARRAY TO AVOID 'CALL BY VALUE' PROBLEMS (SEE SETMEM)
      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
      MEMPTR=.FALSE.
      LTAB=LOCTAB
      LOCPNT=LOCF(IPNTR(1))
      DO 20 I=1,NUMBLK
      IF (LOCPNT.NE.ISTACK(LTAB+4)) GO TO 10
      IF (IPNTR(1)*ISTACK(LTAB+5).NE.ISTACK(LTAB+1)) GO TO 10
      MEMPTR=.TRUE.
      GO TO 30
   10 LTAB=LTAB+NTAB
   20 CONTINUE
   30 RETURN
      END
      SUBROUTINE DMPMEM(IPNTR)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C      THIS ROUTINE PRINTS OUT THE CURRENT MEMORY ALLOCATION MAP.
C *IPNTR* IS THE TABLE POINTER OF THE CURRENT MEMORY MANAGER CALL
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=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)
      DIMENSION APTR(75)
      DATA APTR /6HIELMNT,6HISBCKT,6HNSBCKT,6HIUNSAT,6HNUNSAT,6HITEMPS,
     1 6HNUMTEM,6HISENS ,6HNSENS ,6HIFOUR ,6HNFOUR ,6HIFIELD,
     2 6HICODE ,6HIDELIM,6HICOLUM,6HINSIZE,
     3 6HJUNODE,6HLSBKPT,6HNUMBKP,6HIORDER,6HJMNODE,
     4 6HIUR   ,6HIUC   ,6HILC   ,6HILR   ,6HNUMOFF,6HISR   ,
     5 6HNMOFFC,6HISEQ  ,6HISEQ1  ,6HNEQN  ,6HNODEVS,
     6 6HNDIAG ,6HISWAP ,6HIEQUA ,6HMACINS,6HLVNIM1,
     7 6HLX0   ,6HLVN   ,6HLYNL  ,6HLYU   ,6HLYL   ,
     8 6HLX1   ,6HLX2   ,6HLX3   ,6HLX4   ,6HLX5   ,6HLX6   ,
     9 6HLX7   ,6HLD0   ,6HLD1   ,6HLTD   ,6HIMYNL ,6HIMVN  ,6HLCVN  ,
     * 6HNSNOD ,6HNSMAT ,6HNSVAL ,6HICNOD ,6HICMAT ,6HICVAL ,6HLOUTPT,
     * 6HLPOL  ,6HLZER  ,6HIRSWPF,6HIRSWPR,6HICSWPF,6HICSWPR,6HIRPT  ,
     * 6HJCPT  ,6HIROWNO,6HJCOLNO,6HNTTBR ,6HNTTAR ,6HLVNTMP/
      DATA ABLNK /1H /
C
      IADDR=LOCF(IELMNT)-1
      ITEMP=LOCF(IPNTR(1))-IADDR
      ANAM=ABLNK
      IF(ITEMP.GT.0.AND.ITEMP.LE.75) ANAM=APTR(ITEMP)
      IADR=LOCF(IPNTR(1))
      WRITE (IOFILE,5) ANAM,IADR,ICORE,MAXMEM,MEMAVL,LDVAL
    5 FORMAT('CURRENT POINTER ',A6,'@ = Z',I6,/' CORSIZ=',I7,
     1  /' MAXMEM=',I7,/' AVLSPC=',I7,/' LDVAL=',I7,
     2  /24X,'MEMORY ALLOCATION MAP'/14X,'BLKNUM MEMORG MEMSIZ',
     3  '  MEMUSE USRPTR  ADDR    NAME')
      LTAB1=LOCTAB
      DO 20 I=1,NUMBLK
      MORG=ISTACK(LTAB1+1)
      MSIZ=ISTACK(LTAB1+2)
      MUSE=ISTACK(LTAB1+3)
      MADR=ISTACK(LTAB1+4)
      ANAM=ABLNK
      NDEX=MADR-IADDR
      IF(NDEX.GT.0.AND.NDEX.LE.75) ANAM=APTR(NDEX)
      JPTR=0
      IF (MADR.GT.0) JPTR=ISTACK(LORG+MADR)
      WRITE (IOFILE,11) I,MORG,MSIZ,MUSE,JPTR,MADR,ANAM
   11 FORMAT(13X,5I7,3X,I7,'Z',1X,A6)
      LTAB1=LTAB1+NTAB
   20 CONTINUE
      WRITE (IOFILE,21)
   21 FORMAT(24X,'END OF ALLOCATION MAP'/)
      RETURN
      END
      SUBROUTINE MEMORY
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
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
      IF(ICORE.LE.MAXMEM) GO TO 10
    5 MEMERR=4
      RETURN
   10 CONTINUE
C
C  SET JOB FIELD LENGTH TO 'ICORE+LOCF(ISTACK(IFWA))'
C
      RETURN
      END
      SUBROUTINE MAGPHS(CVAR,XMAG,XPHS)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE COMPUTES THE MAGNITUDE AND PHASE OF ITS COMPLEX ARG-
C UMENT CVAR, STORING THE RESULTS IN XMAG AND XPHS.
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
      COMPLEX CVAR
C
C
      XREAL=DBLE(REAL(CVAR))
      XIMAG=DBLE(AIMAG(CVAR))
      XMAG=DSQRT(XREAL*XREAL+XIMAG*XIMAG)
      IF (XMAG.GE.1.0D-20) GO TO 10
      XMAG=1.0D-20
      XPHS=0.0D0
      RETURN
   10 XPHS=RAD*DATAN2(XIMAG,XREAL)
      RETURN
      END
      INTEGER FUNCTION XXOR(A,B)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE COMPUTES A SINGLE-PRECISION INTEGER RESULT WHICH IS
C THE RESULT OF EXCLUSIVE-OR*ING THE TWO REAL-VALUED ARGUMENTS A AND B
C TOGETHER.
C
      XXOR=1
      IF(A.EQ.B) XXOR=0
      RETURN
      END
      SUBROUTINE OUTNAM(LOC,KTYPE,STRING,IPOS)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE CONSTRUCTS THE 'NAME' FOR THE OUTPUT VARIABLE INDI-
C CATED BY LOC, ADDING THE CHARACTERS TO THE CHARACTER ARRAY 'STRING',
C BEGINNING WITH THE POSITION MARKED BY IPOS.
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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
      DIMENSION STRING(1)
      DIMENSION AOUT(19),LENOUT(19),AOPT(5),LENOPT(5)
      DATA AOUT / 6HV     , 6HVM    , 6HVR    , 6HVI    , 6HVP    ,
     1            6HVDB   , 6HI     , 6HIM    , 6HIR    , 6HII    ,
     2            6HIP    , 6HIDB   , 6HONOISE, 6HINOISE, 6HHD2   ,
     1            6HHD3   , 6HDIM2  , 6HSIM2  , 6HDIM3   /
      DATA LENOUT / 1,2,2,2,2,3,1,2,2,2,2,3,6,6,3,3,4,4,4 /
      DATA AOPT / 5HMAG  , 5HREAL , 5HIMAG , 5HPHASE, 5HDB    /
      DATA LENOPT / 3,4,4,5,2 /
      DATA ALPRN, ACOMMA, ARPRN, ABLNK / 1H(, 1H,, 1H), 1H  /
C
C
      IOUTYP=NODPLC(LOC+5)
      IF (IOUTYP.GE.2) GO TO 10
      LOUT=KTYPE+IOUTYP*6
      GO TO 20
   10 LOUT=IOUTYP+11
   20 CALL MOVE(STRING,IPOS,AOUT(LOUT),1,LENOUT(LOUT))
      IPOS=IPOS+LENOUT(LOUT)
      IF (IOUTYP.GE.2) GO TO 200
      CALL MOVE(STRING,IPOS,ALPRN,1,1)
      IPOS=IPOS+1
      IF (IOUTYP.NE.0) GO TO 100
      NODE1=NODPLC(LOC+2)
      CALL ALFNUM(NODPLC(JUNODE+NODE1),STRING,IPOS)
      NODE2=NODPLC(LOC+3)
      IF (NODE2.EQ.1) GO TO 30
      CALL MOVE(STRING,IPOS,ACOMMA,1,1)
      IPOS=IPOS+1
      CALL ALFNUM(NODPLC(JUNODE+NODE2),STRING,IPOS)
   30 CALL MOVE(STRING,IPOS,ARPRN,1,1)
      IPOS=IPOS+1
      GO TO 1000
C
  100 LOCV=NODPLC(LOC+1)
      ANAM=VALUE(LOCV)
      ACHAR=ABLNK
      DO 110 I=1,8
      CALL MOVE(ACHAR,1,ANAM,I,1)
      IF (ACHAR.EQ.ABLNK) GO TO 120
      CALL MOVE(STRING,IPOS,ACHAR,1,1)
      IPOS=IPOS+1
  110 CONTINUE
  120 CALL MOVE(STRING,IPOS,ARPRN,1,1)
      IPOS=IPOS+1
      GO TO 1000
C
  200 IF (KTYPE.EQ.1) GO TO 1000
      CALL MOVE(STRING,IPOS,ALPRN,1,1)
      IPOS=IPOS+1
      CALL MOVE(STRING,IPOS,AOPT(KTYPE-1),1,LENOPT(KTYPE-1))
      IPOS=IPOS+LENOPT(KTYPE-1)
      CALL MOVE(STRING,IPOS,ARPRN,1,1)
      IPOS=IPOS+1
C
C  FINISHED
C
 1000 RETURN
      END
      SUBROUTINE ALFNUM(NUMBER,STRING,IPOS)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE CONVERTS NUMBER INTO CHARACTER FORM, STORING THE
C CHARACTERS IN THE CHARACTER ARRAY STRING, BEGINNING WITH THE POSITION
C INDICATED BY IPOS.
C
C **** NOTE THAT THE 'IPOS' VARIABLE IS CHANGED TO INDICATE THE POSITION
C      OF THE NEXT UNWRITTEN CHARACTER.  THIS COULD CLOBBER CONSTANTS IF
C      IPOS IS NOT A VARIABLE IN THE CALLING PROGRAM
C
      DIMENSION STRING(1)
      DIMENSION ADIGIT(10)
      DATA ADIGIT / 1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9 /
      DATA AMINUS / 1H- /
C
C
      NUM=NUMBER
C
C  CHECK FOR NUMBER < 0
C
      IF (NUM.GE.0) GO TO 10
      NUM=-NUM
C...  NEGATIVE NUMBER:  INSERT MINUS SIGN
      CALL MOVE(STRING,IPOS,AMINUS,1,1)
      IPOS=IPOS+1
C
C  CONVERT NUMBER ONE DIGIT AT A TIME, IN REVERSE ORDER
C
   10 ISTART=IPOS
   20 NUMTMP=NUM/10
      IDIGIT=NUM-NUMTMP*10
      CALL MOVE(STRING,IPOS,ADIGIT(IDIGIT+1),1,1)
      IPOS=IPOS+1
      NUM=NUMTMP
      IF (NUM.NE.0) GO TO 20
      ISTOP=IPOS-1
C
C  NOW REVERSE THE ORDER OF THE DIGITS
C
   30 IF (ISTOP.LE.ISTART) GO TO 40
      CALL MOVE(TMPDGT,1,STRING,ISTART,1)
      CALL MOVE(STRING,ISTART,STRING,ISTOP,1)
      CALL MOVE(STRING,ISTOP,TMPDGT,1,1)
      ISTART=ISTART+1
      ISTOP=ISTOP-1
      GO TO 30
C
C  CONVERSION COMPLETE
C
   40 RETURN
      END
      SUBROUTINE UNDEFI(ARRAY,LENGTH)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
      DIMENSION ARRAY(1)
C     THIS ROUTINE UNDEFINES THE MEMORY LOCATIONS INDICATED BY ARRAY(1)
C THROUGH ARRAY(LENGTH).
C
      DATA AUNDEF /2H.U/
      IF (LENGTH.EQ.0) RETURN
      DO 10 I=1,LENGTH
      ARRAY(I)=AUNDEF
   10 CONTINUE
      RETURN
      END
      SUBROUTINE GETCJE
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      REAL XTIME
C SPICE VERSION 2G.6  SCCSID=CJE 3/15/83
      COMMON /CJE/ MAXTIM,ITIME,ICOST
      CALL SECOND(XTIME)
      ITIME=XTIME
      RETURN
      END
      SUBROUTINE CPYTB4(ITABO,ITABN)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE COPIES A TABLE.  ITS USE IS MADE NECESSARY BY THE
C FACT THAT ONLY ONE POINTER IS ALLOWED PER TABLE.
C
C SPICE VERSION 2G.6  SCCSID=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C
      CALL SIZMEM(NODPLC(ITABO),ISIZE)
      CALL GETM4(NODPLC(ITABN),ISIZE)
      LOCO=NODPLC(ITABO)
      LOCN=NODPLC(ITABN)
      CALL COPY4(NODPLC(LOCO+1),NODPLC(LOCN+1),ISIZE)
      RETURN
      END
      SUBROUTINE CPYTB8(ITABO,ITABN)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE COPIES A TABLE.  ITS USE IS MADE NECESSARY BY THE
C FACT THAT ONLY ONE POINTER IS ALLOWED PER TABLE.
C
C SPICE VERSION 2G.6  SCCSID=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C
      CALL SIZMEM(NODPLC(ITABO),ISIZE)
      CALL GETM8(NODPLC(ITABN),ISIZE)
      LOCO=NODPLC(ITABO)
      LOCN=NODPLC(ITABN)
      CALL COPY8(VALUE(LOCO+1),VALUE(LOCN+1),ISIZE)
      RETURN
      END
      SUBROUTINE SECOND(T1)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      REAL T1
C      DIMENSION IBUFF(4)
C      CALL TIMES (IBUFF)
C      T1=FLOAT (IBUFF(1))/60.0D0
      T1=SECNDS(0.0)
      RETURN
      END
C SPICE VERSION 2G.6  SCCSID=readin.ma 3/22/83
      SUBROUTINE READIN
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      REAL T1, T2
C
C
C     THIS ROUTINE DRIVES THE INPUT PROCESSING OF SPICE.  ELEMENT CARDS
C AND DEVICE MODELS ARE HANDLED BY THIS ROUTINE.
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=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=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(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C  CONTROL CARD IDENTIFIERS
C
      DIMENSION AIDE(20),NNODS(20),NTNODS(20),L2NOD(24)
      DIMENSION NUMIC(4)
      DIMENSION AIDM(7),IPOLAR(7),MODID(7),IPAR(5),AMPAR(115)
      DIMENSION TITINP(4)
      DIMENSION AIDC(22)
      DATA TITINP / 8HINPUT LI, 8HSTING   , 8H        , 8H         /
      DATA NAIDC / 22 /
      DATA AIDC / 8HAC      , 8HDC      , 8HDISTORTI, 8HEND     ,
     1            8HENDS    , 8HFOURIER , 8HMODEL   , 8HNOISE   ,
     2            8HOP      , 8HOPTIONS , 8HPLOT    , 8HPRINT   ,
     3            8HSUBCKT  , 8HSENSITIV, 8HTRANSIEN, 8HTF      ,
     4            8HTEMPERAT, 8HWIDTH   , 8HNODESET , 8HIC      ,
     5            8H:DEBUG: , 8HALTER   /
C
C  ELEMENT CARD IDENTIFIERS, KEYWORDS, AND INFORMATION
C
      DATA AIDE / 1HR,1HC,1HL,1HK,1HG,1HE,1HF,1HH,1HV,1HI,1HD,1HQ,1HJ,
     1   1HM,1HS,1HY,1HT,0.0D0,1HX,0.0D0 /
      DATA ALSAC,ALSPU,ALSEX,ALSSI /2HAC,2HPU,2HEX,2HSI/
      DATA ALSOFF,ALSDC,ALSPW / 3HOFF,2HDC,3HPW  /
      DATA ALSZ0,ALSZO,ALSNL,ALSF,ALSTD / 2HZ0,2HZO,2HNL,1HF,2HTD /
      DATA ALSL,ALSW,ALSAS,ALSAD,ALSPD,ALSPS,ALSRDS,ALSRSS,ALSXQC
     1   /1HL,1HW,2HAS,2HAD,2HPD,2HPS,3HNRD,3HNRS,3HXQC/
      DATA ALSZX /2HZX/
      DATA ALSSF / 4HSF   /
      DATA APOLY, AIC, AREA / 4HPOLY, 2HIC, 4HAREA /
      DATA ALSTC / 2HTC /
      DATA NUMIC / 1, 2, 2, 3 /
      DATA ABLNK, APER / 1H , 1H. /
      DATA NNODS / 2,2,2,0,2,2,2,2,2,2,2,3,3,4,4,4,4,0,0,0 /
      DATA NTNODS / 2,2,2,0,2,2,2,2,2,2,3,6,5,6,4,4,4,0,0,0 /
      DATA L2NOD / 8,12,14, 6,13,14,13,14,11, 6,
     1            16,36,25,33, 6, 6,33, 0, 3, 3,
     2             3, 3, 3, 3 /
C
C  MODEL CARD KEYWORDS
C
      DATA AIDM /1HD,3HNPN,3HPNP,3HNJF,3HPJF,4HNMOS,4HPMOS/
      DATA IPOLAR /0,1,-1,1,-1,1,-1/
      DATA MODID /1,2,2,3,3,4,4/
      DATA IPAR / 0, 14, 60, 72, 114/
      DATA AMPAR /
     1   6HIS    ,6HRS    ,6HN     ,6HTT    ,6HCJO   ,6HVJ    ,6HM     ,
     2   6HEG    ,6HXTI   ,6HKF    ,6HAF    ,6HFC    ,6HBV    ,6HIBV   ,
     1   6HIS    ,6HBF    ,6HNF    ,6HVAF   ,6HIKF   ,6HISE   ,6HNE    ,
     2   6HBR    ,6HNR    ,6HVAR   ,6HIKR   ,6HISC   ,6HNC    ,6H0     ,
     3   6H0     ,6HRB    ,6HIRB   ,6HRBM   ,6HRE    ,6HRC    ,6HCJE   ,
     4   6HVJE   ,6HMJE   ,6HTF    ,6HXTF   ,6HVTF   ,6HITF   ,6HPTF   ,
     5   6HCJC   ,6HVJC   ,6HMJC   ,6HXCJC  ,6HTR    ,6H0     ,6H0     ,
     6   6H0     ,6H0     ,6HCJS   ,6HVJS   ,6HMJS   ,6HXTB   ,6HEG    ,
     7   6HXTI   ,6HKF    ,6HAF    ,6HFC    ,
     1   6HVTO   ,6HBETA  ,6HLAMBDA,6HRD    ,6HRS    ,6HCGS   ,6HCGD   ,
     2   6HPB    ,6HIS    ,6HKF    ,6HAF    ,6HFC    ,
     1   6HLEVEL ,6HVTO   ,6HKP    ,6HGAMMA ,6HPHI   ,6HLAMBDA,6HRD    ,
     2   6HRS    ,6HCBD   ,6HCBS   ,6HIS    ,6HPB    ,6HCGSO  ,6HCGDO  ,
     3   6HCGBO  ,6HRSH   ,6HCJ    ,6HMJ    ,6HCJSW  ,6HMJSW  ,6HJS    ,
     4   6HTOX   ,6HNSUB  ,6HNSS   ,6HNFS   ,6HTPG   ,6HXJ    ,6HLD    ,
     5   6HUO    ,6HUCRIT ,6HUEXP  ,6HUTRA  ,6HVMAX  ,6HNEFF  ,6HXQC   ,
     6   6HKF    ,6HAF    ,6HFC    ,6HDELTA ,6HTHETA ,6HETA   ,6HKAPPA ,
     7   0.0D0   /
C
C  INITIALIZE VARIABLES
C
      CALL SECOND(T1)
      CALL ZERO4(IDEBUG,20)
      CALL GETLIN
      IF (KEOF.NE.0) GO TO 6000
      CALL COPY8(AFIELD,ATITLE,10)
      CALL GETM4(IELMNT,0)
      CALL GETM8(ITEMPS,1)
      VALUE(ITEMPS+1)=27.0D0
      ITEMNO=1
      NOPAGE=0
      CALL TITLE(-1,72,1,TITINP)
      IWIDTH=80
      DO 5 I=1,8
      ACHAR=ABLNK
      CALL MOVE(ACHAR,1,ATITLE(10),I,1)
      IF(ACHAR.EQ.ABLNK) GO TO 8
    5 CONTINUE
      WRITE(IOFILE,6)
    6 FORMAT('WARNING:  INPUT LINE-WIDTH SET TO 72 COLUMNS BECAUSE',/
     11X,'POSSIBLE SEQUENCING APPEARS IN COLS 73-80')
      IWIDTH=72
    8 DO 10 I=1,15
      AFIELD(I)=ABLNK
   10 CONTINUE
      CALL COPY8(AFIELD,OLDLIN,15)
      CALL GETM4(ISBCKT,0)
      NSBCKT=0
      CALL GETM8(IUNSAT,0)
      NUNSAT=0
      NUMALT=0
      NUMCYC=0
      LWIDTH=132
      IPRNTA=0
      IPRNTL=0
      IPRNTM=1
      IPRNTN=0
      IPRNTO=0
      GMIN=1.0D-12
      PIVTOL=1.0D-13
      PIVREL=1.0D-3
      RELTOL=0.001D0
      ABSTOL=1.0D-12
      VNTOL=1.0D-6
      TRTOL=7.0D0
      CHGTOL=1.0D-14
      DEFL=1.0D-4
      DEFW=1.0D-4
      DEFAD=0.0D0
      DEFAS=0.0D0
      NUMDGT=4
      NUMTEM=1
      ITL1=100
      ITL2=50
      ITL3=4
      ITL4=10
      ITL5=5000
      ITL6=0
      LIMTIM=2
      LIMPTS=201
      LVLCOD=1
      LVLTIM=2
      METHOD=1
      XMU=0.5D0
      MAXORD=2
      NOSOLV=0
      ICVFLG=0
      ITCELM(2)=0
      IDIST=0
      IDPRT=0
      INOISE=0
      JACFLG=0
      JTRFLG=0
      CALL GETM4(IFOUR,0)
      NFOUR=0
      CALL GETM4(NSNOD,0)
      CALL GETM8(NSVAL,0)
      CALL GETM4(ICNOD,0)
      CALL GETM8(ICVAL,0)
      KINEL=0
      KOVAR=0
      KSSOP=0
      NOSPRT=0
      NSENS=0
      CALL GETM4(ISENS,0)
      NUMNOD=0
      NCNODS=0
      NUNODS=0
      CALL ZERO4(LOCATE,50)
      CALL ZERO4(JELCNT,50)
      INSIZE=50
      CALL GETM8(IFIELD,INSIZE)
      CALL GETM4(ICODE,INSIZE)
      CALL GETM8(IDELIM,INSIZE)
      CALL GETM4(ICOLUM,INSIZE)
      GO TO 50
C
C  ERROR ENTRY
C
   40 NOGO=1
C
C  READ AND DECODE NEXT CARD IN INPUT DECK
C
   50 IGOOF=0
      CALL CARD
      IF (KEOF.NE.0) GO TO 5000
      IF (IGOOF.NE.0) GO TO 40
      IF (NODPLC(ICODE+1).EQ.0) GO TO 95
      ANAM=VALUE(IFIELD+1)
      CALL MOVE(ANAM,2,ABLNK,1,7)
      IF (ANAM.NE.APER) GO TO 70
      CALL MOVE(ANAM,1,VALUE(IFIELD+1),2,7)
      CALL KEYSRC(AIDC,NAIDC,ANAM,ID)
      IF (ID.LE.0) GO TO 90
      IF (ID.EQ.4) GO TO 5000
      IF (ID.EQ.5) GO TO 800
      IF (ID.EQ.7) GO TO 500
      IF (ID.EQ.13) GO TO 700
      IF (ID.EQ.22) NUMALT=NUMALT+1
      IF (NSBCKT.GE.1) GO TO 85
      IF (ID.NE.22) CALL RUNCON(ID)
      IF (IGOOF.NE.0) GO TO 40
      GO TO 50
   70 ID=0
   80 ID=ID+1
      IF (ID.GT.20) GO TO 90
      IF (ANAM.EQ.AIDE(ID)) GO TO 100
      GO TO 80
   85 WRITE (IOFILE,86)
   86 FORMAT('WARNING:  ABOVE LINE NOT ALLOWED WITHIN SUBCIRCUIT -- ',
     1   'IGNORED'/)
      GO TO 50
   90 WRITE (IOFILE,91) VALUE(IFIELD+1)
   91 FORMAT('*ERROR*:  UNKNOWN DATA CARD:  ',A8/)
      GO TO 40
   95 WRITE (IOFILE,96)
   96 FORMAT('*ERROR*:  UNRECOGNIZABLE DATA CARD'/)
      GO TO 40
C
C  ELEMENT AND DEVICE CARDS
C
  100 CALL FIND(VALUE(IFIELD+1),ID,LOC,1)
      LOCV=NODPLC(LOC+1)
      IF (ID.EQ.4) GO TO 140
      IF (ID.EQ.19) GO TO 900
      ISTOP=NNODS(ID)+1
      IF (NODPLC(LOC+L2NOD(ID)).NE.0) GO TO 113
      DO 110 I=2,ISTOP
      IF (NODPLC(ICODE+I).NE.0) GO TO 410
      IF (VALUE(IFIELD+I).LT.0.0D0) GO TO 400
  110 NODPLC(LOC+I)=VALUE(IFIELD+I)
      GO TO 115
  113 DO 114 I=2,ISTOP
      NODPLC(LOC+I)=0
  114 CONTINUE
  115 GO TO (120,130,130,140,150,150,180,180,200,200,300,300,300,300,
     1   390,390,350,390,390,390), ID
C
C  RESISTOR
C
  120 IF (NODPLC(ICODE+4).NE.0) GO TO 420
      IF (VALUE(IFIELD+4).EQ.0.0D0) GO TO 480
      VALUE(LOCV+2)=VALUE(IFIELD+4)
      IFLD=4
  122 IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 50,122,124
  124 ANAM=VALUE(IFIELD+IFLD)
      IF (ANAM.NE.ALSTC) GO TO 460
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 50,126,124
  126 VALUE(LOCV+3)=VALUE(IFIELD+IFLD)
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 50,128,124
  128 VALUE(LOCV+4)=VALUE(IFIELD+IFLD)
      GO TO 50
C
C  CAPACITOR OR INDUCTOR
C
  130 IKNT=0
      LTAB=7
      IF (ID.EQ.3) LTAB=10
      IF (NODPLC(ICODE+4)) 420,131,132
  131 IF (VALUE(IFIELD+4).LE.0.0D0) GO TO 420
      VALUE(LOCV+1)=VALUE(IFIELD+4)
      NODPLC(LOC+4)=1
      IFLD=5
      IF (NODPLC(ICODE+IFLD)) 50,420,139
  132 CALL GETM8(NODPLC(LOC+LTAB),0)
      ANAM=VALUE(IFIELD+4)
      IF (ANAM.NE.APOLY) GO TO 450
      IFLD=4
  134 IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 50,136,138
  136 CALL EXTMEM(NODPLC(LOC+LTAB),1)
      IKNT=IKNT+1
      ISPOT=NODPLC(LOC+LTAB)+IKNT
      VALUE(ISPOT)=VALUE(IFIELD+IFLD)
      GO TO 134
  138 IF (IKNT.EQ.0) GO TO 420
  139 ANAM=VALUE(IFIELD+IFLD)
      IF (ANAM.NE.AIC) GO TO 460
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 50
      VALUE(LOCV+2)=VALUE(IFIELD+IFLD)
      GO TO 50
C
C  MUTUAL INDUCTANCE
C
  140 IF (NODPLC(ICODE+2).NE.1) GO TO 430
      ANAM=VALUE(IFIELD+2)
      CALL MOVE(ANAM,2,ABLNK,1,7)
      IF (ANAM.NE.AIDE(3)) GO TO 430
      CALL EXTNAM(VALUE(IFIELD+2),NODPLC(LOC+2))
      IF (NODPLC(ICODE+3).NE.1) GO TO 430
      ANAM=VALUE(IFIELD+3)
      CALL MOVE(ANAM,2,ABLNK,1,7)
      IF (ANAM.NE.AIDE(3)) GO TO 430
      CALL EXTNAM(VALUE(IFIELD+3),NODPLC(LOC+3))
      IF (NODPLC(ICODE+4).NE.0) GO TO 420
      XK=VALUE(IFIELD+4)
      IF (XK.LE.0.0D0) GO TO 420
      IF (XK.LE.1.0D0) GO TO 145
      XK=1.0D0
      WRITE (IOFILE,141)
  141 FORMAT('WARNING:  COEFFICIENT OF COUPLING RESET TO 1.0D0'/)
  145 VALUE(LOCV+1)=XK
      GO TO 50
C
C  VOLTAGE CONTROLLED (NONLINEAR) SOURCES
C
  150 NDIM=1
      IFLD=3
      IF (NODPLC(ICODE+4)) 410,156,152
  152 ANAM=VALUE(IFIELD+4)
      IF (ANAM.NE.APOLY) GO TO 450
      IF (NODPLC(ICODE+5).NE.0) GO TO 420
      NDIM=VALUE(IFIELD+5)
      IF (NDIM.LE.0) GO TO 420
      IFLD=5
  156 NODPLC(LOC+4)=NDIM
      LTAB=ID+1
      NSSNOD=2*NDIM
      NMAT=4*NDIM
      IF (ID.EQ.6) NMAT=4+2*NDIM
      CALL GETM4(NODPLC(LOC+LTAB),NSSNOD)
      CALL GETM4(NODPLC(LOC+LTAB+1),NMAT)
      CALL GETM8(NODPLC(LOC+LTAB+2),0)
      CALL GETM8(NODPLC(LOC+LTAB+3),NDIM)
      CALL GETM4(NODPLC(LOC+LTAB+4),NDIM)
      CALL GETM8(NODPLC(LOC+LTAB+5),NDIM)
      ISPOT=NODPLC(LOC+LTAB+5)
      CALL ZERO8(VALUE(ISPOT+1),NDIM)
      LNOD=NODPLC(LOC+LTAB)
      DO 158 I=1,NSSNOD
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 410
      IF (VALUE(IFIELD+IFLD).LT.0.0D0) GO TO 400
      NODPLC(LNOD+I)=VALUE(IFIELD+IFLD)
  158 CONTINUE
  160 IKNT=0
  162 IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 164
      CALL EXTMEM(NODPLC(LOC+LTAB+2),1)
      IKNT=IKNT+1
      ISPOT=NODPLC(LOC+LTAB+2)+IKNT
      VALUE(ISPOT)=VALUE(IFIELD+IFLD)
      GO TO 162
  164 IF (IKNT.EQ.0) GO TO 420
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 170
      ANAM=VALUE(IFIELD+IFLD)
      IF (ANAM.NE.AIC) GO TO 460
      DO 168 I=1,NDIM
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 170,166,420
  166 ISPOT=NODPLC(LOC+LTAB+5)+I
      VALUE(ISPOT)=VALUE(IFIELD+IFLD)
  168 CONTINUE
  170 IF (NDIM.NE.1) GO TO 50
      IF (IKNT.NE.1) GO TO 50
      CALL EXTMEM(NODPLC(LOC+LTAB+2),1)
      ISPOT=NODPLC(LOC+LTAB+2)
      VALUE(ISPOT+2)=VALUE(ISPOT+1)
      VALUE(ISPOT+1)=0.0D0
      GO TO 50
C
C  CURRENT CONTROLLED (NONLINEAR) SOURCES
C
  180 NDIM=1
      IFLD=3
      IF (NODPLC(ICODE+4).NE.1) GO TO 470
      ANAM=VALUE(IFIELD+4)
      IF (ANAM.NE.APOLY) GO TO 182
      IFLD=5
      IF (NODPLC(ICODE+5).NE.0) GO TO 420
      NDIM=VALUE(IFIELD+5)
      IF (NDIM.LE.0) GO TO 420
  182 NODPLC(LOC+4)=NDIM
      LTAB=ID-1
      NMAT=2*NDIM
      IF (ID.EQ.8) NMAT=4+NDIM
      CALL GETM4(NODPLC(LOC+LTAB),NDIM)
      CALL GETM4(NODPLC(LOC+LTAB+1),NMAT)
      CALL GETM8(NODPLC(LOC+LTAB+2),0)
      CALL GETM8(NODPLC(LOC+LTAB+3),NDIM)
      CALL GETM4(NODPLC(LOC+LTAB+4),NDIM)
      CALL GETM8(NODPLC(LOC+LTAB+5),NDIM)
      ISPOT=NODPLC(LOC+LTAB+5)
      CALL ZERO8(VALUE(ISPOT+1),NDIM)
      DO 184 I=1,NDIM
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 470
      ANAM=VALUE(IFIELD+IFLD)
      CALL MOVE(ANAM,2,ABLNK,1,7)
      IF (ANAM.NE.AIDE(9)) GO TO 470
      CALL EXTNAM(VALUE(IFIELD+IFLD),LOCT)
      ISPOT=NODPLC(LOC+LTAB)+I
      NODPLC(ISPOT)=LOCT
  184 CONTINUE
      GO TO 160
C
C  INDEPENDENT SOURCES
C
  200 IFLD=3
      CALL GETM8(NODPLC(LOC+5),0)
  210 IFLD=IFLD+1
  215 IF (NODPLC(ICODE+IFLD)) 50,220,230
  220 IF (IFLD.GT.4) GO TO 210
  225 VALUE(LOCV+1)=VALUE(IFIELD+IFLD)
      GO TO 210
  230 ANAM=VALUE(IFIELD+IFLD)
      IF (ANAM.NE.ALSDC) GO TO 235
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 50,225,230
  235 IF (ANAM.NE.ALSAC) GO TO 260
      VALUE(LOCV+2)=1.0D0
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 50,240,230
  240 VALUE(LOCV+2)=VALUE(IFIELD+IFLD)
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 50,250,230
  250 VALUE(LOCV+3)=VALUE(IFIELD+IFLD)
      GO TO 210
  260 ID=0
      CALL MOVE(ANAM,3,ABLNK,1,6)
      IF (ANAM.EQ.ALSPU) ID=1
      IF (ANAM.EQ.ALSSI) ID=2
      IF (ANAM.EQ.ALSEX) ID=3
      IF (ANAM.EQ.ALSPW) ID=4
      IF (ANAM.EQ.ALSSF) ID=5
      IF (ID.EQ.0) GO TO 450
      NODPLC(LOC+4)=ID
      IKNT=0
  270 IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 280
      CALL EXTMEM(NODPLC(LOC+5),1)
      IKNT=IKNT+1
      ISPOT=NODPLC(LOC+5)+IKNT
      VALUE(ISPOT)=VALUE(IFIELD+IFLD)
      GO TO 270
  280 AVAL=0.0D0
      IF (ID.NE.4) GO TO 285
C...  FOR PWL SOURCE FUNCTION, FORCE EVEN NUMBER OF INPUT VALUES
      IBIT=0
      IF(IKNT.NE.(IKNT/2)*2) IBIT=1
      AVAL=VALUE(ISPOT)
      IF (IBIT.EQ.0) GO TO 290
      CALL EXTMEM(NODPLC(LOC+5),1)
      AVAL=VALUE(ISPOT-1)
      IKNT=IKNT+1
      ISPOT=NODPLC(LOC+5)+IKNT
      VALUE(ISPOT)=AVAL
      GO TO 290
  285 IF (IKNT.GE.7) GO TO 215
  290 CALL EXTMEM(NODPLC(LOC+5),2)
      ISPOT=NODPLC(LOC+5)+IKNT
      VALUE(ISPOT+1)=0.0D0
      VALUE(ISPOT+2)=AVAL
      IKNT=IKNT+2
      GO TO 285
C
C  DEVICE CARDS
C
  300 VALUE(LOCV+1)=1.0D0
      IF (ID.NE.14) GO TO 305
      VALUE(LOCV+1)=0.0D0
      VALUE(LOCV+11)=0.0D0
      VALUE(LOCV+12)=0.0D0
      VALUE(LOCV+13)=1.0D0
      VALUE(LOCV+14)=1.0D0
      VALUE(LOCV+15)=0.0D0
  305 LOCM=LOC+NTNODS(ID)+2
      IFLD=NNODS(ID)+2
C
C  TEMPORARILY (UNTIL MODCHK) PUT BJT'S SUBSTRATE NODE INTO NODPLC(LOC+5)
C
      IF(ID.NE.12) GO TO 308
      IF(NODPLC(ICODE+5).NE.0) GO TO 308
      IFLD=6
      IF (NODPLC(LOC+L2NOD(ID)).NE.0) GO TO 306
      NODPLC(LOC+5)=VALUE(IFIELD+5)
      GO TO 308
  306 NODPLC(LOC+5)=0
  308 CONTINUE
C
C    RESERVE DEVICE INTERNAL NODES,READ DEVICE GEOMETRY PARAMETERS
C    AND INITIAL CONDITIONS
C
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 440
      CALL EXTNAM(VALUE(IFIELD+IFLD),NODPLC(LOCM))
  310 IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 50,325,315
  315 ANAM=VALUE(IFIELD+IFLD)
      IF (ANAM.NE.ALSOFF) GO TO 320
      NODPLC(LOCM+1)=1
      GO TO 310
  320 IF (ANAM.NE.AREA) GO TO 330
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 50,325,315
  325 IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 420
      IF (ID.EQ.14) GO TO 343
      VALUE(LOCV+1)=VALUE(IFIELD+IFLD)
      GO TO 310
  330 IF (ANAM.NE.AIC) GO TO 341
      IKNT=0
      ICLOC=0
      IF (ID.EQ.14) ICLOC=3
      MAXKNT=NUMIC(ID-10)
  335 IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 50,340,315
  340 IKNT=IKNT+1
      IF (IKNT.GT.MAXKNT) GO TO 335
      VALUE(LOCV+ICLOC+IKNT+1)=VALUE(IFIELD+IFLD)
      GO TO 335
  341 IF (ID.NE.14) GO TO 460
      ISPOT=0
      IF (ANAM.EQ.ALSL) ISPOT=1
      IF (ANAM.EQ.ALSW) ISPOT=2
      IF (ANAM.EQ.ALSAD) ISPOT=3
      IF (ANAM.EQ.ALSZX) ISPOT=3
      IF (ANAM.EQ.ALSAS) ISPOT=4
      IF (ANAM.EQ.ALSPD) ISPOT=11
      IF (ANAM.EQ.ALSPS) ISPOT=12
      IF (ANAM.EQ.ALSRDS) ISPOT=13
      IF (ANAM.EQ.ALSRSS) ISPOT=14
      IF (ANAM.EQ.ALSXQC) ISPOT=15
      IF (ISPOT.EQ.0) GO TO 460
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 50,342,315
  342 IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 420
      VALUE(LOCV+ISPOT)=VALUE(IFIELD+IFLD)
      GO TO 310
  343 IKNT=0
  344 IKNT=IKNT+1
      IF(VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 420
      IF(IKNT.GT.15) GO TO 490
      IF(IKNT.EQ.5) IKNT=11
      VALUE(LOCV+IKNT)=VALUE(IFIELD+IFLD)
      IFLD=IFLD+1
      IF(NODPLC(ICODE+IFLD)) 345,344,345
  345 IF(NODPLC(ICODE+IFLD)) 50,50,315
C
C  TRANSMISSION LINES
C
  350 IFLD=5
      XNL=0.25D0
      TFREQ=0.0D0
  355 IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 378,355,360
  360 ANAM=VALUE(IFIELD+IFLD)
      IF (ANAM.EQ.AIC) GO TO 364
      IF (ANAM.EQ.ALSNL) GO TO 370
      IF (ANAM.EQ.ALSF) GO TO 374
      ID=0
      IF (ANAM.EQ.ALSZ0) ID=1
      IF (ANAM.EQ.ALSZO) ID=1
      IF (ANAM.EQ.ALSTD) ID=2
      IF (ID.EQ.0) GO TO 460
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 378,362,360
  362 IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 420
      VALUE(LOCV+ID)=VALUE(IFIELD+IFLD)
      GO TO 355
  364 IKNT=0
  366 IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 378,368,360
  368 IKNT=IKNT+1
      IF (IKNT.GT.4) GO TO 366
      VALUE(LOCV+IKNT+4)=VALUE(IFIELD+IFLD)
      GO TO 366
  370 IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 378,372,360
  372 IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 420
      XNL=VALUE(IFIELD+IFLD)
      GO TO 355
  374 IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 378,376,360
  376 IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 420
      TFREQ=VALUE(IFIELD+IFLD)
      GO TO 355
  378 IF (VALUE(LOCV+1).NE.0.0D0) GO TO 380
      WRITE (IOFILE,379)
  379 FORMAT('*ERROR*:  Z0 MUST BE SPECIFIED'/)
      GO TO 40
  380 IF (VALUE(LOCV+2).NE.0.0D0) GO TO 50
      IF (TFREQ.NE.0.0D0) GO TO 382
      WRITE (IOFILE,381)
  381 FORMAT('*ERROR*:  EITHER TD OR F MUST BE SPECIFIED'/)
      GO TO 40
  382 VALUE(LOCV+2)=XNL/TFREQ
      GO TO 50
C
C  ELEMENTS NOT YET IMPLEMENTED
C
  390 WRITE (IOFILE,391)
  391 FORMAT('*ERROR*:  ELEMENT TYPE NOT YET IMPLEMENTED'/)
      GO TO 40
C
C  ELEMENT CARD ERRORS
C
  400 WRITE (IOFILE,401)
  401 FORMAT('*ERROR*:  NEGATIVE NODE NUMBER FOUND'/)
      GO TO 40
  410 WRITE (IOFILE,411)
  411 FORMAT('*ERROR*:  NODE NUMBERS ARE MISSING'/)
      GO TO 40
  420 WRITE (IOFILE,421)
  421 FORMAT('*ERROR*:  VALUE IS MISSING OR IS NONPOSITIVE'/)
      GO TO 40
  430 WRITE (IOFILE,431)
  431 FORMAT('*ERROR*:  MUTUAL INDUCTANCE REFERENCES ARE MISSING'/)
      GO TO 40
  440 WRITE (IOFILE,441)
  441 FORMAT('*ERROR*:  MODEL NAME IS MISSING'/)
      GO TO 40
  450 WRITE (IOFILE,451) ANAM
  451 FORMAT('*ERROR*:  UNKNOWN SOURCE FUNCTION:  ',A8)
      GO TO 40
  460 WRITE (IOFILE,461) ANAM
  461 FORMAT('*ERROR*:  UNKNOWN PARAMETER:  ',A8/)
      GO TO 40
  470 WRITE (IOFILE,471)
  471 FORMAT('*ERROR*:  VOLTAGE SOURCE NOT FOUND ON ABOVE LINE'/)
      GO TO 40
  480 WRITE (IOFILE,481)
  481 FORMAT('*ERROR*:  VALUE IS ZERO'/)
      GO TO 40
  490 WRITE(IOFILE,491)
  491 FORMAT('*ERROR*:  EXTRA NUMERICAL DATA ON MOSFET CARD'/)
      GO TO 40
C
C  MODEL CARD
C
  500 IF (NODPLC(ICODE+2).NE.1) GO TO 650
      IF (NODPLC(ICODE+3).NE.1) GO TO 650
      ID=0
  510 ID=ID+1
      IF (ID.GT.7) GO TO 660
      IF (VALUE(IFIELD+3).NE.AIDM(ID)) GO TO 510
      IPOL=IPOLAR(ID)
      JTYPE=MODID(ID)
      ID=JTYPE+20
      CALL FIND(VALUE(IFIELD+2),ID,LOC,1)
      NODPLC(LOC+2)=IPOL
      LOCV=NODPLC(LOC+1)
  520 LOCM=IPAR(JTYPE)
      NOPAR=IPAR(JTYPE+1)-LOCM
      IFLD=3
  530 IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 50,530,560
  560 ANAM=VALUE(IFIELD+IFLD)
      IF(JTYPE.EQ.2) ANAM=ALIAS(ANAM)
      IKNT=0
  570 IKNT=IKNT+1
      IF (IKNT.GT.NOPAR) GO TO 670
      IF (ANAM.NE.AMPAR(LOCM+IKNT)) GO TO 570
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 50,580,560
  580 VALUE(LOCV+IKNT)=VALUE(IFIELD+IFLD)
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 50,590,560
  590 IKNT=IKNT+1
      IF (IKNT.GT.NOPAR) GO TO 530
      IF (ABLNK.NE.AMPAR(LOCM+IKNT)) GO TO 530
      GO TO 580
C
C  MODEL CARD ERRORS
C
  650 WRITE (IOFILE,651)
  651 FORMAT('*ERROR*:  MODEL TYPE IS MISSING'/)
      GO TO 40
  660 WRITE (IOFILE,661) VALUE(IFIELD+3)
  661 FORMAT('*ERROR*:  UNKNOWN MODEL TYPE:  ',A8/)
      GO TO 40
  670 WRITE (IOFILE,671) ANAM
  671 FORMAT('*ERROR*:  UNKNOWN MODEL PARAMETER:  ',A8,/)
      NOGO=1
      GO TO 530
C
C  SUBCIRCUIT DEFINITION
C
  700 IF (NODPLC(ICODE+2).NE.1) GO TO 780
      CALL FIND(VALUE(IFIELD+2),20,LOC,1)
      CALL EXTMEM(ISBCKT,1)
      NSBCKT=NSBCKT+1
      NODPLC(ISBCKT+NSBCKT)=LOC
      IFLD=2
      IF (NODPLC(ICODE+3).NE.0) GO TO 790
      CALL GETM4(NODPLC(LOC+2),0)
      IKNT=0
  710 IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 50,720,710
  720 CALL EXTMEM(NODPLC(LOC+2),1)
      IKNT=IKNT+1
      ISPOT=NODPLC(LOC+2)+IKNT
      IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 770
      NODPLC(ISPOT)=VALUE(IFIELD+IFLD)
      NODE=NODPLC(ISPOT)
      I=IKNT-1
  730 IF (I.EQ.0) GO TO 710
      ISPOT=ISPOT-1
      IF (NODPLC(ISPOT).EQ.NODE) GO TO 760
      I=I-1
      GO TO 730
  760 WRITE (IOFILE,761) NODE
  761 FORMAT('*ERROR*:  SUBCIRCUIT DEFINITION DUPLICATES NODE ',I5,/)
      GO TO 40
  770 WRITE (IOFILE,771)
  771 FORMAT('*ERROR*:  NONPOSITIVE NODE NUMBER FOUND IN SUBCIRCUIT ',
     1   'DEFINITION'/)
      GO TO 40
  780 WRITE (IOFILE,781)
  781 FORMAT('*ERROR*:  SUBCIRCUIT NAME MISSING'/)
      GO TO 40
  790 WRITE (IOFILE,791)
  791 FORMAT('*ERROR*:  SUBCIRCUIT NODES MISSING'/)
      GO TO 40
C
C  .ENDS PROCESSING
C
  800 IF (NSBCKT.EQ.0) GO TO 890
      IKNT=1
      IF (NODPLC(ICODE+2).LE.0) GO TO 820
      ANAM=VALUE(IFIELD+2)
      IKNT=NSBCKT
  810 LOC=NODPLC(ISBCKT+IKNT)
      LOCV=NODPLC(LOC+1)
      ANAMS=VALUE(LOCV)
      IF (ANAM.EQ.ANAMS) GO TO 820
      IKNT=IKNT-1
      IF (IKNT.NE.0) GO TO 810
      GO TO 880
  820 IREL=NSBCKT-IKNT+1
      CALL RELMEM(ISBCKT,IREL)
      NSBCKT=NSBCKT-IREL
      GO TO 50
  880 WRITE (IOFILE,881) ANAM
  881 FORMAT('*ERROR*:  UNKNOWN SUBCIRCUIT NAME:  ',A8/)
      GO TO 40
  890 WRITE (IOFILE,891)
  891 FORMAT('WARNING:  NO SUBCIRCUIT DEFINITION KNOWN -- LINE IGNORED'
     1/)
      GO TO 50
C
C  SUBCIRCUIT CALL
C
  900 CALL GETM4(NODPLC(LOC+2),0)
      IFLD=1
      IKNT=0
  910 IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 920
      CALL EXTMEM(NODPLC(LOC+2),1)
      IKNT=IKNT+1
      ISPOT=NODPLC(LOC+2)+IKNT
      IF (VALUE(IFIELD+IFLD).LT.0.0D0) GO TO 400
      NODPLC(ISPOT)=VALUE(IFIELD+IFLD)
      GO TO 910
  920 IF (IKNT.EQ.0) GO TO 410
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 990
      CALL EXTNAM(VALUE(IFIELD+IFLD),NODPLC(LOC+3))
      GO TO 50
  990 WRITE (IOFILE,991)
  991 FORMAT('*ERROR*:  SUBCIRCUIT NAME MISSING'/)
      GO TO 40
C
C  END
C
 5000 IF (NSBCKT.EQ.0) GO TO 5010
      NSBCKT=0
      WRITE (IOFILE,5001)
 5001 FORMAT('*ERROR*:  .ENDS  CARD MISSING'/)
      NOGO=1
 5010 CALL CLRMEM(IFIELD)
      CALL CLRMEM(ICODE)
      CALL CLRMEM(IDELIM)
      CALL CLRMEM(ICOLUM)
      CALL CLRMEM(ISBCKT)
      IF (NFOUR.EQ.0) CALL CLRMEM(IFOUR)
      IF (NSENS.EQ.0) CALL CLRMEM(ISENS)
 6000 CALL SECOND(T2)
      RSTATS(1)=T2-T1
      RETURN
      END
      DOUBLE PRECISION FUNCTION ALIAS(ANAM)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION ANAM1(14),ANAM2(14)
      DATA ANAM1 /3HVA ,3HVB ,3HCCS,3HNS ,3HC2 ,3HPT ,3HC4 ,
     1            3HPE ,3HME ,3HPC ,3HMC ,3HPS ,3HMS ,3HIK /
      DATA ANAM2 /3HVAF,3HVAR,3HCJS,3HNSS,3HISE,3HXTI,3HISC,
     1            3HVJE,3HMJE,3HVJC,3HMJC,3HVJS,3HMJS,3HIKF/
C
C  THIS FUNCTION RETURNS THE MGP EQUIVALENT OF THE GP PARAMETERS
C  (THOSE WHICH APPLY)
C
      IKNT=0
      ALIAS=ANAM
   10 IKNT=IKNT+1
      IF(IKNT.GT.14) RETURN
      IF(ANAM1(IKNT).NE.ANAM) GO TO 10
      ALIAS=ANAM2(IKNT)
      RETURN
      END
      SUBROUTINE KEYSRC(KEYTAB,LENTAB,TSTWRD,INDEX)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION KEYTAB
C
C     THIS ROUTINE SEARCHES THE KEYWORD TABLE 'KEYTAB' FOR THE POSSIBLE
C ENTRY 'TSTWRD'.  ABBREVIATIONS ARE CONSIDERED AS MATCHES.
C
      DIMENSION KEYTAB(LENTAB)
      INTEGER XXOR
      DATA ABLNK / 1H  /
C
C
      INDEX=0
      LENWRD=0
      ACHAR=ABLNK
      DO 10 I=1,8
      CALL MOVE(ACHAR,8,TSTWRD,I,1)
      IF (ACHAR.EQ.ABLNK) GO TO 20
      LENWRD=LENWRD+1
   10 CONTINUE
C
   20 IF (LENWRD.EQ.0) GO TO 40
      TSTCHR=ABLNK
      CALL MOVE(TSTCHR,8,TSTWRD,1,1)
   30 INDEX=INDEX+1
      IF (INDEX.GT.LENTAB) GO TO 40
      AKEY=ABLNK
      CALL MOVE(AKEY,1,KEYTAB(INDEX),1,LENWRD)
      IF (XXOR(AKEY,TSTWRD).EQ.0) GO TO 50
      GO TO 30
C
   40 INDEX=-1
   50 RETURN
      END
      SUBROUTINE EXTNAM(ANAME,INDEX)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE ADDS 'ANAME' TO THE LIST OF 'UNSATISFIED' NAMES (THAT
C IS, NAMES WHICH CAN ONLY BE RESOLVED AFTER SUBCIRCUIT EXPANSION).
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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
      INTEGER XXOR
C
C
      ANAM=ANAME
      IF (NUNSAT.EQ.0) GO TO 20
      DO 10 INDEX=1,NUNSAT
      IF (XXOR(ANAM,VALUE(IUNSAT+INDEX)).EQ.0) GO TO 30
   10 CONTINUE
C
   20 CALL EXTMEM(IUNSAT,1)
      NUNSAT=NUNSAT+1
      INDEX=NUNSAT
      VALUE(IUNSAT+INDEX)=ANAM
   30 RETURN
      END
      SUBROUTINE RUNCON(ID)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE PROCESSES RUN CONTROL CARDS.
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=CJE 3/15/83
      COMMON /CJE/ MAXTIM,ITIME,ICOST
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=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=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=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=DEBUG 3/15/83
      COMMON/DEBUG/ IDEBUG(20)
C SPICE VERSION 2G.6  SCCSID=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
      DIMENSION IPRNT(5),LIMITS(4),ITRLIM(6),CONTOL(6),DFLTS(4)
      EQUIVALENCE (IPRNT(1),IPRNTA),(LIMITS(1),LIMTIM),(ITRLIM(1),ITL1),
     1   (CONTOL(1),GMIN),(DFLTS(1),DEFL)
C
C
      INTEGER XXOR
C
C  PRINT/PLOT KEYWORDS
C
      DIMENSION AOPT(5)
      DIMENSION AOPTS(34),LSETOP(5)
      DIMENSION AIDE(20)
      DATA AOPT / 2HDC, 2HTR, 2HAC, 2HNO, 2HDI /
C
C  OPTIONS CARD KEYWORDS
C
      DATA AOPTS / 6HACCT  , 6HLIST  , 6HNOMOD , 6HNODE  , 6HOPTS  ,
     1             6HITL1  , 6HITL2  , 6HITL3  , 6HITL4  , 6HITL5  ,
     2             6HITL6  , 6HLIMTIM, 6HLIMPTS, 6HLVLCOD, 6HLVLTIM,
     3             6HGMIN  , 6HRELTOL, 6HABSTOL, 6HVNTOL , 6HTRTOL ,
     4             6HCHGTOL, 6HTNOM  , 6HNUMDGT, 6HMAXORD, 6HMETHOD,
     5             6HNOPAGE, 6HMU    , 6HCPTIME, 6HDEFL  , 6HDEFW  ,
     6             6HDEFAD , 6HDEFAS , 6HPIVTOL, 6HPIVREL /
      DATA LSETOP / 1 ,1, 0, 1, 1 /
C
C
      DATA AIDE / 1HR,1HC,1HL,1HK,1HG,1HE,1HF,1HH,1HV,1HI,1HD,1HQ,1HJ,
     1   1HM,1HS,1HY,1HT,4HTEMP,1HX,0.0D0 /
      DATA ALSDE,ALSOC,ALSLI / 3HDEC, 3HOCT, 3HLIN /
      DATA ATRAP, AGEAR, AUIC / 4HTRAP, 4HGEAR, 3HUIC /
      DATA ABLNK, AIN, AOUT / 1H , 2HIN, 3HOUT /
      DATA AMISS / 8H*MISSING /
      DATA AMS / 2HMS /
      DATA MINPTS / 1 /
C
C
      GO TO (1200,1100,1650,6000,6000,1700,6000,1600,1550,2000,3600,
     1   3500,6000,1750,1300,1500,1800,4000,4100,4200,5900), ID
C
C  DC TRANSFER CURVES
C
 1100 IFLD=2
      ICVFLG=0
      INUM=1
 1105 ANAM=VALUE(IFIELD+IFLD)
      IF(INUM.GT.2) GO TO 6000
      ID=0
      CALL MOVE(ANAM,2,ABLNK,1,7)
      IF (ANAM.EQ.AIDE(1)) ID=1
      IF (ANAM.EQ.AIDE(9)) ID=9
      IF (ANAM.EQ.AIDE(10)) ID=10
      IF (ANAM.EQ.AIDE(17)) GO TO 1108
      IF (ID.EQ.0) GO TO 1130
      CALL FIND(VALUE(IFIELD+IFLD),ID,ITCELM(INUM),0)
      GO TO 1115
 1108 ANAM=VALUE(IFIELD+IFLD)
      CALL MOVE(ANAM,5,ABLNK,1,4)
      IF (ANAM.NE.AIDE(18)) GO TO 1130
      ID=18
      CALL FIND(ANAM,ID,ITCELM(INUM),1)
      LOCS=NODPLC(ITCELM(INUM)+1)
      NODPLC(ITCELM(INUM)+2)=0
      VALUE(LOCS)=ANAM
      VALUE(LOCS+1)=VALUE(ITEMPS+1)
      CALL EXTMEM(ITEMPS,2)
      VALUE(ITEMPS+2)=VALUE(ITEMPS+1)
 1115 IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1130
      TCSTAR(INUM)=VALUE(IFIELD+IFLD)
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1130
      TCSTOP(INUM)=VALUE(IFIELD+IFLD)
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1130
      TCINCR(INUM)=VALUE(IFIELD+IFLD)
      IF (TCINCR(INUM).EQ.0.0D0) GO TO 1130
      TEMP=(TCSTOP(INUM)-TCSTAR(INUM))/TCINCR(INUM)
      IF (TEMP.GT.0.0D0) GO TO 1110
      TCINCR(INUM)=-TCINCR(INUM)
      TEMP=-TEMP
 1110 ITEMP=IDINT(TEMP+0.5D0)+1
      ITEMP=MAX0(ITEMP,MINPTS)
      IF(INUM.EQ.1) ICVFLG=ITEMP
      IF(INUM.EQ.2) ICVFLG=ITEMP*ICVFLG
      IFLD=IFLD+1
      INUM=2
      IF(NODPLC(ICODE+IFLD)) 6000,1130,1105
 1130 WRITE (IOFILE,1131)
      ICVFLG=0
 1131 FORMAT('WARNING:  MISSING PARAMETER(S) ... ANALYSIS OMITTED'/)
      GO TO 6000
C
C  FREQUENCY SPECIFICATION
C
 1200 IFLD=2
      IF (NODPLC(ICODE+2)) 1250,1250,1210
 1210 ID=0
      IF (VALUE(IFIELD+IFLD).EQ.ALSDE) ID=1
      IF (VALUE(IFIELD+IFLD).EQ.ALSOC) ID=2
      IF (VALUE(IFIELD+IFLD).EQ.ALSLI) ID=3
      IF (ID.EQ.0) GO TO 1240
      IDFREQ=ID
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1250
      IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 1250
      FINCR=VALUE(IFIELD+IFLD)
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1250
      IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 1250
      FSTART=VALUE(IFIELD+IFLD)
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1250
      IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 1250
      FSTOP=VALUE(IFIELD+IFLD)
      IF (FSTART.GT.FSTOP) GO TO 1260
      JACFLG=FINCR
      IF (IDFREQ-2) 1215,1220,1235
 1215 FINCR=DEXP(XLOG10/FINCR)
      GO TO 1230
 1220 FINCR=DEXP(XLOG2/FINCR)
 1230 TEMP=DLOG(FSTOP/FSTART)/DLOG(FINCR)
      JACFLG=IDINT(TEMP+0.999D0)+1
 1235 JACFLG=MAX0(JACFLG,MINPTS)
      IF (IDFREQ.NE.3) GO TO 6000
      FINCR=(FSTOP-FSTART)/DFLOAT(MAX0(JACFLG-1,1))
      GO TO 6000
 1240 WRITE (IOFILE,1241) VALUE(IFIELD+IFLD)
 1241 FORMAT('WARNING:  UNKNOWN FREQUENCY FUNCTION:  ',A8,' ... ANALYS'
     1   ,'IS OMITTED'/)
      GO TO 6000
 1250 WRITE (IOFILE,1251)
 1251 FORMAT('WARNING:  FREQUENCY PARAMETERS INCORRECT ... ANALYSIS OM'
     1   ,'ITTED'/)
      GO TO 6000
 1260 WRITE (IOFILE,1261)
 1261 FORMAT('WARNING:  START FREQ > STOP FREQ ... ANALYSIS OMITTED'/)
      GO TO 6000
C
C  TIME SPECIFICATION
C
 1300 IFLD=2
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1430
      IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 1430
      TSTEP=VALUE(IFIELD+IFLD)
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1430
      IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 1430
      TSTOP=VALUE(IFIELD+IFLD)
      TSTART=0.0D0
      DELMAX=TSTOP/50.0D0
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1310
      IF (VALUE(IFIELD+IFLD).LT.0.0D0) GO TO 1430
      TSTART=VALUE(IFIELD+IFLD)
      DELMAX=(TSTOP-TSTART)/50.0D0
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1310
      IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 1430
      DELMAX=VALUE(IFIELD+IFLD)
      IFLD=IFLD+1
 1310 IF (NODPLC(ICODE+IFLD).NE.1) GO TO 1320
      IF (VALUE(IFIELD+IFLD).NE.AUIC) GO TO 1320
      NOSOLV=1
 1320 IF (TSTART.GT.TSTOP) GO TO 1440
      IF (TSTEP.GT.TSTOP) GO TO 1430
      JTRFLG=IDINT((TSTOP-TSTART)/TSTEP+0.5D0)+1
      JTRFLG=MAX0(JTRFLG,MINPTS)
      GO TO 6000
 1430 WRITE (IOFILE,1431)
 1431 FORMAT('WARNING:  TIME PARAMETERS INCORRECT ... ANALYSIS OMITTED'
     1   /)
      GO TO 6000
 1440 WRITE (IOFILE,1441)
 1441 FORMAT('WARNING:  START TIME > STOP TIME ... ANALYSIS OMITTED'/)
      GO TO 6000
C
C  TRANSFER FUNCTION
C
 1500 KSSOP=1
      IFLD=2
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 1530
      CALL OUTDEF(IFLD,1,KOVAR,KTYPE)
      IF (IGOOF.NE.0) GO TO 1530
      IF (KTYPE.NE.1) GO TO 1540
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 1530
      ANAM=VALUE(IFIELD+IFLD)
      CALL MOVE(ANAM,2,ABLNK,1,7)
      ID=0
      IF (ANAM.EQ.AIDE(9)) ID=9
      IF (ANAM.EQ.AIDE(10)) ID=10
      IF (ID.EQ.0) GO TO 1530
      CALL FIND(VALUE(IFIELD+IFLD),ID,KINEL,0)
      KIDIN=ID
      GO TO 6000
 1530 KOVAR=0
      KINEL=0
      WRITE (IOFILE,1131)
      IGOOF=0
      GO TO 6000
 1540 KOVAR=0
      KINEL=0
      WRITE (IOFILE,1541)
 1541 FORMAT('WARNING:  ILLEGAL OUTPUT VARIABLE ... ANALYSIS OMITTED'/)
      IGOOF=0
      GO TO 6000
C
C  OPERATING POINT
C
 1550 KSSOP=1
      GO TO 6000
C
C  NOISE ANALYSIS
C
 1600 IFLD=2
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 1610
      CALL OUTDEF(IFLD,2,NOSOUT,NTYPE)
      IF (IGOOF.NE.0) GO TO 1610
      IF (NTYPE.NE.1) GO TO 1610
      IF (NODPLC(NOSOUT+5).NE.0) GO TO 1610
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 1620
      ANAM=VALUE(IFIELD+IFLD)
      CALL MOVE(ANAM,2,ABLNK,1,7)
      ID=0
      IF (ANAM.EQ.AIDE(9)) ID=9
      IF (ANAM.EQ.AIDE(10)) ID=10
      IF (ID.EQ.0) GO TO 1620
      CALL FIND(VALUE(IFIELD+IFLD),ID,NOSIN,0)
      NOSPRT=0
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1605
      NOSPRT=DMAX1(0.0D0,VALUE(IFIELD+IFLD))
 1605 INOISE=1
      GO TO 6000
 1610 WRITE (IOFILE,1611)
 1611 FORMAT('WARNING:  VOLTAGE OUTPUT UNRECOGNIZABLE ... ANALYSIS OMIT
     1TED'/)
      IGOOF=0
      GO TO 6000
 1620 WRITE (IOFILE,1621)
 1621 FORMAT('WARNING:  INVALID INPUT SOURCE ... ANALYSIS OMITTED'/)
      IGOOF=0
      GO TO 6000
C
C  DISTORTION ANALYSIS
C
 1650 IFLD=2
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 1660
      ANAM=VALUE(IFIELD+IFLD)
      CALL MOVE(ANAM,2,ABLNK,1,7)
      IF (ANAM.NE.AIDE(1)) GO TO 1660
      CALL FIND(VALUE(IFIELD+IFLD),1,IDIST,0)
      IDPRT=0
      SKW2=0.9D0
      REFPRL=1.0D-3
      SPW2=1.0D0
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 6000
      IDPRT=VALUE(IFIELD+IFLD)
      IDPRT=MAX0(IDPRT,0)
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 6000
      IF (VALUE(IFIELD+IFLD).LE.0.001D0) GO TO 1670
      IF (VALUE(IFIELD+IFLD).GT.0.999D0) GO TO 1670
      SKW2=VALUE(IFIELD+IFLD)
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 6000
      IF (VALUE(IFIELD+IFLD).LT.1.0D-10) GO TO 1670
      REFPRL=VALUE(IFIELD+IFLD)
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 6000
      IF (VALUE(IFIELD+IFLD).LT.0.001D0) GO TO 1670
      SPW2=VALUE(IFIELD+IFLD)
      GO TO 6000
 1660 WRITE (IOFILE,1661)
 1661 FORMAT('WARNING:  DISTORTION LOAD RESISTOR MISSING ... ANALYSIS '
     1   ,'OMITTED'/)
      GO TO 6000
 1670 IDIST=0
      WRITE (IOFILE,1671)
 1671 FORMAT('WARNING:  DISTORTION PARAMETERS INCORRECT ... ANALYSIS O'
     1   ,'MITTED'/)
      GO TO 6000
C
C  FOURIER ANALYSIS
C
 1700 IFLD=2
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1720
      IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 1720
      FORFRE=VALUE(IFIELD+IFLD)
 1705 IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 1710
      CALL OUTDEF(IFLD,2,LOCT,LTYPE)
      IF (IGOOF.NE.0) GO TO 1720
      IF (LTYPE.NE.1) GO TO 1720
      CALL EXTMEM(IFOUR,1)
      NFOUR=NFOUR+1
      NODPLC(IFOUR+NFOUR)=LOCT
      GO TO 1705
 1710 IF (NFOUR.GE.1) GO TO 6000
 1720 WRITE (IOFILE,1721)
 1721 FORMAT('WARNING:  FOURIER PARAMETERS INCORRECT ... ANALYSIS OMIT'
     1   ,'TED'/)
      IGOOF=0
      NFOUR=0
      CALL CLRMEM(IFOUR)
      CALL GETM4(IFOUR,0)
      GO TO 6000
C
C  SENSITIVITY ANALYSIS
C
 1750 KSSOP=1
      IFLD=1
 1760 IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 6000
      CALL OUTDEF(IFLD,1,LOCT,LTYPE)
      IF (IGOOF.NE.0) GO TO 1780
      IF (LTYPE.NE.1) GO TO 1780
      CALL EXTMEM(ISENS,1)
      NSENS=NSENS+1
      NODPLC(ISENS+NSENS)=LOCT
      GO TO 1760
 1780 WRITE (IOFILE,1781)
 1781 FORMAT('WARNING:  OUTPUT VARIABLE UNRECOGNIZABLE ... ANALYSIS OM'
     1   ,'MITTED'/)
      IGOOF=0
      NSENS=0
      CALL CLRMEM(ISENS)
      CALL GETM4(ISENS,0)
      GO TO 6000
C
C  TEMPERATURE VARIATION
C
 1800 IFLD=1
 1810 IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 6000
      IF (VALUE(IFIELD+IFLD).LE.-223.0D0) GO TO 1810
      CALL EXTMEM(ITEMPS,1)
      NUMTEM=NUMTEM+1
      VALUE(ITEMPS+NUMTEM)=VALUE(IFIELD+IFLD)
      GO TO 1810
C
C  OPTIONS CARD
C
 2000 IFLD=1
 2010 IFLD=IFLD+1
 2020 IF (NODPLC(ICODE+IFLD)) 6000,2010,2030
 2030 ANAM=VALUE(IFIELD+IFLD)
      DO 2040 I=1,5
      IF (ANAM.NE.AOPTS(I)) GO TO 2040
      IPRNT(I)=LSETOP(I)
      IFLD=IFLD+1
      IF(NODPLC(ICODE+IFLD).NE.0) GO TO 2020
      IPRNT(I)=VALUE(IFIELD+IFLD)
      GO TO 2010
 2040 CONTINUE
      IF (ANAM.EQ.AOPTS(25)) GO TO 2110
      IF (ANAM.EQ.AOPTS(26)) GO TO 2120
      IF (ANAM.EQ.AOPTS(27)) GO TO 2130
      IF (ANAM.EQ.AOPTS(28)) GO TO 2150
      IF (ANAM.EQ.AOPTS(33)) GO TO 2200
      IF (ANAM.EQ.AOPTS(34)) GO TO 2250
      IF (NODPLC(ICODE+IFLD+1).NE.0) GO TO 2510
      IFLD=IFLD+1
      AVAL=VALUE(IFIELD+IFLD)
      DO 2050 I=6,11
      IF (ANAM.NE.AOPTS(I)) GO TO 2050
      IF(AVAL.LE.0.0D0.AND.I.NE.10) GO TO 2510
      ITRLIM(I-5)=AVAL
      GO TO 2010
 2050 CONTINUE
      IF (AVAL.LE.0.0D0) GO TO 2510
      DO 2060 I=12,15
      IF (ANAM.NE.AOPTS(I)) GO TO 2060
      LIMITS(I-11)=AVAL
      GO TO 2010
 2060 CONTINUE
      DO 2070 I=16,21
      IF (ANAM.NE.AOPTS(I)) GO TO 2070
      CONTOL(I-15)=AVAL
      GO TO 2010
 2070 CONTINUE
      DO 2075 I=29,32
      IF(ANAM.NE.AOPTS(I)) GO TO 2075
      DFLTS(I-28)=AVAL
      GO TO 2010
 2075 CONTINUE
      IF (ANAM.NE.AOPTS(22)) GO TO 2080
      IF (AVAL.LT.-223.0D0) GO TO 2510
      VALUE(ITEMPS+1)=AVAL
      GO TO 2010
 2080 IF (ANAM.NE.AOPTS(23)) GO TO 2100
      NDIGIT=AVAL
      IF (NDIGIT.LE.7) GO TO 2090
      NDIGIT=7
      WRITE (IOFILE,2081) NDIGIT
 2081 FORMAT('WARNING:  NUMDGT MAY NOT EXCEED',I2,
     1 ';  MAXIMUM VALUE ASSUMED'/)
 2090 NUMDGT=NDIGIT
      GO TO 2010
 2100 IF (ANAM.NE.AOPTS(24)) GO TO 2500
      N=AVAL
      IF ((N.LE.1).OR.(N.GE.7)) GO TO 2510
      MAXORD=N
      GO TO 2010
 2110 IF (NODPLC(ICODE+IFLD+1).NE.1) GO TO 2510
      IFLD=IFLD+1
      ANAM=VALUE(IFIELD+IFLD)
      CALL MOVE(ANAM,5,ABLNK,1,4)
      JTYPE=0
      IF (ANAM.EQ.ATRAP) JTYPE=1
      IF (ANAM.EQ.AGEAR) JTYPE=2
      IF (JTYPE.EQ.0) GO TO 2510
      METHOD=JTYPE
      GO TO 2010
 2120 NOPAGE=1
      GO TO 2010
 2130 IFLD=IFLD+1
      IF(NODPLC(ICODE+IFLD)) 6000,2140,2030
 2140 AVAL=VALUE(IFIELD+IFLD)
      IF(AVAL.LT.0.0D0.OR.AVAL.GT.0.500001D0) GO TO 2510
      XMU=AVAL
      GO TO 2010
 2150 IFLD=IFLD+1
      IF(NODPLC(ICODE+IFLD)) 6000,2160,2030
 2160 AVAL=VALUE(IFIELD+IFLD)
      MAXTIM=AVAL
      GO TO 2010
 2200 IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 6000,2210,2030
 2210 AVAL=VALUE(IFIELD+IFLD)
      IF (AVAL.GT.1.0D0) GO TO 2510
      PIVTOL=AVAL
      GO TO 2010
 2250 IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 6000,2260,2030
 2260 AVAL=VALUE(IFIELD+IFLD)
      IF (AVAL.GT.1.0D0) GO TO 2510
      PIVREL=AVAL
      GO TO 2010
 2500 WRITE (IOFILE,2501) ANAM
 2501 FORMAT('WARNING:  UNKNOWN OPTION:  ',A8,' ... IGNORED'/)
      GO TO 2010
 2510 WRITE (IOFILE,2511) ANAM
 2511 FORMAT('WARNING:  ILLEGAL VALUE SPECIFIED FOR OPTION:  ',A8,' ...
     1 IGNORED'/)
      GO TO 2010
C
C  PRINT CARD
C
 3500 IPRPL=0
      GO TO 3610
C
C  PLOT (AND PRINT) CARD
C
 3600 IPRPL=1
 3610 IFLD=2
 3613 ANAM=AMISS
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 3950
      ANAM=VALUE(IFIELD+IFLD)
      MS=0
      IF (XXOR(ANAM,AMS).NE.0) GO TO 3615
      MS=1
      IFLD=3
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 3970
      ANAM=VALUE(IFIELD+IFLD)
 3615 CALL MOVE(ANAM,3,ABLNK,1,6)
      DO 3620 I=1,5
      IF (ANAM.NE.AOPT(I)) GO TO 3620
      KTYPE=I
      GO TO 3630
 3620 CONTINUE
      GO TO 3950
 3630 ID=30+5*IPRPL+KTYPE
      CALL FIND(DFLOAT(JELCNT(ID)),ID,LOC,1)
      NODPLC(LOC+2)=KTYPE
      IF (MS.EQ.0) GO TO 3635
      LOCV=NODPLC(LOC+1)
      VALUE(LOCV)=0.0D0
 3635 NUMOUT=0
 3640 IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 3900,3640,3650
 3650 CALL OUTDEF(IFLD,KTYPE,LOCT,LTYPE)
      IF (IGOOF.NE.0) GO TO 3970
      IF (IPRPL.EQ.0) GO TO 3660
      PLIMLO=0.0D0
      PLIMHI=0.0D0
      IF (NODPLC(ICODE+IFLD+1).NE.0) GO TO 3660
      IF (NODPLC(ICODE+IFLD+2).NE.0) GO TO 3660
      PLIMLO=VALUE(IFIELD+IFLD+1)
      PLIMHI=VALUE(IFIELD+IFLD+2)
      IFLD=IFLD+2
 3660 NUMOUT=NUMOUT+1
      LSPOT=LOC+2*NUMOUT+2
      NODPLC(LSPOT)=LOCT
      NODPLC(LSPOT+1)=LTYPE
      IF (IPRPL.EQ.0) GO TO 3670
      LOCV=NODPLC(LOC+1)
      LSPOT=LOCV+2*NUMOUT-1
      VALUE(LSPOT)=PLIMLO
      VALUE(LSPOT+1)=PLIMHI
 3670 IF (NUMOUT.EQ.8) GO TO 3900
      GO TO 3640
 3900 NODPLC(LOC+3)=NUMOUT
      IF (IPRPL.EQ.0) GO TO 6000
C...  PROPOGATE PLOT LIMITS DOWNWARD
      IF (NUMOUT.LE.1) GO TO 6000
      LOCV=NODPLC(LOC+1)
      LSPOT=LOCV+2*NUMOUT-1
      PLIMLO=VALUE(LSPOT)
      PLIMHI=VALUE(LSPOT+1)
      I=NUMOUT-1
 3905 LSPOT=LSPOT-2
      IF (VALUE(LSPOT).NE.0.0D0) GO TO 3910
      IF (VALUE(LSPOT+1).NE.0.0D0) GO TO 3910
      VALUE(LSPOT)=PLIMLO
      VALUE(LSPOT+1)=PLIMHI
      GO TO 3920
 3910 PLIMLO=VALUE(LSPOT)
      PLIMHI=VALUE(LSPOT+1)
 3920 I=I-1
      IF (I.GE.1) GO TO 3905
      GO TO 6000
C
C     ERRORS
C
 3950 WRITE (IOFILE,3951) ANAM
 3951 FORMAT('WARNING:  UNKNOWN ANALYSIS MODE:  ',A8,
     1  ' ... LINE IGNORED'/)
      GO TO 6000
 3970 WRITE (IOFILE,3971)
 3971 FORMAT('WARNING:  UNRECOGNIZABLE OUTPUT VARIABLE ON ABOVE LINE'/)
      IGOOF=0
      GO TO 3640
C
C  WIDTH CARD
C
 4000 IFLD=1
 4010 IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 6000
 4020 ANAM=VALUE(IFIELD+IFLD)
      IF (ANAM.NE.AIN) GO TO 4040
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 6000,4030,4020
 4030 IWIDTH=VALUE(IFIELD+IFLD)
      IWIDTH=MIN0(MAX0(IWIDTH,10),120)
      GO TO 4010
 4040 IF (ANAM.NE.AOUT) GO TO 6000
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 6000,4050,4020
 4050 LWIDTH=DMIN1(DMAX1(VALUE(IFIELD+IFLD),72.0D0),132.0D0)
      GO TO 4010
C
C  NODESET STATEMENT
C
 4100 IFLD=1
 4110 IFLD=IFLD+1
      IF(NODPLC(ICODE+IFLD)) 6000,4120,4110
 4120 NODNUM=VALUE(IFIELD+IFLD)
      IF(NODNUM.LE.0) GO TO 4190
      IFLD=IFLD+1
      IF(NODPLC(ICODE+IFLD)) 4180,4130,4170
 4130 CALL SIZMEM(NSNOD,NIC)
      CALL EXTMEM(NSNOD,1)
      CALL EXTMEM(NSVAL,1)
      NODPLC(NSNOD+NIC+1)=NODNUM
      VALUE(NSVAL+NIC+1)=VALUE(IFIELD+IFLD)
      GO TO 4110
C
C  ERRORS ON .NODESET STATEMENT
C
 4170 WRITE(IOFILE,4171) VALUE(IFIELD+IFLD)
 4171 FORMAT('WARNING: OUT-OF-PLACE NON-NUMERIC FIELD ',A8,
     1 ' SKIPPED'/)
      GO TO 4110
 4180 WRITE(IOFILE,4181) NODNUM
 4181 FORMAT('WARNING: INITIAL VALUE MISSING FOR NODE ',I5,/)
      GO TO 6000
 4190 WRITE(IOFILE,4191)
 4191 FORMAT('WARNING: ATTEMPT TO SPECIFY INITIAL CONDITION FOR ',
     1 'GROUND INGNORED',/)
      IFLD=IFLD+1
      IF(NODPLC(ICODE+IFLD)) 6000,4110,4170
C
C  INITIAL CONDITIONS STATEMENT
C
 4200 IFLD=1
 4210 IFLD=IFLD+1
      IF(NODPLC(ICODE+IFLD)) 6000,4220,4210
 4220 NODNUM=VALUE(IFIELD+IFLD)
      IF(NODNUM.LE.0) GO TO 4290
      IFLD=IFLD+1
      IF(NODPLC(ICODE+IFLD)) 4280,4230,4270
 4230 CALL SIZMEM(ICNOD,NIC)
      CALL EXTMEM(ICNOD,1)
      CALL EXTMEM(ICVAL,1)
      NODPLC(ICNOD+NIC+1)=NODNUM
      VALUE(ICVAL+NIC+1)=VALUE(IFIELD+IFLD)
      GO TO 4210
C
C  ERRORS ON .IC STATEMENT
C
 4270 WRITE(IOFILE,4271) VALUE(IFIELD+IFLD)
 4271 FORMAT('WARNING: OUT-OF-PLACE NON-NUMERIC FIELD ',A8,
     1 ' SKIPPED'/)
      GO TO 4210
 4280 WRITE(IOFILE,4281) NODNUM
 4281 FORMAT('WARNING: INITIAL VALUE MISSING FOR NODE ',I5,/)
      GO TO 6000
 4290 WRITE(IOFILE,4291)
 4291 FORMAT('WARNING: ATTEMPT TO SPECIFY INITIAL CONDITION FOR ',
     1 'GROUND IGNORED',/)
      IFLD=IFLD+1
      IF(NODPLC(ICODE+IFLD)) 6000,4210,4270
C
C     :DEBUG: STATEMENT
C     SAMPLE DEBUG LINE: .:DEBUG: 5=3 17=5
C
 5900 IFLD=1
 5910 IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 6000,5920,5910
 5920 INDEX=VALUE(IFIELD+IFLD)
      IFLD=IFLD+1
      IF (NODPLC(ICODE+IFLD)) 6000,5930,5910
 5930 IVAL=VALUE(IFIELD+IFLD)
      IF (INDEX.LT.1) GO TO 5910
      IF (INDEX.GT.20) GO TO 5910
      WRITE(IOFILE,5931) INDEX,IVAL
 5931 FORMAT(' *DEBUG*:  RUNCON - IDEBUG(',I2,') SET TO ',I10)
      IDEBUG(INDEX)=IVAL
      GO TO 5910
C
C  FINISHED
C
 6000 RETURN
      END
      SUBROUTINE OUTDEF(IFLD,MODE,LOCT,LTYPE)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE CONSTRUCTS THE INTERNAL LIST ELEMENT FOR AN OUTPUT
C VARIABLE DEFINED ON SOME INPUT CARD.
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=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(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
      INTEGER XXOR
      DIMENSION AOUT(19),AOPTS(5)
      DATA AOUT / 4HV   , 4HVM  , 4HVR  , 4HVI  , 4HVP  , 4HVDB ,
     1            4HI   , 4HIM  , 4HIR  , 4HII  , 4HIP  , 4HIDB ,
     2            4HONOI, 4HINOI, 4HHD2 , 4HHD3 , 4HDIM2, 4HSIM2,
     3            4HDIM3 /
      DATA AOPTS / 1HM, 1HR, 1HI, 1HP, 1HD /
      DATA ALPRN, ACOMMA, ABLNK, ALETV / 1H(, 1H,, 1H , 1HV /
C
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 300
      ANAM=VALUE(IFIELD+IFLD)
      CALL MOVE(ANAM,5,ABLNK,1,4)
      DO 10 I=1,19
      IF (XXOR(ANAM,AOUT(I)).NE.0) GO TO 10
      IDOUT=I
      GO TO 20
   10 CONTINUE
      GO TO 300
C
C  FURTHER ERROR CHECKING
C
   20 IF (MODE.GE.3) GO TO 25
C...  DC OR TRAN
      IF ((IDOUT.NE.1).AND.(IDOUT.NE.7)) GO TO 300
      GO TO 38
   25 IF (MODE.GE.4) GO TO 30
C...  AC
      IF (IDOUT.GE.13) GO TO 300
      GO TO 38
   30 IF (MODE.EQ.5) GO TO 35
C...  NOISE
      IF ((IDOUT.NE.13).AND.(IDOUT.NE.14)) GO TO 300
      GO TO 38
C...  DISTORTION
   35 IF (IDOUT.LT.15) GO TO 300
   38 KTYPE=0
      LTYPE=IDOUT
      IF (IDOUT.LT.7) GO TO 40
      KTYPE=1
      LTYPE=LTYPE-6
      IF (IDOUT.LT.13) GO TO 40
      KTYPE=IDOUT-11
      LTYPE=1
C
C  VOLTAGE OUTPUT
C
   40 ID=40+MODE
      IF (KTYPE.NE.0) GO TO 100
      IF (NODPLC(ICODE+IFLD+1).NE.0) GO TO 300
      IFLD=IFLD+1
      N1=VALUE(IFIELD+IFLD)
      IF (N1.LT.0) GO TO 300
      IF(N1.GT.9999) GO TO 300
      N2=0
      ADELIM=VALUE(IDELIM+IFLD)
      IF (ADELIM.EQ.ACOMMA) GO TO 45
      IF (ADELIM.NE.ABLNK) GO TO 50
   45 IF (NODPLC(ICODE+IFLD+1).NE.0) GO TO 300
      IFLD=IFLD+1
      N2=VALUE(IFIELD+IFLD)
      IF (N2.LT.0) GO TO 300
      IF(N2.GT.9999) GO TO 300
   50 OUTNAM=ABLNK
      IPOS=1
      CALL ALFNUM(N1,OUTNAM,IPOS)
      IPOS=5
      CALL ALFNUM(N2,OUTNAM,IPOS)
      CALL FIND(OUTNAM,ID,LOCT,0)
      NODPLC(LOCT+2)=N1
      NODPLC(LOCT+3)=N2
      GO TO 400
C
C  CURRENT OUTPUT
C
  100 IF (KTYPE.NE.1) GO TO 200
      IF (NODPLC(ICODE+IFLD+1).NE.1) GO TO 300
      IFLD=IFLD+1
      AVSRC=VALUE(IFIELD+IFLD)
      ACHEK=AVSRC
      CALL MOVE(ACHEK,2,ABLNK,1,7)
      IF (ACHEK.NE.ALETV) GO TO 300
      CALL FIND(AVSRC,ID,LOCT,0)
      CALL FIND(AVSRC,9,NODPLC(LOCT+2),0)
      NODPLC(LOCT+5)=1
      GO TO 400
C
C  NOISE OR DISTORTION OUTPUTS
C
  200 ID=44
      IF (KTYPE.GE.4) ID=ID+1
      IF (VALUE(IDELIM+IFLD).NE.ALPRN) GO TO 220
      IF (NODPLC(ICODE+IFLD+1).NE.1) GO TO 300
      IFLD=IFLD+1
      ATYPE=VALUE(IFIELD+IFLD)
      CALL MOVE(ATYPE,2,ABLNK,1,7)
      DO 210 I=1,5
      IF (ATYPE.NE.AOPTS(I)) GO TO 210
      LTYPE=I+1
      GO TO 220
  210 CONTINUE
      GO TO 300
  220 CALL FIND(ANAM,ID,LOCT,0)
      NODPLC(LOCT+2)=0
      NODPLC(LOCT+5)=KTYPE
      GO TO 400
C
C  ERRORS
C
  300 IGOOF=1
C
C  FINISHED
C
  400 RETURN
      END
      SUBROUTINE CARD
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE SCANS THE INPUT LINES, STORING EACH FIELD INTO THE
C TABLES IFIELD, IDELIM, ICOLUM, AND ICODE.  WITH THE EXCEPTION OF THE
C '.END' LINE, CARD ALWAYS READS THE NEXT LINE TO CHECK FOR A POSSIBLE
C CONTINUATION BEFORE IT EXITS.
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=LINE 3/15/83
      COMMON /LINE/ ACHAR,AFIELD(15),OLDLIN(15),KNTRC,KNTLIM
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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
      DIMENSION ADIGIT(10)
      DATA ADIGIT / 1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9 /
      DATA ABLNK,APER,APLUS,AMINUS,ASTK / 1H , 1H., 1H+, 1H-, 1H* /
      DATA BG,AK,AU,AN,AP,AE,AM,AF,AT /1HG,1HK,1HU,1HN,1HP,1HE,1HM,
     1  1HF,1HT/
      DATA AI / 1HI /
      DATA ALPRN, ARPRN, AEQUAL / 1H(, 1H), 1H= /
      DATA AEND / 4H.END /
C
C      NOTE:  THE VALUE OF THE FUNCTION *NXTCHR* (USED EXTENSIVELY IN
C THIS ROUTINE) IS AS FOLLOWS:
C
C                    <0:  END-OF-LINE
C                    =0:  DELIMITER FOUND
C                    >0:  NON-DELIMITER FOUND
C
      NUMFLD=0
      NOFLD=10
      GO TO 20
C
C  READ NEXT CARD
C
   10 NOFLD=10
      CALL GETLIN
      IF (KEOF.EQ.0) GO TO 20
C...  ERROR:  UNEXPECTED END-OF-FILE CONDITION ON INPUT
   15 KEOF=1
      NOFLD=1
      NUMFLD=0
      IGOOF=1
      WRITE (IOFILE,16)
   16 FORMAT('*ERROR*:  .END CARD MISSING'/)
      GO TO 1000
C
C  ELIMINATE TRAILING BLANKS RAPIDLY
C
   20 IF (AFIELD(NOFLD).NE.ABLNK) GO TO 40
      IF (NOFLD.EQ.1) GO TO 30
      NOFLD=NOFLD-1
      GO TO 20
C...  WRITE BLANK CARD
   30 WRITE (IOFILE,31)
   31 FORMAT(1X)
      GO TO 10
C...  COPY THE CARD TO OUTPUT LISTING
   40 WRITE (IOFILE,41) (AFIELD(I),I=1,NOFLD)
   41 FORMAT(1X,10A8)
C
C  INITIALIZATION FOR NEW CARD
C
   45 KNTRC=0
      KNTLIM=MIN0(8*NOFLD,IWIDTH)
C
C  FETCH FIRST NON-DELIMITER (SEE ROUTINE *NXTCHR* FOR LIST)
C
   50 IF (NXTCHR(0)) 600,50,60
C...  CHECK FOR COMMENT (LEADING ASTERISK)
   60 IF (ACHAR.EQ.ASTK) GO TO 10
      GO TO 100
C
C  FETCH NEXT CHARACTER
C
   70 IF (NXTCHR(0)) 600,80,100
C
C  TWO CONSECUTIVE DELIMITERS IMPLY NUMERIC ZERO UNLESS THE DELIMITER
C  IS A BLANK OR PARENTHESIS.
C
   80 IF (ACHAR.EQ.ABLNK) GO TO 70
      IF (ACHAR.EQ.ALPRN) GO TO 70
      IF (ACHAR.EQ.ARPRN) GO TO 70
      IF (ACHAR.EQ.AEQUAL) GO TO 70
C...  CHECK FOR SUFFICIENT SPACE IN STORAGE ARRAYS
      IF (NUMFLD.LT.INSIZE-1) GO TO 90
      CALL EXTMEM(IFIELD,50)
      CALL EXTMEM(ICODE,50)
      CALL EXTMEM(IDELIM,50)
      CALL EXTMEM(ICOLUM,50)
      INSIZE=INSIZE+50
   90 NUMFLD=NUMFLD+1
      VALUE(IFIELD+NUMFLD)=0.0D0
      NODPLC(ICODE+NUMFLD)=0
      VALUE(IDELIM+NUMFLD)=ACHAR
      NODPLC(ICOLUM+NUMFLD)=KNTRC
      GO TO 70
C
C  CHECK FOR SUFFICIENT SPACE IN STORAGE ARRAYS
C
  100 IF (NUMFLD.LT.INSIZE-1) GO TO 110
      CALL EXTMEM(IFIELD,50)
      CALL EXTMEM(ICODE,50)
      CALL EXTMEM(IDELIM,50)
      CALL EXTMEM(ICOLUM,50)
      INSIZE=INSIZE+50
C
C  BEGIN SCAN OF NEXT FIELD
C
C...  INITIALIZATION
  110 JDELIM=0
      XSIGN=1.0D0
      XMANT=0.0D0
      IDEC=0
      IEXP=0
C...  CHECK FOR LEADING PLUS OR MINUS SIGN
      IF (ACHAR.EQ.APLUS) GO TO 210
      IF (ACHAR.EQ.AMINUS) GO TO 200
C...  FINISH INITIALIZATION
      ANAM=ABLNK
      KCHR=1
C...  AN ISOLATED PERIOD INDICATES THAT A CONTINUATION CARD FOLLOWS
      IF (ACHAR.NE.APER) GO TO 120
C...  ALTER INITIALIZATION SLIGHTLY IF LEADING PERIOD FOUND
      IDEC=1
      IEXP=-1
      ANAM=APER
      KCHR=2
C...  NOW TAKE A LOOK AT THE NEXT CHARACTER
      IF (NXTCHR(0)) 10,10,120
C
C  TEST FOR NUMBER (ANY DIGIT)
C
  120 DO 130 I=1,10
      IF (ACHAR.NE.ADIGIT(I)) GO TO 130
      XMANT=DFLOAT(I-1)
      GO TO 210
  130 CONTINUE
C
C  ASSEMBLE NAME
C
      NUMFLD=NUMFLD+1
      CALL MOVE(ANAM,KCHR,ACHAR,1,1)
      KCHR=KCHR+1
      DO 150 I=KCHR,8
      IF (NXTCHR(0)) 160,160,140
  140 CALL MOVE(ANAM,I,ACHAR,1,1)
  150 CONTINUE
      GO TO 170
  160 JDELIM=1
  170 VALUE(IFIELD+NUMFLD)=ANAM
      NODPLC(ICODE+NUMFLD)=1
      NODPLC(ICOLUM+NUMFLD)=KNTRC
C...  NO '+' FORMAT CONTINUATION POSSIBLE FOR .END CARD
      IF (NUMFLD.GE.2) GO TO 400
      IF (ANAM.NE.AEND) GO TO 400
      NODPLC(ICODE+NUMFLD+1)=-1
      GO TO 1000
C
C  PROCESS NUMBER
C
C...  TAKE NOTE OF LEADING MINUS SIGN
  200 XSIGN=-1.0D0
C...  TAKE A LOOK AT THE NEXT CHARACTER
  210 IF (NXTCHR(0)) 335,335,220
C...  TEST FOR DIGIT
  220 DO 230 I=1,10
      IF (ACHAR.NE.ADIGIT(I)) GO TO 230
      XMANT=XMANT*10.0D0+DFLOAT(I-1)
      IF (IDEC.EQ.0) GO TO 210
      IEXP=IEXP-1
      GO TO 210
  230 CONTINUE
C
C  CHECK FOR DECIMAL POINT
C
      IF (ACHAR.NE.APER) GO TO 240
C...  MAKE CERTAIN THAT THIS IS THE FIRST ONE FOUND
      IF (IDEC.NE.0) GO TO 500
      IDEC=1
      GO TO 210
C
C  TEST FOR EXPONENT
C
  240 IF (ACHAR.NE.AE) GO TO 300
      IF (NXTCHR(0)) 335,335,250
  250 ITEMP=0
      ISIGN=1
C...  CHECK FOR POSSIBLE LEADING SIGN ON EXPONENT
      IF (ACHAR.EQ.APLUS) GO TO 260
      IF (ACHAR.NE.AMINUS) GO TO 270
      ISIGN=-1
  260 IF (NXTCHR(0)) 285,285,270
C...  TEST FOR DIGIT
  270 DO 280 I=1,10
      IF (ACHAR.NE.ADIGIT(I)) GO TO 280
      ITEMP=ITEMP*10+I-1
      GO TO 260
  280 CONTINUE
      GO TO 290
  285 JDELIM=1
C...  CORRECT INTERNAL EXPONENT
  290 IEXP=IEXP+ISIGN*ITEMP
      GO TO 340
C
C  TEST FOR SCALE FACTOR
C
  300 IF (ACHAR.NE.AM) GO TO 330
C...  SPECIAL CHECK FOR *ME* (AS DISTINGUISHED FROM *M*)
      IF (NXTCHR(0)) 320,320,310
  310 IF (ACHAR.NE.AE) GO TO 315
      IEXP=IEXP+6
      GO TO 340
  315 IF (ACHAR.NE.AI) GO TO 325
      XMANT=XMANT*25.4D-6
      GO TO 340
  320 JDELIM=1
  325 IEXP=IEXP-3
      GO TO 340
  330 IF (ACHAR.EQ.AT) IEXP=IEXP+12
      IF (ACHAR.EQ.BG) IEXP=IEXP+9
      IF (ACHAR.EQ.AK) IEXP=IEXP+3
      IF (ACHAR.EQ.AU) IEXP=IEXP-6
      IF (ACHAR.EQ.AN) IEXP=IEXP-9
      IF (ACHAR.EQ.AP) IEXP=IEXP-12
      IF (ACHAR.EQ.AF) IEXP=IEXP-15
      GO TO 340
  335 JDELIM=1
C
C  ASSEMBLE THE FINAL NUMBER
C
  340 IF (XMANT.EQ.0.0D0) GO TO 350
      IF (IEXP.EQ.0) GO TO 350
      IF (IABS(IEXP).GE.201) GO TO 500
      XMANT=XMANT*DEXP(DFLOAT(IEXP)*XLOG10)
      IF (XMANT.GT.1.0D+35) GO TO 500
      IF (XMANT.LT.1.0D-35) GO TO 500
  350 NUMFLD=NUMFLD+1
      VALUE(IFIELD+NUMFLD)=DSIGN(XMANT,XSIGN)
      NODPLC(ICODE+NUMFLD)=0
      NODPLC(ICOLUM+NUMFLD)=KNTRC
C
C  SKIP TO NON-BLANK DELIMITER (IF NECESSARY)
C
  400 IF (JDELIM.EQ.0) GO TO 440
  410 VALUE(IDELIM+NUMFLD)=ACHAR
      IF (ACHAR.NE.ABLNK) GO TO 70
      IF (NXTCHR(0)) 450,410,420
  420 KNTRC=KNTRC-1
      GO TO 70
  440 IF (NXTCHR(0)) 450,410,440
  450 VALUE(IDELIM+NUMFLD)=ACHAR
      GO TO 600
C
C  ERRORS
C
  500 WRITE (IOFILE,501) KNTRC
  501 FORMAT('*ERROR*:  ILLEGAL NUMBER -- SCAN STOPPED AT COLUMN ',I3/)
      IGOOF=1
      NUMFLD=NUMFLD+1
      VALUE(IFIELD+NUMFLD)=0.0D0
      NODPLC(ICODE+NUMFLD)=0
      VALUE(IDELIM+NUMFLD)=ACHAR
      NODPLC(ICOLUM+NUMFLD)=KNTRC
C
C  FINISHED
C
  600 NODPLC(ICODE+NUMFLD+1)=-1
C
C  CHECK NEXT LINE FOR POSSIBLE CONTINUATION
C
  610 CALL GETLIN
      IF (KEOF.EQ.1) GO TO 15
      NOFLD=10
  620 IF (AFIELD(NOFLD).NE.ABLNK) GO TO 630
      IF (NOFLD.EQ.1) GO TO 650
      NOFLD=NOFLD-1
      GO TO 620
  630 KNTRC=0
      KNTLIM=MIN0(8*NOFLD,IWIDTH)
C...  CONTINUATION LINE HAS A '+' AS FIRST NON-DELIMITER ON CARD
  632 IF(NXTCHR(0)) 650,632,634
  634 IF(ACHAR.NE.APLUS) GO TO 640
      WRITE(IOFILE,41) (AFIELD(I),I=1,NOFLD)
      GO TO 70
  640 IF (ACHAR.NE.ASTK) GO TO 1000
  650 WRITE (IOFILE,41) (AFIELD(I),I=1,NOFLD)
      GO TO 610
 1000 RETURN
      END
      SUBROUTINE GETLIN
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE READS THE NEXT LINE OF INPUT INTO THE ARRAY AFIELD.
C IF END-OF-FILE IS FOUND, THE VARIABLE KEOF IS SET TO 1.
C
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=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=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
C
      CALL COPY8(AFIELD,OLDLIN,15)
      READ(5,6,END=10) (AFIELD(I),I=1,10)
      GO TO 100
    6 FORMAT(10A8)
   10 KEOF=1
  100 CALL USHIFT(AFIELD)
      RETURN
      END
      SUBROUTINE USHIFT(LINE)
C
C..   THIS ROUTINE UPSHIFTS AN INPUT LINE
C
      INTEGER*2 ICHAR1,ICHAR2,LINE(40)
      DO 3 I=1,40
      ICHAR1 = LINE(I) / 256
C..   IF THE TOP BYTE IS BETWEEN 'a' AND 'z', UPSHIFTS IT ...
      IF(.NOT.(ICHAR1 .GE. 97 .AND. ICHAR1 .LE.122)) GOTO 1
      ICHAR1 = ICHAR1 - 32
    1 ICHAR2 = LINE(I) - 256 * (LINE(I) / 256)
C..   IF THE BOTTOM BYTE IS BETWEEN 'a' AND 'z', UPSHIFTS IT ...
      IF(.NOT.(ICHAR2 .GE. 97 .AND. ICHAR2 .LE.122)) GOTO 2
      ICHAR2 = ICHAR2 - 32
    2 LINE(I) = (256 * ICHAR1) + ICHAR2
    3 CONTINUE
      RETURN
      END
      INTEGER FUNCTION NXTCHR(INT)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE ADVANCES THE CURRENT LINE SCAN POINTER ONE COLUMN
C     AND CHECKS WHETHER OR NOT THE NEXT CHARACTER IS A DELIMITER
C
C SPICE VERSION 2G.6  SCCSID=LINE 3/15/83
      COMMON /LINE/ ACHAR,AFIELD(15),OLDLIN(15),KNTRC,KNTLIM
C
      DIMENSION ADELIM(5)
      DATA ADELIM / 1H , 1H,, 1H=, 1H(, 1H) /
      DATA ABLNK / 1H  /
      DATA ICHAR /0/
C
C  ADVANCE SCAN POINTER (KNTRC)
C
      KNTRC=KNTRC+1
      IF (KNTRC.GT.KNTLIM) GO TO 30
      CALL MOVE(ACHAR,1,AFIELD,KNTRC,1)
    5 DO 10 I=1,5
      IF (ACHAR.EQ.ADELIM(I)) GO TO 20
   10 CONTINUE
C
C  NON-DELIMITER
C
      NXTCHR=1
      RETURN
C
C  DELIMITER
C
   20 NXTCHR=0
      RETURN
C
C  END-OF-LINE
C
   30 NXTCHR=-1
      ACHAR=ABLNK
      RETURN
      END
C SPICE VERSION 2G.6  SCCSID=errchk.ma 3/15/83
      SUBROUTINE ERRCHK
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      REAL T1, T2
C
C
C     THIS ROUTINE DRIVES THE PRE-PROCESSING AND GENERAL ERROR-CHECKING
C OF INPUT PERFORMED 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=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=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=CJE 3/15/83
      COMMON /CJE/ MAXTIM,ITIME,ICOST
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=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(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C
      DIMENSION TITLOP(4)
      DIMENSION NNODS(50),ANAME(2)
      DATA ANAME / 4HTRAP, 4HGEAR /
      DATA TITLOP / 8HOPTION S, 8HUMMARY  , 8H        , 8H         /
      DATA NDEFIN / 2H.U /
      DATA NNODS / 2, 2, 2, 0, 2, 2, 2, 2, 2, 2,
     1             2, 4, 3, 4, 0, 0, 4, 0, 1, 0,
     2             0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
     3             0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
     4             2, 2, 2, 0, 0, 0, 0, 0, 0, 0 /
      DATA AELMT,AMODEL,AOUTPT /7HELEMENT,5HMODEL,6HOUTPUT/
      DATA ALSDC,ALSTR,ALSAC / 2HDC, 4HTRAN, 2HAC /
C
C
      CALL SECOND(T1)
      DO 60 ID=1,50
      LOC=LOCATE(ID)
   10 IF (LOC.EQ.0) GO TO 60
      IF (NODPLC(LOC+2).NE.NDEFIN) GO TO 50
      NOGO=1
      LOCV=NODPLC(LOC+1)
      IF (ID.GE.21) GO TO 20
      ANAM=AELMT
      GO TO 40
   20 IF (ID.GE.31) GO TO 30
      ANAM=AMODEL
      GO TO 40
   30 ANAM=AOUTPT
   40 WRITE (IOFILE,41) ANAM,VALUE(LOCV)
   41 FORMAT('*ERROR*:  ',2A8,' HAS BEEN REFERENCED BUT NOT DEFINED'/)
   50 LOC=NODPLC(LOC)
      GO TO 10
   60 CONTINUE
      IF (NOGO.NE.0) GO TO 2000
C
C  CONSTRUCT ORDERED LIST OF USER SPECIFIED NODES
C
      CALL GETM4(JUNODE,1)
      NODPLC(JUNODE+1)=0
      NUNODS=1
      DO 180 ID=1,50
      IF (NNODS(ID).EQ.0) GO TO 180
      LOC=LOCATE(ID)
  110 IF (LOC.EQ.0) GO TO 180
      IF (ID.LE.4) GO TO 120
      IF (ID.LE.8) GO TO 150
      IF (ID.EQ.19) GO TO 165
      IF (ID.LE.40) GO TO 120
      IF (ID.LE.43) GO TO 170
  120 JSTOP=LOC+NNODS(ID)-1
      DO 130 J=LOC,JSTOP
      CALL PUTNOD(NODPLC(J+2))
  130 CONTINUE
      GO TO 170
  150 CALL PUTNOD(NODPLC(LOC+2))
      CALL PUTNOD(NODPLC(LOC+3))
      IF (ID.GE.7) GO TO 170
      LOCP=NODPLC(LOC+ID+1)
      NSSNOD=2*NODPLC(LOC+4)
  155 DO 160 J=1,NSSNOD
      CALL PUTNOD(NODPLC(LOCP+J))
  160 CONTINUE
      GO TO 170
  165 LOCP=NODPLC(LOC+2)
      CALL SIZMEM(NODPLC(LOC+2),NSSNOD)
      GO TO 155
  170 LOC=NODPLC(LOC)
      GO TO 110
  180 CONTINUE
      IF (NOGO.NE.0) GO TO 2000
      NCNODS=NUNODS
C
C  ASSIGN PROGRAM NODES
C
  200 DO 280 ID=1,50
      IF (NNODS(ID).EQ.0) GO TO 280
      LOC=LOCATE(ID)
  210 IF (LOC.EQ.0) GO TO 280
      IF (ID.LE.4) GO TO 220
      IF (ID.LE.8) GO TO 250
      IF (ID.EQ.19) GO TO 265
      IF (ID.LE.40) GO TO 220
      IF (ID.LE.43) GO TO 240
  220 JSTOP=LOC+NNODS(ID)-1
      DO 230 J=LOC,JSTOP
      CALL GETNOD(NODPLC(J+2))
  230 CONTINUE
      GO TO 270
  240 IF (NODPLC(LOC+5).EQ.0) GO TO 220
      GO TO 270
  250 CALL GETNOD(NODPLC(LOC+2))
      CALL GETNOD(NODPLC(LOC+3))
      IF (ID.GE.7) GO TO 270
      LOCP=NODPLC(LOC+ID+1)
      NSSNOD=2*NODPLC(LOC+4)
  255 DO 260 J=1,NSSNOD
      CALL GETNOD(NODPLC(LOCP+J))
  260 CONTINUE
      GO TO 270
  265 LOCP=NODPLC(LOC+2)
      CALL SIZMEM(NODPLC(LOC+2),NSSNOD)
      GO TO 255
  270 LOC=NODPLC(LOC)
      GO TO 210
  280 CONTINUE
C
C  CHECK AND SET .NODESET NODES TO THEIR INTERNAL VALUES
C
      CALL SIZMEM(NSNOD,NIC)
      IF(NIC.EQ.0) GO TO 300
      DO 290 I=1,NIC
      CALL GETNOD(NODPLC(NSNOD+I))
  290 CONTINUE
C
C   CHECK AND SET .IC NODES TO THEIR INTERNAL VALUES
C
  300 CALL SIZMEM(ICNOD,NIC)
      IF(NIC.EQ.0) GO TO 320
      DO 310 I=1,NIC
      CALL GETNOD(NODPLC(ICNOD+I))
  310 CONTINUE
  320 IF (NOGO.NE.0) GO TO 2000
C
C  EXPAND SUBCIRCUIT CALLS
C
      CALL SUBCKT
      IF (NOGO.NE.0) GO TO 2000
      IF (NCNODS.GE.2) GO TO 400
      WRITE (IOFILE,321)
  321 FORMAT('*ERROR*:  CIRCUIT HAS NO NODES'/)
      NOGO=1
      GO TO 2000
  400 NUMNOD=NCNODS
C
C  LINK UNSATISFIED REFERENCES
C
      CALL LNKREF
      IF (NOGO.NE.0) GO TO 2000
C
C  GENERATE SUBCIRCUIT ELEMENT NAMES
C
      IF (JELCNT(19).EQ.0) GO TO 530
      DO 520 ID=1,24
      LOC=LOCATE(ID)
  510 IF (LOC.EQ.0) GO TO 520
      CALL SUBNAM(LOC)
      LOC=NODPLC(LOC)
      GO TO 510
  520 CONTINUE
C
C  TRANSLATE NODE INITIAL CONDITIONS TO DEVICE INITIAL CONDITIONS
C  (CAPACITANCE, DIODE, BJT, JFET AND MOSFET ONLY) WHEN UIC IS
C  SPECIFIED ON THE .TRAN CARD
C
  530 IF (NOSOLV.LE.0) GO TO 600
      CALL SIZMEM(ICNOD,NIC)
      IF(NIC.EQ.0) GO TO 600
      CALL GETM8(LVNIM1,NUMNOD)
      CALL ZERO8(VALUE(LVNIM1+1),NUMNOD)
      DO 535 I=1,NIC
      NODE=NODPLC(ICNOD+I)
  535 VALUE(LVNIM1+NODE)=VALUE(ICVAL+I)
      LOC=LOCATE(2)
  540 IF(LOC.EQ.0) GO TO 550
      LOCV=NODPLC(LOC+1)
      IF(VALUE(LOCV+2).NE.0.0D0) GO TO 545
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      VALUE(LOCV+2)=VALUE(LVNIM1+NODE1)-VALUE(LVNIM1+NODE2)
  545 LOC=NODPLC(LOC)
      GO TO 540
  550 LOC=LOCATE(11)
  555 IF(LOC.EQ.0) GO TO 565
      LOCV=NODPLC(LOC+1)
      IF(VALUE(LOCV+2).NE.0.0D0) GO TO 560
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      VALUE(LOCV+2)=VALUE(LVNIM1+NODE1)-VALUE(LVNIM1+NODE2)
  560 LOC=NODPLC(LOC)
      GO TO 555
  565 LOC=LOCATE(12)
  570 IF(LOC.EQ.0) GO TO 580
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      NODE3=NODPLC(LOC+4)
      IF(VALUE(LOCV+2).EQ.0.0D0) VALUE(LOCV+2)=VALUE(LVNIM1+NODE2)-
     1  VALUE(LVNIM1+NODE3)
      IF(VALUE(LOCV+3).EQ.0.0D0) VALUE(LOCV+3)=VALUE(LVNIM1+NODE1)-
     1  VALUE(LVNIM1+NODE3)
      LOC=NODPLC(LOC)
      GO TO 570
  580 LOC=LOCATE(13)
  585 IF(LOC.EQ.0) GO TO 590
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      NODE3=NODPLC(LOC+4)
      IF(VALUE(LOCV+2).EQ.0.0D0) VALUE(LOCV+2)=VALUE(LVNIM1+NODE1)-
     1  VALUE(LVNIM1+NODE3)
      IF(VALUE(LOCV+3).EQ.0.0D0) VALUE(LOCV+3)=VALUE(LVNIM1+NODE2)-
     1  VALUE(LVNIM1+NODE3)
      LOC=NODPLC(LOC)
      GO TO 585
  590 LOC=LOCATE(14)
  595 IF(LOC.EQ.0) GO TO 598
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      NODE3=NODPLC(LOC+4)
      NODE4=NODPLC(LOC+5)
      IF(VALUE(LOCV+5).EQ.0.0D0) VALUE(LOCV+5)=VALUE(LVNIM1+NODE1)-
     1  VALUE(LVNIM1+NODE3)
      IF(VALUE(LOCV+6).EQ.0.0D0) VALUE(LOCV+6)=VALUE(LVNIM1+NODE2)-
     1  VALUE(LVNIM1+NODE3)
      IF(VALUE(LOCV+7).EQ.0.0D0) VALUE(LOCV+7)=VALUE(LVNIM1+NODE4)-
     1  VALUE(LVNIM1+NODE3)
      LOC=NODPLC(LOC)
      GO TO 595
  598 CALL CLRMEM(LVNIM1)
C
C  PROCESS SOURCES
C
  600 IF (JTRFLG.EQ.0) GO TO 700
      DO 690 ID=9,10
      LOC=LOCATE(ID)
  610 IF (LOC.EQ.0) GO TO 690
      LOCV=NODPLC(LOC+1)
      LOCP=NODPLC(LOC+5)
      JTYPE=NODPLC(LOC+4)+1
      GO TO (680,620,630,640,650,675), JTYPE
  620 VALUE(LOCP+3)=DMAX1(VALUE(LOCP+3),0.0D0)
      IF (VALUE(LOCP+4).LE.0.0D0) VALUE(LOCP+4)=TSTEP
      IF (VALUE(LOCP+5).LE.0.0D0) VALUE(LOCP+5)=TSTEP
      IF (VALUE(LOCP+6).LE.0.0D0) VALUE(LOCP+6)=TSTOP
      IF (VALUE(LOCP+7).LE.0.0D0) VALUE(LOCP+7)=TSTOP
      TEMP=VALUE(LOCP+4)+VALUE(LOCP+5)+VALUE(LOCP+6)
      VALUE(LOCP+7)=DMAX1(VALUE(LOCP+7),TEMP)
      VALUE(LOCV+1)=VALUE(LOCP+1)
      GO TO 680
  630 IF (VALUE(LOCP+3).LE.0.0D0) VALUE(LOCP+3)=1.0D0/TSTOP
      VALUE(LOCP+4)=DMAX1(VALUE(LOCP+4),0.0D0)
      VALUE(LOCV+1)=VALUE(LOCP+1)
      GO TO 680
  640 VALUE(LOCP+3)=DMAX1(VALUE(LOCP+3),0.0D0)
      IF (VALUE(LOCP+4).LE.0.0D0) VALUE(LOCP+4)=TSTEP
      IF (VALUE(LOCP+5).LE.VALUE(LOCP+3))
     1   VALUE(LOCP+5)=VALUE(LOCP+3)+TSTEP
      IF (VALUE(LOCP+6).LE.0.0D0) VALUE(LOCP+6)=TSTEP
      VALUE(LOCV+1)=VALUE(LOCP+1)
      GO TO 680
  650 VALUE(LOCP+1)=DMIN1(DMAX1(VALUE(LOCP+1),0.0D0),TSTOP)
      IKNT=1
      CALL SIZMEM(NODPLC(LOC+5),NUMP)
  660 TEMP=VALUE(LOCP+IKNT)
      IF (VALUE(LOCP+IKNT+2).EQ.0.0D0) GO TO 670
      IF (VALUE(LOCP+IKNT+2).GE.TSTOP) GO TO 670
      VALUE(LOCP+IKNT+2)=DMAX1(VALUE(LOCP+IKNT+2),TEMP)
      IF(TEMP.NE.VALUE(LOCP+IKNT+2)) GO TO 665
      WRITE(IOFILE,661) VALUE(LOCV)
  661 FORMAT('*ERROR*:  ELEMENT ',A8,' PIECEWISE LINEAR SOURCE TABLE NO
     1T INCREASING IN TIME')
      NOGO=1
  665 IKNT=IKNT+2
      IF (IKNT.LT.NUMP) GO TO 660
  670 VALUE(LOCP+IKNT+2)=TSTOP
      VALUE(LOCV+1)=VALUE(LOCP+2)
      CALL RELMEM(NODPLC(LOC+5),NUMP-IKNT-3)
      GO TO 680
  675 IF (VALUE(LOCP+3).LE.0.0D0) VALUE(LOCP+3)=1.0D0/TSTOP
      IF (VALUE(LOCP+5).LE.0.0D0) VALUE(LOCP+5)=1.0D0/TSTOP
      VALUE(LOCV+1)=VALUE(LOCP+1)
  680 LOC=NODPLC(LOC)
      GO TO 610
  690 CONTINUE
C
C  USE DEFAULT VALUES FOR MOS DEVICE GEOMETRIES IF NOT SPECIFIED
C
  700 LOC=LOCATE(14)
  710 IF(LOC.EQ.0) GO TO 720
      LOCV=NODPLC(LOC+1)
      IF(VALUE(LOCV+1).LE.0.0D0) VALUE(LOCV+1)=DEFL
      IF(VALUE(LOCV+2).LE.0.0D0) VALUE(LOCV+2)=DEFW
      IF(VALUE(LOCV+3).LE.0.0D0) VALUE(LOCV+3)=DEFAD
      IF(VALUE(LOCV+4).LE.0.0D0) VALUE(LOCV+4)=DEFAS
      LOC=NODPLC(LOC)
      GO TO 710
C
C  PRINT LISTING OF ELEMENTS, PROCESS DEVICE MODELS,
C  AND CHECK TOPOLOGY
C
  720 IF (IPRNTL.EQ.0) GO TO 730
      CALL ELPRNT
  730 CALL TOPCHK
      CALL MODCHK
      IF (NOGO.NE.0) GO TO 2000
C
C  INVERT RESISTANCE VALUES
C
  800 LOC=LOCATE(1)
  810 IF (LOC.EQ.0) GO TO 900
      LOCV=NODPLC(LOC+1)
      VALUE(LOCV+1)=1.0D0/VALUE(LOCV+2)
      LOC=NODPLC(LOC)
      GO TO 810
C
C  PROCESS MUTUAL INDUCTORS
C
  900 LOC=LOCATE(4)
  910 IF (LOC.EQ.0) GO TO 1000
      LOCV=NODPLC(LOC+1)
      NL1=NODPLC(LOC+2)
      LPTR1=NODPLC(NL1+1)
      NL2=NODPLC(LOC+3)
      LPTR2=NODPLC(NL2+1)
      VALUE(LOCV+1)=VALUE(LOCV+1)*DSQRT(VALUE(LPTR1+1)*VALUE(LPTR2+1))
      LOC=NODPLC(LOC)
      GO TO 910
C
C  LIMIT DELMAX  IF TRANSMISSION LINES IN CIRCUIT
C
 1000 IF (JTRFLG.EQ.0) GO TO 1200
      TDMAX=0.0D0
      LOC=LOCATE(17)
 1010 IF (LOC.EQ.0) GO TO 1200
      LOCV=NODPLC(LOC+1)
      DELMAX=DMIN1(DELMAX,VALUE(LOCV+2)/2.0D0)
      TDMAX=DMAX1(TDMAX,VALUE(LOCV+2))
      LOC=NODPLC(LOC)
      GO TO 1010
C
C  PROCESS SOURCE PARAMETERS
C
 1200 NUMBKP=0
      IF (JTRFLG.EQ.0) GO TO 1205
      TOL=1.0D-2*DELMAX
      NUMBKP=2
      CALL GETM8(LSBKPT,NUMBKP)
      VALUE(LSBKPT+1)=0.0D0
      VALUE(LSBKPT+2)=TSTOP
 1205 DO 1290 ID=9,10
      LOC=LOCATE(ID)
 1210 IF (LOC.EQ.0) GO TO 1290
      LOCV=NODPLC(LOC+1)
      LOCP=NODPLC(LOC+5)
      TEMP=VALUE(LOCV+3)/RAD
      VALUE(LOCV+3)=VALUE(LOCV+2)*DSIN(TEMP)
      VALUE(LOCV+2)=VALUE(LOCV+2)*DCOS(TEMP)
      IF (JTRFLG.EQ.0) GO TO 1280
      JTYPE=NODPLC(LOC+4)+1
      GO TO (1280,1220,1230,1235,1240,1260), JTYPE
 1220 VALUE(LOCP+4)=VALUE(LOCP+4)+VALUE(LOCP+3)
      TEMP=VALUE(LOCP+5)
      VALUE(LOCP+5)=VALUE(LOCP+4)+VALUE(LOCP+6)
      VALUE(LOCP+6)=VALUE(LOCP+5)+TEMP
      TIME=0.0D0
 1225 CALL EXTMEM(LSBKPT,4)
      VALUE(LSBKPT+NUMBKP+1)=VALUE(LOCP+3)+TIME
      VALUE(LSBKPT+NUMBKP+2)=VALUE(LOCP+4)+TIME
      VALUE(LSBKPT+NUMBKP+3)=VALUE(LOCP+5)+TIME
      VALUE(LSBKPT+NUMBKP+4)=VALUE(LOCP+6)+TIME
      NUMBKP=NUMBKP+4
      TIME=TIME+VALUE(LOCP+7)
      IF (TIME.GE.TSTOP) GO TO 1280
      GO TO 1225
 1230 VALUE(LOCP+3)=VALUE(LOCP+3)*TWOPI
      CALL EXTMEM(LSBKPT,1)
 1231 VALUE(LSBKPT+NUMBKP+1)=VALUE(LOCP+4)
      NUMBKP=NUMBKP+1
      GO TO 1280
 1235 CALL EXTMEM(LSBKPT,2)
      VALUE(LSBKPT+NUMBKP+1)=VALUE(LOCP+3)
      VALUE(LSBKPT+NUMBKP+2)=VALUE(LOCP+5)
      NUMBKP=NUMBKP+2
      GO TO 1280
 1240 IKNT=1
      CALL SIZMEM(NODPLC(LOC+5),NUMP)
 1250 CALL EXTMEM(LSBKPT,1)
      VALUE(LSBKPT+NUMBKP+1)=VALUE(LOCP+IKNT)
      NUMBKP=NUMBKP+1
      IKNT=IKNT+2
      IF (IKNT.LE.NUMP) GO TO 1250
      GO TO 1280
 1260 VALUE(LOCP+3)=VALUE(LOCP+3)*TWOPI
      VALUE(LOCP+5)=VALUE(LOCP+5)*TWOPI
 1280 LOC=NODPLC(LOC)
      GO TO 1210
 1290 CONTINUE
C
C  AUGMENT BREAKPOINT TABLE FOR TRANSMISSION LINE DELAYS
C
      IF (JTRFLG.EQ.0) GO TO 1300
      LOC=LOCATE(17)
 1292 IF (LOC.EQ.0) GO TO 1300
      LOCV=NODPLC(LOC+1)
      TD=VALUE(LOCV+2)
      NTEMP=NUMBKP
      DO 1296 IBKP=1,NTEMP
      TIME=VALUE(LSBKPT+IBKP)
 1294 TIME=TIME+TD
      IF (TIME.GE.TSTOP) GO TO 1296
      CALL EXTMEM(LSBKPT,1)
      VALUE(LSBKPT+NUMBKP+1)=TIME
      NUMBKP=NUMBKP+1
      GO TO 1294
 1296 CONTINUE
      CALL SHLSRT(VALUE(LSBKPT+1),NUMBKP)
      NBKPT=1
      DO 1298 I=2,NUMBKP
      IF ((VALUE(LSBKPT+I)-VALUE(LSBKPT+NBKPT)).LT.TOL) GO TO 1298
      NBKPT=NBKPT+1
      VALUE(LSBKPT+NBKPT)=VALUE(LSBKPT+I)
      IF (VALUE(LSBKPT+NBKPT).GE.TSTOP) GO TO 1299
 1298 CONTINUE
 1299 CALL RELMEM(LSBKPT,NUMBKP-NBKPT)
      NUMBKP=NBKPT
      VALUE(LSBKPT+NUMBKP)=DMAX1(VALUE(LSBKPT+NUMBKP),TSTOP)
      LOC=NODPLC(LOC)
      GO TO 1292
C
C  FINISH BREAKPOINT TABLE
C
 1300 IF (JTRFLG.EQ.0) GO TO 1600
      CALL EXTMEM(LSBKPT,1)
      VALUE(LSBKPT+NUMBKP+1)=TSTOP
      NUMBKP=NUMBKP+1
      CALL SHLSRT(VALUE(LSBKPT+1),NUMBKP)
      NBKPT=1
      DO 1310 I=2,NUMBKP
      IF ((VALUE(LSBKPT+I)-VALUE(LSBKPT+NBKPT)).LT.TOL) GO TO 1310
      NBKPT=NBKPT+1
      VALUE(LSBKPT+NBKPT)=VALUE(LSBKPT+I)
      IF (VALUE(LSBKPT+NBKPT).GE.TSTOP) GO TO 1320
 1310 CONTINUE
 1320 CALL RELMEM(LSBKPT,NUMBKP-NBKPT)
      NUMBKP=NBKPT
      VALUE(LSBKPT+NUMBKP)=DMAX1(VALUE(LSBKPT+NUMBKP),TSTOP)
C
C  PRINT OPTION SUMMARY
C
 1600 IF (IPRNTO.EQ.0) GO TO 1700
      CALL TITLE(0,LWIDTH,1,TITLOP)
      WRITE (IOFILE,1601) GMIN,RELTOL,ABSTOL,VNTOL,LVLCOD,ITL1,ITL2
 1601 FORMAT('DC ANALYSIS -',/,
     1   '     GMIN   = ',1PD10.3,/,
     2   '     RELTOL = ',  D10.3,/,
     3   '     ABSTOL = ',  D10.3,/,
     4   '     VNTOL  = ',  D10.3,/,
     5   '     LVLCOD = ',     I6,/,
     6   '     ITL1   = ',     I6,/,
     7   '     ITL2   = ',     I6,/)
      WRITE (IOFILE,1605) PIVTOL,PIVREL
 1605 FORMAT(
     1   '     PIVTOL = ',1PD10.3,/,
     2   '     PIVREL = ',  D10.3)
      WRITE (IOFILE,1611) ANAME(METHOD),MAXORD,CHGTOL,TRTOL,LVLTIM,XMU,
     1   ITL3,ITL4,ITL5
 1611 FORMAT('TRANSIENT ANALYSIS -',/,
     1   '     METHOD =  ',A8,/,
     2   '     MAXORD = ',     I6,/,
     3   '     CHGTOL = ',1PD10.3,/,
     4   '     TRTOL  = ',  D10.3,/,
     5   '     LVLTIM = ',     I6,/,
     6   '     MU     = ',0PF10.3,/,
     7   '     ITL3   = ',     I6,/,
     8   '     ITL4   = ',     I6,/,
     9   '     ITL5   = ',     I6,/)
      WRITE (IOFILE,1621) LIMPTS,LIMTIM,MAXTIM,NUMDGT,VALUE(ITEMPS+1),
     1   DEFL,DEFW,DEFAD,DEFAS
 1621 FORMAT('MISCELLANEOUS -',/,
     1   '     LIMPTS = ',     I6,/,
     2   '     LIMTIM = ',     I6,/,
     3   '     CPTIME = ',     I9,/,
     4   '     NUMDGT = ',     I6,/,
     5   '     TNOM   = ',0PF10.3,/,
     6   '     DEFL   = ',1PD10.3,/,
     7   '     DEFW   = ',D10.3,/,
     8   '     DEFAD  = ',D10.3,/,
     9   '     DEFAS  = ',D10.3)
C
C  MISCELLANEOUS ERROR CHECKING
C
 1700 IF (ICVFLG.EQ.0) GO TO 1720
      IF (ICVFLG.LE.LIMPTS) GO TO 1710
      ICVFLG=0
      WRITE (IOFILE,1701) LIMPTS,ALSDC
 1701 FORMAT('WARNING:  MORE THAN ',I5,' POINTS FOR ',A4,' ANALYSIS,',/
     11X,'ANALYSIS OMITTED.  THIS LIMIT MAY BE OVERRIDDEN USING THE ',/
     21X,'LIMPTS PARAMETER ON THE .OPTION CARD'/)
      GO TO 1720
 1710 IF ((JELCNT(31)+JELCNT(36)).GT.0) GO TO 1720
      IF(IPOSTP.EQ.2) GO TO 1720
      ICVFLG=0
      WRITE (IOFILE,1711) ALSDC
 1711 FORMAT('WARNING:  NO ',A4,' OUTPUTS SPECIFIED .',
     1  '.. ANALYSIS OMITTED'/)
 1720 IF (JTRFLG.EQ.0) GO TO 1740
      IF (METHOD.EQ.1) MAXORD=2
      IF ((METHOD.EQ.2).AND.(MAXORD.GE.3)) LVLTIM=2
      IF (JTRFLG.LE.LIMPTS) GO TO 1730
      JTRFLG=0
      WRITE (IOFILE,1701) LIMPTS,ALSTR
      GO TO 1740
 1730 IF ((JELCNT(32)+JELCNT(37)+NFOUR).GT.0) GO TO 1735
      IF(IPOSTP.EQ.2) GO TO 1735
      JTRFLG=0
      WRITE (IOFILE,1711) ALSTR
      GO TO 1740
 1735 IF (NFOUR.EQ.0) GO TO 1740
      FORPRD=1.0D0/FORFRE
      IF ((TSTOP-FORPRD).GE.(TSTART-1.0D-12)) GO TO 1740
      NFOUR=0
      CALL CLRMEM(IFOUR)
      WRITE (IOFILE,1736)
 1736 FORMAT('WARNING:  FOURIER ANALYSIS FUNDAMENTAL FREQUENCY IS INCOM
     1PATIBLE WITH'/11X,'TRANSIENT ANALYSIS PRINT INTERVAL ... FOURIER A
     2NALYSIS OMITTED'/)
 1740 IF (JACFLG.EQ.0) GO TO 1800
      IF (JACFLG.LE.LIMPTS) GO TO 1750
      JACFLG=0
      WRITE (IOFILE,1701) LIMPTS,ALSAC
      GO TO 1800
 1750 IF ((JELCNT(33)+JELCNT(34)+JELCNT(35)+JELCNT(38)+JELCNT(39)
     1   +JELCNT(40)+IDIST+INOISE).GT.0) GO TO 1800
      IF(IPOSTP.EQ.2) GO TO 1800
      JACFLG=0
      WRITE (IOFILE,1711) ALSAC
C
C  SEQUENCE THROUGH THE OUTPUT LISTS
C
 1800 DO 1820 ID=41,45
      IF (ID.LE.43) NUMOUT=1
      LOC=LOCATE(ID)
 1810 IF (LOC.EQ.0) GO TO 1820
      NUMOUT=NUMOUT+1
      NODPLC(LOC+4)=NUMOUT
      LOC=NODPLC(LOC)
      GO TO 1810
 1820 CONTINUE
C
C   INCREASE NUMBER OF .PRINTS IF TOO MANY OUTPUTS FOR OUTPUT LINE-WIDTH
C
      IFWDTH=MAX0(NUMDGT-1,0)+9
      NOPRLN=MIN0(8,(LWIDTH-12)/IFWDTH)
      DO 1860 ID=31,35
      LOC=LOCATE(ID)
 1830 IF(LOC.EQ.0) GO TO 1860
      NOPREX=NODPLC(LOC+3)-NOPRLN
      IF(NOPREX.LE.0) GO TO 1850
      NODPLC(LOC+3)=NOPRLN
      CALL FIND(DFLOAT(JELCNT(ID)),ID,LOCNEW,1)
      NODPLC(LOCNEW+2)=NODPLC(LOC+2)
      NODPLC(LOCNEW+3)=NOPREX
      CALL COPY4(NODPLC(LOC+2*NOPRLN+4),NODPLC(LOCNEW+4),2*NOPREX)
 1850 LOC=NODPLC(LOC)
      GO TO 1830
 1860 CONTINUE
C
C  EXIT
C
 2000 CALL SECOND(T2)
      RSTATS(1)=RSTATS(1)+T2-T1
      RETURN
      END
      SUBROUTINE SHLSRT(A,N)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE SORTS THE ARRAY A USING A SHELL SORT ALGORITHM.
C
      DIMENSION A(N)
      INTEGER H
C
C
C...  COMPUTE BEST STARTING STEP SIZE
      H=1
   10 H=3*H+1
      IF (H.LT.N) GO TO 10
C...  BACK OFF TWO TIMES
      H=(H-1)/3
      H=(H-1)/3
      H=MAX0(H,1)
C
C  SHELL SORT
C
   20 J=H+1
      GO TO 60
   30 I=J-H
C...  AK = RECORD KEY;  AR = RECORD
      AK=A(J)
      AR=AK
   40 IF (AK.GE.A(I)) GO TO 50
      A(I+H)=A(I)
      I=I-H
      IF (I.GE.1) GO TO 40
   50 A(I+H)=AR
      J=J+1
   60 IF (J.LE.N) GO TO 30
      H=(H-1)/3
      IF (H.NE.0) GO TO 20
      RETURN
      END
      SUBROUTINE PUTNOD(NODE)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE ADDS 'NODE' TO THE LIST OF USER INPUT NODES IN TABLE
C JUNODE.
C
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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C
      JKNT=0
   10 JKNT=JKNT+1
      IF (JKNT.GT.NUNODS) GO TO 20
      IF (NODE-NODPLC(JUNODE+JKNT)) 20,100,10
   20 K=NUNODS+1
      CALL EXTMEM(JUNODE,1)
      IF (K.LE.JKNT) GO TO 30
      CALL COPY4(NODPLC(JUNODE+JKNT),NODPLC(JUNODE+JKNT+1),K-JKNT)
      K=JKNT
   30 NODPLC(JUNODE+K)=NODE
      NUNODS=NUNODS+1
C
C  FINISHED
C
  100 RETURN
      END
      SUBROUTINE GETNOD(NODE)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE CONVERTS FROM THE USER NODE NUMBER TO THE INTERNAL
C (COMPACT) NODE NUMBER.
C
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(1000000)
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
      IF (NOGO.NE.0) GO TO 100
      JKNT=0
   10 JKNT=JKNT+1
      IF (JKNT.GT.NUNODS) GO TO 20
      IF (NODPLC(JUNODE+JKNT).NE.NODE) GO TO 10
      NODE=JKNT
      GO TO 100
C
C  UNKNOWN NODE -- MUST BE IMPLIED BY .PRINT AND/OR .PLOT
C
   20 IF (NODE.EQ.0) GO TO 30
      WRITE (IOFILE,21) NODE
   21 FORMAT('WARNING:  ATTEMPT TO REFERENCE UNDEFINED NODE ',I5,
     1   ' -- NODE RESET TO 0'/)
   30 NODE=1
C
C  FINISHED
C
  100 RETURN
      END
      SUBROUTINE SUBCKT
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE DRIVES THE EXPANSION OF SUBCIRCUIT CALLS.
C
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(1000000)
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(DFLOAT(JELCNT(ID)),ID,LOCE,1)
      NODPLC(LOCE-1)=LOCX
      CALL ADDELT(LOCE,LOC,ID,INODX,INODI,NXNOD)
  110 LOC=NODPLC(LOC)
      GO TO 100
C
C
  200 CALL CLRMEM(INODX)
      CALL CLRMEM(INODI)
      LOCX=NODPLC(LOCX)
      GO TO 10
C
C  ERRORS
C
  250 LOCV=NODPLC(LOCX+1)
      AXNAM=VALUE(LOCV)
      LOCV=NODPLC(LOCS+1)
      ASNAM=VALUE(LOCV)
      WRITE (IOFILE,251) AXNAM,ASNAM
  251 FORMAT('*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('*ERROR*:  SUBCIRCUIT ',A8,' IS DEFINED RECURSIVELY'/)
      NOGO=1
C
C  FINISHED
C
  300 RETURN
      END
      SUBROUTINE FNDNAM(ANAM,JSBPTR,ISPOT,ID)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE SEARCHES FOR AN ELEMENT WITH ID 'ID' BY TRACING BACK
C UP THE SUBCIRCUIT DEFINITION LIST.  IF THE ELEMENT IS NOT FOUND, THE
C NOMINAL ELEMENT LIST IS SEARCHED.
C
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(1000000)
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))
      INTEGER XXOR
C
C
      ISBPTR=NODPLC(JSBPTR)
   10 IF (ISBPTR.EQ.0) GO TO 50
      ISUB=NODPLC(ISBPTR+3)
      LOC=NODPLC(ISUB+3)
   20 IF (LOC.EQ.0) GO TO 40
      IF (ID.NE.NODPLC(LOC-1)) GO TO 30
      LOCV=NODPLC(LOC+1)
      IF (XXOR(ANAM,VALUE(LOCV)).NE.0) GO TO 30
      IF (ID.NE.20) GO TO 50
      GO TO 65
   30 LOC=NODPLC(LOC)
      GO TO 20
   40 ISBPTR=NODPLC(ISBPTR-1)
      GO TO 10
C
   50 LOC=LOCATE(ID)
   60 IF (LOC.EQ.0) GO TO 90
      IF (NODPLC(LOC-1).NE.ISBPTR) GO TO 70
      LOCV=NODPLC(LOC+1)
      IF (XXOR(ANAM,VALUE(LOCV)).NE.0) GO TO 70
   65 NODPLC(ISPOT)=LOC
      GO TO 100
   70 LOC=NODPLC(LOC)
      GO TO 60
   90 WRITE (IOFILE,91) ANAM
   91 FORMAT('*ERROR*:  UNABLE TO FIND ',A8/)
      NOGO=1
  100 RETURN
      END
      SUBROUTINE NEWNOD(NODOLD,NODNEW,INODX,INODI,NNODI)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE MAKES A NEW NODE NUMBER FOR AN ELEMENT WHICH IS ABOUT
C TO BE ADDED TO THE CIRCUIT AS A RESULT OF A SUBCIRCUIT CALL.
C
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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C... INODX, INODI ARE ARRAYS (SEE SUBCKT)
      DIMENSION INODX(1),INODI(1)
C
      IF (NODOLD.NE.0) GO TO 5
      NODNEW=1
      GO TO 20
    5 DO 10 I=1,NNODI
      JNODX=INODX(1)
      IF (NODOLD.NE.NODPLC(JNODX+I)) GO TO 10
      JNODI=INODI(1)
      NODNEW=NODPLC(JNODI+I)
      GO TO 20
   10 CONTINUE
C
      CALL EXTMEM(INODX(1),1)
      CALL EXTMEM(INODI(1),1)
      CALL EXTMEM(JUNODE,1)
      NNODI=NNODI+1
      NCNODS=NCNODS+1
      JNODX=INODX(1)
      NODPLC(JNODX+NNODI)=NODOLD
      JNODI=INODI(1)
      NODPLC(JNODI+NNODI)=NCNODS
      NODPLC(JUNODE+NCNODS)=NODPLC(JUNODE+NCNODS-1)+1
      NODNEW=NCNODS
   20 RETURN
      END
      SUBROUTINE ADDELT(LOCE,LOC,ID,INODX,INODI,NNODI)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE ADDS AN ELEMENT TO THE NOMINAL CIRCUIT DEFINITION
C LISTS.
C
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(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C... INODX(1), INODI(1) ARE ARRAYS (SEE SUBCKT)
      DIMENSION INODX(1),INODI(1)
C
      DIMENSION LNOD(50),LVAL(50),NNODS(50)
      DATA LNOD /10,14,16, 8,15,16,15,16,13, 8,
     1           18,38,27,35, 8, 8,35, 5, 5, 5,
     2            5, 5, 5, 5, 0, 0, 0, 0, 0, 0,
     3           21,21,21,21,21,21,21,21,21,21,
     4            8, 8, 8, 8, 8, 0, 0, 0, 0, 0 /
      DATA LVAL / 5, 4, 4, 2, 1, 1, 1, 1, 4, 4,
     1            3, 4, 4,16, 1, 1, 9, 2, 1, 1,
     2           19,55,17,46, 0, 0, 0, 0, 0, 0,
     3            1, 1, 1, 1, 1,17,17,17,17,17,
     4            1, 1, 1, 1, 1, 0, 0, 0, 0, 0 /
      DATA NNODS / 2, 2, 2, 0, 2, 2, 2, 2, 2, 2,
     1             2, 4, 3, 4, 4, 4, 4, 0, 1, 0,
     2             0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
     3             0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
     4             2, 2, 2, 0, 0, 0, 0, 0, 0, 0 /
C
C  COPY INTEGER PART
C
      NWORD=LNOD(ID)-3
      IF (NWORD.LE.0) GO TO 10
      CALL COPY4(NODPLC(LOC+2),NODPLC(LOCE+2),NWORD)
C
C  SET NODES
C
   10 IF (ID.GE.21) GO TO 100
      IF (NNODS(ID).EQ.0) GO TO 100
      IF (ID.LE.4) GO TO 20
      IF (ID.LE.8) GO TO 40
      IF (ID.EQ.19) GO TO 70
   20 JSTOP=NNODS(ID)
      DO 30 J=1,JSTOP
      CALL NEWNOD(NODPLC(LOC+J+1),NODPLC(LOCE+J+1),INODX(1),
     1  INODI(1),NNODI)
   30 CONTINUE
      GO TO 100
   40 CALL NEWNOD(NODPLC(LOC+2),NODPLC(LOCE+2),INODX(1),INODI(1),NNODI)
      CALL NEWNOD(NODPLC(LOC+3),NODPLC(LOCE+3),INODX(1),INODI(1),NNODI)
      IF (ID.GE.7) GO TO 100
      NLOCP=LOC+ID+1
      NSSNOD=2*NODPLC(LOC+4)
      CALL GETM4(NODPLC(LOCE+ID+1),NSSNOD)
      NLOCPE=LOCE+ID+1
   50 DO 60 J=1,NSSNOD
      LOCP=NODPLC(NLOCP)
      NODOLD=NODPLC(LOCP+J)
      CALL NEWNOD(NODOLD,NODNEW,INODX(1),INODI(1),NNODI)
      LOCPE=NODPLC(NLOCPE)
      NODPLC(LOCPE+J)=NODNEW
   60 CONTINUE
      GO TO 100
   70 NLOCP=LOC+2
      CALL SIZMEM(NODPLC(LOC+2),NSSNOD)
      CALL GETM4(NODPLC(LOCE+2),NSSNOD)
      NLOCPE=LOCE+2
      GO TO 50
C
C  COPY REAL PART
C
  100 IF (NOGO.NE.0) GO TO 300
      LOCV=NODPLC(LOC+1)
      LOCVE=NODPLC(LOCE+1)
      CALL COPY8(VALUE(LOCV),VALUE(LOCVE),LVAL(ID))
C
C  TREAT NON-NODE TABLES SPECIALLY
C
  200 IF (ID.GE.11) GO TO 300
      GO TO (300,210,220,300,230,240,230,240,260,260), ID
  210 IF (NODPLC(LOC+4).EQ.1) GO TO 300
      CALL CPYTB8(LOC+7,LOCE+7)
      GO TO 300
  220 IF (NODPLC(LOC+4).EQ.1) GO TO 300
      CALL CPYTB8(LOC+10,LOCE+10)
      GO TO 300
  230 ITAB=5
      GO TO 250
  240 ITAB=6
  250 IF (ID.LE.6) GO TO 255
      CALL CPYTB4(LOC+ITAB+1,LOCE+ITAB+1)
  255 CALL CPYTB4(LOC+ITAB+2,LOCE+ITAB+2)
      CALL CPYTB8(LOC+ITAB+3,LOCE+ITAB+3)
      CALL CPYTB8(LOC+ITAB+4,LOCE+ITAB+4)
      CALL CPYTB4(LOC+ITAB+5,LOCE+ITAB+5)
      CALL CPYTB8(LOC+ITAB+6,LOCE+ITAB+6)
      GO TO 300
  260 CALL CPYTB8(LOC+5,LOCE+5)
C
C
  300 RETURN
      END
      SUBROUTINE LNKREF
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE RESOLVES ALL UNSATISFIED NAME REFERENCES.
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(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C  MUTUAL INDUCTORS
C
      LOC=LOCATE(4)
  100 IF (LOC.EQ.0) GO TO 200
      IREF=NODPLC(LOC+2)
      CALL FNDNAM(VALUE(IUNSAT+IREF),LOC-1,LOC+2,3)
      IREF=NODPLC(LOC+3)
      CALL FNDNAM(VALUE(IUNSAT+IREF),LOC-1,LOC+3,3)
      LOC=NODPLC(LOC)
      GO TO 100
C
C  CURRENT-CONTROLLED CURRENT SOURCE
C
  200 LOC=LOCATE(7)
  210 IF (LOC.EQ.0) GO TO 300
      NUMP=NODPLC(LOC+4)
      LOCP=NODPLC(LOC+6)
      DO 220 I=1,NUMP
      IREF=NODPLC(LOCP+I)
      CALL FNDNAM(VALUE(IUNSAT+IREF),LOC-1,LOCP+I,9)
  220 CONTINUE
      LOC=NODPLC(LOC)
      GO TO 210
C
C  CURRENT-CONTROLLED VOLTAGE SOURCES
C
  300 LOC=LOCATE(8)
  310 IF (LOC.EQ.0) GO TO 400
      NUMP=NODPLC(LOC+4)
      LOCP=NODPLC(LOC+7)
      DO 320 I=1,NUMP
      IREF=NODPLC(LOCP+I)
      CALL FNDNAM(VALUE(IUNSAT+IREF),LOC-1,LOCP+I,9)
  320 CONTINUE
      LOC=NODPLC(LOC)
      GO TO 310
C
C  DIODES
C
  400 LOC=LOCATE(11)
  410 IF (LOC.EQ.0) GO TO 500
      IREF=NODPLC(LOC+5)
      CALL FNDNAM(VALUE(IUNSAT+IREF),LOC-1,LOC+5,21)
      LOC=NODPLC(LOC)
      GO TO 410
C
C  BJTS
C
  500 LOC=LOCATE(12)
  510 IF (LOC.EQ.0) GO TO 600
      IREF=NODPLC(LOC+8)
      CALL FNDNAM(VALUE(IUNSAT+IREF),LOC-1,LOC+8,22)
      LOC=NODPLC(LOC)
      GO TO 510
C
C  JFETS
C
  600 LOC=LOCATE(13)
  610 IF (LOC.EQ.0) GO TO 700
      IREF=NODPLC(LOC+7)
      CALL FNDNAM(VALUE(IUNSAT+IREF),LOC-1,LOC+7,23)
      LOC=NODPLC(LOC)
      GO TO 610
C
C  MOSFETS
C
  700 LOC=LOCATE(14)
  710 IF (LOC.EQ.0) GO TO 1000
      IREF=NODPLC(LOC+8)
      CALL FNDNAM(VALUE(IUNSAT+IREF),LOC-1,LOC+8,24)
      LOC=NODPLC(LOC)
      GO TO 710
C
C  FINISHED
C
 1000 CALL CLRMEM(IUNSAT)
      RETURN
      END
      SUBROUTINE SUBNAM(LOCE)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE CONSTRUCTS THE NAMES OF ELEMENTS ADDED AS A RESULT OF
C SUBCIRCUIT EXPANSION.  THE FULL ELEMENT NAMES ARE OF THE FORM
C                  NAME.XN. --- XD.XC.XB.XA
C WHERE 'NAME' IS THE NOMINAL ELEMENT NAME, AND THE 'X'*S DENOTE THE
C SEQUENCE OF SUBCIRCUIT CALLS (FROM TOP OR CIRCUIT LEVEL DOWN THROUGH
C NESTED SUBCIRCUIT CALLS) WHICH CAUSED THE PARTICULAR ELEMENT TO BE
C ADDED.  AT PRESENT, SPICE RESTRICTS ALL ELEMENT NAMES TO BE 8 CHARAC-
C TERS OR LESS.  THEREFORE, THE NAME USED CONSISTS OF THE LEFTMOST 8
C CHARACTERS OF THE FULL ELEMENT NAME, WITH THE RIGHTMOST CHARACTER
C REPLACED BY AN ASTERISK ('*') IF THE FULL ELEMENT NAME IS LONGER THAN
C 8 CHARACTERS.
C
C SPICE VERSION 2G.6  SCCSID=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      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 ELPRNT
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE PRINTS A CIRCUIT ELEMENT SUMMARY.
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=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=TRAN 3/15/83
      COMMON /TRAN/ TSTEP,TSTOP,TSTART,DELMAX,TDMAX,FORFRE,JTRFLG
C SPICE VERSION 2G.6  SCCSID=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
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
      DIMENSION ITAB(25),ASTYP(6)
      DIMENSION ELTITL(4)
      DATA ELTITL / 8HCIRCUIT , 8HELEMENT , 8HSUMMARY , 8H         /
      DATA ASTYP / 1H , 5HPULSE, 3HSIN, 3HEXP, 3HPWL, 4HSFFM /
      DATA ABLNK,AOFF /1H ,3HOFF/
C
C  PRINT LISTING OF ELEMENTS
C
      CALL TITLE(0,LWIDTH,1,ELTITL)
C
C  PRINT RESISTORS
C
      IF (JELCNT(1).EQ.0) GO TO 50
      ITITLE=0
   21 FORMAT(//'**** RESISTORS'/'     NAME        NODES     VALUE
     1  TC1        TC2'//)
      LOC=LOCATE(1)
   30 IF ((LOC.EQ.0).OR.(NODPLC(LOC+8).NE.0)) GO TO 50
      IF (ITITLE.EQ.0) WRITE (IOFILE,21)
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      WRITE (IOFILE,31) VALUE(LOCV),NODPLC(JUNODE+NODE1),
     1   NODPLC(JUNODE+NODE2),VALUE(LOCV+2),VALUE(LOCV+3),VALUE(LOCV+4)
   31 FORMAT(5X,A8,2I5,1P3D11.2)
   40 LOC=NODPLC(LOC)
      GO TO 30
C
C  PRINT CAPACITORS AND INDUCTORS
C
   50 IF ((JELCNT(2)+JELCNT(3)).EQ.0) GO TO 80
      ITITLE=0
   51 FORMAT(//'**** CAPACITORS AND INDUCTORS'/'     NAME        NODES
     1    IN COND     VALUE'//)
      DO 70 ID=2,3
      LOC=LOCATE(ID)
   60 IF (LOC.EQ.0) GO TO 70
      IF ((ID.EQ.2).AND.(NODPLC(LOC+12).NE.0)) GO TO 70
      IF ((ID.EQ.3).AND.(NODPLC(LOC+14).NE.0)) GO TO 70
      IF (ITITLE.EQ.0) WRITE (IOFILE,51)
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      IF (NODPLC(LOC+4).NE.1) GO TO 62
      WRITE (IOFILE,31) VALUE(LOCV),NODPLC(JUNODE+NODE1),
     1   NODPLC(JUNODE+NODE2),VALUE(LOCV+2),VALUE(LOCV+1)
      GO TO 65
   62 LTAB=7
      IF (ID.EQ.3) LTAB=10
      CALL SIZMEM(NODPLC(LOC+LTAB),NPARAM)
      ISPOT=NODPLC(LOC+LTAB)+1
      WRITE (IOFILE,63) VALUE(LOCV),NODPLC(JUNODE+NODE1),
     1   NODPLC(JUNODE+NODE2),VALUE(LOCV+2)
   63 FORMAT(5X,A8,2I5,1PD11.2,'   VARIABLE')
   65 LOC=NODPLC(LOC)
      GO TO 60
   70 CONTINUE
C
C  PRINT MUTUAL INDUCTORS
C
   80 IF (JELCNT(4).EQ.0) GO TO 100
      ITITLE=0
   81 FORMAT(//'**** MUTUAL INDUCTORS'/'     NAME        COUPLED INDUC
     1TORS   VALUE'//)
      LOC=LOCATE(4)
   90 IF ((LOC.EQ.0).OR.(NODPLC(LOC+6).NE.0)) GO TO 110
      IF (ITITLE.EQ.0) WRITE (IOFILE,81)
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      NL1=NODPLC(LOC+2)
      NL1=NODPLC(NL1+1)
      NL2=NODPLC(LOC+3)
      NL2=NODPLC(NL2+1)
      WRITE (IOFILE,91) VALUE(LOCV),VALUE(NL1),VALUE(NL2),VALUE(LOCV+1)
   91 FORMAT(5X,A8,4X,A8,2X,A8,1PD10.2)
   95 LOC=NODPLC(LOC)
      GO TO 90
C
C  PRINT NONLINEAR VOLTAGE CONTROLLED SOURCES
C
  100 IF (JELCNT(5).EQ.0) GO TO 120
      ITITLE=0
  101 FORMAT(//'**** VOLTAGE-CONTROLLED CURRENT SOURCES'/'     NAME
     1     +    -   DIMENSION   FUNCTION')
      LOC=LOCATE(5)
  110 IF ((LOC.EQ.0).OR.(NODPLC(LOC+13).NE.0)) GO TO 120
      IF (ITITLE.EQ.0) WRITE (IOFILE,101)
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      WRITE (IOFILE,111) VALUE(LOCV),NODPLC(JUNODE+NODE1),
     1   NODPLC(JUNODE+NODE2),NODPLC(LOC+4)
  111 FORMAT(5X,A8,2I5,I8,9X,'POLY')
  115 LOC=NODPLC(LOC)
      GO TO 110
C
C  NONLINEAR VOLTAGE CONTROLLED VOLTAGE SOURCES
C
  120 IF (JELCNT(6).EQ.0) GO TO 140
      ITITLE=0
  121 FORMAT(//'**** VOLTAGE-CONTROLLED VOLTAGE SOURCES'/'     NAME
     1     +    -   DIMENSION   FUNCTION')
      LOC=LOCATE(6)
  130 IF ((LOC.EQ.0).OR.(NODPLC(LOC+14).NE.0)) GO TO 140
      IF (ITITLE.EQ.0) WRITE (IOFILE,121)
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      WRITE (IOFILE,111) VALUE(LOCV),NODPLC(JUNODE+NODE1),
     1   NODPLC(JUNODE+NODE2),NODPLC(LOC+4)
  135 LOC=NODPLC(LOC)
      GO TO 130
C
C  NONLINEAR CURRENT CONTROLLED CURRENT SOURCES
C
  140 IF (JELCNT(7).EQ.0) GO TO 160
      ITITLE=0
  141 FORMAT(//'**** CURRENT-CONTROLLED CURRENT SOURCES'/'     NAME
     1     +    -   DIMENSION   FUNCTION')
      LOC=LOCATE(7)
  150 IF ((LOC.EQ.0).OR.(NODPLC(LOC+13).NE.0)) GO TO 160
      IF (ITITLE.EQ.0) WRITE (IOFILE,141)
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      WRITE (IOFILE,111) VALUE(LOCV),NODPLC(JUNODE+NODE1),
     1   NODPLC(JUNODE+NODE2),NODPLC(LOC+4)
  155 LOC=NODPLC(LOC)
      GO TO 150
C
C  NONLINEAR CURRENT CONTROLLED VOLTAGE SOURCES
C
  160 IF (JELCNT(8).EQ.0) GO TO 170
      ITITLE=0
  161 FORMAT(//'**** CURRENT-CONTROLLED VOLTAGE SOURCES'/'     NAME
     1     +    -   DIMENSION   FUNCTION')
      LOC=LOCATE(8)
  165 IF ((LOC.EQ.0).OR.(NODPLC(LOC+14).NE.0)) GO TO 170
      IF (ITITLE.EQ.0) WRITE (IOFILE,161)
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      WRITE (IOFILE,111) VALUE(LOCV),NODPLC(JUNODE+NODE1),
     1   NODPLC(JUNODE+NODE2),NODPLC(LOC+4)
  167 LOC=NODPLC(LOC)
      GO TO 165
C
C  PRINT INDEPENDENT SOURCES
C
  170 IF ((JELCNT(9)+JELCNT(10)).EQ.0) GO TO 250
      ITITLE=0
  171 FORMAT(//'**** INDEPENDENT SOURCES'/'     NAME        NODES   DC
     1 VALUE   AC VALUE   AC PHASE   TRANSIENT'//)
      DO 245 ID=9,10
      LOC=LOCATE(ID)
  180 IF (LOC.EQ.0) GO TO 245
      IF ((ID.EQ.9).AND.(NODPLC(LOC+11).NE.0)) GO TO 245
      IF ((ID.EQ.10).AND.(NODPLC(LOC+6).NE.0)) GO TO 245
      IF (ITITLE.EQ.0) WRITE (IOFILE,171)
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      LOCP=NODPLC(LOC+5)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      ITYPE=NODPLC(LOC+4)+1
      ANAM=ASTYP(ITYPE)
      WRITE (IOFILE,181) VALUE(LOCV),NODPLC(JUNODE+NODE1),
     1   NODPLC(JUNODE+NODE2),VALUE(LOCV+1),VALUE(LOCV+2),
     2   VALUE(LOCV+3),ANAM
  181 FORMAT(5X,A8,2I5,1P3D11.2,2X,A8)
      IF (JTRFLG.EQ.0) GO TO 240
      JSTART=LOCP+1
      GO TO (240,190,200,210,220,230), ITYPE
  190 JSTOP=LOCP+7
      WRITE (IOFILE,191) (VALUE(J),J=JSTART,JSTOP)
  191 FORMAT(1H ,42X,'INITIAL VALUE',1PD11.2,/,
     1           43X,'PULSED VALUE.',  D11.2,/,
     2           43X,'DELAY TIME...',  D11.2,/,
     3           43X,'RISETIME.....',  D11.2,/,
     4           43X,'FALLTIME.....',  D11.2,/,
     5           43X,'WIDTH........',  D11.2,/,
     6           43X,'PERIOD.......',  D11.2,/)
      GO TO 240
  200 JSTOP=LOCP+5
      WRITE (IOFILE,201) (VALUE(J),J=JSTART,JSTOP)
  201 FORMAT(1H ,42X,'OFFSET.......',1PD11.2,/,
     1           43X,'AMPLITUDE....',  D11.2,/,
     2           43X,'FREQUENCY....',  D11.2,/,
     3           43X,'DELAY........',  D11.2,/,
     4           43X,'THETA........',  D11.2,/)
      GO TO 240
  210 JSTOP=LOCP+6
      WRITE (IOFILE,211) (VALUE(J),J=JSTART,JSTOP)
  211 FORMAT(1H ,42X,'INITIAL VALUE',1PD11.2,/,
     1           43X,'PULSED VALUE.',  D11.2,/,
     2           43X,'RISE DELAY...',  D11.2,/,
     3           43X,'RISE TAU.....',  D11.2,/,
     4           43X,'FALL DELAY...',  D11.2,/,
     5           43X,'FALL TAU.....',  D11.2,/)
      GO TO 240
  220 CALL SIZMEM(NODPLC(LOC+5),JSTOP)
      JSTOP=LOCP+JSTOP
      WRITE (IOFILE,221) (VALUE(J),J=JSTART,JSTOP)
  221 FORMAT(1H ,49X,'TIME       VALUE'//,(46X,1P2D11.2))
      WRITE (IOFILE,226)
  226 FORMAT(1X)
      GO TO 240
  230 JSTOP=LOCP+5
      WRITE (IOFILE,231) (VALUE(J),J=JSTART,JSTOP)
  231 FORMAT(1H ,42X,'OFFSET.......',1PD11.2,/,
     1           43X,'AMPLITUDE....',  D11.2,/,
     2           43X,'CARRIER FREQ.',  D11.2,/,
     3           43X,'MODN INDEX...',  D11.2,/,
     4           43X,'SIGNAL FREQ..',  D11.2,/)
  240 LOC=NODPLC(LOC)
      GO TO 180
  245 CONTINUE
C
C  PRINT TRANSMISSION LINES
C
  250 IF (JELCNT(17).EQ.0) GO TO 260
      ITITLE=0
  251 FORMAT(//'**** TRANSMISSION LINES'/'     NAME             NODES
     1           Z0         TD'//)
      LOC=LOCATE(17)
  253 IF ((LOC.EQ.0).OR.(NODPLC(LOC+33).NE.0)) GO TO 260
      IF (ITITLE.EQ.0) WRITE (IOFILE,251)
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      NODE3=NODPLC(LOC+4)
      NODE4=NODPLC(LOC+5)
      WRITE (IOFILE,256) VALUE(LOCV),NODPLC(JUNODE+NODE1),
     1   NODPLC(JUNODE+NODE2),NODPLC(JUNODE+NODE3),
     2   NODPLC(JUNODE+NODE4),VALUE(LOCV+1),VALUE(LOCV+2)
  256 FORMAT(5X,A8,4I5,1P2D11.2)
  258 LOC=NODPLC(LOC)
      GO TO 253
C
C  PRINT DIODES
C
  260 IF (JELCNT(11).EQ.0) GO TO 290
      ITITLE=0
  261 FORMAT(//'**** DIODES'/'     NAME        +    -  MODEL       ARE
     1A'//)
      LOC=LOCATE(11)
  270 IF ((LOC.EQ.0).OR.(NODPLC(LOC+16).NE.0)) GO TO 290
      IF (ITITLE.EQ.0) WRITE (IOFILE,261)
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      LOCM=NODPLC(LOC+5)
      LOCM=NODPLC(LOCM+1)
      AIC=ABLNK
      IF (NODPLC(LOC+6).EQ.1) AIC=AOFF
      WRITE (IOFILE,271) VALUE(LOCV),NODPLC(JUNODE+NODE1),
     1   NODPLC(JUNODE+NODE2),VALUE(LOCM),VALUE(LOCV+1),AIC
  271 FORMAT(5X,A8,2I5,2X,A8,F8.3,2X,A8)
  280 LOC=NODPLC(LOC)
      GO TO 270
C
C  PRINT TRANSISTORS
C
  290 IF (JELCNT(12).EQ.0) GO TO 320
      ITITLE=0
  291 FORMAT(//'**** BIPOLAR JUNCTION TRANSISTORS'/'     NAME        C
     1    B    E    S  MODEL       AREA'//)
      LOC=LOCATE(12)
  300 IF ((LOC.EQ.0).OR.(NODPLC(LOC+36).NE.0)) GO TO 320
      IF (ITITLE.EQ.0) WRITE (IOFILE,291)
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      NODE3=NODPLC(LOC+4)
      NODE4=NODPLC(LOC+5)
      LOCM=NODPLC(LOC+8)
      LOCM=NODPLC(LOCM+1)
      AIC=ABLNK
      IF (NODPLC(LOC+9).EQ.1) AIC=AOFF
      WRITE (IOFILE,301) VALUE(LOCV),NODPLC(JUNODE+NODE1),
     1   NODPLC(JUNODE+NODE2),NODPLC(JUNODE+NODE3),NODPLC(JUNODE+NODE4),
     2   VALUE(LOCM),VALUE(LOCV+1),AIC
  301 FORMAT(5X,A8,4I5,2X,A8,F8.3,2X,A8)
  310 LOC=NODPLC(LOC)
      GO TO 300
C
C  PRINT JFETS
C
  320 IF (JELCNT(13).EQ.0) GO TO 350
      ITITLE=0
  321 FORMAT(//'**** JFETS'/'     NAME        D    G    S  MODEL
     1 AREA'//)
      LOC=LOCATE(13)
  330 IF ((LOC.EQ.0).OR.(NODPLC(LOC+25).NE.0)) GO TO 350
      IF (ITITLE.EQ.0) WRITE (IOFILE,321)
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      NODE3=NODPLC(LOC+4)
      LOCM=NODPLC(LOC+7)
      LOCM=NODPLC(LOCM+1)
      AIC=ABLNK
      IF (NODPLC(LOC+8).EQ.1) AIC=AOFF
      WRITE (IOFILE,331) VALUE(LOCV),NODPLC(JUNODE+NODE1),
     1   NODPLC(JUNODE+NODE2),NODPLC(JUNODE+NODE3),
     2   VALUE(LOCM),VALUE(LOCV+1),AIC
  331 FORMAT(5X,A8,3I5,2X,A8,F8.3,2X,A8)
  340 LOC=NODPLC(LOC)
      GO TO 330
C
C  PRINT MOSFETS
C
  350 IF (JELCNT(14).EQ.0) GO TO 400
      ITITLE=0
  351 FORMAT(//'**** MOSFETS',/,'NAME',6X,'D   G   S   B  MODEL',6X,
     1      'W       AD       PD      RDS'/
     2  37X,'L       AS       PS      RSS',//)
      LOC=LOCATE(14)
  360 IF ((LOC.EQ.0).OR.(NODPLC(LOC+33).NE.0)) GO TO 400
      IF (ITITLE.EQ.0) WRITE (IOFILE,351)
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      NODE3=NODPLC(LOC+4)
      NODE4=NODPLC(LOC+5)
      LOCM=NODPLC(LOC+8)
      LOCM=NODPLC(LOCM+1)
      AIC=ABLNK
      IF (NODPLC(LOC+9).EQ.1) AIC=AOFF
      WRITE (IOFILE,361) VALUE(LOCV),NODPLC(JUNODE+NODE1),
     1   NODPLC(JUNODE+NODE2),NODPLC(JUNODE+NODE3),
     2   NODPLC(JUNODE+NODE4),VALUE(LOCM),VALUE(LOCV+2),
     3   VALUE(LOCV+3),VALUE(LOCV+11),VALUE(LOCV+13),
     4   VALUE(LOCV+1),VALUE(LOCV+4),VALUE(LOCV+12),VALUE(LOCV+14),AIC
  361 FORMAT(A8,4I4,1X,A8,1P4D8.1,/34X,1P4D8.1,1X,A8)
  370 LOC=NODPLC(LOC)
      GO TO 360
C
C  SUBCIRCUIT CALLS
C
  400 IF (JELCNT(19).EQ.0) GO TO 500
      ITITLE=0
  401 FORMAT(//'**** SUBCIRCUIT CALLS'/'     NAME     SUBCIRCUIT   EXT
     1ERNAL NODES'//)
      LOC=LOCATE(19)
  410 IF (LOC.EQ.0) GO TO 500
      IF (ITITLE.EQ.0) WRITE (IOFILE,401)
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      LOCN=NODPLC(LOC+2)
      CALL SIZMEM(NODPLC(LOC+2),NNODX)
      LOCS=NODPLC(LOC+3)
      LOCSV=NODPLC(LOCS+1)
      JSTART=1
      NDPRLN=(LWIDTH-28)/5
  412 JSTOP=MIN0(NNODX,JSTART+NDPRLN-1)
      DO 414 J=JSTART,JSTOP
      NODE=NODPLC(LOCN+J)
      ITAB(J-JSTART+1)=NODPLC(JUNODE+NODE)
  414 CONTINUE
      IF (JSTART.EQ.1)
     1   WRITE (IOFILE,416) VALUE(LOCV),VALUE(LOCSV),(ITAB(J),J=1,JSTOP)
  416 FORMAT(5X,A8,2X,A8,4X,20I5)
      IF (JSTART.NE.1)
     1   WRITE (IOFILE,418) (ITAB(J-JSTART+1),J=JSTART,JSTOP)
  418 FORMAT(28X,20I5)
      JSTART=JSTOP+1
      IF (JSTART.LE.NNODX) GO TO 412
      IF (NNODX.LE.NDPRLN) GO TO 420
      WRITE (IOFILE,226)
  420 LOC=NODPLC(LOC)
      GO TO 410
C
C  FINISHED
C
  500 RETURN
      END
      SUBROUTINE MODCHK
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE PERFORMS ONE-TIME PROCESSING OF DEVICE MODEL PARA-
C METERS AND PRINTS OUT A DEVICE MODEL SUMMARY.  IT ALSO RESERVES THE
C ADDITIONAL NODES REQUIRED BY NONZERO DEVICE EXTRINSIC RESISTANCES.
C
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=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=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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C
      DIMENSION ITAB(50),ATABLE(12)
      DIMENSION CPAR(2),BTABLE(12)
      DIMENSION ANTYPE(4),APTYPE(4)
      DIMENSION IPAR(5),AMPAR(115),DEFVAL(115),IFMT(115),IVCHK(115)
      DIMENSION TITLED(4),TITLEB(4),TITLEJ(4),TITLEM(4)
      DATA TITLED / 8HDIODE MO, 8HDEL PARA, 8HMETERS  , 8H         /
      DATA TITLEB / 8HBJT MODE, 8HL PARAME, 8HTERS    , 8H         /
      DATA TITLEJ / 8HJFET MOD, 8HEL PARAM, 8HETERS   , 8H         /
      DATA TITLEM / 8HMOSFET M, 8HODEL PAR, 8HAMETERS , 8H         /
      DATA ANTYPE /1H ,3HNPN,3HNJF,4HNMOS/
      DATA APTYPE /1H ,3HPNP,3HPJF,4HPMOS/
      DATA IPAR /0,14,60,72,114/
      DATA CPAR / 3HC2 ,3HC4 /
      DATA AUNDEF /2H.U/
      DATA AMPAR /
     1   6HIS    ,6HRS    ,6HN     ,6HTT    ,6HCJO   ,6HVJ    ,6HM     ,
     2   6HEG    ,6HXTI   ,6HKF    ,6HAF    ,6HFC    ,6HBV    ,6HIBV   ,
     1   6HIS    ,6HBF    ,6HNF    ,6HVAF   ,6HIKF   ,6HISE   ,6HNE    ,
     2   6HBR    ,6HNR    ,6HVAR   ,6HIKR   ,6HISC   ,6HNC    ,6H0     ,
     3   6H0     ,6HRB    ,6HIRB   ,6HRBM   ,6HRE    ,6HRC    ,6HCJE   ,
     4   6HVJE   ,6HMJE   ,6HTF    ,6HXTF   ,6HVTF   ,6HITF   ,6HPTF   ,
     5   6HCJC   ,6HVJC   ,6HMJC   ,6HXCJC  ,6HTR    ,6H0     ,6H0     ,
     6   6H0     ,6H0     ,6HCJS   ,6HVJS   ,6HMJS   ,6HXTB   ,6HEG    ,
     7   6HXTI   ,6HKF    ,6HAF    ,6HFC    ,
     1   6HVTO   ,6HBETA  ,6HLAMBDA,6HRD    ,6HRS    ,6HCGS   ,6HCGD   ,
     2   6HPB    ,6HIS    ,6HKF    ,6HAF    ,6HFC    ,
     1   6HLEVEL ,6HVTO   ,6HKP    ,6HGAMMA ,6HPHI   ,6HLAMBDA,6HRD    ,
     2   6HRS    ,6HCBD   ,6HCBS   ,6HIS    ,6HPB    ,6HCGSO  ,6HCGDO  ,
     3   6HCGBO  ,6HRSH   ,6HCJ    ,6HMJ    ,6HCJSW  ,6HMJSW  ,6HJS    ,
     4   6HTOX   ,6HNSUB  ,6HNSS   ,6HNFS   ,6HTPG   ,6HXJ    ,6HLD    ,
     5   6HUO    ,6HUCRIT ,6HUEXP  ,6HUTRA  ,6HVMAX  ,6HNEFF  ,6HXQC   ,
     6   6HKF    ,6HAF    ,6HFC    ,6HDELTA ,6HTHETA ,6HETA   ,6HKAPPA ,
     7   0.0D0   /
      DATA DEFVAL /
     1   1.0D-14,  0.0D0,  1.0D0,2*0.0D0,  1.0D0,  0.5D0, 1.11D0,
     2     3.0D0,  0.0D0,  1.0D0,  0.5D0,  0.0D0, 1.0D-3,
     1   1.0D-16,100.0D0,  1.0D0,3*0.0D0,  1.5D0,2*1.0D0,3*0.0D0,
     2     2.0D0,  0.0D0,  1.0D0,6*0.0D0, 0.75D0, 0.33D0,2*0.0D0,
     3   4*0.0D0, 0.75D0, 0.33D0,  1.0D0,6*0.0D0, 0.75D0,2*0.0D0,
     4    1.11D0,  3.0D0,  0.0D0,  1.0D0,  0.5D0,
     1    -2.0D0, 1.0D-4,5*0.0D0,  1.0D0,1.0D-14,  0.0D0,  1.0D0,
     2     0.5D0,
     1     1.0D0,  0.0D0, 2.0D-5,  0.0D0,  0.6D0,5*0.0D0,1.0D-14,
     2     0.8D0,5*0.0D0,  0.5D0,  0.0D0, 0.33D0,5*0.0D0,  1.0D0,
     3   2*0.0D0,600.0D0, 1.0D+4,3*0.0D0,  1.0D0,  1.0D0,  0.0D0,
     4     1.0D0,  0.5D0,3*0.0D0,  0.2D0,
     5     0.0D0/
      DATA IFMT /
     1   4,1,1,2,2,1,1,1,1,2,1,1,2,2,
     2   4,3,3,2,2,2,1,3,3,2,2,2,1,0,0,1,2,1,1,1,2,1,1,2,2,2,2,1,2,1,
     2   1,1,2,0,0,0,0,2,1,1,2,1,1,2,2,2,
     3   3,4,1,1,1,2,2,1,2,2,1,1,
     4   3,3,4,1,1,2,1,1,2,2,2,1,2,2,2,1,2,1,2,1,2,2,2,2,2,1,2,2,
     4   1,2,1,1,2,1,1,2,1,1,1,1,1,1,
     5   0/
      DATA IVCHK /
     1   0,0,0,0,0,0,0,0,0,0,0,0,0,0,
     2   0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
     2   0,0,0,0,0,0,0,0,0,0,0,0,0,-1,0,0,0,
     3   -1,0,0,0,0,0,0,0,0,0,0,0,
     4   0,-1,0,0,-1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-1,0,-1,
     4   0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
     5   0/
C
C
      TNOM=VALUE(ITEMPS+1)+CTOK
      XKT=BOLTZ*TNOM
      VT=XKT/CHARGE
      XNI=1.45D16
      EGFET=1.16D0-(7.02D-4*TNOM*TNOM)/(TNOM+1108.0D0)
      NUMMOD=JELCNT(21)+JELCNT(22)+JELCNT(23)+JELCNT(24)
      IF (NUMMOD.EQ.0) GO TO 1000
C
C  SPECIAL PREPROCESSING FOR MOSFET MODELS
C
      LOC=LOCATE(24)
    5 IF (LOC.EQ.0) GO TO 35
      LOCV=NODPLC(LOC+1)
      TYPE=NODPLC(LOC+2)
C
C     DEFAULT PARAMETERS FOR HIGHER LEVEL MOS MODELS
C
      LEV=VALUE(LOCV+1)
      IF (VALUE(LOCV+1).EQ.AUNDEF) LEV=1
      IF (VALUE(LOCV+23).NE.AUNDEF) XNSUB=VALUE(LOCV+23)*1.0D6
      IF (VALUE(LOCV+22).EQ.AUNDEF.AND.LEV.GT.1) VALUE(LOCV+22)=1.0D-7
      IF (VALUE(LOCV+22).EQ.AUNDEF) GO TO 33
      COX=EPSOX/VALUE(LOCV+22)
C
C     COMPUTE KP, IF NOT INPUT, USING DEFAULT MOBILITY 600 CM**2/V*SEC
C
      IF (VALUE(LOCV+3).NE.AUNDEF) GO TO 10
      IF (VALUE(LOCV+29).EQ.AUNDEF) VALUE(LOCV+29)=600.0D0
      VALUE(LOCV+3)=VALUE(LOCV+29)*COX*1.0D-4
   10 IF (VALUE(LOCV+23).EQ.AUNDEF) GO TO 33
      IF (XNSUB.LE.XNI) GO TO 30
C
C     NSUB NONZERO => PROCESS ORIENTED MODEL
C
      IF (VALUE(LOCV+5).EQ.AUNDEF) VALUE(LOCV+5)=
     1   DMAX1((2.0D0*VT*DLOG(XNSUB/XNI)),0.1D0)
      FERMIS=TYPE*0.5D0*VALUE(LOCV+5)
      WKFNG=3.2D0
      IF (VALUE(LOCV+26).EQ.AUNDEF) VALUE(LOCV+26)=1.0D0
      IF (VALUE(LOCV+26).EQ.0.0D0) GO TO 15
C
C  POLYSILICON GATE
C
      FERMIG=TYPE*VALUE(LOCV+26)*0.5D0*EGFET
      WKFNG=3.25D0+0.5D0*EGFET-FERMIG
   15 WKFNGS=WKFNG-(3.25D0+0.5D0*EGFET+FERMIS)
      IF (VALUE(LOCV+4).EQ.AUNDEF)
     1   VALUE(LOCV+4)=DSQRT(2.0D0*EPSSIL*CHARGE*XNSUB)/COX
C
C     COMPUTED VTO
C
      IF (VALUE(LOCV+2).NE.AUNDEF) GO TO 20
      IF (VALUE(LOCV+24).EQ.AUNDEF) VALUE(LOCV+24)=0.0D0
      VALUE(LOCV+44)=WKFNGS-VALUE(LOCV+24)*1.0D4*CHARGE/COX
      VALUE(LOCV+2)=VALUE(LOCV+44)
     1   +TYPE*(VALUE(LOCV+4)*DSQRT(VALUE(LOCV+5))+VALUE(LOCV+5))
      GO TO 25
C
C     MEASURED VTO HAS BEEN INPUT
C
   20 VALUE(LOCV+44)=VALUE(LOCV+2)
     1   -TYPE*(VALUE(LOCV+4)*DSQRT(VALUE(LOCV+5))+VALUE(LOCV+5))
   25 VALUE(LOCV+45)=DSQRT((EPSSIL+EPSSIL)/(CHARGE*XNSUB))
      GO TO 33
   30 VALUE(LOCV+23)=0.0D0
      WRITE (IOFILE,31) VALUE(LOCV)
   31 FORMAT('*ERROR*:  NSUB <= NI IN MOSFET MODEL ',A8,/)
      NOGO=1
C
C   SPECIAL PROCESSING FOR MOS3: LIMIT KAPPA>0,
C   SET TO ZERO LAMBDA,UCRIT,UEXP AND UTAR
C
   33 IF (LEV.NE.3) GO TO 34
      IF (VALUE(LOCV+42).EQ.AUNDEF) VALUE(LOCV+42)=0.2D0
      VALUE(LOCV+6)=0.0D0
      VALUE(LOCV+30)=0.0D0
      VALUE(LOCV+31)=0.0D0
      VALUE(LOCV+32)=0.0D0
   34 LOC=NODPLC(LOC)
      GO TO 5
C
C     CYCLE THRU DEVICES
C
   35 KNTLIM=LWIDTH/11
      DO 390 ID=1,4
      IF (JELCNT(ID+20).EQ.0) GO TO 390
      LOCM=IPAR(ID)
      NOPAR=IPAR(ID+1)-LOCM
      DO 45 I=1,NOPAR
      IF (IFMT(LOCM+I).GE.3) GO TO 40
      ITAB(I)=0
      GO TO 45
   40 ITAB(I)=IFMT(LOCM+I)-2
   45 CONTINUE
C
C  ASSIGN DEFAULT VALUES
C
      LOC=LOCATE(ID+20)
   50 IF (LOC.EQ.0) GO TO 70
      LOCV=NODPLC(LOC+1)
      DO 65 I=1,NOPAR
      IF (VALUE(LOCV+I).EQ.AUNDEF) GO TO 62
      IF (IVCHK(LOCM+I).LT.0) GO TO 55
      IF (VALUE(LOCV+I).LT.0.0D0) GO TO 62
   55 IF (ITAB(I).NE.0) GO TO 65
      ITAB(I)=IFMT(LOCM+I)
      GO TO 65
   62 VALUE(LOCV+I)=DEFVAL(LOCM+I)
   65 CONTINUE
      LOC=NODPLC(LOC)
      GO TO 50
C
C     LIMIT MODEL VALUES
C
   70 GO TO (80,85,90,95), ID
C...  DIODES
   80 LOC=LOCATE(21)
   82 IF (LOC.EQ.0) GO TO 130
      LOCV=NODPLC(LOC+1)
      VALUE(LOCV+7)=DMIN1(VALUE(LOCV+7),0.9D0)
      VALUE(LOCV+8)=DMAX1(VALUE(LOCV+8),0.1D0)
      VALUE(LOCV+11)=DMAX1(VALUE(LOCV+11),0.1D0)
      VALUE(LOCV+12)=DMIN1(VALUE(LOCV+12),0.95D0)
      LOC=NODPLC(LOC)
      GO TO 82
C...  BIPOLAR TRANSISTORS
   85 LOC=LOCATE(22)
   87 IF (LOC.EQ.0) GO TO 130
      LOCV=NODPLC(LOC+1)
      VALUE(LOCV+23)=DMIN1(VALUE(LOCV+23),0.9D0)
      IF (VALUE(LOCV+24).EQ.0.0D0) VALUE(LOCV+28)=0.0D0
      VALUE(LOCV+31)=DMIN1(VALUE(LOCV+31),0.9D0)
      VALUE(LOCV+32)=DMIN1(VALUE(LOCV+32),1.0D0)
      VALUE(LOCV+40)=DMIN1(VALUE(LOCV+40),0.9D0)
      VALUE(LOCV+42)=DMAX1(VALUE(LOCV+42),0.1D0)
      VALUE(LOCV+45)=DMAX1(VALUE(LOCV+45),0.1D0)
      VALUE(LOCV+46)=DMIN1(VALUE(LOCV+46),0.9999D0)
      LOC=NODPLC(LOC)
      IF (VALUE(LOCV+18).EQ.0.0D0) VALUE(LOCV+18)=VALUE(LOCV+16)
      IF (VALUE(LOCV+16).GE.VALUE(LOCV+18)) GO TO 87
      WRITE(IOFILE,89) VALUE(LOCV)
   89 FORMAT('WARNING:  MINIMUM BASE RESISTANCE (RBM) IS LESS THAN '
     1       ,'TOTAL (RB) FOR MODEL ',A8,/10X,' RBM SET EQUAL TO RB',/)
      VALUE(LOCV+18)=VALUE(LOCV+16)
      GO TO 87
C...  JFETS
   90 LOC=LOCATE(23)
   92 IF (LOC.EQ.0) GO TO 130
      LOCV=NODPLC(LOC+1)
      VALUE(LOCV+11)=DMAX1(VALUE(LOCV+11),0.1D0)
      VALUE(LOCV+12)=DMIN1(VALUE(LOCV+12),0.95D0)
      LOC=NODPLC(LOC)
      GO TO 92
C...  MOSFETS
   95 LOC=LOCATE(24)
   97 IF (LOC.EQ.0) GO TO 130
      LOCV=NODPLC(LOC+1)
C
  100 VALUE(LOCV+37)=DMAX1(VALUE(LOCV+37),0.1D0)
      VALUE(LOCV+38)=DMIN1(VALUE(LOCV+38),0.95D0)
      IF (VALUE(LOCV+23).LE.0.0D0) GO TO 120
      CJ=DSQRT(EPSSIL*CHARGE*VALUE(LOCV+23)*1.0D6/
     1   (2.0D0*VALUE(LOCV+12)))
      IF (VALUE(LOCV+9).LE.0.0D0) GO TO 105
      ITAB(9)=2
  105 IF (VALUE(LOCV+10).LE.0.0D0) GO TO 110
      ITAB(10)=2
      GO TO 115
  110 IF (VALUE(LOCV+17).LE.0.0D0) VALUE(LOCV+17)=CJ
      ITAB(17)=2
  115 IF ((VALUE(LOCV+7).LE.0.0D0).AND.
     1    (VALUE(LOCV+8).LE.0.0D0)) GO TO 120
      ITAB(7)=2
      ITAB(8)=2
  120 IF (VALUE(LOCV+6).GE.0.2D0) WRITE (IOFILE,121) VALUE(LOCV)
  121 FORMAT ('WARNING:  THE VALUE OF LAMBDA FOR MOSFET MODEL ',A8,/,
     1   ' IS UNUSUALLY LARGE AND MIGHT CAUSE NONCONVERGENCE',/)
      IF (LEV.NE.2) VALUE(LOCV+35)=1.0D0
      IF (LEV.NE.3) GO TO 125
      ITAB(40)=1
      ITAB(41)=1
      ITAB(42)=1
      ITAB(43)=1
  125 LOC=NODPLC(LOC)
      GO TO 97
C
C     PRINT MODEL PARAMETERS
C
  130 IF (IPRNTM.EQ.0) GO TO 360
      LOCS=LOCATE(ID+20)
  140 KNTR=0
      LOC=LOCS
      GO TO (150,160,170,180), ID
  150 CALL TITLE(0,LWIDTH,1,TITLED)
      GO TO 200
  160 CALL TITLE(0,LWIDTH,1,TITLEB)
      GO TO 200
  170 CALL TITLE(0,LWIDTH,1,TITLEJ)
      GO TO 200
  180 CALL TITLE(0,LWIDTH,1,TITLEM)
  200 IF (LOC.EQ.0) GO TO 210
      IF (KNTR.LT.KNTLIM) GO TO 220
  210 LOCN=LOC
      GO TO 240
  220 KNTR=KNTR+1
      LOCV=NODPLC(LOC+1)
      ATABLE(KNTR)=VALUE(LOCV)
  230 LOC=NODPLC(LOC)
      GO TO 200
  240 WRITE (IOFILE,241) (ATABLE(K),K=1,KNTR)
  241 FORMAT(//11X,12(2X,A8))
      IF (ID.EQ.1) GO TO 300
      KNTR=0
      LOC=LOCS
  250 IF (LOC.EQ.0) GO TO 260
      IF (KNTR.GE.KNTLIM) GO TO 260
      KNTR=KNTR+1
      ATABLE(KNTR)=ANTYPE(ID)
      IF (NODPLC(LOC+2).EQ.-1) ATABLE(KNTR)=APTYPE(ID)
      LOC=NODPLC(LOC)
      GO TO 250
  260 WRITE (IOFILE,261) (ATABLE(K),K=1,KNTR)
  261 FORMAT('TYPE',4X,12(4X,A6))
  300 DO 340 I=1,NOPAR
      IF (ITAB(I).EQ.0) GO TO 340
      KNTR=0
      ICCFLG=0
      LOC=LOCS
  310 IF (LOC.EQ.0) GO TO 320
      IF (KNTR.GE.KNTLIM) GO TO 320
      LOCV=NODPLC(LOC+1)
      KNTR=KNTR+1
      IF (ICCFLG.NE.0) GO TO 313
      IF (ID.NE.2) GO TO 315
      IF ((I.NE.6).AND.(I.NE.12)) GO TO 315
      IF (VALUE(LOCV+I).LE.1.0D0) GO TO 315
      ICCFLG=I/6
  313 BTABLE(KNTR)=VALUE(LOCV+I)
      VALUE(LOCV+I)=VALUE(LOCV+I)*VALUE(LOCV+1)
  315 ATABLE(KNTR)=VALUE(LOCV+I)
      LOC=NODPLC(LOC)
      GO TO 310
  320 IF (ITAB(I).EQ.2) GO TO 330
      WRITE (IOFILE,321) AMPAR(LOCM+I),(ATABLE(K),K=1,KNTR)
  321 FORMAT(A8,12F10.3)
      GO TO 340
  330 WRITE (IOFILE,331) AMPAR(LOCM+I),(ATABLE(K),K=1,KNTR)
  331 FORMAT(A8,1P12D10.2)
      IF (ICCFLG.EQ.0) GO TO 340
      WRITE (IOFILE,321) CPAR(ICCFLG),(BTABLE(K),K=1,KNTR)
  340 CONTINUE
      IF (LOCN.EQ.0) GO TO 390
      LOCS=LOCN
      GO TO 140
C
C  SPECIAL  TREATMENT FOR C2 & C4 IN THE BJT MODEL
C  WHEN NO MODEL PARAMETER PRINT
C
  360 IF (ID.NE.2) GO TO 390
      LOC=LOCATE(ID+20)
  370 IF (LOC.EQ.0) GO TO 390
      LOCV=NODPLC(LOC+1)
      IF (VALUE(LOCV+6).GE.1.0D0)
     1   VALUE(LOCV+6)=VALUE(LOCV+6)*VALUE(LOCV+1)
      IF (VALUE(LOCV+12).GE.1.0D0)
     1   VALUE(LOCV+12)=VALUE(LOCV+12)*VALUE(LOCV+1)
      LOC=NODPLC(LOC)
      GO TO 370
  390 CONTINUE
C
C  PROCESS MODEL PARAMETERS
C
C  DIODES
C
  400 LOC=LOCATE(21)
  410 IF (LOC.EQ.0) GO TO 420
      LOCV=NODPLC(LOC+1)
      IF (VALUE(LOCV+2).NE.0.0D0) VALUE(LOCV+2)=1.0D0/VALUE(LOCV+2)
      PB=VALUE(LOCV+6)
      XM=VALUE(LOCV+7)
      FC=VALUE(LOCV+12)
      VALUE(LOCV+12)=FC*PB
      XFC=DLOG(1.0D0-FC)
      VALUE(LOCV+15)=PB*(1.0D0-DEXP((1.0D0-XM)*XFC))/(1.0D0-XM)
      VALUE(LOCV+16)=DEXP((1.0D0+XM)*XFC)
      VALUE(LOCV+17)=1.0D0-FC*(1.0D0+XM)
      CSAT=VALUE(LOCV+1)
      VTE=VALUE(LOCV+3)*VT
      VALUE(LOCV+18)=VTE*DLOG(VTE/(ROOT2*CSAT))
      BV=VALUE(LOCV+13)
      IF (BV.EQ.0) GO TO 418
      CBV=VALUE(LOCV+14)
      IF (CBV.GE.CSAT*BV/VT) GO TO 412
      CBV=CSAT*BV/VT
      WRITE (IOFILE,411) VALUE(LOCV),CBV
  411 FORMAT('WARNING:  IN DIODE MODEL ',A8,' IBV INCREASED TO ',1PE10.
     1   3,11X,'TO RESOLVE INCOMPATIBILITY WITH SPECIFIED IS'/)
      XBV=BV
      GO TO 416
  412 TOL=RELTOL*CBV
      XBV=BV-VT*DLOG(1.0D0+CBV/CSAT)
      ITER=0
  413 XBV=BV-VT*DLOG(CBV/CSAT+1.0D0-XBV/VT)
      XCBV=CSAT*(DEXP((BV-XBV)/VT)-1.0D0+XBV/VT)
      IF (DABS(XCBV-CBV).LE.TOL) GO TO 416
      ITER=ITER+1
      IF (ITER.LT.25) GO TO 413
      WRITE (IOFILE,415) XBV,XCBV
  415 FORMAT('WARNING:  UNABLE TO MATCH FORWARD AND REVERSE DIODE REGIO
     1NS',/,11X,'BV = ',1PD10.3,' AND IBV = ',D10.3,/)
  416 VALUE(LOCV+13)=XBV
  418 LOC=NODPLC(LOC)
      GO TO 410
C
C  BIPOLAR TRANSISTOR MODELS
C
  420 LOC=LOCATE(22)
  430 IF (LOC.EQ.0) GO TO 440
      LOCV=NODPLC(LOC+1)
      IF (VALUE(LOCV+4).NE.0.0D0) VALUE(LOCV+4)=1.0D0/VALUE(LOCV+4)
      IF (VALUE(LOCV+5).NE.0.0D0) VALUE(LOCV+5)=1.0D0/VALUE(LOCV+5)
      IF (VALUE(LOCV+10).NE.0.0D0) VALUE(LOCV+10)=1.0D0/VALUE(LOCV+10)
      IF (VALUE(LOCV+11).NE.0.0D0) VALUE(LOCV+11)=1.0D0/VALUE(LOCV+11)
      IF (VALUE(LOCV+19).NE.0.0D0) VALUE(LOCV+19)=1.0D0/VALUE(LOCV+19)
      IF (VALUE(LOCV+20).NE.0.0D0) VALUE(LOCV+20)=1.0D0/VALUE(LOCV+20)
      IF (VALUE(LOCV+26).NE.0.0D0) VALUE(LOCV+26)=1.0D0/VALUE(LOCV+26)
     1   /1.44D0
      VALUE(LOCV+28)=VALUE(LOCV+28)/RAD*VALUE(LOCV+24)
      IF (VALUE(LOCV+35).NE.0.0D0) VALUE(LOCV+35)=1.0D0/VALUE(LOCV+35)
     1   /1.44D0
      PE=VALUE(LOCV+22)
      XME=VALUE(LOCV+23)
      PC=VALUE(LOCV+30)
      XMC=VALUE(LOCV+31)
      FC=VALUE(LOCV+46)
      VALUE(LOCV+46)=FC*PE
      XFC=DLOG(1.0D0-FC)
      VALUE(LOCV+47)=PE*(1.0D0-DEXP((1.0D0-XME)*XFC))/(1.0D0-XME)
      VALUE(LOCV+48)=DEXP((1.0D0+XME)*XFC)
      VALUE(LOCV+49)=1.0D0-FC*(1.0D0+XME)
      VALUE(LOCV+50)=FC*PC
      VALUE(LOCV+51)=PC*(1.0D0-DEXP((1.0D0-XMC)*XFC))/(1.0D0-XMC)
      VALUE(LOCV+52)=DEXP((1.0D0+XMC)*XFC)
      VALUE(LOCV+53)=1.0D0-FC*(1.0D0+XMC)
      CSAT=VALUE(LOCV+1)
      VALUE(LOCV+54)=VT*DLOG(VT/(ROOT2*CSAT))
      LOC=NODPLC(LOC)
      GO TO 430
C
C  JFET MODELS
C
  440 LOC=LOCATE(23)
  450 IF (LOC.EQ.0) GO TO 460
      LOCV=NODPLC(LOC+1)
      IF (VALUE(LOCV+4).NE.0.0D0) VALUE(LOCV+4)=1.0D0/VALUE(LOCV+4)
      IF (VALUE(LOCV+5).NE.0.0D0) VALUE(LOCV+5)=1.0D0/VALUE(LOCV+5)
      PB=VALUE(LOCV+8)
      XM=0.5D0
      FC=VALUE(LOCV+12)
      VALUE(LOCV+12)=FC*PB
      XFC=DLOG(1.0D0-FC)
      VALUE(LOCV+13)=PB*(1.0D0-DEXP((1.0D0-XM)*XFC))/(1.0D0-XM)
      VALUE(LOCV+14)=DEXP((1.0D0+XM)*XFC)
      VALUE(LOCV+15)=1.0D0-FC*(1.0D0+XM)
      CSAT=VALUE(LOCV+9)
      VALUE(LOCV+16)=VT*DLOG(VT/(ROOT2*CSAT))
      LOC=NODPLC(LOC)
      GO TO 450
C
C  MOSFET MODELS
C
  460 LOC=LOCATE(24)
  470 IF (LOC.EQ.0) GO TO 600
      LOCV=NODPLC(LOC+1)
      TYPE=NODPLC(LOC+2)
      IF (VALUE(LOCV+7).NE.0.0D0) VALUE(LOCV+7)=1.0D0/VALUE(LOCV+7)
      IF (VALUE(LOCV+8).NE.0.0D0) VALUE(LOCV+8)=1.0D0/VALUE(LOCV+8)
      IF (VALUE(LOCV+16).NE.0.0D0) VALUE(LOCV+16)=1.0D0/VALUE(LOCV+16)
      VALUE(LOCV+23)=VALUE(LOCV+23)*1.0D6
      VALUE(LOCV+24)=VALUE(LOCV+24)*1.0D4
      VALUE(LOCV+25)=VALUE(LOCV+25)*1.0D4
      IF (VALUE(LOCV+22).NE.0.0D0) VALUE(LOCV+22)=EPSOX/VALUE(LOCV+22)
      VALUE(LOCV+29)=VALUE(LOCV+29)*1.0D-4
      IF (LEV.EQ.3) GO TO 472
      VALUE(LOCV+30)=VALUE(LOCV+30)*1.0D2
      GO TO 473
C
C   MOVE MOS3 PARAMETERS : THETA FROM LOCATIONS LOCV+40 TO LOCV+30
C                          ETA                       41         31
C                          KAPPA                     42         32
C   AND REPLACE LOCV+6 BY (XD)**2
C
  472 VALUE(LOCV+39)=VALUE(LOCV+39)
     1   *0.25D0*TWOPI*EPSSIL/VALUE(LOCV+22)
      VALUE(LOCV+30)=VALUE(LOCV+40)
      VALUE(LOCV+31)=VALUE(LOCV+41)*8.15D-22/VALUE(LOCV+22)
      VALUE(LOCV+32)=VALUE(LOCV+42)
      IF (VALUE(LOCV+23).GT.0.0D0)
     1    VALUE(LOCV+6)=(EPSSIL+EPSSIL)/(CHARGE*VALUE(LOCV+23))
C
C   NOISE PARAMETERS
C
  473 PB=VALUE(LOCV+12)
      XM=0.5D0
      FC=VALUE(LOCV+38)
      VALUE(LOCV+38)=FC*PB
      XFC=DLOG(1.0D0-FC)
      VALUE(LOCV+40)=PB*(1.0D0-DEXP((1.0D0-XM)*XFC))/(1.0D0-XM)
      VALUE(LOCV+41)=DEXP((1.0D0+XM)*XFC)
      VALUE(LOCV+42)=1.0D0-FC*(1.0D0+XM)
      VALUE(LOCV+43)=-1.0D0
      VALUE(LOCV+44)=VALUE(LOCV+2)-
     1   TYPE*VALUE(LOCV+4)*DSQRT(VALUE(LOCV+5))
  475 IF (VALUE(LOCV+22).NE.0.0D0.AND.LEV.NE.3)
     1   VALUE(LOCV+30)=VALUE(LOCV+30)*EPSSIL/VALUE(LOCV+22)
      LOC=NODPLC(LOC)
      GO TO 470
C
C  RESERVE ADDITIONAL NODES
C
C  DIODES
C
  600 LOC=LOCATE(11)
  610 IF ((LOC.EQ.0).OR.(NODPLC(LOC+16).NE.0)) GO TO 700
      LOCM=NODPLC(LOC+5)
      LOCM=NODPLC(LOCM+1)
      IF (VALUE(LOCM+2).EQ.0.0D0) GO TO 620
      NUMNOD=NUMNOD+1
      NODPLC(LOC+4)=NUMNOD
      GO TO 630
  620 NODPLC(LOC+4)=NODPLC(LOC+2)
  630 LOC=NODPLC(LOC)
      GO TO 610
C
C  TRANSISTORS
C
  700 LOC=LOCATE(12)
  710 IF ((LOC.EQ.0).OR.(NODPLC(LOC+36).NE.0)) GO TO 800
      NODPLC(LOC+30)=NODPLC(LOC+5)
      LOCM=NODPLC(LOC+8)
      LOCM=NODPLC(LOCM+1)
      IF (VALUE(LOCM+16).EQ.0.0D0) GO TO 720
      NUMNOD=NUMNOD+1
      NODPLC(LOC+6)=NUMNOD
      GO TO 730
  720 NODPLC(LOC+6)=NODPLC(LOC+3)
  730 IF (VALUE(LOCM+20).EQ.0.0D0) GO TO 740
      NUMNOD=NUMNOD+1
      NODPLC(LOC+5)=NUMNOD
      GO TO 750
  740 NODPLC(LOC+5)=NODPLC(LOC+2)
  750 IF (VALUE(LOCM+19).EQ.0.0D0) GO TO 760
      NUMNOD=NUMNOD+1
      NODPLC(LOC+7)=NUMNOD
      GO TO 770
  760 NODPLC(LOC+7)=NODPLC(LOC+4)
  770 LOC=NODPLC(LOC)
      GO TO 710
C
C  JFETS
C
  800 LOC=LOCATE(13)
  810 IF ((LOC.EQ.0).OR.(NODPLC(LOC+25).NE.0)) GO TO 900
      LOCM=NODPLC(LOC+7)
      LOCM=NODPLC(LOCM+1)
      IF (VALUE(LOCM+4).EQ.0.0D0) GO TO 820
      NUMNOD=NUMNOD+1
      NODPLC(LOC+5)=NUMNOD
      GO TO 830
  820 NODPLC(LOC+5)=NODPLC(LOC+2)
  830 IF (VALUE(LOCM+5).EQ.0.0D0) GO TO 840
      NUMNOD=NUMNOD+1
      NODPLC(LOC+6)=NUMNOD
      GO TO 850
  840 NODPLC(LOC+6)=NODPLC(LOC+4)
  850 LOC=NODPLC(LOC)
      GO TO 810
C
C  MOSFETS
C
  900 LOC=LOCATE(14)
  910 IF (LOC.EQ.0) GO TO 1000
      LOCM=NODPLC(LOC+8)
      LOCM=NODPLC(LOCM+1)
      LOCV=NODPLC(LOC+1)
      XLEFF=VALUE(LOCV+1)-2.0D0*VALUE(LOCM+28)
      IF (XLEFF.GT.0.0D0) GO TO 915
      WRITE(IOFILE,911) VALUE(LOCV),VALUE(LOCM)
  911 FORMAT('*ERROR*:  EFFECTIVE CHANNEL LENGTH OF ',A8,' LESS THAN ',
     1   'ZERO.',/' CHECK VALUE OF LD FOR MODEL ',A8)
      IF (NODPLC(LOC+33).NE.0) GO TO 960
  915 IF ((VALUE(LOCM+7).EQ.0.0D0).AND.
     1    (VALUE(LOCM+16).EQ.0.0D0)) GO TO 920
      NUMNOD=NUMNOD+1
      NODPLC(LOC+6)=NUMNOD
      GO TO 930
  920 NODPLC(LOC+6)=NODPLC(LOC+2)
  930 IF ((VALUE(LOCM+8).EQ.0.0D0).AND.
     1    (VALUE(LOCM+16).EQ.0.0D0)) GO TO 940
      NUMNOD=NUMNOD+1
      NODPLC(LOC+7)=NUMNOD
      GO TO 950
  940 NODPLC(LOC+7)=NODPLC(LOC+4)
  950 AD=VALUE(LOCV+3)
      AS=VALUE(LOCV+4)
      IF ((AD.LE.0.0D0).OR.(AS.LE.0.0D0)
     1   .AND.VALUE(LOCM+11).LE.0.0D0)
     2   VALUE(LOCM+11)=1.0D-14
  960 LOC=NODPLC(LOC)
      GO TO 910
C
C  TRANSMISSION LINES
C
 1000 LOC=LOCATE(17)
 1010 IF ((LOC.EQ.0).OR.(NODPLC(LOC+33).NE.0)) GO TO 2000
      NUMNOD=NUMNOD+1
      NODPLC(LOC+6)=NUMNOD
      NUMNOD=NUMNOD+1
      NODPLC(LOC+7)=NUMNOD
      LOC=NODPLC(LOC)
      GO TO 1010
C
C  FINISHED
C
 2000 RETURN
      END
      SUBROUTINE TOPCHK
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE CONSTRUCTS THE ELEMENT NODE TABLE.  IT ALSO CHECKS
C FOR VOLTAGE SOURCE/INDUCTOR LOOPS, CURRENT SOURCE/CAPACITOR CUTSETS,
C AND THAT EVERY NODE HAS A DC (CONDUCTIVE) PATH TO GROUND
C
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=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(1000000)
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))
      INTEGER CHANGE
C
C
      DIMENSION ATABLE(12),AIDE(20),NNODS(20)
      DIMENSION IDLIST(4),IDLIS2(4)
      DIMENSION TOPTIT(4)
      DATA TOPTIT / 8HELEMENT , 8HNODE TAB, 8HLE      , 8H         /
      DATA IDLIST / 3, 6, 8, 9 /
      DATA IDLIS2 /14,14,14,11 /
      DATA AIDE / 1HR,0.0D0,1HL,2*0.0D0,1HE,0.0D0,1HH,1HV,0.0D0,1HD,
     1   1HQ,1HJ,1HM,0.0D0,0.0D0,1HT,0.0D0,0.0D0,0.0D0 /
      DATA NNODS / 2,2,2,0,2,2,2,2,2,2,2,4,3,4,4,4,4,0,0,0 /
      DATA ABLNK /1H /
C
C  ALLOCATE STORAGE
C
      CALL GETM4(IORDER,NCNODS)
      CALL GETM4(IUR,NCNODS+1)
C
C  CONSTRUCT NODE TABLE
C
      KNTLIM=LWIDTH/11
 1300 CALL GETM4(ITABLE,0)
      CALL GETM4(ITABID,0)
      ISTOP=NCNODS+1
      DO 1310 I=1,ISTOP
 1310 NODPLC(IUR+I)=1
      DO 1370 ID=1,18
      IF (NNODS(ID).EQ.0) GO TO 1370
      LOC=LOCATE(ID)
 1320 IF (LOC.EQ.0) GO TO 1370
      NLOC=LOC+1
      JSTOP=NNODS(ID)
 1330 DO 1360 J=1,JSTOP
      NODE=NODPLC(NLOC+J)
      ISPOT=NODPLC(IUR+NODE+1)
      K=NODPLC(IUR+NCNODS+1)
      CALL EXTMEM(ITABLE,1)
      CALL EXTMEM(ITABID,1)
      IF (K.LE.ISPOT) GO TO 1340
      CALL COPY4(NODPLC(ITABLE+ISPOT),NODPLC(ITABLE+ISPOT+1),K-ISPOT)
      CALL COPY4(NODPLC(ITABID+ISPOT),NODPLC(ITABID+ISPOT+1),K-ISPOT)
 1340 NODPLC(ITABLE+ISPOT)=LOC
      NODPLC(ITABID+ISPOT)=ID
C...  TREAT THE SUBSTRATE NODE OF A MOSFET AS IF IT WERE A TRANSMISSION
C...  LINE NODE, I.E. LET IT DANGLE IF DESIRED
      IF(ID.EQ.14.AND.J.EQ.4) NODPLC(ITABID+ISPOT)=17
      K=NODE
      KSTOP=NCNODS+1
 1350 K=K+1
      IF (K.GT.KSTOP) GO TO 1360
      NODPLC(IUR+K)=NODPLC(IUR+K)+1
      GO TO 1350
 1360 CONTINUE
      LOC=NODPLC(LOC)
      GO TO 1320
 1370 CONTINUE
C
C  CHECK THAT EVERY NODE HAS A DC PATH TO GROUND
C
      CALL ZERO4(NODPLC(IORDER+1),NCNODS)
      NODPLC(IORDER+1)=1
 1420 IFLAG=0
      DO 1470 I=2,NCNODS
      IF (NODPLC(IORDER+I).EQ.1) GO TO 1470
      JSTART=NODPLC(IUR+I)
      JSTOP=NODPLC(IUR+I+1)-1
      IF (JSTART.GT.JSTOP) GO TO 1470
      DO 1450 J=JSTART,JSTOP
      LOC=NODPLC(ITABLE+J)
      ID=NODPLC(ITABID+J)
      IF (AIDE(ID).EQ.0.0D0) GO TO 1450
      IF (ID.EQ.17) GO TO 1445
      KSTOP=LOC+NNODS(ID)-1
      DO 1440 K=LOC,KSTOP
      NODE=NODPLC(K+2)
      IF (NODPLC(IORDER+NODE).EQ.1) GO TO 1460
 1440 CONTINUE
      GO TO 1450
 1445 IF (NODPLC(LOC+2).EQ.I) NODE=NODPLC(LOC+3)
      IF (NODPLC(LOC+3).EQ.I) NODE=NODPLC(LOC+2)
      IF (NODPLC(LOC+4).EQ.I) NODE=NODPLC(LOC+5)
      IF (NODPLC(LOC+5).EQ.I) NODE=NODPLC(LOC+4)
      IF (NODPLC(IORDER+NODE).EQ.1) GO TO 1460
 1450 CONTINUE
      GO TO 1470
 1460 NODPLC(IORDER+I)=1
      IFLAG=1
 1470 CONTINUE
      IF (IFLAG.EQ.1) GO TO 1420
C
C  PRINT NODE TABLE AND TOPOLOGY ERROR MESSAGES
C
      IF (IPRNTN.EQ.0) GO TO 1510
      CALL TITLE(0,LWIDTH,1,TOPTIT)
 1510 DO 1590 I=1,NCNODS
      JSTART=NODPLC(IUR+I)
      JSTOP=NODPLC(IUR+I+1)-1
      IF (IPRNTN.EQ.0) GO TO 1550
      IF (JSTART.LE.JSTOP) GO TO 1520
      WRITE (IOFILE,1511) NODPLC(JUNODE+I)
 1511 FORMAT(I7)
      GO TO 1550
 1520 KNTR=0
      JFLAG=1
      DO 1540 J=JSTART,JSTOP
      LOC=NODPLC(ITABLE+J)
      LOCV=NODPLC(LOC+1)
      KNTR=KNTR+1
      ATABLE(KNTR)=VALUE(LOCV)
      IF (KNTR.LT.KNTLIM) GO TO 1540
      IF (JFLAG.EQ.0) GO TO 1525
      JFLAG=0
      WRITE (IOFILE,1521) NODPLC(JUNODE+I),(ATABLE(K),K=1,KNTR)
 1521 FORMAT(I7,3X,12(1X,A8))
      GO TO 1530
 1525 WRITE (IOFILE,1526) (ATABLE(K),K=1,KNTR)
 1526 FORMAT(10X,12(1X,A8))
 1530 KNTR=0
 1540 CONTINUE
      IF (KNTR.EQ.0) GO TO 1550
      IF (JFLAG.EQ.0) GO TO 1545
      WRITE (IOFILE,1521) NODPLC(JUNODE+I),(ATABLE(K),K=1,KNTR)
      GO TO 1550
 1545 WRITE (IOFILE,1526) (ATABLE(K),K=1,KNTR)
 1550 IF (JSTART-JSTOP) 1560,1552,1556
C
C  ALLOW NODE WITH ONLY ONE CONNECTION IFF ELEMENT IS A T-LINE
C
 1552 IF (NODPLC(ITABID+JSTART).EQ.17) GO TO 1560
 1556 NOGO=1
      WRITE (IOFILE,1557) NODPLC(JUNODE+I)
 1557 FORMAT('*ERROR*:  LESS THAN 2 CONNECTIONS AT NODE ',I6/)
      GO TO 1590
 1560 IF (NODPLC(IORDER+I).EQ.1) GO TO 1590
      NOGO=1
      WRITE (IOFILE,1561) NODPLC(JUNODE+I)
 1561 FORMAT('*ERROR*:  NO DC PATH TO GROUND FROM NODE ',I6/)
 1590 CONTINUE
C
C  CHECK FOR INDUCTOR/VOLTAGE SOURCE LOOPS
C
      DO 1700 I=1,NCNODS
      CALL ZERO4(NODPLC(IORDER+1),NCNODS)
      NODPLC(IORDER+I)=-1
 1605 CHANGE=0
      DO 1690 IDCNTR=1,4
      ID=IDLIST(IDCNTR)
      LOC=LOCATE(ID)
 1610 IF ((LOC.EQ.0).OR.(NODPLC(LOC+IDLIS2(IDCNTR)).NE.0)) GO TO 1690
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      IF (NODPLC(IORDER+NODE1).EQ.LOC.OR.
     1   NODPLC(IORDER+NODE2).EQ.LOC) GO TO 1680
      IF (NODPLC(IORDER+NODE1)) 1620,1640,1630
 1620 NODPLC(IORDER+NODE1)=LOC
      CHANGE=1
 1630 NODE=NODE2
      GO TO 1670
 1640 IF (NODPLC(IORDER+NODE2)) 1650,1680,1660
 1650 NODPLC(IORDER+NODE2)=LOC
      CHANGE=1
 1660 NODE=NODE1
 1670 IF (NODPLC(IORDER+NODE).NE.0) GO TO 1710
      NODPLC(IORDER+NODE)=LOC
      CHANGE=1
 1680 LOC=NODPLC(LOC)
      GO TO 1610
 1690 CONTINUE
      IF (CHANGE.EQ.1) GO TO 1605
 1700 CONTINUE
      GO TO 1900
C ... LOOP FOUND
 1710 LOCV=NODPLC(LOC+1)
      WRITE (IOFILE,1711) VALUE(LOCV)
 1711 FORMAT('*ERROR*:  INDUCTOR/VOLTAGE SOURCE LOOP FOUND, CONTAINING
     1',A8/)
      NOGO=1
C
C
 1900 CALL CLRMEM(IORDER)
      CALL CLRMEM(IUR)
      CALL CLRMEM(ITABLE)
      CALL CLRMEM(ITABID)
 2000 RETURN
      END
C SPICE VERSION 2G.6  SCCSID=setup.ma 3/15/83
      SUBROUTINE SETUP
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      REAL T1, T2
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(1000000)
      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 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
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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX 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 GETM4(IRPT,NSTOP)
      CALL GETM4(JCPT,NSTOP)
      CALL GETM4(IROWNO,NSTOP)
      CALL GETM4(JCOLNO,NSTOP)
      CALL SLPMEM(IRPT,NSTOP)
      CALL SLPMEM(JCPT,NSTOP)
      CALL SLPMEM(IROWNO,NSTOP)
      CALL SLPMEM(JCOLNO,NSTOP)
      CALL CRUNCH
C
      CALL ZERO4(NODPLC(IRPT+1),NSTOP)
      CALL ZERO4(NODPLC(JCPT+1),NSTOP)
      CALL ZERO4(NODPLC(IROWNO+1),NSTOP)
      CALL ZERO4(NODPLC(JCOLNO+1),NSTOP)
      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).OR.(NODPLC(LOC+8).NE.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).OR.(NODPLC(LOC+12).NE.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).OR.(NODPLC(LOC+14).NE.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).OR.(NODPLC(LOC+6).NE.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).OR.(NODPLC(LOC+13).NE.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).OR.(NODPLC(LOC+14).NE.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).OR.(NODPLC(LOC+11).NE.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).OR.(NODPLC(LOC+13).NE.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).OR.(NODPLC(LOC+14).NE.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).OR.(NODPLC(LOC+16).NE.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).OR.(NODPLC(LOC+36).NE.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)
      LOCM=NODPLC(LOC+8)
      LOCM=NODPLC(LOCM+1)
      CDIS=VALUE(LOCM+32)
      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)
      IF (CDIS.LT.1.0D0) CALL RESERV(NODE2,NODE4)
      IF (CDIS.LT.1.0D0) CALL RESERV(NODE4,NODE2)
      NODPLC(LOC+22)=NXTRM+1
      NXTRM=NXTRM+19
      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).OR.(NODPLC(LOC+25).NE.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).OR.(NODPLC(LOC+33).NE.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+28
      LOC=NODPLC(LOC)
      GO TO 570
C
C  TRANSMISSION LINES
C
  600 LOC=LOCATE(17)
  610 IF ((LOC.EQ.0).OR.(NODPLC(LOC+33).NE.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 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.
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(1000000)
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  ALLOCATE AND INITIALIZE STORAGE
C
      CALL GETM4(IRSWPF,NSTOP)
      CALL GETM4(IRSWPR,NSTOP)
      CALL GETM4(ICSWPF,NSTOP)
      CALL GETM4(ICSWPR,NSTOP)
C
      DO 10 I=1,NSTOP
      NODPLC(IRSWPF+I)=I
   10 CONTINUE
      CALL COPY4(NODPLC(IRSWPF+1),NODPLC(IRSWPR+1),NSTOP)
      CALL COPY4(NODPLC(IRSWPF+1),NODPLC(ICSWPF+1),NSTOP)
      CALL COPY4(NODPLC(IRSWPF+1),NODPLC(ICSWPR+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 600
      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 145
      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 145
      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
  145 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(IRSWPF+IBR)
      J=NODPLC(IRSWPR+NODE)
      NODPLC(IRSWPF+J)=L
      NODPLC(IRSWPR+L)=J
      NODPLC(IRSWPF+IBR)=NODE
      NODPLC(IRSWPR+NODE)=IBR
      CALL SWAPIJ(IBR,J,1,1)
      NEXTV=NEXTV+1
      GO TO 100
C
C
C  ERROR - VOLTAGE-SOURCE/INDUCTOR/TRANSMISSION-LINE LOOP DETECTED ...
C
  590 NOGO=1
      WRITE (IOFILE,591)
C...  LOOP SHOULD HAVE BEEN DETECTED IN TOPCHK
  591 FORMAT('*ABORT*:  SPICE INTERNAL ERROR IN REORDR'/)
C
C  FINISHED
C
  600 RETURN
      END
C SPICE VERSION 2G.6  SCCSID=dctran.ma 3/15/83
      SUBROUTINE DCTRAN
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      REAL T1, T2
C
C
C     THIS ROUTINE CONTROLS THE DC TRANSFER CURVE, DC OPERATING POINT,
C AND TRANSIENT ANALYSES.  THE VARIABLES MODE AND MODEDC (DEFINED BELOW)
C DETERMINE EXACTLY WHICH ANALYSIS IS PERFORMED.
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=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=TRAN 3/15/83
      COMMON /TRAN/ TSTEP,TSTOP,TSTART,DELMAX,TDMAX,FORFRE,JTRFLG
C SPICE VERSION 2G.6  SCCSID=CJE 3/15/83
      COMMON /CJE/ MAXTIM,ITIME,ICOST
C SPICE VERSION 2G.6  SCCSID=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
      LOGICAL MEMPTR
C
C
      DIMENSION SUBTIT(4,2)
      DIMENSION AVHDR(3),AVFRM(4)
      DATA AVHDR / 8H( (2X,A4, 8H,3X,A7,3, 5HX)//) /
      DATA AVFRM / 8H( (1H ,A, 8H1,I3,1H), 8H,F10.4,3, 4HX)/) /
      DATA ANODE, AVLTG / 4HNODE, 7HVOLTAGE /
      DATA SUBTIT / 8HSMALL SI, 8HGNAL BIA, 8HS SOLUTI, 8HON      ,
     1              8HINITIAL , 8HTRANSIEN, 8HT SOLUTI, 8HON      /
      DATA LPRN /1H(/
      DATA ABLNK, ALETR, ALETT /1H , 1HR, 1HT /
C
C      THE VARIABLES *MODE*, *MODEDC*, AND *INITF* ARE USED BY SPICE TO
C KEEP TRACK OF THE STATE OF THE ANALYSIS.  THE VALUES OF THESE FLAGS
C (AND THE CORRESPONDING MEANINGS) ARE AS FOLLOWS:
C
C        FLAG    VALUE    MEANING
C        ----    -----    -------
C
C        MODE      1      DC ANALYSIS (SUBTYPE DEFINED BY *MODEDC*)
C                  2      TRANSIENT ANALYSIS
C                  3      AC ANALYSIS (SMALL SIGNAL)
C
C        MODEDC    1      DC OPERATING POINT
C                  2      INITIAL OPERATING POINT FOR TRANSIENT ANALYSIS
C                  3      DC TRANSFER CURVE COMPUTATION
C
C        INITF     1      CONVERGE WITH 'OFF' DEVICES ALLOWED TO FLOAT
C                  2      INITIALIZE JUNCTION VOLTAGES
C                  3      CONVERGE WITH 'OFF' DEVICES HELD 'OFF'
C                  4      STORE SMALL-SIGNAL PARAMETERS AWAY
C                  5      FIRST TIMEPOINT IN TRANSIENT ANALYSIS
C                  6      PREDICTION STEP
C
C NOTE:  *MODEDC* IS ONLY SIGNIFICANT IF *MODE* = 1.
C
C
C  INITIALIZE
C
      CALL SECOND(T1)
      SFACTR=1.0D0
C.. DON'T TAKE ANY CHANCES WITH LX3, SET TO LARGE NUMBER
      LX3=20000000
      LX2=20000000
C.. SEE IF LX3 AND LX2 TABLES ARE NEEDED
      NOLX2=0
      NOLX3=0
   20 LOCTIM=5
C
C.. POST-PROCESSING INITIALIZATION
C
      IF(IPOSTP.NE.2) GO TO 25
      NUMCUR=JELCNT(9)
      NUMPOS=NUNODS+NUMCUR
      CALL GETM8(IBUFF,NUMPOS)
      NUMPOS=NUMPOS*4
      IF(NUMCUR.EQ.0) GO TO 25
      LOC=LOCATE(9)
      LOCCUR=NODPLC(LOC+6)-1
C
C...  SET UP FORMAT
C
   25 NVPRLN=4+(LWIDTH-72)/19
      NVPRLN=MIN0(NVPRLN,NCNODS-1)
      IPOS=2
      CALL ALFNUM(NVPRLN,AVFRM,IPOS)
      IPOS=2
      CALL ALFNUM(NVPRLN,AVHDR,IPOS)
C...  ALLOCATE STORAGE
      IF (MODE.EQ.2) GO TO 35
      NEED=4*NSTOP+NTTBR+NXTRM
      CALL AVLM8(NAVL)
      IF(NEED.LE.NAVL) GO TO 30
C...  NOT ENOUGH MEMORY FOR DC OPERATING POINT ANALYSIS
      WRITE(IOFILE,26) NEED,NAVL
   26 FORMAT('INSUFFICIENT MEMORY AVAILABLE FOR DC ANALYSIS.',/
     1' MEMORY REQUIRED ',I6,', MEMORY AVAILABLE ',I6,'.')
      NOGO=1
      GO TO 1100
   30 CALL GETM8(LVNIM1,NSTOP)
      CALL GETM8(LVN,NSTOP+NTTBR)
      CALL SLPMEM(LVN,NSTOP)
      CALL GETM8(LX0,NXTRM)
      CALL GETM8(LVNTMP,NSTOP)
      IF (MODEDC.NE.3) GO TO 45
   35 CALL GETM8(LX1,NXTRM)
      IF(NOLX2.EQ.0) CALL GETM8(LX2,NXTRM)
      IF (MODE.NE.2) GO TO 40
      IF(NOLX3.EQ.0) CALL GETM8(LX3,NXTRM)
      CALL GETM8(LTD,0)
   40 CALL GETM8(LOUTPT,0)
   45 CALL CRUNCH
   50 IF (MODE.EQ.2) GO TO 500
      TIME=0.0D0
      AG(1)=0.0D0
      CALL SORUPD
      IF (MODEDC.EQ.3) GO TO 300
C
C
C  ....  SINGLE POINT DC ANALYSIS
C
C
C  COMPUTE DC OPERATING POINT
C
  100 IF (ITL6.GT.0) GO TO 105
      INITF=2
      CALL ITER8(ITL1)
      RSTATS(6)=RSTATS(6)+ITERNO
      IF (IGOOF.NE.0) GO TO 150
      GO TO 110
  105 CALL SORSTP(ITL6)
      RSTATS(6)=RSTATS(6)+ITERNO
      IF (IGOOF.NE.0) GO TO 150
  110 IF (MODEDC.NE.1) GO TO 120
      INITF=4
      CALL DIODE
      CALL BJT
      CALL JFET
      CALL MOSFET
C
C  PRINT OPERATING POINT
C
  120 IF ((MODE.EQ.1).AND.(MODEDC.EQ.2).AND.(NOSOLV.NE.0)) GO TO 1000
      CALL TITLE(-1,LWIDTH,1,SUBTIT(1,MODEDC))
      WRITE (IOFILE,AVHDR) (ANODE,AVLTG,I=1,NVPRLN)
      WRITE (IOFILE,AVFRM) (LPRN,NODPLC(JUNODE+I),VALUE(LVNIM1+I),
     1  I=2,NCNODS)
      GO TO 1000
C
C  NO CONVERGENCE
C
  150 NOGO=1
      WRITE (IOFILE,151)
  151 FORMAT('*ERROR*:  NO CONVERGENCE IN DC ANALYSIS'/'LAST NODE VOL'
     1   ,'TAGES:'/)
      WRITE (IOFILE,AVHDR) (ANODE,AVLTG,I=1,NVPRLN)
      WRITE (IOFILE,AVFRM) (LPRN,NODPLC(JUNODE+I),VALUE(LVNIM1+I),
     1  I=2,NCNODS)
      GO TO 1000
C
C  ....  DC TRANSFER CURVES
C
  300 NUMOUT=JELCNT(41)+1
      IF(IPOSTP.EQ.2) CALL PHEADR(ATITLE)
      ITEMP=ITCELM(1)
      LOCS=NODPLC(ITEMP+1)
      ANAM=VALUE(LOCS)
      CALL MOVE(ANAM,2,ABLNK,1,7)
      IRDCTC=0
      IRDCT2=0
      ITDCTC=0
      ITDCT2=0
      IF (ANAM.EQ.ALETR) IRDCTC=1
      IF (ANAM.EQ.ALETT) ITDCTC=1
      TEMVAL=VALUE(LOCS+1)
      ICVFL2=1
      IF(ITCELM(2).EQ.0) GO TO 310
      ITEMP=ITCELM(2)
      LOCS2=NODPLC(ITEMP+1)
      ANAM=VALUE(LOCS2)
      CALL MOVE(ANAM,2,ABLNK,1,7)
      IF (ANAM.EQ.ALETR) IRDCT2=1
      IF (ANAM.EQ.ALETT) ITDCT2=1
      TEMV2=VALUE(LOCS2+1)
      VALUE(LOCS2+1)=TCSTAR(2)
      TEMP=DABS((TCSTOP(2)-TCSTAR(2))/TCINCR(2))+0.5D0
      ICVFL2=IDINT(TEMP)+1
      ICVFL2=MAX0(ICVFL2,1)
  310 DELTA=TCINCR(1)
      DO 320 I=1,7
      DELOLD(I)=DELTA
  320 CONTINUE
      ICVFL1=ICVFLG/ICVFL2
      VALUE(LOCS+1)=TCSTAR(1)
      IF ((ITDCTC.NE.1).AND.(ITDCT2.NE.1)) GO TO 325
      ITEMNO=3
      IF (ITDCTC.EQ.1) VALUE(ITEMPS+ITEMNO)=VALUE(LOCS+1)
      IF (ITDCT2.EQ.1) VALUE(ITEMPS+ITEMNO)=VALUE(LOCS2+1)
      CALL TMPUPD
  325 IF (IRDCTC.EQ.1) VALUE(LOCS+1)=1.0D0/VALUE(LOCS+1)
      IF (IRDCT2.EQ.1) VALUE(LOCS2+1)=1.0D0/VALUE(LOCS2+1)
      ICALC=0
      ICAL2=0
      LOCTIM=3
  340 INITF=2
      CALL ITER8(ITL1)
      RSTATS(4)=RSTATS(4)+ITERNO
      CALL COPY8(VALUE(LX0+1),VALUE(LX1+1),NXTRM)
      IF(NOLX2.EQ.0) CALL COPY8(VALUE(LX0+1),VALUE(LX2+1),NXTRM)
      IF (IGOOF.NE.0) GO TO 450
      GO TO 360
  350 CALL GETCJE
      IF ((MAXTIM-ITIME).LE.LIMTIM) GO TO 460
      INITF=6
      CALL ITER8(ITL2)
      RSTATS(4)=RSTATS(4)+ITERNO
      IF (IGOOF.NE.0) GO TO 340
C
C  STORE OUTPUTS
C
  360 CALL EXTMEM(LOUTPT,NUMOUT)
      LOCO=LOUTPT+ICALC*NUMOUT
      ICALC=ICALC+1
      ICAL2=ICAL2+1
      VALUE(LOCO+1)=VALUE(LOCS+1)
      IF (IRDCTC.EQ.1) VALUE(LOCO+1)=1.0D0/VALUE(LOCO+1)
      LOC=LOCATE(41)
  370 IF (LOC.EQ.0) GO TO 400
      IF (NODPLC(LOC+5).NE.0) GO TO 380
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      ISEQ=NODPLC(LOC+4)
      VALUE(LOCO+ISEQ)=VALUE(LVNIM1+NODE1)-VALUE(LVNIM1+NODE2)
      LOC=NODPLC(LOC)
      GO TO 370
  380 IPTR=NODPLC(LOC+2)
      IPTR=NODPLC(IPTR+6)
      ISEQ=NODPLC(LOC+4)
      VALUE(LOCO+ISEQ)=VALUE(LVNIM1+IPTR)
      LOC=NODPLC(LOC)
      GO TO 370
C
C  INCREMENT SOURCE VALUE
C
  400 IF(IPOSTP.NE.2) GO TO 410
      VALUE(IBUFF+1)=VALUE(LOCS+1)
      CALL COPY8(VALUE(LVNIM1+2),VALUE(IBUFF+2),NUNODS-1)
      IF(NUMCUR.NE.0) CALL COPY8(VALUE(LVNIM1+LOCCUR+1),
     1  VALUE(IBUFF+NUNODS+1),NUMCUR)
      CALL FWRITE(VALUE(IBUFF+1),NUMPOS)
  410 IF (ICALC.GE.ICVFLG) GO TO 490
      IF(ICAL2.GE.ICVFL1) GO TO 480
      IF(NOLX2.NE.0) GO TO 420
      CALL PTRMEM(LX2,ITEMP)
      CALL PTRMEM(LX1,LX2)
      GO TO 430
  420 CALL PTRMEM(LX1,ITEMP)
  430 CALL PTRMEM(LX0,LX1)
      CALL PTRMEM(ITEMP,LX0)
      VALUE(LOCS+1)=TCSTAR(1)+DFLOAT(ICAL2)*DELTA
      IF (ITDCTC.NE.1) GO TO 440
      VALUE(ITEMPS+ITEMNO-1)=VALUE(ITEMPS+ITEMNO)
      VALUE(ITEMPS+ITEMNO)=VALUE(LOCS+1)
      CALL TMPUPD
  440 IF (IRDCTC.EQ.1) VALUE(LOCS+1)=1.0D0/VALUE(LOCS+1)
      GO TO 350
C
C  NO CONVERGENCE
C
  450 ITEMP=ITCELM(1)
      LOCE=NODPLC(ITEMP+1)
      WRITE (IOFILE,451) VALUE(LOCE),VALUE(LOCS+1)
  451 FORMAT('*ERROR*:  NO CONVERGENCE IN DC TRANSFER CURVES AT ',A8,
     1   ' = ',1PD10.3/'LAST NODE VOLTAGES:'/)
      WRITE (IOFILE,AVHDR) (ANODE,AVLTG,I=1,NVPRLN)
      WRITE (IOFILE,AVFRM) (LPRN,NODPLC(JUNODE+I),VALUE(LVNIM1+I),
     1  I=2,NCNODS)
      GO TO 470
  460 WRITE (IOFILE,461)
  461 FORMAT('*ERROR*:  CPU TIME LIMIT EXCEEDED ... ANALYSIS STOPPED'/)
      GO TO 470
  462 WRITE(IOFILE,463)
  463 FORMAT('*ERROR*:   TEMPERATURE SWEEP SHOULD BE THE SECOND SWEEP
     1SOURCE, CHANGE THE ORDER AND RE-EXECUTE'/)
  470 NOGO=1
      GO TO 490
C... RESET FIRST SWEEP VARIABLE ... STEP SECOND
  480 ICAL2=0
      VALUE(LOCS+1)=TCSTAR(1)
      IF (IRDCTC.EQ.1) VALUE(LOCS+1)=1.0D0/VALUE(LOCS+1)
      IF (ITDCTC.EQ.1) GO TO 462
      VALUE(LOCS2+1)=VALUE(LOCS2+1)+TCINCR(2)
      IF (IRDCT2.EQ.1) VALUE(LOCS2+1)=1.0D0/VALUE(LOCS2+1)
      IF (ITDCT2.NE.1) GO TO 340
      VALUE(ITEMPS+ITEMNO-1)=VALUE(ITEMPS+ITEMNO)
      VALUE(ITEMPS+ITEMNO)=VALUE(LOCS2+1)
      CALL TMPUPD
      GO TO 340
C
C  FINISHED WITH DC TRANSFER CURVES
C
  490 VALUE(LOCS+1)=TEMVAL
      IF(ITCELM(2).NE.0) VALUE(LOCS2+1)=TEMV2
      IF ((ITDCTC.EQ.0).AND.(ITDCT2.EQ.0)) GO TO 1000
      VALUE(ITEMPS+ITEMNO-1)=VALUE(ITEMPS+ITEMNO)
      IF (ITDCTC.EQ.1) VALUE(ITEMPS+ITEMNO)=TEMVAL
      IF (ITDCT2.EQ.1) VALUE(ITEMPS+ITEMNO)=TEMV2
      WRITE (IOFILE,492)
  492 FORMAT (/,'***** RETURN TO ORIGINAL TEMPERATURE *****',/)
      CALL TMPUPD
      ITEMNO=1
      CALL RELMEM(ITEMPS,2)
      IF(IPOSTP.NE.2) GO TO 1000
      CALL FWRITE(VALUE(IBUFF+1),NUMPOS)
      GO TO 1000
C
C  ....  TRANSIENT ANALYSIS
C
  500 NUMOUT=JELCNT(42)+1
      IF(IPOSTP.EQ.2) CALL PHEADR(ATITLE)
C...  LIMIT DELMAX IF NO ENERGY-STORAGE ELEMENTS
      NUMESE=JELCNT(2)+JELCNT(3)+JELCNT(11)+JELCNT(12)+JELCNT(13)
     1   +JELCNT(14)
      IF (NUMESE.EQ.0) DELMAX=DMIN1(DELMAX,TSTEP)
      INITF=5
      IORD=1
      LOCTIM=9
      ICALC=0
      NUMTP=0
      NUMRTP=0
      NUMNIT=0
      TIME=0.0D0
      IBKFLG=1
      DELBKP=DELMAX
      NBKPT=1
      DELTA=DELMAX
      DO 510 I=1,7
      DELOLD(I)=DELTA
  510 CONTINUE
      DELNEW=DELTA
      DELMIN=1.0D-9*DELMAX
      GO TO 650
C
C  INCREMENT TIME, UPDATE SOURCES, AND SOLVE NEXT TIMEPOINT
C
  600 TIME=TIME+DELTA
      CALL SORUPD
      IF (NOGO.NE.0) GO TO 950
      CALL GETCJE
      IF ((MAXTIM-ITIME).LE.LIMTIM) GO TO 920
      IF ((ITL5.NE.0).AND.(NUMNIT.GE.ITL5)) GO TO 905
      CALL COMCOF
      IF (INITF.NE.5) INITF=6
      ITRLIM=ITL4
      IF ((NUMTP.EQ.0).AND.(NOSOLV.NE.0)) ITRLIM=ITL1
      CALL ITER8(ITRLIM)
      NUMNIT=NUMNIT+ITERNO
      NUMTP=NUMTP+1
      IF (NUMTP.NE.1) GO TO 605
      IF(NOLX2.EQ.0) CALL COPY8(VALUE(LX1+1),VALUE(LX2+1),NXTRM)
      IF(NOLX3.EQ.0) CALL COPY8(VALUE(LX1+1),VALUE(LX3+1),NXTRM)
C.. NOTE THAT TIME-POINT IS CUT WHEN ITRLIM EXCEEDED REGARDLESS
C.. OF WHICH TIME-STEP CONTOL IS SPECIFIED THRU 'LVLTIM'.
  605 IF (IGOOF.EQ.0) GO TO 610
      JORD=IORD
      IORD=1
      IF (JORD.GE.5) CALL CLRMEM(LX7)
      IF (JORD.GE.4) CALL CLRMEM(LX6)
      IF (JORD.GE.3) CALL CLRMEM(LX5)
      IF ((JORD.GE.2).AND.(METHOD.NE.1)) CALL CLRMEM(LX4)
      IGOOF=0
      TIME=TIME-DELTA
      DELTA=DELTA/8.0D0
      GO TO 620
  610 DELNEW=DELTA
      IF (NUMTP.EQ.1) GO TO 630
      CALL TRUNC(DELNEW)
      IF (DELNEW.GE.(0.9D0*DELTA)) GO TO 630
      TIME=TIME-DELTA
      DELTA=DELNEW
  620 NUMRTP=NUMRTP+1
      IBKFLG=0
      DELOLD(1)=DELTA
      IF (DELTA.GE.DELMIN) GO TO 600
      TIME=TIME+DELTA
      GO TO 900
C
C  DETERMINE ORDER OF INTEGRATION METHOD
C
C...  SKIP IF TRAPEZOIDAL ALGORITHM USED
  630 IF ((METHOD.EQ.1).AND.(IORD.EQ.2)) GO TO 650
      IF (NUMTP.EQ.1) GO TO 650
      ORDRAT=1.05D0
      IF (IORD.GT.1) GO TO 635
      IORD=2
      CALL TRUNC(DELNEW)
      IORD=1
      IF ((DELNEW/DELTA).LE.ORDRAT) GO TO 650
      IF (MAXORD.LE.1) GO TO 650
      IORD=2
      IF (METHOD.EQ.1) GO TO 650
      CALL GETM8(LX4,NXTRM)
      GO TO 650
  635 IF (IORD.LT.MAXORD) GO TO 640
      IORD=IORD-1
      CALL TRUNC(DELNEW)
      IORD=IORD+1
      IF ((DELNEW/DELTA).LE.ORDRAT) GO TO 650
      GO TO 642
  640 IORD=IORD-1
      CALL TRUNC(DELNEW)
      IORD=IORD+1
      IF ((DELNEW/DELTA).LE.ORDRAT) GO TO 645
  642 IORD=IORD-1
      IF (IORD.EQ.1) CALL CLRMEM(LX4)
      IF (IORD.EQ.2) CALL CLRMEM(LX5)
      IF (IORD.EQ.3) CALL CLRMEM(LX6)
      IF (IORD.EQ.4) CALL CLRMEM(LX7)
      GO TO 650
  645 IORD=IORD+1
      CALL TRUNC(DELNEW)
      IORD=IORD-1
      IF ((DELNEW/DELTA).LE.ORDRAT) GO TO 650
      IORD=IORD+1
      IF (IORD.EQ.2) CALL GETM8(LX4,NXTRM)
      IF (IORD.EQ.3) CALL GETM8(LX5,NXTRM)
      IF (IORD.EQ.4) CALL GETM8(LX6,NXTRM)
      IF (IORD.EQ.5) CALL GETM8(LX7,NXTRM)
C
C  STORE OUTPUTS
C
  650 IF ((TIME+DELTA).LE.TSTART) GO TO 685
      IF ((NUMTP.EQ.0).AND.(NOSOLV.NE.0)) GO TO 685
      CALL EXTMEM(LOUTPT,NUMOUT)
      LOCO=LOUTPT+ICALC*NUMOUT
      ICALC=ICALC+1
      VALUE(LOCO+1)=TIME
      LOC=LOCATE(42)
  670 IF (LOC.EQ.0) GO TO 682
      IF (NODPLC(LOC+5).NE.0) GO TO 680
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      ISEQ=NODPLC(LOC+4)
      VALUE(LOCO+ISEQ)=VALUE(LVNIM1+NODE1)-VALUE(LVNIM1+NODE2)
      LOC=NODPLC(LOC)
      GO TO 670
  680 IPTR=NODPLC(LOC+2)
      IPTR=NODPLC(IPTR+6)
      ISEQ=NODPLC(LOC+4)
      VALUE(LOCO+ISEQ)=VALUE(LVNIM1+IPTR)
      LOC=NODPLC(LOC)
      GO TO 670
  682 IF(IPOSTP.NE.2) GO TO 684
      VALUE(IBUFF+1)=TIME
      CALL COPY8(VALUE(LVNIM1+2),VALUE(IBUFF+2),NUNODS-1)
      IF(NUMCUR.NE.0) CALL COPY8(VALUE(LVNIM1+LOCCUR+1),
     1  VALUE(IBUFF+NUNODS+1),NUMCUR)
      CALL FWRITE(VALUE(IBUFF+1),NUMPOS)
  684 CONTINUE
C
C  UPDATE TRANSMISSION LINE DELAY TABLE
C
  685 IF (JELCNT(17).EQ.0) GO TO 694
      CALL SIZMEM(LTD,LTDSIZ)
      NUMTD=LTDSIZ/NTLIN
      IF (NUMTD.LE.3) GO TO 689
      BAKTIM=TIME-TDMAX
      IF (BAKTIM.LT.0.0D0) GO TO 689
      LCNTR=0
      LTEMP=LTD
      DO 686 I=1,NUMTD
      IF (VALUE(LTEMP+1).GE.BAKTIM) GO TO 687
      LTEMP=LTEMP+NTLIN
      LCNTR=LCNTR+1
  686 CONTINUE
      GO TO 689
  687 IF (LCNTR.LE.2) GO TO 689
      LCNTR=LCNTR-2
      NWORDS=LCNTR*NTLIN
      LTEMP=LTEMP-NTLIN-NTLIN
      CALL COPY8(VALUE(LTEMP+1),VALUE(LTD+1),LTDSIZ-NWORDS)
      CALL RELMEM(LTD,NWORDS)
      CALL SIZMEM(LTD,LTDSIZ)
  689 CALL EXTMEM(LTD,NTLIN)
      LTDPTR=LTD+LTDSIZ
      VALUE(LTDPTR+1)=TIME
      LOC=LOCATE(17)
  690 IF (LOC.EQ.0) GO TO 693
      LOCV=NODPLC(LOC+1)
      Z0=VALUE(LOCV+1)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      NODE3=NODPLC(LOC+4)
      NODE4=NODPLC(LOC+5)
      IBR1=NODPLC(LOC+8)
      IBR2=NODPLC(LOC+9)
      LSPOT=NODPLC(LOC+30)+LTDPTR
      IF ((INITF.EQ.5).AND.(NOSOLV.NE.0)) GO TO 691
      VALUE(LSPOT)=VALUE(LVNIM1+NODE3)-VALUE(LVNIM1+NODE4)
     1   +VALUE(LVNIM1+IBR2)*Z0
      VALUE(LSPOT+1)=VALUE(LVNIM1+NODE1)-VALUE(LVNIM1+NODE2)
     1   +VALUE(LVNIM1+IBR1)*Z0
      GO TO 692
  691 VALUE(LSPOT)=VALUE(LOCV+7)+VALUE(LOCV+8)*Z0
      VALUE(LSPOT+1)=VALUE(LOCV+5)+VALUE(LOCV+6)*Z0
  692 LOC=NODPLC(LOC)
      GO TO 690
C
C  ADD TWO *FAKE* BACKPOINTS TO LTD FOR INTERPOLATION NEAR TIME=0.0D0
C
  693 IF (NUMTD.NE.0) GO TO 694
      CALL EXTMEM(LTD,NTLIN+NTLIN)
      CALL COPY8(VALUE(LTD+1),VALUE(LTD+NTLIN+1),NTLIN)
      CALL COPY8(VALUE(LTD+1),VALUE(LTD+2*NTLIN+1),NTLIN)
      VALUE(LTD+2*NTLIN+1)=TIME
      VALUE(LTD+NTLIN+1)=TIME-DELTA
      VALUE(LTD+1)=TIME-DELTA-DELTA
C
C  ROTATE STATE VECTOR STORAGE
C
C.. TIME-POINT ACCEPTED
  694 CALL COPY8(DELOLD(1),DELOLD(2),6)
      DELTA=DELNEW
      DELOLD(1)=DELTA
      GO TO (710,706,702,698,696,696), IORD
  696 CALL PTRMEM(LX7,ITEMP)
      CALL PTRMEM(LX6,LX7)
      GO TO 700
  698 CALL PTRMEM(LX6,ITEMP)
  700 CALL PTRMEM(LX5,LX6)
      GO TO 704
  702 CALL PTRMEM(LX5,ITEMP)
  704 CALL PTRMEM(LX4,LX5)
      GO TO 708
  706 IF (METHOD.EQ.1) GO TO 710
      CALL PTRMEM(LX4,ITEMP)
  708 CALL PTRMEM(LX3,LX4)
      GO TO 713
  710 IF(NOLX3.EQ.0) GO TO 712
      IF(NOLX2.EQ.0) GO TO 711
      CALL PTRMEM(LX1,ITEMP)
      GO TO 714
  711 CALL PTRMEM(LX2,ITEMP)
      CALL PTRMEM(LX1,LX2)
      GO TO 714
  712 CALL PTRMEM(LX3,ITEMP)
  713 CALL PTRMEM(LX2,LX3)
      CALL PTRMEM(LX1,LX2)
  714 CALL PTRMEM(LX0,LX1)
      CALL PTRMEM(ITEMP,LX0)
C
C  CHECK BREAKPOINTS
C
  750 IF (IBKFLG.EQ.0) GO TO 760
C.. JUST ACCEPTED ANALYSIS AT BREAKPOINT
      JORD=IORD
      IORD=1
      IF (JORD.GE.5) CALL CLRMEM(LX7)
      IF (JORD.GE.4) CALL CLRMEM(LX6)
      IF (JORD.GE.3) CALL CLRMEM(LX5)
      IF ((JORD.GE.2).AND.(METHOD.NE.1)) CALL CLRMEM(LX4)
      IBKFLG=0
      NBKPT=NBKPT+1
      IF (NBKPT.GT.NUMBKP) GO TO 950
      TEMP=DMIN1(DELBKP,VALUE(LSBKPT+NBKPT)-TIME)
      DELTA=DMIN1(DELTA,0.1D0*TEMP,DELMAX)
      IF (NUMTP.EQ.0) DELTA=DELTA/10.0D0
      DELOLD(1)=DELTA
      GO TO 600
  760 DEL1=VALUE(LSBKPT+NBKPT)-TIME
      IF ((1.01D0*DELTA).LE.DEL1) GO TO 600
      IBKFLG=1
      DELBKP=DELTA
      DELTA=DEL1
      DELOLD(1)=DELTA
      GO TO 600
C
C  TRANSIENT ANALYSIS FAILED
C
  900 WRITE (IOFILE,901)
  901 FORMAT('*ERROR*:  INTERNAL TIMESTEP TOO SMALL IN TRANSIENT ANALYS
     1IS'/)
      GO TO 910
  905 WRITE (IOFILE,906) ITL5
  906 FORMAT('*ERROR*:  TRANSIENT ANALYSIS ITERATIONS EXCEED LIMIT OF '
     1,I5,/'THIS LIMIT MAY BE OVERRIDDEN USING THE ITL5 PARAMETER ON TH
     2E .OPTION CARD')
  910 WRITE (IOFILE,911) TIME,DELTA,NUMNIT
  911 FORMAT(10X,'TIME = ',1PD12.5,';  DELTA = ',D12.5,';  NUMNIT =
     1',I6/)
      WRITE (IOFILE,916)
  916 FORMAT(/'LAST NODE VOLTAGES:'/)
      WRITE (IOFILE,AVHDR) (ANODE,AVLTG,I=1,NVPRLN)
      WRITE (IOFILE,AVFRM) (LPRN,NODPLC(JUNODE+I),VALUE(LVNIM1+I),
     1  I=2,NCNODS)
      GO TO 930
  920 WRITE (IOFILE,921) TIME
  921 FORMAT('*ERROR*:  CPU TIME LIMIT EXCEEDED IN TRANSIENT ANALYSIS '
     1   ,'AT TIME = ',1PD13.6/)
  930 NOGO=1
C
C  FINISHED WITH TRANSIENT ANALYSIS
C
  950 RSTATS(10)=RSTATS(10)+NUMNIT
      RSTATS(30)=RSTATS(30)+NUMTP
      RSTATS(31)=RSTATS(31)+NUMRTP
      RSTATS(32)=RSTATS(32)+NUMNIT
      IF(IPOSTP.NE.2) GO TO 1000
CDW      IF (IPOSTP.NE.0) CALL CLSRAW
C
C  RETURN UNNEEDED MEMORY
C
 1000 IF (MODE.EQ.2) GO TO 1010
      IF (MODEDC.NE.3) GO TO 1100
 1010 CALL CLRMEM(LVNIM1)
      CALL CLRMEM(LX0)
      CALL CLRMEM(LVN)
      CALL CLRMEM(LX1)
      IF (MEMPTR(MACINS)) CALL CLRMEM(MACINS)
      IF(NOLX2.EQ.0) CALL CLRMEM(LX2)
      CALL CLRMEM(LVNTMP)
      IF ((MODE.EQ.1).AND.(MODEDC.EQ.3)) GO TO 1020
      IF(NOLX3.EQ.0) CALL CLRMEM(LX3)
      IF (MODE.EQ.1) GO TO 1020
      CALL CLRMEM(LTD)
      IF (IORD.EQ.1) GO TO 1020
      IF (METHOD.EQ.1) GO TO 1020
      CALL CLRMEM(LX4)
      IF (IORD.EQ.2) GO TO 1020
      CALL CLRMEM(LX5)
      IF (IORD.EQ.3) GO TO 1020
      CALL CLRMEM(LX6)
      IF (IORD.EQ.4) GO TO 1020
      CALL CLRMEM(LX7)
 1020 CALL EXTMEM(LOUTPT,2*NUMOUT)
 1100 IF(IPOSTP.EQ.2) CALL CLRMEM(IBUFF)
      CALL SECOND(T2)
      RSTATS(LOCTIM)=RSTATS(LOCTIM)+T2-T1
      RETURN
      END
      SUBROUTINE PHEADR(AHEADR)
      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=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=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=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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
C int3 (not used) is strictly for alignment.  f77 on Unix craps out.
      INTEGER*2 INT2,int3
      INTEGER NODPL2(128)
      EQUIVALENCE (VALUE(1),NODPL2(1))
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
      DIMENSION AHEADR(10)
C
C  PUT OUT THE HEADER RECORDS ONTO THE POST-PROCESSING FILE
C  ROUTINE IS USED FOR ALL ANALYSIS MODES (MODE=1,2,3)
C
      DIMENSION XTYPE(2)
      DATA XTYPE /4HTIME,4HFREQ/
      DATA ABLNK,ALETV,ALETI /1H ,1HV,1HI/
C
C File structure for post-processor
C
C Record 1  Title card (80 bytes), date (8 bytes), time (8 bytes) TOTAL-96 BYTES
C Record 2  Number of output variables (including "sweep" variable)
C Record 3  Integer '4' (2 bytes)
C Record 4  Names of each output variable (8 bytes ea.)
C Record 5  Type of each output       0-no type
C                                     1-time
C                                     2-frequency
C                                     3-voltage
C                                     4-current
C                                     5-output noise
C                                     6-input noise
C                                     7-HD2    |
C                                     8-HD3    |
C                                     9-DIM2   }   distortion outputs
C                                    10-SIM2   |
C                                    11-DIM3   |
C Record 6  The location of each variable within each sweep point.
C           (Normally just 1,2,3,4,... but needed if outputs are mixed up)
C Record 6a 24 characters that are the plot title if Record 3 is a '4'.
C Record 7  Output at first sweep point
C Record 8  Output at second sweep point
C Record 9  .
C           .
C           .
C last record
C
C
      CALL GETM8(IBUFF,12)
      CALL COPY8(AHEADR(1),VALUE(IBUFF+1),10)
      VALUE(IBUFF+11)=ADATE
      VALUE(IBUFF+12)=ATIME
      CALL FWRITE(VALUE(IBUFF+1),48)
      NUMOUT=NUNODS+JELCNT(9)
C Force nused to be allocated by useless usage.
      int2 = NUMOUT
      int3 = NUMOUT
      INFO=4
      CALL GETM8(INAMES,NUMOUT)
      CALL GETM4(ITYPES,NUMOUT)
      CALL GETM4(ISEQS,NUMOUT)
      ITYPE2=ITYPES*2
      ISEQ2=ISEQS*2
      IKNT=1
      NODPL2(ISEQ2+1)=1
C
C DC Transfer curve (mode = 1):
C
      IF(MODE.NE.1) GO TO 10
      LOC=ITCELM(1)
      LOCV=NODPLC(LOC+1)
      VALUE(INAMES+1)=VALUE(LOCV)
      ANAM=ABLNK
      CALL MOVE(ANAM,1,VALUE(LOCV),1,1)
      ITYP=0
C Voltage transfer becomes type 3 and Current transfer becomes 4.
      IF(ANAM.EQ.ALETV) ITYP=3
      IF(ANAM.EQ.ALETI) ITYP=4
      NODPL2(ITYPE2+1)=ITYP
      GO TO 20
   10 VALUE(INAMES+1)=XTYPE(MODE-1)
      NODPL2(ITYPE2+1)=MODE-1
   20 DO 30 I=2,NUNODS
      NODPL2(ITYPE2+I)=3
      NODPL2(ISEQ2+I)=I
      VALUE(INAMES+I)=ABLNK
      IPOS=1
      CALL ALFNUM(NODPLC(JUNODE+I),VALUE(INAMES+I),IPOS)
   30 CONTINUE
      LOC=LOCATE(9)
      IKNT=NUNODS
   40 IF(LOC.EQ.0) GO TO 50
      IKNT=IKNT+1
      NODPL2(ITYPE2+IKNT)=4
      NODPL2(ISEQ2+IKNT)=IKNT
      LOCV=NODPLC(LOC+1)
      VALUE(INAMES+IKNT)=VALUE(LOCV)
      LOC=NODPLC(LOC)
      GO TO 40
   50 INT2=NUMOUT
      CALL FWRITE(INT2,1)
      INT2=INFO
      CALL FWRITE(INT2,1)
      NWDS=NUMOUT*4
      CALL FWRITE(VALUE(INAMES+1),NWDS)
CDW Adapt SPICE2 header format: 2 bytes for types and order
      DO I = 1,NUMOUT
        INT2 = NODPL2(ITYPE2+I)
        CALL FWRITE(INT2,1)
      END DO
      DO I = 1,NUMOUT
        INT2 = NODPL2(ISEQ2+I)
        CALL FWRITE(INT2,1)
      END DO
      CALL FWRITE(APROG(1),12)
      CALL CLRMEM(IBUFF)
      CALL CLRMEM(INAMES)
      CALL CLRMEM(ITYPES)
      CALL CLRMEM(ISEQS)
      RETURN
      END
      SUBROUTINE COMCOF
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE CALCULATES THE TIMESTEP-DEPENDENT TERMS USED IN THE
C NUMERICAL INTEGRATION.
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=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(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
      DIMENSION GMAT(7,7)
C
C  COMPUTE COEFFICIENTS FOR PARTICULAR INTEGRATION METHOD
C
      IF (METHOD.NE.1) GO TO 5
      IF (IORD.EQ.1) GO TO 5
C...  TRAPEZOIDAL METHOD
      AG(1)=1.0D0/DELTA/(1.0D0-XMU)
      AG(2)=XMU/(1.0D0-XMU)
      GO TO 200
C
C  CONSTRUCT GEAR COEFFICIENT MATRIX
C
    5 ISTOP=IORD+1
      CALL ZERO8(AG,ISTOP)
      AG(2)=-1.0D0
      DO 10 I=1,ISTOP
      GMAT(1,I)=1.0D0
   10 CONTINUE
      DO 20 I=2,ISTOP
      GMAT(I,1)=0.0D0
   20 CONTINUE
      ARG=0.0D0
      DO 40 I=2,ISTOP
      ARG=ARG+DELOLD(I-1)
      ARG1=1.0D0
      DO 30 J=2,ISTOP
      ARG1=ARG1*ARG
      GMAT(J,I)=ARG1
   30 CONTINUE
   40 CONTINUE
C
C  SOLVE FOR GEAR COEFFICIENTS AG(*)
C
C
C  LU DECOMPOSITION
C
      DO 70 I=2,ISTOP
      JSTART=I+1
      IF (JSTART.GT.ISTOP) GO TO 70
      DO 60 J=JSTART,ISTOP
      GMAT(J,I)=GMAT(J,I)/GMAT(I,I)
      DO 50 K=JSTART,ISTOP
      GMAT(J,K)=GMAT(J,K)-GMAT(J,I)*GMAT(I,K)
   50 CONTINUE
   60 CONTINUE
   70 CONTINUE
C
C  FORWARD SUBSTITUTION
C
      DO 90 I=2,ISTOP
      JSTART=I+1
      IF (JSTART.GT.ISTOP) GO TO 90
      DO 80 J=JSTART,ISTOP
      AG(J)=AG(J)-GMAT(J,I)*AG(I)
   80 CONTINUE
   90 CONTINUE
C
C  BACKWARD SUBSTITUTION
C
      AG(ISTOP)=AG(ISTOP)/GMAT(ISTOP,ISTOP)
      IR=ISTOP
      DO 110 I=2,ISTOP
      JSTART=IR
      IR=IR-1
      DO 100 J=JSTART,ISTOP
      AG(IR)=AG(IR)-GMAT(IR,J)*AG(J)
  100 CONTINUE
      AG(IR)=AG(IR)/GMAT(IR,IR)
  110 CONTINUE
C
C  FINISHED
C
  200 RETURN
      END
      SUBROUTINE TRUNC(DELNEW)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE DETERMINES THE NEW TRANSIENT STEPSIZE BY EITHER
C CALLING TERR TO ESTIMATE THE LOCAL TRUNCATION ERROR, OR BY CHECKING
C ON THE NUMBER OF ITERATIONS NEEDED TO CONVERGE AT THE LAST TIMEPOINT.
C
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=TRAN 3/15/83
      COMMON /TRAN/ TSTEP,TSTOP,TSTART,DELMAX,TDMAX,FORFRE,JTRFLG
C SPICE VERSION 2G.6  SCCSID=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C
      IF (LVLTIM.NE.0) GO TO 5
      DELNEW=DMIN1(TSTEP,DELMAX)
      RETURN
    5 IF (LVLTIM.NE.1) GO TO 10
      DELNEW=DELTA
      IF (ITERNO.GT.ITL3) RETURN
      DELNEW=DMIN1(2.0D0*DELTA,TSTEP,DELMAX)
      RETURN
C
C  CAPACITORS
C
   10 DELNEW=1.0D20
      LOC=LOCATE(2)
   20 IF ((LOC.EQ.0).OR.(NODPLC(LOC+12).NE.0)) GO TO 30
      LOCT=NODPLC(LOC+8)
      CALL TERR(LOCT,DELNEW)
      LOC=NODPLC(LOC)
      GO TO 20
C
C  INDUCTORS
C
   30 LOC=LOCATE(3)
   40 IF ((LOC.EQ.0).OR.(NODPLC(LOC+14).NE.0)) GO TO 50
      LOCT=NODPLC(LOC+11)
      CALL TERR(LOCT,DELNEW)
      LOC=NODPLC(LOC)
      GO TO 40
C
C  DIODES
C
   50 LOC=LOCATE(11)
   60 IF ((LOC.EQ.0).OR.(NODPLC(LOC+16).NE.0)) GO TO 70
      LOCT=NODPLC(LOC+11)
      CALL TERR(LOCT+3,DELNEW)
      LOC=NODPLC(LOC)
      GO TO 60
C
C  BJTS
C
   70 LOC=LOCATE(12)
   80 IF ((LOC.EQ.0).OR.(NODPLC(LOC+36).NE.0)) GO TO 90
      LOCT=NODPLC(LOC+22)
      CALL TERR(LOCT+8,DELNEW)
      CALL TERR(LOCT+10,DELNEW)
      CALL TERR(LOCT+12,DELNEW)
      LOC=NODPLC(LOC)
      GO TO 80
C
C  JFETS
C
   90 LOC=LOCATE(13)
  100 IF ((LOC.EQ.0).OR.(NODPLC(LOC+25).NE.0)) GO TO 110
      LOCT=NODPLC(LOC+19)
      CALL TERR(LOCT+9,DELNEW)
      CALL TERR(LOCT+11,DELNEW)
      LOC=NODPLC(LOC)
      GO TO 100
C
C  MOSFETS
C
  110 LOC=LOCATE(14)
  120 IF ((LOC.EQ.0).OR.(NODPLC(LOC+33).NE.0)) GO TO 200
      LOCT=NODPLC(LOC+26)
      CALL TERR(LOCT+12,DELNEW)
      CALL TERR(LOCT+14,DELNEW)
      CALL TERR(LOCT+16,DELNEW)
      LOC=NODPLC(LOC)
      GO TO 120
C
C  DELTA IS ALLOWED ONLY TO DOUBLE AT EACH TIMEPOINT
C
  200 DELNEW=DMIN1(2.0D0*DELTA,DELNEW,DELMAX)
      RETURN
      END
      SUBROUTINE TERR(LOCT,DELNEW)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE ESTIMATES THE LOCAL TRUNCATION ERROR FOR A PARTICULAR
C CIRCUIT ELEMENT.  IT THEN COMPUTES THE APPROPRIATE STEPSIZE WHICH
C SHOULD BE USED.
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=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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C
      DIMENSION QCAP(1),CCAP(1),DIFF(8),DELTMP(7),COEF(6)
      EQUIVALENCE (QCAP(1),VALUE(1)),(CCAP(1),VALUE(2))
      DATA COEF / 5.000000000D-1, 2.222222222D-1, 1.363636364D-1,
     1            9.600000000D-2, 7.299270073D-2, 5.830903790D-2 /
      DATA XTWELV / 8.333333333D-2 /
C
C
      TOL=RELTOL*DMAX1(DABS(CCAP(LX0+LOCT)),DABS(CCAP(LX1+LOCT)))+ABSTOL
      CTOL=RELTOL*DMAX1(DABS(QCAP(LX0+LOCT)),DABS(QCAP(LX1+LOCT)),
     1   CHGTOL)/DELTA
      TOL=DMAX1(TOL,CTOL)
C
C  DETERMINE DIVIDED DIFFERENCES
C
      GO TO (6,5,4,3,2,1), IORD
    1 DIFF(8)=QCAP(LX7+LOCT)
    2 DIFF(7)=QCAP(LX6+LOCT)
    3 DIFF(6)=QCAP(LX5+LOCT)
    4 DIFF(5)=QCAP(LX4+LOCT)
    5 DIFF(4)=QCAP(LX3+LOCT)
    6 DIFF(3)=QCAP(LX2+LOCT)
      DIFF(2)=QCAP(LX1+LOCT)
      DIFF(1)=QCAP(LX0+LOCT)
      ISTOP=IORD+1
      DO 10 I=1,ISTOP
      DELTMP(I)=DELOLD(I)
   10 CONTINUE
   20 DO 30 I=1,ISTOP
      DIFF(I)=(DIFF(I)-DIFF(I+1))/DELTMP(I)
   30 CONTINUE
      ISTOP=ISTOP-1
      IF (ISTOP.EQ.0) GO TO 100
      DO 40 I=1,ISTOP
      DELTMP(I)=DELTMP(I+1)+DELOLD(I)
   40 CONTINUE
      GO TO 20
C
C  DIFF(1) CONTAINS DIVIDED DIFFERENCE
C
  100 CONST=COEF(IORD)
      IF ((METHOD.EQ.1).AND.(IORD.EQ.2)) CONST=XTWELV
      DEL=TRTOL*TOL/DMAX1(ABSTOL,CONST*DABS(DIFF(1)))
      IF (IORD.EQ.1) GO TO 200
      IF (IORD.GE.3) GO TO 150
      DEL=DSQRT(DEL)
      GO TO 200
  150 DEL=DEXP(DLOG(DEL)/DFLOAT(IORD))
  200 DELNEW=DMIN1(DELNEW,DEL)
      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(1000000)
      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('*ABORT*:  INTERNAL SPICE ERROR:  SORUPD:  ',2I5/)
C
C  FINISHED
C
 1000 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(1000000)
      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(' SOURCE STEPPING METHOD FAILED')
  200 INITF=2
      RETURN
      END
      SUBROUTINE ITER8(ITLIM)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE DRIVES THE NEWTON-RAPHSON ITERATION TECHNIQUE USED TO
C SOLVE THE SET OF NONLINEAR CIRCUIT EQUATIONS.
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=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(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C
      IGOOF=0
      ITERNO=0
      NDRFLO=0
      NONCON=0
      IPASS=0
C
C  CONSTRUCT LINEAR EQUATIONS AND CHECK CONVERGENCE
C
   10 IVMFLG=0
      CALL LOAD
   15 IF ((MODE.EQ.1).AND.(MODEDC.EQ.2).AND.(NOSOLV.NE.0)) GO TO 300
      ITERNO=ITERNO+1
      GO TO (20,30,40,60,50,60),INITF
   20 IF(MODE.NE.1) GO TO 22
      CALL SIZMEM(NSNOD,NIC)
      IF (NIC.EQ.0) GO TO 22
      IF (IPASS.NE.0) NONCON=IPASS
      IPASS=0
   22 IF (NONCON.EQ.0) GO TO 300
      GO TO 100
   30 INITF=3
      IF(LVLCOD.EQ.3) LVLCOD=2
      IPIV=1
   40 IF (NONCON.EQ.0) INITF=1
      IPASS=1
      GO TO 100
   50 IF (ITERNO.GT.1) GO TO 60
      IPIV=1
      IF (LVLCOD.EQ.3) LVLCOD=2
   60 INITF=1
C
C  SOLVE EQUATIONS FOR NEXT ITERATION
C
  100 IF (ITERNO.GE.ITLIM) GO TO 200
  102 CALL DCDCMP
      IF (IGOOF.NE.0) GO TO 400
      IF (LVLCOD.EQ.1) GO TO 105
  105 CALL DCSOL
      GO TO 120
  120 IF (IGOOF.EQ.0) GO TO 130
      IGOOF=0
      IF (LVLCOD.NE.1) LVLCOD=2
      IPIV=1
      CALL LOAD
      GO TO 102
  130 VALUE(LVN+1)=0.0D0
      DO 135 I=1,NSTOP
      J=NODPLC(ICSWPR+I)
      K=NODPLC(IRSWPF+J)
      VALUE(LVNTMP+K)=VALUE(LVNIM1+I)
  135 CONTINUE
      CALL COPY8(VALUE(LVNTMP+1),VALUE(LVNIM1+1),NSTOP)
      NTEMP=NONCON
      NONCON=0
      IF (NTEMP.GT.0) GO TO 150
      IF (ITERNO.EQ.1) GO TO 150
      DO 140 I=2,NUMNOD
      VOLD=VALUE(LVNIM1+I)
      VNEW=VALUE(LVN+I)
      TOL=RELTOL*DMAX1(DABS(VOLD),DABS(VNEW))+VNTOL
      IF (DABS(VOLD-VNEW).LE.TOL) GO TO 140
      NONCON=NONCON+1
  140 CONTINUE
  150 DO 160 I=1,NSTOP
      J=NODPLC(ICSWPR+I)
      K=NODPLC(IRSWPF+J)
      VALUE(LVNIM1+I)=VALUE(LVN+K)
  160 CONTINUE
C     WRITE(IOFILE,151) (VALUE(LVN+K),K=1,NSTOP)
C 151 FORMAT(' SOLUTION: '/1P12D10.3)
      GO TO 10
C
C  NO CONVERGENCE
C
  200 IGOOF=1
  300 IF (NDRFLO.EQ.0) GO TO 400
      WRITE (IOFILE,301) NDRFLO
  301 FORMAT('WARNING:  UNDERFLOW OCCURRED ',I4,' TIME(S)')
C
C  FINISHED
C
  400 RETURN
      END
      SUBROUTINE LOAD
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      REAL T1, T2
C
C     THIS ROUTINE ZEROES-OUT AND THEN LOADS THE COEFFICIENT MATRIX.
C THE ACTIVE DEVICES AND THE CONTROLLED SOURCES ARE LOADED BY SEPARATE
C SUBROUTINES.
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=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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C
      DIMENSION QCAP(1),CCAP(1)
      EQUIVALENCE (QCAP(1),VALUE(1)),(CCAP(1),VALUE(2))
      DIMENSION FIND(1),VIND(1)
      EQUIVALENCE (FIND(1),VALUE(1)),(VIND(1),VALUE(2))
C
      CALL SECOND(T1)
C
C  ZERO Y MATRIX AND CURRENT VECTOR
C
      CALL ZERO8(VALUE(LVN+1),NSTOP+NTTBR)
C
C  RESISTORS
C
      LOC=LOCATE(1)
   20 IF ((LOC.EQ.0).OR.(NODPLC(LOC+8).NE.0)) GO TO 30
      LOCV=NODPLC(LOC+1)
      VAL=VALUE(LOCV+1)
      LOCY=LVN+NODPLC(LOC+6)
      VALUE(LOCY)=VALUE(LOCY)+VAL
      LOCY=LVN+NODPLC(LOC+7)
      VALUE(LOCY)=VALUE(LOCY)+VAL
      LOCY=LVN+NODPLC(LOC+4)
      VALUE(LOCY)=VALUE(LOCY)-VAL
      LOCY=LVN+NODPLC(LOC+5)
      VALUE(LOCY)=VALUE(LOCY)-VAL
      LOC=NODPLC(LOC)
      GO TO 20
C
C  CAPACITORS
C
   30 LOC=LOCATE(2)
      IF ((MODE.EQ.1).AND.(MODEDC.NE.2)) GO TO 100
   40 IF ((LOC.EQ.0).OR.(NODPLC(LOC+12).NE.0)) GO TO 100
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      LOCT=NODPLC(LOC+8)
      IPOLY=NODPLC(LOC+4)
      IF (IPOLY.EQ.1) GO TO 43
      LCOEF=NODPLC(LOC+7)
      CALL SIZMEM(NODPLC(LOC+7),NCOEF)
   43 VCAP=VALUE(LOCV+2)
      IF ((MODE.EQ.1).AND.(INITF.EQ.2)) GO TO 45
      IF ((NOSOLV.NE.0).AND.(INITF.EQ.5)) GO TO 45
      VCAP=VALUE(LVNIM1+NODE1)-VALUE(LVNIM1+NODE2)
   45 VALUE(LOCV+3)=VCAP
      IF (MODE.EQ.1) GO TO 60
   47 IF (INITF.NE.6) GO TO 50
      QCAP(LX0+LOCT)=QCAP(LX1+LOCT)
      GO TO 60
   50 IF (IPOLY.EQ.0) GO TO 53
      QCAP(LX0+LOCT)=VALUE(LOCV+1)*VCAP
      IF (INITF.NE.5) GO TO 60
      IF (NOSOLV.NE.0) QCAP(LX0+LOCT)=VALUE(LOCV+1)*VALUE(LOCV+2)
      QCAP(LX1+LOCT)=QCAP(LX0+LOCT)
      GO TO 60
   53 CALL EVPOLY(QCAP(LX0+LOCT),-1,LCOEF,NCOEF,LOCV+2,1,LOC+8)
      IF (INITF.NE.5) GO TO 60
      IF (NOSOLV.EQ.0) GO TO 55
      VCAP=VALUE(LOCV+2)
      VALUE(LOCV+3)=VCAP
      CALL EVPOLY(QCAP(LX0+LOCT),-1,LCOEF,NCOEF,LOCV+2,1,LOC+8)
   55 QCAP(LX1+LOCT)=QCAP(LX0+LOCT)
   60 IF (IPOLY.EQ.1) GO TO 62
      CALL EVPOLY(VALUE(LOCV+1),0,LCOEF,NCOEF,LOCV+2,1,LOC+8)
   62 IF (MODE.EQ.1) GO TO 90
      CALL INTGR8(GEQ,CEQ,VALUE(LOCV+1),LOCT)
      IF (IPOLY.EQ.1) GO TO 65
      CEQ=CEQ-GEQ*VCAP+AG(1)*QCAP(LX0+LOCT)
   65 IF(INITF.NE.5) GO TO 70
      CCAP(LX1+LOCT)=CCAP(LX0+LOCT)
   70 LOCY=LVN+NODPLC(LOC+10)
      VALUE(LOCY)=VALUE(LOCY)+GEQ
      LOCY=LVN+NODPLC(LOC+11)
      VALUE(LOCY)=VALUE(LOCY)+GEQ
      LOCY=LVN+NODPLC(LOC+5)
      VALUE(LOCY)=VALUE(LOCY)-GEQ
      LOCY=LVN+NODPLC(LOC+6)
      VALUE(LOCY)=VALUE(LOCY)-GEQ
      VALUE(LVN+NODE1)=VALUE(LVN+NODE1)-CEQ
      VALUE(LVN+NODE2)=VALUE(LVN+NODE2)+CEQ
   90 LOC=NODPLC(LOC)
      GO TO 40
C
C  INDUCTORS
C
  100 IF (JELCNT(3).EQ.0) GO TO 400
      IF (MODE.EQ.1) GO TO 150
      IF (INITF.EQ.6) GO TO 150
      LOC=LOCATE(3)
  110 IF ((LOC.EQ.0).OR.(NODPLC(LOC+14).NE.0)) GO TO 120
      LOCV=NODPLC(LOC+1)
      IPTR=NODPLC(LOC+5)
      LOCT=NODPLC(LOC+11)
      IPOLY=NODPLC(LOC+4)
      IF (IPOLY.EQ.0) GO TO 115
      FIND(LX0+LOCT)=VALUE(LOCV+1)*VALUE(LVNIM1+IPTR)
      IF ((INITF.EQ.5).AND.(NOSOLV.NE.0))
     1   FIND(LX0+LOCT)=VALUE(LOCV+1)*VALUE(LOCV+2)
      GO TO 118
  115 LCOEF=NODPLC(LOC+10)
      CALL SIZMEM(NODPLC(LOC+10),NCOEF)
      CIND=VALUE(LVNIM1+IPTR)
      IF ((INITF.EQ.5).AND.(NOSOLV.NE.0)) CIND=VALUE(LOCV+2)
      VALUE(LOCV+3)=CIND
      CALL EVPOLY(FIND(LX0+LOCT),-1,LCOEF,NCOEF,LOCV+2,1,LOC+11)
  118 LOC=NODPLC(LOC)
      GO TO 110
  120 LOC=LOCATE(4)
  130 IF ((LOC.EQ.0).OR.(NODPLC(LOC+6).NE.0)) GO TO 150
      LOCV=NODPLC(LOC+1)
      NL1=NODPLC(LOC+2)
      NL2=NODPLC(LOC+3)
      IPTR1=NODPLC(NL1+5)
      IPTR2=NODPLC(NL2+5)
      LOCT1=NODPLC(NL1+11)
      LOCT2=NODPLC(NL2+11)
      FIND(LX0+LOCT1)=FIND(LX0+LOCT1)+VALUE(LOCV+1)*VALUE(LVNIM1+IPTR2)
      FIND(LX0+LOCT2)=FIND(LX0+LOCT2)+VALUE(LOCV+1)*VALUE(LVNIM1+IPTR1)
      LOC=NODPLC(LOC)
      GO TO 130
  150 LOC=LOCATE(3)
  160 IF ((LOC.EQ.0).OR.(NODPLC(LOC+14).NE.0)) GO TO 300
      LOCV=NODPLC(LOC+1)
      IPTR=NODPLC(LOC+5)
      LOCT=NODPLC(LOC+11)
      IPOLY=NODPLC(LOC+4)
      IF (IPOLY.EQ.1) GO TO 170
      LCOEF=NODPLC(LOC+10)
      CALL SIZMEM(NODPLC(LOC+10),NCOEF)
  170 CIND=VALUE(LVNIM1+IPTR)
      IF ((NOSOLV.NE.0).AND.(INITF.EQ.5)) CIND=VALUE(LOCV+2)
      VALUE(LOCV+3)=CIND
  180 IF (MODE.NE.1) GO TO 200
      VEQ=0.0D0
      REQ=0.0D0
      GO TO 210
  200 IF (INITF.NE.6) GO TO 205
      FIND(LX0+LOCT)=FIND(LX1+LOCT)
      GO TO 210
  205 IF (INITF.NE.5) GO TO 210
      FIND(LX1+LOCT)=FIND(LX0+LOCT)
  210 IF (IPOLY.EQ.1) GO TO 220
      CALL EVPOLY(VALUE(LOCV+1),0,LCOEF,NCOEF,LOCV+2,1,LOC+11)
  220 IF (MODE.EQ.1) GO TO 250
      CALL INTGR8(REQ,VEQ,VALUE(LOCV+1),LOCT)
      IF (IPOLY.EQ.1) GO TO 250
      VEQ=VEQ-REQ*CIND+AG(1)*FIND(LX0+LOCT)
  250 VALUE(LVN+IPTR)=VEQ
      IF(INITF.NE.5) GO TO 260
      VIND(LX1+LOCT)=VIND(LX0+LOCT)
  260 LOCY=LVN+NODPLC(LOC+13)
      VALUE(LOCY)=-REQ
      LOCY=LVN+NODPLC(LOC+6)
      VALUE(LOCY)=1.0D0
      LOCY=LVN+NODPLC(LOC+7)
      VALUE(LOCY)=-1.0D0
      LOCY=LVN+NODPLC(LOC+8)
      VALUE(LOCY)=1.0D0
      LOCY=LVN+NODPLC(LOC+9)
      VALUE(LOCY)=-1.0D0
      LOC=NODPLC(LOC)
      GO TO 160
C
C  MUTUAL INDUCTANCES
C
  300 LOC=LOCATE(4)
  310 IF ((LOC.EQ.0).OR.(NODPLC(LOC+6).NE.0)) GO TO 400
      LOCV=NODPLC(LOC+1)
      REQ=AG(1)*VALUE(LOCV+1)
      LOCY=LVN+NODPLC(LOC+4)
      VALUE(LOCY)=-REQ
      LOCY=LVN+NODPLC(LOC+5)
      VALUE(LOCY)=-REQ
      LOC=NODPLC(LOC)
      GO TO 310
C
C  NONLINEAR CONTROLLED SOURCES
C
  400 CALL NLCSRC
C
C  VOLTAGE SOURCES
C
      LOC=LOCATE(9)
  610 IF ((LOC.EQ.0).OR.(NODPLC(LOC+11).NE.0)) GO TO 700
      LOCV=NODPLC(LOC+1)
      IPTR=NODPLC(LOC+6)
      VALUE(LVN+IPTR)=VALUE(LOCV+1)*SFACTR
      LOCY=LVN+NODPLC(LOC+7)
      VALUE(LOCY)=VALUE(LOCY)+1.0D0
      LOCY=LVN+NODPLC(LOC+8)
      VALUE(LOCY)=VALUE(LOCY)-1.0D0
      LOCY=LVN+NODPLC(LOC+9)
      VALUE(LOCY)=VALUE(LOCY)+1.0D0
      LOCY=LVN+NODPLC(LOC+10)
      VALUE(LOCY)=VALUE(LOCY)-1.0D0
      LOC=NODPLC(LOC)
      GO TO 610
C
C  CURRENT SOURCES
C
  700 LOC=LOCATE(10)
  710 IF ((LOC.EQ.0).OR.(NODPLC(LOC+6).NE.0)) GO TO 800
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      VAL=VALUE(LOCV+1)*SFACTR
      VALUE(LVN+NODE1)=VALUE(LVN+NODE1)-VAL
      VALUE(LVN+NODE2)=VALUE(LVN+NODE2)+VAL
      LOC=NODPLC(LOC)
      GO TO 710
C
C  CALL DEVICE MODEL ROUTINES
C
  800 CALL DIODE
      CALL BJT
      CALL JFET
      CALL MOSFET
C
C  TRANSMISSION LINES
C
      LOC=LOCATE(17)
  910 IF ((LOC.EQ.0).OR.(NODPLC(LOC+33).NE.0)) GO TO 980
      LOCV=NODPLC(LOC+1)
      Z0=VALUE(LOCV+1)
      Y0=1.0D0/Z0
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      NODE3=NODPLC(LOC+4)
      NODE4=NODPLC(LOC+5)
      IBR1=NODPLC(LOC+8)
      IBR2=NODPLC(LOC+9)
      LOCY=LVN+NODPLC(LOC+10)
      VALUE(LOCY)=VALUE(LOCY)+Y0
      LOCY=LVN+NODPLC(LOC+11)
      VALUE(LOCY)=-Y0
      LOCY=LVN+NODPLC(LOC+12)
      VALUE(LOCY)=-1.0D0
      LOCY=LVN+NODPLC(LOC+13)
      VALUE(LOCY)=VALUE(LOCY)+Y0
      LOCY=LVN+NODPLC(LOC+14)
      VALUE(LOCY)=-1.0D0
      LOCY=LVN+NODPLC(LOC+15)
      VALUE(LOCY)=-Y0
      LOCY=LVN+NODPLC(LOC+16)
      VALUE(LOCY)=+Y0
      LOCY=LVN+NODPLC(LOC+17)
      VALUE(LOCY)=+1.0D0
      LOCY=LVN+NODPLC(LOC+18)
      VALUE(LOCY)=+Y0
      LOCY=LVN+NODPLC(LOC+19)
      VALUE(LOCY)=+1.0D0
      LOCY=LVN+NODPLC(LOC+20)
      VALUE(LOCY)=-1.0D0
      LOCY=LVN+NODPLC(LOC+23)
      VALUE(LOCY)=+1.0D0
      LOCY=LVN+NODPLC(LOC+27)
      VALUE(LOCY)=-1.0D0
      LOCY=LVN+NODPLC(LOC+28)
      VALUE(LOCY)=+1.0D0
      LOCY=LVN+NODPLC(LOC+31)
      VALUE(LOCY)=-Y0
      LOCY=LVN+NODPLC(LOC+32)
      VALUE(LOCY)=-Y0
      IF (MODE.NE.1) GO TO 920
      LOCY=LVN+NODPLC(LOC+21)
      VALUE(LOCY)=-1.0D0
      LOCY=LVN+NODPLC(LOC+22)
      VALUE(LOCY)=+1.0D0
      LOCY=LVN+NODPLC(LOC+24)
      VALUE(LOCY)=-(1.0D0-GMIN)*Z0
      LOCY=LVN+NODPLC(LOC+25)
      VALUE(LOCY)=-1.0D0
      LOCY=LVN+NODPLC(LOC+26)
      VALUE(LOCY)=+1.0D0
      LOCY=LVN+NODPLC(LOC+29)
      VALUE(LOCY)=-(1.0D0-GMIN)*Z0
      GO TO 950
  920 IF (INITF.NE.5) GO TO 930
      IF (NOSOLV.NE.0) GO TO 925
      VALUE(LOCV+3)=VALUE(LVNIM1+NODE3)-VALUE(LVNIM1+NODE4)
     1   +VALUE(LVNIM1+IBR2)*Z0
      VALUE(LOCV+4)=VALUE(LVNIM1+NODE1)-VALUE(LVNIM1+NODE2)
     1   +VALUE(LVNIM1+IBR1)*Z0
      GO TO 930
  925 VALUE(LOCV+3)=VALUE(LOCV+7)+VALUE(LOCV+8)*Z0
      VALUE(LOCV+4)=VALUE(LOCV+5)+VALUE(LOCV+6)*Z0
  930 VALUE(LVN+IBR1)=VALUE(LOCV+3)
      VALUE(LVN+IBR2)=VALUE(LOCV+4)
  950 LOC=NODPLC(LOC)
      GO TO 910
C
C  INITIALIZE NODES
C
  980 IF(MODE.NE.1) GO TO 995
      IF(INITF.NE.3.AND.INITF.NE.2) GO TO 995
      CALL SIZMEM(NSNOD,NIC)
      IF(NIC.EQ.0) GO TO 995
      CALL SIZMEM(ICNOD,NTEST)
      IF(MODEDC.EQ.2.AND.NTEST.NE.0) GO TO 995
      G=1.0D0
      DO 990 I=1,NIC
      LOCY=LVN+NODPLC(NSMAT+I)
      VALUE(LOCY)=VALUE(LOCY)+G
      NODE=NODPLC(NSNOD+I)
      VALUE(LVN+NODE)=VALUE(LVN+NODE)+VALUE(NSVAL+I)*G
  990 CONTINUE
C
C  TRANSIENT INITIAL CONDITIONS (UIC NOT SPECIFIED)
C
  995 IF(MODE.NE.1) GO TO 1000
      IF(MODEDC.NE.2) GO TO 1000
      IF(NOSOLV.NE.0) GO TO 1000
      CALL SIZMEM(ICNOD,NIC)
      IF(NIC.EQ.0) GO TO 1000
      G=1.0D0
      DO 996 I=1,NIC
      LOCY=LVN+NODPLC(ICMAT+I)
      VALUE(LOCY)=VALUE(LOCY)+G
      NODE=NODPLC(ICNOD+I)
      VALUE(LVN+NODE)=VALUE(LVN+NODE)+VALUE(ICVAL+I)*G
  996 CONTINUE
C
C  FINISHED
C
 1000 CALL SECOND(T2)
      RSTATS(45)=RSTATS(45)+T2-T1
      RETURN
      END
      SUBROUTINE NLCSRC
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE LOADS THE NONLINEAR CONTROLLED SOURCES INTO THE
C COEFFICIENT MATRIX.
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=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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C  NONLINEAR VOLTAGE-CONTROLLED CURRENT SOURCES
C
      LOC=LOCATE(5)
   10 IF ((LOC.EQ.0).OR.(NODPLC(LOC+13).NE.0)) GO TO 100
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      NDIM=NODPLC(LOC+4)
      LNOD=NODPLC(LOC+6)
      LMAT=NODPLC(LOC+7)
      LCOEF=NODPLC(LOC+8)
      CALL SIZMEM(NODPLC(LOC+8),NCOEF)
      LARG=NODPLC(LOC+9)
      LEXP=NODPLC(LOC+10)
      LIC=NODPLC(LOC+11)
      LOCT=NODPLC(LOC+12)+1
      ICHECK=0
      DO 20 I=1,NDIM
      CALL UPDATE(VALUE(LIC+I),LOCT,NODPLC(LNOD+1),NODPLC(LNOD+2),2,
     1   ICHECK)
      VALUE(LARG+I)=VALUE(LX0+LOCT)
      LOCT=LOCT+2
      LNOD=LNOD+2
   20 CONTINUE
      CALL EVPOLY(COLD,0,LCOEF,NCOEF,LARG,NDIM,LEXP)
      LOCT=NODPLC(LOC+12)
      IF (ICHECK.EQ.1) GO TO 30
      IF (INITF.EQ.6) GO TO 30
      TOL=RELTOL*DMAX1(DABS(COLD),DABS(VALUE(LX0+LOCT)))+ABSTOL
      IF (DABS(COLD-VALUE(LX0+LOCT)).LT.TOL) GO TO 40
   30 NONCON=NONCON+1
   40 VALUE(LX0+LOCT)=COLD
      CEQ=COLD
      DO 50 I=1,NDIM
      CALL EVPOLY(GEQ,I,LCOEF,NCOEF,LARG,NDIM,LEXP)
      LOCT=LOCT+2
      VALUE(LX0+LOCT)=GEQ
      CEQ=CEQ-GEQ*VALUE(LARG+I)
      LOCY=LVN+NODPLC(LMAT+1)
      VALUE(LOCY)=VALUE(LOCY)+GEQ
      LOCY=LVN+NODPLC(LMAT+2)
      VALUE(LOCY)=VALUE(LOCY)-GEQ
      LOCY=LVN+NODPLC(LMAT+3)
      VALUE(LOCY)=VALUE(LOCY)-GEQ
      LOCY=LVN+NODPLC(LMAT+4)
      VALUE(LOCY)=VALUE(LOCY)+GEQ
      LMAT=LMAT+4
   50 CONTINUE
      VALUE(LVN+NODE1)=VALUE(LVN+NODE1)-CEQ
      VALUE(LVN+NODE2)=VALUE(LVN+NODE2)+CEQ
      LOC=NODPLC(LOC)
      GO TO 10
C
C  NONLINEAR VOLTAGE CONTROLLED VOLTAGE SOURCES
C
  100 LOC=LOCATE(6)
  110 IF ((LOC.EQ.0).OR.(NODPLC(LOC+14).NE.0)) GO TO 200
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      NDIM=NODPLC(LOC+4)
      IPTR=NODPLC(LOC+6)
      LNOD=NODPLC(LOC+7)
      LMAT=NODPLC(LOC+8)
      LCOEF=NODPLC(LOC+9)
      CALL SIZMEM(NODPLC(LOC+9),NCOEF)
      LARG=NODPLC(LOC+10)
      LEXP=NODPLC(LOC+11)
      LIC=NODPLC(LOC+12)
      LOCT=NODPLC(LOC+13)+2
      ICHECK=0
      DO 120 I=1,NDIM
      CALL UPDATE(VALUE(LIC+I),LOCT,NODPLC(LNOD+1),NODPLC(LNOD+2),2,
     1   ICHECK)
      VALUE(LARG+I)=VALUE(LX0+LOCT)
      LOCT=LOCT+2
      LNOD=LNOD+2
  120 CONTINUE
      CALL EVPOLY(VOLT,0,LCOEF,NCOEF,LARG,NDIM,LEXP)
      LOCT=NODPLC(LOC+13)
      IF (ICHECK.EQ.1) GO TO 130
      IF (INITF.EQ.6) GO TO 130
      TOL=RELTOL*DMAX1(DABS(VOLT),DABS(VALUE(LX0+LOCT)))+VNTOL
      IF (DABS(VOLT-VALUE(LX0+LOCT)).LT.TOL) GO TO 140
  130 NONCON=NONCON+1
  140 VALUE(LX0+LOCT)=VOLT
      VALUE(LX0+LOCT+1)=VALUE(LVNIM1+IPTR)
      VEQ=VOLT
      LOCY=LVN+NODPLC(LMAT+1)
      VALUE(LOCY)=+1.0D0
      LOCY=LVN+NODPLC(LMAT+2)
      VALUE(LOCY)=-1.0D0
      LOCY=LVN+NODPLC(LMAT+3)
      VALUE(LOCY)=+1.0D0
      LOCY=LVN+NODPLC(LMAT+4)
      VALUE(LOCY)=-1.0D0
      LMAT=LMAT+4
      LOCT=LOCT+1
      DO 150 I=1,NDIM
      CALL EVPOLY(VGAIN,I,LCOEF,NCOEF,LARG,NDIM,LEXP)
      LOCT=LOCT+2
      VALUE(LX0+LOCT)=VGAIN
      VEQ=VEQ-VGAIN*VALUE(LARG+I)
      LOCY=LVN+NODPLC(LMAT+1)
      VALUE(LOCY)=VALUE(LOCY)-VGAIN
      LOCY=LVN+NODPLC(LMAT+2)
      VALUE(LOCY)=VALUE(LOCY)+VGAIN
      LMAT=LMAT+2
  150 CONTINUE
      VALUE(LVN+IPTR)=VEQ
      LOC=NODPLC(LOC)
      GO TO 110
C
C  NONLINEAR CURRENT-CONTROLLED CURRENT SOURCES
C
  200 LOC=LOCATE(7)
  210 IF ((LOC.EQ.0).OR.(NODPLC(LOC+13).NE.0)) GO TO 300
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      NDIM=NODPLC(LOC+4)
      LVS=NODPLC(LOC+6)
      LMAT=NODPLC(LOC+7)
      LCOEF=NODPLC(LOC+8)
      CALL SIZMEM(NODPLC(LOC+8),NCOEF)
      LARG=NODPLC(LOC+9)
      LEXP=NODPLC(LOC+10)
      LIC=NODPLC(LOC+11)
      LOCT=NODPLC(LOC+12)+1
      ICHECK=0
      DO 220 I=1,NDIM
      IPTR=NODPLC(LVS+I)
      IPTR=NODPLC(IPTR+6)
      CALL UPDATE(VALUE(LIC+I),LOCT,IPTR,1,2,ICHECK)
      VALUE(LARG+I)=VALUE(LX0+LOCT)
      LOCT=LOCT+2
  220 CONTINUE
      CALL EVPOLY(CSRC,0,LCOEF,NCOEF,LARG,NDIM,LEXP)
      LOCT=NODPLC(LOC+12)
      IF (ICHECK.EQ.1) GO TO 230
      IF (INITF.EQ.6) GO TO 230
      TOL=RELTOL*DMAX1(DABS(CSRC),DABS(VALUE(LX0+LOCT)))+ABSTOL
      IF (DABS(CSRC-VALUE(LX0+LOCT)).LT.TOL) GO TO 240
  230 NONCON=NONCON+1
  240 VALUE(LX0+LOCT)=CSRC
      CEQ=CSRC
      DO 250 I=1,NDIM
      CALL EVPOLY(CGAIN,I,LCOEF,NCOEF,LARG,NDIM,LEXP)
      LOCT=LOCT+2
      VALUE(LX0+LOCT)=CGAIN
      CEQ=CEQ-CGAIN*VALUE(LARG+I)
      LOCY=LVN+NODPLC(LMAT+1)
      VALUE(LOCY)=VALUE(LOCY)+CGAIN
      LOCY=LVN+NODPLC(LMAT+2)
      VALUE(LOCY)=VALUE(LOCY)-CGAIN
      LMAT=LMAT+2
  250 CONTINUE
      VALUE(LVN+NODE1)=VALUE(LVN+NODE1)-CEQ
      VALUE(LVN+NODE2)=VALUE(LVN+NODE2)+CEQ
      LOC=NODPLC(LOC)
      GO TO 210
C
C  NONLINEAR CURRENT CONTROLLED VOLTAGE SOURCES
C
  300 LOC=LOCATE(8)
  310 IF ((LOC.EQ.0).OR.(NODPLC(LOC+14).NE.0)) GO TO 1000
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      NDIM=NODPLC(LOC+4)
      IBR=NODPLC(LOC+6)
      LVS=NODPLC(LOC+7)
      LMAT=NODPLC(LOC+8)
      LCOEF=NODPLC(LOC+9)
      CALL SIZMEM(NODPLC(LOC+9),NCOEF)
      LARG=NODPLC(LOC+10)
      LEXP=NODPLC(LOC+11)
      LIC=NODPLC(LOC+12)
      LOCT=NODPLC(LOC+13)+2
      ICHECK=0
      DO 320 I=1,NDIM
      IPTR=NODPLC(LVS+I)
      IPTR=NODPLC(IPTR+6)
      CALL UPDATE(VALUE(LIC+I),LOCT,IPTR,1,2,ICHECK)
      VALUE(LARG+I)=VALUE(LX0+LOCT)
      LOCT=LOCT+2
  320 CONTINUE
      CALL EVPOLY(VOLT,0,LCOEF,NCOEF,LARG,NDIM,LEXP)
      LOCT=NODPLC(LOC+13)
      IF (ICHECK.EQ.1) GO TO 330
      IF (INITF.EQ.6) GO TO 330
      TOL=RELTOL*DMAX1(DABS(VOLT),DABS(VALUE(LX0+LOCT)))+VNTOL
      IF (DABS(VOLT-VALUE(LX0+LOCT)).LT.TOL) GO TO 340
  330 NONCON=NONCON+1
  340 VALUE(LX0+LOCT)=VOLT
      VALUE(LX0+LOCT+1)=VALUE(LVNIM1+IBR)
      VEQ=VOLT
      LOCY=LVN+NODPLC(LMAT+1)
      VALUE(LOCY)=+1.0D0
      LOCY=LVN+NODPLC(LMAT+2)
      VALUE(LOCY)=-1.0D0
      LOCY=LVN+NODPLC(LMAT+3)
      VALUE(LOCY)=+1.0D0
      LOCY=LVN+NODPLC(LMAT+4)
      VALUE(LOCY)=-1.0D0
      LMAT=LMAT+4
      LOCT=LOCT+1
      DO 350 I=1,NDIM
      CALL EVPOLY(TRANSR,I,LCOEF,NCOEF,LARG,NDIM,LEXP)
      LOCT=LOCT+2
      VALUE(LX0+LOCT)=TRANSR
      VEQ=VEQ-TRANSR*VALUE(LARG+I)
      LOCY=LVN+NODPLC(LMAT+I)
      VALUE(LOCY)=VALUE(LOCY)-TRANSR
  350 CONTINUE
      VALUE(LVN+IBR)=VEQ
      LOC=NODPLC(LOC)
      GO TO 310
C
C  FINISHED
C
 1000 RETURN
      END
      SUBROUTINE UPDATE(VINIT,LOCT,NODE1,NODE2,NUPDA,ICHECK)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE UPDATES AND LIMITS THE CONTROLLING VARIABLES FOR THE
C NONLINEAR CONTROLLED SOURCES.
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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C
      GO TO (40,10,40,20,30,50), INITF
   10 VNEW=VINIT
      GO TO 70
   20 VNEW=VALUE(LX0+LOCT)
      GO TO 70
   30 VNEW=VALUE(LX1+LOCT)
      GO TO 70
   40 VNEW=VALUE(LVNIM1+NODE1)-VALUE(LVNIM1+NODE2)
      GO TO 60
   50 CALL COPY8(VALUE(LX1+LOCT),VALUE(LX0+LOCT),NUPDA)
      XFACT=DELTA/DELOLD(2)
      VNEW=(1.0D0+XFACT)*VALUE(LX1+LOCT)-XFACT*VALUE(LX2+LOCT)
   60 IF (DABS(VNEW).LE.1.0D0) GO TO 80
      DELV=VNEW-VALUE(LX0+LOCT)
      IF (DABS(DELV).LE.0.1D0) GO TO 80
      VLIM=DMAX1(DABS(0.1D0*VALUE(LX0+LOCT)),0.1D0)
      VNEW=VALUE(LX0+LOCT)+DSIGN(DMIN1(DABS(DELV),VLIM),DELV)
      GO TO 70
   70 ICHECK=1
   80 VALUE(LX0+LOCT)=VNEW
      RETURN
      END
      SUBROUTINE EVPOLY(RESULT,ITYPE,LCOEF,NCOEF,LARG,
     1  NARG,LEXP)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE EVALUATES A POLYNOMIAL.  LCOEF POINTS TO THE COEF-
C FICIENTS, AND LARG POINTS TO THE VALUES OF THE POLYNOMIAL ARGUMENT(S).
C
C SPICE VERSION 2G.6  SCCSID=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C
      IF (ITYPE) 100,200,300
C
C  INTEGRATION (POLYNOMIAL *MUST* BE ONE-DIMENSIONAL)
C
  100 RESULT=0.0D0
      ARG=1.0D0
      ARG1=VALUE(LARG+1)
      DO 110 I=1,NCOEF
      ARG=ARG*ARG1
      RESULT=RESULT+VALUE(LCOEF+I)*ARG/DFLOAT(I)
  110 CONTINUE
      GO TO 1000
C
C  EVALUATION OF THE POLYNOMIAL
C
  200 RESULT=VALUE(LCOEF+1)
      IF (NCOEF.EQ.1) GO TO 1000
      CALL ZERO4(NODPLC(LEXP+1),NARG)
      DO 220 I=2,NCOEF
      CALL NXTPWR(NODPLC(LEXP+1),NARG)
      IF (VALUE(LCOEF+I).EQ.0.0D0) GO TO 220
      ARG=1.0D0
      DO 210 J=1,NARG
      CALL EVTERM(VAL,VALUE(LARG+J),NODPLC(LEXP+J))
      ARG=ARG*VAL
  210 CONTINUE
      RESULT=RESULT+VALUE(LCOEF+I)*ARG
  220 CONTINUE
      GO TO 1000
C
C  PARTIAL DERIVATIVE WITH RESPECT TO THE ITYPE*TH VARIABLE
C
  300 RESULT=0.0D0
      IF (NCOEF.EQ.1) GO TO 1000
      CALL ZERO4(NODPLC(LEXP+1),NARG)
      DO 330 I=2,NCOEF
      CALL NXTPWR(NODPLC(LEXP+1),NARG)
      IF (NODPLC(LEXP+ITYPE).EQ.0) GO TO 330
      IF (VALUE(LCOEF+I).EQ.0.0D0) GO TO 330
      ARG=1.0D0
      DO 320 J=1,NARG
      IF (J.EQ.ITYPE) GO TO 310
      CALL EVTERM(VAL,VALUE(LARG+J),NODPLC(LEXP+J))
      ARG=ARG*VAL
      GO TO 320
  310 CALL EVTERM(VAL,VALUE(LARG+J),NODPLC(LEXP+J)-1)
      ARG=ARG*DFLOAT(NODPLC(LEXP+J))*VAL
  320 CONTINUE
      RESULT=RESULT+VALUE(LCOEF+I)*ARG
  330 CONTINUE
C
C  FINISHED
C
 1000 RETURN
      END
      SUBROUTINE EVTERM(VAL,ARG,IEXP)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE EVALUATES ONE TERM OF A POLYNOMIAL.
C
      JEXP=IEXP+1
      IF (JEXP.GE.6) GO TO 60
      GO TO (10,20,30,40,50), JEXP
   10 VAL=1.0D0
      GO TO 100
   20 VAL=ARG
      GO TO 100
   30 VAL=ARG*ARG
      GO TO 100
   40 VAL=ARG*ARG*ARG
      GO TO 100
   50 VAL=ARG*ARG
      VAL=VAL*VAL
      GO TO 100
   60 IF (ARG.EQ.0.0D0) GO TO 70
      ARGEXP=DFLOAT(IEXP)*DLOG(DABS(ARG))
      IF (ARGEXP.LT.-200.0D0) GO TO 70
      VAL=DEXP(ARGEXP)
      IF((IEXP/2)*2.EQ.IEXP) GO TO 100
      VAL=DSIGN(VAL,ARG)
      GO TO 100
   70 VAL=0.0D0
C
C  FINISHED
C
  100 RETURN
      END
      SUBROUTINE NXTPWR(PWRSEQ,PDIM)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE DETERMINES THE 'NEXT' SET OF EXPONENTS FOR THE
C DIFFERENT DIMENSIONS OF A POLYNOMIAL.
C
      INTEGER PWRSEQ(1),PDIM,PSUM
C
C
      IF (PDIM.EQ.1) GO TO 80
      K=PDIM
   10 IF (PWRSEQ(K).NE.0) GO TO 20
      K=K-1
      IF (K.NE.0) GO TO 10
      GO TO 80
   20 IF (K.EQ.PDIM) GO TO 30
      PWRSEQ(K)=PWRSEQ(K)-1
      PWRSEQ(K+1)=PWRSEQ(K+1)+1
      GO TO 100
   30 KM1=K-1
      DO 40 I=1,KM1
      IF (PWRSEQ(I).NE.0) GO TO 50
   40 CONTINUE
      PWRSEQ(1)=PWRSEQ(PDIM)+1
      PWRSEQ(PDIM)=0
      GO TO 100
   50 PSUM=1
      K=PDIM
   60 IF (PWRSEQ(K-1).GE.1) GO TO 70
      PSUM=PSUM+PWRSEQ(K)
      PWRSEQ(K)=0
      K=K-1
      GO TO 60
   70 PWRSEQ(K)=PWRSEQ(K)+PSUM
      PWRSEQ(K-1)=PWRSEQ(K-1)-1
      GO TO 100
   80 PWRSEQ(1)=PWRSEQ(1)+1
C
C  FINISHED
C
  100 RETURN
      END
      SUBROUTINE INTGR8(GEQ,CEQ,CAPVAL,LOCT)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE PERFORMS THE ACTUAL NUMERICAL INTEGRATION FOR EACH
C CIRCUIT ELEMENT.
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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C
      DIMENSION QCAP(1),CCAP(1)
      EQUIVALENCE (QCAP(1),VALUE(1)),(CCAP(1),VALUE(2))
C
C
      IF (METHOD.EQ.2) GO TO 100
C
C  TRAPEZOIDAL ALGORITHM
C
      IF (IORD.EQ.1) GO TO 100
      CCAP(LX0+LOCT)=-CCAP(LX1+LOCT)*AG(2)
     1   +AG(1)*(QCAP(LX0+LOCT)-QCAP(LX1+LOCT))
      GO TO 190
C
C  GEARS ALGORITHM
C
  100 GO TO (110,120,130,140,150,160), IORD
  110 CCAP(LX0+LOCT)=AG(1)*QCAP(LX0+LOCT)+AG(2)*QCAP(LX1+LOCT)
      GO TO 190
  120 CCAP(LX0+LOCT)=AG(1)*QCAP(LX0+LOCT)+AG(2)*QCAP(LX1+LOCT)
     1              +AG(3)*QCAP(LX2+LOCT)
      GO TO 190
  130 CCAP(LX0+LOCT)=AG(1)*QCAP(LX0+LOCT)+AG(2)*QCAP(LX1+LOCT)
     1              +AG(3)*QCAP(LX2+LOCT)+AG(4)*QCAP(LX3+LOCT)
      GO TO 190
  140 CCAP(LX0+LOCT)=AG(1)*QCAP(LX0+LOCT)+AG(2)*QCAP(LX1+LOCT)
     1              +AG(3)*QCAP(LX2+LOCT)+AG(4)*QCAP(LX3+LOCT)
     2              +AG(5)*QCAP(LX4+LOCT)
      GO TO 190
  150 CCAP(LX0+LOCT)=AG(1)*QCAP(LX0+LOCT)+AG(2)*QCAP(LX1+LOCT)
     1              +AG(3)*QCAP(LX2+LOCT)+AG(4)*QCAP(LX3+LOCT)
     2              +AG(5)*QCAP(LX4+LOCT)+AG(6)*QCAP(LX5+LOCT)
      GO TO 190
  160 CCAP(LX0+LOCT)=AG(1)*QCAP(LX0+LOCT)+AG(2)*QCAP(LX1+LOCT)
     1              +AG(3)*QCAP(LX2+LOCT)+AG(4)*QCAP(LX3+LOCT)
     2              +AG(5)*QCAP(LX4+LOCT)+AG(6)*QCAP(LX5+LOCT)
     3              +AG(7)*QCAP(LX6+LOCT)
C... CEQ IS THE EQUIVALENT CURRENT APPLICABLE TO LINEAR CAPACITANCE
C    (INDUCTANCE) ONLY, I.E. Q=C*V
  190 CEQ=CCAP(LX0+LOCT)-AG(1)*QCAP(LX0+LOCT)
      GEQ=AG(1)*CAPVAL
      RETURN
      END
      SUBROUTINE PNJLIM(VNEW,VOLD,VT,VCRIT,ICHECK)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE LIMITS THE CHANGE-PER-ITERATION OF DEVICE PN-JUNCTION
C VOLTAGES.
C
      IF (VNEW.LE.VCRIT) GO TO 30
      VLIM=VT+VT
      DELV=VNEW-VOLD
      IF (DABS(DELV).LE.VLIM) GO TO 30
      IF (VOLD.LE.0.0D0) GO TO 20
      ARG=1.0D0+DELV/VT
      IF (ARG.LE.0.0D0) GO TO 10
      VNEW=VOLD+VT*DLOG(ARG)
      GO TO 100
   10 VNEW=VCRIT
      GO TO 100
   20 VNEW=VT*DLOG(VNEW/VT)
      GO TO 100
   30 ICHECK=0
C
C  FINISHED
C
  100 RETURN
      END
      SUBROUTINE DIODE
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE PROCESSES DIODES FOR DC AND TRANSIENT ANALYSES.
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=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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C
      DIMENSION VDO(1),CDO(1),GDO(1),QD(1),CQD(1)
      EQUIVALENCE (VDO(1),VALUE(1)),(CDO(1),VALUE(2)),
     1   (GDO(1),VALUE(3)),(QD(1),VALUE(4)),(CQD(1),VALUE(5))
C
C
      LOC=LOCATE(11)
   10 IF ((LOC.EQ.0).OR.(NODPLC(LOC+16).NE.0)) RETURN
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      NODE3=NODPLC(LOC+4)
      LOCM=NODPLC(LOC+5)
      IOFF=NODPLC(LOC+6)
      LOCM=NODPLC(LOCM+1)
      LOCT=NODPLC(LOC+11)
C
C  DC MODEL PARAMETERS
C
      AREA=VALUE(LOCV+1)
      CSAT=VALUE(LOCM+1)*AREA
      GSPR=VALUE(LOCM+2)*AREA
      VTE=VALUE(LOCM+3)*VT
      BV=VALUE(LOCM+13)
      VCRIT=VALUE(LOCM+18)
C
C  INITIALIZATION
C
      ICHECK=1
      GO TO (100,20,30,50,60,70),INITF
   20 IF(MODE.NE.1.OR.MODEDC.NE.2.OR.NOSOLV.EQ.0) GO TO 25
      VD=VALUE(LOCV+2)
      GO TO 300
   25 IF(IOFF.NE.0) GO TO 40
      VD=VCRIT
      GO TO 300
   30 IF (IOFF.EQ.0) GO TO 100
   40 VD=0.0D0
      GO TO 300
   50 VD=VDO(LX0+LOCT)
      GO TO 300
   60 VD=VDO(LX1+LOCT)
      GO TO 300
   70 XFACT=DELTA/DELOLD(2)
      VDO(LX0+LOCT)=VDO(LX1+LOCT)
      VD=(1.0D0+XFACT)*VDO(LX1+LOCT)-XFACT*VDO(LX2+LOCT)
      CDO(LX0+LOCT)=CDO(LX1+LOCT)
      GDO(LX0+LOCT)=GDO(LX1+LOCT)
      GO TO 110
C
C  COMPUTE NEW NONLINEAR BRANCH VOLTAGE
C
  100 VD=VALUE(LVNIM1+NODE3)-VALUE(LVNIM1+NODE2)
  110 DELVD=VD-VDO(LX0+LOCT)
      CDHAT=CDO(LX0+LOCT)+GDO(LX0+LOCT)*DELVD
C
C  BYPASS IF SOLUTION HAS NOT CHANGED
C
      IF (INITF.EQ.6) GO TO 200
      TOL=RELTOL*DMAX1(DABS(VD),DABS(VDO(LX0+LOCT)))+VNTOL
      IF (DABS(DELVD).GE.TOL) GO TO 200
      TOL=RELTOL*DMAX1(DABS(CDHAT),DABS(CDO(LX0+LOCT)))+ABSTOL
      IF (DABS(CDHAT-CDO(LX0+LOCT)).GE.TOL) GO TO 200
      VD=VDO(LX0+LOCT)
      CD=CDO(LX0+LOCT)
      GD=GDO(LX0+LOCT)
      GO TO 800
C
C  LIMIT NEW JUNCTION VOLTAGE
C
  200 VLIM=VTE+VTE
      IF(BV.EQ.0.0D0) GO TO 205
      IF (VD.LT.DMIN1(0.0D0,-BV+10.0D0*VTE)) GO TO 210
  205 CALL PNJLIM(VD,VDO(LX0+LOCT),VTE,VCRIT,ICHECK)
      GO TO 300
  210 VDTEMP=-(VD+BV)
      CALL PNJLIM(VDTEMP,-(VDO(LX0+LOCT)+BV),VTE,VCRIT,ICHECK)
      VD=-(VDTEMP+BV)
C
C  COMPUTE DC CURRENT AND DERIVITIVES
C
  300 IF (VD.LT.-5.0D0*VTE) GO TO 310
      EVD=DEXP(VD/VTE)
      CD=CSAT*(EVD-1.0D0)+GMIN*VD
      GD=CSAT*EVD/VTE+GMIN
      GO TO 330
  310 IF(BV.EQ.0.0D0) GO TO 315
      IF(VD.LT.-BV) GO TO 320
  315 GD=-CSAT/VD+GMIN
      CD=GD*VD
      GO TO 330
  320 EVREV=DEXP(-(BV+VD)/VT)
      CD=-CSAT*(EVREV-1.0D0+BV/VT)
      GD=CSAT*EVREV/VT
  330 IF (MODE.NE.1) GO TO 500
      IF ((MODEDC.EQ.2).AND.(NOSOLV.NE.0)) GO TO 500
      IF (INITF.EQ.4) GO TO 500
      GO TO 700
C
C  CHARGE STORAGE ELEMENTS
C
  500 TAU=VALUE(LOCM+4)
      CZERO=VALUE(LOCM+5)*AREA
      PB=VALUE(LOCM+6)
      XM=VALUE(LOCM+7)
      FCPB=VALUE(LOCM+12)
      IF (VD.GE.FCPB) GO TO 510
      ARG=1.0D0-VD/PB
      SARG=DEXP(-XM*DLOG(ARG))
      QD(LX0+LOCT)=TAU*CD+PB*CZERO*(1.0D0-ARG*SARG)/(1.0D0-XM)
      CAPD=TAU*GD+CZERO*SARG
      GO TO 520
  510 F1=VALUE(LOCM+15)
      F2=VALUE(LOCM+16)
      F3=VALUE(LOCM+17)
      CZOF2=CZERO/F2
      QD(LX0+LOCT)=TAU*CD+CZERO*F1+CZOF2*(F3*(VD-FCPB)
     1   +(XM/(PB+PB))*(VD*VD-FCPB*FCPB))
      CAPD=TAU*GD+CZOF2*(F3+XM*VD/PB)
C
C  STORE SMALL-SIGNAL PARAMETERS
C
  520 IF ((MODE.EQ.1).AND.(MODEDC.EQ.2).AND.(NOSOLV.NE.0)) GO TO 700
      IF (INITF.NE.4) GO TO 600
      VALUE(LX0+LOCT+4)=CAPD
      GO TO 1000
C
C  TRANSIENT ANALYSIS
C
  600 IF (INITF.NE.5) GO TO 610
      QD(LX1+LOCT)=QD(LX0+LOCT)
  610 CALL INTGR8(GEQ,CEQ,CAPD,LOCT+3)
      GD=GD+GEQ
      CD=CD+CQD(LX0+LOCT)
      IF (INITF.NE.5) GO TO 700
      CQD(LX1+LOCT)=CQD(LX0+LOCT)
C
C  CHECK CONVERGENCE
C
  700 IF (INITF.NE.3) GO TO 710
      IF (IOFF.EQ.0) GO TO 710
      GO TO 750
  710 IF (ICHECK.EQ.1) GO TO 720
      TOL=RELTOL*DMAX1(DABS(CDHAT),DABS(CD))+ABSTOL
      IF (DABS(CDHAT-CD).LE.TOL) GO TO 750
  720 NONCON=NONCON+1
  750 VDO(LX0+LOCT)=VD
      CDO(LX0+LOCT)=CD
      GDO(LX0+LOCT)=GD
C
C  LOAD CURRENT VECTOR
C
  800 CDEQ=CD-GD*VD
      VALUE(LVN+NODE2)=VALUE(LVN+NODE2)+CDEQ
      VALUE(LVN+NODE3)=VALUE(LVN+NODE3)-CDEQ
C
C  LOAD MATRIX
C
      LOCY=LVN+NODPLC(LOC+13)
      VALUE(LOCY)=VALUE(LOCY)+GSPR
      LOCY=LVN+NODPLC(LOC+14)
      VALUE(LOCY)=VALUE(LOCY)+GD
      LOCY=LVN+NODPLC(LOC+15)
      VALUE(LOCY)=VALUE(LOCY)+GD+GSPR
      LOCY=LVN+NODPLC(LOC+7)
      VALUE(LOCY)=VALUE(LOCY)-GSPR
      LOCY=LVN+NODPLC(LOC+8)
      VALUE(LOCY)=VALUE(LOCY)-GD
      LOCY=LVN+NODPLC(LOC+9)
      VALUE(LOCY)=VALUE(LOCY)-GSPR
      LOCY=LVN+NODPLC(LOC+10)
      VALUE(LOCY)=VALUE(LOCY)-GD
 1000 LOC=NODPLC(LOC)
      GO TO 10
      END
      SUBROUTINE BJT
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE PROCESSES BJTS FOR DC AND TRANSIENT ANALYSES.
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=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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C
      DIMENSION VBEO(1),VBCO(1),CCO(1),CBO(1),GPIO(1),GMUO(1),GMO(1),
     1   GOO(1),QBE(1),CQBE(1),QBC(1),CQBC(1),QCS(1),CQCS(1),QBX(1),
     2   CQBX(1),GXO(1),CEXBC(1),GEQCBO(1)
      EQUIVALENCE (VBEO(1),VALUE(1)),(VBCO(1),VALUE(2)),
     1   (CCO(1),VALUE(3)),(CBO(1),VALUE(4)),(GPIO(1),VALUE(5)),
     2   (GMUO(1),VALUE(6)),(GMO(1),VALUE(7)),(GOO(1),VALUE(8)),
     3   (QBE(1),VALUE(9)),(CQBE(1),VALUE(10)),(QBC(1),VALUE(11)),
     4   (CQBC(1),VALUE(12)),(QCS(1),VALUE(13)),(CQCS(1),VALUE(14)),
     5   (QBX(1),VALUE(15)),(CQBX(1),VALUE(16)),(GXO(1),VALUE(17)),
     6   (CEXBC(1),VALUE(18)),(GEQCBO(1),VALUE(19))
C
C
      LOC=LOCATE(12)
   10 IF ((LOC.EQ.0).OR.(NODPLC(LOC+36).NE.0)) RETURN
      LOCV=NODPLC(LOC+1)
      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)
      LOCM=NODPLC(LOC+8)
      IOFF=NODPLC(LOC+9)
      TYPE=NODPLC(LOCM+2)
      LOCM=NODPLC(LOCM+1)
      LOCT=NODPLC(LOC+22)
      GCCS=0.0D0
      CEQCS=0.0D0
      GEQBX=0.0D0
      CEQBX=0.0D0
      GEQCB=0.0D0
C
C  DC MODEL PARAMTERS
C
      AREA=VALUE(LOCV+1)
      BFM=VALUE(LOCM+2)
      BRM=VALUE(LOCM+8)
      CSAT=VALUE(LOCM+1)*AREA
      RBPR=VALUE(LOCM+18)/AREA
      RBPI=VALUE(LOCM+16)/AREA-RBPR
      GCPR=VALUE(LOCM+20)*AREA
      GEPR=VALUE(LOCM+19)*AREA
      OVA=VALUE(LOCM+4)
      OVB=VALUE(LOCM+10)
      OIK=VALUE(LOCM+5)/AREA
      C2=VALUE(LOCM+6)*AREA
      VTE=VALUE(LOCM+7)*VT
      OIKR=VALUE(LOCM+11)/AREA
      C4=VALUE(LOCM+12)*AREA
      VTC=VALUE(LOCM+13)*VT
      VCRIT=VALUE(LOCM+54)
      TD=VALUE(LOCM+28)
      XJRB=VALUE(LOCM+17)*AREA
C
C  INITIALIZATION
C
      ICHECK=1
      GO TO (100,20,30,50,60,70),INITF
   20 IF(MODE.NE.1.OR.MODEDC.NE.2.OR.NOSOLV.EQ.0) GO TO 25
      VBE=TYPE*VALUE(LOCV+2)
      VCE=TYPE*VALUE(LOCV+3)
      VBC=VBE-VCE
      VBX=VBC
      VCS=0.0D0
      GO TO 300
   25 IF(IOFF.NE.0) GO TO 40
      VBE=VCRIT
      VBC=0.0D0
      GO TO 300
   30 IF (IOFF.EQ.0) GO TO 100
   40 VBE=0.0D0
      VBC=0.0D0
      GO TO 300
   50 VBE=VBEO(LX0+LOCT)
      VBC=VBCO(LX0+LOCT)
      VBX=TYPE*(VALUE(LVNIM1+NODE2)-VALUE(LVNIM1+NODE4))
      VCS=TYPE*(VALUE(LVNIM1+NODE7)-VALUE(LVNIM1+NODE4))
      GO TO 300
   60 VBE=VBEO(LX1+LOCT)
      VBC=VBCO(LX1+LOCT)
      VBX=TYPE*(VALUE(LVNIM1+NODE2)-VALUE(LVNIM1+NODE4))
      VCS=TYPE*(VALUE(LVNIM1+NODE7)-VALUE(LVNIM1+NODE4))
      IF(MODE.NE.2.OR.NOSOLV.EQ.0) GO TO 300
      VBX=TYPE*(VALUE(LOCV+2)-VALUE(LOCV+3))
      VCS=0.0D0
      GO TO 300
   70 XFACT=DELTA/DELOLD(2)
      VBEO(LX0+LOCT)=VBEO(LX1+LOCT)
      VBE=(1.0D0+XFACT)*VBEO(LX1+LOCT)-XFACT*VBEO(LX2+LOCT)
      VBCO(LX0+LOCT)=VBCO(LX1+LOCT)
      VBC=(1.0D0+XFACT)*VBCO(LX1+LOCT)-XFACT*VBCO(LX2+LOCT)
      CCO(LX0+LOCT)=CCO(LX1+LOCT)
      CBO(LX0+LOCT)=CBO(LX1+LOCT)
      GPIO(LX0+LOCT)=GPIO(LX1+LOCT)
      GMUO(LX0+LOCT)=GMUO(LX1+LOCT)
      GMO(LX0+LOCT)=GMO(LX1+LOCT)
      GOO(LX0+LOCT)=GOO(LX1+LOCT)
      GXO(LX0+LOCT)=GXO(LX1+LOCT)
      GO TO 110
C
C  COMPUTE NEW NONLINEAR BRANCH VOLTAGES
C
  100 VBE=TYPE*(VALUE(LVNIM1+NODE5)-VALUE(LVNIM1+NODE6))
      VBC=TYPE*(VALUE(LVNIM1+NODE5)-VALUE(LVNIM1+NODE4))
  110 DELVBE=VBE-VBEO(LX0+LOCT)
      DELVBC=VBC-VBCO(LX0+LOCT)
      VBX=TYPE*(VALUE(LVNIM1+NODE2)-VALUE(LVNIM1+NODE4))
      VCS=TYPE*(VALUE(LVNIM1+NODE7)-VALUE(LVNIM1+NODE4))
      CCHAT=CCO(LX0+LOCT)+(GMO(LX0+LOCT)+GOO(LX0+LOCT))*DELVBE
     1   -(GOO(LX0+LOCT)+GMUO(LX0+LOCT))*DELVBC
      CBHAT=CBO(LX0+LOCT)+GPIO(LX0+LOCT)*DELVBE+GMUO(LX0+LOCT)*DELVBC
C
C   BYPASS IF SOLUTION HAS NOT CHANGED
C
      IF (INITF.EQ.6) GO TO 200
      TOL=RELTOL*DMAX1(DABS(VBE),DABS(VBEO(LX0+LOCT)))+VNTOL
      IF (DABS(DELVBE).GE.TOL) GO TO 200
      TOL=RELTOL*DMAX1(DABS(VBC),DABS(VBCO(LX0+LOCT)))+VNTOL
      IF (DABS(DELVBC).GE.TOL) GO TO 200
      TOL=RELTOL*DMAX1(DABS(CCHAT),DABS(CCO(LX0+LOCT)))+ABSTOL
      IF (DABS(CCHAT-CCO(LX0+LOCT)).GE.TOL) GO TO 200
      TOL=RELTOL*DMAX1(DABS(CBHAT),DABS(CBO(LX0+LOCT)))+ABSTOL
      IF (DABS(CBHAT-CBO(LX0+LOCT)).GE.TOL) GO TO 200
      VBE=VBEO(LX0+LOCT)
      VBC=VBCO(LX0+LOCT)
      CC=CCO(LX0+LOCT)
      CB=CBO(LX0+LOCT)
      GPI=GPIO(LX0+LOCT)
      GMU=GMUO(LX0+LOCT)
      GM=GMO(LX0+LOCT)
      GO=GOO(LX0+LOCT)
      GX=GXO(LX0+LOCT)
      GEQCB=GEQCBO(LX0+LOCT)
      IF (MODE.NE.1) GO TO 800
      GO TO 900
C
C  LIMIT NONLINEAR BRANCH VOLTAGES
C
  200 ICHK1=1
      CALL PNJLIM(VBE,VBEO(LX0+LOCT),VT,VCRIT,ICHECK)
      CALL PNJLIM(VBC,VBCO(LX0+LOCT),VT,VCRIT,ICHK1)
      IF (ICHK1.EQ.1) ICHECK=1
C
C  DETERMINE DC CURRENT AND DERIVITIVES
C
  300 VTN=VT*VALUE(LOCM+3)
      IF(VBE.LE.-5.0D0*VTN) GO TO 320
      EVBE=DEXP(VBE/VTN)
      CBE=CSAT*(EVBE-1.0D0)+GMIN*VBE
      GBE=CSAT*EVBE/VTN+GMIN
      IF (C2.NE.0.0D0) GO TO 310
      CBEN=0.0D0
      GBEN=0.0D0
      GO TO 350
  310 EVBEN=DEXP(VBE/VTE)
      CBEN=C2*(EVBEN-1.0D0)
      GBEN=C2*EVBEN/VTE
      GO TO 350
  320 GBE=-CSAT/VBE+GMIN
      CBE=GBE*VBE
      GBEN=-C2/VBE
      CBEN=GBEN*VBE
  350 VTN=VT*VALUE(LOCM+9)
      IF(VBC.LE.-5.0D0*VTN) GO TO 370
      EVBC=DEXP(VBC/VTN)
      CBC=CSAT*(EVBC-1.0D0)+GMIN*VBC
      GBC=CSAT*EVBC/VTN+GMIN
      IF (C4.NE.0.0D0) GO TO 360
      CBCN=0.0D0
      GBCN=0.0D0
      GO TO 400
  360 EVBCN=DEXP(VBC/VTC)
      CBCN=C4*(EVBCN-1.0D0)
      GBCN=C4*EVBCN/VTC
      GO TO 400
  370 GBC=-CSAT/VBC+GMIN
      CBC=GBC*VBC
      GBCN=-C4/VBC
      CBCN=GBCN*VBC
C
C  DETERMINE BASE CHARGE TERMS
C
  400 Q1=1.0D0/(1.0D0-OVA*VBC-OVB*VBE)
      IF (OIK.NE.0.0D0) GO TO 405
      IF (OIKR.NE.0.0D0) GO TO 405
      QB=Q1
      DQBDVE=Q1*QB*OVB
      DQBDVC=Q1*QB*OVA
      GO TO 410
  405 Q2=OIK*CBE+OIKR*CBC
      ARG=DMAX1(0.0D0,1.0D0+4.0D0*Q2)
      SQARG=1.0D0
      IF(ARG.NE.0.0D0) SQARG=DSQRT(ARG)
      QB=Q1*(1.0D0+SQARG)/2.0D0
      DQBDVE=Q1*(QB*OVB+OIK*GBE/SQARG)
      DQBDVC=Q1*(QB*OVA+OIKR*GBC/SQARG)
C
C  WEIL'S APPROX. FOR EXCESS PHASE APPLIED WITH BACKWARD-
C  EULER INTEGRATION
C
  410 CC=0.0D0
      CEX=CBE
      GEX=GBE
      IF(MODE.EQ.1) GO TO 420
      IF(TD.EQ.0.0D0) GO TO 420
      ARG1=DELTA/TD
      ARG2=3.0D0*ARG1
      ARG1=ARG2*ARG1
      DENOM=1.0D0+ARG1+ARG2
      ARG3=ARG1/DENOM
      IF(INITF.NE.5) GO TO 411
      CEXBC(LX1+LOCT)=CBE/QB
      CEXBC(LX2+LOCT)=CEXBC(LX1+LOCT)
  411 CC=(CEXBC(LX1+LOCT)*(1.0D0+DELTA/DELOLD(2)+ARG2)
     1  -CEXBC(LX2+LOCT)*DELTA/DELOLD(2))/DENOM
      CEX=CBE*ARG3
      GEX=GBE*ARG3
      CEXBC(LX0+LOCT)=CC+CEX/QB
C
C  DETERMINE DC INCREMENTAL CONDUCTANCES
C
  420 CC=CC+(CEX-CBC)/QB-CBC/BRM-CBCN
      CB=CBE/BFM+CBEN+CBC/BRM+CBCN
      GX=RBPR+RBPI/QB
      IF(XJRB.EQ.0.0D0) GO TO 430
      ARG1=DMAX1(CB/XJRB,1.0D-9)
      ARG2=(-1.0D0+DSQRT(1.0D0+14.59025D0*ARG1))/2.4317D0/DSQRT(ARG1)
      ARG1=DTAN(ARG2)
      GX=RBPR+3.0D0*RBPI*(ARG1-ARG2)/ARG2/ARG1/ARG1
  430 IF(GX.NE.0.0D0) GX=1.0D0/GX
      GPI=GBE/BFM+GBEN
      GMU=GBC/BRM+GBCN
      GO=(GBC+(CEX-CBC)*DQBDVC/QB)/QB
      GM=(GEX-(CEX-CBC)*DQBDVE/QB)/QB-GO
      IF (MODE.NE.1) GO TO 500
      IF ((MODEDC.EQ.2).AND.(NOSOLV.NE.0)) GO TO 500
      IF (INITF.EQ.4) GO TO 500
      GO TO 700
C
C  CHARGE STORAGE ELEMENTS
C
  500 TF=VALUE(LOCM+24)
      TR=VALUE(LOCM+33)
      CZBE=VALUE(LOCM+21)*AREA
      PE=VALUE(LOCM+22)
      XME=VALUE(LOCM+23)
      CDIS=VALUE(LOCM+32)
      CTOT=VALUE(LOCM+29)*AREA
      CZBC=CTOT*CDIS
      CZBX=CTOT-CZBC
      PC=VALUE(LOCM+30)
      XMC=VALUE(LOCM+31)
      FCPE=VALUE(LOCM+46)
      CZCS=VALUE(LOCM+38)*AREA
      PS=VALUE(LOCM+39)
      XMS=VALUE(LOCM+40)
      XTF=VALUE(LOCM+25)
      OVTF=VALUE(LOCM+26)
      XJTF=VALUE(LOCM+27)*AREA
      IF(TF.EQ.0.0D0) GO TO 505
      IF(VBE.LE.0.0D0) GO TO 505
      ARGTF=0.0D0
      ARG2=0.0D0
      ARG3=0.0D0
      IF(XTF.EQ.0.0D0) GO TO 504
      ARGTF=XTF
      IF(OVTF.NE.0.0D0) ARGTF=ARGTF*DEXP(VBC*OVTF)
      ARG2=ARGTF
      IF(XJTF.EQ.0.0D0) GO TO 503
      TEMP=CBE/(CBE+XJTF)
      ARGTF=ARGTF*TEMP*TEMP
      ARG2=ARGTF*(3.0D0-TEMP-TEMP)
  503 ARG3=CBE*ARGTF*OVTF
  504 CBE=CBE*(1.0D0+ARGTF)/QB
      GBE=(GBE*(1.0D0+ARG2)-CBE*DQBDVE)/QB
      GEQCB=TF*(ARG3-CBE*DQBDVC)/QB
  505 IF (VBE.GE.FCPE) GO TO 510
      ARG=1.0D0-VBE/PE
      SARG=DEXP(-XME*DLOG(ARG))
      QBE(LX0+LOCT)=TF*CBE+PE*CZBE*(1.0D0-ARG*SARG)/(1.0D0-XME)
      CAPBE=TF*GBE+CZBE*SARG
      GO TO 520
  510 F1=VALUE(LOCM+47)
      F2=VALUE(LOCM+48)
      F3=VALUE(LOCM+49)
      CZBEF2=CZBE/F2
      QBE(LX0+LOCT)=TF*CBE+CZBE*F1+CZBEF2*(F3*(VBE-FCPE)
     1   +(XME/(PE+PE))*(VBE*VBE-FCPE*FCPE))
      CAPBE=TF*GBE+CZBEF2*(F3+XME*VBE/PE)
  520 FCPC=VALUE(LOCM+50)
      F1=VALUE(LOCM+51)
      F2=VALUE(LOCM+52)
      F3=VALUE(LOCM+53)
      IF (VBC.GE.FCPC) GO TO 530
      ARG=1.0D0-VBC/PC
      SARG=DEXP(-XMC*DLOG(ARG))
      QBC(LX0+LOCT)=TR*CBC+PC*CZBC*(1.0D0-ARG*SARG)/(1.0D0-XMC)
      CAPBC=TR*GBC+CZBC*SARG
      GO TO 540
  530 CZBCF2=CZBC/F2
      QBC(LX0+LOCT)=TR*CBC+CZBC*F1+CZBCF2*(F3*(VBC-FCPC)
     1   +(XMC/(PC+PC))*(VBC*VBC-FCPC*FCPC))
      CAPBC=TR*GBC+CZBCF2*(F3+XMC*VBC/PC)
  540 IF(VBX.GE.FCPC) GO TO 550
      ARG=1.0D0-VBX/PC
      SARG=DEXP(-XMC*DLOG(ARG))
      QBX(LX0+LOCT)=PC*CZBX*(1.0D0-ARG*SARG)/(1.0D0-XMC)
      CAPBX=CZBX*SARG
      GO TO 560
  550 CZBXF2=CZBX/F2
      QBX(LX0+LOCT)=CZBX*F1+CZBXF2*(F3*(VBX-FCPC)+(XMC/(PC+PC))*
     1   (VBX*VBX-FCPC*FCPC))
      CAPBX=CZBXF2*(F3+XMC*VBX/PC)
  560 IF(VCS.GE.0.0D0) GO TO 570
      ARG=1.0D0-VCS/PS
      SARG=DEXP(-XMS*DLOG(ARG))
      QCS(LX0+LOCT)=PS*CZCS*(1.0D0-ARG*SARG)/(1.0D0-XMS)
      CAPCS=CZCS*SARG
      GO TO 580
  570 QCS(LX0+LOCT)=VCS*CZCS*(1.0D0+XMS*VCS/(2.0D0*PS))
      CAPCS=CZCS*(1.0D0+XMS*VCS/PS)
C
C  STORE SMALL-SIGNAL PARAMETERS
C
  580 IF ((MODE.EQ.1).AND.(MODEDC.EQ.2).AND.(NOSOLV.NE.0)) GO TO 700
      IF (INITF.NE.4) GO TO 600
      VALUE(LX0+LOCT+9)=CAPBE
      VALUE(LX0+LOCT+11)=CAPBC
      VALUE(LX0+LOCT+13)=CAPCS
      VALUE(LX0+LOCT+15)=CAPBX
      VALUE(LX0+LOCT+17)=GEQCB
      GO TO 1000
C
C  TRANSIENT ANALYSIS
C
  600 IF (INITF.NE.5) GO TO 610
      QBE(LX1+LOCT)=QBE(LX0+LOCT)
      QBC(LX1+LOCT)=QBC(LX0+LOCT)
      QBX(LX1+LOCT)=QBX(LX0+LOCT)
      QCS(LX1+LOCT)=QCS(LX0+LOCT)
  610 CALL INTGR8(GEQ,CEQ,CAPBE,LOCT+8)
      GEQCB=GEQCB*AG(1)
      GPI=GPI+GEQ
      CB=CB+CQBE(LX0+LOCT)
      CALL INTGR8(GEQ,CEQ,CAPBC,LOCT+10)
      GMU=GMU+GEQ
      CB=CB+CQBC(LX0+LOCT)
      CC=CC-CQBC(LX0+LOCT)
      IF (INITF.NE.5) GO TO 700
      CQBE(LX1+LOCT)=CQBE(LX0+LOCT)
      CQBC(LX1+LOCT)=CQBC(LX0+LOCT)
C
C  CHECK CONVERGENCE
C
  700 IF (INITF.NE.3) GO TO 710
      IF (IOFF.EQ.0) GO TO 710
      GO TO 750
  710 IF (ICHECK.EQ.1) GO TO 720
      TOL=RELTOL*DMAX1(DABS(CCHAT),DABS(CC))+ABSTOL
      IF (DABS(CCHAT-CC).GT.TOL) GO TO 720
      TOL=RELTOL*DMAX1(DABS(CBHAT),DABS(CB))+ABSTOL
      IF (DABS(CBHAT-CB).LE.TOL) GO TO 750
  720 NONCON=NONCON+1
  750 VBEO(LX0+LOCT)=VBE
      VBCO(LX0+LOCT)=VBC
      CCO(LX0+LOCT)=CC
      CBO(LX0+LOCT)=CB
      GPIO(LX0+LOCT)=GPI
      GMUO(LX0+LOCT)=GMU
      GMO(LX0+LOCT)=GM
      GOO(LX0+LOCT)=GO
      GXO(LX0+LOCT)=GX
      GEQCBO(LX0+LOCT)=GEQCB
      IF (MODE.EQ.1) GO TO 900
C
C     CHARGE STORAGE FOR C-S AND B-X JUNCTIONS
C
  800 CALL INTGR8(GCCS,CEQ,CAPCS,LOCT+12)
      CEQCS=TYPE*(CQCS(LX0+LOCT)-VCS*GCCS)
      CALL INTGR8(GEQBX,CEQ,CAPBX,LOCT+14)
      CEQBX=TYPE*(CQBX(LX0+LOCT)-VBX*GEQBX)
      IF (INITF.NE.5) GO TO 900
      CQBX(LX1+LOCT)=CQBX(LX0+LOCT)
      CQCS(LX1+LOCT)=CQCS(LX0+LOCT)
C
C  LOAD CURRENT EXCITATION VECTOR
C
  900 CEQBE=TYPE*(CC+CB-VBE*(GM+GO+GPI)+VBC*(GO-GEQCB))
      CEQBC=TYPE*(-CC+VBE*(GM+GO)-VBC*(GMU+GO))
      VALUE(LVN+NODE2)=VALUE(LVN+NODE2)-CEQBX
      VALUE(LVN+NODE4)=VALUE(LVN+NODE4)+CEQCS+CEQBX+CEQBC
      VALUE(LVN+NODE5)=VALUE(LVN+NODE5)-CEQBE-CEQBC
      VALUE(LVN+NODE6)=VALUE(LVN+NODE6)+CEQBE
      VALUE(LVN+NODE7)=VALUE(LVN+NODE7)-CEQCS
C
C  LOAD Y MATRIX
C
      LOCY=LVN+NODPLC(LOC+24)
      VALUE(LOCY)=VALUE(LOCY)+GCPR
      LOCY=LVN+NODPLC(LOC+25)
      VALUE(LOCY)=VALUE(LOCY)+GX+GEQBX
      LOCY=LVN+NODPLC(LOC+26)
      VALUE(LOCY)=VALUE(LOCY)+GEPR
      LOCY=LVN+NODPLC(LOC+27)
      VALUE(LOCY)=VALUE(LOCY)+GMU+GO+GCPR+GCCS+GEQBX
      LOCY=LVN+NODPLC(LOC+28)
      VALUE(LOCY)=VALUE(LOCY)+GX  +GPI+GMU+GEQCB
      LOCY=LVN+NODPLC(LOC+29)
      VALUE(LOCY)=VALUE(LOCY)+GPI+GEPR+GM+GO
      LOCY=LVN+NODPLC(LOC+10)
      VALUE(LOCY)=VALUE(LOCY)-GCPR
      LOCY=LVN+NODPLC(LOC+11)
      VALUE(LOCY)=VALUE(LOCY)-GX
      LOCY=LVN+NODPLC(LOC+12)
      VALUE(LOCY)=VALUE(LOCY)-GEPR
      LOCY=LVN+NODPLC(LOC+13)
      VALUE(LOCY)=VALUE(LOCY)-GCPR
      LOCY=LVN+NODPLC(LOC+14)
      VALUE(LOCY)=VALUE(LOCY)-GMU+GM
      LOCY=LVN+NODPLC(LOC+15)
      VALUE(LOCY)=VALUE(LOCY)-GM-GO
      LOCY=LVN+NODPLC(LOC+16)
      VALUE(LOCY)=VALUE(LOCY)-GX
      LOCY=LVN+NODPLC(LOC+17)
      VALUE(LOCY)=VALUE(LOCY)-GMU-GEQCB
      LOCY=LVN+NODPLC(LOC+18)
      VALUE(LOCY)=VALUE(LOCY)-GPI
      LOCY=LVN+NODPLC(LOC+19)
      VALUE(LOCY)=VALUE(LOCY)-GEPR
      LOCY=LVN+NODPLC(LOC+20)
      VALUE(LOCY)=VALUE(LOCY)-GO+GEQCB
      LOCY=LVN+NODPLC(LOC+21)
      VALUE(LOCY)=VALUE(LOCY)-GPI-GM-GEQCB
      LOCY=LVN+NODPLC(LOC+31)
      VALUE(LOCY)=VALUE(LOCY)+GCCS
      LOCY=LVN+NODPLC(LOC+32)
      VALUE(LOCY)=VALUE(LOCY)-GCCS
      LOCY=LVN+NODPLC(LOC+33)
      VALUE(LOCY)=VALUE(LOCY)-GCCS
      LOCY=LVN+NODPLC(LOC+34)
      VALUE(LOCY)=VALUE(LOCY)-GEQBX
      LOCY=LVN+NODPLC(LOC+35)
      VALUE(LOCY)=VALUE(LOCY)-GEQBX
 1000 LOC=NODPLC(LOC)
      GO TO 10
      END
      SUBROUTINE FETLIM(VNEW,VOLD,VTO)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE LIMITS THE PER-ITERATION CHANGE OF FET VOLTAGES.
C
C
C      THREE REGIONS OF OPERATION ARE IDENTIFIED:
C
C                  V < VTO        DEFINITELY OFF
C            VTO <= V <= VTO+3.5D0    OFF OR ON DEPENDING ON VBS
C        VTO+3.5D0 < V              DEFINITELY ON
C
      VTSTHI=DABS(2.0D0*(VOLD-VTO))+2.0D0
      VTSTLO=VTSTHI/2.0D0+2.0D0
      VTOX=VTO+3.5D0
      DELV=VNEW-VOLD
C
      IF (VOLD.LT.VTO) GO TO 300
      IF (VOLD.LT.VTOX) GO TO 200
C
C  ON ...
C
      IF (DELV.GT.0.0D0) GO TO 120
C...  GOING OFF
      IF (VNEW.LT.VTOX) GO TO 110
      IF (-DELV.LE.VTSTLO) GO TO 500
      VNEW=VOLD-VTSTLO
      GO TO 500
  110 VNEW=DMAX1(VNEW,VTO+2.0D0)
      GO TO 500
C...  STAYING ON
  120 IF (DELV.LT.VTSTHI) GO TO 500
      VNEW=VOLD+VTSTHI
      GO TO 500
C
C  MIDDLE REGION ...
C
  200 IF (DELV.GT.0.0D0) GO TO 210
C...  DECREASING
      VNEW=DMAX1(VNEW,VTO-0.5D0)
      GO TO 500
C...  INCREASING
  210 VNEW=DMIN1(VNEW,VTO+4.0D0)
      GO TO 500
C
C  OFF ...
C
  300 IF (DELV.GT.0.0D0) GO TO 310
      IF (-DELV.LE.VTSTHI) GO TO 500
      VNEW=VOLD-VTSTHI
      GO TO 500
  310 VTEMP=VTO+0.5D0
      IF (VNEW.GT.VTEMP) GO TO 320
      IF (DELV.LE.VTSTLO) GO TO 500
      VNEW=VOLD+VTSTLO
      GO TO 500
  320 VNEW=VTEMP
C
C  FINISHED
C
  500 RETURN
      END
      SUBROUTINE LIMVDS(VNEW,VOLD)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE LIMITS THE PER-ITERATION CHANGE OF FET VDS.
C
      IF (VOLD.LT.3.5D0) GO TO 200
C
      IF (VNEW.LE.VOLD) GO TO 100
      VNEW=DMIN1(VNEW,3.0D0*VOLD+2.0D0)
      GO TO 500
  100 IF (VNEW.LT.3.5D0) VNEW=DMAX1(VNEW,2.0D0)
      GO TO 500
C
  200 IF (VNEW.LE.VOLD) GO TO 300
      VNEW=DMIN1(VNEW,4.0D0)
      GO TO 500
  300 VNEW=DMAX1(VNEW,-0.5D0)
C
  500 RETURN
      END
      SUBROUTINE JFET
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE PROCESSES JFETS FOR DC AND TRANSIENT ANALYSES.
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=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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C
      DIMENSION VGSO(1),VGDO(1),CGO(1),CDO(1),CGDO(1),GMO(1),GDSO(1),
     1   GGSO(1),GGDO(1),QGS(1),CQGS(1),QGD(1),CQGD(1)
      EQUIVALENCE (VGSO(1),VALUE( 1)),(VGDO(1),VALUE( 2)),
     1            (CGO (1),VALUE( 3)),(CDO (1),VALUE( 4)),
     2            (CGDO(1),VALUE( 5)),(GMO (1),VALUE( 6)),
     3            (GDSO(1),VALUE( 7)),(GGSO(1),VALUE( 8)),
     4            (GGDO(1),VALUE( 9)),(QGS (1),VALUE(10)),
     5            (CQGS(1),VALUE(11)),(QGD (1),VALUE(12)),
     6            (CQGD(1),VALUE(13))
C
C
      LOC=LOCATE(13)
   10 IF ((LOC.EQ.0).OR.(NODPLC(LOC+25).NE.0)) RETURN
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      NODE3=NODPLC(LOC+4)
      NODE4=NODPLC(LOC+5)
      NODE5=NODPLC(LOC+6)
      LOCM=NODPLC(LOC+7)
      IOFF=NODPLC(LOC+8)
      TYPE=NODPLC(LOCM+2)
      LOCM=NODPLC(LOCM+1)
      LOCT=NODPLC(LOC+19)
C
C  DC MODEL PARAMETERS
C
      AREA=VALUE(LOCV+1)
      VTO=VALUE(LOCM+1)
      BETA=VALUE(LOCM+2)*AREA
      XLAMB=VALUE(LOCM+3)
      GDPR=VALUE(LOCM+4)*AREA
      GSPR=VALUE(LOCM+5)*AREA
      CSAT=VALUE(LOCM+9)*AREA
      VCRIT=VALUE(LOCM+16)
C
C  INITIALIZATION
C
      ICHECK=1
      GO TO (100,20,30,50,60,70), INITF
   20 IF(MODE.NE.1.OR.MODEDC.NE.2.OR.NOSOLV.EQ.0) GO TO 25
      VDS=TYPE*VALUE(LOCV+2)
      VGS=TYPE*VALUE(LOCV+3)
      VGD=VGS-VDS
      GO TO 300
   25 IF(IOFF.NE.0) GO TO 40
      VGS=-1.0D0
      VGD=-1.0D0
      GO TO 300
   30 IF (IOFF.EQ.0) GO TO 100
   40 VGS=0.0D0
      VGD=0.0D0
      GO TO 300
   50 VGS=VGSO(LX0+LOCT)
      VGD=VGDO(LX0+LOCT)
      GO TO 300
   60 VGS=VGSO(LX1+LOCT)
      VGD=VGDO(LX1+LOCT)
      GO TO 300
   70 XFACT=DELTA/DELOLD(2)
      VGSO(LX0+LOCT)=VGSO(LX1+LOCT)
      VGS=(1.0D0+XFACT)*VGSO(LX1+LOCT)-XFACT*VGSO(LX2+LOCT)
      VGDO(LX0+LOCT)=VGDO(LX1+LOCT)
      VGD=(1.0D0+XFACT)*VGDO(LX1+LOCT)-XFACT*VGDO(LX2+LOCT)
      CGO(LX0+LOCT)=CGO(LX1+LOCT)
      CDO(LX0+LOCT)=CDO(LX1+LOCT)
      CGDO(LX0+LOCT)=CGDO(LX1+LOCT)
      GMO(LX0+LOCT)=GMO(LX1+LOCT)
      GDSO(LX0+LOCT)=GDSO(LX1+LOCT)
      GGSO(LX0+LOCT)=GGSO(LX1+LOCT)
      GGDO(LX0+LOCT)=GGDO(LX1+LOCT)
      GO TO 110
C
C  COMPUTE NEW NONLINEAR BRANCH VOLTAGES
C
  100 VGS=TYPE*(VALUE(LVNIM1+NODE2)-VALUE(LVNIM1+NODE5))
      VGD=TYPE*(VALUE(LVNIM1+NODE2)-VALUE(LVNIM1+NODE4))
  110 DELVGS=VGS-VGSO(LX0+LOCT)
      DELVGD=VGD-VGDO(LX0+LOCT)
      DELVDS=DELVGS-DELVGD
      CGHAT=CGO(LX0+LOCT)+GGDO(LX0+LOCT)*DELVGD+GGSO(LX0+LOCT)*DELVGS
      CDHAT=CDO(LX0+LOCT)+GMO(LX0+LOCT)*DELVGS+GDSO(LX0+LOCT)*DELVDS
     1   -GGDO(LX0+LOCT)*DELVGD
C
C  BYPASS IF SOLUTION HAS NOT CHANGED
C
      IF (INITF.EQ.6) GO TO 200
      TOL=RELTOL*DMAX1(DABS(VGS),DABS(VGSO(LX0+LOCT)))+VNTOL
      IF (DABS(DELVGS).GE.TOL) GO TO 200
      TOL=RELTOL*DMAX1(DABS(VGD),DABS(VGDO(LX0+LOCT)))+VNTOL
      IF (DABS(DELVGD).GE.TOL) GO TO 200
      TOL=RELTOL*DMAX1(DABS(CGHAT),DABS(CGO(LX0+LOCT)))+ABSTOL
      IF (DABS(CGHAT-CGO(LX0+LOCT)).GE.TOL) GO TO 200
      TOL=RELTOL*DMAX1(DABS(CDHAT),DABS(CDO(LX0+LOCT)))+ABSTOL
      IF (DABS(CDHAT-CDO(LX0+LOCT)).GE.TOL) GO TO 200
      VGS=VGSO(LX0+LOCT)
      VGD=VGDO(LX0+LOCT)
      VDS=VGS-VGD
      CG=CGO(LX0+LOCT)
      CD=CDO(LX0+LOCT)
      CGD=CGDO(LX0+LOCT)
      GM=GMO(LX0+LOCT)
      GDS=GDSO(LX0+LOCT)
      GGS=GGSO(LX0+LOCT)
      GGD=GGDO(LX0+LOCT)
      GO TO 900
C
C  LIMIT NONLINEAR BRANCH VOLTAGES
C
  200 ICHK1=1
      CALL PNJLIM(VGS,VGSO(LX0+LOCT),VT,VCRIT,ICHECK)
      CALL PNJLIM(VGD,VGDO(LX0+LOCT),VT,VCRIT,ICHK1)
      IF (ICHK1.EQ.1) ICHECK=1
      CALL FETLIM(VGS,VGSO(LX0+LOCT),VTO)
      CALL FETLIM(VGD,VGDO(LX0+LOCT),VTO)
C
C  DETERMINE DC CURRENT AND DERIVATIVES
C
  300 VDS=VGS-VGD
      IF (VGS.GT.-5.0D0*VT) GO TO 310
      GGS=-CSAT/VGS+GMIN
      CG=GGS*VGS
      GO TO 320
  310 EVGS=DEXP(VGS/VT)
      GGS=CSAT*EVGS/VT+GMIN
      CG=CSAT*(EVGS-1.0D0)+GMIN*VGS
  320 IF (VGD.GT.-5.0D0*VT) GO TO 330
      GGD=-CSAT/VGD+GMIN
      CGD=GGD*VGD
      GO TO 340
  330 EVGD=DEXP(VGD/VT)
      GGD=CSAT*EVGD/VT+GMIN
      CGD=CSAT*(EVGD-1.0D0)+GMIN*VGD
  340 CG=CG+CGD
C
C  COMPUTE DRAIN CURRENT AND DERIVITIVES FOR NORMAL MODE
C
  400 IF (VDS.LT.0.0D0) GO TO 450
      VGST=VGS-VTO
C
C  NORMAL MODE, CUTOFF REGION
C
      IF (VGST.GT.0.0D0) GO TO 410
      CDRAIN=0.0D0
      GM=0.0D0
      GDS=0.0D0
      GO TO 490
C
C  NORMAL MODE, SATURATION REGION
C
  410 BETAP=BETA*(1.0D0+XLAMB*VDS)
      TWOB=BETAP+BETAP
      IF (VGST.GT.VDS) GO TO 420
      CDRAIN=BETAP*VGST*VGST
      GM=TWOB*VGST
      GDS=XLAMB*BETA*VGST*VGST
      GO TO 490
C
C  NORMAL MODE, LINEAR REGION
C
  420 CDRAIN=BETAP*VDS*(VGST+VGST-VDS)
      GM=TWOB*VDS
      GDS=TWOB*(VGST-VDS)+XLAMB*BETA*VDS*(VGST+VGST-VDS)
      GO TO 490
C
C  COMPUTE DRAIN CURRENT AND DERIVITIVES FOR INVERSE MODE
C
  450 VGDT=VGD-VTO
C
C  INVERSE MODE, CUTOFF REGION
C
      IF (VGDT.GT.0.0D0) GO TO 460
      CDRAIN=0.0D0
      GM=0.0D0
      GDS=0.0D0
      GO TO 490
C
C  INVERSE MODE, SATURATION REGION
C
  460 BETAP=BETA*(1.0D0-XLAMB*VDS)
      TWOB=BETAP+BETAP
      IF (VGDT.GT.-VDS) GO TO 470
      CDRAIN=-BETAP*VGDT*VGDT
      GM=-TWOB*VGDT
      GDS=XLAMB*BETA*VGDT*VGDT-GM
      GO TO 490
C
C  INVERSE MODE, LINEAR REGION
C
  470 CDRAIN=BETAP*VDS*(VGDT+VGDT+VDS)
      GM=TWOB*VDS
      GDS=TWOB*VGDT-XLAMB*BETA*VDS*(VGDT+VGDT+VDS)
C
C  COMPUTE EQUIVALENT DRAIN CURRENT SOURCE
C
  490 CD=CDRAIN-CGD
      IF (MODE.NE.1) GO TO 500
      IF ((MODEDC.EQ.2).AND.(NOSOLV.NE.0)) GO TO 500
      IF (INITF.EQ.4) GO TO 500
      GO TO 700
C
C  CHARGE STORAGE ELEMENTS
C
  500 CZGS=VALUE(LOCM+6)*AREA
      CZGD=VALUE(LOCM+7)*AREA
      PHIB=VALUE(LOCM+8)
      TWOP=PHIB+PHIB
      FCPB=VALUE(LOCM+12)
      FCPB2=FCPB*FCPB
      F1=VALUE(LOCM+13)
      F2=VALUE(LOCM+14)
      F3=VALUE(LOCM+15)
      CZGSF2=CZGS/F2
      CZGDF2=CZGD/F2
      IF (VGS.GE.FCPB) GO TO 510
      SARG=DSQRT(1.0D0-VGS/PHIB)
      QGS(LX0+LOCT)=TWOP*CZGS*(1.0D0-SARG)
      CAPGS=CZGS/SARG
      GO TO 520
  510 QGS(LX0+LOCT)=CZGS*F1+CZGSF2*(F3*(VGS-FCPB)
     1   +(VGS*VGS-FCPB2)/(TWOP+TWOP))
      CAPGS=CZGSF2*(F3+VGS/TWOP)
  520 IF (VGD.GE.FCPB) GO TO 530
      SARG=DSQRT(1.0D0-VGD/PHIB)
      QGD(LX0+LOCT)=TWOP*CZGD*(1.0D0-SARG)
      CAPGD=CZGD/SARG
      GO TO 560
  530 QGD(LX0+LOCT)=CZGD*F1+CZGDF2*(F3*(VGD-FCPB)
     1   +(VGD*VGD-FCPB2)/(TWOP+TWOP))
      CAPGD=CZGDF2*(F3+VGD/TWOP)
C
C  STORE SMALL-SIGNAL PARAMETERS
C
  560 IF ((MODE.EQ.1).AND.(MODEDC.EQ.2).AND.(NOSOLV.NE.0)) GO TO 700
      IF (INITF.NE.4) GO TO 600
      VALUE(LX0+LOCT+9)=CAPGS
      VALUE(LX0+LOCT+11)=CAPGD
      GO TO 1000
C
C  TRANSIENT ANALYSIS
C
  600 IF (INITF.NE.5) GO TO 610
      QGS(LX1+LOCT)=QGS(LX0+LOCT)
      QGD(LX1+LOCT)=QGD(LX0+LOCT)
  610 CALL INTGR8(GEQ,CEQ,CAPGS,LOCT+9)
      GGS=GGS+GEQ
      CG=CG+CQGS(LX0+LOCT)
      CALL INTGR8(GEQ,CEQ,CAPGD,LOCT+11)
      GGD=GGD+GEQ
      CG=CG+CQGD(LX0+LOCT)
      CD=CD-CQGD(LX0+LOCT)
      CGD=CGD+CQGD(LX0+LOCT)
      IF (INITF.NE.5) GO TO 700
      CQGS(LX1+LOCT)=CQGS(LX0+LOCT)
      CQGD(LX1+LOCT)=CQGD(LX0+LOCT)
C
C  CHECK CONVERGENCE
C
  700 IF (INITF.NE.3) GO TO 710
      IF (IOFF.EQ.0) GO TO 710
      GO TO 750
  710 IF (ICHECK.EQ.1) GO TO 720
      TOL=RELTOL*DMAX1(DABS(CGHAT),DABS(CG))+ABSTOL
      IF (DABS(CGHAT-CG).GE.TOL) GO TO 720
      TOL=RELTOL*DMAX1(DABS(CDHAT),DABS(CD))+ABSTOL
      IF (DABS(CDHAT-CD).LE.TOL) GO TO 750
  720 NONCON=NONCON+1
  750 VGSO(LX0+LOCT)=VGS
      VGDO(LX0+LOCT)=VGD
      CGO(LX0+LOCT)=CG
      CDO(LX0+LOCT)=CD
      CGDO(LX0+LOCT)=CGD
      GMO(LX0+LOCT)=GM
      GDSO(LX0+LOCT)=GDS
      GGSO(LX0+LOCT)=GGS
      GGDO(LX0+LOCT)=GGD
C
C  LOAD CURRENT VECTOR
C
  900 CEQGD=TYPE*(CGD-GGD*VGD)
      CEQGS=TYPE*((CG-CGD)-GGS*VGS)
      CDREQ=TYPE*((CD+CGD)-GDS*VDS-GM*VGS)
      VALUE(LVN+NODE2)=VALUE(LVN+NODE2)-CEQGS-CEQGD
      VALUE(LVN+NODE4)=VALUE(LVN+NODE4)-CDREQ+CEQGD
      VALUE(LVN+NODE5)=VALUE(LVN+NODE5)+CDREQ+CEQGS
C
C  LOAD Y MATRIX
C
      LOCY=LVN+NODPLC(LOC+20)
      VALUE(LOCY)=VALUE(LOCY)+GDPR
      LOCY=LVN+NODPLC(LOC+21)
      VALUE(LOCY)=VALUE(LOCY)+GGD+GGS
      LOCY=LVN+NODPLC(LOC+22)
      VALUE(LOCY)=VALUE(LOCY)+GSPR
      LOCY=LVN+NODPLC(LOC+23)
      VALUE(LOCY)=VALUE(LOCY)+GDPR+GDS+GGD
      LOCY=LVN+NODPLC(LOC+24)
      VALUE(LOCY)=VALUE(LOCY)+GSPR+GDS+GM+GGS
      LOCY=LVN+NODPLC(LOC+9)
      VALUE(LOCY)=VALUE(LOCY)-GDPR
      LOCY=LVN+NODPLC(LOC+10)
      VALUE(LOCY)=VALUE(LOCY)-GGD
      LOCY=LVN+NODPLC(LOC+11)
      VALUE(LOCY)=VALUE(LOCY)-GGS
      LOCY=LVN+NODPLC(LOC+12)
      VALUE(LOCY)=VALUE(LOCY)-GSPR
      LOCY=LVN+NODPLC(LOC+13)
      VALUE(LOCY)=VALUE(LOCY)-GDPR
      LOCY=LVN+NODPLC(LOC+14)
      VALUE(LOCY)=VALUE(LOCY)+GM-GGD
      LOCY=LVN+NODPLC(LOC+15)
      VALUE(LOCY)=VALUE(LOCY)-GDS-GM
      LOCY=LVN+NODPLC(LOC+16)
      VALUE(LOCY)=VALUE(LOCY)-GGS-GM
      LOCY=LVN+NODPLC(LOC+17)
      VALUE(LOCY)=VALUE(LOCY)-GSPR
      LOCY=LVN+NODPLC(LOC+18)
      VALUE(LOCY)=VALUE(LOCY)-GDS
 1000 LOC=NODPLC(LOC)
      GO TO 10
      END
      SUBROUTINE MOSFET
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE PROCESSES MOSFETS FOR DC AND TRANSIENT ANALYSES.
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=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=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=DEBUG 3/15/83
      COMMON/DEBUG/ IDEBUG(20)
C SPICE VERSION 2G.6  SCCSID=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C
      DIMENSION VBDO(1),VBSO(1),VGSO(1),VDSO(1),CDO(1),CBSO(1),CBDO(1),
     1   GMO(1),GDSO(1),GMBSO(1),GBDO(1),GBSO(1),
     2   QB(1),CQB(1),QG(1),CQG(1),QD(1),CQD(1),
     3   CGGBO(1),CGDBO(1),CGSBO(1),CBGBO(1),CBDBO(1),CBSBO(1),
     4   CGBO(1),CGDO(1),CGSO(1),VONO(1),VDSATO(1)
      DIMENSION QBD(1),CQBD(1),QBS(1),CQBS(1),
     1          QGS(1),CQGS(1),QGD(1),CQGD(1),QGB(1),CQGB(1)
      EQUIVALENCE (VBDO (1),VALUE( 1)),(VBSO (1),VALUE( 2)),
     1            (VGSO (1),VALUE( 3)),(VDSO (1),VALUE( 4)),
     2            (CDO  (1),VALUE( 5)),(CBSO (1),VALUE( 6)),
     3            (CBDO (1),VALUE( 7)),(GMO  (1),VALUE( 8)),
     4            (GDSO (1),VALUE( 9)),(GMBSO(1),VALUE(10)),
     5            (GBDO (1),VALUE(11)),(GBSO (1),VALUE(12)),
     6            (QB   (1),QGS  ( 1), VALUE(13)),
     7            (CQB  (1),CQGS ( 1), VALUE(14)),
     8            (QG   (1),QGD  ( 1), VALUE(15)),
     9            (CQG  (1),CQGD ( 1), VALUE(16)),
     A            (QD   (1),QGB  ( 1), VALUE(17)),
     B            (CQD  (1),CQGB ( 1), VALUE(18)),
     C            (CGGBO(1),CGBO  (1), VALUE(19)),
     D            (CGDBO(1),CGDO  (1), VALUE(20)),
     E            (CGSBO(1),CGSO  (1), VALUE(21)),
     F            (CBGBO(1),VONO  (1), VALUE(22)),
     G            (CBDBO(1),VDSATO(1), VALUE(23)),
     H            (CBSBO(1),           VALUE(24))
      EQUIVALENCE (QBD  (1),VALUE(25)),(CQBD (1),VALUE(26)),
     1            (QBS  (1),VALUE(27)),(CQBS (1),VALUE(28))
C
C
      LOC=LOCATE(14)
   10 IF ((LOC.EQ.0).OR.(NODPLC(LOC+33).NE.0)) RETURN
      LOCV=NODPLC(LOC+1)
      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)
      IOFF=NODPLC(LOC+9)
      TYPE=NODPLC(LOCM+2)
      LOCM=NODPLC(LOCM+1)
      LOCT=NODPLC(LOC+26)
C
C  DC MODEL PARAMETERS
C
      XJ=VALUE(LOCM+27)
      XLD=VALUE(LOCM+28)
      XL=VALUE(LOCV+1)-2.0D0*XLD
      XW=VALUE(LOCV+2)
      DEVMOD=VALUE(LOCV+8)
      VTO=TYPE*VALUE(LOCM+2)
      VDSAT=TYPE*VALUE(LOCV+10)
      VINIT=VALUE(LOCM+43)
      AD=VALUE(LOCV+3)
      AS=VALUE(LOCV+4)
      PD=VALUE(LOCV+11)
      PS=VALUE(LOCV+12)
      IF (VALUE(LOCM+21).EQ.0.0D0.
     1   OR.AD.EQ.0.0D0.OR.AS.EQ.0.0D0) GO TO 12
      CDSAT=VALUE(LOCM+21)*AD
      CSSAT=VALUE(LOCM+21)*AS
      GO TO 15
   12 CDSAT=VALUE(LOCM+11)
      CSSAT=VALUE(LOCM+11)
   15 IF ((VALUE(LOCM+7).LE.0.0D0).AND.
     1              (VALUE(LOCM+8).LE.0.0D0)) GO TO 17
      GDPR=VALUE(LOCM+7)
      GSPR=VALUE(LOCM+8)
      GO TO 19
   17 GDPR=VALUE(LOCM+16)/VALUE(LOCV+13)
      GSPR=VALUE(LOCM+16)/VALUE(LOCV+14)
   19 COVLGS=VALUE(LOCM+13)*XW
      COVLGD=VALUE(LOCM+14)*XW
      COVLGB=VALUE(LOCM+15)*XL
      LEV=VALUE(LOCM+1)
C
C     MOS1, MOS2 AND MOS3 MODEL PARAMETERS
C
      BETA=VALUE(LOCM+3)*XW/XL
      GAMMA=VALUE(LOCM+4)
      PHI=VALUE(LOCM+5)
      XLAMDA=VALUE(LOCM+6)
      PHIB=VALUE(LOCM+12)
      COX=VALUE(LOCM+22)*XW*XL
      XNSUB=VALUE(LOCM+23)
      XNFS=VALUE(LOCM+25)
      UO=VALUE(LOCM+29)
      VBP=VALUE(LOCM+30)
      UEXP=VALUE(LOCM+31)
      UTRA=VALUE(LOCM+32)
      VBI=TYPE*VALUE(LOCM+44)
      XD=VALUE(LOCM+45)
      VMAX=VALUE(LOCM+33)
      XNEFF=VALUE(LOCM+34)
      XQCO=VALUE(LOCM+35)
      FNARRW=VALUE(LOCM+39)
      IF (LEV.EQ.3) FNARRW=FNARRW/XW
C
C     INITIALIZATION
C
      ICHECK=1
      IBYPAS=0
      GO TO (100,20,30,50,60,70), INITF
   20 IF (IOFF.NE.0) GO TO 40
      VDS=TYPE*VALUE(LOCV+5)
      VGS=TYPE*VALUE(LOCV+6)
      VBS=TYPE*VALUE(LOCV+7)
      IF (VDS.NE.0.0D0) GO TO 300
      IF (VGS.NE.0.0D0) GO TO 300
      IF (VBS.NE.0.0D0) GO TO 300
      IF ((MODE.EQ.1).AND.(MODEDC.EQ.2).AND.(NOSOLV.NE.0)) GO TO 300
      VBS=VINIT
      VGS=VTO
      VDS=0.0D0
      GO TO 300
   30 IF (IOFF.EQ.0) GO TO 100
   40 VBS=0.0D0
      VGS=0.0D0
      VDS=0.0D0
      GO TO 300
   50 VBS=VBSO(LX0+LOCT)
      VGS=VGSO(LX0+LOCT)
      VDS=VDSO(LX0+LOCT)
      GO TO 300
   60 VBS=VBSO(LX1+LOCT)
      VGS=VGSO(LX1+LOCT)
      VDS=VDSO(LX1+LOCT)
      GO TO 300
   70 XFACT=DELTA/DELOLD(2)
      VBSO(LX0+LOCT)=VBSO(LX1+LOCT)
      VBS=(1.0D0+XFACT)*VBSO(LX1+LOCT)-XFACT*VBSO(LX2+LOCT)
      VGSO(LX0+LOCT)=VGSO(LX1+LOCT)
      VGS=(1.0D0+XFACT)*VGSO(LX1+LOCT)-XFACT*VGSO(LX2+LOCT)
      VDSO(LX0+LOCT)=VDSO(LX1+LOCT)
      VDS=(1.0D0+XFACT)*VDSO(LX1+LOCT)-XFACT*VDSO(LX2+LOCT)
      VBDO(LX0+LOCT)=VBSO(LX0+LOCT)-VDSO(LX0+LOCT)
      CDO(LX0+LOCT)=CDO(LX1+LOCT)
      CBSO(LX0+LOCT)=CBSO(LX1+LOCT)
      CBDO(LX0+LOCT)=CBDO(LX1+LOCT)
      GMO(LX0+LOCT)=GMO(LX1+LOCT)
      GDSO(LX0+LOCT)=GDSO(LX1+LOCT)
      GMBSO(LX0+LOCT)=GMBSO(LX1+LOCT)
      GBDO(LX0+LOCT)=GBDO(LX1+LOCT)
      GBSO(LX0+LOCT)=GBSO(LX1+LOCT)
      CGGBO(LX0+LOCT)=CGGBO(LX1+LOCT)
      CGDBO(LX0+LOCT)=CGDBO(LX1+LOCT)
      CGSBO(LX0+LOCT)=CGSBO(LX1+LOCT)
      CBGBO(LX0+LOCT)=CBGBO(LX1+LOCT)
      CBDBO(LX0+LOCT)=CBDBO(LX1+LOCT)
      CBSBO(LX0+LOCT)=CBSBO(LX1+LOCT)
      GO TO 110
C
C  COMPUTE NEW NONLINEAR BRANCH VOLTAGES
C
  100 VBS=TYPE*(VALUE(LVNIM1+NODE4)-VALUE(LVNIM1+NODE6))
      VGS=TYPE*(VALUE(LVNIM1+NODE2)-VALUE(LVNIM1+NODE6))
      VDS=TYPE*(VALUE(LVNIM1+NODE5)-VALUE(LVNIM1+NODE6))
  110 VBD=VBS-VDS
      VGD=VGS-VDS
      VGDO=VGSO(LX0+LOCT)-VDSO(LX0+LOCT)
      DELVBS=VBS-VBSO(LX0+LOCT)
      DELVBD=VBD-VBDO(LX0+LOCT)
      DELVGS=VGS-VGSO(LX0+LOCT)
      DELVDS=VDS-VDSO(LX0+LOCT)
      DELVGD=VGD-VGDO
      IF (DEVMOD.LT.0.0D0) GO TO 120
      CDHAT=CDO(LX0+LOCT)-GBDO(LX0+LOCT)*DELVBD+GMBSO(LX0+LOCT)*DELVBS
     1   +GMO(LX0+LOCT)*DELVGS+GDSO(LX0+LOCT)*DELVDS
      GO TO 130
  120 CDHAT=CDO(LX0+LOCT)-(GBDO(LX0+LOCT)-GMBSO(LX0+LOCT))*DELVBD
     1   -GMO(LX0+LOCT)*DELVGD+GDSO(LX0+LOCT)*DELVDS
  130 CBHAT=CBSO(LX0+LOCT)+CBDO(LX0+LOCT)+GBDO(LX0+LOCT)*DELVBD
     1   +GBSO(LX0+LOCT)*DELVBS
C
C  BYPASS IF SOLUTION HAS NOT CHANGED
C
      IF (INITF.EQ.6) GO TO 200
      TOL=RELTOL*DMAX1(DABS(VBS),DABS(VBSO(LX0+LOCT)))+VNTOL
      IF (DABS(DELVBS).GE.TOL) GO TO 200
      TOL=RELTOL*DMAX1(DABS(VBD),DABS(VBDO(LX0+LOCT)))+VNTOL
      IF (DABS(DELVBD).GE.TOL) GO TO 200
      TOL=RELTOL*DMAX1(DABS(VGS),DABS(VGSO(LX0+LOCT)))+VNTOL
      IF (DABS(DELVGS).GE.TOL) GO TO 200
      TOL=RELTOL*DMAX1(DABS(VDS),DABS(VDSO(LX0+LOCT)))+VNTOL
      IF (DABS(DELVDS).GE.TOL) GO TO 200
      TOL=RELTOL*DMAX1(DABS(CDHAT),DABS(CDO(LX0+LOCT)))+ABSTOL
      IF (DABS(CDHAT-CDO(LX0+LOCT)).GE.TOL) GO TO 200
      TOL=RELTOL*DMAX1(DABS(CBHAT),DABS(CBSO(LX0+LOCT)+CBDO(LX0+LOCT)))
     1   +ABSTOL
      IF (DABS(CBHAT-(CBSO(LX0+LOCT)+CBDO(LX0+LOCT))).GE.TOL) GO TO 200
      VBS=VBSO(LX0+LOCT)
      VBD=VBDO(LX0+LOCT)
      VGS=VGSO(LX0+LOCT)
      VDS=VDSO(LX0+LOCT)
      VGD=VGS-VDS
      VGB=VGS-VBS
      CD=CDO(LX0+LOCT)
      CBS=CBSO(LX0+LOCT)
      CBD=CBDO(LX0+LOCT)
      CDRAIN=DEVMOD*(CD+CBD)
      GM=GMO(LX0+LOCT)
      GDS=GDSO(LX0+LOCT)
      GMBS=GMBSO(LX0+LOCT)
      GBD=GBDO(LX0+LOCT)
      GBS=GBSO(LX0+LOCT)
      DEVMOD=VALUE(LOCV+8)
      IF (MODE.NE.1) GO TO 135
      IF ((MODEDC.EQ.2).AND.(NOSOLV.NE.0)) GO TO 135
      IF (XQCO.GT.0.5D0) GO TO 742
      GO TO 850
  135 IF (XQCO.LE.0.5D0) GO TO 140
      CGB=CGBO(LX0+LOCT)
      CGD=CGDO(LX0+LOCT)
      CGS=CGSO(LX0+LOCT)
      VGS1=VGSO(LX1+LOCT)
      VGB1=VGS1-VBSO(LX1+LOCT)
      VGD1=VGS1-VDSO(LX1+LOCT)
      GO TO 735
  140 CGGB=CGGBO(LX0+LOCT)
      CGDB=CGDBO(LX0+LOCT)
      CGSB=CGSBO(LX0+LOCT)
      CBGB=CBGBO(LX0+LOCT)
      CBDB=CBDBO(LX0+LOCT)
      CBSB=CBSBO(LX0+LOCT)
      XQC=VALUE(LOCV+15)
      IBYPAS=1
      GO TO 755
C
C  LIMIT NONLINEAR BRANCH VOLTAGES
C
  200 VON=TYPE*VALUE(LOCV+9)
      IF (VDSO(LX0+LOCT).LT.0.0D0) GO TO 205
      CALL FETLIM(VGS,VGSO(LX0+LOCT),VON)
      VDS=VGS-VGD
      CALL LIMVDS(VDS,VDSO(LX0+LOCT))
      VGD=VGS-VDS
      GO TO 210
  205 CALL FETLIM(VGD,VGDO,VON)
      VDS=VGS-VGD
      CALL LIMVDS(-VDS,-VDSO(LX0+LOCT))
      VGS=VGD+VDS
  210 IF (VDS.LT.0.0D0) GO TO 220
      VCRIT=VT*DLOG(VT/(ROOT2*CSSAT))
      CALL PNJLIM(VBS,VBSO(LX0+LOCT),VT,VCRIT,ICHECK)
      VBD=VBS-VDS
      GO TO 300
  220 VCRIT=VT*DLOG(VT/(ROOT2*CDSAT))
      CALL PNJLIM(VBD,VBDO(LX0+LOCT),VT,VCRIT,ICHECK)
      VBS=VBD+VDS
C
C  DETERMINE DC CURRENT AND DERIVATIVES
C
  300 VBD=VBS-VDS
      VGD=VGS-VDS
      VGB=VGS-VBS
      IF (VBS.GT.0.0D0) GO TO 310
      GBS=CSSAT/VT
      CBS=GBS*VBS
      GBS=GBS+GMIN
      GO TO 320
  310 EVBS=DEXP(VBS/VT)
      GBS=CSSAT*EVBS/VT+GMIN
      CBS=CSSAT*(EVBS-1.0D0)
  320 IF (VBD.GT.0.0D0) GO TO 330
      GBD=CDSAT/VT
      CBD=GBD*VBD
      GBD=GBD+GMIN
      GO TO 400
  330 EVBD=DEXP(VBD/VT)
      GBD=CDSAT*EVBD/VT+GMIN
      CBD=CDSAT*(EVBD-1.0D0)
C
C  COMPUTE DRAIN CURRENT AND DERIVATIVES
C
  400 IF (VDS.LT.0.0D0) GO TO 450
C
C  NORMAL MODE
C
      DEVMOD=1.0D0
      VALUE(LOCV+8)=DEVMOD
      GO TO (405,410,415), LEV
  405 CALL MOSEQ1(VDS,VBS,VGS,GM,GDS,GMBS)
      GO TO 460
  410 CALL MOSEQ2(VDS,VBS,VGS,GM,GDS,GMBS,
     1   QGATE,QCHAN,QBULK,CGGB,CGDB,CGSB,CBGB,CBDB,CBSB)
      GO TO 460
  415 CALL MOSEQ3(VDS,VBS,VGS,GM,GDS,GMBS,
     1   QGATE,QCHAN,QBULK,CGGB,CGDB,CGSB,CBGB,CBDB,CBSB)
      GO TO 460
C
C  INVERSE MODE
C
  450 DEVMOD=-1.0D0
      VALUE(LOCV+8)=DEVMOD
      GO TO (452,453,454), LEV
  452 CALL MOSEQ1(-VDS,VBD,VGD,GM,GDS,GMBS)
      GO TO 460
  453 CALL MOSEQ2(-VDS,VBD,VGD,GM,GDS,GMBS,
     1   QGATE,QCHAN,QBULK,CGGB,CGSB,CGDB,CBGB,CBSB,CBDB)
      GO TO 460
  454 CALL MOSEQ3(-VDS,VBD,VGD,GM,GDS,GMBS,
     1   QGATE,QCHAN,QBULK,CGGB,CGSB,CGDB,CBGB,CBSB,CBDB)
  460 VALUE(LOCV+9)=TYPE*VON
      VALUE(LOCV+10)=TYPE*VDSAT
      IF (XQCO.LE.0.5D0) VALUE(LOCV+15)=XQC
C
C  COMPUTE EQUIVALENT DRAIN CURRENT SOURCE
C
  490 CD=DEVMOD*CDRAIN-CBD
      IF (MODE.NE.1) GO TO 500
      IF ((MODEDC.EQ.2).AND.(NOSOLV.NE.0)) GO TO 500
      IF (INITF.EQ.4) GO TO 500
      GO TO 650
C
C  CHARGE STORAGE ELEMENTS
C
C.. BULK-DRAIN AND BULK-SOURCE DEPLETION CAPACITANCES
C
  500 CZBD=0.0D0
      CZBS=0.0D0
      CZBDSW=0.0D0
      CZBSSW=0.0D0
      IF ((VALUE(LOCM+9).EQ.0.0D0).OR.(VALUE(LOCM+10).EQ.0.0D0))
     1   GO TO 505
      CZBD=VALUE(LOCM+9)
      CZBS=VALUE(LOCM+10)
      GO TO 510
  505 IF (VALUE(LOCM+17).EQ.0.0D0) GO TO 510
      CZBD=VALUE(LOCM+17)*AD
      CZBS=VALUE(LOCM+17)*AS
  510 IF (VALUE(LOCM+19).EQ.0.0D0) GO TO 515
      CZBDSW=VALUE(LOCM+19)*PD
      CZBSSW=VALUE(LOCM+19)*PS
  515 PHIB=VALUE(LOCM+12)
      XMJ=VALUE(LOCM+18)
      XMJSW=VALUE(LOCM+20)
      TWOP=PHIB+PHIB
      FCPB=VALUE(LOCM+38)
      FCPB2=FCPB*FCPB
      F1=VALUE(LOCM+40)
      F2=VALUE(LOCM+41)
      F3=VALUE(LOCM+42)
      CZSF2=CZBS/F2
      CZSWF2=CZBSSW/F2
      CZDF2=CZBD/F2
      CZDWF2=CZBDSW/F2
      IF (VBS.GE.FCPB) GO TO 520
      ARG=1.0D0-VBS/PHIB
      SARG=DEXP(-XMJ*DLOG(ARG))
      SARGSW=DEXP(-XMJSW*DLOG(ARG))
      QBS(LX0+LOCT)=PHIB*(CZBS*(1.0D0-ARG*SARG)/(1.0D0-XMJ)
     1                +CZBSSW*(1.0D0-ARG*SARGSW)/(1.0D0-XMJSW))
      CAPBS=CZBS*SARG+CZBSSW*SARGSW
      GO TO 525
  520 QBS(LX0+LOCT)=F1*(CZBS+CZBSSW)+F3*(VBS-FCPB)*(CZSF2+CZSWF2)
     1    +(VBS*VBS-FCPB*FCPB)*(CZSF2*XMJ+CZSWF2*XMJSW)
      CAPBS=F3*(CZSF2+CZSWF2)+VBS/PHIB*(CZSF2*XMJ+CZSWF2*XMJSW)
  525 IF (VBD.GE.FCPB) GO TO 530
      ARG=1.0D0-VBD/PHIB
      SARG=DEXP(-XMJ*DLOG(ARG))
      SARGSW=DEXP(-XMJSW*DLOG(ARG))
      QBD(LX0+LOCT)=PHIB*(CZBD*(1.0D0-ARG*SARG)/(1.0D0-XMJ)
     1              +CZBDSW*(1.0D0-ARG*SARGSW)/(1.0D0-XMJSW))
      CAPBD=CZBD*SARG+CZBDSW*SARGSW
      GO TO 560
  530 QBD(LX0+LOCT)=F1*(CZBD+CZBDSW)+F3*(VBD-FCPB)*(CZDF2+CZDWF2)
     1    +(VBD*VBD-FCPB*FCPB)*(CZDF2*XMJ+CZDWF2*XMJSW)
      CAPBD=F3*(CZDF2+CZDWF2)+VBD/PHIB*(CZDF2*XMJ+CZDWF2*XMJSW)
C
  560 IF (XQCO.LE.0.5D0) GO TO 650
      IF ((MODE.EQ.1).AND.(MODEDC.EQ.2).AND.(NOSOLV.NE.0)) GO TO 650
      IF (INITF.NE.4) GO TO 600
      GO TO 705
C
CC    CALCULATE EQUIVALENT CONDUCTANCES AND CURRENTS FOR
CC    DEPLETION CAPACITORS
C
  600 IF (INITF.NE.5) GO TO 610
      QBD(LX1+LOCT)=QBD(LX0+LOCT)
      QBS(LX1+LOCT)=QBS(LX0+LOCT)
  610 CALL INTGR8(GEQ,CEQ,CAPBD,LOCT+24)
      GBD=GBD+GEQ
      CBD=CBD+CQBD(LX0+LOCT)
      CD=CD-CQBD(LX0+LOCT)
      CALL INTGR8(GEQ,CEQ,CAPBS,LOCT+26)
      GBS=GBS+GEQ
      CBS=CBS+CQBS(LX0+LOCT)
      IF (INITF.NE.5) GO TO 650
      CQBD(LX1+LOCT)=CQBD(LX0+LOCT)
      CQBS(LX1+LOCT)=CQBS(LX0+LOCT)
C
C  CHECK CONVERGENCE
C
  650 IF (INITF.NE.3) GO TO 660
      IF (IOFF.NE.0) GO TO 680
  660 IF (ICHECK.EQ.1) GO TO 670
      TOL=RELTOL*DMAX1(DABS(CDHAT),DABS(CD))+ABSTOL
      IF (DABS(CDHAT-CD).GE.TOL) GO TO 670
      TOL=RELTOL*DMAX1(DABS(CBHAT),DABS(CBS+CBD))+ABSTOL
      IF (DABS(CBHAT-(CBS+CBD)).LE.TOL) GO TO 680
  670 NONCON=NONCON+1
  680 VBSO(LX0+LOCT)=VBS
      VBDO(LX0+LOCT)=VBD
      VGSO(LX0+LOCT)=VGS
      VDSO(LX0+LOCT)=VDS
      CDO(LX0+LOCT)=CD
      CBSO(LX0+LOCT)=CBS
      CBDO(LX0+LOCT)=CBD
      GMO(LX0+LOCT)=GM
      GDSO(LX0+LOCT)=GDS
      GMBSO(LX0+LOCT)=GMBS
      GBDO(LX0+LOCT)=GBD
      GBSO(LX0+LOCT)=GBS
      IF (XQCO.LE.0.5D0) GO TO 690
      VONO(LX0+LOCT)=VON
      VDSATO(LX0+LOCT)=VDSAT
      GO TO 700
  690 CGGBO(LX0+LOCT)=CGGB
      CGDBO(LX0+LOCT)=CGDB
      CGSBO(LX0+LOCT)=CGSB
      CBGBO(LX0+LOCT)=CBGB
      CBDBO(LX0+LOCT)=CBDB
      CBSBO(LX0+LOCT)=CBSB
      GO TO 750
C
C     XQCO > 0.5D0 USE MEYER"S CAPACITOR MODEL
C
  700 IF (MODE.NE.1) GO TO 705
      IF ((MODEDC.EQ.2).AND.(NOSOLV.NE.0)) GO TO 705
      IF (INITF.EQ.4) GO TO 705
      GO TO 742
C
C     CALCULATE MEYER'S CAPACITORS
C
  705 VON1=VON
      VGS1=VGS
      VGD1=VGD
      VGB1=VGS-VBS
      VDSAT1=VDSAT
      IF ((MODE.NE.2).OR.(INITF.EQ.5)) GO TO 710
      VON1=VONO(LX1+LOCT)
      VGS1=VGSO(LX1+LOCT)
      VGD1=VGS1-VDSO(LX1+LOCT)
      VGB1=VGS1-VBSO(LX1+LOCT)
      VDSAT1=VDSATO(LX1+LOCT)
  710 IF (DEVMOD.LT.0.0D0) GO TO 715
      CALL CMEYER (VGS1,VGD1,VGB1,VON1,VDSAT1,VGS,VGD,VGB,
     1   COVLGS,COVLGD,COVLGB,CGS1,CGD1,CGB1,CGS,CGD,CGB)
      GO TO 720
  715 CALL CMEYER (VGD1,VGS1,VGB1,VON1,VDSAT1,VGD,VGS,VGB,
     1   COVLGD,COVLGS,COVLGB,CGD1,CGS1,CGB1,CGD,CGS,CGB)
  720 CGS=0.5D0*(CGS+CGS1)
      CGD=0.5D0*(CGD+CGD1)
      CGB=0.5D0*(CGB+CGB1)
C
C     STORE SMALL-SIGNAL PARAMETERS (FOR MEYER"S MODEL)
C
      IF (MODE.NE.1) GO TO 730
      IF (INITF.NE.4) GO TO 730
      VALUE(LX0+LOCT+24)=CAPBD
      VALUE(LX0+LOCT+26)=CAPBS
      VALUE(LX0+LOCT+12)=CGS-COVLGS
      VALUE(LX0+LOCT+14)=CGD-COVLGD
      VALUE(LX0+LOCT+16)=CGB-COVLGB
      GO TO 1000
CC
  730 IF (INITF.NE.6) GO TO 735
      QGS(LX0+LOCT)=(1.0D0+XFACT)*QGS(LX1+LOCT)-XFACT*QGS(LX2+LOCT)
      QGD(LX0+LOCT)=(1.0D0+XFACT)*QGD(LX1+LOCT)-XFACT*QGD(LX2+LOCT)
      QGB(LX0+LOCT)=(1.0D0+XFACT)*QGB(LX1+LOCT)-XFACT*QGB(LX2+LOCT)
      GO TO 745
  735 QGS(LX0+LOCT)=(VGS-VGS1)*CGS
      QGD(LX0+LOCT)=(VGD-VGD1)*CGD
      QGB(LX0+LOCT)=(VGB-VGB1)*CGB
      IF((MODE.NE.2).OR.(INITF.EQ.5))GO TO 740
      QGS(LX0+LOCT)=QGS(LX0+LOCT)+QGS(LX1+LOCT)
      QGD(LX0+LOCT)=QGD(LX0+LOCT)+QGD(LX1+LOCT)
      QGB(LX0+LOCT)=QGB(LX0+LOCT)+QGB(LX1+LOCT)
  740 IF((MODE.EQ.1).AND.(MODEDC.EQ.2).AND.(NOSOLV.NE.0)) GO TO 742
      IF (INITF.NE.5) GO TO 745
      QGS(LX0+LOCT)=CGS*VGS
      QGD(LX0+LOCT)=CGD*VGD
      QGB(LX0+LOCT)=CGB*VGB
      QGS(LX1+LOCT)=QGS(LX0+LOCT)
      QGD(LX1+LOCT)=QGD(LX0+LOCT)
      QGB(LX1+LOCT)=QGB(LX0+LOCT)
C
C     INITIALIZE TO ZERO CHARGE CONDUCTANCES AND CURRENT
C
  742 GCGS=0.0D0
      CEQGS=0.0D0
      GCGD=0.0D0
      CEQGD=0.0D0
      GCGB=0.0D0
      CEQGB=0.0D0
      GO TO  870
CC
 745  IF(CGS.EQ.0.0D0) VALUE(LX0+LOCT+13)=0.0D0
      IF(CGD.EQ.0.0D0) VALUE(LX0+LOCT+15)=0.0D0
      IF(CGB.EQ.0.0D0) VALUE(LX0+LOCT+17)=0.0D0
CC
CC    CALCULATE EQUIVALENT CONDUCTANCES AND CURRENTS FOR
CC    MEYER"S CAPACITORS
CC
      CALL INTGR8(GCGS,CEQGS,CGS,LOCT+12)
      CALL INTGR8(GCGD,CEQGD,CGD,LOCT+14)
      CALL INTGR8(GCGB,CEQGB,CGB,LOCT+16)
      CEQGS=CEQGS-GCGS*VGS+AG(1)*QGS(LX0+LOCT)
      CEQGD=CEQGD-GCGD*VGD+AG(1)*QGD(LX0+LOCT)
      CEQGB=CEQGB-GCGB*VGB+AG(1)*QGB(LX0+LOCT)
      IF (INITF.NE.5) GO TO 870
      CQGS(LX1+LOCT)=CQGS(LX0+LOCT)
      CQGD(LX1+LOCT)=CQGD(LX0+LOCT)
      CQGB(LX1+LOCT)=CQGB(LX0+LOCT)
      GO TO 870
C
C.. BULK AND CHANNEL CHARGE (PLUS OVERLAPS)
C
  750 IF (MODE.NE.1) GO TO 755
      IF ((MODEDC.EQ.2).AND.(NOSOLV.NE.0)) GO TO 755
      IF (INITF.EQ.4) GO TO 755
      GO TO 850
  755 IF (DEVMOD.EQ.-1.0D0) GO TO 760
      CALL MOSCAP(VGD,VGS,VGB,COVLGD,COVLGS,COVLGB,
     1   CAPBD,CAPBS,CGGB,CGDB,CGSB,CBGB,CBDB,CBSB,
     2   GCGGB,GCGDB,GCGSB,GCBGB,GCBDB,GCBSB,
     3   GCDGB,GCDDB,GCDSB,GCSGB,GCSDB,GCSSB,
     4   QGATE,QCHAN,QBULK,QDRN,QSRC)
      GO TO 780
  760 CALL MOSCAP(VGS,VGD,VGB,COVLGS,COVLGD,COVLGB,
     1   CAPBS,CAPBD,CGGB,CGSB,CGDB,CBGB,CBSB,CBDB,
     2   GCGGB,GCGSB,GCGDB,GCBGB,GCBSB,GCBDB,
     3   GCSGB,GCSSB,GCSDB,GCDGB,GCDSB,GCDDB,
     4   QGATE,QCHAN,QBULK,QSRC,QDRN)
  780 IF (IBYPAS.EQ.1) GO TO 860
      QG(LX0+LOCT)=QGATE
      QD(LX0+LOCT)=QDRN-QBD(LX0+LOCT)
      QB(LX0+LOCT)=QBULK+QBD(LX0+LOCT)+QBS(LX0+LOCT)
C
C  STORE SMALL-SIGNAL PARAMETERS
C
  790 IF ((MODE.EQ.1).AND.(MODEDC.EQ.2).AND.(NOSOLV.NE.0)) GO TO 850
      IF (INITF.NE.4) GO TO 800
      VALUE(LX0+LOCT+18)=CGGB
      VALUE(LX0+LOCT+19)=CGDB
      VALUE(LX0+LOCT+20)=CGSB
      VALUE(LX0+LOCT+21)=CBGB
      VALUE(LX0+LOCT+22)=CBDB
      VALUE(LX0+LOCT+23)=CBSB
      VALUE(LX0+LOCT+24)=CAPBD
      VALUE(LX0+LOCT+26)=CAPBS
      GO TO 1000
C
C  TRANSIENT ANALYSIS
C
  800 IF (INITF.NE.5) GO TO 810
      QB(LX1+LOCT)=QB(LX0+LOCT)
      QG(LX1+LOCT)=QG(LX0+LOCT)
      QD(LX1+LOCT)=QD(LX0+LOCT)
C.. INTEGRATE QB
  810 CALL INTGR8(GEQ,CEQ,0.0D0,LOCT+12)
C.. INTEGRATE QG
      CALL INTGR8(GEQ,CEQ,0.0D0,LOCT+14)
C.. INTEGRATE QD
      CALL INTGR8(GEQ,CEQ,0.0D0,LOCT+16)
      GO TO 860
C
C     INITIALIZE TO ZERO CHARGE CONDUCTANCES AND CURRENT
C
  850 CEQQG=0.0D0
      CEQQB=0.0D0
      CEQQD=0.0D0
      GCDGB=0.0D0
      GCDDB=0.0D0
      GCDSB=0.0D0
      GCSGB=0.0D0
      GCSDB=0.0D0
      GCSSB=0.0D0
      GCGGB=0.0D0
      GCGDB=0.0D0
      GCGSB=0.0D0
      GCBGB=0.0D0
      GCBDB=0.0D0
      GCBSB=0.0D0
      GO TO 900
C
C     EVALUATE EQUIVALENT CHARGE CURRENTS
C
  860 CGATE=CQG(LX0+LOCT)
      CQBULK=CQB(LX0+LOCT)
      CQDRN=CQD(LX0+LOCT)
      CEQQG=CGATE-GCGGB*VGB+GCGDB*VBD+GCGSB*VBS
      CEQQB=CQBULK-GCBGB*VGB+GCBDB*VBD+GCBSB*VBS
      CEQQD=CQDRN-GCDGB*VGB+GCDDB*VBD+GCDSB*VBS
      IF (INITF.NE.5) GO TO 900
      CQB(LX1+LOCT)=CQB(LX0+LOCT)
      CQG(LX1+LOCT)=CQG(LX0+LOCT)
      CQD(LX1+LOCT)=CQD(LX0+LOCT)
      GO TO 900
C
CC   DO THE MAPPING FROM MEYER"S CAPACITOR MODEL INTO THE CHARGE
CC   ORIENTED MODEL
CC
  870 CEQQG=CEQGS+CEQGB+CEQGD
      CEQQB=-CEQGB
      CEQQD=-CEQGD
      GCBDB=0.0D0
      GCBSB=0.0D0
      GCDSB=0.0D0
      GCSDB=0.0D0
      GCGDB=-GCGD
      GCGSB=-GCGS
      GCBGB=-GCGB
      GCDGB=-GCGD
      GCSGB=-GCGS
      GCSSB=GCGS
      GCDDB=GCGD
      GCGGB=GCGD+GCGS+GCGB
C
C     STORE CHARGE STORAGE INFO FOR MEYER'S CAP IN LX TABLE
C
      CGBO(LX0+LOCT)=CGB
      CGSO(LX0+LOCT)=CGS
      CGDO(LX0+LOCT)=CGD
C
C  LOAD CURRENT VECTOR
C
  900 CEQBS=TYPE*(CBS-(GBS-GMIN)*VBS)
      CEQBD=TYPE*(CBD-(GBD-GMIN)*VBD)
      CEQQG=TYPE*CEQQG
      CEQQB=TYPE*CEQQB
      CEQQD=TYPE*CEQQD
      XNRM=1.0D0
      XREV=0.0D0
      IF (DEVMOD.LT.0.0D0) GO TO 910
      CDREQ=TYPE*(CDRAIN-GDS*VDS-GM*VGS-GMBS*VBS)
      GO TO 920
  910 XNRM=0.0D0
      XREV=1.0D0
      CDREQ=-TYPE*(CDRAIN-GDS*(-VDS)-GM*VGD-GMBS*VBD)
  920 VALUE(LVN+NODE2)=VALUE(LVN+NODE2)-CEQQG
      VALUE(LVN+NODE4)=VALUE(LVN+NODE4)-CEQBS-CEQBD-CEQQB
      VALUE(LVN+NODE5)=VALUE(LVN+NODE5)-CDREQ+CEQBD-CEQQD
      VALUE(LVN+NODE6)=VALUE(LVN+NODE6)+CDREQ+CEQBS
     1   +CEQQG+CEQQB+CEQQD
C
C  LOAD Y MATRIX
C
      LOCY=LVN+NODPLC(LOC+27)
      VALUE(LOCY)=VALUE(LOCY)+GDPR
      LOCY=LVN+NODPLC(LOC+28)
      VALUE(LOCY)=VALUE(LOCY)+GCGGB
      LOCY=LVN+NODPLC(LOC+29)
      VALUE(LOCY)=VALUE(LOCY)+GSPR
      LOCY=LVN+NODPLC(LOC+30)
      VALUE(LOCY)=VALUE(LOCY)+GBD+GBS-GCBGB-GCBDB-GCBSB
      LOCY=LVN+NODPLC(LOC+31)
      VALUE(LOCY)=VALUE(LOCY)+GDPR+GDS+GBD+XREV*(GM+GMBS)+GCDDB
      LOCY=LVN+NODPLC(LOC+32)
      VALUE(LOCY)=VALUE(LOCY)+GSPR+GDS+GBS+XNRM*(GM+GMBS)+GCSSB
      LOCY=LVN+NODPLC(LOC+10)
      VALUE(LOCY)=VALUE(LOCY)-GDPR
      LOCY=LVN+NODPLC(LOC+11)
      VALUE(LOCY)=VALUE(LOCY)-GCGGB-GCGDB-GCGSB
      LOCY=LVN+NODPLC(LOC+12)
      VALUE(LOCY)=VALUE(LOCY)+GCGDB
      LOCY=LVN+NODPLC(LOC+13)
      VALUE(LOCY)=VALUE(LOCY)+GCGSB
      LOCY=LVN+NODPLC(LOC+14)
      VALUE(LOCY)=VALUE(LOCY)-GSPR
      LOCY=LVN+NODPLC(LOC+15)
      VALUE(LOCY)=VALUE(LOCY)+GCBGB
      LOCY=LVN+NODPLC(LOC+16)
      VALUE(LOCY)=VALUE(LOCY)-GBD+GCBDB
      LOCY=LVN+NODPLC(LOC+17)
      VALUE(LOCY)=VALUE(LOCY)-GBS+GCBSB
      LOCY=LVN+NODPLC(LOC+18)
      VALUE(LOCY)=VALUE(LOCY)-GDPR
      LOCY=LVN+NODPLC(LOC+19)
      VALUE(LOCY)=VALUE(LOCY)+(XNRM-XREV)*GM+GCDGB
      LOCY=LVN+NODPLC(LOC+20)
      VALUE(LOCY)=VALUE(LOCY)-GBD+(XNRM-XREV)*GMBS-
     1   GCDGB-GCDDB-GCDSB
      LOCY=LVN+NODPLC(LOC+21)
      VALUE(LOCY)=VALUE(LOCY)-GDS-XNRM*(GM+GMBS)+GCDSB
      LOCY=LVN+NODPLC(LOC+22)
      VALUE(LOCY)=VALUE(LOCY)-(XNRM-XREV)*GM+GCSGB
      LOCY=LVN+NODPLC(LOC+23)
      VALUE(LOCY)=VALUE(LOCY)-GSPR
      LOCY=LVN+NODPLC(LOC+24)
      VALUE(LOCY)=VALUE(LOCY)-GBS-(XNRM-XREV)*GMBS-
     1   GCSGB-GCSDB-GCSSB
      LOCY=LVN+NODPLC(LOC+25)
      VALUE(LOCY)=VALUE(LOCY)-GDS-XREV*(GM+GMBS)+GCSDB
 1000 LOC=NODPLC(LOC)
      GO TO 10
      END
      SUBROUTINE MOSEQ1(VDS,VBS,VGS,GM,GDS,GMBS)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE EVALUATES THE DRAIN CURRENT AND ITS DERIVATIVES
C     USING THE SHICHMAN-HODGES MODEL AND THE CHARGES ASSOCIATED
C     WITH THE GATE, CHANNEL AND BULK FOR MOSFETS
C
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=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
      VBD=VBS-VDS
      VGB=VGS-VBS
C
C
      IF (VBS.GT.0.0D0) GO TO 102
      SARG=DSQRT(PHI-VBS)
      GO TO 104
  102 SARG=DSQRT(PHI)
      SARG=SARG-VBS/(SARG+SARG)
      SARG=DMAX1(0.0D0,SARG)
  104 VON=VBI+GAMMA*SARG
      VGST=VGS-VON
      VDSAT=DMAX1(VGST,0.0D0)
      IF (SARG.GT.0.0D0) GO TO 105
      ARG=0.0D0
      GO TO 108
  105 ARG=GAMMA/(SARG+SARG)
  108 IF (VGST.GT.0.0D0) GO TO 110
C
C     CUTOFF REGION
C
      CDRAIN=0.0D0
      GM=0.0D0
      GDS=0.0D0
      GMBS=0.0D0
      GO TO 1000
C
C     SATURATION REGION
C
  110 BETAP=BETA*(1.0D0+XLAMDA*VDS)
      IF (VGST.GT.VDS) GO TO 120
      CDRAIN=BETAP*VGST*VGST*0.5D0
      GM=BETAP*VGST
      GDS=XLAMDA*BETA*VGST*VGST*0.5D0
      GMBS=GM*ARG
      GO TO 1000
C
C     LINEAR REGION
C
  120 CDRAIN=BETAP*VDS*(VGST-0.5D0*VDS)
      GM=BETAP*VDS
      GDS=BETAP*(VGST-VDS)+XLAMDA*BETA*VDS*(VGST-0.5D0*VDS)
      GMBS=GM*ARG
C
C     FINISHED
C
 1000 RETURN
      END
      SUBROUTINE MOSEQ2(VDS,VBS,VGS,GM,GDS,GMBS,
     1   QG,QC,QB,CGGB,CGDB,CGSB,CBGB,CBDB,CBSB)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE EVALUATES THE DRAIN CURRENT, ITS DERIVATIVES AND
C     THE CHARGES ASSOCIATED WITH THE GATE, CHANNEL AND BULK
C     FOR MOSFETS
C
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=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
      DIMENSION A4(4),B4(4),X4(8),POLY4(8),SIG1(4),SIG2(4)
      DATA SIG1 / 1.0D0, -1.0D0, 1.0D0, -1.0D0/,
     1     SIG2 / 1.0D0,  1.0D0,-1.0D0, -1.0D0/
C
C     ICHARG=1 CAUSES CHARGES TO BE COMPUTED
C     ICHARG=0 BYPASSES THE COMPUTATION OF CHARGES
C
      ICHARG=1
      IF (MODE.NE.1.AND.XQCO.LE.0.5D0) GO TO 100
      ICHARG=0
      IF (XQCO.GT.0.5D0) GO TO 100
      IF (MODEDC.EQ.2.AND.NOSOLV.NE.0) ICHARG=1
      IF (INITF.EQ.4) ICHARG=1
C
C  COMPUTE SOME USEFUL QUANTITIES
C
  100 IF (VBS.GT.0.0D0) GO TO 110
      SARG=DSQRT(PHI-VBS)
      TSARG=SARG+SARG
      DSRGDB=-0.5D0/SARG
      D2SDB2=+0.5D0*DSRGDB/(PHI-VBS)
      GO TO 120
  110 SPHI=DSQRT(PHI)
      SPHI3=PHI*SPHI
      SARG=SPHI/(1.0D0+0.5D0*VBS/PHI)
      TSARG=SARG+SARG
      DSRGDB=-0.5D0*SARG*SARG/SPHI3
      D2SDB2=-DSRGDB*SARG/SPHI3
  120 IF ((VDS-VBS).LT.0.0D0) GO TO 130
      BARG=DSQRT(PHI+VDS-VBS)
      DBRGDB=-0.5D0/BARG
      D2BDB2=+0.5D0*DBRGDB/(PHI+VDS-VBS)
      GO TO 200
  130 BARG=SPHI/(1.0D0+0.5D0*(VBS-VDS)/PHI)
      DBRGDB=-0.5D0*BARG*BARG/SPHI3
      D2BDB2=-DBRGDB*BARG/SPHI3
C
C  CALCULATE THRESHOLD VOLTAGE (VON)
C     NARROW-CHANNEL EFFECT
C
  200 FACTOR=0.125D0*FNARRW*TWOPI*EPSSIL/COX*XL
      ETA=1.0D0+FACTOR
      VBIN=VBI+FACTOR*(PHI-VBS)
      IF (GAMMA.LE.0.0D0) GO TO 215
      IF (XNSUB.LE.0.0D0) GO TO 215
      XWD=XD*BARG
      XWS=XD*SARG
C
C     SHORT-CHANNEL EFFECT WITH VDS .NE. 0.0D0
C
      ARGSS=0.0D0
      ARGSD=0.0D0
      DBARGS=0.0D0
      DBARGD=0.0D0
      DGDVDS=0.0D0
      DGDDB2=0.0D0
      IF (XJ.LE.0.0D0) GO TO 205
      ARGXS=1.0D0+2.0D0*XWS/XJ
      ARGS=DSQRT(ARGXS)
      ARGSS=0.5D0*XJ/XL*(ARGS-1.0D0)
      ARGXD=1.0D0+2.0D0*XWD/XJ
      ARGD=DSQRT(ARGXD)
      ARGSD=0.5D0*XJ/XL*(ARGD-1.0D0)
  205 GAMASD=GAMMA*(1.0D0-ARGSS-ARGSD)
      GAMASS=GAMMA*(1.0D0-2.0D0*ARGSS)
      DBXWD=XD*DBRGDB
      DBXWS=XD*DSRGDB
      IF (XJ.LE.0.0D0) GO TO 210
      DBARGS=0.5D0/XL*DBXWS/ARGS
      DBARGD=0.5D0/XL*DBXWD/ARGD
      DASDB2=-XD*( D2SDB2+DSRGDB*DSRGDB*XD/(XJ*ARGXS) )/(XL*ARGS)
      DADDB2=-XD*( D2BDB2+DBRGDB*DBRGDB*XD/(XJ*ARGXD) )/(XL*ARGD)
      DGDDB2=-0.5D0*GAMMA*(DASDB2+DADDB2)
  210 DGDDVB=-GAMMA*(DBARGS+DBARGD)
      DGSDVB=-2.0D0*GAMMA*DBARGS
      IF (XJ.LE.0.0D0) GO TO 220
      DDXWD=-DBXWD
      DGDVDS=-GAMMA*0.5D0/XL*DDXWD/ARGD
      GO TO 220
  215 GAMASD=GAMMA
      GAMASS=GAMMA
      GAMMAD=GAMMA
      DGDDVB=0.0D0
      DGSDVB=0.0D0
      DGDVDS=0.0D0
      DGDDB2=0.0D0
  220 VON=VBIN+GAMASD*SARG
C     WRITE(IOFILE,221) VON,VBIN,VBI,GAMASD,ARGSS,ARGSD,XJ
  221 FORMAT ('MSG1:'/1P7D10.2)
      VTH=VON
      VDSAT=0.0D0
  225 IF (XNFS.EQ.0.0D0.OR.COX.EQ.0.0D0) GO TO 230
      CFS=CHARGE*XNFS
      CDONCO=-(GAMASD*DSRGDB+DGDDVB*SARG)+FACTOR
      XN=1.0D0+CFS/COX*XW*XL+CDONCO
      VON=VON+VT*XN
C     WRITE (IOFILE,226) VON,CDONCO,XN,CFS,XD
  226 FORMAT(' MSG2:'/1P6D10.2)
      ARGG=1.0D0/(VT*XN)
      VGST=VGS-VON
      GO TO 300
  230 VGST=VGS-VON
      IF (VGS.GT.VON) GO TO 300
C
C  CUTOFF REGION
C
      GDS=0.0D0
      GO TO 1050
C
C  COMPUTE SOME MORE USEFUL QUANTITIES
C
  300 SARG3=SARG*SARG*SARG
      SBIARG=DSQRT(PHIB)
      GAMMAD=GAMASD
      DGDVBS=DGDDVB
      BODY=BARG*BARG*BARG-SARG3
      GDBDV=2.0D0*GAMMAD*(BARG*BARG*DBRGDB-SARG*SARG*DSRGDB)
      DODVBS=-FACTOR+DGDVBS*SARG+GAMMAD*DSRGDB
      IF (XNFS.EQ.0.0D0) GO TO 400
      IF (COX.EQ.0.0D0) GO TO 410
      DXNDVB=2.0D0*DGDVBS*DSRGDB+GAMMAD*D2SDB2+DGDDB2*SARG
      DODVBS=DODVBS+VT*DXNDVB
      DXNDVD=DGDVDS*DSRGDB
      DODVDS=DGDVDS*SARG+VT*DXNDVD
C
C  EVALUATE EFFECTIVE MOBILITY AND ITS DERIVATIVES
C
  400 IF (COX.LE.0.0D0) GO TO 410
      UDENOM=VGST
      IF (UDENOM.LE.VBP) GO TO 410
      UFACT=DEXP(UEXP*DLOG(VBP/UDENOM))
      UEFF=UO*UFACT
      DUDVGS=-UFACT*UEXP/UDENOM
      DUDVDS=0.0D0
      DUDVBS=UEXP*UFACT*DODVBS/VGST
      GO TO 500
  410 UFACT=1.0D0
      UEFF=UO
      DUDVGS=0.0D0
      DUDVDS=0.0D0
      DUDVBS=0.0D0
C
C     EVALUATE SATURATION VOLTAGE AND ITS DERIVATIVES ACCORDING TO
C     GROVE-FROHMAN EQUATION
C
  500 VGSX=VGS
      GAMMAD=GAMASD/ETA
      DGDVBS=DGDDVB
      IF (XNFS.NE.0.0D0.AND.COX.NE.0.0D0)
     1   VGSX=DMAX1(VGS,VON)
  505 IF (GAMMAD.LE.0.0D0) GO TO 535
      GAMMD2=GAMMAD*GAMMAD
      ARGV=(VGSX-VBIN)/ETA+PHI-VBS
      IF (ARGV.LE.0.0D0) GO TO 540
      ARG=DSQRT(1.0D0+4.0D0*ARGV/GAMMD2)
      VDSAT=(VGSX-VBIN)/ETA+GAMMD2*(1.0D0-ARG)/2.0D0
      VDSAT=DMAX1(VDSAT,0.0D0)
  510 IF (ICHARG.EQ.0) GO TO 530
      ARG1=GAMMD2/(ETA*ETA)
      ARG2=VDS-0.5D0*ARG1
      ARGSQ=(ARG2+0.5D0*ARG1+PHI-VBS)*ARG1
      IF (ARGSQ.GE.0.0D0) GO TO 515
      VPOF=VTH
      GO TO 520
  515 VPOF=VBIN+ETA*(ARG2+0.5D0*ARG1+DSQRT(ARGSQ))
  520 ARGV1=(VPOF-VBIN)/ETA+PHI-VBS
      IF (ARGV1.GT.0.0D0) GO TO 525
      VDSAT1=0.0D0
      GO TO 530
  525 ARG1=DSQRT(1.0D0+4.0D0*ARGV1/GAMMD2)
      VDSAT1=(VPOF-VBIN)/ETA+GAMMD2*(1.0D0-ARG1)/2.0D0
      VDSAT1=DMAX1(VDSAT1,0.0D0)
  530 DSDVGS=(1.0D0-1.0D0/ARG)/ETA
      DSDVBS=(GAMMAD*(1.0D0-ARG)+2.0D0*ARGV/(GAMMAD*ARG))/ETA*DGDVBS+
     1       1.0D0/ARG+FACTOR*DSDVGS
      GO TO 545
  535 VDSAT=DMAX1((VGSX-VBIN)/ETA,0.0D0)
      VPOF=DMAX1((ETA*VDS+VBIN),0.0D0)
      VDSAT1=DMAX1((VPOF-VBIN)/ETA,0.0D0)
      DSDVGS=1.0D0
      DSDVBS=0.0D0
      GO TO 545
  540 VDSAT=0.0D0
      VPOF=VTH
      VDSAT1=0.0D0
      DSDVGS=0.0D0
      DSDVBS=0.0D0
C
C     STORE VDSAT AS ABOVE IN VPOF (PINCH-OFF)
C
  545 IF (VMAX.LE.0.0D0) GO TO 600
C
C     EVALUATE SATURATION VOLTAGE AND ITS DERIVATIVES ACCORDING TO
C     BAUM'S THEORY OF SCATTERING VELOCITY SATURATION
C
      GAMMD2=GAMMAD*GAMMAD
      V1=(VGSX-VBIN)/ETA+PHI-VBS
      V2=PHI-VBS
      XV=VMAX*XL/UEFF
      A1=GAMMAD/0.75D0
      B1=-2.0D0*(V1+XV)
      C1=-2.0D0*GAMMAD*XV
      D1=2.0D0*V1*(V2+XV)-V2*V2-4.0D0/3.0D0*GAMMAD*SARG3
      A=-B1
      B=A1*C1-4.0D0*D1
      C=-D1*(A1*A1-4.0D0*B1)-C1*C1
      R=-A*A/3.0D0+B
      S=2.0D0*A*A*A/27.0D0-A*B/3.0D0+C
      R3=R*R*R
      S2=S*S
      P=S2/4.0D0+R3/27.0D0
      P0=DABS(P)
      P2=DSQRT(P0)
      IF (P.GE.0.0D0) GO TO 550
      RO=DSQRT(S2/4.0D0+P0)
      RO=DLOG(RO)/3.0D0
      RO=DEXP(RO)
      FI=DATAN(-2.0D0*P2/S)
      Y3=2.0D0*RO*DCOS(FI/3.0D0)-A/3.0D0
      GO TO 560
  550 P3=DEXP(DLOG(DABS(-S/2.0D0+P2))/3.0D0)
      P4=DEXP(DLOG(DABS(-S/2.0D0-P2))/3.0D0)
      Y3=P3+P4-A/3.0D0
  560 IKNT=0
      A3=DSQRT(A1*A1/4.0D0-B1+Y3)
      B3=DSQRT(Y3*Y3/4.0D0-D1)
      DO 570 I=1,4
      A4(I)=A1/2.0D0+SIG1(I)*A3
      B4(I)=Y3/2.0D0+SIG2(I)*B3
      DELTA4=A4(I)*A4(I)/4.0D0-B4(I)
      IF (DELTA4.LT.0.0D0) GO TO 570
      IKNT=IKNT+1
      X4(IKNT)=-A4(I)/2.0D0+DSQRT(DELTA4)
      IKNT=IKNT+1
      X4(IKNT)=-A4(I)/2.0D0-DSQRT(DELTA4)
  570 CONTINUE
      JKNT=0
      DO 580 J=1,IKNT
      IF (X4(J).LE.0.0D0) GO TO 580
      POLY4(J)=X4(J)*X4(J)*X4(J)*X4(J)+A1*X4(J)*X4(J)*X4(J)
      POLY4(J)=POLY4(J)+B1*X4(J)*X4(J)+C1*X4(J)+D1
      IF (DABS(POLY4(J)).GT.1.0D-6) GO TO 580
      JKNT=JKNT+1
      IF (JKNT.GT.1) GO TO 575
      XVALID=X4(J)
  575 IF (X4(J).GT.XVALID) GO TO 580
      XVALID=X4(J)
  580 CONTINUE
      IF (JKNT.GT.0) GO TO 590
      IVMFLG=IVMFLG+1
      GO TO 600
  590 VDSAT=XVALID*XVALID+VBS-PHI
C
C  EVALUATE EFFECTIVE CHANNEL LENGTH AND ITS DERIVATIVES
C
  600 IF (VDS.EQ.0.0D0) GO TO 610
      GAMMAD=GAMASD
      IF ((VBS-VDSAT).GT.0.0D0) GO TO 601
      BSARG=DSQRT(VDSAT-VBS+PHI)
      DBSRDB=-0.5D0/BSARG
      GO TO 602
  601 BSARG=SPHI/(1.0D0+0.5D0*(VBS-VDSAT)/PHI)
      DBSRDB=-0.5D0*BSARG*BSARG/SPHI3
  602 BODYS=BSARG*BSARG*BSARG-SARG3
      GDBDVS=2.0D0*GAMMAD*(BSARG*BSARG*DBSRDB-SARG*SARG*DSRGDB)
      IF (VMAX.GT.0.0D0) GO TO 603
      IF (XNSUB.EQ.0.0D0) GO TO 610
      IF (XLAMDA.GT.0.0D0) GO TO 610
      ARGV=(VDS-VDSAT)/4.0D0
      SARGV=DSQRT(1.0D0+ARGV*ARGV)
      ARG=DSQRT(ARGV+SARGV)
      XLFACT=XD/(XL*VDS)
      XLAMDA=XLFACT*ARG
      DLDSAT=VDS*XLFACT*ARG/(8.0D0*SARGV)
      GO TO 605
  603 ARGV=(VGSX-VBIN)/ETA-VDSAT
      XDV=XD/DSQRT(XNEFF)
      XLV=VMAX*XDV/(2.0D0*UEFF)
      VQCHAN=ARGV-GAMMAD*BSARG
      DQDSAT=-1.0D0+GAMMAD*DBSRDB
      VL=VMAX*XL
      DFUNDS=VL*DQDSAT-UEFF*VQCHAN
      DFUNDG=(VL-UEFF*VDSAT)/ETA
      DFUNDB=-VL*(1.0D0+DQDSAT-FACTOR/ETA)+
     1        UEFF*(GDBDVS-DGDVBS*BODYS/1.5D0)/ETA
      DSDVGS=-DFUNDG/DFUNDS
      DSDVBS=-DFUNDB/DFUNDS
      IF (XNSUB.EQ.0.0D0) GO TO 610
      IF (XLAMDA.GT.0.0D0) GO TO 610
      ARGV=DMAX1(VDS-VDSAT,0.0D0)
      XLS=DSQRT(XLV*XLV+ARGV)
      DLDSAT=XDV/(2.0D0*XLS)
      XLFACT=XDV/(XL*VDS)
      XLAMDA=XLFACT*(XLS-XLV)
      DLDSAT=DLDSAT/XL
  605 DLDVGS=DLDSAT*DSDVGS
      DLDVDS=-XLAMDA+DLDSAT
      DLDVBS=DLDSAT*DSDVBS
      GO TO 620
  610 DLDVGS=0.0D0
      DLDVDS=0.0D0
      DLDVBS=0.0D0
C
C     LIMIT CHANNEL SHORTENING AT PUNCH-THROUGH
C
  620 XWB=XD*SBIARG
      XLD=XL-XWB
      CLFACT=1.0D0-XLAMDA*VDS
      DLDVDS=-XLAMDA-DLDVDS
      XLEFF=XL*CLFACT
      DELTAL=XLAMDA*VDS*XL
      IF (XNSUB.EQ.0.0D0) XWB=0.25D-6
      IF (XLEFF.GE.XWB) GO TO 700
      XLEFF=XWB/(1.0D0+(DELTAL-XLD)/XWB)
      CLFACT=XLEFF/XL
      DFACT=XLEFF*XLEFF/(XWB*XWB)
      DLDVGS=DFACT*DLDVGS
      DLDVDS=DFACT*DLDVDS
      DLDVBS=DFACT*DLDVBS
C
C  EVALUATE EFFECTIVE BETA (EFFECTIVE KP)
C
  700 BETA1=BETA*UFACT/CLFACT
C
C  TEST FOR MODE OF OPERATION AND BRANCH APPROPRIATELY
C
      GAMMAD=GAMASD
      DGDVBS=DGDDVB
      IF (VDS.GT.1.0D-8) GO TO 730
      IF (VGS.GT.VON) GO TO 720
      IF ((XNFS.NE.0.0D0).AND.(COX.NE.0.0D0)) GO TO 710
      GDS=0.0D0
      GO TO 1050
C
  710 GDS=BETA1*(VON-VBIN-GAMMAD*SARG)*DEXP(ARGG*(VGS-VON))
      GO TO 1050
C
C
  720 GDS=BETA1*(VGS-VBIN-GAMMAD*SARG)
      GO TO 1050
C
  730 IF (VGS.GT.VON) GO TO 900
C
C  SUBTHRESHOLD REGION
C
      IF (VDSAT.GT.0.0D0) GO TO 830
      GDS=0.0D0
      IF (VGS.GT.VTH) GO TO 1020
      GO TO 1050
  830 VDSON=DMIN1(VDSAT,VDS)
      IF (VDS.LE.VDSAT) GO TO 850
      BARG=BSARG
      DBRGDB=DBSRDB
      BODY=BODYS
      GDBDV=GDBDVS
  850 CDSON=BETA1*((VON-VBIN-ETA*VDSON*0.5D0)*VDSON-GAMMAD*BODY/1.5D0)
      DIDVDS=BETA1*(VON-VBIN-ETA*VDSON-GAMMAD*BARG)
      GDSON=-CDSON*DLDVDS/CLFACT-BETA1*DGDVDS*BODY/1.5D0
      IF (VDS.LT.VDSAT) GDSON=GDSON+DIDVDS
      GBSON=-CDSON*DLDVBS/CLFACT
     1      +BETA1*(DODVBS*VDSON+FACTOR*VDSON-DGDVBS*BODY/1.5D0-GDBDV)
      IF (VDS.GT.VDSAT) GBSON=GBSON+DIDVDS*DSDVBS
      EXPG=DEXP(ARGG*(VGS-VON))
      CDRAIN=CDSON*EXPG
      GMW=CDRAIN*ARGG
      GM=GMW
      IF (VDS.GT.VDSAT) GM=GMW+DIDVDS*DSDVGS*EXPG
      GDS=GDSON*EXPG-GM*DODVDS-GMW*(VGS-VON)*DXNDVD/XN
      GMBS=GBSON*EXPG-GM*DODVBS-GMW*(VGS-VON)*DXNDVB/XN
      GO TO 1020
C
C
  900 IF (VDS.GT.VDSAT) GO TO 1000
C
C  LINEAR REGION
C
      CDRAIN=BETA1*((VGS-VBIN-ETA*VDS/2.0D0)*VDS-GAMMAD*BODY/1.5D0)
      ARG=CDRAIN*(DUDVGS/UFACT-DLDVGS/CLFACT)
      GM=ARG+BETA1*VDS
      ARG=CDRAIN*(DUDVDS/UFACT-DLDVDS/CLFACT)
      GDS=ARG+BETA1*(VGS-VBIN-ETA*VDS-
     1   GAMMAD*BARG-DGDVDS*BODY/1.5D0)
      ARG=CDRAIN*(DUDVBS/UFACT-DLDVBS/CLFACT)
      GMBS=ARG-BETA1*(GDBDV+DGDVBS*BODY/1.5D0-FACTOR*VDS)
      GO TO 1020
C
C  SATURATION REGION
C
 1000 CDRAIN=BETA1*((VGS-VBIN-ETA*VDSAT/2.0D0)*VDSAT-GAMMAD*BODYS/1.5D0)
      ARG=CDRAIN*(DUDVGS/UFACT-DLDVGS/CLFACT)
      GM=ARG+BETA1*VDSAT+
     1   BETA1*(VGS-VBIN-ETA*VDSAT-GAMMAD*BSARG)*DSDVGS
      GDS=-CDRAIN*DLDVDS/CLFACT-BETA1*DGDVDS*BODYS/1.5D0
      ARG=CDRAIN*(DUDVBS/UFACT-DLDVBS/CLFACT)
      GMBS=ARG-BETA1*(GDBDVS+DGDVBS*BODYS/1.5D0-FACTOR*VDSAT)+
     1     BETA1*(VGS-VBIN-ETA*VDSAT-GAMMAD*BSARG)*DSDVBS
C
C     COMPUTE CHARGES FOR "ON" REGION
C
 1020 IF (ICHARG.EQ.0) GO TO 1500
      IF (VGS.LE.VTH) GO TO 1070
      CALL MQSPOF(VDS,VBS,VGS,VPOF,VDSAT1,VTH,VBIN,GAMASD,
     1   QG,QC,QB,CGGB,CGDB,CGSB,CBGB,CBDB,CBSB)
      GO TO 2000
C
C  FINISH SPECIAL CASES
C
 1050 CDRAIN=0.0D0
      GM=0.0D0
      GMBS=0.0D0
 1070 XQC=XQCO
      IF (ICHARG.EQ.0) GO TO 1500
      CALL MOSQ2(VDS,VBS,VGS,VDSAT,VTH,VBIN,GAMASD,COX,PHI,
     1   QG,QC,QB,CGGB,CGDB,CGSB,CBGB,CBDB,CBSB)
      QSPOF=0.0D0
      GO TO 2000
C
C  FINISHED
C
 1500 QG=0.0D0
      QB=0.0D0
      QC=0.0D0
      QSPOF=0.0D0
 2000 RETURN
      END
      SUBROUTINE MOSEQ3(VDS,VBS,VGS,GM,GDS,GMBS,
     1   QG,QC,QB,CGGB,CGDB,CGSB,CBGB,CBDB,CBSB)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE EVALUATES THE DRAIN CURRENT, ITS DERIVATIVES AND
C     THE CHARGES ASSOCIATED WITH THE GATE, CHANNEL AND BULK
C     FOR MOSFETS BASED ON SEMI-EMPIRICAL EQUATIONS
C
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=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
      EQUIVALENCE (XLAMDA,ALPHA),(VBP,THETA),(UEXP,ETA),(UTRA,XKAPPA)
      DATA COEFF0/0.0631353D0/,COEFF1/0.8013292D0/,COEFF2/-0.01110777D0/
C
C     ICHARG=1 CAUSES CHARGES TO BE COMPUTED
C     ICHARG=0 BYPASSES THE COMPUTATION OF CHARGES
C
C     ICHARG=1
C     IF (MODE.NE.1) GO TO 10
C     ICHARG=0
C     IF (MODEDC.EQ.2.AND.NOSOLV.NE.0) ICHARG=1
C     IF (INITF.EQ.4) ICHARG=1
C
C     REFERENCE CDRAIN EQUATIONS TO SOURCE AND
C     CHARGE EQUATIONS TO BULK
C
10    CONTINUE
      ICHARG=0
      VGB=VGS-VBS
      VFB=VBI-PHI
      VDSAT=0.0D0
      QG=0.0D0
      QB=0.0D0
      QC=0.0D0
      CGDB=0.0D0
      CBDB=0.0D0
      ONXL=1.0D0/XL
      ETA=ETA/(XL*XL*XL)
C
C.....SQUARE ROOT TERM
C
      IF ( VBS.GT.0.0D0 ) GO TO 120
      PHIBS=PHI-VBS
      SQPHBS=DSQRT(PHIBS)
      DSQDVB=-0.5D0/SQPHBS
      GO TO 200
120   CONTINUE
      SQPHIS=DSQRT(PHI)
      SQPHS3=PHI*SQPHIS
      SQPHBS=SQPHIS/(1.0D0+VBS/(PHI+PHI))
      PHIBS=SQPHBS*SQPHBS
      DSQDVB=-PHIBS/(SQPHS3+SQPHS3)
C
C.....SHORT CHANNEL EFFECT FACTOR
C
200   CONTINUE
      IF ( (XJ.EQ.0.0D0).OR.(XD.EQ.0.0D0) ) GO TO 210
      WPS=XD*SQPHBS
      ONXJ=1.0D0/XJ
      XJONXL=XJ*ONXL
      DJONXJ=XLD*ONXJ
      WPONXJ=WPS*ONXJ
      WCONXJ=COEFF0+COEFF1*WPONXJ+COEFF2*WPONXJ*WPONXJ
      WCS=WCONXJ*XJ
      ARGA=WCONXJ+DJONXJ
      ARGC=WPONXJ/(1.0D0+WPONXJ)
      ARGB=DSQRT(1.0D0-ARGC*ARGC)
      FSHORT=1.0D0-XJONXL*(ARGA*ARGB-DJONXJ)
      DWPDVB=XD*DSQDVB
      DADVB=(COEFF1+COEFF2*(WPONXJ+WPONXJ))*DWPDVB*ONXJ
      DBDVB=-ARGC*ARGC*(1.0D0-ARGC)*DWPDVB/(ARGB*WPS)
      DFSDVB=-XJONXL*(DADVB*ARGB+ARGA*DBDVB)
      GO TO 220
210   CONTINUE
      FSHORT=1.0D0
      DFSDVB=0.0D0
      WCS=0.05D-6
C
C.....BODY EFFECT
C
220   CONTINUE
      GAMMAS=GAMMA*FSHORT
      FBODYS=0.5D0*GAMMAS/(SQPHBS+SQPHBS)
      FBODY=FBODYS+FNARRW
      ONFBDY=1.0D0/(1.0D0+FBODY)
      DFBDVB=-FBODYS*DSQDVB/SQPHBS+FBODYS*DFSDVB/FSHORT
      QBONCO=GAMMAS*SQPHBS+FNARRW*PHIBS
      DQBDVB=GAMMAS*DSQDVB+GAMMA*DFSDVB*SQPHBS-FNARRW
C
C.....STATIC FEEDBACK EFFECT
C
      VBIX=VBI-ETA*VDS
C
C.....THRESHOLD VOLTAGE
C
      VTH=VBIX+QBONCO
      DVTDVD=-ETA
      DVTDVB=DQBDVB
C
C.....JOINT WEAK INVERSION AND STRONG INVERSION
C
      VON=VTH
      IF ( XNFS.EQ.0.0D0 ) GO TO 250
           CSONCO=CHARGE*XNFS*XL*XW/COX
           CDONCO=QBONCO/(PHIBS+PHIBS)
           XN=1.0D0+CSONCO+CDONCO
           VON=VTH+VT*XN
           DXNDVB=DQBDVB/(PHIBS+PHIBS)-QBONCO*DSQDVB/(PHIBS*SQPHBS)
           DVODVD=DVTDVD
           DVODVB=DVTDVB+VT*DXNDVB
           GO TO 300
C
C.....CUTOFF REGION
C
250   CONTINUE
      IF ( VGS.GT.VON ) GO TO 300
      CDRAIN=0.0D0
      GM=0.0D0
      GDS=0.0D0
      GMBS=0.0D0
      IF ( ICHARG.NE.0 ) GO TO 800
      GO TO 1000
C
C.....DEVICE IS ON
C
300   CONTINUE
      VGSX=DMAX1(VGS,VON)
C
C.....MOBILITY MODULATION BY GATE VOLTAGE
C
      ONFG=1.0D0+THETA*(VGSX-VTH)
      FGATE=1.0D0/ONFG
      US=UO*FGATE
      DFGDVG=-THETA*FGATE*FGATE
      DFGDVD=-DFGDVG*DVTDVD
      DFGDVB=-DFGDVG*DVTDVB
C
C.....SATURATION VOLTAGE
C
      VDSAT=(VGSX-VTH)*ONFBDY
      VPOF=VDSAT
      IF ( VMAX.GT.0.0D0 ) GO TO 310
      DVSDVG=ONFBDY
      DVSDVD=-DVSDVG*DVTDVD
      DVSDVB=-DVSDVG*DVTDVB-VDSAT*DFBDVB*ONFBDY
      GO TO 400
  310 VDSC=XL*VMAX/US
      ONVDSC=1.0D0/VDSC
      ARGA=(VGSX-VTH)*ONFBDY
      ARGB=DSQRT(ARGA*ARGA+VDSC*VDSC)
      VDSAT=ARGA+VDSC-ARGB
      DVSDGA=(1.0D0-ARGA/ARGB)*ONFBDY
      DVSDVG=DVSDGA-(1.0D0-VDSC/ARGB)*VDSC*DFGDVG*ONFG
      DVSDVD=-DVSDVG*DVTDVD
      DVSDVB=-DVSDVG*DVTDVB-ARGA*DVSDGA*DFBDVB
C
C.....CURRENT FACTORS IN LINEAR REGION
C
400   CONTINUE
      VDSX=DMIN1(VDS,VDSAT)
      IF ( VDSX.EQ.0.0D0 ) GO TO 900
      CDO=VGSX-VTH-0.5D0*(1.0D0+FBODY)*VDSX
      DCODVG=1.0D0
      IF (VDS.LT.VDSAT) DCODVD=-DVTDVD-0.5D0*(1.0D0+FBODY)
      DCODVB=-DVTDVB-0.5D0*DFBDVB*VDSX
C
C.....NORMALIZED DRAIN CURRENT
C
410   CONTINUE
      CDNORM=CDO*VDSX
      GM=VDSX
      GDS=VGSX-VTH-(1.0D0+FBODY+DVTDVD)*VDSX
      GMBS=DCODVB*VDSX
C
C.....DRAIN CURRENT WITHOUT VELOCITY SATURATION EFFECT
C
      CD1=BETA*CDNORM
      BETA=BETA*FGATE
      CDRAIN=BETA*CDNORM
      GM=BETA*GM+DFGDVG*CD1
      GDS=BETA*GDS+DFGDVD*CD1
      GMBS=BETA*GMBS
C
C.....VELOCITY SATURATION FACTOR
C
      IF ( VMAX.EQ.0.0D0 ) GO TO 500
      FDRAIN=1.0D0/(1.0D0+VDSX*ONVDSC)
      FD2=FDRAIN*FDRAIN
      ARGA=FD2*VDSX*ONVDSC*ONFG
      DFDDVG=-DFGDVG*ARGA
      DFDDVD=-DFGDVD*ARGA-FD2*ONVDSC
      DFDDVB=-DFGDVB*ARGA
C
C.....DRAIN CURRENT
C
      GM=FDRAIN*GM+DFDDVG*CDRAIN
      GDS=FDRAIN*GDS+DFDDVD*CDRAIN
      GMBS=FDRAIN*GMBS+DFDDVB*CDRAIN
      CDRAIN=FDRAIN*CDRAIN
      BETA=BETA*FDRAIN
C
C.....CHANNEL LENGTH MODULATION
C
500   CONTINUE
      IF ( VDS.LE.VDSAT ) GO TO 700
      IF ( VMAX.EQ.0.0D0 ) GO TO 510
      IF (ALPHA.EQ.0.0D0) GO TO 700
      CDSAT=CDRAIN
      GDSAT=CDSAT*(1.0D0-FDRAIN)*ONVDSC
      GDSAT=DMAX1(1.0D-12,GDSAT)
      GDONCD=GDSAT/CDSAT
      GDONFD=GDSAT/(1.0D0-FDRAIN)
      GDONFG=GDSAT*ONFG
      DGDVG=GDONCD*GM-GDONFD*DFDDVG+GDONFG*DFGDVG
      DGDVD=GDONCD*GDS-GDONFD*DFDDVD+GDONFG*DFGDVD
      DGDVB=GDONCD*GMBS-GDONFD*DFDDVB+GDONFG*DFGDVB
C
      EMAX=CDSAT*ONXL/GDSAT
      EMONCD=EMAX/CDSAT
      EMONGD=EMAX/GDSAT
      DEMDVG=EMONCD*GM-EMONGD*DGDVG
      DEMDVD=EMONCD*GDS-EMONGD*DGDVD
      DEMDVB=EMONCD*GMBS-EMONGD*DGDVB
C
      ARGA=0.5D0*EMAX*ALPHA
      ARGC=XKAPPA*ALPHA
      ARGB=DSQRT(ARGA*ARGA+ARGC*(VDS-VDSAT))
      DELXL=ARGB-ARGA
      DLDVD=ARGC/(ARGB+ARGB)
      DLDEM=0.5D0*(ARGA/ARGB-1.0D0)*ALPHA
      DDLDVG=DLDEM*DEMDVG
      DDLDVD=DLDEM*DEMDVD-DLDVD
      DDLDVB=DLDEM*DEMDVB
      GO TO 520
510   CONTINUE
      DELXL=DSQRT(XKAPPA*(VDS-VDSAT)*ALPHA)
      DLDVD=0.5D0*DELXL/(VDS-VDSAT)
      DDLDVG=0.0D0
      DDLDVD=-DLDVD
      DDLDVB=0.0D0
C
C.....PUNCH THROUGH APPROXIMATION
C
520   CONTINUE
      IF ( DELXL.LE.(0.5D0*XL) ) GO TO 600
      WCS2=WCS*WCS
      DELXL=XL-(XL**2/(4.0D0*DELXL))
      ARGA=4.0D0*(XL-DELXL)**2/XL**2
      DDLDVG=DDLDVG*ARGA
      DDLDVD=DDLDVD*ARGA
      DDLDVB=DDLDVB*ARGA
       DLDVD= DLDVD*ARGA
C
C.....SATURATION REGION
C
600   CONTINUE
      DLONXL=DELXL*ONXL
      XLFACT=1.0D0/(1.0D0-DLONXL)
      CDRAIN=CDRAIN*XLFACT
      DIDDL=CDRAIN/(XL-DELXL)
      GM=GM*XLFACT+DIDDL*DDLDVG
      GDS0=GDS*XLFACT+DIDDL*DDLDVD
      GMBS=GMBS*XLFACT+DIDDL*DDLDVB
      GM=GM+GDS0*DVSDVG
      GMBS=GMBS+GDS0*DVSDVB
      GDS=GDS0*DVSDVD+DIDDL*DLDVD
C
C.....FINISH STRONG INVERSION CASE
C
700   CONTINUE
      IF ( VGS.GE.VON ) GO TO 750
C
C.....WEAK INVERSION
C
                ONXN=1.0D0/XN
                ONDVT=ONXN/VT
                WFACT=DEXP( (VGS-VON)*ONDVT )
                CDRAIN=CDRAIN*WFACT
                GMS=GM*WFACT
                GMW=CDRAIN*ONDVT
                GM=GMW
                IF (VDS.GT.VDSAT) GM=GM+GDS0*DVSDVG*WFACT
                GDS=GDS*WFACT+(GMS-GMW)*DVODVD
                GMBS=GMBS*WFACT+(GMS-GMW)*DVODVB
     1                         -GMW*(VGS-VON)*ONXN*DXNDVB
C
C.....CHARGE COMPUTATION
C
  750 CONTINUE
      IF (ICHARG.EQ.0) GO TO 1000
      IF (VGS.LE.VTH) GO TO 800
      CALL MQSPOF(VDS,VBS,VGS,VPOF,VDSAT1,VTH,VBIN,GAMASD,
     1   QG,QC,QB,CGGB,CGDB,CGSB,CBGB,CBDB,CBSB)
      GO TO 2000
C
C.....CHARGE COMPUTATION FOR VGS<VTH
C
800   CONTINUE
      XQC=XQCO
      CALL MOSQ3(VDS,VBS,VPOF,VDSAT1,VTH,VBIN,GAMASD,COX,PHI,
     1   QG,QC,QB,CGGB,CGDB,CGSB,CBGB,CBDB,CBSB)
      QSPOF=0.0D0
      GO TO 2000
C
C.....SPECIAL CASE OF VDS=0.0D0
C
900   CONTINUE
      BETA=BETA*FGATE
      CDRAIN=0.0D0
      GM=0.0D0
      GDS=BETA*(VGSX-VTH)
      GMBS=0.0D0
           IF ( (XNFS.NE.0.0D0).AND.(VGS.LT.VON) )
     1          GDS=GDS*DEXP((VGS-VON)/(VT*XN))
      IF (ICHARG.EQ.0) GO TO 1000
      CALL MOSQ3(VDS,VBS,VPOF,VDSAT1,VTH,VBIN,GAMASD,COX,PHI,
     1   QG,QC,QB,CGGB,CGDB,CGSB,CBGB,CBDB,CBSB)
1000  QSPOF=0.0D0
C
C.....DONE
C
 2000 RETURN
      END
      SUBROUTINE MOSCAP(VGD,VGS,VGB,COVLGD,COVLGS,COVLGB,
     1   CAPBD,CAPBS,CGGB,CGDB,CGSB,CBGB,CBDB,CBSB,
     2   GCGGB,GCGDB,GCGSB,GCBGB,GCBDB,GCBSB,
     3   GCDGB,GCDDB,GCDSB,GCSGB,GCSDB,GCSSB,
     4   QGATE,QCHAN,QBULK,QDRN,QSRC)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C     COMPUTE EQUIVALENT CONDUCTANCES
C     DIVIDE UP THE CHANNEL CHARGE (1-XQC)/XQC TO SOURCE AND DRAIN
C
      GCG=(CGGB+CBGB)*AG(1)
      GCD=(CGDB+CBDB)*AG(1)
      GCS=(CGSB+CBSB)*AG(1)
      GCGXD=-XQC*GCG
      GCGXS=-(1.0D0-XQC)*GCG
      GCDXD=-XQC*GCD
      GCDXS=-(1.0D0-XQC)*GCD
      GCSXD=-XQC*GCS
      GCSXS=-(1.0D0-XQC)*GCS
      GCDGB=GCGXD-COVLGD*AG(1)
      GCDDB=GCDXD+(CAPBD+COVLGD)*AG(1)
      GCDSB=GCSXD
      GCSGB=GCGXS-COVLGS*AG(1)
      GCSDB=GCDXS
      GCSSB=GCSXS+(CAPBS+COVLGS)*AG(1)
      GCGGB=(CGGB+COVLGD+COVLGS+COVLGB)*AG(1)
      GCGDB=(CGDB-COVLGD)*AG(1)
      GCGSB=(CGSB-COVLGS)*AG(1)
      GCBGB=(CBGB-COVLGB)*AG(1)
      GCBDB=(CBDB-CAPBD)*AG(1)
      GCBSB=(CBSB-CAPBS)*AG(1)
C
C     COMPUTE TOTAL TERMINAL CHARGES
C
      QGD=COVLGD*VGD
      QGS=COVLGS*VGS
      QGB=COVLGB*VGB
      QGATE=QGATE+QGD+QGS+QGB
      QBULK=QBULK-QGB
      QDRN=XQC*QCHAN-QGD
      QSRC=(1.0D0-XQC)*QCHAN-QGS
C
C     FINISHED
C
      RETURN
      END
      SUBROUTINE CMEYER (VGS0,VGD0,VGB0,VON0,VDSAT0,VGS1,VGD1,VGB1,
     1   COVLGS,COVLGD,COVLGB,CGS0,CGD0,CGB0,CGS1,CGD1,CGB1)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE COMPUTES THE MOSFET OVERLAP CAPACITANCES AS FUNCTIONS
C OF THE DEVICE TERMINAL VOLTAGES.
C
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=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=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
      INDAX=1
      VGS=VGS1
      VGD=VGD1
      VGB=VGB1
      VONS=VON
      VBS=VGS-VGB
      VDBSAT=VDSAT-VBS
      VDB=VGB-VGD
   10 VDS=VGS-VGD
      VGBT=VGS-VONS
      IF (VGBT.GT.-PHI) GO TO 100
      CGB=COX+COVLGB
      CGD=COVLGD
      CGS=COVLGS
      GO TO 430
C
C
  100 IF (VGBT.GT.-PHI/2.0D0) GO TO 200
      CGB=-VGBT*COX/PHI+COVLGB
      CGD=COVLGD
      CGS=COVLGS
      GO TO 430
C
C
  200 IF (VGBT.GT.0.0D0) GO TO 300
      CGB=-VGBT*COX/PHI+COVLGB
      CGD=COVLGD
      CGS=COX/(7.5D-1*PHI)*VGBT+COX/1.5D0+COVLGS
      GO TO 430
C
C
  300 IF (VDBSAT.GT.VDB) GO TO 400
      CGB=COVLGB
      CGD=COVLGD
      CGS=COX/1.5D0+COVLGS
      GO TO 430
C
C
  400 VDDIF=2.0D0*VDBSAT-VDB
      VDDIF1=VDBSAT-VDB-1.0D-12
      VDDIF2=VDDIF*VDDIF
      CGD=COX*(1.0D0-VDBSAT*VDBSAT/VDDIF2)/1.5D0+COVLGD
      CGS=COX*(1.0D0-VDDIF1*VDDIF1/VDDIF2)/1.5D0+COVLGS
      CGB=COVLGB
C
C
  430 GO TO (440,560), INDAX
  440 INDAX=2
      CGS1=CGS
      CGD1=CGD
      CGB1=CGB
      VGS=VGS0
      VGD=VGD0
      VGB=VGB0
      VONS=VON0
      VBS=VGS-VGB
      VDBSAT=VDSAT0-VBS
      VDB=VGB-VGD
      GO TO 10
C
C
  560 CGS0=CGS
      CGD0=CGD
      CGB0=CGB
C
C  FINISHED
C
 1000 RETURN
      END
      SUBROUTINE MOSQ2(VDS,VBS,VGS,VDSAT,VTH,VBIN,GAMASD,COX,PHI,
     1   QG,QC,QB,CGGB,CGDB,CGSB,CBGB,CBDB,CBSB)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     INITIALIZE CHARGES;
C     CHANGE REFERENCE VOLTAGES FOR CHARGE COMPUTATION
C
      QG=0.0D0
      QB=0.0D0
      VBD=VBS-VDS
      VGB=VGS-VBS
      VD=DMAX1(PHI-VBD,1.0D-8)
      VS=DMAX1(PHI-VBS,1.0D-8)
      VG=VGB-VBIN+PHI
      VSP5=DSQRT(VS)
C
C     DETERMINE OPERATING REGION
C
      IF (VGS.LE.VTH) GO TO 1100
C
C     COMPUTE CHARGES FOR "ON" REGION
C
 1020 VSAT=VDSAT+VS
      VS2=VS*VS
      VS3=VS2*VS
      VS5=VS3*VS2
      VS1P5=VS*VSP5
      VS2P5=VS1P5*VS
 1025 IF (VD.GE.VSAT) GO TO 1035
      VE=VD
 1030 DVEDVD=1.0D0
      DVEDVG=0.0D0
      GO TO 1040
 1035 VE=VSAT
      DVEDVD=0.0D0
      DVEDVG=0.0D0
 1040 VE2=VE*VE
      VE3=VE2*VE
      VE5=VE2*VE3
      VEP5=DSQRT(VE)
      VE1P5=VE*VEP5
      VE2P5=VE1P5*VE
      TERM0=VE+VS
      TERM1=VEP5+VSP5
      TERM2=VEP5*VSP5
      TERM3=VE2+VS2
      TERM4=VE*VS
      TERM5=TERM0*TERM1
      TERM6=(TERM3+TERM4)+TERM2*TERM0
      TERM7=(TERM3+TERM4)*TERM1
      TERM10=VEP5+0.5D0*VSP5
      TERM11=1.5D0*VE+VSP5*TERM10
      TERM12=2.0D0*VE1P5+VSP5*TERM11
      TERM20=0.5D0*VEP5+VSP5
      TERM21=1.5D0*VS+VEP5*TERM20
      TERM22=2.0D0*VS1P5+VEP5*TERM21
      ARGN=0.5D0*VG*TERM5-0.4D0*GAMASD*TERM6-TERM7/3.0D0
      ARGD=VG*TERM1-GAMASD*(TERM0+TERM2)/1.5D0-0.5D0*TERM1*TERM0
      ARGD2=ARGD*ARGD
      QG=COX*(VG-ARGN/ARGD)
      DGNDVE=0.5D0*VG*TERM11-0.4D0*GAMASD*TERM12-
     1   (2.5D0*VE2+VSP5*TERM12)/3.0D0
      DDDVE=0.5D0*VG-GAMASD*TERM10/1.5D0-0.5D0*TERM11
      DQGDVE=-COX/ARGD*(DGNDVE-(VG-QG/COX)*DDDVE)
      DGNDVS=0.5D0*VG*TERM21-0.4D0*GAMASD*TERM22-
     1   (2.5D0*VS2+VEP5*TERM22)/3.0D0
      DDDVS=0.5D0*VG-GAMASD*TERM20/1.5D0-0.5D0*TERM21
      CGDB=-COX/(ARGD*VEP5)*(DGNDVE-(VG-QG/COX)*DDDVE)*DVEDVD
      CGSB=-COX/(ARGD*VSP5)*(DGNDVS-(VG-QG/COX)*DDDVS)
      CGGB=COX*(1.0D0-TERM1/ARGD*(0.5D0*TERM0-VG+QG/COX))
      ARGN=VG*(TERM0+TERM2)/1.5D0-0.5D0*GAMASD*TERM5-0.4D0*TERM6
      DGNDVE=VG*TERM10/1.5D0-0.5D0*GAMASD*TERM11-0.4D0*TERM12
      DGNDVS=VG*TERM20/1.5D0-0.5D0*GAMASD*TERM21-0.4D0*TERM22
      QB=-GAMASD*COX*ARGN/ARGD
      CBDB=-COX/(VEP5*ARGD)*(QB/COX*DDDVE+GAMASD*DGNDVE)*DVEDVD
      CBSB=-COX/(VSP5*ARGD)*(QB/COX*DDDVS+GAMASD*DGNDVS)
      CBGB=-COX/ARGD*(GAMASD*(TERM0+TERM2)/1.5D0+QB/COX*TERM1)
      GO TO 2000
C
C  FINISH SPECIAL CASES
C
 1100 IF (VG.GT.0.0D0) GO TO 1110
      QG=COX*VG
      CGGB=COX
      GO TO 1120
 1110 GAMMA2=GAMASD*0.5D0
      SQARG=DSQRT(GAMMA2*GAMMA2+VG)
      QG=GAMASD*COX*(SQARG-GAMMA2)
      CGGB=0.5D0*COX*GAMASD/SQARG
 1120 QB=-QG
      CBGB=-CGGB
      CGDB=0.0D0
      CGSB=0.0D0
      CBDB=0.0D0
      CBSB=0.0D0
C
C  FINISHED
C
 2000 QC=-(QG+QB)
 2050 RETURN
      END
      SUBROUTINE MQSPOF(VDS,VBS,VGS,VPOF,VDSAT1,VTH,VBIN,GAMASD,
     $QG,QC,QB,CGGB,CGDB,CGSB,CBGB,CBDB,CBSB)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
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
C     VDSAT1=DMAX1(VDS,VDSAT1)+1.0D-3
      IF( LEV .EQ. 3 ) GOTO 50
      IF( LEV .NE. 2 ) GOTO 1000
      CALL MOSQ2(VDS,VBS,VGS,VDSAT,VTH,VBIN,GAMASD,COX,PHI,
     $QG,QC,QB,CGGB,CGDB,CGSB,CBGB,CBDB,CBSB)
      IF (VDS.GE.VDSAT) GO TO 80
      CALL MOSQ2(VDS,VBS,VPOF,VDSAT1,VTH,VBIN, GAMASD,COX,PHI,
     $QG1,QCPOF1,QB1,CGGB1,CGDB1,CGSB1,CBGB1,CBDB1,CBSB1)
      CALL MOSQ2(VDSAT,VBS,VGS,VDSAT,VTH,VBIN, GAMASD,COX,PHI,
     $QG2,QCPOF2,QB2,CGGB2,CGDB2,CGSB2,CBGB2,CBDB2,CBSB2)
      GOTO 75
   50 CALL MOSQ3(VDS,VBS,VPOF,VDSAT1,VTH,VBIN, GAMASD,COX,PHI,
     $QG,QCPOF,QB,CGGB1,CGDB1,CGSB1,CBGB1,CBDB1,CBSB1)
      CALL MOSQ3(VDS,VBS,VGS,VDSAT,VTH,VBIN,GAMASD,COX,PHI,
     $QG,QC,QB,CGGB,CGDB,CGSB,CBGB,CBDB,CBSB)
   75 IF(VGS.GT.VPOF. OR .VDS.LT.VDSAT) GOTO 100
   80 XQC = XQCO
      GOTO 1000
C
C     TANGENTIAL LIMITING OF QS
C
  100 CSGB1=-(1.0D0-XQCO)*(CGGB1+CBGB1)
      QS=CSGB1*(VGS-VPOF)
     1   +(1.0D0-XQCO)*QCPOF1
C      write(IOFILE,*) "VGS,VDS,QC,CGGB,CGDB,CGSB,CBGB,CBDB,CBSB =",
C    1   vgs,vds,qc,cggb,cgdb,cgsb,cbgb,cbdb,cbsb
C      write(IOFILE,*) "VPOF,VDSAT,VDSAT1,QCPOF1,QCPOF2,QS,CSGB1 =",
C    1   vpof,vdsat,vdsat1,qcpof1,qcpof2,qs,csgb1
      QSPOF2=(1.0D0-XQCO)*QCPOF2
      IF (DABS(QS) .LT. DABS(QSPOF2)) QS=QSPOF2
      IF( DABS( QS ) .GE. 0.5D0 * DABS( QC ) ) GOTO 200
C     CSDB=-0.25D0*(CGDB+CBDB)
C     QS=QS+CSDB*(VDSAT-VDS)
C     XQC=DMIN1(0.5D0,(QC-QS)/QC)
      XQC=0.5D0
C      write(IOFILE,*) "QS,XQC =",
C    1   qs,xqc
      GOTO 1000
  200 QD = QC - QS
      XQC = QD / QC
C     write(IOFILE,*) "200,QS,QD,XQC =",
C    1   qs,qd,xqc
C
C     CONSTANT LIMITING OF QS
C
C 100 QDPOF = QCPOF * XQCO
C     QSPOF = QCPOF - QDPOF
C     IF( DABS( QSPOF ) .GT. 0.5D0 * DABS( QC ) ) GOTO 200
C     XQC = 0.5D0
C     GOTO 1000
C 200 QD = QC - QSPOF
C     QS = QSPOF
C     XQC = QD / QC
 1000 RETURN
      END
      SUBROUTINE MOSQ3(VDS,VBS,VGS,VDSAT,VTH,VBIN,GAMASD,COX,PHI,
     1   QG,QC,QB,CGGB,CGDB,CGSB,CBGB,CBDB,CBSB)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
      EQUIVALENCE (XLAMDA,ALPHA),(VBP,THETA),(UEXP,ETA),(UTRA,XKAPPA)
C
C     CHARGE EQUATIONS ARE REFERENCED TO BULK
C
      VGB=VGS-VBS
      VFB=VBI-PHI
      ONXL=1.0D0/XL
      PHIBS=SQPHBS*SQPHBS
C
C     BODY EFFECT
C
      GAMMAS=GAMMA*FSHORT
      FBODYS=GAMMAS/(SQPHBS+SQPHBS)*0.5D0
      FBODY=FBODYS+FNARRW
      ONFBDY=1.0D0/(1.0D0+FBODY)
      DFBDVB=-FBODYS*DSQDVB/SQPHBS+FBODYS*DFSDVB/FSHORT
      QBONCO=GAMMAS*SQPHBS+FNARRW*PHIBS
      DQBDVB=GAMMAS*DSQDVB+GAMMA*DFSDVB*SQPHBS-FNARRW
C
C.....STATIC FEEDBACK EFFECT
C
      VBIX=VBI-ETA*VDS
C
C.....THRESHOLD VOLTAGE
C
      VTH=VBIX+QBONCO
      DVTDVD=-ETA
      DVTDVB=DQBDVB
C
C     BRANCH ACCORDING TO REGION OF OPERATION
C
      IF (VGS.LE.VTH) GO TO 800
      VGSX=DMAX1(VGS,VON)
C
C     BRANCH ON VDS=0.0D0
C
      VDSX=DMIN1(VDS,VDSAT)
      IF ( VDSX.EQ.0.0D0 ) GO TO 900
      CDO=VGSX-VTH-0.5D0*(1.0D0+FBODY)*VDSX
      DCODVG=1.0D0
      IF (VDS.LT.VDSAT) DCODVD=-DVTDVD-0.5D0*(1.0D0+FBODY)
      DCODVB=-DVTDVB-0.5D0*DFBDVB*VDSX
C
C.....CHARGE TERMS
C
420   CONTINUE
      ARGA=(1.0D0+FBODY)*VDSX*VDSX/(12.0D0*CDO)
      DADCO=-ARGA/CDO
      IF (VDS.LT.VDSAT) DADVD=ARGA/VDSX
      DADFB=ARGA*ONFBDY
C
C.....GATE CHARGE
C
      QG=COX*(VGS-VBIX-0.5D0*VDSX+ARGA)
      CGGB=COX*(1.0D0+DADCO*DCODVG)
      IF (VDS.LT.VDSAT) CGDB=COX*(-DVTDVD-0.5D0+DADVD+DADCO*DCODVD)
      CGSB=-CGGB-CGDB-COX*(DADCO*DCODVB+DADFB*DFBDVB)
C
C.....BULK CHARGE
C
      ARGA=ARGA*FBODY
      DADCO=DADCO*FBODY
      IF (VDS.LT.VDSAT) DADVD=DADVD*FBODY
      DADFB=DADFB*(1.0D0+FBODY+FBODY)
C
      QB=-COX*(QBONCO+0.5D0*FBODY*VDSX-ARGA)
      CBGB=COX*DADCO*DCODVG
      IF (VDS.LT.VDSAT) CBDB=-COX*(0.5D0*FBODY-DADVD-DADCO*DCODVD)
      CBSB=-CBGB-CBDB
     1          +COX*(DQBDVB+(0.5D0*VDSX-DADFB)*DFBDVB-DADCO*DCODVB)
      GO TO 1000
C
C.....CHARGE TERMS OF VGS<VTH
C
800   CONTINUE
      IF ( VGB.GT.VFB ) GO TO 810
      QG=COX*(VGB-VFB)
      CGGB=COX
      GO TO  820
810   CONTINUE
      GAMMA2=GAMMAS*0.5D0
      ARGA=DSQRT(GAMMA2*GAMMA2+(VGB-VFB))
      QG=GAMMAS*COX*(ARGA-GAMMA2)
      CGGB=0.5D0*COX*GAMMAS/ARGA
820   CONTINUE
      QB=-QG
      CBGB=-CGGB
      CGDB=0.0D0
      CGSB=0.0D0
      CBDB=0.0D0
      CBSB=0.0D0
      GO TO 1000
C
C     SPECIAL CASE VDS=0.0D0
C
  900 QG=COX*(VGS-VBI)
      QB=-COX*QBONCO
      CGGB=COX
      CGDB=-COX*(0.5D0+DVTDVD)
      CGSB=-COX*(0.5D0-DVTDVB)
      CBGB=0.0D0
      CBDB=-0.5D0*COX*FBODY
      CBSB=COX*(DQBDVB+0.5D0*FBODY)
C
C     DONE
C
 1000 QC=-(QG+QB)
      RETURN
      END
C SPICE VERSION 2G.6  SCCSID=dcop.ma 3/15/83
      SUBROUTINE DCOP
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      REAL T1, T2
C
C     THIS ROUTINE PRINTS OUT THE OPERATING POINTS OF THE NONLINEAR
C CIRCUIT ELEMENTS.
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=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=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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
      LOGICAL MEMPTR
C
C
      DIMENSION OPTITL(4)
      DIMENSION ANAM(12),AV1(12),AI1(12),REQ(12)
      DIMENSION AMOD(12),VD(12),CAP(12)
      DIMENSION CB(12),CC(12),VBE(12),VBC(12),VCE(12),RPI(12),
     1   RO(12),CPI(12),CMU(12),BETADC(12),BETAAC(12),FT(12),
     2   CCS(12),CBX(12),RX(12)
      DIMENSION CG(12),VGS(12),VDS(12),GDS(12),VBS(12),CBD(12),CBS(12),
     2  CGSOV(12),CGDOV(12),CGBOV(12),VTH(12),VDSAT(12),CD(12),GM(12),
     3  CGGB(12),CGDB(12),CGSB(12),CBGB(12),CBDB(12),CBSB(12),
     4  GMB(12)
      DIMENSION CGS(12),CGD(12),CGB(12),CDS(12)
      EQUIVALENCE(CB(1),CG(1)),(CC(1),VGS(1)),(VBE(1),VDS(1)),
     1(VBC(1),GDS(1)),(VCE(1),VBS(1)),(RPI(1),CBD(1)),
     2(RO(1),CBS(1)),(CPI(1),CGSOV(1)),(CMU(1),CGDOV(1)),
     3(BETADC(1),CGBOV(1)),(BETAAC(1),VTH(1)),(FT(1),VDSAT(1)),
     4(CCS(1),CD(1)),(CBX(1),CGGB(1)),(RX(1),CGDB(1))
      EQUIVALENCE(VD(1),CG(1)),(CAP(1),VGS(1)),(AV1(1),VDS(1)),
     1  (AI1(1),GDS(1)),(REQ(1),VBS(1))
      EQUIVALENCE (CGS(1),CGGB(1)),(CGD(1),CGDB(1)),(CGB(1),CGSB(1)),
     1  (CDS(1),CBGB(1))
      DIMENSION AFMT1(3),AFMT2(2),AFMT3(3),AFMT4(3)
      DATA OPTITL / 8HOPERATIN, 8HG POINT , 8HINFORMAT, 8HION      /
      DATA AV,AVD,AVBE,AVBC,AVCE,AVGS,AVDS,AVBS / 1HV,2HVD,3HVBE,3HVBC,
     1   3HVCE,3HVGS,3HVDS,3HVBS /
      DATA ACNTRV,ACNTRI,ASRCV,ASRCI,ATRANG,ATRANR,AVGAIN,AIGAIN /
     1   8HV-CONTRL, 8HI-CONTRL, 8HV-SOURCE, 8HI-SOURCE,
     2   8HTRANS-G , 8HTRANS-R , 8HV GAIN  , 8HI GAIN   /
      DATA AI,AID,AIB,AIC,AIG / 1HI,2HID,2HIB,2HIC,2HIG /
      DATA AREQ,ARPI,ARO / 3HREQ,3HRPI,2HRO /
      DATA ACAP,ACPI,ACMU,ACGS,ACGD,ACBD,ACBS / 3HCAP,3HCPI,3HCMU,3HCGS,
     1   3HCGD,3HCBD,3HCBS /
      DATA ACGSOV,ACGDOV,ACGBOV /6HCGSOVL,6HCGDOVL,6HCGBOVL/
      DATA ACGGB,ACGDB,ACGSB,ACBGB,ACBDB,ACBSB /7HDQGDVGB,7HDQGDVDB,
     1  7HDQGDVSB,7HDQBDVGB,7HDQBDVDB,7HDQBDVSB/
      DATA ACGB,ACDS / 3HCGB,3HCDS /
      DATA AVTH, AVDSAT / 3HVTH, 5HVDSAT /
      DATA AGM,AGDS / 2HGM,3HGDS /
      DATA AGMB / 4HGMB /
      DATA ACCS,ACBX,ARX /3HCCS,3HCBX,2HRX/
      DATA ABETAD,ABETAA / 6HBETADC,6HBETAAC /
      DATA AFT / 2HFT /
C
      DATA ABLNK /1H /
      DATA AFMT1 /8H(//1H ,1,8H0X,  (2X,8H,A8))   /
      DATA AFMT2 /8H(1H ,A8,,8H  F10.3)/
      DATA AFMT3 /8H(1H ,A8,,8H1P  E10.,8H2)      /
      DATA AFMT4 /8H(' MODEL,8H   ',  (,8H2X,A8)) /
C
C.. FIX-UP THE FORMAT STATEMENTS
C
      KNTR=12
      IF(LWIDTH.LE.80) KNTR=7
      IPOS=12
      CALL MOVE(AFMT1,IPOS,ABLNK,1,2)
      CALL ALFNUM(KNTR,AFMT1,IPOS)
      IPOS=9
      CALL MOVE(AFMT2,IPOS,ABLNK,1,2)
      CALL ALFNUM(KNTR,AFMT2,IPOS)
      IPOS=11
      CALL MOVE(AFMT3,IPOS,ABLNK,1,2)
      CALL ALFNUM(KNTR,AFMT3,IPOS)
      IPOS=14
      CALL MOVE(AFMT4,IPOS,ABLNK,1,2)
      CALL ALFNUM(KNTR,AFMT4,IPOS)
C
C  COMPUTE VOLTAGE SOURCE CURRENTS AND POWER DISSIPATION
C
      CALL SECOND(T1)
      IF ((MODE.EQ.1).AND.(MODEDC.EQ.2).AND.(NOSOLV.NE.0)) GO TO 700
      POWER=0.0D0
      IF (JELCNT(9).EQ.0) GO TO 50
      ITITLE=0
   11 FORMAT (////5X,'VOLTAGE SOURCE CURRENTS'//5X,'NAME',
     1   7X,'CURRENT'/)
      LOC=LOCATE(9)
   20 IF ((LOC.EQ.0).OR.(NODPLC(LOC+11).NE.0)) GO TO 50
      LOCV=NODPLC(LOC+1)
      IPTR=NODPLC(LOC+6)
      CREAL=VALUE(LVNIM1+IPTR)
      POWER=POWER-CREAL*VALUE(LOCV+1)
      IF (ITITLE.EQ.0) WRITE (IOFILE,11)
      ITITLE=1
      WRITE (IOFILE,21) VALUE(LOCV),CREAL
   21 FORMAT (/5X,A8,1X,1PD10.3)
   30 LOC=NODPLC(LOC)
      GO TO 20
   50 LOC=LOCATE(10)
   60 IF ((LOC.EQ.0).OR.(NODPLC(LOC+6).NE.0)) GO TO 90
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      POWER=POWER-VALUE(LOCV+1)
     1   *(VALUE(LVNIM1+NODE1)-VALUE(LVNIM1+NODE2))
      LOC=NODPLC(LOC)
      GO TO 60
   90 WRITE (IOFILE,91) POWER
   91 FORMAT (//5X,'TOTAL POWER DISSIPATION  ',1PD9.2,'  WATTS')
C
C  SMALL SIGNAL DEVICE PARAMETERS
C
      NUMDEV=JELCNT(5)+JELCNT(6)+JELCNT(7)+JELCNT(8)+JELCNT(11)
     1   +JELCNT(12)+JELCNT(13)+JELCNT(14)
      IF (NUMDEV.EQ.0) GO TO 600
      CALL TITLE(0,LWIDTH,1,OPTITL)
      KNTLIM=LWIDTH/11
C
C  NONLINEAR VOLTAGE CONTROLLED CURRENT SOURCES
C
      IF (JELCNT(5).EQ.0) GO TO 175
      ITITLE=0
  111 FORMAT(1H ,/,'**** VOLTAGE-CONTROLLED CURRENT SOURCES')
      LOC=LOCATE(5)
      KNTR=0
  120 IF ((LOC.EQ.0).OR.(NODPLC(LOC+13).NE.0)) GO TO 140
      KNTR=KNTR+1
      LOCV=NODPLC(LOC+1)
      LOCT=LX0+NODPLC(LOC+12)
      ANAM(KNTR)=VALUE(LOCV)
      AI1(KNTR)=VALUE(LOCT)
      IF (KNTR.GE.KNTLIM) GO TO 150
  130 LOC=NODPLC(LOC)
      GO TO 120
  140 IF (KNTR.EQ.0) GO TO 175
  150 IF (ITITLE.EQ.0) WRITE (IOFILE,111)
      ITITLE=1
      WRITE (IOFILE,AFMT1) (ANAM(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ASRCI,(AI1(I),I=1,KNTR)
      KNTR=0
      IF ((LOC.NE.0).AND.(NODPLC(LOC+13).EQ.0)) GO TO 130
C
C  NONLINEAR VOLTAGE CONTROLLED VOLTAGE SOURCES
C
  175 IF (JELCNT(6).EQ.0) GO TO 186
      ITITLE=0
  176 FORMAT(1H ,/,'**** VOLTAGE-CONTROLLED VOLTAGE SOURCES')
      LOC=LOCATE(6)
      KNTR=0
  178 IF ((LOC.EQ.0).OR.(NODPLC(LOC+14).NE.0)) GO TO 182
      KNTR=KNTR+1
      LOCV=NODPLC(LOC+1)
      LOCT=LX0+NODPLC(LOC+13)
      ANAM(KNTR)=VALUE(LOCV)
      AV1(KNTR)=VALUE(LOCT)
      AI1(KNTR)=VALUE(LOCT+1)
      IF (KNTR.GE.KNTLIM) GO TO 184
  180 LOC=NODPLC(LOC)
      GO TO 178
  182 IF (KNTR.EQ.0) GO TO 186
  184 IF (ITITLE.EQ.0) WRITE (IOFILE,176)
      ITITLE=1
      WRITE (IOFILE,AFMT1) (ANAM(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) ASRCV,(AV1(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ASRCI,(AI1(I),I=1,KNTR)
      KNTR=0
      IF ((LOC.NE.0).AND.(NODPLC(LOC+14).EQ.0)) GO TO 180
C
C  NONLINEAR CURRENT CONTROLLED CURRENT SOURCES
C
  186 IF (JELCNT(7).EQ.0) GO TO 196
      ITITLE=0
  187 FORMAT(1H ,/,'**** CURRENT-CONTROLLED CURRENT SOURCES')
      LOC=LOCATE(7)
      KNTR=0
  188 IF ((LOC.EQ.0).OR.(NODPLC(LOC+13).NE.0)) GO TO 192
      KNTR=KNTR+1
      LOCV=NODPLC(LOC+1)
      LOCT=LX0+NODPLC(LOC+12)
      ANAM(KNTR)=VALUE(LOCV)
      AI1(KNTR)=VALUE(LOCT)
      IF (KNTR.GE.KNTLIM) GO TO 194
  190 LOC=NODPLC(LOC)
      GO TO 188
  192 IF (KNTR.EQ.0) GO TO 196
  194 IF (ITITLE.EQ.0) WRITE (IOFILE,187)
      ITITLE=1
      WRITE (IOFILE,AFMT1) (ANAM(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ASRCI,(AI1(I),I=1,KNTR)
      KNTR=0
      IF ((LOC.NE.0).AND.(NODPLC(LOC+13).EQ.0)) GO TO 190
C
C  NONLINEAR CURRENT CONTROLLED VOLTAGE SOURCES
C
  196 IF (JELCNT(8).EQ.0) GO TO 210
      ITITLE=0
  197 FORMAT(1H ,/,'**** CURRENT-CONTROLLED VOLTAGE SOURCES')
      LOC=LOCATE(8)
      KNTR=0
  198 IF ((LOC.EQ.0).OR.(NODPLC(LOC+14).NE.0)) GO TO 202
      KNTR=KNTR+1
      LOCV=NODPLC(LOC+1)
      LOCT=LX0+NODPLC(LOC+13)
      ANAM(KNTR)=VALUE(LOCV)
      AV1(KNTR)=VALUE(LOCT)
      AI1(KNTR)=VALUE(LOCT+1)
      IF (KNTR.GE.KNTLIM) GO TO 204
  200 LOC=NODPLC(LOC)
      GO TO 198
  202 IF (KNTR.EQ.0) GO TO 210
  204 IF (ITITLE.EQ.0) WRITE (IOFILE,197)
      ITITLE=1
      WRITE (IOFILE,AFMT1) (ANAM(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) ASRCV,(AV1(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ASRCI,(AI1(I),I=1,KNTR)
      KNTR=0
      IF ((LOC.NE.0).AND.(NODPLC(LOC+14).EQ.0)) GO TO 200
C
C  DIODES
C
  210 IF (JELCNT(11).EQ.0) GO TO 300
      ITITLE=0
  211 FORMAT(1H ,/,'**** DIODES')
      LOC=LOCATE(11)
      KNTR=0
  220 IF ((LOC.EQ.0).OR.(NODPLC(LOC+16).NE.0)) GO TO 240
      KNTR=KNTR+1
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      LOCM=NODPLC(LOC+5)
      LOCM=NODPLC(LOCM+1)
      LOCT=LX0+NODPLC(LOC+11)
      ANAM(KNTR)=VALUE(LOCV)
      AMOD(KNTR)=VALUE(LOCM)
      CD(KNTR)=VALUE(LOCT+1)
      VD(KNTR)=VALUE(LVNIM1+NODE1)-VALUE(LVNIM1+NODE2)
      IF (MODEDC.NE.1) GO TO 225
      REQ(KNTR)=1.0D0/VALUE(LOCT+2)
      CAP(KNTR)=VALUE(LOCT+4)
  225 IF (KNTR.GE.KNTLIM) GO TO 250
  230 LOC=NODPLC(LOC)
      GO TO 220
  240 IF (KNTR.EQ.0) GO TO 300
  250 IF (ITITLE.EQ.0) WRITE (IOFILE,211)
      ITITLE=1
      WRITE (IOFILE,AFMT1) (ANAM(I),I=1,KNTR)
      WRITE (IOFILE,AFMT4) (AMOD(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) AID,(CD(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) AVD,(VD(I),I=1,KNTR)
      IF (MODEDC.NE.1) GO TO 260
      WRITE (IOFILE,AFMT3) AREQ,(REQ(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ACAP,(CAP(I),I=1,KNTR)
  260 KNTR=0
      IF ((LOC.NE.0).AND.(NODPLC(LOC+16).EQ.0)) GO TO 230
C
C  BIPOLAR JUNCTION TRANSISTORS
C
  300 IF (JELCNT(12).EQ.0) GO TO 400
      ITITLE=0
  301 FORMAT(1H ,/,'**** BIPOLAR JUNCTION TRANSISTORS')
      LOC=LOCATE(12)
      KNTR=0
  320 IF ((LOC.EQ.0).OR.(NODPLC(LOC+36).NE.0)) GO TO 340
      KNTR=KNTR+1
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      NODE3=NODPLC(LOC+4)
      LOCM=NODPLC(LOC+8)
      TYPE=NODPLC(LOCM+2)
      LOCM=NODPLC(LOCM+1)
      LOCT=LX0+NODPLC(LOC+22)
      ANAM(KNTR)=VALUE(LOCV)
      AMOD(KNTR)=VALUE(LOCM)
      CB(KNTR)=TYPE*VALUE(LOCT+3)
      CC(KNTR)=TYPE*VALUE(LOCT+2)
      VBE(KNTR)=VALUE(LVNIM1+NODE2)-VALUE(LVNIM1+NODE3)
      VBC(KNTR)=VALUE(LVNIM1+NODE2)-VALUE(LVNIM1+NODE1)
      VCE(KNTR)=VBE(KNTR)-VBC(KNTR)
      BETADC(KNTR)=CC(KNTR)/DSIGN(DMAX1(DABS(CB(KNTR)),1.0D-20),
     1  CB(KNTR))
      IF (MODEDC.NE.1) GO TO 325
      RX(KNTR)=0.0D0
      IF(VALUE(LOCT+16).NE.0.0D0) RX(KNTR)=1.0D0/VALUE(LOCT+16)
      CCS(KNTR)=VALUE(LOCT+13)
      CBX(KNTR)=VALUE(LOCT+15)
      RPI(KNTR)=1.0D0/VALUE(LOCT+4)
      GM(KNTR)=VALUE(LOCT+6)
      RO(KNTR)=1.0D0/VALUE(LOCT+7)
      CPI(KNTR)=VALUE(LOCT+9)
      CMU(KNTR)=VALUE(LOCT+11)
      BETAAC(KNTR)=GM(KNTR)*RPI(KNTR)
      FT(KNTR)=GM(KNTR)/(TWOPI*DMAX1(CPI(KNTR)+CMU(KNTR)+CBX(KNTR),
     1  1.0D-20))
  325 IF (KNTR.GE.KNTLIM) GO TO 350
  330 LOC=NODPLC(LOC)
      GO TO 320
  340 IF (KNTR.EQ.0) GO TO 400
  350 IF (ITITLE.EQ.0) WRITE (IOFILE,301)
      ITITLE=1
      WRITE (IOFILE,AFMT1) (ANAM(I),I=1,KNTR)
      WRITE (IOFILE,AFMT4) (AMOD(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) AIB,(CB(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) AIC,(CC(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) AVBE,(VBE(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) AVBC,(VBC(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) AVCE,(VCE(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) ABETAD,(BETADC(I),I=1,KNTR)
      IF (MODEDC.NE.1) GO TO 360
      WRITE (IOFILE,AFMT3) AGM,(GM(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ARPI,(RPI(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ARX,(RX(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ARO,(RO(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ACPI,(CPI(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ACMU,(CMU(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ACBX,(CBX(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ACCS,(CCS(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) ABETAA,(BETAAC(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) AFT,(FT(I),I=1,KNTR)
  360 KNTR=0
      IF ((LOC.NE.0).AND.(NODPLC(LOC+36).EQ.0)) GO TO 330
C
C  JFETS
C
  400 IF (JELCNT(13).EQ.0) GO TO 500
      ITITLE=0
  401 FORMAT(1H ,/,'**** JFETS')
      LOC=LOCATE(13)
      KNTR=0
  420 IF ((LOC.EQ.0).OR.(NODPLC(LOC+25).NE.0)) GO TO 440
      KNTR=KNTR+1
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      NODE3=NODPLC(LOC+4)
      LOCM=NODPLC(LOC+7)
      TYPE=NODPLC(LOCM+2)
      LOCM=NODPLC(LOCM+1)
      LOCT=LX0+NODPLC(LOC+19)
      ANAM(KNTR)=VALUE(LOCV)
      AMOD(KNTR)=VALUE(LOCM)
      CD(KNTR)=TYPE*(VALUE(LOCT+3)-VALUE(LOCT+4))
      VGS(KNTR)=VALUE(LVNIM1+NODE2)-VALUE(LVNIM1+NODE3)
      VDS(KNTR)=VALUE(LVNIM1+NODE1)-VALUE(LVNIM1+NODE3)
      IF (MODEDC.NE.1) GO TO 425
      GM(KNTR)=VALUE(LOCT+5)
      GDS(KNTR)=VALUE(LOCT+6)
      CGS(KNTR)=VALUE(LOCT+9)
      CGD(KNTR)=VALUE(LOCT+11)
  425 IF (KNTR.GE.KNTLIM) GO TO 450
  430 LOC=NODPLC(LOC)
      GO TO 420
  440 IF (KNTR.EQ.0) GO TO 500
  450 IF (ITITLE.EQ.0) WRITE (IOFILE,401)
      ITITLE=1
      WRITE (IOFILE,AFMT1) (ANAM(I),I=1,KNTR)
      WRITE (IOFILE,AFMT4) (AMOD(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) AID,(CD(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) AVGS,(VGS(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) AVDS,(VDS(I),I=1,KNTR)
      IF (MODEDC.NE.1) GO TO 460
      WRITE (IOFILE,AFMT3) AGM,(GM(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) AGDS,(GDS(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ACGS,(CGS(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ACGD,(CGD(I),I=1,KNTR)
  460 KNTR=0
      IF ((LOC.NE.0).AND.(NODPLC(LOC+25).EQ.0)) GO TO 430
C
C  MOSFETS
C
  500 IF (JELCNT(14).EQ.0) GO TO 600
      ITITLE=0
  501 FORMAT(1H ,/,'**** MOSFETS')
      LOC=LOCATE(14)
      KNTR=0
  520 IF ((LOC.EQ.0).OR.(NODPLC(LOC+33).NE.0)) GO TO 540
      KNTR=KNTR+1
      LOCV=NODPLC(LOC+1)
      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+26)
      ANAM(KNTR)=VALUE(LOCV)
      AMOD(KNTR)=VALUE(LOCM)
      CD(KNTR)=TYPE*VALUE(LOCT+4)
      VGS(KNTR)=VALUE(LVNIM1+NODE2)-VALUE(LVNIM1+NODE3)
      VDS(KNTR)=VALUE(LVNIM1+NODE1)-VALUE(LVNIM1+NODE3)
      VBS(KNTR)=VALUE(LVNIM1+NODE4)-VALUE(LVNIM1+NODE3)
      IF (MODEDC.NE.1) GO TO 525
      XL=VALUE(LOCV+1)-2.0D0*VALUE(LOCM+28)
      XW=VALUE(LOCV+2)
      COVLGS=VALUE(LOCM+13)*XW
      COVLGD=VALUE(LOCM+14)*XW
      COVLGB=VALUE(LOCM+15)*XL
      XQCO=VALUE(LOCM+35)
      DEVMOD=VALUE(LOCV+8)
      VDSAT(KNTR)=VALUE(LOCV+10)
      VTH(KNTR)=VALUE(LOCV+9)
      GM(KNTR)=VALUE(LOCT+7)
      GDS(KNTR)=VALUE(LOCT+8)
      GMB(KNTR)=VALUE(LOCT+9)
      IF(DEVMOD.GT.0.0D0) GO TO 521
      VTH(KNTR)=VALUE(LOCV+9)
  521 CBD(KNTR)=VALUE(LOCT+24)
      CBS(KNTR)=VALUE(LOCT+26)
      CGSOV(KNTR)=COVLGS
      CGDOV(KNTR)=COVLGD
      CGBOV(KNTR)=COVLGB
      IF (XQCO.GT.0.5D0) GO TO 522
      CGGB(KNTR)=VALUE(LOCT+18)
      CGDB(KNTR)=VALUE(LOCT+19)
      CGSB(KNTR)=VALUE(LOCT+20)
      CBGB(KNTR)=VALUE(LOCT+21)
      CBDB(KNTR)=VALUE(LOCT+22)
      CBSB(KNTR)=VALUE(LOCT+23)
      GO TO 525
  522 CGS(KNTR)=VALUE(LOCT+12)
      CGD(KNTR)=VALUE(LOCT+14)
      CGB(KNTR)=VALUE(LOCT+16)
  525 IF (KNTR.GE.KNTLIM) GO TO 550
  530 LOC=NODPLC(LOC)
      GO TO 520
  540 IF (KNTR.EQ.0) GO TO 600
  550 IF (ITITLE.EQ.0) WRITE (IOFILE,501)
      ITITLE=1
      WRITE (IOFILE,AFMT1) (ANAM(I),I=1,KNTR)
      WRITE (IOFILE,AFMT4) (AMOD(I),I=1,KNTR)
      IF(TYPE.EQ.0.0D0) GO TO 555
      WRITE (IOFILE,AFMT3) AID,(CD(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) AVGS,(VGS(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) AVDS,(VDS(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) AVBS,(VBS(I),I=1,KNTR)
      IF (MODEDC.NE.1) GO TO 560
      WRITE (IOFILE,AFMT2) AVTH,(VTH(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) AVDSAT,(VDSAT(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) AGM,(GM(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) AGDS,(GDS(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) AGMB,(GMB(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ACBD,(CBD(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ACBS,(CBS(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ACGSOV,(CGSOV(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ACGDOV,(CGDOV(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ACGBOV,(CGBOV(I),I=1,KNTR)
      IF (XQCO.GT.0.5D0) GO TO 552
      WRITE (IOFILE,551)
  551 FORMAT(' DERIVATIVES OF GATE (DQGDVX) AND BULK (DQBDVX) CHARGES')
      WRITE (IOFILE,AFMT3) ACGGB,(CGGB(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ACGDB,(CGDB(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ACGSB,(CGSB(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ACBGB,(CBGB(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ACBDB,(CBDB(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ACBSB,(CBSB(I),I=1,KNTR)
      GO TO 560
  552 WRITE (IOFILE,AFMT3) ACGS,(CGS(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ACGD,(CGD(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ACGB,(CGB(I),I=1,KNTR)
      GO TO 560
  555 WRITE (IOFILE,AFMT3) AID,(CD(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) AIG,(CG(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) AVGS,(VGS(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) AVDS,(VDS(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) AVBS,(VBS(I),I=1,KNTR)
      IF (MODEDC.NE.1) GO TO 560
      WRITE (IOFILE,AFMT3) AGM,(GM(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) AGDS,(GDS(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ACGS,(CGS(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ACGD,(CGD(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ACGB,(CGB(I),I=1,KNTR)
      WRITE (IOFILE,AFMT3) ACDS,(CDS(I),I=1,KNTR)
  560 KNTR=0
      IF ((LOC.NE.0).AND.(NODPLC(LOC+33).EQ.0)) GO TO 530
C
C  OPERATING POINT ANALYSES
C
  600 IF (MODEDC.NE.1) GO TO 700
      IF (KINEL.EQ.0) GO TO 610
      CALL SSTF
  610 IF (NSENS.EQ.0) GO TO 700
      CALL SENCAL
C
C  FINISHED
C
  700 IF (MODEDC.EQ.2) GO TO 710
      IF (JACFLG.NE.0) GO TO 705
      CALL CLRMEM(LVNIM1)
      CALL CLRMEM(LX0)
  705 CALL CLRMEM(LVN)
      CALL CLRMEM(LVNTMP)
      IF (MEMPTR(MACINS)) CALL CLRMEM(MACINS)
  710 CALL SECOND(T2)
      RSTATS(5)=RSTATS(5)+T2-T1
      RETURN
      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(1000000)
      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(////,'****     SMALL-SIGNAL CHARACTERISTICS'//,
     1   1H ,5X,5A8,3H = ,1PD10.3,/,
     2   1H ,5X,'INPUT RESISTANCE AT ',A8,12X,3H = ,D10.3,/,
     3   1H ,5X,'OUTPUT RESISTANCE AT ',2A8,A3,3H = ,D10.3)
      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(1000000)
      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,
     1ALSVB / 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('DC SENSITIVITIES OF OUTPUT ',5A8)
      IF(IVOLTS.NE.0) WRITE (IOFILE,41)
      IF(IVOLTS.EQ.0) WRITE(IOFILE,42)
   41 FORMAT(1H ,8X,'ELEMENT',9X,'ELEMENT',7X,'ELEMENT',7X,'NORMALIZED'/
     1   10X,'NAME',12X,'VALUE',6X,'SENSITIVITY    SENSITIVITY'/35X,
     2   ' (VOLTS/UNIT) (VOLTS/PERCENT)'/)
   42 FORMAT(1H ,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 ASOL
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE EVALUATES THE ADJOINT CIRCUIT RESPONSE BY DOING A
C FORWARD/BACKWARD SUBSTITUTION ON THE TRANSPOSE OF THE COEFFICIENT
C MATRIX.
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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C  FORWARD SUBSTITUTION
C
      DO 20 I=2,NSTOP
      IORD=NODPLC(ICSWPF+I)
      LOC=I
   10 LOC=NODPLC(IRPT+LOC)
      IF (NODPLC(IROWNO+LOC).GE.I) GO TO 15
      J=NODPLC(IROWNO+LOC)
      JORD=NODPLC(ICSWPF+J)
      VALUE(LVN+IORD)=VALUE(LVN+IORD)-VALUE(LVN+LOC)*VALUE(LVN+JORD)
      GO TO 10
   15 JORD=NODPLC(IRSWPF+I)
      LOCNN=INDXX(JORD,IORD)
      VALUE(LVN+IORD)=VALUE(LVN+IORD)/VALUE(LVN+LOCNN)
   20 CONTINUE
C
C  BACKWARD SUBSTITUTION
C
      I=NSTOP
   30 I=I-1
      IF (I.LE.1) GO TO 60
      IORD=NODPLC(ICSWPF+I)
      LOC=I
   35 LOC=NODPLC(IRPT+LOC)
   40 IF (NODPLC(IROWNO+LOC).NE.I) GO TO 35
   50 LOC=NODPLC(IRPT+LOC)
      IF (LOC.EQ.0) GO TO 30
      J=NODPLC(IROWNO+LOC)
      JORD=NODPLC(ICSWPF+J)
      VALUE(LVN+IORD)=VALUE(LVN+IORD)-VALUE(LVN+LOC)*VALUE(LVN+JORD)
      GO TO 50
C
C     REORDER SOLUTION VECTOR
C
   60 DO 70 I=1,NSTOP
      J=NODPLC(IRSWPR+I)
      K=NODPLC(ICSWPF+J)
      VALUE(LVNTMP+I)=VALUE(LVN+K)
   70 CONTINUE
      CALL COPY8(VALUE(LVNTMP+1),VALUE(LVN+1),NSTOP)
C
C  FINISHED
C
      RETURN
      END
C SPICE VERSION 2G.6  SCCSID=acan.ma 3/15/83
      SUBROUTINE ACAN
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      REAL T1, T2
C
C     THIS ROUTINE DRIVES THE SMALL-SIGNAL ANALYSES.
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=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=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=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=CJE 3/15/83
      COMMON /CJE/ MAXTIM,ITIME,ICOST
C SPICE VERSION 2G.6  SCCSID=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      COMPLEX CENDOR
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
      CALL SECOND(T1)
C.. POST-PROCESSOR INITIALIZATION
      IF(IPOSTP.NE.2) GO TO 1
      NUMCUR=JELCNT(9)
      NUMPOS=NUNODS+NUMCUR
      CALL GETM16(IBUFF,NUMPOS)
      NUMPOS=NUMPOS*4
      IF(NUMCUR.EQ.0) GO TO 1
      LOC=LOCATE(9)
      LOCCUR=NODPLC(LOC+6)-1
C
C  ALLOCATE STORAGE
C
    1 CALL GETM8(NDIAG,2*NSTOP)
      CALL GETM8(LVN,NSTOP+NTTBR)
      CALL GETM8(IMVN,NSTOP+NTTBR)
      CALL GETM16(LCVN,NSTOP)
      IF (IDIST.NE.0) CALL DINIT
      NANDD=0
      IF (INOISE.EQ.0) GO TO 10
      IF (IDIST.EQ.0) GO TO 10
      NANDD=1
      CALL GETM16(LVNTMP,NSTOP)
   10 CALL GETM16(LOUTPT,0)
      CALL CRUNCH
      NUMOUT=JELCNT(43)+JELCNT(44)+JELCNT(45)+1
      LYNL=LVN
      IMYNL=IMVN
      LCVNTP=LVNTMP
      ICALC=0
      IF (IPOSTP.EQ.2) CALL PHEADR(ATITLE)
      FREQ=FSTART
C
C  LOAD Y MATRIX AND C VECTOR, SOLVE FOR V VECTOR
C
  100 CALL GETCJE
      IF ((MAXTIM-ITIME).LE.LIMTIM) GO TO 900
      OMEGA=TWOPI*FREQ
      CALL ACLOAD
  110 CALL ACDCMP
      CALL ACSOL
      IF (IGOOF.EQ.0) GO TO 200
      WRITE (IOFILE,121) IGOOF,FREQ
  121 FORMAT('WARNING:  UNDERFLOW ',I4,' TIME(S) IN AC ANALYSIS AT FREQ
     1 = ',1PD10.3,' HZ')
      IGOOF=0
C
C  STORE OUTPUTS
C
  200 CALL EXTMEM(LOUTPT,NUMOUT)
      LOCO=LOUTPT+ICALC*NUMOUT
      ICALC=ICALC+1
      CVALUE(LOCO+1)=CMPLX(SNGL(FREQ),SNGL(OMEGA))
      LOC=LOCATE(43)
  310 IF (LOC.EQ.0) GO TO 350
      IF (NODPLC(LOC+5).NE.0) GO TO 320
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      ISEQ=NODPLC(LOC+4)
      CVALUE(LOCO+ISEQ)=CVALUE(LCVN+NODE1)-CVALUE(LCVN+NODE2)
      LOC=NODPLC(LOC)
      GO TO 310
  320 IPTR=NODPLC(LOC+2)
      IPTR=NODPLC(IPTR+6)
      ISEQ=NODPLC(LOC+4)
      CVALUE(LOCO+ISEQ)=CVALUE(LCVN+IPTR)
      LOC=NODPLC(LOC)
      GO TO 310
  350 IF(IPOSTP.NE.2) GO TO 400
      CVALUE(IBUFF+1)=CMPLX(SNGL(FREQ),0.0E0)
      CALL COPY16(CVALUE(LCVN+2),CVALUE(IBUFF+2),NUNODS-1)
      IF(NUMCUR.NE.0) CALL COPY16(CVALUE(LCVN+LOCCUR+1),
     1  CVALUE(IBUFF+NUNODS+1),NUMCUR)
C      CALL DBLSGL(CVALUE(IBUFF+1),NUMPOS)
      CALL FWRITE(CVALUE(IBUFF+1),NUMPOS)
C
C  NOISE AND DISTORTION ANALYSES
C
  400 IF (NANDD.EQ.0) GO TO 410
      CALL COPY16(CVALUE(LCVN+1),CVALUE(LCVNTP+1),NSTOP)
  410 IF (INOISE.NE.0) CALL NOISE(LOCO)
      IF (NANDD.EQ.0) GO TO 420
      CALL COPY16(CVALUE(LCVNTP+1),CVALUE(LCVN+1),NSTOP)
  420 IF (IDIST.NE.0) CALL DISTO(LOCO)
C
C  INCREMENT FREQUENCY
C
      IF (ICALC.GE.JACFLG) GO TO 1000
      IF (IDFREQ.GE.3) GO TO 510
      FREQ=FREQ*FINCR
      GO TO 100
  510 FREQ=FREQ+FINCR
      GO TO 100
C
C  FINISHED
C
  900 WRITE (IOFILE,901)
  901 FORMAT('*ERROR*:  CPU TIME LIMIT EXCEEDED ... ANALYSIS STOPPED'/)
      NOGO=1
 1000 IF(IPOSTP.NE.2) GO TO 1010
CDW      IF (IPOSTP.NE.0) CALL CLSRAW
      IF(IPOSTP.EQ.2) CALL CLRMEM(IBUFF)
 1010 CALL CLRMEM(LVNIM1)
      CALL CLRMEM(LX0)
      CALL CLRMEM(LVN)
      CALL CLRMEM(IMVN)
      CALL CLRMEM(LCVN)
      CALL CLRMEM(NDIAG)
      IF (IDIST.EQ.0) GO TO 1020
      CALL CLRMEM(LD0)
      CALL CLRMEM(LD1)
 1020 IF (NANDD.EQ.0) GO TO 1040
      CALL CLRMEM(LVNTMP)
 1040 CALL SECOND(T2)
      RSTATS(7)=RSTATS(7)+T2-T1
      RSTATS(8)=RSTATS(8)+ICALC
      RETURN
      END
      SUBROUTINE CDIV(XR,XI,YR,YI,CR,CI)
C.. OK IF CR AND CI ARE REALLY XR AND XI OR YR AND YI
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      XRTEMP=XR
      XITEMP=XI
      YRTEMP=YR
      YITEMP=YI
      AMAG2=YRTEMP*YRTEMP+YITEMP*YITEMP
      CR=(XRTEMP*YRTEMP+XITEMP*YITEMP)/AMAG2
      CI=(XITEMP*YRTEMP-XRTEMP*YITEMP)/AMAG2
      RETURN
      END
      SUBROUTINE CMULT(XR,XI,YR,YI,CR,CI)
C.. OK IF CR AND CI ARE REALLY XR AND XI OR YR AND YI
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      XRTEMP=XR
      XITEMP=XI
      YRTEMP=YR
      YITEMP=YI
      CR=XRTEMP*YRTEMP-XITEMP*YITEMP
      CI=XITEMP*YRTEMP+XRTEMP*YITEMP
      RETURN
      END
      SUBROUTINE ACDCMP
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE PERFORMS AN LU FACTORIZATION OF THE CIRCUIT EQUATION
C COEFFICIENT MATRIX.
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=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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
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
      N=1
   10 N=N+1
      NXTI=N
      NXTJ=N
C
C     CALCULATE CONTRIBUTION FROM (NXTI,NXTJ)
C
      IF (N.GE.NSTOP) RETURN
      N1=NODPLC(IRSWPF+NXTI)
      N2=NODPLC(ICSWPF+NXTJ)
      LOCNN=INDXX(N1,N2)
      GDIAG=DABS(VALUE(LYNL+LOCNN))+DABS(VALUE(IMYNL+LOCNN))
      IF (GDIAG.GE.PIVTOL) GO TO 20
      VALUE(LYNL+LOCNN)=PIVTOL
      VALUE(IMYNL+LOCNN)=0.0D0
      WRITE(IOFILE,11) N
   11 FORMAT(' UNDERFLOW OCCURED AT STEP N= ',I5)
C
C     DOWN COL J
C
   20 LOCR=NODPLC(IRPT+LOCNN)
   25 IF (LOCR.EQ.0) GO TO 10
      I=NODPLC(IROWNO+LOCR)
      CALL CDIV(VALUE(LYNL+LOCR),VALUE(IMYNL+LOCR),VALUE(LYNL+LOCNN),
     1     VALUE(IMYNL+LOCNN),VALUE(LYNL+LOCR),VALUE(IMYNL+LOCR))
      LOCC=NODPLC(JCPT+LOCNN)
C
C     FOR EACH ELEMENT LOOK UP ROW NXTI
C
   30 IF (LOCC.EQ.0) GO TO 70
      J=NODPLC(JCOLNO+LOCC)
C
C     LOCATE ELEMENT (I,J)
C
   35 IF (J.LT.I) GO TO 45
      LOCIJ=LOCC
   40 LOCIJ=NODPLC(IRPT+LOCIJ)
      IF (NODPLC(IROWNO+LOCIJ).EQ.I) GO TO 55
      GO TO 40
   45 LOCIJ=LOCR
   50 LOCIJ=NODPLC(JCPT+LOCIJ)
      IF (NODPLC(JCOLNO+LOCIJ).EQ.J) GO TO 55
      GO TO 50
   55 CALL CMULT(VALUE(LYNL+LOCC),VALUE(IMYNL+LOCC),
     1     VALUE(LYNL+LOCR),VALUE(IMYNL+LOCR),XREAL,XIMAG)
      VALUE(LYNL+LOCIJ)=VALUE(LYNL+LOCIJ)-XREAL
      VALUE(IMYNL+LOCIJ)=VALUE(IMYNL+LOCIJ)-XIMAG
      LOCC=NODPLC(JCPT+LOCC)
      GO TO 30
   70 LOCR=NODPLC(IRPT+LOCR)
      GO TO 25
      END
      SUBROUTINE ACSOL
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE SOLVES THE CIRCUIT EQUATIONS BY PERFORMING A FORWARD
C AND BACKWARD SUBSTITUTION USING THE PREVIOUSLY-COMPUTED LU FACTORS.
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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C  FORWARD SUBSTITUTION
C
      DO 20 I=2,NSTOP
      LOC=I
      IORD=NODPLC(IRSWPF+I)
   10 LOC=NODPLC(JCPT+LOC)
      IF (NODPLC(JCOLNO+LOC).GE.I) GO TO 20
      J=NODPLC(JCOLNO+LOC)
      JORD=NODPLC(IRSWPF+J)
      CALL CMULT(VALUE(LYNL+LOC),VALUE(IMYNL+LOC),
     1     VALUE(LVN+JORD),VALUE(IMVN+JORD),XREAL,XIMAG)
      VALUE(LVN+IORD)=VALUE(LVN+IORD)-XREAL
      VALUE(IMVN+IORD)=VALUE(IMVN+IORD)-XIMAG
      GO TO 10
   20 CONTINUE
C
C      BACK SUBSTITUTION
C
      I=NSTOP
      IORD=NODPLC(IRSWPF+I)
      JORD=NODPLC(ICSWPF+I)
      LOCNN=INDXX(IORD,JORD)
   30 CALL CDIV(VALUE(LVN+IORD),VALUE(IMVN+IORD),VALUE(LYNL+LOCNN),
     1     VALUE(IMYNL+LOCNN),VALUE(LVN+IORD),VALUE(IMVN+IORD))
      I=I-1
      IF (I.LE.1) GO TO 60
      IORD=NODPLC(IRSWPF+I)
      LOC=I
   35 LOC=NODPLC(JCPT+LOC)
   40 IF (NODPLC(JCOLNO+LOC).NE.I) GO TO 35
      LOCNN=LOC
   50 LOC=NODPLC(JCPT+LOC)
      IF (LOC.EQ.0) GO TO 30
      J=NODPLC(JCOLNO+LOC)
      JORD=NODPLC(IRSWPF+J)
      CALL CMULT(VALUE(LYNL+LOC),VALUE(IMYNL+LOC),
     1     VALUE(LVN+JORD),VALUE(IMVN+JORD),XREAL,XIMAG)
      VALUE(LVN+IORD)=VALUE(LVN+IORD)-XREAL
      VALUE(IMVN+IORD)=VALUE(IMVN+IORD)-XIMAG
      GO TO 50
C
C  REORDER SOLUTION VECTOR
C
   60 DO 70 I=1,NSTOP
      J=NODPLC(ICSWPR+I)
      K=NODPLC(IRSWPF+J)
      VALUE(NDIAG+I)=VALUE(LVN+K)
      VALUE(NDIAG+I+NSTOP)=VALUE(IMVN+K)
   70 CONTINUE
      CALL COPY8(VALUE(NDIAG+1),VALUE(LVN+1),NSTOP)
      CALL COPY8(VALUE(NDIAG+1+NSTOP),VALUE(IMVN+1),NSTOP)
      DO 120 I=2,NSTOP
      CVALUE(LCVN+I)=CMPLX(SNGL(VALUE(LVN+I)),SNGL(VALUE(IMVN+I)))
  120 CONTINUE
      CVALUE(LCVN+1)=CMPLX(0.0E0,0.0E0)
C
C  FINISHED
C
      RETURN
      END
      SUBROUTINE ACLOAD
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE ZEROES-OUT AND THEN LOADS THE COMPLEX COEFFICIENT
C     MATRIX
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=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(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C
      COMPLEX CVAL
C
C  ZERO Y MATRIX AND CURRENT VECTOR
C
      CALL ZERO8(VALUE(LVN+1),NSTOP+NTTBR)
      CALL ZERO8(VALUE(IMVN+1),NSTOP+NTTBR)
C
C  RESISTORS
C
      LOC=LOCATE(1)
   20 IF ((LOC.EQ.0).OR.(NODPLC(LOC+8).NE.0)) GO TO 30
      LOCV=NODPLC(LOC+1)
      VAL=VALUE(LOCV+1)
      LOCY=LYNL+NODPLC(LOC+6)
      VALUE(LOCY)=VALUE(LOCY)+VAL
      LOCY=LYNL+NODPLC(LOC+7)
      VALUE(LOCY)=VALUE(LOCY)+VAL
      LOCY=LYNL+NODPLC(LOC+4)
      VALUE(LOCY)=VALUE(LOCY)-VAL
      LOCY=LYNL+NODPLC(LOC+5)
      VALUE(LOCY)=VALUE(LOCY)-VAL
      LOC=NODPLC(LOC)
      GO TO 20
C
C  CAPACITORS
C
   30 LOC=LOCATE(2)
   40 IF ((LOC.EQ.0).OR.(NODPLC(LOC+12).NE.0)) GO TO 50
      LOCV=NODPLC(LOC+1)
      VAL=OMEGA*VALUE(LOCV+1)
      LOCYI=IMYNL+NODPLC(LOC+10)
      VALUE(LOCYI)=VALUE(LOCYI)+VAL
      LOCYI=IMYNL+NODPLC(LOC+11)
      VALUE(LOCYI)=VALUE(LOCYI)+VAL
      LOCYI=IMYNL+NODPLC(LOC+5)
      VALUE(LOCYI)=VALUE(LOCYI)-VAL
      LOCYI=IMYNL+NODPLC(LOC+6)
      VALUE(LOCYI)=VALUE(LOCYI)-VAL
      LOC=NODPLC(LOC)
      GO TO 40
C
C  INDUCTORS
C
   50 LOC=LOCATE(3)
   60 IF ((LOC.EQ.0).OR.(NODPLC(LOC+14).NE.0)) GO TO 70
      LOCV=NODPLC(LOC+1)
      VAL=OMEGA*VALUE(LOCV+1)
      LOCYI=IMYNL+NODPLC(LOC+13)
      LOCY=LYNL+NODPLC(LOC+13)
      VALUE(LOCY)=0.0D0
      VALUE(LOCYI)=-VAL
      LOCY=LYNL+NODPLC(LOC+6)
      LOCYI=IMYNL+NODPLC(LOC+6)
      VALUE(LOCY)=1.0D0
      VALUE(LOCYI)=0.0D0
      LOCY=LYNL+NODPLC(LOC+7)
      LOCYI=IMYNL+NODPLC(LOC+7)
      VALUE(LOCY)=-1.0D0
      VALUE(LOCYI)=0.0D0
      LOCY=LYNL+NODPLC(LOC+8)
      LOCYI=IMYNL+NODPLC(LOC+8)
      VALUE(LOCY)=1.0D0
      VALUE(LOCYI)=0.0D0
      LOCY=LYNL+NODPLC(LOC+9)
      LOCYI=IMYNL+NODPLC(LOC+9)
      VALUE(LOCY)=-1.0D0
      VALUE(LOCYI)=0.0D0
      LOC=NODPLC(LOC)
      GO TO 60
C
C  MUTUAL INDUCTORS
C
   70 LOC=LOCATE(4)
   80 IF ((LOC.EQ.0).OR.(NODPLC(LOC+6).NE.0)) GO TO 90
      LOCV=NODPLC(LOC+1)
      VAL=OMEGA*VALUE(LOCV+1)
      LOCY=LYNL+NODPLC(LOC+4)
      LOCYI=IMYNL+NODPLC(LOC+4)
      VALUE(LOCY)=0.0D0
      VALUE(LOCYI)=-VAL
      LOCY=LYNL+NODPLC(LOC+5)
      LOCYI=IMYNL+NODPLC(LOC+5)
      VALUE(LOCY)=0.0D0
      VALUE(LOCYI)=-VAL
      LOC=NODPLC(LOC)
      GO TO 80
C
C  NONLINEAR VOLTAGE CONTROLLED CURRENT SOURCES
C
   90 LOC=LOCATE(5)
   95 IF ((LOC.EQ.0).OR.(NODPLC(LOC+13).NE.0)) GO TO 100
      NDIM=NODPLC(LOC+4)
      LMAT=NODPLC(LOC+7)
      LOCT=LX0+NODPLC(LOC+12)+2
      DO 97 I=1,NDIM
      VAL=VALUE(LOCT)
      LOCT=LOCT+2
      LOCY=LYNL+NODPLC(LMAT+1)
      VALUE(LOCY)=VALUE(LOCY)+VAL
      LOCY=LYNL+NODPLC(LMAT+2)
      VALUE(LOCY)=VALUE(LOCY)-VAL
      LOCY=LYNL+NODPLC(LMAT+3)
      VALUE(LOCY)=VALUE(LOCY)-VAL
      LOCY=LYNL+NODPLC(LMAT+4)
      VALUE(LOCY)=VALUE(LOCY)+VAL
      LMAT=LMAT+4
   97 CONTINUE
      LOC=NODPLC(LOC)
      GO TO 95
C
C  NONLINEAR VOLTAGE CONTROLLED VOLTAGE SOURCES
C
  100 LOC=LOCATE(6)
  105 IF ((LOC.EQ.0).OR.(NODPLC(LOC+14).NE.0)) GO TO 110
      NDIM=NODPLC(LOC+4)
      LMAT=NODPLC(LOC+8)
      LOCT=LX0+NODPLC(LOC+13)+3
      LOCY=LYNL+NODPLC(LMAT+1)
      LOCYI=IMYNL+NODPLC(LMAT+1)
      VALUE(LOCY)=+1.0D0
      VALUE(LOCYI)=0.0D0
      LOCY=LYNL+NODPLC(LMAT+2)
      LOCYI=IMYNL+NODPLC(LMAT+2)
      VALUE(LOCY)=-1.0D0
      VALUE(LOCYI)=0.0D0
      LOCY=LYNL+NODPLC(LMAT+3)
      LOCYI=IMYNL+NODPLC(LMAT+3)
      VALUE(LOCY)=+1.0D0
      VALUE(LOCYI)=0.0D0
      LOCY=LYNL+NODPLC(LMAT+4)
      LOCYI=IMYNL+NODPLC(LMAT+4)
      VALUE(LOCY)=-1.0D0
      VALUE(LOCYI)=0.0D0
      LMAT=LMAT+4
      DO 107 I=1,NDIM
      VAL=VALUE(LOCT)
      LOCT=LOCT+2
      LOCY=LYNL+NODPLC(LMAT+1)
      VALUE(LOCY)=VALUE(LOCY)-VAL
      LOCY=LYNL+NODPLC(LMAT+2)
      VALUE(LOCY)=VALUE(LOCY)+VAL
      LMAT=LMAT+2
  107 CONTINUE
      LOC=NODPLC(LOC)
      GO TO 105
C
C  NONLINEAR CURRENT CONTROLLED CURRENT SOURCES
C
  110 LOC=LOCATE(7)
  115 IF ((LOC.EQ.0).OR.(NODPLC(LOC+13).NE.0)) GO TO 120
      NDIM=NODPLC(LOC+4)
      LMAT=NODPLC(LOC+7)
      LOCT=LX0+NODPLC(LOC+12)+2
      DO 117 I=1,NDIM
      VAL=VALUE(LOCT)
      LOCT=LOCT+2
      LOCY=LYNL+NODPLC(LMAT+1)
      LOCYI=IMYNL+NODPLC(LMAT+1)
      VALUE(LOCY)=+VAL
      VALUE(LOCYI)=0.0D0
      LOCY=LYNL+NODPLC(LMAT+2)
      LOCYI=IMYNL+NODPLC(LMAT+2)
      VALUE(LOCY)=-VAL
      VALUE(LOCYI)=0.0D0
      LMAT=LMAT+2
  117 CONTINUE
      LOC=NODPLC(LOC)
      GO TO 115
C
C  NONLINEAR CURRENT CONTROLLED VOLTAGE SOURCES
C
  120 LOC=LOCATE(8)
  125 IF ((LOC.EQ.0).OR.(NODPLC(LOC+14).NE.0)) GO TO 140
      NDIM=NODPLC(LOC+4)
      LMAT=NODPLC(LOC+8)
      LOCT=LX0+NODPLC(LOC+13)+3
      LOCY=LYNL+NODPLC(LMAT+1)
      LOCYI=IMYNL+NODPLC(LMAT+1)
      VALUE(LOCY)=+1.0D0
      VALUE(LOCYI)=0.0D0
      LOCY=LYNL+NODPLC(LMAT+2)
      LOCYI=IMYNL+NODPLC(LMAT+2)
      VALUE(LOCY)=-1.0D0
      VALUE(LOCYI)=0.0D0
      LOCY=LYNL+NODPLC(LMAT+3)
      LOCYI=IMYNL+NODPLC(LMAT+3)
      VALUE(LOCY)=+1.0D0
      VALUE(LOCYI)=0.0D0
      LOCY=LYNL+NODPLC(LMAT+4)
      LOCYI=IMYNL+NODPLC(LMAT+4)
      VALUE(LOCY)=-1.0D0
      VALUE(LOCYI)=0.0D0
      LMAT=LMAT+4
      DO 127 I=1,NDIM
      VAL=VALUE(LOCT)
      LOCT=LOCT+2
      LOCY=LYNL+NODPLC(LMAT+I)
      VALUE(LOCY)=VALUE(LOCY)-VAL
  127 CONTINUE
      LOC=NODPLC(LOC)
      GO TO 125
C
C  VOLTAGE SOURCES
C
  140 LOC=LOCATE(9)
  150 IF ((LOC.EQ.0).OR.(NODPLC(LOC+11).NE.0)) GO TO 160
      LOCV=NODPLC(LOC+1)
      IPTR=NODPLC(LOC+6)
      VALUE(LVN+IPTR)=VALUE(LOCV+2)
      VALUE(IMVN+IPTR)=VALUE(LOCV+3)
      LOCY=LYNL+NODPLC(LOC+7)
      VALUE(LOCY)=VALUE(LOCY)+1.0D0
      LOCY=LYNL+NODPLC(LOC+8)
      VALUE(LOCY)=VALUE(LOCY)-1.0D0
      LOCY=LYNL+NODPLC(LOC+9)
      VALUE(LOCY)=VALUE(LOCY)+1.0D0
      LOCY=LYNL+NODPLC(LOC+10)
      VALUE(LOCY)=VALUE(LOCY)-1.0D0
      LOC=NODPLC(LOC)
      GO TO 150
C
C  CURRENT SOURCES
C
  160 LOC=LOCATE(10)
  170 IF ((LOC.EQ.0).OR.(NODPLC(LOC+6).NE.0)) GO TO 200
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      VALUE(LVN+NODE1)=VALUE(LVN+NODE1)-VALUE(LOCV+2)
      VALUE(IMVN+NODE1)=VALUE(IMVN+NODE1)-VALUE(LOCV+3)
      VALUE(LVN+NODE2)=VALUE(LVN+NODE2)+VALUE(LOCV+2)
      VALUE(IMVN+NODE2)=VALUE(IMVN+NODE2)+VALUE(LOCV+3)
      LOC=NODPLC(LOC)
      GO TO 170
C
C  DIODES
C
  200 LOC=LOCATE(11)
  210 IF ((LOC.EQ.0).OR.(NODPLC(LOC+16).NE.0)) GO TO 250
      LOCV=NODPLC(LOC+1)
      AREA=VALUE(LOCV+1)
      LOCM=NODPLC(LOC+5)
      LOCM=NODPLC(LOCM+1)
      LOCT=LX0+NODPLC(LOC+11)
      GSPR=VALUE(LOCM+2)*AREA
      GEQ=VALUE(LOCT+2)
      XCEQ=VALUE(LOCT+4)*OMEGA
      LOCY=LYNL+NODPLC(LOC+13)
      VALUE(LOCY)=VALUE(LOCY)+GSPR
      LOCY=LYNL+NODPLC(LOC+14)
      LOCYI=IMYNL+NODPLC(LOC+14)
      VALUE(LOCY)=VALUE(LOCY)+GEQ
      VALUE(LOCYI)=VALUE(LOCYI)+XCEQ
      LOCY=LYNL+NODPLC(LOC+15)
      LOCYI=IMYNL+NODPLC(LOC+15)
      VALUE(LOCY)=VALUE(LOCY)+GEQ+GSPR
      VALUE(LOCYI)=VALUE(LOCYI)+XCEQ
      LOCY=LYNL+NODPLC(LOC+7)
      VALUE(LOCY)=VALUE(LOCY)-GSPR
      LOCY=LYNL+NODPLC(LOC+8)
      LOCYI=IMYNL+NODPLC(LOC+8)
      VALUE(LOCY)=VALUE(LOCY)-GEQ
      VALUE(LOCYI)=VALUE(LOCYI)-XCEQ
      LOCY=LYNL+NODPLC(LOC+9)
      VALUE(LOCY)=VALUE(LOCY)-GSPR
      LOCY=LYNL+NODPLC(LOC+10)
      LOCYI=IMYNL+NODPLC(LOC+10)
      VALUE(LOCY)=VALUE(LOCY)-GEQ
      VALUE(LOCYI)=VALUE(LOCYI)-XCEQ
      LOC=NODPLC(LOC)
      GO TO 210
C
C  BJTS
C
  250 LOC=LOCATE(12)
  260 IF ((LOC.EQ.0).OR.(NODPLC(LOC+36).NE.0)) GO TO 300
      LOCV=NODPLC(LOC+1)
      AREA=VALUE(LOCV+1)
      LOCM=NODPLC(LOC+8)
      LOCM=NODPLC(LOCM+1)
      LOCT=LX0+NODPLC(LOC+22)
      GCPR=VALUE(LOCM+20)*AREA
      GEPR=VALUE(LOCM+19)*AREA
      GPI=VALUE(LOCT+4)
      GMU=VALUE(LOCT+5)
      GM=VALUE(LOCT+6)
      GO=VALUE(LOCT+7)
      XGM=0.0D0
      TD=VALUE(LOCM+28)
      IF(TD.EQ.0.0D0) GO TO 270
      ARG=TD*OMEGA
      GM=GM+GO
      XGM=-GM*DSIN(ARG)
      GM=GM*DCOS(ARG)-GO
  270 GX=VALUE(LOCT+16)
      XCPI=VALUE(LOCT+9)*OMEGA
      XCMU=VALUE(LOCT+11)*OMEGA
      XCBX=VALUE(LOCT+15)*OMEGA
      XCCS=VALUE(LOCT+13)*OMEGA
      XCMCB=VALUE(LOCT+17)*OMEGA
      LOCY=LYNL+NODPLC(LOC+24)
      VALUE(LOCY)=VALUE(LOCY)+GCPR
      LOCY=LYNL+NODPLC(LOC+25)
      LOCYI=IMYNL+NODPLC(LOC+25)
      VALUE(LOCY)=VALUE(LOCY)+GX
      VALUE(LOCYI)=VALUE(LOCYI)+XCBX
      LOCY=LYNL+NODPLC(LOC+26)
      VALUE(LOCY)=VALUE(LOCY)+GEPR
      LOCY=LYNL+NODPLC(LOC+27)
      LOCYI=IMYNL+NODPLC(LOC+27)
      VALUE(LOCY)=VALUE(LOCY)+GMU+GO+GCPR
      VALUE(LOCYI)=VALUE(LOCYI)+XCMU+XCCS+XCBX
      LOCY=LYNL+NODPLC(LOC+28)
      LOCYI=IMYNL+NODPLC(LOC+28)
      VALUE(LOCY)=VALUE(LOCY)+GX+GPI+GMU
      VALUE(LOCYI)=VALUE(LOCYI)+XCPI+XCMU+XCMCB
      LOCY=LYNL+NODPLC(LOC+29)
      LOCYI=IMYNL+NODPLC(LOC+29)
      VALUE(LOCY)=VALUE(LOCY)+GPI+GEPR+GM+GO
      VALUE(LOCYI)=VALUE(LOCYI)+XCPI+XGM
      LOCY=LYNL+NODPLC(LOC+10)
      VALUE(LOCY)=VALUE(LOCY)-GCPR
      LOCY=LYNL+NODPLC(LOC+11)
      VALUE(LOCY)=VALUE(LOCY)-GX
      LOCY=LYNL+NODPLC(LOC+12)
      VALUE(LOCY)=VALUE(LOCY)-GEPR
      LOCY=LYNL+NODPLC(LOC+13)
      VALUE(LOCY)=VALUE(LOCY)-GCPR
      LOCY=LYNL+NODPLC(LOC+14)
      LOCYI=IMYNL+NODPLC(LOC+14)
      VALUE(LOCY)=VALUE(LOCY)-GMU+GM
      VALUE(LOCYI)=VALUE(LOCYI)-XCMU+XGM
      LOCY=LYNL+NODPLC(LOC+15)
      LOCYI=IMYNL+NODPLC(LOC+15)
      VALUE(LOCY)=VALUE(LOCY)-GM-GO
      VALUE(LOCYI)=VALUE(LOCYI)-XGM
      LOCY=LYNL+NODPLC(LOC+16)
      VALUE(LOCY)=VALUE(LOCY)-GX
      LOCY=LYNL+NODPLC(LOC+17)
      LOCYI=IMYNL+NODPLC(LOC+17)
      VALUE(LOCY)=VALUE(LOCY)-GMU
      VALUE(LOCYI)=VALUE(LOCYI)-XCMU-XCMCB
      LOCY=LYNL+NODPLC(LOC+18)
      LOCYI=IMYNL+NODPLC(LOC+18)
      VALUE(LOCY)=VALUE(LOCY)-GPI
      VALUE(LOCYI)=VALUE(LOCYI)-XCPI
      LOCY=LYNL+NODPLC(LOC+19)
      VALUE(LOCY)=VALUE(LOCY)-GEPR
      LOCY=LYNL+NODPLC(LOC+20)
      LOCYI=IMYNL+NODPLC(LOC+20)
      VALUE(LOCY)=VALUE(LOCY)-GO
      VALUE(LOCYI)=VALUE(LOCYI)+XCMCB
      LOCY=LYNL+NODPLC(LOC+21)
      LOCYI=IMYNL+NODPLC(LOC+21)
      VALUE(LOCY)=VALUE(LOCY)-GPI-GM
      VALUE(LOCYI)=VALUE(LOCYI)-XCPI-XGM-XCMCB
      LOCYI=IMYNL+NODPLC(LOC+31)
      VALUE(LOCYI)=VALUE(LOCYI)+XCCS
      LOCYI=IMYNL+NODPLC(LOC+32)
      VALUE(LOCYI)=VALUE(LOCYI)-XCCS
      LOCYI=IMYNL+NODPLC(LOC+33)
      VALUE(LOCYI)=VALUE(LOCYI)-XCCS
      LOCYI=IMYNL+NODPLC(LOC+34)
      VALUE(LOCYI)=VALUE(LOCYI)-XCBX
      LOCYI=IMYNL+NODPLC(LOC+35)
      VALUE(LOCYI)=VALUE(LOCYI)-XCBX
      LOC=NODPLC(LOC)
      GO TO 260
C
C  JFETS
C
  300 LOC=LOCATE(13)
  310 IF ((LOC.EQ.0).OR.(NODPLC(LOC+25).NE.0)) GO TO 350
      LOCV=NODPLC(LOC+1)
      AREA=VALUE(LOCV+1)
      LOCM=NODPLC(LOC+7)
      LOCM=NODPLC(LOCM+1)
      LOCT=LX0+NODPLC(LOC+19)
      GDPR=VALUE(LOCM+4)*AREA
      GSPR=VALUE(LOCM+5)*AREA
      GM=VALUE(LOCT+5)
      GDS=VALUE(LOCT+6)
      GGS=VALUE(LOCT+7)
      XGS=VALUE(LOCT+9)*OMEGA
      GGD=VALUE(LOCT+8)
      XGD=VALUE(LOCT+11)*OMEGA
      LOCY=LYNL+NODPLC(LOC+20)
      VALUE(LOCY)=VALUE(LOCY)+GDPR
      LOCY=LYNL+NODPLC(LOC+21)
      LOCYI=IMYNL+NODPLC(LOC+21)
      VALUE(LOCY)=VALUE(LOCY)+GGD+GGS
      VALUE(LOCYI)=VALUE(LOCYI)+XGD+XGS
      LOCY=LYNL+NODPLC(LOC+22)
      VALUE(LOCY)=VALUE(LOCY)+GSPR
      LOCY=LYNL+NODPLC(LOC+23)
      LOCYI=IMYNL+NODPLC(LOC+23)
      VALUE(LOCY)=VALUE(LOCY)+GDPR+GDS+GGD
      VALUE(LOCYI)=VALUE(LOCYI)+XGD
      LOCY=LYNL+NODPLC(LOC+24)
      LOCYI=IMYNL+NODPLC(LOC+24)
      VALUE(LOCY)=VALUE(LOCY)+GSPR+GDS+GM+GGS
      VALUE(LOCYI)=VALUE(LOCYI)+XGS
      LOCY=LYNL+NODPLC(LOC+9)
      VALUE(LOCY)=VALUE(LOCY)-GDPR
      LOCY=LYNL+NODPLC(LOC+10)
      LOCYI=IMYNL+NODPLC(LOC+10)
      VALUE(LOCY)=VALUE(LOCY)-GGD
      VALUE(LOCYI)=VALUE(LOCYI)-XGD
      LOCY=LYNL+NODPLC(LOC+11)
      LOCYI=IMYNL+NODPLC(LOC+11)
      VALUE(LOCY)=VALUE(LOCY)-GGS
      VALUE(LOCYI)=VALUE(LOCYI)-XGS
      LOCY=LYNL+NODPLC(LOC+12)
      VALUE(LOCY)=VALUE(LOCY)-GSPR
      LOCY=LYNL+NODPLC(LOC+13)
      VALUE(LOCY)=VALUE(LOCY)-GDPR
      LOCY=LYNL+NODPLC(LOC+14)
      LOCYI=IMYNL+NODPLC(LOC+14)
      VALUE(LOCY)=VALUE(LOCY)-GGD+GM
      VALUE(LOCYI)=VALUE(LOCYI)-XGD
      LOCY=LYNL+NODPLC(LOC+15)
      VALUE(LOCY)=VALUE(LOCY)-GDS-GM
      LOCY=LYNL+NODPLC(LOC+16)
      LOCYI=IMYNL+NODPLC(LOC+16)
      VALUE(LOCY)=VALUE(LOCY)-GGS-GM
      VALUE(LOCYI)=VALUE(LOCYI)-XGS
      LOCY=LYNL+NODPLC(LOC+17)
      VALUE(LOCY)=VALUE(LOCY)-GSPR
      LOCY=LYNL+NODPLC(LOC+18)
      VALUE(LOCY)=VALUE(LOCY)-GDS
      LOC=NODPLC(LOC)
      GO TO 310
C
C  MOSFETS
C
  350 LOC=LOCATE(14)
  360 IF ((LOC.EQ.0).OR.(NODPLC(LOC+33).NE.0)) GO TO 400
      LOCV=NODPLC(LOC+1)
      LOCM=NODPLC(LOC+8)
      ITYPE=NODPLC(LOCM+2)
      LOCM=NODPLC(LOCM+1)
      DEVMOD=VALUE(LOCV+8)
      XNRM=1.0D0
      XREV=0.0D0
      IF (DEVMOD.GE.0.0D0) GO TO 370
      XNRM=0.0D0
      XREV=1.0D0
  370 LOCT=LX0+NODPLC(LOC+26)
      IF (VALUE(LOCM+7).EQ.0.0D0.AND.
     1   VALUE(LOCM+8).EQ.0.0D0) GO TO 375
      GDPR=VALUE(LOCM+7)
      GSPR=VALUE(LOCM+8)
      GO TO 380
  375 GDPR=VALUE(LOCM+16)/VALUE(LOCV+13)
      GSPR=VALUE(LOCM+16)/VALUE(LOCV+14)
  380 GM=VALUE(LOCT+7)
      GDS=VALUE(LOCT+8)
      GMBS=VALUE(LOCT+9)
      GBD=VALUE(LOCT+10)
      GBS=VALUE(LOCT+11)
      CAPBD=VALUE(LOCT+24)
      CAPBS=VALUE(LOCT+26)
CC
CC    CHARGE ORIENTED MODEL PARAMETERS
CC
      XL=VALUE(LOCV+1)-2.0D0*VALUE(LOCM+28)
      XW=VALUE(LOCV+2)
      XQCO=VALUE(LOCM+35)
      XQC=VALUE(LOCV+15)
      COVLGS=VALUE(LOCM+13)*XW
      COVLGD=VALUE(LOCM+14)*XW
      COVLGB=VALUE(LOCM+15)*XL
      IF (XQCO.GT.0.5D0) GO TO 385
      CGGB=VALUE(LOCT+18)
      CGDB=VALUE(LOCT+19)
      CGSB=VALUE(LOCT+20)
      CBGB=VALUE(LOCT+21)
      CBDB=VALUE(LOCT+22)
      CBSB=VALUE(LOCT+23)
      GCG=(CGGB+CBGB)*OMEGA
      GCD=(CGDB+CBDB)*OMEGA
      GCS=(CGSB+CBSB)*OMEGA
      XCGXD=-XQC*GCG
      XCGXS=-(1.0D0-XQC)*GCG
      XCDXD=-XQC*GCD
      XCDXS=-(1.0D0-XQC)*GCD
      XCSXD=-XQC*GCS
      XCSXS=-(1.0D0-XQC)*GCS
      XCDGB=XCGXD-COVLGD*OMEGA
      XCDDB=XCDXD+(CAPBD+COVLGD)*OMEGA
      XCDSB=XCSXD
      XCSGB=XCGXS-COVLGS*OMEGA
      XCSDB=XCDXS
      XCSSB=XCSXS+(CAPBS+COVLGS)*OMEGA
      XCGGB=(CGGB+COVLGD+COVLGS+COVLGB)*OMEGA
      XCGDB=(CGDB-COVLGD)*OMEGA
      XCGSB=(CGSB-COVLGS)*OMEGA
      XCBGB=(CBGB-COVLGB)*OMEGA
      XCBDB=(CBDB-CAPBD)*OMEGA
      XCBSB=(CBSB-CAPBS)*OMEGA
      GO TO 390
C
C     MEYER"S MODEL PARAMETERS
C
  385 XCGS=(VALUE(LOCT+12)+COVLGS)*OMEGA
      XCGD=(VALUE(LOCT+14)+COVLGD)*OMEGA
      XCGB=(VALUE(LOCT+16)+COVLGB)*OMEGA
      XBD=CAPBD*OMEGA
      XBS=CAPBS*OMEGA
CC
CC    DO THE MAPPING FROM MEYER"S MODEL INTO CHARGE ORIENTED MODEL
CC
      XCGGB=XCGD+XCGS+XCGB
      XCGDB=-XCGD
      XCGSB=-XCGS
      XCBGB=-XCGB
      XCBDB=-XBD
      XCBSB=-XBS
      XCDDB=XCGD+XBD
      XCSSB=XCGS+XBS
CC    XCGSB=-XCGB
      XCDGB=-XCGD
      XCSGB=-XCGS
      XCDSB=0.0D0
      XCSDB=0.0D0
CC
  390 LOCYI=IMYNL+NODPLC(LOC+28)
      VALUE(LOCYI)=VALUE(LOCYI)+XCGGB
      LOCYI=IMYNL+NODPLC(LOC+30)
      VALUE(LOCYI)=VALUE(LOCYI)-XCBGB-XCBDB-XCBSB
      LOCYI=IMYNL+NODPLC(LOC+31)
      VALUE(LOCYI)=VALUE(LOCYI)+XCDDB
      LOCYI=IMYNL+NODPLC(LOC+32)
      VALUE(LOCYI)=VALUE(LOCYI)+XCSSB
      LOCYI=IMYNL+NODPLC(LOC+11)
      VALUE(LOCYI)=VALUE(LOCYI)-XCGGB-XCGDB-XCGSB
      LOCYI=IMYNL+NODPLC(LOC+12)
      VALUE(LOCYI)=VALUE(LOCYI)+XCGDB
      LOCYI=IMYNL+NODPLC(LOC+13)
      VALUE(LOCYI)=VALUE(LOCYI)+XCGSB
      LOCYI=IMYNL+NODPLC(LOC+15)
      VALUE(LOCYI)=VALUE(LOCYI)+XCBGB
      LOCYI=IMYNL+NODPLC(LOC+16)
      VALUE(LOCYI)=VALUE(LOCYI)+XCBDB
      LOCYI=IMYNL+NODPLC(LOC+17)
      VALUE(LOCYI)=VALUE(LOCYI)+XCBSB
      LOCYI=IMYNL+NODPLC(LOC+19)
      VALUE(LOCYI)=VALUE(LOCYI)+XCDGB
      LOCYI=IMYNL+NODPLC(LOC+20)
      VALUE(LOCYI)=VALUE(LOCYI)-XCDGB-XCDDB-XCDSB
      LOCYI=IMYNL+NODPLC(LOC+21)
      VALUE(LOCYI)=VALUE(LOCYI)+XCDSB
      LOCYI=IMYNL+NODPLC(LOC+22)
      VALUE(LOCYI)=VALUE(LOCYI)+XCSGB
      LOCYI=IMYNL+NODPLC(LOC+24)
      VALUE(LOCYI)=VALUE(LOCYI)-XCSGB-XCSDB-XCSSB
      LOCYI=IMYNL+NODPLC(LOC+25)
      VALUE(LOCYI)=VALUE(LOCYI)+XCSDB
      LOCY=LYNL+NODPLC(LOC+27)
      VALUE(LOCY)=VALUE(LOCY)+GDPR
      LOCY=LYNL+NODPLC(LOC+29)
      VALUE(LOCY)=VALUE(LOCY)+GSPR
      LOCY=LYNL+NODPLC(LOC+30)
      VALUE(LOCY)=VALUE(LOCY)+GBD+GBS
      LOCY=LYNL+NODPLC(LOC+31)
      VALUE(LOCY)=VALUE(LOCY)+GDPR+GDS+GBD+XREV*(GM+GMBS)
      LOCY=LYNL+NODPLC(LOC+32)
      VALUE(LOCY)=VALUE(LOCY)+GSPR+GDS+GBS+XNRM*(GM+GMBS)
      LOCY=LYNL+NODPLC(LOC+10)
      VALUE(LOCY)=VALUE(LOCY)-GDPR
      LOCY=LYNL+NODPLC(LOC+14)
      VALUE(LOCY)=VALUE(LOCY)-GSPR
      LOCY=LYNL+NODPLC(LOC+16)
      VALUE(LOCY)=VALUE(LOCY)-GBD
      LOCY=LYNL+NODPLC(LOC+17)
      VALUE(LOCY)=VALUE(LOCY)-GBS
      LOCY=LYNL+NODPLC(LOC+18)
      VALUE(LOCY)=VALUE(LOCY)-GDPR
      LOCY=LYNL+NODPLC(LOC+19)
      VALUE(LOCY)=VALUE(LOCY)+(XNRM-XREV)*GM
      LOCY=LYNL+NODPLC(LOC+20)
      VALUE(LOCY)=VALUE(LOCY)-GBD+(XNRM-XREV)*GMBS
      LOCY=LYNL+NODPLC(LOC+21)
      VALUE(LOCY)=VALUE(LOCY)-GDS-XNRM*(GM+GMBS)
      LOCY=LYNL+NODPLC(LOC+22)
      VALUE(LOCY)=VALUE(LOCY)-(XNRM-XREV)*GM
      LOCY=LYNL+NODPLC(LOC+23)
      VALUE(LOCY)=VALUE(LOCY)-GSPR
      LOCY=LYNL+NODPLC(LOC+24)
      VALUE(LOCY)=VALUE(LOCY)-GBS-(XNRM-XREV)*GMBS
      LOCY=LYNL+NODPLC(LOC+25)
      VALUE(LOCY)=VALUE(LOCY)-GDS-XREV*(GM+GMBS)
      LOC=NODPLC(LOC)
      GO TO 360
C
C  TRANSMISSION LINES
C
  400 LOC=LOCATE(17)
  410 IF ((LOC.EQ.0).OR.(NODPLC(LOC+33).NE.0)) GO TO 1000
      LOCV=NODPLC(LOC+1)
      Z0=VALUE(LOCV+1)
      Y0=1.0D0/Z0
      TD=VALUE(LOCV+2)
      ARG=-OMEGA*TD
      RVAL=DCOS(ARG)
      XVAL=DSIN(ARG)
      LOCY=LYNL+NODPLC(LOC+10)
      VALUE(LOCY)=VALUE(LOCY)+Y0
      LOCY=LYNL+NODPLC(LOC+11)
      LOCYI=IMYNL+NODPLC(LOC+11)
      VALUE(LOCY)=-Y0
      VALUE(LOCYI)=0.0D0
      LOCY=LYNL+NODPLC(LOC+12)
      LOCYI=IMYNL+NODPLC(LOC+12)
      VALUE(LOCY)=-1.0D0
      VALUE(LOCYI)=0.0D0
      LOCY=LYNL+NODPLC(LOC+13)
      VALUE(LOCY)=VALUE(LOCY)+Y0
      LOCY=LYNL+NODPLC(LOC+14)
      LOCYI=IMYNL+NODPLC(LOC+14)
      VALUE(LOCY)=-1.0D0
      VALUE(LOCYI)=0.0D0
      LOCY=LYNL+NODPLC(LOC+15)
      LOCYI=IMYNL+NODPLC(LOC+15)
      VALUE(LOCY)=-Y0
      VALUE(LOCYI)=0.0D0
      LOCY=LYNL+NODPLC(LOC+16)
      LOCYI=IMYNL+NODPLC(LOC+16)
      VALUE(LOCY)=+Y0
      VALUE(LOCYI)=0.0D0
      LOCY=LYNL+NODPLC(LOC+17)
      LOCYI=IMYNL+NODPLC(LOC+17)
      VALUE(LOCY)=+1.0D0
      VALUE(LOCYI)=0.0D0
      LOCY=LYNL+NODPLC(LOC+18)
      LOCYI=IMYNL+NODPLC(LOC+18)
      VALUE(LOCY)=+Y0
      VALUE(LOCYI)=0.0D0
      LOCY=LYNL+NODPLC(LOC+19)
      LOCYI=IMYNL+NODPLC(LOC+19)
      VALUE(LOCY)=+1.0D0
      VALUE(LOCYI)=0.0D0
      LOCY=LYNL+NODPLC(LOC+20)
      LOCYI=IMYNL+NODPLC(LOC+20)
      VALUE(LOCY)=-1.0D0
      VALUE(LOCYI)=0.0D0
      LOCY=LYNL+NODPLC(LOC+21)
      LOCYI=IMYNL+NODPLC(LOC+21)
      VALUE(LOCY)=-RVAL
      VALUE(LOCYI)=-XVAL
      LOCY=LYNL+NODPLC(LOC+22)
      LOCYI=IMYNL+NODPLC(LOC+22)
      VALUE(LOCY)=+RVAL
      VALUE(LOCYI)=+XVAL
      LOCY=LYNL+NODPLC(LOC+23)
      LOCYI=IMYNL+NODPLC(LOC+23)
      VALUE(LOCY)=+1.0D0
      VALUE(LOCYI)=0.0D0
      LOCY=LYNL+NODPLC(LOC+24)
      LOCYI=IMYNL+NODPLC(LOC+24)
      VALUE(LOCY)=-RVAL*Z0
      VALUE(LOCYI)=-XVAL*Z0
      LOCY=LYNL+NODPLC(LOC+25)
      LOCYI=IMYNL+NODPLC(LOC+25)
      VALUE(LOCY)=-RVAL
      VALUE(LOCYI)=-XVAL
      LOCY=LYNL+NODPLC(LOC+26)
      LOCYI=IMYNL+NODPLC(LOC+26)
      VALUE(LOCY)=+RVAL
      VALUE(LOCYI)=+XVAL
      LOCY=LYNL+NODPLC(LOC+27)
      LOCYI=IMYNL+NODPLC(LOC+27)
      VALUE(LOCY)=-1.0D0
      VALUE(LOCYI)=0.0D0
      LOCY=LYNL+NODPLC(LOC+28)
      LOCYI=IMYNL+NODPLC(LOC+28)
      VALUE(LOCY)=+1.0D0
      VALUE(LOCYI)=0.0D0
      LOCY=LYNL+NODPLC(LOC+29)
      LOCYI=IMYNL+NODPLC(LOC+29)
      VALUE(LOCY)=-RVAL*Z0
      VALUE(LOCYI)=-XVAL*Z0
      LOCY=LYNL+NODPLC(LOC+31)
      LOCYI=IMYNL+NODPLC(LOC+31)
      VALUE(LOCY)=-Y0
      VALUE(LOCYI)=0.0D0
      LOCY=LYNL+NODPLC(LOC+32)
      LOCYI=IMYNL+NODPLC(LOC+32)
      VALUE(LOCY)=-Y0
      VALUE(LOCYI)=0.0D0
      LOC=NODPLC(LOC)
      GO TO 410
C
C  FINISHED
C
 1000 RETURN
      END
      SUBROUTINE NOISE(LOCO)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE COMPUTES THE NOISE DUE TO VARIOUS CIRCUIT ELEMENTS.
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=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=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(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C
      DIMENSION VNO1(12),VNO2(12),VNO3(12),VNO4(12),VNO5(12),VNO6(12)
      DIMENSION VNTOT(12),ANAM(12),STRING(5)
      REAL V,VREAL,VIMAG
      DIMENSION TITLN(4),V(2)
      DIMENSION AFMT1(3),AFMT2(3)
      COMPLEX CVAL,C(1)
      EQUIVALENCE (C(1),V(1),CVAL)
      EQUIVALENCE (V(1),VREAL),(V(2),VIMAG)
      DATA TITLN / 8HNOISE AN, 8HALYSIS  , 8H        , 8H         /
      DATA ALSRB,ALSRC,ALSRE,ALSRS,ALSRD / 2HRB,2HRC,2HRE,2HRS,2HRD /
      DATA ALSIB,ALSIC,ALSID,ALSFN / 2HIB,2HIC,2HID,2HFN /
      DATA ALSTOT / 5HTOTAL /
      DATA ASLASH,ABLNK / 1H/, 1H  /
      DATA AFMT1 /8H(////,11,8HX,  (2X,,8HA8))    /
      DATA AFMT2 /8H(1H ,A8,,8H1P  D10.,8H3)      /
C
C
C.. FIX-UP FORMATS
      KNTR=12
      IF(LWIDTH.LE.80) KNTR=7
      IPOS=11
      CALL MOVE(AFMT1,IPOS,ABLNK,1,2)
      CALL ALFNUM(KNTR,AFMT1,IPOS)
      IPOS=11
      CALL MOVE(AFMT2,IPOS,ABLNK,1,2)
      CALL ALFNUM(KNTR,AFMT2,IPOS)
      NPRNT=0
      FREQ=OMEGA/TWOPI
      IF (ICALC.GE.2) GO TO 10
      FOURKT=4.0D0*CHARGE*VT
      TWOQ=2.0D0*CHARGE
      NOPOSO=NODPLC(NOSOUT+2)
      NONEGO=NODPLC(NOSOUT+3)
      KNTLIM=LWIDTH/11
      NKNTR=1
   10 IF (NOSPRT.EQ.0) GO TO 30
      IF (NKNTR.GT.ICALC) GO TO 30
      NPRNT=1
      NKNTR=NKNTR+NOSPRT
      CALL TITLE(0,LWIDTH,1,TITLN)
      WRITE (IOFILE,16) FREQ
   16 FORMAT('    FREQUENCY = ',1PD10.3,' HZ'/)
C
C  OBTAIN ADJOINT CIRCUIT SOLUTION
C
   30 VNRMS=0.0D0
      CVAL=CVALUE(LCVN+NOPOSO)-CVALUE(LCVN+NONEGO)
      VOUT=DSQRT(DBLE(VREAL*VREAL)+DBLE(VIMAG*VIMAG))
      VOUT=DMAX1(VOUT,1.0D-20)
      CALL ZERO8(VALUE(LVN+1),NSTOP)
      CALL ZERO8(VALUE(IMVN+1),NSTOP)
      VALUE(LVN+NOPOSO)=-1.0D0
      VALUE(LVN+NONEGO)=+1.0D0
      CALL ACASOL
C
C  RESISTORS
C
      IF (JELCNT(1).EQ.0) GO TO 200
      ITITLE=0
   91 FORMAT(//'**** RESISTOR SQUARED NOISE VOLTAGES (SQ V/HZ)')
  100 LOC=LOCATE(1)
      KNTR=0
  110 IF ((LOC.EQ.0).OR.(NODPLC(LOC+8).NE.0)) GO TO 130
      KNTR=KNTR+1
      LOCV=NODPLC(LOC+1)
      ANAM(KNTR)=VALUE(LOCV)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      CVAL=CVALUE(LCVN+NODE1)-CVALUE(LCVN+NODE2)
      VNTOT(KNTR)=(DBLE(VREAL*VREAL)+DBLE(VIMAG*VIMAG))
     1   *FOURKT*VALUE(LOCV+1)
      VNRMS=VNRMS+VNTOT(KNTR)
      IF (KNTR.GE.KNTLIM) GO TO 140
  120 LOC=NODPLC(LOC)
      GO TO 110
  130 IF (KNTR.EQ.0) GO TO 200
  140 IF (NPRNT.EQ.0) GO TO 160
      IF (ITITLE.EQ.0) WRITE (IOFILE,91)
      ITITLE=1
      WRITE (IOFILE,AFMT1) (ANAM(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) ALSTOT,(VNTOT(I),I=1,KNTR)
  160 KNTR=0
      IF (LOC.NE.0) GO TO 120
C
C  DIODES
C
  200 IF (JELCNT(11).EQ.0) GO TO 300
      ITITLE=0
  201 FORMAT(//'**** DIODE SQUARED NOISE VOLTAGES (SQ V/HZ)')
  210 LOC=LOCATE(11)
      KNTR=0
  220 IF ((LOC.EQ.0).OR.(NODPLC(LOC+16).NE.0)) GO TO 240
      KNTR=KNTR+1
      LOCV=NODPLC(LOC+1)
      ANAM(KNTR)=VALUE(LOCV)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      NODE3=NODPLC(LOC+4)
      LOCM=NODPLC(LOC+5)
      LOCM=NODPLC(LOCM+1)
      LOCT=NODPLC(LOC+11)
      AREA=VALUE(LOCV+1)
      FNK=VALUE(LOCM+10)
      FNA=VALUE(LOCM+11)
C
C  OHMIC RESISTANCE
C
      CVAL=CVALUE(LCVN+NODE1)-CVALUE(LCVN+NODE3)
      VNO1(KNTR)=(DBLE(VREAL*VREAL)+DBLE(VIMAG*VIMAG))
     1   *FOURKT*VALUE(LOCM+2)*AREA
C
C  JUNCTION SHOT NOISE AND FLICKER NOISE
C
      CVAL=CVALUE(LCVN+NODE3)-CVALUE(LCVN+NODE2)
      VTEMP=DBLE(VREAL*VREAL)+DBLE(VIMAG*VIMAG)
      ARG=DMAX1(DABS(VALUE(LX0+LOCT+1)),1.0D-20)
      VNO2(KNTR)=VTEMP*TWOQ*ARG
      VNO3(KNTR)=VTEMP*FNK*DEXP(FNA*DLOG(ARG))/FREQ
      VNTOT(KNTR)=VNO1(KNTR)+VNO2(KNTR)+VNO3(KNTR)
      VNRMS=VNRMS+VNTOT(KNTR)
      IF (KNTR.GE.KNTLIM) GO TO 250
  230 LOC=NODPLC(LOC)
      GO TO 220
  240 IF (KNTR.EQ.0) GO TO 300
  250 IF (NPRNT.EQ.0) GO TO 260
      IF (ITITLE.EQ.0) WRITE (IOFILE,201)
      ITITLE=1
      WRITE (IOFILE,AFMT1) (ANAM(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) ALSRS,(VNO1(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) ALSID,(VNO2(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) ALSFN,(VNO3(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) ALSTOT,(VNTOT(I),I=1,KNTR)
  260 KNTR=0
      IF (LOC.NE.0) GO TO 230
C
C  BIPOLAR JUNCTION TRANSISTORS
C
  300 IF (JELCNT(12).EQ.0) GO TO 400
      ITITLE=0
  301 FORMAT(//'**** TRANSISTOR SQUARED NOISE VOLTAGES (SQ V/HZ)')
  310 LOC=LOCATE(12)
      KNTR=0
  320 IF ((LOC.EQ.0).OR.(NODPLC(LOC+36).NE.0)) GO TO 340
      KNTR=KNTR+1
      LOCV=NODPLC(LOC+1)
      ANAM(KNTR)=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)
      LOCM=NODPLC(LOCM+1)
      LOCT=NODPLC(LOC+22)
      AREA=VALUE(LOCV+1)
      FNK=VALUE(LOCM+44)
      FNA=VALUE(LOCM+45)
C
C  EXTRINSIC RESISTANCES
C
C...  BASE RESISTANCE
      CVAL=CVALUE(LCVN+NODE2)-CVALUE(LCVN+NODE5)
      VNO1(KNTR)=(DBLE(VREAL*VREAL)+DBLE(VIMAG*VIMAG))
     1  *FOURKT*VALUE(LX0+LOCT+16)
C...  COLLECTOR RESISTANCE
      CVAL=CVALUE(LCVN+NODE1)-CVALUE(LCVN+NODE4)
      VNO2(KNTR)=(DBLE(VREAL*VREAL)+DBLE(VIMAG*VIMAG))
     1   *FOURKT*VALUE(LOCM+20)*AREA
C...  EMITTER RESISTANCE
      CVAL=CVALUE(LCVN+NODE3)-CVALUE(LCVN+NODE6)
      VNO3(KNTR)=(DBLE(VREAL*VREAL)+DBLE(VIMAG*VIMAG))
     1   *FOURKT*VALUE(LOCM+19)*AREA
C
C  BASE CURRENT SHOT NOISE AND FLICKER NOISE
C
      CVAL=CVALUE(LCVN+NODE5)-CVALUE(LCVN+NODE6)
      VTEMP=DBLE(VREAL*VREAL)+DBLE(VIMAG*VIMAG)
      ARG=DMAX1(DABS(VALUE(LX0+LOCT+3)),1.0D-20)
      VNO4(KNTR)=VTEMP*TWOQ*ARG
      VNO5(KNTR)=VTEMP*FNK*DEXP(FNA*DLOG(ARG))/FREQ
C
C  COLLECTOR CURRENT SHOT NOISE
C
      CVAL=CVALUE(LCVN+NODE4)-CVALUE(LCVN+NODE6)
      VNO6(KNTR)=(DBLE(VREAL*VREAL)+DBLE(VIMAG*VIMAG))
     1   *TWOQ*DABS(VALUE(LX0+LOCT+2))
      VNTOT(KNTR)=VNO1(KNTR)+VNO2(KNTR)+VNO3(KNTR)+VNO4(KNTR)+VNO5(KNTR)
     1   +VNO6(KNTR)
      VNRMS=VNRMS+VNTOT(KNTR)
      IF (KNTR.GE.KNTLIM) GO TO 350
  330 LOC=NODPLC(LOC)
      GO TO 320
  340 IF (KNTR.EQ.0) GO TO 400
  350 IF (NPRNT.EQ.0) GO TO 360
      IF (ITITLE.EQ.0) WRITE (IOFILE,301)
      ITITLE=1
      WRITE (IOFILE,AFMT1) (ANAM(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) ALSRB,(VNO1(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) ALSRC,(VNO2(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) ALSRE,(VNO3(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) ALSIB,(VNO4(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) ALSIC,(VNO6(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) ALSFN,(VNO5(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) ALSTOT,(VNTOT(I),I=1,KNTR)
  360 KNTR=0
      IF (LOC.NE.0) GO TO 330
C
C  JFETS
C
  400 IF (JELCNT(13).EQ.0) GO TO 500
      ITITLE=0
  401 FORMAT(//'**** JFET SQUARED NOISE VOLTAGES (SQ V/HZ)')
  410 LOC=LOCATE(13)
      KNTR=0
  420 IF ((LOC.EQ.0).OR.(NODPLC(LOC+25).NE.0)) GO TO 440
      KNTR=KNTR+1
      LOCV=NODPLC(LOC+1)
      ANAM(KNTR)=VALUE(LOCV)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      NODE3=NODPLC(LOC+4)
      NODE4=NODPLC(LOC+5)
      NODE5=NODPLC(LOC+6)
      LOCM=NODPLC(LOC+7)
      LOCM=NODPLC(LOCM+1)
      LOCT=NODPLC(LOC+19)
      AREA=VALUE(LOCV+1)
      FNK=VALUE(LOCM+10)
      FNA=VALUE(LOCM+11)
C
C  EXTRINSIC RESISTANCES
C
C...  DRAIN RESISTANCE
      CVAL=CVALUE(LCVN+NODE1)-CVALUE(LCVN+NODE4)
      VNO1(KNTR)=(DBLE(VREAL*VREAL)+DBLE(VIMAG*VIMAG))
     1   *FOURKT*VALUE(LOCM+4)*AREA
C...  SOURCE RESISTANCE
      CVAL=CVALUE(LCVN+NODE3)-CVALUE(LCVN+NODE5)
      VNO2(KNTR)=(DBLE(VREAL*VREAL)+DBLE(VIMAG*VIMAG))
     1   *FOURKT*VALUE(LOCM+5)*AREA
C
C  DRAIN CURRENT SHOT NOISE AND FLICKER NOISE
C
      CVAL=CVALUE(LCVN+NODE4)-CVALUE(LCVN+NODE5)
      VTEMP=DBLE(VREAL*VREAL)+DBLE(VIMAG*VIMAG)
      VNO3(KNTR)=VTEMP*FOURKT*2.0D0*DABS(VALUE(LX0+LOCT+5))/3.0D0
      ARG=DMAX1(DABS(VALUE(LX0+LOCT+3)),1.0D-20)
      VNO4(KNTR)=VTEMP*FNK*DEXP(FNA*DLOG(ARG))/FREQ
      VNTOT(KNTR)=VNO1(KNTR)+VNO2(KNTR)+VNO3(KNTR)+VNO4(KNTR)
      VNRMS=VNRMS+VNTOT(KNTR)
      IF (KNTR.GE.KNTLIM) GO TO 450
  430 LOC=NODPLC(LOC)
      GO TO 420
  440 IF (KNTR.EQ.0) GO TO 500
  450 IF (NPRNT.EQ.0) GO TO 460
      IF (ITITLE.EQ.0) WRITE (IOFILE,401)
      ITITLE=1
      WRITE (IOFILE,AFMT1) (ANAM(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) ALSRD,(VNO1(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) ALSRS,(VNO2(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) ALSID,(VNO3(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) ALSFN,(VNO4(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) ALSTOT,(VNTOT(I),I=1,KNTR)
  460 KNTR=0
      IF (LOC.NE.0) GO TO 430
C
C  MOSFETS
C
  500 IF (JELCNT(14).EQ.0) GO TO 600
      ITITLE=0
  501 FORMAT(//'**** MOSFET SQUARED NOISE VOLTAGES (SQ V/HZ)')
  510 LOC=LOCATE(14)
      KNTR=0
  520 IF ((LOC.EQ.0).OR.(NODPLC(LOC+33).NE.0)) GO TO 540
      KNTR=KNTR+1
      LOCV=NODPLC(LOC+1)
      ANAM(KNTR)=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)
      ITYPE=NODPLC(LOCM+2)
      LOCT=NODPLC(LOC+26)
      LOCM=NODPLC(LOCM+1)
      XL=VALUE(LOCV+1)-2.0D0*VALUE(LOCM+28)
      XW=VALUE(LOCV+2)
      COX=VALUE(LOCM+22)
      IF (COX.LE.0.0D0) COX=EPSOX/1.0D-7
      FNK=VALUE(LOCM+36)
      FNA=VALUE(LOCM+37)
C
C  EXTRINSIC RESISTANCES
C
      IF ((VALUE(LOCM+7).LE.0.0D0).AND.
     1   (VALUE(LOCM+8).LE.0.0D0)) GO TO 522
      GDPR=VALUE(LOCM+7)
      GSPR=VALUE(LOCM+8)
      GO TO 524
  522 GDPR=VALUE(LOCM+16)/VALUE(LOCV+13)
      GSPR=VALUE(LOCM+16)/VALUE(LOCV+14)
C...  DRAIN RESISTANCE
  524 CVAL=CVALUE(LCVN+NODE1)-CVALUE(LCVN+NODE5)
      VNO1(KNTR)=(DBLE(VREAL*VREAL)+DBLE(VIMAG*VIMAG))*FOURKT*GDPR
C...  SOURCE RESISTANCE
      CVAL=CVALUE(LCVN+NODE3)-CVALUE(LCVN+NODE6)
      VNO2(KNTR)=(DBLE(VREAL*VREAL)+DBLE(VIMAG*VIMAG))*FOURKT*GSPR
C
C  DRAIN CURRENT SHOT NOISE AND FLICKER NOISE
C
      CVAL=CVALUE(LCVN+NODE5)-CVALUE(LCVN+NODE6)
      VTEMP=DBLE(VREAL*VREAL)+DBLE(VIMAG*VIMAG)
      GM=VALUE(LX0+LOCT+7)
      ARG=DMAX1(DABS(VALUE(LX0+LOCT+4)),1.0D-20)
      VNO3(KNTR)=VTEMP*FOURKT*DABS(GM)/1.5D0
      VNO4(KNTR)=VTEMP*FNK*DEXP(FNA*DLOG(ARG))/(FREQ*COX*XL*XL)
  525 VNTOT(KNTR)=VNO1(KNTR)+VNO2(KNTR)+VNO3(KNTR)+VNO4(KNTR)
      VNRMS=VNRMS+VNTOT(KNTR)
      IF (KNTR.GE.KNTLIM) GO TO 550
  530 LOC=NODPLC(LOC)
      GO TO 520
  540 IF (KNTR.EQ.0) GO TO 600
  550 IF (NPRNT.EQ.0) GO TO 560
      IF (ITITLE.EQ.0) WRITE (IOFILE,501)
      ITITLE=1
      WRITE (IOFILE,AFMT1) (ANAM(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) ALSRD,(VNO1(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) ALSRS,(VNO2(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) ALSID,(VNO3(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) ALSFN,(VNO4(I),I=1,KNTR)
      WRITE (IOFILE,AFMT2) ALSTOT,(VNTOT(I),I=1,KNTR)
  560 KNTR=0
      IF (LOC.NE.0) GO TO 530
C
C  COMPUTE EQUIVALENT INPUT NOISE VOLTAGE
C
  600 VNOUT=DSQRT(VNRMS)
      VNIN=VNOUT/VOUT
      IF (NPRNT.EQ.0) GO TO 620
      DO 610 I=1,5
      STRING(I)=ABLNK
  610 CONTINUE
      IOUTYP=1
      IPOS=1
      CALL OUTNAM(NOSOUT,IOUTYP,STRING,IPOS)
      CALL MOVE(STRING,IPOS,ASLASH,1,1)
      IPOS=IPOS+1
      LOCV=NODPLC(NOSIN+1)
      ANAM1=VALUE(LOCV)
      CALL MOVE(STRING,IPOS,ANAM1,1,8)
      WRITE (IOFILE,611) VNRMS,VNOUT,STRING,VOUT,ANAM1,VNIN
  611 FORMAT(////,
     1   '**** TOTAL OUTPUT NOISE VOLTAGE',9X,'= ',1PD10.3,' SQ V/HZ'/,
     2   40X,'= ',D10.3,' V/RT HZ'/,
     3   '     TRANSFER FUNCTION VALUE:',/,
     4   7X,4A8,A1,'= ',D10.3,/,
     5   '     EQUIVALENT INPUT NOISE AT ',A8,' = ',D10.3,' /RT HZ')
C
C  SAVE NOISE OUTPUTS
C
  620 LOC=LOCATE(44)
  630 IF (LOC.EQ.0) GO TO 1000
      ISEQ=NODPLC(LOC+4)
      IF (NODPLC(LOC+5).NE.2) GO TO 640
      CVALUE(LOCO+ISEQ)=VNOUT
      GO TO 650
  640 CVALUE(LOCO+ISEQ)=VNIN
  650 LOC=NODPLC(LOC)
      GO TO 630
C
C  FINISHED
C
 1000 RETURN
      END
      SUBROUTINE ACASOL
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE EVALUATES THE RESPONSE OF THE ADJOINT CIRCUIT BY
C DOING A FORWARD/BACKWARD SUBSTITUTION STEP USING THE TRANSPOSE OF THE
C CIRCUIT EQUATION COEFFICIENT MATRIX.
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=BLANK 3/15/83
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C  EVALUATES ADJOINT RESPONSE BY DOING FORWARD/BACKWARD SUBSTITUTION ON
C  THE TRANSPOSE OF THE Y MATRIX
C
C  FORWARD SUBSTITUTION
C
      DO 20 I=2,NSTOP
      LOC=I
      IORD=NODPLC(ICSWPF+I)
   10 LOC=NODPLC(IRPT+LOC)
      IF (NODPLC(IROWNO+LOC).GE.I) GO TO 15
      J=NODPLC(IROWNO+LOC)
      JORD=NODPLC(ICSWPF+J)
      CALL CMULT(VALUE(LYNL+LOC),VALUE(IMYNL+LOC),
     1     VALUE(LVN+JORD),VALUE(IMVN+JORD),XREAL,XIMAG)
      VALUE(LVN+IORD)=VALUE(LVN+IORD)-XREAL
      VALUE(IMVN+IORD)=VALUE(IMVN+IORD)-XIMAG
      GO TO 10
   15 JORD=NODPLC(IRSWPF+I)
      LOCNN=INDXX(JORD,IORD)
      CALL CDIV(VALUE(LVN+IORD),VALUE(IMVN+IORD),VALUE(LYNL+LOCNN),
     1     VALUE(IMYNL+LOCNN),VALUE(LVN+IORD),VALUE(IMVN+IORD))
   20 CONTINUE
C
C  BACKWARD SUBSTITUTION
C
      I=NSTOP
   30 I=I-1
      IF (I.LE.1) GO TO 60
      IORD=NODPLC(ICSWPF+I)
      LOC=I
   35 LOC=NODPLC(IRPT+LOC)
   40 IF (NODPLC(IROWNO+LOC).NE.I) GO TO 35
   50 LOC=NODPLC(IRPT+LOC)
      IF (LOC.EQ.0) GO TO 30
      J=NODPLC(IROWNO+LOC)
      JORD=NODPLC(ICSWPF+J)
      CALL CMULT(VALUE(LYNL+LOC),VALUE(IMYNL+LOC),
     1     VALUE(LVN+JORD),VALUE(IMVN+JORD),XREAL,XIMAG)
      VALUE(LVN+IORD)=VALUE(LVN+IORD)-XREAL
      VALUE(IMVN+IORD)=VALUE(IMVN+IORD)-XIMAG
      GO TO 50
C
C  REORDER SOLUTION VECTOR
C
   60 DO 70 I=1,NSTOP
      J=NODPLC(IRSWPR+I)
      K=NODPLC(ICSWPF+J)
      VALUE(NDIAG+I)=VALUE(LVN+K)
      VALUE(NDIAG+I+NSTOP)=VALUE(IMVN+K)
   70 CONTINUE
      CALL COPY8(VALUE(NDIAG+1),VALUE(LVN+1),NSTOP)
      CALL COPY8(VALUE(NDIAG+1+NSTOP),VALUE(IMVN+1),NSTOP)
      DO 120 I=2,NSTOP
      CVALUE(LCVN+I)=CMPLX(SNGL(VALUE(LVN+I)),SNGL(VALUE(IMVN+I)))
  120 CONTINUE
      CVALUE(LCVN+1)=CMPLX(0.0E0,0.0E0)
C
C  FINISHED
C
      RETURN
      END
      SUBROUTINE DINIT
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE PERFORMS STORAGE-ALLOCATION AND ONE-TIME COMPUTATION
C NEEDED TO DO THE SMALL-SIGNAL DISTORTION ANALYSIS.
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(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C
      CALL GETM8(LD0,NDIST)
      CALL GETM16(LD1,5*NSTOP)
C
C  BIPOLAR JUNCTION TRANSISTORS
C
      LOC=LOCATE(12)
  100 IF ((LOC.EQ.0).OR.(NODPLC(LOC+36).NE.0)) GO TO 200
      LOCV=NODPLC(LOC+1)
      AREA=VALUE(LOCV+1)
      LOCM=NODPLC(LOC+8)
      LOCM=NODPLC(LOCM+1)
      LOCT=LX0+NODPLC(LOC+22)
      LOCD=LD0+NODPLC(LOC+23)
      CSAT=VALUE(LOCM+1)*AREA
      OVA=VALUE(LOCM+4)
      TF=VALUE(LOCM+24)
      TR=VALUE(LOCM+33)
      CZBE=VALUE(LOCM+21)*AREA
      CZBC=VALUE(LOCM+29)*AREA
      PE=VALUE(LOCM+22)
      XME=VALUE(LOCM+23)
      PC=VALUE(LOCM+30)
      XMC=VALUE(LOCM+31)
      FCPE=VALUE(LOCM+46)
      FCPC=VALUE(LOCM+50)
      VBE=VALUE(LOCT)
      VBC=VALUE(LOCT+1)
      GPI=VALUE(LOCT+4)
      GO=VALUE(LOCT+7)
      GM=VALUE(LOCT+6)
      GMU=VALUE(LOCT+5)
      IF (VBE.GT.0.0D0) GO TO 110
      EVBE=1.0D0
      CBE=CSAT*VBE/VT
      GO TO 120
  110 EVBE=DEXP(VBE/VT)
      CBE=CSAT*(EVBE-1.0D0)
  120 IF (VBC.GT.0.0D0) GO TO 130
      EVBC=1.0D0
      CBC=CSAT*VBC/VT
      ARG=1.0D0-VBC/PC
      GO TO 140
  130 EVBC=DEXP(VBC/VT)
      CBC=CSAT*(EVBC-1.0D0)
  140 IF (VBE.GE.FCPE) GO TO 150
      ARG=1.0D0-VBE/PE
      SARG=DEXP(XME*DLOG(ARG))
      CJEO=CZBE/SARG
      ARGBE=PE-VBE
      CJE1=XME*CJEO/ARGBE
      CJE2=(1.0D0+XME)*CJE1/ARGBE
      GO TO 160
  150 DENOM=DEXP((1.0D0+XME)*DLOG(1.0D0-FCPE))
      CJEO=CZBE*(1.0D0-FCPE*(1.0D0+XME)+XME*VBE/PE)/DENOM
      CJE1=CZBE*XME/(DENOM*PE)
      CJE2=0.0D0
  160 IF (VBC.GE.FCPC) GO TO 170
      ARG=1.0D0-VBC/PC
      SARG=DEXP(XMC*DLOG(ARG))
      CJCO=CZBC/SARG
      ARGBC=PC-VBC
      CJC1=XMC*CJCO/ARGBC
      CJC2=(1.0D0+XMC)*CJC1/ARGBC
      GO TO 180
  170 DENOM=DEXP((1.0D0+XMC)*DLOG(1.0D0-FCPC))
      CJCO=CZBC*(1.0D0-FCPC*(1.0D0+XMC)+XMC*VBC/PC)/DENOM
      CJC1=CZBC*XMC/(DENOM*PC)
      CJC2=0.0D0
  180 TWOVT=VT+VT
      GO2=(-GO+CSAT*(EVBE+EVBC)*OVA)/TWOVT
      GMO2=(CBE+CSAT)*OVA/VT-2.0D0*GO2
      GM2=(GM+GO)/TWOVT-GMO2-GO2
      GMU2=GMU/TWOVT
      IF (VBC.LE.0.0D0) GMU2=0.0D0
      GPI2=GPI/TWOVT
      IF (VBE.LE.0.0D0) GPI2=0.0D0
      CBO=TF*CSAT*EVBE/VT
      CBOR=TR*CSAT*EVBC/VT
      CB1=CBO/VT
      CB1R=CBOR/VT
      TRIVT=3.0D0*VT
      GO3=-(GO2+(CBC+CSAT)*OVA/TWOVT)/TRIVT
      GMO23=-3.0D0*GO3
      GM2O3=-GMO23+(CBE+CSAT)*OVA/(VT*TWOVT)
      GM3=(GM2-(CBE-CBC)*OVA/TWOVT)/TRIVT
      GMU3=GMU2/TRIVT
      GPI3=GPI2/TRIVT
      CB2=CB1/TWOVT
      CB2R=CB1R/TWOVT
      VALUE(LOCD)=CJE1
      VALUE(LOCD+1)=CJE2
      VALUE(LOCD+2)=CJC1
      VALUE(LOCD+3)=CJC2
      VALUE(LOCD+4)=GO2
      VALUE(LOCD+5)=GMO2
      VALUE(LOCD+6)=GM2
      VALUE(LOCD+7)=GMU2
      VALUE(LOCD+8)=GPI2
      VALUE(LOCD+9)=CBO
      VALUE(LOCD+10)=CBOR
      VALUE(LOCD+11)=CB1
      VALUE(LOCD+12)=CB1R
      VALUE(LOCD+13)=GO3
      VALUE(LOCD+14)=GMO23
      VALUE(LOCD+15)=GM2O3
      VALUE(LOCD+16)=GM3
      VALUE(LOCD+17)=GMU3
      VALUE(LOCD+18)=GPI3
      VALUE(LOCD+19)=CB2
      VALUE(LOCD+20)=CB2R
      LOC=NODPLC(LOC)
      GO TO 100
C
C  DIODES
C
  200 LOC=LOCATE(11)
  210 IF ((LOC.EQ.0).OR.(NODPLC(LOC+16).NE.0)) GO TO 300
      LOCV=NODPLC(LOC+1)
      AREA=VALUE(LOCV+1)
      LOCM=NODPLC(LOC+5)
      LOCM=NODPLC(LOCM+1)
      LOCT=LX0+NODPLC(LOC+11)
      LOCD=LD0+NODPLC(LOC+12)
      CSAT=VALUE(LOCM+1)*AREA
      VTE=VALUE(LOCM+3)*VT
      TAU=VALUE(LOCM+4)
      CZERO=VALUE(LOCM+5)*AREA
      PHIB=VALUE(LOCM+6)
      XM=VALUE(LOCM+7)
      FCPB=VALUE(LOCM+12)
      VD=VALUE(LOCT)
      GEQ=VALUE(LOCT+2)
      EVD=1.0D0
      IF (VD.GE.0.0D0) EVD=DEXP(VD/VTE)
      IF (VD.GE.FCPB) GO TO 220
      ARG=1.0D0-VD/PHIB
      SARG=DEXP(XM*DLOG(ARG))
      CDJO=CZERO/SARG
      ARGD=PHIB-VD
      CDJ1=XM*CDJO/ARGD
      CDJ2=(1.0D0+XM)*CDJ1/ARGD
      GO TO 230
  220 DENOM=DEXP((1.0D0+XM)*DLOG(1.0D0-FCPB))
      CDJO=CZERO*(1.0D0-FCPB*(1.0D0+XM)+XM*VD/PHIB)/DENOM
      CDJ1=CZERO*XM/(DENOM*PHIB)
      CDJ2=0.0D0
      CDJ2=0.0D0
  230 CDBO=TAU*CSAT*EVD/VTE
      CDB1=CDBO/VTE
      TWOVTE=2.0D0*VTE
      GEQ2=GEQ/TWOVTE
      IF (VD.LE.0.0D0) GEQ2=0.0D0
      TRIVTE=3.0D0*VTE
      GEQ3=GEQ2/TRIVTE
      CDB2=CDB1/TWOVTE
      VALUE(LOCD)=CDJ1
      VALUE(LOCD+1)=CDJ2
      VALUE(LOCD+2)=CDBO
      VALUE(LOCD+3)=CDB1
      VALUE(LOCD+4)=GEQ2
      VALUE(LOCD+5)=GEQ3
      VALUE(LOCD+6)=CDB2
      LOC=NODPLC(LOC)
      GO TO 210
C
C  FINISHED
C
  300 RETURN
      END
      SUBROUTINE DISTO(LOCO)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE PERFORMS THE SMALL-SIGNAL DISTORTION ANALYSIS.
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=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=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=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=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(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C
      COMPLEX DIFVN1,DIFVN2,DIFVN3,DIFVI1,DIFVI2,DIFVI3,DSGO2,DSGM2,
     1   DSGMU2,DSGPI2,DSCB1,DSCB1R,DSCJE1,DSCJC1,DISTO1,DISTO2,DISTO3,
     2   DSGMO2,DGM2O3,DGMO23,BEW,CEW,BCW,BE2W,CE2W,BC2W,BEW2,CEW2,
     3   BCW2,BEW12,CEW12,BCW12,DSCDB1,DSCDJ1,DSG2,CVABE,CVABC,CVACE,
     4   CVOUT,CVDIST
      DIMENSION DISTIT(4)
      DIMENSION VDO(2,12)
      COMPLEX CVDO(12)
      REAL VDO
      EQUIVALENCE (CVDO(1),VDO(1,1))
      DATA DISTIT / 8HDISTORTI, 8HON ANALY, 8HSIS     , 8H        /
C
C
      ICVW1=LD1
      ICV2W1=ICVW1+NSTOP
      ICVW2=ICV2W1+NSTOP
      ICVW12=ICVW2+NSTOP
      ICVADJ=ICVW12+NSTOP
      IPRNT=0
      IF (ICALC.GE.2) GO TO 10
      IDNP=NODPLC(IDIST+2)
      IDNN=NODPLC(IDIST+3)
      LOCV=NODPLC(IDIST+1)
      RLOAD=1.0D0/VALUE(LOCV+1)
      KNTR=1
   10 IF (IDPRT.EQ.0) GO TO 30
      IF (KNTR.GT.ICALC) GO TO 30
      IPRNT=1
      KNTR=KNTR+IDPRT
      CALL TITLE(0,LWIDTH,1,DISTIT)
   30 FREQ1=DBLE(REAL(CVALUE(LOCO+1)))
      FREQ2=SKW2*FREQ1
      CALL COPY16(CVALUE(LCVN+1),CVALUE(ICVW1+1),NSTOP)
      CVOUT=CVALUE(ICVW1+IDNP)-CVALUE(ICVW1+IDNN)
      CALL MAGPHS(CVOUT,OMAG,OPHASE)
C
C  BEGIN THE DISTORTION ANALYSIS
C
      DO 1000 KDISTO=1,7
      CVDIST=CMPLX(0.0E0,0.0E0)
      GO TO (1000,110,120,130,140,160,170),KDISTO
  110 FREQD=2.0D0*FREQ1
      ARG=DSQRT(2.0D0*RLOAD*REFPRL)/(OMAG*OMAG)
      IF (IPRNT.EQ.0) GO TO 200
      WRITE (IOFILE,111) FREQ1,FREQD,OMAG,OPHASE
  111 FORMAT (///5X,'2ND HARMONIC DISTORTION',30X,'FREQ1 = ',1PD9.2,
     1   '  HZ'//5X,'DISTORTION FREQUENCY  ',D9.2,'  HZ',16X,
     2   'MAG ',D10.3,3X,'PHS ',0PF7.2)
      GO TO 200
  120 FREQD=3.0D0*FREQ1
      ARG=2.0D0*RLOAD*REFPRL/(OMAG*OMAG*OMAG)
      IF (IPRNT.EQ.0) GO TO 200
      WRITE (IOFILE,121) FREQ1,FREQD,OMAG,OPHASE
  121 FORMAT (1H1,4X,'3RD HARMONIC DISTORTION',30X,'FREQ1 = ',1PD9.2,
     1   '  HZ'//5X,'DISTORTION FREQUENCY  ',D9.2,'  HZ',16X,
     2   'MAG ',D10.3,3X,'PHS ',0PF7.2)
      GO TO 200
  130 FREQD=FREQ2
      GO TO 200
  140 FREQD=FREQ1-FREQ2
      ARG=DSQRT(2.0D0*RLOAD*REFPRL)*SPW2/(OMAG*OMAG)
      IF (IPRNT.EQ.0) GO TO 200
      WRITE (IOFILE,151) FREQ1,FREQ2,FREQD,OMAG,OPHASE,OW2MAG,OW2PHS
  151 FORMAT (1H1,4X,'2ND ORDER INTERMODULATION DIFFERENCE COMPONENT',
     1   7X,'FREQ1 = ',1PD9.2,'  HZ',15X,'FREQ2 = ',D9.2,'  HZ'//
     2   5X,'DISTORTION FREQUENCY  ',D9.2,'  HZ',16X,'MAG ',
     3   D10.3,3X,'PHS ',0PF7.2,9X,'MAG ',1PD10.3,3X,'PHS ',0PF7.2)
      GO TO 200
  160 FREQD=FREQ1+FREQ2
      ARG=DSQRT(2.0D0*RLOAD*REFPRL)*SPW2/(OMAG*OMAG)
      IF (IPRNT.EQ.0) GO TO 200
      WRITE (IOFILE,161) FREQ1,FREQ2,FREQD,OMAG,OPHASE,OW2MAG,OW2PHS
  161 FORMAT (1H1,4X,'2ND ORDER INTERMODULATION SUM COMPONENT',
     1   14X,'FREQ1 = ',1PD9.2,'  HZ',15X,'FREQ2 = ',D9.2,'  HZ'//
     2   5X,'DISTORTION FREQUENCY  ',D9.2,'  HZ',16X,'MAG ',
     3   D10.3,3X,'PHS ',0PF7.2,9X,'MAG ',1PD10.3,3X,'PHS ',0PF7.2)
      GO TO 200
  170 FREQD=2.0D0*FREQ1-FREQ2
      ARG=2.0D0*RLOAD*REFPRL*SPW2/(OMAG*OMAG*OMAG)
      IF (IPRNT.EQ.0) GO TO 200
      WRITE (IOFILE,171) FREQ1,FREQ2,FREQD,OMAG,OPHASE,OW2MAG,OW2PHS
  171 FORMAT (1H1,4X,'3RD ORDER INTERMODULATION DIFFERENCE COMPONENT',
     1   7X,'FREQ1 = ',1PD9.2,'  HZ',15X,'FREQ2 = ',D9.2,'  HZ'//
     2   5X,'DISTORTION FREQUENCY  ',D9.2,'  HZ',16X,'MAG ',
     3   D10.3,3X,'PHS ',0PF7.2,9X,'MAG ',1PD10.3,3X,'PHS ',0PF7.2)
C
C  LOAD AND DECOMPOSE Y MATRIX
C
  200 OMEGA=TWOPI*FREQD
      IGOOF=0
      CALL ACLOAD
      CALL ACDCMP
      IF (IGOOF.EQ.0) GO TO 220
      WRITE (IOFILE,211) IGOOF,FREQD
  211 FORMAT('WARNING:  UNDERFLOW ',I4,' TIME(S) IN DISTORTION ANALYSIS
     1 AT FREQ = ',1PD10.3,' HZ')
      IGOOF=0
  220 IF (KDISTO.EQ.4) GO TO 710
C
C  OBTAIN ADJOINT SOLUTION
C
      CALL ZERO8(VALUE(LVN+1),NSTOP)
      CALL ZERO8(VALUE(IMVN+1),NSTOP)
      VALUE(LVN+IDNP)=-1.0D0
      VALUE(LVN+IDNN)=+1.0D0
      CALL ACASOL
      CALL COPY16(CVALUE(LCVN+1),CVALUE(ICVADJ+1),NSTOP)
      CALL ZERO8(VALUE(LVN+1),NSTOP)
      CALL ZERO8(VALUE(IMVN+1),NSTOP)
C
C  BJTS
C
      IF (JELCNT(12).EQ.0) GO TO 500
      ITITLE=0
  301 FORMAT (////1X,'BJT DISTORTION COMPONENTS'//1X,'NAME',11X,'GM',
     1   8X,'GPI',7X,'GO',8X,'GMU',6X,'GMO2',7X,'CB',8X,'CBR',7X,'CJE',
     2   7X,'CJC',6X,'TOTAL')
  311 FORMAT (////1X,'BJT DISTORTION COMPONENTS'//1X,'NAME',11X,'GM',
     1   8X,'GPI',7X,'GO',8X,'GMU',6X,'GMO2',7X,'CB',8X,'CBR',7X,'CJE',
     2   7X,'CJC',6X,'GM203',5X,'GMO23',5X,'TOTAL')
  320 LOC=LOCATE(12)
  330 IF ((LOC.EQ.0).OR.(NODPLC(LOC+36).NE.0)) GO TO 500
      LOCV=NODPLC(LOC+1)
      LOCT=LX0+NODPLC(LOC+22)
      LOCD=LD0+NODPLC(LOC+23)
      NODE1=NODPLC(LOC+5)
      NODE2=NODPLC(LOC+6)
      NODE3=NODPLC(LOC+7)
      CJE1=VALUE(LOCD)
      CJE2=VALUE(LOCD+1)
      CJC1=VALUE(LOCD+2)
      CJC2=VALUE(LOCD+3)
      GO2=VALUE(LOCD+4)
      GMO2=VALUE(LOCD+5)
      GM2=VALUE(LOCD+6)
      GMU2=VALUE(LOCD+7)
      GPI2=VALUE(LOCD+8)
      CB1=VALUE(LOCD+11)
      CB1R=VALUE(LOCD+12)
      GO3=VALUE(LOCD+13)
      GMO23=VALUE(LOCD+14)
      GM2O3=VALUE(LOCD+15)
      GM3=VALUE(LOCD+16)
      GMU3=VALUE(LOCD+17)
      GPI3=VALUE(LOCD+18)
      CB2=VALUE(LOCD+19)
      CB2R=VALUE(LOCD+20)
      BEW=CVALUE(ICVW1+NODE2)-CVALUE(ICVW1+NODE3)
      CEW=CVALUE(ICVW1+NODE1)-CVALUE(ICVW1+NODE3)
      BCW=CVALUE(ICVW1+NODE2)-CVALUE(ICVW1+NODE1)
      IF (KDISTO.EQ.2) GO TO 370
      BE2W=CVALUE(ICV2W1+NODE2)-CVALUE(ICV2W1+NODE3)
      CE2W=CVALUE(ICV2W1+NODE1)-CVALUE(ICV2W1+NODE3)
      BC2W=CVALUE(ICV2W1+NODE2)-CVALUE(ICV2W1+NODE1)
      IF (KDISTO.EQ.3) GO TO 380
      BEW2=CVALUE(ICVW2+NODE2)-CVALUE(ICVW2+NODE3)
      CEW2=CVALUE(ICVW2+NODE1)-CVALUE(ICVW2+NODE3)
      BCW2=CVALUE(ICVW2+NODE2)-CVALUE(ICVW2+NODE1)
      IF (KDISTO.EQ.5) GO TO 390
      IF (KDISTO.EQ.6) GO TO 400
      BEW12=CVALUE(ICVW12+NODE2)-CVALUE(ICVW12+NODE3)
      CEW12=CVALUE(ICVW12+NODE1)-CVALUE(ICVW12+NODE3)
      BCW12=CVALUE(ICVW12+NODE2)-CVALUE(ICVW12+NODE1)
      GO TO 410
C
C  CALCULATE HD2 CURRENT GENERATORS
C
  370 DIFVN1=0.5D0*CEW*CEW
      DIFVN2=0.5D0*BEW*BEW
      DIFVN3=0.5D0*BCW*BCW
      DSGMO2=GMO2*0.5D0*BEW*CEW
      GO TO 420
C
C  CALCULATE HD3 CURRENT GENERATORS
C
  380 DIFVI1=0.50D0*CEW*CE2W
      DIFVN1=0.25D0*CEW*CEW*CEW
      DIFVI2=0.50D0*BEW*BE2W
      DIFVN2=0.25D0*BEW*BEW*BEW
      DIFVI3=0.50D0*BCW*BC2W
      DIFVN3=0.25D0*BCW*BCW*BCW
      DSGMO2=GMO2*(BEW*CE2W+BE2W*CEW)*0.5D0
      GO TO 430
C
C  CALCULATE IM2D CURRENT GENERATORS
C
  390 DIFVN1=CEW*CONJG(CEW2)
      DIFVN2=BEW*CONJG(BEW2)
      DIFVN3=BCW*CONJG(BCW2)
      DSGMO2=GMO2*0.5D0*(BEW*CONJG(CEW2)+CEW*CONJG(BEW2))
      GO TO 420
C
C  CALCULATE IM2S CURRENT GENERATORS
C
  400 DIFVN1=CEW*CEW2
      DIFVN2=BEW*BEW2
      DIFVN3=BCW*BCW2
      DSGMO2=GMO2*0.5D0*(BEW*CEW2+BEW2*CEW)
      GO TO 420
C
C  CALCULATE IM3 CURRENT GENERATORS
C
  410 DIFVI1=0.5D0*(CE2W*CONJG(CEW2)+CEW*CEW12)
      DIFVI2=0.5D0*(BE2W*CONJG(BEW2)+BEW*BEW12)
      DIFVI3=0.5D0*(BC2W*CONJG(BCW2)+BCW*BCW12)
      DIFVN1=CEW*CEW*CONJG(CEW2)*0.75D0
      DIFVN2=BEW*BEW*CONJG(BEW2)*0.75D0
      DIFVN3=BCW*BCW*CONJG(BCW2)*0.75D0
      DSGMO2=GMO2*0.5D0*(CONJG(BEW2)*CE2W+BEW*CEW12+CONJG(CEW2)*BE2W+
     1   CEW*BEW12)
      GO TO 430
C
  420 DSGO2=GO2*DIFVN1
      DSGM2=GM2*DIFVN2
      DSGMU2=GMU2*DIFVN3
      DSGPI2=GPI2*DIFVN2
      DSCB1=0.5D0*CB1*OMEGA*CMPLX(-AIMAG(DIFVN2),REAL(DIFVN2))
      DSCB1R=0.5D0*CB1R*OMEGA*CMPLX(-AIMAG(DIFVN3),REAL(DIFVN3))
      DSCJE1=0.5D0*CJE1*OMEGA*CMPLX(-AIMAG(DIFVN2),REAL(DIFVN2))
      DSCJC1=0.5D0*CJC1*OMEGA*CMPLX(-AIMAG(DIFVN3),REAL(DIFVN3))
      GO TO 440
C
  430 DSGO2=2.0D0*GO2*DIFVI1+GO3*DIFVN1
      DSGM2=2.0D0*GM2*DIFVI2+GM3*DIFVN2
      DSGMU2=2.0D0*GMU2*DIFVI3+GMU3*DIFVN3
      DSGPI2=2.0D0*GPI2*DIFVI2+GPI3*DIFVN2
      DSCB1=OMEGA*(CB1*DIFVI2+CB2*DIFVN2/3.0D0)
      DSCB1=CMPLX(-AIMAG(DSCB1),REAL(DSCB1))
      DSCB1R=OMEGA*(CB1R*DIFVI3+CB2R*DIFVN3/3.0D0)
      DSCB1R=CMPLX(-AIMAG(DSCB1R),REAL(DSCB1R))
      DSCJE1=OMEGA*(CJE1*DIFVI2+CJE2*DIFVN2/3.0D0)
      DSCJE1=CMPLX(-AIMAG(DSCJE1),REAL(DSCJE1))
      DSCJC1=OMEGA*(CJC1*DIFVI3+CJC2*DIFVN3/3.0D0)
      DSCJC1=CMPLX(-AIMAG(DSCJC1),REAL(DSCJC1))
C
C  DETERMINE CONTRIBUTION OF EACH DISTORTION SOURCE
C
  440 CVABE=CVALUE(ICVADJ+NODE2)-CVALUE(ICVADJ+NODE3)
      CVABC=CVALUE(ICVADJ+NODE2)-CVALUE(ICVADJ+NODE1)
      CVACE=CVALUE(ICVADJ+NODE1)-CVALUE(ICVADJ+NODE3)
      DISTO1=DSGM2+DSGO2+DSGMO2
      DISTO2=DSGPI2+DSCB1+DSCJE1
      DISTO3=DSGMU2+DSCB1R+DSCJC1
      CVDO(1)=DSGM2*CVACE*ARG
      CVDO(2)=DSGPI2*CVABE*ARG
      CVDO(3)=DSGO2*CVACE*ARG
      CVDO(4)=DSGMU2*CVABC*ARG
      CVDO(5)=DSGMO2*CVACE*ARG
      CVDO(6)=DSCB1*CVABE*ARG
      CVDO(7)=DSCB1R*CVABC*ARG
      CVDO(8)=DSCJE1*CVABE*ARG
      CVDO(9)=DSCJC1*CVABC*ARG
      IF (KDISTO.EQ.3) GO TO 450
      IF (KDISTO.EQ.7) GO TO 460
      CVDO(10)=CVDO(1)+CVDO(2)+CVDO(3)+CVDO(4)+CVDO(5)+CVDO(6)+CVDO(7)+
     1   CVDO(8)+CVDO(9)
      CVDIST=CVDIST+CVDO(10)
      IF (IPRNT.EQ.0) GO TO 480
      DO 445 J=1,10
      CALL MAGPHS(CVDO(J),XMAG,XPHS)
      CVDO(J)=CMPLX(SNGL(XMAG),SNGL(XPHS))
  445 CONTINUE
      IF (ITITLE.EQ.0) WRITE (IOFILE,301)
      ITITLE=1
      WRITE (IOFILE,446) VALUE(LOCV),(VDO(1,J),J=1,10)
  446 FORMAT(1H ,A8,'MAG',1P12D10.3)
      WRITE (IOFILE,447) (VDO(2,J),J=1,10)
  447 FORMAT(9X,'PHS',12(1X,F7.2,2X))
      GO TO 480
  450 DGM2O3=GM2O3*CEW*BEW*BEW*0.25D0
      DGMO23=GMO23*BEW*CEW*CEW*0.25D0
      GO TO 470
  460 DGM2O3=GM2O3*(0.5D0*BEW*CONJG(BEW2)*CEW+0.25D0*BEW*BEW*
     1  CONJG(CEW2))
      DGMO23=GMO23*(0.5D0*CEW*CONJG(CEW2)*BEW+0.25D0*CEW*CEW*
     1  CONJG(BEW2))
  470 DISTO1=DISTO1+DGM2O3+DGMO23
      CVDO(10)=DGM2O3*CVACE*ARG
      CVDO(11)=DGMO23*CVACE*ARG
      CVDO(12)=CVDO(1)+CVDO(2)+CVDO(3)+CVDO(4)+CVDO(5)+CVDO(6)+CVDO(7)+
     1   CVDO(8)+CVDO(9)+CVDO(10)+CVDO(11)
      CVDIST=CVDIST+CVDO(12)
      IF (IPRNT.EQ.0) GO TO 480
      DO 475 J=1,12
      CALL MAGPHS(CVDO(J),XMAG,XPHS)
      CVDO(J)=CMPLX(SNGL(XMAG),SNGL(XPHS))
  475 CONTINUE
      IF (ITITLE.EQ.0) WRITE (IOFILE,311)
      ITITLE=1
      WRITE (IOFILE,446) VALUE(LOCV),(VDO(1,J),J=1,12)
      WRITE (IOFILE,447) (VDO(2,J),J=1,12)
  480 VALUE(LVN+NODE1)=VALUE(LVN+NODE1)
     1  -REAL(DISTO1-DISTO3)
      VALUE(LVN+NODE2)=VALUE(LVN+NODE2)
     1  -REAL(DISTO2+DISTO3)
      VALUE(LVN+NODE3)=VALUE(LVN+NODE3)
     1  +REAL(DISTO1+DISTO2)
      VALUE(IMVN+NODE1)=VALUE(IMVN+NODE1)
     1  -AIMAG(DISTO1-DISTO3)
      VALUE(IMVN+NODE2)=VALUE(IMVN+NODE2)
     1  -AIMAG(DISTO2+DISTO3)
      VALUE(IMVN+NODE3)=VALUE(IMVN+NODE3)
     1  +AIMAG(DISTO1+DISTO2)
      LOC=NODPLC(LOC)
      GO TO 330
C
C   JUNCTION DIODES
C
  500 IF (JELCNT(11).EQ.0) GO TO 700
      ITITLE=0
  501 FORMAT (////1X,'DIODE DISTORTION COMPONENTS'//1X,'NAME',
     1   11X,'GEQ',7X,'CB',8X,'CJ',7X,'TOTAL')
  510 LOC=LOCATE(11)
  520 IF ((LOC.EQ.0).OR.(NODPLC(LOC+16).NE.0)) GO TO 700
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2)
      NODE2=NODPLC(LOC+3)
      NODE3=NODPLC(LOC+4)
      LOCM=NODPLC(LOC+5)
      LOCM=NODPLC(LOCM+1)
      LOCT=LX0+NODPLC(LOC+11)
      LOCD=LD0+NODPLC(LOC+12)
      CDJ1=VALUE(LOCD)
      CDJ2=VALUE(LOCD+1)
      CDB1=VALUE(LOCD+3)
      GEQ2=VALUE(LOCD+4)
      GEQ3=VALUE(LOCD+5)
      CDB2=VALUE(LOCD+6)
      BEW=CVALUE(ICVW1+NODE3)-CVALUE(ICVW1+NODE2)
      IF (KDISTO.EQ.2) GO TO 540
      BE2W=CVALUE(ICV2W1+NODE3)-CVALUE(ICV2W1+NODE2)
      IF (KDISTO.EQ.3) GO TO 550
      BEW2=CVALUE(ICVW2+NODE3)-CVALUE(ICVW2+NODE2)
      IF (KDISTO.EQ.5) GO TO 560
      IF (KDISTO.EQ.6) GO TO 570
      BEW12=CVALUE(ICVW12+NODE3)-CVALUE(ICVW12+NODE2)
      GO TO 580
C
C    CALCULATE HD2 CURRENT GENERATORS
C
  540 DIFVN1=0.5D0*BEW*BEW
      GO TO 590
C
C    CALCULATE HD3 CURRENT GENERATORS
C
  550 DIFVI1=0.5D0*BEW*BE2W
      DIFVN1=0.25D0*BEW*BEW*BEW
      GO TO 600
C
C    CALCULATE IM2D CURRENT GENERATORS
C
  560 DIFVN1=BEW*CONJG(BEW2)
      GO TO 590
C
C    CALCULATE IM2S CURRENT GENERATORS
C
  570 DIFVN1=BEW*BEW2
      GO TO 590
C
C    CALCULATE IM3 CURRENT GENERATORS
C
  580 DIFVI1=0.5D0*(BE2W*CONJG(BEW2)+BEW*BEW12)
      DIFVN1=BEW*BEW*CONJG(BEW2)*0.75D0
      GO TO 600
  590 DSG2=GEQ2*DIFVN1
      DSCDB1=0.5D0*CDB1*OMEGA*CMPLX(-AIMAG(DIFVN1),REAL(DIFVN1))
      DSCDJ1=0.5D0*CDJ1*OMEGA*CMPLX(-AIMAG(DIFVN1),REAL(DIFVN1))
      GO TO 610
C
  600 DSG2=2.0D0*GEQ2*DIFVI1+GEQ3*DIFVN1
      DSCDB1=OMEGA*(CDB1*DIFVI1+CDB2*DIFVN1/3.0D0)
      DSCDB1=CMPLX(-AIMAG(DSCDB1),REAL(DSCDB1))
      DSCDJ1=OMEGA*(CDJ1*DIFVI1+CDJ2*DIFVN1/3.0D0)
      DSCDJ1=CMPLX(-AIMAG(DSCDJ1),REAL(DSCDJ1))
C
C  DETERMINE CONTRIBUTION OF EACH DISTORTION SOURCE
C
  610 CVABE=CVALUE(ICVADJ+NODE3)-CVALUE(ICVADJ+NODE2)
      DISTO1=DSG2+DSCDB1+DSCDJ1
      CVDO(1)=DSG2*CVABE*ARG
      CVDO(2)=DSCDB1*CVABE*ARG
      CVDO(3)=DSCDJ1*CVABE*ARG
      CVDO(4)=CVDO(1)+CVDO(2)+CVDO(3)
      CVDIST=CVDIST+CVDO(4)
      IF (IPRNT.EQ.0) GO TO 680
      DO 670 J=1,4
      CALL MAGPHS(CVDO(J),XMAG,XPHS)
      CVDO(J)=CMPLX(SNGL(XMAG),SNGL(XPHS))
  670 CONTINUE
      IF (ITITLE.EQ.0) WRITE (IOFILE,501)
      ITITLE=1
      WRITE (IOFILE,446) VALUE(LOCV),(VDO(1,J),J=1,4)
      WRITE (IOFILE,447) (VDO(2,J),J=1,4)
  680 VALUE(LVN+NODE2)=VALUE(LVN+NODE2)+REAL(DISTO1)
      VALUE(LVN+NODE3)=VALUE(LVN+NODE3)-REAL(DISTO1)
      VALUE(IMVN+NODE2)=VALUE(IMVN+NODE2)+AIMAG(DISTO1)
      VALUE(IMVN+NODE3)=VALUE(IMVN+NODE3)-AIMAG(DISTO1)
      LOC=NODPLC(LOC)
      GO TO 520
C
C  OBTAIN TOTAL DISTORTION SOLUTION IF NECESSARY
C
  700 GO TO (1000,710,790,710,710,840,860),KDISTO
  710 CALL ACSOL
C
C  STORE SOLUTION, PRINT AND STORE ANSWERS
C
  760 GO TO (1000,770,790,800,820,840,860),KDISTO
  770 CALL COPY16(CVALUE(LCVN+1),CVALUE(ICV2W1+1),NSTOP)
      CALL MAGPHS(CVDIST,O2MAG,O2PHS)
      IF (IPRNT.EQ.0) GO TO 900
      O2LOG=20.0D0*DLOG10(O2MAG)
      WRITE (IOFILE,781) O2MAG,O2PHS,O2LOG
  781 FORMAT (///5X,'HD2     MAGNITUDE  ',1PD10.3,5X,'PHASE  ',0PF7.2,
     1   5X,'=  ',F7.2,'  DB')
      GO TO 900
  790 CALL MAGPHS(CVDIST,O3MAG,O3PHS)
      IF (IPRNT.EQ.0) GO TO 900
      O3LOG=20.0D0*DLOG10(O3MAG)
      WRITE (IOFILE,791) O3MAG,O3PHS,O3LOG
  791 FORMAT (///5X,'HD3     MAGNITUDE  ',1PD10.3,5X,'PHASE  ',0PF7.2,
     1   5X,'=  ',F7.2,'  DB')
      GO TO 900
  800 CALL COPY16(CVALUE(LCVN+1),CVALUE(ICVW2+1),NSTOP)
      CVOUT=CVALUE(ICVW2+IDNP)-CVALUE(ICVW2+IDNN)
      CALL MAGPHS(CVOUT,OW2MAG,OW2PHS)
      GO TO 1000
  820 CALL COPY16(CVALUE(LCVN+1),CVALUE(ICVW12+1),NSTOP)
  840 CALL MAGPHS(CVDIST,O12MAG,O12PHS)
      IF (IPRNT.EQ.0) GO TO 900
      O12LOG=20.0D0*DLOG10(O12MAG)
      IF (KDISTO.EQ.6) GO TO 850
      WRITE (IOFILE,841) O12MAG,O12PHS,O12LOG
  841 FORMAT (///5X,'IM2D    MAGNITUDE  ',1PD10.3,5X,'PHASE  ',0PF7.2,
     1   5X,'=  ',F7.2,'  DB')
      GO TO 900
  850 WRITE (IOFILE,851) O12MAG,O12PHS,O12LOG
  851 FORMAT (///5X,'IM2S    MAGNITUDE  ',1PD10.3,5X,'PHASE  ',0PF7.2,
     1   5X,'=  ',F7.2,'  DB')
      GO TO 900
  860 CALL MAGPHS(CVDIST,O21MAG,O21PHS)
      IF (IPRNT.EQ.0) GO TO 900
      O21LOG=20.0D0*DLOG10(O21MAG)
      WRITE (IOFILE,861) O21MAG,O21PHS,O21LOG
  861 FORMAT (///5X,'IM3     MAGNITUDE  ',1PD10.3,5X,'PHASE  ',0PF7.2,
     1   5X,'=  ',F7.2,'  DB')
      CMA=DABS(4.0D0*O21MAG*DCOS((O21PHS-OPHASE)/RAD))
      CMA=DMAX1(CMA,1.0D-20)
      CMP=DABS(4.0D0*O21MAG*DSIN((O21PHS-OPHASE)/RAD))
      CMP=DMAX1(CMP,1.0D-20)
      CMALOG=20.0D0*DLOG10(CMA)
      CMPLOG=20.0D0*DLOG10(CMP)
      WRITE (IOFILE,866)
  866 FORMAT (////5X,'APPROXIMATE CROSS MODULATION COMPONENTS')
      WRITE (IOFILE,871) CMA,CMALOG
  871 FORMAT (/5X,'CMA     MAGNITUDE  ',1PD10.3,24X,'=  ',0PF7.2,'  DB')
      WRITE (IOFILE,881) CMP,CMPLOG
  881 FORMAT (/5X,'CMP     MAGNITUDE  ',1PD10.3,24X,'=  ',0PF7.2,'  DB')
C
C  SAVE DISTORTION OUTPUTS
C
  900 IFLAG=KDISTO+2
      IF (IFLAG.GE.7) IFLAG=IFLAG-1
      LOC=LOCATE(45)
  910 IF (LOC.EQ.0) GO TO 1000
      IF (NODPLC(LOC+5).NE.IFLAG) GO TO 920
      ISEQ=NODPLC(LOC+4)
      CVALUE(LOCO+ISEQ)=CVDIST
  920 LOC=NODPLC(LOC)
      GO TO 910
 1000 CONTINUE
C
C  FINISHED
C
 2000 RETURN
      END
C SPICE VERSION 2G.6  SCCSID=ovtpvt.ma 3/15/83
      SUBROUTINE OVTPVT
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      REAL T1, T2
C
C
C     THIS ROUTINE GENERATES THE REQUESTED TABULAR LISTINGS OF ANALYSIS
C RESULTS.  IT CALLS PLOT TO GENERATE 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=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=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(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
      COMPLEX CVAL
      DIMENSION PRFORM(3)
      DIMENSION SUBTIT(4,3)
      DATA SUBTIT / 8HDC TRANS, 8HFER CURV, 8HES      , 8H        ,
     1              8HTRANSIEN, 8HT ANALYS, 8HIS      , 8H        ,
     2              8HAC ANALY, 8HSIS     , 8H        , 8H         /
      DATA PRFORM / 8H(1PE11.3, 8H,2X,8E00, 8H.00)     /
      DATA APER,RPRN / 1H., 1H) /
C
      CALL SECOND(T1)
      IF (ICALC.LE.0) GO TO 1000
      CALL CRUNCH
      IF (NOGO.LT.0) GO TO 1000
C
C  CONSTRUCT FORMAT STATEMENT TO BE USED FOR PRINTING THE OUTPUTS
C
      IFRACT=MAX0(NUMDGT-1,0)
      IFWDTH=IFRACT+9
      IPOS=15
      CALL ALFNUM(IFWDTH,PRFORM,IPOS)
      CALL MOVE(PRFORM,IPOS,APER,1,1)
      IPOS=IPOS+1
      CALL ALFNUM(IFRACT,PRFORM,IPOS)
      CALL MOVE(PRFORM,IPOS,RPRN,1,1)
C
      NOPRLN=MIN0(8,(LWIDTH-12)/IFWDTH)
      IF (MODE-2) 50,60,300
   50 NUMOUT=JELCNT(41)+1
      GO TO 70
   60 NUMOUT=JELCNT(42)+1
C
C  DC AND TRANSIENT ANALYSIS PRINTING
C
   70 LOC=LOCATE(30+MODE)
   80 IF (LOC.EQ.0) GO TO 200
      KNTR=MIN0(NOPRLN,NODPLC(LOC+3))
      IF (KNTR.LE.0) GO TO 120
      CALL TITLE(1,LWIDTH,1,SUBTIT(1,MODE))
      CALL SETPRN(LOC)
C
C  GET BUFFER SPACE
C
      CALL GETM8(LOCX,NPOINT)
      CALL GETM8(LOCY,KNTR*NPOINT)
C
C  INTERPOLATE OUTPUTS
C
      CALL NTRPL8(LOCX,LOCY,NUMPNT)
C
C  PRINT OUTPUTS
C
      if (IPOSTP.EQ.3) call pheadr3(ATITLE)
      DO 100 I=1,NUMPNT
      XVAR=VALUE(LOCX+I)
      LOCYT=LOCY
      DO 90 K=1,KNTR
      YVAR(K)=VALUE(LOCYT+I)
      LOCYT=LOCYT+NPOINT
   90 CONTINUE
      WRITE (IOFILE,PRFORM) XVAR,(YVAR(K),K=1,KNTR)
      if (IPOSTP.EQ.3) write(ipostp) XVAR, (YVAR(K), K=1,KNTR)
  100 CONTINUE
      WRITE (IOFILE,111)
  111 FORMAT(1HY)
      CALL CLRMEM(LOCX)
      CALL CLRMEM(LOCY)
  120 LOC=NODPLC(LOC)
      GO TO 80
C
C  DC AND TRANSIENT ANALYSIS PLOTTING
C
  200 LOC=LOCATE(35+MODE)
  210 IF (LOC.EQ.0) GO TO 250
      KNTR=NODPLC(LOC+3)
      IF (KNTR.LE.0) GO TO 220
      LOCV=NODPLC(LOC+1)
      CALL TITLE(1,LWIDTH,1,SUBTIT(1,MODE))
      CALL SETPLT(LOC)
C
C     GET BUFFER SPACE
C
      CALL GETM8(LOCX,NPOINT)
      CALL GETM8(LOCY,KNTR*NPOINT)
C
C  INTERPOLATE OUTPUTS AND LOAD PLOT BUFFERS
C
      CALL NTRPL8(LOCX,LOCY,NUMPNT)
CDW Collect and write x and y values for spice3 raw file
      if (IPOSTP.EQ.3) then
         call pheadr3(ATITLE)
         do i=1,numpnt
            xvar=value(locx+i)
            locyt=locy
            do k=1,kntr
               yvar(k)=value(locyt+i)
               locyt=locyt+npoint
            enddo
            write(ipostp) xvar, (yvar(k), k=1,kntr)
         enddo
      endif
      CALL PLOT(NUMPNT,LOCX,LOCY,LOCV)
      CALL CLRMEM(LOCX)
      CALL CLRMEM(LOCY)
  220 LOC=NODPLC(LOC)
      GO TO 210
C
C  FOURIER ANALYSIS
C
  250 IF (MODE.EQ.1) GO TO 1000
      IF (NFOUR.EQ.0) GO TO 1000
      IF (NOGO.NE.0) GO TO 1000
      CALL FOURAN
      GO TO 1000
C
C  AC ANALYSIS PRINTING
C
  300 NUMOUT=JELCNT(43)+JELCNT(44)+JELCNT(45)+1
      DO 599 ID=33,35
      LOC=LOCATE(ID)
  320 IF (LOC.EQ.0) GO TO 599
      KNTR=MIN0(NOPRLN,NODPLC(LOC+3))
      IF (KNTR.LE.0) GO TO 595
      CALL TITLE(1,LWIDTH,1,SUBTIT(1,MODE))
      CALL SETPRN(LOC)
C
C  PRINT AC OUTPUTS
C
      if (IPOSTP.EQ.3) call pheadr3(ATITLE)
      LOUT=LOUTPT
      DO 590 I=1,ICALC
      XVAR=DBLE(REAL(CVALUE(LOUT+1)))
      DO 500 K=1,KNTR
      ISEQ=ITAB(K)
      ISEQ=NODPLC(ISEQ+4)
      CVAL=CVALUE(LOUT+ISEQ)
      KTYPE=ITYPE(K)
      GO TO (450,450,430,440,450,450), KTYPE
  430 YVAR(K)=DBLE(REAL(CVAL))
      GO TO 500
  440 YVAR(K)=DBLE(AIMAG(CVAL))
      GO TO 500
  450 CALL MAGPHS(CVAL,XMAG,XPHS)
      GO TO (460,460,430,440,470,465), KTYPE
  460 YVAR(K)=XMAG
      GO TO 500
  465 YVAR(K)=20.0D0*DLOG10(XMAG)
      GO TO 500
  470 YVAR(K)=XPHS
  500 CONTINUE
      LOUT=LOUT+NUMOUT
  580 WRITE (IOFILE,PRFORM) XVAR,(YVAR(K),K=1,KNTR)
      if (IPOSTP.EQ.3) write(ipostp) XVAR,(YVAR(K),K=1,KNTR)
  590 CONTINUE
      WRITE (IOFILE,111)
  595 LOC=NODPLC(LOC)
      GO TO 320
  599 CONTINUE
C
C  AC ANALYSIS PLOTTING
C
      DO 760 ID=38,40
      LOC=LOCATE(ID)
  610 IF (LOC.EQ.0) GO TO 760
      KNTR=NODPLC(LOC+3)
      IF (KNTR.LE.0) GO TO 750
      LOCV=NODPLC(LOC+1)
      CALL TITLE(1,LWIDTH,1,SUBTIT(1,MODE))
      CALL SETPLT(LOC)
C
      CALL GETM8(LOCX,ICALC)
      CALL GETM8(LOCY,KNTR*ICALC)
C
C     LOAD PLOT BUFFERS
C
      if (IPOSTP.EQ.3) call pheadr3(ATITLE)
      LOUT=LOUTPT
      DO 710 I=1,ICALC
      XVAR=DBLE(REAL(CVALUE(LOUT+1)))
      LOCYT=LOCY
      DO 700 K=1,KNTR
      ISEQ=ITAB(K)
      ISEQ=NODPLC(ISEQ+4)
      CVAL=CVALUE(LOUT+ISEQ)
      KTYPE=ITYPE(K)
      GO TO (670,670,650,660,670,670), KTYPE
  650 YVR=DBLE(REAL(CVAL))
      GO TO 695
  660 YVR=DBLE(AIMAG(CVAL))
      GO TO 695
  670 CALL MAGPHS(CVAL,XMAG,XPHS)
      GO TO (680,680,650,660,690,685), KTYPE
  680 YVR=DLOG10(XMAG)
      GO TO 695
  685 YVR=20.0D0*DLOG10(XMAG)
      GO TO 695
  690 YVR=XPHS
  695 VALUE(LOCYT+I)=YVR
      LOCYT=LOCYT+ICALC
      yvar(k)=YVR
  700 CONTINUE
      VALUE(LOCX+I)=XVAR
      LOUT=LOUT+NUMOUT
      if (IPOSTP.EQ.3) write(ipostp) XVAR,(yvar(K),K=1,KNTR)
  710 CONTINUE
      CALL PLOT(ICALC,LOCX,LOCY,LOCV)
      CALL CLRMEM(LOCX)
      CALL CLRMEM(LOCY)
  750 LOC=NODPLC(LOC)
      GO TO 610
  760 CONTINUE
C
C  FINISHED
C
 1000 CALL CLRMEM(LOUTPT)
      CALL SECOND(T2)
      RSTATS(11)=RSTATS(11)+T2-T1
      RETURN
      END
      SUBROUTINE NTRPL8(LOCX,LOCY,NUMPNT)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      REAL T1, T2
C
C     THIS ROUTINE INTERPOLATES THE ANALYSIS DATA TO OBTAIN THE VALUES
C PRINTED AND/OR PLOTTED, USING LINEAR INTERPOLATION.
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=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(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C
C  FOR DC TRANSFER CURVE, NO INTERPOLATION NECESSARY
C
      IF(MODE.NE.1) GO TO 4
      NUMPNT=ICALC
      LOCO=LOUTPT
      DO 3 I=1,NUMPNT
      LOCYT=LOCY
      VALUE(LOCX+I)=VALUE(LOCO+1)
      DO 2 K=1,KNTR
      ISEQ=ITAB(K)
      ISEQ=NODPLC(ISEQ+4)
      VALUE(LOCYT+I)=VALUE(LOCO+ISEQ)
      LOCYT=LOCYT+NPOINT
    2 CONTINUE
      LOCO=LOCO+NUMOUT
    3 CONTINUE
      RETURN
    4 CONTINUE
      XVAR=XSTART
      XVTOL=XINCR*1.0D-5
      IPPNT=0
      ICPNT=2
      LOCO1=LOUTPT
      LOCO2=LOCO1+NUMOUT
      IF (ICALC.LT.2) GO TO 50
   10 X1=VALUE(LOCO1+1)
      X2=VALUE(LOCO2+1)
      DX1X2=X1-X2
   20 IF (XINCR.LT.0.0D0) GO TO 24
      IF (XVAR.LE.(X2+XVTOL)) GO TO 30
      GO TO 28
   24 IF (XVAR.GE.(X2+XVTOL)) GO TO 30
   28 IF (ICPNT.GE.ICALC) GO TO 100
      ICPNT=ICPNT+1
      LOCO1=LOCO2
      LOCO2=LOCO1+NUMOUT
      GO TO 10
   30 IPPNT=IPPNT+1
      VALUE(LOCX+IPPNT)=XVAR
      DXX1=XVAR-X1
      LOCYT=LOCY
      DO 40 I=1,KNTR
      ISEQ=ITAB(I)
      ISEQ=NODPLC(ISEQ+4)
      V1=VALUE(LOCO1+ISEQ)
      V2=VALUE(LOCO2+ISEQ)
      YVR=V1+(V1-V2)*DXX1/DX1X2
      TOL=DMIN1(DABS(V1),DABS(V2))*1.0D-10
      IF (DABS(YVR).LE.TOL) YVR=0.0D0
      VALUE(LOCYT+IPPNT)=YVR
      LOCYT=LOCYT+NPOINT
   40 CONTINUE
      IF (IPPNT.GE.NPOINT) GO TO 100
      XVAR=XSTART+DFLOAT(IPPNT)*XINCR
      IF (DABS(XVAR).GE.DABS(XVTOL)) GO TO 20
      XVAR=0.0D0
      GO TO 20
C
C  SPECIAL HANDLING IF ICALC = 1
C
C...  ICALC=1;  JUST COPY OVER THE SINGLE POINT AND RETURN
   50 IPPNT=1
      VALUE(LOCX+IPPNT)=XVAR
      LOCYT=LOCY
      DO 60 I=1,KNTR
      ISEQ=ITAB(I)
      ISEQ=NODPLC(ISEQ+4)
      VALUE(LOCYT+IPPNT)=VALUE(LOCO1+ISEQ)
      LOCYT=LOCYT+NPOINT
   60 CONTINUE
      GO TO 100
C
C  RETURN
C
  100 NUMPNT=IPPNT
      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(1000000)
      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
      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(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
      double precision allstring(15)
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('LEGEND:'/)
      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)
CDW Collect all wanted plot signals in array
      allstring(i) = STRING(1)
      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)
CDW Transfer the plot signals into STRING array
      IF ( KNTR.NE.1 ) THEN
         do i = 1, KNTR
            STRING(i) = allstring(i)
         enddo
      endif
      RETURN
      END
      SUBROUTINE PLOT(NUMPNT,LOCX,LOCY,LOCV)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE GENERATES THE LINE-PRINTER PLOTS.
C
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=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=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=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(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C
      INTEGER XXOR
      DIMENSION YCOOR(5,8),ICOOR(8),DELPLT(8)
      DIMENSION AGRAPH(13),APLOT(13)
      DIMENSION ASYM(2),PMIN(8),JCOOR(8)
      DATA ABLNK, ALETX, APER / 1H , 1HX, 1H. /
      DATA ASYM1, ASYM2, ARPRN / 8H(-------, 8H--------, 1H) /
      DATA PLTSYM / 8H*+=$0<>? /
C
C
      IWIDE=1
      NWIDE=101
      NWIDE4=25
      IF(LWIDTH.GT.80) GO TO 3
      IWIDE=0
      NWIDE=57
      NWIDE4=14
    3 IF (NUMPNT.LE.0) GO TO 400
      DO 5 I=1,13
      AGRAPH(I)=ABLNK
    5 CONTINUE
      DO 7 I=1,5
      ISPOT=1+NWIDE4*(I-1)
      CALL MOVE(AGRAPH,ISPOT,APER,1,1)
    7 CONTINUE
      LOCYT=LOCY
      LSPOT=LOCV-1
      MLTSCL=0
      IF (VALUE(LOCV).EQ.0.0D0) MLTSCL=1
      DO 235 K=1,KNTR
      LSPOT=LSPOT+2
      YMIN=VALUE(LSPOT)
      YMAX=VALUE(LSPOT+1)
      IF (YMIN.NE.0.0D0) GO TO 10
      IF (YMAX.NE.0.0D0) GO TO 10
      GO TO 100
   10 YMIN1=DMIN1(YMIN,YMAX)
      YMAX1=DMAX1(YMIN,YMAX)
   30 IF (ILOGY(K).EQ.1) GO TO 40
      YMIN1=DLOG10(DMAX1(YMIN1,1.0D-20))
      YMAX1=DLOG10(DMAX1(YMAX1,1.0D-20))
      DEL=DMAX1(YMAX1-YMIN1,0.0001D0)/4.0D0
      GO TO 50
   40 DEL=DMAX1(YMAX1-YMIN1,1.0D-20)/4.0D0
   50 YMIN=YMIN1
      YMAX=YMAX1
      GO TO 200
C
C  DETERMINE MAX AND MIN VALUES
C
  100 YMAX1=VALUE(LOCYT+1)
      YMIN1=YMAX1
      IF (NUMPNT.EQ.1) GO TO 150
      DO 110 I=2,NUMPNT
      YMIN1=DMIN1(YMIN1,VALUE(LOCYT+I))
      YMAX1=DMAX1(YMAX1,VALUE(LOCYT+I))
  110 CONTINUE
C
C  SCALING
C
  150 CALL SCALE(YMIN1,YMAX1,4,YMIN,YMAX,DEL)
C
C  DETERMINE COORDINATES
C
  200 YCOOR(1,K)=YMIN
      PMIN(K)=YMIN
      SMALL=DEL*1.0D-4
      IF (DABS(YCOOR(1,K)).LE.SMALL) YCOOR(1,K)=0.0D0
      DO 210 I=1,4
      YCOOR(I+1,K)=YCOOR(I,K)+DEL
      IF (DABS(YCOOR(I+1,K)).LE.SMALL) YCOOR(I+1,K)=0.0D0
  210 CONTINUE
      IF (ILOGY(K).EQ.1) GO TO 230
      DO 220 I=1,5
  220 YCOOR(I,K)=DEXP(XLOG10*YCOOR(I,K))
  230 DELPLT(K)=DEL/DFLOAT(NWIDE4)
      LOCYT=LOCYT+NPOINT
  235 CONTINUE
C
C  COUNT DISTINCT COORDINATES
C
      ICOOR(1)=1
      JCOOR(1)=1
      NUMCOR=1
      IF (KNTR.EQ.1) GO TO 290
      DO 250 I=2,KNTR
      DO 245 J=1,NUMCOR
      L=JCOOR(J)
C...  COORDINATES ARE *EQUAL* IF THE MOST SIGNIFICANT 24 BITS AGREE
      DO 240 K=1,5
C*****************************************************************
C  TEMPORARILY CHECK 'EQUALITY' THIS WAY
      Y1=YCOOR(K,I)
      Y2=YCOOR(K,L)
      IF(Y1.EQ.0.0D0.AND.Y2.EQ.0.0D0) GO TO 240
      IF(DABS((Y1-Y2)/DMAX1(DABS(Y1),DABS(Y2))).GE.1.0D-7) GO TO 245
  240 CONTINUE
      ICOOR(I)=L
      GO TO 250
  245 CONTINUE
      ICOOR(I)=I
      NUMCOR=NUMCOR+1
      JCOOR(NUMCOR)=I
  250 CONTINUE
C
C  PRINT COORDINATES
C
  260 DO 280 I=1,NUMCOR
      ASYM(1)=ASYM1
      ASYM(2)=ASYM2
      IPOS=2
      DO 270 J=1,KNTR
      IF (ICOOR(J).NE.JCOOR(I)) GO TO 270
      CALL MOVE(ASYM,IPOS,PLTSYM,J,1)
      IPOS=IPOS+1
  270 CONTINUE
      CALL MOVE(ASYM,IPOS,ARPRN,1,1)
      K=JCOOR(I)
      IF(IWIDE.NE.0) WRITE(IOFILE,271) ASYM,(YCOOR(J,K),J=1,5)
  271 FORMAT(/2A8,4H----,1PD12.3,4(15X,D10.3)/26X,51(2H -))
      IF(IWIDE.EQ.0) WRITE(IOFILE,273) ASYM,(YCOOR(J,K),J=1,5)
  273 FORMAT(/2A8,1X,1PD10.3,3(4X,D10.3),1X,D10.3/22X,29(2H -))
  280 CONTINUE
      GO TO 300
  290 IF(IWIDE.NE.0) WRITE(IOFILE,291) (YCOOR(J,1),J=1,5)
  291 FORMAT(/20X,1PD12.3,4(15X,D10.3)/26X,51(2H -))
      IF(IWIDE.EQ.0) WRITE(IOFILE,293) (YCOOR(J,1),J=1,5)
  293 FORMAT(/15X,1PD12.3,3(4X,D10.3),1X,D10.3/22X,29(2H -))
C
C  PLOTTING
C
  300 ASPOT=ABLNK
      DO 320 I=1,NUMPNT
      XVAR=VALUE(LOCX+I)
      LOCYT=LOCY
      CALL COPY8(AGRAPH,APLOT,13)
      DO 310 K=1,KNTR
      YVR=VALUE(LOCYT+I)
      KTMP=ICOOR(K)
      YMIN1=PMIN(KTMP)
      JPOINT=IDINT((YVR-YMIN1)/DELPLT(K)+0.5D0)+1
      IF (JPOINT.LE.0) GO TO 306
      IF (JPOINT.GT.NWIDE) GO TO 306
      CALL MOVE(ASPOT,1,APLOT,JPOINT,1)
      IF (ASPOT.EQ.ABLNK) GO TO 303
      IF (ASPOT.EQ.APER) GO TO 303
      CALL MOVE(APLOT,JPOINT,ALETX,1,1)
      GO TO 306
  303 CALL MOVE(APLOT,JPOINT,PLTSYM,K,1)
  306 LOCYT=LOCYT+NPOINT
  310 CONTINUE
      YVR=VALUE(LOCY+I)
      IF (ILOGY(1).EQ.1) GO TO 315
      YVR=DEXP(XLOG10*YVR)
  315 IF(IWIDE.NE.0) WRITE(IOFILE,316) XVAR,YVR,APLOT
  316 FORMAT(1PD10.3,3X,D10.3,3X,13A8)
      IF(IWIDE.EQ.0) WRITE(IOFILE,317) XVAR,YVR,(APLOT(K),K=1,8)
  317 FORMAT(1PD10.3,1X,D10.3,1X,7A8,A1)
  320 CONTINUE
C
C  FINISHED
C
      IF(IWIDE.NE.0) WRITE(IOFILE,331)
  331 FORMAT(26X,51(2H -)//)
      IF(IWIDE.EQ.0) WRITE(IOFILE,332)
  332 FORMAT(22X,29(2H -)//)
      GO TO 500
C
C  TOO FEW POINTS
C
  400 WRITE (IOFILE,401)
  401 FORMAT('WARNING:  TOO FEW POINTS FOR PLOTTING'/)
  500 WRITE (IOFILE,501)
  501 FORMAT(1HY)
      RETURN
      END
      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)/DFLOAT(N)
      NAL=IDINT(DLOG10(A))
      IF (A.LT.1.0D0) NAL=NAL-1
      XFACT=DEXP(XLOG10*DFLOAT(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(DFLOAT(M1)+1.0D0-FM1).LT.EPS) M1=M1+1
C...  COMPUTE NEW MAXIMUM AND MINIMUM LIMITS
      XMINP=DEL*DFLOAT(M1)
      FM2=XMAX/DEL
      M2=FM2+1.0D0
      IF (FM2.LT.(-1.0D0)) M2=M2-1
      IF (DABS(FM2+1.0D0-DFLOAT(M2)).LT.EPS) M2=M2-1
      XMAXP=DEL*DFLOAT(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-DFLOAT(NX)*DEL)
      XMAXP=DMAX1(XMAX,XMINP+DFLOAT(N)*DEL)
      RETURN
      END
      SUBROUTINE FOURAN
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     THIS ROUTINE DETERMINES THE FOURIER COEFFICIENTS OF A TRANSIENT
C ANALYSIS WAVEFORM.
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=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=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=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=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(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C
C
      DIMENSION SINCO(9),COSCO(9)
      DIMENSION FORTIT(4)
      DATA FORTIT / 8HFOURIER , 8HANALYSIS, 8H        , 8H         /
      DATA ABLNK / 1H  /
C
C
      FORPRD=1.0D0/FORFRE
      XSTART=TSTOP-FORPRD
      KNTR=1
CC    XN=101.0D0
      XINCR=FORPRD/NPOINT
CC    NPOINT=XN
      CALL GETM8(LOCX,NPOINT)
      CALL GETM8(LOCY,NPOINT)
      DO 105 NKNT=1,NFOUR
      ITAB(1)=NODPLC(IFOUR+NKNT)
      KFROUT=ITAB(1)
      CALL NTRPL8(LOCX,LOCY,NUMPNT)
      DCCO=0.0D0
      CALL ZERO8(SINCO,9)
      CALL ZERO8(COSCO,9)
      LOCT=LOCY+1
      IPNT=0
   10 YVR=VALUE(LOCT+IPNT)
      DCCO=DCCO+YVR
      FORFAC=DFLOAT(IPNT)*TWOPI/NPOINT
      ARG=0.0D0
      DO 20 K=1,9
      ARG=ARG+FORFAC
      SINCO(K)=SINCO(K)+YVR*DSIN(ARG)
      COSCO(K)=COSCO(K)+YVR*DCOS(ARG)
   20 CONTINUE
      IPNT=IPNT+1
      IF (IPNT.NE.NPOINT) GO TO 10
      DCCO=DCCO/NPOINT
      FORFAC=2.0D0/NPOINT
      DO 30 K=1,9
      SINCO(K)=SINCO(K)*FORFAC
      COSCO(K)=COSCO(K)*FORFAC
   30 CONTINUE
      CALL TITLE(0,72,1,FORTIT)
      IPOS=1
      CALL OUTNAM(KFROUT,1,STRING,IPOS)
      CALL MOVE(STRING,IPOS,ABLNK,1,7)
      JSTOP=(IPOS+6)/8
      WRITE (IOFILE,61) (STRING(J),J=1,JSTOP)
   61 FORMAT(' FOURIER COMPONENTS OF TRANSIENT RESPONSE ',5A8///)
      WRITE (IOFILE,71) DCCO
   71 FORMAT('DC COMPONENT =',1PD12.3/,
     1   'HARMONIC   FREQUENCY    FOURIER    NORMALIZED    PHASE     NO
     2RMALIZED'/,
     3   '    NO         (HZ)     COMPONENT    COMPONENT    (DEG)    PHA
     4SE (DEG)'//)
      IKNT=1
      FREQ1=FORFRE
      XNHARM=1.0D0
      CALL MAGPHS(CMPLX(SNGL(SINCO(1)),SNGL(COSCO(1))),XNORM,PNORM)
      PHASEN=0.0D0
      WRITE (IOFILE,81) IKNT,FREQ1,XNORM,XNHARM,PNORM,PHASEN
   81 FORMAT(I6,1PD15.3,D12.3,0PF13.6,F10.3,F12.3/)
      THD=0.0D0
      DO 90 IKNT=2,9
      FREQ1=DFLOAT(IKNT)*FORFRE
      CALL MAGPHS(CMPLX(SNGL(SINCO(IKNT)),SNGL(COSCO(IKNT))),
     1   HARM,PHASE)
      XNHARM=HARM/XNORM
      PHASEN=PHASE-PNORM
      THD=THD+XNHARM*XNHARM
      WRITE (IOFILE,81) IKNT,FREQ1,HARM,XNHARM,PHASE,PHASEN
   90 CONTINUE
      THD=100.0D0*DSQRT(THD)
      WRITE (IOFILE,101) THD
  101 FORMAT (//5X,'TOTAL HARMONIC DISTORTION =  ',F12.6,'  PERCENT')
  105 CONTINUE
      CALL CLRMEM(LOCX)
      CALL CLRMEM(LOCY)
  110 RETURN
      END

C
C Open raw data file.  Return 1 if file is opened,
C return 0 if file is not opened
C
      integer function iopraw()
  
      integer i, iargc, argc
      character*256 argv, rawfile
      iopraw = 0
      argc = iargc()
      do i = 1, argc
         call getarg( i, argv )
         if ( argv .eq. '-r' ) then
            if ( i < argc ) then
               call getarg( i+1, argv )
               rawfile = argv
               iopraw = 2
               goto 22
            else
               rawfile = "rawspice"
            endif
         else if ( argv .eq. '-r3' ) then
            if ( i < argc ) then
               call getarg( i+1, argv )
               rawfile = argv
               iopraw = 3
               goto 22
            else
               rawfile = "rawspice"
            endif
         else
            write(*, 102) argv
  102 format ('spice: illegal option - ', 1x, a12, ' - ignored')
            return
         endif
      end do
   22 open(unit=iopraw, file=rawfile, form='unformatted',
     &access='stream', status='replace', err=1500)
      return
 1500 write (*,103) rawfile
  103 format ('SPICE: unable to open file ',a12,' status: ',
     & 'SPICE:  *** program terminated ***')
      stop

      end

C 
C Write into raw file numwds 16 bit words starting
C at location data
C 
      subroutine fwrite(data, numwds)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)

      integer numwds
      integer*2 data(numwds)

c     File-Unit from COMMON-Block
      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     Writing binary (Stream-File assumed)
      write(ipostp) data

c     Equivalent fflush(rawfile)
      call flush(ipostp)

      return
      end

C 
C Close raw file.
C 
      subroutine clsraw()
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      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

      close(ipostp)

      end

      SUBROUTINE PHEADR3(AHEADR)
      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=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=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=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=BLANK 3/15/83
      COMMON /outinf/ Xincr , String(15) , Xstart , Yvar(8) , Itab(8) , 
     &                Itype(8) , Ilogy(8) , Npoint , Numout , Kntr , 
     &                Numdgt
      COMMON /BLANK/ VALUE(1000000)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      INTEGER NODPL2(128)
      EQUIVALENCE (VALUE(1),NODPL2(1))
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
      character*120 rawstring
      equivalence (String(1), rawstring)
      character numbuf*8, varbuf*80
      integer ipos
      DIMENSION AHEADR(10)
C
C  PUT OUT THE HEADER RECORDS ONTO THE POST-PROCESSING FILE
C  ROUTINE IS USED FOR ALL ANALYSIS MODES (MODE=1,2,3)
C
      DIMENSION XTYPE(2)
      DATA XTYPE /4HTIME,4HFREQ/
      DATA ABLNK,ALETV,ALETI /1H ,1HV,1HI/
C
C File structure for post-processor spice3 raw file
C
C Title: Title card (80 bytes)
C Date: date (8 bytes), time (8 bytes)
C Plotname: Plotname (24 bytes)
C Flags: kind of data (real or complex) (8 bytes)
C No. Variables: Number output variables (incl. "sweep" variable) (8 bytes)
C No. Points: Number of data points (8 bytes)
C Variables:
C 	location	Name of independent variable	Type
C 	location	Name of 1. dependent variable	Type
C 	location	Name of 2. dependent variable	Type
C                 .
C 	location	Name of N. dependent variable	type
C               Type of each output       0-no type
C                                         1-time
C                                         2-frequency
C                                         3-voltage
C                                         4-current
C                                         5-output noise
C                                         6-input noise
C Binary: Begin of data section
C       Output at first sweep point
C       Output at second sweep point
C           .
C           .
C last record
C
      CALL GETM8(IBUFF,12)
      CALL COPY8(AHEADR(1),VALUE(IBUFF+1),10)

      write(ipostp) 'Title: '
      write(varbuf,'(10A8)') (ATITLE(I),I=1,10)
      write(ipostp) varbuf(1:len_trim(varbuf))//char(10)
      write(ipostp) 'Date: '
      write(varbuf,'(A8,1X,A8)') ADATE, ATIME
      write(ipostp) varbuf(1:len_trim(varbuf))//char(10)
      write(ipostp) 'Plotname: '
      write(varbuf,'(3A8)') (APROG(I),I=1,3)
      write(ipostp) varbuf(1:len_trim(varbuf))//char(10)
C      write(iofile,*) 'NUMOUT: ', NUMOUT
      CALL GETM8(INAMES,NUMOUT)
      CALL GETM4(ITYPES,NUMOUT)
      CALL GETM4(ISEQS,NUMOUT)
      ITYPE2=ITYPES*2
      ISEQ2=ISEQS*2
      IKNT=1
      NODPL2(ISEQ2+1)=1
C
C DC Transfer curve (mode = 1):
C
      IF ( Mode.NE.1 ) THEN
         Value(inames+1) = xtype(Mode-1)
         Nodpl2(itype2+1) = Mode - 1
      ELSE
         loc = Itcelm(1)
         locv = Nodplc(loc+1)
         Value(inames+1) = Value(locv)
         anam = ablnk
         CALL move(anam,1,Value(locv),1,1)
         ityp = 0
C Voltage transfer becomes type 3 and Current transfer becomes 4.
         IF ( anam.EQ.aletv ) ityp = 3
         IF ( anam.EQ.aleti ) ityp = 4
         Nodpl2(itype2+1) = ityp
      ENDIF
      DO i = 2 , Nunods
         Nodpl2(itype2+i) = 3
         Nodpl2(iseq2+i) = i
         Value(inames+i) = ablnk
         ipos = 1
         CALL alfnum(Nodplc(Junode+i),Value(inames+i),ipos)
      ENDDO
      loc = Locate(9)
      iknt = Nunods
      DO WHILE ( loc.NE.0 )
         iknt = iknt + 1
         Nodpl2(itype2+iknt) = 4
         Nodpl2(iseq2+iknt) = iknt
         locv = Nodplc(loc+1)
         Value(inames+iknt) = Value(locv)
         loc = Nodplc(loc)
      ENDDO

      write(ipostp) 'Flags: real'//char(10)

      write(ipostp) 'No. Variables:'
      write(numbuf,'(I8)') Kntr+1
      write(ipostp) numbuf(1:8)//char(10)

      write(ipostp) 'No. Points:'
      write(numbuf,'(I8)') Npoint
      write(ipostp) numbuf(1:8)//char(10)

      write(ipostp) 'Variables:'//char(10)
      DO I = 1,NUMOUT
         write(numbuf,'(I8)') 0
         numbuf = adjustl(numbuf)
         write(ipostp) char(9)//numbuf(1:len_trim(numbuf))//char(9)
         write(varbuf,'(A8)') VALUE(INAMES+I)
         write(ipostp) varbuf(1:len_trim(varbuf))//char(9)
         if (NODPL2(ITYPE2+I).eq.1) then
            write(ipostp) 'time'//char(10)
            exit
         else if (NODPL2(ITYPE2+I).eq.2) then
            write(ipostp) 'frequency'//char(10)
            exit
         else if (NODPL2(ITYPE2+I).eq.3) then
            write(ipostp) 'voltage'//char(10)
            exit
         else if (NODPL2(ITYPE2+I).eq.4) then
            write(ipostp) 'current'//char(10)
            exit
         endif
      END DO

C      write(iofile,*) rawstring
C      write(iofile,*) 'KNTR: ', KNTR
      ipos = 1
      do i = 1, kntr
         call get_varname(rawstring, ipos, varbuf)
         varbuf = adjustl(varbuf)
C      write(iofile,'(A)') varbuf(1:len_trim(varbuf))
         j = ichar(varbuf(1:1))
         write(numbuf,'(I8)') i
         numbuf = adjustl(numbuf)
         write(ipostp) char(9)//numbuf(1:len_trim(numbuf))//char(9)
         if ((j.eq.86).or.(j.eq.73).or.(j.eq.79)) then
            if (varbuf(1:2).eq.'IN') then
               write(ipostp) varbuf(1:len_trim(varbuf))
               write(ipostp) char(9)//'inoise'//char(10)
            else if (varbuf(1:2).eq.'ON') then
               write(ipostp) varbuf(1:len_trim(varbuf))
               write(ipostp) char(9)//'onoise'//char(10)
            else if (varbuf(1:1).eq.'V') then
               write(ipostp) varbuf(1:len_trim(varbuf))
               write(ipostp) char(9)//'voltage'//char(10)
            else if (varbuf(1:1).eq.'I') then
               write(ipostp) varbuf(1:len_trim(varbuf))
               write(ipostp) char(9)//'current'//char(10)
            endif
         endif
      enddo

      write(ipostp) 'Binary:'//char(10)

      CALL CLRMEM(IBUFF)
      CALL CLRMEM(INAMES)
      CALL CLRMEM(ITYPES)
      CALL CLRMEM(ISEQS)
      RETURN
      END
      SUBROUTINE GET_VARNAME(RAW, IPOS, NAME)
      CHARACTER*(*) RAW
      CHARACTER*(*) NAME
      INTEGER IPOS

      INTEGER LRAW, K
      CHARACTER*1 C

      LRAW = LEN(RAW)
      NAME = ' '
      K = 1

c     Führende Blanks ODER NULs überspringen
 10   IF (IPOS .GT. LRAW) RETURN
      C = RAW(IPOS:IPOS)
      IF (C .EQ. ' ' .OR. ICHAR(C) .EQ. 0) THEN
         IPOS = IPOS + 1
         GOTO 10
      ENDIF

c     Zeichen sammeln bis Blank ODER NUL
 20   IF (IPOS .GT. LRAW) GOTO 30
      C = RAW(IPOS:IPOS)
      IF (C .EQ. ' ' .OR. ICHAR(C) .EQ. 0) GOTO 30

      NAME(K:K) = C
      K = K + 1
      IPOS = IPOS + 1
      GOTO 20

 30   CONTINUE
      RETURN
      END

      SUBROUTINE XDATE(BDATE)
      IMPLICIT NONE
      DOUBLE PRECISION BDATE
      CHARACTER*8 CDATE
      CHARACTER*8 DDATE
      CHARACTER*10 DTIME

      CALL DATE_AND_TIME(DDATE, DTIME)
      CDATE = DDATE

      BDATE = TRANSFER(CDATE, BDATE)

      RETURN
      END

      SUBROUTINE XTIME(BTIME)
      IMPLICIT NONE
      DOUBLE PRECISION BTIME
      CHARACTER*8 CTIME
      CHARACTER*10 DTIME
      CHARACTER*8  DDATE

      CALL DATE_AND_TIME(DDATE, DTIME)

C     HH:MM:SS from DTIME(1:8)
      CTIME = DTIME(1:8)

      BTIME = TRANSFER(CTIME, BTIME)

      RETURN
      END