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:   ACAN                       * 
*  SOURCE: 92091-18007                * 
*  RELOC:  92091-16007                * 
*  PGMR:   C. GEBER                   * 
*************************************** 
$PAGE 
$EMA /BLANK/
$CDS ON 
      SUBROUTINE ACAN 
     + ,92091-16007 REV.5000 <890418.1141>
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE DRIVES THE SMALL-SIGNAL ANALYSES.
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 /AC/ FSTART,FSTOP,FINCR,SKW2,REFPRL,SPW2,JACFLG,IDFREQ,
     1   INOISE,NOSPRT,NOSOUT,NOSIN,IDIST,IDPRT 
      COMMON /CJE/ MAXTIM,ITIME,ICOST 
      COMMON /BLANK/ VALUE(64)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      COMPLEX CENDOR
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
      CALL SECOND(T1) 
C 
C.. POST-PROCESSOR INITIALIZATION 
C 
      IF (IPOSTP.EQ.0) 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
$PAGE 
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 
      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 (6,121) IGOOF,FREQ
  121 FORMAT('0WARNING:  UNDERFLOW ',I4,' TIME(S) IN AC ANALYSIS AT FREQ
     1 = ',1PD9.3,' HZ')
      IGOOF=0 
$PAGE 
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.EQ.0) 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 
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 
$PAGE 
C 
C  FINISHED 
C 
  900 WRITE (6,901) 
  901 FORMAT('0*ERROR*:  CPU TIME LIMIT EXCEEDED ... ANALYSIS STOPPED'/)
      NOGO=1
 1000 IF (IPOSTP.EQ.0) GO TO 1010 
      IF (IPOSTP.NE.0) 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 
$EMA /BLANK/                            
      SUBROUTINE ACASOL 
     + ,92091-16007 REV.5000 <890418.1141>  
      IMPLICIT REAL*8 (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 
      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  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
$PAGE 
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 
$EMA /BLANK/                            
      SUBROUTINE ACDCMP 
     + ,92091-16007 REV.5000 <890418.1141>  
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE PERFORMS AN LU FACTORIZATION OF THE CIRCUIT EQUATION 
C COEFFICIENT MATRIX. 
C 
      COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 
     1   ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 
     2   JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 
     3   NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 
     4   LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD,
     5   IMYNL,IMVN,LCVN,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 /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 
      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(6,11) N 
   11 FORMAT(1H0,' 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) 
$PAGE 
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 
$EMA /BLANK/                            
      SUBROUTINE ACLOAD 
     + ,92091-16007 REV.5000 <890418.1141>  
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE ZEROES-OUT AND THEN LOADS THE COMPLEX COEFFICIENT
C     MATRIX
C 
      COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 
     1   ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 
     2   JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 
     3   NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 
     4   LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD,
     5   IMYNL,IMVN,LCVN,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 /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 /AC/ FSTART,FSTOP,FINCR,SKW2,REFPRL,SPW2,JACFLG,IDFREQ,
     1   INOISE,NOSPRT,NOSOUT,NOSIN,IDIST,IDPRT 
      COMMON /BLANK/ VALUE(64)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
      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) 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
$PAGE 
C 
C  CAPACITORS 
C 
   30 LOC=LOCATE(2) 
   40 IF (LOC.EQ.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) 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
$PAGE 
C 
C  MUTUAL INDUCTORS 
C 
   70 LOC=LOCATE(4) 
   80 IF (LOC.EQ.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) 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
$PAGE 
C 
C  NONLINEAR VOLTAGE CONTROLLED VOLTAGE SOURCES 
C 
  100 LOC=LOCATE(6) 
  105 IF (LOC.EQ.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 
$PAGE 
C 
C  NONLINEAR CURRENT CONTROLLED CURRENT SOURCES 
C 
  110 LOC=LOCATE(7) 
  115 IF (LOC.EQ.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) 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) 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) 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 
