/* dinit.f -- translated by f2c (version of 3 February 1990  3:36:42).
   You must link the resulting object file with the libraries:
	-lF77 -lI77 -lm -lc   (in that order)
*/

#include "f2c.h"

/* Common Block Declarations */

struct {
    integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
	    nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
	    junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
	    numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
	    iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
	    lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
	    nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
	    irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
	    lvntmp;
} tabinf_;

#define tabinf_1 tabinf_

struct {
    integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt, 
	    nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
} cirdat_;

#define cirdat_1 cirdat_

struct {
    doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
	    sfactr;
    integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
	    itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
} status_;

#define status_1 status_

struct {
    integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod, 
	    lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
} flags_;

#define flags_1 flags_

struct {
    doublereal value[200000];
} blank_;

#define blank_1 blank_

/*<       subroutine dinit >*/
/* Subroutine */ int dinit_()
{
    /* System generated locals */
    integer i_1;

    /* Builtin functions */
    double exp(), log();

    /* Local variables */
    static doublereal cdbo, area, fcpb, fcpc, fcpe, cjco, evbc, cjeo;
    static integer locd;
    static doublereal czbc, czbe, evbe, cbor, gmo23;
    static integer locm;
    static doublereal csat, sarg, gm2o3;
    static integer locv, loct;
    static doublereal phib, cdjo, argd;
    extern /* Subroutine */ int getm8_();
    static doublereal argbc, argbe, denom;
    extern /* Subroutine */ int getm16_();
    static doublereal czero, trivt, twovt, pc, gm, pe, go, tf, vd, xm, tr;
#define nodplc ((integer *)&blank_1)
#define cvalue ((complex *)&blank_1)
    static doublereal cbe, cbc, go2, gm2, cb1, go3, gm3, cb2, twovte, trivte, 
	    cbo, arg, vbc;
    static integer loc;
    static doublereal vbe, gpi, geq, evd, ova, xmc, gmu, xme, tau, vte, cdb1, 
	    cdb2, cjc1, cjc2, cje1, cje2, cdj1, cdj2, cb1r, cb2r, geq2, geq3, 
	    gpi2, gpi3, gmo2, gmu2, gmu3;

/*<       implicit double precision (a-h,o-z) >*/

/*     this routine performs storage-allocation and one-time computation 
*/
/* needed to do the small-signal distortion analysis. */

/* spice version 2g.6  sccsid=tabinf 3/15/83 */
/*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
/*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
/*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
/*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
/*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
/*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
/*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
/*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
/* spice version 2g.6  sccsid=cirdat 3/15/83 */
/*<       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
/*<      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
/* spice version 2g.6  sccsid=status 3/15/83 */
/*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
/*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
/*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
/* spice version 2g.6  sccsid=flags 3/15/83 */
/*<       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
/*<      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
/* spice version 2g.6  sccsid=blank 3/15/83 */
/*<       common /blank/ value(200000) >*/
/*<       integer nodplc(64) >*/
/*<       complex cvalue(32) >*/
/*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/


/*<       call getm8(ld0,ndist) >*/
    getm8_(&tabinf_1.ld0, &cirdat_1.ndist);
/*<       call getm16(ld1,5*nstop) >*/
    i_1 = cirdat_1.nstop * 5;
    getm16_(&tabinf_1.ld1, &i_1);

/*  bipolar junction transistors */

/*<       loc=locate(12) >*/
    loc = cirdat_1.locate[11];
/*<   100 if ((loc.eq.0).or.(nodplc(loc+36).ne.0)) go to 200 >*/
L100:
    if (loc == 0 || nodplc[loc + 35] != 0) {
	goto L200;
    }
/*<       locv=nodplc(loc+1) >*/
    locv = nodplc[loc];
/*<       area=value(locv+1) >*/
    area = blank_1.value[locv];
/*<       locm=nodplc(loc+8) >*/
    locm = nodplc[loc + 7];
/*<       locm=nodplc(locm+1) >*/
    locm = nodplc[locm];
/*<       loct=lx0+nodplc(loc+22) >*/
    loct = tabinf_1.lx0 + nodplc[loc + 21];
/*<       locd=ld0+nodplc(loc+23) >*/
    locd = tabinf_1.ld0 + nodplc[loc + 22];
/*<       csat=value(locm+1)*area >*/
    csat = blank_1.value[locm] * area;
/*<       ova=value(locm+4) >*/
    ova = blank_1.value[locm + 3];
/*<       tf=value(locm+24) >*/
    tf = blank_1.value[locm + 23];
/*<       tr=value(locm+33) >*/
    tr = blank_1.value[locm + 32];
/*<       czbe=value(locm+21)*area >*/
    czbe = blank_1.value[locm + 20] * area;
/*<       czbc=value(locm+29)*area >*/
    czbc = blank_1.value[locm + 28] * area;
/*<       pe=value(locm+22) >*/
    pe = blank_1.value[locm + 21];
/*<       xme=value(locm+23) >*/
    xme = blank_1.value[locm + 22];
/*<       pc=value(locm+30) >*/
    pc = blank_1.value[locm + 29];
/*<       xmc=value(locm+31) >*/
    xmc = blank_1.value[locm + 30];
/*<       fcpe=value(locm+46) >*/
    fcpe = blank_1.value[locm + 45];
/*<       fcpc=value(locm+50) >*/
    fcpc = blank_1.value[locm + 49];
/*<       vbe=value(loct) >*/
    vbe = blank_1.value[loct - 1];
/*<       vbc=value(loct+1) >*/
    vbc = blank_1.value[loct];
/*<       gpi=value(loct+4) >*/
    gpi = blank_1.value[loct + 3];
/*<       go=value(loct+7) >*/
    go = blank_1.value[loct + 6];
/*<       gm=value(loct+6) >*/
    gm = blank_1.value[loct + 5];
/*<       gmu=value(loct+5) >*/
    gmu = blank_1.value[loct + 4];
/*<       if (vbe.gt.0.0d0) go to 110 >*/
    if (vbe > 0.) {
	goto L110;
    }
/*<       evbe=1.0d0 >*/
    evbe = 1.;
/*<       cbe=csat*vbe/vt >*/
    cbe = csat * vbe / status_1.vt;
/*<       go to 120 >*/
    goto L120;
/*<   110 evbe=dexp(vbe/vt) >*/
L110:
    evbe = exp(vbe / status_1.vt);
/*<       cbe=csat*(evbe-1.0d0) >*/
    cbe = csat * (evbe - 1.);
/*<   120 if (vbc.gt.0.0d0) go to 130 >*/
L120:
    if (vbc > 0.) {
	goto L130;
    }
/*<       evbc=1.0d0 >*/
    evbc = 1.;
/*<       cbc=csat*vbc/vt >*/
    cbc = csat * vbc / status_1.vt;
/*<       arg=1.0d0-vbc/pc >*/
    arg = 1. - vbc / pc;
/*<       go to 140 >*/
    goto L140;
/*<   130 evbc=dexp(vbc/vt) >*/
L130:
    evbc = exp(vbc / status_1.vt);
/*<       cbc=csat*(evbc-1.0d0) >*/
    cbc = csat * (evbc - 1.);
/*<   140 if (vbe.ge.fcpe) go to 150 >*/
L140:
    if (vbe >= fcpe) {
	goto L150;
    }
/*<       arg=1.0d0-vbe/pe >*/
    arg = 1. - vbe / pe;
/*<       sarg=dexp(xme*dlog(arg)) >*/
    sarg = exp(xme * log(arg));
/*<       cjeo=czbe/sarg >*/
    cjeo = czbe / sarg;
/*<       argbe=pe-vbe >*/
    argbe = pe - vbe;
/*<       cje1=xme*cjeo/argbe >*/
    cje1 = xme * cjeo / argbe;
/*<       cje2=(1.0d0+xme)*cje1/argbe >*/
    cje2 = (xme + 1.) * cje1 / argbe;
/*<       go to 160 >*/
    goto L160;
/*<   150 denom=dexp((1.0d0+xme)*dlog(1.0d0-fcpe)) >*/
L150:
    denom = exp((xme + 1.) * log(1. - fcpe));
/*<       cjeo=czbe*(1.0d0-fcpe*(1.0d0+xme)+xme*vbe/pe)/denom >*/
    cjeo = czbe * (1. - fcpe * (xme + 1.) + xme * vbe / pe) / denom;
/*<       cje1=czbe*xme/(denom*pe) >*/
    cje1 = czbe * xme / (denom * pe);
/*<       cje2=0.0d0 >*/
    cje2 = 0.;
/*<   160 if (vbc.ge.fcpc) go to 170 >*/
L160:
    if (vbc >= fcpc) {
	goto L170;
    }
/*<       arg=1.0d0-vbc/pc >*/
    arg = 1. - vbc / pc;
/*<       sarg=dexp(xmc*dlog(arg)) >*/
    sarg = exp(xmc * log(arg));
/*<       cjco=czbc/sarg >*/
    cjco = czbc / sarg;
/*<       argbc=pc-vbc >*/
    argbc = pc - vbc;
/*<       cjc1=xmc*cjco/argbc >*/
    cjc1 = xmc * cjco / argbc;
/*<       cjc2=(1.0d0+xmc)*cjc1/argbc >*/
    cjc2 = (xmc + 1.) * cjc1 / argbc;
/*<       go to 180 >*/
    goto L180;
/*<   170 denom=dexp((1.0d0+xmc)*dlog(1.0d0-fcpc)) >*/
L170:
    denom = exp((xmc + 1.) * log(1. - fcpc));
/*<       cjco=czbc*(1.0d0-fcpc*(1.0d0+xmc)+xmc*vbc/pc)/denom >*/
    cjco = czbc * (1. - fcpc * (xmc + 1.) + xmc * vbc / pc) / denom;
/*<       cjc1=czbc*xmc/(denom*pc) >*/
    cjc1 = czbc * xmc / (denom * pc);
/*<       cjc2=0.0d0 >*/
    cjc2 = 0.;
/*<   180 twovt=vt+vt >*/
L180:
    twovt = status_1.vt + status_1.vt;
/*<       go2=(-go+csat*(evbe+evbc)*ova)/twovt >*/
    go2 = (-go + csat * (evbe + evbc) * ova) / twovt;
/*<       gmo2=(cbe+csat)*ova/vt-2.0d0*go2 >*/
    gmo2 = (cbe + csat) * ova / status_1.vt - go2 * 2.;
/*<       gm2=(gm+go)/twovt-gmo2-go2 >*/
    gm2 = (gm + go) / twovt - gmo2 - go2;
/*<       gmu2=gmu/twovt >*/
    gmu2 = gmu / twovt;
/*<       if (vbc.le.0.0d0) gmu2=0.0d0 >*/
    if (vbc <= 0.) {
	gmu2 = 0.;
    }
/*<       gpi2=gpi/twovt >*/
    gpi2 = gpi / twovt;
/*<       if (vbe.le.0.0d0) gpi2=0.0d0 >*/
    if (vbe <= 0.) {
	gpi2 = 0.;
    }
/*<       cbo=tf*csat*evbe/vt >*/
    cbo = tf * csat * evbe / status_1.vt;
/*<       cbor=tr*csat*evbc/vt >*/
    cbor = tr * csat * evbc / status_1.vt;
/*<       cb1=cbo/vt >*/
    cb1 = cbo / status_1.vt;
/*<       cb1r=cbor/vt >*/
    cb1r = cbor / status_1.vt;
/*<       trivt=3.0d0*vt >*/
    trivt = status_1.vt * 3.;
/*<       go3=-(go2+(cbc+csat)*ova/twovt)/trivt >*/
    go3 = -(go2 + (cbc + csat) * ova / twovt) / trivt;
/*<       gmo23=-3.0d0*go3 >*/
    gmo23 = go3 * -3.;
/*<       gm2o3=-gmo23+(cbe+csat)*ova/(vt*twovt) >*/
    gm2o3 = -gmo23 + (cbe + csat) * ova / (status_1.vt * twovt);
/*<       gm3=(gm2-(cbe-cbc)*ova/twovt)/trivt >*/
    gm3 = (gm2 - (cbe - cbc) * ova / twovt) / trivt;
/*<       gmu3=gmu2/trivt >*/
    gmu3 = gmu2 / trivt;
/*<       gpi3=gpi2/trivt >*/
    gpi3 = gpi2 / trivt;
/*<       cb2=cb1/twovt >*/
    cb2 = cb1 / twovt;
/*<       cb2r=cb1r/twovt >*/
    cb2r = cb1r / twovt;
/*<       value(locd)=cje1 >*/
    blank_1.value[locd - 1] = cje1;
/*<       value(locd+1)=cje2 >*/
    blank_1.value[locd] = cje2;
/*<       value(locd+2)=cjc1 >*/
    blank_1.value[locd + 1] = cjc1;
/*<       value(locd+3)=cjc2 >*/
    blank_1.value[locd + 2] = cjc2;
/*<       value(locd+4)=go2 >*/
    blank_1.value[locd + 3] = go2;
/*<       value(locd+5)=gmo2 >*/
    blank_1.value[locd + 4] = gmo2;
/*<       value(locd+6)=gm2 >*/
    blank_1.value[locd + 5] = gm2;
/*<       value(locd+7)=gmu2 >*/
    blank_1.value[locd + 6] = gmu2;
/*<       value(locd+8)=gpi2 >*/
    blank_1.value[locd + 7] = gpi2;
/*<       value(locd+9)=cbo >*/
    blank_1.value[locd + 8] = cbo;
/*<       value(locd+10)=cbor >*/
    blank_1.value[locd + 9] = cbor;
/*<       value(locd+11)=cb1 >*/
    blank_1.value[locd + 10] = cb1;
/*<       value(locd+12)=cb1r >*/
    blank_1.value[locd + 11] = cb1r;
/*<       value(locd+13)=go3 >*/
    blank_1.value[locd + 12] = go3;
/*<       value(locd+14)=gmo23 >*/
    blank_1.value[locd + 13] = gmo23;
/*<       value(locd+15)=gm2o3 >*/
    blank_1.value[locd + 14] = gm2o3;
/*<       value(locd+16)=gm3 >*/
    blank_1.value[locd + 15] = gm3;
/*<       value(locd+17)=gmu3 >*/
    blank_1.value[locd + 16] = gmu3;
/*<       value(locd+18)=gpi3 >*/
    blank_1.value[locd + 17] = gpi3;
/*<       value(locd+19)=cb2 >*/
    blank_1.value[locd + 18] = cb2;
/*<       value(locd+20)=cb2r >*/
    blank_1.value[locd + 19] = cb2r;
/*<       loc=nodplc(loc) >*/
    loc = nodplc[loc - 1];
/*<       go to 100 >*/
    goto L100;

/*  diodes */

/*<   200 loc=locate(11) >*/
L200:
    loc = cirdat_1.locate[10];
/*<   210 if ((loc.eq.0).or.(nodplc(loc+16).ne.0)) go to 300 >*/
L210:
    if (loc == 0 || nodplc[loc + 15] != 0) {
	goto L300;
    }
/*<       locv=nodplc(loc+1) >*/
    locv = nodplc[loc];
/*<       area=value(locv+1) >*/
    area = blank_1.value[locv];
/*<       locm=nodplc(loc+5) >*/
    locm = nodplc[loc + 4];
/*<       locm=nodplc(locm+1) >*/
    locm = nodplc[locm];
/*<       loct=lx0+nodplc(loc+11) >*/
    loct = tabinf_1.lx0 + nodplc[loc + 10];
/*<       locd=ld0+nodplc(loc+12) >*/
    locd = tabinf_1.ld0 + nodplc[loc + 11];
/*<       csat=value(locm+1)*area >*/
    csat = blank_1.value[locm] * area;
/*<       vte=value(locm+3)*vt >*/
    vte = blank_1.value[locm + 2] * status_1.vt;
/*<       tau=value(locm+4) >*/
    tau = blank_1.value[locm + 3];
/*<       czero=value(locm+5)*area >*/
    czero = blank_1.value[locm + 4] * area;
/*<       phib=value(locm+6) >*/
    phib = blank_1.value[locm + 5];
/*<       xm=value(locm+7) >*/
    xm = blank_1.value[locm + 6];
/*<       fcpb=value(locm+12) >*/
    fcpb = blank_1.value[locm + 11];
/*<       vd=value(loct) >*/
    vd = blank_1.value[loct - 1];
/*<       geq=value(loct+2) >*/
    geq = blank_1.value[loct + 1];
/*<       evd=1.0d0 >*/
    evd = 1.;
/*<       if (vd.ge.0.0d0) evd=dexp(vd/vte) >*/
    if (vd >= 0.) {
	evd = exp(vd / vte);
    }
/*<       if (vd.ge.fcpb) go to 220 >*/
    if (vd >= fcpb) {
	goto L220;
    }
/*<       arg=1.0d0-vd/phib >*/
    arg = 1. - vd / phib;
/*<       sarg=dexp(xm*dlog(arg)) >*/
    sarg = exp(xm * log(arg));
/*<       cdjo=czero/sarg >*/
    cdjo = czero / sarg;
/*<       argd=phib-vd >*/
    argd = phib - vd;
/*<       cdj1=xm*cdjo/argd >*/
    cdj1 = xm * cdjo / argd;
/*<       cdj2=(1.0d0+xm)*cdj1/argd >*/
    cdj2 = (xm + 1.) * cdj1 / argd;
/*<       go to 230 >*/
    goto L230;
/*<   220 denom=dexp((1.0d0+xm)*dlog(1.0d0-fcpb)) >*/
L220:
    denom = exp((xm + 1.) * log(1. - fcpb));
/*<       cdjo=czero*(1.0d0-fcpb*(1.0d0+xm)+xm*vd/phib)/denom >*/
    cdjo = czero * (1. - fcpb * (xm + 1.) + xm * vd / phib) / denom;
/*<       cdj1=czero*xm/(denom*phib) >*/
    cdj1 = czero * xm / (denom * phib);
/*<       cdj2=0.0d0 >*/
    cdj2 = 0.;
/*<       cdj2=0.0d0 >*/
    cdj2 = 0.;
/*<   230 cdbo=tau*csat*evd/vte >*/
L230:
    cdbo = tau * csat * evd / vte;
/*<       cdb1=cdbo/vte >*/
    cdb1 = cdbo / vte;
/*<       twovte=2.0d0*vte >*/
    twovte = vte * 2.;
/*<       geq2=geq/twovte >*/
    geq2 = geq / twovte;
/*<       if (vd.le.0.0d0) geq2=0.0d0 >*/
    if (vd <= 0.) {
	geq2 = 0.;
    }
/*<       trivte=3.0d0*vte >*/
    trivte = vte * 3.;
/*<       geq3=geq2/trivte >*/
    geq3 = geq2 / trivte;
/*<       cdb2=cdb1/twovte >*/
    cdb2 = cdb1 / twovte;
/*<       value(locd)=cdj1 >*/
    blank_1.value[locd - 1] = cdj1;
/*<       value(locd+1)=cdj2 >*/
    blank_1.value[locd] = cdj2;
/*<       value(locd+2)=cdbo >*/
    blank_1.value[locd + 1] = cdbo;
/*<       value(locd+3)=cdb1 >*/
    blank_1.value[locd + 2] = cdb1;
/*<       value(locd+4)=geq2 >*/
    blank_1.value[locd + 3] = geq2;
/*<       value(locd+5)=geq3 >*/
    blank_1.value[locd + 4] = geq3;
/*<       value(locd+6)=cdb2 >*/
    blank_1.value[locd + 5] = cdb2;
/*<       loc=nodplc(loc) >*/
    loc = nodplc[loc - 1];
/*<       go to 210 >*/
    goto L210;

/*  finished */

/*<   300 return >*/
L300:
    return 0;
/*<       end >*/
} /* dinit_ */

#undef cvalue
#undef nodplc


