FTN66,Y,J,E 
*************************************************************** 
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  ALL RIGHTS     * 
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE-  * 
* REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * 
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.   * 
*************************************************************** 
*  NAME:   READN                      * 
*  SOURCE: 92091-18002                * 
*  RELOC:  92091-16002                * 
*  PGMR:   C. GEBER                   * 
*************************************** 
$PAGE 
$CDS ON 
      SUBROUTINE ALFNUM( NUMBER , STRING , IPOS ) 
     + ,92091-16002 REV.5000 <890418.1140>
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE CONVERTS NUMBER INTO CHARACTER FORM, STORING THE 
C CHARACTERS IN THE CHARACTER ARRAY STRING, BEGINNING WITH THE POSITION 
C INDICATED BY IPOS.
C 
C **** NOTE THAT THE 'IPOS' VARIABLE IS CHANGED TO INDICATE THE POSITION
C      OF THE NEXT UNWRITTEN CHARACTER.  THIS COULD CLOBBER CONSTANTS IF
C      IPOS IS NOT A VARIABLE IN THE CALLING PROGRAM
C 
      DIMENSION STRING(1) 
      DIMENSION ADIGIT(10)
      DATA ADIGIT / 1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9 / 
      DATA AMINUS / 1H- / 
C 
      NUM=NUMBER
C 
C  CHECK FOR NUMBER < 0 
C 
      IF (NUM.GE.0) GO TO 10
      NUM=-NUM
C 
C...  NEGATIVE NUMBER:  INSERT MINUS SIGN 
C 
      CALL MOVE(STRING,IPOS,AMINUS,1,1) 
      IPOS=IPOS+1 
C 
C  CONVERT NUMBER ONE DIGIT AT A TIME, IN REVERSE ORDER 
C 
   10 ISTART=IPOS 
   20 NUMTMP=NUM/10 
      IDIGIT=NUM-NUMTMP*10
      CALL MOVE(STRING,IPOS,ADIGIT(IDIGIT+1),1,1) 
      IPOS=IPOS+1 
      NUM=NUMTMP
      IF (NUM.NE.0) GO TO 20
      ISTOP=IPOS-1
C 
C  NOW REVERSE THE ORDER OF THE DIGITS
C 
   30 IF (ISTOP.LE.ISTART) GO TO 40 
      CALL MOVE(TMPDGT,1,STRING,ISTART,1) 
      CALL MOVE(STRING,ISTART,STRING,ISTOP,1) 
      CALL MOVE(STRING,ISTOP,TMPDGT,1,1)
      ISTART=ISTART+1 
      ISTOP=ISTOP-1 
      GO TO 30
C 
C  CONVERSION COMPLETE
C 
   40 RETURN
      END 
      DOUBLE PRECISION FUNCTION ALIAS( ANAM ) 
     + ,92091-16002 REV.5000 <890418.1140>
      IMPLICIT REAL*8 (A-H,O-Z) 
      DIMENSION ANAM1(14),ANAM2(14) 
      DATA ANAM1 /3HVA ,3HVB ,3HCCS,3HNS ,3HC2 ,3HPT ,3HC4 ,
     1            3HPE ,3HME ,3HPC ,3HMC ,3HPS ,3HMS ,3HIK /
      DATA ANAM2 /3HVAF,3HVAR,3HCJS,3HNSS,3HISE,3HXTI,3HISC,
     1            3HVJE,3HMJE,3HVJC,3HMJC,3HVJS,3HMJS,3HIKF/
C 
C  THIS FUNCTION RETURNS THE MGP EQUIVALENT OF THE GP PARAMETERS
C  (THOSE WHICH APPLY)
C 
      IKNT=0
      ALIAS=ANAM
   10 IKNT=IKNT+1 
      IF (IKNT.GT.14) RETURN
      IF (IXXOR(ANAM1(IKNT),ANAM).NE.0) GO TO 10
      ALIAS=ANAM2(IKNT) 
      RETURN
      END 
$EMA /BLANK/
      SUBROUTINE CARD 
     + ,92091-16002 REV.5000 <890418.1140>
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE SCANS THE INPUT LINES, STORING EACH FIELD INTO THE 
C TABLES IFIELD, IDELIM, ICOLUM, AND ICODE.  WITH THE EXCEPTION OF THE
C '.END' LINE, CARD ALWAYS READS THE NEXT LINE TO CHECK FOR A POSSIBLE
C CONTINUATION BEFORE IT EXITS. 
C 
      LOGICAL FROMLIB   !   modif 21/7/87 (RM)
      COMMON /CMRMEXPLORELIB/ FROMLIB 
      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 
      COMMON /MISCEL/ ATIME,APROG(3),ADATE,ATITLE(10),DEFL,DEFW,DEFAD,
     1  DEFAS,RSTATS(50),IWIDTH,LWIDTH,NOPAGE 
      COMMON /LINE/ ACHAR,AFIELD(15),OLDLIN(15),KNTRC,KNTLIM
      COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS,
     1   LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF 
      COMMON /KNSTNT/ TWOPI,XLOG2,XLOG10,ROOT2,RAD,BOLTZ,CHARGE,CTOK, 
     1   GMIN,RELTOL,ABSTOL,VNTOL,TRTOL,CHGTOL,EPS0,EPSSIL,EPSOX, 
     2   PIVTOL,PIVREL
      COMMON /BLANK/ VALUE(64)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C 
      DIMENSION ADIGIT(10)
      DATA ADIGIT / 1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9 / 
      DATA ABLNK,APER,APLUS,AMINUS,ASTK / 1H , 1H., 1H+, 1H-, 1H* / 
      DATA AG,AK,AU,AN,AP,AE,AM,AF,AT /1HG,1HK,1HU,1HN,1HP,1HE,1HM, 
     1  1HF,1HT/
      DATA AI / 1HI / 
      DATA ALPRN, ARPRN, AEQUAL / 1H(, 1H), 1H= / 
      DATA AEND / 4H.END /
C 
C      NOTE:  THE VALUE OF THE FUNCTION *NXTCHR* (USED EXTENSIVELY IN 
C THIS ROUTINE) IS AS FOLLOWS:
C 
C                    <0:  END-OF-LINE 
C                    =0:  DELIMITER FOUND 
C                    >0:  NON-DELIMITER FOUND 
C 
$PAGE 
      NUMFLD=0
      NOFLD=10
      GO TO 20
C 
C  READ NEXT CARD 
C 
   10 NOFLD=10
      CALL GETLIN 
      IF (KEOF.EQ.0) GO TO 20 
C 
C...  ERROR:  UNEXPECTED END-OF-FILE CONDITION ON INPUT 
C 
   15 KEOF=1
      NOFLD=1 
      NUMFLD=0
      IGOOF=1 
      WRITE (6,16)
   16 FORMAT('0*ERROR*:  .END CARD MISSING'/) 
      GO TO 1000
C 
C  ELIMINATE TRAILING BLANKS RAPIDLY
C 
   20 IF (IXXOR(AFIELD(NOFLD),ABLNK).NE.0) GO TO 40 
      IF (NOFLD.EQ.1) GO TO 30
      NOFLD=NOFLD-1 
      GO TO 20
C 
C...  WRITE BLANK CARD
C 
   30 WRITE (6,31)
   31 FORMAT(1X)
      GO TO 10
C 
C...  COPY THE CARD TO OUTPUT LISTING 
C 
   40 IF(FROMLIB) THEN
        WRITE (6,41) (AFIELD(I),I=1,NOFLD)
   41 FORMAT(3X,10A8) 
      ELSE
        WRITE (6,42) (AFIELD(I),I=1,NOFLD)
   42 FORMAT(1X,10A8) 
      ENDIF 
C 
C  INITIALIZATION FOR NEW CARD
C 
   45 KNTRC=0 
      KNTLIM=MIN0(8*NOFLD,IWIDTH) 
C 
C  FETCH FIRST NON-DELIMITER (SEE ROUTINE *NXTCHR* FOR LIST)
C 
   50 IF (NXTCHR(0)) 600,50,60
C 
C...  CHECK FOR COMMENT (LEADING ASTERISK)
C 
   60 IF (IXXOR(ACHAR,ASTK).EQ.0) GO TO 10
      GO TO 100 
$PAGE 
C 
C  FETCH NEXT CHARACTER 
C 
   70 IF (NXTCHR(0)) 600,80,100 
C 
C  TWO CONSECUTIVE DELIMITERS IMPLY NUMERIC ZERO UNLESS THE DELIMITER 
C  IS A BLANK OR PARENTHESIS. 
C 
   80 IF (IXXOR(ACHAR,ABLNK).EQ.0) GO TO 70 
      IF (IXXOR(ACHAR,ALPRN).EQ.0) GO TO 70 
      IF (IXXOR(ACHAR,ARPRN).EQ.0) GO TO 70 
      IF (IXXOR(ACHAR,AEQUAL).EQ.0) GO TO 70
C 
C...  CHECK FOR SUFFICIENT SPACE IN STORAGE ARRAYS
C 
      IF (NUMFLD.LT.INSIZE-1) GO TO 90
      CALL EXTMEM(IFIELD,50)
      CALL EXTMEM(ICODE,50) 
      CALL EXTMEM(IDELIM,50)
      CALL EXTMEM(ICOLUM,50)
      INSIZE=INSIZE+50
   90 NUMFLD=NUMFLD+1 
      VALUE(IFIELD+NUMFLD)=0.0D0
      NODPLC(ICODE+NUMFLD)=0
      VALUE(IDELIM+NUMFLD)=ACHAR
      NODPLC(ICOLUM+NUMFLD)=KNTRC 
      GO TO 70
C 
C  CHECK FOR SUFFICIENT SPACE IN STORAGE ARRAYS 
C 
  100 IF (NUMFLD.LT.INSIZE-1) GO TO 110 
      CALL EXTMEM(IFIELD,50)
      CALL EXTMEM(ICODE,50) 
      CALL EXTMEM(IDELIM,50)
      CALL EXTMEM(ICOLUM,50)
      INSIZE=INSIZE+50
C 
C  BEGIN SCAN OF NEXT FIELD 
C 
C...  INITIALIZATION
C 
  110 JDELIM=0
      XSIGN=1.0D0 
      XMANT=0.0D0 
      IDEC=0
      IEXP=0
C 
C...  CHECK FOR LEADING PLUS OR MINUS SIGN
C 
      IF (IXXOR(ACHAR,APLUS).EQ.0) GO TO 210
      IF (IXXOR(ACHAR,AMINUS).EQ.0) GO TO 200 
$PAGE 
C 
C...  FINISH INITIALIZATION 
C 
      ANAM=ABLNK
      KCHR=1
C 
C...  AN ISOLATED PERIOD INDICATES THAT A CONTINUATION CARD FOLLOWS 
C 
      IF (IXXOR(ACHAR,APER).NE.0) GO TO 120 
C 
C...  ALTER INITIALIZATION SLIGHTLY IF LEADING PERIOD FOUND 
C 
      IDEC=1
      IEXP=-1 
      ANAM=APER 
      KCHR=2
C 
C...  NOW TAKE A LOOK AT THE NEXT CHARACTER 
C 
      IF (NXTCHR(0)) 10,10,120
C 
C  TEST FOR NUMBER (ANY DIGIT)
C 
  120 DO 130 I=1,10 
      IF (IXXOR(ACHAR,ADIGIT(I)).NE.0) GO TO 130
      XMANT=DFLOAT(I-1) 
      GO TO 210 
  130 CONTINUE
C 
C  ASSEMBLE NAME
C 
      NUMFLD=NUMFLD+1 
      CALL MOVE(ANAM,KCHR,ACHAR,1,1)
      KCHR=KCHR+1 
      DO 150 I=KCHR,8 
      IF (NXTCHR(0)) 160,160,140
  140 CALL MOVE(ANAM,I,ACHAR,1,1) 
  150 CONTINUE
      GO TO 170 
  160 JDELIM=1
  170 VALUE(IFIELD+NUMFLD)=ANAM 
      NODPLC(ICODE+NUMFLD)=1
      NODPLC(ICOLUM+NUMFLD)=KNTRC 
C 
C...  NO '+' FORMAT CONTINUATION POSSIBLE FOR .END CARD 
C 
      IF (NUMFLD.GE.2) GO TO 400
      IF (IXXOR(ANAM,AEND).NE.0) GO TO 400
      NODPLC(ICODE+NUMFLD+1)=-1 
      GO TO 1000
$PAGE 
C 
C  PROCESS NUMBER 
C 
C...  TAKE NOTE OF LEADING MINUS SIGN 
C 
  200 XSIGN=-1.0D0
C 
C...  TAKE A LOOK AT THE NEXT CHARACTER 
C 
  210 IF (NXTCHR(0)) 335,335,220
C 
C...  TEST FOR DIGIT
C 
  220 DO 230 I=1,10 
      IF (IXXOR(ACHAR,ADIGIT(I)).NE.0) GO TO 230
      XMANT=XMANT*10.0D0+DFLOAT(I-1)
      IF (IDEC.EQ.0) GO TO 210
      IEXP=IEXP-1 
      GO TO 210 
  230 CONTINUE
C 
C  CHECK FOR DECIMAL POINT
C 
      IF (IXXOR(ACHAR,APER).NE.0) GO TO 240 
C 
C...  MAKE CERTAIN THAT THIS IS THE FIRST ONE FOUND 
C 
      IF (IDEC.NE.0) GO TO 500
      IDEC=1
      GO TO 210 
C 
C  TEST FOR EXPONENT
C 
  240 IF (IXXOR(ACHAR,AE).NE.0) GO TO 300 
      IF (NXTCHR(0)) 335,335,250
  250 ITEMP=0 
      ISIGN=1 
C 
C...  CHECK FOR POSSIBLE LEADING SIGN ON EXPONENT 
C 
      IF (IXXOR(ACHAR,APLUS).EQ.0) GO TO 260
      IF (IXXOR(ACHAR,AMINUS).NE.0) GO TO 270 
      ISIGN=-1
  260 IF (NXTCHR(0)) 285,285,270
