![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to readins.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 3BSD / cmd / spice|
Return to readins.f CVS log | Up to [CSRG BSD Unix] / 3BSD / cmd / spice |
BSD 3.0
subroutine readin
implicit double precision (a-h,o-z)
c
c
c this routine drives the input processing of spice. element cards
c and device models are handled by this routine.
c
common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
1 defas,rstats(50),iwidth,lwidth,nopage
common /line/ achar,afield(15),oldlin(15),kntrc,kntlim
common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
1 xmu,mode,modedc,icalc,initf,method,iord,maxord,noncon,iterno,
2 itemno,nosolv,ipostp,iscrch
common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok,
1 gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox
common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop,
1 kinel,kidin,kovar,kidout
common /ac/ fstart,fstop,fincr,skw2,refprl,spw2,jacflg,idfreq,
1 inoise,nosprt,nosout,nosin,idist,idprt
common /tran/ tstep,tstop,tstart,delmax,tdmax,forfre,jtrflg
common /outinf/ xincr,string(15),xstart,yvar(8),itab(8),itype(8),
1 ilogy(8),npoint,numout,kntr,numdgt
common /cje/ maxtim,itime,icost
common /blank/ value(1000)
integer nodplc(64)
complex*16 cvalue(32)
equivalence (value(1),nodplc(1),cvalue(1))
c
c control card identifiers
c
dimension aide(20),nnods(20),ntnods(20)
dimension numic(4)
dimension aidm(8),ipolar(8),modid(8),ipar(6),ampar(120)
dimension titinp(4)
dimension aidc(20)
dimension alibm(6),alpar(46,6),dummy1(92),dummy2(92),dummy3(92)
equivalence (alpar(1,1),dummy1(1)),(alpar(1,3),dummy2(1))
equivalence (alpar(1,5),dummy3(1))
data titinp / 8hinput li, 8hsting , 8h , 8h /
data naidc / 20 /
data aidc / 8hac , 8hdc , 8hdistorti, 8hend ,
1 8hends , 8hfourier , 8hmodel , 8hnoise ,
2 8hop , 8hoptions , 8hplot , 8hprint ,
3 8hsubckt , 8hsensitiv, 8htransien, 8htf ,
4 8htemperat, 8hwidth , 8hnodeset , 8hic /
c
c element card identifiers, keywords, and information
c
data aide / 1hr,1hc,1hl,1hk,1hg,1he,1hf,1hh,1hv,1hi,1hd,1hq,1hj,
1 1hm,1hs,1hy,1ht,0.0d0,1hx,0.0d0 /
data alsac,alspu,alsex,alssi /2hac,2hpu,2hex,2hsi/
data alsoff,alsdc,alspw / 3hoff,2hdc,3hpw /
data alsz0,alszo,alsnl,alsf,alstd / 2hz0,2hzo,2hnl,1hf,2htd /
data alsl,alsw,alsas,alsad,alsrd,alsrs / 1hl,1hw,2has,2had,2hrd,
1 2hrs /
data alszx /2hzx/
data alssf / 4hsf /
data apoly, aic, area / 4hpoly, 2hic, 4harea /
data alstc / 2htc /
data numic / 1, 2, 2, 3 /
data ablnk, aper / 1h , 1h. /
data nnods / 2,2,2,0,2,2,2,2,2,2,2,3,3,4,4,4,4,0,0,0 /
data ntnods / 2,2,2,0,2,2,2,2,2,2,3,6,5,6,4,4,4,0,0,0 /
c
c model card keywords
c
data aidm /1hd,3hnpn,3hpnp,3hnjf,3hpjf,4hnmos,4hpmos,4hgaas/
data ipolar /0,1,-1,1,-1,1,-1,0/
data modid /1,2,2,3,3,4,4,4/
data ipar / 0, 14, 60, 72, 106, 119 /
data ampar /
1 6his ,6hrs ,6hn ,6htt ,6hcjo ,6hpb ,6hm ,
2 6heg ,6hpt ,6hkf ,6haf ,6hfc ,6hbv ,6hibv ,
1 6hjs ,6hbf ,6hnf ,6hvbf ,6hjbf ,6hjle ,6hnle ,
2 6hbr ,6hnr ,6hvbr ,6hjbr ,6hjlc ,6hnlc ,6h0 ,
3 6h0 ,6hrb ,6hjrb ,6hrbm ,6hre ,6hrc ,6hcje ,
4 6hvje ,6hmje ,6htf ,6hxtf ,6hvtf ,6hjtf ,6hptf ,
5 6hcjc ,6hvjc ,6hmjc ,6hcdis ,6htr ,6h0 ,6h0 ,
6 6h0 ,6h0 ,6hcjs ,6hvjs ,6hmjs ,6htb ,6heg ,
7 6hpt ,6hkf ,6haf ,6hfc ,
1 6hvto ,6hbeta ,6hlambda,6hrd ,6hrs ,6hcgs ,6hcgd ,
2 6hpb ,6his ,6hkf ,6haf ,6hfc ,
1 6hvto ,6hkp ,6hgamma ,6hphi ,6hlambda,6hrd ,6hrs ,
2 6hcgs ,6hcgd ,6hcgb ,6hcbd ,6hcbs ,6htox ,6hpb ,
3 6hjs ,6hnsub ,6hnss ,6hnfs ,6hxj ,6hld ,6hngate ,
4 6htps ,6huo ,6hucrit ,6huexp ,6hutra ,6hkf ,6haf ,
5 6hfc ,6hwd ,6hecrit ,6hetra ,6hvnorm ,6hdesat ,
1 6hvp ,6hvbr ,6hvbi ,6hvfwd ,6hnd ,6hkdso ,6hkdv ,
2 6hcdso ,6hczg ,6hgnoise,6hnexp ,6hkf ,6haf ,0.0d0 /
data alibm /7hlib001n,7hlib002n,7hlib239n,7hlib250n,7hlib255n,
1 7hlib620n/
data dummy1/
* 1.60d-16, 1.08d+02, 1.04d+00, 1.34d+02, 1.54d-02, 1.20d-14,
* 1.53d+00, 5.86d-01, 1.03d+00, 1.00d+10, 9.82d-03, 0.0d0,
* 0.0d0, 0.0d0, 1.04d+00, 2.40d+02, 6.47d-04, 1.80d+02,
* 3.90d+00, 9.20d+01, 1.90d-13, 6.70d-01, 3.33d-01, 1.51d-10,
* 0.0d0, 0.0d0, 0.0d0, 9.14d0, 1.60d-13, 4.20d-01,
* 3.33d-01, 9.70d-01, 1.51d-09, 0.0d0, 0.0d0, 0.0d0,
* 0.0d0, 1.60d-13, 4.20d-01, 3.33d-01, 1.10d+00, 1.11d+00,
* 0.0d0, 0.0d0, 0.0d0, 0.0d0,
* 6.17d-16, 1.64d+02, 1.05d+00, 7.60d+01, 3.34d-02, 2.50d-14,
* 1.49d+00, 1.36d+00, 1.05d+00, 1.00d+10, 2.15d-04, 0.0d0,
* 0.0d0, 0.0d0, 1.05d+00, 7.33d+01, 2.14d-03, 3.00d+01,
* 2.70d+00, 1.00d+01, 5.70d-13, 6.70d-01, 3.33d-01, 1.25d-10,
* 0.0d0, 0.0d0, 0.0d0, 10.22d0, 5.20d-13, 4.80d-01,
* 3.33d-01, 7.50d-01, 1.25d-09, 0.0d0, 0.0d0, 0.0d0,
* 0.0d0, 5.20d-13, 4.80d-01, 3.33d-01, 1.10d+00, 1.11d+00,
* 0.0d0, 0.0d0, 0.0d0, 0.0d0/
data dummy2 /
* 2.89d-16, 6.88d+01, 1.01d+00, 4.43d+01, 1.67d-01, 1.60d-13,
* 1.85d+00, 3.32d-01, 1.10d+00, 1.00d+10, 3.42d-03, 0.0d0,
* 0.0d0, 0.0d0, 1.01d+00, 2.00d+01, 8.18d-03, 1.00d+01,
* 1.90d+00, 5.50d+00, 5.70d-13, 1.20d+00, 5.00d-01, 1.80d-11,
* 0.0d0, 0.0d0, 0.0d0, 38.2d0, 5.60d-13, 8.20d-01,
* 5.00d-01, 3.50d-01, 1.80d-10, 0.0d0, 0.0d0, 0.0d0,
* 0.0d0, 5.60d-13, 8.20d-01, 5.00d-01, 1.10d+00, 1.11d+00,
* 0.0d0, 0.0d0, 0.0d0, 0.0d0,
* 1.90d-15, 1.02d+02, 1.08d+00, 5.50d+01, 7.63d-02, 8.80d-14,
* 1.98d+00, 5.54d+00, 1.05d+00, 1.00d+10, 1.36d-02, 0.0d0,
* 0.0d0, 0.0d0, 1.08d+00, 1.27d+02, 1.23d-03, 1.50d+01,
* 2.50d+00, 6.00d+00, 4.80d-13, 1.20d+00, 5.00d-01, 4.40d-11,
* 0.0d0, 0.0d0, 0.0d0, 16.15d0, 2.90d-13, 4.20d-01,
* 3.33d-01, 6.10d-01, 4.40d-10, 0.0d0, 0.0d0, 0.0d0,
* 0.0d0, 2.90d-13, 4.20d-01, 3.33d-01, 1.10d+00, 1.11d+00,
* 0.0d0, 0.0d0, 0.0d0, 0.0d0/
data dummy3 /
* 1.90d-16, 1.00d+02, 1.00d+00, 5.70d+01, 4.17d-02, 4.80d-16,
* 1.38d+00, 6.19d-01, 1.04d+00, 1.00d+10, 5.52d-03, 0.0d0,
* 0.0d0, 0.0d0, 1.00d+00, 1.33d+02, 1.17d-03, 1.60d+01,
* 2.40d+00, 7.00d+00, 3.20d-13, 1.20d+00, 5.00d-01, 4.70d-11,
* 0.0d0, 0.0d0, 0.0d0, 14.51d0, 2.40d-13, 3.60d-01,
* 3.33d-01, 4.50d-01, 4.70d-10, 0.0d0, 0.0d0, 0.0d0,
* 0.0d0, 2.40d-13, 3.60d-01, 3.33d-01, 1.10d+00, 1.11d+00,
* 0.0d0, 0.0d0, 0.0d0, 0.0d0,
* 1.59d-15, 9.14d+01, 1.03d+00, 6.00d+01, 2.06d-01, 1.33d-16,
* 1.23d+00, 1.27d+01, 1.00d+00, 1.00d+10, 5.39d-02, 0.0d0,
* 0.0d0, 0.0d0, 1.03d+00, 8.33d+01, 1.87d-03, 8.00d+00,
* 1.20d+00, 3.50d+00, 1.30d-12, 1.20d+00, 5.00d-01, 3.26d-11,
* 0.0d0, 0.0d0, 0.0d0, 45.87d0, 7.50d-13, 5.50d-01,
* 3.33d-01, 9.70d-01, 3.26d-10, 0.0d0, 0.0d0, 0.0d0,
* 0.0d0, 7.50d-13, 5.50d-01, 3.33d-01, 1.10d+00, 1.11d+00,
* 0.0d0, 0.0d0, 0.0d0, 0.0d0/
c
c initialize variables
c
call second(t1)
call getlin
if (keof.ne.0) go to 6000
call copy8(afield,atitle,15)
call getm4(ielmnt,0)
call getm8(itemps,1)
value(itemps+1)=25.0d0
itemno=1
nopage=0
call title(-1,72,1,titinp)
iwidth=80
do 5 i=1,8
achar=ablnk
call move(achar,1,atitle(10),i,1)
if(achar.eq.ablnk) go to 8
5 continue
write(6,6)
6 format('0warning: input line-width set to 72 columns because',/
11x,'possible sequencing appears in cols 73-80')
iwidth=72
8 do 10 i=1,15
afield(i)=ablnk
10 continue
call copy8(afield,oldlin,15)
call getm4(isbckt,0)
nsbckt=0
call getm8(iunsat,0)
nunsat=0
lwidth=80
iprnta=1
iprntl=1
iprntm=1
iprntn=1
iprnto=0
gmin=1.0d-12
reltol=0.001d0
abstol=1.0d-12
vntol=50.0d-6
trtol=7.0d0
chgtol=1.0d-14
defl=1.0d0
defw=1.0d0
defad=1.0d-12
defas=1.0d-12
numdgt=4
numtem=1
itl1=100
itl2=50
itl3=4
itl4=10
itl5=5000
limtim=2
limpts=201
lvlcod=2
lvltim=1
method=1
xmu=0.5d0
maxord=2
nosolv=0
icvflg=0
itcelm(2)=0
idist=0
idprt=0
inoise=0
jacflg=0
jtrflg=0
call getm4(ifour,0)
nfour=0
call getm4(nsnod,0)
call getm8(nsval,0)
call getm4(icnod,0)
call getm8(icval,0)
kinel=0
kovar=0
kssop=0
nosprt=0
nsens=0
call getm4(isens,0)
numnod=0
ncnods=0
nunods=0
call zero4(locate,50)
call zero4(jelcnt,50)
insize=50
call getm8(ifield,insize)
call getm4(icode,insize)
call getm8(idelim,insize)
call getm4(icolum,insize)
go to 50
c
c error entry
c
40 nogo=1
c
c read and decode next card in input deck
c
50 igoof=0
call card
if (keof.ne.0) go to 5000
if (igoof.ne.0) go to 40
if (nodplc(icode+1).eq.0) go to 95
anam=value(ifield+1)
call move(anam,2,ablnk,1,7)
if (anam.ne.aper) go to 70
call move(anam,1,value(ifield+1),2,7)
call keysrc(aidc,naidc,anam,id)
if (id.le.0) go to 90
if (id.eq.4) go to 5000
if (id.eq.5) go to 800
if (id.eq.7) go to 500
if (id.eq.13) go to 700
if (nsbckt.ge.1) go to 85
call runcon(id)
if (igoof.ne.0) go to 40
go to 50
70 id=0
80 id=id+1
if (id.gt.20) go to 90
if (anam.eq.aide(id)) go to 100
go to 80
85 write (6,86)
86 format('0warning: above line not allowed within subcircuit -- ',
1 'ignored'/)
go to 50
90 write (6,91) value(ifield+1)
91 format('0*error*: unknown data card: ',a8/)
go to 40
95 write (6,96)
96 format('0*error*: unrecognizable data card'/)
go to 40
c
c element and device cards
c
100 call find(value(ifield+1),id,loc,1)
locv=nodplc(loc+1)
if (id.eq.4) go to 140
if (id.eq.19) go to 900
istop=nnods(id)+1
do 110 i=2,istop
if (nodplc(icode+i).ne.0) go to 410
if (value(ifield+i).lt.0.0d0) go to 400
110 nodplc(loc+i)=value(ifield+i)
go to (120,130,130,140,150,150,180,180,200,200,300,300,300,300,
1 390,390,350,390,390,390), id
c
c resistor
c
120 if (nodplc(icode+4).ne.0) go to 420
if (value(ifield+4).eq.0.0d0) go to 480
value(locv+2)=value(ifield+4)
ifld=4
122 ifld=ifld+1
if (nodplc(icode+ifld)) 50,122,124
124 anam=value(ifield+ifld)
if (anam.ne.alstc) go to 460
ifld=ifld+1
if (nodplc(icode+ifld)) 50,126,124
126 value(locv+3)=value(ifield+ifld)
ifld=ifld+1
if (nodplc(icode+ifld)) 50,128,124
128 value(locv+4)=value(ifield+ifld)
go to 50
c
c capacitor or inductor
c
130 ifld=3
iknt=0
ltab=7
if (id.eq.3) ltab=10
call getm8(nodplc(loc+ltab),0)
if (nodplc(icode+4).ne.1) go to 132
anam=value(ifield+4)
if (anam.ne.apoly) go to 450
ifld=4
132 ifld=ifld+1
if (nodplc(icode+ifld).ne.0) go to 136
call extmem(nodplc(loc+ltab),1)
iknt=iknt+1
ispot=nodplc(loc+ltab)+iknt
value(ispot)=value(ifield+ifld)
go to 132
136 if (iknt.eq.0) go to 420
if (nodplc(icode+ifld).ne.1) go to 50
anam=value(ifield+ifld)
if (anam.ne.aic) go to 460
ifld=ifld+1
if (nodplc(icode+ifld)) 50,138,136
138 value(locv+2)=value(ifield+ifld)
go to 50
c
c mutual inductance
c
140 if (nodplc(icode+2).ne.1) go to 430
anam=value(ifield+2)
call move(anam,2,ablnk,1,7)
if (anam.ne.aide(3)) go to 430
call extnam(value(ifield+2),nodplc(loc+2))
if (nodplc(icode+3).ne.1) go to 430
anam=value(ifield+3)
call move(anam,2,ablnk,1,7)
if (anam.ne.aide(3)) go to 430
call extnam(value(ifield+3),nodplc(loc+3))
if (nodplc(icode+4).ne.0) go to 420
xk=value(ifield+4)
if (xk.le.0.0d0) go to 420
if (xk.le.1.0d0) go to 145
xk=1.0d0
write (6,141)
141 format('0warning: coefficient of coupling reset to 1.0d0'/)
145 value(locv+1)=xk
go to 50
c
c voltage controlled (nonlinear) sources
c
150 ndim=1
ifld=3
if (nodplc(icode+4)) 410,156,152
152 anam=value(ifield+4)
if (anam.ne.apoly) go to 450
if (nodplc(icode+5).ne.0) go to 420
ndim=value(ifield+5)
if (ndim.le.0) go to 420
ifld=5
156 nodplc(loc+4)=ndim
ltab=id+1
nssnod=2*ndim
nmat=4*ndim
if (id.eq.6) nmat=4+2*ndim
call getm4(nodplc(loc+ltab),nssnod)
call getm4(nodplc(loc+ltab+1),nmat)
call getm8(nodplc(loc+ltab+2),0)
call getm8(nodplc(loc+ltab+3),ndim)
call getm4(nodplc(loc+ltab+4),ndim)
call getm8(nodplc(loc+ltab+5),ndim)
ispot=nodplc(loc+ltab+5)
call zero8(value(ispot+1),ndim)
lnod=nodplc(loc+ltab)
do 158 i=1,nssnod
ifld=ifld+1
if (nodplc(icode+ifld).ne.0) go to 410
if (value(ifield+ifld).lt.0.0d0) go to 400
nodplc(lnod+i)=value(ifield+ifld)
158 continue
160 iknt=0
162 ifld=ifld+1
if (nodplc(icode+ifld).ne.0) go to 164
call extmem(nodplc(loc+ltab+2),1)
iknt=iknt+1
ispot=nodplc(loc+ltab+2)+iknt
value(ispot)=value(ifield+ifld)
go to 162
164 if (iknt.eq.0) go to 420
if (nodplc(icode+ifld).ne.1) go to 170
anam=value(ifield+ifld)
if (anam.ne.aic) go to 460
do 168 i=1,ndim
ifld=ifld+1
if (nodplc(icode+ifld)) 170,166,420
166 ispot=nodplc(loc+ltab+5)+i
value(ispot)=value(ifield+ifld)
168 continue
170 if (ndim.ne.1) go to 50
if (iknt.ne.1) go to 50
call extmem(nodplc(loc+ltab+2),1)
ispot=nodplc(loc+ltab+2)
value(ispot+2)=value(ispot+1)
value(ispot+1)=0.0d0
go to 50
c
c current controlled (nonlinear) sources
c
180 ndim=1
ifld=3
if (nodplc(icode+4).ne.1) go to 470
anam=value(ifield+4)
if (anam.ne.apoly) go to 182
ifld=5
if (nodplc(icode+5).ne.0) go to 420
ndim=value(ifield+5)
if (ndim.le.0) go to 420
182 nodplc(loc+4)=ndim
ltab=id-1
nmat=2*ndim
if (id.eq.8) nmat=4+ndim
call getm4(nodplc(loc+ltab),ndim)
call getm4(nodplc(loc+ltab+1),nmat)
call getm8(nodplc(loc+ltab+2),0)
call getm8(nodplc(loc+ltab+3),ndim)
call getm4(nodplc(loc+ltab+4),ndim)
call getm8(nodplc(loc+ltab+5),ndim)
ispot=nodplc(loc+ltab+5)
call zero8(value(ispot+1),ndim)
do 184 i=1,ndim
ifld=ifld+1
if (nodplc(icode+ifld).ne.1) go to 470
anam=value(ifield+ifld)
call move(anam,2,ablnk,1,7)
if (anam.ne.aide(9)) go to 470
call extnam(value(ifield+ifld),loct)
ispot=nodplc(loc+ltab)+i
nodplc(ispot)=loct
184 continue
go to 160
c
c independent sources
c
200 ifld=3
call getm8(nodplc(loc+5),0)
210 ifld=ifld+1
215 if (nodplc(icode+ifld)) 50,220,230
220 if (ifld.gt.4) go to 210
225 value(locv+1)=value(ifield+ifld)
go to 210
230 anam=value(ifield+ifld)
if (anam.ne.alsdc) go to 235
ifld=ifld+1
if (nodplc(icode+ifld)) 50,225,230
235 if (anam.ne.alsac) go to 260
value(locv+2)=1.0d0
ifld=ifld+1
if (nodplc(icode+ifld)) 50,240,230
240 value(locv+2)=value(ifield+ifld)
ifld=ifld+1
if (nodplc(icode+ifld)) 50,250,230
250 value(locv+3)=value(ifield+ifld)
go to 210
260 id=0
call move(anam,3,ablnk,1,6)
if (anam.eq.alspu) id=1
if (anam.eq.alssi) id=2
if (anam.eq.alsex) id=3
if (anam.eq.alspw) id=4
if (anam.eq.alssf) id=5
if (id.eq.0) go to 450
nodplc(loc+4)=id
iknt=0
270 ifld=ifld+1
if (nodplc(icode+ifld).ne.0) go to 280
call extmem(nodplc(loc+5),1)
iknt=iknt+1
ispot=nodplc(loc+5)+iknt
value(ispot)=value(ifield+ifld)
go to 270
280 aval=0.0d0
if (id.ne.4) go to 285
c... for pwl source function, force even number of input values
ibit=0
if(iknt.ne.(iknt/2)*2) ibit=1
aval=value(ispot)
if (ibit.eq.0) go to 290
call extmem(nodplc(loc+5),1)
aval=value(ispot-1)
iknt=iknt+1
ispot=nodplc(loc+5)+iknt
value(ispot)=aval
go to 290
285 if (iknt.ge.7) go to 215
290 call extmem(nodplc(loc+5),2)
ispot=nodplc(loc+5)+iknt
value(ispot+1)=0.0d0
value(ispot+2)=aval
iknt=iknt+2
go to 285
c
c device cards
c
300 if(id.ne.14) value(locv+1)=1.0d0
locm=loc+ntnods(id)+2
ifld=nnods(id)+2
c
c temporarily (until modchk) put substrate node into nodplc(loc+5)
c
if(id.ne.12) go to 308
if(nodplc(icode+5).ne.0) go to 308
ifld=6
nodplc(loc+5)=value(ifield+5)
308 continue
if (nodplc(icode+ifld).ne.1) go to 440
call extnam(value(ifield+ifld),nodplc(locm))
310 ifld=ifld+1
if (nodplc(icode+ifld)) 50,325,315
315 anam=value(ifield+ifld)
if (anam.ne.alsoff) go to 320
nodplc(locm+1)=1
go to 310
320 if (anam.ne.area) go to 330
ifld=ifld+1
if (nodplc(icode+ifld)) 50,325,315
325 if (value(ifield+ifld).le.0.0d0) go to 420
if (id.eq.14) go to 343
value(locv+1)=value(ifield+ifld)
go to 310
330 if (anam.ne.aic) go to 341
iknt=0
icloc=0
if (id.eq.14) icloc=3
maxknt=numic(id-10)
335 ifld=ifld+1
if (nodplc(icode+ifld)) 50,340,315
340 iknt=iknt+1
if (iknt.gt.maxknt) go to 335
value(locv+icloc+iknt+1)=value(ifield+ifld)
go to 335
341 if (id.ne.14) go to 460
ispot=0
if (anam.eq.alsl) ispot=1
if (anam.eq.alsw) ispot=2
if (anam.eq.alsad) ispot=3
if(anam.eq.alszx) ispot=3
if (anam.eq.alsas) ispot=4
if(anam.eq.alsrd) ispot=11
if(anam.eq.alsrs) ispot=12
if (ispot.eq.0) go to 460
ifld=ifld+1
if (nodplc(icode+ifld)) 50,342,315
342 if (value(ifield+ifld).le.0.0d0) go to 420
value(locv+ispot)=value(ifield+ifld)
go to 310
343 iknt=0
344 iknt=iknt+1
if(value(ifield+ifld).le.0.0d0) go to 420
if(iknt.gt.12) go to 490
if(iknt.eq.5) iknt=11
value(locv+iknt)=value(ifield+ifld)
ifld=ifld+1
if(nodplc(icode+ifld)) 345,344,345
345 if(nodplc(icode+ifld)) 50,50,315
c
c transmission lines
c
350 ifld=5
xnl=0.25d0
tfreq=0.0d0
355 ifld=ifld+1
if (nodplc(icode+ifld)) 378,355,360
360 anam=value(ifield+ifld)
if (anam.eq.aic) go to 364
if (anam.eq.alsnl) go to 370
if (anam.eq.alsf) go to 374
id=0
if (anam.eq.alsz0) id=1
if (anam.eq.alszo) id=1
if (anam.eq.alstd) id=2
if (id.eq.0) go to 460
ifld=ifld+1
if (nodplc(icode+ifld)) 378,362,360
362 if (value(ifield+ifld).le.0.0d0) go to 420
value(locv+id)=value(ifield+ifld)
go to 355
364 iknt=0
366 ifld=ifld+1
if (nodplc(icode+ifld)) 378,368,360
368 iknt=iknt+1
if (iknt.gt.4) go to 366
value(locv+iknt+4)=value(ifield+ifld)
go to 366
370 ifld=ifld+1
if (nodplc(icode+ifld)) 378,372,360
372 if (value(ifield+ifld).le.0.0d0) go to 420
xnl=value(ifield+ifld)
go to 355
374 ifld=ifld+1
if (nodplc(icode+ifld)) 378,376,360
376 if (value(ifield+ifld).le.0.0d0) go to 420
tfreq=value(ifield+ifld)
go to 355
378 if (value(locv+1).ne.0.0d0) go to 380
write (6,379)
379 format('0*error*: z0 must be specified'/)
go to 40
380 if (value(locv+2).ne.0.0d0) go to 50
if (tfreq.ne.0.0d0) go to 382
write (6,381)
381 format('0*error*: either td or f must be specified'/)
go to 40
382 value(locv+2)=xnl/tfreq
go to 50
c
c elements not yet implemented
c
390 write (6,391)
391 format('0*error*: element type not yet implemented'/)
go to 40
c
c element card errors
c
400 write (6,401)
401 format('0*error*: negative node number found'/)
go to 40
410 write (6,411)
411 format('0*error*: node numbers are missing'/)
go to 40
420 write (6,421)
421 format('0*error*: value is missing or is nonpositive'/)
go to 40
430 write (6,431)
431 format('0*error*: mutual inductance references are missing'/)
go to 40
440 write (6,441)
441 format('0*error*: model name is missing'/)
go to 40
450 write (6,451) anam
451 format('0*error*: unknown source function: ',a8)
go to 40
460 write (6,461) anam
461 format('0*error*: unknown parameter: ',a8/)
go to 40
470 write (6,471)
471 format('0*error*: voltage source not found on above line'/)
go to 40
480 write (6,481)
481 format('0*error*: value is zero'/)
go to 40
490 write(6,491)
491 format('0*error*: extra numerical data on mosfet card'/)
go to 40
c
c model card
c
500 if (nodplc(icode+2).ne.1) go to 650
if (nodplc(icode+3).ne.1) go to 650
c
c process for library models
c
iknt=0
502 iknt=iknt+1
if(iknt.gt.6) go to 506
if(alibm(iknt).ne.value(ifield+3)) go to 502
ipol=ipolar(2)
jtype=modid(2)
id=jtype+20
call find(value(ifield+2),id,loc,1)
nodplc(loc+2)=ipol
locv=nodplc(loc+1)
do 504 i=1,46
504 value(locv+i)=alpar(i,iknt)
go to 520
506 id=0
510 id=id+1
if (id.gt.8) go to 660
if (value(ifield+3).ne.aidm(id)) go to 510
ipol=ipolar(id)
jtype=modid(id)
id=jtype+20
call find(value(ifield+2),id,loc,1)
c... adjust jtype for gaas
if(jtype.eq.4.and.ipol.eq.0) jtype=5
nodplc(loc+2)=ipol
locv=nodplc(loc+1)
520 locm=ipar(jtype)
nopar=ipar(jtype+1)-locm
ifld=3
530 ifld=ifld+1
if (nodplc(icode+ifld)) 50,530,560
560 anam=value(ifield+ifld)
if(jtype.eq.2) anam=alias(anam)
iknt=0
570 iknt=iknt+1
if (iknt.gt.nopar) go to 670
if (anam.ne.ampar(locm+iknt)) go to 570
ifld=ifld+1
if (nodplc(icode+ifld)) 50,580,560
580 value(locv+iknt)=value(ifield+ifld)
ifld=ifld+1
if (nodplc(icode+ifld)) 50,590,560
590 iknt=iknt+1
if (iknt.gt.nopar) go to 530
if (ablnk.ne.ampar(locm+iknt)) go to 530
go to 580
c
c model card errors
c
650 write (6,651)
651 format('0*error*: model type is missing'/)
go to 40
660 write (6,661) value(ifield+3)
661 format('0*error*: unknown model type: ',a8/)
go to 40
670 write (6,671) anam
671 format('0*error*: unknown model parameter: ',a8,/)
nogo=1
go to 530
c
c subcircuit definition
c
700 if (nodplc(icode+2).ne.1) go to 780
call find(value(ifield+2),20,loc,1)
call extmem(isbckt,1)
nsbckt=nsbckt+1
nodplc(isbckt+nsbckt)=loc
ifld=2
if (nodplc(icode+3).ne.0) go to 790
call getm4(nodplc(loc+2),0)
iknt=0
710 ifld=ifld+1
if (nodplc(icode+ifld)) 50,720,710
720 call extmem(nodplc(loc+2),1)
iknt=iknt+1
ispot=nodplc(loc+2)+iknt
if (value(ifield+ifld).le.0.0d0) go to 770
nodplc(ispot)=value(ifield+ifld)
node=nodplc(ispot)
i=iknt-1
730 if (i.eq.0) go to 710
ispot=ispot-1
if (nodplc(ispot).eq.node) go to 760
i=i-1
go to 730
760 write (6,761) node
761 format('0*error*: subcircuit definition duplicates node ',i5,/)
go to 40
770 write (6,771)
771 format('0*error*: nonpositive node number found in subcircuit ',
1 'definition'/)
go to 40
780 write (6,781)
781 format('0*error*: subcircuit name missing'/)
go to 40
790 write (6,791)
791 format('0*error*: subcircuit nodes missing'/)
go to 40
c
c .ends processing
c
800 if (nsbckt.eq.0) go to 890
iknt=1
if (nodplc(icode+2).le.0) go to 820
anam=value(ifield+2)
iknt=nsbckt
810 loc=nodplc(isbckt+iknt)
locv=nodplc(loc+1)
anams=value(locv)
if (anam.eq.anams) go to 820
iknt=iknt-1
if (iknt.ne.0) go to 810
go to 880
820 irel=nsbckt-iknt+1
call relmem(isbckt,irel)
nsbckt=nsbckt-irel
go to 50
880 write (6,881) anam
881 format('0*error*: unknown subcircuit name: ',a8/)
go to 40
890 write (6,891)
891 format('0warning: no subcircuit definition known -- line ignored'
1/)
go to 50
c
c subcircuit call
c
900 call getm4(nodplc(loc+2),0)
ifld=1
iknt=0
910 ifld=ifld+1
if (nodplc(icode+ifld).ne.0) go to 920
call extmem(nodplc(loc+2),1)
iknt=iknt+1
ispot=nodplc(loc+2)+iknt
if (value(ifield+ifld).lt.0.0d0) go to 400
nodplc(ispot)=value(ifield+ifld)
go to 910
920 if (iknt.eq.0) go to 410
if (nodplc(icode+ifld).ne.1) go to 990
call extnam(value(ifield+ifld),nodplc(loc+3))
go to 50
990 write (6,991)
991 format('0*error*: subcircuit name missing'/)
go to 40
c
c end
c
5000 if (nsbckt.eq.0) go to 5010
nsbckt=0
write (6,5001)
5001 format('0*error*: .ends card missing'/)
nogo=1
5010 call clrmem(ifield)
call clrmem(icode)
call clrmem(idelim)
call clrmem(icolum)
call clrmem(isbckt)
if (nfour.eq.0) call clrmem(ifour)
if (nsens.eq.0) call clrmem(isens)
6000 call second(t2)
rstats(1)=t2-t1
return
end
double precision function alias(anam)
implicit double precision (a-h,o-z)
dimension anam1(15),anam2(15)
data anam1 /3his ,3hva ,3hne ,3hvb ,3hnc ,3hccs,3hns ,
1 3hpe ,3hme ,3hpc ,3hmc ,3hps ,3hms ,3hik ,3hikr/
data anam2 /3hjs ,3hvbf,3hnle,3hvbr,3hnlc,3hcjs,3hnss,
1 3hvje,3hmje,3hvjc,3hmjc,3hvjs,3hmjs,3hjbf,3hjbr/
c
c this function returns the mgp equivalent of the gp parameters
c (those which apply)
c
iknt=0
alias=anam
10 iknt=iknt+1
if(iknt.gt.15) return
if(anam1(iknt).ne.anam) go to 10
alias=anam2(iknt)
return
end
subroutine keysrc(keytab,lentab,tstwrd,index)
implicit double precision (a-h,o-z)
double precision keytab
c
c this routine searches the keyword table 'keytab' for the possible
c entry 'tstwrd'. abbreviations are considered as matches.
c
dimension keytab(lentab)
integer xxor
data ablnk / 1h /
c
c
index=0
lenwrd=0
achar=ablnk
do 10 i=1,8
call move(achar,8,tstwrd,i,1)
if (achar.eq.ablnk) go to 20
lenwrd=lenwrd+1
10 continue
c
20 if (lenwrd.eq.0) go to 40
tstchr=ablnk
call move(tstchr,8,tstwrd,1,1)
30 index=index+1
if (index.gt.lentab) go to 40
akey=ablnk
call move(akey,1,keytab(index),1,lenwrd)
if (xxor(akey,tstwrd).eq.0) go to 50
go to 30
c
40 index=-1
50 return
end
subroutine extnam(aname,index)
implicit double precision (a-h,o-z)
c
c this routine adds 'aname' to the list of 'unsatisfied' names (that
c is, names which can only be resolved after subcircuit expansion).
c
common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
common /blank/ value(1000)
integer nodplc(64)
complex*16 cvalue(32)
equivalence (value(1),nodplc(1),cvalue(1))
integer xxor
c
c
anam=aname
if (nunsat.eq.0) go to 20
do 10 index=1,nunsat
if (xxor(anam,value(iunsat+index)).eq.0) go to 30
10 continue
c
20 call extmem(iunsat,1)
nunsat=nunsat+1
index=nunsat
value(iunsat+index)=anam
30 return
end
subroutine runcon(id)
implicit double precision (a-h,o-z)
c
c this routine processes run control cards.
c
common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
common /cje/ maxtim,itime,icost
common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
1 defas,rstats(50),iwidth,lwidth,nopage
common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs
common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
1 xmu,mode,modedc,icalc,initf,method,iord,maxord,noncon,iterno,
2 itemno,nosolv,ipostp,iscrch
common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok,
1 gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox
common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop,
1 kinel,kidin,kovar,kidout
common /ac/ fstart,fstop,fincr,skw2,refprl,spw2,jacflg,idfreq,
1 inoise,nosprt,nosout,nosin,idist,idprt
common /tran/ tstep,tstop,tstart,delmax,tdmax,forfre,jtrflg
common /outinf/ xincr,string(15),xstart,yvar(8),itab(8),itype(8),
1 ilogy(8),npoint,numout,kntr,numdgt
common /blank/ value(1000)
integer nodplc(64)
complex*16 cvalue(32)
equivalence (value(1),nodplc(1),cvalue(1))
dimension iprnt(5),limits(4),itrlim(5),contol(6),dflts(4)
equivalence (iprnt(1),iprnta),(limits(1),limtim),(itrlim(1),itl1),
1 (contol(1),gmin),(dflts(1),defl)
c
c
integer xxor
c
c print/plot keywords
c
dimension aopt(5)
dimension aopts(31),lsetop(5)
dimension aide(20)
data aopt / 2hdc, 2htr, 2hac, 2hno, 2hdi /
c
c options card keywords
c
data aopts / 6hnoacct, 6hnolist, 6hnomod , 6hnonode, 6hopts ,
1 6hitl1 , 6hitl2 , 6hitl3 , 6hitl4 , 6hitl5 ,
2 6hlimtim, 6hlimpts, 6hlvlcod, 6hlvltim, 6hgmin ,
3 6hreltol, 6habstol, 6hvntol , 6htrtol , 6hchgtol,
4 6htnom , 6hnumdgt, 6hmaxord, 6hmethod, 6hnopage,
5 6hmu , 6hcptime, 6hdefl , 6hdefw , 6hdefad ,
6 6hdefas /
data lsetop / 0 ,0, 0, 0, 1 /
c
c
data aide / 1hr,1hc,1hl,1hk,1hg,1he,1hf,1hh,1hv,1hi,1hd,1hq,1hj,
1 1hm,1hs,1hy,1ht,0.0d0,1hx,0.0d0 /
data alsde,alsoc,alsli / 3hdec, 3hoct, 3hlin /
data atrap, agear, auic / 4htrap, 4hgear, 3huic /
data ablnk, ain, aout / 1h , 2hin, 3hout /
data amiss / 8h*missing /
data ams / 2hms /
data minpts / 1 /
c
c
go to (1200,1100,1650,6000,6000,1700,6000,1600,1550,2000,3600,
1 3500,6000,1750,1300,1500,1800,4000,4100,4200), id
c
c dc transfer curves
c
1100 ifld=2
icvflg=0
inum=1
1105 anam=value(ifield+ifld)
if(inum.gt.2) go to 6000
id=0
call move(anam,2,ablnk,1,7)
if (anam.eq.aide(9)) id=9
if (anam.eq.aide(10)) id=10
if (id.eq.0) go to 1130
call find(value(ifield+ifld),id,itcelm(inum),0)
ifld=ifld+1
if (nodplc(icode+ifld).ne.0) go to 1130
tcstar(inum)=value(ifield+ifld)
ifld=ifld+1
if (nodplc(icode+ifld).ne.0) go to 1130
tcstop(inum)=value(ifield+ifld)
ifld=ifld+1
if (nodplc(icode+ifld).ne.0) go to 1130
tcincr(inum)=value(ifield+ifld)
if (tcincr(inum).eq.0.0d0) go to 1130
temp=(tcstop(inum)-tcstar(inum))/tcincr(inum)
if (temp.gt.0.0d0) go to 1110
tcincr(inum)=-tcincr(inum)
temp=-temp
1110 itemp=idint(temp+0.5d0)+1
itemp=max0(itemp,minpts)
if(inum.eq.1) icvflg=itemp
if(inum.eq.2) icvflg=itemp*icvflg
ifld=ifld+1
inum=2
if(nodplc(icode+ifld)) 6000,1130,1105
1130 write (6,1131)
icvflg=0
1131 format('0warning: missing parameter(s) ... analysis omitted'/)
go to 6000
c
c frequency specification
c
1200 ifld=2
if (nodplc(icode+2)) 1250,1250,1210
1210 id=0
if (value(ifield+ifld).eq.alsde) id=1
if (value(ifield+ifld).eq.alsoc) id=2
if (value(ifield+ifld).eq.alsli) id=3
if (id.eq.0) go to 1240
idfreq=id
ifld=ifld+1
if (nodplc(icode+ifld).ne.0) go to 1250
if (value(ifield+ifld).le.0.0d0) go to 1250
fincr=value(ifield+ifld)
ifld=ifld+1
if (nodplc(icode+ifld).ne.0) go to 1250
if (value(ifield+ifld).le.0.0d0) go to 1250
fstart=value(ifield+ifld)
ifld=ifld+1
if (nodplc(icode+ifld).ne.0) go to 1250
if (value(ifield+ifld).le.0.0d0) go to 1250
fstop=value(ifield+ifld)
if (fstart.gt.fstop) go to 1260
jacflg=fincr
if (idfreq-2) 1215,1220,1235
1215 fincr=dexp(xlog10/fincr)
go to 1230
1220 fincr=dexp(xlog2/fincr)
1230 temp=dlog(fstop/fstart)/dlog(fincr)
jacflg=idint(temp+0.999d0)+1
1235 jacflg=max0(jacflg,minpts)
if (idfreq.ne.3) go to 6000
fincr=(fstop-fstart)/dfloat(max0(jacflg-1,1))
go to 6000
1240 write (6,1241) value(ifield+ifld)
1241 format('0warning: unknown frequency function: ',a8,' ... analys'
1 ,'is omitted'/)
go to 6000
1250 write (6,1251)
1251 format('0warning: frequency parameters incorrect ... analysis om'
1 ,'itted'/)
go to 6000
1260 write (6,1261)
1261 format('0warning: start freq > stop freq ... analysis omitted'/)
go to 6000
c
c time specification
c
1300 ifld=2
if (nodplc(icode+ifld).ne.0) go to 1430
if (value(ifield+ifld).le.0.0d0) go to 1430
tstep=value(ifield+ifld)
ifld=ifld+1
if (nodplc(icode+ifld).ne.0) go to 1430
if (value(ifield+ifld).le.0.0d0) go to 1430
tstop=value(ifield+ifld)
tstart=0.0d0
delmax=tstop/50.0d0
ifld=ifld+1
if (nodplc(icode+ifld).ne.0) go to 1310
if (value(ifield+ifld).lt.0.0d0) go to 1430
tstart=value(ifield+ifld)
delmax=(tstop-tstart)/50.0d0
ifld=ifld+1
if (nodplc(icode+ifld).ne.0) go to 1310
if (value(ifield+ifld).le.0.0d0) go to 1430
delmax=value(ifield+ifld)
ifld=ifld+1
1310 if (nodplc(icode+ifld).ne.1) go to 1320
if (value(ifield+ifld).ne.auic) go to 1320
nosolv=1
1320 if (tstart.gt.tstop) go to 1440
if (tstep.gt.tstop) go to 1430
jtrflg=idint((tstop-tstart)/tstep+0.5d0)+1
jtrflg=max0(jtrflg,minpts)
go to 6000
1430 write (6,1431)
1431 format('0warning: time parameters incorrect ... analysis omitted'
1 /)
go to 6000
1440 write (6,1441)
1441 format('0warning: start time > stop time ... analysis omitted'/)
go to 6000
c
c transfer function
c
1500 kssop=1
ifld=2
if (nodplc(icode+ifld).ne.1) go to 1530
call outdef(ifld,1,kovar,ktype)
if (igoof.ne.0) go to 1530
if (ktype.ne.1) go to 1540
ifld=ifld+1
if (nodplc(icode+ifld).ne.1) go to 1530
anam=value(ifield+ifld)
call move(anam,2,ablnk,1,7)
id=0
if (anam.eq.aide(9)) id=9
if (anam.eq.aide(10)) id=10
if (id.eq.0) go to 1530
call find(value(ifield+ifld),id,kinel,0)
kidin=id
go to 6000
1530 kovar=0
kinel=0
write (6,1131)
igoof=0
go to 6000
1540 kovar=0
kinel=0
write (6,1541)
1541 format('0warning: illegal output variable ... analysis omitted'/)
igoof=0
go to 6000
c
c operating point
c
1550 kssop=1
go to 6000
c
c noise analysis
c
1600 ifld=2
if (nodplc(icode+ifld).ne.1) go to 1610
call outdef(ifld,2,nosout,ntype)
if (igoof.ne.0) go to 1610
if (ntype.ne.1) go to 1610
if (nodplc(nosout+5).ne.0) go to 1610
ifld=ifld+1
if (nodplc(icode+ifld).ne.1) go to 1620
anam=value(ifield+ifld)
call move(anam,2,ablnk,1,7)
id=0
if (anam.eq.aide(9)) id=9
if (anam.eq.aide(10)) id=10
if (id.eq.0) go to 1620
call find(value(ifield+ifld),id,nosin,0)
nosprt=0
ifld=ifld+1
if (nodplc(icode+ifld).ne.0) go to 1605
nosprt=dmax1(0.0d0,value(ifield+ifld))
1605 inoise=1
go to 6000
1610 write (6,1611)
1611 format('0warning: voltage output unrecognizable ... analysis omit
1ted'/)
igoof=0
go to 6000
1620 write (6,1621)
1621 format('0warning: invalid input source ... analysis omitted'/)
igoof=0
go to 6000
c
c distortion analysis
c
1650 ifld=2
if (nodplc(icode+ifld).ne.1) go to 1660
anam=value(ifield+ifld)
call move(anam,2,ablnk,1,7)
if (anam.ne.aide(1)) go to 1660
call find(value(ifield+ifld),1,idist,0)
idprt=0
skw2=0.9d0
refprl=1.0d-3
spw2=1.0d0
ifld=ifld+1
if (nodplc(icode+ifld).ne.0) go to 6000
idprt=value(ifield+ifld)
idprt=max0(idprt,0)
ifld=ifld+1
if (nodplc(icode+ifld).ne.0) go to 6000
if (value(ifield+ifld).le.0.001d0) go to 1670
if (value(ifield+ifld).gt.0.999d0) go to 1670
skw2=value(ifield+ifld)
ifld=ifld+1
if (nodplc(icode+ifld).ne.0) go to 6000
if (value(ifield+ifld).lt.1.0d-10) go to 1670
refprl=value(ifield+ifld)
ifld=ifld+1
if (nodplc(icode+ifld).ne.0) go to 6000
if (value(ifield+ifld).lt.0.001d0) go to 1670
spw2=value(ifield+ifld)
go to 6000
1660 write (6,1661)
1661 format('0warning: distortion load resistor missing ... analysis '
1 ,'omitted'/)
go to 6000
1670 idist=0
write (6,1671)
1671 format('0warning: distortion parameters incorrect ... analysis o'
1 ,'mitted'/)
go to 6000
c
c fourier analysis
c
1700 ifld=2
if (nodplc(icode+ifld).ne.0) go to 1720
if (value(ifield+ifld).le.0.0d0) go to 1720
forfre=value(ifield+ifld)
1705 ifld=ifld+1
if (nodplc(icode+ifld).ne.1) go to 1710
call outdef(ifld,2,loct,ltype)
if (igoof.ne.0) go to 1720
if (ltype.ne.1) go to 1720
call extmem(ifour,1)
nfour=nfour+1
nodplc(ifour+nfour)=loct
go to 1705
1710 if (nfour.ge.1) go to 6000
1720 write (6,1721)
1721 format('0warning: fourier parameters incorrect ... analysis omit'
1 ,'ted'/)
igoof=0
nfour=0
call clrmem(ifour)
call getm4(ifour,0)
go to 6000
c
c sensitivity analysis
c
1750 kssop=1
ifld=1
1760 ifld=ifld+1
if (nodplc(icode+ifld).ne.1) go to 6000
call outdef(ifld,1,loct,ltype)
if (igoof.ne.0) go to 1780
if (ltype.ne.1) go to 1780
call extmem(isens,1)
nsens=nsens+1
nodplc(isens+nsens)=loct
go to 1760
1780 write (6,1781)
1781 format('0warning: output variable unrecognizable ... analysis om'
1 ,'mitted'/)
igoof=0
nsens=0
call clrmem(isens)
call getm4(isens,0)
go to 6000
c
c temperature variation
c
1800 ifld=1
1810 ifld=ifld+1
if (nodplc(icode+ifld).ne.0) go to 6000
if (value(ifield+ifld).le.-223.0d0) go to 1810
call extmem(itemps,1)
numtem=numtem+1
value(itemps+numtem)=value(ifield+ifld)
go to 1810
c
c options card
c
2000 ifld=1
2010 ifld=ifld+1
2020 if (nodplc(icode+ifld)) 6000,2010,2030
2030 anam=value(ifield+ifld)
do 2040 i=1,5
if (anam.ne.aopts(i)) go to 2040
iprnt(i)=lsetop(i)
ifld=ifld+1
if(nodplc(icode+ifld).ne.0) go to 2020
iprnt(i)=value(ifield+ifld)
go to 2010
2040 continue
if (anam.eq.aopts(24)) go to 2110
if (anam.eq.aopts(25)) go to 2120
if(anam.eq.aopts(26)) go to 2130
if(anam.eq.aopts(27)) go to 2150
if (nodplc(icode+ifld+1).ne.0) go to 2510
ifld=ifld+1
aval=value(ifield+ifld)
do 2050 i=6,10
if (anam.ne.aopts(i)) go to 2050
if(aval.le.0.0d0.and.i.ne.10) go to 2510
itrlim(i-5)=aval
go to 2010
2050 continue
if (aval.le.0.0d0) go to 2510
do 2060 i=11,14
if (anam.ne.aopts(i)) go to 2060
limits(i-10)=aval
go to 2010
2060 continue
do 2070 i=15,20
if (anam.ne.aopts(i)) go to 2070
contol(i-14)=aval
go to 2010
2070 continue
do 2075 i=28,31
if(anam.ne.aopts(i)) go to 2075
dflts(i-27)=aval
go to 2010
2075 continue
if (anam.ne.aopts(21)) go to 2080
if (aval.lt.-223.0d0) go to 2510
value(itemps+1)=aval
go to 2010
2080 if (anam.ne.aopts(22)) go to 2100
ndigit=aval
if (ndigit.le.7) go to 2090
ndigit=7
write (6,2081) ndigit
2081 format('0warning: numdgt may not exceed',i2,
1 '; maximum value assumed'/)
2090 numdgt=ndigit
go to 2010
2100 if (anam.ne.aopts(23)) go to 2500
n=aval
if ((n.le.1).or.(n.ge.7)) go to 2510
maxord=n
go to 2010
2110 if (nodplc(icode+ifld+1).ne.1) go to 2510
ifld=ifld+1
anam=value(ifield+ifld)
call move(anam,5,ablnk,1,4)
jtype=0
if (anam.eq.atrap) jtype=1
if (anam.eq.agear) jtype=2
if (jtype.eq.0) go to 2510
method=jtype
go to 2010
2120 nopage=1
go to 2010
2130 ifld=ifld+1
if(nodplc(icode+ifld)) 6000,2140,2010
2140 aval=value(ifield+ifld)
if(aval.lt.0.0d0.or.aval.gt.0.500001d0) go to 2510
xmu=aval
go to 2010
2150 ifld=ifld+1
if(nodplc(icode+ifld)) 6000,2160,2010
2160 aval=value(ifield+ifld)
maxtim=aval
go to 2010
2500 write (6,2501) anam
2501 format('0warning: unknown option: ',a8,' ... ignored'/)
go to 2010
2510 write (6,2511) anam
2511 format('0warning: illegal value specified for option: ',a8,' ...
1 ignored'/)
go to 2010
c
c print card
c
3500 iprpl=0
go to 3610
c
c plot (and print) card
c
3600 iprpl=1
3610 ifld=2
3613 anam=amiss
if (nodplc(icode+ifld).ne.1) go to 3950
anam=value(ifield+ifld)
ms=0
if (xxor(anam,ams).ne.0) go to 3615
ms=1
ifld=3
if (nodplc(icode+ifld).ne.1) go to 3970
anam=value(ifield+ifld)
3615 call move(anam,3,ablnk,1,6)
do 3620 i=1,5
if (anam.ne.aopt(i)) go to 3620
ktype=i
go to 3630
3620 continue
go to 3950
3630 id=30+5*iprpl+ktype
call find(dfloat(jelcnt(id)),id,loc,1)
nodplc(loc+2)=ktype
if (ms.eq.0) go to 3635
locv=nodplc(loc+1)
value(locv)=0.0d0
3635 numout=0
3640 ifld=ifld+1
if (nodplc(icode+ifld)) 3900,3640,3650
3650 call outdef(ifld,ktype,loct,ltype)
if (igoof.ne.0) go to 3970
if (iprpl.eq.0) go to 3660
plimlo=0.0d0
plimhi=0.0d0
if (nodplc(icode+ifld+1).ne.0) go to 3660
if (nodplc(icode+ifld+2).ne.0) go to 3660
plimlo=value(ifield+ifld+1)
plimhi=value(ifield+ifld+2)
ifld=ifld+2
3660 numout=numout+1
lspot=loc+2*numout+2
nodplc(lspot)=loct
nodplc(lspot+1)=ltype
if (iprpl.eq.0) go to 3670
locv=nodplc(loc+1)
lspot=locv+2*numout-1
value(lspot)=plimlo
value(lspot+1)=plimhi
3670 if (numout.eq.8) go to 3900
go to 3640
3900 nodplc(loc+3)=numout
if (iprpl.eq.0) go to 6000
c... propogate plot limits downward
if (numout.le.1) go to 6000
locv=nodplc(loc+1)
lspot=locv+2*numout-1
plimlo=value(lspot)
plimhi=value(lspot+1)
i=numout-1
3905 lspot=lspot-2
if (value(lspot).ne.0.0d0) go to 3910
if (value(lspot+1).ne.0.0d0) go to 3910
value(lspot)=plimlo
value(lspot+1)=plimhi
go to 3920
3910 plimlo=value(lspot)
plimhi=value(lspot+1)
3920 i=i-1
if (i.ge.1) go to 3905
go to 6000
c
c errors
c
3950 write (6,3951) anam
3951 format('0warning: unknown analysis mode: ',a8,
1 ' ... line ignored'/)
go to 6000
3970 write (6,3971)
3971 format('0warning: unrecognizable output variable on above line'/)
igoof=0
go to 3640
c
c width card
c
4000 ifld=1
4010 ifld=ifld+1
if (nodplc(icode+ifld).ne.1) go to 6000
4020 anam=value(ifield+ifld)
if (anam.ne.ain) go to 4040
ifld=ifld+1
if (nodplc(icode+ifld)) 6000,4030,4020
4030 iwidth=value(ifield+ifld)
iwidth=min0(max0(iwidth,10),120)
go to 4010
4040 if (anam.ne.aout) go to 6000
ifld=ifld+1
if (nodplc(icode+ifld)) 6000,4050,4020
4050 lwidth=dmin1(dmax1(value(ifield+ifld),72.0d0),132.0d0)
go to 4010
c
c nodeset statement
c
4100 ifld=1
4110 ifld=ifld+1
if(nodplc(icode+ifld)) 6000,4120,4110
4120 nodnum=value(ifield+ifld)
if(nodnum.le.0) go to 4190
ifld=ifld+1
if(nodplc(icode+ifld)) 4180,4130,4170
4130 call sizmem(nsnod,nic)
call extmem(nsnod,1)
call extmem(nsval,1)
nodplc(nsnod+nic+1)=nodnum
value(nsval+nic+1)=value(ifield+ifld)
go to 4110
c
c errors on .nodeset statement
c
4170 write(6,4171) value(ifield+ifld)
4171 format('0warning: out-of-place non-numeric field ',a8,
1 ' skipped'/)
go to 4110
4180 write(6,4181) nodnum
4181 format('0warning: initial value missing for node ',i5,/)
go to 6000
4190 write(6,4191)
4191 format('0warning: attempt to specify initial condition for ',
1 'ground ingnored',/)
ifld=ifld+1
if(nodplc(icode+ifld)) 6000,4110,4170
c
c initial conditions statement
c
4200 ifld=1
4210 ifld=ifld+1
if(nodplc(icode+ifld)) 6000,4220,4210
4220 nodnum=value(ifield+ifld)
if(nodnum.le.0) go to 4290
ifld=ifld+1
if(nodplc(icode+ifld)) 4280,4230,4270
4230 call sizmem(icnod,nic)
call extmem(icnod,1)
call extmem(icval,1)
nodplc(icnod+nic+1)=nodnum
value(icval+nic+1)=value(ifield+ifld)
go to 4210
c
c errors on .ic statement
c
4270 write(6,4271) value(ifield+ifld)
4271 format('0warning: out-of-place non-numeric field ',a8,
1 ' skipped'/)
go to 4210
4280 write(6,4281) nodnum
4281 format('0warning: initial value missing for node ',i5,/)
go to 6000
4290 write(6,4291)
4291 format('0warning: attempt to specify initial condition for ',
1 'ground ingnored',/)
ifld=ifld+1
if(nodplc(icode+ifld)) 6000,4210,4270
c
c finished
c
6000 return
end
subroutine outdef(ifld,mode,loct,ltype)
implicit double precision (a-h,o-z)
c
c this routine constructs the internal list element for an output
c variable defined on some input card.
c
common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
common /blank/ value(1000)
integer nodplc(64)
complex*16 cvalue(32)
equivalence (value(1),nodplc(1),cvalue(1))
c
integer xxor
dimension aout(19),aopts(5)
data aout / 4hv , 4hvm , 4hvr , 4hvi , 4hvp , 4hvdb ,
1 4hi , 4him , 4hir , 4hii , 4hip , 4hidb ,
2 4honoi, 4hinoi, 4hhd2 , 4hhd3 , 4hdim2, 4hsim2,
3 4hdim3 /
data aopts / 1hm, 1hr, 1hi, 1hp, 1hd /
data alprn, acomma, ablnk, aletv / 1h(, 1h,, 1h , 1hv /
c
if (nodplc(icode+ifld).ne.1) go to 300
anam=value(ifield+ifld)
call move(anam,5,ablnk,1,4)
do 10 i=1,19
if (xxor(anam,aout(i)).ne.0) go to 10
idout=i
go to 20
10 continue
go to 300
c
c further error checking
c
20 if (mode.ge.3) go to 25
c... dc or tran
if ((idout.ne.1).and.(idout.ne.7)) go to 300
go to 38
25 if (mode.ge.4) go to 30
c... ac
if (idout.ge.13) go to 300
go to 38
30 if (mode.eq.5) go to 35
c... noise
if ((idout.ne.13).and.(idout.ne.14)) go to 300
go to 38
c... distortion
35 if (idout.lt.15) go to 300
38 ktype=0
ltype=idout
if (idout.lt.7) go to 40
ktype=1
ltype=ltype-6
if (idout.lt.13) go to 40
ktype=idout-11
ltype=1
c
c voltage output
c
40 id=40+mode
if (ktype.ne.0) go to 100
if (nodplc(icode+ifld+1).ne.0) go to 300
ifld=ifld+1
n1=value(ifield+ifld)
if (n1.lt.0) go to 300
if(n1.gt.9999) go to 300
n2=0
adelim=value(idelim+ifld)
if (adelim.eq.acomma) go to 45
if (adelim.ne.ablnk) go to 50
45 if (nodplc(icode+ifld+1).ne.0) go to 300
ifld=ifld+1
n2=value(ifield+ifld)
if (n2.lt.0) go to 300
if(n2.gt.9999) go to 300
50 outnam=ablnk
ipos=1
call alfnum(n1,outnam,ipos)
ipos=5
call alfnum(n2,outnam,ipos)
call find(outnam,id,loct,0)
nodplc(loct+2)=n1
nodplc(loct+3)=n2
go to 400
c
c current output
c
100 if (ktype.ne.1) go to 200
if (nodplc(icode+ifld+1).ne.1) go to 300
ifld=ifld+1
avsrc=value(ifield+ifld)
achek=avsrc
call move(achek,2,ablnk,1,7)
if (achek.ne.aletv) go to 300
call find(avsrc,id,loct,0)
call find(avsrc,9,nodplc(loct+2),0)
nodplc(loct+5)=1
go to 400
c
c noise or distortion outputs
c
200 id=44
if (ktype.ge.4) id=id+1
if (value(idelim+ifld).ne.alprn) go to 220
if (nodplc(icode+ifld+1).ne.1) go to 300
ifld=ifld+1
atype=value(ifield+ifld)
call move(atype,2,ablnk,1,7)
do 210 i=1,5
if (atype.ne.aopts(i)) go to 210
ltype=i+1
go to 220
210 continue
go to 300
220 call find(anam,id,loct,0)
nodplc(loct+2)=0
nodplc(loct+5)=ktype
go to 400
c
c errors
c
300 igoof=1
c
c finished
c
400 return
end
subroutine card
implicit double precision (a-h,o-z)
c
c this routine scans the input lines, storing each field into the
c tables ifield, idelim, icolum, and icode. with the exception of the
c '.end' line, card always reads the next line to check for a possible
c continuation before it exits.
c
common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval
common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
1 defas,rstats(50),iwidth,lwidth,nopage
common /line/ achar,afield(15),oldlin(15),kntrc,kntlim
common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok,
1 gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox
common /blank/ value(1000)
integer nodplc(64)
complex*16 cvalue(32)
equivalence (value(1),nodplc(1),cvalue(1))
c
dimension adigit(10)
data adigit / 1h0,1h1,1h2,1h3,1h4,1h5,1h6,1h7,1h8,1h9 /
data ablnk,aper,aplus,aminus,astk / 1h , 1h., 1h+, 1h-, 1h* /
data ag,ak,au,an,ap,ae,am,af,at /1hg,1hk,1hu,1hn,1hp,1he,1hm,
1 1hf,1ht/
data ai / 1hi /
data alprn, arprn, aequal / 1h(, 1h), 1h= /
data aend / 4h.end /
c
c note: the value of the function *nxtchr* (used extensively in
c this routine) is as follows:
c
c <0: end-of-line
c =0: delimiter found
c >0: non-delimiter found
c
numfld=0
nofld=10
go to 20
c
c read next card
c
10 nofld=10
call getlin
if (keof.eq.0) go to 20
c... error: unexpected end-of-file condition on input
15 keof=1
nofld=1
numfld=0
igoof=1
write (6,16)
16 format('0*error*: .end card missing'/)
go to 1000
c
c eliminate trailing blanks rapidly
c
20 if (afield(nofld).ne.ablnk) go to 40
if (nofld.eq.1) go to 30
nofld=nofld-1
go to 20
c... write blank card
30 write (6,31)
31 format(1x)
go to 10
c... copy the card to output listing
40 write (6,41) (afield(i),i=1,nofld)
41 format(1x,10a8)
c
c initialization for new card
c
45 kntrc=0
kntlim=min0(8*nofld,iwidth)
c
c fetch first non-delimiter (see routine *nxtchr* for list)
c
50 if (nxtchr(0)) 600,50,60
c... check for comment (leading asterisk)
60 if (achar.eq.astk) go to 10
go to 100
c
c fetch next character
c
70 if (nxtchr(0)) 600,80,100
c
c two consecutive delimiters imply numeric zero unless the delimiter
c is a blank or parenthesis.
c
80 if (achar.eq.ablnk) go to 70
if (achar.eq.alprn) go to 70
if (achar.eq.arprn) go to 70
if (achar.eq.aequal) go to 70
c... check for sufficient space in storage arrays
if (numfld.lt.insize-1) go to 90
call extmem(ifield,50)
call extmem(icode,50)
call extmem(idelim,50)
call extmem(icolum,50)
insize=insize+50
90 numfld=numfld+1
value(ifield+numfld)=0.0d0
nodplc(icode+numfld)=0
value(idelim+numfld)=achar
nodplc(icolum+numfld)=kntrc
go to 70
c
c check for sufficient space in storage arrays
c
100 if (numfld.lt.insize-1) go to 110
call extmem(ifield,50)
call extmem(icode,50)
call extmem(idelim,50)
call extmem(icolum,50)
insize=insize+50
c
c begin scan of next field
c
c... initialization
110 jdelim=0
xsign=1.0d0
xmant=0.0d0
idec=0
iexp=0
c... check for leading plus or minus sign
if (achar.eq.aplus) go to 210
if (achar.eq.aminus) go to 200
c... finish initialization
anam=ablnk
kchr=1
c... an isolated period indicates that a continuation card follows
if (achar.ne.aper) go to 120
c... alter initialization slightly if leading period found
idec=1
iexp=-1
anam=aper
kchr=2
c... now take a look at the next character
if (nxtchr(0)) 10,10,120
c
c test for number (any digit)
c
120 do 130 i=1,10
if (achar.ne.adigit(i)) go to 130
xmant=dfloat(i-1)
go to 210
130 continue
c
c assemble name
c
numfld=numfld+1
call move(anam,kchr,achar,1,1)
kchr=kchr+1
do 150 i=kchr,8
if (nxtchr(0)) 160,160,140
140 call move(anam,i,achar,1,1)
150 continue
go to 170
160 jdelim=1
170 value(ifield+numfld)=anam
nodplc(icode+numfld)=1
nodplc(icolum+numfld)=kntrc
c... no '+' format continuation possible for .end card
if (numfld.ge.2) go to 400
if (anam.ne.aend) go to 400
nodplc(icode+numfld+1)=-1
go to 1000
c
c process number
c
c... take note of leading minus sign
200 xsign=-1.0d0
c... take a look at the next character
210 if (nxtchr(0)) 335,335,220
c... test for digit
220 do 230 i=1,10
if (achar.ne.adigit(i)) go to 230
xmant=xmant*10.0d0+dfloat(i-1)
if (idec.eq.0) go to 210
iexp=iexp-1
go to 210
230 continue
c
c check for decimal point
c
if (achar.ne.aper) go to 240
c... make certain that this is the first one found
if (idec.ne.0) go to 500
idec=1
go to 210
c
c test for exponent
c
240 if (achar.ne.ae) go to 300
if (nxtchr(0)) 335,335,250
250 itemp=0
isign=1
c... check for possible leading sign on exponent
if (achar.eq.aplus) go to 260
if (achar.ne.aminus) go to 270
isign=-1
260 if (nxtchr(0)) 285,285,270
c... test for digit
270 do 280 i=1,10
if (achar.ne.adigit(i)) go to 280
itemp=itemp*10+i-1
go to 260
280 continue
go to 290
285 jdelim=1
c... correct internal exponent
290 iexp=iexp+isign*itemp
go to 340
c
c test for scale factor
c
300 if (achar.ne.am) go to 330
c... special check for *me* (as distinguished from *m*)
if (nxtchr(0)) 320,320,310
310 if (achar.ne.ae) go to 315
iexp=iexp+6
go to 340
315 if (achar.ne.ai) go to 325
xmant=xmant*25.4d-6
go to 340
320 jdelim=1
325 iexp=iexp-3
go to 340
330 if (achar.eq.at) iexp=iexp+12
if (achar.eq.ag) iexp=iexp+9
if (achar.eq.ak) iexp=iexp+3
if (achar.eq.au) iexp=iexp-6
if (achar.eq.an) iexp=iexp-9
if (achar.eq.ap) iexp=iexp-12
if (achar.eq.af) iexp=iexp-15
go to 340
335 jdelim=1
c
c assemble the final number
c
340 if (xmant.eq.0.0d0) go to 350
if (iexp.eq.0) go to 350
if (iabs(iexp).ge.201) go to 500
xmant=xmant*dexp(dfloat(iexp)*xlog10)
if (xmant.gt.1.0d+35) go to 500
if (xmant.lt.1.0d-35) go to 500
350 numfld=numfld+1
value(ifield+numfld)=dsign(xmant,xsign)
nodplc(icode+numfld)=0
nodplc(icolum+numfld)=kntrc
c
c skip to non-blank delimiter (if necessary)
c
400 if (jdelim.eq.0) go to 440
410 value(idelim+numfld)=achar
c... the characters ) and . form a single delimiter if adjacent
if (achar.ne.arprn) go to 70
if (nxtchr(0)) 430,430,420
420 if (achar.ne.aper) go to 430
call move(value(idelim+numfld),2,aper,1,1)
go to 70
430 kntrc=kntrc-1
go to 70
440 if (nxtchr(0)) 450,410,440
450 value(idelim+numfld)=achar
go to 600
c
c errors
c
500 write (6,501) kntrc
501 format('0*error*: illegal number -- scan stopped at column ',i3/)
igoof=1
numfld=numfld+1
value(ifield+numfld)=0.0d0
nodplc(icode+numfld)=0
value(idelim+numfld)=achar
nodplc(icolum+numfld)=kntrc
c
c finished
c
600 nodplc(icode+numfld+1)=-1
c
c check next line for possible continuation
c
610 call getlin
if (keof.eq.1) go to 15
nofld=10
620 if (afield(nofld).ne.ablnk) go to 630
if (nofld.eq.1) go to 650
nofld=nofld-1
go to 620
630 kntrc=0
kntlim=min0(8*nofld,iwidth)
c... continuation line has a '+' as first non-delimiter on card
632 if(nxtchr(0)) 650,632,634
634 if(achar.ne.aplus) go to 640
write(6,41) (afield(i),i=1,nofld)
go to 70
640 if (achar.ne.astk) go to 1000
650 write (6,41) (afield(i),i=1,nofld)
go to 610
1000 return
end
subroutine getlin
implicit double precision (a-h,o-z)
c
c this routine reads the next line of input into the array afield.
c if end-of-file is found, the variable keof is set to 1.
c
common /line/ achar,afield(15),oldlin(15),kntrc,kntlim
common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof
call copy8(afield,oldlin,15)
read(5,6,end=10) (afield(i),i=1,10)
go to 100
6 format(10a8)
10 keof=1
100 return
end
integer function nxtchr(int)
implicit double precision (a-h,o-z)
c
c this routine advances the current line scan pointer one column
c and checks whether or not the next character is a delimiter
c
common /line/ achar,afield(15),oldlin(15),kntrc,kntlim
c
dimension adelim(5)
data adelim / 1h , 1h,, 1h=, 1h(, 1h) /
data ablnk / 1h /
data ichar /0/
c
c advance scan pointer (kntrc)
kntrc=kntrc+1
if (kntrc.gt.kntlim) go to 30
call move(achar,1,afield,kntrc,1)
call move(ichar,2,achar,1,1)
if(ichar.gt.31.and.ichar.lt.91) go to 5
c.. delete ascii control codes
if(ichar.lt.32) ichar=32
if(ichar.gt.96.and.ichar.lt.123) ichar=ichar-32
if(ichar.eq.127) ichar=32
call move(achar,1,ichar,2,1)
5 do 10 i=1,5
if (achar.eq.adelim(i)) go to 20
10 continue
c
c non-delimiter
c
nxtchr=1
return
c
c delimiter
c
20 nxtchr=0
return
c
c end-of-line
c
30 nxtchr=-1
achar=ablnk
return
end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.