$PAGE 
C 
C  DIODES 
C 
  200 LOC=LOCATE(11)
  210 IF (LOC.EQ.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 
$PAGE 
C 
C  BJTS 
C 
  250 LOC=LOCATE(12)
  260 IF (LOC.EQ.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 
$PAGE 
C 
C  JFETS
C 
  300 LOC=LOCATE(13)
  310 IF (LOC.EQ.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) 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
      XCGSB=-XCGB 
      XCDGB=-XCGD 
      XCSGB=-XCGS 
      XCDSB=0.0D0 
      XCSDB=0.0D0 
$PAGE 
  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) 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 
$EMA /BLANK/                            
      SUBROUTINE ACSOL
     + ,92091-16007 REV.5000 <890418.1141>  
      IMPLICIT REAL*8 (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 
      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  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
$PAGE 
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 CDIV(XR,XI,YR,YI,CR,CI)
     + ,92091-16007 REV.5000 <890418.1141>
C 
C.. OK IF CR AND CI ARE REALLY XR AND XI OR YR AND YI 
C 
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
      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) 
     + ,92091-16007 REV.5000 <890418.1141>
C 
C.. OK IF CR AND CI ARE REALLY XR AND XI OR YR AND YI 
C 
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
      XRTEMP=XR 
      XITEMP=XI 
      YRTEMP=YR 
      YITEMP=YI 
      CR=XRTEMP*YRTEMP-XITEMP*YITEMP
      CI=XITEMP*YRTEMP+XRTEMP*YITEMP
      RETURN
      END 
$EMA /BLANK/
      SUBROUTINE DINIT
     + ,92091-16007 REV.5000 <890418.1141>
      IMPLICIT REAL*8 (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 
      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 /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 /BLANK/ VALUE(64)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C 
      CALL GETM8(LD0,NDIST) 
      CALL GETM16(LD1,5*NSTOP)
$PAGE 
C 
C  BIPOLAR JUNCTION TRANSISTORS 
C 
      LOC=LOCATE(12)
  100 IF (LOC.EQ.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) 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 
$PAGE 
C 
C  FINISHED 
C 
  300 RETURN
      END 
$EMA /BLANK/
      SUBROUTINE DISTO( LOCO )
     + ,92091-16007 REV.5000 <890418.1141>
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE PERFORMS THE SMALL-SIGNAL DISTORTION ANALYSIS. 
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 /KNSTNT/ TWOPI,XLOG2,XLOG10,ROOT2,RAD,BOLTZ,CHARGE,CTOK, 
     1   GMIN,RELTOL,ABSTOL,VNTOL,TRTOL,CHGTOL,EPS0,EPSSIL,EPSOX, 
     2   PIVTOL,PIVREL
      COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS,
     1   LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF 
      COMMON /AC/ FSTART,FSTOP,FINCR,SKW2,REFPRL,SPW2,JACFLG,IDFREQ,
     1   INOISE,NOSPRT,NOSOUT,NOSIN,IDIST,IDPRT 
      COMMON /BLANK/ VALUE(64)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
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))
********************************************************************
* 
      SAVE IDNP,IDNN,LOCV,RLOAD,KNTR
* 
********************************************************************
      DATA DISTIT / 8HDISTORTI, 8HON ANALY, 8HSIS     , 8H        / 
