/* subnam.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 value[200000];
} blank_;

#define blank_1 blank_

/* Table of constant values */

static integer c__1 = 1;
static integer c__8 = 8;

/*<       subroutine subnam(loce) >*/
/* Subroutine */ int subnam_(loce)
integer *loce;
{
    /* Initialized data */

    static struct {
	char e_1[8];
	doublereal e_2;
	} equiv_14 = { {' ', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };

#define ablank (*(doublereal *)&equiv_14)

    static struct {
	char e_1[8];
	doublereal e_2;
	} equiv_15 = { {'.', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };

#define aper (*(doublereal *)&equiv_15)

    static struct {
	char e_1[8];
	doublereal e_2;
	} equiv_16 = { {'*', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };

#define astk (*(doublereal *)&equiv_16)


    /* Local variables */
    static integer locv;
    extern /* Subroutine */ int move_();
    static doublereal achar;
    static integer ichar, nchar;
    static doublereal sname;
    static integer locve;
    static doublereal elname;
#define nodplc ((integer *)&blank_1)
#define cvalue ((complex *)&blank_1)
    static integer loc;

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

/*     this routine constructs the names of elements added as a result of 
*/
/* subcircuit expansion.  the full element names are of the form */
/*                  name.xn. --- xd.xc.xb.xa */
/* where 'name' is the nominal element name, and the 'x'*s denote the */
/* sequence of subcircuit calls (from top or circuit level down through */

/* nested subcircuit calls) which caused the particular element to be */
/* added.  at present, spice restricts all element names to be 8 charac- 
*/
/* ters or less.  therefore, the name used consists of the leftmost 8 */
/* characters of the full element name, with the rightmost character */
/* replaced by an asterisk ('*') if the full element name is longer than 
*/
/* 8 characters. */

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


/*<       data ablank, aper, astk / 1h , 1h., 1h* / >*/

/*  construct subcircuit element name */

/*<       if (nodplc(loce-1).eq.0) go to 100 >*/
    if (nodplc[*loce - 2] == 0) {
	goto L100;
    }
/*<       locve=nodplc(loce+1) >*/
    locve = nodplc[*loce];
/*<       loc=loce >*/
    loc = *loce;
/*<       nchar=0 >*/
    nchar = 0;
/*<       sname=ablank >*/
    sname = ablank;
/*<       achar=ablank >*/
    achar = ablank;
/*<    10 locv=nodplc(loc+1) >*/
L10:
    locv = nodplc[loc];
/*<       elname=value(locv) >*/
    elname = blank_1.value[locv - 1];
/*<       do 20 ichar=1,8 >*/
    for (ichar = 1; ichar <= 8; ++ichar) {
/*<       call move(achar,1,elname,ichar,1) >*/
	move_(&achar, &c__1, &elname, &ichar, &c__1);
/*<       if (achar.eq.ablank) go to 30 >*/
	if (achar == ablank) {
	    goto L30;
	}
/*<       if (nchar.eq.8) go to 40 >*/
	if (nchar == 8) {
	    goto L40;
	}
/*<       nchar=nchar+1 >*/
	++nchar;
/*<       call move(sname,nchar,achar,1,1) >*/
	move_(&sname, &nchar, &achar, &c__1, &c__1);
/*<    20 continue >*/
/* L20: */
    }
/*<    30 loc=nodplc(loc-1) >*/
L30:
    loc = nodplc[loc - 2];
/*<       if (loc.eq.0) go to 60 >*/
    if (loc == 0) {
	goto L60;
    }
/*<       if (nchar.eq.8) go to 40 >*/
    if (nchar == 8) {
	goto L40;
    }
/*<       nchar=nchar+1 >*/
    ++nchar;
/*<       call move(sname,nchar,aper,1,1) >*/
    move_(&sname, &nchar, &aper, &c__1, &c__1);
/*<       go to 10 >*/
    goto L10;

/*  name is longer than 8 characters:  flag with asterisk */

/*<    40 call move(sname,8,astk,1,1) >*/
L40:
    move_(&sname, &c__8, &astk, &c__1, &c__1);
/*<    60 value(locve)=sname >*/
L60:
    blank_1.value[locve - 1] = sname;

/*  finished */

/*<   100 return >*/
L100:
    return 0;
/*<       end >*/
} /* subnam_ */

#undef cvalue
#undef nodplc
#undef astk
#undef aper
#undef ablank