C 
C...  TEST FOR DIGIT
C 
  270 DO 280 I=1,10 
      IF (IXXOR(ACHAR,ADIGIT(I)).NE.0) GO TO 280
      ITEMP=ITEMP*10+I-1
      GO TO 260 
  280 CONTINUE
      GO TO 290 
  285 JDELIM=1
$PAGE 
C 
C...  CORRECT INTERNAL EXPONENT 
C 
  290 IEXP=IEXP+ISIGN*ITEMP 
      GO TO 340 
C 
C  TEST FOR SCALE FACTOR
C 
  300 IF (IXXOR(ACHAR,AM).NE.0) GO TO 330 
C 
C...  SPECIAL CHECK FOR *ME* (AS DISTINGUISHED FROM *M*)
C 
      IF (NXTCHR(0)) 320,320,310
  310 IF (IXXOR(ACHAR,AE).NE.0) GO TO 315 
      IEXP=IEXP+6 
      GO TO 340 
  315 IF (IXXOR(ACHAR,AI).NE.0) GO TO 325 
      XMANT=XMANT*25.4D-6 
      GO TO 340 
  320 JDELIM=1
  325 IEXP=IEXP-3 
      GO TO 340 
  330 IF (IXXOR(ACHAR,AT).EQ.0) IEXP=IEXP+12  
      IF (IXXOR(ACHAR,AG).EQ.0) IEXP=IEXP+9 
      IF (IXXOR(ACHAR,AK).EQ.0) IEXP=IEXP+3 
      IF (IXXOR(ACHAR,AU).EQ.0) IEXP=IEXP-6 
      IF (IXXOR(ACHAR,AN).EQ.0) IEXP=IEXP-9 
      IF (IXXOR(ACHAR,AP).EQ.0) IEXP=IEXP-12  
      IF (IXXOR(ACHAR,AF).EQ.0) IEXP=IEXP-15  
      GO TO 340 
  335 JDELIM=1
C 
C  ASSEMBLE THE FINAL NUMBER
C 
  340 IF (XMANT.EQ.0.0D0) GO TO 350 
      IF (IEXP.EQ.0) GO TO 350
      IF (IABS(IEXP).GE.201) GO TO 500
      XMANT=XMANT*DEXP(DFLOAT(IEXP)*XLOG10) 
      IF (XMANT.GT.1.0D+35) GO TO 500 
      IF (XMANT.LT.1.0D-35) GO TO 500 
  350 NUMFLD=NUMFLD+1 
      VALUE(IFIELD+NUMFLD)=DSIGN(XMANT,XSIGN) 
      NODPLC(ICODE+NUMFLD)=0
      NODPLC(ICOLUM+NUMFLD)=KNTRC 
$PAGE 
C 
C  SKIP TO NON-BLANK DELIMITER (IF NECESSARY) 
C 
  400 IF (JDELIM.EQ.0) GO TO 440
  410 VALUE(IDELIM+NUMFLD)=ACHAR
      IF (IXXOR(ACHAR,ABLNK).NE.0) GO TO 70 
      IF (NXTCHR(0)) 450,410,420
  420 KNTRC=KNTRC-1 
      GO TO 70
  440 IF (NXTCHR(0)) 450,410,440
  450 VALUE(IDELIM+NUMFLD)=ACHAR
      GO TO 600 
C 
C  ERRORS 
C 
  500 WRITE (6,501) KNTRC 
  501 FORMAT('0*ERROR*:  ILLEGAL NUMBER -- SCAN STOPPED AT COLUMN ',I3/)
      IGOOF=1 
      NUMFLD=NUMFLD+1 
      VALUE(IFIELD+NUMFLD)=0.0D0
      NODPLC(ICODE+NUMFLD)=0
      VALUE(IDELIM+NUMFLD)=ACHAR
      NODPLC(ICOLUM+NUMFLD)=KNTRC 
C 
C  FINISHED 
C 
  600 NODPLC(ICODE+NUMFLD+1)=-1 
C 
C  CHECK NEXT LINE FOR POSSIBLE CONTINUATION
C 
  610 CALL GETLIN 
      IF (KEOF.EQ.1) GO TO 15 
      NOFLD=10
  620 IF (IXXOR(AFIELD(NOFLD),ABLNK).NE.0) GO TO 630
      IF (NOFLD.EQ.1) GO TO 650 
      NOFLD=NOFLD-1 
      GO TO 620 
  630 KNTRC=0 
      KNTLIM=MIN0(8*NOFLD,IWIDTH) 
$PAGE 
C 
C...  CONTINUATION LINE HAS A '+' AS FIRST NON-DELIMITER ON CARD
C 
  632 IF (NXTCHR(0)) 650,632,634
  634 IF (IXXOR(ACHAR,APLUS).NE.0) GO TO 640
      WRITE(6,41) (AFIELD(I),I=1,NOFLD) 
      GO TO 70
  640 IF (IXXOR(ACHAR,ASTK).NE.0) GO TO 1000
  650 WRITE (6,41) (AFIELD(I),I=1,NOFLD)
      GO TO 610 
 1000 RETURN
      END 
$EMA /BLANK/
      SUBROUTINE EXTNAM( ANAME , INDEX )
     + ,92091-16002 REV.5000 <890418.1140>
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE ADDS 'ANAME' TO THE LIST OF 'UNSATISFIED' NAMES (THAT
C IS, NAMES WHICH CAN ONLY BE RESOLVED AFTER SUBCIRCUIT EXPANSION). 
C 
      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 
      COMMON /BLANK/ VALUE(64)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
      INTEGER IXXOR 
C 
      ANAM=ANAME
      IF (NUNSAT.EQ.0) GO TO 20 
      DO 10 INDEX=1,NUNSAT
      IF (IXXOR(ANAM,VALUE(IUNSAT+INDEX)).EQ.0) GO TO 30
   10 CONTINUE
C 
   20 CALL EXTMEM(IUNSAT,1) 
      NUNSAT=NUNSAT+1 
      INDEX=NUNSAT
      VALUE(IUNSAT+INDEX)=ANAM
   30 RETURN
      END 
$EMA /BLANK/
      SUBROUTINE FIND( ANAME , ID , LOC , IFORCE )
     + ,92091-16002 REV.5000 <890418.1140>
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE SEARCHES THE LIST WITH NUMBER 'ID' FOR AN ELEMENT
C WITH NAME 'ANAME'.  LOC IS SET TO POINT TO THE ELEMENT.  IF IFORCE IS 
C NONZERO, THEN FIND EXPECTS TO HAVE TO ADD THE ELEMENT TO THE LIST, AND
C REPORTS A FATAL ERROR IF THE ELEMENT IS FOUND.  IF SUBCIRCUIT DEFINI- 
C TION IS IN PROGRESS (NONZERO VALUE FOR NSBCKT), THEN FIND SEARCHES THE
C CURRENT SUBCIRCUIT DEFINITION LIST RATHER THAN THE NOMINAL ELEMENT
C LIST. 
C 
      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 
      COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 
     1   NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS
      COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS,
     1   LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF 
      COMMON /MEMMGR/ CPYKNT,ISTACK(1),LORG,ICORE,MAXCOR,MAXUSE,MEMAVL, 
     1   LDVAL,NUMBLK,LOCTAB,LTAB,IFWA,NWOFF,NTAB,MAXMEM,MEMERR,NWD4, 
     2   NWD8,NWD16 
      COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET,
     1   XMU,MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO,
     2   ITEMNO,NOSOLV,MODAC,IPIV,IVMFLG,IPOSTP,ISCRCH,IOFILE 
      COMMON /BLANK/ VALUE(64)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
$PAGE 
C 
C  INDEX TO THE CONTENTS OF THE VARIOUS LISTS:
C 
C        LIST      CONTENTS 
C        ----      -------- 
C 
C          1       RESISTORS
C          2       NONLINEAR CAPACITORS 
C          3       NONLINEAR INDUCTORS
C          4       MUTUAL INDUCTORS 
C          5       NONLINEAR VOLTAGE CONTROLLED CURRENT SOURCES 
C          6       NONLINEAR VOLTAGE CONTROLLED VOLTAGE SOURCES 
C          7       NONLINEAR CURRENT CONTROLLED CURRENT SOURCES 
C          8       NONLINEAR CURRENT CONTROLLED VOLTAGE SOURCES 
C          9       INDEPENDENT VOLTAGE SOURCES
C         10       INDEPENDENT CURRENT SOURCES
C         11       DIODES 
C         12       BIPOLAR JUNCTION TRANSISTORS 
C         13       JUNCTION FIELD-EFFECT TRANSISTORS (JFETS)
C         14       METAL-OXIDE-SEMICONDUCTOR JUNCTION FETS (MOSFETS)
C         15       S-PARAMETER 2-PORT NETWORK 
C         16       Y-PARAMETER 2-PORT NETWORK 
C         17       TRANSMISSION LINES 
C         18       <UNUSED> 
C         19       SUBCIRCUIT CALLS 
C         20       SUBCIRCUIT DEFINITIONS 
C         21       DIODE MODEL
C         22       BJT MODEL
C         23       JFET MODEL 
C         24       MOSFET MODEL 
C      25-30       <UNUSED> 
C         31       .PRINT DC
C         32       .PRINT TRAN
C         33       .PRINT AC
C         34       .PRINT NOISE 
C         35       .PRINT DISTORTION
C         36       .PLOT DC 
C         37       .PLOT TR 
C         38       .PLOT AC 
C         39       .PLOT NOISE
C         40       .PLOT DISTORTION 
C         41       OUTPUTS FOR DC 
C         42       OUTPUTS FOR TRANSIENT
C         43       OUTPUTS FOR AC 
C         44       OUTPUTS FOR NOISE
C         45       OUTPUTS FOR DISTORTION 
********************************************************************
* 
*         46       .GRAPH DC
*         47       .GRAPH TRAN
*         48       .GRAPH AC
*         49       .GRAPH NOISE 
*         50       .GRAPH DISTO 
* 
********************************************************************
      INTEGER IXXOR 
      DIMENSION LNOD(50),LVAL(50) 
********************************************************************
* 
*     FILL TABLE VALUES FOR .GRAPH COMMANDS (SAME AS PLOT)
* 
      DATA LNOD / 9,13,15, 7,14,15,14,15,12, 7, 
     1           17,37,26,34, 7, 7,34, 0, 5, 5, 
     2            4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 
     3           21,21,21,21,21,21,21,21,21,21, 
     4            8, 8, 8, 8, 8,21,21,21,21,21 /
      DATA LVAL / 5, 4, 4, 2, 1, 1, 1, 1, 4, 4, 
     1            3, 4, 4,16, 1, 1, 9, 0, 1, 1, 
     2           19,55,17,46, 0, 0, 0, 0, 0, 0, 
     3            1, 1, 1, 1, 1,17,17,17,17,17, 
     4            1, 1, 1, 1, 1,17,17,17,17,17 /
* 
********************************************************************
      DATA NDEFIN /2H.U/
C 
      ANAM=ANAME
      CALL SIZMEM(IELMNT,ISIZE) 
      LOCN=IELMNT+ISIZE+2 
      IF (NSBCKT.EQ.0) GO TO 10 
      LOCT=NODPLC(ISBCKT+NSBCKT)
      LOC=NODPLC(LOCT+3)
      IF (LOC.NE.0) GO TO 20
      NODPLC(LOCT+3)=LOCN 
      GO TO 60
   10 LOC=LOCATE(ID)
      IF (LOC.NE.0) GO TO 20
      LOCATE(ID)=LOCN 
      GO TO 50
C 
C  SEARCH LIST FOR A NAME MATCH 
C 
   20 LOCV=NODPLC(LOC+1)
      IF (IXXOR(ANAM,VALUE(LOCV)).NE.0) GO TO 30  
      IF (NSBCKT.EQ.0) GO TO 25 
      IF (NODPLC(LOC-1).NE.ID) GO TO 30 
   25 IF (NODPLC(LOC+2).EQ.NDEFIN) GO TO 200
      IF (IFORCE.EQ.0) GO TO 200
      WRITE (IOFILE,26) ANAM
   26 FORMAT('0*ERROR*:  ABOVE LINE ATTEMPTS TO REDEFINE ',A8/) 
      NOGO=1
   30 IF (NODPLC(LOC).EQ.0) GO TO 40
      LOC=NODPLC(LOC) 
      GO TO 20
$PAGE 
C 
C  RESERVE SPACE FOR THIS ELEMENT 
C 
   40 NODPLC(LOC)=LOCN
      IF (NSBCKT.NE.0) GO TO 60 
   50 JELCNT(ID)=JELCNT(ID)+1 
   60 LOC=LOCN
      ITEMP=LOC+LNOD(ID)*NWD4-1 
      LOCV=NXTEVN(ITEMP-1)+1
      ITEMP=LOCV-ITEMP
      KTMP=LNOD(ID)*NWD4+LVAL(ID)*NWD8+ITEMP
      CALL EXTMEM(IELMNT,KTMP)
      LOCV=(LOCV-1)/NWD8+1
      IPTR=0
      IF (NSBCKT.EQ.0) GO TO 80 
      IPTR=ID 
   80 NODPLC(LOC-1)=IPTR
      NODPLC(LOC)=0 
      NODPLC(LOC+1)=LOCV
      VALUE(LOCV)=ANAM
C 
C  BACKGROUND STORAGE 
C 
  100 NODPLC(LOC+2)=NDEFIN
      NWORD=LNOD(ID)-4
      IF (NWORD.LT.1) GO TO 120 
      CALL ZERO4(NODPLC(LOC+3),NWORD) 
  120 NWORD=LVAL(ID)-1
      IF (NWORD.LT.1) GO TO 200 
      CALL ZERO8(VALUE(LOCV+1),NWORD) 
      IF ((ID.GE.21).AND.(ID.LE.24)) CALL UNDEFI(VALUE(LOCV+1),NWORD) 
C 
C  EXIT 
C 
  200 RETURN
      END 
