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