/* sorupd.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_

/* Table of constant values */

static integer c__1 = 1;

/*<       subroutine sorupd >*/
/* Subroutine */ int sorupd_()
{
    /* Format strings */
    static char fmt_901[] = "(\0020*abort*:  internal spice error:  sorupd: \
 \002,2i5/)";

    /* Builtin functions */
    double sin(), exp();
    integer s_wsfe(), do_fio(), e_wsfe();

    /* Local variables */
    static doublereal omeg;
    static integer locp, locv, iknt;
    static doublereal xmod, dt1t2, dt1t3, dt2t3, time1, omegc, theta, omegs;
    static integer icntr, itype, numtd, l1, l2, l3;
    static doublereal t1, t2, v1, v2, t3, t4, tfact1, tfact2, tfact3, tdnom1, 
	    tdnom2, tdnom3;
    static integer id;
    static doublereal td, baktim;
#define nodplc ((integer *)&blank_1)
#define cvalue ((complex *)&blank_1)
    static doublereal period;
    extern /* Subroutine */ int sizmem_();
    static integer ltdsiz, ltdptr, loc;
    static doublereal tau1, tau2, dtt1, dtt2, dtt3;

    /* Fortran I/O blocks */
    static cilist io__45 = { 0, 0, 0, fmt_901, 0 };


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

/*     this routine updates the independent voltage and current sources */

/* used in the circuit.  it also updates the ltd table (which contains */
/* previous (delayed) values of the sources used to model transmission */
/* lines). */

/* 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)) >*/


/*<       do 500 id=9,10 >*/
    for (id = 9; id <= 10; ++id) {
/*<       loc=locate(id) >*/
	loc = cirdat_1.locate[id - 1];
/*<    10 if (loc.eq.0) go to 500 >*/
L10:
	if (loc == 0) {
	    goto L500;
	}
/*<       if ((id.eq.9).and.(nodplc(loc+11).ne.0)) go to 500 >*/
	if (id == 9 && nodplc[loc + 10] != 0) {
	    goto L500;
	}
/*<       if ((id.eq.10).and.(nodplc(loc+6).ne.0)) go to 500 >*/
	if (id == 10 && nodplc[loc + 5] != 0) {
	    goto L500;
	}
/*<       locv=nodplc(loc+1) >*/
	locv = nodplc[loc];
/*<       locp=nodplc(loc+5) >*/
	locp = nodplc[loc + 4];
/*<       itype=nodplc(loc+4)+1 >*/
	itype = nodplc[loc + 3] + 1;
/*<       go to (490,100,200,300,400,450), itype >*/
	switch (itype) {
	    case 1:  goto L490;
	    case 2:  goto L100;
	    case 3:  goto L200;
	    case 4:  goto L300;
	    case 5:  goto L400;
	    case 6:  goto L450;
	}

/*  pulse source */

/*<   100 v1=value(locp+1) >*/
L100:
	v1 = blank_1.value[locp];
/*<       v2=value(locp+2) >*/
	v2 = blank_1.value[locp + 1];
/*<       t1=value(locp+3) >*/
	t1 = blank_1.value[locp + 2];
/*<       t2=value(locp+4) >*/
	t2 = blank_1.value[locp + 3];
/*<       t3=value(locp+5) >*/
	t3 = blank_1.value[locp + 4];
/*<       t4=value(locp+6) >*/
	t4 = blank_1.value[locp + 5];
/*<       period=value(locp+7) >*/
	period = blank_1.value[locp + 6];
/*<       time1=time >*/
	time1 = status_1.time;
/*<       if (time1.le.0.0d0) go to 160 >*/
	if (time1 <= 0.) {
	    goto L160;
	}
/*<   110 if (time1.lt.t1+period) go to 120 >*/
L110:
	if (time1 < t1 + period) {
	    goto L120;
	}
/*<       time1=time1-period >*/
	time1 -= period;
/*<       go to 110 >*/
	goto L110;
/*<   120 if (time1.lt.t4) go to 130 >*/
L120:
	if (time1 < t4) {
	    goto L130;
	}
/*<       value(locv+1)=v1 >*/
	blank_1.value[locv] = v1;
/*<       go to 490 >*/
	goto L490;
/*<   130 if (time1.lt.t3) go to 140 >*/
L130:
	if (time1 < t3) {
	    goto L140;
	}
/*<       value(locv+1)=v2+(time1-t3)*(v1-v2)/(t4-t3) >*/
	blank_1.value[locv] = v2 + (time1 - t3) * (v1 - v2) / (t4 - t3);
/*<       go to 490 >*/
	goto L490;
/*<   140 if (time1.lt.t2) go to 150 >*/
L140:
	if (time1 < t2) {
	    goto L150;
	}
/*<       value(locv+1)=v2 >*/
	blank_1.value[locv] = v2;
/*<       go to 490 >*/
	goto L490;
/*<   150 if (time1.lt.t1) go to 160 >*/
L150:
	if (time1 < t1) {
	    goto L160;
	}
/*<       value(locv+1)=v1+(time1-t1)*(v2-v1)/(t2-t1) >*/
	blank_1.value[locv] = v1 + (time1 - t1) * (v2 - v1) / (t2 - t1);
/*<       go to 490 >*/
	goto L490;
/*<   160 value(locv+1)=v1 >*/
L160:
	blank_1.value[locv] = v1;
/*<       go to 490 >*/
	goto L490;

/*  sinusoidal source */

/*<   200 v1=value(locp+1) >*/
L200:
	v1 = blank_1.value[locp];
/*<       v2=value(locp+2) >*/
	v2 = blank_1.value[locp + 1];
/*<       omeg=value(locp+3) >*/
	omeg = blank_1.value[locp + 2];
/*<       t1=value(locp+4) >*/
	t1 = blank_1.value[locp + 3];
/*<       theta=value(locp+5) >*/
	theta = blank_1.value[locp + 4];
/*<       time1=time-t1 >*/
	time1 = status_1.time - t1;
/*<       if (time1.gt.0.0d0) go to 210 >*/
	if (time1 > 0.) {
	    goto L210;
	}
/*<       value(locv+1)=v1 >*/
	blank_1.value[locv] = v1;
/*<       go to 490 >*/
	goto L490;
/*<   210 if (theta.ne.0.0d0) go to 220 >*/
L210:
	if (theta != 0.) {
	    goto L220;
	}
/*<       value(locv+1)=v1+v2*dsin(omeg*time1) >*/
	blank_1.value[locv] = v1 + v2 * sin(omeg * time1);
/*<       go to 490 >*/
	goto L490;
/*<   220 value(locv+1)=v1+v2*dsin(omeg*time1)*dexp(-time1*theta) >*/
L220:
	blank_1.value[locv] = v1 + v2 * sin(omeg * time1) * exp(-time1 * 
		theta);
/*<       go to 490 >*/
	goto L490;

/*  exponential source */

/*<   300 v1=value(locp+1) >*/
L300:
	v1 = blank_1.value[locp];
/*<       v2=value(locp+2) >*/
	v2 = blank_1.value[locp + 1];
/*<       t1=value(locp+3) >*/
	t1 = blank_1.value[locp + 2];
/*<       tau1=value(locp+4) >*/
	tau1 = blank_1.value[locp + 3];
/*<       t2=value(locp+5) >*/
	t2 = blank_1.value[locp + 4];
/*<       tau2=value(locp+6) >*/
	tau2 = blank_1.value[locp + 5];
/*<       time1=time >*/
	time1 = status_1.time;
/*<       if (time1.gt.t1) go to 310 >*/
	if (time1 > t1) {
	    goto L310;
	}
/*<       value(locv+1)=v1 >*/
	blank_1.value[locv] = v1;
/*<       go to 490 >*/
	goto L490;
/*<   310 if (time1.gt.t2) go to 320 >*/
L310:
	if (time1 > t2) {
	    goto L320;
	}
/*<       value(locv+1)=v1+(v2-v1)*(1.0d0-dexp((t1-time1)/tau1)) >*/
	blank_1.value[locv] = v1 + (v2 - v1) * (1. - exp((t1 - time1) / tau1))
		;
/*<       go to 490 >*/
	goto L490;
/*<   320 value(locv+1)=v1+(v2-v1)*(1.0d0-dexp((t1-time1)/tau1)) >*/
/*<      1   +(v1-v2)*(1.0d0-dexp((t2-time1)/tau2)) >*/
L320:
	blank_1.value[locv] = v1 + (v2 - v1) * (1. - exp((t1 - time1) / tau1))
		 + (v1 - v2) * (1. - exp((t2 - time1) / tau2));
/*<       go to 490 >*/
	goto L490;

/*  piecewise-linear source */

/*<   400 t1=value(locp+1) >*/
L400:
	t1 = blank_1.value[locp];
/*<       v1=value(locp+2) >*/
	v1 = blank_1.value[locp + 1];
/*<       t2=value(locp+3) >*/
	t2 = blank_1.value[locp + 2];
/*<       v2=value(locp+4) >*/
	v2 = blank_1.value[locp + 3];
/*<       iknt=4 >*/
	iknt = 4;
/*<   410 if (time.le.t2) go to 420 >*/
L410:
	if (status_1.time <= t2) {
	    goto L420;
	}
/*<       t1=t2 >*/
	t1 = t2;
/*<       v1=v2 >*/
	v1 = v2;
/*<       t2=value(locp+iknt+1) >*/
	t2 = blank_1.value[locp + iknt];
/*<       v2=value(locp+iknt+2) >*/
	v2 = blank_1.value[locp + iknt + 1];
/*<       iknt=iknt+2 >*/
	iknt += 2;
/*<       go to 410 >*/
	goto L410;
/*<   420 value(locv+1)=v1+((time-t1)/(t2-t1))*(v2-v1) >*/
L420:
	blank_1.value[locv] = v1 + (status_1.time - t1) / (t2 - t1) * (v2 - 
		v1);
/*<       go to 490 >*/
	goto L490;

/*  single-frequency fm */

/*<   450 v1=value(locp+1) >*/
L450:
	v1 = blank_1.value[locp];
/*<       v2=value(locp+2) >*/
	v2 = blank_1.value[locp + 1];
/*<       omegc=value(locp+3) >*/
	omegc = blank_1.value[locp + 2];
/*<       xmod=value(locp+4) >*/
	xmod = blank_1.value[locp + 3];
/*<       omegs=value(locp+5) >*/
	omegs = blank_1.value[locp + 4];
/*<       value(locv+1)=v1+v2*dsin(omegc*time+xmod*dsin(omegs*time)) >*/
	blank_1.value[locv] = v1 + v2 * sin(omegc * status_1.time + xmod * 
		sin(omegs * status_1.time));
/*<   490 loc=nodplc(loc) >*/
L490:
	loc = nodplc[loc - 1];
/*<       go to 10 >*/
	goto L10;
/*<   500 continue >*/
L500:
    ;}

/*  update transmission line sources */

/*<       if (jelcnt(17).eq.0) go to 1000 >*/
    if (cirdat_1.jelcnt[16] == 0) {
	goto L1000;
    }
/*<       if (mode.ne.2) go to 1000 >*/
    if (status_1.mode != 2) {
	goto L1000;
    }
/*<       call sizmem(ltd,ltdsiz) >*/
    sizmem_(&tabinf_1.ltd, &ltdsiz);
/*<       numtd=ltdsiz/ntlin >*/
    numtd = ltdsiz / cirdat_1.ntlin;
/*<       if (numtd.lt.3) go to 900 >*/
    if (numtd < 3) {
	goto L900;
    }
/*<       loc=locate(17) >*/
    loc = cirdat_1.locate[16];
/*<   610 if (loc.eq.0) go to 1000 >*/
L610:
    if (loc == 0) {
	goto L1000;
    }
/*<       locv=nodplc(loc+1) >*/
    locv = nodplc[loc];
/*<       td=value(locv+2) >*/
    td = blank_1.value[locv + 1];
/*<       baktim=time-td >*/
    baktim = status_1.time - td;
/*<       if (baktim.lt.0.0d0) go to 640 >*/
    if (baktim < 0.) {
	goto L640;
    }
/*<       ltdptr=nodplc(loc+30) >*/
    ltdptr = nodplc[loc + 29];
/*<       icntr=2 >*/
    icntr = 2;
/*<       l1=ltd >*/
    l1 = tabinf_1.ltd;
/*<       l2=l1+ntlin >*/
    l2 = l1 + cirdat_1.ntlin;
/*<       l3=l2+ntlin >*/
    l3 = l2 + cirdat_1.ntlin;
/*<       t1=value(l1+1) >*/
    t1 = blank_1.value[l1];
/*<       t2=value(l2+1) >*/
    t2 = blank_1.value[l2];
/*<   620 t3=value(l3+1) >*/
L620:
    t3 = blank_1.value[l3];
/*<       icntr=icntr+1 >*/
    ++icntr;
/*<       if (baktim.le.t3) go to 630 >*/
    if (baktim <= t3) {
	goto L630;
    }
/*<       if (icntr.eq.numtd) go to 900 >*/
    if (icntr == numtd) {
	goto L900;
    }
/*<       l1=l2 >*/
    l1 = l2;
/*<       l2=l3 >*/
    l2 = l3;
/*<       l3=l2+ntlin >*/
    l3 = l2 + cirdat_1.ntlin;
/*<       t1=t2 >*/
    t1 = t2;
/*<       t2=t3 >*/
    t2 = t3;
/*<       go to 620 >*/
    goto L620;
/*<   630 dt1t2=t1-t2 >*/
L630:
    dt1t2 = t1 - t2;
/*<       dt1t3=t1-t3 >*/
    dt1t3 = t1 - t3;
/*<       dt2t3=t2-t3 >*/
    dt2t3 = t2 - t3;
/*<       tdnom1=1.0d0/(dt1t2*dt1t3) >*/
    tdnom1 = 1. / (dt1t2 * dt1t3);
/*<       tdnom2=-1.0d0/(dt1t2*dt2t3) >*/
    tdnom2 = -1. / (dt1t2 * dt2t3);
/*<       tdnom3=1.0d0/(dt2t3*dt1t3) >*/
    tdnom3 = 1. / (dt2t3 * dt1t3);
/*<       dtt1=baktim-t1 >*/
    dtt1 = baktim - t1;
/*<       dtt2=baktim-t2 >*/
    dtt2 = baktim - t2;
/*<       dtt3=baktim-t3 >*/
    dtt3 = baktim - t3;
/*<       tfact1=dtt2*dtt3*tdnom1 >*/
    tfact1 = dtt2 * dtt3 * tdnom1;
/*<       tfact2=dtt1*dtt3*tdnom2 >*/
    tfact2 = dtt1 * dtt3 * tdnom2;
/*<       tfact3=dtt1*dtt2*tdnom3 >*/
    tfact3 = dtt1 * dtt2 * tdnom3;
/*<       value(locv+3)=value(l1+ltdptr+0)*tfact1+value(l2+ltdptr+0)*tfact2 >*/
/*<      1   +value(l3+ltdptr+0)*tfact3 >*/
    blank_1.value[locv + 2] = blank_1.value[l1 + ltdptr - 1] * tfact1 + 
	    blank_1.value[l2 + ltdptr - 1] * tfact2 + blank_1.value[l3 + 
	    ltdptr - 1] * tfact3;
/*<       value(locv+4)=value(l1+ltdptr+1)*tfact1+value(l2+ltdptr+1)*tfact2 >*/
/*<      1   +value(l3+ltdptr+1)*tfact3 >*/
    blank_1.value[locv + 3] = blank_1.value[l1 + ltdptr] * tfact1 + 
	    blank_1.value[l2 + ltdptr] * tfact2 + blank_1.value[l3 + ltdptr] *
	     tfact3;
/*<   640 loc=nodplc(loc) >*/
L640:
    loc = nodplc[loc - 1];
/*<       go to 610 >*/
    goto L610;

/*  internal logic error:  less than 3 entries in ltd */

/*<   900 nogo=1 >*/
L900:
    flags_1.nogo = 1;
/*<       write (iofile,901) numtd,icntr >*/
    io__45.ciunit = status_1.iofile;
    s_wsfe(&io__45);
    do_fio(&c__1, (char *)&numtd, (ftnlen)sizeof(integer));
    do_fio(&c__1, (char *)&icntr, (ftnlen)sizeof(integer));
    e_wsfe();
/*<   901 format('0*abort*:  internal spice error:  sorupd:  ',2i5/) >*/

/*  finished */

/*<  1000 return >*/
L1000:
    return 0;
/*<       end >*/
} /* sorupd_ */

#undef cvalue
#undef nodplc