C        GETLIN   ! modifie le 21/7/87 par RM --> exploration bibliotheque
$EMA /BLANK/
      SUBROUTINE GETLIN 
     + ,92091-16002 REV.5000 <890418.1140>
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE READS THE NEXT LINE OF INPUT INTO THE ARRAY AFIELD.
C IF END-OF-FILE IS FOUND, THE VARIABLE KEOF IS SET TO 1. 
C 
      PARAMETER (NBDANSLIBRMMAX=32)              ! modif du 21/7/87 (RM)
      DIMENSION DANSLIBRM(NBDANSLIBRMMAX) 
      LOGICAL FROMLIB 
      COMMON /CMRMEXPLORELIB/ FROMLIB,NBDANSLIBRM,DANSLIBRM 
      COMMON /LINE/ ACHAR,AFIELD(15),OLDLIN(15),KNTRC,KNTLIM
      COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS,
     1   LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF 
      COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT
      COMMON /CIRDAT/ LOCATE(50)
      COMMON /BLANK/ VALUE(64)
      INTEGER NODPLC(64)
      EQUIVALENCE (VALUE(1),NODPLC(1))
C 
      LOGICAL LENDFOUND,DONE,MOREINLIB
      SAVE LENDFOUND,DONE 
      DATA ENDCARD /8H.END    /,ENDCARD1 /8H .END   /,
     1   BLANKCARD /8H        / 
      DATA ENDSCARD /8H.ENDS   /
      DATA LENDFOUND/.FALSE./,DONE/.FALSE./ 
      IF(DONE) GOTO 200 
      CALL COPY8(AFIELD,OLDLIN,15)
10    READ(5,20,END=100) (AFIELD(I),I=1,10) 
20    FORMAT(10A8)
      IF(AFIELD(1).NE.ENDCARD.AND.AFIELD(1).NE.ENDCARD1) GOTO 70
      IF(LENDFOUND) THEN
        WRITE(6,'(A)')
     1          ' *** Carte .END trouvee dans la bibliotheque! ***' 
        GOTO 300
      ENDIF 
      LENDFOUND=.TRUE.
      FROMLIB=.TRUE.
30    NBDANSLIBRM=0       ! modif RM 21/7/87 : trouver les Unsat
      DO INDEXRM=1,NUNSAT 
        DO IDRM=20,24     ! voir s'il est deja defini : 
          LOCRM=LOCATE(IDRM)
          DO WHILE(LOCRM.NE.0)
            LOCVRM=NODPLC(LOCRM+1)
          IF (IXXOR(VALUE(LOCVRM),VALUE(IUNSAT+INDEXRM)).EQ.0) GOTO 50
            LOCRM=NODPLC(LOCRM) 
          ENDDO 
        ENDDO 
        NBDANSLIBRM=NBDANSLIBRM+1 
        DANSLIBRM(NBDANSLIBRM)=VALUE(IUNSAT+INDEXRM)
        IF(NBDANSLIBRM.GE.NBDANSLIBRMMAX) GOTO 60 
50      CONTINUE
      ENDDO       !       non defini suivant
60    IF(NBDANSLIBRM.EQ.0) GOTO 300 
      NBDANSLIBRM=-NBDANSLIBRM
      GOTO 200
70    IF(.NOT.LENDFOUND) RETURN 
      IF(AFIELD(1).EQ.ENDSCARD) THEN
        DONE=.TRUE. 
      ENDIF 
      RETURN
100   KEOF=1
      LENDFOUND=.FALSE. 
      DONE=.FALSE.
      RETURN
200   IF(NBDANSLIBRM.NE.0) THEN 
        IF(MOREINLIB()) THEN
          DONE=.FALSE.
          GOTO 10 
        ENDIF 
      ENDIF 
      DONE=.FALSE.
      IF(NBDANSLIBRM.EQ.0) GOTO 30        !  on a tout resolu; de nouveaux? 
300   LENDFOUND=.FALSE.                   !  si l'on n'a pas tout resolu
      AFIELD(1)=ENDCARD 
      DO I=2,10 
        AFIELD(I)=BLANKCARD 
      ENDDO 
      FROMLIB=.FALSE. 
      END     !     fin de GETLIN modifie le 21/7/87 (RM) 
      SUBROUTINE KEYSRC( KEYTAB , LENTAB , TSTWRD , INDEX ) 
     + ,92091-16002 REV.5000 <890418.1140>
      IMPLICIT REAL*8 (A-H,O-Z) 
      DOUBLE PRECISION KEYTAB 
C 
C     THIS ROUTINE SEARCHES THE KEYWORD TABLE 'KEYTAB' FOR THE POSSIBLE 
C ENTRY 'TSTWRD'.  ABBREVIATIONS ARE CONSIDERED AS MATCHES. 
C 
      DIMENSION KEYTAB(LENTAB)
      INTEGER IXXOR 
      DATA ABLNK / 1H  /
C 
      INDEX=0 
      LENWRD=0
      ACHAR=ABLNK 
      DO 10 I=1,8 
      CALL MOVE(ACHAR,8,TSTWRD,I,1) 
      IF (IXXOR(ACHAR,ABLNK).EQ.0) GO TO 20 
      LENWRD=LENWRD+1 
   10 CONTINUE
C 
   20 IF (LENWRD.EQ.0) GO TO 40 
      TSTCHR=ABLNK
      CALL MOVE(TSTCHR,8,TSTWRD,1,1)
   30 INDEX=INDEX+1 
      IF (INDEX.GT.LENTAB) GO TO 40 
      AKEY=ABLNK
      CALL MOVE(AKEY,1,KEYTAB(INDEX),1,LENWRD)
      IF (IXXOR(AKEY,TSTWRD).EQ.0) GO TO 50 
      GO TO 30
C 
   40 INDEX=-1
   50 RETURN
      END 
      INTEGER FUNCTION NXTCHR( INT )
     + ,92091-16002 REV.5000 <890418.1140>
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE ADVANCES THE CURRENT LINE SCAN POINTER ONE COLUMN
C     AND CHECKS WHETHER OR NOT THE NEXT CHARACTER IS A DELIMITER 
C 
      COMMON /LINE/ ACHAR,AFIELD(15),OLDLIN(15),KNTRC,KNTLIM
C 
      DIMENSION ADELIM(5) 
      DATA ADELIM / 1H , 1H,, 1H=, 1H(, 1H) / 
      DATA ABLNK / 1H  /
      DATA ICHAR /0/
C 
C  ADVANCE SCAN POINTER (KNTRC) 
C 
      KNTRC=KNTRC+1 
      IF (KNTRC.GT.KNTLIM) GO TO 30 
      CALL MOVE(ACHAR,1,AFIELD,KNTRC,1) 
    5 DO 10 I=1,5 
      IF (IXXOR(ACHAR,ADELIM(I)).EQ.0) GO TO 20 
   10 CONTINUE
C 
C  NON-DELIMITER
C 
      NXTCHR=1
      RETURN
C 
C  DELIMITER
C 
   20 NXTCHR=0
      RETURN
C 
C  END-OF-LINE
C 
   30 NXTCHR=-1 
      ACHAR=ABLNK 
      RETURN
      END 
$EMA /BLANK/                            
      SUBROUTINE OUTDEF( IFLD , MODE , LOCT , LTYPE ) 
     + ,92091-16002 REV.5000 <890418.1140>  
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE CONSTRUCTS THE INTERNAL LIST ELEMENT FOR AN OUTPUT 
C VARIABLE DEFINED ON SOME INPUT CARD.
C 
      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 
      COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS,
     1   LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF 
      COMMON /BLANK/ VALUE(64)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
