projects / unix-history / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
BSD 3 development
[unix-history] / usr / src / cmd / spice / readins.f
CommitLineData
2978e8b9
D		 1 subroutine readin
2 implicit double precision (a-h,o-z)
3c
4c
5c this routine drives the input processing of spice. element cards
6c and device models are handled by this routine.
7c
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))
38c
39c control card identifiers
40c
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 /
56c
57c element card identifiers, keywords, and information
58c
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 /
74c
75c model card keywords
76c
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/
153c
154c initialize variables
155c
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
245c
246c error entry
247c
248 40 nogo=1
249c
250c read and decode next card in input deck
251c
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
286c
287c element and device cards
288c
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
300c
301c resistor
302c
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
318c
319c capacitor or inductor
320c
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
345c
346c mutual inductance
347c
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
367c
368c voltage controlled (nonlinear) sources
369c
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
424c
425c current controlled (nonlinear) sources
426c
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
459c
460c independent sources
461c
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
501c... 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
519c
520c device cards
521c
522 300 if(id.ne.14) value(locv+1)=1.0d0
523 locm=loc+ntnods(id)+2
524 ifld=nnods(id)+2
525c
526c temporarily (until modchk) put substrate node into nodplc(loc+5)
527c
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
583c
584c transmission lines
585c
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
633c
634c elements not yet implemented
635c
636 390 write (6,391)
637 391 format('0*error*: element type not yet implemented'/)
638 go to 40
639c
640c element card errors
641c
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
672c
673c model card
674c
675 500 if (nodplc(icode+2).ne.1) go to 650
676 if (nodplc(icode+3).ne.1) go to 650
677c
678c process for library models
679c
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)
701c... 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
725c
726c model card errors
727c
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
738c
739c subcircuit definition
740c
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
777c
778c .ends processing
779c
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
803c
804c subcircuit call
805c
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
824c
825c end
826c
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/
850c
851c this function returns the mgp equivalent of the gp parameters
852c (those which apply)
853c
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
865c
866c this routine searches the keyword table 'keytab' for the possible
867c entry 'tstwrd'. abbreviations are considered as matches.
868c
869 dimension keytab(lentab)
870 integer xxor
871 data ablnk / 1h /
872c
873c
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
882c
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
892c
893 40 index=-1
894 50 return
895 end
896 subroutine extnam(aname,index)
897 implicit double precision (a-h,o-z)
898c
899c this routine adds 'aname' to the list of 'unsatisfied' names (that
900c is, names which can only be resolved after subcircuit expansion).
901c
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
913c
914c
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
920c
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)
929c
930c this routine processes run control cards.
931c
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)
964c
965c
966 integer xxor
967c
968c print/plot keywords
969c
970 dimension aopt(5)
971 dimension aopts(31),lsetop(5)
972 dimension aide(20)
973 data aopt / 2hdc, 2htr, 2hac, 2hno, 2hdi /
974c
975c options card keywords
976c
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 /
985c
986c
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 /
995c
996c
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
999c
1000c dc transfer curves
1001c
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
1038c
1039c frequency specification
1040c
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
1084c
1085c time specification
1086c
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
1122c
1123c transfer function
1124c
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
1153c
1154c operating point
1155c
1156 1550 kssop=1
1157 go to 6000
1158c
1159c noise analysis
1160c
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
1191c
1192c distortion analysis
1193c
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
1231c
1232c fourier analysis
1233c
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
1256c
1257c sensitivity analysis
1258c
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
1278c
1279c temperature variation
1280c
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
1289c
1290c options card
1291c
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
1381c
1382c print card
1383c
1384 3500 iprpl=0
1385 go to 3610
1386c
1387c plot (and print) card
1388c
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
1439c... 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
1457c
1458c errors
1459c
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
1468c
1469c width card
1470c
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
1486c
1487c nodeset statement
1488c
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
1502c
1503c errors on .nodeset statement
1504c
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
1517c
1518c initial conditions statement
1519c
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
1533c
1534c errors on .ic statement
1535c
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
1548c
1549c finished
1550c
1551 6000 return
1552 end
1553 subroutine outdef(ifld,mode,loct,ltype)
1554 implicit double precision (a-h,o-z)
1555c
1556c this routine constructs the internal list element for an output
1557c variable defined on some input card.
1558c
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))
1571c
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 /
1580c
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
1590c
1591c further error checking
1592c
1593 20 if (mode.ge.3) go to 25
1594c... 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
1598c... ac
1599 if (idout.ge.13) go to 300
1600 go to 38
1601 30 if (mode.eq.5) go to 35
1602c... noise
1603 if ((idout.ne.13).and.(idout.ne.14)) go to 300
1604 go to 38
1605c... 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
1615c
1616c voltage output
1617c
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
1643c
1644c current output
1645c
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
1657c
1658c noise or distortion outputs
1659c
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
1677c
1678c errors
1679c
1680 300 igoof=1
1681c
1682c finished
1683c
1684 400 return
1685 end
1686 subroutine card
1687 implicit double precision (a-h,o-z)
1688c
1689c this routine scans the input lines, storing each field into the
1690c tables ifield, idelim, icolum, and icode. with the exception of the
1691c '.end' line, card always reads the next line to check for a possible
1692c continuation before it exits.
1693c
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))
1711c
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 /
1720c
1721c note: the value of the function *nxtchr* (used extensively in
1722c this routine) is as follows:
1723c
1724c <0: end-of-line
1725c =0: delimiter found
1726c >0: non-delimiter found
1727c
1728 numfld=0
1729 nofld=10
1730 go to 20
1731c
1732c read next card
1733c
1734 10 nofld=10
1735 call getlin
1736 if (keof.eq.0) go to 20
1737c... 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
1745c
1746c eliminate trailing blanks rapidly
1747c
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
1752c... write blank card
1753 30 write (6,31)
1754 31 format(1x)
1755 go to 10
1756c... copy the card to output listing
1757 40 write (6,41) (afield(i),i=1,nofld)
1758 41 format(1x,10a8)
1759c
1760c initialization for new card
1761c
1762 45 kntrc=0
1763 kntlim=min0(8*nofld,iwidth)
1764c
1765c fetch first non-delimiter (see routine *nxtchr* for list)
1766c
1767 50 if (nxtchr(0)) 600,50,60
1768c... check for comment (leading asterisk)
1769 60 if (achar.eq.astk) go to 10
1770 go to 100
1771c
1772c fetch next character
1773c
1774 70 if (nxtchr(0)) 600,80,100
1775c
1776c two consecutive delimiters imply numeric zero unless the delimiter
1777c is a blank or parenthesis.
1778c
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
1783c... 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
1796c
1797c check for sufficient space in storage arrays
1798c
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
1805c
1806c begin scan of next field
1807c
1808c... initialization
1809 110 jdelim=0
1810 xsign=1.0d0
1811 xmant=0.0d0
1812 idec=0
1813 iexp=0
1814c... check for leading plus or minus sign
1815 if (achar.eq.aplus) go to 210
1816 if (achar.eq.aminus) go to 200
1817c... finish initialization
1818 anam=ablnk
1819 kchr=1
1820c... an isolated period indicates that a continuation card follows
1821 if (achar.ne.aper) go to 120
1822c... alter initialization slightly if leading period found
1823 idec=1
1824 iexp=-1
1825 anam=aper
1826 kchr=2
1827c... now take a look at the next character
1828 if (nxtchr(0)) 10,10,120
1829c
1830c test for number (any digit)
1831c
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
1837c
1838c assemble name
1839c
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
1852c... 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
1857c
1858c process number
1859c
1860c... take note of leading minus sign
1861 200 xsign=-1.0d0
1862c... take a look at the next character
1863 210 if (nxtchr(0)) 335,335,220
1864c... 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
1872c
1873c check for decimal point
1874c
1875 if (achar.ne.aper) go to 240
1876c... make certain that this is the first one found
1877 if (idec.ne.0) go to 500
1878 idec=1
1879 go to 210
1880c
1881c test for exponent
1882c
1883 240 if (achar.ne.ae) go to 300
1884 if (nxtchr(0)) 335,335,250
1885 250 itemp=0
1886 isign=1
1887c... 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
1892c... 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
1900c... correct internal exponent
1901 290 iexp=iexp+isign*itemp
1902 go to 340
1903c
1904c test for scale factor
1905c
1906 300 if (achar.ne.am) go to 330
1907c... 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
1927c
1928c assemble the final number
1929c
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
1940c
1941c skip to non-blank delimiter (if necessary)
1942c
1943 400 if (jdelim.eq.0) go to 440
1944 410 value(idelim+numfld)=achar
1945c... 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
1956c
1957c errors
1958c
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
1967c
1968c finished
1969c
1970 600 nodplc(icode+numfld+1)=-1
1971c
1972c check next line for possible continuation
1973c
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)
1983c... 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)
1995c
1996c this routine reads the next line of input into the array afield.
1997c if end-of-file is found, the variable keof is set to 1.
1998c
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)
2011c
2012c this routine advances the current line scan pointer one column
2013c and checks whether or not the next character is a delimiter
2014c
2015 common /line/ achar,afield(15),oldlin(15),kntrc,kntlim
2016c
2017 dimension adelim(5)
2018 data adelim / 1h , 1h,, 1h=, 1h(, 1h) /
2019 data ablnk / 1h /
2020 data ichar /0/
2021c
2022c 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
2028c.. 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
2036c
2037c non-delimiter
2038c
2039 nxtchr=1
2040 return
2041c
2042c delimiter
2043c
2044 20 nxtchr=0
2045 return
2046c
2047c end-of-line
2048c
2049 30 nxtchr=-1
2050 achar=ablnk
2051 return
2052 end
Continuous source code history from original PDP-7 UNIX to FreeBSD 2, the first fully unencumbered FreeBSD release.