![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dcops.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 dcops.f CVS log | Up to [CSRG BSD Unix] / 3BSD / cmd / spice |
1.1 ! root 1: subroutine dcop ! 2: implicit double precision (a-h,o-z) ! 3: c ! 4: c ! 5: c this routine prints out the operating points of the nonlinear ! 6: c circuit elements. ! 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 /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, ! 15: 1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs ! 16: common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, ! 17: 1 xmu,mode,modedc,icalc,initf,method,iord,maxord,noncon,iterno, ! 18: 2 itemno,nosolv,ipostp,iscrch ! 19: common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok, ! 20: 1 gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox ! 21: common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad, ! 22: 1 defas,rstats(50),iwidth,lwidth,nopage ! 23: common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop, ! 24: 1 kinel,kidin,kovar,kidout ! 25: common /ac/ fstart,fstop,fincr,skw2,refprl,spw2,jacflg,idfreq, ! 26: 1 inoise,nosprt,nosout,nosin,idist,idprt ! 27: common /blank/ value(1000) ! 28: integer nodplc(64) ! 29: complex*16 cvalue(32) ! 30: equivalence (value(1),nodplc(1),cvalue(1)) ! 31: c ! 32: c ! 33: dimension optitl(4) ! 34: dimension anam(12),av1(12),ai1(12),req(12) ! 35: dimension amod(12),vd(12),cap(12) ! 36: dimension cb(12),cc(12),vbe(12),vbc(12),vce(12),rpi(12), ! 37: 1 ro(12),cpi(12),cmu(12),betadc(12),betaac(12),ft(12), ! 38: 2 ccs(12),cbx(12),rx(12) ! 39: dimension cg(12),vgs(12),vds(12),gds(12),vbs(12),cbd(12),cbs(12), ! 40: 2 cgsov(12),cgdov(12),cgbov(12),vth(12),vdsat(12),cd(12),gm(12), ! 41: 3 ccgg(12),ccgd(12),ccgs(12),ccbg(12),ccbd(12),ccbs(12), ! 42: 4 gmb(12) ! 43: dimension cgs(12),cgd(12),cgb(12),cds(12) ! 44: equivalence(cb(1),cg(1)),(cc(1),vgs(1)),(vbe(1),vds(1)), ! 45: 1(vbc(1),gds(1)),(vce(1),vbs(1)),(rpi(1),cbd(1)), ! 46: 2(ro(1),cbs(1)),(cpi(1),cgsov(1)),(cmu(1),cgdov(1)), ! 47: 3(betadc(1),cgbov(1)),(betaac(1),vth(1)),(ft(1),vdsat(1)), ! 48: 4(ccs(1),cd(1)),(cbx(1),ccgg(1)),(rx(1),ccgd(1)) ! 49: equivalence(vd(1),cg(1)),(cap(1),vgs(1)),(av1(1),vds(1)), ! 50: 1 (ai1(1),gds(1)),(req(1),vbs(1)) ! 51: equivalence (cgs(1),ccgg(1)),(cgd(1),ccgd(1)),(cgb(1),ccgs(1)), ! 52: 1 (cds(1),ccbg(1)) ! 53: dimension afmt1(3),afmt2(2),afmt3(3),afmt4(3) ! 54: data optitl / 8hoperatin, 8hg point , 8hinformat, 8hion / ! 55: data av,avd,avbe,avbc,avce,avgs,avds,avbs / 1hv,2hvd,3hvbe,3hvbc, ! 56: 1 3hvce,3hvgs,3hvds,3hvbs / ! 57: data acntrv,acntri,asrcv,asrci,atrang,atranr,avgain,aigain / ! 58: 1 8hv-contrl, 8hi-contrl, 8hv-source, 8hi-source, ! 59: 2 8htrans-g , 8htrans-r , 8hv gain , 8hi gain / ! 60: data ai,aid,aib,aic,aig / 1hi,2hid,2hib,2hic,2hig / ! 61: data areq,arpi,aro / 3hreq,3hrpi,2hro / ! 62: data acap,acpi,acmu,acgs,acgd,acbd,acbs / 3hcap,3hcpi,3hcmu,3hcgs, ! 63: 1 3hcgd,3hcbd,3hcbs / ! 64: data acgsov,acgdov,acgbov /6hcgsovl,6hcgdovl,6hcgbovl/ ! 65: data accgg,accgd,accgs,accbg,accbd,accbs /7hdqgdvgb,7hdqgdvdb, ! 66: 1 7hdqgdvsb,7hdqbdvgb,7hdqbdvdb,7hdqbdvsb/ ! 67: data acgb,acds / 3hcgb,3hcds / ! 68: data avth, avdsat / 3hvth, 5hvdsat / ! 69: data agm,agds / 2hgm,3hgds / ! 70: data agmb / 4hgmb / ! 71: data accs,acbx,arx /3hccs,3hcbx,2hrx/ ! 72: data abetad,abetaa / 6hbetadc,6hbetaac / ! 73: data aft / 2hft / ! 74: c ! 75: data ablnk /1h / ! 76: data afmt1 /8h(//1h0,1,8h0x, (2x,8h,a8)) / ! 77: data afmt2 /8h(1h ,a8,,8h f10.3)/ ! 78: data afmt3 /8h(1h ,a8,,8h1p d10.,8h2) / ! 79: data afmt4 /8h('0model,8h ', (,8h2x,a8)) / ! 80: c ! 81: c.. fix-up the format statements ! 82: c ! 83: kntr=12 ! 84: if(lwidth.le.80) kntr=7 ! 85: ipos=12 ! 86: call move(afmt1,ipos,ablnk,1,2) ! 87: call alfnum(kntr,afmt1,ipos) ! 88: ipos=9 ! 89: call move(afmt2,ipos,ablnk,1,2) ! 90: call alfnum(kntr,afmt2,ipos) ! 91: ipos=11 ! 92: call move(afmt3,ipos,ablnk,1,2) ! 93: call alfnum(kntr,afmt3,ipos) ! 94: ipos=14 ! 95: call move(afmt4,ipos,ablnk,1,2) ! 96: call alfnum(kntr,afmt4,ipos) ! 97: c ! 98: c compute voltage source currents and power dissipation ! 99: c ! 100: call second(t1) ! 101: if ((mode.eq.1).and.(modedc.eq.2).and.(nosolv.ne.0)) go to 700 ! 102: power=0.0d0 ! 103: if (jelcnt(9).eq.0) go to 50 ! 104: ititle=0 ! 105: 11 format (////5x,'voltage source currents'//5x,'name', ! 106: 1 7x,'current'/) ! 107: loc=locate(9) ! 108: 20 if (loc.eq.0) go to 50 ! 109: locv=nodplc(loc+1) ! 110: iptr=nodplc(loc+6) ! 111: creal=value(lvnim1+iptr) ! 112: power=power-creal*value(locv+1) ! 113: if (ititle.eq.0) write (6,11) ! 114: ititle=1 ! 115: write (6,21) value(locv),creal ! 116: 21 format (/5x,a8,1x,1pd10.3) ! 117: 30 loc=nodplc(loc) ! 118: go to 20 ! 119: 50 loc=locate(10) ! 120: 60 if (loc.eq.0) go to 90 ! 121: locv=nodplc(loc+1) ! 122: node1=nodplc(loc+2) ! 123: node2=nodplc(loc+3) ! 124: power=power-value(locv+1) ! 125: 1 *(value(lvnim1+node1)-value(lvnim1+node2)) ! 126: loc=nodplc(loc) ! 127: go to 60 ! 128: 90 write (6,91) power ! 129: 91 format (//5x,'total power dissipation ',1pd9.2,' watts') ! 130: c ! 131: c small signal device parameters ! 132: c ! 133: numdev=jelcnt(5)+jelcnt(6)+jelcnt(7)+jelcnt(8)+jelcnt(11) ! 134: 1 +jelcnt(12)+jelcnt(13)+jelcnt(14) ! 135: if (numdev.eq.0) go to 600 ! 136: call title(0,lwidth,1,optitl) ! 137: kntlim=lwidth/11 ! 138: c ! 139: c nonlinear voltage controlled current sources ! 140: c ! 141: if (jelcnt(5).eq.0) go to 175 ! 142: ititle=0 ! 143: 111 format(1h0,/,'0**** voltage-controlled current sources') ! 144: loc=locate(5) ! 145: kntr=0 ! 146: 120 if (loc.eq.0) go to 140 ! 147: kntr=kntr+1 ! 148: locv=nodplc(loc+1) ! 149: loct=lx0+nodplc(loc+12) ! 150: anam(kntr)=value(locv) ! 151: ai1(kntr)=value(loct) ! 152: if (kntr.ge.kntlim) go to 150 ! 153: 130 loc=nodplc(loc) ! 154: go to 120 ! 155: 140 if (kntr.eq.0) go to 175 ! 156: 150 if (ititle.eq.0) write (6,111) ! 157: ititle=1 ! 158: write (6,afmt1) (anam(i),i=1,kntr) ! 159: write (6,afmt3) asrci,(ai1(i),i=1,kntr) ! 160: kntr=0 ! 161: if (loc.ne.0) go to 130 ! 162: c ! 163: c nonlinear voltage controlled voltage sources ! 164: c ! 165: 175 if (jelcnt(6).eq.0) go to 186 ! 166: ititle=0 ! 167: 176 format(1h0,/,'0**** voltage-controlled voltage sources') ! 168: loc=locate(6) ! 169: kntr=0 ! 170: 178 if (loc.eq.0) go to 182 ! 171: kntr=kntr+1 ! 172: locv=nodplc(loc+1) ! 173: loct=lx0+nodplc(loc+13) ! 174: anam(kntr)=value(locv) ! 175: av1(kntr)=value(loct) ! 176: ai1(kntr)=value(loct+1) ! 177: if (kntr.ge.kntlim) go to 184 ! 178: 180 loc=nodplc(loc) ! 179: go to 178 ! 180: 182 if (kntr.eq.0) go to 186 ! 181: 184 if (ititle.eq.0) write (6,176) ! 182: ititle=1 ! 183: write (6,afmt1) (anam(i),i=1,kntr) ! 184: write (6,afmt2) asrcv,(av1(i),i=1,kntr) ! 185: write (6,afmt3) asrci,(ai1(i),i=1,kntr) ! 186: kntr=0 ! 187: if (loc.ne.0) go to 180 ! 188: c ! 189: c nonlinear current controlled current sources ! 190: c ! 191: 186 if (jelcnt(7).eq.0) go to 196 ! 192: ititle=0 ! 193: 187 format(1h0,/,'0**** current-controlled current sources') ! 194: loc=locate(7) ! 195: kntr=0 ! 196: 188 if (loc.eq.0) go to 192 ! 197: kntr=kntr+1 ! 198: locv=nodplc(loc+1) ! 199: loct=lx0+nodplc(loc+12) ! 200: anam(kntr)=value(locv) ! 201: ai1(kntr)=value(loct) ! 202: if (kntr.ge.kntlim) go to 194 ! 203: 190 loc=nodplc(loc) ! 204: go to 188 ! 205: 192 if (kntr.eq.0) go to 196 ! 206: 194 if (ititle.eq.0) write (6,187) ! 207: ititle=1 ! 208: write (6,afmt1) (anam(i),i=1,kntr) ! 209: write (6,afmt3) asrci,(ai1(i),i=1,kntr) ! 210: kntr=0 ! 211: if (loc.ne.0) go to 190 ! 212: c ! 213: c nonlinear current controlled voltage sources ! 214: c ! 215: 196 if (jelcnt(8).eq.0) go to 210 ! 216: ititle=0 ! 217: 197 format(1h0,/,'0**** current-controlled voltage sources') ! 218: loc=locate(8) ! 219: kntr=0 ! 220: 198 if (loc.eq.0) go to 202 ! 221: kntr=kntr+1 ! 222: locv=nodplc(loc+1) ! 223: loct=lx0+nodplc(loc+13) ! 224: anam(kntr)=value(locv) ! 225: av1(kntr)=value(loct) ! 226: ai1(kntr)=value(loct+1) ! 227: if (kntr.ge.kntlim) go to 204 ! 228: 200 loc=nodplc(loc) ! 229: go to 198 ! 230: 202 if (kntr.eq.0) go to 210 ! 231: 204 if (ititle.eq.0) write (6,197) ! 232: ititle=1 ! 233: write (6,afmt1) (anam(i),i=1,kntr) ! 234: write (6,afmt2) asrcv,(av1(i),i=1,kntr) ! 235: write (6,afmt3) asrci,(ai1(i),i=1,kntr) ! 236: kntr=0 ! 237: if (loc.ne.0) go to 200 ! 238: c ! 239: c diodes ! 240: c ! 241: 210 if (jelcnt(11).eq.0) go to 300 ! 242: ititle=0 ! 243: 211 format(1h0,/,'0**** diodes') ! 244: loc=locate(11) ! 245: kntr=0 ! 246: 220 if (loc.eq.0) go to 240 ! 247: kntr=kntr+1 ! 248: locv=nodplc(loc+1) ! 249: node1=nodplc(loc+2) ! 250: node2=nodplc(loc+3) ! 251: locm=nodplc(loc+5) ! 252: locm=nodplc(locm+1) ! 253: loct=lx0+nodplc(loc+11) ! 254: anam(kntr)=value(locv) ! 255: amod(kntr)=value(locm) ! 256: cd(kntr)=value(loct+1) ! 257: vd(kntr)=value(lvnim1+node1)-value(lvnim1+node2) ! 258: if (modedc.ne.1) go to 225 ! 259: req(kntr)=1.0d0/value(loct+2) ! 260: cap(kntr)=value(loct+4) ! 261: 225 if (kntr.ge.kntlim) go to 250 ! 262: 230 loc=nodplc(loc) ! 263: go to 220 ! 264: 240 if (kntr.eq.0) go to 300 ! 265: 250 if (ititle.eq.0) write (6,211) ! 266: ititle=1 ! 267: write (6,afmt1) (anam(i),i=1,kntr) ! 268: write (6,afmt4) (amod(i),i=1,kntr) ! 269: write (6,afmt3) aid,(cd(i),i=1,kntr) ! 270: write (6,afmt2) avd,(vd(i),i=1,kntr) ! 271: if (modedc.ne.1) go to 260 ! 272: write (6,afmt3) areq,(req(i),i=1,kntr) ! 273: write (6,afmt3) acap,(cap(i),i=1,kntr) ! 274: 260 kntr=0 ! 275: if (loc.ne.0) go to 230 ! 276: c ! 277: c bipolar junction transistors ! 278: c ! 279: 300 if (jelcnt(12).eq.0) go to 400 ! 280: ititle=0 ! 281: 301 format(1h0,/,'0**** bipolar junction transistors') ! 282: loc=locate(12) ! 283: kntr=0 ! 284: 320 if (loc.eq.0) go to 340 ! 285: kntr=kntr+1 ! 286: locv=nodplc(loc+1) ! 287: node1=nodplc(loc+2) ! 288: node2=nodplc(loc+3) ! 289: node3=nodplc(loc+4) ! 290: locm=nodplc(loc+8) ! 291: type=nodplc(locm+2) ! 292: locm=nodplc(locm+1) ! 293: loct=lx0+nodplc(loc+22) ! 294: anam(kntr)=value(locv) ! 295: amod(kntr)=value(locm) ! 296: cb(kntr)=type*value(loct+3) ! 297: cc(kntr)=type*value(loct+2) ! 298: vbe(kntr)=value(lvnim1+node2)-value(lvnim1+node3) ! 299: vbc(kntr)=value(lvnim1+node2)-value(lvnim1+node1) ! 300: vce(kntr)=vbe(kntr)-vbc(kntr) ! 301: betadc(kntr)=cc(kntr)/dsign(dmax1(dabs(cb(kntr)),1.0d-20), ! 302: 1 cb(kntr)) ! 303: if (modedc.ne.1) go to 325 ! 304: rx(kntr)=0.0d0 ! 305: if(value(loct+16).ne.0.0d0) rx(kntr)=1.0d0/value(loct+16) ! 306: ccs(kntr)=value(loct+13) ! 307: cbx(kntr)=value(loct+15) ! 308: rpi(kntr)=1.0d0/value(loct+4) ! 309: gm(kntr)=value(loct+6) ! 310: ro(kntr)=1.0d0/value(loct+7) ! 311: cpi(kntr)=value(loct+9) ! 312: cmu(kntr)=value(loct+11) ! 313: betaac(kntr)=gm(kntr)*rpi(kntr) ! 314: ft(kntr)=gm(kntr)/(twopi*dmax1(cpi(kntr)+cmu(kntr)+cbx(kntr), ! 315: 1 1.0d-20)) ! 316: 325 if (kntr.ge.kntlim) go to 350 ! 317: 330 loc=nodplc(loc) ! 318: go to 320 ! 319: 340 if (kntr.eq.0) go to 400 ! 320: 350 if (ititle.eq.0) write (6,301) ! 321: ititle=1 ! 322: write (6,afmt1) (anam(i),i=1,kntr) ! 323: write (6,afmt4) (amod(i),i=1,kntr) ! 324: write (6,afmt3) aib,(cb(i),i=1,kntr) ! 325: write (6,afmt3) aic,(cc(i),i=1,kntr) ! 326: write (6,afmt2) avbe,(vbe(i),i=1,kntr) ! 327: write (6,afmt2) avbc,(vbc(i),i=1,kntr) ! 328: write (6,afmt2) avce,(vce(i),i=1,kntr) ! 329: write (6,afmt2) abetad,(betadc(i),i=1,kntr) ! 330: if (modedc.ne.1) go to 360 ! 331: write (6,afmt3) agm,(gm(i),i=1,kntr) ! 332: write (6,afmt3) arpi,(rpi(i),i=1,kntr) ! 333: write(6,afmt3) arx,(rx(i),i=1,kntr) ! 334: write (6,afmt3) aro,(ro(i),i=1,kntr) ! 335: write (6,afmt3) acpi,(cpi(i),i=1,kntr) ! 336: write (6,afmt3) acmu,(cmu(i),i=1,kntr) ! 337: write(6,afmt3) acbx,(cbx(i),i=1,kntr) ! 338: write(6,afmt3) accs,(ccs(i),i=1,kntr) ! 339: write (6,afmt2) abetaa,(betaac(i),i=1,kntr) ! 340: write (6,afmt3) aft,(ft(i),i=1,kntr) ! 341: 360 kntr=0 ! 342: if (loc.ne.0) go to 330 ! 343: c ! 344: c jfets ! 345: c ! 346: 400 if (jelcnt(13).eq.0) go to 500 ! 347: ititle=0 ! 348: 401 format(1h0,/,'0**** jfets') ! 349: loc=locate(13) ! 350: kntr=0 ! 351: 420 if (loc.eq.0) go to 440 ! 352: kntr=kntr+1 ! 353: locv=nodplc(loc+1) ! 354: node1=nodplc(loc+2) ! 355: node2=nodplc(loc+3) ! 356: node3=nodplc(loc+4) ! 357: locm=nodplc(loc+7) ! 358: type=nodplc(locm+2) ! 359: locm=nodplc(locm+1) ! 360: loct=lx0+nodplc(loc+19) ! 361: anam(kntr)=value(locv) ! 362: amod(kntr)=value(locm) ! 363: cd(kntr)=type*(value(loct+3)-value(loct+4)) ! 364: vgs(kntr)=value(lvnim1+node2)-value(lvnim1+node3) ! 365: vds(kntr)=value(lvnim1+node1)-value(lvnim1+node3) ! 366: if (modedc.ne.1) go to 425 ! 367: gm(kntr)=value(loct+5) ! 368: gds(kntr)=value(loct+6) ! 369: cgs(kntr)=value(loct+9) ! 370: cgd(kntr)=value(loct+11) ! 371: 425 if (kntr.ge.kntlim) go to 450 ! 372: 430 loc=nodplc(loc) ! 373: go to 420 ! 374: 440 if (kntr.eq.0) go to 500 ! 375: 450 if (ititle.eq.0) write (6,401) ! 376: ititle=1 ! 377: write (6,afmt1) (anam(i),i=1,kntr) ! 378: write (6,afmt4) (amod(i),i=1,kntr) ! 379: write (6,afmt3) aid,(cd(i),i=1,kntr) ! 380: write (6,afmt2) avgs,(vgs(i),i=1,kntr) ! 381: write (6,afmt2) avds,(vds(i),i=1,kntr) ! 382: if (modedc.ne.1) go to 460 ! 383: write (6,afmt3) agm,(gm(i),i=1,kntr) ! 384: write (6,afmt3) agds,(gds(i),i=1,kntr) ! 385: write (6,afmt3) acgs,(cgs(i),i=1,kntr) ! 386: write (6,afmt3) acgd,(cgd(i),i=1,kntr) ! 387: 460 kntr=0 ! 388: if (loc.ne.0) go to 430 ! 389: c ! 390: c mosfets ! 391: c ! 392: 500 if (jelcnt(14).eq.0) go to 600 ! 393: ititle=0 ! 394: 501 format(1h0,/,'0**** mosfets') ! 395: loc=locate(14) ! 396: kntr=0 ! 397: 520 if (loc.eq.0) go to 540 ! 398: kntr=kntr+1 ! 399: locv=nodplc(loc+1) ! 400: node1=nodplc(loc+2) ! 401: node2=nodplc(loc+3) ! 402: node3=nodplc(loc+4) ! 403: node4=nodplc(loc+5) ! 404: node5=nodplc(loc+6) ! 405: node6=nodplc(loc+7) ! 406: locm=nodplc(loc+8) ! 407: type=nodplc(locm+2) ! 408: locm=nodplc(locm+1) ! 409: loct=lx0+nodplc(loc+26) ! 410: anam(kntr)=value(locv) ! 411: amod(kntr)=value(locm) ! 412: if(type.eq.0.0d0) go to 522 ! 413: cd(kntr)=type*value(loct+4) ! 414: vgs(kntr)=value(lvnim1+node2)-value(lvnim1+node3) ! 415: vds(kntr)=value(lvnim1+node1)-value(lvnim1+node3) ! 416: vbs(kntr)=value(lvnim1+node4)-value(lvnim1+node3) ! 417: if (modedc.ne.1) go to 525 ! 418: xl=value(locv+1)-2.0d0*value(locm+20) ! 419: xw=value(locv+2)-2.0d0*value(locm+36) ! 420: covlgs=value(locm+8)*xw ! 421: covlgd=value(locm+9)*xw ! 422: covlgb=value(locm+10)*xl ! 423: devmod=value(locv+8) ! 424: vdsat(kntr)=value(locv+10) ! 425: vth(kntr)=value(locv+9)+type*(value(lvnim1+node4)- ! 426: 1 value(lvnim1+node6)) ! 427: gds(kntr)=value(loct+1) ! 428: gm(kntr)=value(loct) ! 429: gmb(kntr)=-(value(loct)+value(loct+1)+value(loct+2)) ! 430: if(devmod.gt.0.0d0) go to 521 ! 431: gds(kntr)=value(loct+2) ! 432: vth(kntr)=value(locv+9)+type*(value(lvnim1+node4)- ! 433: 1 value(lvnim1+node5)) ! 434: 521 cbd(kntr)=value(loct+14) ! 435: cbs(kntr)=value(loct+15) ! 436: cgsov(kntr)=covlgs ! 437: cgdov(kntr)=covlgd ! 438: cgbov(kntr)=covlgb ! 439: ccgg(kntr)=value(loct+8) ! 440: ccgd(kntr)=value(loct+9) ! 441: ccgs(kntr)=value(loct+10) ! 442: ccbg(kntr)=value(loct+11) ! 443: ccbd(kntr)=value(loct+12) ! 444: ccbs(kntr)=value(loct+13) ! 445: go to 525 ! 446: c... special case for ga-as ! 447: 522 cd(kntr)=value(loct+4) ! 448: cg(kntr)=value(loct+5) ! 449: vgs(kntr)=value(lvnim1+node2)-value(lvnim1+node3) ! 450: vds(kntr)=value(lvnim1+node1)-value(lvnim1+node3) ! 451: vbs(kntr)=value(lvnim1+node4)-value(lvnim1+node3) ! 452: if(modedc.ne.1) go to 525 ! 453: modeop=value(locv+8) ! 454: gm(kntr)=value(loct+7) ! 455: gds(kntr)=(value(loct+8)*value(loct+11)) ! 456: 1 /(value(loct+8)+value(loct+11)) ! 457: if(modeop.le.0) gm(kntr)=value(loct+13) ! 458: cds(kntr)=value(loct+10) ! 459: cgs(kntr)=value(loct+12) ! 460: cgd(kntr)=value(loct+14) ! 461: cgb(kntr)=value(loct+16) ! 462: 525 if (kntr.ge.kntlim) go to 550 ! 463: 530 loc=nodplc(loc) ! 464: go to 520 ! 465: 540 if (kntr.eq.0) go to 600 ! 466: 550 if (ititle.eq.0) write (6,501) ! 467: ititle=1 ! 468: write (6,afmt1) (anam(i),i=1,kntr) ! 469: write (6,afmt4) (amod(i),i=1,kntr) ! 470: if(type.eq.0.0d0) go to 555 ! 471: write (6,afmt3) aid,(cd(i),i=1,kntr) ! 472: write (6,afmt2) avgs,(vgs(i),i=1,kntr) ! 473: write (6,afmt2) avds,(vds(i),i=1,kntr) ! 474: write (6,afmt2) avbs,(vbs(i),i=1,kntr) ! 475: if (modedc.ne.1) go to 560 ! 476: write (6,afmt2) avth,(vth(i),i=1,kntr) ! 477: write (6,afmt2) avdsat,(vdsat(i),i=1,kntr) ! 478: write (6,afmt3) agm,(gm(i),i=1,kntr) ! 479: write (6,afmt3) agds,(gds(i),i=1,kntr) ! 480: write (6,afmt3) agmb,(gmb(i),i=1,kntr) ! 481: write (6,afmt3) acbd,(cbd(i),i=1,kntr) ! 482: write (6,afmt3) acbs,(cbs(i),i=1,kntr) ! 483: write (6,afmt3) acgsov,(cgsov(i),i=1,kntr) ! 484: write (6,afmt3) acgdov,(cgdov(i),i=1,kntr) ! 485: write (6,afmt3) acgbov,(cgbov(i),i=1,kntr) ! 486: write(6,551) ! 487: 551 format(' derivatives of gate (dqgdvx) and bulk (dqbdvx) charges') ! 488: write (6,afmt3) accgg,(ccgg(i),i=1,kntr) ! 489: write (6,afmt3) accgd,(ccgd(i),i=1,kntr) ! 490: write (6,afmt3) accgs,(ccgs(i),i=1,kntr) ! 491: write (6,afmt3) accbg,(ccbg(i),i=1,kntr) ! 492: write (6,afmt3) accbd,(ccbd(i),i=1,kntr) ! 493: write (6,afmt3) accbs,(ccbs(i),i=1,kntr) ! 494: go to 560 ! 495: 555 write(6,afmt3) aid,(cd(i),i=1,kntr) ! 496: write(6,afmt3) aig,(cg(i),i=1,kntr) ! 497: write (6,afmt2) avgs,(vgs(i),i=1,kntr) ! 498: write (6,afmt2) avds,(vds(i),i=1,kntr) ! 499: write (6,afmt2) avbs,(vbs(i),i=1,kntr) ! 500: if (modedc.ne.1) go to 560 ! 501: write (6,afmt3) agm,(gm(i),i=1,kntr) ! 502: write (6,afmt3) agds,(gds(i),i=1,kntr) ! 503: write (6,afmt3) acgs,(cgs(i),i=1,kntr) ! 504: write (6,afmt3) acgd,(cgd(i),i=1,kntr) ! 505: write (6,afmt3) acgb,(cgb(i),i=1,kntr) ! 506: write (6,afmt3) acds,(cds(i),i=1,kntr) ! 507: 560 kntr=0 ! 508: if (loc.ne.0) go to 530 ! 509: 600 if (modedc.ne.1) go to 700 ! 510: if (kinel.eq.0) go to 610 ! 511: call sstf ! 512: 610 if (nsens.eq.0) go to 700 ! 513: call sencal ! 514: c ! 515: c finished ! 516: c ! 517: 700 if (modedc.eq.2) go to 710 ! 518: if (jacflg.ne.0) go to 705 ! 519: call clrmem(lvnim1) ! 520: call clrmem(lx0) ! 521: 705 call clrmem(lvn) ! 522: call clrmem(ndiag) ! 523: 710 call second(t2) ! 524: rstats(5)=rstats(5)+t2-t1 ! 525: return ! 526: end ! 527: subroutine sstf ! 528: implicit double precision (a-h,o-z) ! 529: c ! 530: c this routine computes the value of the small-signal transfer ! 531: c function specified by the user. ! 532: c ! 533: common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, ! 534: 1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, ! 535: 2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, ! 536: 3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, ! 537: 4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, ! 538: 5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval ! 539: common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, ! 540: 1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs ! 541: common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, ! 542: 1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof ! 543: common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop, ! 544: 1 kinel,kidin,kovar,kidout ! 545: common /blank/ value(1000) ! 546: integer nodplc(64) ! 547: complex*16 cvalue(32) ! 548: equivalence (value(1),nodplc(1),cvalue(1)) ! 549: c ! 550: c ! 551: dimension string(5),save(3) ! 552: data aslash, ablnk / 1h/, 1h / ! 553: c ! 554: c setup current vector for input resistance and transfer function ! 555: c ! 556: call zero8(value(lvn+1),nstop) ! 557: if (kidin.eq.10) go to 5 ! 558: c... voltage source input ! 559: iptri=nodplc(kinel+6) ! 560: value(lvn+iptri)=+1.0d0 ! 561: go to 10 ! 562: c... current source input ! 563: 5 noposi=nodplc(kinel+2) ! 564: nonegi=nodplc(kinel+3) ! 565: value(lvn+noposi)=-1.0d0 ! 566: value(lvn+nonegi)=+1.0d0 ! 567: c ! 568: c lu decompose and solve the system of circuit equations ! 569: c ! 570: c... reorder the right-hand side ! 571: 10 do 15 i=2,nstop ! 572: j=nodplc(iswap+i) ! 573: value(ndiag+i)=value(lvn+j) ! 574: 15 continue ! 575: call copy8(value(ndiag+1),value(lvn+1),nstop) ! 576: 20 call dcdcmp ! 577: call dcsol ! 578: value(lvn+1)=0.0d0 ! 579: c ! 580: c evaluate transfer function ! 581: c ! 582: if (nodplc(kovar+5).ne.0) go to 30 ! 583: c... voltage output ! 584: noposo=nodplc(kovar+2) ! 585: nonego=nodplc(kovar+3) ! 586: trfn=value(lvn+noposo)-value(lvn+nonego) ! 587: go to 40 ! 588: c... current output (through voltage source) ! 589: 30 iptro=nodplc(kovar+2) ! 590: iptro=nodplc(iptro+6) ! 591: trfn=value(lvn+iptro) ! 592: c ! 593: c evaluate input resistance ! 594: c ! 595: 40 if (kidin.eq.9) go to 50 ! 596: c... current source input ! 597: zin=value(lvn+nonegi)-value(lvn+noposi) ! 598: go to 70 ! 599: c... voltage source input ! 600: 50 creal=value(lvn+iptri) ! 601: if (dabs(creal).ge.1.0d-20) go to 60 ! 602: zin=1.0d20 ! 603: go to 70 ! 604: 60 zin=-1.0d0/creal ! 605: c ! 606: c setup current vector for output resistance ! 607: c ! 608: 70 call zero8(value(lvn+1),nstop) ! 609: if (nodplc(kovar+5).ne.0) go to 80 ! 610: c... voltage output ! 611: value(lvn+noposo)=-1.0d0 ! 612: value(lvn+nonego)=+1.0d0 ! 613: go to 90 ! 614: 80 if (nodplc(kovar+2).ne.kinel) go to 85 ! 615: zout=zin ! 616: go to 200 ! 617: c... current output (through voltage source) ! 618: 85 value(lvn+iptro)=+1.0d0 ! 619: c ! 620: c perform new forward and backward substitution ! 621: c ! 622: c... reorder the right-hand side ! 623: 90 do 95 i=2,nstop ! 624: j=nodplc(iswap+i) ! 625: value(ndiag+i)=value(lvn+j) ! 626: 95 continue ! 627: call copy8(value(ndiag+1),value(lvn+1),nstop) ! 628: call dcsol ! 629: value(lvn+1)=0.0d0 ! 630: c ! 631: c evaluate output resistance ! 632: c ! 633: 100 if (nodplc(kovar+5).ne.0) go to 110 ! 634: c... voltage output ! 635: zout=value(lvn+nonego)-value(lvn+noposo) ! 636: go to 200 ! 637: c... current output (through voltage source) ! 638: 110 creal=value(lvn+iptro) ! 639: if (dabs(creal).ge.1.0d-20) go to 120 ! 640: zout=1.0d20 ! 641: go to 200 ! 642: 120 zout=-1.0d0/creal ! 643: c ! 644: c print results ! 645: c ! 646: 200 do 210 i=1,5 ! 647: string(i)=ablnk ! 648: 210 continue ! 649: ipos=1 ! 650: call outnam(kovar,1,string,ipos) ! 651: call copy8(string,save,3) ! 652: call move(string,ipos,aslash,1,1) ! 653: ipos=ipos+1 ! 654: locv=nodplc(kinel+1) ! 655: anam=value(locv) ! 656: call move(string,ipos,anam,1,8) ! 657: write (6,231) string,trfn,anam,zin,save,zout ! 658: 231 format(////,'0**** small-signal characteristics'//, ! 659: 1 1h0,5x,5a8,3h = ,1pd10.3,/, ! 660: 2 1h0,5x,'input resistance at ',a8,12x,3h = ,d10.3,/, ! 661: 3 1h0,5x,'output resistance at ',2a8,a3,3h = ,d10.3) ! 662: return ! 663: end ! 664: subroutine sencal ! 665: implicit double precision (a-h,o-z) ! 666: c ! 667: c this routine computes the dc sensitivities of circuit elements ! 668: c with respect to user specified outputs. ! 669: c ! 670: common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, ! 671: 1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, ! 672: 2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, ! 673: 3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, ! 674: 4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, ! 675: 5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval ! 676: common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, ! 677: 1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs ! 678: common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, ! 679: 1 xmu,mode,modedc,icalc,initf,method,iord,maxord,noncon,iterno, ! 680: 2 itemno,nosolv,ipostp,iscrch ! 681: common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad, ! 682: 1 defas,rstats(50),iwidth,lwidth,nopage ! 683: common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, ! 684: 1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,igoof,nogo,keof ! 685: common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop, ! 686: 1 kinel,kidin,kovar,kidout ! 687: common /blank/ value(1000) ! 688: integer nodplc(64) ! 689: complex*16 cvalue(32) ! 690: equivalence (value(1),nodplc(1),cvalue(1)) ! 691: c ! 692: c ! 693: dimension string(5),sentit(4) ! 694: data alsrs,alsis,alsn,alsrb,alsrc,alsre / 2hrs,2his,1hn,2hrb,2hrc, ! 695: 1 2hre / ! 696: data alsbf,alsc2,alsbr,alsc4,alsne,alsnc,alsik,alsikr,alsva,alsvb ! 697: 1 / 2hbf,3hjle,2hbr,3hjlc,3hnle,3hnlc,3hjbf,3hjbr,3hvbf,3hvbr/ ! 698: data alsjs /2hjs/ ! 699: data sentit / 8hdc sensi, 8htivity a, 8hnalysis , 8h / ! 700: data ablnk / 1h / ! 701: c ! 702: c ! 703: if (kinel.ne.0) go to 8 ! 704: 4 call dcdcmp ! 705: c ! 706: c ! 707: 8 do 1000 n=1,nsens ! 708: c ! 709: c prepare adjoint excitation vector ! 710: c ! 711: call zero8(value(lvn+1),nstop) ! 712: locs=nodplc(isens+n) ! 713: ioutyp=nodplc(locs+5) ! 714: if (ioutyp.ne.0) go to 10 ! 715: c... voltage output ! 716: ivolts=1 ! 717: noposo=nodplc(locs+2) ! 718: nonego=nodplc(locs+3) ! 719: value(lvn+noposo)=-1.0d0 ! 720: value(lvn+nonego)=+1.0d0 ! 721: go to 20 ! 722: c... current output (through voltage source) ! 723: 10 iptro=nodplc(locs+2) ! 724: ivolts=0 ! 725: iptro=nodplc(iptro+6) ! 726: value(lvn+iptro)=-1.0d0 ! 727: c ! 728: c obtain adjoint solution by doing forward/backward substitution on ! 729: c the transpose of the y matrix ! 730: c ! 731: 20 call asol ! 732: value(lvn+1)=0.0d0 ! 733: c ! 734: c real solution in lvnim1; adjoint solution in lvn ... ! 735: c ! 736: call title(0,lwidth,1,sentit) ! 737: ipos=1 ! 738: call outnam(locs,1,string,ipos) ! 739: call move(string,ipos,ablnk,1,7) ! 740: jstop=(ipos+6)/8 ! 741: write (6,36) (string(j),j=1,jstop) ! 742: 36 format('0dc sensitivities of output ',5a8) ! 743: if(ivolts.ne.0) write (6,41) ! 744: if(ivolts.eq.0) write(6,42) ! 745: 41 format(1h0,8x,'element',9x,'element',7x,'element',7x,'normalized'/ ! 746: 1 10x,'name',12x,'value',6x,'sensitivity sensitivity'/35x, ! 747: 2 ' (volts/unit) (volts/percent)'/) ! 748: 42 format(1h0,8x,'element',9x,'element',7x,'element',7x,'normalized'/ ! 749: 1 10x,'name',12x,'value',6x,'sensitivity sensitivity'/35x, ! 750: 2 ' (amps/unit) (amps/percent)'/) ! 751: c ! 752: c resistors ! 753: c ! 754: loc=locate(1) ! 755: 100 if (loc.eq.0) go to 110 ! 756: locv=nodplc(loc+1) ! 757: node1=nodplc(loc+2) ! 758: node2=nodplc(loc+3) ! 759: val=1.0d0/value(locv+1) ! 760: sens=-(value(lvnim1+node1)-value(lvnim1+node2))* ! 761: 1 (value(lvn +node1)-value(lvn +node2))/(val*val) ! 762: sensn=val*sens/100.0d0 ! 763: write (6,101) value(locv),val,sens,sensn ! 764: 101 format(10x,a8,4x,1pd10.3,5x,d10.3,5x,d10.3) ! 765: 105 loc=nodplc(loc) ! 766: go to 100 ! 767: c ! 768: c voltage sources ! 769: c ! 770: 110 loc=locate(9) ! 771: 140 if (loc.eq.0) go to 150 ! 772: locv=nodplc(loc+1) ! 773: val=value(locv+1) ! 774: iptrv=nodplc(loc+6) ! 775: sens=-value(lvn+iptrv) ! 776: sensn=val*sens/100.0d0 ! 777: write (6,101) value(locv),val,sens,sensn ! 778: 145 loc=nodplc(loc) ! 779: go to 140 ! 780: c ! 781: c current sources ! 782: c ! 783: 150 loc=locate(10) ! 784: 160 if (loc.eq.0) go to 170 ! 785: locv=nodplc(loc+1) ! 786: node1=nodplc(loc+2) ! 787: node2=nodplc(loc+3) ! 788: val=value(locv+1) ! 789: sens=value(lvn+node1)-value(lvn+node2) ! 790: sensn=val*sens/100.0d0 ! 791: write (6,101) value(locv),val,sens,sensn ! 792: 165 loc=nodplc(loc) ! 793: go to 160 ! 794: c ! 795: c diodes ! 796: c ! 797: 170 loc=locate(11) ! 798: 180 if (loc.eq.0) go to 210 ! 799: locv=nodplc(loc+1) ! 800: write (6,181) value(locv) ! 801: 181 format(1x,a8) ! 802: node1=nodplc(loc+2) ! 803: node2=nodplc(loc+3) ! 804: node3=nodplc(loc+4) ! 805: locm=nodplc(loc+5) ! 806: locm=nodplc(locm+1) ! 807: area=value(locv+1) ! 808: c ! 809: c series resistance (rs) ! 810: c ! 811: val=value(locm+2)*area ! 812: if (val.ne.0.0d0) go to 190 ! 813: write (6,186) alsrs ! 814: 186 format(10x,a8,5x,2h0.,13x,2h0.,13x,2h0.) ! 815: go to 200 ! 816: 190 val=1.0d0/val ! 817: sens=-(value(lvnim1+node1)-value(lvnim1+node3))* ! 818: 1 (value(lvn +node1)-value(lvn +node3))/(val*val) ! 819: sensn=val*sens/100.0d0 ! 820: write (6,101) alsrs,val,sens,sensn ! 821: c ! 822: c intrinsic parameters ! 823: c ! 824: 200 csat=value(locm+1)*area ! 825: xn=value(locm+3) ! 826: vbe=value(lvnim1+node3)-value(lvnim1+node2) ! 827: vte=xn*vt ! 828: evbe=dexp(vbe/vte) ! 829: vabe=value(lvn+node3)-value(lvn+node2) ! 830: c ! 831: c saturation current (is) ! 832: c ! 833: sens=vabe*(evbe-1.0d0) ! 834: sensn=csat*sens/100.0d0 ! 835: write (6,101) alsis,csat,sens,sensn ! 836: c ! 837: c ideality factor (n) ! 838: c ! 839: sens=-vabe*(csat/xn)*(vbe/vte)*evbe ! 840: if (dabs(sens).lt.1.0d-50) sens=0.0d0 ! 841: sensn=xn*sens/100.0d0 ! 842: write (6,101) alsn,xn,sens,sensn ! 843: 205 loc=nodplc(loc) ! 844: go to 180 ! 845: c ! 846: c bipolar junction transistors ! 847: c ! 848: 210 loc=locate(12) ! 849: 220 if (loc.eq.0) go to 1000 ! 850: locv=nodplc(loc+1) ! 851: write (6,181) value(locv) ! 852: node1=nodplc(loc+2) ! 853: node2=nodplc(loc+3) ! 854: node3=nodplc(loc+4) ! 855: node4=nodplc(loc+5) ! 856: node5=nodplc(loc+6) ! 857: node6=nodplc(loc+7) ! 858: locm=nodplc(loc+8) ! 859: type=nodplc(locm+2) ! 860: locm=nodplc(locm+1) ! 861: loct=lx0+nodplc(loc+22) ! 862: area=value(locv+1) ! 863: c ! 864: c base resistance (rb) ! 865: c ! 866: val=value(loct+16) ! 867: if (val.ne.0.0d0) go to 230 ! 868: write (6,186) alsrb ! 869: go to 240 ! 870: 230 val=1.0d0/val ! 871: sens=-(value(lvnim1+node2)-value(lvnim1+node5))* ! 872: 1 (value(lvn +node2)-value(lvn +node5))/(val*val) ! 873: sensn=val*sens/100.0d0 ! 874: write (6,101) alsrb,val,sens,sensn ! 875: c ! 876: c collector resistance (rc) ! 877: c ! 878: 240 val=value(locm+20)*area ! 879: if (val.ne.0.0d0) go to 250 ! 880: write (6,186) alsrc ! 881: go to 260 ! 882: 250 val=1.0d0/val ! 883: sens=-(value(lvnim1+node1)-value(lvnim1+node4))* ! 884: 1 (value(lvn +node1)-value(lvn +node4))/(val*val) ! 885: sensn=val*sens/100.0d0 ! 886: write (6,101) alsrc,val,sens,sensn ! 887: c ! 888: c emitter resistance (re) ! 889: c ! 890: 260 val=value(locm+19)*area ! 891: if (val.ne.0.0d0) go to 270 ! 892: write (6,186) alsre ! 893: go to 280 ! 894: 270 val=1.0d0/val ! 895: sens=-(value(lvnim1+node3)-value(lvnim1+node6))* ! 896: 1 (value(lvn +node3)-value(lvn +node6))/(val*val) ! 897: sensn=val*sens/100.0d0 ! 898: write (6,101) alsre,val,sens,sensn ! 899: c ! 900: c intrinsic parameters ! 901: c ! 902: 280 bf=value(locm+2) ! 903: br=value(locm+8) ! 904: csat=value(locm+1)*area ! 905: ova=value(locm+4) ! 906: ovb=value(locm+19) ! 907: oik=value(locm+5)/area ! 908: c2=value(locm+6)*area ! 909: xne=value(locm+7) ! 910: vte=xne*vt ! 911: oikr=value(locm+11)/area ! 912: c4=value(locm+12)*area ! 913: xnc=value(locm+13) ! 914: vtc=xnc*vt ! 915: vbe=type*(value(lvnim1+node5)-value(lvnim1+node6)) ! 916: vbc=type*(value(lvnim1+node5)-value(lvnim1+node4)) ! 917: vabe=type*(value(lvn+node5)-value(lvn+node6)) ! 918: vabc=type*(value(lvn+node5)-value(lvn+node4)) ! 919: vace=vabe-vabc ! 920: if (vbe.le.-vt) go to 320 ! 921: evbe=dexp(vbe/vt/value(locm+3)) ! 922: cbe=csat*(evbe-1.0d0) ! 923: gbe=csat*evbe/vt/value(locm+3) ! 924: if (c2.ne.0.0d0) go to 310 ! 925: cben=0.0d0 ! 926: gben=0.0d0 ! 927: go to 350 ! 928: 310 evben=dexp(vbe/vte) ! 929: cben=c2 *(evben-1.0d0) ! 930: gben=c2 *evben/vte ! 931: go to 350 ! 932: 320 gbe=-csat/vbe ! 933: cbe=gbe*vbe ! 934: gben=-c2/vbe ! 935: cben=gben*vbe ! 936: 350 if (vbc.le.-vt) go to 370 ! 937: evbc=dexp(vbc/vt/value(locm+9)) ! 938: cbc=csat*(evbc-1.0d0) ! 939: gbc=csat*evbc/vt/value(locm+9) ! 940: if (c4.ne.0.0d0) go to 360 ! 941: cbcn=0.0d0 ! 942: gbcn=0.0d0 ! 943: go to 400 ! 944: 360 evbcn=dexp(vbc/vtc) ! 945: cbcn=c4 *(evbcn-1.0d0) ! 946: gbcn=c4 *evbcn/vtc ! 947: go to 400 ! 948: 370 gbc=-csat/vbc ! 949: cbc=gbc*vbc ! 950: gbcn=-c4/vbc ! 951: cbcn=gbcn*vbc ! 952: 400 q1=1.0d0/(1.0d0-ova*vbc-ovb*vbe) ! 953: q2=oik*cbe+oikr*cbc ! 954: sqarg=dsqrt(1.0d0+4.0d0*q2) ! 955: qb=q1*(1.0d0+sqarg)/2.0d0 ! 956: dqb=(cbe-cbc)/(qb*qb) ! 957: sqarg=dsqrt(1.0d0+4.0d0*q2) ! 958: dq1=dqb*(1.0d0+sqarg)+(q1*q1)/2.0d0 ! 959: dq2=q1*dqb/sqarg ! 960: c ! 961: c compute sensitivities ! 962: c ! 963: c... bf ! 964: sens=-vabe*cbe/bf/bf ! 965: sensn=bf*sens/100.0d0 ! 966: write (6,101) alsbf,bf,sens,sensn ! 967: c... jle ! 968: if (c2.ne.0.0d0) go to 430 ! 969: write (6,186) alsc2 ! 970: go to 440 ! 971: 430 sens=vabe*cben/c2 ! 972: sensn=c2*sens/100.0d0 ! 973: write (6,101) alsc2,c2,sens,sensn ! 974: c... br ! 975: 440 sens=-vabc*cbc/br/br ! 976: sensn=br*sens/100.0d0 ! 977: write (6,101) alsbr,br,sens,sensn ! 978: c... jlc ! 979: if (c4.ne.0.0d0) go to 450 ! 980: write (6,186) alsc4 ! 981: go to 460 ! 982: 450 sens=vabc*cbcn/c4 ! 983: sensn=c4*sens/100.0d0 ! 984: write (6,101) alsc4,c4,sens,sensn ! 985: c... is ! 986: 460 sens=(vabe*(cbe/bf)+vabc*(cbc/br) ! 987: 1 +vace*(dqb*qb-dq2*q2))/csat ! 988: sensn=csat*sens/100.0d0 ! 989: write (6,101) alsjs,csat,sens,sensn ! 990: c... ne ! 991: sens=-vabe*gben*vbe/xne ! 992: sensn=xne*sens/100.0d0 ! 993: write (6,101) alsne,xne,sens,sensn ! 994: c... nc ! 995: sens=-vabc*gbcn*vbc/xnc ! 996: sensn=xnc*sens/100.0d0 ! 997: write (6,101) alsnc,xnc,sens,sensn ! 998: c... ik ! 999: if (oik.ne.0.0d0) go to 470 ! 1000: write (6,186) alsik ! 1001: go to 480 ! 1002: 470 val=1.0d0/oik ! 1003: sens=vace*dq2*cbe/(val*val) ! 1004: sensn=val*sens/100.0d0 ! 1005: write (6,101) alsik,val,sens,sensn ! 1006: c... ikr ! 1007: 480 if (oikr.ne.0.0d0) go to 490 ! 1008: write (6,186) alsikr ! 1009: go to 500 ! 1010: 490 val=1.0d0/oikr ! 1011: sens=vace*dq2*cbc/(val*val) ! 1012: sensn=val*sens/100.0d0 ! 1013: write (6,101) alsikr,val,sens,sensn ! 1014: c... va ! 1015: 500 if (ova.ne.0.0d0) go to 510 ! 1016: write (6,186) alsva ! 1017: go to 520 ! 1018: 510 va=1.0d0/ova ! 1019: sens=vace*dq1*vbc/(va*va) ! 1020: sensn=va*sens/100.0d0 ! 1021: write (6,101) alsva,va,sens,sensn ! 1022: c... vb ! 1023: 520 if (ovb.ne.0.0d0) go to 530 ! 1024: write (6,186) alsvb ! 1025: go to 540 ! 1026: 530 vb=1.0d0/ovb ! 1027: sens=vace*dq1*vbe/(vb*vb) ! 1028: sensn=vb*sens/100.0d0 ! 1029: write (6,101) alsvb,vb,sens,sensn ! 1030: c ! 1031: c ! 1032: 540 loc=nodplc(loc) ! 1033: go to 220 ! 1034: c ! 1035: c finished ! 1036: c ! 1037: 1000 continue ! 1038: return ! 1039: end ! 1040: subroutine asol ! 1041: implicit double precision (a-h,o-z) ! 1042: c ! 1043: c this routine evaluates the adjoint circuit response by doing a ! 1044: c forward/backward substitution on the transpose of the coefficient ! 1045: c matrix. ! 1046: c ! 1047: common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, ! 1048: 1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, ! 1049: 2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, ! 1050: 3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, ! 1051: 4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, ! 1052: 5 imynl,imvn,lcvn,loutpt,nsnod,nsmat,nsval,icnod,icmat,icval ! 1053: common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, ! 1054: 1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs ! 1055: common /blank/ value(1000) ! 1056: integer nodplc(64) ! 1057: complex*16 cvalue(32) ! 1058: equivalence (value(1),nodplc(1),cvalue(1)) ! 1059: c ! 1060: c forward substitution ! 1061: c ! 1062: do 20 i=2,nstop ! 1063: io=nodplc(iorder+i) ! 1064: value(lvn+io)=value(lvn+io)/value(lynl+io) ! 1065: jstart=nodplc(iur+i) ! 1066: jstop=nodplc(iur+i+1)-1 ! 1067: if (jstart.gt.jstop) go to 20 ! 1068: if (value(lvn+io).eq.0.0d0) go to 20 ! 1069: do 10 j=jstart,jstop ! 1070: jo=nodplc(iuc+j) ! 1071: jo=nodplc(iorder+jo) ! 1072: value(lvn+jo)=value(lvn+jo)-value(lyu+j)*value(lvn+io) ! 1073: 10 continue ! 1074: 20 continue ! 1075: c ! 1076: c backward substitution ! 1077: c ! 1078: k=nstop+1 ! 1079: do 40 i=2,nstop ! 1080: k=k-1 ! 1081: io=nodplc(iorder+k) ! 1082: jstart=nodplc(ilc+k) ! 1083: jstop=nodplc(ilc+k+1)-1 ! 1084: if (jstart.gt.jstop) go to 40 ! 1085: do 30 j=jstart,jstop ! 1086: jo=nodplc(ilr+j) ! 1087: jo=nodplc(iorder+jo) ! 1088: value(lvn+io)=value(lvn+io)-value(lyl+j)*value(lvn+jo) ! 1089: 30 continue ! 1090: 40 continue ! 1091: c ! 1092: c reorder right-hand side ! 1093: c ! 1094: do 50 i=2,nstop ! 1095: j=nodplc(iswap+i) ! 1096: value(ndiag+i)=value(lvn+j) ! 1097: 50 continue ! 1098: call copy8(value(ndiag+1),value(lvn+1),nstop) ! 1099: c ! 1100: c finished ! 1101: c ! 1102: return ! 1103: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.