C 
      INTEGER IXXOR 
      DIMENSION AOUT(19),AOPTS(5) 
      DATA AOUT / 4HV   , 4HVM  , 4HVR  , 4HVI  , 4HVP  , 4HVDB , 
     1            4HI   , 4HIM  , 4HIR  , 4HII  , 4HIP  , 4HIDB , 
     2            4HONOI, 4HINOI, 4HHD2 , 4HHD3 , 4HDIM2, 4HSIM2, 
     3            4HDIM3 /
      DATA AOPTS / 1HM, 1HR, 1HI, 1HP, 1HD /
      DATA ALPRN, ACOMMA, ABLNK, ALETV / 1H(, 1H,, 1H , 1HV / 
C 
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 300
      ANAM=VALUE(IFIELD+IFLD) 
      CALL MOVE(ANAM,5,ABLNK,1,4) 
      DO 10 I=1,19
      IF (IXXOR(ANAM,AOUT(I)).NE.0) GO TO 10
      IDOUT=I 
      GO TO 20
   10 CONTINUE
      GO TO 300 
C 
C  FURTHER ERROR CHECKING 
C 
   20 IF (MODE.GE.3) GO TO 25 
C 
C...  DC OR TRAN
C 
      IF ((IDOUT.NE.1).AND.(IDOUT.NE.7)) GO TO 300
      GO TO 38
   25 IF (MODE.GE.4) GO TO 30 
$PAGE 
C 
C...  AC
C 
      IF (IDOUT.GE.13) GO TO 300
      GO TO 38
   30 IF (MODE.EQ.5) GO TO 35 
C 
C...  NOISE 
C 
      IF ((IDOUT.NE.13).AND.(IDOUT.NE.14)) GO TO 300
      GO TO 38
C 
C...  DISTORTION
C 
   35 IF (IDOUT.LT.15) GO TO 300
   38 KTYPE=0 
      LTYPE=IDOUT 
      IF (IDOUT.LT.7) GO TO 40
      KTYPE=1 
      LTYPE=LTYPE-6 
      IF (IDOUT.LT.13) GO TO 40 
      KTYPE=IDOUT-11
      LTYPE=1 
C 
C  VOLTAGE OUTPUT 
C 
   40 ID=40+MODE
      IF (KTYPE.NE.0) GO TO 100 
      IF (NODPLC(ICODE+IFLD+1).NE.0) GO TO 300
      IFLD=IFLD+1 
      N1=VALUE(IFIELD+IFLD) 
      IF (N1.LT.0) GO TO 300
      IF (N1.GT.9999) GO TO 300 
      N2=0
      ADELIM=VALUE(IDELIM+IFLD) 
      IF (IXXOR(ADELIM,ACOMMA).EQ.0) GO TO 45 
      IF (IXXOR(ADELIM,ABLNK).NE.0) GO TO 50  
   45 IF (NODPLC(ICODE+IFLD+1).NE.0) GO TO 300
      IFLD=IFLD+1 
      N2=VALUE(IFIELD+IFLD) 
      IF (N2.LT.0) GO TO 300
      IF (N2.GT.9999) GO TO 300 
   50 OUTNAM=ABLNK
      IPOS=1
      CALL ALFNUM(N1,OUTNAM,IPOS) 
      IPOS=5
      CALL ALFNUM(N2,OUTNAM,IPOS) 
      CALL FIND(OUTNAM,ID,LOCT,0) 
      NODPLC(LOCT+2)=N1 
      NODPLC(LOCT+3)=N2 
      GO TO 400 
$PAGE 
C 
C  CURRENT OUTPUT 
C 
  100 IF (KTYPE.NE.1) GO TO 200 
      IF (NODPLC(ICODE+IFLD+1).NE.1) GO TO 300
      IFLD=IFLD+1 
      AVSRC=VALUE(IFIELD+IFLD)
      ACHEK=AVSRC 
      CALL MOVE(ACHEK,2,ABLNK,1,7)
      IF (IXXOR(ACHEK,ALETV).NE.0) GO TO 300
      CALL FIND(AVSRC,ID,LOCT,0)
      CALL FIND(AVSRC,9,NODPLC(LOCT+2),0) 
      NODPLC(LOCT+5)=1
      GO TO 400 
C 
C  NOISE OR DISTORTION OUTPUTS
C 
  200 ID=44 
      IF (KTYPE.GE.4) ID=ID+1 
      IF (IXXOR(VALUE(IDELIM+IFLD),ALPRN).NE.0) GO TO 220 
      IF (NODPLC(ICODE+IFLD+1).NE.1) GO TO 300
      IFLD=IFLD+1 
      ATYPE=VALUE(IFIELD+IFLD)
      CALL MOVE(ATYPE,2,ABLNK,1,7)
      DO 210 I=1,5
      IF (IXXOR(ATYPE,AOPTS(I)).NE.0) GO TO 210 
      LTYPE=I+1 
      GO TO 220 
  210 CONTINUE
      GO TO 300 
  220 CALL FIND(ANAM,ID,LOCT,0) 
      NODPLC(LOCT+2)=0
      NODPLC(LOCT+5)=KTYPE
      GO TO 400 
C 
C  ERRORS 
C 
  300 IGOOF=1 
C 
C  FINISHED 
C 
  400 RETURN
      END 
$EMA /BLANK/                            
      SUBROUTINE READIN 
     + ,92091-16002 REV.5000 <890418.1140>  
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C 
C     THIS ROUTINE DRIVES THE INPUT PROCESSING OF SPICE.  ELEMENT CARDS 
C AND DEVICE MODELS ARE HANDLED BY THIS ROUTINE.
C 
      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 
      COMMON /MISCEL/ ATIME,APROG(3),ADATE,ATITLE(10),DEFL,DEFW,DEFAD,
     1  DEFAS,RSTATS(50),IWIDTH,LWIDTH,NOPAGE 
      COMMON /LINE/ ACHAR,AFIELD(15),OLDLIN(15),KNTRC,KNTLIM
      COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 
     1   NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS
      COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET,
     1   XMU,MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO,
     2   ITEMNO,NOSOLV,MODAC,IPIV,IVMFLG,IPOSTP,ISCRCH,IOFILE 
      COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS,
     1   LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF 
      COMMON /KNSTNT/ TWOPI,XLOG2,XLOG10,ROOT2,RAD,BOLTZ,CHARGE,CTOK, 
     1   GMIN,RELTOL,ABSTOL,VNTOL,TRTOL,CHGTOL,EPS0,EPSSIL,EPSOX, 
     2   PIVTOL,PIVREL
      COMMON /DC/ TCSTAR(2),TCSTOP(2),TCINCR(2),ICVFLG,ITCELM(2),KSSOP, 
     1   KINEL,KIDIN,KOVAR,KIDOUT 
      COMMON /AC/ FSTART,FSTOP,FINCR,SKW2,REFPRL,SPW2,JACFLG,IDFREQ,
     1   INOISE,NOSPRT,NOSOUT,NOSIN,IDIST,IDPRT 
      COMMON /TRAN/ TSTEP,TSTOP,TSTART,DELMAX,TDMAX,FORFRE,JTRFLG 
      COMMON /OUTINF/ XINCR,STRING(15),XSTART,YVAR(8),ITAB(8),ITYPE(8), 
     1   ILOGY(8),NPOINT,NUMOUT,KNTR,NUMDGT 
      COMMON /CJE/ MAXTIM,ITIME,ICOST 
      COMMON/DEBUG/ IDEBUG(20)
      COMMON /BLANK/ VALUE(64)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
$PAGE 
C 
C  CONTROL CARD IDENTIFIERS 
C 
      DIMENSION AIDE(20),NNODS(20),NTNODS(20) 
      DIMENSION NUMIC(4)
      DIMENSION AIDM(7),IPOLAR(7),MODID(7),IPAR(5),AMPAR(115) 
      DIMENSION TITINP(4) 
********************************************************************
* 
*     ADD .GRAPH CARD 
* 
      DIMENSION AIDC(22)
      DATA TITINP / 8HINPUT LI, 8HSTING   , 8H        , 8H         /
      DATA NAIDC / 22 / 
      DATA AIDC / 8HAC      , 8HDC      , 8HDISTORTI, 8HEND     , 
     1            8HENDS    , 8HFOURIER , 8HMODEL   , 8HNOISE   , 
     2            8HOP      , 8HOPTIONS , 8HPLOT    , 8HPRINT   , 
     3            8HSUBCKT  , 8HSENSITIV, 8HTRANSIEN, 8HTF      , 
     4            8HTEMPERAT, 8HWIDTH   , 8HNODESET , 8HIC      , 
     5            8H:DEBUG: , 8HGRAPH   / 
* 
********************************************************************
C 
C  ELEMENT CARD IDENTIFIERS, KEYWORDS, AND INFORMATION
C 
      DATA AIDE / 1HR,1HC,1HL,1HK,1HG,1HE,1HF,1HH,1HV,1HI,1HD,1HQ,1HJ,
     1   1HM,1HS,1HY,1HT,0.0D0,1HX,0.0D0 /
      DATA ALSAC,ALSPU,ALSEX,ALSSI /2HAC,2HPU,2HEX,2HSI/
      DATA ALSOFF,ALSDC,ALSPW / 3HOFF,2HDC,3HPW  /
      DATA ALSZ0,ALSZO,ALSNL,ALSF,ALSTD / 2HZ0,2HZO,2HNL,1HF,2HTD / 
      DATA ALSL,ALSW,ALSAS,ALSAD,ALSPD,ALSPS,ALSRDS,ALSRSS,ALSXQC 
     1   /1HL,1HW,2HAS,2HAD,2HPD,2HPS,3HNRD,3HNRS,3HXQC/
      DATA ALSZX /2HZX/ 
      DATA ALSSF / 4HSF   / 
      DATA APOLY, AIC, AREA / 4HPOLY, 2HIC, 4HAREA /
      DATA ALSTC / 2HTC / 
      DATA NUMIC / 1, 2, 2, 3 / 
      DATA ABLNK, APER / 1H , 1H. / 
      DATA NNODS / 2,2,2,0,2,2,2,2,2,2,2,3,3,4,4,4,4,0,0,0 /
      DATA NTNODS / 2,2,2,0,2,2,2,2,2,2,3,6,5,6,4,4,4,0,0,0 / 
$PAGE 
C 
C  MODEL CARD KEYWORDS
C 
      DATA AIDM /1HD,3HNPN,3HPNP,3HNJF,3HPJF,4HNMOS,4HPMOS/ 
      DATA IPOLAR /0,1,-1,1,-1,1,-1/
      DATA MODID /1,2,2,3,3,4,4/
      DATA IPAR / 0, 14, 60, 72, 114/ 
      DATA AMPAR /
     1   6HIS    ,6HRS    ,6HN     ,6HTT    ,6HCJO   ,6HVJ    ,6HM     ,
     2   6HEG    ,6HXTI   ,6HKF    ,6HAF    ,6HFC    ,6HBV    ,6HIBV   ,
     1   6HIS    ,6HBF    ,6HNF    ,6HVAF   ,6HIKF   ,6HISE   ,6HNE    ,
     2   6HBR    ,6HNR    ,6HVAR   ,6HIKR   ,6HISC   ,6HNC    ,6H0     ,
     3   6H0     ,6HRB    ,6HIRB   ,6HRBM   ,6HRE    ,6HRC    ,6HCJE   ,
     4   6HVJE   ,6HMJE   ,6HTF    ,6HXTF   ,6HVTF   ,6HITF   ,6HPTF   ,
     5   6HCJC   ,6HVJC   ,6HMJC   ,6HXCJC  ,6HTR    ,6H0     ,6H0     ,
     6   6H0     ,6H0     ,6HCJS   ,6HVJS   ,6HMJS   ,6HXTB   ,6HEG    ,
     7   6HXTI   ,6HKF    ,6HAF    ,6HFC    , 
     1   6HVTO   ,6HBETA  ,6HLAMBDA,6HRD    ,6HRS    ,6HCGS   ,6HCGD   ,
     2   6HPB    ,6HIS    ,6HKF    ,6HAF    ,6HFC    ,
     1   6HLEVEL ,6HVTO   ,6HKP    ,6HGAMMA ,6HPHI   ,6HLAMBDA,6HRD    ,
     2   6HRS    ,6HCBD   ,6HCBS   ,6HIS    ,6HPB    ,6HCGSO  ,6HCGDO  ,
     3   6HCGBO  ,6HRSH   ,6HCJ    ,6HMJ    ,6HCJSW  ,6HMJSW  ,6HJS    ,
     4   6HTOX   ,6HNSUB  ,6HNSS   ,6HNFS   ,6HTPG   ,6HXJ    ,6HLD    ,
     5   6HUO    ,6HUCRIT ,6HUEXP  ,6HUTRA  ,6HVMAX  ,6HNEFF  ,6HXQC   ,
     6   6HKF    ,6HAF    ,6HFC    ,6HDELTA ,6HTHETA ,6HETA   ,6HKAPPA ,
     7   0.0D0   /
$PAGE 
C 
C  INITIALIZE VARIABLES 
C 
      CALL SECOND(T1) 
      CALL ZERO4(IDEBUG,20) 
      CALL GETLIN 
      IF (KEOF.NE.0) GO TO 6000 
      CALL COPY8(AFIELD,ATITLE,10)
      CALL GETM4(IELMNT,0)
      CALL GETM8(ITEMPS,1)
      VALUE(ITEMPS+1)=27.0D0
      ITEMNO=1
      NOPAGE=0
      CALL TITLE(-1,72,1,TITINP)
      IWIDTH=80 
      DO 5 I=1,8
      ACHAR=ABLNK 
      CALL MOVE(ACHAR,1,ATITLE(10),I,1) 
      IF (IXXOR(ACHAR,ABLNK).EQ.0) GO TO 8
    5 CONTINUE
      WRITE(6,6)
    6 FORMAT('0WARNING:  INPUT LINE-WIDTH SET TO 72 COLUMNS BECAUSE',/
     11X,'POSSIBLE SEQUENCING APPEARS IN COLS 73-80') 
      IWIDTH=72 
    8 DO 10 I=1,15
      AFIELD(I)=ABLNK 
   10 CONTINUE
      CALL COPY8(AFIELD,OLDLIN,15)
      CALL GETM4(ISBCKT,0)
      NSBCKT=0
      CALL GETM8(IUNSAT,0)
      NUNSAT=0
********************************************************************
* 
*     SET DEFAULT PRINT OUTPUT WIDTH TO 80 COLUMNS
*                 AND TURN ON ACCOUNTING
* 
      LWIDTH=80 
      IPRNTA=1
* 
********************************************************************
      IPRNTL=0
      IPRNTM=1
      IPRNTN=0
      IPRNTO=0
      GMIN=1.0D-12
      PIVTOL=1.0D-13
      PIVREL=1.0D-3 
      RELTOL=0.001D0
      ABSTOL=1.0D-12
      VNTOL=1.0D-6
      TRTOL=7.0D0 
      CHGTOL=1.0D-14
      DEFL=1.0D-4 
      DEFW=1.0D-4 
      DEFAD=0.0D0 
      DEFAS=0.0D0 
      NUMDGT=4
      NUMTEM=1
      ITL1=100
      ITL2=50 
      ITL3=4
      ITL4=10 
      ITL5=5000 
      LIMTIM=2
      LIMPTS=201
******************************************************************* 
* 
*     TURN OFF CODE GENERATION
* 
      LVLCOD=1
* 
******************************************************************* 
      LVLTIM=2
      METHOD=1
      XMU=0.5D0 
      MAXORD=2
      NOSOLV=0
      ICVFLG=0
      ITCELM(2)=0 
      IDIST=0 
      IDPRT=0 
      INOISE=0
      JACFLG=0
      JTRFLG=0
      CALL GETM4(IFOUR,0) 
      NFOUR=0 
      CALL GETM4(NSNOD,0) 
      CALL GETM8(NSVAL,0) 
      CALL GETM4(ICNOD,0) 
      CALL GETM8(ICVAL,0) 
      KINEL=0 
      KOVAR=0 
      KSSOP=0 
      NOSPRT=0
      NSENS=0 
      CALL GETM4(ISENS,0) 
      NUMNOD=0
      NCNODS=0
      NUNODS=0
      CALL ZERO4(LOCATE,50) 
      CALL ZERO4(JELCNT,50) 
      INSIZE=50 
      CALL GETM8(IFIELD,INSIZE) 
      CALL GETM4(ICODE,INSIZE)
      CALL GETM8(IDELIM,INSIZE) 
      CALL GETM4(ICOLUM,INSIZE) 
      GO TO 50
$PAGE 
C 
C  ERROR ENTRY
C 
   40 NOGO=1
C 
C  READ AND DECODE NEXT CARD IN INPUT DECK
C 
   50 IGOOF=0 
      CALL CARD 
********************************************************************
* 
      IF (KEOF.NE.0) THEN 
          NOGO = 1
          GO TO 5000
      ENDIF 
* 
********************************************************************
      IF (IGOOF.NE.0) GO TO 40
      IF (NODPLC(ICODE+1).EQ.0) GO TO 95
      ANAM=VALUE(IFIELD+1)
      CALL MOVE(ANAM,2,ABLNK,1,7) 
      IF (IXXOR(ANAM,APER).NE.0) GO TO 70 
      CALL MOVE(ANAM,1,VALUE(IFIELD+1),2,7) 
      CALL KEYSRC(AIDC,NAIDC,ANAM,ID) 
      IF (ID.LE.0) GO TO 90 
      IF (ID.EQ.4) GO TO 5000 
      IF (ID.EQ.5) GO TO 800
      IF (ID.EQ.7) GO TO 500
      IF (ID.EQ.13) GO TO 700 
      IF (NSBCKT.GE.1) GO TO 85 
      CALL RUNCON(ID) 
      IF (IGOOF.NE.0) GO TO 40
      GO TO 50
   70 ID=0
   80 ID=ID+1 
      IF (ID.GT.20) GO TO 90
      IF (IXXOR(ANAM,AIDE(ID)).EQ.0) GO TO 100  
      GO TO 80
   85 WRITE (6,86)
   86 FORMAT('0WARNING:  ABOVE LINE NOT ALLOWED WITHIN SUBCIRCUIT -- ', 
     1   'IGNORED'/)
      GO TO 50
   90 WRITE (6,91) VALUE(IFIELD+1)
   91 FORMAT('0*ERROR*:  UNKNOWN DATA CARD:  ',A8/) 
      GO TO 40
   95 WRITE (6,96)
   96 FORMAT('0*ERROR*:  UNRECOGNIZABLE DATA CARD'/)
      GO TO 40
$PAGE 
C 
C  ELEMENT AND DEVICE CARDS 
C 
  100 CALL FIND(VALUE(IFIELD+1),ID,LOC,1) 
      LOCV=NODPLC(LOC+1)
      IF (ID.EQ.4) GO TO 140
      IF (ID.EQ.19) GO TO 900 
      ISTOP=NNODS(ID)+1 
      DO 110 I=2,ISTOP
      IF (NODPLC(ICODE+I).NE.0) GO TO 410 
      IF (VALUE(IFIELD+I).LT.0.0D0) GO TO 400 
  110 NODPLC(LOC+I)=VALUE(IFIELD+I) 
      GO TO (120,130,130,140,150,150,180,180,200,200,300,300,300,300, 
     1   390,390,350,390,390,390), ID 
C 
C  RESISTOR 
C 
  120 IF (NODPLC(ICODE+4).NE.0) GO TO 420 
      IF (VALUE(IFIELD+4).EQ.0.0D0) GO TO 480 
      VALUE(LOCV+2)=VALUE(IFIELD+4) 
      IFLD=4
  122 IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 50,122,124
  124 ANAM=VALUE(IFIELD+IFLD) 
      IF (IXXOR(ANAM,ALSTC).NE.0) GO TO 460 
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 50,126,124
  126 VALUE(LOCV+3)=VALUE(IFIELD+IFLD)
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 50,128,124
  128 VALUE(LOCV+4)=VALUE(IFIELD+IFLD)
      GO TO 50
$PAGE 
C 
C  CAPACITOR OR INDUCTOR
C 
  130 IKNT=0
      LTAB=7
      IF (ID.EQ.3) LTAB=10
      IF (NODPLC(ICODE+4)) 420,131,132
  131 IF (VALUE(IFIELD+4).LE.0.0D0) GO TO 420 
      VALUE(LOCV+1)=VALUE(IFIELD+4) 
      NODPLC(LOC+4)=1 
      IFLD=5
      IF (NODPLC(ICODE+IFLD)) 50,420,139
  132 CALL GETM8(NODPLC(LOC+LTAB),0)
      ANAM=VALUE(IFIELD+4)
      IF (IXXOR(ANAM,APOLY).NE.0) GO TO 450 
      IFLD=4
  134 IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 50,136,138
  136 CALL EXTMEM(NODPLC(LOC+LTAB),1) 
      IKNT=IKNT+1 
      ISPOT=NODPLC(LOC+LTAB)+IKNT 
      VALUE(ISPOT)=VALUE(IFIELD+IFLD) 
      GO TO 134 
  138 IF (IKNT.EQ.0) GO TO 420
  139 ANAM=VALUE(IFIELD+IFLD) 
      IF (IXXOR(ANAM,AIC).NE.0) GO TO 460 
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 50 
      VALUE(LOCV+2)=VALUE(IFIELD+IFLD)
      GO TO 50
C 
C  MUTUAL INDUCTANCE
C 
  140 IF (NODPLC(ICODE+2).NE.1) GO TO 430 
      ANAM=VALUE(IFIELD+2)
      CALL MOVE(ANAM,2,ABLNK,1,7) 
      IF (IXXOR(ANAM,AIDE(3)).NE.0) GO TO 430 
      CALL EXTNAM(VALUE(IFIELD+2),NODPLC(LOC+2))
      IF (NODPLC(ICODE+3).NE.1) GO TO 430 
      ANAM=VALUE(IFIELD+3)
      CALL MOVE(ANAM,2,ABLNK,1,7) 
      IF (IXXOR(ANAM,AIDE(3)).NE.0) GO TO 430 
      CALL EXTNAM(VALUE(IFIELD+3),NODPLC(LOC+3))
      IF (NODPLC(ICODE+4).NE.0) GO TO 420 
      XK=VALUE(IFIELD+4)
      IF (XK.LE.0.0D0) GO TO 420
      IF (XK.LE.1.0D0) GO TO 145
      XK=1.0D0
      WRITE (6,141) 
  141 FORMAT('0WARNING:  COEFFICIENT OF COUPLING RESET TO 1.0D0'/)
  145 VALUE(LOCV+1)=XK
      GO TO 50
$PAGE 
C 
C  VOLTAGE CONTROLLED (NONLINEAR) SOURCES 
C 
  150 NDIM=1
      IFLD=3
      IF (NODPLC(ICODE+4)) 410,156,152
  152 ANAM=VALUE(IFIELD+4)
      IF (IXXOR(ANAM,APOLY).NE.0) GO TO 450 
      IF (NODPLC(ICODE+5).NE.0) GO TO 420 
      NDIM=VALUE(IFIELD+5)
      IF (NDIM.LE.0) GO TO 420
      IFLD=5
  156 NODPLC(LOC+4)=NDIM
      LTAB=ID+1 
      NSSNOD=2*NDIM 
      NMAT=4*NDIM 
      IF (ID.EQ.6) NMAT=4+2*NDIM
      CALL GETM4(NODPLC(LOC+LTAB),NSSNOD) 
      CALL GETM4(NODPLC(LOC+LTAB+1),NMAT) 
      CALL GETM8(NODPLC(LOC+LTAB+2),0)
      CALL GETM8(NODPLC(LOC+LTAB+3),NDIM) 
      CALL GETM4(NODPLC(LOC+LTAB+4),NDIM) 
      CALL GETM8(NODPLC(LOC+LTAB+5),NDIM) 
      ISPOT=NODPLC(LOC+LTAB+5)
      CALL ZERO8(VALUE(ISPOT+1),NDIM) 
      LNOD=NODPLC(LOC+LTAB) 
      DO 158 I=1,NSSNOD 
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 410
      IF (VALUE(IFIELD+IFLD).LT.0.0D0) GO TO 400
      NODPLC(LNOD+I)=VALUE(IFIELD+IFLD) 
  158 CONTINUE
  160 IKNT=0
  162 IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 164
      CALL EXTMEM(NODPLC(LOC+LTAB+2),1) 
      IKNT=IKNT+1 
      ISPOT=NODPLC(LOC+LTAB+2)+IKNT 
      VALUE(ISPOT)=VALUE(IFIELD+IFLD) 
      GO TO 162 
  164 IF (IKNT.EQ.0) GO TO 420
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 170
      ANAM=VALUE(IFIELD+IFLD) 
      IF (IXXOR(ANAM,AIC).NE.0) GO TO 460 
      DO 168 I=1,NDIM 
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 170,166,420 
  166 ISPOT=NODPLC(LOC+LTAB+5)+I
      VALUE(ISPOT)=VALUE(IFIELD+IFLD) 
  168 CONTINUE
  170 IF (NDIM.NE.1) GO TO 50 
      IF (IKNT.NE.1) GO TO 50 
      CALL EXTMEM(NODPLC(LOC+LTAB+2),1) 
      ISPOT=NODPLC(LOC+LTAB+2)
      VALUE(ISPOT+2)=VALUE(ISPOT+1) 
      VALUE(ISPOT+1)=0.0D0
      GO TO 50
C 
C  CURRENT CONTROLLED (NONLINEAR) SOURCES 
C 
  180 NDIM=1
      IFLD=3
      IF (NODPLC(ICODE+4).NE.1) GO TO 470 
      ANAM=VALUE(IFIELD+4)
      IF (IXXOR(ANAM,APOLY).NE.0) GO TO 182 
      IFLD=5
      IF (NODPLC(ICODE+5).NE.0) GO TO 420 
      NDIM=VALUE(IFIELD+5)
      IF (NDIM.LE.0) GO TO 420
  182 NODPLC(LOC+4)=NDIM
      LTAB=ID-1 
      NMAT=2*NDIM 
      IF (ID.EQ.8) NMAT=4+NDIM
      CALL GETM4(NODPLC(LOC+LTAB),NDIM) 
      CALL GETM4(NODPLC(LOC+LTAB+1),NMAT) 
      CALL GETM8(NODPLC(LOC+LTAB+2),0)
      CALL GETM8(NODPLC(LOC+LTAB+3),NDIM) 
      CALL GETM4(NODPLC(LOC+LTAB+4),NDIM) 
      CALL GETM8(NODPLC(LOC+LTAB+5),NDIM) 
      ISPOT=NODPLC(LOC+LTAB+5)
      CALL ZERO8(VALUE(ISPOT+1),NDIM) 
      DO 184 I=1,NDIM 
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 470
      ANAM=VALUE(IFIELD+IFLD) 
      CALL MOVE(ANAM,2,ABLNK,1,7) 
      IF (IXXOR(ANAM,AIDE(9)).NE.0) GO TO 470 
      CALL EXTNAM(VALUE(IFIELD+IFLD),LOCT)
      ISPOT=NODPLC(LOC+LTAB)+I
      NODPLC(ISPOT)=LOCT
  184 CONTINUE
      GO TO 160 
C 
C  INDEPENDENT SOURCES
C 
  200 IFLD=3
      CALL GETM8(NODPLC(LOC+5),0) 
  210 IFLD=IFLD+1 
  215 IF (NODPLC(ICODE+IFLD)) 50,220,230
  220 IF (IFLD.GT.4) GO TO 210
  225 VALUE(LOCV+1)=VALUE(IFIELD+IFLD)
      GO TO 210 
  230 ANAM=VALUE(IFIELD+IFLD) 
      IF (IXXOR(ANAM,ALSDC).NE.0) GO TO 235 
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 50,225,230
  235 IF (IXXOR(ANAM,ALSAC).NE.0) GO TO 260 
      VALUE(LOCV+2)=1.0D0 
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 50,240,230
  240 VALUE(LOCV+2)=VALUE(IFIELD+IFLD)
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 50,250,230
  250 VALUE(LOCV+3)=VALUE(IFIELD+IFLD)
      GO TO 210 
  260 ID=0
      CALL MOVE(ANAM,3,ABLNK,1,6) 
      IF (IXXOR(ANAM,ALSPU).EQ.0) ID=1  
      IF (IXXOR(ANAM,ALSSI).EQ.0) ID=2  
      IF (IXXOR(ANAM,ALSEX).EQ.0) ID=3
      IF (IXXOR(ANAM,ALSPW).EQ.0) ID=4
      IF (IXXOR(ANAM,ALSSF).EQ.0) ID=5
      IF (ID.EQ.0) GO TO 450
      NODPLC(LOC+4)=ID
      IKNT=0
  270 IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 280
      CALL EXTMEM(NODPLC(LOC+5),1)
      IKNT=IKNT+1 
      ISPOT=NODPLC(LOC+5)+IKNT
      VALUE(ISPOT)=VALUE(IFIELD+IFLD) 
      GO TO 270 
  280 AVAL=0.0D0
      IF (ID.NE.4) GO TO 285
C 
C...  FOR PWL SOURCE FUNCTION, FORCE EVEN NUMBER OF INPUT VALUES
C 
      IBIT=0
      IF (IKNT.NE.(IKNT/2)*2) IBIT=1
      AVAL=VALUE(ISPOT) 
      IF (IBIT.EQ.0) GO TO 290
      CALL EXTMEM(NODPLC(LOC+5),1)
      AVAL=VALUE(ISPOT-1) 
      IKNT=IKNT+1 
      ISPOT=NODPLC(LOC+5)+IKNT
      VALUE(ISPOT)=AVAL 
      GO TO 290 
  285 IF (IKNT.GE.7) GO TO 215
  290 CALL EXTMEM(NODPLC(LOC+5),2)
      ISPOT=NODPLC(LOC+5)+IKNT
      VALUE(ISPOT+1)=0.0D0
      VALUE(ISPOT+2)=AVAL 
      IKNT=IKNT+2 
      GO TO 285 
$PAGE 
C 
C  DEVICE CARDS 
C 
  300 VALUE(LOCV+1)=1.0D0 
      IF (ID.NE.14) GO TO 305 
      VALUE(LOCV+1)=0.0D0 
      VALUE(LOCV+11)=0.0D0
      VALUE(LOCV+12)=0.0D0
      VALUE(LOCV+13)=1.0D0
      VALUE(LOCV+14)=1.0D0
      VALUE(LOCV+15)=0.0D0
  305 LOCM=LOC+NTNODS(ID)+2 
      IFLD=NNODS(ID)+2
C 
C  TEMPORARILY (UNTIL MODCHK) PUT SUBSTRATE NODE INTO NODPLC(LOC+5) 
C 
      IF (ID.NE.12) GO TO 308 
      IF (NODPLC(ICODE+5).NE.0) GO TO 308 
      IFLD=6
      NODPLC(LOC+5)=VALUE(IFIELD+5) 
  308 CONTINUE
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 440
      CALL EXTNAM(VALUE(IFIELD+IFLD),NODPLC(LOCM))
  310 IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 50,325,315
  315 ANAM=VALUE(IFIELD+IFLD) 
      IF (IXXOR(ANAM,ALSOFF).NE.0) GO TO 320  
      NODPLC(LOCM+1)=1
      GO TO 310 
  320 IF (IXXOR(ANAM,AREA).NE.0) GO TO 330  
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 50,325,315
  325 IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 420
      IF (ID.EQ.14) GO TO 343 
      VALUE(LOCV+1)=VALUE(IFIELD+IFLD)
      GO TO 310 
  330 IF (IXXOR(ANAM,AIC).NE.0) GO TO 341 
      IKNT=0
      ICLOC=0 
      IF (ID.EQ.14) ICLOC=3 
      MAXKNT=NUMIC(ID-10) 
  335 IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 50,340,315
  340 IKNT=IKNT+1 
      IF (IKNT.GT.MAXKNT) GO TO 335 
      VALUE(LOCV+ICLOC+IKNT+1)=VALUE(IFIELD+IFLD) 
      GO TO 335 
$PAGE 
  341 IF (ID.NE.14) GO TO 460 
      ISPOT=0 
      IF (IXXOR(ANAM,ALSL).EQ.0) ISPOT=1
      IF (IXXOR(ANAM,ALSW).EQ.0) ISPOT=2
      IF (IXXOR(ANAM,ALSAD).EQ.0) ISPOT=3 
      IF (IXXOR(ANAM,ALSZX).EQ.0) ISPOT=3 
      IF (IXXOR(ANAM,ALSAS).EQ.0) ISPOT=4 
      IF (IXXOR(ANAM,ALSPD).EQ.0) ISPOT=11
      IF (IXXOR(ANAM,ALSPS).EQ.0) ISPOT=12
      IF (IXXOR(ANAM,ALSRDS).EQ.0) ISPOT=13 
      IF (IXXOR(ANAM,ALSRSS).EQ.0) ISPOT=14 
      IF (IXXOR(ANAM,ALSXQC).EQ.0) ISPOT=15 
      IF (ISPOT.EQ.0) GO TO 460 
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 50,342,315
  342 IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 420
      VALUE(LOCV+ISPOT)=VALUE(IFIELD+IFLD)
      GO TO 310 
  343 IKNT=0
  344 IKNT=IKNT+1 
      IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 420
      IF (IKNT.GT.15) GO TO 490 
      IF (IKNT.EQ.5) IKNT=11
      VALUE(LOCV+IKNT)=VALUE(IFIELD+IFLD) 
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 345,344,345 
  345 IF (NODPLC(ICODE+IFLD)) 50,50,315 
$PAGE 
C 
C  TRANSMISSION LINES 
C 
  350 IFLD=5
      XNL=0.25D0
      TFREQ=0.0D0 
  355 IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 378,355,360 
  360 ANAM=VALUE(IFIELD+IFLD) 
      IF (IXXOR(ANAM,AIC).EQ.0) GO TO 364 
      IF (IXXOR(ANAM,ALSNL).EQ.0) GO TO 370 
      IF (IXXOR(ANAM,ALSF).EQ.0) GO TO 374  
      ID=0
      IF (IXXOR(ANAM,ALSZ0).EQ.0) ID=1  
      IF (IXXOR(ANAM,ALSZO).EQ.0) ID=1  
      IF (IXXOR(ANAM,ALSTD).EQ.0) ID=2  
      IF (ID.EQ.0) GO TO 460
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 378,362,360 
  362 IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 420
      VALUE(LOCV+ID)=VALUE(IFIELD+IFLD) 
      GO TO 355 
  364 IKNT=0
  366 IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 378,368,360 
  368 IKNT=IKNT+1 
      IF (IKNT.GT.4) GO TO 366
      VALUE(LOCV+IKNT+4)=VALUE(IFIELD+IFLD) 
      GO TO 366 
  370 IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 378,372,360 
  372 IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 420
      XNL=VALUE(IFIELD+IFLD)
      GO TO 355 
  374 IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 378,376,360 
  376 IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 420
      TFREQ=VALUE(IFIELD+IFLD)
      GO TO 355 
  378 IF (VALUE(LOCV+1).NE.0.0D0) GO TO 380 
      WRITE (6,379) 
  379 FORMAT('0*ERROR*:  Z0 MUST BE SPECIFIED'/)
      GO TO 40
  380 IF (VALUE(LOCV+2).NE.0.0D0) GO TO 50
      IF (TFREQ.NE.0.0D0) GO TO 382 
      WRITE (6,381) 
  381 FORMAT('0*ERROR*:  EITHER TD OR F MUST BE SPECIFIED'/)
      GO TO 40
  382 VALUE(LOCV+2)=XNL/TFREQ 
      GO TO 50
$PAGE 
C 
C  ELEMENTS NOT YET IMPLEMENTED 
C 
  390 WRITE (6,391) 
  391 FORMAT('0*ERROR*:  ELEMENT TYPE NOT YET IMPLEMENTED'/)
      GO TO 40
C 
C  ELEMENT CARD ERRORS
C 
  400 WRITE (6,401) 
  401 FORMAT('0*ERROR*:  NEGATIVE NODE NUMBER FOUND'/)
      GO TO 40
  410 WRITE (6,411) 
  411 FORMAT('0*ERROR*:  NODE NUMBERS ARE MISSING'/)
      GO TO 40
  420 WRITE (6,421) 
  421 FORMAT('0*ERROR*:  VALUE IS MISSING OR IS NONPOSITIVE'/)
      GO TO 40
  430 WRITE (6,431) 
  431 FORMAT('0*ERROR*:  MUTUAL INDUCTANCE REFERENCES ARE MISSING'/)
      GO TO 40
  440 WRITE (6,441) 
  441 FORMAT('0*ERROR*:  MODEL NAME IS MISSING'/) 
      GO TO 40
  450 WRITE (6,451) ANAM
  451 FORMAT('0*ERROR*:  UNKNOWN SOURCE FUNCTION:  ',A8)
      GO TO 40
  460 WRITE (6,461) ANAM
  461 FORMAT('0*ERROR*:  UNKNOWN PARAMETER:  ',A8/) 
      GO TO 40
  470 WRITE (6,471) 
  471 FORMAT('0*ERROR*:  VOLTAGE SOURCE NOT FOUND ON ABOVE LINE'/)
      GO TO 40
  480 WRITE (6,481) 
  481 FORMAT('0*ERROR*:  VALUE IS ZERO'/) 
      GO TO 40
  490 WRITE(6,491)
  491 FORMAT('0*ERROR*:  EXTRA NUMERICAL DATA ON MOSFET CARD'/) 
      GO TO 40
$PAGE 
C 
C  MODEL CARD 
C 
  500 IF (NODPLC(ICODE+2).NE.1) GO TO 650 
      IF (NODPLC(ICODE+3).NE.1) GO TO 650 
      ID=0
  510 ID=ID+1 
      IF (ID.GT.7) GO TO 660
      IF (IXXOR(VALUE(IFIELD+3),AIDM(ID)).NE.0) GO TO 510 
      IPOL=IPOLAR(ID) 
      JTYPE=MODID(ID) 
      ID=JTYPE+20 
      CALL FIND(VALUE(IFIELD+2),ID,LOC,1) 
      NODPLC(LOC+2)=IPOL
      LOCV=NODPLC(LOC+1)
  520 LOCM=IPAR(JTYPE)
      NOPAR=IPAR(JTYPE+1)-LOCM
      IFLD=3
  530 IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 50,530,560
  560 ANAM=VALUE(IFIELD+IFLD) 
      IF (JTYPE.EQ.2) ANAM=ALIAS(ANAM)  
      IKNT=0
  570 IKNT=IKNT+1 
      IF (IKNT.GT.NOPAR) GO TO 670
      IF (IXXOR(ANAM,AMPAR(LOCM+IKNT)).NE.0) GO TO 570  
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 50,580,560
  580 VALUE(LOCV+IKNT)=VALUE(IFIELD+IFLD) 
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 50,590,560
  590 IKNT=IKNT+1 
      IF (IKNT.GT.NOPAR) GO TO 530
      IF (IXXOR(ABLNK,AMPAR(LOCM+IKNT)).NE.0) GO TO 530 
      GO TO 580 
C 
C  MODEL CARD ERRORS
C 
  650 WRITE (6,651) 
  651 FORMAT('0*ERROR*:  MODEL TYPE IS MISSING'/) 
      GO TO 40
  660 WRITE (6,661) VALUE(IFIELD+3) 
  661 FORMAT('0*ERROR*:  UNKNOWN MODEL TYPE:  ',A8/)
      GO TO 40
  670 WRITE (6,671) ANAM
  671 FORMAT('0*ERROR*:  UNKNOWN MODEL PARAMETER:  ',A8,/)
      NOGO=1
      GO TO 530 
$PAGE 
C 
C  SUBCIRCUIT DEFINITION
C 
  700 IF (NODPLC(ICODE+2).NE.1) GO TO 780 
      CALL FIND(VALUE(IFIELD+2),20,LOC,1) 
      CALL EXTMEM(ISBCKT,1) 
      NSBCKT=NSBCKT+1 
      NODPLC(ISBCKT+NSBCKT)=LOC 
      IFLD=2
      IF (NODPLC(ICODE+3).NE.0) GO TO 790 
      CALL GETM4(NODPLC(LOC+2),0) 
      IKNT=0
  710 IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 50,720,710
  720 CALL EXTMEM(NODPLC(LOC+2),1)
      IKNT=IKNT+1 
      ISPOT=NODPLC(LOC+2)+IKNT
      IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 770
      NODPLC(ISPOT)=VALUE(IFIELD+IFLD)
      NODE=NODPLC(ISPOT)
      I=IKNT-1
  730 IF (I.EQ.0) GO TO 710 
      ISPOT=ISPOT-1 
      IF (NODPLC(ISPOT).EQ.NODE) GO TO 760
      I=I-1 
      GO TO 730 
  760 WRITE (6,761) NODE
  761 FORMAT('0*ERROR*:  SUBCIRCUIT DEFINITION DUPLICATES NODE ',I5,/)
      GO TO 40
  770 WRITE (6,771) 
  771 FORMAT('0*ERROR*:  NONPOSITIVE NODE NUMBER FOUND IN SUBCIRCUIT ', 
     1   'DEFINITION'/) 
      GO TO 40
  780 WRITE (6,781) 
  781 FORMAT('0*ERROR*:  SUBCIRCUIT NAME MISSING'/) 
      GO TO 40
  790 WRITE (6,791) 
  791 FORMAT('0*ERROR*:  SUBCIRCUIT NODES MISSING'/)
      GO TO 40
$PAGE 
C 
C  .ENDS PROCESSING 
C 
  800 IF (NSBCKT.EQ.0) GO TO 890
      IKNT=1
      IF (NODPLC(ICODE+2).LE.0) GO TO 820 
      ANAM=VALUE(IFIELD+2)
      IKNT=NSBCKT 
  810 LOC=NODPLC(ISBCKT+IKNT) 
      LOCV=NODPLC(LOC+1)
      ANAMS=VALUE(LOCV) 
      IF (IXXOR(ANAM,ANAMS).EQ.0) GO TO 820 
      IKNT=IKNT-1 
      IF (IKNT.NE.0) GO TO 810
      GO TO 880 
  820 IREL=NSBCKT-IKNT+1
      CALL RELMEM(ISBCKT,IREL)
      NSBCKT=NSBCKT-IREL
      GO TO 50
  880 WRITE (6,881) ANAM
  881 FORMAT('0*ERROR*:  UNKNOWN SUBCIRCUIT NAME:  ',A8/) 
      GO TO 40
  890 WRITE (6,891) 
  891 FORMAT('0WARNING:  NO SUBCIRCUIT DEFINITION KNOWN -- LINE IGNORED'
     1/)
      GO TO 50
C 
C  SUBCIRCUIT CALL
C 
  900 CALL GETM4(NODPLC(LOC+2),0) 
      IFLD=1
      IKNT=0
  910 IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 920
      CALL EXTMEM(NODPLC(LOC+2),1)
      IKNT=IKNT+1 
      ISPOT=NODPLC(LOC+2)+IKNT
      IF (VALUE(IFIELD+IFLD).LT.0.0D0) GO TO 400
      NODPLC(ISPOT)=VALUE(IFIELD+IFLD)
      GO TO 910 
  920 IF (IKNT.EQ.0) GO TO 410
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 990
      CALL EXTNAM(VALUE(IFIELD+IFLD),NODPLC(LOC+3)) 
      GO TO 50
  990 WRITE (6,991) 
  991 FORMAT('0*ERROR*:  SUBCIRCUIT NAME MISSING'/) 
      GO TO 40
$PAGE 
C 
C  END
C 
 5000 IF (NSBCKT.EQ.0) GO TO 5010 
      NSBCKT=0
      WRITE (6,5001)
 5001 FORMAT('0*ERROR*:  .ENDS  CARD MISSING'/) 
      NOGO=1
5010  CALL CLRMEM(IFIELD) 
      CALL CLRMEM(ICODE)
      CALL CLRMEM(IDELIM) 
      CALL CLRMEM(ICOLUM) 
      CALL CLRMEM(ISBCKT) 
      IF (NFOUR.EQ.0) CALL CLRMEM(IFOUR)
      IF (NSENS.EQ.0) CALL CLRMEM(ISENS)
 6000 CALL SECOND(T2) 
      RSTATS(1)=T2-T1 
      RETURN
      END 
$EMA /BLANK/                            
      SUBROUTINE RUNCON( ID ) 
     + ,92091-16002 REV.5000 <890418.1140>  
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE PROCESSES RUN CONTROL CARDS. 
C 
      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 
      COMMON /CJE/ MAXTIM,ITIME,ICOST 
      COMMON /MISCEL/ ATIME,APROG(3),ADATE,ATITLE(10),DEFL,DEFW,DEFAD,
     1  DEFAS,RSTATS(50),IWIDTH,LWIDTH,NOPAGE 
      COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 
     1   NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS
      COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET,
     1   XMU,MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO,
     2   ITEMNO,NOSOLV,MODAC,IPIV,IVMFLG,IPOSTP,ISCRCH,IOFILE 
      COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS,
     1   LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF 
      COMMON /KNSTNT/ TWOPI,XLOG2,XLOG10,ROOT2,RAD,BOLTZ,CHARGE,CTOK, 
     1   GMIN,RELTOL,ABSTOL,VNTOL,TRTOL,CHGTOL,EPS0,EPSSIL,EPSOX, 
     2   PIVTOL,PIVREL
      COMMON /DC/ TCSTAR(2),TCSTOP(2),TCINCR(2),ICVFLG,ITCELM(2),KSSOP, 
     1   KINEL,KIDIN,KOVAR,KIDOUT 
      COMMON /AC/ FSTART,FSTOP,FINCR,SKW2,REFPRL,SPW2,JACFLG,IDFREQ,
     1   INOISE,NOSPRT,NOSOUT,NOSIN,IDIST,IDPRT 
      COMMON /TRAN/ TSTEP,TSTOP,TSTART,DELMAX,TDMAX,FORFRE,JTRFLG 
      COMMON /OUTINF/ XINCR,STRING(15),XSTART,YVAR(8),ITAB(8),ITYPE(8), 
     1   ILOGY(8),NPOINT,NUMOUT,KNTR,NUMDGT 
      COMMON/DEBUG/ IDEBUG(20)
      COMMON /BLANK/ VALUE(64)
      INTEGER NODPLC(64)
      COMPLEX CVALUE(32)
      EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1))
      DIMENSION IPRNT(5),LIMITS(4),ITRLIM(5),CONTOL(6),DFLTS(4) 
      EQUIVALENCE (IPRNT(1),IPRNTA),(LIMITS(1),LIMTIM),(ITRLIM(1),ITL1),
     1   (CONTOL(1),GMIN),(DFLTS(1),DEFL) 
      INTEGER IXXOR 
