home *** CD-ROM | disk | FTP | other *** search
- /* update.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 {
- 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 {
- doublereal value[200000];
- } blank_;
-
- #define blank_1 blank_
-
- /*< subroutine update(vinit,loct,node1,node2,nupda,icheck) >*/
- /* Subroutine */ int update_(vinit, loct, node1, node2, nupda, icheck)
- doublereal *vinit;
- integer *loct, *node1, *node2, *nupda, *icheck;
- {
- /* System generated locals */
- doublereal d_1, d_2;
-
- /* Builtin functions */
- double d_sign();
-
- /* Local variables */
- static doublereal delv, vlim, vnew;
- extern /* Subroutine */ int copy8_();
- static doublereal xfact;
- #define nodplc ((integer *)&blank_1)
- #define cvalue ((complex *)&blank_1)
-
- /*< implicit double precision (a-h,o-z) >*/
-
- /* this routine updates and limits the controlling variables for the
- */
- /* nonlinear controlled sources. */
-
- /* 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=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=blank 3/15/83 */
- /*< common /blank/ value(200000) >*/
- /*< integer nodplc(64) >*/
- /*< complex cvalue(32) >*/
- /*< equivalence (value(1),nodplc(1),cvalue(1)) >*/
-
-
- /*< go to (40,10,40,20,30,50), initf >*/
- switch (status_1.initf) {
- case 1: goto L40;
- case 2: goto L10;
- case 3: goto L40;
- case 4: goto L20;
- case 5: goto L30;
- case 6: goto L50;
- }
- /*< 10 vnew=vinit >*/
- L10:
- vnew = *vinit;
- /*< go to 70 >*/
- goto L70;
- /*< 20 vnew=value(lx0+loct) >*/
- L20:
- vnew = blank_1.value[tabinf_1.lx0 + *loct - 1];
- /*< go to 70 >*/
- goto L70;
- /*< 30 vnew=value(lx1+loct) >*/
- L30:
- vnew = blank_1.value[tabinf_1.lx1 + *loct - 1];
- /*< go to 70 >*/
- goto L70;
- /*< 40 vnew=value(lvnim1+node1)-value(lvnim1+node2) >*/
- L40:
- vnew = blank_1.value[tabinf_1.lvnim1 + *node1 - 1] - blank_1.value[
- tabinf_1.lvnim1 + *node2 - 1];
- /*< go to 60 >*/
- goto L60;
- /*< 50 call copy8(value(lx1+loct),value(lx0+loct),nupda) >*/
- L50:
- copy8_(&blank_1.value[tabinf_1.lx1 + *loct - 1], &blank_1.value[
- tabinf_1.lx0 + *loct - 1], nupda);
- /*< xfact=delta/delold(2) >*/
- xfact = status_1.delta / status_1.delold[1];
- /*< vnew=(1.0d0+xfact)*value(lx1+loct)-xfact*value(lx2+loct) >*/
- vnew = (xfact + 1.) * blank_1.value[tabinf_1.lx1 + *loct - 1] - xfact *
- blank_1.value[tabinf_1.lx2 + *loct - 1];
- /*< 60 if (dabs(vnew).le.1.0d0) go to 80 >*/
- L60:
- if (abs(vnew) <= 1.) {
- goto L80;
- }
- /*< delv=vnew-value(lx0+loct) >*/
- delv = vnew - blank_1.value[tabinf_1.lx0 + *loct - 1];
- /*< if (dabs(delv).le.0.1d0) go to 80 >*/
- if (abs(delv) <= .1) {
- goto L80;
- }
- /*< vlim=dmax1(dabs(0.1d0*value(lx0+loct)),0.1d0) >*/
- /* Computing MAX */
- d_2 = (d_1 = blank_1.value[tabinf_1.lx0 + *loct - 1] * .1, abs(d_1));
- vlim = max(.1,d_2);
- /*< vnew=value(lx0+loct)+dsign(dmin1(dabs(delv),vlim),delv) >*/
- /* Computing MAX */
- d_2 = abs(delv);
- d_1 = min(vlim,d_2);
- vnew = blank_1.value[tabinf_1.lx0 + *loct - 1] + d_sign(&d_1, &delv);
- /*< go to 70 >*/
- goto L70;
- /*< 70 icheck=1 >*/
- L70:
- *icheck = 1;
- /*< 80 value(lx0+loct)=vnew >*/
- L80:
- blank_1.value[tabinf_1.lx0 + *loct - 1] = vnew;
- /*< return >*/
- return 0;
- /*< end >*/
- } /* update_ */
-
- #undef cvalue
- #undef nodplc
-
-
-