$PAGE 
      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 (6,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 ',D9.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 (6,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 ',D9.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 (6,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   D9.3,3X,'PHS ',0PF7.2,9X,'MAG ',1PD9.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 (6,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   D9.3,3X,'PHS ',0PF7.2,9X,'MAG ',1PD9.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 (6,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   D9.3,3X,'PHS ',0PF7.2,9X,'MAG ',1PD9.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 (6,211) IGOOF,FREQD 
  211 FORMAT('0WARNING:  UNDERFLOW ',I4,' TIME(S) IN DISTORTION ANALYSIS
     1 AT FREQ = ',1PD9.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) 
$PAGE 
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) 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 
$PAGE 
  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 (6,301)
      ITITLE=1
      WRITE (6,446) VALUE(LOCV),(VDO(1,J),J=1,10) 
  446 FORMAT(1H0,A8,'MAG',1P12D10.3)
      WRITE (6,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 (6,311)
      ITITLE=1
      WRITE (6,446) VALUE(LOCV),(VDO(1,J),J=1,12) 
      WRITE (6,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 
$PAGE 
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) 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 
$PAGE 
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 (6,501)
      ITITLE=1
      WRITE (6,446) VALUE(LOCV),(VDO(1,J),J=1,4)
      WRITE (6,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
$PAGE 
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 (6,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 (6,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 (6,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 (6,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 (6,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 (6,866) 
  866 FORMAT (////5X,'APPROXIMATE CROSS MODULATION COMPONENTS') 
      WRITE (6,871) CMA,CMALOG
  871 FORMAT (/5X,'CMA     MAGNITUDE  ',1PD10.3,24X,'=  ',0PF7.2,'  DB')
      WRITE (6,881) CMP,CMPLOG
  881 FORMAT (/5X,'CMP     MAGNITUDE  ',1PD10.3,24X,'=  ',0PF7.2,'  DB')
$PAGE 
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 
      SUBROUTINE MAGPHS( CVAR , XMAG , XPHS ) 
     + ,92091-16007 REV.5000 <890418.1141>
      IMPLICIT REAL*8 (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 
      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 
      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 
$EMA /BLANK/                            
      SUBROUTINE NOISE( LOCO )
     + ,92091-16007 REV.5000 <890418.1141>  
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE COMPUTES THE NOISE DUE TO VARIOUS CIRCUIT ELEMENTS.
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 /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 /MISCEL/ ATIME,APROG(3),ADATE,ATITLE(10),DEFL,DEFW,DEFAD,
     1  DEFAS,RSTATS(50),IWIDTH,LWIDTH,NOPAGE 
      COMMON /KNSTNT/ TWOPI,XLOG2,XLOG10,ROOT2,RAD,BOLTZ,CHARGE,CTOK, 
     1   GMIN,RELTOL,ABSTOL,VNTOL,TRTOL,CHGTOL,EPS0,EPSSIL,EPSOX, 
     2   PIVTOL,PIVREL
      COMMON /AC/ FSTART,FSTOP,FINCR,SKW2,REFPRL,SPW2,JACFLG,IDFREQ,
     1   INOISE,NOSPRT,NOSOUT,NOSIN,IDIST,IDPRT 
      COMMON /BLANK/ VALUE(64)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
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) 
********************************************************************
* 
      SAVE FOURKT,TWOQ,NOPOSO,NONEGO,KNTLIM,NKNTR 
* 
********************************************************************
      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(1H0,A8,,8H1P  D10.,8H3)      / 
$PAGE 
C 
C.. FIX-UP FORMATS
C 
      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 (6,16) FREQ 
   16 FORMAT('0    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 
$PAGE 
C 
C  RESISTORS
C 
      IF (JELCNT(1).EQ.0) GO TO 200 
      ITITLE=0
   91 FORMAT(//'0**** RESISTOR SQUARED NOISE VOLTAGES (SQ V/HZ)') 
  100 LOC=LOCATE(1) 
      KNTR=0
  110 IF (LOC.EQ.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 (6,91) 
      ITITLE=1
      WRITE (6,AFMT1) (ANAM(I),I=1,KNTR)
      WRITE (6,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(//'0**** DIODE SQUARED NOISE VOLTAGES (SQ V/HZ)')
  210 LOC=LOCATE(11)
      KNTR=0
  220 IF (LOC.EQ.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)
$PAGE 
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 (6,201)
      ITITLE=1
      WRITE (6,AFMT1) (ANAM(I),I=1,KNTR)
      WRITE (6,AFMT2) ALSRS,(VNO1(I),I=1,KNTR)
      WRITE (6,AFMT2) ALSID,(VNO2(I),I=1,KNTR)
      WRITE (6,AFMT2) ALSFN,(VNO3(I),I=1,KNTR)
      WRITE (6,AFMT2) ALSTOT,(VNTOT(I),I=1,KNTR)
  260 KNTR=0
      IF (LOC.NE.0) GO TO 230 
$PAGE 
C 
C  BIPOLAR JUNCTION TRANSISTORS 
C 
  300 IF (JELCNT(12).EQ.0) GO TO 400
      ITITLE=0
  301 FORMAT(//'0**** TRANSISTOR SQUARED NOISE VOLTAGES (SQ V/HZ)') 
  310 LOC=LOCATE(12)
      KNTR=0
  320 IF (LOC.EQ.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 
C 
      CVAL=CVALUE(LCVN+NODE2)-CVALUE(LCVN+NODE5)
      VNO1(KNTR)=(DBLE(VREAL*VREAL)+DBLE(VIMAG*VIMAG))
     1  *FOURKT*VALUE(LX0+LOCT+16)
C 
C...  COLLECTOR RESISTANCE
C 
      CVAL=CVALUE(LCVN+NODE1)-CVALUE(LCVN+NODE4)
      VNO2(KNTR)=(DBLE(VREAL*VREAL)+DBLE(VIMAG*VIMAG))
     1   *FOURKT*VALUE(LOCM+20)*AREA
C 
C...  EMITTER RESISTANCE
C 
      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 
$PAGE 
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 (6,301)
      ITITLE=1
      WRITE (6,AFMT1) (ANAM(I),I=1,KNTR)
      WRITE (6,AFMT2) ALSRB,(VNO1(I),I=1,KNTR)
      WRITE (6,AFMT2) ALSRC,(VNO2(I),I=1,KNTR)
      WRITE (6,AFMT2) ALSRE,(VNO3(I),I=1,KNTR)
      WRITE (6,AFMT2) ALSIB,(VNO4(I),I=1,KNTR)
      WRITE (6,AFMT2) ALSIC,(VNO6(I),I=1,KNTR)
      WRITE (6,AFMT2) ALSFN,(VNO5(I),I=1,KNTR)
      WRITE (6,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(//'0**** JFET SQUARED NOISE VOLTAGES (SQ V/HZ)') 
  410 LOC=LOCATE(13)
      KNTR=0
  420 IF (LOC.EQ.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)
$PAGE 
C 
C  EXTRINSIC RESISTANCES
C 
C...  DRAIN RESISTANCE
C 
      CVAL=CVALUE(LCVN+NODE1)-CVALUE(LCVN+NODE4)
      VNO1(KNTR)=(DBLE(VREAL*VREAL)+DBLE(VIMAG*VIMAG))
     1   *FOURKT*VALUE(LOCM+4)*AREA 
C 
C...  SOURCE RESISTANCE 
C 
      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 (6,401)
      ITITLE=1
      WRITE (6,AFMT1) (ANAM(I),I=1,KNTR)
      WRITE (6,AFMT2) ALSRD,(VNO1(I),I=1,KNTR)
      WRITE (6,AFMT2) ALSRS,(VNO2(I),I=1,KNTR)
      WRITE (6,AFMT2) ALSID,(VNO3(I),I=1,KNTR)
      WRITE (6,AFMT2) ALSFN,(VNO4(I),I=1,KNTR)
      WRITE (6,AFMT2) ALSTOT,(VNTOT(I),I=1,KNTR)
  460 KNTR=0
      IF (LOC.NE.0) GO TO 430 
$PAGE 
C 
C  MOSFETS
C 
  500 IF (JELCNT(14).EQ.0) GO TO 600
      ITITLE=0
  501 FORMAT(//'0**** MOSFET SQUARED NOISE VOLTAGES (SQ V/HZ)') 
  510 LOC=LOCATE(14)
      KNTR=0
  520 IF (LOC.EQ.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 
C...  DRAIN RESISTANCE
C 
  524 CVAL=CVALUE(LCVN+NODE1)-CVALUE(LCVN+NODE5)
      VNO1(KNTR)=(DBLE(VREAL*VREAL)+DBLE(VIMAG*VIMAG))*FOURKT*GDPR
C 
C...  SOURCE RESISTANCE 
C 
      CVAL=CVALUE(LCVN+NODE3)-CVALUE(LCVN+NODE6)
      VNO2(KNTR)=(DBLE(VREAL*VREAL)+DBLE(VIMAG*VIMAG))*FOURKT*GSPR
$PAGE 
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 (6,501)
      ITITLE=1
      WRITE (6,AFMT1) (ANAM(I),I=1,KNTR)
      WRITE (6,AFMT2) ALSRD,(VNO1(I),I=1,KNTR)
      WRITE (6,AFMT2) ALSRS,(VNO2(I),I=1,KNTR)
      WRITE (6,AFMT2) ALSID,(VNO3(I),I=1,KNTR)
      WRITE (6,AFMT2) ALSFN,(VNO4(I),I=1,KNTR)
      WRITE (6,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 (6,611) VNRMS,VNOUT,STRING,VOUT,ANAM1,VNIN
  611 FORMAT(////,
     1   '0**** TOTAL OUTPUT NOISE VOLTAGE',9X,'= ',1PD10.3,' SQ V/HZ'/,
     2   1H0,40X,'= ',D10.3,' V/RT HZ'/,
     3   '0     TRANSFER FUNCTION VALUE:',/,
     4   1H0,7X,4A8,A1,'= ',D10.3,/,
     5   '0     EQUIVALENT INPUT NOISE AT ',A8,' = ',D10.3,' /RT HZ') 
$PAGE 
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 