$PAGE 
C 
C  PRINT/PLOT KEYWORDS
C 
      DIMENSION AOPT(5) 
      DIMENSION AOPTS(33),LSETOP(5) 
      DIMENSION AIDE(20)
      DATA AOPT / 2HDC, 2HTR, 2HAC, 2HNO, 2HDI /
C 
C  OPTIONS CARD KEYWORDS
C 
      DATA AOPTS / 6HACCT  , 6HLIST  , 6HNOMOD , 6HNODE  , 6HOPTS  ,
     1             6HITL1  , 6HITL2  , 6HITL3  , 6HITL4  , 6HITL5  ,
     2             6HLIMTIM, 6HLIMPTS, 6HLVLCOD, 6HLVLTIM, 6HGMIN  ,
     3             6HRELTOL, 6HABSTOL, 6HVNTOL , 6HTRTOL , 6HCHGTOL,
     4             6HTNOM  , 6HNUMDGT, 6HMAXORD, 6HMETHOD, 6HNOPAGE,
     5             6HMU    , 6HCPTIME, 6HDEFL  , 6HDEFW  , 6HDEFAD ,
     6             6HDEFAS , 6HPIVTOL, 6HPIVREL / 
      DATA LSETOP / 1 ,1, 0, 1, 1 / 
C 
      DATA AIDE / 1HR,1HC,1HL,1HK,1HG,1HE,1HF,1HH,1HV,1HI,1HD,1HQ,1HJ,
     1   1HM,1HS,1HY,1HT,0.0D0,1HX,0.0D0 /
      DATA ALSDE,ALSOC,ALSLI / 3HDEC, 3HOCT, 3HLIN /
      DATA ATRAP, AGEAR, AUIC / 4HTRAP, 4HGEAR, 3HUIC / 
      DATA ABLNK, AIN, AOUT / 1H , 2HIN, 3HOUT /
      DATA AMISS / 8H*MISSING / 
      DATA AMS / 2HMS / 
      DATA MINPTS / 1 / 
