/* sorstp.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 {
    doublereal twopi, xlog2, xlog10, root2, rad, boltz, charge, ctok, gmin, 
	    reltol, abstol, vntol, trtol, chgtol, eps0, epssil, epsox, pivtol,
	     pivrel;
} knstnt_;

#define knstnt_1 knstnt_

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 {
    doublereal atime, aprog[3], adate, atitle[10], defl, defw, defad, defas, 
	    rstats[50];
    integer iwidth, lwidth, nopage;
} miscel_;

#define miscel_1 miscel_

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 sorstp(itlim) >*/
/* Subroutine */ int sorstp_(itlim)
integer *itlim;
{
    /* Format strings */
    static char fmt_110[] = "(\0020 source stepping method failed\002)";

    /* Builtin functions */
    double sqrt();
    integer s_wsfe(), e_wsfe();

    /* Local variables */
    extern /* Subroutine */ int iter8_();
    static doublereal bound, fractn;
#define nodplc ((integer *)&blank_1)
#define cvalue ((complex *)&blank_1)

    /* Fortran I/O blocks */
    static cilist io__5 = { 0, 0, 0, fmt_110, 0 };


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

/*     this routine uses the source stepping method to solve the dc */
/*     operating point */

/* spice version 2g.6  sccsid=knstnt 3/15/83 */
/*<       common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok, >*/
/*<      1   gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox, >*/
/*<      2   pivtol,pivrel >*/
/* 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=miscel 3/15/83 */
/*<       common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad, >*/
/*<      1  defas,rstats(50),iwidth,lwidth,nopage >*/
/* 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)) >*/

/*<       bound=1.0d0/64 >*/
    bound = .015625;
/*<       fractn=1.0d0/16 >*/
    fractn = .0625;

/*  step down sources */

/*<    10 fractn=fractn*2.0d0 >*/
L10:
    fractn *= 2.;
/*<       sfactr=sfactr*fractn >*/
    status_1.sfactr *= fractn;
/*<       if (sfactr.lt.bound) go to 100 >*/
    if (status_1.sfactr < bound) {
	goto L100;
    }
/*<       initf=2 >*/
    status_1.initf = 2;
/*<       call iter8(itlim) >*/
    iter8_(itlim);
/*<       rstats(6)=rstats(6)+iterno >*/
    miscel_1.rstats[5] += status_1.iterno;
/*<       if (igoof.ne.0) go to 10 >*/
    if (flags_1.igoof != 0) {
	goto L10;
    }
/*<       fractn=2.0d0 >*/
    fractn = 2.;

/*  step up sources */

/*<    20 sfactr=sfactr*fractn >*/
L20:
    status_1.sfactr *= fractn;
/*<       if (sfactr.le.1.0d0) go to 30 >*/
    if (status_1.sfactr <= 1.) {
	goto L30;
    }
/*<       sfactr=1.0d0 >*/
    status_1.sfactr = 1.;
/*<    30 initf=3 >*/
L30:
    status_1.initf = 3;
/*<       call iter8(itlim) >*/
    iter8_(itlim);
/*<       rstats(6)=rstats(6)+iterno >*/
    miscel_1.rstats[5] += status_1.iterno;
/*<       if ((igoof.eq.0).and.(sfactr.eq.1.0d0)) go to 200 >*/
    if (flags_1.igoof == 0 && status_1.sfactr == 1.) {
	goto L200;
    }
/*<       if (igoof.eq.0) go to 20 >*/
    if (flags_1.igoof == 0) {
	goto L20;
    }

/*  step down if step up failed */

/*<    40 fractn=dsqrt(fractn) >*/
L40:
    fractn = sqrt(fractn);
/*<       if (fractn.lt.1.0001d0) go to 100 >*/
    if (fractn < 1.0001) {
	goto L100;
    }
/*<       sfactr=sfactr/fractn >*/
    status_1.sfactr /= fractn;
/*<       initf=3 >*/
    status_1.initf = 3;
/*<       call iter8(itlim) >*/
    iter8_(itlim);
/*<       rstats(6)=rstats(6)+iterno >*/
    miscel_1.rstats[5] += status_1.iterno;
/*<       if (igoof.ne.0) go to 40 >*/
    if (flags_1.igoof != 0) {
	goto L40;
    }
/*<       go to 20 >*/
    goto L20;

/*   finish with source stepping method */

/*<   100 igoof=1 >*/
L100:
    flags_1.igoof = 1;
/*<       write(iofile,110) >*/
    io__5.ciunit = status_1.iofile;
    s_wsfe(&io__5);
    e_wsfe();
/*<   110 format('0 source stepping method failed') >*/
/*<   200 initf=2 >*/
L200:
    status_1.initf = 2;
/*<       return >*/
    return 0;
/*<       end >*/
} /* sorstp_ */

#undef cvalue
#undef nodplc


