|
|
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.