********************************************************************
* 
*     ADD ID = 22 FOR .GRAPH CARD 
* 
      GO TO (1200,1100,1650,6000,6000,1700,6000,1600,1550,2000,3600,
     1   3500,6000,1750,1300,1500,1800,4000,4100,4200,5900,3400), ID
* 
********************************************************************
$PAGE 
C 
C  DC TRANSFER CURVES 
C 
 1100 IFLD=2
      ICVFLG=0
      INUM=1
 1105 ANAM=VALUE(IFIELD+IFLD) 
      IF (INUM.GT.2) GO TO 6000 
      ID=0
      CALL MOVE(ANAM,2,ABLNK,1,7) 
      IF (IXXOR(ANAM,AIDE(9)).EQ.0) ID=9
      IF (IXXOR(ANAM,AIDE(10)).EQ.0) ID=10
      IF (ID.EQ.0) GO TO 1130 
      CALL FIND(VALUE(IFIELD+IFLD),ID,ITCELM(INUM),0) 
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1130 
      TCSTAR(INUM)=VALUE(IFIELD+IFLD) 
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1130 
      TCSTOP(INUM)=VALUE(IFIELD+IFLD) 
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1130 
      TCINCR(INUM)=VALUE(IFIELD+IFLD) 
      IF (TCINCR(INUM).EQ.0.0D0) GO TO 1130 
      TEMP=(TCSTOP(INUM)-TCSTAR(INUM))/TCINCR(INUM) 
      IF (TEMP.GT.0.0D0) GO TO 1110 
      TCINCR(INUM)=-TCINCR(INUM)
      TEMP=-TEMP
 1110 ITEMP=IDINT(TEMP+0.5D0)+1 
      ITEMP=MAX0(ITEMP,MINPTS)
      IF (INUM.EQ.1) ICVFLG=ITEMP 
      IF (INUM.EQ.2) ICVFLG=ITEMP*ICVFLG  
      IFLD=IFLD+1 
      INUM=2
      IF (NODPLC(ICODE+IFLD)) 6000,1130,1105
 1130 WRITE (6,1131)
      ICVFLG=0
 1131 FORMAT('0WARNING:  MISSING PARAMETER(S) ... ANALYSIS OMITTED'/) 
      GO TO 6000
