Annotation of 3BSD/cmd/spice/readins.f, revision 1.1

1.1     ! root        1:       subroutine readin
        !             2:       implicit double precision (a-h,o-z)
        !             3: c
        !             4: c
        !             5: c     this routine drives the input processing of spice.  element cards
        !             6: c and device models are handled by this routine.
        !             7: c
        !             8:       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
        !             9:      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
        !            10:      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
        !            11:      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
        !            12:      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
        !            13:      5   imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
        !            14:       common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
        !            15:      1  defas,rstats(50),iwidth,lwidth,nopage
        !            16:       common /line/ achar,afield(15),oldlin(15),kntrc,kntlim
        !            17:       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
        !            18:      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
        !            19:       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
        !            20:      1   xmu,mode,modedc,icalc,initf,method,iord,maxord,noncon,iterno,
        !            21:      2   itemno,nosolv,ipostp,iscrch
        !            22:       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
        !            23:      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
        !            24:       common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok,
        !            25:      1   gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox
        !            26:       common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop,
        !            27:      1   kinel,kidin,kovar,kidout
        !            28:       common /ac/ fstart,fstop,fincr,skw2,refprl,spw2,jacflg,idfreq,
        !            29:      1   inoise,nosprt,nosout,nosin,idist,idprt
        !            30:       common /tran/ tstep,tstop,tstart,delmax,tdmax,forfre,jtrflg
        !            31:       common /outinf/ xincr,string(15),xstart,yvar(8),itab(8),itype(8),
        !            32:      1   ilogy(8),npoint,numout,kntr,numdgt
        !            33:       common /cje/ maxtim,itime,icost
        !            34:       common /blank/ value(1000)
        !            35:       integer nodplc(64)
        !            36:       complex*16 cvalue(32)
        !            37:       equivalence (value(1),nodplc(1),cvalue(1))
        !            38: c
        !            39: c  control card identifiers
        !            40: c
        !            41:       dimension aide(20),nnods(20),ntnods(20)
        !            42:       dimension numic(4)
        !            43:       dimension aidm(8),ipolar(8),modid(8),ipar(6),ampar(120)
        !            44:       dimension titinp(4)
        !            45:       dimension aidc(20)
        !            46:       dimension alibm(6),alpar(46,6),dummy1(92),dummy2(92),dummy3(92)
        !            47:       equivalence (alpar(1,1),dummy1(1)),(alpar(1,3),dummy2(1))
        !            48:       equivalence (alpar(1,5),dummy3(1))
        !            49:       data titinp / 8hinput li, 8hsting   , 8h        , 8h         /
        !            50:       data naidc / 20 /
        !            51:       data aidc / 8hac      , 8hdc      , 8hdistorti, 8hend     ,
        !            52:      1            8hends    , 8hfourier , 8hmodel   , 8hnoise   ,
        !            53:      2            8hop      , 8hoptions , 8hplot    , 8hprint   ,
        !            54:      3            8hsubckt  , 8hsensitiv, 8htransien, 8htf      ,
        !            55:      4            8htemperat, 8hwidth   , 8hnodeset , 8hic      /
        !            56: c
        !            57: c  element card identifiers, keywords, and information
        !            58: c
        !            59:       data aide / 1hr,1hc,1hl,1hk,1hg,1he,1hf,1hh,1hv,1hi,1hd,1hq,1hj,
        !            60:      1   1hm,1hs,1hy,1ht,0.0d0,1hx,0.0d0 /
        !            61:       data alsac,alspu,alsex,alssi /2hac,2hpu,2hex,2hsi/
        !            62:       data alsoff,alsdc,alspw / 3hoff,2hdc,3hpw  /
        !            63:       data alsz0,alszo,alsnl,alsf,alstd / 2hz0,2hzo,2hnl,1hf,2htd /
        !            64:       data alsl,alsw,alsas,alsad,alsrd,alsrs / 1hl,1hw,2has,2had,2hrd,
        !            65:      1  2hrs /
        !            66:       data alszx /2hzx/
        !            67:       data alssf / 4hsf   /
        !            68:       data apoly, aic, area / 4hpoly, 2hic, 4harea /
        !            69:       data alstc / 2htc /
        !            70:       data numic / 1, 2, 2, 3 /
        !            71:       data ablnk, aper / 1h , 1h. /
        !            72:       data nnods / 2,2,2,0,2,2,2,2,2,2,2,3,3,4,4,4,4,0,0,0 /
        !            73:       data ntnods / 2,2,2,0,2,2,2,2,2,2,3,6,5,6,4,4,4,0,0,0 /
        !            74: c
        !            75: c  model card keywords
        !            76: c
        !            77:       data aidm /1hd,3hnpn,3hpnp,3hnjf,3hpjf,4hnmos,4hpmos,4hgaas/
        !            78:       data ipolar /0,1,-1,1,-1,1,-1,0/
        !            79:       data modid /1,2,2,3,3,4,4,4/
        !            80:       data ipar / 0, 14, 60, 72, 106, 119 /
        !            81:       data ampar /
        !            82:      1   6his    ,6hrs    ,6hn     ,6htt    ,6hcjo   ,6hpb    ,6hm     ,
        !            83:      2   6heg    ,6hpt    ,6hkf    ,6haf    ,6hfc    ,6hbv    ,6hibv   ,
        !            84:      1   6hjs    ,6hbf    ,6hnf    ,6hvbf   ,6hjbf   ,6hjle   ,6hnle   ,
        !            85:      2   6hbr    ,6hnr    ,6hvbr   ,6hjbr   ,6hjlc   ,6hnlc   ,6h0     ,
        !            86:      3   6h0     ,6hrb    ,6hjrb   ,6hrbm   ,6hre    ,6hrc    ,6hcje   ,
        !            87:      4   6hvje   ,6hmje   ,6htf    ,6hxtf   ,6hvtf   ,6hjtf   ,6hptf   ,
        !            88:      5   6hcjc   ,6hvjc   ,6hmjc   ,6hcdis  ,6htr    ,6h0     ,6h0     ,
        !            89:      6   6h0     ,6h0     ,6hcjs   ,6hvjs   ,6hmjs   ,6htb    ,6heg    ,
        !            90:      7   6hpt    ,6hkf    ,6haf    ,6hfc    ,
        !            91:      1   6hvto   ,6hbeta  ,6hlambda,6hrd    ,6hrs    ,6hcgs   ,6hcgd   ,
        !            92:      2   6hpb    ,6his    ,6hkf    ,6haf    ,6hfc    ,
        !            93:      1   6hvto   ,6hkp    ,6hgamma ,6hphi   ,6hlambda,6hrd    ,6hrs    ,
        !            94:      2   6hcgs   ,6hcgd   ,6hcgb   ,6hcbd   ,6hcbs   ,6htox   ,6hpb    ,
        !            95:      3   6hjs    ,6hnsub  ,6hnss   ,6hnfs   ,6hxj    ,6hld    ,6hngate ,
        !            96:      4   6htps   ,6huo    ,6hucrit ,6huexp  ,6hutra  ,6hkf    ,6haf    ,
        !            97:      5   6hfc    ,6hwd    ,6hecrit ,6hetra  ,6hvnorm ,6hdesat ,
        !            98:      1   6hvp    ,6hvbr   ,6hvbi   ,6hvfwd  ,6hnd    ,6hkdso  ,6hkdv   ,
        !            99:      2   6hcdso  ,6hczg   ,6hgnoise,6hnexp  ,6hkf    ,6haf    ,0.0d0 /
        !           100:       data alibm /7hlib001n,7hlib002n,7hlib239n,7hlib250n,7hlib255n,
        !           101:      1  7hlib620n/
        !           102:       data dummy1/
        !           103:      * 1.60d-16, 1.08d+02, 1.04d+00, 1.34d+02, 1.54d-02, 1.20d-14,
        !           104:      * 1.53d+00, 5.86d-01, 1.03d+00, 1.00d+10, 9.82d-03,    0.0d0,
        !           105:      *    0.0d0,    0.0d0, 1.04d+00, 2.40d+02, 6.47d-04, 1.80d+02,
        !           106:      * 3.90d+00, 9.20d+01, 1.90d-13, 6.70d-01, 3.33d-01, 1.51d-10,
        !           107:      *    0.0d0,    0.0d0,    0.0d0,   9.14d0, 1.60d-13, 4.20d-01,
        !           108:      * 3.33d-01, 9.70d-01, 1.51d-09,    0.0d0,    0.0d0,    0.0d0,
        !           109:      *    0.0d0, 1.60d-13, 4.20d-01, 3.33d-01, 1.10d+00, 1.11d+00,
        !           110:      *    0.0d0,    0.0d0,    0.0d0,    0.0d0,
        !           111:      * 6.17d-16, 1.64d+02, 1.05d+00, 7.60d+01, 3.34d-02, 2.50d-14,
        !           112:      * 1.49d+00, 1.36d+00, 1.05d+00, 1.00d+10, 2.15d-04,    0.0d0,
        !           113:      *    0.0d0,    0.0d0, 1.05d+00, 7.33d+01, 2.14d-03, 3.00d+01,
        !           114:      * 2.70d+00, 1.00d+01, 5.70d-13, 6.70d-01, 3.33d-01, 1.25d-10,
        !           115:      *    0.0d0,    0.0d0,    0.0d0,  10.22d0, 5.20d-13, 4.80d-01,
        !           116:      * 3.33d-01, 7.50d-01, 1.25d-09,    0.0d0,    0.0d0,    0.0d0,
        !           117:      *    0.0d0, 5.20d-13, 4.80d-01, 3.33d-01, 1.10d+00, 1.11d+00,
        !           118:      *    0.0d0,    0.0d0,    0.0d0,    0.0d0/
        !           119:       data dummy2 /
        !           120:      * 2.89d-16, 6.88d+01, 1.01d+00, 4.43d+01, 1.67d-01, 1.60d-13,
        !           121:      * 1.85d+00, 3.32d-01, 1.10d+00, 1.00d+10, 3.42d-03,    0.0d0,
        !           122:      *    0.0d0,    0.0d0, 1.01d+00, 2.00d+01, 8.18d-03, 1.00d+01,
        !           123:      * 1.90d+00, 5.50d+00, 5.70d-13, 1.20d+00, 5.00d-01, 1.80d-11,
        !           124:      *    0.0d0,    0.0d0,    0.0d0,   38.2d0, 5.60d-13, 8.20d-01,
        !           125:      * 5.00d-01, 3.50d-01, 1.80d-10,    0.0d0,    0.0d0,    0.0d0,
        !           126:      *    0.0d0, 5.60d-13, 8.20d-01, 5.00d-01, 1.10d+00, 1.11d+00,
        !           127:      *    0.0d0,    0.0d0,    0.0d0,    0.0d0,
        !           128:      * 1.90d-15, 1.02d+02, 1.08d+00, 5.50d+01, 7.63d-02, 8.80d-14,
        !           129:      * 1.98d+00, 5.54d+00, 1.05d+00, 1.00d+10, 1.36d-02,    0.0d0,
        !           130:      *    0.0d0,    0.0d0, 1.08d+00, 1.27d+02, 1.23d-03, 1.50d+01,
        !           131:      * 2.50d+00, 6.00d+00, 4.80d-13, 1.20d+00, 5.00d-01, 4.40d-11,
        !           132:      *    0.0d0,    0.0d0,    0.0d0,  16.15d0, 2.90d-13, 4.20d-01,
        !           133:      * 3.33d-01, 6.10d-01, 4.40d-10,    0.0d0,    0.0d0,    0.0d0,
        !           134:      *    0.0d0, 2.90d-13, 4.20d-01, 3.33d-01, 1.10d+00, 1.11d+00,
        !           135:      *    0.0d0,    0.0d0,    0.0d0,    0.0d0/
        !           136:       data dummy3 /
        !           137:      * 1.90d-16, 1.00d+02, 1.00d+00, 5.70d+01, 4.17d-02, 4.80d-16,
        !           138:      * 1.38d+00, 6.19d-01, 1.04d+00, 1.00d+10, 5.52d-03,    0.0d0,
        !           139:      *    0.0d0,    0.0d0, 1.00d+00, 1.33d+02, 1.17d-03, 1.60d+01,
        !           140:      * 2.40d+00, 7.00d+00, 3.20d-13, 1.20d+00, 5.00d-01, 4.70d-11,
        !           141:      *    0.0d0,    0.0d0,    0.0d0,  14.51d0, 2.40d-13, 3.60d-01,
        !           142:      * 3.33d-01, 4.50d-01, 4.70d-10,    0.0d0,    0.0d0,    0.0d0,
        !           143:      *    0.0d0, 2.40d-13, 3.60d-01, 3.33d-01, 1.10d+00, 1.11d+00,
        !           144:      *    0.0d0,    0.0d0,    0.0d0,    0.0d0,
        !           145:      * 1.59d-15, 9.14d+01, 1.03d+00, 6.00d+01, 2.06d-01, 1.33d-16,
        !           146:      * 1.23d+00, 1.27d+01, 1.00d+00, 1.00d+10, 5.39d-02,    0.0d0,
        !           147:      *    0.0d0,    0.0d0, 1.03d+00, 8.33d+01, 1.87d-03, 8.00d+00,
        !           148:      * 1.20d+00, 3.50d+00, 1.30d-12, 1.20d+00, 5.00d-01, 3.26d-11,
        !           149:      *    0.0d0,    0.0d0,    0.0d0,  45.87d0, 7.50d-13, 5.50d-01,
        !           150:      * 3.33d-01, 9.70d-01, 3.26d-10,    0.0d0,    0.0d0,    0.0d0,
        !           151:      *    0.0d0, 7.50d-13, 5.50d-01, 3.33d-01, 1.10d+00, 1.11d+00,
        !           152:      *    0.0d0,    0.0d0,    0.0d0,    0.0d0/
        !           153: c
        !           154: c  initialize variables
        !           155: c
        !           156:       call second(t1)
        !           157:       call getlin
        !           158:       if (keof.ne.0) go to 6000
        !           159:       call copy8(afield,atitle,15)
        !           160:       call getm4(ielmnt,0)
        !           161:       call getm8(itemps,1)
        !           162:       value(itemps+1)=25.0d0
        !           163:       itemno=1
        !           164:       nopage=0
        !           165:       call title(-1,72,1,titinp)
        !           166:       iwidth=80
        !           167:       do 5 i=1,8
        !           168:       achar=ablnk
        !           169:       call move(achar,1,atitle(10),i,1)
        !           170:       if(achar.eq.ablnk) go to 8
        !           171:     5 continue
        !           172:       write(6,6)
        !           173:     6 format('0warning:  input line-width set to 72 columns because',/
        !           174:      11x,'possible sequencing appears in cols 73-80')
        !           175:       iwidth=72
        !           176:     8 do 10 i=1,15
        !           177:       afield(i)=ablnk
        !           178:    10 continue
        !           179:       call copy8(afield,oldlin,15)
        !           180:       call getm4(isbckt,0)
        !           181:       nsbckt=0
        !           182:       call getm8(iunsat,0)
        !           183:       nunsat=0
        !           184:       lwidth=80
        !           185:       iprnta=1
        !           186:       iprntl=1
        !           187:       iprntm=1
        !           188:       iprntn=1
        !           189:       iprnto=0
        !           190:       gmin=1.0d-12
        !           191:       reltol=0.001d0
        !           192:       abstol=1.0d-12
        !           193:       vntol=50.0d-6
        !           194:       trtol=7.0d0
        !           195:       chgtol=1.0d-14
        !           196:       defl=1.0d0
        !           197:       defw=1.0d0
        !           198:       defad=1.0d-12
        !           199:       defas=1.0d-12
        !           200:       numdgt=4
        !           201:       numtem=1
        !           202:       itl1=100
        !           203:       itl2=50
        !           204:       itl3=4
        !           205:       itl4=10
        !           206:       itl5=5000
        !           207:       limtim=2
        !           208:       limpts=201
        !           209:       lvlcod=2
        !           210:       lvltim=1
        !           211:       method=1
        !           212:       xmu=0.5d0
        !           213:       maxord=2
        !           214:       nosolv=0
        !           215:       icvflg=0
        !           216:       itcelm(2)=0
        !           217:       idist=0
        !           218:       idprt=0
        !           219:       inoise=0
        !           220:       jacflg=0
        !           221:       jtrflg=0
        !           222:       call getm4(ifour,0)
        !           223:       nfour=0
        !           224:       call getm4(nsnod,0)
        !           225:       call getm8(nsval,0)
        !           226:       call getm4(icnod,0)
        !           227:       call getm8(icval,0)
        !           228:       kinel=0
        !           229:       kovar=0
        !           230:       kssop=0
        !           231:       nosprt=0
        !           232:       nsens=0
        !           233:       call getm4(isens,0)
        !           234:       numnod=0
        !           235:       ncnods=0
        !           236:       nunods=0
        !           237:       call zero4(locate,50)
        !           238:       call zero4(jelcnt,50)
        !           239:       insize=50
        !           240:       call getm8(ifield,insize)
        !           241:       call getm4(icode,insize)
        !           242:       call getm8(idelim,insize)
        !           243:       call getm4(icolum,insize)
        !           244:       go to 50
        !           245: c
        !           246: c  error entry
        !           247: c
        !           248:    40 nogo=1
        !           249: c
        !           250: c  read and decode next card in input deck
        !           251: c
        !           252:    50 igoof=0
        !           253:       call card
        !           254:       if (keof.ne.0) go to 5000
        !           255:       if (igoof.ne.0) go to 40
        !           256:       if (nodplc(icode+1).eq.0) go to 95
        !           257:       anam=value(ifield+1)
        !           258:       call move(anam,2,ablnk,1,7)
        !           259:       if (anam.ne.aper) go to 70
        !           260:       call move(anam,1,value(ifield+1),2,7)
        !           261:       call keysrc(aidc,naidc,anam,id)
        !           262:       if (id.le.0) go to 90
        !           263:       if (id.eq.4) go to 5000
        !           264:       if (id.eq.5) go to 800
        !           265:       if (id.eq.7) go to 500
        !           266:       if (id.eq.13) go to 700
        !           267:       if (nsbckt.ge.1) go to 85
        !           268:       call runcon(id)
        !           269:       if (igoof.ne.0) go to 40
        !           270:       go to 50
        !           271:    70 id=0
        !           272:    80 id=id+1
        !           273:       if (id.gt.20) go to 90
        !           274:       if (anam.eq.aide(id)) go to 100
        !           275:       go to 80
        !           276:    85 write (6,86)
        !           277:    86 format('0warning:  above line not allowed within subcircuit -- ',
        !           278:      1   'ignored'/)
        !           279:       go to 50
        !           280:    90 write (6,91) value(ifield+1)
        !           281:    91 format('0*error*:  unknown data card:  ',a8/)
        !           282:       go to 40
        !           283:    95 write (6,96)
        !           284:    96 format('0*error*:  unrecognizable data card'/)
        !           285:       go to 40
        !           286: c
        !           287: c  element and device cards
        !           288: c
        !           289:   100 call find(value(ifield+1),id,loc,1)
        !           290:       locv=nodplc(loc+1)
        !           291:       if (id.eq.4) go to 140
        !           292:       if (id.eq.19) go to 900
        !           293:       istop=nnods(id)+1
        !           294:       do 110 i=2,istop
        !           295:       if (nodplc(icode+i).ne.0) go to 410
        !           296:       if (value(ifield+i).lt.0.0d0) go to 400
        !           297:   110 nodplc(loc+i)=value(ifield+i)
        !           298:       go to (120,130,130,140,150,150,180,180,200,200,300,300,300,300,
        !           299:      1   390,390,350,390,390,390), id
        !           300: c
        !           301: c  resistor
        !           302: c
        !           303:   120 if (nodplc(icode+4).ne.0) go to 420
        !           304:       if (value(ifield+4).eq.0.0d0) go to 480
        !           305:       value(locv+2)=value(ifield+4)
        !           306:       ifld=4
        !           307:   122 ifld=ifld+1
        !           308:       if (nodplc(icode+ifld)) 50,122,124
        !           309:   124 anam=value(ifield+ifld)
        !           310:       if (anam.ne.alstc) go to 460
        !           311:       ifld=ifld+1
        !           312:       if (nodplc(icode+ifld)) 50,126,124
        !           313:   126 value(locv+3)=value(ifield+ifld)
        !           314:       ifld=ifld+1
        !           315:       if (nodplc(icode+ifld)) 50,128,124
        !           316:   128 value(locv+4)=value(ifield+ifld)
        !           317:       go to 50
        !           318: c
        !           319: c  capacitor or inductor
        !           320: c
        !           321:   130 ifld=3
        !           322:       iknt=0
        !           323:       ltab=7
        !           324:       if (id.eq.3) ltab=10
        !           325:       call getm8(nodplc(loc+ltab),0)
        !           326:       if (nodplc(icode+4).ne.1) go to 132
        !           327:       anam=value(ifield+4)
        !           328:       if (anam.ne.apoly) go to 450
        !           329:       ifld=4
        !           330:   132 ifld=ifld+1
        !           331:       if (nodplc(icode+ifld).ne.0) go to 136
        !           332:       call extmem(nodplc(loc+ltab),1)
        !           333:       iknt=iknt+1
        !           334:       ispot=nodplc(loc+ltab)+iknt
        !           335:       value(ispot)=value(ifield+ifld)
        !           336:       go to 132
        !           337:   136 if (iknt.eq.0) go to 420
        !           338:       if (nodplc(icode+ifld).ne.1) go to 50
        !           339:       anam=value(ifield+ifld)
        !           340:       if (anam.ne.aic) go to 460
        !           341:       ifld=ifld+1
        !           342:       if (nodplc(icode+ifld)) 50,138,136
        !           343:   138 value(locv+2)=value(ifield+ifld)
        !           344:       go to 50
        !           345: c
        !           346: c  mutual inductance
        !           347: c
        !           348:   140 if (nodplc(icode+2).ne.1) go to 430
        !           349:       anam=value(ifield+2)
        !           350:       call move(anam,2,ablnk,1,7)
        !           351:       if (anam.ne.aide(3)) go to 430
        !           352:       call extnam(value(ifield+2),nodplc(loc+2))
        !           353:       if (nodplc(icode+3).ne.1) go to 430
        !           354:       anam=value(ifield+3)
        !           355:       call move(anam,2,ablnk,1,7)
        !           356:       if (anam.ne.aide(3)) go to 430
        !           357:       call extnam(value(ifield+3),nodplc(loc+3))
        !           358:       if (nodplc(icode+4).ne.0) go to 420
        !           359:       xk=value(ifield+4)
        !           360:       if (xk.le.0.0d0) go to 420
        !           361:       if (xk.le.1.0d0) go to 145
        !           362:       xk=1.0d0
        !           363:       write (6,141)
        !           364:   141 format('0warning:  coefficient of coupling reset to 1.0d0'/)
        !           365:   145 value(locv+1)=xk
        !           366:       go to 50
        !           367: c
        !           368: c  voltage controlled (nonlinear) sources
        !           369: c
        !           370:   150 ndim=1
        !           371:       ifld=3
        !           372:       if (nodplc(icode+4)) 410,156,152
        !           373:   152 anam=value(ifield+4)
        !           374:       if (anam.ne.apoly) go to 450
        !           375:       if (nodplc(icode+5).ne.0) go to 420
        !           376:       ndim=value(ifield+5)
        !           377:       if (ndim.le.0) go to 420
        !           378:       ifld=5
        !           379:   156 nodplc(loc+4)=ndim
        !           380:       ltab=id+1
        !           381:       nssnod=2*ndim
        !           382:       nmat=4*ndim
        !           383:       if (id.eq.6) nmat=4+2*ndim
        !           384:       call getm4(nodplc(loc+ltab),nssnod)
        !           385:       call getm4(nodplc(loc+ltab+1),nmat)
        !           386:       call getm8(nodplc(loc+ltab+2),0)
        !           387:       call getm8(nodplc(loc+ltab+3),ndim)
        !           388:       call getm4(nodplc(loc+ltab+4),ndim)
        !           389:       call getm8(nodplc(loc+ltab+5),ndim)
        !           390:       ispot=nodplc(loc+ltab+5)
        !           391:       call zero8(value(ispot+1),ndim)
        !           392:       lnod=nodplc(loc+ltab)
        !           393:       do 158 i=1,nssnod
        !           394:       ifld=ifld+1
        !           395:       if (nodplc(icode+ifld).ne.0) go to 410
        !           396:       if (value(ifield+ifld).lt.0.0d0) go to 400
        !           397:       nodplc(lnod+i)=value(ifield+ifld)
        !           398:   158 continue
        !           399:   160 iknt=0
        !           400:   162 ifld=ifld+1
        !           401:       if (nodplc(icode+ifld).ne.0) go to 164
        !           402:       call extmem(nodplc(loc+ltab+2),1)
        !           403:       iknt=iknt+1
        !           404:       ispot=nodplc(loc+ltab+2)+iknt
        !           405:       value(ispot)=value(ifield+ifld)
        !           406:       go to 162
        !           407:   164 if (iknt.eq.0) go to 420
        !           408:       if (nodplc(icode+ifld).ne.1) go to 170
        !           409:       anam=value(ifield+ifld)
        !           410:       if (anam.ne.aic) go to 460
        !           411:       do 168 i=1,ndim
        !           412:       ifld=ifld+1
        !           413:       if (nodplc(icode+ifld)) 170,166,420
        !           414:   166 ispot=nodplc(loc+ltab+5)+i
        !           415:       value(ispot)=value(ifield+ifld)
        !           416:   168 continue
        !           417:   170 if (ndim.ne.1) go to 50
        !           418:       if (iknt.ne.1) go to 50
        !           419:       call extmem(nodplc(loc+ltab+2),1)
        !           420:       ispot=nodplc(loc+ltab+2)
        !           421:       value(ispot+2)=value(ispot+1)
        !           422:       value(ispot+1)=0.0d0
        !           423:       go to 50
        !           424: c
        !           425: c  current controlled (nonlinear) sources
        !           426: c
        !           427:   180 ndim=1
        !           428:       ifld=3
        !           429:       if (nodplc(icode+4).ne.1) go to 470
        !           430:       anam=value(ifield+4)
        !           431:       if (anam.ne.apoly) go to 182
        !           432:       ifld=5
        !           433:       if (nodplc(icode+5).ne.0) go to 420
        !           434:       ndim=value(ifield+5)
        !           435:       if (ndim.le.0) go to 420
        !           436:   182 nodplc(loc+4)=ndim
        !           437:       ltab=id-1
        !           438:       nmat=2*ndim
        !           439:       if (id.eq.8) nmat=4+ndim
        !           440:       call getm4(nodplc(loc+ltab),ndim)
        !           441:       call getm4(nodplc(loc+ltab+1),nmat)
        !           442:       call getm8(nodplc(loc+ltab+2),0)
        !           443:       call getm8(nodplc(loc+ltab+3),ndim)
        !           444:       call getm4(nodplc(loc+ltab+4),ndim)
        !           445:       call getm8(nodplc(loc+ltab+5),ndim)
        !           446:       ispot=nodplc(loc+ltab+5)
        !           447:       call zero8(value(ispot+1),ndim)
        !           448:       do 184 i=1,ndim
        !           449:       ifld=ifld+1
        !           450:       if (nodplc(icode+ifld).ne.1) go to 470
        !           451:       anam=value(ifield+ifld)
        !           452:       call move(anam,2,ablnk,1,7)
        !           453:       if (anam.ne.aide(9)) go to 470
        !           454:       call extnam(value(ifield+ifld),loct)
        !           455:       ispot=nodplc(loc+ltab)+i
        !           456:       nodplc(ispot)=loct
        !           457:   184 continue
        !           458:       go to 160
        !           459: c
        !           460: c  independent sources
        !           461: c
        !           462:   200 ifld=3
        !           463:       call getm8(nodplc(loc+5),0)
        !           464:   210 ifld=ifld+1
        !           465:   215 if (nodplc(icode+ifld)) 50,220,230
        !           466:   220 if (ifld.gt.4) go to 210
        !           467:   225 value(locv+1)=value(ifield+ifld)
        !           468:       go to 210
        !           469:   230 anam=value(ifield+ifld)
        !           470:       if (anam.ne.alsdc) go to 235
        !           471:       ifld=ifld+1
        !           472:       if (nodplc(icode+ifld)) 50,225,230
        !           473:   235 if (anam.ne.alsac) go to 260
        !           474:       value(locv+2)=1.0d0
        !           475:       ifld=ifld+1
        !           476:       if (nodplc(icode+ifld)) 50,240,230
        !           477:   240 value(locv+2)=value(ifield+ifld)
        !           478:       ifld=ifld+1
        !           479:       if (nodplc(icode+ifld)) 50,250,230
        !           480:   250 value(locv+3)=value(ifield+ifld)
        !           481:       go to 210
        !           482:   260 id=0
        !           483:       call move(anam,3,ablnk,1,6)
        !           484:       if (anam.eq.alspu) id=1
        !           485:       if (anam.eq.alssi) id=2
        !           486:       if (anam.eq.alsex) id=3
        !           487:       if (anam.eq.alspw) id=4
        !           488:       if (anam.eq.alssf) id=5
        !           489:       if (id.eq.0) go to 450
        !           490:       nodplc(loc+4)=id
        !           491:       iknt=0
        !           492:   270 ifld=ifld+1
        !           493:       if (nodplc(icode+ifld).ne.0) go to 280
        !           494:       call extmem(nodplc(loc+5),1)
        !           495:       iknt=iknt+1
        !           496:       ispot=nodplc(loc+5)+iknt
        !           497:       value(ispot)=value(ifield+ifld)
        !           498:       go to 270
        !           499:   280 aval=0.0d0
        !           500:       if (id.ne.4) go to 285
        !           501: c...  for pwl source function, force even number of input values
        !           502:       ibit=0
        !           503:       if(iknt.ne.(iknt/2)*2) ibit=1
        !           504:       aval=value(ispot)
        !           505:       if (ibit.eq.0) go to 290
        !           506:       call extmem(nodplc(loc+5),1)
        !           507:       aval=value(ispot-1)
        !           508:       iknt=iknt+1
        !           509:       ispot=nodplc(loc+5)+iknt
        !           510:       value(ispot)=aval
        !           511:       go to 290
        !           512:   285 if (iknt.ge.7) go to 215
        !           513:   290 call extmem(nodplc(loc+5),2)
        !           514:       ispot=nodplc(loc+5)+iknt
        !           515:       value(ispot+1)=0.0d0
        !           516:       value(ispot+2)=aval
        !           517:       iknt=iknt+2
        !           518:       go to 285
        !           519: c
        !           520: c  device cards
        !           521: c
        !           522:   300 if(id.ne.14) value(locv+1)=1.0d0
        !           523:       locm=loc+ntnods(id)+2
        !           524:       ifld=nnods(id)+2
        !           525: c
        !           526: c  temporarily (until modchk) put substrate node into nodplc(loc+5)
        !           527: c
        !           528:       if(id.ne.12) go to 308
        !           529:       if(nodplc(icode+5).ne.0) go to 308
        !           530:       ifld=6
        !           531:       nodplc(loc+5)=value(ifield+5)
        !           532:   308 continue
        !           533:       if (nodplc(icode+ifld).ne.1) go to 440
        !           534:       call extnam(value(ifield+ifld),nodplc(locm))
        !           535:   310 ifld=ifld+1
        !           536:       if (nodplc(icode+ifld)) 50,325,315
        !           537:   315 anam=value(ifield+ifld)
        !           538:       if (anam.ne.alsoff) go to 320
        !           539:       nodplc(locm+1)=1
        !           540:       go to 310
        !           541:   320 if (anam.ne.area) go to 330
        !           542:       ifld=ifld+1
        !           543:       if (nodplc(icode+ifld)) 50,325,315
        !           544:   325 if (value(ifield+ifld).le.0.0d0) go to 420
        !           545:       if (id.eq.14) go to 343
        !           546:       value(locv+1)=value(ifield+ifld)
        !           547:       go to 310
        !           548:   330 if (anam.ne.aic) go to 341
        !           549:       iknt=0
        !           550:       icloc=0
        !           551:       if (id.eq.14) icloc=3
        !           552:       maxknt=numic(id-10)
        !           553:   335 ifld=ifld+1
        !           554:       if (nodplc(icode+ifld)) 50,340,315
        !           555:   340 iknt=iknt+1
        !           556:       if (iknt.gt.maxknt) go to 335
        !           557:       value(locv+icloc+iknt+1)=value(ifield+ifld)
        !           558:       go to 335
        !           559:   341 if (id.ne.14) go to 460
        !           560:       ispot=0
        !           561:       if (anam.eq.alsl) ispot=1
        !           562:       if (anam.eq.alsw) ispot=2
        !           563:       if (anam.eq.alsad) ispot=3
        !           564:       if(anam.eq.alszx) ispot=3
        !           565:       if (anam.eq.alsas) ispot=4
        !           566:       if(anam.eq.alsrd) ispot=11
        !           567:       if(anam.eq.alsrs) ispot=12
        !           568:       if (ispot.eq.0) go to 460
        !           569:       ifld=ifld+1
        !           570:       if (nodplc(icode+ifld)) 50,342,315
        !           571:   342 if (value(ifield+ifld).le.0.0d0) go to 420
        !           572:       value(locv+ispot)=value(ifield+ifld)
        !           573:       go to 310
        !           574:   343 iknt=0
        !           575:   344 iknt=iknt+1
        !           576:       if(value(ifield+ifld).le.0.0d0) go to 420
        !           577:       if(iknt.gt.12) go to 490
        !           578:       if(iknt.eq.5) iknt=11
        !           579:       value(locv+iknt)=value(ifield+ifld)
        !           580:       ifld=ifld+1
        !           581:       if(nodplc(icode+ifld)) 345,344,345
        !           582:   345 if(nodplc(icode+ifld)) 50,50,315
        !           583: c
        !           584: c  transmission lines
        !           585: c
        !           586:   350 ifld=5
        !           587:       xnl=0.25d0
        !           588:       tfreq=0.0d0
        !           589:   355 ifld=ifld+1
        !           590:       if (nodplc(icode+ifld)) 378,355,360
        !           591:   360 anam=value(ifield+ifld)
        !           592:       if (anam.eq.aic) go to 364
        !           593:       if (anam.eq.alsnl) go to 370
        !           594:       if (anam.eq.alsf) go to 374
        !           595:       id=0
        !           596:       if (anam.eq.alsz0) id=1
        !           597:       if (anam.eq.alszo) id=1
        !           598:       if (anam.eq.alstd) id=2
        !           599:       if (id.eq.0) go to 460
        !           600:       ifld=ifld+1
        !           601:       if (nodplc(icode+ifld)) 378,362,360
        !           602:   362 if (value(ifield+ifld).le.0.0d0) go to 420
        !           603:       value(locv+id)=value(ifield+ifld)
        !           604:       go to 355
        !           605:   364 iknt=0
        !           606:   366 ifld=ifld+1
        !           607:       if (nodplc(icode+ifld)) 378,368,360
        !           608:   368 iknt=iknt+1
        !           609:       if (iknt.gt.4) go to 366
        !           610:       value(locv+iknt+4)=value(ifield+ifld)
        !           611:       go to 366
        !           612:   370 ifld=ifld+1
        !           613:       if (nodplc(icode+ifld)) 378,372,360
        !           614:   372 if (value(ifield+ifld).le.0.0d0) go to 420
        !           615:       xnl=value(ifield+ifld)
        !           616:       go to 355
        !           617:   374 ifld=ifld+1
        !           618:       if (nodplc(icode+ifld)) 378,376,360
        !           619:   376 if (value(ifield+ifld).le.0.0d0) go to 420
        !           620:       tfreq=value(ifield+ifld)
        !           621:       go to 355
        !           622:   378 if (value(locv+1).ne.0.0d0) go to 380
        !           623:       write (6,379)
        !           624:   379 format('0*error*:  z0 must be specified'/)
        !           625:       go to 40
        !           626:   380 if (value(locv+2).ne.0.0d0) go to 50
        !           627:       if (tfreq.ne.0.0d0) go to 382
        !           628:       write (6,381)
        !           629:   381 format('0*error*:  either td or f must be specified'/)
        !           630:       go to 40
        !           631:   382 value(locv+2)=xnl/tfreq
        !           632:       go to 50
        !           633: c
        !           634: c  elements not yet implemented
        !           635: c
        !           636:   390 write (6,391)
        !           637:   391 format('0*error*:  element type not yet implemented'/)
        !           638:       go to 40
        !           639: c
        !           640: c  element card errors
        !           641: c
        !           642:   400 write (6,401)
        !           643:   401 format('0*error*:  negative node number found'/)
        !           644:       go to 40
        !           645:   410 write (6,411)
        !           646:   411 format('0*error*:  node numbers are missing'/)
        !           647:       go to 40
        !           648:   420 write (6,421)
        !           649:   421 format('0*error*:  value is missing or is nonpositive'/)
        !           650:       go to 40
        !           651:   430 write (6,431)
        !           652:   431 format('0*error*:  mutual inductance references are missing'/)
        !           653:       go to 40
        !           654:   440 write (6,441)
        !           655:   441 format('0*error*:  model name is missing'/)
        !           656:       go to 40
        !           657:   450 write (6,451) anam
        !           658:   451 format('0*error*:  unknown source function:  ',a8)
        !           659:       go to 40
        !           660:   460 write (6,461) anam
        !           661:   461 format('0*error*:  unknown parameter:  ',a8/)
        !           662:       go to 40
        !           663:   470 write (6,471)
        !           664:   471 format('0*error*:  voltage source not found on above line'/)
        !           665:       go to 40
        !           666:   480 write (6,481)
        !           667:   481 format('0*error*:  value is zero'/)
        !           668:       go to 40
        !           669:   490 write(6,491)
        !           670:   491 format('0*error*:  extra numerical data on mosfet card'/)
        !           671:       go to 40
        !           672: c
        !           673: c  model card
        !           674: c
        !           675:   500 if (nodplc(icode+2).ne.1) go to 650
        !           676:       if (nodplc(icode+3).ne.1) go to 650
        !           677: c
        !           678: c  process for library models
        !           679: c
        !           680:       iknt=0
        !           681:   502 iknt=iknt+1
        !           682:       if(iknt.gt.6) go to 506
        !           683:       if(alibm(iknt).ne.value(ifield+3)) go to 502
        !           684:       ipol=ipolar(2)
        !           685:       jtype=modid(2)
        !           686:       id=jtype+20
        !           687:       call find(value(ifield+2),id,loc,1)
        !           688:       nodplc(loc+2)=ipol
        !           689:       locv=nodplc(loc+1)
        !           690:       do 504 i=1,46
        !           691:   504 value(locv+i)=alpar(i,iknt)
        !           692:       go to 520
        !           693:   506 id=0
        !           694:   510 id=id+1
        !           695:       if (id.gt.8) go to 660
        !           696:       if (value(ifield+3).ne.aidm(id)) go to 510
        !           697:       ipol=ipolar(id)
        !           698:       jtype=modid(id)
        !           699:       id=jtype+20
        !           700:       call find(value(ifield+2),id,loc,1)
        !           701: c... adjust jtype for gaas
        !           702:       if(jtype.eq.4.and.ipol.eq.0) jtype=5
        !           703:       nodplc(loc+2)=ipol
        !           704:       locv=nodplc(loc+1)
        !           705:   520 locm=ipar(jtype)
        !           706:       nopar=ipar(jtype+1)-locm
        !           707:       ifld=3
        !           708:   530 ifld=ifld+1
        !           709:       if (nodplc(icode+ifld)) 50,530,560
        !           710:   560 anam=value(ifield+ifld)
        !           711:       if(jtype.eq.2) anam=alias(anam)
        !           712:       iknt=0
        !           713:   570 iknt=iknt+1
        !           714:       if (iknt.gt.nopar) go to 670
        !           715:       if (anam.ne.ampar(locm+iknt)) go to 570
        !           716:       ifld=ifld+1
        !           717:       if (nodplc(icode+ifld)) 50,580,560
        !           718:   580 value(locv+iknt)=value(ifield+ifld)
        !           719:       ifld=ifld+1
        !           720:       if (nodplc(icode+ifld)) 50,590,560
        !           721:   590 iknt=iknt+1
        !           722:       if (iknt.gt.nopar) go to 530
        !           723:       if (ablnk.ne.ampar(locm+iknt)) go to 530
        !           724:       go to 580
        !           725: c
        !           726: c  model card errors
        !           727: c
        !           728:   650 write (6,651)
        !           729:   651 format('0*error*:  model type is missing'/)
        !           730:       go to 40
        !           731:   660 write (6,661) value(ifield+3)
        !           732:   661 format('0*error*:  unknown model type:  ',a8/)
        !           733:       go to 40
        !           734:   670 write (6,671) anam
        !           735:   671 format('0*error*:  unknown model parameter:  ',a8,/)
        !           736:       nogo=1
        !           737:       go to 530
        !           738: c
        !           739: c  subcircuit definition
        !           740: c
        !           741:   700 if (nodplc(icode+2).ne.1) go to 780
        !           742:       call find(value(ifield+2),20,loc,1)
        !           743:       call extmem(isbckt,1)
        !           744:       nsbckt=nsbckt+1
        !           745:       nodplc(isbckt+nsbckt)=loc
        !           746:       ifld=2
        !           747:       if (nodplc(icode+3).ne.0) go to 790
        !           748:       call getm4(nodplc(loc+2),0)
        !           749:       iknt=0
        !           750:   710 ifld=ifld+1
        !           751:       if (nodplc(icode+ifld)) 50,720,710
        !           752:   720 call extmem(nodplc(loc+2),1)
        !           753:       iknt=iknt+1
        !           754:       ispot=nodplc(loc+2)+iknt
        !           755:       if (value(ifield+ifld).le.0.0d0) go to 770
        !           756:       nodplc(ispot)=value(ifield+ifld)
        !           757:       node=nodplc(ispot)
        !           758:       i=iknt-1
        !           759:   730 if (i.eq.0) go to 710
        !           760:       ispot=ispot-1
        !           761:       if (nodplc(ispot).eq.node) go to 760
        !           762:       i=i-1
        !           763:       go to 730
        !           764:   760 write (6,761) node
        !           765:   761 format('0*error*:  subcircuit definition duplicates node ',i5,/)
        !           766:       go to 40
        !           767:   770 write (6,771)
        !           768:   771 format('0*error*:  nonpositive node number found in subcircuit ',
        !           769:      1   'definition'/)
        !           770:       go to 40
        !           771:   780 write (6,781)
        !           772:   781 format('0*error*:  subcircuit name missing'/)
        !           773:       go to 40
        !           774:   790 write (6,791)
        !           775:   791 format('0*error*:  subcircuit nodes missing'/)
        !           776:       go to 40
        !           777: c
        !           778: c  .ends processing
        !           779: c
        !           780:   800 if (nsbckt.eq.0) go to 890
        !           781:       iknt=1
        !           782:       if (nodplc(icode+2).le.0) go to 820
        !           783:       anam=value(ifield+2)
        !           784:       iknt=nsbckt
        !           785:   810 loc=nodplc(isbckt+iknt)
        !           786:       locv=nodplc(loc+1)
        !           787:       anams=value(locv)
        !           788:       if (anam.eq.anams) go to 820
        !           789:       iknt=iknt-1
        !           790:       if (iknt.ne.0) go to 810
        !           791:       go to 880
        !           792:   820 irel=nsbckt-iknt+1
        !           793:       call relmem(isbckt,irel)
        !           794:       nsbckt=nsbckt-irel
        !           795:       go to 50
        !           796:   880 write (6,881) anam
        !           797:   881 format('0*error*:  unknown subcircuit name:  ',a8/)
        !           798:       go to 40
        !           799:   890 write (6,891)
        !           800:   891 format('0warning:  no subcircuit definition known -- line ignored'
        !           801:      1/)
        !           802:       go to 50
        !           803: c
        !           804: c  subcircuit call
        !           805: c
        !           806:   900 call getm4(nodplc(loc+2),0)
        !           807:       ifld=1
        !           808:       iknt=0
        !           809:   910 ifld=ifld+1
        !           810:       if (nodplc(icode+ifld).ne.0) go to 920
        !           811:       call extmem(nodplc(loc+2),1)
        !           812:       iknt=iknt+1
        !           813:       ispot=nodplc(loc+2)+iknt
        !           814:       if (value(ifield+ifld).lt.0.0d0) go to 400
        !           815:       nodplc(ispot)=value(ifield+ifld)
        !           816:       go to 910
        !           817:   920 if (iknt.eq.0) go to 410
        !           818:       if (nodplc(icode+ifld).ne.1) go to 990
        !           819:       call extnam(value(ifield+ifld),nodplc(loc+3))
        !           820:       go to 50
        !           821:   990 write (6,991)
        !           822:   991 format('0*error*:  subcircuit name missing'/)
        !           823:       go to 40
        !           824: c
        !           825: c  end
        !           826: c
        !           827:  5000 if (nsbckt.eq.0) go to 5010
        !           828:       nsbckt=0
        !           829:       write (6,5001)
        !           830:  5001 format('0*error*:  .ends  card missing'/)
        !           831:       nogo=1
        !           832:  5010 call clrmem(ifield)
        !           833:       call clrmem(icode)
        !           834:       call clrmem(idelim)
        !           835:       call clrmem(icolum)
        !           836:       call clrmem(isbckt)
        !           837:       if (nfour.eq.0) call clrmem(ifour)
        !           838:       if (nsens.eq.0) call clrmem(isens)
        !           839:  6000 call second(t2)
        !           840:       rstats(1)=t2-t1
        !           841:       return
        !           842:       end
        !           843:       double precision function alias(anam)
        !           844:       implicit double precision (a-h,o-z)
        !           845:       dimension anam1(15),anam2(15)
        !           846:       data anam1 /3his ,3hva ,3hne ,3hvb ,3hnc ,3hccs,3hns ,
        !           847:      1            3hpe ,3hme ,3hpc ,3hmc ,3hps ,3hms ,3hik ,3hikr/
        !           848:       data anam2 /3hjs ,3hvbf,3hnle,3hvbr,3hnlc,3hcjs,3hnss,
        !           849:      1            3hvje,3hmje,3hvjc,3hmjc,3hvjs,3hmjs,3hjbf,3hjbr/
        !           850: c
        !           851: c  this function returns the mgp equivalent of the gp parameters
        !           852: c  (those which apply)
        !           853: c
        !           854:       iknt=0
        !           855:       alias=anam
        !           856:    10 iknt=iknt+1
        !           857:       if(iknt.gt.15) return
        !           858:       if(anam1(iknt).ne.anam) go to 10
        !           859:       alias=anam2(iknt)
        !           860:       return
        !           861:       end
        !           862:       subroutine keysrc(keytab,lentab,tstwrd,index)
        !           863:       implicit double precision (a-h,o-z)
        !           864:       double precision keytab
        !           865: c
        !           866: c     this routine searches the keyword table 'keytab' for the possible
        !           867: c entry 'tstwrd'.  abbreviations are considered as matches.
        !           868: c
        !           869:       dimension keytab(lentab)
        !           870:       integer xxor
        !           871:       data ablnk / 1h  /
        !           872: c
        !           873: c
        !           874:       index=0
        !           875:       lenwrd=0
        !           876:       achar=ablnk
        !           877:       do 10 i=1,8
        !           878:       call move(achar,8,tstwrd,i,1)
        !           879:       if (achar.eq.ablnk) go to 20
        !           880:       lenwrd=lenwrd+1
        !           881:    10 continue
        !           882: c
        !           883:    20 if (lenwrd.eq.0) go to 40
        !           884:       tstchr=ablnk
        !           885:       call move(tstchr,8,tstwrd,1,1)
        !           886:    30 index=index+1
        !           887:       if (index.gt.lentab) go to 40
        !           888:       akey=ablnk
        !           889:       call move(akey,1,keytab(index),1,lenwrd)
        !           890:       if (xxor(akey,tstwrd).eq.0) go to 50
        !           891:       go to 30
        !           892: c
        !           893:    40 index=-1
        !           894:    50 return
        !           895:       end
        !           896:       subroutine extnam(aname,index)
        !           897:       implicit double precision (a-h,o-z)
        !           898: c
        !           899: c     this routine adds 'aname' to the list of 'unsatisfied' names (that
        !           900: c is, names which can only be resolved after subcircuit expansion).
        !           901: c
        !           902:       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
        !           903:      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
        !           904:      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
        !           905:      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
        !           906:      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
        !           907:      5   imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
        !           908:       common /blank/ value(1000)
        !           909:       integer nodplc(64)
        !           910:       complex*16 cvalue(32)
        !           911:       equivalence (value(1),nodplc(1),cvalue(1))
        !           912:       integer xxor
        !           913: c
        !           914: c
        !           915:       anam=aname
        !           916:       if (nunsat.eq.0) go to 20
        !           917:       do 10 index=1,nunsat
        !           918:       if (xxor(anam,value(iunsat+index)).eq.0) go to 30
        !           919:    10 continue
        !           920: c
        !           921:    20 call extmem(iunsat,1)
        !           922:       nunsat=nunsat+1
        !           923:       index=nunsat
        !           924:       value(iunsat+index)=anam
        !           925:    30 return
        !           926:       end
        !           927:       subroutine runcon(id)
        !           928:       implicit double precision (a-h,o-z)
        !           929: c
        !           930: c     this routine processes run control cards.
        !           931: c
        !           932:       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
        !           933:      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
        !           934:      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
        !           935:      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
        !           936:      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
        !           937:      5   imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
        !           938:       common /cje/ maxtim,itime,icost
        !           939:       common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
        !           940:      1  defas,rstats(50),iwidth,lwidth,nopage
        !           941:       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
        !           942:      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
        !           943:       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
        !           944:      1   xmu,mode,modedc,icalc,initf,method,iord,maxord,noncon,iterno,
        !           945:      2   itemno,nosolv,ipostp,iscrch
        !           946:       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
        !           947:      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
        !           948:       common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok,
        !           949:      1   gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox
        !           950:       common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop,
        !           951:      1   kinel,kidin,kovar,kidout
        !           952:       common /ac/ fstart,fstop,fincr,skw2,refprl,spw2,jacflg,idfreq,
        !           953:      1   inoise,nosprt,nosout,nosin,idist,idprt
        !           954:       common /tran/ tstep,tstop,tstart,delmax,tdmax,forfre,jtrflg
        !           955:       common /outinf/ xincr,string(15),xstart,yvar(8),itab(8),itype(8),
        !           956:      1   ilogy(8),npoint,numout,kntr,numdgt
        !           957:       common /blank/ value(1000)
        !           958:       integer nodplc(64)
        !           959:       complex*16 cvalue(32)
        !           960:       equivalence (value(1),nodplc(1),cvalue(1))
        !           961:       dimension iprnt(5),limits(4),itrlim(5),contol(6),dflts(4)
        !           962:       equivalence (iprnt(1),iprnta),(limits(1),limtim),(itrlim(1),itl1),
        !           963:      1   (contol(1),gmin),(dflts(1),defl)
        !           964: c
        !           965: c
        !           966:       integer xxor
        !           967: c
        !           968: c  print/plot keywords
        !           969: c
        !           970:       dimension aopt(5)
        !           971:       dimension aopts(31),lsetop(5)
        !           972:       dimension aide(20)
        !           973:       data aopt / 2hdc, 2htr, 2hac, 2hno, 2hdi /
        !           974: c
        !           975: c  options card keywords
        !           976: c
        !           977:       data aopts / 6hnoacct, 6hnolist, 6hnomod , 6hnonode, 6hopts  ,
        !           978:      1             6hitl1  , 6hitl2  , 6hitl3  , 6hitl4  , 6hitl5  ,
        !           979:      2             6hlimtim, 6hlimpts, 6hlvlcod, 6hlvltim, 6hgmin  ,
        !           980:      3             6hreltol, 6habstol, 6hvntol , 6htrtol , 6hchgtol,
        !           981:      4             6htnom  , 6hnumdgt, 6hmaxord, 6hmethod, 6hnopage,
        !           982:      5             6hmu    , 6hcptime, 6hdefl  , 6hdefw  , 6hdefad ,
        !           983:      6             6hdefas /
        !           984:       data lsetop / 0 ,0, 0, 0, 1 /
        !           985: c
        !           986: c
        !           987:       data aide / 1hr,1hc,1hl,1hk,1hg,1he,1hf,1hh,1hv,1hi,1hd,1hq,1hj,
        !           988:      1   1hm,1hs,1hy,1ht,0.0d0,1hx,0.0d0 /
        !           989:       data alsde,alsoc,alsli / 3hdec, 3hoct, 3hlin /
        !           990:       data atrap, agear, auic / 4htrap, 4hgear, 3huic /
        !           991:       data ablnk, ain, aout / 1h , 2hin, 3hout /
        !           992:       data amiss / 8h*missing /
        !           993:       data ams / 2hms /
        !           994:       data minpts / 1 /
        !           995: c
        !           996: c
        !           997:       go to (1200,1100,1650,6000,6000,1700,6000,1600,1550,2000,3600,
        !           998:      1   3500,6000,1750,1300,1500,1800,4000,4100,4200), id
        !           999: c
        !          1000: c  dc transfer curves
        !          1001: c
        !          1002:  1100 ifld=2
        !          1003:       icvflg=0
        !          1004:       inum=1
        !          1005:  1105 anam=value(ifield+ifld)
        !          1006:       if(inum.gt.2) go to 6000
        !          1007:       id=0
        !          1008:       call move(anam,2,ablnk,1,7)
        !          1009:       if (anam.eq.aide(9)) id=9
        !          1010:       if (anam.eq.aide(10)) id=10
        !          1011:       if (id.eq.0) go to 1130
        !          1012:       call find(value(ifield+ifld),id,itcelm(inum),0)
        !          1013:       ifld=ifld+1
        !          1014:       if (nodplc(icode+ifld).ne.0) go to 1130
        !          1015:       tcstar(inum)=value(ifield+ifld)
        !          1016:       ifld=ifld+1
        !          1017:       if (nodplc(icode+ifld).ne.0) go to 1130
        !          1018:       tcstop(inum)=value(ifield+ifld)
        !          1019:       ifld=ifld+1
        !          1020:       if (nodplc(icode+ifld).ne.0) go to 1130
        !          1021:       tcincr(inum)=value(ifield+ifld)
        !          1022:       if (tcincr(inum).eq.0.0d0) go to 1130
        !          1023:       temp=(tcstop(inum)-tcstar(inum))/tcincr(inum)
        !          1024:       if (temp.gt.0.0d0) go to 1110
        !          1025:       tcincr(inum)=-tcincr(inum)
        !          1026:       temp=-temp
        !          1027:  1110 itemp=idint(temp+0.5d0)+1
        !          1028:       itemp=max0(itemp,minpts)
        !          1029:       if(inum.eq.1) icvflg=itemp
        !          1030:       if(inum.eq.2) icvflg=itemp*icvflg
        !          1031:       ifld=ifld+1
        !          1032:       inum=2
        !          1033:       if(nodplc(icode+ifld)) 6000,1130,1105
        !          1034:  1130 write (6,1131)
        !          1035:       icvflg=0
        !          1036:  1131 format('0warning:  missing parameter(s) ... analysis omitted'/)
        !          1037:       go to 6000
        !          1038: c
        !          1039: c  frequency specification
        !          1040: c
        !          1041:  1200 ifld=2
        !          1042:       if (nodplc(icode+2)) 1250,1250,1210
        !          1043:  1210 id=0
        !          1044:       if (value(ifield+ifld).eq.alsde) id=1
        !          1045:       if (value(ifield+ifld).eq.alsoc) id=2
        !          1046:       if (value(ifield+ifld).eq.alsli) id=3
        !          1047:       if (id.eq.0) go to 1240
        !          1048:       idfreq=id
        !          1049:       ifld=ifld+1
        !          1050:       if (nodplc(icode+ifld).ne.0) go to 1250
        !          1051:       if (value(ifield+ifld).le.0.0d0) go to 1250
        !          1052:       fincr=value(ifield+ifld)
        !          1053:       ifld=ifld+1
        !          1054:       if (nodplc(icode+ifld).ne.0) go to 1250
        !          1055:       if (value(ifield+ifld).le.0.0d0) go to 1250
        !          1056:       fstart=value(ifield+ifld)
        !          1057:       ifld=ifld+1
        !          1058:       if (nodplc(icode+ifld).ne.0) go to 1250
        !          1059:       if (value(ifield+ifld).le.0.0d0) go to 1250
        !          1060:       fstop=value(ifield+ifld)
        !          1061:       if (fstart.gt.fstop) go to 1260
        !          1062:       jacflg=fincr
        !          1063:       if (idfreq-2) 1215,1220,1235
        !          1064:  1215 fincr=dexp(xlog10/fincr)
        !          1065:       go to 1230
        !          1066:  1220 fincr=dexp(xlog2/fincr)
        !          1067:  1230 temp=dlog(fstop/fstart)/dlog(fincr)
        !          1068:       jacflg=idint(temp+0.999d0)+1
        !          1069:  1235 jacflg=max0(jacflg,minpts)
        !          1070:       if (idfreq.ne.3) go to 6000
        !          1071:       fincr=(fstop-fstart)/dfloat(max0(jacflg-1,1))
        !          1072:       go to 6000
        !          1073:  1240 write (6,1241) value(ifield+ifld)
        !          1074:  1241 format('0warning:  unknown frequency function:  ',a8,' ... analys'
        !          1075:      1   ,'is omitted'/)
        !          1076:       go to 6000
        !          1077:  1250 write (6,1251)
        !          1078:  1251 format('0warning:  frequency parameters incorrect ... analysis om'
        !          1079:      1   ,'itted'/)
        !          1080:       go to 6000
        !          1081:  1260 write (6,1261)
        !          1082:  1261 format('0warning:  start freq > stop freq ... analysis omitted'/)
        !          1083:       go to 6000
        !          1084: c
        !          1085: c  time specification
        !          1086: c
        !          1087:  1300 ifld=2
        !          1088:       if (nodplc(icode+ifld).ne.0) go to 1430
        !          1089:       if (value(ifield+ifld).le.0.0d0) go to 1430
        !          1090:       tstep=value(ifield+ifld)
        !          1091:       ifld=ifld+1
        !          1092:       if (nodplc(icode+ifld).ne.0) go to 1430
        !          1093:       if (value(ifield+ifld).le.0.0d0) go to 1430
        !          1094:       tstop=value(ifield+ifld)
        !          1095:       tstart=0.0d0
        !          1096:       delmax=tstop/50.0d0
        !          1097:       ifld=ifld+1
        !          1098:       if (nodplc(icode+ifld).ne.0) go to 1310
        !          1099:       if (value(ifield+ifld).lt.0.0d0) go to 1430
        !          1100:       tstart=value(ifield+ifld)
        !          1101:       delmax=(tstop-tstart)/50.0d0
        !          1102:       ifld=ifld+1
        !          1103:       if (nodplc(icode+ifld).ne.0) go to 1310
        !          1104:       if (value(ifield+ifld).le.0.0d0) go to 1430
        !          1105:       delmax=value(ifield+ifld)
        !          1106:       ifld=ifld+1
        !          1107:  1310 if (nodplc(icode+ifld).ne.1) go to 1320
        !          1108:       if (value(ifield+ifld).ne.auic) go to 1320
        !          1109:       nosolv=1
        !          1110:  1320 if (tstart.gt.tstop) go to 1440
        !          1111:       if (tstep.gt.tstop) go to 1430
        !          1112:       jtrflg=idint((tstop-tstart)/tstep+0.5d0)+1
        !          1113:       jtrflg=max0(jtrflg,minpts)
        !          1114:       go to 6000
        !          1115:  1430 write (6,1431)
        !          1116:  1431 format('0warning:  time parameters incorrect ... analysis omitted'
        !          1117:      1   /)
        !          1118:       go to 6000
        !          1119:  1440 write (6,1441)
        !          1120:  1441 format('0warning:  start time > stop time ... analysis omitted'/)
        !          1121:       go to 6000
        !          1122: c
        !          1123: c  transfer function
        !          1124: c
        !          1125:  1500 kssop=1
        !          1126:       ifld=2
        !          1127:       if (nodplc(icode+ifld).ne.1) go to 1530
        !          1128:       call outdef(ifld,1,kovar,ktype)
        !          1129:       if (igoof.ne.0) go to 1530
        !          1130:       if (ktype.ne.1) go to 1540
        !          1131:       ifld=ifld+1
        !          1132:       if (nodplc(icode+ifld).ne.1) go to 1530
        !          1133:       anam=value(ifield+ifld)
        !          1134:       call move(anam,2,ablnk,1,7)
        !          1135:       id=0
        !          1136:       if (anam.eq.aide(9)) id=9
        !          1137:       if (anam.eq.aide(10)) id=10
        !          1138:       if (id.eq.0) go to 1530
        !          1139:       call find(value(ifield+ifld),id,kinel,0)
        !          1140:       kidin=id
        !          1141:       go to 6000
        !          1142:  1530 kovar=0
        !          1143:       kinel=0
        !          1144:       write (6,1131)
        !          1145:       igoof=0
        !          1146:       go to 6000
        !          1147:  1540 kovar=0
        !          1148:       kinel=0
        !          1149:       write (6,1541)
        !          1150:  1541 format('0warning:  illegal output variable ... analysis omitted'/)
        !          1151:       igoof=0
        !          1152:       go to 6000
        !          1153: c
        !          1154: c  operating point
        !          1155: c
        !          1156:  1550 kssop=1
        !          1157:       go to 6000
        !          1158: c
        !          1159: c  noise analysis
        !          1160: c
        !          1161:  1600 ifld=2
        !          1162:       if (nodplc(icode+ifld).ne.1) go to 1610
        !          1163:       call outdef(ifld,2,nosout,ntype)
        !          1164:       if (igoof.ne.0) go to 1610
        !          1165:       if (ntype.ne.1) go to 1610
        !          1166:       if (nodplc(nosout+5).ne.0) go to 1610
        !          1167:       ifld=ifld+1
        !          1168:       if (nodplc(icode+ifld).ne.1) go to 1620
        !          1169:       anam=value(ifield+ifld)
        !          1170:       call move(anam,2,ablnk,1,7)
        !          1171:       id=0
        !          1172:       if (anam.eq.aide(9)) id=9
        !          1173:       if (anam.eq.aide(10)) id=10
        !          1174:       if (id.eq.0) go to 1620
        !          1175:       call find(value(ifield+ifld),id,nosin,0)
        !          1176:       nosprt=0
        !          1177:       ifld=ifld+1
        !          1178:       if (nodplc(icode+ifld).ne.0) go to 1605
        !          1179:       nosprt=dmax1(0.0d0,value(ifield+ifld))
        !          1180:  1605 inoise=1
        !          1181:       go to 6000
        !          1182:  1610 write (6,1611)
        !          1183:  1611 format('0warning:  voltage output unrecognizable ... analysis omit
        !          1184:      1ted'/)
        !          1185:       igoof=0
        !          1186:       go to 6000
        !          1187:  1620 write (6,1621)
        !          1188:  1621 format('0warning:  invalid input source ... analysis omitted'/)
        !          1189:       igoof=0
        !          1190:       go to 6000
        !          1191: c
        !          1192: c  distortion analysis
        !          1193: c
        !          1194:  1650 ifld=2
        !          1195:       if (nodplc(icode+ifld).ne.1) go to 1660
        !          1196:       anam=value(ifield+ifld)
        !          1197:       call move(anam,2,ablnk,1,7)
        !          1198:       if (anam.ne.aide(1)) go to 1660
        !          1199:       call find(value(ifield+ifld),1,idist,0)
        !          1200:       idprt=0
        !          1201:       skw2=0.9d0
        !          1202:       refprl=1.0d-3
        !          1203:       spw2=1.0d0
        !          1204:       ifld=ifld+1
        !          1205:       if (nodplc(icode+ifld).ne.0) go to 6000
        !          1206:       idprt=value(ifield+ifld)
        !          1207:       idprt=max0(idprt,0)
        !          1208:       ifld=ifld+1
        !          1209:       if (nodplc(icode+ifld).ne.0) go to 6000
        !          1210:       if (value(ifield+ifld).le.0.001d0) go to 1670
        !          1211:       if (value(ifield+ifld).gt.0.999d0) go to 1670
        !          1212:       skw2=value(ifield+ifld)
        !          1213:       ifld=ifld+1
        !          1214:       if (nodplc(icode+ifld).ne.0) go to 6000
        !          1215:       if (value(ifield+ifld).lt.1.0d-10) go to 1670
        !          1216:       refprl=value(ifield+ifld)
        !          1217:       ifld=ifld+1
        !          1218:       if (nodplc(icode+ifld).ne.0) go to 6000
        !          1219:       if (value(ifield+ifld).lt.0.001d0) go to 1670
        !          1220:       spw2=value(ifield+ifld)
        !          1221:       go to 6000
        !          1222:  1660 write (6,1661)
        !          1223:  1661 format('0warning:  distortion load resistor missing ... analysis '
        !          1224:      1   ,'omitted'/)
        !          1225:       go to 6000
        !          1226:  1670 idist=0
        !          1227:       write (6,1671)
        !          1228:  1671 format('0warning:  distortion parameters incorrect ... analysis o'
        !          1229:      1   ,'mitted'/)
        !          1230:       go to 6000
        !          1231: c
        !          1232: c  fourier analysis
        !          1233: c
        !          1234:  1700 ifld=2
        !          1235:       if (nodplc(icode+ifld).ne.0) go to 1720
        !          1236:       if (value(ifield+ifld).le.0.0d0) go to 1720
        !          1237:       forfre=value(ifield+ifld)
        !          1238:  1705 ifld=ifld+1
        !          1239:       if (nodplc(icode+ifld).ne.1) go to 1710
        !          1240:       call outdef(ifld,2,loct,ltype)
        !          1241:       if (igoof.ne.0) go to 1720
        !          1242:       if (ltype.ne.1) go to 1720
        !          1243:       call extmem(ifour,1)
        !          1244:       nfour=nfour+1
        !          1245:       nodplc(ifour+nfour)=loct
        !          1246:       go to 1705
        !          1247:  1710 if (nfour.ge.1) go to 6000
        !          1248:  1720 write (6,1721)
        !          1249:  1721 format('0warning:  fourier parameters incorrect ... analysis omit'
        !          1250:      1   ,'ted'/)
        !          1251:       igoof=0
        !          1252:       nfour=0
        !          1253:       call clrmem(ifour)
        !          1254:       call getm4(ifour,0)
        !          1255:       go to 6000
        !          1256: c
        !          1257: c  sensitivity analysis
        !          1258: c
        !          1259:  1750 kssop=1
        !          1260:       ifld=1
        !          1261:  1760 ifld=ifld+1
        !          1262:       if (nodplc(icode+ifld).ne.1) go to 6000
        !          1263:       call outdef(ifld,1,loct,ltype)
        !          1264:       if (igoof.ne.0) go to 1780
        !          1265:       if (ltype.ne.1) go to 1780
        !          1266:       call extmem(isens,1)
        !          1267:       nsens=nsens+1
        !          1268:       nodplc(isens+nsens)=loct
        !          1269:       go to 1760
        !          1270:  1780 write (6,1781)
        !          1271:  1781 format('0warning:  output variable unrecognizable ... analysis om'
        !          1272:      1   ,'mitted'/)
        !          1273:       igoof=0
        !          1274:       nsens=0
        !          1275:       call clrmem(isens)
        !          1276:       call getm4(isens,0)
        !          1277:       go to 6000
        !          1278: c
        !          1279: c  temperature variation
        !          1280: c
        !          1281:  1800 ifld=1
        !          1282:  1810 ifld=ifld+1
        !          1283:       if (nodplc(icode+ifld).ne.0) go to 6000
        !          1284:       if (value(ifield+ifld).le.-223.0d0) go to 1810
        !          1285:       call extmem(itemps,1)
        !          1286:       numtem=numtem+1
        !          1287:       value(itemps+numtem)=value(ifield+ifld)
        !          1288:       go to 1810
        !          1289: c
        !          1290: c  options card
        !          1291: c
        !          1292:  2000 ifld=1
        !          1293:  2010 ifld=ifld+1
        !          1294:  2020 if (nodplc(icode+ifld)) 6000,2010,2030
        !          1295:  2030 anam=value(ifield+ifld)
        !          1296:       do 2040 i=1,5
        !          1297:       if (anam.ne.aopts(i)) go to 2040
        !          1298:       iprnt(i)=lsetop(i)
        !          1299:       ifld=ifld+1
        !          1300:       if(nodplc(icode+ifld).ne.0) go to 2020
        !          1301:       iprnt(i)=value(ifield+ifld)
        !          1302:       go to 2010
        !          1303:  2040 continue
        !          1304:       if (anam.eq.aopts(24)) go to 2110
        !          1305:       if (anam.eq.aopts(25)) go to 2120
        !          1306:       if(anam.eq.aopts(26)) go to 2130
        !          1307:       if(anam.eq.aopts(27)) go to 2150
        !          1308:       if (nodplc(icode+ifld+1).ne.0) go to 2510
        !          1309:       ifld=ifld+1
        !          1310:       aval=value(ifield+ifld)
        !          1311:       do 2050 i=6,10
        !          1312:       if (anam.ne.aopts(i)) go to 2050
        !          1313:       if(aval.le.0.0d0.and.i.ne.10) go to 2510
        !          1314:       itrlim(i-5)=aval
        !          1315:       go to 2010
        !          1316:  2050 continue
        !          1317:       if (aval.le.0.0d0) go to 2510
        !          1318:       do 2060 i=11,14
        !          1319:       if (anam.ne.aopts(i)) go to 2060
        !          1320:       limits(i-10)=aval
        !          1321:       go to 2010
        !          1322:  2060 continue
        !          1323:       do 2070 i=15,20
        !          1324:       if (anam.ne.aopts(i)) go to 2070
        !          1325:       contol(i-14)=aval
        !          1326:       go to 2010
        !          1327:  2070 continue
        !          1328:       do 2075 i=28,31
        !          1329:       if(anam.ne.aopts(i)) go to 2075
        !          1330:       dflts(i-27)=aval
        !          1331:       go to 2010
        !          1332:  2075 continue
        !          1333:       if (anam.ne.aopts(21)) go to 2080
        !          1334:       if (aval.lt.-223.0d0) go to 2510
        !          1335:       value(itemps+1)=aval
        !          1336:       go to 2010
        !          1337:  2080 if (anam.ne.aopts(22)) go to 2100
        !          1338:       ndigit=aval
        !          1339:       if (ndigit.le.7) go to 2090
        !          1340:       ndigit=7
        !          1341:       write (6,2081) ndigit
        !          1342:  2081 format('0warning:  numdgt may not exceed',i2,
        !          1343:      1 ';  maximum value assumed'/)
        !          1344:  2090 numdgt=ndigit
        !          1345:       go to 2010
        !          1346:  2100 if (anam.ne.aopts(23)) go to 2500
        !          1347:       n=aval
        !          1348:       if ((n.le.1).or.(n.ge.7)) go to 2510
        !          1349:       maxord=n
        !          1350:       go to 2010
        !          1351:  2110 if (nodplc(icode+ifld+1).ne.1) go to 2510
        !          1352:       ifld=ifld+1
        !          1353:       anam=value(ifield+ifld)
        !          1354:       call move(anam,5,ablnk,1,4)
        !          1355:       jtype=0
        !          1356:       if (anam.eq.atrap) jtype=1
        !          1357:       if (anam.eq.agear) jtype=2
        !          1358:       if (jtype.eq.0) go to 2510
        !          1359:       method=jtype
        !          1360:       go to 2010
        !          1361:  2120 nopage=1
        !          1362:       go to 2010
        !          1363:  2130 ifld=ifld+1
        !          1364:       if(nodplc(icode+ifld)) 6000,2140,2010
        !          1365:  2140 aval=value(ifield+ifld)
        !          1366:       if(aval.lt.0.0d0.or.aval.gt.0.500001d0) go to 2510
        !          1367:       xmu=aval
        !          1368:       go to 2010
        !          1369:  2150 ifld=ifld+1
        !          1370:       if(nodplc(icode+ifld)) 6000,2160,2010
        !          1371:  2160 aval=value(ifield+ifld)
        !          1372:       maxtim=aval
        !          1373:       go to 2010
        !          1374:  2500 write (6,2501) anam
        !          1375:  2501 format('0warning:  unknown option:  ',a8,' ... ignored'/)
        !          1376:       go to 2010
        !          1377:  2510 write (6,2511) anam
        !          1378:  2511 format('0warning:  illegal value specified for option:  ',a8,' ...
        !          1379:      1 ignored'/)
        !          1380:       go to 2010
        !          1381: c
        !          1382: c  print card
        !          1383: c
        !          1384:  3500 iprpl=0
        !          1385:       go to 3610
        !          1386: c
        !          1387: c  plot (and print) card
        !          1388: c
        !          1389:  3600 iprpl=1
        !          1390:  3610 ifld=2
        !          1391:  3613 anam=amiss
        !          1392:       if (nodplc(icode+ifld).ne.1) go to 3950
        !          1393:       anam=value(ifield+ifld)
        !          1394:       ms=0
        !          1395:       if (xxor(anam,ams).ne.0) go to 3615
        !          1396:       ms=1
        !          1397:       ifld=3
        !          1398:       if (nodplc(icode+ifld).ne.1) go to 3970
        !          1399:       anam=value(ifield+ifld)
        !          1400:  3615 call move(anam,3,ablnk,1,6)
        !          1401:       do 3620 i=1,5
        !          1402:       if (anam.ne.aopt(i)) go to 3620
        !          1403:       ktype=i
        !          1404:       go to 3630
        !          1405:  3620 continue
        !          1406:       go to 3950
        !          1407:  3630 id=30+5*iprpl+ktype
        !          1408:       call find(dfloat(jelcnt(id)),id,loc,1)
        !          1409:       nodplc(loc+2)=ktype
        !          1410:       if (ms.eq.0) go to 3635
        !          1411:       locv=nodplc(loc+1)
        !          1412:       value(locv)=0.0d0
        !          1413:  3635 numout=0
        !          1414:  3640 ifld=ifld+1
        !          1415:       if (nodplc(icode+ifld)) 3900,3640,3650
        !          1416:  3650 call outdef(ifld,ktype,loct,ltype)
        !          1417:       if (igoof.ne.0) go to 3970
        !          1418:       if (iprpl.eq.0) go to 3660
        !          1419:       plimlo=0.0d0
        !          1420:       plimhi=0.0d0
        !          1421:       if (nodplc(icode+ifld+1).ne.0) go to 3660
        !          1422:       if (nodplc(icode+ifld+2).ne.0) go to 3660
        !          1423:       plimlo=value(ifield+ifld+1)
        !          1424:       plimhi=value(ifield+ifld+2)
        !          1425:       ifld=ifld+2
        !          1426:  3660 numout=numout+1
        !          1427:       lspot=loc+2*numout+2
        !          1428:       nodplc(lspot)=loct
        !          1429:       nodplc(lspot+1)=ltype
        !          1430:       if (iprpl.eq.0) go to 3670
        !          1431:       locv=nodplc(loc+1)
        !          1432:       lspot=locv+2*numout-1
        !          1433:       value(lspot)=plimlo
        !          1434:       value(lspot+1)=plimhi
        !          1435:  3670 if (numout.eq.8) go to 3900
        !          1436:       go to 3640
        !          1437:  3900 nodplc(loc+3)=numout
        !          1438:       if (iprpl.eq.0) go to 6000
        !          1439: c...  propogate plot limits downward
        !          1440:       if (numout.le.1) go to 6000
        !          1441:       locv=nodplc(loc+1)
        !          1442:       lspot=locv+2*numout-1
        !          1443:       plimlo=value(lspot)
        !          1444:       plimhi=value(lspot+1)
        !          1445:       i=numout-1
        !          1446:  3905 lspot=lspot-2
        !          1447:       if (value(lspot).ne.0.0d0) go to 3910
        !          1448:       if (value(lspot+1).ne.0.0d0) go to 3910
        !          1449:       value(lspot)=plimlo
        !          1450:       value(lspot+1)=plimhi
        !          1451:       go to 3920
        !          1452:  3910 plimlo=value(lspot)
        !          1453:       plimhi=value(lspot+1)
        !          1454:  3920 i=i-1
        !          1455:       if (i.ge.1) go to 3905
        !          1456:       go to 6000
        !          1457: c
        !          1458: c     errors
        !          1459: c
        !          1460:  3950 write (6,3951) anam
        !          1461:  3951 format('0warning:  unknown analysis mode:  ',a8,
        !          1462:      1  ' ... line ignored'/)
        !          1463:       go to 6000
        !          1464:  3970 write (6,3971)
        !          1465:  3971 format('0warning:  unrecognizable output variable on above line'/)
        !          1466:       igoof=0
        !          1467:       go to 3640
        !          1468: c
        !          1469: c  width card
        !          1470: c
        !          1471:  4000 ifld=1
        !          1472:  4010 ifld=ifld+1
        !          1473:       if (nodplc(icode+ifld).ne.1) go to 6000
        !          1474:  4020 anam=value(ifield+ifld)
        !          1475:       if (anam.ne.ain) go to 4040
        !          1476:       ifld=ifld+1
        !          1477:       if (nodplc(icode+ifld)) 6000,4030,4020
        !          1478:  4030 iwidth=value(ifield+ifld)
        !          1479:       iwidth=min0(max0(iwidth,10),120)
        !          1480:       go to 4010
        !          1481:  4040 if (anam.ne.aout) go to 6000
        !          1482:       ifld=ifld+1
        !          1483:       if (nodplc(icode+ifld)) 6000,4050,4020
        !          1484:  4050 lwidth=dmin1(dmax1(value(ifield+ifld),72.0d0),132.0d0)
        !          1485:       go to 4010
        !          1486: c
        !          1487: c  nodeset statement
        !          1488: c
        !          1489:  4100 ifld=1
        !          1490:  4110 ifld=ifld+1
        !          1491:       if(nodplc(icode+ifld)) 6000,4120,4110
        !          1492:  4120 nodnum=value(ifield+ifld)
        !          1493:       if(nodnum.le.0) go to 4190
        !          1494:       ifld=ifld+1
        !          1495:       if(nodplc(icode+ifld)) 4180,4130,4170
        !          1496:  4130 call sizmem(nsnod,nic)
        !          1497:       call extmem(nsnod,1)
        !          1498:       call extmem(nsval,1)
        !          1499:       nodplc(nsnod+nic+1)=nodnum
        !          1500:       value(nsval+nic+1)=value(ifield+ifld)
        !          1501:       go to 4110
        !          1502: c
        !          1503: c  errors on .nodeset statement
        !          1504: c
        !          1505:  4170 write(6,4171) value(ifield+ifld)
        !          1506:  4171 format('0warning: out-of-place non-numeric field ',a8,
        !          1507:      1 ' skipped'/)
        !          1508:       go to 4110
        !          1509:  4180 write(6,4181) nodnum
        !          1510:  4181 format('0warning: initial value missing for node ',i5,/)
        !          1511:       go to 6000
        !          1512:  4190 write(6,4191)
        !          1513:  4191 format('0warning: attempt to specify initial condition for ',
        !          1514:      1 'ground ingnored',/)
        !          1515:       ifld=ifld+1
        !          1516:       if(nodplc(icode+ifld)) 6000,4110,4170
        !          1517: c
        !          1518: c  initial conditions statement
        !          1519: c
        !          1520:  4200 ifld=1
        !          1521:  4210 ifld=ifld+1
        !          1522:       if(nodplc(icode+ifld)) 6000,4220,4210
        !          1523:  4220 nodnum=value(ifield+ifld)
        !          1524:       if(nodnum.le.0) go to 4290
        !          1525:       ifld=ifld+1
        !          1526:       if(nodplc(icode+ifld)) 4280,4230,4270
        !          1527:  4230 call sizmem(icnod,nic)
        !          1528:       call extmem(icnod,1)
        !          1529:       call extmem(icval,1)
        !          1530:       nodplc(icnod+nic+1)=nodnum
        !          1531:       value(icval+nic+1)=value(ifield+ifld)
        !          1532:       go to 4210
        !          1533: c
        !          1534: c  errors on .ic statement
        !          1535: c
        !          1536:  4270 write(6,4271) value(ifield+ifld)
        !          1537:  4271 format('0warning: out-of-place non-numeric field ',a8,
        !          1538:      1 ' skipped'/)
        !          1539:       go to 4210
        !          1540:  4280 write(6,4281) nodnum
        !          1541:  4281 format('0warning: initial value missing for node ',i5,/)
        !          1542:       go to 6000
        !          1543:  4290 write(6,4291)
        !          1544:  4291 format('0warning: attempt to specify initial condition for ',
        !          1545:      1 'ground ingnored',/)
        !          1546:       ifld=ifld+1
        !          1547:       if(nodplc(icode+ifld)) 6000,4210,4270
        !          1548: c
        !          1549: c  finished
        !          1550: c
        !          1551:  6000 return
        !          1552:       end
        !          1553:       subroutine outdef(ifld,mode,loct,ltype)
        !          1554:       implicit double precision (a-h,o-z)
        !          1555: c
        !          1556: c     this routine constructs the internal list element for an output
        !          1557: c variable defined on some input card.
        !          1558: c
        !          1559:       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
        !          1560:      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
        !          1561:      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
        !          1562:      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
        !          1563:      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
        !          1564:      5   imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
        !          1565:       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
        !          1566:      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
        !          1567:       common /blank/ value(1000)
        !          1568:       integer nodplc(64)
        !          1569:       complex*16 cvalue(32)
        !          1570:       equivalence (value(1),nodplc(1),cvalue(1))
        !          1571: c
        !          1572:       integer xxor
        !          1573:       dimension aout(19),aopts(5)
        !          1574:       data aout / 4hv   , 4hvm  , 4hvr  , 4hvi  , 4hvp  , 4hvdb ,
        !          1575:      1            4hi   , 4him  , 4hir  , 4hii  , 4hip  , 4hidb ,
        !          1576:      2            4honoi, 4hinoi, 4hhd2 , 4hhd3 , 4hdim2, 4hsim2,
        !          1577:      3            4hdim3 /
        !          1578:       data aopts / 1hm, 1hr, 1hi, 1hp, 1hd /
        !          1579:       data alprn, acomma, ablnk, aletv / 1h(, 1h,, 1h , 1hv /
        !          1580: c
        !          1581:       if (nodplc(icode+ifld).ne.1) go to 300
        !          1582:       anam=value(ifield+ifld)
        !          1583:       call move(anam,5,ablnk,1,4)
        !          1584:       do 10 i=1,19
        !          1585:       if (xxor(anam,aout(i)).ne.0) go to 10
        !          1586:       idout=i
        !          1587:       go to 20
        !          1588:    10 continue
        !          1589:       go to 300
        !          1590: c
        !          1591: c  further error checking
        !          1592: c
        !          1593:    20 if (mode.ge.3) go to 25
        !          1594: c...  dc or tran
        !          1595:       if ((idout.ne.1).and.(idout.ne.7)) go to 300
        !          1596:       go to 38
        !          1597:    25 if (mode.ge.4) go to 30
        !          1598: c...  ac
        !          1599:       if (idout.ge.13) go to 300
        !          1600:       go to 38
        !          1601:    30 if (mode.eq.5) go to 35
        !          1602: c...  noise
        !          1603:       if ((idout.ne.13).and.(idout.ne.14)) go to 300
        !          1604:       go to 38
        !          1605: c...  distortion
        !          1606:    35 if (idout.lt.15) go to 300
        !          1607:    38 ktype=0
        !          1608:       ltype=idout
        !          1609:       if (idout.lt.7) go to 40
        !          1610:       ktype=1
        !          1611:       ltype=ltype-6
        !          1612:       if (idout.lt.13) go to 40
        !          1613:       ktype=idout-11
        !          1614:       ltype=1
        !          1615: c
        !          1616: c  voltage output
        !          1617: c
        !          1618:    40 id=40+mode
        !          1619:       if (ktype.ne.0) go to 100
        !          1620:       if (nodplc(icode+ifld+1).ne.0) go to 300
        !          1621:       ifld=ifld+1
        !          1622:       n1=value(ifield+ifld)
        !          1623:       if (n1.lt.0) go to 300
        !          1624:       if(n1.gt.9999) go to 300
        !          1625:       n2=0
        !          1626:       adelim=value(idelim+ifld)
        !          1627:       if (adelim.eq.acomma) go to 45
        !          1628:       if (adelim.ne.ablnk) go to 50
        !          1629:    45 if (nodplc(icode+ifld+1).ne.0) go to 300
        !          1630:       ifld=ifld+1
        !          1631:       n2=value(ifield+ifld)
        !          1632:       if (n2.lt.0) go to 300
        !          1633:       if(n2.gt.9999) go to 300
        !          1634:    50 outnam=ablnk
        !          1635:       ipos=1
        !          1636:       call alfnum(n1,outnam,ipos)
        !          1637:       ipos=5
        !          1638:       call alfnum(n2,outnam,ipos)
        !          1639:       call find(outnam,id,loct,0)
        !          1640:       nodplc(loct+2)=n1
        !          1641:       nodplc(loct+3)=n2
        !          1642:       go to 400
        !          1643: c
        !          1644: c  current output
        !          1645: c
        !          1646:   100 if (ktype.ne.1) go to 200
        !          1647:       if (nodplc(icode+ifld+1).ne.1) go to 300
        !          1648:       ifld=ifld+1
        !          1649:       avsrc=value(ifield+ifld)
        !          1650:       achek=avsrc
        !          1651:       call move(achek,2,ablnk,1,7)
        !          1652:       if (achek.ne.aletv) go to 300
        !          1653:       call find(avsrc,id,loct,0)
        !          1654:       call find(avsrc,9,nodplc(loct+2),0)
        !          1655:       nodplc(loct+5)=1
        !          1656:       go to 400
        !          1657: c
        !          1658: c  noise or distortion outputs
        !          1659: c
        !          1660:   200 id=44
        !          1661:       if (ktype.ge.4) id=id+1
        !          1662:       if (value(idelim+ifld).ne.alprn) go to 220
        !          1663:       if (nodplc(icode+ifld+1).ne.1) go to 300
        !          1664:       ifld=ifld+1
        !          1665:       atype=value(ifield+ifld)
        !          1666:       call move(atype,2,ablnk,1,7)
        !          1667:       do 210 i=1,5
        !          1668:       if (atype.ne.aopts(i)) go to 210
        !          1669:       ltype=i+1
        !          1670:       go to 220
        !          1671:   210 continue
        !          1672:       go to 300
        !          1673:   220 call find(anam,id,loct,0)
        !          1674:       nodplc(loct+2)=0
        !          1675:       nodplc(loct+5)=ktype
        !          1676:       go to 400
        !          1677: c
        !          1678: c  errors
        !          1679: c
        !          1680:   300 igoof=1
        !          1681: c
        !          1682: c  finished
        !          1683: c
        !          1684:   400 return
        !          1685:       end
        !          1686:       subroutine card
        !          1687:       implicit double precision (a-h,o-z)
        !          1688: c
        !          1689: c     this routine scans the input lines, storing each field into the
        !          1690: c tables ifield, idelim, icolum, and icode.  with the exception of the
        !          1691: c '.end' line, card always reads the next line to check for a possible
        !          1692: c continuation before it exits.
        !          1693: c
        !          1694:       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
        !          1695:      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
        !          1696:      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
        !          1697:      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
        !          1698:      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
        !          1699:      5   imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
        !          1700:       common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
        !          1701:      1  defas,rstats(50),iwidth,lwidth,nopage
        !          1702:       common /line/ achar,afield(15),oldlin(15),kntrc,kntlim
        !          1703:       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
        !          1704:      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
        !          1705:       common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok,
        !          1706:      1   gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox
        !          1707:       common /blank/ value(1000)
        !          1708:       integer nodplc(64)
        !          1709:       complex*16 cvalue(32)
        !          1710:       equivalence (value(1),nodplc(1),cvalue(1))
        !          1711: c
        !          1712:       dimension adigit(10)
        !          1713:       data adigit / 1h0,1h1,1h2,1h3,1h4,1h5,1h6,1h7,1h8,1h9 /
        !          1714:       data ablnk,aper,aplus,aminus,astk / 1h , 1h., 1h+, 1h-, 1h* /
        !          1715:       data ag,ak,au,an,ap,ae,am,af,at /1hg,1hk,1hu,1hn,1hp,1he,1hm,
        !          1716:      1  1hf,1ht/
        !          1717:       data ai / 1hi /
        !          1718:       data alprn, arprn, aequal / 1h(, 1h), 1h= /
        !          1719:       data aend / 4h.end /
        !          1720: c
        !          1721: c      note:  the value of the function *nxtchr* (used extensively in
        !          1722: c this routine) is as follows:
        !          1723: c
        !          1724: c                    <0:  end-of-line
        !          1725: c                    =0:  delimiter found
        !          1726: c                    >0:  non-delimiter found
        !          1727: c
        !          1728:       numfld=0
        !          1729:       nofld=10
        !          1730:       go to 20
        !          1731: c
        !          1732: c  read next card
        !          1733: c
        !          1734:    10 nofld=10
        !          1735:       call getlin
        !          1736:       if (keof.eq.0) go to 20
        !          1737: c...  error:  unexpected end-of-file condition on input
        !          1738:    15 keof=1
        !          1739:       nofld=1
        !          1740:       numfld=0
        !          1741:       igoof=1
        !          1742:       write (6,16)
        !          1743:    16 format('0*error*:  .end card missing'/)
        !          1744:       go to 1000
        !          1745: c
        !          1746: c  eliminate trailing blanks rapidly
        !          1747: c
        !          1748:    20 if (afield(nofld).ne.ablnk) go to 40
        !          1749:       if (nofld.eq.1) go to 30
        !          1750:       nofld=nofld-1
        !          1751:       go to 20
        !          1752: c...  write blank card
        !          1753:    30 write (6,31)
        !          1754:    31 format(1x)
        !          1755:       go to 10
        !          1756: c...  copy the card to output listing
        !          1757:    40 write (6,41) (afield(i),i=1,nofld)
        !          1758:    41 format(1x,10a8)
        !          1759: c
        !          1760: c  initialization for new card
        !          1761: c
        !          1762:    45 kntrc=0
        !          1763:       kntlim=min0(8*nofld,iwidth)
        !          1764: c
        !          1765: c  fetch first non-delimiter (see routine *nxtchr* for list)
        !          1766: c
        !          1767:    50 if (nxtchr(0)) 600,50,60
        !          1768: c...  check for comment (leading asterisk)
        !          1769:    60 if (achar.eq.astk) go to 10
        !          1770:       go to 100
        !          1771: c
        !          1772: c  fetch next character
        !          1773: c
        !          1774:    70 if (nxtchr(0)) 600,80,100
        !          1775: c
        !          1776: c  two consecutive delimiters imply numeric zero unless the delimiter
        !          1777: c  is a blank or parenthesis.
        !          1778: c
        !          1779:    80 if (achar.eq.ablnk) go to 70
        !          1780:       if (achar.eq.alprn) go to 70
        !          1781:       if (achar.eq.arprn) go to 70
        !          1782:       if (achar.eq.aequal) go to 70
        !          1783: c...  check for sufficient space in storage arrays
        !          1784:       if (numfld.lt.insize-1) go to 90
        !          1785:       call extmem(ifield,50)
        !          1786:       call extmem(icode,50)
        !          1787:       call extmem(idelim,50)
        !          1788:       call extmem(icolum,50)
        !          1789:       insize=insize+50
        !          1790:    90 numfld=numfld+1
        !          1791:       value(ifield+numfld)=0.0d0
        !          1792:       nodplc(icode+numfld)=0
        !          1793:       value(idelim+numfld)=achar
        !          1794:       nodplc(icolum+numfld)=kntrc
        !          1795:       go to 70
        !          1796: c
        !          1797: c  check for sufficient space in storage arrays
        !          1798: c
        !          1799:   100 if (numfld.lt.insize-1) go to 110
        !          1800:       call extmem(ifield,50)
        !          1801:       call extmem(icode,50)
        !          1802:       call extmem(idelim,50)
        !          1803:       call extmem(icolum,50)
        !          1804:       insize=insize+50
        !          1805: c
        !          1806: c  begin scan of next field
        !          1807: c
        !          1808: c...  initialization
        !          1809:   110 jdelim=0
        !          1810:       xsign=1.0d0
        !          1811:       xmant=0.0d0
        !          1812:       idec=0
        !          1813:       iexp=0
        !          1814: c...  check for leading plus or minus sign
        !          1815:       if (achar.eq.aplus) go to 210
        !          1816:       if (achar.eq.aminus) go to 200
        !          1817: c...  finish initialization
        !          1818:       anam=ablnk
        !          1819:       kchr=1
        !          1820: c...  an isolated period indicates that a continuation card follows
        !          1821:       if (achar.ne.aper) go to 120
        !          1822: c...  alter initialization slightly if leading period found
        !          1823:       idec=1
        !          1824:       iexp=-1
        !          1825:       anam=aper
        !          1826:       kchr=2
        !          1827: c...  now take a look at the next character
        !          1828:       if (nxtchr(0)) 10,10,120
        !          1829: c
        !          1830: c  test for number (any digit)
        !          1831: c
        !          1832:   120 do 130 i=1,10
        !          1833:       if (achar.ne.adigit(i)) go to 130
        !          1834:       xmant=dfloat(i-1)
        !          1835:       go to 210
        !          1836:   130 continue
        !          1837: c
        !          1838: c  assemble name
        !          1839: c
        !          1840:       numfld=numfld+1
        !          1841:       call move(anam,kchr,achar,1,1)
        !          1842:       kchr=kchr+1
        !          1843:       do 150 i=kchr,8
        !          1844:       if (nxtchr(0)) 160,160,140
        !          1845:   140 call move(anam,i,achar,1,1)
        !          1846:   150 continue
        !          1847:       go to 170
        !          1848:   160 jdelim=1
        !          1849:   170 value(ifield+numfld)=anam
        !          1850:       nodplc(icode+numfld)=1
        !          1851:       nodplc(icolum+numfld)=kntrc
        !          1852: c...  no '+' format continuation possible for .end card
        !          1853:       if (numfld.ge.2) go to 400
        !          1854:       if (anam.ne.aend) go to 400
        !          1855:       nodplc(icode+numfld+1)=-1
        !          1856:       go to 1000
        !          1857: c
        !          1858: c  process number
        !          1859: c
        !          1860: c...  take note of leading minus sign
        !          1861:   200 xsign=-1.0d0
        !          1862: c...  take a look at the next character
        !          1863:   210 if (nxtchr(0)) 335,335,220
        !          1864: c...  test for digit
        !          1865:   220 do 230 i=1,10
        !          1866:       if (achar.ne.adigit(i)) go to 230
        !          1867:       xmant=xmant*10.0d0+dfloat(i-1)
        !          1868:       if (idec.eq.0) go to 210
        !          1869:       iexp=iexp-1
        !          1870:       go to 210
        !          1871:   230 continue
        !          1872: c
        !          1873: c  check for decimal point
        !          1874: c
        !          1875:       if (achar.ne.aper) go to 240
        !          1876: c...  make certain that this is the first one found
        !          1877:       if (idec.ne.0) go to 500
        !          1878:       idec=1
        !          1879:       go to 210
        !          1880: c
        !          1881: c  test for exponent
        !          1882: c
        !          1883:   240 if (achar.ne.ae) go to 300
        !          1884:       if (nxtchr(0)) 335,335,250
        !          1885:   250 itemp=0
        !          1886:       isign=1
        !          1887: c...  check for possible leading sign on exponent
        !          1888:       if (achar.eq.aplus) go to 260
        !          1889:       if (achar.ne.aminus) go to 270
        !          1890:       isign=-1
        !          1891:   260 if (nxtchr(0)) 285,285,270
        !          1892: c...  test for digit
        !          1893:   270 do 280 i=1,10
        !          1894:       if (achar.ne.adigit(i)) go to 280
        !          1895:       itemp=itemp*10+i-1
        !          1896:       go to 260
        !          1897:   280 continue
        !          1898:       go to 290
        !          1899:   285 jdelim=1
        !          1900: c...  correct internal exponent
        !          1901:   290 iexp=iexp+isign*itemp
        !          1902:       go to 340
        !          1903: c
        !          1904: c  test for scale factor
        !          1905: c
        !          1906:   300 if (achar.ne.am) go to 330
        !          1907: c...  special check for *me* (as distinguished from *m*)
        !          1908:       if (nxtchr(0)) 320,320,310
        !          1909:   310 if (achar.ne.ae) go to 315
        !          1910:       iexp=iexp+6
        !          1911:       go to 340
        !          1912:   315 if (achar.ne.ai) go to 325
        !          1913:       xmant=xmant*25.4d-6
        !          1914:       go to 340
        !          1915:   320 jdelim=1
        !          1916:   325 iexp=iexp-3
        !          1917:       go to 340
        !          1918:   330 if (achar.eq.at) iexp=iexp+12
        !          1919:       if (achar.eq.ag) iexp=iexp+9
        !          1920:       if (achar.eq.ak) iexp=iexp+3
        !          1921:       if (achar.eq.au) iexp=iexp-6
        !          1922:       if (achar.eq.an) iexp=iexp-9
        !          1923:       if (achar.eq.ap) iexp=iexp-12
        !          1924:       if (achar.eq.af) iexp=iexp-15
        !          1925:       go to 340
        !          1926:   335 jdelim=1
        !          1927: c
        !          1928: c  assemble the final number
        !          1929: c
        !          1930:   340 if (xmant.eq.0.0d0) go to 350
        !          1931:       if (iexp.eq.0) go to 350
        !          1932:       if (iabs(iexp).ge.201) go to 500
        !          1933:       xmant=xmant*dexp(dfloat(iexp)*xlog10)
        !          1934:       if (xmant.gt.1.0d+35) go to 500
        !          1935:       if (xmant.lt.1.0d-35) go to 500
        !          1936:   350 numfld=numfld+1
        !          1937:       value(ifield+numfld)=dsign(xmant,xsign)
        !          1938:       nodplc(icode+numfld)=0
        !          1939:       nodplc(icolum+numfld)=kntrc
        !          1940: c
        !          1941: c  skip to non-blank delimiter (if necessary)
        !          1942: c
        !          1943:   400 if (jdelim.eq.0) go to 440
        !          1944:   410 value(idelim+numfld)=achar
        !          1945: c...  the characters  )  and  .  form a single delimiter if adjacent
        !          1946:       if (achar.ne.arprn) go to 70
        !          1947:       if (nxtchr(0)) 430,430,420
        !          1948:   420 if (achar.ne.aper) go to 430
        !          1949:       call move(value(idelim+numfld),2,aper,1,1)
        !          1950:       go to 70
        !          1951:   430 kntrc=kntrc-1
        !          1952:       go to 70
        !          1953:   440 if (nxtchr(0)) 450,410,440
        !          1954:   450 value(idelim+numfld)=achar
        !          1955:       go to 600
        !          1956: c
        !          1957: c  errors
        !          1958: c
        !          1959:   500 write (6,501) kntrc
        !          1960:   501 format('0*error*:  illegal number -- scan stopped at column ',i3/)
        !          1961:       igoof=1
        !          1962:       numfld=numfld+1
        !          1963:       value(ifield+numfld)=0.0d0
        !          1964:       nodplc(icode+numfld)=0
        !          1965:       value(idelim+numfld)=achar
        !          1966:       nodplc(icolum+numfld)=kntrc
        !          1967: c
        !          1968: c  finished
        !          1969: c
        !          1970:   600 nodplc(icode+numfld+1)=-1
        !          1971: c
        !          1972: c  check next line for possible continuation
        !          1973: c
        !          1974:   610 call getlin
        !          1975:       if (keof.eq.1) go to 15
        !          1976:       nofld=10
        !          1977:   620 if (afield(nofld).ne.ablnk) go to 630
        !          1978:       if (nofld.eq.1) go to 650
        !          1979:       nofld=nofld-1
        !          1980:       go to 620
        !          1981:   630 kntrc=0
        !          1982:       kntlim=min0(8*nofld,iwidth)
        !          1983: c...  continuation line has a '+' as first non-delimiter on card
        !          1984:   632 if(nxtchr(0)) 650,632,634
        !          1985:   634 if(achar.ne.aplus) go to 640
        !          1986:       write(6,41) (afield(i),i=1,nofld)
        !          1987:       go to 70
        !          1988:   640 if (achar.ne.astk) go to 1000
        !          1989:   650 write (6,41) (afield(i),i=1,nofld)
        !          1990:       go to 610
        !          1991:  1000 return
        !          1992:       end
        !          1993:       subroutine getlin
        !          1994:       implicit double precision (a-h,o-z)
        !          1995: c
        !          1996: c     this routine reads the next line of input into the array afield.
        !          1997: c if end-of-file is found, the variable keof is set to 1.
        !          1998: c
        !          1999:       common /line/ achar,afield(15),oldlin(15),kntrc,kntlim
        !          2000:       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
        !          2001:      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
        !          2002:       call copy8(afield,oldlin,15)
        !          2003:       read(5,6,end=10) (afield(i),i=1,10)
        !          2004:       go to 100
        !          2005:     6 format(10a8)
        !          2006:    10 keof=1
        !          2007:   100 return
        !          2008:       end
        !          2009:       integer function nxtchr(int)
        !          2010:       implicit double precision (a-h,o-z)
        !          2011: c
        !          2012: c     this routine advances the current line scan pointer one column
        !          2013: c     and checks whether or not the next character is a delimiter
        !          2014: c
        !          2015:       common /line/ achar,afield(15),oldlin(15),kntrc,kntlim
        !          2016: c
        !          2017:       dimension adelim(5)
        !          2018:       data adelim / 1h , 1h,, 1h=, 1h(, 1h) /
        !          2019:       data ablnk / 1h  /
        !          2020:       data ichar /0/
        !          2021: c
        !          2022: c  advance scan pointer (kntrc)
        !          2023:       kntrc=kntrc+1
        !          2024:       if (kntrc.gt.kntlim) go to 30
        !          2025:       call move(achar,1,afield,kntrc,1)
        !          2026:       call move(ichar,2,achar,1,1)
        !          2027:       if(ichar.gt.31.and.ichar.lt.91) go to 5
        !          2028: c.. delete ascii control codes
        !          2029:       if(ichar.lt.32) ichar=32
        !          2030:       if(ichar.gt.96.and.ichar.lt.123) ichar=ichar-32
        !          2031:       if(ichar.eq.127) ichar=32
        !          2032:       call move(achar,1,ichar,2,1)
        !          2033:     5 do 10 i=1,5
        !          2034:       if (achar.eq.adelim(i)) go to 20
        !          2035:    10 continue
        !          2036: c
        !          2037: c  non-delimiter
        !          2038: c
        !          2039:       nxtchr=1
        !          2040:       return
        !          2041: c
        !          2042: c  delimiter
        !          2043: c
        !          2044:    20 nxtchr=0
        !          2045:       return
        !          2046: c
        !          2047: c  end-of-line
        !          2048: c
        !          2049:    30 nxtchr=-1
        !          2050:       achar=ablnk
        !          2051:       return
        !          2052:       end

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.