FTN66,Y,J,E 
*************************************************************** 
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  ALL RIGHTS     * 
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE-  * 
* REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * 
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.   * 
*************************************************************** 
*  NAME:   ERRCK                      * 
*  SOURCE: 92091-18003                * 
*  RELOC:  92091-16003                * 
*  PGMR:   C. GEBER                   * 
*************************************** 
$PAGE 
$EMA /BLANK/
$CDS ON 
      SUBROUTINE ADDELT( LOCE , LOC , ID , INODX , INODI , NNODI )
     + ,92091-16003 REV.5000 <890418.1140>
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE ADDS AN ELEMENT TO THE NOMINAL CIRCUIT DEFINITION
C LISTS.
C 
      COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 
     1   ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 
     2   JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 
     3   NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 
     4   LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD,
     5   IMYNL,IMVN,LCVN,NSNOD,NSMAT,NSVAL,ICNOD,ICMAT,ICVAL, 
     6   LOUTPT,LPOL,LZER,IRSWPF,IRSWPR,ICSWPF,ICSWPR,IRPT,JCPT,
     7   IROWNO,JCOLNO,NTTBR,NTTAR,LVNTMP 
      COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 
     1   NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS
      COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS,
     1   LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF 
      COMMON /BLANK/ VALUE(64)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C 
C... INODX(1), INODI(1) ARE ARRAYS (SEE SUBCKT) 
C 
      DIMENSION INODX(1),INODI(1) 
C 
      DIMENSION LNOD(50),LVAL(50),NNODS(50) 
      DATA LNOD / 9,13,15, 7,14,15,14,15,12, 7, 
     1           17,37,26,34, 7, 7,34, 0, 5, 5, 
     2            4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 
     3           21,21,21,21,21,21,21,21,21,21, 
     4            8, 8, 8, 8, 8, 0, 0, 0, 0, 0 /
      DATA LVAL / 5, 4, 4, 2, 1, 1, 1, 1, 4, 4, 
     1            3, 4, 4,16, 1, 1, 9, 0, 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 / 
$PAGE 
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)) 
$PAGE 
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 
  300 RETURN
      END 
$EMA /BLANK/
      SUBROUTINE ELPRNT 
     + ,92091-16003 REV.5000 <890418.1140>  
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE PRINTS A CIRCUIT ELEMENT SUMMARY.
C 
      COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 
     1   ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 
     2   JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 
     3   NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 
     4   LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD,
     5   IMYNL,IMVN,LCVN,NSNOD,NSMAT,NSVAL,ICNOD,ICMAT,ICVAL, 
     6   LOUTPT,LPOL,LZER,IRSWPF,IRSWPR,ICSWPF,ICSWPR,IRPT,JCPT,
     7   IROWNO,JCOLNO,NTTBR,NTTAR,LVNTMP 
      COMMON /MISCEL/ ATIME,APROG(3),ADATE,ATITLE(10),DEFL,DEFW,DEFAD,
     1  DEFAS,RSTATS(50),IWIDTH,LWIDTH,NOPAGE 
      COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 
     1   NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS
      COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS,
     1   LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF 
      COMMON /TRAN/ TSTEP,TSTOP,TSTART,DELMAX,TDMAX,FORFRE,JTRFLG 
      COMMON /BLANK/ VALUE(64)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
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) 
$PAGE 
C 
C  PRINT RESISTORS
C 
      IF (JELCNT(1).EQ.0) GO TO 50
      ITITLE=0
   21 FORMAT(//'0**** RESISTORS'/'0     NAME        NODES     VALUE 
     1  TC1        TC2'//)
      LOC=LOCATE(1) 
   30 IF (LOC.EQ.0) GO TO 50
      IF (ITITLE.EQ.0) WRITE (6,21) 
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2) 
      NODE2=NODPLC(LOC+3) 
      WRITE (6,31) VALUE(LOCV),NODPLC(JUNODE+NODE1),
     1   NODPLC(JUNODE+NODE2),VALUE(LOCV+2),VALUE(LOCV+3),VALUE(LOCV+4) 
   31 FORMAT(6X,A8,2I5,1P3D11.2)
   40 LOC=NODPLC(LOC) 
      GO TO 30