$PAGE 
C 
C  FREQUENCY SPECIFICATION
C 
 1200 IFLD=2
      IF (NODPLC(ICODE+2)) 1250,1250,1210 
 1210 ID=0
      IF (IXXOR(VALUE(IFIELD+IFLD),ALSDE).EQ.0) ID=1
      IF (IXXOR(VALUE(IFIELD+IFLD),ALSOC).EQ.0) ID=2
      IF (IXXOR(VALUE(IFIELD+IFLD),ALSLI).EQ.0) ID=3
      IF (ID.EQ.0) GO TO 1240 
      IDFREQ=ID 
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1250 
      IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 1250 
      FINCR=VALUE(IFIELD+IFLD)
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1250 
      IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 1250 
      FSTART=VALUE(IFIELD+IFLD) 
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1250 
      IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 1250 
      FSTOP=VALUE(IFIELD+IFLD)
      IF (FSTART.GT.FSTOP) GO TO 1260 
      JACFLG=FINCR
      IF (IDFREQ-2) 1215,1220,1235
 1215 FINCR=DEXP(XLOG10/FINCR)
      GO TO 1230
 1220 FINCR=DEXP(XLOG2/FINCR) 
 1230 TEMP=DLOG(FSTOP/FSTART)/DLOG(FINCR) 
      JACFLG=IDINT(TEMP+0.999D0)+1
 1235 JACFLG=MAX0(JACFLG,MINPTS)
      IF (IDFREQ.NE.3) GO TO 6000 
      FINCR=(FSTOP-FSTART)/DFLOAT(MAX0(JACFLG-1,1)) 
      GO TO 6000
 1240 WRITE (6,1241) VALUE(IFIELD+IFLD) 
 1241 FORMAT('0WARNING:  UNKNOWN FREQUENCY FUNCTION:  ',A8,' ... ANALYS'
     1   ,'IS OMITTED'/)
      GO TO 6000
 1250 WRITE (6,1251)
 1251 FORMAT('0WARNING:  FREQUENCY PARAMETERS INCORRECT ... ANALYSIS OM'
     1   ,'ITTED'/) 
      GO TO 6000
 1260 WRITE (6,1261)
 1261 FORMAT('0WARNING:  START FREQ > STOP FREQ ... ANALYSIS OMITTED'/) 
      GO TO 6000
$PAGE 
C 
C  TIME SPECIFICATION 
C 
 1300 IFLD=2
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1430 
      IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 1430 
      TSTEP=VALUE(IFIELD+IFLD)
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1430 
      IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 1430 
      TSTOP=VALUE(IFIELD+IFLD)
      TSTART=0.0D0
      DELMAX=TSTOP/50.0D0 
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1310 
      IF (VALUE(IFIELD+IFLD).LT.0.0D0) GO TO 1430 
      TSTART=VALUE(IFIELD+IFLD) 
      DELMAX=(TSTOP-TSTART)/50.0D0
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1310 
      IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 1430 
      DELMAX=VALUE(IFIELD+IFLD) 
      IFLD=IFLD+1 
 1310 IF (NODPLC(ICODE+IFLD).NE.1) GO TO 1320 
      IF (IXXOR(VALUE(IFIELD+IFLD),AUIC).NE.0) GO TO 1320 
      NOSOLV=1
 1320 IF (TSTART.GT.TSTOP) GO TO 1440 
      IF (TSTEP.GT.TSTOP) GO TO 1430
      JTRFLG=IDINT((TSTOP-TSTART)/TSTEP+0.5D0)+1
      JTRFLG=MAX0(JTRFLG,MINPTS)
      GO TO 6000
 1430 WRITE (6,1431)
 1431 FORMAT('0WARNING:  TIME PARAMETERS INCORRECT ... ANALYSIS OMITTED'
     1   /) 
      GO TO 6000
 1440 WRITE (6,1441)
 1441 FORMAT('0WARNING:  START TIME > STOP TIME ... ANALYSIS OMITTED'/) 
      GO TO 6000
$PAGE 
C 
C  TRANSFER FUNCTION
C 
 1500 KSSOP=1 
      IFLD=2
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 1530 
      CALL OUTDEF(IFLD,1,KOVAR,KTYPE) 
      IF (IGOOF.NE.0) GO TO 1530
      IF (KTYPE.NE.1) GO TO 1540
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 1530 
      ANAM=VALUE(IFIELD+IFLD) 
      CALL MOVE(ANAM,2,ABLNK,1,7) 
      ID=0
      IF (IXXOR(ANAM,AIDE(9)).EQ.0) ID=9  
      IF (IXXOR(ANAM,AIDE(10)).EQ.0) ID=10  
      IF (ID.EQ.0) GO TO 1530 
      CALL FIND(VALUE(IFIELD+IFLD),ID,KINEL,0)
      KIDIN=ID
      GO TO 6000
 1530 KOVAR=0 
      KINEL=0 
      WRITE (6,1131)
      IGOOF=0 
      GO TO 6000
 1540 KOVAR=0 
      KINEL=0 
      WRITE (6,1541)
 1541 FORMAT('0WARNING:  ILLEGAL OUTPUT VARIABLE ... ANALYSIS OMITTED'/)
      IGOOF=0 
      GO TO 6000
C 
C  OPERATING POINT
C 
 1550 KSSOP=1 
      GO TO 6000
$PAGE 
C 
C  NOISE ANALYSIS 
C 
 1600 IFLD=2
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 1610 
      CALL OUTDEF(IFLD,2,NOSOUT,NTYPE)
      IF (IGOOF.NE.0) GO TO 1610
      IF (NTYPE.NE.1) GO TO 1610
      IF (NODPLC(NOSOUT+5).NE.0) GO TO 1610 
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 1620 
      ANAM=VALUE(IFIELD+IFLD) 
      CALL MOVE(ANAM,2,ABLNK,1,7) 
      ID=0
      IF (IXXOR(ANAM,AIDE(9)).EQ.0) ID=9  
      IF (IXXOR(ANAM,AIDE(10)).EQ.0) ID=10  
      IF (ID.EQ.0) GO TO 1620 
      CALL FIND(VALUE(IFIELD+IFLD),ID,NOSIN,0)
      NOSPRT=0
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1605 
      NOSPRT=DMAX1(0.0D0,VALUE(IFIELD+IFLD))
 1605 INOISE=1
      GO TO 6000
 1610 WRITE (6,1611)
 1611 FORMAT('0WARNING:  VOLTAGE OUTPUT UNRECOGNIZABLE ... ANALYSIS OMIT
     1TED'/)
      IGOOF=0 
      GO TO 6000
 1620 WRITE (6,1621)
 1621 FORMAT('0WARNING:  INVALID INPUT SOURCE ... ANALYSIS OMITTED'/) 
      IGOOF=0 
      GO TO 6000
$PAGE 
C 
C  DISTORTION ANALYSIS
C 
 1650 IFLD=2
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 1660 
      ANAM=VALUE(IFIELD+IFLD) 
      CALL MOVE(ANAM,2,ABLNK,1,7) 
      IF (IXXOR(ANAM,AIDE(1)).NE.0) GO TO 1660
      CALL FIND(VALUE(IFIELD+IFLD),1,IDIST,0) 
      IDPRT=0 
      SKW2=0.9D0
      REFPRL=1.0D-3 
      SPW2=1.0D0
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 6000 
      IDPRT=VALUE(IFIELD+IFLD)
      IDPRT=MAX0(IDPRT,0) 
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 6000 
      IF (VALUE(IFIELD+IFLD).LE.0.001D0) GO TO 1670 
      IF (VALUE(IFIELD+IFLD).GT.0.999D0) GO TO 1670 
      SKW2=VALUE(IFIELD+IFLD) 
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 6000 
      IF (VALUE(IFIELD+IFLD).LT.1.0D-10) GO TO 1670 
      REFPRL=VALUE(IFIELD+IFLD) 
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 6000 
      IF (VALUE(IFIELD+IFLD).LT.0.001D0) GO TO 1670 
      SPW2=VALUE(IFIELD+IFLD) 
      GO TO 6000
 1660 WRITE (6,1661)
 1661 FORMAT('0WARNING:  DISTORTION LOAD RESISTOR MISSING ... ANALYSIS '
     1   ,'OMITTED'/) 
      GO TO 6000
 1670 IDIST=0 
      WRITE (6,1671)
 1671 FORMAT('0WARNING:  DISTORTION PARAMETERS INCORRECT ... ANALYSIS O'
     1   ,'MITTED'/)
      GO TO 6000
$PAGE 
C 
C  FOURIER ANALYSIS 
C 
 1700 IFLD=2
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1720 
      IF (VALUE(IFIELD+IFLD).LE.0.0D0) GO TO 1720 
      FORFRE=VALUE(IFIELD+IFLD) 
 1705 IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 1710 
      CALL OUTDEF(IFLD,2,LOCT,LTYPE)
      IF (IGOOF.NE.0) GO TO 1720
      IF (LTYPE.NE.1) GO TO 1720
      CALL EXTMEM(IFOUR,1)
      NFOUR=NFOUR+1 
      NODPLC(IFOUR+NFOUR)=LOCT
      GO TO 1705
 1710 IF (NFOUR.GE.1) GO TO 6000
 1720 WRITE (6,1721)
 1721 FORMAT('0WARNING:  FOURIER PARAMETERS INCORRECT ... ANALYSIS OMIT'
     1   ,'TED'/) 
      IGOOF=0 
      NFOUR=0 
      CALL CLRMEM(IFOUR)
      CALL GETM4(IFOUR,0) 
      GO TO 6000
C 
C  SENSITIVITY ANALYSIS 
C 
 1750 KSSOP=1 
      IFLD=1
 1760 IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 6000 
      CALL OUTDEF(IFLD,1,LOCT,LTYPE)
      IF (IGOOF.NE.0) GO TO 1780
      IF (LTYPE.NE.1) GO TO 1780
      CALL EXTMEM(ISENS,1)
      NSENS=NSENS+1 
      NODPLC(ISENS+NSENS)=LOCT
      GO TO 1760
 1780 WRITE (6,1781)
 1781 FORMAT('0WARNING:  OUTPUT VARIABLE UNRECOGNIZABLE ... ANALYSIS OM'
     1   ,'MITTED'/)
      IGOOF=0 
      NSENS=0 
      CALL CLRMEM(ISENS)
      CALL GETM4(ISENS,0) 
      GO TO 6000
$PAGE 
C 
C  TEMPERATURE VARIATION
C 
 1800 IFLD=1
 1810 IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 6000 
      IF (VALUE(IFIELD+IFLD).LE.-223.0D0) GO TO 1810
      CALL EXTMEM(ITEMPS,1) 
      NUMTEM=NUMTEM+1 
      VALUE(ITEMPS+NUMTEM)=VALUE(IFIELD+IFLD) 
      GO TO 1810
$PAGE 
C 
C  OPTIONS CARD 
C 
 2000 IFLD=1
 2010 IFLD=IFLD+1 
 2020 IF (NODPLC(ICODE+IFLD)) 6000,2010,2030
 2030 ANAM=VALUE(IFIELD+IFLD) 
      DO 2040 I=1,5 
      IF (IXXOR(ANAM,AOPTS(I)).NE.0) GO TO 2040 
      IPRNT(I)=LSETOP(I)
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.0) GO TO 2020 
      IPRNT(I)=VALUE(IFIELD+IFLD) 
      GO TO 2010
 2040 CONTINUE
      IF (IXXOR(ANAM,AOPTS(24)).EQ.0) GO TO 2110  
      IF (IXXOR(ANAM,AOPTS(25)).EQ.0) GO TO 2120  
      IF (IXXOR(ANAM,AOPTS(26)).EQ.0) GO TO 2130  
      IF (IXXOR(ANAM,AOPTS(27)).EQ.0) GO TO 2150  
      IF (IXXOR(ANAM,AOPTS(32)).EQ.0) GO TO 2200  
      IF (IXXOR(ANAM,AOPTS(33)).EQ.0) GO TO 2250  
      IF (NODPLC(ICODE+IFLD+1).NE.0) GO TO 2510 
      IFLD=IFLD+1 
      AVAL=VALUE(IFIELD+IFLD) 
      DO 2050 I=6,10
      IF (IXXOR(ANAM,AOPTS(I)).NE.0) GO TO 2050 
      IF (AVAL.LE.0.0D0.AND.I.NE.10) GO TO 2510 
      ITRLIM(I-5)=AVAL
      GO TO 2010
 2050 CONTINUE
      IF (AVAL.LE.0.0D0) GO TO 2510 
      DO 2060 I=11,14 
      IF (IXXOR(ANAM,AOPTS(I)).NE.0) GO TO 2060 
      LIMITS(I-10)=AVAL 
      GO TO 2010
 2060 CONTINUE
      DO 2070 I=15,20 
      IF (IXXOR(ANAM,AOPTS(I)).NE.0) GO TO 2070 
      CONTOL(I-14)=AVAL 
      GO TO 2010
 2070 CONTINUE
      DO 2075 I=28,31 
      IF (IXXOR(ANAM,AOPTS(I)).NE.0) GO TO 2075 
      DFLTS(I-27)=AVAL
      GO TO 2010
 2075 CONTINUE
      IF (IXXOR(ANAM,AOPTS(21)).NE.0) GO TO 2080
      IF (AVAL.LT.-223.0D0) GO TO 2510
      VALUE(ITEMPS+1)=AVAL
      GO TO 2010
 2080 IF (IXXOR(ANAM,AOPTS(22)).NE.0) GO TO 2100  
      NDIGIT=AVAL 
      IF (NDIGIT.LE.7) GO TO 2090 
      NDIGIT=7
$PAGE 
      WRITE (6,2081) NDIGIT 
 2081 FORMAT('0WARNING:  NUMDGT MAY NOT EXCEED',I2, 
     1 ';  MAXIMUM VALUE ASSUMED'/) 
 2090 NUMDGT=NDIGIT 
      GO TO 2010
 2100 IF (IXXOR(ANAM,AOPTS(23)).NE.0) GO TO 2500  
      N=AVAL
      IF ((N.LE.1).OR.(N.GE.7)) GO TO 2510
      MAXORD=N
      GO TO 2010
 2110 IF (NODPLC(ICODE+IFLD+1).NE.1) GO TO 2510 
      IFLD=IFLD+1 
      ANAM=VALUE(IFIELD+IFLD) 
      CALL MOVE(ANAM,5,ABLNK,1,4) 
      JTYPE=0 
      IF (IXXOR(ANAM,ATRAP).EQ.0) JTYPE=1 
      IF (IXXOR(ANAM,AGEAR).EQ.0) JTYPE=2 
      IF (JTYPE.EQ.0) GO TO 2510
      METHOD=JTYPE
      GO TO 2010
 2120 NOPAGE=1
      GO TO 2010
 2130 IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 6000,2140,2010  
 2140 AVAL=VALUE(IFIELD+IFLD) 
      IF (AVAL.LT.0.0D0.OR.AVAL.GT.0.500001D0) GO TO 2510 
      XMU=AVAL
      GO TO 2010
 2150 IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 6000,2160,2010  
 2160 AVAL=VALUE(IFIELD+IFLD) 
      MAXTIM=AVAL 
      GO TO 2010
 2200 IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 6000,2210,2010
 2210 AVAL=VALUE(IFIELD+IFLD) 
      IF (AVAL.GT.1.0D0) GO TO 2510 
      PIVTOL=AVAL 
      GO TO 2010
 2250 IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 6000,2260,2010
 2260 AVAL=VALUE(IFIELD+IFLD) 
      IF (AVAL.GT.1.0D0) GO TO 2510 
      PIVREL=AVAL 
      GO TO 2010
 2500 WRITE (6,2501) ANAM 
 2501 FORMAT('0WARNING:  UNKNOWN OPTION:  ',A8,' ... IGNORED'/) 
      GO TO 2010
 2510 WRITE (6,2511) ANAM 
 2511 FORMAT('0WARNING:  ILLEGAL VALUE SPECIFIED FOR OPTION:  ',A8,' ...
     1 IGNORED'/) 
      GO TO 2010
$PAGE 
********************************************************************
* 
*  GRAPH CARD:  GRAPH CARDS USE ELEMENTS 46-50 (SEE FIND ROUTINE).
*               THE SUBROUTINE 'GRPCRD' WILL PROCESS STATEMENTS 
*               OF THE FORM '.GRAPH XXXX ALL'; IF NOT OF THIS FORM, 
*               PROCESSING WILL BE DONE BY THE '.PLOT' PROCESS CODE.
* 
 3400 CALL GRPCRD(ICODE,IFIELD,IERR)
      IF (IERR.EQ.0) THEN 
          GO TO 6000
      ELSE
          IPRPL = 3 
          GO TO 3610
      ENDIF 
* 
********************************************************************
C 
C  PRINT CARD 
C 
 3500 IPRPL=0 
      GO TO 3610
C 
C  PLOT (AND PRINT) CARD
C 
 3600 IPRPL=1 
 3610 IFLD=2
 3613 ANAM=AMISS
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 3950 
      ANAM=VALUE(IFIELD+IFLD) 
      MS=0
      IF (IXXOR(ANAM,AMS).NE.0) GO TO 3615
      MS=1
      IFLD=3
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 3970 
      ANAM=VALUE(IFIELD+IFLD) 
 3615 CALL MOVE(ANAM,3,ABLNK,1,6) 
      DO 3620 I=1,5 
      IF (IXXOR(ANAM,AOPT(I)).NE.0) GO TO 3620  
      KTYPE=I 
      GO TO 3630
 3620 CONTINUE
      GO TO 3950
 3630 ID=30+5*IPRPL+KTYPE 
      CALL FIND(DFLOAT(JELCNT(ID)),ID,LOC,1)
      NODPLC(LOC+2)=KTYPE 
      IF (MS.EQ.0) GO TO 3635 
      LOCV=NODPLC(LOC+1)
      VALUE(LOCV)=0.0D0 
 3635 NUMOUT=0
 3640 IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 3900,3640,3650
 3650 CALL OUTDEF(IFLD,KTYPE,LOCT,LTYPE)
      IF (IGOOF.NE.0) GO TO 3970
      IF (IPRPL.EQ.0) GO TO 3660
$PAGE 
      PLIMLO=0.0D0
      PLIMHI=0.0D0
      IF (NODPLC(ICODE+IFLD+1).NE.0) GO TO 3660 
      IF (NODPLC(ICODE+IFLD+2).NE.0) GO TO 3660 
      PLIMLO=VALUE(IFIELD+IFLD+1) 
      PLIMHI=VALUE(IFIELD+IFLD+2) 
      IFLD=IFLD+2 
 3660 NUMOUT=NUMOUT+1 
      LSPOT=LOC+2*NUMOUT+2
      NODPLC(LSPOT)=LOCT
      NODPLC(LSPOT+1)=LTYPE 
      IF (IPRPL.EQ.0) GO TO 3670
      LOCV=NODPLC(LOC+1)
      LSPOT=LOCV+2*NUMOUT-1 
      VALUE(LSPOT)=PLIMLO 
      VALUE(LSPOT+1)=PLIMHI 
 3670 IF (NUMOUT.EQ.8) GO TO 3900 
      GO TO 3640
 3900 NODPLC(LOC+3)=NUMOUT
      IF (IPRPL.EQ.0) GO TO 6000
C 
C...  PROPOGATE PLOT LIMITS DOWNWARD
C 
      IF (NUMOUT.LE.1) GO TO 6000 
      LOCV=NODPLC(LOC+1)
      LSPOT=LOCV+2*NUMOUT-1 
      PLIMLO=VALUE(LSPOT) 
      PLIMHI=VALUE(LSPOT+1) 
      I=NUMOUT-1
 3905 LSPOT=LSPOT-2 
      IF (VALUE(LSPOT).NE.0.0D0) GO TO 3910 
      IF (VALUE(LSPOT+1).NE.0.0D0) GO TO 3910 
      VALUE(LSPOT)=PLIMLO 
      VALUE(LSPOT+1)=PLIMHI 
      GO TO 3920
 3910 PLIMLO=VALUE(LSPOT) 
      PLIMHI=VALUE(LSPOT+1) 
 3920 I=I-1 
      IF (I.GE.1) GO TO 3905
      GO TO 6000
C 
C     ERRORS
C 
 3950 WRITE (6,3951) ANAM 
 3951 FORMAT('0WARNING:  UNKNOWN ANALYSIS MODE:  ',A8,
     1  ' ... LINE IGNORED'/) 
      GO TO 6000
 3970 WRITE (6,3971)
 3971 FORMAT('0WARNING:  UNRECOGNIZABLE OUTPUT VARIABLE ON ABOVE LINE'/)
      IGOOF=0 
      GO TO 3640
$PAGE 
C 
C  WIDTH CARD 
C 
 4000 IFLD=1
 4010 IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD).NE.1) GO TO 6000 
 4020 ANAM=VALUE(IFIELD+IFLD) 
      IF (IXXOR(ANAM,AIN).NE.0) GO TO 4040  
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 6000,4030,4020
 4030 IWIDTH=VALUE(IFIELD+IFLD) 
      IWIDTH=MIN0(MAX0(IWIDTH,10),120)
      GO TO 4010
 4040 IF (IXXOR(ANAM,AOUT).NE.0) GO TO 6000 
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 6000,4050,4020
 4050 LWIDTH=DMIN1(DMAX1(VALUE(IFIELD+IFLD),72.0D0),132.0D0)
      GO TO 4010
C 
C  NODESET STATEMENT
C 
 4100 IFLD=1
 4110 IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 6000,4120,4110  
 4120 NODNUM=VALUE(IFIELD+IFLD) 
      IF (NODNUM.LE.0) GO TO 4190 
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 4180,4130,4170  
 4130 CALL SIZMEM(NSNOD,NIC)
      CALL EXTMEM(NSNOD,1)
      CALL EXTMEM(NSVAL,1)
      NODPLC(NSNOD+NIC+1)=NODNUM
      VALUE(NSVAL+NIC+1)=VALUE(IFIELD+IFLD) 
      GO TO 4110
C 
C  ERRORS ON .NODESET STATEMENT 
C 
 4170 WRITE(6,4171) VALUE(IFIELD+IFLD)
 4171 FORMAT('0WARNING: OUT-OF-PLACE NON-NUMERIC FIELD ',A8,
     1 ' SKIPPED'/) 
      GO TO 4110
 4180 WRITE(6,4181) NODNUM
 4181 FORMAT('0WARNING: INITIAL VALUE MISSING FOR NODE ',I5,/)
      GO TO 6000
 4190 WRITE(6,4191) 
 4191 FORMAT('0WARNING: ATTEMPT TO SPECIFY INITIAL CONDITION FOR ', 
     1 'GROUND INGNORED',/) 
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 6000,4110,4170
$PAGE 
C 
C  INITIAL CONDITIONS STATEMENT 
C 
 4200 IFLD=1
 4210 IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 6000,4220,4210
 4220 NODNUM=VALUE(IFIELD+IFLD) 
      IF (NODNUM.LE.0) GO TO 4290 
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 4280,4230,4270
 4230 CALL SIZMEM(ICNOD,NIC)
      CALL EXTMEM(ICNOD,1)
      CALL EXTMEM(ICVAL,1)
      NODPLC(ICNOD+NIC+1)=NODNUM
      VALUE(ICVAL+NIC+1)=VALUE(IFIELD+IFLD) 
      GO TO 4210
C 
C  ERRORS ON .IC STATEMENT
C 
 4270 WRITE(6,4271) VALUE(IFIELD+IFLD)
 4271 FORMAT('0WARNING: OUT-OF-PLACE NON-NUMERIC FIELD ',A8,
     1 ' SKIPPED'/) 
      GO TO 4210
 4280 WRITE(6,4281) NODNUM
 4281 FORMAT('0WARNING: INITIAL VALUE MISSING FOR NODE ',I5,/)
      GO TO 6000
 4290 WRITE(6,4291) 
 4291 FORMAT('0WARNING: ATTEMPT TO SPECIFY INITIAL CONDITION FOR ', 
     1 'GROUND INGNORED',/) 
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 6000,4210,4270  
C 
C     :DEBUG: STATEMENT 
C     SAMPLE DEBUG LINE: .:DEBUG: 5=3 17=5
C 
 5900 IFLD=1
 5910 IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 6000,5920,5910
 5920 INDEX=VALUE(IFIELD+IFLD)
      IFLD=IFLD+1 
      IF (NODPLC(ICODE+IFLD)) 6000,5930,5910
 5930 IVAL=VALUE(IFIELD+IFLD) 
      IF (INDEX.LT.1) GO TO 5910
      IF (INDEX.GT.20) GO TO 5910 
      WRITE(6,5931) INDEX,IVAL
 5931 FORMAT(' *DEBUG*:  RUNCON - IDEBUG(',I2,') SET TO ',I10)
      IDEBUG(INDEX)=IVAL
      GO TO 5910
C 
C  FINISHED 
C 
 6000 RETURN
      END 
      SUBROUTINE UNDEFI( ARRAY , LENGTH ) 
     + ,92091-16002 REV.5000 <890418.1140>
      IMPLICIT REAL*8 (A-H,O-Z) 
      DIMENSION ARRAY(1)
C 
C     THIS ROUTINE UNDEFINES THE MEMORY LOCATIONS INDICATED BY ARRAY(1) 
C THROUGH ARRAY(LENGTH).
C 
      DATA AUNDEF /2H.U/
      IF (LENGTH.EQ.0) RETURN 
      DO 10 I=1,LENGTH
      ARRAY(I)=AUNDEF 
   10 CONTINUE
      RETURN
      END 