C 
C  PRINT CAPACITORS AND INDUCTORS 
C 
   50 IF ((JELCNT(2)+JELCNT(3)).EQ.0) GO TO 80
      ITITLE=0
   51 FORMAT(//'0**** CAPACITORS AND INDUCTORS'/'0     NAME        NODES
     1    IN COND     VALUE'//) 
      DO 70 ID=2,3
      LOC=LOCATE(ID)
   60 IF (LOC.EQ.0) GO TO 70
      IF (ITITLE.EQ.0) WRITE (6,51) 
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2) 
      NODE2=NODPLC(LOC+3) 
      IF (NODPLC(LOC+4).NE.1) GO TO 62
      WRITE (6,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 (6,63) VALUE(LOCV),NODPLC(JUNODE+NODE1),
     1   NODPLC(JUNODE+NODE2),VALUE(LOCV+2) 
   63 FORMAT(6X,A8,2I5,1PD11.2,'   VARIABLE') 
   65 LOC=NODPLC(LOC) 
      GO TO 60
   70 CONTINUE
$PAGE 
C 
C  PRINT MUTUAL INDUCTORS 
C 
   80 IF (JELCNT(4).EQ.0) GO TO 100 
      ITITLE=0
   81 FORMAT(//'0**** MUTUAL INDUCTORS'/'0     NAME        COUPLED INDUC
     1TORS   VALUE'//)
      LOC=LOCATE(4) 
   90 IF (LOC.EQ.0) GO TO 110 
      IF (ITITLE.EQ.0) WRITE (6,81) 
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      NL1=NODPLC(LOC+2) 
      NL1=NODPLC(NL1+1) 
      NL2=NODPLC(LOC+3) 
      NL2=NODPLC(NL2+1) 
      WRITE (6,91) VALUE(LOCV),VALUE(NL1),VALUE(NL2),VALUE(LOCV+1)
   91 FORMAT(6X,A8,4X,A8,2X,A8,1PD10.2) 
   95 LOC=NODPLC(LOC) 
      GO TO 90
C 
C  PRINT NONLINEAR VOLTAGE CONTROLLED SOURCES 
C 
  100 IF (JELCNT(5).EQ.0) GO TO 120 
      ITITLE=0
  101 FORMAT(//'0**** VOLTAGE-CONTROLLED CURRENT SOURCES'/'0     NAME 
     1     +    -   DIMENSION   FUNCTION')
      LOC=LOCATE(5) 
  110 IF (LOC.EQ.0) GO TO 120 
      IF (ITITLE.EQ.0) WRITE (6,101)
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2) 
      NODE2=NODPLC(LOC+3) 
      WRITE (6,111) VALUE(LOCV),NODPLC(JUNODE+NODE1), 
     1   NODPLC(JUNODE+NODE2),NODPLC(LOC+4) 
  111 FORMAT(6X,A8,2I5,I8,9X,'POLY')
  115 LOC=NODPLC(LOC) 
      GO TO 110 
$PAGE 
C 
C  NONLINEAR VOLTAGE CONTROLLED VOLTAGE SOURCES 
C 
  120 IF (JELCNT(6).EQ.0) GO TO 140 
      ITITLE=0
  121 FORMAT(//'0**** VOLTAGE-CONTROLLED VOLTAGE SOURCES'/'0     NAME 
     1     +    -   DIMENSION   FUNCTION')
      LOC=LOCATE(6) 
  130 IF (LOC.EQ.0) GO TO 140 
      IF (ITITLE.EQ.0) WRITE (6,121)
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2) 
      NODE2=NODPLC(LOC+3) 
      WRITE (6,111) VALUE(LOCV),NODPLC(JUNODE+NODE1), 
     1   NODPLC(JUNODE+NODE2),NODPLC(LOC+4) 
  135 LOC=NODPLC(LOC) 
      GO TO 130 
C 
C  NONLINEAR CURRENT CONTROLLED CURRENT SOURCES 
C 
  140 IF (JELCNT(7).EQ.0) GO TO 160 
      ITITLE=0
  141 FORMAT(//'0**** CURRENT-CONTROLLED CURRENT SOURCES'/'0     NAME 
     1     +    -   DIMENSION   FUNCTION')
      LOC=LOCATE(7) 
  150 IF (LOC.EQ.0) GO TO 160 
      IF (ITITLE.EQ.0) WRITE (6,141)
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2) 
      NODE2=NODPLC(LOC+3) 
      WRITE (6,111) VALUE(LOCV),NODPLC(JUNODE+NODE1), 
     1   NODPLC(JUNODE+NODE2),NODPLC(LOC+4) 
  155 LOC=NODPLC(LOC) 
      GO TO 150 
C 
C  NONLINEAR CURRENT CONTROLLED VOLTAGE SOURCES 
C 
  160 IF (JELCNT(8).EQ.0) GO TO 170 
      ITITLE=0
  161 FORMAT(//'0**** CURRENT-CONTROLLED VOLTAGE SOURCES'/'0     NAME 
     1     +    -   DIMENSION   FUNCTION')
      LOC=LOCATE(8) 
  165 IF (LOC.EQ.0) GO TO 170 
      IF (ITITLE.EQ.0) WRITE (6,161)
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2) 
      NODE2=NODPLC(LOC+3) 
      WRITE (6,111) VALUE(LOCV),NODPLC(JUNODE+NODE1), 
     1   NODPLC(JUNODE+NODE2),NODPLC(LOC+4) 
  167 LOC=NODPLC(LOC) 
      GO TO 165 
$PAGE 
C 
C  PRINT INDEPENDENT SOURCES
C 
  170 IF ((JELCNT(9)+JELCNT(10)).EQ.0) GO TO 250
      ITITLE=0
  171 FORMAT(//'0**** INDEPENDENT SOURCES'/'0     NAME        NODES   DC
     1 VALUE   AC VALUE   AC PHASE   TRANSIENT'//)
      DO 245 ID=9,10
      LOC=LOCATE(ID)
  180 IF (LOC.EQ.0) GO TO 245 
      IF (ITITLE.EQ.0) WRITE (6,171)
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      LOCP=NODPLC(LOC+5)
      NODE1=NODPLC(LOC+2) 
      NODE2=NODPLC(LOC+3) 
      ITYPE=NODPLC(LOC+4)+1 
      ANAM=ASTYP(ITYPE) 
      WRITE (6,181) VALUE(LOCV),NODPLC(JUNODE+NODE1), 
     1   NODPLC(JUNODE+NODE2),VALUE(LOCV+1),VALUE(LOCV+2),
     2   VALUE(LOCV+3),ANAM 
  181 FORMAT(6X,A8,2I5,1P3D11.2,2X,A8)
      IF (JTRFLG.EQ.0) GO TO 240
      JSTART=LOCP+1 
      GO TO (240,190,200,210,220,230), ITYPE
  190 JSTOP=LOCP+7
      WRITE (6,191) (VALUE(J),J=JSTART,JSTOP) 
  191 FORMAT(1H0,42X,'INITIAL VALUE',1PD11.2,/, 
     1           43X,'PULSED VALUE.',  D11.2,/, 
     2           43X,'DELAY TIME...',  D11.2,/, 
     3           43X,'RISETIME.....',  D11.2,/, 
     4           43X,'FALLTIME.....',  D11.2,/, 
     5           43X,'WIDTH........',  D11.2,/, 
     6           43X,'PERIOD.......',  D11.2,/) 
      GO TO 240 
  200 JSTOP=LOCP+5
      WRITE (6,201) (VALUE(J),J=JSTART,JSTOP) 
  201 FORMAT(1H0,42X,'OFFSET.......',1PD11.2,/, 
     1           43X,'AMPLITUDE....',  D11.2,/, 
     2           43X,'FREQUENCY....',  D11.2,/, 
     3           43X,'DELAY........',  D11.2,/, 
     4           43X,'THETA........',  D11.2,/) 
      GO TO 240 
  210 JSTOP=LOCP+6
      WRITE (6,211) (VALUE(J),J=JSTART,JSTOP) 
  211 FORMAT(1H0,42X,'INITIAL VALUE',1PD11.2,/, 
     1           43X,'PULSED VALUE.',  D11.2,/, 
     2           43X,'RISE DELAY...',  D11.2,/, 
     3           43X,'RISE TAU.....',  D11.2,/, 
     4           43X,'FALL DELAY...',  D11.2,/, 
     5           43X,'FALL TAU.....',  D11.2,/) 
      GO TO 240 
$PAGE 
  220 CALL SIZMEM(NODPLC(LOC+5),JSTOP)
      JSTOP=LOCP+JSTOP
      WRITE (6,221) (VALUE(J),J=JSTART,JSTOP) 
  221 FORMAT(1H0,49X,'TIME       VALUE'//,(46X,1P2D11.2)) 
      WRITE (6,226) 
  226 FORMAT(1X)
      GO TO 240 
  230 JSTOP=LOCP+5
      WRITE (6,231) (VALUE(J),J=JSTART,JSTOP) 
  231 FORMAT(1H0,42X,'OFFSET.......',1PD11.2,/, 
     1           43X,'AMPLITUDE....',  D11.2,/, 
     2           43X,'CARRIER FREQ.',  D11.2,/, 
     3           43X,'MODN INDEX...',  D11.2,/, 
     4           43X,'SIGNAL FREQ..',  D11.2,/) 
  240 LOC=NODPLC(LOC) 
      GO TO 180 
  245 CONTINUE
C 
C  PRINT TRANSMISSION LINES 
C 
  250 IF (JELCNT(17).EQ.0) GO TO 260
      ITITLE=0
  251 FORMAT(//'0**** TRANSMISSION LINES'/'0     NAME             NODES 
     1           Z0         TD'//)
      LOC=LOCATE(17)
  253 IF (LOC.EQ.0) GO TO 260 
      IF (ITITLE.EQ.0) WRITE (6,251)
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2) 
      NODE2=NODPLC(LOC+3) 
      NODE3=NODPLC(LOC+4) 
      NODE4=NODPLC(LOC+5) 
      WRITE (6,256) VALUE(LOCV),NODPLC(JUNODE+NODE1), 
     1   NODPLC(JUNODE+NODE2),NODPLC(JUNODE+NODE3), 
     2   NODPLC(JUNODE+NODE4),VALUE(LOCV+1),VALUE(LOCV+2) 
  256 FORMAT(6X,A8,4I5,1P2D11.2)
  258 LOC=NODPLC(LOC) 
      GO TO 253 
$PAGE 
C 
C  PRINT DIODES 
C 
  260 IF (JELCNT(11).EQ.0) GO TO 290
      ITITLE=0
  261 FORMAT(//'0**** DIODES'/'0     NAME        +    -  MODEL       ARE
     1A'//) 
      LOC=LOCATE(11)
  270 IF (LOC.EQ.0) GO TO 290 
      IF (ITITLE.EQ.0) WRITE (6,261)
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2) 
      NODE2=NODPLC(LOC+3) 
      LOCM=NODPLC(LOC+5)
      LOCM=NODPLC(LOCM+1) 
      AIC=ABLNK 
      IF (NODPLC(LOC+6).EQ.1) AIC=AOFF
      WRITE (6,271) VALUE(LOCV),NODPLC(JUNODE+NODE1), 
     1   NODPLC(JUNODE+NODE2),VALUE(LOCM),VALUE(LOCV+1),AIC 
  271 FORMAT(6X,A8,2I5,2X,A8,F8.3,2X,A8)
  280 LOC=NODPLC(LOC) 
      GO TO 270 
C 
C  PRINT TRANSISTORS
C 
  290 IF (JELCNT(12).EQ.0) GO TO 320
      ITITLE=0
  291 FORMAT(//'0**** BIPOLAR JUNCTION TRANSISTORS'/'0     NAME        C
     1    B    E    S  MODEL       AREA'//) 
      LOC=LOCATE(12)
  300 IF (LOC.EQ.0) GO TO 320 
      IF (ITITLE.EQ.0) WRITE (6,291)
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2) 
      NODE2=NODPLC(LOC+3) 
      NODE3=NODPLC(LOC+4) 
      NODE4=NODPLC(LOC+5) 
      LOCM=NODPLC(LOC+8)
      LOCM=NODPLC(LOCM+1) 
      AIC=ABLNK 
      IF (NODPLC(LOC+9).EQ.1) AIC=AOFF
      WRITE (6,301) VALUE(LOCV),NODPLC(JUNODE+NODE1), 
     1   NODPLC(JUNODE+NODE2),NODPLC(JUNODE+NODE3),NODPLC(JUNODE+NODE4),
     2   VALUE(LOCM),VALUE(LOCV+1),AIC
  301 FORMAT(6X,A8,4I5,2X,A8,F8.3,2X,A8)
  310 LOC=NODPLC(LOC) 
      GO TO 300 
$PAGE 
C 
C  PRINT JFETS
C 
  320 IF (JELCNT(13).EQ.0) GO TO 350
      ITITLE=0
  321 FORMAT(//'0**** JFETS'/'0     NAME        D    G    S  MODEL
     1 AREA'//) 
      LOC=LOCATE(13)
  330 IF (LOC.EQ.0) GO TO 350 
      IF (ITITLE.EQ.0) WRITE (6,321)
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2) 
      NODE2=NODPLC(LOC+3) 
      NODE3=NODPLC(LOC+4) 
      LOCM=NODPLC(LOC+7)
      LOCM=NODPLC(LOCM+1) 
      AIC=ABLNK 
      IF (NODPLC(LOC+8).EQ.1) AIC=AOFF
      WRITE (6,331) VALUE(LOCV),NODPLC(JUNODE+NODE1), 
     1   NODPLC(JUNODE+NODE2),NODPLC(JUNODE+NODE3), 
     2   VALUE(LOCM),VALUE(LOCV+1),AIC
  331 FORMAT(6X,A8,3I5,2X,A8,F8.3,2X,A8)
  340 LOC=NODPLC(LOC) 
      GO TO 330 
C 
C  PRINT MOSFETS
C 
  350 IF (JELCNT(14).EQ.0) GO TO 400
      ITITLE=0
  351 FORMAT(//'0**** MOSFETS',/,'0NAME',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) GO TO 400 
      IF (ITITLE.EQ.0) WRITE (6,351)
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      NODE1=NODPLC(LOC+2) 
      NODE2=NODPLC(LOC+3) 
      NODE3=NODPLC(LOC+4) 
      NODE4=NODPLC(LOC+5) 
      LOCM=NODPLC(LOC+8)
      LOCM=NODPLC(LOCM+1) 
      AIC=ABLNK 
      IF (NODPLC(LOC+9).EQ.1) AIC=AOFF
      WRITE (6,361) VALUE(LOCV),NODPLC(JUNODE+NODE1), 
     1   NODPLC(JUNODE+NODE2),NODPLC(JUNODE+NODE3), 
     2   NODPLC(JUNODE+NODE4),VALUE(LOCM),VALUE(LOCV+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(1X,A8,4I4,1X,A8,1P4D8.1,/34X,1P4D8.1,1X,A8)
  370 LOC=NODPLC(LOC) 
      GO TO 360 
$PAGE 
C 
C  SUBCIRCUIT CALLS 
C 
  400 IF (JELCNT(19).EQ.0) GO TO 500
      ITITLE=0
  401 FORMAT(//'0**** SUBCIRCUIT CALLS'/'0     NAME     SUBCIRCUIT   EXT
     1ERNAL NODES'//) 
      LOC=LOCATE(19)
  410 IF (LOC.EQ.0) GO TO 500 
      IF (ITITLE.EQ.0) WRITE (6,401)
      ITITLE=1
      LOCV=NODPLC(LOC+1)
      LOCN=NODPLC(LOC+2)
      CALL SIZMEM(NODPLC(LOC+2),NNODX)
      LOCS=NODPLC(LOC+3)
      LOCSV=NODPLC(LOCS+1)
      JSTART=1
      NDPRLN=(LWIDTH-28)/5
  412 JSTOP=MIN0(NNODX,JSTART+NDPRLN-1) 
      DO 414 J=JSTART,JSTOP 
      NODE=NODPLC(LOCN+J) 
      ITAB(J-JSTART+1)=NODPLC(JUNODE+NODE)
  414 CONTINUE
      IF (JSTART.EQ.1)
     1   WRITE (6,416) VALUE(LOCV),VALUE(LOCSV),(ITAB(J),J=1,JSTOP) 
  416 FORMAT(6X,A8,2X,A8,4X,20I5) 
      IF (JSTART.NE.1)
     1   WRITE (6,418) (ITAB(J-JSTART+1),J=JSTART,JSTOP)
  418 FORMAT(28X,20I5)
      JSTART=JSTOP+1
      IF (JSTART.LE.NNODX) GO TO 412
      IF (NNODX.LE.NDPRLN) GO TO 420
      WRITE (6,226) 
  420 LOC=NODPLC(LOC) 
      GO TO 410 
C 
C  FINISHED 
C 
  500 RETURN
      END 
$EMA /BLANK/
      SUBROUTINE ERRCHK 
     + ,92091-16003 REV.5000 <890418.1140>  
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE DRIVES THE PRE-PROCESSING AND GENERAL ERROR-CHECKING 
C OF INPUT PERFORMED BY SPICE.
C 
      COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 
     1   ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 
     2   JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 
     3   NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 
     4   LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD,
     5   IMYNL,IMVN,LCVN,NSNOD,NSMAT,NSVAL,ICNOD,ICMAT,ICVAL, 
     6   LOUTPT,LPOL,LZER,IRSWPF,IRSWPR,ICSWPF,ICSWPR,IRPT,JCPT,
     7   IROWNO,JCOLNO,NTTBR,NTTAR,LVNTMP 
      COMMON /MISCEL/ ATIME,APROG(3),ADATE,ATITLE(10),DEFL,DEFW,DEFAD,
     1  DEFAS,RSTATS(50),IWIDTH,LWIDTH,NOPAGE 
      COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 
     1   NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS
      COMMON /CJE/ MAXTIM,ITIME,ICOST 
      COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET,
     1   XMU,MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO,
     2   ITEMNO,NOSOLV,MODAC,IPIV,IVMFLG,IPOSTP,ISCRCH,IOFILE 
      COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS,
     1   LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF 
      COMMON /KNSTNT/ TWOPI,XLOG2,XLOG10,ROOT2,RAD,BOLTZ,CHARGE,CTOK, 
     1   GMIN,RELTOL,ABSTOL,VNTOL,TRTOL,CHGTOL,EPS0,EPSSIL,EPSOX, 
     2   PIVTOL,PIVREL
      COMMON /DC/ TCSTAR(2),TCSTOP(2),TCINCR(2),ICVFLG,ITCELM(2),KSSOP, 
     1   KINEL,KIDIN,KOVAR,KIDOUT 
      COMMON /AC/ FSTART,FSTOP,FINCR,SKW2,REFPRL,SPW2,JACFLG,IDFREQ,
     1   INOISE,NOSPRT,NOSOUT,NOSIN,IDIST,IDPRT 
      COMMON /TRAN/ TSTEP,TSTOP,TSTART,DELMAX,TDMAX,FORFRE,JTRFLG 
      COMMON /OUTINF/ XINCR,STRING(15),XSTART,YVAR(8),ITAB(8),ITYPE(8), 
     1   ILOGY(8),NPOINT,NUMOUT,KNTR,NUMDGT 
      COMMON /BLANK/ VALUE(64)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
      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 / 
$PAGE 
      CALL SECOND(T1) 
      DO 60 ID=1,50 
      LOC=LOCATE(ID)
   10 IF (LOC.EQ.0) GO TO 60
      IF (NODPLC(LOC+2).NE.NDEFIN) GO TO 50 
      NOGO=1
      LOCV=NODPLC(LOC+1)
      IF (ID.GE.21) GO TO 20
      ANAM=AELMT
      GO TO 40
   20 IF (ID.GE.31) GO TO 30
      ANAM=AMODEL 
      GO TO 40
   30 ANAM=AOUTPT 
   40 WRITE (6,41) ANAM,VALUE(LOCV) 
   41 FORMAT('0*ERROR*:  ',2A8,' HAS BEEN REFERENCED BUT NOT DEFINED'/) 
   50 LOC=NODPLC(LOC) 
      GO TO 10
   60 CONTINUE
      IF (NOGO.NE.0) GO TO 2000 
C 
C  CONSTRUCT ORDERED LIST OF USER SPECIFIED NODES 
C 
      CALL GETM4(JUNODE,1)
      NODPLC(JUNODE+1)=0
      NUNODS=1
      DO 180 ID=1,50
      IF (NNODS(ID).EQ.0) GO TO 180 
      LOC=LOCATE(ID)
  110 IF (LOC.EQ.0) GO TO 180 
      IF (ID.LE.4) GO TO 120
      IF (ID.LE.8) GO TO 150
      IF (ID.EQ.19) GO TO 165 
      IF (ID.LE.40) GO TO 120 
      IF (ID.LE.43) GO TO 170 
  120 JSTOP=LOC+NNODS(ID)-1 
      DO 130 J=LOC,JSTOP
      CALL PUTNOD(NODPLC(J+2))
  130 CONTINUE
      GO TO 170 
$PAGE 
  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
$PAGE 
C 
C  CHECK AND SET .NODESET NODES TO THEIR INTERNAL VALUES
C 
      CALL SIZMEM(NSNOD,NIC)
      IF (NIC.EQ.0) GO TO 300 
      DO 290 I=1,NIC
      CALL GETNOD(NODPLC(NSNOD+I))
  290 CONTINUE
C 
C   CHECK AND SET .IC NODES TO THEIR INTERNAL VALUES
C 
  300 CALL SIZMEM(ICNOD,NIC)
      IF (NIC.EQ.0) GO TO 320 
      DO 310 I=1,NIC
      CALL GETNOD(NODPLC(ICNOD+I))
  310 CONTINUE
  320 IF (NOGO.NE.0) GO TO 2000 
C 
C  EXPAND SUBCIRCUIT CALLS
C 
      CALL SUBCKT 
      IF (NOGO.NE.0) GO TO 2000 
      IF (NCNODS.GE.2) GO TO 400
      WRITE (6,321) 
  321 FORMAT('0*ERROR*:  CIRCUIT HAS NO NODES'/)
      NOGO=1
      GO TO 2000
  400 NUMNOD=NCNODS 
C 
C  LINK UNSATISFIED REFERENCES
C 
      CALL LNKREF 
      IF (NOGO.NE.0) GO TO 2000 
C 
C  GENERATE SUBCIRCUIT ELEMENT NAMES
C 
      IF (JELCNT(19).EQ.0) GO TO 530
      DO 520 ID=1,24
      LOC=LOCATE(ID)
  510 IF (LOC.EQ.0) GO TO 520 
      CALL SUBNAM(LOC)
      LOC=NODPLC(LOC) 
      GO TO 510 
  520 CONTINUE
$PAGE 
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 (IXXOR(TEMP,VALUE(LOCP+IKNT+2)).NE.0) GO TO 665  
      WRITE(6,661) VALUE(LOCV)
  661 FORMAT('0*ERROR*:  ELEMENT ',A8,' PIECEWISE LINEAR SOURCE TABLE NO
     1T INCREASING IN TIME')
      NOGO=1
  665 IKNT=IKNT+2 
      IF (IKNT.LT.NUMP) GO TO 660 
  670 VALUE(LOCP+IKNT+2)=TSTOP
      VALUE(LOCV+1)=VALUE(LOCP+2) 
      CALL RELMEM(NODPLC(LOC+5),NUMP-IKNT-3)
      GO TO 680 
  675 IF (VALUE(LOCP+3).LE.0.0D0) VALUE(LOCP+3)=1.0D0/TSTOP 
      IF (VALUE(LOCP+5).LE.0.0D0) VALUE(LOCP+5)=1.0D0/TSTOP 
      VALUE(LOCV+1)=VALUE(LOCP+1) 
  680 LOC=NODPLC(LOC) 
      GO TO 610 
  690 CONTINUE
C 
C  USE DEFAULT VALUES FOR MOS DEVICE GEOMETRIES IF NOT SPECIFIED
C 
  700 LOC=LOCATE(14)
  710 IF (LOC.EQ.0) GO TO 720 
      LOCV=NODPLC(LOC+1)
      IF (VALUE(LOCV+1).LE.0.0D0) VALUE(LOCV+1)=DEFL  
      IF (VALUE(LOCV+2).LE.0.0D0) VALUE(LOCV+2)=DEFW  
      IF (VALUE(LOCV+3).LE.0.0D0) VALUE(LOCV+3)=DEFAD 
      IF (VALUE(LOCV+4).LE.0.0D0) VALUE(LOCV+4)=DEFAS 
      LOC=NODPLC(LOC) 
      GO TO 710 
C 
C  PRINT LISTING OF ELEMENTS, PROCESS DEVICE MODELS,
C  AND CHECK TOPOLOGY 
C 
  720 IF (IPRNTL.EQ.0) GO TO 730
      CALL ELPRNT 
  730 CALL TOPCHK 
      CALL MODCHK 
      IF (NOGO.NE.0) GO TO 2000 
C 
C  INVERT RESISTANCE VALUES 
C 
  800 LOC=LOCATE(1) 
  810 IF (LOC.EQ.0) GO TO 900 
      LOCV=NODPLC(LOC+1)
      VALUE(LOCV+1)=1.0D0/VALUE(LOCV+2) 
      LOC=NODPLC(LOC) 
      GO TO 810 
$PAGE 
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)
$PAGE 
C 
C  PRINT OPTION SUMMARY 
C 
********************************************************************
* 
 1600 IF (LVLCOD.GT.1) THEN 
          WRITE (6,1631) LVLCOD 
 1631     FORMAT('0WARNING: LVLCOD=',I1,' IS NOT SUPPORTED.', 
     +           ' LVLCOD RESET TO 1.') 
          LVLCOD = 1
      ENDIF 
* 
      IF (IPRNTO.EQ.0) GO TO 1700 
* 
********************************************************************
      CALL TITLE(0,LWIDTH,1,TITLOP) 
      WRITE (6,1601) GMIN,RELTOL,ABSTOL,VNTOL,LVLCOD,ITL1,ITL2
 1601 FORMAT('0DC ANALYSIS -',/,
     1   '0    GMIN   = ',1PD10.3,/,
     2   '     RELTOL = ',  D10.3,/,
     3   '     ABSTOL = ',  D10.3,/,
     4   '     VNTOL  = ',  D10.3,/,
     5   '     LVLCOD = ',     I6,/,
     6   '     ITL1   = ',     I6,/,
     7   '     ITL2   = ',     I6,/)
      WRITE (6,1605) PIVTOL,PIVREL
 1605 FORMAT( 
     1   '     PIVTOL = ',1PD10.3,/,
     2   '     PIVREL = ',  D10.3)
      WRITE (6,1611) ANAME(METHOD),MAXORD,CHGTOL,TRTOL,LVLTIM,XMU,
     1   ITL3,ITL4,ITL5 
 1611 FORMAT('0TRANSIENT ANALYSIS -',/, 
     1   '0    METHOD =  ',A8,/,
     2   '     MAXORD = ',     I6,/,
     3   '     CHGTOL = ',1PD10.3,/,
     4   '     TRTOL  = ',  D10.3,/,
     5   '     LVLTIM = ',     I6,/,
     6   '     MU     = ',0PF10.3,/,
     7   '     ITL3   = ',     I6,/,
     8   '     ITL4   = ',     I6,/,
     9   '     ITL5   = ',     I6,/)
      WRITE (6,1621) LIMPTS,LIMTIM,MAXTIM,NUMDGT,VALUE(ITEMPS+1), 
     1   DEFL,DEFW,DEFAD,DEFAS
 1621 FORMAT('0MISCELLANEOUS -',/,
     1   '0    LIMPTS = ',     I6,/,
     2   '     LIMTIM = ',     I6,/,
     3   '     CPTIME = ',     I9,/,
     4   '     NUMDGT = ',     I6,/,
     5   '     TNOM   = ',0PF10.3,/,
     6   '     DEFL   = ',1PD10.3,/,
     7   '     DEFW   = ',D10.3,/,
     8   '     DEFAD  = ',D10.3,/,
     9   '     DEFAS  = ',D10.3)
$PAGE 
* 
*  MISCELLANEOUS ERROR CHECKING - DC ANALYSIS 
* 
 1700 IF (ICVFLG.EQ.0) GO TO 1720 
      IF (ICVFLG.LE.LIMPTS) GO TO 1710
      ICVFLG=0
      WRITE (6,1701) LIMPTS,ALSDC 
 1701 FORMAT('0WARNING:  MORE THAN ',I5,' POINTS FOR ',A4,' ANALYSIS,',/
     11X,'ANALYSIS OMITTED.  THIS LIMIT MAY BE OVERRIDDEN USING THE ',/ 
     21X,'LIMPTS PARAMETER ON THE .OPTION CARD'/) 
      GO TO 1720
 1710 IF ((JELCNT(31)+JELCNT(36)).GT.0) GO TO 1720
      IF (IPOSTP.NE.0) GO TO 1720 
********************************************************************
* 
*     CHECK FOR .GRAPH DC OUTPUT SPECIFICATIONS 
* 
      IF (JELCNT(46).GT.0) GO TO 1720 
* 
********************************************************************
      ICVFLG=0
      WRITE (6,1711) ALSDC
 1711 FORMAT('0WARNING:  NO ',A4,' OUTPUTS SPECIFIED .',
     1  '.. ANALYSIS OMITTED'/) 
* 
*     MISCELLANEOUS ERROR CHECKING - TRAN ANALYSIS
* 
 1720 IF (JTRFLG.EQ.0) GO TO 1740 
      IF (METHOD.EQ.1) MAXORD=2 
      IF ((METHOD.EQ.2).AND.(MAXORD.GE.3)) LVLTIM=2 
      IF (JTRFLG.LE.LIMPTS) GO TO 1730
      JTRFLG=0
      WRITE (6,1701) LIMPTS,ALSTR 
      GO TO 1740
 1730 IF ((JELCNT(32)+JELCNT(37)+NFOUR).GT.0) GO TO 1735
      IF (IPOSTP.NE.0) GO TO 1735 
********************************************************************
* 
*     CHECK FOR .GRAPH TRAN OUTPUT SPECIFICATIONS 
* 
      IF (JELCNT(47).GT.0) GO TO 1735 
* 
********************************************************************
      JTRFLG=0
      WRITE (6,1711) ALSTR
      GO TO 1740
 1735 IF (NFOUR.EQ.0) GO TO 1740
      FORPRD=1.0D0/FORFRE 
      IF ((TSTOP-FORPRD).GE.(TSTART-1.0D-12)) GO TO 1740
      NFOUR=0 
      CALL CLRMEM(IFOUR)
      WRITE (6,1736)
 1736 FORMAT('0WARNING:  FOURIER ANALYSIS FUNDAMENTAL FREQUENCY IS INCOM
     1PATIBLE WITH'/11X'TRANSIENT ANALYSIS PRINT INTERVAL ... FOURIER AN
     2ALYSIS OMITTED'/) 
* 
*     MISCELLANEOUS ERROR CHECKING - AC ANALYSIS
* 
 1740 IF (JACFLG.EQ.0) GO TO 1800 
      IF (JACFLG.LE.LIMPTS) GO TO 1750
      JACFLG=0
      WRITE (6,1701) LIMPTS,ALSAC 
      GO TO 1800
 1750 IF ((JELCNT(33)+JELCNT(34)+JELCNT(35)+JELCNT(38)+JELCNT(39) 
     1   +JELCNT(40)+IDIST+INOISE).GT.0) GO TO 1800 
      IF (IPOSTP.NE.0) GO TO 1800 
********************************************************************
* 
*     CHECK FOR .GRAPH (AC,NOISE,DISTO) OUTPUT SPECIFICATIONS 
* 
      IF ((JELCNT(48)+JELCNT(49)+JELCNT(50)).GT.0) GO TO 1800 
* 
********************************************************************
      JACFLG=0
      WRITE (6,1711) ALSAC
********************************************************************
* 
*     PROCESS ".GRAPH ALL" OUTPUT SPECIFICATIONS
* 
 1800 CALL GRPALL(JELCNT,JUNODE,LOCATE,NUNODS)
C 
C  SEQUENCE THROUGH THE OUTPUT LISTS
C 
 1900 DO 1920 ID=41,45
      IF (ID.LE.43) NUMOUT=1
      LOC=LOCATE(ID)
 1910 IF (LOC.EQ.0) GO TO 1920
      NUMOUT=NUMOUT+1 
      NODPLC(LOC+4)=NUMOUT
      LOC=NODPLC(LOC) 
      GO TO 1910
 1920 CONTINUE
* 
********************************************************************* 
$PAGE 
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 
$EMA /BLANK/                            
      SUBROUTINE FNDNAM( ANAM , JSBPTR , ISPOT , ID ) 
     + ,92091-16003 REV.5000 <890418.1140>  
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE SEARCHES FOR AN ELEMENT WITH ID 'ID' BY TRACING BACK 
C UP THE SUBCIRCUIT DEFINITION LIST.  IF THE ELEMENT IS NOT FOUND, THE
C NOMINAL ELEMENT LIST IS SEARCHED. 
C 
      COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 
     1   ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 
     2   JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 
     3   NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 
     4   LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD,
     5   IMYNL,IMVN,LCVN,NSNOD,NSMAT,NSVAL,ICNOD,ICMAT,ICVAL, 
     6   LOUTPT,LPOL,LZER,IRSWPF,IRSWPR,ICSWPF,ICSWPR,IRPT,JCPT,
     7   IROWNO,JCOLNO,NTTBR,NTTAR,LVNTMP 
      COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 
     1   NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS
      COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS,
     1   LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF 
      COMMON /BLANK/ VALUE(64)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
      INTEGER IXXOR 
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 (IXXOR(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
$PAGE 
   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 (IXXOR(ANAM,VALUE(LOCV)).NE.0) GO TO 70
   65 NODPLC(ISPOT)=LOC 
      GO TO 100 
   70 LOC=NODPLC(LOC) 
      GO TO 60
90    WRITE (6,91) ANAM 
   91 FORMAT('0*ERROR*:  UNABLE TO FIND ',A8/)
      NOGO=1
  100 RETURN
      END 
$EMA /BLANK/
      SUBROUTINE GETNOD( NODE ) 
     + ,92091-16003 REV.5000 <890418.1140>
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE CONVERTS FROM THE USER NODE NUMBER TO THE INTERNAL 
C (COMPACT) NODE NUMBER.
C 
      COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 
     1   ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 
     2   JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 
     3   NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 
     4   LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD,
     5   IMYNL,IMVN,LCVN,NSNOD,NSMAT,NSVAL,ICNOD,ICMAT,ICVAL, 
     6   LOUTPT,LPOL,LZER,IRSWPF,IRSWPR,ICSWPF,ICSWPR,IRPT,JCPT,
     7   IROWNO,JCOLNO,NTTBR,NTTAR,LVNTMP 
      COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 
     1   NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS
      COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS,
     1   LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF 
      COMMON /BLANK/ VALUE(64)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C 
      IF (NOGO.NE.0) GO TO 100
      JKNT=0
   10 JKNT=JKNT+1 
      IF (JKNT.GT.NUNODS) GO TO 20
      IF (NODPLC(JUNODE+JKNT).NE.NODE) GO TO 10 
      NODE=JKNT 
      GO TO 100 
C 
C  UNKNOWN NODE -- MUST BE IMPLIED BY .PRINT AND/OR .PLOT 
C 
   20 IF (NODE.EQ.0) GO TO 30 
      WRITE (6,21) NODE 
   21 FORMAT('0WARNING:  ATTEMPT TO REFERENCE UNDEFINED NODE ',I5,
     1   ' -- NODE RESET TO 0'/)
   30 NODE=1
C 
C  FINISHED 
C 
  100 RETURN
      END 
$EMA /BLANK/                            
      SUBROUTINE LNKREF 
     + ,92091-16003 REV.5000 <890418.1140>  
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE RESOLVES ALL UNSATISFIED NAME REFERENCES.
C 
      COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 
     1   ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 
     2   JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 
     3   NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 
     4   LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD,
     5   IMYNL,IMVN,LCVN,NSNOD,NSMAT,NSVAL,ICNOD,ICMAT,ICVAL, 
     6   LOUTPT,LPOL,LZER,IRSWPF,IRSWPR,ICSWPF,ICSWPR,IRPT,JCPT,
     7   IROWNO,JCOLNO,NTTBR,NTTAR,LVNTMP 
      COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 
     1   NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS
      COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS,
     1   LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF 
      COMMON /BLANK/ VALUE(64)
      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 
$PAGE 
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 
$PAGE 
C 
C  FINISHED 
C 
 1000 CALL CLRMEM(IUNSAT) 
      RETURN
      END 
$EMA /BLANK/
      SUBROUTINE MODCHK 
     + ,92091-16003 REV.5000 <890418.1140>  
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE PERFORMS ONE-TIME PROCESSING OF DEVICE MODEL PARA- 
C METERS AND PRINTS OUT A DEVICE MODEL SUMMARY.  IT ALSO RESERVES THE 
C ADDITIONAL NODES REQUIRED BY NONZERO DEVICE EXTRINSIC RESISTANCES.
C 
      COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 
     1   ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 
     2   JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 
     3   NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 
     4   LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD,
     5   IMYNL,IMVN,LCVN,NSNOD,NSMAT,NSVAL,ICNOD,ICMAT,ICVAL, 
     6   LOUTPT,LPOL,LZER,IRSWPF,IRSWPR,ICSWPF,ICSWPR,IRPT,JCPT,
     7   IROWNO,JCOLNO,NTTBR,NTTAR,LVNTMP 
      COMMON /MISCEL/ ATIME,APROG(3),ADATE,ATITLE(10),DEFL,DEFW,DEFAD,
     1  DEFAS,RSTATS(50),IWIDTH,LWIDTH,NOPAGE 
      COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 
     1   NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS
      COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET,
     1   XMU,MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO,
     2   ITEMNO,NOSOLV,MODAC,IPIV,IVMFLG,IPOSTP,ISCRCH,IOFILE 
      COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS,
     1   LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF 
      COMMON /KNSTNT/ TWOPI,XLOG2,XLOG10,ROOT2,RAD,BOLTZ,CHARGE,CTOK, 
     1   GMIN,RELTOL,ABSTOL,VNTOL,TRTOL,CHGTOL,EPS0,EPSSIL,EPSOX, 
     2   PIVTOL,PIVREL
      COMMON /BLANK/ VALUE(64)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
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/
$PAGE 
      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/ 
      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 (LEV.EQ.AUNDEF) LEV=1
      IF (IXXOR(VALUE(LOCV+23),AUNDEF).NE.0) XNSUB=VALUE(LOCV+23)*1.0D6 
*********************************************************************** 
* 
      IF (IXXOR(VALUE(LOCV+22),AUNDEF).EQ.0.AND.LEV.GT.1) 
     +    VALUE(LOCV+22) = 1.0D-7 
* 
*********************************************************************** 
      IF (IXXOR(VALUE(LOCV+22),AUNDEF).EQ.0) 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 (IXXOR(VALUE(LOCV+3),AUNDEF).NE.0) GO TO 10
      IF (IXXOR(VALUE(LOCV+29),AUNDEF).EQ.0) VALUE(LOCV+29)=600.0D0 
      VALUE(LOCV+3)=VALUE(LOCV+29)*COX*1.0D-4 
   10 IF (IXXOR(VALUE(LOCV+23),AUNDEF).EQ.0) GO TO 33 
      IF (XNSUB.LE.XNI) GO TO 30
C 
C     NSUB NONZERO => PROCESS ORIENTED MODEL
C 
      IF (IXXOR(VALUE(LOCV+5),AUNDEF).EQ.0) VALUE(LOCV+5)=
     1   DMAX1((2.0D0*VT*DLOG(XNSUB/XNI)),0.1D0)
      FERMIS=TYPE*0.5D0*VALUE(LOCV+5) 
      WKFNG=3.2D0 
      IF (IXXOR(VALUE(LOCV+26),AUNDEF).EQ.0) 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 (IXXOR(VALUE(LOCV+4),AUNDEF).EQ.0) 
     1   VALUE(LOCV+4)=DSQRT(2.0D0*EPSSIL*CHARGE*XNSUB)/COX 
* 
********************************************************************
$PAGE 
C 
C     COMPUTED VTO
C 
      IF (IXXOR(VALUE(LOCV+2),AUNDEF).NE.0) GO TO 20
      IF (IXXOR(VALUE(LOCV+24),AUNDEF).EQ.0) 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 (6,31) VALUE(LOCV)
   31 FORMAT('0*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 (IXXOR(VALUE(LOCV+42),AUNDEF).EQ.0) 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
$PAGE 
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 (IXXOR(VALUE(LOCV+I),AUNDEF).EQ.0) 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 
C...  DIODES
C 
   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 
C...  BIPOLAR TRANSISTORS 
C 
   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(6,89) VALUE(LOCV) 
   89 FORMAT('0WARNING:  MINIMUM BASE RESISTANCE (RBM) IS LESS THAN ' 
     1       ,'TOTAL (RB) FOR MODEL ',A8,/10X' RBM SET EQUAL TO RB',/)
      VALUE(LOCV+18)=VALUE(LOCV+16) 
      GO TO 87
C 
C...  JFETS 
C 
   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 
C...  MOSFETS 
C 
   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 (6,121) VALUE(LOCV) 
  121 FORMAT ('0WARNING:  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
$PAGE 
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 (6,241) (ATABLE(K),K=1,KNTR)
  241 FORMAT(//11X,12(2X,A8)) 
      IF (ID.EQ.1) GO TO 300
      KNTR=0
      LOC=LOCS
  250 IF (LOC.EQ.0) GO TO 260 
      IF (KNTR.GE.KNTLIM) GO TO 260 
      KNTR=KNTR+1 
      ATABLE(KNTR)=ANTYPE(ID) 
      IF (NODPLC(LOC+2).EQ.-1) ATABLE(KNTR)=APTYPE(ID)
      LOC=NODPLC(LOC) 
      GO TO 250 
  260 WRITE (6,261) (ATABLE(K),K=1,KNTR)
  261 FORMAT('0TYPE',4X,12(4X,A6))
  300 DO 340 I=1,NOPAR
      IF (ITAB(I).EQ.0) GO TO 340 
      KNTR=0
      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 (6,321) AMPAR(LOCM+I),(ATABLE(K),K=1,KNTR)
  321 FORMAT(1H0,A8,12F10.3)
      GO TO 340 
  330 WRITE (6,331) AMPAR(LOCM+I),(ATABLE(K),K=1,KNTR)
  331 FORMAT(1H0,A8,1P12D10.2)
      IF (ICCFLG.EQ.0) GO TO 340
      WRITE (6,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) 
      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)
  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 (6,411) VALUE(LOCV),CBV 
  411 FORMAT('0WARNING:  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 (6,415) XBV,XCBV
  415 FORMAT('0WARNING:  UNABLE TO MATCH FORWARD AND REVERSE DIODE REGIO
     1NS',/,11X,'BV = ',1PD10.3,' AND IBV = ',D10.3,/)
  416 VALUE(LOCV+13)=XBV
  418 LOC=NODPLC(LOC) 
      GO TO 410 
C 
C  BIPOLAR TRANSISTOR MODELS
C 
  420 LOC=LOCATE(22)
  430 IF (LOC.EQ.0) GO TO 440 
      LOCV=NODPLC(LOC+1)
      IF (VALUE(LOCV+4).NE.0.0D0) VALUE(LOCV+4)=1.0D0/VALUE(LOCV+4) 
      IF (VALUE(LOCV+5).NE.0.0D0) VALUE(LOCV+5)=1.0D0/VALUE(LOCV+5) 
      IF (VALUE(LOCV+10).NE.0.0D0) VALUE(LOCV+10)=1.0D0/VALUE(LOCV+10)
      IF (VALUE(LOCV+11).NE.0.0D0) VALUE(LOCV+11)=1.0D0/VALUE(LOCV+11)
      IF (VALUE(LOCV+19).NE.0.0D0) VALUE(LOCV+19)=1.0D0/VALUE(LOCV+19)
      IF (VALUE(LOCV+20).NE.0.0D0) VALUE(LOCV+20)=1.0D0/VALUE(LOCV+20)
      IF (VALUE(LOCV+26).NE.0.0D0) VALUE(LOCV+26)=1.0D0/VALUE(LOCV+26)
     1   /1.44D0
      VALUE(LOCV+28)=VALUE(LOCV+28)/RAD*VALUE(LOCV+24)
      IF (VALUE(LOCV+35).NE.0.0D0) VALUE(LOCV+35)=1.0D0/VALUE(LOCV+35)
     1   /1.44D0
      PE=VALUE(LOCV+22) 
      XME=VALUE(LOCV+23)
      PC=VALUE(LOCV+30) 
      XMC=VALUE(LOCV+31)
      FC=VALUE(LOCV+46) 
      VALUE(LOCV+46)=FC*PE
      XFC=DLOG(1.0D0-FC)
      VALUE(LOCV+47)=PE*(1.0D0-DEXP((1.0D0-XME)*XFC))/(1.0D0-XME) 
      VALUE(LOCV+48)=DEXP((1.0D0+XME)*XFC)
      VALUE(LOCV+49)=1.0D0-FC*(1.0D0+XME) 
      VALUE(LOCV+50)=FC*PC
      VALUE(LOCV+51)=PC*(1.0D0-DEXP((1.0D0-XMC)*XFC))/(1.0D0-XMC) 
      VALUE(LOCV+52)=DEXP((1.0D0+XMC)*XFC)
      VALUE(LOCV+53)=1.0D0-FC*(1.0D0+XMC) 
      CSAT=VALUE(LOCV+1)
      VALUE(LOCV+54)=VT*DLOG(VT/(ROOT2*CSAT)) 
      LOC=NODPLC(LOC) 
      GO TO 430 
$PAGE 
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)) 
$PAGE 
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) GO TO 700 
      LOCM=NODPLC(LOC+5)
      LOCM=NODPLC(LOCM+1) 
      IF (VALUE(LOCM+2).EQ.0.0D0) GO TO 620 
      NUMNOD=NUMNOD+1 
      NODPLC(LOC+4)=NUMNOD
      GO TO 630 
  620 NODPLC(LOC+4)=NODPLC(LOC+2) 
  630 LOC=NODPLC(LOC) 
      GO TO 610 
C 
C  TRANSISTORS
C 
  700 LOC=LOCATE(12)
  710 IF (LOC.EQ.0) GO TO 800 
C 
C     SAVE SUBSTRATE NODE INTO NODPLC(LOC+30) 
C 
      NODPLC(LOC+30)=NODPLC(LOC+5)
      LOCM=NODPLC(LOC+8)
      LOCM=NODPLC(LOCM+1) 
      IF (VALUE(LOCM+16).EQ.0.0D0) GO TO 720
      NUMNOD=NUMNOD+1 
      NODPLC(LOC+6)=NUMNOD
      GO TO 730 
  720 NODPLC(LOC+6)=NODPLC(LOC+3) 
  730 IF (VALUE(LOCM+20).EQ.0.0D0) GO TO 740
      NUMNOD=NUMNOD+1 
      NODPLC(LOC+5)=NUMNOD
      GO TO 750 
  740 NODPLC(LOC+5)=NODPLC(LOC+2) 
  750 IF (VALUE(LOCM+19).EQ.0.0D0) GO TO 760
      NUMNOD=NUMNOD+1 
      NODPLC(LOC+7)=NUMNOD
      GO TO 770 
  760 NODPLC(LOC+7)=NODPLC(LOC+4) 
  770 LOC=NODPLC(LOC) 
      GO TO 710 
C 
C  JFETS
C 
  800 LOC=LOCATE(13)
  810 IF (LOC.EQ.0) GO TO 900 
      LOCM=NODPLC(LOC+7)
      LOCM=NODPLC(LOCM+1) 
      IF (VALUE(LOCM+4).EQ.0.0D0) GO TO 820 
      NUMNOD=NUMNOD+1 
      NODPLC(LOC+5)=NUMNOD
      GO TO 830 
  820 NODPLC(LOC+5)=NODPLC(LOC+2) 
  830 IF (VALUE(LOCM+5).EQ.0.0D0) GO TO 840 
      NUMNOD=NUMNOD+1 
      NODPLC(LOC+6)=NUMNOD
      GO TO 850 
  840 NODPLC(LOC+6)=NODPLC(LOC+4) 
  850 LOC=NODPLC(LOC) 
      GO TO 810 
C 
C  MOSFETS
C 
  900 LOC=LOCATE(14)
  910 IF (LOC.EQ.0) GO TO 1000
      LOCM=NODPLC(LOC+8)
      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(6,911) VALUE(LOCV),VALUE(LOCM)
  911 FORMAT('0*ERROR*:  EFFECTIVE CHANNEL LENGTH OF ',A8,' LESS THAN ',
     1   'ZERO.',/' CHECK VALUE OF LD FOR MODEL ',A8) 
  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 
$PAGE 
  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 
      LOC=NODPLC(LOC) 
      GO TO 910 
C 
C  TRANSMISSION LINES 
C 
 1000 LOC=LOCATE(17)
 1010 IF (LOC.EQ.0) GO TO 2000
      NUMNOD=NUMNOD+1 
      NODPLC(LOC+6)=NUMNOD
      NUMNOD=NUMNOD+1 
      NODPLC(LOC+7)=NUMNOD
      LOC=NODPLC(LOC) 
      GO TO 1010
C 
C  FINISHED 
C 
 2000 RETURN
      END 
$EMA /BLANK/                            
      SUBROUTINE NEWNOD( NODOLD , NODNEW , INODX , INODI , NNODI )
     + ,92091-16003 REV.5000 <890418.1140>  
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE MAKES A NEW NODE NUMBER FOR AN ELEMENT WHICH IS ABOUT
C TO BE ADDED TO THE CIRCUIT AS A RESULT OF A SUBCIRCUIT CALL.
C 
      COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 
     1   ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 
     2   JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 
     3   NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 
     4   LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD,
     5   IMYNL,IMVN,LCVN,NSNOD,NSMAT,NSVAL,ICNOD,ICMAT,ICVAL, 
     6   LOUTPT,LPOL,LZER,IRSWPF,IRSWPR,ICSWPF,ICSWPR,IRPT,JCPT,
     7   IROWNO,JCOLNO,NTTBR,NTTAR,LVNTMP 
      COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 
     1   NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS
      COMMON /BLANK/ VALUE(64)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C 
C... INODX, INODI ARE ARRAYS (SEE SUBCKT) 
C 
      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 
$EMA /BLANK/                            
      SUBROUTINE PUTNOD( NODE ) 
     + ,92091-16003 REV.5000 <890418.1140>  
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE ADDS 'NODE' TO THE LIST OF USER INPUT NODES IN TABLE 
C JUNODE. 
C 
      COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 
     1   ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 
     2   JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 
     3   NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 
     4   LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD,
     5   IMYNL,IMVN,LCVN,NSNOD,NSMAT,NSVAL,ICNOD,ICMAT,ICVAL, 
     6   LOUTPT,LPOL,LZER,IRSWPF,IRSWPR,ICSWPF,ICSWPR,IRPT,JCPT,
     7   IROWNO,JCOLNO,NTTBR,NTTAR,LVNTMP 
      COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 
     1   NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS
      COMMON /BLANK/ VALUE(64)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
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 
$EMA /BLANK/
      SUBROUTINE SHLSRT( A , N )
     + ,92091-16003 REV.5000 <890418.1140>  
      IMPLICIT REAL*8 (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...  COMPUTE BEST STARTING STEP SIZE 
C 
      H=1 
   10 H=3*H+1 
      IF (H.LT.N) GO TO 10
C 
C...  BACK OFF TWO TIMES
C 
      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 
C...  AK = RECORD KEY;  AR = RECORD 
C 
      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 
$EMA /BLANK/                            
      SUBROUTINE SUBCKT 
     + ,92091-16003 REV.5000 <890418.1140>  
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE DRIVES THE EXPANSION OF SUBCIRCUIT CALLS.
C 
      COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 
     1   ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 
     2   JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 
     3   NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 
     4   LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD,
     5   IMYNL,IMVN,LCVN,NSNOD,NSMAT,NSVAL,ICNOD,ICMAT,ICVAL, 
     6   LOUTPT,LPOL,LZER,IRSWPF,IRSWPR,ICSWPF,ICSWPR,IRPT,JCPT,
     7   IROWNO,JCOLNO,NTTBR,NTTAR,LVNTMP 
      COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 
     1   NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS
      COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS,
     1   LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF 
      COMMON /BLANK/ VALUE(64)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C 
C... AVOID 'CALL BY VALUE' PROBLEMS, MAKE INODI, INODX ARRAYS 
C... IN ROUTINES WHICH RECEIVE THEM AS PARAMETERS ]]] 
C 
      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 
   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) 
$PAGE 
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 
  200 CALL CLRMEM(INODX)
      CALL CLRMEM(INODI)
      LOCX=NODPLC(LOCX) 
      GO TO 10
C 
C  ERRORS 
C 
  250 LOCV=NODPLC(LOCX+1) 
      AXNAM=VALUE(LOCV) 
      LOCV=NODPLC(LOCS+1) 
      ASNAM=VALUE(LOCV) 
      WRITE (6,251) AXNAM,ASNAM 
  251 FORMAT('0*ERROR*:  ',A8,' HAS DIFFERENT NUMBER OF NODES THAN ',A8/
     1) 
      NOGO=1
      GO TO 300 
  260 LOCSV=NODPLC(LOCS+1)
      ASNAM=VALUE(LOCSV)
      WRITE (6,261) ASNAM 
  261 FORMAT('0*ERROR*:  SUBCIRCUIT ',A8,' IS DEFINED RECURSIVELY'/)
      NOGO=1
C 
C  FINISHED 
C 
  300 RETURN
      END 
$EMA /BLANK/                            
      SUBROUTINE SUBNAM( LOCE ) 
     + ,92091-16003 REV.5000 <890418.1140>  
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE CONSTRUCTS THE NAMES OF ELEMENTS ADDED AS A RESULT OF
C SUBCIRCUIT EXPANSION.  THE FULL ELEMENT NAMES ARE OF THE FORM 
C                  NAME.XN. --- XD.XC.XB.XA 
C WHERE 'NAME' IS THE NOMINAL ELEMENT NAME, AND THE 'X'*S DENOTE THE
C SEQUENCE OF SUBCIRCUIT CALLS (FROM TOP OR CIRCUIT LEVEL DOWN THROUGH
C NESTED SUBCIRCUIT CALLS) WHICH CAUSED THE PARTICULAR ELEMENT TO BE
C ADDED.  AT PRESENT, SPICE RESTRICTS ALL ELEMENT NAMES TO BE 8 CHARAC- 
C TERS OR LESS.  THEREFORE, THE NAME USED CONSISTS OF THE LEFTMOST 8
C CHARACTERS OF THE FULL ELEMENT NAME, WITH THE RIGHTMOST CHARACTER 
C REPLACED BY AN ASTERISK ('*') IF THE FULL ELEMENT NAME IS LONGER THAN 
C 8 CHARACTERS. 
C 
      COMMON /BLANK/ VALUE(64)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
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 (IXXOR(ACHAR,ABLANK).EQ.0) 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
$PAGE 
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 
$EMA /BLANK/
      SUBROUTINE TOPCHK 
     + ,92091-16003 REV.5000 <890418.1140>  
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE CONSTRUCTS THE ELEMENT NODE TABLE.  IT ALSO CHECKS 
C FOR VOLTAGE SOURCE/INDUCTOR LOOPS, CURRENT SOURCE/CAPACITOR CUTSETS,
C AND THAT EVERY NODE HAS A DC (CONDUCTIVE) PATH TO GROUND
C 
      COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 
     1   ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 
     2   JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 
     3   NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 
     4   LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD,
     5   IMYNL,IMVN,LCVN,NSNOD,NSMAT,NSVAL,ICNOD,ICMAT,ICVAL, 
     6   LOUTPT,LPOL,LZER,IRSWPF,IRSWPR,ICSWPF,ICSWPR,IRPT,JCPT,
     7   IROWNO,JCOLNO,NTTBR,NTTAR,LVNTMP 
      COMMON /MISCEL/ ATIME,APROG(3),ADATE,ATITLE(10),DEFL,DEFW,DEFAD,
     1  DEFAS,RSTATS(50),IWIDTH,LWIDTH,NOPAGE 
      COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 
     1   NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS
      COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS,
     1   LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF 
      COMMON /BLANK/ VALUE(64)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
      INTEGER CHANGE
C 
      DIMENSION ATABLE(12),AIDE(20),NNODS(20) 
      DIMENSION IDLIST(4) 
      DIMENSION TOPTIT(4) 
      DATA TOPTIT / 8HELEMENT , 8HNODE TAB, 8HLE      , 8H         /
      DATA IDLIST / 3, 6, 8, 9 /
      DATA AIDE / 1HR,0.0D0,1HL,2*0.0D0,1HE,0.0D0,1HH,1HV,0.0D0,1HD,
     1   1HQ,1HJ,1HM,0.0D0,0.0D0,1HT,0.0D0,0.0D0,0.0D0 /
      DATA NNODS / 2,2,2,0,2,2,2,2,2,2,2,4,3,4,4,4,4,0,0,0 /
      DATA ABLNK /1H /
C 
C  ALLOCATE STORAGE 
C 
      CALL GETM4(IORDER,NCNODS) 
      CALL GETM4(IUR,NCNODS+1)
$PAGE 
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 
C...  TREAT THE SUBSTRATE NODE OF A MOSFET AS IF IT WERE A TRANSMISSION 
C...  LINE NODE, I.E. LET IT DANGLE IF DESIRED
C 
      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
$PAGE 
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
$PAGE 
C 
C  PRINT NODE TABLE AND TOPOLOGY ERROR MESSAGES 
C 
      IF (IPRNTN.EQ.0) GO TO 1510 
      CALL TITLE(0,LWIDTH,1,TOPTIT) 
 1510 DO 1590 I=1,NCNODS
      JSTART=NODPLC(IUR+I)
      JSTOP=NODPLC(IUR+I+1)-1 
      IF (IPRNTN.EQ.0) GO TO 1550 
      IF (JSTART.LE.JSTOP) GO TO 1520 
      WRITE (6,1511) NODPLC(JUNODE+I) 
 1511 FORMAT(1H0,I7)
      GO TO 1550
 1520 KNTR=0
      JFLAG=1 
      DO 1540 J=JSTART,JSTOP
      LOC=NODPLC(ITABLE+J)
      LOCV=NODPLC(LOC+1)
      KNTR=KNTR+1 
      ATABLE(KNTR)=VALUE(LOCV)
      IF (KNTR.LT.KNTLIM) GO TO 1540
      IF (JFLAG.EQ.0) GO TO 1525
      JFLAG=0 
      WRITE (6,1521) NODPLC(JUNODE+I),(ATABLE(K),K=1,KNTR)
 1521 FORMAT(1H0,I7,3X,12(1X,A8)) 
      GO TO 1530
 1525 WRITE (6,1526) (ATABLE(K),K=1,KNTR) 
 1526 FORMAT(11X,12(1X,A8)) 
 1530 KNTR=0
 1540 CONTINUE
      IF (KNTR.EQ.0) GO TO 1550 
      IF (JFLAG.EQ.0) GO TO 1545
      WRITE (6,1521) NODPLC(JUNODE+I),(ATABLE(K),K=1,KNTR)
      GO TO 1550
 1545 WRITE (6,1526) (ATABLE(K),K=1,KNTR) 
 1550 IF (JSTART-JSTOP) 1560,1552,1556
$PAGE 
C 
C  ALLOW NODE WITH ONLY ONE CONNECTION IFF ELEMENT IS A T-LINE
C 
 1552 IF (NODPLC(ITABID+JSTART).EQ.17) GO TO 1560 
 1556 NOGO=1
      WRITE (6,1557) NODPLC(JUNODE+I) 
 1557 FORMAT('0*ERROR*:  LESS THAN 2 CONNECTIONS AT NODE ',I6/) 
      GO TO 1590
 1560 IF (NODPLC(IORDER+I).EQ.1) GO TO 1590 
      NOGO=1
      WRITE (6,1561) NODPLC(JUNODE+I) 
 1561 FORMAT('0*ERROR*:  NO DC PATH TO GROUND FROM NODE ',I6/)
 1590 CONTINUE
C 
C  CHECK FOR INDUCTOR/VOLTAGE SOURCE LOOPS
C 
      DO 1700 I=1,NCNODS
      CALL ZERO4(NODPLC(IORDER+1),NCNODS) 
      NODPLC(IORDER+I)=-1 
 1605 CHANGE=0
      DO 1690 IDCNTR=1,4
      ID=IDLIST(IDCNTR) 
      LOC=LOCATE(ID)
 1610 IF (LOC.EQ.0) GO TO 1690
      NODE1=NODPLC(LOC+2) 
      NODE2=NODPLC(LOC+3) 
      IF (NODPLC(IORDER+NODE1).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
$PAGE 
C 
C ... LOOP FOUND
C 
 1710 LOCV=NODPLC(LOC+1)
      WRITE (6,1711) VALUE(LOCV)
 1711 FORMAT('0*ERROR*:  INDUCTOR/VOLTAGE SOURCE LOOP FOUND, CONTAINING 
     1',A8/)
      NOGO=1
C 
 1900 CALL CLRMEM(IORDER) 
      CALL CLRMEM(IUR)
      CALL CLRMEM(ITABLE) 
      CALL CLRMEM(ITABID) 
 2000 RETURN
      END 
