SPICE,T200,CM60000. UPDATE(N=SPICE2E,C=0) UPDATE(P=SPICE2E,C=COMPILE,F) RUN(S,,,COMPILE,,LGO) LGO. ~eor *COMDECK ASMARG TITLE ASSEMBLE ARGUMENTS INTO B REGISTERS COMPILER MICRO 1,,*FTN* DELETE IF COMPILER IS RUN SYSTEM SPACE 4 SYSTEM MICRO 1,,*SCOPE* DELETE IF OPERATING SYSTEM IS NOT SCOPE SYSTEM MICRO 1,,*CALIDOSCOPE* DITTO FOR CALIDOSCOPE RUN SPACE 4 RUN IFC EQ,*"COMPILER"*RUN* ASMARG OPSYN NIL RUN ENDIF FTN SPACE 4 FTN IFC EQ,*"COMPILER"*FTN* ASMARG MACRO N LOCAL CNT SB1 X1 ASMARG IFGT N,1 CNT SET 1 SB7 1 ASMARG DUP N-1 CNT SET CNT+1 SA1 A1+B7 SB.CNT X1 ASMARG ENDD ASMARG ENDIF ASMARG ENDM FTN ENDIF *COMDECK ASMCOM ASMCOM TITLE ASSEMBLY-LANGUAGE COMMON-BLOCK VARIABLE DEFINITIONS USE /MEMRY/ MAXCOR EQU *+2 BSS 9 TABINF SPACE 2 USE /TABINF/ IORDER EQU *+19 IUR EQU IORDER+2 IUC EQU IUR+1 ILC EQU IUC+1 ILR EQU ILC+1 ISWAP EQU ILR+9 LVN EQU ISWAP+5 LYNL EQU LVN+1 LYU EQU LYNL+1 LYL EQU LYU+1 BSS 55 CIRDAT SPACE 2 USE /CIRDAT/ NSTOP EQU *+103 BSS 111 FLAGS SPACE 2 USE /FLAGS/ IGOOF EQU *+14 NOGO EQU IGOOF+1 BSS 17 KNSTNT SPACE 2 USE /KNSTNT/ GMIN EQU *+8 BSS 17 BLANK SPACE 2 USE /CJE/ MAXMEM EQU *+7 BSS 32 SPACE 2 USE /BLANK/ VALUE EQU *-1 NODPLC EQU VALUE CVALUE EQU VALUE BSS 64 ENDCOM SPACE 2 USE 0 *DECK SPICE OVERLAY(SPICE,0,0) PROGRAM SPICE (INPUT=201,OUTPUT=201,TAPE5=INPUT,TAPE6=OUTPUT) C C C *** VERSION 2E.0 (18JAN78) *** C C C SPICE IS AN ELECTRONIC CIRCUIT SIMULATION PROGRAM THAT WAS DEVE- C LOPED BY THE INTEGRATED CIRCUITS GROUP OF THE ELECTRONICS RESEARCH C LABORATORY AND THE DEPARTMENT OF ELECTRICAL ENGINEERING AND COMPUTER C SCIENCES AT THE UNIVERSITY OF CALIFORNIA, BERKELEY, CALIFORNIA. THE C PROGRAM SPICE IS AVAILABLE FREE OF CHARGE TO ANY INTERESTED PARTY. C THE SALE, RESALE, OR USE OF THIS PROGRAM FOR PROFIT WITHOUT THE C EXPRESS WRITTEN CONSENT OF THE DEPARTMENT OF ELECTRICAL ENGINEERING C AND COMPUTER SCIENCES, UNIVERSITY OF CALIFORNIA, BERKELEY, CALIFORNIA, C IS FORBIDDEN. C C C IMPLEMENTATION NOTES: C C SUBROUTINES MCLOCK AND MDATE RETURN THE TIME (AS HH:MM:SS) AND C THE DATE (AS DD MMM YY), RESPECTIVELY. SUBROUTINE GETCJE RETURNS IN C COMMON BLOCK /CJE/ VARIOUS ATTRIBUTES OF THE CURRENT JOB ENVIRONMENT. C SPICE EXPECTS GETCJE TO SET /CJE/ VARIABLES MAXMEM, MAXTIM, ITIME, C ICOST, AND ILINES TO THE MAXIMUM PERMITTED FIELD LENGTH (IN WORDS), C THE CPU TIME LIMIT FOR THIS JOB (IN MILLISECONDS), THE ELAPSED CPU C TIME (IN MILLISECONDS), THE JOB COST (IN CENTS), AND THE NUMBER OF C LINES PRINTED. IF UNABLE TO OBTAIN THE INFORMATION MENTIONED, SET C MAXMEM AND MAXTIM TO 1E8 AND SET ITIME, ICOST, AND ILINES TO 0. C SUBROUTINE MEMORY IS USED TO CHANGE THE NUMBER OF MEMORY WORDS C ALLOCATED TO SPICE. IF THE AMOUNT OF MEMORY ALLOCATED TO A JOBSTEP C IS FIXED, SUBROUTINE MEMORY NEED NOT BE CHANGED. C IFAMWA (SET IN A DATA STATEMENT BELOW) SHOULD BE SET TO THE C ADDRESS OF THE FIRST AVAILABLE WORD OF MEMORY (FOLLOWING OVERLAYS, IF C ANY). THE PROPER VALUE SHOULD BE EASILY OBTAINABLE FROM ANY LOAD MAP. C FOR CDC INSTALLATIONS, DEFINE SYMBOLS *SYSTEM* AND *COMPILER* C APPROPRIATELY IN COMDECK ASMARG (CALLED BY THE ROUTINES WRITTEN IN C ASSEMBLY LANGUAGE). C WITH THE EXCEPTION OF MOST FLAGS, ALL DATA IN SPICE IS STORED IN C THE FORM OF MANAGED TABLES ALLOCATED IN THE /BLANK/ ARRAY VALUE(). C IN ITS PRESENT FORM, THE PROGRAM ASSUMES THAT BOTH INTEGER AND REAL C VALUES REQUIRE ONE WORD OF MEMORY. IF THIS ASSUMPTION DOES NOT HOLD, C THEN A CONSIDERABLE AMOUNT OF CONVERSION WORK IS NECESSARY. THIS WORK C HAS ALREADY BEEN DONE FOR THE IBM 360. C SPICE IS PARTICULARLY WELL-SUITED TO BEING RUN USING A ONE-LEVEL C OVERLAY STRUCTURE BEGINNING WITH ROUTINES SPICE (THE OVERLAY ROOT), C READIN, ERRCHK, SETUP, DCTRAN, DCOP, ACAN, AND OVTPVT. THE ORDER OF C THE ROUTINES IN THIS LISTING CORRESPONDS TO THAT STRUCTURE. NOTE C THAT IF CDC-STYLE OVERLAY IS TO BE USED, AN OVERLAY DIRECTIVE CARD C MUST BE INSERTED BEFORE THE FIRST LINE OF EACH OF THE JUST-NAMED C ROUTINES. C C COMMON /MEMRY/ LORG,ICORE,MAXCOR,MAXUSE,MEMAVL,LDVAL,NUMBLK, 1 LOCTAB,LTAB COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /MISCEL/ APROG(3),ATIME,ADATE,ATITLE(15),RSTATS(50), 1 IWIDTH,LWIDTH,NOPAGE COMMON /LINE/ ACHAR,AFIELD(15),OLDLIN(15),KNTRC,KNTLIM COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /MOSARG/ GAMMA,BETA,VTO,PHI,COX,VBI,XNFS,XNSUB,XD,XJ,XL, 1 XLAMDA,UTRA,UEXP,VBP,VON,VDSAT,GM,GMBS,GDS,CDRAIN, 1 ALPHA,ALPHAF,TAHPLA,AHPLA2,VALPHA,BETA0,BETA1,SCATT,VSCATT, 2 XW,TOX,AION,BION,CDAVAL,UFB,UPHIB,UTHSUB,ETAD,ETAS,CD1,LEV COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET, 1 MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO, 2 ITEMNO,NOSOLV,MODAC COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /KNSTNT/ TWOPI,XLOG2,XLOG10,ROOT2,RAD,BOLTZ,CHARGE,CTOK, 1 GMIN,RELTOL,ABSTOL,VNTOL,TRTOL,CHGTOL,EPS0,EPSSIL,EPSOX COMMON /DC/ TCSTAR,TCSTOP,TCINCR,ICVFLG,ITCELM,KSSOP,KINEL,KIDIN, 1 KOVAR,KIDOUT COMMON /AC/ FSTART,FSTOP,FINCR,SKW2,REFPRL,SPW2,JACFLG,IDFREQ, 1 INOISE,NOSPRT,NOSOUT,NOSIN,IDIST,IDPRT,JPZFLG,JPZTYP, 2 IPZIN,IPZITP,IPZOUT,IPZEQO,IPZLOC(2),IPZEQI,IPOMAT(3), 3 IPIMAT(4) COMMON /TRAN/ TSTEP,TSTOP,TSTART,DELMAX,TDMAX,FORFRE,JTRFLG COMMON /OUTINF/ STRING(15),YVAR(8),XSTART,XINCR,ITAB(8),ITYPE(8), 1 ILOGY(8),NPOINT,NUMOUT,KNTR,NUMDGT COMMON /CJE/ JOBNAM,USRID1,USRID2,MAXTAP,ITAPE,MAXECS,IECS,MAXMEM, 1 IMEM,MAXLIN,ILINES,MAXPCH,IPUNCH,MAXTIM,ITIME,MAXPPU,IPPU, 2 IEFTIM,ISPTIM,MAXDLR,ICOST,XCJEX(11) COMMON /DEBUG/ IDEBUG(20) COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C DIMENSION ACCTIT(4) INTEGER READIN,ERRCHK,SETUP,DCTRAN,DCOP,ACAN,OVTPVT DATA READIN,ERRCHK,SETUP,DCTRAN,DCOP,ACAN,OVTPVT / 1,2,3,4,5,6,7 / DATA FILNAM / 5HSPICE / DATA ABLNK / 1H / DATA ACCTIT / 8HJOB STAT, 8HISTICS S, 8HUMMARY , 8H / DATA AHDR1 / 8H SPICE / DATA AHDR2 / 8H2E.0 (18 / DATA AHDR3 / 8HJAN78) / C C DATA IFAMWA / 42000B / C C INITIALIZATION C APROG(1)=AHDR1 APROG(2)=AHDR2 APROG(3)=AHDR3 ACHAR=ABLNK KEOF=0 CALL CLOCK(ATIME) CALL DATE(ADATE) BOLTZ=1.3806226E-23 CHARGE=1.6021918E-19 CTOK=273.15 EPS0=8.854214871E-14 EPSSIL=11.7*EPS0 EPSOX=3.9*EPS0 TWOPI=8.0*ATAN2(1.0,1.0) RAD=360.0/TWOPI XLOG2=ALOG(2.0) XLOG10=ALOG(10.0) ROOT2=SQRT(2.0) C C BEGIN JOB C 10 IF (KEOF.EQ.1) GO TO 1000 CALL GETCJE ITIME1=ITIME ICOST1=ICOST ILINE1=ILINES IGOOF=0 MODE=0 NOGO=0 CALL SETMEM(IFAMWA) IF (NOGO.NE.0) GO TO 1000 CALL ZERO8(RSTATS,50) C C READ REMAINDER OF DATA DECK AND CHECK FOR INPUT ERRORS C CALL OVERLAY(FILNAM,READIN,0,0) IF (NOGO.NE.0) GO TO 300 IF (KEOF.EQ.1) GO TO 1000 CALL OVERLAY(FILNAM,ERRCHK,0,0) IF (NOGO.NE.0) GO TO 300 CALL OVERLAY(FILNAM,SETUP,0,0) IF (NOGO.NE.0) GO TO 300 C C CYCLE THROUGH TEMPERATURES C ITEMNO=1 IF (NUMTEM.EQ.1) GO TO 110 100 IF (ITEMNO.EQ.NUMTEM) GO TO 310 ITEMNO=ITEMNO+1 CALL TMPUPD C C DC TRANSFER CURVES C 110 IF (ICVFLG.EQ.0) GO TO 150 C... SEE ROUTINE *DCTRAN* FOR EXPLANATION OF *MODE*, ETC. MODE=1 MODEDC=3 CALL OVERLAY(FILNAM,DCTRAN,0,0) CALL OVERLAY(FILNAM,OVTPVT,0,0) IF (NOGO.NE.0) GO TO 300 C C SMALL SIGNAL OPERATING POINT C 150 IF (KSSOP.GT.0) GO TO 170 IF ((JACFLG+JPZFLG).NE.0) GO TO 170 IF ((ICVFLG+JTRFLG).GT.0) GO TO 250 170 MODE=1 MODEDC=1 CALL OVERLAY(FILNAM,DCTRAN,0,0) IF (NOGO.NE.0) GO TO 300 CALL OVERLAY(FILNAM,DCOP,0,0) IF (NOGO.NE.0) GO TO 300 C C AC SMALL SIGNAL ANALYSIS C 200 IF (JACFLG.EQ.0) GO TO 210 MODE=3 MODAC=1 CALL OVERLAY(FILNAM,ACAN,0,0) CALL OVERLAY(FILNAM,OVTPVT,0,0) IF (NOGO.NE.0) GO TO 300 C C POLE/ZERO ANALYSIS C 210 IF (JPZFLG.EQ.0) GO TO 250 MODE=3 MODAC=2 CALL OVERLAY(FILNAM,ACAN,0,0) IF (NOGO.NE.0) GO TO 300 MODAC=3 CALL OVERLAY(FILNAM,SETUP,0,0) IF (NOGO.NE.0) GO TO 300 CALL OVERLAY(FILNAM,ACAN,0,0) IF (NOGO.NE.0) GO TO 300 IF ((JTRFLG.EQ.0).AND.(ITEMNO.EQ.NUMTEM)) GO TO 310 MODE=0 CALL OVERLAY(FILNAM,SETUP,0,0) C C TRANSIENT ANALYSIS C 250 IF (JTRFLG.EQ.0) GO TO 100 MODE=1 MODEDC=2 CALL OVERLAY(FILNAM,DCTRAN,0,0) IF (NOGO.NE.0) GO TO 300 CALL OVERLAY(FILNAM,DCOP,0,0) IF (NOGO.NE.0) GO TO 300 MODE=2 CALL OVERLAY(FILNAM,DCTRAN,0,0) CALL OVERLAY(FILNAM,OVTPVT,0,0) IF (NOGO.NE.0) GO TO 300 GO TO 100 C C JOB CONCLUDED C 300 WRITE (6,301) 301 FORMAT(1H0,/,1H0,9X,"JOB ABORTED") GO TO 320 310 WRITE (6,311) 311 FORMAT(1H0,/,1H0,9X,"JOB CONCLUDED") C C JOB ACCOUNTING C 320 IF (IPRNTA.EQ.0) GO TO 800 CALL TITLE(-1,LWIDTH,1,ACCTIT) NUMEL=0 DO 360 I=1,18 360 NUMEL=NUMEL+JELCNT(I) WRITE (6,361) NUNODS,NCNODS,NUMNOD,NUMEL,(JELCNT(I),I=11,14) 361 FORMAT(" NUNODS NCNODS NUMNOD NUMEL DIODES BJTS JFETS MFETS" 1 //,I9,2I7,I6,I8,I6,2I7) NUMTEM=MAX0(NUMTEM-1,1) IDIST=MIN0(IDIST,1) WRITE (6,371) NUMTEM,ICVFLG,JTRFLG,JACFLG,INOISE,IDIST,NOGO 371 FORMAT(/"0 NUMTEM ICVFLG JTRFLG JACFLG INOISE IDIST NOGO"/, 1 2H0 ,7I7) WRITE (6,381) RSTATS(20),RSTATS(21),RSTATS(22),RSTATS(23), 1 RSTATS(26),RSTATS(27) 381 FORMAT(/"0 NSTOP NTTBR NTTAR IFILL IOPS PERSPA"//, 1 1X,5F8.0,F9.3) WRITE (6,391) RSTATS(30),RSTATS(31),RSTATS(32),MAXCOR,MAXUSE, 1 RSTATS(33) 391 FORMAT(/"0 NUMTTP NUMRTP NUMNIT",19X,"MAXMEM MAXUSE CPYTIM"//, 1 2X,3F8.0,17X,O6,1HB,I7,F8.3) WRITE (6,401) (RSTATS(I),I=1,11) 401 FORMAT(/, 1 1H0,9X,*READIN *,12X,F10.3/, 2 1H0,9X,*SETUP *,12X,F10.3/, 3 1H0,9X,*TRCURV *,12X,F10.3,10X,F6.0/, 4 1H0,9X,*DCAN *,12X,F10.3,10X,F6.0/, 5 1H0,9X,*ACAN *,12X,F10.3,10X,F6.0/, 6 1H0,9X,*TRANAN *,12X,F10.3,10X,F6.0/, 7 1H0,9X,*OUTPUT *,12X,F10.3) 800 CALL GETCJE ET=FLOAT(ITIME-ITIME1)/1000.0 CPCOST=FLOAT(ICOST-ICOST1)/100.0 PRCOST=FLOAT(ILINES-ILINE1)*0.00060 TCOST=CPCOST+PRCOST RSTATS(34)=CPCOST RSTATS(35)=FLOAT(ILINES-ILINE1) CALL AUDIT IF (IPRNTA.EQ.0) GO TO 810 OHEAD=ET-(RSTATS(1)+RSTATS(2)+RSTATS(3)+RSTATS(5)+RSTATS(7) 1 +RSTATS(9)+RSTATS(11)) WRITE (6,801) OHEAD 801 FORMAT(1H0,9X,*OVERHEAD*,12X,F10.3) 810 WRITE (6,811) ET,TCOST 811 FORMAT(1H0,9X,"TOTAL JOB TIME ",F8.3,/, 1 1H0,9X,"TOTAL JOB COST $",F8.3) WRITE (6,816) CPCOST,PRCOST 816 FORMAT(1H0,9X," COMPUTE COST $",F8.3,/, 1 1H0,9X," PRINTER COST $",F8.3) 900 IF ((MAXTIM-ITIME).GE.LIMTIM*1000) GO TO 10 WRITE (6,901) 901 FORMAT("1WARNING: FURTHER ANALYSIS STOPPED DUE TO CPU TIME LIMIT" 1/) NOGO=0 CALL SETMEM(IFAMWA) 1000 CALL EXIT END SUBROUTINE AUDIT RETURN END SUBROUTINE TITLE(IFOLD,LEN,ICOM,COMENT) C C THIS ROUTINE WRITES A TITLE ON THE OUTPUT FILE. IFOLD INDICATES C WHETHER THE PAGE EJECT SHOULD BE TO THE NEXT CONCAVE, CONVEX, OR ANY C PAGE FOLD DEPENDING ON WHETHER ITS VALUE IS <0, >0, OR =0. THE PAGE C EJECT IS SUPPRESSED (AS IS MUCH OF THE HEADING) IF THE VARIABLE NOPAGE C IS NONZERO. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /MISCEL/ APROG(3),ATIME,ADATE,ATITLE(15),RSTATS(50), 1 IWIDTH,LWIDTH,NOPAGE COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET, 1 MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO, 2 ITEMNO,NOSOLV,MODAC COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C DIMENSION COMENT(4) C C IF (NOPAGE.EQ.1) GO TO 150 IF (IFOLD) 10,30,20 10 WRITE (6,11) 11 FORMAT(1H6) GO TO 30 20 WRITE (6,21) 21 FORMAT(1H7) C C 30 IF (LEN.LE.72) GO TO 100 WRITE (6,31) ADATE,APROG,ATIME,ATITLE 31 FORMAT(1H1,15(1H*),A10,1X,23(1H*),3A8,23(1H*),A10,15(1H*)//1H0, 1 15A8/) IF (ICOM.EQ.0) GO TO 40 WRITE (6,36) COMENT,VALUE(ITEMPS+ITEMNO) 36 FORMAT(1H0,21X,4A8,21X,*TEMPERATURE =*,F9.3,* DEG C*/) 40 WRITE (6,41) 41 FORMAT(1H0,121(1H*)//) GO TO 200 C C 100 WRITE (6,101) ADATE,APROG,ATIME,ATITLE 101 FORMAT(1H1,5(1H*),A10,1X,8(1H*),3A8,8(1H*),A10,5(1H*)//1H0,15A8/) IF (ICOM.EQ.0) GO TO 110 WRITE (6,106) COMENT,VALUE(ITEMPS+ITEMNO) 106 FORMAT(1H0,5X,4A8,* TEMPERATURE =*,F9.3,* DEG C*/) 110 WRITE (6,111) 111 FORMAT(1H0,71(1H*)//) GO TO 200 C C 150 IF (ICOM.EQ.0) GO TO 160 WRITE (6,151) APROG,COMENT 151 FORMAT(1H0,3A8,"-- ",4A8,/) GO TO 200 160 WRITE (6,161) APROG 161 FORMAT(1H0,3A8,/) C C FINISHED C 200 RETURN END SUBROUTINE SETMEM(IPNTR,ISIZE) C C THIS ROUTINE PERFORMS THE DYNAMIC MEMORY MANAGEMENT USED BY SPICE. C C C ENTRY POINTS: C SETMEM - SET INITIAL MEMORY C GETMEM - GET BLOCK C RELMEM - RELEASE PART OF BLOCK C EXTMEM - EXTEND SIZE OF EXISTING BLOCK C SIZMEM - DETERMINE SIZE OF EXISTING BLOCK C CLRMEM - RELEASE BLOCK C PTRMEM - RESET MEMORY POINTER C CRUNCH - FORCE MEMORY COMPACTION C C CALLING SEQUENCES: C CALL SETMEM(IFAMWA) C CALL GETMEM(IPNTR,BLKSIZ) C CALL RELMEM(IPNTR,RELSIZ) C CALL EXTMEM(IPNTR,EXTSIZ) C CALL SIZMEM(IPNTR,BLKSIZ) C CALL CLRMEM(IPNTR) C CALL PTRMEM(IPNTR1,IPNTR2) C CALL CRUNCH C C C GENERAL COMMENTS: C FOR EACH BLOCK WHICH IS ALLOCATED, A 4-WORD ENTRY IS MAINTAINED C IN A TABLE KEPT IN HIGH MEMORY, OF THE FORM C C WORD CONTENTS C ---- -------- C C 1 ADDR(BLOCK ORIGIN)-1 (AS SUBSCRIPT TO NODPLC()) C 2 BLOCK SIZE (IN WORDS) C 3 NUMBER OF WORDS IN USE C 4 ADDRESS OF VARIABLE CONTAINING BLOCK ORIGIN C C ALL ALLOCATED BLOCKS ARE AN EVEN NUMBER OF WORDS IN LENGTH. C SINCE BLOCK REPOSITIONING MAY BE NECESSARY, THE CONVENTION THAT C ONLY ONE VARIABLE CONTAIN A BLOCK ORIGIN SHOULD BE OBSERVED. C FOR *GETMEM*, *IPNTR* IS SET SUCH THAT *NODPLC(IPNTR+1)* IS THE C FIRST WORD OF THE ALLOCATED BLOCK. C FOR *CLRMEM*, *IPNTR* IS SET TO 400000B TO ENABLE RAPID DETECTION C OF AN ATTEMPT TO USE A CLEARED BLOCK. C IF ANY FATAL ERRORS ARE FOUND, A MESSAGE IS PRINTED AND A FLAG C SET INHIBITING FURTHER ACTION UNTIL *SETMEM* IS CALLED. (IN THIS C CONTEXT, INSUFFICIENT MEMORY IS CONSIDERED A FATAL ERROR.) C THROUGHOUT THIS ROUTINE, *LDVAL* ALWAYS CONTAINS THE SUBSCRIPT OF C THE LAST ADDRESSABLE WORD OF MEMORY, *MEMAVL* ALWAYS CONTAINS THE C NUMBER OF AVAILABLE WORDS OF MEMORY, *NUMBLK* ALWAYS CONTAINS THE C NUMBER OF ALLOCATED BLOCKS, AND NODPLC(*LOCTAB* +1) ALWAYS CONTAINS C THE FIRST WORD OF THE BLOCK TABLE. C COMMON /MEMRY/ LORG,ICORE,MAXCOR,MAXUSE,MEMAVL,LDVAL,NUMBLK, 1 LOCTAB,LTAB COMMON /MISCEL/ APROG(3),ATIME,ADATE,ATITLE(15),RSTATS(50), 1 IWIDTH,LWIDTH,NOPAGE COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /CJE/ JOBNAM,USRID1,USRID2,MAXTAP,ITAPE,MAXECS,IECS,MAXMEM, 1 IMEM,MAXLIN,ILINES,MAXPCH,IPUNCH,MAXTIM,ITIME,MAXPPU,IPPU, 2 IEFTIM,ISPTIM,MAXDLR,ICOST,XCJEX(11) COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) LOGICAL MEMPTR DATA ENDMEM / 8HENDOFMEM / DATA C1 / 2HC1 / DATA E1, E2 / 2HE1, 2HE2 / DATA G1, G2 / 2HG1, 2HG2 / DATA P1 / 2HP1 / DATA R1, R2, R3 / 2HR1, 2HR2, 2HR3 / DATA S1 / 2HS1 / DATA CLRNAM / 6HCLRMEM / DATA EXTNAM / 6HEXTMEM / DATA GETNAM / 6HGETMEM / DATA PTRNAM / 6HPTRMEM / DATA RELNAM / 6HRELMEM / DATA SETNAM / 6HSETMEM / DATA SIZNAM / 6HSIZMEM / C C... APPROXIMATE TIME REQUIRED TO COPY *NWORDS* INTEGER VALUES CTIME4(NUMWRD)=3.4E-6*FLOAT(NUMWRD)+1.0E-5 C... RETURNS NEXT HIGHER EVEN INTEGER NXTEVN(N)=AND(N+1,COMPL(1)) C... RETURNS NEXT HIGHER MEMORY SIZE NXTMEM(MEMWDS)=((MEMWDS+1777B)/2000B)*2000B C C C*** SETMEM - SET INITIAL MEMORY C IFAMWA=IPNTR CALL GETCJE LORG=1-LOCF(NODPLC(1)) IFWA=NXTEVN(IFAMWA+LORG-1) ICORE=NXTMEM(-LORG+1+IFWA+NXTMEM(1)) LDVAL=ICORE+LORG-1 LDVAL=(LDVAL/2)*2-4 MEMAVL=LDVAL-4-IFWA MAXCOR=0 MAXUSE=0 CALL MEMORY(2HCM,2,ICORE) ERRNAM=SETNAM IF (NOGO.LT.0) GO TO 300 NUMBLK=1 LOCTAB=LDVAL-4 NODPLC(LOCTAB+1)=IFWA NODPLC(LOCTAB+2)=MEMAVL NODPLC(LOCTAB+3)=0 NODPLC(LOCTAB+4)=0 VALUE(LDVAL+1)=ENDMEM GO TO 200 C C*** GETMEM - GET BLOCK C ENTRY GETMEM C IF (NOGO.LT.0) GO TO 1000 C... CHECK FOR VALID SIZE IF (ISIZE.LT.0) GO TO 410 C... CHECK FOR ATTEMPT TO REALLOCATE EXISTING BLOCK IF (MEMPTR(IPNTR)) GO TO 420 JSIZE=NXTEVN(ISIZE) CALL COMPRS(0,LDVAL) C... CHECK IF ENOUGH SPACE ALREADY THERE NEED=JSIZE+4-MEMAVL IF (NEED.LE.0) GO TO 10 C... INSUFFICIENT SPACE -- BUMP MEMORY SIZE NEED=NXTMEM(NEED) ICORE=ICORE+NEED CALL MEMORY(2HCM,2,ICORE) ERRNAM=GETNAM IF (NOGO.LT.0) GO TO 300 LTAB1=LDVAL-4 NODPLC(LTAB1+2)=NODPLC(LTAB1+2)+NEED C... RELOCATE BLOCK ENTRY TABLE NWORDS=NUMBLK*4 RSTATS(33)=RSTATS(33)+CTIME4(NWORDS) CALL COPY4(NODPLC(LOCTAB+1),NODPLC(LOCTAB+NEED+1),NWORDS) LOCTAB=LOCTAB+NEED LDVAL=LDVAL+NEED MEMAVL=MEMAVL+NEED C... A BLOCK LARGE ENOUGH NOW EXISTS -- ALLOCATE IT 10 LTAB1=LDVAL-4 MORG=NODPLC(LTAB1+1) MSIZ=NODPLC(LTAB1+2) MUSE=NODPLC(LTAB1+3) MUSE=NXTEVN(MUSE) MADR=NODPLC(LTAB1+4) IF (MADR.NE.0) GO TO 15 IF (MUSE.EQ.0) GO TO 20 C... CONSTRUCT NEW TABLE ENTRY 15 NODPLC(LTAB1+2)=MUSE LOCTAB=LOCTAB-4 NWORDS=NUMBLK*4 RSTATS(33)=RSTATS(33)+CTIME4(NWORDS) CALL COPY4(NODPLC(LOCTAB+4+1),NODPLC(LOCTAB+1),NWORDS) NUMBLK=NUMBLK+1 MEMAVL=MEMAVL-4 NODPLC(LTAB1+1)=MORG+MUSE NODPLC(LTAB1+2)=MSIZ-MUSE-4 C... SET USER SIZE INTO TABLE ENTRY FOR THIS BLOCK 20 NODPLC(LTAB1+3)=ISIZE NODPLC(LTAB1+4)=LOCF(IPNTR) MEMAVL=MEMAVL-JSIZE IPNTR=NODPLC(LTAB1+1) GO TO 50 C C*** RELMEM - RELEASE PART OF BLOCK C ENTRY RELMEM C IF (NOGO.LT.0) GO TO 1000 C... CHECK FOR VALID POINTER IF (.NOT.MEMPTR(IPNTR)) GO TO 510 C... CHECK FOR VALID SIZE IF (ISIZE.LT.0) GO TO 520 JSIZE=NODPLC(LTAB+3) IF (ISIZE.GT.JSIZE) GO TO 530 NODPLC(LTAB+3)=NODPLC(LTAB+3)-ISIZE MEMAVL=MEMAVL+(NXTEVN(JSIZE)-NXTEVN(NODPLC(LTAB+3))) GO TO 50 C C*** EXTMEM - EXTEND SIZE OF EXISTING BLOCK C ENTRY EXTMEM C IF (NOGO.LT.0) GO TO 1000 C... CHECK FOR VALID SIZE IF (ISIZE.LT.0) GO TO 620 C... CHECK FOR VALID POINTER IF (.NOT.MEMPTR(IPNTR)) GO TO 610 C... CHECK IF ENOUGH SPACE ALREADY THERE IF ((NODPLC(LTAB+2)-NODPLC(LTAB+3)).GE.ISIZE) GO TO 40 NEED=NXTEVN(ISIZE)-MEMAVL IF (NEED.LE.0) GO TO 30 C... INSUFFICIENT SPACE -- BUMP MEMORY SIZE NEED=NXTMEM(NEED) ICORE=ICORE+NEED CALL MEMORY(2HCM,2,ICORE) ERRNAM=EXTNAM IF (NOGO.LT.0) GO TO 300 LTAB1=LDVAL-4 NODPLC(LTAB1+2)=NODPLC(LTAB1+2)+NEED C... RELOCATE BLOCK ENTRY TABLE NWORDS=NUMBLK*4 RSTATS(33)=RSTATS(33)+CTIME4(NWORDS) CALL COPY4(NODPLC(LOCTAB+1),NODPLC(LOCTAB+NEED+1),NWORDS) LOCTAB=LOCTAB+NEED LDVAL=LDVAL+NEED MEMAVL=MEMAVL+NEED LTAB=LTAB+NEED C... MOVE BLOCKS TO MAKE SPACE 30 CALL COMPRS(0,LTAB) CALL COMPRS(1,LTAB) 40 JSIZE=NODPLC(LTAB+3) NODPLC(LTAB+3)=NODPLC(LTAB+3)+ISIZE MEMAVL=MEMAVL-(NXTEVN(NODPLC(LTAB+3))-NXTEVN(JSIZE)) GO TO 50 C C*** SIZMEM - DETERMINE SIZE OF EXISTING BLOCK C ENTRY SIZMEM C IF (NOGO.LT.0) GO TO 1000 C... CHECK FOR VALID POINTER IF (.NOT.MEMPTR(IPNTR)) GO TO 710 ISIZE=NODPLC(LTAB+3) GO TO 200 C C*** CLRMEM - RELEASE BLOCK C ENTRY CLRMEM C IF (NOGO.LT.0) GO TO 1000 C... CHECK THAT POINTER IS VALID IF (.NOT.MEMPTR(IPNTR)) GO TO 810 MSIZ=NODPLC(LTAB+2) MUSE=NODPLC(LTAB+3) MEMAVL=MEMAVL+NXTEVN(MUSE) C... ASSUMPTION: FIRST ALLOCATED BLOCK IS NEVER CLEARED. LTAB1=LTAB-4 NODPLC(LTAB1+2)=NODPLC(LTAB1+2)+MSIZ C... REPOSITION THE BLOCK TABLE NWORDS=LTAB-LOCTAB RSTATS(33)=RSTATS(33)+CTIME4(NWORDS) CALL COPY4(NODPLC(LOCTAB+1),NODPLC(LOCTAB+4+1),NWORDS) NUMBLK=NUMBLK-1 LOCTAB=LOCTAB+4 MEMAVL=MEMAVL+4 LTAB1=LDVAL-4 NODPLC(LTAB1+2)=NODPLC(LTAB1+2)+4 IPNTR=400000B GO TO 50 C C*** PTRMEM - RESET MEMORY POINTER C ENTRY PTRMEM C IF (NOGO.LT.0) GO TO 1000 C... VERIFY THAT POINTER IS VALID IF (.NOT.MEMPTR(IPNTR)) GO TO 860 C... RESET BLOCK POINTER TO BE *ISIZE* ISIZE=IPNTR NODPLC(LTAB+4)=LOCF(ISIZE) GO TO 50 C C*** CRUNCH - FORCE MEMORY COMPACTION C ENTRY CRUNCH C IF (NOGO.LT.0) GO TO 1000 CALL COMPRS(0,LDVAL) C C*** ADJUST MEMORY DOWNWARD *** C 50 MAXUSE=MAX0(MAXUSE,LDVAL-MEMAVL-IFWA) MEMDEC=2*NXTMEM(1) IF (MEMAVL.LT.MEMDEC) GO TO 200 C... COMPRESS CURRENT ALLOCATIONS OF MEMORY CALL COMPRS(0,LDVAL) C... ADJUST MEMORY SIZE MEMDEL=0 60 ICORE=ICORE-MEMDEC MEMDEL=MEMDEL+MEMDEC MEMAVL=MEMAVL-MEMDEC IF (MEMAVL.GE.MEMDEC) GO TO 60 LTAB1=LDVAL-4 NODPLC(LTAB1+2)=NODPLC(LTAB1+2)-MEMDEL C... RELOCATE BLOCK ENTRY TABLE NWORDS=NUMBLK*4 RSTATS(33)=RSTATS(33)+CTIME4(NWORDS) CALL COPY4(NODPLC(LOCTAB+1),NODPLC(LOCTAB-MEMDEL+1),NWORDS) LOCTAB=LOCTAB-MEMDEL LDVAL=LDVAL-MEMDEL CALL MEMORY(2HCM,2,ICORE) C C*** NORMAL RETURN *** C 200 RETURN C C*** ERROR(S) FOUND *** C C... MEMORY NEEDS EXCEED MAXIMUM AVAILABLE SPACE 300 WRITE (6,301) MAXMEM,MAXMEM 301 FORMAT("0*ERROR*: MEMORY NEEDS EXCEED",I6,"(",O6,"B)"/) GO TO 950 C... GETMEM: *ISIZE* < 0 410 ERRCOD=G1 ERRNAM=GETNAM GO TO 900 C... GETMEM: ATTEMPT TO REALLOCATE EXISTING BLOCK 420 ERRCOD=G2 ERRNAM=GETNAM GO TO 900 C... RELMEM: *IPNTR* INVALID 510 ERRCOD=R1 ERRNAM=RELNAM GO TO 900 C... RELMEM: *ISIZE* < 0 520 ERRCOD=R2 ERRNAM=RELNAM GO TO 900 C... RELMEM: *ISIZE* LARGER THAN INDICATED BLOCK 530 ERRCOD=R3 ERRNAM=RELNAM GO TO 900 C... EXTMEM: *IPNTR* INVALID 610 ERRCOD=E1 ERRNAM=EXTNAM GO TO 900 C... EXTMEM: *ISIZE* < 0 620 ERRCOD=E2 ERRNAM=EXTNAM GO TO 900 C... SIZMEM: *IPNTR* INVALID 710 ERRCOD=S1 ERRNAM=SIZNAM GO TO 900 C... CLRMEM: *IPNTR* INVALID 810 ERRCOD=C1 ERRNAM=CLRNAM GO TO 900 C... PTRMEM: *IPNTR* INVALID 860 ERRCOD=P1 ERRNAM=PTRNAM C... ISSUE ERROR MESSAGE 900 LARG1=LOCF(IPNTR) LARG2=LOCF(ISIZE) WRITE (6,901) ERRCOD,LARG1,LARG2 901 FORMAT("0*ABORT*: INTERNAL SPICE ERROR -- CODE ",A2,/, 1 "0 ARG INFO = (",O6,", ",O6,")") 950 CALL DMPMEM(ERRNAM) 1000 CALL EXIT END SUBROUTINE COMPRS(ICODE,LIMIT) C C THIS ROUTINE COMPRESSES ALL AVAILABLE MEMORY INTO A SINGLE BLOCK. C IF *ICODE* IS ZERO, COMPRESSION OF MEMORY FROM WORD 1 TO *LIMIT* IS C DONE; OTHERWISE, COMPRESSION FROM *LDVAL* DOWN TO *LIMIT* IS DONE. C COMMON /MEMRY/ LORG,ICORE,MAXCOR,MAXUSE,MEMAVL,LDVAL,NUMBLK, 1 LOCTAB,LTAB COMMON /MISCEL/ APROG(3),ATIME,ADATE,ATITLE(15),RSTATS(50), 1 IWIDTH,LWIDTH,NOPAGE COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C... APPROXIMATE TIME REQUIRED TO COPY *NWORDS* REAL VALUES CTIME8(NUMWRD)=3.4E-6*FLOAT(NUMWRD)+1.0E-5 C... RETURNS NEXT HIGHER EVEN INTEGER NXTEVN(N)=AND(N+1,COMPL(1)) C IF (ICODE.NE.0) GO TO 100 NBLK=NUMBLK LTAB2=LOCTAB 10 LTAB1=LTAB2 IF (LTAB1.GE.LIMIT) GO TO 200 IF (NBLK.EQ.1) GO TO 200 NBLK=NBLK-1 LTAB2=LTAB1+4 MORG=NODPLC(LTAB1+1) MSIZ=NODPLC(LTAB1+2) MUSE=NODPLC(LTAB1+3) MUSE=NXTEVN(MUSE) IF (MSIZ.EQ.MUSE) GO TO 10 C... MOVE SUCCEEDING BLOCK DOWN MORG2=NODPLC(LTAB2+1) MUSE2=NODPLC(LTAB2+3) MADR2=NODPLC(LTAB2+4) IF (MADR2.NE.0) GO TO 15 IF (MUSE2.EQ.0) GO TO 20 15 RSTATS(33)=RSTATS(33)+CTIME8(MUSE2) CALL COPY8(VALUE(MORG2+1),VALUE(MORG+MUSE+1),MUSE2) NODPLC(LORG+MADR2)=MORG+MUSE 20 NODPLC(LTAB1+2)=MUSE NODPLC(LTAB2+1)=MORG+MUSE NODPLC(LTAB2+2)=NODPLC(LTAB2+2)+(MSIZ-MUSE) GO TO 10 C C 100 NBLK=NUMBLK LTAB2=LDVAL-4 110 LTAB1=LTAB2 IF (LTAB1.LE.LIMIT) GO TO 200 IF (NBLK.EQ.1) GO TO 200 NBLK=NBLK-1 LTAB2=LTAB1-4 MORG=NODPLC(LTAB1+1) MSIZ=NODPLC(LTAB1+2) MUSE=NODPLC(LTAB1+3) MUSE=NXTEVN(MUSE) MADR=NODPLC(LTAB1+4) MSPC=MSIZ-MUSE IF (MSPC.EQ.0) GO TO 110 RSTATS(33)=RSTATS(33)+CTIME8(MUSE) CALL COPY8(VALUE(MORG+1),VALUE(MORG+MSPC+1),MUSE) NODPLC(LTAB1+1)=MORG+MSPC NODPLC(LTAB1+2)=MUSE NODPLC(LTAB2+2)=NODPLC(LTAB2+2)+MSPC IF (MADR.EQ.0) GO TO 110 NODPLC(LORG+MADR)=MORG+MSPC GO TO 110 C... ALL DONE 200 RETURN END LOGICAL FUNCTION MEMPTR(IPNTR) C C THIS ROUTINE CHECKS WHETHER *IPNTR* IS A VALID BLOCK POINTER. C IF IT IS VALID, *LTAB* IS SET TO POINT TO THE CORRESPONDING ENTRY IN C THE BLOCK TABLE. C COMMON /MEMRY/ LORG,ICORE,MAXCOR,MAXUSE,MEMAVL,LDVAL,NUMBLK, 1 LOCTAB,LTAB COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C MEMPTR=.FALSE. LTAB=LOCTAB LOCPNT=LOCF(IPNTR) DO 20 I=1,NUMBLK IF (IPNTR.NE.NODPLC(LTAB+1)) GO TO 10 IF (LOCPNT.NE.NODPLC(LTAB+4)) GO TO 10 MEMPTR=.TRUE. GO TO 30 10 LTAB=LTAB+4 20 CONTINUE 30 RETURN END SUBROUTINE DMPMEM(ANAM) C C THIS ROUTINE PRINTS OUT THE CURRENT MEMORY ALLOCATION MAP. C *ANAM* SHOULD BE THE (BCD) NAME OF THE ROUTINE CALLING DMPMEM. C COMMON /MEMRY/ LORG,ICORE,MAXCOR,MAXUSE,MEMAVL,LDVAL,NUMBLK, 1 LOCTAB,LTAB COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C WRITE (6,5) ANAM,ICORE,MEMAVL,LDVAL 5 FORMAT(*0DMPMEM CALLED BY *A7,*; CORSIZ=*,O6,*B; AVLSPC=*,I6,*; LD 1VAL=*I6/1H0,24X,*MEMORY ALLOCATION MAP*/14X,*BLKNUM MEMORG MEMSIZ 2MEMUSE USRPTR ADDR($)*) LTAB1=LOCTAB DO 20 I=1,NUMBLK MORG=NODPLC(LTAB1+1) MSIZ=NODPLC(LTAB1+2) MUSE=NODPLC(LTAB1+3) MADR=NODPLC(LTAB1+4) JPTR=0 IF (MADR.NE.0) JPTR=NODPLC(LORG+MADR) WRITE (6,11) I,MORG,MSIZ,MUSE,JPTR,MADR 11 FORMAT(13X,5I7,1X,O6,*B*) LTAB1=LTAB1+4 20 CONTINUE WRITE (6,21) 21 FORMAT(1H0,24X,*END OF ALLOCATION MAP*/) C C... IF WE*RE LUCKY, SOME SYSTEMS WILL GIVE FULL TRACEBACK GARBAG=SQRT(-1.0) RETURN END SUBROUTINE DMPMAT(ANAM) C C THIS ROUTINE DUMPS OUT THE MATRIX. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET, 1 MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO, 2 ITEMNO,NOSOLV,MODAC COMMON /DC/ TCSTAR,TCSTOP,TCINCR,ICVFLG,ITCELM,KSSOP,KINEL,KIDIN, 1 KOVAR,KIDOUT COMMON /AC/ FSTART,FSTOP,FINCR,SKW2,REFPRL,SPW2,JACFLG,IDFREQ, 1 INOISE,NOSPRT,NOSOUT,NOSIN,IDIST,IDPRT,JPZFLG,JPZTYP, 2 IPZIN,IPZITP,IPZOUT,IPZEQO,IPZLOC(2),IPZEQI,IPOMAT(3), 3 IPIMAT(4) COMMON /TRAN/ TSTEP,TSTOP,TSTART,DELMAX,TDMAX,FORFRE,JTRFLG COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C WRITE (6,11) ANAM 11 FORMAT("0*DEBUG*: DMPMAT CALLED BY ",A8) C C JSTOP=NSTOP+1 IF (MODE.EQ.3) GO TO 100 CALL GETMEM(LINE,NSTOP+1) DO 30 I=2,NSTOP DO 20 J=2,JSTOP CALL MATVAL(I,J) VALUE(LINE+J)=VALUE(1) 20 CONTINUE WRITE (6,26) (VALUE(LINE+J),J=2,JSTOP) 26 FORMAT(" *DEBUG*: ",1P12E10.3) 30 CONTINUE GO TO 1000 C C 100 CALL GETMEM(LINE,2*(NSTOP+1)) LSPOT=(LINE+1)/2 DO 130 I=2,NSTOP DO 120 J=2,JSTOP CALL MATVAL(I,J) CVALUE(LSPOT+J)=CVALUE(1) 120 CONTINUE WRITE (6,126) (CVALUE(LSPOT+J),J=2,JSTOP) 126 FORMAT(" *DEBUG*: ", 1P12E10.3) 130 CONTINUE C C 1000 CALL CLRMEM(LINE) RETURN END SUBROUTINE MATVAL(I,J) C C THIS ROUTINE SETS VALUE(1) OR CVALUE(1) TO THE VALUE OF THE C (I,J)TH MATRIX VALUE, OR TO THE ITH RHS VALUE IF J=NSTOP+1. C C IMPLICIT REAL(A-H,O-Z) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET, 1 MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO, 2 ITEMNO,NOSOLV,MODAC COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C DATA UNINIT / 6000 2525 2525 2525 2525 B / C DATA UNINIT / 6000 2525 2525 2525 2525 B / DATA UNINIT / 0.0D0 / C C IF (J.EQ.NSTOP+1) GO TO 400 IF (I.EQ.J) GO TO 300 IF (I.GT.J) GO TO 200 C C... UPPER TRIANGLE ISTART=NODPLC(IUR+I) ISTOP=NODPLC(IUR+I+1)-1 IF (ISTART.GT.ISTOP) GO TO 600 DO 100 ISPOT=ISTART,ISTOP IF (NODPLC(IUC+ISPOT).EQ.J) GO TO 110 100 CONTINUE GO TO 600 110 ISPOT=LYU+ISPOT GO TO 500 C C... LOWER TRIANGLE 200 JSTART=NODPLC(ILC+J) JSTOP=NODPLC(ILC+J+1)-1 IF (JSTART.GT.JSTOP) GO TO 600 DO 210 ISPOT=JSTART,JSTOP IF (NODPLC(ILR+ISPOT).EQ.I) GO TO 220 210 CONTINUE GO TO 600 220 ISPOT=LYL+ISPOT GO TO 500 C C... DIAGONAL 300 IO=NODPLC(IORDER+I) ISPOT=LYNL+IO GO TO 500 C C... RHS 400 ISPOT=LVN+I C C... SET NONZERO TERM 500 IF (MODE.EQ.3) GO TO 510 VALUE(1)=VALUE(ISPOT) GO TO 1000 510 CVALUE(1)=CVALUE(ISPOT) GO TO 1000 C C... SET (IDENTICALLY) ZERO TERM 600 IF (MODE.EQ.3) GO TO 610 VALUE(1)=UNINIT GO TO 1000 610 CVALUE(1)=CMPLX(UNINIT,UNINIT) GO TO 1000 C C... FINISHED 1000 RETURN END SUBROUTINE TMPUPD C C THIS ROUTINE UPDATES THE TEMPERATURE-DEPENDENT PARAMETERS IN THE C DEVICE MODELS. IT ALSO UPDATES THE VALUES OF TEMPERATURE-DEPENDENT C RESISTORS. THE UPDATED VALUES ARE PRINTED. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /MISCEL/ APROG(3),ATIME,ADATE,ATITLE(15),RSTATS(50), 1 IWIDTH,LWIDTH,NOPAGE COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET, 1 MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO, 2 ITEMNO,NOSOLV,MODAC COMMON /KNSTNT/ TWOPI,XLOG2,XLOG10,ROOT2,RAD,BOLTZ,CHARGE,CTOK, 1 GMIN,RELTOL,ABSTOL,VNTOL,TRTOL,CHGTOL,EPS0,EPSSIL,EPSOX COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C DIMENSION TMPTIT(4) DATA TMPTIT / 8HTEMPERAT, 8HURE-ADJU, 8HSTED VAL, 8HUES / C C TEMPD=VALUE(ITEMPS+ITEMNO)+CTOK XKT=BOLTZ*TEMPD OLDVT=VT VT=XKT/CHARGE DTEMP=VALUE(ITEMPS+ITEMNO)-VALUE(ITEMPS+ITEMNO-1) RATIO=TEMPD/(VALUE(ITEMPS+ITEMNO-1)+CTOK) RATLOG=ALOG(RATIO) RATIO1=RATIO-1.0 DELT=VALUE(ITEMPS+ITEMNO)-VALUE(ITEMPS+1) DELTSQ=DELT*DELT REFTMP=27.0+CTOK OLDEG=EGFET EGFET=1.16-(7.02E-4*TEMPD*TEMPD)/(TEMPD+1108.0) OLDXNI=XNI ARG=-EGFET/(XKT+XKT)+1.12/(BOLTZ*(REFTMP+REFTMP)) FACTOR=TEMPD/REFTMP FACTOR=FACTOR*SQRT(FACTOR) XNI=1.45E10*FACTOR*EXP(CHARGE*ARG) PBFACT=(VT+VT)*ALOG(OLDXNI/XNI) CALL TITLE(0,LWIDTH,1,TMPTIT) C C RESISTORS C LOC=LOCATE(1) ITITLE=0 10 IF (LOC.EQ.0) GO TO 100 LOCV=NODPLC(LOC+1) TC1=VALUE(LOCV+3) TC2=VALUE(LOCV+4) IF (TC1.NE.0.0) GO TO 20 IF (TC2.EQ.0.0) GO TO 40 20 IF (ITITLE.NE.0) GO TO 30 WRITE (6,21) 21 FORMAT(//"0**** RESISTORS",/,"0NAME",8X,"VALUE",//) ITITLE=1 30 RNEW=VALUE(LOCV+2)*(1.0+TC1*DELT+TC2*DELTSQ) VALUE(LOCV+1)=1.0/RNEW WRITE (6,31) VALUE(LOCV),RNEW 31 FORMAT(1X,A8,1P6E11.2) 40 LOC=NODPLC(LOC) GO TO 10 C C DIODE MODEL C 100 LOC=LOCATE(21) IF (LOC.EQ.0) GO TO 200 WRITE (6,101) 101 FORMAT(//"0**** DIODE MODEL PARAMETERS",/,"0NAME",9X,"IS",9X,"PB", 1 8X,"CJO",//) 110 IF (LOC.EQ.0) GO TO 200 LOCV=NODPLC(LOC+1) C... IS(T2)=IS(T1)*EXP(EG/(N*VT)*(T2/T1-1))*(T2/T1)'(PT/N) XN=VALUE(LOCV+3) FACTOR=RATIO1*VALUE(LOCV+8)/(XN*VT)+VALUE(LOCV+9)/XN*RATLOG FACTOR=EXP(FACTOR) VALUE(LOCV+1)=VALUE(LOCV+1)*FACTOR OLDPB=VALUE(LOCV+6) VALUE(LOCV+6)=RATIO*OLDPB+PBFACT PBDIFF=VALUE(LOCV+6)-OLDPB VALUE(LOCV+5)=VALUE(LOCV+5) 1 *(1.0+VALUE(LOCV+7)*(400.0E-6*DTEMP-PBDIFF)) PBRAT=VALUE(LOCV+6)/OLDPB VALUE(LOCV+12)=VALUE(LOCV+12)*PBRAT VALUE(LOCV+15)=VALUE(LOCV+15)*PBRAT VTE=VALUE(LOCV+3)*VT VALUE(LOCV+18)=VTE*ALOG(VTE/(ROOT2*VALUE(LOCV+1))) WRITE (6,31) VALUE(LOCV),VALUE(LOCV+1),VALUE(LOCV+6),VALUE(LOCV+5) LOC=NODPLC(LOC) GO TO 110 C C BIPOLAR TRANSISTOR MODEL C 200 LOC=LOCATE(22) IF (LOC.EQ.0) GO TO 300 WRITE (6,201) 201 FORMAT(//"0**** BJT MODEL PARAMETERS",/,"0NAME",9X,"IS",8X, 1 "CJE",9X,"PE",8X,"CJC",9X,"PC",//) 210 IF (LOC.EQ.0) GO TO 300 LOCV=NODPLC(LOC+1) C... IS(T2)=IS(T1)*EXP(EG/VT*(T2/T1-1))*(T2/T1)'PT FACTOR=RATIO1*VALUE(LOCV+24)/VT+VALUE(LOCV+25)*RATLOG FACTOR=EXP(FACTOR) CSATO=VALUE(LOCV+3) VALUE(LOCV+3)=VALUE(LOCV+3)*FACTOR CSATN=VALUE(LOCV+3) CFACTR=ALOG(CSATO/CSATN) C2=VALUE(LOCV+10) ONE=1.0/VALUE(LOCV+11) VALUE(LOCV+10)=C2*EXP((1.0-ONE)*CFACTR) C4=VALUE(LOCV+13) ONC=1.0/VALUE(LOCV+14) VALUE(LOCV+13)=C4*EXP((1.0-ONC)*CFACTR) OLDPB=VALUE(LOCV+19) VALUE(LOCV+19)=RATIO*OLDPB+PBFACT PBDIFF=VALUE(LOCV+19)-OLDPB VALUE(LOCV+18)=VALUE(LOCV+18) 1 *(1.0+VALUE(LOCV+20)*(400.0E-6*DTEMP-PBDIFF)) PBRAT=VALUE(LOCV+19)/OLDPB VALUE(LOCV+28)=VALUE(LOCV+28)*PBRAT VALUE(LOCV+30)=VALUE(LOCV+30)*PBRAT OLDPB=VALUE(LOCV+22) VALUE(LOCV+22)=RATIO*OLDPB+PBFACT PBDIFF=VALUE(LOCV+22)-OLDPB VALUE(LOCV+21)=VALUE(LOCV+21) 1 *(1.0+VALUE(LOCV+23)*(400.0E-6*DTEMP-PBDIFF)) PBRAT=VALUE(LOCV+22)/OLDPB VALUE(LOCV+33)=VALUE(LOCV+33)*PBRAT VALUE(LOCV+34)=VALUE(LOCV+34)*PBRAT VALUE(LOCV+37)=VT*ALOG(VT/(ROOT2*VALUE(LOCV+3))) WRITE (6,31) VALUE(LOCV),VALUE(LOCV+3),VALUE(LOCV+18), 1 VALUE(LOCV+19),VALUE(LOCV+21),VALUE(LOCV+22) LOC=NODPLC(LOC) GO TO 210 C C JFET MODEL C 300 LOC=LOCATE(23) IF (LOC.EQ.0) GO TO 400 WRITE (6,301) 301 FORMAT(//"0**** JFET MODEL PARAMETERS",/,"0NAME",9X,"IS",9X,"PB", 1 8X,"CGS",8X,"CGD",//) 310 IF (LOC.EQ.0) GO TO 400 LOCV=NODPLC(LOC+1) VALUE(LOCV+9)=VALUE(LOCV+9)*EXP(RATIO1*1.11/VT) OLDPB=VALUE(LOCV+8) VALUE(LOCV+8)=RATIO*OLDPB+PBFACT PBDIFF=VALUE(LOCV+8)-OLDPB CJFACT=1.0+0.5*(400.0E-6*DTEMP-PBDIFF) VALUE(LOCV+6)=VALUE(LOCV+6)*CJFACT VALUE(LOCV+7)=VALUE(LOCV+7)*CJFACT PBRAT=VALUE(LOCV+8)/OLDPB VALUE(LOCV+12)=VALUE(LOCV+12)*PBRAT VALUE(LOCV+13)=VALUE(LOCV+13)*PBRAT VALUE(LOCV+16)=VT*ALOG(VT/(ROOT2*VALUE(LOCV+9))) WRITE (6,31) VALUE(LOCV),VALUE(LOCV+9),VALUE(LOCV+8), 1 VALUE(LOCV+6),VALUE(LOCV+7) LOC=NODPLC(LOC) GO TO 310 C C MOSFET MODEL C 400 LOC=LOCATE(24) IF (LOC.EQ.0) GO TO 1000 WRITE (6,401) 401 FORMAT(//"0**** MOSFET MODEL PARAMETERS",/,"0NAME",8X,"VTO",8X, 1 "PHI",9X,"PB",9X,"JS",7X,"BETA",//) 410 IF (LOC.EQ.0) GO TO 1000 LOCV=NODPLC(LOC+1) RATIO4=RATIO*SQRT(RATIO) VALUE(LOCV+2)=VALUE(LOCV+2)/RATIO4 VALUE(LOCV+23)=VALUE(LOCV+23)/RATIO4 OLDPHI=VALUE(LOCV+4) VALUE(LOCV+4)=RATIO*OLDPHI+PBFACT PHI=VALUE(LOCV+4) C C PROCESS EL-MANSY"S MOSFET MODEL PARAMETERS C IF (VALUE(LOCV+36).EQ.0.0) GO TO 420 VALUE(LOCV+37)=SQRT(VT)/VALUE(LOCV+3) ALPHA=VALUE(LOCV+37) VALUE(LOCV+38)=VT/ALPHA AHPLA=1.0/ALPHA VALUE(LOCV+39)=(ALPHA+ALPHA)+AHPLA TAHPLA=AHPLA+AHPLA VALUE(LOCV+40)=TAHPLA VALUE(LOCV+41)=TAHPLA*TAHPLA VALUE(LOCV+42)=VALUE(LOCV+4)/(2.0*VT) VLIM=1.0E7 IF (NODPLC(LOC+2).LT.0) VLIM=6.0E6 VALUE(LOCV+43)=VALUE(LOCV+23)/VLIM GO TO 430 C 420 VFB=VALUE(LOCV+34)-OLDPHI VALUE(LOCV+34)=VFB+PHI 430 CONTINUE VALUE(LOCV+1)=VALUE(LOCV+34)+VALUE(LOCV+3)*SQRT(PHI) VALUE(LOCV+15)=VALUE(LOCV+15)*EXP(-EGFET/VT+OLDEG/OLDVT) OLDPB=VALUE(LOCV+14) VALUE(LOCV+14)=RATIO*OLDPB+PBFACT PB=VALUE(LOCV+14) RATIO2=OLDPB/PB RATIO3=SQRT(RATIO2) VALUE(LOCV+11)=VALUE(LOCV+11)*RATIO3 VALUE(LOCV+12)=VALUE(LOCV+12)*RATIO3 PBRAT=PB/OLDPB VALUE(LOCV+29)=VALUE(LOCV+29)*PBRAT VALUE(LOCV+30)=VALUE(LOCV+30)*PBRAT WRITE (6,31) VALUE(LOCV),VALUE(LOCV+1),VALUE(LOCV+4), 1 VALUE(LOCV+14),VALUE(LOCV+15),VALUE(LOCV+2) LOC=NODPLC(LOC) GO TO 410 C C FINISHED C 1000 RETURN END SUBROUTINE MAGPHS(CVAR,XMAG,XPHS) C C THIS ROUTINE COMPUTES THE MAGNITUDE AND PHASE OF ITS COMPLEX ARG- C UMENT CVAR, STORING THE RESULTS IN XMAG AND XPHS. C COMMON /KNSTNT/ TWOPI,XLOG2,XLOG10,ROOT2,RAD,BOLTZ,CHARGE,CTOK, 1 GMIN,RELTOL,ABSTOL,VNTOL,TRTOL,CHGTOL,EPS0,EPSSIL,EPSOX COMPLEX CVAR C C XREAL=REAL(CVAR) XIMAG=AIMAG(CVAR) XMAG=SQRT(XREAL*XREAL+XIMAG*XIMAG) IF (XMAG.GE.1.0E-20) GO TO 10 XMAG=1.0E-20 XPHS=0.0 RETURN 10 XPHS=RAD*ATAN2(XIMAG,XREAL) RETURN END INTEGER FUNCTION XOR(A,B) C C THIS ROUTINE COMPUTES A SINGLE-PRECISION INTEGER RESULT WHICH IS C THE RESULT OF EXCLUSIVE-OR*ING THE TWO REAL-VALUED ARGUMENTS A AND B C TOGETHER. C XOR=OR(AND(A,COMPL(B)),AND(B,COMPL(A))) RETURN END SUBROUTINE OUTNAM(LOC,KTYPE,STRING,IPOS) C C THIS ROUTINE CONSTRUCTS THE "NAME" FOR THE OUTPUT VARIABLE INDI- C CATED BY LOC, ADDING THE CHARACTERS TO THE CHARACTER ARRAY "STRING", C BEGINNING WITH THE POSITION MARKED BY IPOS. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C DIMENSION STRING(1) DIMENSION AOUT(19),LENOUT(19),AOPT(5),LENOPT(5) DATA AOUT / 6HV , 6HVM , 6HVR , 6HVI , 6HVP , 1 6HVDB , 6HI , 6HIM , 6HIR , 6HII , 2 6HIP , 6HIDB , 6HONOISE, 6HINOISE, 6HHD2 , 1 6HHD3 , 6HDIM2 , 6HSIM2 , 6HDIM3 / DATA LENOUT / 1,2,2,2,2,3,1,2,2,2,2,3,6,6,3,3,4,4,4 / DATA AOPT / 5HMAG , 5HREAL , 5HIMAG , 5HPHASE, 5HDB / DATA LENOPT / 3,4,4,5,2 / DATA ALPRN, ACOMMA, ARPRN, ABLNK / 1H(, 1H,, 1H), 1H / C C IOUTYP=NODPLC(LOC+5) IF (IOUTYP.GE.2) GO TO 10 LOUT=KTYPE+IOUTYP*6 GO TO 20 10 LOUT=IOUTYP+11 20 CALL MOVE(STRING,IPOS,AOUT(LOUT),1,LENOUT(LOUT)) IPOS=IPOS+LENOUT(LOUT) IF (IOUTYP.GE.2) GO TO 200 CALL MOVE(STRING,IPOS,ALPRN,1,1) IPOS=IPOS+1 IF (IOUTYP.NE.0) GO TO 100 NODE1=NODPLC(LOC+2) CALL ALFNUM(NODPLC(JUNODE+NODE1),STRING,IPOS) NODE2=NODPLC(LOC+3) IF (NODE2.EQ.1) GO TO 30 CALL MOVE(STRING,IPOS,ACOMMA,1,1) IPOS=IPOS+1 CALL ALFNUM(NODPLC(JUNODE+NODE2),STRING,IPOS) 30 CALL MOVE(STRING,IPOS,ARPRN,1,1) IPOS=IPOS+1 GO TO 1000 C 100 LOCV=NODPLC(LOC+1) ANAM=VALUE(LOCV) ACHAR=ABLNK DO 110 I=1,8 CALL MOVE(ACHAR,1,ANAM,I,1) IF (ACHAR.EQ.ABLNK) GO TO 120 CALL MOVE(STRING,IPOS,ACHAR,1,1) IPOS=IPOS+1 110 CONTINUE 120 CALL MOVE(STRING,IPOS,ARPRN,1,1) IPOS=IPOS+1 GO TO 1000 C 200 IF (KTYPE.EQ.1) GO TO 1000 CALL MOVE(STRING,IPOS,ALPRN,1,1) IPOS=IPOS+1 CALL MOVE(STRING,IPOS,AOPT(KTYPE-1),1,LENOPT(KTYPE-1)) IPOS=IPOS+LENOPT(KTYPE-1) CALL MOVE(STRING,IPOS,ARPRN,1,1) IPOS=IPOS+1 C C FINISHED C 1000 RETURN END SUBROUTINE ALFNUM(NUMBER,STRING,IPOS) C C THIS ROUTINE CONVERTS NUMBER INTO CHARACTER FORM, STORING THE C CHARACTERS IN THE CHARACTER ARRAY STRING, BEGINNING WITH THE POSITION C INDICATED BY IPOS. C C DIMENSION STRING(1) DIMENSION ADIGIT(10) DATA ADIGIT / 1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9 / DATA AMINUS / 1H- / C C NUM=NUMBER C C CHECK FOR NUMBER < 0 C IF (NUM.GE.0) GO TO 10 NUM=-NUM C... NEGATIVE NUMBER: INSERT MINUS SIGN CALL MOVE(STRING,IPOS,AMINUS,1,1) IPOS=IPOS+1 C C CONVERT NUMBER ONE DIGIT AT A TIME, IN REVERSE ORDER C 10 ISTART=IPOS 20 NUMTMP=NUM/10 IDIGIT=NUM-NUMTMP*10 CALL MOVE(STRING,IPOS,ADIGIT(IDIGIT+1),1,1) IPOS=IPOS+1 NUM=NUMTMP IF (NUM.NE.0) GO TO 20 ISTOP=IPOS-1 C C NOW REVERSE THE ORDER OF THE DIGITS C 30 IF (ISTOP.LE.ISTART) GO TO 40 CALL MOVE(TMPDGT,1,STRING,ISTART,1) CALL MOVE(STRING,ISTART,STRING,ISTOP,1) CALL MOVE(STRING,ISTOP,TMPDGT,1,1) ISTART=ISTART+1 ISTOP=ISTOP-1 GO TO 30 C C CONVERSION COMPLETE C 40 RETURN END SUBROUTINE FIND(ANAME,ID,LOC,IFORCE) C C THIS ROUTINE SEARCHES THE LIST WITH NUMBER "ID" FOR AN ELEMENT C WITH NAME "ANAME". LOC IS SET TO POINT TO THE ELEMENT. IF IFORCE IS C NONZERO, THEN FIND EXPECTS TO HAVE TO ADD THE ELEMENT TO THE LIST, AND C REPORTS A FATAL ERROR IF THE ELEMENT IS FOUND. IF SUBCIRCUIT DEFINI- C TION IS IN PROGRESS (NONZERO VALUE FOR NSBCKT), THEN FIND SEARCHES THE C CURRENT SUBCIRCUIT DEFINITION LIST RATHER THAN THE NOMINAL ELEMENT C LIST. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C INDEX TO THE CONTENTS OF THE VARIOUS LISTS: C C LIST CONTENTS C ---- -------- C C 1 RESISTORS C 2 CAPACITORS C 3 INDUCTORS C 4 MUTUAL INDUCTORS C 5 NONLINEAR VOLTAGE CONTROLLED CURRENT SOURCES C 6 NONLINEAR VOLTAGE CONTROLLED VOLTAGE SOURCES C 7 NONLINEAR CURRENT CONTROLLED CURRENT SOURCES C 8 NONLINEAR CURRENT CONTROLLED VOLTAGE SOURCES C 9 INDEPENDENT VOLTAGE SOURCES C 10 INDEPENDENT CURRENT SOURCES C 11 DIODES C 12 BIPOLAR JUNCTION TRANSISTORS C 13 JUNCTION FIELD-EFFECT TRANSISTORS (JFETS) C 14 METAL-OXIDE-SEMICONDUCTOR JUNCTION FETS (MOSFETS) C 15 S-PARAMETER 2-PORT NETWORK C 16 Y-PARAMETER 2-PORT NETWORK C 17 TRANSMISSION LINES C 18 C 19 SUBCIRCUIT CALLS C 20 SUBCIRCUIT DEFINITIONS C 21 DIODE MODEL C 22 BJT MODEL C 23 JFET MODEL C 24 MOSFET MODEL C 25-30 C 31 .PRINT DC C 32 .PRINT TRAN C 33 .PRINT AC C 34 .PRINT NOISE C 35 .PRINT DISTORTION C 36 .PLOT DC C 37 .PLOT TR C 38 .PLOT AC C 39 .PLOT NOISE C 40 .PLOT DISTORTION C 41 OUTPUTS FOR DC C 42 OUTPUTS FOR TRANSIENT C 43 OUTPUTS FOR AC C 44 OUTPUTS FOR NOISE C 45 OUTPUTS FOR DISTORTION C 46-50 C INTEGER XOR DIMENSION LNOD(50),LVAL(50) DATA LNOD / 9,10,12, 7,14,15,14,15,12, 7, 1 17,31,26,34, 7, 7,34, 0, 5, 5, 2 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 3 21,21,21,21,21,21,21,21,21,21, 4 8, 8, 8, 8, 8, 0, 0, 0, 0, 0 / DATA LVAL / 5, 3, 3, 2, 1, 1, 1, 1, 4, 4, 1 3, 4, 4,11, 1, 1, 9, 0, 1, 1, 2 19,38,17,44, 0, 0, 0, 0, 0, 0, 3 1, 1, 1, 1, 1,17,17,17,17,17, 4 1, 1, 1, 1, 1, 0, 0, 0, 0, 0 / DATA NDEFIN /2H.U/ C C ANAM=ANAME CALL SIZMEM(IELMNT,ISIZE) LOCN=IELMNT+ISIZE+2 IF (NSBCKT.EQ.0) GO TO 10 LOCT=NODPLC(ISBCKT+NSBCKT) LOC=NODPLC(LOCT+3) IF (LOC.NE.0) GO TO 20 NODPLC(LOCT+3)=LOCN GO TO 60 10 LOC=LOCATE(ID) IF (LOC.NE.0) GO TO 20 LOCATE(ID)=LOCN GO TO 50 C C SEARCH LIST FOR A NAME MATCH C 20 LOCV=NODPLC(LOC+1) IF (XOR(ANAM,VALUE(LOCV)).NE.0) GO TO 30 IF (NSBCKT.EQ.0) GO TO 25 IF (NODPLC(LOC-1).NE.ID) GO TO 30 25 IF (NODPLC(LOC+2).EQ.NDEFIN) GO TO 200 IF (IFORCE.EQ.0) GO TO 200 WRITE (6,26) ANAM 26 FORMAT("0*ERROR*: ABOVE LINE ATTEMPTS TO REDEFINE ",A8/) NOGO=1 30 IF (NODPLC(LOC).EQ.0) GO TO 40 LOC=NODPLC(LOC) GO TO 20 C C RESERVE SPACE FOR THIS ELEMENT C 40 NODPLC(LOC)=LOCN IF (NSBCKT.NE.0) GO TO 60 50 JELCNT(ID)=JELCNT(ID)+1 60 LOC=LOCN LOCV=LOC+LNOD(ID)-1 KTMP=LNOD(ID)+LVAL(ID) CALL EXTMEM(IELMNT,KTMP) IPTR=0 IF (NSBCKT.EQ.0) GO TO 80 IPTR=ID 80 NODPLC(LOC-1)=IPTR NODPLC(LOC)=0 NODPLC(LOC+1)=LOCV VALUE(LOCV)=ANAM C C BACKGROUND STORAGE C 100 NODPLC(LOC+2)=NDEFIN NWORD=LNOD(ID)-4 IF (NWORD.LT.1) GO TO 120 CALL ZERO4(NODPLC(LOC+3),NWORD) 120 NWORD=LVAL(ID)-1 IF (NWORD.LT.1) GO TO 200 CALL ZERO8(VALUE(LOCV+1),NWORD) C C EXIT C 200 RETURN END IDENT MEMORY ENTRY MEMORY TITLE MEMORY ALLOCATION SYSTEM INTERFACE FORTRAN TITLE EQUIVALENT FORTRAN DECK LISTING LIST F FORTRAN IFC NE,*FORTRAN*FORTRAN* SUBROUTINE MEMORY(ATYPE,KEY,MFL) C C THIS ROUTINE ADJUSTS THE AMOUNT OF CENTRAL MEMORY USED BY SPICE. C COMMON /MEMRY/ LORG,ICORE,MAXCOR,MAXUSE,MEMAVL,LDVAL,NUMBLK, 1 LOCTAB,LTAB COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /CJE/ JOBNAM,USRID1,USRID2,MAXTAP,ITAPE,MAXECS,IECS,MAXMEM, 1 IMEM,MAXLIN,ILINES,MAXPCH,IPUNCH,MAXTIM,ITIME,MAXPPU,IPPU, 2 IEFTIM,ISPTIM,MAXDLR,ICOST,XCJEX(11) COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C IF (MFL.GT.MAXMEM) GO TO 30 MAXCOR=MAX0(MAXCOR,MFL) C C CHANGE MEMORY ALLOCATION TO BE MFL WORDS C GO TO 40 30 NOGO=-1 40 RETURN * END FORTRAN ENDIF LIST -F *CALL,ASMARG *CALL,ASMCOM TITLE THE REAL THING MERR SX6 -1 SET ERROR FLAG SA6 NOGO . SPACE 1 MEMORY BSS 1 ENTRY/EXIT SPACE 1 ASMARG 3 SPACE 1 SA1 B3 FETCH MFL SA2 MAXMEM COMPARE TO LIMIT IX3 X1-X2 . + ZR X3,*+1 . EQUAL PL X3,MERR . GREATER SPACE 1 SA2 MAXCOR MAXCOR=MAX0(MAXCOR,MFL) IX3 X1-X2 . AX3 59 . BX4 -X3*X1 . BX5 X3*X2 . BX6 X4+X5 . SA6 A2 . SPACE 1 LX1 30 FORMAT SYSTEM REQUEST BX7 X1 . SA7 MEMCALL+1 . L10 SA1 1 WAIT FOR ALL QUIET IN RA+1 NZ X1,L10 . SA2 MEMCALL POST SYSTEM REQUEST BX6 X2 . SA6 A1 . L20 SA1 1 WAIT TILL SYSTEM SWALLOWS THE REQUEST NZ X1,L20 . SPACE 1 SA1 MEMCALL+1 VERIFY THAT ENTIRE REQUEST WAS GRANTED AX1 30 . SA2 B3 . IX3 X1-X2 . NZ X3,MERR . ERROR -- INSUFFICIENT MEMORY SPACE 1 IFCAL IFC EQ,$"SYSTEM"$CALIDOSCOPE$ IFRUN IFC EQ,$"COMPILER"$RUN$ SPACE 1 USE /SYS.MEM/ DECLARE SYSTEM MEMORY BLOCK SYS.MEM BSS 5 (WORD 1) = CURRENT CMFL USE * SPACE 1 LX7 30 UPDATE CMFL IN SYSTEM BLOCK SA7 SYS.MEM . SPACE 1 IFRUN ENDIF IFCAL ENDIF SPACE 1 EQ MEMORY EXIT MEMCALL SPACE 2 MEMCALL VFD 24/4LMEMP,36/*+1 VFD 30/0,30/0 END SUBROUTINE DCDCMP C C THIS ROUTINE PERFORMS AN IN-PLACE LU FACTORIZATION OF THE COEF- C FICIENT MATRIX. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /KNSTNT/ TWOPI,XLOG2,XLOG10,ROOT2,RAD,BOLTZ,CHARGE,CTOK, 1 GMIN,RELTOL,ABSTOL,VNTOL,TRTOL,CHGTOL,EPS0,EPSSIL,EPSOX COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C DO 100 I=2,NSTOP IO=NODPLC(IORDER+I) IF (ABS(VALUE(LYNL+IO)).GE.GMIN) GO TO 10 VALUE(LYNL+IO)=GMIN IGOOF=IGOOF+1 10 JSTART=NODPLC(ILC+I) JSTOP=NODPLC(ILC+I+1)-1 IF (JSTART.GT.JSTOP) GO TO 100 DO 90 J=JSTART,JSTOP VALUE(LYL+J)=VALUE(LYL+J)/VALUE(LYNL+IO) ICOL=NODPLC(ILR+J) KSTART=NODPLC(IUR+I) KSTOP=NODPLC(IUR+I+1)-1 IF (KSTART.GT.KSTOP) GO TO 90 DO 80 K=KSTART,KSTOP IROW=NODPLC(IUC+K) IF (ICOL-IROW) 20,60,40 C C FIND (ICOL,IROW) MATRIX TERM (UPPER TRIANGLE) C 20 L=NODPLC(IUR+ICOL+1) 30 L=L-1 IF (NODPLC(IUC+L).NE.IROW) GO TO 30 ISPOT=LYU+L GO TO 70 C C FIND (ICOL,IROW) MATRIX TERM (LOWER TRIANGLE) C 40 L=NODPLC(ILC+IROW+1) 50 L=L-1 IF (NODPLC(ILR+L).NE.ICOL) GO TO 50 ISPOT=LYL+L GO TO 70 C C FIND (ICOL,IROW) MATRIX TERM (DIAGONAL) C 60 ISPOT=LYNL+NODPLC(IORDER+IROW) C 70 VALUE(ISPOT)=VALUE(ISPOT)-VALUE(LYL+J)*VALUE(LYU+K) 80 CONTINUE 90 CONTINUE 100 CONTINUE RETURN END SUBROUTINE DCSOL C C THIS ROUTINE SOLVES THE SYSTEM OF CIRCUIT EQUATIONS BY PERFORMING C A FORWARD AND BACKWARD SUBSTITUTION STEP USING THE PREVIOUSLY-COMPUTED C LU FACTORS. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C FORWARD SUBSTITUTION C DO 20 I=2,NSTOP JSTART=NODPLC(ILC+I) JSTOP=NODPLC(ILC+I+1)-1 IF (JSTART.GT.JSTOP) GO TO 20 IO=NODPLC(IORDER+I) IF (VALUE(LVN+IO).EQ.0.0) GO TO 20 DO 10 J=JSTART,JSTOP JO=NODPLC(ILR+J) JO=NODPLC(IORDER+JO) VALUE(LVN+JO)=VALUE(LVN+JO)-VALUE(LYL+J)*VALUE(LVN+IO) 10 CONTINUE 20 CONTINUE C C BACK SUBSTITUTION C K=NSTOP+1 DO 50 I=2,NSTOP K=K-1 IO=NODPLC(IORDER+K) JSTART=NODPLC(IUR+K) JSTOP=NODPLC(IUR+K+1)-1 IF (JSTART.GT.JSTOP) GO TO 40 DO 30 J=JSTART,JSTOP JO=NODPLC(IUC+J) JO=NODPLC(IORDER+JO) VALUE(LVN+IO)=VALUE(LVN+IO)-VALUE(LYU+J)*VALUE(LVN+JO) 30 CONTINUE 40 VALUE(LVN+IO)=VALUE(LVN+IO)/VALUE(LYNL+IO) 50 CONTINUE RETURN END IDENT MOVE ENTRY MOVE MOVE TITLE *** MOVE CHARACTERS *** SPACE 5 * NOTE: FOR COMPATIBILITY WITH IBM, THIS ROUTINE ASSUMES EIGHT * CHARACTERS PER WORD, USING THE UPPER 48 BITS FOR THAT PURPOSE. FORTRAN TITLE FORTRAN EQUIVALENT DECK LISTING LIST F FORTRAN IFC NE,*FORTRAN*FORTRAN* SUBROUTINE MOVE(A,I,B,J,N) LOGICAL*1 A(1),B(1) C C THIS ROUTINE MOVES N CHARACTERS FROM CHARACTER ARRAY B TO CHARAC- C TER ARRAY A, BEGINNING WITH THE J*TH AND I*TH CHARACTER POSITIONS, C RESPECTIVELY. C IF (N.EQ.0) RETURN DO 10 K=1,N A(I+K-1)=B(J+K-1) 10 CONTINUE RETURN * END FORTRAN ENDIF LIST -F *CALL,ASMARG COMPASS TITLE COMPASS PROGRAM MOVE BSS 1 ENTRY/EXIT SPACE 1 ASMARG 5 SPACE 1 SA5 B5 FETCH N ZR X5,MOVE EXIT IF NULL MOVE REQUESTED SPACE 1 MX0 57 USEFUL MASK MX7 59 =-1 SB7 1 INVIOLATE CONSTANT SPACE 1 SA2 B2 SETUP *A* IX3 X2+X7 (I-1) BX4 X3 SAVE FOR A FEW USEC AX3 3 (I-1)/8 SA1 B1+X3 FETCH APPROPRIATE WORD OF *A* BX4 -X0*X4 CHARACTER POSITION (0-7) SB1 X4 HOLD POSITION IN B1 SB5 B1+B1 ORIENT *A* PROPERLY SB6 B5+B5 . SB5 B5+B6 . LX1 B5,X1 . DONE SPACE 1 SA2 B4 SETUP *B* IX3 X2+X7 (J-1) BX4 X3 SAVE FOR A FEW USEC AX3 3 (J-1)/8 SA2 B3+X3 FETCH APPROPRIATE WORD OF *B* BX4 -X0*X4 CHARACTER POSITION (0-7) SB2 X4 HOLD POSITION IN B2 SB3 B2+B2 ORIENT *B* PROPERLY SB4 B3+B3 . SB3 B3+B4 . LX2 B3,X2 . DONE SPACE 1 SB3 7 USEFUL CONSTANT MX0 6 ONE CHARACTER MASK SPACE 1 MOVE1 BX3 X0*X2 EXTRACT CHARACTER FROM *B* BX1 -X0*X1 CLEAR THE POSITION IN *A* BX1 X1+X3 MERGE THE NEW CHARACTER INTO *A* IX5 X5+X7 DECREMENT MOVE COUNT ZR X5,MOVE4 UNTIL ZERO LX1 6 SHIFT *A* ONE CHARACTER POSITION LX2 6 SHIFT *B* ONE CHARACTER POSITION SB2 B2+1 CHECK FOR EXHAUSTION OF CURRENT WORD OF *B* LE B2,B3,MOVE2 JUMP IF NOT EXHAUSTED SB2 0 RESET CHARACTER COUNTER SA2 A2+1 AND FETCH NEXT WORD OF *B* MOVE2 NE B1,B3,MOVE3 JUMP IF CURRENT WORD OF *A* IS NOT FULL SB1 B0-B7 CURRENT WORD IS FULL: RESET ASSEMBLY LX1 12 COMPENSATE FOR 8 CHARS OUT OF 10 BX6 X1 COPY TO SUITABLE REGISTER SA6 A1 AND STORE AWAY IN MEMORY SA1 A1+1 FETCH NEXT WORD OF *A* FOR MODIFICATION MOVE3 SB1 B1+1 UPDATE CHARACTER COUNT FOR *A* EQ MOVE1 AND GO MOVE THE NEXT CHARACTER MOVE4 SB2 10 FINAL SHIFT OF CURRENT WORD OF *A* ... SB1 B2-B1 . = 6 * (10 - B1) SB2 B1+B1 . SB3 B2+B2 . SB1 B2+B3 . LX6 B1,X1 . DONE SA6 A1 STORE AWAY IN MEMORY EQ MOVE EXIT END IDENT COPY ENTRY COPY4,COPY8,COPY16 TITLE BLOCK CM COPY ROUTINE TITLE FORTRAN EQUIVALENT DECK LISTING LIST F FORTRAN IFC NE,*FORTRAN*FORTRAN* SUBROUTINE COPY4(FROM,TO,NWORDS) INTEGER*4 FROM(1),TO(1),NWORDS REAL*8 RFROM(1),RTO(1) COMPLEX*16 CFROM(1),CTO(1) C C THIS ROUTINE COPIES A BLOCK OF "NWORDS" WORDS (OF THE APPROPRIATE C TYPE) FROM THE ARRAY "FROM" TO THE ARRAY "TO". IT DETERMINES FROM C WHICH END OF THE BLOCK TO TRANSFER FIRST, TO PREVENT OVER-STORES WHICH C MIGHT OVER-WRITE THE DATA. C IF (NWORDS.EQ.0) RETURN IF (LOCF(FROM(1)).LT.LOCF(TO(1))) GO TO 20 C... LOCF() RETURNS AS ITS VALUE THE ADDRESS OF ITS ARGUMENT DO 10 I=1,NWORDS TO(I)=FROM(I) 10 CONTINUE RETURN C 20 I=NWORDS 30 TO(I)=FROM(I) I=I-1 IF (I.NE.0) GO TO 30 RETURN C C C ENTRY COPY8(RFROM,RTO,NWORDS) C IF (NWORDS.EQ.0) RETURN IF (LOCF(RFROM(1)).LT.LOCF(RTO(1))) GO TO 120 DO 110 I=1,NWORDS RTO(I)=RFROM(I) 110 CONTINUE RETURN C 120 I=NWORDS 130 RTO(I)=RFROM(I) I=I-1 IF (I.NE.0) GO TO 130 RETURN C C C ENTRY COPY16(CFROM,CTO,NWORDS) C IF (NWORDS.EQ.0) RETURN IF (LOCF(CFROM(1)).LT.LOCF(CTO(1))) GO TO 220 DO 210 I=1,NWORDS CTO(I)=CFROM(I) 210 CONTINUE RETURN C 220 I=NWORDS 230 CTO(I)=CFROM(I) I=I-1 IF (I.NE.0) GO TO 230 RETURN * END FORTRAN ENDIF LIST -F *CALL,ASMARG TITLE COMPASS PROGRAM COPY BSS 1 ENTRY/EXIT SPACE 1 ASMARG 3 SPACE 1 COPY4 EQU COPY COPY8 EQU COPY SPACE 1 SA1 B3 FETCH *NWORDS* SB3 X1 INTO B3 ZR B3,COPY EXIT IF NULL COPY REQUESTED SPACE 1 COPYCON SB7 1 SET CONSTANT SPACE 1 GT B1,B2,COPY1 JUMP IF ADDR(FROM) > ADDR(TO) SB4 B3-B7 INITIALIZATION SA1 B1+B4 MOVE THE FIRST WORD BX6 X1 . SA6 B2+B4 . DONE SB6 -1 SET REGISTER TO DECREMENT EQ COPY2 GO DO IT SPACE 1 COPY1 SA1 B1 MOVE THE FIRST WORD BX6 X1 . SA6 B2 . DONE SB6 B7 SET REGISTER TO INCREMENT SPACE 1 COPY2 SB3 B3-1 CHECK FOR ONE-WORD COPY ZR B3,COPY AND EXIT IF SO SPACE 1 SB4 4 ANOTHER USEFUL CONSTANT LT B3,B4,COPY.CRW JUMP IF FEWER THAN 4 WORDS TO COPY SPACE 1 COPY3 SA1 A1+B6 MOVE WORDS IN BLOCKS OF 4 BX6 X1 . AS MUCH AS POSSIBLE SA2 A1+B6 . SA6 A6+B6 . SA3 A2+B6 . TIMING: BX7 X2 . 3.4 USEC PER WORD SA7 A6+B6 . (ON THE CDC 6400) BX7 X3 . SA1 A3+B6 . BX6 X1 . SA7 A7+B6 . SA6 A7+B6 . SB3 B3-4 . GE B3,B4,COPY3 . LOOP UNTIL *NWORDS* @ 3 SPACE 1 ZR B3,COPY EXIT IF MOD(*NWORDS*,4) = 0 SPACE 1 COPY.CRW SA1 A1+B6 COPY REMAINING WORDS (@ 3) BX6 X1 . SA6 A6+B6 . SB3 B3-B7 DECREMENT *NWORDS* NZ B3,COPY.CRW UNTIL ZERO SPACE 1 EQ COPY EXIT SPACE 5 COPY16 BSS 1 ENTRY TO COPY COMPLEX SPACE 1 ASMARG 3 SPACE 1 SA1 B3 FETCH *NWORDS* SB3 X1 INTO B3 ZR B3,COPY16 EXIT IF NULL COPY REQUESTED SB3 B3+B3 OTHERWISE, DOUBLE THE WORD COUNT SPACE 1 SA1 COPY16 MOVE RETURN ADDRESS BX6 X1 . SA6 COPY . DONE SPACE 1 EQ COPYCON CONTINUE SPACE 1 END IDENT ZERO ENTRY ZERO4,ZERO8,ZERO16 TITLE SUPER-FAST MEMORY CLEAR ROUTINE FORTRAN TITLE EQUIVALENT FORTRAN DECK LISTING LIST F FORTRAN IFC NE,*FORTRAN*FORTRAN* SUBROUTINE ZERO4(ARRAY,LENGTH) INTEGER*4 ARRAY(1),LENGTH REAL*8 RARRAY(1) COMPLEX*16 CARRAY(1) C C THIS ROUTINE ZEROES THE MEMORY LOCATIONS INDICATED BY ARRAY(1) C THROUGH ARRAY(LENGTH). C IF (LENGTH.EQ.0) RETURN DO 10 I=1,LENGTH ARRAY(I)=0.0 10 CONTINUE RETURN C C C ENTRY ZERO8(RARRAY,LENGTH) C IF (LENGTH.EQ.0) RETURN DO 110 I=1,LENGTH RARRAY(I)=0.0D0 110 CONTINUE RETURN C C C ENTRY ZERO16(CARRAY,LENGTH) C IF (LENGTH.EQ.0) RETURN DO 210 I=1,LENGTH CARRAY(I)=(0.0D0,0.0D0) 210 CONTINUE RETURN * END FORTRAN ENDIF LIST -F *CALL,ASMARG TITLE THE REAL THING ZERO BSS 1 ENTRY/EXIT SPACE 1 ASMARG 2 SPACE 1 ZERO4 EQU ZERO ZERO8 EQU ZERO SPACE 1 SA2 B2 FETCH *LENGTH* ZR X2,ZERO EXIT IF ZERO SB2 X2 OTHERWISE, LOAD *LENGTH* INTO B2 SPACE 1 ZEROTFW SX6 0 ZERO THE FIRST WORD SA6 B1+0 OF THE BLOCK SPACE 1 SB2 B2-1 CHECK WHETHER ONLY ONE-WORD ZERO REQUESTED ZR B2,ZERO AND EXIT IF SO SPACE 1 SB6 7 USEFUL CONSTANT SB7 1 DITTO SPACE 1 LT B2,B6,ZERO2 JUMP IF FEWER THAN 7 WORDS IN THE BLOCK SPACE 1 ZERO1 SA6 A6+B7 ZERO-OUT THE BLOCK IN 7-WORD CHUNKS SA6 A6+B7 . SA6 A6+B7 . SA6 A6+B7 . SA6 A6+B7 . SA6 A6+B7 . SA6 A6+B7 . DONE SPACE 1 SB2 B2-B6 DECREMENT *LENGTH* GE B2,B6,ZERO1 LOOP UNTIL *LENGTH* < 7 SPACE 1 ZR B2,ZERO EXIT IF MOD(*LENGTH*,7) = 0 SPACE 1 ZERO2 SA6 A6+B7 ZERO-OUT THE REMAINING WORDS SB2 B2-B7 . NZ B2,ZERO2 . LOOP UNTIL FINISHED SPACE 1 EQ ZERO EXIT SPACE 5 ZERO16 BSS 1 ENTRY TO CLEAR COMPLEX-VALUED ARRAY SPACE 1 ASMARG 2 SPACE 1 SA2 B2 FETCH *LENGTH* ZR X2,ZERO16 AND EXIT IF ZERO LX2 1 DOUBLE THE VALUE OF *LENGTH* SB2 X2 AND SAVE IN B2 SPACE 1 SA1 ZERO16 MOVE THE RETURN ADDRESS BX6 X1 TO THE NORMAL EXIT LOCATION SA6 ZERO . DONE EQ ZEROTFW GO ZERO THE FIRST WORD END SUBROUTINE GETCJE COMMON /CJE/ JOBNAM,USRID1,USRID2,MAXTAP,ITAPE,MAXECS,IECS,MAXMEM, 1IMEM,MAXLIN,ILINES,MAXPCH,IPUNCH,MAXTIM,ITIME,MAXPPU,IPPU,IEFTIM, 2ISPTIM,MAXDLR,ICOST,XCJEX(11) MAXTIM=MAXMEM=100000000 ITIME=ICOST=ILINES=0 RETURN END OVERLAY(1,0) PROGRAM READIN C C THIS ROUTINE DRIVES THE INPUT PROCESSING OF SPICE. ELEMENT CARDS C AND DEVICE MODELS ARE HANDLED BY THIS ROUTINE. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /MISCEL/ APROG(3),ATIME,ADATE,ATITLE(15),RSTATS(50), 1 IWIDTH,LWIDTH,NOPAGE COMMON /LINE/ ACHAR,AFIELD(15),OLDLIN(15),KNTRC,KNTLIM COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET, 1 MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO, 2 ITEMNO,NOSOLV,MODAC COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /KNSTNT/ TWOPI,XLOG2,XLOG10,ROOT2,RAD,BOLTZ,CHARGE,CTOK, 1 GMIN,RELTOL,ABSTOL,VNTOL,TRTOL,CHGTOL,EPS0,EPSSIL,EPSOX COMMON /DC/ TCSTAR,TCSTOP,TCINCR,ICVFLG,ITCELM,KSSOP,KINEL,KIDIN, 1 KOVAR,KIDOUT COMMON /AC/ FSTART,FSTOP,FINCR,SKW2,REFPRL,SPW2,JACFLG,IDFREQ, 1 INOISE,NOSPRT,NOSOUT,NOSIN,IDIST,IDPRT,JPZFLG,JPZTYP, 2 IPZIN,IPZITP,IPZOUT,IPZEQO,IPZLOC(2),IPZEQI,IPOMAT(3), 3 IPIMAT(4) COMMON /TRAN/ TSTEP,TSTOP,TSTART,DELMAX,TDMAX,FORFRE,JTRFLG COMMON /OUTINF/ STRING(15),YVAR(8),XSTART,XINCR,ITAB(8),ITYPE(8), 1 ILOGY(8),NPOINT,NUMOUT,KNTR,NUMDGT COMMON /CJE/ JOBNAM,USRID1,USRID2,MAXTAP,ITAPE,MAXECS,IECS,MAXMEM, 1 IMEM,MAXLIN,ILINES,MAXPCH,IPUNCH,MAXTIM,ITIME,MAXPPU,IPPU, 2 IEFTIM,ISPTIM,MAXDLR,ICOST,XCJEX(11) COMMON /DEBUG/ IDEBUG(20) COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C CONTROL CARD IDENTIFIERS C DIMENSION AIDE(20),NNODS(20),NTNODS(20) DIMENSION NUMIC(4) DIMENSION AIDM(7),IPOLAR(7),MODID(7),IPAR(5),AMPAR(90) DIMENSION TITINP(4) DIMENSION AIDC(31),JAIDC(31) DATA TITINP / 8HINPUT LI, 8HSTING , 8H , 8H / DATA NAIDC / 31 / DATA AIDC / 1 8HAC ,8HDC ,8HDISTORT ,8HDISTO ,8HEND , 2 8HENDS ,8HFOURIER ,8HFOUR ,8HMODEL ,8HMOD , 3 8HNOISE ,8HOP ,8HOPTIONS ,8HOPTION ,8HOPT , 4 8HPLOT ,8HPL ,8HPRINT ,8HPR ,8HPZ , 5 8HSUBCKT ,8HSENSITI ,8HSENS ,8HTRANSIE ,8HTRAN , 6 8HTR ,8HTF ,8HTEMPERA ,8HTEMP ,8HWIDTH , 7 8H:DEBUG: / DATA JAIDC / 1 1, 2, 3, 3, 4, 2 5, 6, 6, 7, 7, 3 8, 9, 10, 10, 10, 4 11, 11, 12, 12, 13, 5 14, 15, 15, 16, 16, 6 16, 17, 18, 18, 19, 7 20/ C C ELEMENT CARD IDENTIFIERS, KEYWORDS, AND INFORMATION C DATA AIDE / 1HR,1HC,1HL,1HK,1HG,1HE,1HF,1HH,1HV,1HI,1HD,1HQ,1HJ, 1 1HM,1HS,1HY,1HT,0.0,1HX,0.0 / DATA ALSAC,ALSPU,ALSEX,ALSSI /2HAC,5HPULSE,3HEXP,3HSIN/ DATA ALSOFF,ALSDC,ALSPW / 3HOFF,2HDC,3HPWL / DATA ALSZ0,ALSZO,ALSNL,ALSF,ALSTD / 2HZ0,2HZO,2HNL,1HF,2HTD / DATA ALSL,ALSW,ALSAS,ALSAD / 1HL,1HW,2HAS,2HAD / DATA ALSSF / 4HSFFM / DATA APOLY, AIC, AREA / 4HPOLY, 2HIC, 4HAREA / DATA ALSTC / 2HTC / DATA NUMIC / 1, 2, 2, 3 / DATA ABLNK, APER / 1H , 1H. / DATA NNODS / 2,2,2,0,2,2,2,2,2,2,2,3,3,4,4,4,4,0,0,0 / DATA NTNODS / 2,2,2,0,2,2,2,2,2,2,3,6,5,6,4,4,4,0,0,0 / C C MODEL CARD KEYWORDS C DATA AIDM /1HD,3HNPN,3HPNP,3HNJF,3HPJF,4HNMOS,4HPMOS/ DATA IPOLAR /0,1,-1,1,-1,1,-1/ DATA MODID /1,2,2,3,3,4,4/ DATA IPAR /0, 14, 43, 55, 85/ DATA AMPAR / 1 6HIS ,6HRS ,6HN ,6HTT ,6HCJO ,6HPB ,6HM , 2 6HEG ,6HPT ,6HKF ,6HAF ,6HFC ,6HBV ,6HIBV , 1 6HBF ,6HBR ,6HIS ,6HRB ,6HRC ,6HRE ,6HVA , 2 6HVB ,6HIK ,6HC2 ,6HNE ,6HIKR ,6HC4 ,6HNC , 3 6HTF ,6HTR ,6HCCS ,6HCJE ,6HPE ,6HME ,6HCJC , 4 6HPC ,6HMC ,6HEG ,6HPT ,6HKF ,6HAF ,6HFC , 5 6HDELAY , 1 6HVTO ,6HBETA ,6HLAMBDA,6HRD ,6HRS ,6HCGS ,6HCGD , 2 6HPB ,6HIS ,6HKF ,6HAF ,6HFC , 1 6HVTO ,6HKP ,6HGAMMA ,6HPHI ,6HLAMBDA,6HRD ,6HRS , 2 6HCGD ,6HCGS ,6HCGB ,6HCBD ,6HCBS ,6HTOX ,6HPB , 3 6HJS ,6HNSUB ,6HNSS ,6HNFS ,6HXJ ,6HLD ,6HNGATE , 4 6HTPS ,6HUO ,6HUCRIT ,6HUEXP ,6HUTRA ,6HKF ,6HAF , 5 6HFC ,6HLEVEL , 1 5*0.0 / C C INITIALIZE VARIABLES C CALL SECOND(T1) CALL ZERO4(IDEBUG,20) CALL GETLIN IF (KEOF.NE.0) GO TO 6000 CALL COPY8(AFIELD,ATITLE,15) CALL GETMEM(IELMNT,0) CALL GETMEM(ITEMPS,1) VALUE(ITEMPS+1)=27.0 ITEMNO=1 NOPAGE=0 CALL TITLE(-1,72,1,TITINP) DO 10 I=1,15 AFIELD(I)=ABLNK 10 CONTINUE CALL COPY8(AFIELD,OLDLIN,15) CALL GETMEM(ISBCKT,0) NSBCKT=0 CALL GETMEM(IUNSAT,0) NUNSAT=0 IWIDTH=80 LWIDTH=132 IPRNTA=0 IPRNTL=0 IPRNTM=1 IPRNTN=0 IPRNTO=0 GMIN=1.0E-12 RELTOL=0.001 ABSTOL=1.0E-12 VNTOL=1.0E-6 TRTOL=7.0 CHGTOL=1.0E-14 NUMDGT=4 NUMTEM=1 ITL1=100 ITL2=20 ITL3=4 ITL4=10 ITL5=5000 LIMTIM=2 LIMPTS=201 LVLCOD=2 LVLTIM=2 METHOD=1 MAXORD=2 NOSOLV=0 ICVFLG=0 IDIST=0 IDPRT=0 INOISE=0 JACFLG=0 JPZFLG=0 JTRFLG=0 CALL GETMEM(IFOUR,0) NFOUR=0 KINEL=0 KOVAR=0 KSSOP=0 NOSPRT=0 NSENS=0 CALL GETMEM(ISENS,0) NUMNOD=0 NCNODS=0 NUNODS=0 CALL ZERO4(LOCATE,50) CALL ZERO4(JELCNT,50) INSIZE=50 CALL GETMEM(IFIELD,INSIZE) CALL GETMEM(ICODE,INSIZE) CALL GETMEM(IDELIM,INSIZE) CALL GETMEM(ICOLUM,INSIZE) GO TO 50 C C ERROR ENTRY C 40 NOGO=1 C C READ AND DECODE NEXT CARD IN INPUT DECK C 50 IGOOF=0 CALL CARD IF (KEOF.NE.0) GO TO 5000 IF (IGOOF.NE.0) GO TO 40 IF (NODPLC(ICODE+1).EQ.0) GO TO 95 ANAM=VALUE(IFIELD+1) CALL MOVE(ANAM,2,ABLNK,1,7) IF (ANAM.NE.APER) GO TO 70 CALL MOVE(ANAM,1,VALUE(IFIELD+1),2,7) CALL KEYSRC(AIDC,JAIDC,NAIDC,ANAM,ID) IF (ID.LE.0) GO TO 90 IF (ID.EQ.4) GO TO 5000 IF (ID.EQ.5) GO TO 800 IF (ID.EQ.7) GO TO 500 IF (ID.EQ.14) GO TO 700 IF (NSBCKT.GE.1) GO TO 85 CALL RUNCON(ID) IF (IGOOF.NE.0) GO TO 40 GO TO 50 70 ID=0 80 ID=ID+1 IF (ID.GT.20) GO TO 90 IF (ANAM.EQ.AIDE(ID)) GO TO 100 GO TO 80 85 WRITE (6,86) 86 FORMAT("0WARNING: ABOVE LINE NOT ALLOWED WITHIN SUBCIRCUIT -- ", 1 "IGNORED"/) GO TO 50 90 WRITE (6,91) VALUE(IFIELD+1) 91 FORMAT("0*ERROR*: UNKNOWN DATA CARD: ",A8/) GO TO 40 95 WRITE (6,96) 96 FORMAT("0*ERROR*: UNRECOGNIZABLE DATA CARD"/) GO TO 40 C C ELEMENT AND DEVICE CARDS C 100 CALL FIND(VALUE(IFIELD+1),ID,LOC,1) LOCV=NODPLC(LOC+1) IF (ID.EQ.4) GO TO 140 IF (ID.EQ.19) GO TO 900 ISTOP=NNODS(ID)+1 DO 110 I=2,ISTOP IF (NODPLC(ICODE+I).NE.0) GO TO 410 IF (VALUE(IFIELD+I).LT.0.0) GO TO 400 110 NODPLC(LOC+I)=VALUE(IFIELD+I) GO TO (120,130,130,140,150,150,180,180,200,200,300,300,300,300, 1 390,390,350,390,390,390), ID C C RESISTOR C 120 IF (NODPLC(ICODE+4).NE.0) GO TO 420 IF (VALUE(IFIELD+4).EQ.0.0) GO TO 480 VALUE(LOCV+2)=VALUE(IFIELD+4) IFLD=4 122 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD)) 50,122,124 124 ANAM=VALUE(IFIELD+IFLD) IF (ANAM.NE.ALSTC) GO TO 460 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD)) 50,126,124 126 VALUE(LOCV+3)=VALUE(IFIELD+IFLD) IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD)) 50,128,124 128 VALUE(LOCV+4)=VALUE(IFIELD+IFLD) GO TO 50 C C CAPACITOR OR INDUCTOR C 130 IF (NODPLC(ICODE+4).NE.0) GO TO 420 IF (VALUE(IFIELD+4).LE.0.0) GO TO 420 VALUE(LOCV+1)=VALUE(IFIELD+4) IF (NODPLC(ICODE+5).NE.1) GO TO 50 134 ANAM=VALUE(IFIELD+5) IF (ANAM.NE.AIC) GO TO 460 IF (NODPLC(ICODE+6).NE.0) GO TO 50 VALUE(LOCV+2)=VALUE(IFIELD+6) GO TO 50 C C MUTUAL INDUCTANCE C 140 IF (NODPLC(ICODE+2).NE.1) GO TO 430 ANAM=VALUE(IFIELD+2) CALL MOVE(ANAM,2,ABLNK,1,7) IF (ANAM.NE.AIDE(3)) GO TO 430 CALL EXTNAM(VALUE(IFIELD+2),NODPLC(LOC+2)) IF (NODPLC(ICODE+3).NE.1) GO TO 430 ANAM=VALUE(IFIELD+3) CALL MOVE(ANAM,2,ABLNK,1,7) IF (ANAM.NE.AIDE(3)) GO TO 430 CALL EXTNAM(VALUE(IFIELD+3),NODPLC(LOC+3)) IF (NODPLC(ICODE+4).NE.0) GO TO 420 XK=VALUE(IFIELD+4) IF (XK.LE.0.0) GO TO 420 IF (XK.LE.1.0) GO TO 145 XK=1.0 WRITE (6,141) 141 FORMAT("0WARNING: COEFFICIENT OF COUPLING RESET TO 1.0"/) 145 VALUE(LOCV+1)=XK GO TO 50 C C VOLTAGE CONTROLLED (NONLINEAR) SOURCES C 150 NDIM=1 IFLD=3 IF (NODPLC(ICODE+4)) 410,156,152 152 ANAM=VALUE(IFIELD+4) IF (ANAM.NE.APOLY) GO TO 450 IF (NODPLC(ICODE+5).NE.0) GO TO 420 NDIM=VALUE(IFIELD+5) IF (NDIM.LE.0) GO TO 420 IFLD=5 156 NODPLC(LOC+4)=NDIM LTAB=ID+1 NSNOD=2*NDIM NMAT=4*NDIM IF (ID.EQ.6) NMAT=4+2*NDIM CALL GETMEM(NODPLC(LOC+LTAB),NSNOD) CALL GETMEM(NODPLC(LOC+LTAB+1),NMAT) CALL GETMEM(NODPLC(LOC+LTAB+2),0) CALL GETMEM(NODPLC(LOC+LTAB+3),NDIM) CALL GETMEM(NODPLC(LOC+LTAB+4),NDIM) CALL GETMEM(NODPLC(LOC+LTAB+5),NDIM) ISPOT=NODPLC(LOC+LTAB+5) CALL ZERO8(VALUE(ISPOT+1),NDIM) LNOD=NODPLC(LOC+LTAB) DO 158 I=1,NSNOD IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.0) GO TO 410 IF (VALUE(IFIELD+IFLD).LT.0.0) GO TO 400 NODPLC(LNOD+I)=VALUE(IFIELD+IFLD) 158 CONTINUE 160 IKNT=0 162 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.0) GO TO 164 CALL EXTMEM(NODPLC(LOC+LTAB+2),1) IKNT=IKNT+1 ISPOT=NODPLC(LOC+LTAB+2)+IKNT VALUE(ISPOT)=VALUE(IFIELD+IFLD) GO TO 162 164 IF (IKNT.EQ.0) GO TO 420 IF (NODPLC(ICODE+IFLD).NE.1) GO TO 170 ANAM=VALUE(IFIELD+IFLD) IF (ANAM.NE.AIC) GO TO 460 DO 168 I=1,NDIM IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD)) 170,166,420 166 ISPOT=NODPLC(LOC+LTAB+5)+I VALUE(ISPOT)=VALUE(IFIELD+IFLD) 168 CONTINUE 170 IF (NDIM.NE.1) GO TO 50 IF (IKNT.NE.1) GO TO 50 CALL EXTMEM(NODPLC(LOC+LTAB+2),1) ISPOT=NODPLC(LOC+LTAB+2) VALUE(ISPOT+2)=VALUE(ISPOT+1) VALUE(ISPOT+1)=0.0 GO TO 50 C C CURRENT CONTROLLED (NONLINEAR) SOURCES C 180 NDIM=1 IFLD=3 IF (NODPLC(ICODE+4).NE.1) GO TO 470 ANAM=VALUE(IFIELD+4) IF (ANAM.NE.APOLY) GO TO 182 IFLD=5 IF (NODPLC(ICODE+5).NE.0) GO TO 420 NDIM=VALUE(IFIELD+5) IF (NDIM.LE.0) GO TO 420 182 NODPLC(LOC+4)=NDIM LTAB=ID-1 NMAT=2*NDIM IF (ID.EQ.8) NMAT=4+NDIM CALL GETMEM(NODPLC(LOC+LTAB),NDIM) CALL GETMEM(NODPLC(LOC+LTAB+1),NMAT) CALL GETMEM(NODPLC(LOC+LTAB+2),0) CALL GETMEM(NODPLC(LOC+LTAB+3),NDIM) CALL GETMEM(NODPLC(LOC+LTAB+4),NDIM) CALL GETMEM(NODPLC(LOC+LTAB+5),NDIM) ISPOT=NODPLC(LOC+LTAB+5) CALL ZERO8(VALUE(ISPOT+1),NDIM) DO 184 I=1,NDIM IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.1) GO TO 470 ANAM=VALUE(IFIELD+IFLD) CALL MOVE(ANAM,2,ABLNK,1,7) IF (ANAM.NE.AIDE(9)) GO TO 470 CALL EXTNAM(VALUE(IFIELD+IFLD),LOCT) ISPOT=NODPLC(LOC+LTAB)+I NODPLC(ISPOT)=LOCT 184 CONTINUE GO TO 160 C C INDEPENDENT SOURCES C 200 IFLD=3 CALL GETMEM(NODPLC(LOC+5),0) 210 IFLD=IFLD+1 215 IF (NODPLC(ICODE+IFLD)) 50,220,230 220 IF (IFLD.GT.4) GO TO 210 225 VALUE(LOCV+1)=VALUE(IFIELD+IFLD) GO TO 210 230 ANAM=VALUE(IFIELD+IFLD) IF (ANAM.NE.ALSDC) GO TO 235 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD)) 50,225,230 235 IF (ANAM.NE.ALSAC) GO TO 260 VALUE(LOCV+2)=1.0 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD)) 50,240,230 240 VALUE(LOCV+2)=VALUE(IFIELD+IFLD) IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD)) 50,250,230 250 VALUE(LOCV+3)=VALUE(IFIELD+IFLD) GO TO 210 260 ID=0 IF (ANAM.EQ.ALSPU) ID=1 IF (ANAM.EQ.ALSSI) ID=2 IF (ANAM.EQ.ALSEX) ID=3 IF (ANAM.EQ.ALSPW) ID=4 IF (ANAM.EQ.ALSSF) ID=5 IF (ID.EQ.0) GO TO 450 NODPLC(LOC+4)=ID IKNT=0 270 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.0) GO TO 280 CALL EXTMEM(NODPLC(LOC+5),1) IKNT=IKNT+1 ISPOT=NODPLC(LOC+5)+IKNT VALUE(ISPOT)=VALUE(IFIELD+IFLD) GO TO 270 280 AVAL=0.0 IF (ID.NE.4) GO TO 285 C... FOR PWL SOURCE FUNCTION, FORCE EVEN NUMBER OF INPUT VALUES IBIT=AND(IKNT,1) AVAL=VALUE(ISPOT) IF (IBIT.EQ.0) GO TO 290 CALL EXTMEM(NODPLC(LOC+5),1) AVAL=VALUE(ISPOT-1) IKNT=IKNT+1 ISPOT=NODPLC(LOC+5)+IKNT VALUE(ISPOT)=AVAL GO TO 290 285 IF (IKNT.GE.7) GO TO 215 290 CALL EXTMEM(NODPLC(LOC+5),2) ISPOT=NODPLC(LOC+5)+IKNT VALUE(ISPOT+1)=0.0 VALUE(ISPOT+2)=AVAL IKNT=IKNT+2 GO TO 285 C C DEVICE CARDS C 300 VALUE(LOCV+1)=1.0 IF (ID.NE.14) GO TO 305 VALUE(LOCV+2)=1.0 VALUE(LOCV+3)=1.0E-6 VALUE(LOCV+4)=1.0E-6 305 LOCM=LOC+NTNODS(ID)+2 IFLD=NNODS(ID)+2 IF (NODPLC(ICODE+IFLD).NE.1) GO TO 440 CALL EXTNAM(VALUE(IFIELD+IFLD),NODPLC(LOCM)) 310 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD)) 50,325,315 315 ANAM=VALUE(IFIELD+IFLD) IF (ANAM.NE.ALSOFF) GO TO 320 NODPLC(LOCM+1)=1 GO TO 310 320 IF (ANAM.NE.AREA) GO TO 330 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD)) 50,325,315 325 IF (VALUE(IFIELD+IFLD).LE.0.0) GO TO 420 IF (ID.EQ.14) GO TO 490 VALUE(LOCV+1)=VALUE(IFIELD+IFLD) GO TO 310 330 IF (ANAM.NE.AIC) GO TO 345 IKNT=0 ICLOC=0 IF (ID.EQ.14) ICLOC=3 MAXKNT=NUMIC(ID-10) 335 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD)) 50,340,315 340 IKNT=IKNT+1 IF (IKNT.GT.MAXKNT) GO TO 335 VALUE(LOCV+ICLOC+IKNT+1)=VALUE(IFIELD+IFLD) GO TO 335 345 IF (ID.NE.14) GO TO 460 ISPOT=0 IF (ANAM.EQ.ALSL) ISPOT=1 IF (ANAM.EQ.ALSW) ISPOT=2 IF (ANAM.EQ.ALSAD) ISPOT=3 IF (ANAM.EQ.ALSAS) ISPOT=4 IF (ISPOT.EQ.0) GO TO 460 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD)) 50,347,315 347 IF (VALUE(IFIELD+IFLD).LE.0.0) GO TO 420 VALUE(LOCV+ISPOT)=VALUE(IFIELD+IFLD) GO TO 310 C C TRANSMISSION LINES C 350 IFLD=5 XNL=0.25 TFREQ=0.0 355 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD)) 378,355,360 360 ANAM=VALUE(IFIELD+IFLD) IF (ANAM.EQ.AIC) GO TO 364 IF (ANAM.EQ.ALSNL) GO TO 370 IF (ANAM.EQ.ALSF) GO TO 374 ID=0 IF (ANAM.EQ.ALSZ0) ID=1 IF (ANAM.EQ.ALSZO) ID=1 IF (ANAM.EQ.ALSTD) ID=2 IF (ID.EQ.0) GO TO 460 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD)) 378,362,360 362 IF (VALUE(IFIELD+IFLD).LE.0.0) GO TO 420 VALUE(LOCV+ID)=VALUE(IFIELD+IFLD) GO TO 355 364 IKNT=0 366 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD)) 378,368,360 368 IKNT=IKNT+1 IF (IKNT.GT.4) GO TO 366 VALUE(LOCV+IKNT+4)=VALUE(IFIELD+IFLD) GO TO 366 370 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD)) 378,372,360 372 IF (VALUE(IFIELD+IFLD).LE.0.0) GO TO 420 XNL=VALUE(IFIELD+IFLD) GO TO 355 374 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD)) 378,376,360 376 IF (VALUE(IFIELD+IFLD).LE.0.0) GO TO 420 TFREQ=VALUE(IFIELD+IFLD) GO TO 355 378 IF (VALUE(LOCV+1).NE.0.0) GO TO 380 WRITE (6,379) 379 FORMAT("0*ERROR*: Z0 MUST BE SPECIFIED"/) GO TO 40 380 IF (VALUE(LOCV+2).NE.0.0) GO TO 50 IF (TFREQ.NE.0.0) GO TO 382 WRITE (6,381) 381 FORMAT("0*ERROR*: EITHER TD OR F MUST BE SPECIFIED"/) GO TO 40 382 VALUE(LOCV+2)=XNL/TFREQ GO TO 50 C C ELEMENTS NOT YET IMPLEMENTED C 390 WRITE (6,391) 391 FORMAT("0*ERROR*: ELEMENT TYPE NOT YET IMPLEMENTED"/) GO TO 40 C C ELEMENT CARD ERRORS C 400 WRITE (6,401) 401 FORMAT("0*ERROR*: NEGATIVE NODE NUMBER FOUND"/) GO TO 40 410 WRITE (6,411) 411 FORMAT("0*ERROR*: NODE NUMBERS ARE MISSING"/) GO TO 40 420 WRITE (6,421) 421 FORMAT("0*ERROR*: VALUE IS MISSING OR IS NONPOSITIVE"/) GO TO 40 430 WRITE (6,431) 431 FORMAT("0*ERROR*: MUTUAL INDUCTANCE REFERENCES ARE MISSING"/) GO TO 40 440 WRITE (6,441) 441 FORMAT("0*ERROR*: MODEL NAME IS MISSING"/) GO TO 40 450 WRITE (6,451) ANAM 451 FORMAT("0*ERROR*: UNKNOWN SOURCE FUNCTION: ",A8/) GO TO 40 460 WRITE (6,461) ANAM 461 FORMAT("0*ERROR*: UNKNOWN PARAMETER: ",A8/) GO TO 40 470 WRITE (6,471) 471 FORMAT("0*ERROR*: VOLTAGE SOURCE NOT FOUND ON ABOVE LINE"/) GO TO 40 480 WRITE (6,481) 481 FORMAT("0*ERROR*: VALUE IS ZERO"/) GO TO 40 490 WRITE(6,491) 491 FORMAT("0*ERROR*: AREA FACTOR UNDEFINED FOR MOSFET"/) GO TO 40 C C MODEL CARD C 500 IF (NODPLC(ICODE+2).NE.1) GO TO 650 IF (NODPLC(ICODE+3).NE.1) GO TO 650 ID=0 510 ID=ID+1 IF (ID.GT.7) GO TO 660 IF (VALUE(IFIELD+3).NE.AIDM(ID)) GO TO 510 IPOL=IPOLAR(ID) JTYPE=MODID(ID) ID=JTYPE+20 CALL FIND(VALUE(IFIELD+2),ID,LOC,1) NODPLC(LOC+2)=IPOL LOCV=NODPLC(LOC+1) LOCM=IPAR(JTYPE) NOPAR=IPAR(JTYPE+1)-LOCM IFLD=3 530 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD)) 50,530,560 560 ANAM=VALUE(IFIELD+IFLD) IKNT=0 570 IKNT=IKNT+1 IF (IKNT.GT.NOPAR) GO TO 670 IF (ANAM.NE.AMPAR(LOCM+IKNT)) GO TO 570 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD)) 50,580,560 580 VALUE(LOCV+IKNT)=VALUE(IFIELD+IFLD) IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD)) 50,590,560 590 IKNT=IKNT+1 IF (IKNT.GT.NOPAR) GO TO 530 IF (ABLNK.NE.AMPAR(LOCM+IKNT)) GO TO 530 GO TO 580 C C MODEL CARD ERRORS C 650 WRITE (6,651) 651 FORMAT("0*ERROR*: MODEL TYPE IS MISSING"/) GO TO 40 660 WRITE (6,661) VALUE(IFIELD+3) 661 FORMAT("0*ERROR*: UNKNOWN MODEL TYPE: ",A8/) GO TO 40 670 WRITE (6,671) ANAM 671 FORMAT("0*ERROR*: UNKNOWN MODEL PARAMETER: ",A8,/) NOGO=1 GO TO 530 C C SUBCIRCUIT DEFINITION C 700 IF (NODPLC(ICODE+2).NE.1) GO TO 780 CALL FIND(VALUE(IFIELD+2),20,LOC,1) CALL EXTMEM(ISBCKT,1) NSBCKT=NSBCKT+1 NODPLC(ISBCKT+NSBCKT)=LOC IFLD=2 IF (NODPLC(ICODE+3).NE.0) GO TO 790 CALL GETMEM(NODPLC(LOC+2),0) IKNT=0 710 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD)) 50,720,710 720 CALL EXTMEM(NODPLC(LOC+2),1) IKNT=IKNT+1 ISPOT=NODPLC(LOC+2)+IKNT IF (VALUE(IFIELD+IFLD).LE.0.0) GO TO 770 NODPLC(ISPOT)=VALUE(IFIELD+IFLD) NODE=NODPLC(ISPOT) I=IKNT-1 730 IF (I.EQ.0) GO TO 710 ISPOT=ISPOT-1 IF (NODPLC(ISPOT).EQ.NODE) GO TO 760 I=I-1 GO TO 730 760 WRITE (6,761) NODE 761 FORMAT("0*ERROR*: SUBCIRCUIT DEFINITION DUPLICATES NODE ",I5,/) GO TO 40 770 WRITE (6,771) 771 FORMAT("0*ERROR*: NONPOSITIVE NODE NUMBER FOUND IN SUBCIRCUIT ", 1 "DEFINITION"/) GO TO 40 780 WRITE (6,781) 781 FORMAT("0*ERROR*: SUBCIRCUIT NAME MISSING"/) GO TO 40 790 WRITE (6,791) 791 FORMAT("0*ERROR*: SUBCIRCUIT NODES MISSING"/) GO TO 40 C C .ENDS PROCESSING C 800 IF (NSBCKT.EQ.0) GO TO 890 IKNT=1 IF (NODPLC(ICODE+2).LE.0) GO TO 820 ANAM=VALUE(IFIELD+2) IKNT=NSBCKT 810 LOC=NODPLC(ISBCKT+IKNT) LOCV=NODPLC(LOC+1) ANAMS=VALUE(LOCV) IF (ANAM.EQ.ANAMS) GO TO 820 IKNT=IKNT-1 IF (IKNT.NE.0) GO TO 810 GO TO 880 820 IREL=NSBCKT-IKNT+1 CALL RELMEM(ISBCKT,IREL) NSBCKT=NSBCKT-IREL GO TO 50 880 WRITE (6,881) ANAM 881 FORMAT("0*ERROR*: UNKNOWN SUBCIRCUIT NAME: ",A8/) GO TO 40 890 WRITE (6,891) 891 FORMAT("0WARNING: NO SUBCIRCUIT DEFINITION KNOWN -- LINE IGNORED" 1/) GO TO 50 C C SUBCIRCUIT CALL C 900 CALL GETMEM(NODPLC(LOC+2),0) IFLD=1 IKNT=0 910 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.0) GO TO 920 CALL EXTMEM(NODPLC(LOC+2),1) IKNT=IKNT+1 ISPOT=NODPLC(LOC+2)+IKNT IF (VALUE(IFIELD+IFLD).LT.0.0) GO TO 400 NODPLC(ISPOT)=VALUE(IFIELD+IFLD) GO TO 910 920 IF (IKNT.EQ.0) GO TO 410 IF (NODPLC(ICODE+IFLD).NE.1) GO TO 990 CALL EXTNAM(VALUE(IFIELD+IFLD),NODPLC(LOC+3)) GO TO 50 990 WRITE (6,991) 991 FORMAT("0*ERROR*: SUBCIRCUIT NAME MISSING"/) GO TO 40 C C END C 5000 IF (NSBCKT.EQ.0) GO TO 5010 NSBCKT=0 WRITE (6,5001) 5001 FORMAT("0*ERROR*: .ENDS CARD MISSING"/) NOGO=1 5010 CALL CLRMEM(IFIELD) CALL CLRMEM(ICODE) CALL CLRMEM(IDELIM) CALL CLRMEM(ICOLUM) CALL CLRMEM(ISBCKT) IF (NFOUR.EQ.0) CALL CLRMEM(IFOUR) IF (NSENS.EQ.0) CALL CLRMEM(ISENS) 6000 CALL SECOND(T2) RSTATS(1)=T2-T1 RETURN END SUBROUTINE KEYSRC(AIDC,JAIDC,NAIDC,ANAM,ID) C C THIS ROUTINE SEARCHES THE KEYWORD TABLE -AIDC- FOR AN EXACT C MATCH WITH -ANAM-. IF A MATCH IS FOUND, THE CORRESPONDING ENTRY C IN -JAIDC- IS RETURNED IN -ID-. IF NO MATCH IS FOUND, ID = -1. C DIMENSION AIDC(NAIDC),JAIDC(NAIDC) INTEGER XOR C C DO 10 I=1,NAIDC IF (XOR(AIDC(I),ANAM).EQ.0) GO TO 20 10 CONTINUE ID=-1 GO TO 30 C 20 ID=JAIDC(I) 30 RETURN END SUBROUTINE EXTNAM(ANAME,INDEX) C C THIS ROUTINE ADDS "ANAME" TO THE LIST OF "UNSATISFIED" NAMES (THAT C IS, NAMES WHICH CAN ONLY BE RESOLVED AFTER SUBCIRCUIT EXPANSION). C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) INTEGER XOR C C ANAM=ANAME IF (NUNSAT.EQ.0) GO TO 20 DO 10 INDEX=1,NUNSAT IF (XOR(ANAM,VALUE(IUNSAT+INDEX)).EQ.0) GO TO 30 10 CONTINUE C 20 CALL EXTMEM(IUNSAT,1) NUNSAT=NUNSAT+1 INDEX=NUNSAT VALUE(IUNSAT+INDEX)=ANAM 30 RETURN END SUBROUTINE RUNCON(ID) C C THIS ROUTINE PROCESSES RUN CONTROL CARDS. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /MISCEL/ APROG(3),ATIME,ADATE,ATITLE(15),RSTATS(50), 1 IWIDTH,LWIDTH,NOPAGE COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET, 1 MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO, 2 ITEMNO,NOSOLV,MODAC COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /KNSTNT/ TWOPI,XLOG2,XLOG10,ROOT2,RAD,BOLTZ,CHARGE,CTOK, 1 GMIN,RELTOL,ABSTOL,VNTOL,TRTOL,CHGTOL,EPS0,EPSSIL,EPSOX COMMON /DC/ TCSTAR,TCSTOP,TCINCR,ICVFLG,ITCELM,KSSOP,KINEL,KIDIN, 1 KOVAR,KIDOUT COMMON /AC/ FSTART,FSTOP,FINCR,SKW2,REFPRL,SPW2,JACFLG,IDFREQ, 1 INOISE,NOSPRT,NOSOUT,NOSIN,IDIST,IDPRT,JPZFLG,JPZTYP, 2 IPZIN,IPZITP,IPZOUT,IPZEQO,IPZLOC(2),IPZEQI,IPOMAT(3), 3 IPIMAT(4) COMMON /TRAN/ TSTEP,TSTOP,TSTART,DELMAX,TDMAX,FORFRE,JTRFLG COMMON /OUTINF/ STRING(15),YVAR(8),XSTART,XINCR,ITAB(8),ITYPE(8), 1 ILOGY(8),NPOINT,NUMOUT,KNTR,NUMDGT COMMON /DEBUG/ IDEBUG(20) COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) DIMENSION IPRNT(5),LIMITS(4),ITRLIM(5),CONTOL(6) EQUIVALENCE (IPRNT(1),IPRNTA),(LIMITS(1),LIMTIM),(ITRLIM(1),ITL1), 1 (CONTOL(1),GMIN) C C INTEGER XOR C C PRINT/PLOT KEYWORDS C DIMENSION AOPT(5) DIMENSION AOPTS(25),LSETOP(5) DIMENSION AIDE(20) DATA AOPT / 2HDC, 2HTR, 2HAC, 2HNO, 2HDI / C C OPTIONS CARD KEYWORDS C DATA AOPTS / 6HACCT , 6HLIST , 6HNOMOD , 6HNODE , 6HOPTS , 1 6HITL1 , 6HITL2 , 6HITL3 , 6HITL4 , 6HITL5 , 2 6HLIMTIM, 6HLIMPTS, 6HLVLCOD, 6HLVLTIM, 6HGMIN , 3 6HRELTOL, 6HABSTOL, 6HVNTOL , 6HTRTOL , 6HCHGTOL, 4 6HTNOM , 6HNUMDGT, 6HMAXORD, 6HMETHOD, 6HNOPAGE / DATA LSETOP / 1, 1, 0, 1, 1 / C C DATA AIDE / 1HR,1HC,1HL,1HK,1HG,1HE,1HF,1HH,1HV,1HI,1HD,1HQ,1HJ, 1 1HM,1HS,1HY,1HT,0.0,1HX,0.0 / DATA ALSDE,ALSOC,ALSLI / 3HDEC, 3HOCT, 3HLIN / DATA ATRAP, AGEAR, AUIC / 4HTRAP, 4HGEAR, 3HUIC / DATA AMUL, AADJ / 3HMUL, 3HADJ / DATA ALETI, ALETV / 1HI, 1HV / DATA ALPRN / 1H( / DATA ABLNK, AIN, AOUT / 1H , 2HIN, 3HOUT / DATA AMISS / 8H*MISSING / DATA AMS / 2HMS / DATA MINPTS / 1 / C C IF (ID.EQ.20) GO TO 5900 GO TO (1200,1100,1650,6000,6000,1700,6000,1600,1550,2000,3600, 1 3500,2600,6000,1750,1300,1500,1800,4000), ID C C DC TRANSFER CURVES C 1100 IFLD=2 ANAM=VALUE(IFIELD+2) ID=0 CALL MOVE(ANAM,2,ABLNK,1,7) IF (ANAM.EQ.AIDE(9)) ID=9 IF (ANAM.EQ.AIDE(10)) ID=10 IF (ID.EQ.0) GO TO 1130 CALL FIND(VALUE(IFIELD+IFLD),ID,ITCELM,0) IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1130 TCSTAR=VALUE(IFIELD+IFLD) IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1130 TCSTOP=VALUE(IFIELD+IFLD) IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1130 TCINCR=VALUE(IFIELD+IFLD) IF (TCINCR.EQ.0.0) GO TO 1130 TEMP=(TCSTOP-TCSTAR)/TCINCR IF (TEMP.GT.0.0) GO TO 1110 TCINCR=-TCINCR TEMP=-TEMP 1110 ICVFLG=IFIX(TEMP+0.5)+1 ICVFLG=MAX0(ICVFLG,MINPTS) GO TO 6000 1130 WRITE (6,1131) 1131 FORMAT("0WARNING: MISSING PARAMETER(S) ... ANALYSIS OMITTED"/) GO TO 6000 C C FREQUENCY SPECIFICATION C 1200 IFLD=2 IF (NODPLC(ICODE+2)) 1250,1250,1210 1210 ID=0 IF (VALUE(IFIELD+IFLD).EQ.ALSDE) ID=1 IF (VALUE(IFIELD+IFLD).EQ.ALSOC) ID=2 IF (VALUE(IFIELD+IFLD).EQ.ALSLI) ID=3 IF (ID.EQ.0) GO TO 1240 IDFREQ=ID IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1250 IF (VALUE(IFIELD+IFLD).LE.0.0) GO TO 1250 FINCR=VALUE(IFIELD+IFLD) IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1250 IF (VALUE(IFIELD+IFLD).LE.0.0) GO TO 1250 FSTART=VALUE(IFIELD+IFLD) IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1250 IF (VALUE(IFIELD+IFLD).LE.0.0) GO TO 1250 FSTOP=VALUE(IFIELD+IFLD) IF (FSTART.GT.FSTOP) GO TO 1260 JACFLG=FINCR IF (IDFREQ-2) 1215,1220,1235 1215 FINCR=EXP(XLOG10/FINCR) GO TO 1230 1220 FINCR=EXP(XLOG2/FINCR) 1230 TEMP=ALOG(FSTOP/FSTART)/ALOG(FINCR) JACFLG=IFIX(TEMP+0.999)+1 1235 JACFLG=MAX0(JACFLG,MINPTS) IF (IDFREQ.NE.3) GO TO 6000 FINCR=(FSTOP-FSTART)/FLOAT(MAX0(JACFLG-1,1)) GO TO 6000 1240 WRITE (6,1241) VALUE(IFIELD+IFLD) 1241 FORMAT("0WARNING: UNKNOWN FREQUENCY FUNCTION: ",A8," ... ANALYS" 1 "IS OMITTED"/) GO TO 6000 1250 WRITE (6,1251) 1251 FORMAT("0WARNING: FREQUENCY PARAMETERS INCORRECT ... ANALYSIS OM" 1 "ITTED"/) GO TO 6000 1260 WRITE (6,1261) 1261 FORMAT("0WARNING: START FREQ > STOP FREQ ... ANALYSIS OMITTED"/) GO TO 6000 C C TIME SPECIFICATION C 1300 IFLD=2 IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1430 IF (VALUE(IFIELD+IFLD).LE.0.0) GO TO 1430 TSTEP=VALUE(IFIELD+IFLD) DELMAX=TSTEP IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1430 IF (VALUE(IFIELD+IFLD).LE.0.0) GO TO 1430 TSTOP=VALUE(IFIELD+IFLD) TSTART=0.0 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1310 IF (VALUE(IFIELD+IFLD).LT.0.0) GO TO 1430 TSTART=VALUE(IFIELD+IFLD) IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1310 IF (VALUE(IFIELD+IFLD).LE.0.0) GO TO 1430 DELMAX=VALUE(IFIELD+IFLD) DELMAX=AMIN1(DELMAX,TSTEP) IFLD=IFLD+1 1310 IF (NODPLC(ICODE+IFLD).NE.1) GO TO 1320 IF (VALUE(IFIELD+IFLD).NE.AUIC) GO TO 1320 NOSOLV=1 1320 IF (TSTART.GT.TSTOP) GO TO 1440 IF (TSTEP.GT.TSTOP) GO TO 1430 JTRFLG=IFIX((TSTOP-TSTART)/TSTEP+0.5)+1 JTRFLG=MAX0(JTRFLG,MINPTS) GO TO 6000 1430 WRITE (6,1431) 1431 FORMAT("0WARNING: TIME PARAMETERS INCORRECT ... ANALYSIS OMITTED" 1 /) GO TO 6000 1440 WRITE (6,1441) 1441 FORMAT("0WARNING: START TIME > STOP TIME ... ANALYSIS OMITTED"/) GO TO 6000 C C TRANSFER FUNCTION C 1500 KSSOP=1 IFLD=2 IF (NODPLC(ICODE+IFLD).NE.1) GO TO 1530 CALL OUTDEF(IFLD,1,KOVAR,KTYPE) IF (IGOOF.NE.0) GO TO 1530 IF (KTYPE.NE.1) GO TO 1540 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.1) GO TO 1530 ANAM=VALUE(IFIELD+IFLD) CALL MOVE(ANAM,2,ABLNK,1,7) ID=0 IF (ANAM.EQ.AIDE(9)) ID=9 IF (ANAM.EQ.AIDE(10)) ID=10 IF (ID.EQ.0) GO TO 1530 CALL FIND(VALUE(IFIELD+IFLD),ID,KINEL,0) KIDIN=ID GO TO 6000 1530 KOVAR=0 KINEL=0 WRITE (6,1131) IGOOF=0 GO TO 6000 1540 KOVAR=0 KINEL=0 WRITE (6,1541) 1541 FORMAT("0WARNING: ILLEGAL OUTPUT VARIABLE ... ANALYSIS OMITTED"/) IGOOF=0 GO TO 6000 C C OPERATING POINT C 1550 KSSOP=1 GO TO 6000 C C NOISE ANALYSIS C 1600 IFLD=2 IF (NODPLC(ICODE+IFLD).NE.1) GO TO 1610 CALL OUTDEF(IFLD,2,NOSOUT,NTYPE) IF (IGOOF.NE.0) GO TO 1610 IF (NTYPE.NE.1) GO TO 1610 IF (NODPLC(NOSOUT+5).NE.0) GO TO 1610 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.1) GO TO 1620 ANAM=VALUE(IFIELD+IFLD) CALL MOVE(ANAM,2,ABLNK,1,7) ID=0 IF (ANAM.EQ.AIDE(9)) ID=9 IF (ANAM.EQ.AIDE(10)) ID=10 IF (ID.EQ.0) GO TO 1620 CALL FIND(VALUE(IFIELD+IFLD),ID,NOSIN,0) NOSPRT=0 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1605 NOSPRT=AMAX1(0.0,VALUE(IFIELD+IFLD)) 1605 INOISE=1 GO TO 6000 1610 WRITE (6,1611) 1611 FORMAT("0WARNING: VOLTAGE OUTPUT UNRECOGNIZABLE ... ANALYSIS OMIT 1TED"/) IGOOF=0 GO TO 6000 1620 WRITE (6,1621) 1621 FORMAT("0WARNING: INVALID INPUT SOURCE ... ANALYSIS OMITTED"/) IGOOF=0 GO TO 6000 C C DISTORTION ANALYSIS C 1650 IFLD=2 IF (NODPLC(ICODE+IFLD).NE.1) GO TO 1660 ANAM=VALUE(IFIELD+IFLD) CALL MOVE(ANAM,2,ABLNK,1,7) IF (ANAM.NE.AIDE(1)) GO TO 1660 CALL FIND(VALUE(IFIELD+IFLD),1,IDIST,0) IDPRT=0 SKW2=0.9 REFPRL=1.0E-3 SPW2=1.0 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.0) GO TO 6000 IDPRT=VALUE(IFIELD+IFLD) IDPRT=MAX0(IDPRT,0) IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.0) GO TO 6000 IF (VALUE(IFIELD+IFLD).LE.0.001) GO TO 1670 IF (VALUE(IFIELD+IFLD).GT.0.999) GO TO 1670 SKW2=VALUE(IFIELD+IFLD) IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.0) GO TO 6000 IF (VALUE(IFIELD+IFLD).LT.1.0E-10) GO TO 1670 REFPRL=VALUE(IFIELD+IFLD) IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.0) GO TO 6000 IF (VALUE(IFIELD+IFLD).LT.0.001) GO TO 1670 SPW2=VALUE(IFIELD+IFLD) GO TO 6000 1660 WRITE (6,1661) 1661 FORMAT("0WARNING: DISTORTION LOAD RESISTOR MISSING ... ANALYSIS " 1 "OMITTED"/) GO TO 6000 1670 IDIST=0 WRITE (6,1671) 1671 FORMAT("0WARNING: DISTORTION PARAMETERS INCORRECT ... ANALYSIS O" 1 "MITTED"/) GO TO 6000 C C FOURIER ANALYSIS C 1700 IFLD=2 IF (NODPLC(ICODE+IFLD).NE.0) GO TO 1720 IF (VALUE(IFIELD+IFLD).LE.0.0) GO TO 1720 FORFRE=VALUE(IFIELD+IFLD) 1705 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.1) GO TO 1710 CALL OUTDEF(IFLD,2,LOCT,LTYPE) IF (IGOOF.NE.0) GO TO 1720 IF (LTYPE.NE.1) GO TO 1720 CALL EXTMEM(IFOUR,1) NFOUR=NFOUR+1 NODPLC(IFOUR+NFOUR)=LOCT GO TO 1705 1710 IF (NFOUR.GE.1) GO TO 6000 1720 WRITE (6,1721) 1721 FORMAT("0WARNING: FOURIER PARAMETERS INCORRECT ... ANALYSIS OMIT" 1 "TED"/) IGOOF=0 NFOUR=0 CALL CLRMEM(IFOUR) CALL GETMEM(IFOUR,0) GO TO 6000 C C SENSITIVITY ANALYSIS C 1750 KSSOP=1 IFLD=1 1760 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.1) GO TO 6000 CALL OUTDEF(IFLD,1,LOCT,LTYPE) IF (IGOOF.NE.0) GO TO 1780 IF (LTYPE.NE.1) GO TO 1780 CALL EXTMEM(ISENS,1) NSENS=NSENS+1 NODPLC(ISENS+NSENS)=LOCT GO TO 1760 1780 WRITE (6,1781) 1781 FORMAT("0WARNING: OUTPUT VARIABLE UNRECOGNIZABLE ... ANALYSIS OM" 1 "MITTED"/) IGOOF=0 NSENS=0 CALL CLRMEM(ISENS) CALL GETMEM(ISENS,0) GO TO 6000 C C TEMPERATURE VARIATION C 1800 IFLD=1 1810 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.0) GO TO 6000 IF (VALUE(IFIELD+IFLD).LE.-223.0) GO TO 1810 CALL EXTMEM(ITEMPS,1) NUMTEM=NUMTEM+1 VALUE(ITEMPS+NUMTEM)=VALUE(IFIELD+IFLD) GO TO 1810 C C OPTIONS CARD C 2000 IFLD=1 2010 IFLD=IFLD+1 2020 IF (NODPLC(ICODE+IFLD)) 6000,2010,2030 2030 ANAM=VALUE(IFIELD+IFLD) DO 2040 I=1,5 IF (ANAM.NE.AOPTS(I)) GO TO 2040 IPRNT(I)=LSETOP(I) GO TO 2010 2040 CONTINUE IF (ANAM.EQ.AOPTS(24)) GO TO 2110 IF (ANAM.EQ.AOPTS(25)) GO TO 2120 IF (NODPLC(ICODE+IFLD+1).NE.0) GO TO 2500 IFLD=IFLD+1 AVAL=VALUE(IFIELD+IFLD) IF (AVAL.LE.0.0) GO TO 2510 DO 2050 I=6,10 IF (ANAM.NE.AOPTS(I)) GO TO 2050 ITRLIM(I-5)=AVAL GO TO 2010 2050 CONTINUE DO 2060 I=11,14 IF (ANAM.NE.AOPTS(I)) GO TO 2060 LIMITS(I-10)=AVAL GO TO 2010 2060 CONTINUE DO 2070 I=15,20 IF (ANAM.NE.AOPTS(I)) GO TO 2070 CONTOL(I-14)=AVAL GO TO 2010 2070 CONTINUE IF (ANAM.NE.AOPTS(21)) GO TO 2080 IF (AVAL.LT.-223.0) GO TO 2510 VALUE(ITEMPS+1)=AVAL GO TO 2010 2080 IF (ANAM.NE.AOPTS(22)) GO TO 2100 NDIGIT=AVAL IF (NDIGIT.LE.7) GO TO 2090 NDIGIT=7 WRITE (6,2081) NDIGIT 2081 FORMAT("0WARNING: NUMDGT MAY NOT EXCEED"I2"; MAXIMUM VALUE ASSUM 1ED"/) 2090 NUMDGT=NDIGIT GO TO 2010 2100 IF (ANAM.NE.AOPTS(23)) GO TO 2500 N=AVAL IF ((N.LE.1).OR.(N.GE.7)) GO TO 2510 MAXORD=N GO TO 2010 2110 IF (NODPLC(ICODE+IFLD+1).NE.1) GO TO 2510 IFLD=IFLD+1 ANAM=VALUE(IFIELD+IFLD) CALL MOVE(ANAM,5,ABLNK,1,4) JTYPE=0 IF (ANAM.EQ.ATRAP) JTYPE=1 IF (ANAM.EQ.AGEAR) JTYPE=2 IF (JTYPE.EQ.0) GO TO 2510 METHOD=JTYPE GO TO 2010 2120 NOPAGE=1 GO TO 2010 2500 WRITE (6,2501) ANAM 2501 FORMAT("0WARNING: UNKNOWN OPTION: ",A8," ... IGNORED"/) GO TO 2010 2510 WRITE (6,2511) ANAM 2511 FORMAT("0WARNING: ILLEGAL VALUE SPECIFIED FOR OPTION: ",A8," ... 1 IGNORED"/) GO TO 2010 C C .PZ CARD C 2600 IFLD=2 IF (NODPLC(ICODE+IFLD).NE.1) GO TO 2650 CALL OUTDEF(IFLD,1,IPZOUT,KTYPE) IF (IGOOF.NE.0) GO TO 2650 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.1) GO TO 2650 ACHAR=VALUE(IFIELD+IFLD) CALL MOVE(ACHAR,2,ABLNK,1,7) IPZITP=0 IF (ACHAR.EQ.ALETV) IPZITP=9 IF (ACHAR.EQ.ALETI) IPZITP=10 IF (IPZITP.EQ.0) GO TO 2650 IF (VALUE(IDELIM+IFLD).NE.ALPRN) GO TO 2610 IF (IPZITP.EQ.9) GO TO 2620 IF (IPZITP.EQ.10) GO TO 2650 2610 CALL FIND(VALUE(IFIELD+IFLD),IPZITP,IPZIN,0) GO TO 2630 2620 CALL OUTDEF(IFLD,1,IPZIN,KTYPE) IF (IGOOF.NE.0) GO TO 2650 IPZITP=41 2630 JPZFLG=1 JPZTYP=1 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.1) GO TO 6000 AWRD=VALUE(IFIELD+IFLD) CALL MOVE(AWRD,4,ABLNK,1,5) ID=0 IF (AWRD.EQ.AMUL) ID=1 IF (AWRD.EQ.AADJ) ID=2 IF (ID.EQ.0) GO TO 2650 JPZTYP=ID GO TO 6000 C C ERRORS ... C 2650 WRITE (6,2651) 2651 FORMAT("0WARNING: ERROR(S) IN INPUT/OUTPUT SPEC ... LINE ", 1 "IGNORED",/) IGOOF=0 JPZFLG=0 GO TO 6000 C C PRINT CARD C 3500 IPRPL=0 GO TO 3610 C C PLOT (AND PRINT) CARD C 3600 IPRPL=1 3610 IFLD=2 3613 ANAM=AMISS IF (NODPLC(ICODE+IFLD).NE.1) GO TO 3950 ANAM=VALUE(IFIELD+IFLD) MS=0 IF (XOR(ANAM,AMS).NE.0) GO TO 3615 MS=1 IFLD=3 IF (NODPLC(ICODE+IFLD).NE.1) GO TO 3970 ANAM=VALUE(IFIELD+IFLD) 3615 CALL MOVE(ANAM,3,ABLNK,1,6) DO 3620 I=1,5 IF (ANAM.NE.AOPT(I)) GO TO 3620 KTYPE=I GO TO 3630 3620 CONTINUE GO TO 3950 3630 ID=30+5*IPRPL+KTYPE CALL FIND(FLOAT(JELCNT(ID)),ID,LOC,1) NODPLC(LOC+2)=KTYPE IF (MS.EQ.0) GO TO 3635 LOCV=NODPLC(LOC+1) VALUE(LOCV)=0.0 3635 NUMOUT=0 3640 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD)) 3900,3640,3650 3650 CALL OUTDEF(IFLD,KTYPE,LOCT,LTYPE) IF (IGOOF.NE.0) GO TO 3970 IF (IPRPL.EQ.0) GO TO 3660 PLIMLO=0.0 PLIMHI=0.0 IF (NODPLC(ICODE+IFLD+1).NE.0) GO TO 3660 IF (NODPLC(ICODE+IFLD+2).NE.0) GO TO 3660 PLIMLO=VALUE(IFIELD+IFLD+1) PLIMHI=VALUE(IFIELD+IFLD+2) IFLD=IFLD+2 3660 IF (NUMOUT.EQ.8) GO TO 3980 NUMOUT=NUMOUT+1 LSPOT=LOC+2*NUMOUT+2 NODPLC(LSPOT)=LOCT NODPLC(LSPOT+1)=LTYPE IF (IPRPL.EQ.0) GO TO 3670 LOCV=NODPLC(LOC+1) LSPOT=LOCV+2*NUMOUT-1 VALUE(LSPOT)=PLIMLO VALUE(LSPOT+1)=PLIMHI 3670 GO TO 3640 3900 NODPLC(LOC+3)=NUMOUT IF (IPRPL.EQ.0) GO TO 6000 C... PROPOGATE PLOT LIMITS DOWNWARD IF (NUMOUT.LE.1) GO TO 6000 LOCV=NODPLC(LOC+1) LSPOT=LOCV+2*NUMOUT-1 PLIMLO=VALUE(LSPOT) PLIMHI=VALUE(LSPOT+1) I=NUMOUT-1 3905 LSPOT=LSPOT-2 IF (VALUE(LSPOT).NE.0.0) GO TO 3910 IF (VALUE(LSPOT+1).NE.0.0) GO TO 3910 VALUE(LSPOT)=PLIMLO VALUE(LSPOT+1)=PLIMHI GO TO 3920 3910 PLIMLO=VALUE(LSPOT) PLIMHI=VALUE(LSPOT+1) 3920 I=I-1 IF (I.GE.1) GO TO 3905 GO TO 6000 C C ERRORS C 3950 WRITE (6,3951) ANAM 3951 FORMAT("0WARNING: UNKNOWN ANALYSIS MODE: "A8" ... LINE IGNORED"/ 1) GO TO 6000 3970 WRITE (6,3971) 3971 FORMAT("0WARNING: UNRECOGNIZABLE OUTPUT VARIABLE ON ABOVE LINE"/) IGOOF=0 GO TO 3640 3980 WRITE (6,3981) 3981 FORMAT("0WARNING: ONLY FIRST 8 OUTPUT VARIABLES USED ON ABOVE ", 1 "LINE"/) GO TO 3900 C C WIDTH CARD C 4000 IFLD=1 4010 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD).NE.1) GO TO 6000 4020 ANAM=VALUE(IFIELD+IFLD) IF (ANAM.NE.AIN) GO TO 4040 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD)) 6000,4030,4020 4030 IWIDTH=VALUE(IFIELD+IFLD) IWIDTH=MIN0(MAX0(IWIDTH,10),120) GO TO 4010 4040 IF (ANAM.NE.AOUT) GO TO 6000 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD)) 6000,4050,4020 4050 LWIDTH=AMIN1(AMAX1(VALUE(IFIELD+IFLD),72.0),132.0) GO TO 4010 C C DEBUG STATEMENT C 5900 IFLD=1 5910 IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD)) 6000,5920,5910 5920 INDEX=VALUE(IFIELD+IFLD) IFLD=IFLD+1 IF (NODPLC(ICODE+IFLD)) 6000,5930,5910 5930 IVAL=VALUE(IFIELD+IFLD) IF (INDEX.LT.1) GO TO 5910 IF (INDEX.GT.20) GO TO 5910 WRITE (6,5931) INDEX,IVAL 5931 FORMAT(" *DEBUG*: RUNCON - IDEBUG(",I2,") SET TO ",I10) IDEBUG(INDEX)=IVAL GO TO 5910 C C FINISHED C 6000 RETURN END SUBROUTINE OUTDEF(IFLD,MODE,LOCT,LTYPE) C C THIS ROUTINE CONSTRUCTS THE INTERNAL LIST ELEMENT FOR AN OUTPUT C VARIABLE DEFINED ON SOME INPUT CARD. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C INTEGER XOR DIMENSION AOUT(19),AOPTS(5) DATA AOUT / 4HV , 4HVM , 4HVR , 4HVI , 4HVP , 4HVDB , 1 4HI , 4HIM , 4HIR , 4HII , 4HIP , 4HIDB , 2 4HONOI, 4HINOI, 4HHD2 , 4HHD3 , 4HDIM2, 4HSIM2, 3 4HDIM3 / DATA AOPTS / 1HM, 1HR, 1HI, 1HP, 1HD / DATA ALPRN, ACOMMA, ABLNK, ALETV / 1H(, 1H,, 1H , 1HV / C IF (NODPLC(ICODE+IFLD).NE.1) GO TO 300 ANAM=VALUE(IFIELD+IFLD) CALL MOVE(ANAM,5,ABLNK,1,4) DO 10 I=1,19 IF (XOR(ANAM,AOUT(I)).NE.0) GO TO 10 IDOUT=I GO TO 20 10 CONTINUE GO TO 300 C C FURTHER ERROR CHECKING C 20 IF (MODE.GE.3) GO TO 25 C... DC OR TRAN IF ((IDOUT.NE.1).AND.(IDOUT.NE.7)) GO TO 300 GO TO 38 25 IF (MODE.GE.4) GO TO 30 C... AC IF (IDOUT.GE.13) GO TO 300 GO TO 38 30 IF (MODE.EQ.5) GO TO 35 C... NOISE IF ((IDOUT.NE.13).AND.(IDOUT.NE.14)) GO TO 300 GO TO 38 C... DISTORTION 35 IF (IDOUT.LT.15) GO TO 300 38 KTYPE=0 LTYPE=IDOUT IF (IDOUT.LT.7) GO TO 40 KTYPE=1 LTYPE=LTYPE-6 IF (IDOUT.LT.13) GO TO 40 KTYPE=IDOUT-11 LTYPE=1 C C VOLTAGE OUTPUT C 40 ID=40+MODE IF (KTYPE.NE.0) GO TO 100 IF (NODPLC(ICODE+IFLD+1).NE.0) GO TO 300 IFLD=IFLD+1 N1=VALUE(IFIELD+IFLD) IF (N1.LT.0) GO TO 300 N2=0 ADELIM=VALUE(IDELIM+IFLD) IF (ADELIM.EQ.ACOMMA) GO TO 45 IF (ADELIM.NE.ABLNK) GO TO 50 45 IF (NODPLC(ICODE+IFLD+1).NE.0) GO TO 300 IFLD=IFLD+1 N2=VALUE(IFIELD+IFLD) IF (N2.LT.0) GO TO 300 50 OUTNAM=0.0 CALL MOVE(OUTNAM,1,N1*10000B,5,4) CALL MOVE(OUTNAM,5,N2*10000B,5,4) CALL FIND(OUTNAM,ID,LOCT,0) NODPLC(LOCT+2)=N1 NODPLC(LOCT+3)=N2 GO TO 400 C C CURRENT OUTPUT C 100 IF (KTYPE.NE.1) GO TO 200 IF (NODPLC(ICODE+IFLD+1).NE.1) GO TO 300 IFLD=IFLD+1 AVSRC=VALUE(IFIELD+IFLD) ACHEK=AVSRC CALL MOVE(ACHEK,2,ABLNK,1,7) IF (ACHEK.NE.ALETV) GO TO 300 CALL FIND(AVSRC,ID,LOCT,0) CALL FIND(AVSRC,9,NODPLC(LOCT+2),0) NODPLC(LOCT+5)=1 GO TO 400 C C NOISE OR DISTORTION OUTPUTS C 200 ID=44 IF (KTYPE.GE.4) ID=ID+1 IF (VALUE(IDELIM+IFLD).NE.ALPRN) GO TO 220 IF (NODPLC(ICODE+IFLD+1).NE.1) GO TO 300 IFLD=IFLD+1 ATYPE=VALUE(IFIELD+IFLD) CALL MOVE(ATYPE,2,ABLNK,1,7) DO 210 I=1,5 IF (ATYPE.NE.AOPTS(I)) GO TO 210 LTYPE=I+1 GO TO 220 210 CONTINUE GO TO 300 220 CALL FIND(ANAM,ID,LOCT,0) NODPLC(LOCT+2)=0 NODPLC(LOCT+5)=KTYPE GO TO 400 C C ERRORS C 300 IGOOF=1 C C FINISHED C 400 RETURN END SUBROUTINE CARD C C THIS ROUTINE SCANS THE INPUT LINES, STORING EACH FIELD INTO THE C TABLES IFIELD, IDELIM, ICOLUM, AND ICODE. WITH THE EXCEPTION OF THE C ".END" LINE, CARD ALWAYS READS THE NEXT LINE TO CHECK FOR A POSSIBLE C CONTINUATION BEFORE IT EXITS. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /MISCEL/ APROG(3),ATIME,ADATE,ATITLE(15),RSTATS(50), 1 IWIDTH,LWIDTH,NOPAGE COMMON /LINE/ ACHAR,AFIELD(15),OLDLIN(15),KNTRC,KNTLIM COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /KNSTNT/ TWOPI,XLOG2,XLOG10,ROOT2,RAD,BOLTZ,CHARGE,CTOK, 1 GMIN,RELTOL,ABSTOL,VNTOL,TRTOL,CHGTOL,EPS0,EPSSIL,EPSOX COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C DIMENSION ADIGIT(10) DATA ADIGIT / 1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9 / DATA ABLNK,APER,APLUS,AMINUS,ASTK / 1H , 1H., 1H+, 1H-, 1H* / DATA AG,AK,AU,AN,AP,AE,AM / 1HG,1HK,1HU,1HN,1HP,1HE,1HM / DATA AF, AI / 1HF, 1HI / DATA ALPRN, ARPRN / 1H(, 1H) / DATA AEND / 4H.END / C C NOTE: THE VALUE OF THE FUNCTION *NXTCHR* (USED EXTENSIVELY IN C THIS ROUTINE) IS AS FOLLOWS: C C <0: END-OF-LINE C =0: DELIMITER FOUND C >0: NON-DELIMITER FOUND C NUMFLD=0 NOFLD=15 GO TO 20 C C READ NEXT CARD C 10 NOFLD=15 CALL GETLIN IF (KEOF.EQ.0) GO TO 20 C... ERROR: UNEXPECTED END-OF-FILE CONDITION ON INPUT 15 KEOF=1 NOFLD=1 NUMFLD=0 IGOOF=1 WRITE (6,16) 16 FORMAT("0*ERROR*: .END CARD MISSING"/) GO TO 1000 C C ELIMINATE TRAILING BLANKS RAPIDLY C 20 IF (AFIELD(NOFLD).NE.ABLNK) GO TO 40 IF (NOFLD.EQ.1) GO TO 30 NOFLD=NOFLD-1 GO TO 20 C... WRITE BLANK CARD 30 WRITE (6,31) 31 FORMAT(1X) GO TO 10 C... COPY THE CARD TO OUTPUT LISTING 40 WRITE (6,41) (AFIELD(I),I=1,NOFLD) 41 FORMAT(1X,15A8) C C INITIALIZATION FOR NEW CARD C 45 KNTRC=0 KNTLIM=MIN0(8*NOFLD,IWIDTH) C C FETCH FIRST NON-DELIMITER (SEE ROUTINE *NXTCHR* FOR LIST) C 50 IF (NXTCHR(0)) 600,50,60 C... CHECK FOR COMMENT (LEADING ASTERISK) 60 IF (ACHAR.EQ.ASTK) GO TO 10 GO TO 100 C C FETCH NEXT CHARACTER C 70 IF (NXTCHR(0)) 600,80,100 C C TWO CONSECUTIVE DELIMITERS IMPLY NUMERIC ZERO UNLESS THE DELIMITER C IS A BLANK OR PARENTHESIS. C 80 IF (ACHAR.EQ.ABLNK) GO TO 70 IF (ACHAR.EQ.ALPRN) GO TO 70 IF (ACHAR.EQ.ARPRN) GO TO 70 C... CHECK FOR SUFFICIENT SPACE IN STORAGE ARRAYS IF (NUMFLD.LT.INSIZE-1) GO TO 90 CALL EXTMEM(IFIELD,50) CALL EXTMEM(ICODE,50) CALL EXTMEM(IDELIM,50) CALL EXTMEM(ICOLUM,50) INSIZE=INSIZE+50 90 NUMFLD=NUMFLD+1 VALUE(IFIELD+NUMFLD)=0.0 NODPLC(ICODE+NUMFLD)=0 VALUE(IDELIM+NUMFLD)=ACHAR NODPLC(ICOLUM+NUMFLD)=KNTRC GO TO 70 C C CHECK FOR SUFFICIENT SPACE IN STORAGE ARRAYS C 100 IF (NUMFLD.LT.INSIZE-1) GO TO 110 CALL EXTMEM(IFIELD,50) CALL EXTMEM(ICODE,50) CALL EXTMEM(IDELIM,50) CALL EXTMEM(ICOLUM,50) INSIZE=INSIZE+50 C C BEGIN SCAN OF NEXT FIELD C C... INITIALIZATION 110 JDELIM=0 XSIGN=1.0 XMANT=0.0 IDEC=0 IEXP=0 C... CHECK FOR LEADING PLUS OR MINUS SIGN IF (ACHAR.EQ.APLUS) GO TO 210 IF (ACHAR.EQ.AMINUS) GO TO 200 C... FINISH INITIALIZATION ANAM=ABLNK KCHR=1 C... AN ISOLATED PERIOD INDICATES THAT A CONTINUATION CARD FOLLOWS IF (ACHAR.NE.APER) GO TO 120 C... ALTER INITIALIZATION SLIGHTLY IF LEADING PERIOD FOUND IDEC=1 IEXP=-1 ANAM=APER KCHR=2 C... NOW TAKE A LOOK AT THE NEXT CHARACTER IF (NXTCHR(0)) 10,10,120 C C TEST FOR NUMBER (ANY DIGIT) C 120 DO 130 I=1,10 IF (ACHAR.NE.ADIGIT(I)) GO TO 130 XMANT=FLOAT(I-1) GO TO 210 130 CONTINUE C C ASSEMBLE NAME C NUMFLD=NUMFLD+1 CALL MOVE(ANAM,KCHR,ACHAR,1,1) KCHR=KCHR+1 DO 150 I=KCHR,8 IF (NXTCHR(0)) 160,160,140 140 CALL MOVE(ANAM,I,ACHAR,1,1) 150 CONTINUE GO TO 170 160 JDELIM=1 170 VALUE(IFIELD+NUMFLD)=ANAM NODPLC(ICODE+NUMFLD)=1 NODPLC(ICOLUM+NUMFLD)=KNTRC C... NO "+" FORMAT CONTINUATION POSSIBLE FOR .END CARD IF (NUMFLD.GE.2) GO TO 400 IF (ANAM.NE.AEND) GO TO 400 NODPLC(ICODE+NUMFLD+1)=-1 GO TO 1000 C C PROCESS NUMBER C C... TAKE NOTE OF LEADING MINUS SIGN 200 XSIGN=-1.0 C... TAKE A LOOK AT THE NEXT CHARACTER 210 IF (NXTCHR(0)) 335,335,220 C... TEST FOR DIGIT 220 DO 230 I=1,10 IF (ACHAR.NE.ADIGIT(I)) GO TO 230 XMANT=XMANT*10.0+FLOAT(I-1) IF (IDEC.EQ.0) GO TO 210 IEXP=IEXP-1 GO TO 210 230 CONTINUE C C CHECK FOR DECIMAL POINT C IF (ACHAR.NE.APER) GO TO 240 C... MAKE CERTAIN THAT THIS IS THE FIRST ONE FOUND IF (IDEC.NE.0) GO TO 500 IDEC=1 GO TO 210 C C TEST FOR EXPONENT C 240 IF (ACHAR.NE.AE) GO TO 300 IF (NXTCHR(0)) 335,335,250 250 ITEMP=0 ISIGN=1 C... CHECK FOR POSSIBLE LEADING SIGN ON EXPONENT IF (ACHAR.EQ.APLUS) GO TO 260 IF (ACHAR.NE.AMINUS) GO TO 270 ISIGN=-1 260 IF (NXTCHR(0)) 285,285,270 C... TEST FOR DIGIT 270 DO 280 I=1,10 IF (ACHAR.NE.ADIGIT(I)) GO TO 280 ITEMP=ITEMP*10+I-1 GO TO 260 280 CONTINUE GO TO 290 285 JDELIM=1 C... CORRECT INTERNAL EXPONENT 290 IEXP=IEXP+ISIGN*ITEMP GO TO 340 C C TEST FOR SCALE FACTOR C 300 IF (ACHAR.NE.AM) GO TO 330 C... SPECIAL CHECK FOR *ME* (AS DISTINGUISHED FROM *M*) IF (NXTCHR(0)) 320,320,310 310 IF (ACHAR.NE.AE) GO TO 315 IEXP=IEXP+6 GO TO 340 315 IF (ACHAR.NE.AI) GO TO 325 XMANT=XMANT*25.4E-4 GO TO 340 320 JDELIM=1 325 IEXP=IEXP-3 GO TO 340 330 IF (ACHAR.EQ.AG) IEXP=IEXP+9 IF (ACHAR.EQ.AK) IEXP=IEXP+3 IF (ACHAR.EQ.AU) IEXP=IEXP-6 IF (ACHAR.EQ.AN) IEXP=IEXP-9 IF (ACHAR.EQ.AP) IEXP=IEXP-12 IF (ACHAR.EQ.AF) IEXP=IEXP-15 GO TO 340 335 JDELIM=1 C C ASSEMBLE THE FINAL NUMBER C 340 IF (XMANT.EQ.0.0) GO TO 350 IF (IEXP.EQ.0) GO TO 350 IF (IABS(IEXP).GE.201) GO TO 500 XMANT=XMANT*EXP(FLOAT(IEXP)*XLOG10) IF (XMANT.GT.1.0E+200) GO TO 500 IF (XMANT.LT.1.0E-200) GO TO 500 350 NUMFLD=NUMFLD+1 VALUE(IFIELD+NUMFLD)=SIGN(XMANT,XSIGN) NODPLC(ICODE+NUMFLD)=0 NODPLC(ICOLUM+NUMFLD)=KNTRC C C SKIP TO NON-BLANK DELIMITER (IF NECESSARY) C 400 IF (JDELIM.EQ.0) GO TO 440 410 VALUE(IDELIM+NUMFLD)=ACHAR IF (ACHAR.NE.ABLNK) GO TO 70 IF (NXTCHR(0)) 450,410,420 420 KNTRC=KNTRC-1 GO TO 70 440 IF (NXTCHR(0)) 450,410,440 450 VALUE(IDELIM+NUMFLD)=ACHAR GO TO 600 C C ERRORS C 500 WRITE (6,501) KNTRC 501 FORMAT("0*ERROR*: ILLEGAL NUMBER -- SCAN STOPPED AT COLUMN ",I3/) IGOOF=1 NUMFLD=NUMFLD+1 VALUE(IFIELD+NUMFLD)=0.0 NODPLC(ICODE+NUMFLD)=0 VALUE(IDELIM+NUMFLD)=ACHAR NODPLC(ICOLUM+NUMFLD)=KNTRC C C FINISHED C 600 NODPLC(ICODE+NUMFLD+1)=-1 C C CHECK NEXT LINE FOR POSSIBLE CONTINUATION C 610 CALL GETLIN IF (KEOF.EQ.1) GO TO 15 C... CONTINUATION DENOTED BY "+" IN COLUMN 1 OF FOLLOWING CARD CALL MOVE(ACHAR,1,AFIELD,1,1) NOFLD=15 620 IF (AFIELD(NOFLD).NE.ABLNK) GO TO 630 IF (NOFLD.EQ.1) GO TO 650 NOFLD=NOFLD-1 GO TO 620 630 IF (ACHAR.NE.APLUS) GO TO 640 WRITE (6,41) (AFIELD(I),I=1,NOFLD) KNTRC=1 KNTLIM=MIN0(8*NOFLD,IWIDTH) GO TO 70 640 IF (ACHAR.NE.ASTK) GO TO 1000 650 WRITE (6,41) (AFIELD(I),I=1,NOFLD) GO TO 610 1000 RETURN END SUBROUTINE GETLIN C C THIS ROUTINE READS THE NEXT LINE OF INPUT INTO THE ARRAY AFIELD. C IF END-OF-FILE IS FOUND, THE VARIABLE KEOF IS SET TO 1. C COMMON /LINE/ ACHAR,AFIELD(15),OLDLIN(15),KNTRC,KNTLIM COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF C C CALL COPY8(AFIELD,OLDLIN,15) READ (5,6) AFIELD 6 FORMAT(15A8) IF (EOF(5)) 10,100,10 10 KEOF=1 100 RETURN END IDENT NXTCHR ENTRY NXTCHR TITLE DETERMINE TYPE OF NEXT CHARACTER IN CURRENT INPUT LINE TITLE EQUIVALENT FORTRAN DECK LISTING LIST F FORTRAN IFC NE,*FORTRAN*FORTRAN* FUNCTION NXTCHR(INT) C C THIS ROUTINE ADVANCES THE CURRENT LINE SCAN POSITION BY ONE COLUMN C AND CHECKS WHETHER OR NOT THE NEXT CHARACTER IS A DELIMITER. C COMMON /LINE/ ACHAR,AFIELD(15),OLDLIN(15),KNTRC,KNTLIM C DIMENSION ADELIM(5) DATA ADELIM / 1H , 1H,, 1H=, 1H(, 1H) / DATA ABLNK / 1H / C KNTRC=KNTRC+1 IF (KNTRC.GT.KNTLIM) GO TO 30 CALL MOVE(ACHAR,1,AFIELD,KNTRC,1) DO 10 I=1,5 IF (ACHAR.EQ.ADELIM(I)) GO TO 20 10 CONTINUE C C NON-DELIMITER C NXTCHR=1 RETURN C C DELIMITER C 20 NXTCHR=0 RETURN C C END-OF-LINE C 30 NXTCHR=-1 ACHAR=ABLNK RETURN * END FORTRAN ENDIF LIST -F *CALL,ASMARG TITLE DECLARATIONS AND LOCAL VARIABLES USE /LINE/ SPACE 1 ACHAR BSS 1 NEXT CHARACTER, IN 1H FORMAT AFIELD BSS 15 CURRENT INPUT LINE, IN A8 FORMAT OLDLIN BSS 15 PREVIOUS INPUT LINE KNTRC BSS 1 CARD COLUMN COUNTER KNTLIM BSS 1 LAST CHARACTER POSITION WORTH LOOKING AT SPACE 1 USE 0 SPACE 5 BITFLG VFD 60/1S41+1S42+1S44+1S45+1S46 * BIT FLAG FOR CHARACTERS ()= , TITLE THE REAL THING EOL SA1 =1H SET ACHAR TO * * ON END-OF-LINE BX7 X1 . SA7 ACHAR . SPACE 1 NXTCHR BSS 1 ENTRY/EXIT SPACE 1 SB7 1 USEFUL CONSTANT SPACE 1 SA1 KNTRC INCREMENT KNTRC SX7 X1+B7 . SA7 A1 . DONE SPACE 1 SA2 A1+B7 FETCH KNTLIM IX6 X2-X7 COMPUTE KNTLIM-KNTRC NG X6,EOL EXIT IF RESULT<0 (END-OF-LINE FOUND) SPACE 1 RUN IFC EQ,*"COMPILER"*RUN* SB1 ACHAR CALL MOVE(ACHAR,1,AFIELD,KNTRC,1) SB2 =1 . SB3 AFIELD . SB4 A1+0 . SB5 B2+0 . RJ =XMOVE . DONE RUN ENDIF SPACE 1 FTN IFC EQ,*"COMPILER"*FTN* SA1 ARGLST CALL MOVE(ACHAR,1,AFIELD,KNTRC,1) RJ =XMOVE . SPACE 4 USE ARGLST ARGLST VFD 60/ACHAR ARGUMENT LIST VFD 60/=1 . VFD 60/AFIELD . VFD 60/KNTRC . VFD 60/=1 . VFD 60/0 . USE * SPACE 4 FTN ENDIF SPACE 1 SA1 ACHAR GET THE NEXT CHARACTER INTO B1 MX0 6 . ONE-CHARACTER MASK BX1 X0*X1 . ISOLATE THE CHARACTER LX1 6 . MOVE TO WORKABLE POSITION SB1 X1 . DO THE LOAD SPACE 1 SA1 BITFLG FETCH THE BIT-FLAG WORD SX6 1 ASSUME CHARACTER IS NON-DELIMITER AX1 B1,X1 OH, SWING TO THE RIGHT LX1 59 AND SWING TO THE LEFT PL X1,NXTCHR EXIT -- BIT NOT PRESENT SX6 0 CHARACTER IS A DELIMITER -- RETURN WITH 0 EQ NXTCHR EXIT END OVERLAY(2,0) PROGRAM ERRCHK C C THIS ROUTINE DRIVES THE PRE-PROCESSING AND GENERAL ERROR-CHECKING C OF INPUT PERFORMED BY SPICE. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /MISCEL/ APROG(3),ATIME,ADATE,ATITLE(15),RSTATS(50), 1 IWIDTH,LWIDTH,NOPAGE COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET, 1 MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO, 2 ITEMNO,NOSOLV,MODAC COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /KNSTNT/ TWOPI,XLOG2,XLOG10,ROOT2,RAD,BOLTZ,CHARGE,CTOK, 1 GMIN,RELTOL,ABSTOL,VNTOL,TRTOL,CHGTOL,EPS0,EPSSIL,EPSOX COMMON /DC/ TCSTAR,TCSTOP,TCINCR,ICVFLG,ITCELM,KSSOP,KINEL,KIDIN, 1 KOVAR,KIDOUT COMMON /AC/ FSTART,FSTOP,FINCR,SKW2,REFPRL,SPW2,JACFLG,IDFREQ, 1 INOISE,NOSPRT,NOSOUT,NOSIN,IDIST,IDPRT,JPZFLG,JPZTYP, 2 IPZIN,IPZITP,IPZOUT,IPZEQO,IPZLOC(2),IPZEQI,IPOMAT(3), 3 IPIMAT(4) COMMON /TRAN/ TSTEP,TSTOP,TSTART,DELMAX,TDMAX,FORFRE,JTRFLG COMMON /OUTINF/ STRING(15),YVAR(8),XSTART,XINCR,ITAB(8),ITYPE(8), 1 ILOGY(8),NPOINT,NUMOUT,KNTR,NUMDGT COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C DIMENSION TITLOP(4) DIMENSION NNODS(50),ANAME(2) DATA ANAME / 4HTRAP, 4HGEAR / DATA TITLOP / 8HOPTION S, 8HUMMARY , 8H , 8H / DATA NDEFIN / 2H.U / DATA NNODS / 2, 2, 2, 0, 2, 2, 2, 2, 2, 2, 1 2, 3, 3, 4, 0, 0, 4, 0, 1, 0, 2 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4 2, 2, 2, 0, 0, 0, 0, 0, 0, 0 / DATA AELMT,AMODEL,AOUTPT /7HELEMENT,5HMODEL,6HOUTPUT/ DATA ALSDC,ALSTR,ALSAC / 2HDC, 4HTRAN, 2HAC / C C CALL SECOND(T1) DO 60 ID=1,50 LOC=LOCATE(ID) 10 IF (LOC.EQ.0) GO TO 60 IF (NODPLC(LOC+2).NE.NDEFIN) GO TO 50 NOGO=1 LOCV=NODPLC(LOC+1) IF (ID.GE.21) GO TO 20 ANAM=AELMT GO TO 40 20 IF (ID.GE.31) GO TO 30 ANAM=AMODEL GO TO 40 30 ANAM=AOUTPT 40 WRITE (6,41) ANAM,VALUE(LOCV) 41 FORMAT("0*ERROR*: ",2A8," HAS BEEN REFERENCED BUT NOT DEFINED"/) 50 LOC=NODPLC(LOC) GO TO 10 60 CONTINUE IF (NOGO.NE.0) GO TO 2000 C C CONSTRUCT ORDERED LIST OF USER SPECIFIED NODES C CALL GETMEM(JUNODE,1) NODPLC(JUNODE+1)=0 NUNODS=1 DO 180 ID=1,50 IF (NNODS(ID).EQ.0) GO TO 180 LOC=LOCATE(ID) 110 IF (LOC.EQ.0) GO TO 180 IF (ID.LE.4) GO TO 120 IF (ID.LE.8) GO TO 150 IF (ID.EQ.19) GO TO 165 IF (ID.LE.40) GO TO 120 IF (ID.LE.43) GO TO 170 120 JSTOP=LOC+NNODS(ID)-1 DO 130 J=LOC,JSTOP CALL PUTNOD(NODPLC(J+2)) 130 CONTINUE GO TO 170 150 CALL PUTNOD(NODPLC(LOC+2)) CALL PUTNOD(NODPLC(LOC+3)) IF (ID.GE.7) GO TO 170 LOCP=NODPLC(LOC+ID+1) NSNOD=2*NODPLC(LOC+4) 155 DO 160 J=1,NSNOD CALL PUTNOD(NODPLC(LOCP+J)) 160 CONTINUE GO TO 170 165 LOCP=NODPLC(LOC+2) CALL SIZMEM(NODPLC(LOC+2),NSNOD) GO TO 155 170 LOC=NODPLC(LOC) GO TO 110 180 CONTINUE IF (NOGO.NE.0) GO TO 2000 NCNODS=NUNODS C C ASSIGN PROGRAM NODES C 200 DO 280 ID=1,50 IF (NNODS(ID).EQ.0) GO TO 280 LOC=LOCATE(ID) 210 IF (LOC.EQ.0) GO TO 280 IF (ID.LE.4) GO TO 220 IF (ID.LE.8) GO TO 250 IF (ID.EQ.19) GO TO 265 IF (ID.LE.40) GO TO 220 IF (ID.LE.43) GO TO 240 220 JSTOP=LOC+NNODS(ID)-1 DO 230 J=LOC,JSTOP CALL GETNOD(NODPLC(J+2)) 230 CONTINUE GO TO 270 240 IF (NODPLC(LOC+5).EQ.0) GO TO 220 GO TO 270 250 CALL GETNOD(NODPLC(LOC+2)) CALL GETNOD(NODPLC(LOC+3)) IF (ID.GE.7) GO TO 270 LOCP=NODPLC(LOC+ID+1) NSNOD=2*NODPLC(LOC+4) 255 DO 260 J=1,NSNOD CALL GETNOD(NODPLC(LOCP+J)) 260 CONTINUE GO TO 270 265 LOCP=NODPLC(LOC+2) CALL SIZMEM(NODPLC(LOC+2),NSNOD) GO TO 255 270 LOC=NODPLC(LOC) GO TO 210 280 CONTINUE IF (NOGO.NE.0) GO TO 2000 C C EXPAND SUBCIRCUIT CALLS C CALL SUBCKT IF (NOGO.NE.0) GO TO 2000 IF (NCNODS.GE.2) GO TO 400 WRITE (6,321) 321 FORMAT("0*ERROR*: CIRCUIT HAS NO NODES"/) NOGO=1 GO TO 2000 400 NUMNOD=NCNODS C C LINK UNSATISFIED REFERENCES C CALL LNKREF IF (NOGO.NE.0) GO TO 2000 C C GENERATE SUBCIRCUIT ELEMENT NAMES C IF (JELCNT(19).EQ.0) GO TO 600 DO 520 ID=1,24 LOC=LOCATE(ID) 510 IF (LOC.EQ.0) GO TO 520 CALL SUBNAM(LOC) LOC=NODPLC(LOC) GO TO 510 520 CONTINUE C C PROCESS SOURCES C 600 IF (JTRFLG.EQ.0) GO TO 700 DO 690 ID=9,10 LOC=LOCATE(ID) 610 IF (LOC.EQ.0) GO TO 690 LOCV=NODPLC(LOC+1) LOCP=NODPLC(LOC+5) JTYPE=NODPLC(LOC+4)+1 GO TO (680,620,630,640,650,675), JTYPE 620 VALUE(LOCP+3)=AMAX1(VALUE(LOCP+3),0.0) IF (VALUE(LOCP+4).LE.0.0) VALUE(LOCP+4)=TSTEP IF (VALUE(LOCP+5).LE.0.0) VALUE(LOCP+5)=TSTEP IF (VALUE(LOCP+6).LE.0.0) VALUE(LOCP+6)=TSTOP IF (VALUE(LOCP+7).LE.0.0) VALUE(LOCP+7)=TSTOP TEMP=VALUE(LOCP+4)+VALUE(LOCP+5)+VALUE(LOCP+6) VALUE(LOCP+7)=AMAX1(VALUE(LOCP+7),TEMP) VALUE(LOCV+1)=VALUE(LOCP+1) GO TO 680 630 IF (VALUE(LOCP+3).LE.0.0) VALUE(LOCP+3)=1.0/TSTOP DELMAX=AMIN1(DELMAX,0.04/VALUE(LOCP+3)) VALUE(LOCP+4)=AMAX1(VALUE(LOCP+4),0.0) VALUE(LOCV+1)=VALUE(LOCP+1) GO TO 680 640 VALUE(LOCP+3)=AMAX1(VALUE(LOCP+3),0.0) IF (VALUE(LOCP+4).LE.0.0) VALUE(LOCP+4)=TSTEP DELMAX=AMIN1(DELMAX,0.20/VALUE(LOCP+4)) IF (VALUE(LOCP+5).LE.VALUE(LOCP+3)) 1 VALUE(LOCP+5)=VALUE(LOCP+3)+TSTEP IF (VALUE(LOCP+6).LE.0.0) VALUE(LOCP+6)=TSTEP DELMAX=AMIN1(DELMAX,0.20/VALUE(LOCP+6)) VALUE(LOCV+1)=VALUE(LOCP+1) GO TO 680 650 VALUE(LOCP+1)=AMIN1(AMAX1(VALUE(LOCP+1),0.0),TSTOP) IKNT=1 CALL SIZMEM(NODPLC(LOC+5),NUMP) 660 TEMP=VALUE(LOCP+IKNT) IF (VALUE(LOCP+IKNT+2).EQ.0.0) GO TO 670 IF (VALUE(LOCP+IKNT+2).GE.TSTOP) GO TO 670 IF (VALUE(LOCP+IKNT+2).GT.TEMP) GO TO 665 NOGO=1 WRITE (6,661) VALUE(LOCV) 661 FORMAT("0*ERROR*: PWL SPECIFICATION FOR INDEPENDENT SOURCE ",A8, 1 /,11X,"INDICATES A TRANSITION IN <= 0 TIME",/) GO TO 680 665 IKNT=IKNT+2 IF (IKNT.LT.NUMP) GO TO 660 670 VALUE(LOCP+IKNT+2)=TSTOP VALUE(LOCV+1)=VALUE(LOCP+2) CALL RELMEM(NODPLC(LOC+5),NUMP-IKNT-3) GO TO 680 675 IF (VALUE(LOCP+3).LE.0.0) VALUE(LOCP+3)=1.0/TSTOP DELMAX=AMIN1(DELMAX,0.04/VALUE(LOCP+3)) IF (VALUE(LOCP+5).LE.0.0) VALUE(LOCP+5)=1.0/TSTOP DELMAX=AMIN1(DELMAX,0.20/VALUE(LOCP+5)) VALUE(LOCV+1)=VALUE(LOCP+1) 680 LOC=NODPLC(LOC) GO TO 610 690 CONTINUE C C PRINT LISTING OF ELEMENTS, PROCESS DEVICE MODELS, C AND CHECK TOPOLOGY C 700 IF (IPRNTL.EQ.0) GO TO 710 CALL ELPRNT 710 CALL MODCHK CALL TOPCHK IF (NOGO.NE.0) GO TO 2000 C C INVERT RESISTANCE VALUES C 800 LOC=LOCATE(1) 810 IF (LOC.EQ.0) GO TO 900 LOCV=NODPLC(LOC+1) VALUE(LOCV+1)=1.0/VALUE(LOCV+2) LOC=NODPLC(LOC) GO TO 810 C C PROCESS MUTUAL INDUCTORS C 900 LOC=LOCATE(4) 910 IF (LOC.EQ.0) GO TO 1000 LOCV=NODPLC(LOC+1) LPTR1=NODPLC(LOC+2) LPTR1=NODPLC(LPTR1+1) LPTR2=NODPLC(LOC+3) LPTR2=NODPLC(LPTR2+1) VALUE(LOCV+1)=VALUE(LOCV+1)*SQRT(VALUE(LPTR1+1)*VALUE(LPTR2+1)) LOC=NODPLC(LOC) GO TO 910 C C LIMIT DELMAX IF TRANSMISSION LINES IN CIRCUIT C 1000 IF (JTRFLG.EQ.0) GO TO 1200 TDMAX=0.0 LOC=LOCATE(17) 1010 IF (LOC.EQ.0) GO TO 1200 LOCV=NODPLC(LOC+1) DELMAX=AMIN1(DELMAX,VALUE(LOCV+2)) TDMAX=AMAX1(TDMAX,VALUE(LOCV+2)) LOC=NODPLC(LOC) GO TO 1010 C C PROCESS SOURCE PARAMETERS C 1200 NUMBKP=0 IF (JTRFLG.EQ.0) GO TO 1205 TOL=0.1*TSTEP NUMBKP=2 CALL GETMEM(LSBKPT,NUMBKP) VALUE(LSBKPT+1)=0.0 VALUE(LSBKPT+2)=TSTOP 1205 DO 1290 ID=9,10 LOC=LOCATE(ID) 1210 IF (LOC.EQ.0) GO TO 1290 LOCV=NODPLC(LOC+1) LOCP=NODPLC(LOC+5) TEMP=VALUE(LOCV+3)/RAD VALUE(LOCV+3)=VALUE(LOCV+2)*SIN(TEMP) VALUE(LOCV+2)=VALUE(LOCV+2)*COS(TEMP) IF (JTRFLG.EQ.0) GO TO 1280 JTYPE=NODPLC(LOC+4)+1 GO TO (1280,1220,1230,1235,1240,1260), JTYPE 1220 VALUE(LOCP+4)=VALUE(LOCP+4)+VALUE(LOCP+3) TEMP=VALUE(LOCP+5) VALUE(LOCP+5)=VALUE(LOCP+4)+VALUE(LOCP+6) VALUE(LOCP+6)=VALUE(LOCP+5)+TEMP TIME=0.0 1225 CALL EXTMEM(LSBKPT,4) VALUE(LSBKPT+NUMBKP+1)=VALUE(LOCP+3)+TIME VALUE(LSBKPT+NUMBKP+2)=VALUE(LOCP+4)+TIME VALUE(LSBKPT+NUMBKP+3)=VALUE(LOCP+5)+TIME VALUE(LSBKPT+NUMBKP+4)=VALUE(LOCP+6)+TIME NUMBKP=NUMBKP+4 TIME=TIME+VALUE(LOCP+7) IF (TIME.GE.TSTOP) GO TO 1280 GO TO 1225 1230 VALUE(LOCP+3)=VALUE(LOCP+3)*TWOPI CALL EXTMEM(LSBKPT,1) 1231 VALUE(LSBKPT+NUMBKP+1)=VALUE(LOCP+4) NUMBKP=NUMBKP+1 GO TO 1280 1235 CALL EXTMEM(LSBKPT,2) VALUE(LSBKPT+NUMBKP+1)=VALUE(LOCP+3) VALUE(LSBKPT+NUMBKP+2)=VALUE(LOCP+5) NUMBKP=NUMBKP+2 GO TO 1280 1240 IKNT=1 CALL SIZMEM(NODPLC(LOC+5),NUMP) 1250 CALL EXTMEM(LSBKPT,1) VALUE(LSBKPT+NUMBKP+1)=VALUE(LOCP+IKNT) NUMBKP=NUMBKP+1 IKNT=IKNT+2 IF (IKNT.LE.NUMP) GO TO 1250 GO TO 1280 1260 VALUE(LOCP+3)=VALUE(LOCP+3)*TWOPI VALUE(LOCP+5)=VALUE(LOCP+5)*TWOPI 1280 LOC=NODPLC(LOC) GO TO 1210 1290 CONTINUE C C AUGMENT BREAKPOINT TABLE FOR TRANSMISSION LINE DELAYS C IF (JTRFLG.EQ.0) GO TO 1300 LOC=LOCATE(17) 1292 IF (LOC.EQ.0) GO TO 1300 LOCV=NODPLC(LOC+1) TD=VALUE(LOCV+2) NTEMP=NUMBKP DO 1296 IBKP=1,NTEMP TIME=VALUE(LSBKPT+IBKP) 1294 TIME=TIME+TD IF (TIME.GE.TSTOP) GO TO 1296 CALL EXTMEM(LSBKPT,1) VALUE(LSBKPT+NUMBKP+1)=TIME NUMBKP=NUMBKP+1 GO TO 1294 1296 CONTINUE CALL SHLSRT(VALUE(LSBKPT+1),NUMBKP) NBKPT=1 DO 1298 I=2,NUMBKP IF ((VALUE(LSBKPT+I)-VALUE(LSBKPT+NBKPT)).LT.TOL) GO TO 1298 NBKPT=NBKPT+1 VALUE(LSBKPT+NBKPT)=VALUE(LSBKPT+I) IF (VALUE(LSBKPT+NBKPT).GE.TSTOP) GO TO 1299 1298 CONTINUE 1299 CALL RELMEM(LSBKPT,NUMBKP-NBKPT) NUMBKP=NBKPT VALUE(LSBKPT+NUMBKP)=AMAX1(VALUE(LSBKPT+NUMBKP),TSTOP) LOC=NODPLC(LOC) GO TO 1292 C C FINISH BREAKPOINT TABLE C 1300 IF (JTRFLG.EQ.0) GO TO 1600 CALL EXTMEM(LSBKPT,1) VALUE(LSBKPT+NUMBKP+1)=TSTOP NUMBKP=NUMBKP+1 CALL SHLSRT(VALUE(LSBKPT+1),NUMBKP) NBKPT=1 DO 1310 I=2,NUMBKP IF ((VALUE(LSBKPT+I)-VALUE(LSBKPT+NBKPT)).LT.TOL) GO TO 1310 NBKPT=NBKPT+1 VALUE(LSBKPT+NBKPT)=VALUE(LSBKPT+I) IF (ABS(VALUE(LSBKPT+NBKPT)-TSTOP).LE.TOL) GO TO 1320 1310 CONTINUE WRITE (6,1311) 1311 FORMAT("0*ABORT*: INTERNAL SPICE ERROR -- ERRCHK/BKPTAB",/) NOGO=1 GO TO 2000 1320 CALL RELMEM(LSBKPT,NUMBKP-NBKPT) NUMBKP=NBKPT VALUE(LSBKPT+NUMBKP)=TSTOP C C PRINT OPTION SUMMARY C 1600 IF (IPRNTO.EQ.0) GO TO 1700 CALL TITLE(0,LWIDTH,1,TITLOP) WRITE (6,1601) GMIN,RELTOL,ABSTOL,VNTOL,LVLCOD,ITL1,ITL2 1601 FORMAT("0DC ANALYSIS -",/, 1 "0 GMIN = ",1PE10.3,/, 2 " RELTOL = ", E10.3,/, 3 " ABSTOL = ", E10.3,/, 4 " VNTOL = ", E10.3,/, 5 " LVLCOD = ", I6,/, 6 " ITL1 = ", I6,/, 7 " ITL2 = ", I6,/) WRITE (6,1611) ANAME(METHOD),MAXORD,CHGTOL,TRTOL,LVLTIM,ITL3, 1 ITL4,ITL5 1611 FORMAT("0TRANSIENT ANALYSIS -",/, 1 "0 METHOD = ",A8,/, 2 " MAXORD = ", I6,/, 3 " CHGTOL = ",1PE10.3,/, 4 " TRTOL = ", E10.3,/, 5 " LVLTIM = ", I6,/, 6 " ITL3 = ", I6,/, 7 " ITL4 = ", I6,/, 8 " ITL5 = ", I6,/) WRITE (6,1621) LIMPTS,LIMTIM,NUMDGT,VALUE(ITEMPS+1) 1621 FORMAT("0MISCELLANEOUS -",/, 1 "0 LIMPTS = ", I6,/, 2 " LIMTIM = ", I6,/, 3 " NUMDGT = ", I6,/, 4 " TNOM = ",0PF10.3) C C MISCELLANEOUS ERROR CHECKING C 1700 IF (ICVFLG.EQ.0) GO TO 1720 IF (ICVFLG.LE.LIMPTS) GO TO 1710 ICVFLG=0 WRITE (6,1701) LIMPTS,ALSDC 1701 FORMAT("0WARNING: MORE THAN "I5" POINTS FOR "A4" ANALYSIS ... ANA 1LYSIS OMITTED"/) GO TO 1720 1710 IF ((JELCNT(31)+JELCNT(36)).GT.0) GO TO 1720 ICVFLG=0 WRITE (6,1711) ALSDC 1711 FORMAT("0WARNING: NO "A4" OUTPUTS SPECIFIED ... ANALYSIS OMITTED" 1/) 1720 IF (JTRFLG.EQ.0) GO TO 1740 IF (METHOD.EQ.1) MAXORD=2 IF ((METHOD.EQ.2).AND.(MAXORD.GE.3)) LVLTIM=2 IF (JTRFLG.LE.LIMPTS) GO TO 1730 JTRFLG=0 WRITE (6,1701) LIMPTS,ALSTR GO TO 1740 1730 IF ((JELCNT(32)+JELCNT(37)+NFOUR).GT.0) GO TO 1735 JTRFLG=0 WRITE (6,1711) ALSTR GO TO 1740 1735 IF (NFOUR.EQ.0) GO TO 1740 FORPRD=1.0/FORFRE IF ((TSTOP-FORPRD).GE.(TSTART-1.0E-12)) GO TO 1740 NFOUR=0 CALL CLRMEM(IFOUR) WRITE (6,1736) 1736 FORMAT("0WARNING: FOURIER ANALYSIS FUNDAMENTAL FREQUENCY IS INCOM 1PATIBLE WITH"/11X"TRANSIENT ANALYSIS PRINT INTERVAL ... FOURIER AN 2ALYSIS OMITTED"/) 1740 IF (JACFLG.EQ.0) GO TO 1760 IF (JACFLG.LE.LIMPTS) GO TO 1750 JACFLG=0 WRITE (6,1701) LIMPTS,ALSAC GO TO 1760 1750 IF ((JELCNT(33)+JELCNT(34)+JELCNT(35)+JELCNT(38)+JELCNT(39) 1 +JELCNT(40)+IDIST+INOISE).GT.0) GO TO 1760 JACFLG=0 WRITE (6,1711) ALSAC 1760 IF (JPZFLG.EQ.0) GO TO 1800 IF (JELCNT(17).EQ.0) GO TO 1800 JPZFLG=0 WRITE (6,1761) 1761 FORMAT("0WARNING: POLE/ZERO ANALYSIS NOT POSSIBLE WITH ", 1 "TRANSMISSION LINE ELEMENTS",/) C C SEQUENCE THROUGH THE OUTPUT LISTS C 1800 DO 1820 ID=41,45 IF (ID.LE.43) NUMOUT=1 LOC=LOCATE(ID) 1810 IF (LOC.EQ.0) GO TO 1820 NUMOUT=NUMOUT+1 NODPLC(LOC+4)=NUMOUT LOC=NODPLC(LOC) GO TO 1810 1820 CONTINUE C C EXIT C 2000 CALL SECOND(T2) RSTATS(1)=RSTATS(1)+T2-T1 RETURN END SUBROUTINE SHLSRT(A,N) C C THIS ROUTINE SORTS THE ARRAY A USING A SHELL SORT ALGORITHM. C DIMENSION A(N) INTEGER H C C C... COMPUTE BEST STARTING STEP SIZE H=1 10 H=3*H+1 IF (H.LT.N) GO TO 10 C... BACK OFF TWO TIMES H=(H-1)/3 H=(H-1)/3 H=MAX0(H,1) C C SHELL SORT C 20 J=H+1 GO TO 60 30 I=J-H C... AK = RECORD KEY; AR = RECORD AK=A(J) AR=AK 40 IF (AK.GE.A(I)) GO TO 50 A(I+H)=A(I) I=I-H IF (I.GE.1) GO TO 40 50 A(I+H)=AR J=J+1 60 IF (J.LE.N) GO TO 30 H=(H-1)/3 IF (H.NE.0) GO TO 20 RETURN END SUBROUTINE PUTNOD(NODE) C C THIS ROUTINE ADDS "NODE" TO THE LIST OF USER INPUT NODES IN TABLE C JUNODE. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C JKNT=0 10 JKNT=JKNT+1 IF (JKNT.GT.NUNODS) GO TO 20 IF (NODE-NODPLC(JUNODE+JKNT)) 20,100,10 20 K=NUNODS+1 CALL EXTMEM(JUNODE,1) IF (K.LE.JKNT) GO TO 30 CALL COPY4(NODPLC(JUNODE+JKNT),NODPLC(JUNODE+JKNT+1),K-JKNT) K=JKNT 30 NODPLC(JUNODE+K)=NODE NUNODS=NUNODS+1 C C FINISHED C 100 RETURN END SUBROUTINE GETNOD(NODE) C C THIS ROUTINE CONVERTS FROM THE USER NODE NUMBER TO THE INTERNAL C (COMPACT) NODE NUMBER. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C IF (NOGO.NE.0) GO TO 100 JKNT=0 10 JKNT=JKNT+1 IF (JKNT.GT.NUNODS) GO TO 20 IF (NODPLC(JUNODE+JKNT).NE.NODE) GO TO 10 NODE=JKNT GO TO 100 C C UNKNOWN NODE -- MUST BE IMPLIED BY .PRINT AND/OR .PLOT C 20 IF (NODE.EQ.0) GO TO 30 WRITE (6,21) NODE 21 FORMAT("0WARNING: ATTEMPT TO OUTPUT UNDEFINED NODE ",I5, 1 " -- NODE RESET TO 0"/) 30 NODE=1 C C FINISHED C 100 RETURN END SUBROUTINE SUBCKT C C THIS ROUTINE DRIVES THE EXPANSION OF SUBCIRCUIT CALLS. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C LOCX=LOCATE(19) 10 IF (LOCX.EQ.0) GO TO 300 LOCS=NODPLC(LOCX+3) ASNAM=VALUE(IUNSAT+LOCS) CALL FNDNAM(ASNAM,LOCX-1,LOCX+3,20) IF (NOGO.NE.0) GO TO 300 LOCS=NODPLC(LOCX+3) C C CHECK FOR RECURSION C ISBPTR=NODPLC(LOCX-1) 20 IF (ISBPTR.EQ.0) GO TO 30 IF (LOCS.EQ.NODPLC(ISBPTR+3)) GO TO 260 ISBPTR=NODPLC(ISBPTR-1) GO TO 20 C C 30 CALL SIZMEM(NODPLC(LOCX+2),NXNOD) CALL SIZMEM(NODPLC(LOCS+2),NSNOD) IF (NXNOD.NE.NSNOD) GO TO 250 CALL GETMEM(INODX,NSNOD) CALL GETMEM(INODI,NSNOD) ITEMP=NODPLC(LOCS+2) CALL COPY4(NODPLC(ITEMP+1),NODPLC(INODX+1),NSNOD) ITEMP=NODPLC(LOCX+2) CALL COPY4(NODPLC(ITEMP+1),NODPLC(INODI+1),NXNOD) C C ADD ELEMENTS OF SUBCIRCUIT TO NOMINAL CIRCUIT C LOC=NODPLC(LOCS+3) 100 IF (LOC.EQ.0) GO TO 200 ID=NODPLC(LOC-1) IF (ID.EQ.20) GO TO 110 CALL FIND(FLOAT(JELCNT(ID)),ID,LOCE,1) NODPLC(LOCE-1)=LOCX CALL ADDELT(LOCE,LOC,ID,INODX,INODI,NXNOD) 110 LOC=NODPLC(LOC) GO TO 100 C C 200 CALL CLRMEM(INODX) CALL CLRMEM(INODI) LOCX=NODPLC(LOCX) GO TO 10 C C ERRORS C 250 LOCV=NODPLC(LOCX+1) AXNAM=VALUE(LOCV) LOCV=NODPLC(LOCS+1) ASNAM=VALUE(LOCV) WRITE (6,251) AXNAM,ASNAM 251 FORMAT("0*ERROR*: ",A8," HAS DIFFERENT NUMBER OF NODES THAN ",A8/ 1) NOGO=1 GO TO 300 260 LOCSV=NODPLC(LOCS+1) ASNAM=VALUE(LOCSV) WRITE (6,261) ASNAM 261 FORMAT("0*ERROR*: SUBCIRCUIT ",A8," IS DEFINED RECURSIVELY"/) NOGO=1 C C FINISHED C 300 RETURN END SUBROUTINE FNDNAM(ANAM,JSBPTR,ISPOT,ID) C C THIS ROUTINE SEARCHES FOR AN ELEMENT WITH ID "ID" BY TRACING BACK C UP THE SUBCIRCUIT DEFINITION LIST. IF THE ELEMENT IS NOT FOUND, THE C NOMINAL ELEMENT LIST IS SEARCHED. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) INTEGER XOR C C ISBPTR=NODPLC(JSBPTR) 10 IF (ISBPTR.EQ.0) GO TO 50 ISUB=NODPLC(ISBPTR+3) LOC=NODPLC(ISUB+3) 20 IF (LOC.EQ.0) GO TO 40 IF (ID.NE.NODPLC(LOC-1)) GO TO 30 LOCV=NODPLC(LOC+1) IF (XOR(ANAM,VALUE(LOCV)).NE.0) GO TO 30 IF (ID.NE.20) GO TO 50 GO TO 65 30 LOC=NODPLC(LOC) GO TO 20 40 ISBPTR=NODPLC(ISBPTR-1) GO TO 10 C 50 LOC=LOCATE(ID) 60 IF (LOC.EQ.0) GO TO 90 IF (NODPLC(LOC-1).NE.ISBPTR) GO TO 70 LOCV=NODPLC(LOC+1) IF (XOR(ANAM,VALUE(LOCV)).NE.0) GO TO 70 65 NODPLC(ISPOT)=LOC GO TO 100 70 LOC=NODPLC(LOC) GO TO 60 90 WRITE (6,91) ANAM 91 FORMAT("0*ERROR*: UNABLE TO FIND ",A8/) NOGO=1 100 RETURN END SUBROUTINE NEWNOD(NODOLD,NODNEW,INODX,INODI,NNODI) C C THIS ROUTINE MAKES A NEW NODE NUMBER FOR AN ELEMENT WHICH IS ABOUT C TO BE ADDED TO THE CIRCUIT AS A RESULT OF A SUBCIRCUIT CALL. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C IF (NODOLD.NE.0) GO TO 5 NODNEW=1 GO TO 20 5 DO 10 I=1,NNODI IF (NODOLD.NE.NODPLC(INODX+I)) GO TO 10 NODNEW=NODPLC(INODI+I) GO TO 20 10 CONTINUE C CALL EXTMEM(INODX,1) CALL EXTMEM(INODI,1) CALL EXTMEM(JUNODE,1) NNODI=NNODI+1 NCNODS=NCNODS+1 NODPLC(INODX+NNODI)=NODOLD NODPLC(INODI+NNODI)=NCNODS NODPLC(JUNODE+NCNODS)=NODPLC(JUNODE+NCNODS-1)+1 NODNEW=NCNODS 20 RETURN END SUBROUTINE ADDELT(LOCE,LOC,ID,INODX,INODI,NNODI) C C THIS ROUTINE ADDS AN ELEMENT TO THE NOMINAL CIRCUIT DEFINITION C LISTS. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C DIMENSION LNOD(50),LVAL(50),NNODS(50) DATA LNOD / 9,10,12, 7,14,15,14,15,12, 7, 1 17,31,26,34, 7, 7,34, 0, 5, 5, 2 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 3 21,21,21,21,21,21,21,21,21,21, 4 8, 8, 8, 8, 8, 0, 0, 0, 0, 0 / DATA LVAL / 5, 3, 3, 2, 1, 1, 1, 1, 4, 4, 1 3, 4, 4,11, 1, 1, 9, 0, 1, 1, 2 19,38,17,44, 0, 0, 0, 0, 0, 0, 3 1, 1, 1, 1, 1,17,17,17,17,17, 4 1, 1, 1, 1, 1, 0, 0, 0, 0, 0 / DATA NNODS / 2, 2, 2, 0, 2, 2, 2, 2, 2, 2, 1 2, 3, 3, 4, 4, 4, 4, 0, 1, 0, 2 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4 2, 2, 2, 0, 0, 0, 0, 0, 0, 0 / C C COPY INTEGER PART C NWORD=LNOD(ID)-3 IF (NWORD.LE.0) GO TO 10 CALL COPY4(NODPLC(LOC+2),NODPLC(LOCE+2),NWORD) C C SET NODES C 10 IF (ID.GE.21) GO TO 100 IF (NNODS(ID).EQ.0) GO TO 100 IF (ID.LE.4) GO TO 20 IF (ID.LE.8) GO TO 40 IF (ID.EQ.19) GO TO 70 20 JSTOP=NNODS(ID) DO 30 J=1,JSTOP CALL NEWNOD(NODPLC(LOC+J+1),NODPLC(LOCE+J+1),INODX,INODI,NNODI) 30 CONTINUE GO TO 100 40 CALL NEWNOD(NODPLC(LOC+2),NODPLC(LOCE+2),INODX,INODI,NNODI) CALL NEWNOD(NODPLC(LOC+3),NODPLC(LOCE+3),INODX,INODI,NNODI) IF (ID.GE.7) GO TO 100 NLOCP=LOC+ID+1 NSNOD=2*NODPLC(LOC+4) CALL GETMEM(NODPLC(LOCE+ID+1),NSNOD) NLOCPE=LOCE+ID+1 50 DO 60 J=1,NSNOD LOCP=NODPLC(NLOCP) NODOLD=NODPLC(LOCP+J) CALL NEWNOD(NODOLD,NODNEW,INODX,INODI,NNODI) LOCPE=NODPLC(NLOCPE) NODPLC(LOCPE+J)=NODNEW 60 CONTINUE GO TO 100 70 NLOCP=LOC+2 CALL SIZMEM(NODPLC(LOC+2),NSNOD) CALL GETMEM(NODPLC(LOCE+2),NSNOD) NLOCPE=LOCE+2 GO TO 50 C C COPY REAL PART C 100 IF (NOGO.NE.0) GO TO 300 LOCV=NODPLC(LOC+1) LOCVE=NODPLC(LOCE+1) CALL COPY8(VALUE(LOCV),VALUE(LOCVE),LVAL(ID)) C C TREAT NON-NODE TABLES SPECIALLY C 200 IF (ID.GE.11) GO TO 300 IF (ID.LE.4) GO TO 300 IJMP=ID-4 GO TO (230,240,230,240,260,260), IJMP 230 ITAB=5 GO TO 250 240 ITAB=6 250 IF (ID.LE.6) GO TO 255 CALL CPYTAB(LOC+ITAB+1,LOCE+ITAB+1) 255 CALL CPYTAB(LOC+ITAB+2,LOCE+ITAB+2) CALL CPYTAB(LOC+ITAB+3,LOCE+ITAB+3) CALL CPYTAB(LOC+ITAB+4,LOCE+ITAB+4) CALL CPYTAB(LOC+ITAB+5,LOCE+ITAB+5) CALL CPYTAB(LOC+ITAB+6,LOCE+ITAB+6) GO TO 300 260 CALL CPYTAB(LOC+5,LOCE+5) C C 300 RETURN END SUBROUTINE CPYTAB(ITABO,ITABN) C C THIS ROUTINE COPIES A TABLE. ITS USE IS MADE NECESSARY BY THE C FACT THAT ONLY ONE POINTER IS ALLOWED PER TABLE. C COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C CALL SIZMEM(NODPLC(ITABO),ISIZE) CALL GETMEM(NODPLC(ITABN),ISIZE) LOCO=NODPLC(ITABO) LOCN=NODPLC(ITABN) CALL COPY4(NODPLC(LOCO+1),NODPLC(LOCN+1),ISIZE) RETURN END SUBROUTINE LNKREF C C THIS ROUTINE RESOLVES ALL UNSATISFIED NAME REFERENCES. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C MUTUAL INDUCTORS C LOC=LOCATE(4) 100 IF (LOC.EQ.0) GO TO 200 IREF=NODPLC(LOC+2) CALL FNDNAM(VALUE(IUNSAT+IREF),LOC-1,LOC+2,3) IREF=NODPLC(LOC+3) CALL FNDNAM(VALUE(IUNSAT+IREF),LOC-1,LOC+3,3) LOC=NODPLC(LOC) GO TO 100 C C CURRENT-CONTROLLED CURRENT SOURCE C 200 LOC=LOCATE(7) 210 IF (LOC.EQ.0) GO TO 300 NUMP=NODPLC(LOC+4) LOCP=NODPLC(LOC+6) DO 220 I=1,NUMP IREF=NODPLC(LOCP+I) CALL FNDNAM(VALUE(IUNSAT+IREF),LOC-1,LOCP+I,9) 220 CONTINUE LOC=NODPLC(LOC) GO TO 210 C C CURRENT-CONTROLLED VOLTAGE SOURCES C 300 LOC=LOCATE(8) 310 IF (LOC.EQ.0) GO TO 400 NUMP=NODPLC(LOC+4) LOCP=NODPLC(LOC+7) DO 320 I=1,NUMP IREF=NODPLC(LOCP+I) CALL FNDNAM(VALUE(IUNSAT+IREF),LOC-1,LOCP+I,9) 320 CONTINUE LOC=NODPLC(LOC) GO TO 310 C C DIODES C 400 LOC=LOCATE(11) 410 IF (LOC.EQ.0) GO TO 500 IREF=NODPLC(LOC+5) CALL FNDNAM(VALUE(IUNSAT+IREF),LOC-1,LOC+5,21) LOC=NODPLC(LOC) GO TO 410 C C BJTS C 500 LOC=LOCATE(12) 510 IF (LOC.EQ.0) GO TO 600 IREF=NODPLC(LOC+8) CALL FNDNAM(VALUE(IUNSAT+IREF),LOC-1,LOC+8,22) LOC=NODPLC(LOC) GO TO 510 C C JFETS C 600 LOC=LOCATE(13) 610 IF (LOC.EQ.0) GO TO 700 IREF=NODPLC(LOC+7) CALL FNDNAM(VALUE(IUNSAT+IREF),LOC-1,LOC+7,23) LOC=NODPLC(LOC) GO TO 610 C C MOSFETS C 700 LOC=LOCATE(14) 710 IF (LOC.EQ.0) GO TO 1000 IREF=NODPLC(LOC+8) CALL FNDNAM(VALUE(IUNSAT+IREF),LOC-1,LOC+8,24) LOC=NODPLC(LOC) GO TO 710 C C FINISHED C 1000 CALL CLRMEM(IUNSAT) RETURN END SUBROUTINE SUBNAM(LOCE) C C THIS ROUTINE CONSTRUCTS THE NAMES OF ELEMENTS ADDED AS A RESULT OF C SUBCIRCUIT EXPANSION. THE FULL ELEMENT NAMES ARE OF THE FORM C XA.XB.XC.XD. --- .XN.NAME C WHERE "NAME" IS THE NOMINAL ELEMENT NAME, AND THE "X"*S DENOTE THE C SEQUENCE OF SUBCIRCUIT CALLS (FROM TOP OR CIRCUIT LEVEL DOWN THROUGH C NESTED SUBCIRCUIT CALLS) WHICH CAUSED THE PARTICULAR ELEMENT TO BE C ADDED. AT PRESENT, SPICE RESTRICTS ALL ELEMENT NAMES TO BE 8 CHARAC- C TERS OR LESS. THEREFORE, THE NAME USED CONSISTS OF THE RIGHTMOST 8 C CHARACTERS OF THE FULL ELEMENT NAME, WITH THE LEFTMOST CHARACTER C REPLACED BY AN ASTERISK ("*") IF THE FULL ELEMENT NAME IS LONGER THAN C 8 CHARACTERS. C COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C DATA ABLANK, APER, ASTK / 1H , 1H., 1H* / C C CONSTRUCT SUBCIRCUIT ELEMENT NAME C IF (NODPLC(LOCE-1).EQ.0) GO TO 100 LOCVE=NODPLC(LOCE+1) LOC=LOCE NCHAR=9 SNAME=ABLANK ACHAR=ABLANK 10 LOCV=NODPLC(LOC+1) ELNAME=VALUE(LOCV) DO 20 ICHAR=1,8 CALL MOVE(ACHAR,1,ELNAME,9-ICHAR,1) IF (ACHAR.EQ.ABLANK) GO TO 20 IF (NCHAR.EQ.1) GO TO 40 NCHAR=NCHAR-1 CALL MOVE(SNAME,NCHAR,ACHAR,1,1) 20 CONTINUE 30 LOC=NODPLC(LOC-1) IF (LOC.EQ.0) GO TO 60 IF (NCHAR.EQ.1) GO TO 40 NCHAR=NCHAR-1 CALL MOVE(SNAME,NCHAR,APER,1,1) GO TO 10 C C NAME IS LONGER THAN 8 CHARACTERS: FLAG WITH ASTERISK C 40 CALL MOVE(SNAME,1,ASTK,1,1) GO TO 70 C C LEFT-JUSTIFY AND STORE THE CONSTRUCTED NAME C 60 IF (NCHAR.EQ.1) GO TO 70 CALL MOVE(SNAME,1,SNAME,NCHAR,9-NCHAR) CALL MOVE(SNAME,10-NCHAR,ABLANK,1,NCHAR-1) 70 VALUE(LOCVE)=SNAME C C FINISHED C 100 RETURN END SUBROUTINE ELPRNT C C THIS ROUTINE PRINTS A CIRCUIT ELEMENT SUMMARY. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /MISCEL/ APROG(3),ATIME,ADATE,ATITLE(15),RSTATS(50), 1 IWIDTH,LWIDTH,NOPAGE COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /TRAN/ TSTEP,TSTOP,TSTART,DELMAX,TDMAX,FORFRE,JTRFLG COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C DIMENSION ITAB(25),ASTYP(6) DIMENSION ELTITL(4) DATA ELTITL / 8HCIRCUIT , 8HELEMENT , 8HSUMMARY , 8H / DATA ASTYP / 1H , 5HPULSE, 3HSIN, 3HEXP, 3HPWL, 4HSFFM / DATA ABLNK,AOFF /1H ,3HOFF/ C C PRINT LISTING OF ELEMENTS C CALL TITLE(0,LWIDTH,1,ELTITL) C C PRINT RESISTORS C IF (JELCNT(1).EQ.0) GO TO 50 ITITLE=0 21 FORMAT(//"0**** RESISTORS"/"0 NAME NODES VALUE 1 TC1 TC2"//) LOC=LOCATE(1) 30 IF (LOC.EQ.0) GO TO 50 IF (ITITLE.EQ.0) WRITE (6,21) ITITLE=1 LOCV=NODPLC(LOC+1) NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) WRITE (6,31) VALUE(LOCV),NODPLC(JUNODE+NODE1), 1 NODPLC(JUNODE+NODE2),VALUE(LOCV+2),VALUE(LOCV+3),VALUE(LOCV+4) 31 FORMAT(6X,A8,2I5,1P3E11.2) 40 LOC=NODPLC(LOC) GO TO 30 C C PRINT CAPACITORS AND INDUCTORS C 50 IF ((JELCNT(2)+JELCNT(3)).EQ.0) GO TO 80 ITITLE=0 51 FORMAT(//"0**** CAPACITORS AND INDUCTORS"/"0 NAME NODES 1 IN COND VALUE"//) DO 70 ID=2,3 LOC=LOCATE(ID) 60 IF (LOC.EQ.0) GO TO 70 IF (ITITLE.EQ.0) WRITE (6,51) ITITLE=1 LOCV=NODPLC(LOC+1) NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) WRITE (6,31) VALUE(LOCV),NODPLC(JUNODE+NODE1), 1 NODPLC(JUNODE+NODE2),VALUE(LOCV+2),VALUE(LOCV+1) LOC=NODPLC(LOC) GO TO 60 70 CONTINUE C C PRINT MUTUAL INDUCTORS C 80 IF (JELCNT(4).EQ.0) GO TO 100 ITITLE=0 81 FORMAT(//"0**** MUTUAL INDUCTORS"/"0 NAME COUPLED INDUC 1TORS VALUE"//) LOC=LOCATE(4) 90 IF (LOC.EQ.0) GO TO 110 IF (ITITLE.EQ.0) WRITE (6,81) ITITLE=1 LOCV=NODPLC(LOC+1) NL1=NODPLC(LOC+2) NL1=NODPLC(NL1+1) NL2=NODPLC(LOC+3) NL2=NODPLC(NL2+1) WRITE (6,91) VALUE(LOCV),VALUE(NL1),VALUE(NL2),VALUE(LOCV+1) 91 FORMAT(6X,A8,4X,A8,2X,A8,1PE10.2) 95 LOC=NODPLC(LOC) GO TO 90 C C PRINT NONLINEAR VOLTAGE CONTROLLED SOURCES C 100 IF (JELCNT(5).EQ.0) GO TO 120 ITITLE=0 101 FORMAT(//"0**** VOLTAGE-CONTROLLED CURRENT SOURCES"/"0 NAME 1 + - DIMENSION FUNCTION"//) LOC=LOCATE(5) 110 IF (LOC.EQ.0) GO TO 120 IF (ITITLE.EQ.0) WRITE (6,101) ITITLE=1 LOCV=NODPLC(LOC+1) NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) WRITE (6,111) VALUE(LOCV),NODPLC(JUNODE+NODE1), 1 NODPLC(JUNODE+NODE2),NODPLC(LOC+4) 111 FORMAT(6X,A8,2I5,I8,9X,"POLY") 115 LOC=NODPLC(LOC) GO TO 110 C C NONLINEAR VOLTAGE CONTROLLED VOLTAGE SOURCES C 120 IF (JELCNT(6).EQ.0) GO TO 140 ITITLE=0 121 FORMAT(//"0**** VOLTAGE-CONTROLLED VOLTAGE SOURCES"/"0 NAME 1 + - DIMENSION FUNCTION"//) LOC=LOCATE(6) 130 IF (LOC.EQ.0) GO TO 140 IF (ITITLE.EQ.0) WRITE (6,121) ITITLE=1 LOCV=NODPLC(LOC+1) NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) WRITE (6,111) VALUE(LOCV),NODPLC(JUNODE+NODE1), 1 NODPLC(JUNODE+NODE2),NODPLC(LOC+4) 135 LOC=NODPLC(LOC) GO TO 130 C C NONLINEAR CURRENT CONTROLLED CURRENT SOURCES C 140 IF (JELCNT(7).EQ.0) GO TO 160 ITITLE=0 141 FORMAT(//"0**** CURRENT-CONTROLLED CURRENT SOURCES"/"0 NAME 1 + - DIMENSION FUNCTION"//) LOC=LOCATE(7) 150 IF (LOC.EQ.0) GO TO 160 IF (ITITLE.EQ.0) WRITE (6,141) ITITLE=1 LOCV=NODPLC(LOC+1) NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) WRITE (6,111) VALUE(LOCV),NODPLC(JUNODE+NODE1), 1 NODPLC(JUNODE+NODE2),NODPLC(LOC+4) 155 LOC=NODPLC(LOC) GO TO 150 C C NONLINEAR CURRENT CONTROLLED VOLTAGE SOURCES C 160 IF (JELCNT(8).EQ.0) GO TO 170 ITITLE=0 161 FORMAT(//"0**** CURRENT-CONTROLLED VOLTAGE SOURCES"/"0 NAME 1 + - DIMENSION FUNCTION"//) LOC=LOCATE(8) 165 IF (LOC.EQ.0) GO TO 170 IF (ITITLE.EQ.0) WRITE (6,161) ITITLE=1 LOCV=NODPLC(LOC+1) NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) WRITE (6,111) VALUE(LOCV),NODPLC(JUNODE+NODE1), 1 NODPLC(JUNODE+NODE2),NODPLC(LOC+4) 167 LOC=NODPLC(LOC) GO TO 165 C C PRINT INDEPENDENT SOURCES C 170 IF ((JELCNT(9)+JELCNT(10)).EQ.0) GO TO 250 ITITLE=0 171 FORMAT(//"0**** INDEPENDENT SOURCES"/"0 NAME NODES DC 1 VALUE AC VALUE AC PHASE TRANSIENT"//) DO 245 ID=9,10 LOC=LOCATE(ID) 180 IF (LOC.EQ.0) GO TO 245 IF (ITITLE.EQ.0) WRITE (6,171) ITITLE=1 LOCV=NODPLC(LOC+1) LOCP=NODPLC(LOC+5) NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) ITYPE=NODPLC(LOC+4)+1 ANAM=ASTYP(ITYPE) WRITE (6,181) VALUE(LOCV),NODPLC(JUNODE+NODE1), 1 NODPLC(JUNODE+NODE2),VALUE(LOCV+1),VALUE(LOCV+2), 2 VALUE(LOCV+3),ANAM 181 FORMAT(6X,A8,2I5,1P3E11.2,2X,A8) IF (JTRFLG.EQ.0) GO TO 240 JSTART=LOCP+1 GO TO (240,190,200,210,220,230), ITYPE 190 JSTOP=LOCP+7 WRITE (6,191) (VALUE(J),J=JSTART,JSTOP) 191 FORMAT(1H0,42X,*INITIAL VALUE*,1PE11.2,/, 1 43X,*PULSED VALUE.*, E11.2,/, 2 43X,*DELAY TIME...*, E11.2,/, 3 43X,*RISETIME.....*, E11.2,/, 4 43X,*FALLTIME.....*, E11.2,/, 5 43X,*WIDTH........*, E11.2,/, 6 43X,*PERIOD.......*, E11.2,/) GO TO 240 200 JSTOP=LOCP+5 WRITE (6,201) (VALUE(J),J=JSTART,JSTOP) 201 FORMAT(1H0,42X,*OFFSET.......*,1PE11.2,/, 1 43X,*AMPLITUDE....*, E11.2,/, 2 43X,*FREQUENCY....*, E11.2,/, 3 43X,*DELAY........*, E11.2,/, 4 43X,*THETA........*, E11.2,/) GO TO 240 210 JSTOP=LOCP+6 WRITE (6,211) (VALUE(J),J=JSTART,JSTOP) 211 FORMAT(1H0,42X,*INITIAL VALUE*,1PE11.2,/, 1 43X,*PULSED VALUE.*, E11.2,/, 2 43X,*RISE DELAY...*, E11.2,/, 3 43X,*RISE TAU.....*, E11.2,/, 4 43X,*FALL DELAY...*, E11.2,/, 5 43X,*FALL TAU.....*, E11.2,/) GO TO 240 220 CALL SIZMEM(NODPLC(LOC+5),JSTOP) JSTOP=LOCP+JSTOP WRITE (6,221) (VALUE(J),J=JSTART,JSTOP) 221 FORMAT(1H0,49X,*TIME VALUE*//,(46X,1P2E11.2)) WRITE (6,226) 226 FORMAT(1X) GO TO 240 230 JSTOP=LOCP+5 WRITE (6,231) (VALUE(J),J=JSTART,JSTOP) 231 FORMAT(1H0,42X,*OFFSET.......*,1PE11.2,/, 1 43X,*AMPLITUDE....*, E11.2,/, 2 43X,*CARRIER FREQ.*, E11.2,/, 3 43X,*MODN INDEX...*, E11.2,/, 4 43X,*SIGNAL FREQ..*, E11.2,/) 240 LOC=NODPLC(LOC) GO TO 180 245 CONTINUE C C PRINT TRANSMISSION LINES C 250 IF (JELCNT(17).EQ.0) GO TO 260 ITITLE=0 251 FORMAT(//"0**** TRANSMISSION LINES"/"0 NAME NODES 1 Z0 TD"//) LOC=LOCATE(17) 253 IF (LOC.EQ.0) GO TO 260 IF (ITITLE.EQ.0) WRITE (6,251) ITITLE=1 LOCV=NODPLC(LOC+1) NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NODE3=NODPLC(LOC+4) NODE4=NODPLC(LOC+5) WRITE (6,256) VALUE(LOCV),NODPLC(JUNODE+NODE1), 1 NODPLC(JUNODE+NODE2),NODPLC(JUNODE+NODE3), 2 NODPLC(JUNODE+NODE4),VALUE(LOCV+1),VALUE(LOCV+2) 256 FORMAT(6X,A8,4I5,1P2E11.2) 258 LOC=NODPLC(LOC) GO TO 253 C C PRINT DIODES C 260 IF (JELCNT(11).EQ.0) GO TO 290 ITITLE=0 261 FORMAT(//"0**** DIODES"/"0 NAME + - MODEL ARE 1A"//) LOC=LOCATE(11) 270 IF (LOC.EQ.0) GO TO 290 IF (ITITLE.EQ.0) WRITE (6,261) ITITLE=1 LOCV=NODPLC(LOC+1) NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) LOCM=NODPLC(LOC+5) LOCM=NODPLC(LOCM+1) AIC=ABLNK IF (NODPLC(LOC+6).EQ.1) AIC=AOFF WRITE (6,271) VALUE(LOCV),NODPLC(JUNODE+NODE1), 1 NODPLC(JUNODE+NODE2),VALUE(LOCM),VALUE(LOCV+1),AIC 271 FORMAT(6X,A8,2I5,2X,A8,F8.3,2X,A8) 280 LOC=NODPLC(LOC) GO TO 270 C C PRINT TRANSISTORS C 290 IF (JELCNT(12).EQ.0) GO TO 320 ITITLE=0 291 FORMAT(//"0**** BIPOLAR JUNCTION TRANSISTORS"/"0 NAME C 1 B E MODEL AREA"//) LOC=LOCATE(12) 300 IF (LOC.EQ.0) GO TO 320 IF (ITITLE.EQ.0) WRITE (6,291) ITITLE=1 LOCV=NODPLC(LOC+1) NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NODE3=NODPLC(LOC+4) LOCM=NODPLC(LOC+8) LOCM=NODPLC(LOCM+1) AIC=ABLNK IF (NODPLC(LOC+9).EQ.1) AIC=AOFF WRITE (6,301) VALUE(LOCV),NODPLC(JUNODE+NODE1), 1 NODPLC(JUNODE+NODE2),NODPLC(JUNODE+NODE3), 2 VALUE(LOCM),VALUE(LOCV+1),AIC 301 FORMAT(6X,A8,3I5,2X,A8,F8.3,2X,A8) 310 LOC=NODPLC(LOC) GO TO 300 C C PRINT JFETS C 320 IF (JELCNT(13).EQ.0) GO TO 350 ITITLE=0 321 FORMAT(//"0**** JFETS"/"0 NAME D G S MODEL 1 AREA"//) LOC=LOCATE(13) 330 IF (LOC.EQ.0) GO TO 350 IF (ITITLE.EQ.0) WRITE (6,321) ITITLE=1 LOCV=NODPLC(LOC+1) NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NODE3=NODPLC(LOC+4) LOCM=NODPLC(LOC+7) LOCM=NODPLC(LOCM+1) AIC=ABLNK IF (NODPLC(LOC+8).EQ.1) AIC=AOFF WRITE (6,301) VALUE(LOCV),NODPLC(JUNODE+NODE1), 1 NODPLC(JUNODE+NODE2),NODPLC(JUNODE+NODE3), 2 VALUE(LOCM),VALUE(LOCV+1),AIC 340 LOC=NODPLC(LOC) GO TO 330 C C PRINT MOSFETS C 350 IF (JELCNT(14).EQ.0) GO TO 400 ITITLE=0 351 FORMAT(//"0**** MOSFETS",/,"0 NAME D G S B MODEL 1 L W AD AS",//) LOC=LOCATE(14) 360 IF (LOC.EQ.0) GO TO 400 IF (ITITLE.EQ.0) WRITE (6,351) ITITLE=1 LOCV=NODPLC(LOC+1) NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NODE3=NODPLC(LOC+4) NODE4=NODPLC(LOC+5) LOCM=NODPLC(LOC+8) LOCM=NODPLC(LOCM+1) AIC=ABLNK IF (NODPLC(LOC+9).EQ.1) AIC=AOFF WRITE (6,361) VALUE(LOCV),NODPLC(JUNODE+NODE1), 1 NODPLC(JUNODE+NODE2),NODPLC(JUNODE+NODE3), 2 NODPLC(JUNODE+NODE4),VALUE(LOCM),VALUE(LOCV+1),VALUE(LOCV+2), 3 VALUE(LOCV+3),VALUE(LOCV+4),AIC 361 FORMAT(6X,A8,4I3,1X,A8,1P4E8.1,1X,A8) 370 LOC=NODPLC(LOC) GO TO 360 C C SUBCIRCUIT CALLS C 400 IF (JELCNT(19).EQ.0) GO TO 500 ITITLE=0 401 FORMAT(//"0**** SUBCIRCUIT CALLS"/"0 NAME SUBCIRCUIT EXT 1ERNAL NODES"//) LOC=LOCATE(19) 410 IF (LOC.EQ.0) GO TO 500 IF (ITITLE.EQ.0) WRITE (6,401) ITITLE=1 LOCV=NODPLC(LOC+1) LOCN=NODPLC(LOC+2) CALL SIZMEM(NODPLC(LOC+2),NNODX) LOCS=NODPLC(LOC+3) LOCSV=NODPLC(LOCS+1) JSTART=1 NDPRLN=(LWIDTH-28)/5 412 JSTOP=MIN0(NNODX,JSTART+NDPRLN-1) DO 414 J=JSTART,JSTOP NODE=NODPLC(LOCN+J) ITAB(J-JSTART+1)=NODPLC(JUNODE+NODE) 414 CONTINUE IF (JSTART.EQ.1) 1 WRITE (6,416) VALUE(LOCV),VALUE(LOCSV),(ITAB(J),J=1,JSTOP) 416 FORMAT(6X,A8,2X,A8,4X,20I5) IF (JSTART.NE.1) 1 WRITE (6,418) (ITAB(J-JSTART+1),J=JSTART,JSTOP) 418 FORMAT(28X,20I5) JSTART=JSTOP+1 IF (JSTART.LE.NNODX) GO TO 412 IF (NNODX.LE.NDPRLN) GO TO 420 WRITE (6,226) 420 LOC=NODPLC(LOC) GO TO 410 C C FINISHED C 500 RETURN END SUBROUTINE MODCHK C C THIS ROUTINE PERFORMS ONE-TIME PROCESSING OF DEVICE MODEL PARA- C METERS AND PRINTS OUT A DEVICE MODEL SUMMARY. IT ALSO RESERVES THE C ADDITIONAL NODES REQUIRED BY NONZERO DEVICE EXTRINSIC RESISTANCES. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /MISCEL/ APROG(3),ATIME,ADATE,ATITLE(15),RSTATS(50), 1 IWIDTH,LWIDTH,NOPAGE COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET, 1 MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO, 2 ITEMNO,NOSOLV,MODAC COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /KNSTNT/ TWOPI,XLOG2,XLOG10,ROOT2,RAD,BOLTZ,CHARGE,CTOK, 1 GMIN,RELTOL,ABSTOL,VNTOL,TRTOL,CHGTOL,EPS0,EPSSIL,EPSOX COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C DIMENSION ITAB(50),ATABLE(10) DIMENSION ANTYPE(4),APTYPE(4) INTEGER PRPOSN(90) DIMENSION IPAR(5),AMPAR(90),DEFVAL(90),IFMT(90),IVCHK(90) DIMENSION TITLED(4),TITLEB(4),TITLEJ(4),TITLEM(4) DATA TITLED / 8HDIODE MO, 8HDEL PARA, 8HMETERS , 8H / DATA TITLEB / 8HBJT MODE, 8HL PARAME, 8HTERS , 8H / DATA TITLEJ / 8HJFET MOD, 8HEL PARAM, 8HETERS , 8H / DATA TITLEM / 8HMOSFET M, 8HODEL PAR, 8HAMETERS , 8H / DATA ANTYPE /0,3HNPN,3HNJF,4HNMOS/ DATA APTYPE /0,3HPNP,3HPJF,4HPMOS/ DATA IPAR / 0, 14, 43, 55, 85 / DATA AMPAR / 1 6HIS ,6HRS ,6HN ,6HTT ,6HCJO ,6HPB ,6HM , 2 6HEG ,6HPT ,6HKF ,6HAF ,6HFC ,6HBV ,6HIBV , 1 6HBF ,6HBR ,6HIS ,6HRB ,6HRC ,6HRE ,6HVA , 2 6HVB ,6HIK ,6HC2 ,6HNE ,6HIKR ,6HC4 ,6HNC , 3 6HTF ,6HTR ,6HCCS ,6HCJE ,6HPE ,6HME ,6HCJC , 4 6HPC ,6HMC ,6HEG ,6HPT ,6HKF ,6HAF ,6HFC , 5 6HDELAY , 1 6HVTO ,6HBETA ,6HLAMBDA,6HRD ,6HRS ,6HCGS ,6HCGD , 2 6HPB ,6HIS ,6HKF ,6HAF ,6HFC , 1 6HVTO ,6HKP ,6HGAMMA ,6HPHI ,6HLAMBDA,6HRD ,6HRS , 2 6HCGD ,6HCGS ,6HCGB ,6HCBD ,6HCBS ,6HTOX ,6HPB , 3 6HJS ,6HNSUB ,6HNSS ,6HNFS ,6HXJ ,6HLD ,6HNGATE , 4 6HTPS ,6HUO ,6HUCRIT ,6HUEXP ,6HUTRA ,6HKF ,6HAF , 5 6HFC ,6HLEVEL , 1 5*0.0 / DATA PRPOSN / 1 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14, 2 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,16,17,18,19,20, 3 21,22,23,24,25,26,27,28,29, 4 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12, 5 30, 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,16,17,18,19, 6 20,21,22,23,24,25,26,27,28,29, 7 5*0 / DATA DEFVAL / 1 1.0E-14, 0.0, 1.0, 2*0.0, 1.0, 0.5, 1.11, 2 3.0,0.0,1.0,0.5,0.0,1.0E-3, 1 100.0, 1.0,1.0E-14, 7*0.0, 2.0, 2*0.0, 2.0, 2 4*0.0, 1.0, 0.5, 0.0, 1.0, 0.5, 1.11, 3 3.0, 0.0, 1.0, 0.5, 4 0.0, 1 -2.0, 1.0E-4, 5*0.0, 1.0,1.0E-14, 0.0, 1.0, 2 0.5, 1 0.0, 1.0E-5, 0.0, 0.6, 9*0.0, 0.8, 1.0E-8, 2 4*0.0, 0.8, 0.0, 1.0, 700.0, 1.0E+4, 3*0.0, 3 1.0, 0.5, 1.0, 1 5*0.0 / DATA IFMT / 1 4,1,1,2,2,1,1,1,1,2,1,1,2,2, 2 3,3,4,1,1,1,1,1,2,2,1,2,2,1,2,2,2,2,1,1,2,1,1,1,1,2,1,1,2, 3 3,4,1,1,1,2,2,1,2,2,1,1, 4 3,4,1,1,2,1,1,2,2,2,2,2,2,1,2,2,2,2,2,2,2,1,1,2,1,1,2,1,1,3, 5 5*0 / DATA IVCHK / 1 0,0,0,0,0,0,0,0,0,0,0,0,0,0, 2 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 3 -1,0,0,0,0,0,0,0,0,0,0,0, 4 -1,0,0,-1,0,0,0,0,0,0,0,0,0,0,0,0,-1,0,0,0,0,-1,0,0,0,0,0,0,0, 5 0, 6 5*0 / C C TNOM=VALUE(ITEMPS+1)+CTOK XKT=BOLTZ*TNOM VT=XKT/CHARGE XNI=1.45E10 EGFET=1.12 NUMMOD=JELCNT(21)+JELCNT(22)+JELCNT(23)+JELCNT(24) IF (NUMMOD.EQ.0) GO TO 1000 C C SPECIAL PREPROCESSING FOR MOSFET MODELS C LOC=LOCATE(24) 10 IF (LOC.EQ.0) GO TO 28 LOCV=NODPLC(LOC+1) TYPE=NODPLC(LOC+2) C C DEFAULT PARAMETERS FOR HIGHER LEVEL MOS MODELS C LEV=VALUE(LOCV+30) VALUE(LOCV+36)=LEV XNSUB=VALUE(LOCV+16) IF (VALUE(LOCV+13).LE.0.0.AND.LEV.GT.1) VALUE(LOCV+13)=1.0E-5 IF (VALUE(LOCV+13).LE.0.0) GO TO 25 COX=EPSOX/VALUE(LOCV+13) IF (XNSUB.LE.0.0.AND.LEV.LT.3) GO TO 25 IF (XNSUB.LE.0.0) XNSUB=1.0E15 IF (XNSUB.LE.XNI) GO TO 23 C C NSUB NONZERO => PROCESS ORIENTED MODEL C IF (VALUE(LOCV+4).LE.0.0) VALUE(LOCV+4)= 1 AMAX1((2.0*VT*ALOG(XNSUB/XNI)),0.1) FERMIS=TYPE*0.5*VALUE(LOCV+4) WKFNG=3.2 IF (VALUE(LOCV+21).LE.0.0) GO TO 15 C C POLYSILICON GATE C FERMIG=TYPE*VALUE(LOCV+22)*VT*ALOG(VALUE(LOCV+21)/XNI) WKFNG=3.25+0.5*EGFET-FERMIG 15 WKFNGS=WKFNG-(3.25+0.5*EGFET+FERMIS) IF (VALUE(LOCV+3).LE.0.0) 1 VALUE(LOCV+3)=SQRT(2.0*EPSSIL*CHARGE*XNSUB)/COX C C COMPUTED VTO C IF (VALUE(LOCV+1).NE.0.0) GO TO 20 VALUE(LOCV+34)=WKFNGS-VALUE(LOCV+17)*CHARGE/COX VALUE(LOCV+1)=VALUE(LOCV+34) 1 +TYPE*(VALUE(LOCV+3)*SQRT(VALUE(LOCV+4))+VALUE(LOCV+4)) GO TO 21 C C MEASURED VTO HAS BEEN INPUT C 20 VALUE(LOCV+34)=VALUE(LOCV+1) 1 -TYPE*(VALUE(LOCV+3)*SQRT(VALUE(LOCV+4))+VALUE(LOCV+4)) C C COMPUTE KP, IF NOT INPUT, USING DEFAULT MOBILITY 600 CM**2/V*SEC C 21 IF (VALUE(LOCV+2).GT.0.0) GO TO 22 IF (VALUE(LOCV+23).LE.0.0) VALUE(LOCV+23)=600.0 VALUE(LOCV+2)=VALUE(LOCV+23)*COX 22 IF (LEV.GT.2) GO TO 25 VALUE(LOCV+35)=SQRT((EPSSIL+EPSSIL)/(CHARGE*XNSUB)) GO TO 25 23 VALUE(LOCV+16)=0.0 WRITE (6,24) VALUE(LOCV) 24 FORMAT("0*ERROR*: NSUB@NI IN MOSFET MODEL ",A8,/) NOGO=1 25 LOC=NODPLC(LOC) GO TO 10 C C ASSIGN DEFAULT VALUES C 28 KNTLIM=LWIDTH/11 DO 390 ID=1,4 IF (JELCNT(ID+20).EQ.0) GO TO 390 LOCM=IPAR(ID) NOPAR=IPAR(ID+1)-LOCM DO 40 I=1,NOPAR IF (IFMT(LOCM+I).GE.3) GO TO 30 ITAB(I)=0 GO TO 40 30 ITAB(I)=IFMT(LOCM+I)-2 40 CONTINUE LOC=LOCATE(ID+20) 50 IF (LOC.EQ.0) GO TO 75 LOCV=NODPLC(LOC+1) DO 70 I=1,NOPAR IF (VALUE(LOCV+I).EQ.0.0) GO TO 60 IF (IVCHK(LOCM+I).LT.0) GO TO 55 IF (VALUE(LOCV+I).LT.0.0) GO TO 60 55 IF (ITAB(I).NE.0) GO TO 70 ITAB(I)=IFMT(LOCM+I) GO TO 70 60 VALUE(LOCV+I)=DEFVAL(LOCM+I) 70 CONTINUE LOC=NODPLC(LOC) GO TO 50 C C LIMIT MODEL VALUES C 75 GO TO (80,85,90,95), ID C... DIODES 80 LOC=LOCATE(21) 82 IF (LOC.EQ.0) GO TO 100 LOCV=NODPLC(LOC+1) VALUE(LOCV+7)=AMIN1(VALUE(LOCV+7),0.9) VALUE(LOCV+8)=AMAX1(VALUE(LOCV+8),0.1) VALUE(LOCV+11)=AMAX1(VALUE(LOCV+11),0.1) VALUE(LOCV+12)=AMIN1(VALUE(LOCV+12),0.95) LOC=NODPLC(LOC) GO TO 82 C... BIPOLAR TRANSISTORS 85 LOC=LOCATE(22) 87 IF (LOC.EQ.0) GO TO 100 LOCV=NODPLC(LOC+1) VALUE(LOCV+20)=AMIN1(VALUE(LOCV+20),0.9) VALUE(LOCV+23)=AMIN1(VALUE(LOCV+23),0.9) VALUE(LOCV+24)=AMAX1(VALUE(LOCV+24),0.1) VALUE(LOCV+27)=AMAX1(VALUE(LOCV+27),0.1) VALUE(LOCV+28)=AMIN1(VALUE(LOCV+28),0.95) IF (VALUE(LOCV+29).GE.1.0) 1 VALUE(LOCV+29)=(VALUE(LOCV+29)/RAD)*VALUE(LOCV+15) LOC=NODPLC(LOC) GO TO 87 C... JFETS 90 LOC=LOCATE(23) 92 IF (LOC.EQ.0) GO TO 100 LOCV=NODPLC(LOC+1) VALUE(LOCV+11)=AMAX1(VALUE(LOCV+11),0.1) VALUE(LOCV+12)=AMIN1(VALUE(LOCV+12),0.95) LOC=NODPLC(LOC) GO TO 92 C... MOSFETS 95 LOC=LOCATE(24) 97 IF (LOC.EQ.0) GO TO 100 LOCV=NODPLC(LOC+1) VALUE(LOCV+28)=AMAX1(VALUE(LOCV+28),0.1) VALUE(LOCV+29)=AMIN1(VALUE(LOCV+29),0.95) IF (VALUE(LOCV+30).GT.3.0) VALUE(LOCV+30)=1.0 VALUE(LOCV+36)=VALUE(LOCV+30) IF (VALUE(LOCV+5).GE.0.20) WRITE (6,98) VALUE(LOCV) 98 FORMAT("0WARNING: THE VALUE OF LAMBDA FOR MOSFET MODEL "A8,/, 1 " IS UNUSUALLY LARGE AND MAY CAUSE NONCONVERGENCE",/) LOC=NODPLC(LOC) GO TO 97 C C PRINT MODEL PARAMETERS C 100 IF (IPRNTM.EQ.0) GO TO 390 LOCS=LOCATE(ID+20) 110 KNTR=0 LOC=LOCS GO TO (120,130,140,150),ID 120 CALL TITLE(0,LWIDTH,1,TITLED) GO TO 200 130 CALL TITLE(0,LWIDTH,1,TITLEB) GO TO 200 140 CALL TITLE(0,LWIDTH,1,TITLEJ) GO TO 200 150 CALL TITLE(0,LWIDTH,1,TITLEM) 200 IF (LOC.EQ.0) GO TO 210 IF (KNTR.LT.KNTLIM) GO TO 220 210 LOCN=LOC GO TO 240 220 KNTR=KNTR+1 LOCV=NODPLC(LOC+1) ATABLE(KNTR)=VALUE(LOCV) 230 LOC=NODPLC(LOC) GO TO 200 240 WRITE (6,241) (ATABLE(K),K=1,KNTR) 241 FORMAT(//11X,12(2X,A8)) IF (ID.EQ.1) GO TO 300 KNTR=0 LOC=LOCS 250 IF (LOC.EQ.0) GO TO 260 IF (KNTR.GE.KNTLIM) GO TO 260 KNTR=KNTR+1 ATABLE(KNTR)=ANTYPE(ID) IF (NODPLC(LOC+2).EQ.-1) ATABLE(KNTR)=APTYPE(ID) LOC=NODPLC(LOC) GO TO 250 260 WRITE (6,261) (ATABLE(K),K=1,KNTR) 261 FORMAT("0TYPE",4X,12(4X,A4,2X)) 300 DO 340 II=1,NOPAR I=PRPOSN(LOCM+II) IF (ITAB(I).EQ.0) GO TO 340 KNTR=0 LOC=LOCS 310 IF (LOC.EQ.0) GO TO 320 IF (KNTR.GE.KNTLIM) GO TO 320 LOCV=NODPLC(LOC+1) KNTR=KNTR+1 ATABLE(KNTR)=VALUE(LOCV+I) LOC=NODPLC(LOC) GO TO 310 320 IF (ITAB(I).EQ.2) GO TO 330 WRITE (6,321) AMPAR(LOCM+I),(ATABLE(K),K=1,KNTR) 321 FORMAT(1H0,A8,12F10.3) GO TO 340 330 WRITE (6,331) AMPAR(LOCM+I),(ATABLE(K),K=1,KNTR) 331 FORMAT(1H0,A8,1P12E10.2) 340 CONTINUE IF (LOCN.EQ.0) GO TO 390 LOCS=LOCN GO TO 110 390 CONTINUE C C PROCESS MODEL PARAMETERS C C DIODES C 400 LOC=LOCATE(21) 410 IF (LOC.EQ.0) GO TO 420 LOCV=NODPLC(LOC+1) IF (VALUE(LOCV+2).NE.0.0) VALUE(LOCV+2)=1.0/VALUE(LOCV+2) PB=VALUE(LOCV+6) XM=VALUE(LOCV+7) FC=VALUE(LOCV+12) VALUE(LOCV+12)=FC*PB XFC=ALOG(1.0-FC) VALUE(LOCV+15)=PB*(1.0-EXP((1.0-XM)*XFC))/(1.0-XM) VALUE(LOCV+16)=EXP((1.0+XM)*XFC) VALUE(LOCV+17)=1.0-FC*(1.0+XM) CSAT=VALUE(LOCV+1) VTE=VALUE(LOCV+3)*VT VALUE(LOCV+18)=VTE*ALOG(VTE/(ROOT2*CSAT)) BV=VALUE(LOCV+13) IF (BV.EQ.0) GO TO 418 CBV=VALUE(LOCV+14) IF (CBV.GE.CSAT*BV/VT) GO TO 412 CBV=CSAT*BV/VT WRITE (6,411) VALUE(LOCV),CBV 411 FORMAT("0WARNING: IN DIODE MODEL ",A8," IBV INCREASED TO ",1PE10. 1 11X,"TO RESOLVE INCOMPATIBILITY WITH SPECIFIED IS",/) XBV=BV GO TO 416 412 TOL=RELTOL*CBV XBV=BV-VT*ALOG(1.0+CBV/CSAT) ITER=0 413 XBV=BV-VT*ALOG(CBV/CSAT+1.0-XBV/VT) XCBV=CSAT*(EXP((BV-XBV)/VT)-1.0+XBV/VT) IF (ABS(XCBV-CBV).LE.TOL) GO TO 416 ITER=ITER+1 IF (ITER.LT.25) GO TO 413 WRITE (6,415) XBV,XCBV 415 FORMAT("0WARNING: UNABLE TO MATCH FORWARD AND REVERSE DIODE REGIO 1NS",/,11X,"BV = ",1PE10.3," AND IBV = ",E10.3,/) 416 VALUE(LOCV+13)=XBV 418 LOC=NODPLC(LOC) GO TO 410 C C BIPOLAR TRANSISTOR MODELS C 420 LOC=LOCATE(22) 430 IF (LOC.EQ.0) GO TO 440 LOCV=NODPLC(LOC+1) IF (VALUE(LOCV+4).NE.0.0) VALUE(LOCV+4)=1.0/VALUE(LOCV+4) IF (VALUE(LOCV+5).NE.0.0) VALUE(LOCV+5)=1.0/VALUE(LOCV+5) IF (VALUE(LOCV+6).NE.0.0) VALUE(LOCV+6)=1.0/VALUE(LOCV+6) IF (VALUE(LOCV+7).NE.0.0) VALUE(LOCV+7)=1.0/VALUE(LOCV+7) IF (VALUE(LOCV+8).NE.0.0) VALUE(LOCV+8)=1.0/VALUE(LOCV+8) IF (VALUE(LOCV+9).NE.0.0) VALUE(LOCV+9)=1.0/VALUE(LOCV+9) IF (VALUE(LOCV+12).NE.0.0) VALUE(LOCV+12)=1.0/VALUE(LOCV+12) PE=VALUE(LOCV+19) XME=VALUE(LOCV+20) PC=VALUE(LOCV+22) XMC=VALUE(LOCV+23) FC=VALUE(LOCV+28) VALUE(LOCV+28)=FC*PE XFC=ALOG(1.0-FC) VALUE(LOCV+30)=PE*(1.0-EXP((1.0-XME)*XFC))/(1.0-XME) VALUE(LOCV+31)=EXP((1.0+XME)*XFC) VALUE(LOCV+32)=1.0-FC*(1.0+XME) VALUE(LOCV+33)=FC*PC VALUE(LOCV+34)=PC*(1.0-EXP((1.0-XMC)*XFC))/(1.0-XMC) VALUE(LOCV+35)=EXP((1.0+XMC)*XFC) VALUE(LOCV+36)=1.0-FC*(1.0+XMC) CSAT=VALUE(LOCV+3) VALUE(LOCV+37)=VT*ALOG(VT/(ROOT2*CSAT)) LOC=NODPLC(LOC) GO TO 430 C C JFET MODELS C 440 LOC=LOCATE(23) 450 IF (LOC.EQ.0) GO TO 460 LOCV=NODPLC(LOC+1) IF (VALUE(LOCV+4).NE.0.0) VALUE(LOCV+4)=1.0/VALUE(LOCV+4) IF (VALUE(LOCV+5).NE.0.0) VALUE(LOCV+5)=1.0/VALUE(LOCV+5) PB=VALUE(LOCV+8) XM=0.5 FC=VALUE(LOCV+12) VALUE(LOCV+12)=FC*PB XFC=ALOG(1.0-FC) VALUE(LOCV+13)=PB*(1.0-EXP((1.0-XM)*XFC))/(1.0-XM) VALUE(LOCV+14)=EXP((1.0+XM)*XFC) VALUE(LOCV+15)=1.0-FC*(1.0+XM) CSAT=VALUE(LOCV+9) VALUE(LOCV+16)=VT*ALOG(VT/(ROOT2*CSAT)) LOC=NODPLC(LOC) GO TO 450 C C MOSFET MODELS C 460 LOC=LOCATE(24) 470 IF (LOC.EQ.0) GO TO 600 LOCV=NODPLC(LOC+1) TYPE=NODPLC(LOC+2) IF (VALUE(LOCV+6).NE.0.0) VALUE(LOCV+6)=1.0/VALUE(LOCV+6) IF (VALUE(LOCV+7).NE.0.0) VALUE(LOCV+7)=1.0/VALUE(LOCV+7) C C SAVE TOX FOR EL-MANSY MOSFET MODEL C VALUE(LOCV+37)=VALUE(LOCV+13) C IF (VALUE(LOCV+13).NE.0.0) VALUE(LOCV+13)=COX PB=VALUE(LOCV+14) XM=0.5 FC=VALUE(LOCV+29) VALUE(LOCV+29)=FC*PB XFC=ALOG(1.0-FC) VALUE(LOCV+30)=PB*(1.0-EXP((1.0-XM)*XFC))/(1.0-XM) VALUE(LOCV+31)=EXP((1.0+XM)*XFC) VALUE(LOCV+32)=1.0-FC*(1.0+XM) VALUE(LOCV+33)=-1.0 C IF (VALUE(LOCV+36).GT.2.0) GO TO 476 C VALUE(LOCV+34)=VALUE(LOCV+1)- 1 TYPE*VALUE(LOCV+3)*SQRT(VALUE(LOCV+4)) 475 IF (VALUE(LOCV+13).NE.0.0) 1 VALUE(LOCV+24)=VALUE(LOCV+24)*EPSSIL/VALUE(LOCV+13) GO TO 480 C C PROCESS EL-MANSY"S MOSFET MODEL PARAMETERS C 476 VALUE(LOCV+34)=VALUE(LOCV+34)/VT VALUE(LOCV+35)=SQRT(VT)/VALUE(LOCV+3) ALPHA=VALUE(LOCV+35) VALUE(LOCV+38)=VT/ALPHA VALUE(LOCV+39)=(ALPHA+ALPHA)+1.0/ALPHA TAHPLA=1.0/(ALPHA+ALPHA) VALUE(LOCV+40)=TAHPLA VALUE(LOCV+41)=TAHPLA*TAHPLA VALUE(LOCV+42)=VALUE(LOCV+4)/(2.0*VT) C C SCATTERING LIMITED VELOCITY C VLIM=1.0E7 IF (TYPE.LT.0.0) VLIM=6.0E6 VALUE(LOCV+43)=VALUE(LOCV+23)/VLIM 480 LOC=NODPLC(LOC) GO TO 470 C C RESERVE ADDITIONAL NODES C C DIODES C 600 LOC=LOCATE(11) 610 IF (LOC.EQ.0) GO TO 700 LOCM=NODPLC(LOC+5) LOCM=NODPLC(LOCM+1) IF (VALUE(LOCM+2).EQ.0.0) GO TO 620 NUMNOD=NUMNOD+1 NODPLC(LOC+4)=NUMNOD GO TO 630 620 NODPLC(LOC+4)=NODPLC(LOC+2) 630 LOC=NODPLC(LOC) GO TO 610 C C TRANSISTORS C 700 LOC=LOCATE(12) 710 IF (LOC.EQ.0) GO TO 800 LOCM=NODPLC(LOC+8) LOCM=NODPLC(LOCM+1) IF (VALUE(LOCM+4).EQ.0.0) GO TO 720 NUMNOD=NUMNOD+1 NODPLC(LOC+6)=NUMNOD GO TO 730 720 NODPLC(LOC+6)=NODPLC(LOC+3) 730 IF (VALUE(LOCM+5).EQ.0.0) GO TO 740 NUMNOD=NUMNOD+1 NODPLC(LOC+5)=NUMNOD GO TO 750 740 NODPLC(LOC+5)=NODPLC(LOC+2) 750 IF (VALUE(LOCM+6).EQ.0.0) GO TO 760 NUMNOD=NUMNOD+1 NODPLC(LOC+7)=NUMNOD GO TO 770 760 NODPLC(LOC+7)=NODPLC(LOC+4) 770 LOC=NODPLC(LOC) GO TO 710 C C JFETS C 800 LOC=LOCATE(13) 810 IF (LOC.EQ.0) GO TO 900 LOCM=NODPLC(LOC+7) LOCM=NODPLC(LOCM+1) IF (VALUE(LOCM+4).EQ.0.0) GO TO 820 NUMNOD=NUMNOD+1 NODPLC(LOC+5)=NUMNOD GO TO 830 820 NODPLC(LOC+5)=NODPLC(LOC+2) 830 IF (VALUE(LOCM+5).EQ.0.0) GO TO 840 NUMNOD=NUMNOD+1 NODPLC(LOC+6)=NUMNOD GO TO 850 840 NODPLC(LOC+6)=NODPLC(LOC+4) 850 LOC=NODPLC(LOC) GO TO 810 C C MOSFETS C 900 LOC=LOCATE(14) 910 IF (LOC.EQ.0) GO TO 1000 LOCM=NODPLC(LOC+8) LOCM=NODPLC(LOCM+1) IF (VALUE(LOCM+6).EQ.0.0) GO TO 920 NUMNOD=NUMNOD+1 NODPLC(LOC+6)=NUMNOD GO TO 930 920 NODPLC(LOC+6)=NODPLC(LOC+2) 930 IF (VALUE(LOCM+7).EQ.0.0) GO TO 940 NUMNOD=NUMNOD+1 NODPLC(LOC+7)=NUMNOD GO TO 950 940 NODPLC(LOC+7)=NODPLC(LOC+4) 950 LOC=NODPLC(LOC) GO TO 910 C C TRANSMISSION LINES C 1000 LOC=LOCATE(17) 1010 IF (LOC.EQ.0) GO TO 2000 NUMNOD=NUMNOD+1 NODPLC(LOC+6)=NUMNOD NUMNOD=NUMNOD+1 NODPLC(LOC+7)=NUMNOD LOC=NODPLC(LOC) GO TO 1010 C C FINISHED C 2000 RETURN END SUBROUTINE TOPCHK C C THIS ROUTINE CONSTRUCTS THE ELEMENT NODE TABLE. IT ALSO CHECKS C FOR VOLTAGE SOURCE/INDUCTOR LOOPS, CURRENT SOURCE/CAPACITOR CUTSETS, C AND THAT EVERY NODE HAS A DC (CONDUCTIVE) PATH TO GROUND. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /MISCEL/ APROG(3),ATIME,ADATE,ATITLE(15),RSTATS(50), 1 IWIDTH,LWIDTH,NOPAGE COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C DIMENSION ATABLE(12),AIDE(20),NNODS(20) DIMENSION IDLIST(4) DIMENSION TOPTIT(4) DATA TOPTIT / 8HELEMENT , 8HNODE TAB, 8HLE , 8H / DATA IDLIST / 3, 6, 8, 9 / DATA AIDE / 1HR,0.0,1HL,2*0.0,1HE,0.0,1HH,1HV,0.0,1HD,1HQ,1HJ,1HM, 1 0.0,0.0,1HT,0.0,0.0,0.0 / DATA NNODS / 2,2,2,0,2,2,2,2,2,2,2,3,3,4,4,4,4,0,1,0 / DATA ABLNK /1H / C C ALLOCATE STORAGE C CALL GETMEM(IORDER,NCNODS) CALL GETMEM(IUR,NCNODS+1) C C CONSTRUCT NODE TABLE C KNTLIM=LWIDTH/11 1300 CALL GETMEM(ITABLE,0) CALL GETMEM(ITABID,0) ISTOP=NCNODS+1 DO 1310 I=1,ISTOP 1310 NODPLC(IUR+I)=1 DO 1370 ID=1,19 IF (NNODS(ID).EQ.0) GO TO 1370 LOC=LOCATE(ID) 1320 IF (LOC.EQ.0) GO TO 1370 NLOC=LOC+1 JSTOP=NNODS(ID) IF (ID.NE.19) GO TO 1330 NLOC=NODPLC(LOC+2) CALL SIZMEM(NODPLC(LOC+2),JSTOP) 1330 DO 1360 J=1,JSTOP NODE=NODPLC(NLOC+J) ISPOT=NODPLC(IUR+NODE+1) K=NODPLC(IUR+NCNODS+1) CALL EXTMEM(ITABLE,1) CALL EXTMEM(ITABID,1) IF (K.LE.ISPOT) GO TO 1340 CALL COPY4(NODPLC(ITABLE+ISPOT),NODPLC(ITABLE+ISPOT+1),K-ISPOT) CALL COPY4(NODPLC(ITABID+ISPOT),NODPLC(ITABID+ISPOT+1),K-ISPOT) 1340 NODPLC(ITABLE+ISPOT)=LOC NODPLC(ITABID+ISPOT)=ID K=NODE KSTOP=NCNODS+1 1350 K=K+1 IF (K.GT.KSTOP) GO TO 1360 NODPLC(IUR+K)=NODPLC(IUR+K)+1 GO TO 1350 1360 CONTINUE LOC=NODPLC(LOC) GO TO 1320 1370 CONTINUE C C CHECK THAT EVERY NODE HAS A DC PATH TO GROUND C CALL ZERO4(NODPLC(IORDER+1),NCNODS) NODPLC(IORDER+1)=1 1420 IFLAG=0 DO 1470 I=2,NCNODS IF (NODPLC(IORDER+I).EQ.1) GO TO 1470 JSTART=NODPLC(IUR+I) JSTOP=NODPLC(IUR+I+1)-1 IF (JSTART.GT.JSTOP) GO TO 1470 DO 1450 J=JSTART,JSTOP LOC=NODPLC(ITABLE+J) ID=NODPLC(ITABID+J) IF (AIDE(ID).EQ.0.0) GO TO 1450 IF (ID.EQ.17) GO TO 1445 KSTOP=LOC+NNODS(ID)-1 DO 1440 K=LOC,KSTOP NODE=NODPLC(K+2) IF (NODPLC(IORDER+NODE).EQ.1) GO TO 1460 1440 CONTINUE GO TO 1450 1445 IF (NODPLC(LOC+2).EQ.I) NODE=NODPLC(LOC+3) IF (NODPLC(LOC+3).EQ.I) NODE=NODPLC(LOC+2) IF (NODPLC(LOC+4).EQ.I) NODE=NODPLC(LOC+5) IF (NODPLC(LOC+5).EQ.I) NODE=NODPLC(LOC+4) IF (NODPLC(IORDER+NODE).EQ.1) GO TO 1460 1450 CONTINUE GO TO 1470 1460 NODPLC(IORDER+I)=1 IFLAG=1 1470 CONTINUE IF (IFLAG.EQ.1) GO TO 1420 C C PRINT NODE TABLE AND TOPOLOGY ERROR MESSAGES C IF (IPRNTN.EQ.0) GO TO 1510 CALL TITLE(0,LWIDTH,1,TOPTIT) 1510 DO 1590 I=1,NCNODS JSTART=NODPLC(IUR+I) JSTOP=NODPLC(IUR+I+1)-1 IF (IPRNTN.EQ.0) GO TO 1550 IF (JSTART.LE.JSTOP) GO TO 1520 WRITE (6,1511) NODPLC(JUNODE+I) 1511 FORMAT(1H0,I7) GO TO 1550 1520 KNTR=0 JFLAG=1 DO 1540 J=JSTART,JSTOP LOC=NODPLC(ITABLE+J) LOCV=NODPLC(LOC+1) KNTR=KNTR+1 ATABLE(KNTR)=VALUE(LOCV) IF (KNTR.LT.KNTLIM) GO TO 1540 IF (JFLAG.EQ.0) GO TO 1525 JFLAG=0 WRITE (6,1521) NODPLC(JUNODE+I),(ATABLE(K),K=1,KNTR) 1521 FORMAT(1H0,I7,3X,12(1X,A8)) GO TO 1530 1525 WRITE (6,1526) (ATABLE(K),K=1,KNTR) 1526 FORMAT(11X,12(1X,A8)) 1530 KNTR=0 1540 CONTINUE IF (KNTR.EQ.0) GO TO 1550 IF (JFLAG.EQ.0) GO TO 1545 WRITE (6,1521) NODPLC(JUNODE+I),(ATABLE(K),K=1,KNTR) GO TO 1550 1545 WRITE (6,1526) (ATABLE(K),K=1,KNTR) 1550 IF (JSTART-JSTOP) 1560,1552,1556 C C ALLOW NODE WITH ONLY ONE CONNECTION IFF ELEMENT IS A T-LINE C 1552 IF (NODPLC(ITABID+JSTART).EQ.17) GO TO 1560 1556 NOGO=1 WRITE (6,1557) NODPLC(JUNODE+I) 1557 FORMAT("0*ERROR*: LESS THAN 2 CONNECTIONS AT NODE ",I6/) GO TO 1590 1560 IF (NODPLC(IORDER+I).EQ.1) GO TO 1590 NOGO=1 WRITE (6,1561) NODPLC(JUNODE+I) 1561 FORMAT("0*ERROR*: NO DC PATH TO GROUND FROM NODE ",I6/) 1590 CONTINUE C C CHECK FOR INDUCTOR/VOLTAGE SOURCE LOOPS C DO 1700 I=1,NCNODS CALL ZERO4(NODPLC(IORDER+1),NCNODS) NODPLC(IORDER+I)=-1 DO 1690 IDCNTR=1,4 ID=IDLIST(IDCNTR) LOC=LOCATE(ID) 1610 IF (LOC.EQ.0) GO TO 1690 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) IF (NODPLC(IORDER+NODE1)) 1620,1640,1630 1620 NODPLC(IORDER+NODE1)=LOC 1630 NODE=NODE2 GO TO 1670 1640 IF (NODPLC(IORDER+NODE2)) 1650,1680,1660 1650 NODPLC(IORDER+NODE2)=LOC 1660 NODE=NODE1 1670 IF (NODPLC(IORDER+NODE).NE.0) GO TO 1710 NODPLC(IORDER+NODE)=LOC 1680 LOC=NODPLC(LOC) GO TO 1610 1690 CONTINUE 1700 CONTINUE GO TO 1900 C ... LOOP FOUND 1710 LOCV=NODPLC(LOC+1) WRITE (6,1711) VALUE(LOCV) 1711 FORMAT("0*ERROR*: INDUCTOR/VOLTAGE SOURCE LOOP FOUND, CONTAINING 1",A8/) NOGO=1 C C 1900 CALL CLRMEM(IORDER) CALL CLRMEM(IUR) CALL CLRMEM(ITABLE) CALL CLRMEM(ITABID) 2000 RETURN END OVERLAY(3,0) PROGRAM SETUP C C THIS ROUTINE DRIVES THE SPARSE MATRIX SETUP USED BY SPICE. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /MISCEL/ APROG(3),ATIME,ADATE,ATITLE(15),RSTATS(50), 1 IWIDTH,LWIDTH,NOPAGE COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET, 1 MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO, 2 ITEMNO,NOSOLV,MODAC COMMON /DC/ TCSTAR,TCSTOP,TCINCR,ICVFLG,ITCELM,KSSOP,KINEL,KIDIN, 1 KOVAR,KIDOUT COMMON /AC/ FSTART,FSTOP,FINCR,SKW2,REFPRL,SPW2,JACFLG,IDFREQ, 1 INOISE,NOSPRT,NOSOUT,NOSIN,IDIST,IDPRT,JPZFLG,JPZTYP, 2 IPZIN,IPZITP,IPZOUT,IPZEQO,IPZLOC(2),IPZEQI,IPOMAT(3), 3 IPIMAT(4) COMMON /DEBUG/ IDEBUG(20) COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C LOGICAL MEMPTR C C CALL SECOND(T1) NSTOP=NUMNOD+JELCNT(3)+JELCNT(6)+JELCNT(8)+JELCNT(9)+2*JELCNT(17) IF (MODE.NE.3) GO TO 10 IF (MODAC.NE.3) GO TO 10 NSTOP=NSTOP+1 IF (IPZITP.EQ.41) NSTOP=NSTOP+1 C C CLEAR OLD TABLES C IF (MEMPTR(ISWAP)) CALL CLRMEM(ISWAP) IF (MEMPTR(IORDER)) CALL CLRMEM(IORDER) IF (MEMPTR(IUR)) CALL CLRMEM(IUR) IF (MEMPTR(ILC)) CALL CLRMEM(ILC) IF (MEMPTR(IUC)) CALL CLRMEM(IUC) IF (MEMPTR(ILR)) CALL CLRMEM(ILR) IF (MEMPTR(MACINS)) CALL CLRMEM(MACINS) C C RESERVE MATRIX LOCATIONS FOR EACH ELEMENT C 10 CALL MATPTR IF (NOGO.NE.0) GO TO 1000 C C REORDER MATRIX POINTERS FOR MINIMAL FILL-IN C NTTBR=0 DO 120 I=2,NSTOP LOC=ISR+I 110 IF (NODPLC(LOC).EQ.0) GO TO 120 LOC=NODPLC(LOC) NTTBR=NTTBR+1 GO TO 110 120 CONTINUE C... ADD GROUND NTTBR=NTTBR+1 CALL REORDR IF (NOGO.NE.0) GO TO 1000 NTTAR=NODPLC(IUR+NSTOP+1)-1+NODPLC(ILC+NSTOP+1)-1+NSTOP IFILL=NTTAR-NTTBR PERSPA=100.0*(1.0-FLOAT(NTTAR)/FLOAT(NSTOP*NSTOP)) IOPS=0 DO 130 I=2,NSTOP NOFFR=NODPLC(IUR+I+1)-NODPLC(IUR+I) NOFFC=NODPLC(ILC+I+1)-NODPLC(ILC+I) IOPS=IOPS+NOFFR+NOFFC*(NOFFR+2)+1 130 CONTINUE RSTATS(20)=NSTOP RSTATS(21)=NTTBR RSTATS(22)=NTTAR RSTATS(23)=IFILL RSTATS(24)=0.0 RSTATS(25)=NTTAR RSTATS(26)=IOPS RSTATS(27)=PERSPA C C STORE MATRIX LOCATIONS C CALL MATLOC CALL CLRMEM(ISR) CALL CLRMEM(ISEQ) CALL CLRMEM(ISEQ1) CALL CLRMEM(NEQN) CALL CLRMEM(NODEVS) CALL CLRMEM(NDIAG) CALL CLRMEM(NMOFFC) CALL CLRMEM(NUMOFF) CALL CLRMEM(IEQUA) CALL CLRMEM(JMNODE) C C GENERATE MACHINE CODE C IF (LVLCOD.NE.2) GO TO 1000 IF ((MODE.EQ.3).AND.(MODAC.EQ.3)) GO TO 1000 CALL CODGEN IF ((JACFLG+JPZFLG+NSENS+KINEL).NE.0) GO TO 1000 JDEBUG=0 DO 910 I=1,20 JDEBUG=JDEBUG+IABS(IDEBUG(I)) 910 CONTINUE IF (JDEBUG.NE.0) GO TO 1000 CALL CLRMEM(IORDER) CALL CLRMEM(IUR) CALL CLRMEM(IUC) CALL CLRMEM(ILR) CALL CLRMEM(ILC) C C FINISHED C 1000 CALL SECOND(T2) RSTATS(2)=RSTATS(2)+T2-T1 RETURN END SUBROUTINE MATPTR C C THIS ROUTINE (BY CALLS TO THE ROUTINE RESERVE) ESTABLISHES THE C NONZERO-ELEMENT STRUCTURE OF THE CIRCUIT EQUATION COEFFICIENT MATRIX. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET, 1 MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO, 2 ITEMNO,NOSOLV,MODAC COMMON /AC/ FSTART,FSTOP,FINCR,SKW2,REFPRL,SPW2,JACFLG,IDFREQ, 1 INOISE,NOSPRT,NOSOUT,NOSIN,IDIST,IDPRT,JPZFLG,JPZTYP, 2 IPZIN,IPZITP,IPZOUT,IPZEQO,IPZLOC(2),IPZEQI,IPOMAT(3), 3 IPIMAT(4) COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C ALLOCATE AND INITIALIZE STORAGE C CALL GETMEM(ISR,NSTOP+1) NUMVS=JELCNT(3)+JELCNT(6)+JELCNT(8)+JELCNT(9)+2*JELCNT(17) IF (MODE.NE.3) GO TO 10 IF (MODAC.NE.3) GO TO 10 IF (IPZITP.EQ.41) NUMVS=NUMVS+1 10 CALL GETMEM(ISEQ,NUMVS) CALL GETMEM(ISEQ1,NUMVS) CALL GETMEM(NEQN,NUMVS) CALL GETMEM(NODEVS,NUMNOD) CALL GETMEM(NDIAG,NSTOP) CALL GETMEM(NMOFFC,NSTOP) CALL GETMEM(NUMOFF,NSTOP) CALL CRUNCH C CALL ZERO4(NODPLC(ISR+1),NSTOP+1) CALL ZERO4(NODPLC(ISEQ1+1),NUMVS) CALL ZERO4(NODPLC(NODEVS+1),NUMNOD) CALL ZERO4(NODPLC(NDIAG+1),NSTOP) CALL ZERO4(NODPLC(NMOFFC+1),NSTOP) CALL ZERO4(NODPLC(NUMOFF+1),NSTOP) C NUMVS=0 NXTRM=0 NDIST=0 NTLIN=1 IBR=NUMNOD C C RESISTORS C LOC=LOCATE(1) 110 IF (LOC.EQ.0) GO TO 120 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) CALL RESERV(NODE1,NODE1) CALL RESERV(NODE1,NODE2) CALL RESERV(NODE2,NODE1) CALL RESERV(NODE2,NODE2) LOC=NODPLC(LOC) GO TO 110 C C CAPACITORS C 120 LOC=LOCATE(2) 130 IF (LOC.EQ.0) GO TO 400 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) CALL RESERV(NODE1,NODE2) CALL RESERV(NODE2,NODE1) NTEMP=NODPLC(NDIAG+NODE1) CALL RESERV(NODE1,NODE1) NODPLC(NDIAG+NODE1)=NTEMP NTEMP=NODPLC(NDIAG+NODE2) CALL RESERV(NODE2,NODE2) NODPLC(NDIAG+NODE2)=NTEMP NODPLC(LOC+8)=NXTRM+1 NXTRM=NXTRM+2 LOC=NODPLC(LOC) GO TO 130 C C INDUCTORS C 400 LOC=LOCATE(3) 430 IF (LOC.EQ.0) GO TO 440 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) IBR=IBR+1 NODPLC(LOC+4)=IBR CALL RESERV(NODE1,IBR) CALL RESERV(NODE2,IBR) CALL RESERV(IBR,NODE1) CALL RESERV(IBR,NODE2) NTEMP=NODPLC(NDIAG+IBR) CALL RESERV(IBR,IBR) NODPLC(NDIAG+IBR)=NTEMP NUMVS=NUMVS+1 NODPLC(ISEQ+NUMVS)=LOC NODPLC(NEQN+NUMVS)=IBR NODPLC(NODEVS+NODE1)=NODPLC(NODEVS+NODE1)+1 NODPLC(NODEVS+NODE2)=NODPLC(NODEVS+NODE2)+1 NODPLC(LOC+10)=NXTRM+1 NXTRM=NXTRM+2 LOC=NODPLC(LOC) GO TO 430 C C MUTUAL INDUCTORS C 440 LOC=LOCATE(4) 450 IF (LOC.EQ.0) GO TO 460 NL1=NODPLC(LOC+2) NL2=NODPLC(LOC+3) NL1=NODPLC(NL1+4) NL2=NODPLC(NL2+4) CALL RESERV(NL1,NL2) CALL RESERV(NL2,NL1) LOC=NODPLC(LOC) GO TO 450 C C NONLINEAR VOLTAGE-CONTROLLED CURRENT SOURCES C 460 LOC=LOCATE(5) 462 IF (LOC.EQ.0) GO TO 464 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NDIM=NODPLC(LOC+4) NDIM2=NDIM+NDIM LOCN=NODPLC(LOC+6) DO 463 I=1,NDIM2 NODE=NODPLC(LOCN+I) CALL RESERV(NODE1,NODE) CALL RESERV(NODE2,NODE) 463 CONTINUE NODPLC(LOC+12)=NXTRM+1 NXTRM=NXTRM+1+NDIM2 LOC=NODPLC(LOC) GO TO 462 C C NONLINEAR VOLTAGE CONTROLLED VOLTAGE SOURCES C 464 LOC=LOCATE(6) 466 IF (LOC.EQ.0) GO TO 468 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) IBR=IBR+1 NODPLC(LOC+6)=IBR CALL RESERV(NODE1,IBR) CALL RESERV(NODE2,IBR) CALL RESERV(IBR,NODE1) CALL RESERV(IBR,NODE2) NUMVS=NUMVS+1 NODPLC(ISEQ+NUMVS)=LOC NODPLC(NEQN+NUMVS)=IBR NODPLC(NODEVS+NODE1)=NODPLC(NODEVS+NODE1)+1 NODPLC(NODEVS+NODE2)=NODPLC(NODEVS+NODE2)+1 NDIM=NODPLC(LOC+4) NDIM2=NDIM+NDIM LOCN=NODPLC(LOC+7) DO 467 I=1,NDIM2 NODE=NODPLC(LOCN+I) CALL RESERV(IBR,NODE) 467 CONTINUE NODPLC(LOC+13)=NXTRM+1 NXTRM=NXTRM+2+NDIM2 LOC=NODPLC(LOC) GO TO 466 C C VOLTAGE SOURCES C 468 LOC=LOCATE(9) 470 IF (LOC.EQ.0) GO TO 472 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) IBR=IBR+1 NODPLC(LOC+6)=IBR CALL RESERV(NODE1,IBR) CALL RESERV(NODE2,IBR) CALL RESERV(IBR,NODE1) CALL RESERV(IBR,NODE2) NUMVS=NUMVS+1 NODPLC(ISEQ+NUMVS)=LOC NODPLC(NEQN+NUMVS)=IBR NODPLC(NODEVS+NODE1)=NODPLC(NODEVS+NODE1)+1 NODPLC(NODEVS+NODE2)=NODPLC(NODEVS+NODE2)+1 LOC=NODPLC(LOC) GO TO 470 C C NONLINEAR CURRENT CONTROLLED CURRENT SOURCES C 472 LOC=LOCATE(7) 474 IF (LOC.EQ.0) GO TO 476 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NDIM=NODPLC(LOC+4) LOCVS=NODPLC(LOC+6) DO 475 I=1,NDIM LOCVST=NODPLC(LOCVS+I) KBR=NODPLC(LOCVST+6) CALL RESERV(NODE1,KBR) CALL RESERV(NODE2,KBR) 475 CONTINUE NODPLC(LOC+12)=NXTRM+1 NXTRM=NXTRM+1+NDIM+NDIM LOC=NODPLC(LOC) GO TO 474 C C NONLINEAR CURRENT CONTROLLED VOLTAGE SOURCES C 476 LOC=LOCATE(8) 478 IF (LOC.EQ.0) GO TO 500 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) IBR=IBR+1 NODPLC(LOC+6)=IBR CALL RESERV(NODE1,IBR) CALL RESERV(NODE2,IBR) CALL RESERV(IBR,NODE1) CALL RESERV(IBR,NODE2) NUMVS=NUMVS+1 NODPLC(ISEQ+NUMVS)=LOC NODPLC(NEQN+NUMVS)=IBR NODPLC(NODEVS+NODE1)=NODPLC(NODEVS+NODE1)+1 NODPLC(NODEVS+NODE2)=NODPLC(NODEVS+NODE2)+1 NDIM=NODPLC(LOC+4) LOCVS=NODPLC(LOC+7) DO 479 I=1,NDIM LOCVST=NODPLC(LOCVS+I) KBR=NODPLC(LOCVST+6) CALL RESERV(IBR,KBR) 479 CONTINUE NODPLC(LOC+13)=NXTRM+1 NXTRM=NXTRM+2+NDIM+NDIM LOC=NODPLC(LOC) GO TO 478 C C DIODES C 500 LOC=LOCATE(11) 510 IF (LOC.EQ.0) GO TO 520 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NODE3=NODPLC(LOC+4) CALL RESERV(NODE1,NODE1) CALL RESERV(NODE2,NODE2) CALL RESERV(NODE3,NODE3) CALL RESERV(NODE1,NODE3) CALL RESERV(NODE2,NODE3) CALL RESERV(NODE3,NODE1) CALL RESERV(NODE3,NODE2) NODPLC(LOC+11)=NXTRM+1 NXTRM=NXTRM+5 NODPLC(LOC+12)=NDIST+1 NDIST=NDIST+7 LOC=NODPLC(LOC) GO TO 510 C C TRANSISTORS C 520 LOC=LOCATE(12) 530 IF (LOC.EQ.0) GO TO 540 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NODE3=NODPLC(LOC+4) NODE4=NODPLC(LOC+5) NODE5=NODPLC(LOC+6) NODE6=NODPLC(LOC+7) CALL RESERV(NODE1,NODE1) CALL RESERV(NODE2,NODE2) CALL RESERV(NODE3,NODE3) CALL RESERV(NODE4,NODE4) CALL RESERV(NODE5,NODE5) CALL RESERV(NODE6,NODE6) CALL RESERV(NODE1,NODE4) CALL RESERV(NODE2,NODE5) CALL RESERV(NODE3,NODE6) CALL RESERV(NODE4,NODE5) CALL RESERV(NODE4,NODE6) CALL RESERV(NODE5,NODE6) CALL RESERV(NODE4,NODE1) CALL RESERV(NODE5,NODE2) CALL RESERV(NODE6,NODE3) CALL RESERV(NODE5,NODE4) CALL RESERV(NODE6,NODE4) CALL RESERV(NODE6,NODE5) NODPLC(LOC+22)=NXTRM+1 NXTRM=NXTRM+14 NODPLC(LOC+23)=NDIST+1 NDIST=NDIST+21 LOC=NODPLC(LOC) GO TO 530 C C JFETS C 540 LOC=LOCATE(13) 550 IF (LOC.EQ.0) GO TO 560 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NODE3=NODPLC(LOC+4) NODE4=NODPLC(LOC+5) NODE5=NODPLC(LOC+6) CALL RESERV(NODE1,NODE1) CALL RESERV(NODE2,NODE2) CALL RESERV(NODE3,NODE3) CALL RESERV(NODE4,NODE4) CALL RESERV(NODE5,NODE5) CALL RESERV(NODE1,NODE4) CALL RESERV(NODE2,NODE4) CALL RESERV(NODE2,NODE5) CALL RESERV(NODE3,NODE5) CALL RESERV(NODE4,NODE5) CALL RESERV(NODE4,NODE1) CALL RESERV(NODE4,NODE2) CALL RESERV(NODE5,NODE2) CALL RESERV(NODE5,NODE3) CALL RESERV(NODE5,NODE4) NODPLC(LOC+19)=NXTRM+1 NXTRM=NXTRM+13 LOC=NODPLC(LOC) GO TO 550 C C MOSFETS C 560 LOC=LOCATE(14) 570 IF (LOC.EQ.0) GO TO 600 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NODE3=NODPLC(LOC+4) NODE4=NODPLC(LOC+5) NODE5=NODPLC(LOC+6) NODE6=NODPLC(LOC+7) CALL RESERV(NODE1,NODE1) CALL RESERV(NODE2,NODE2) CALL RESERV(NODE3,NODE3) CALL RESERV(NODE4,NODE4) CALL RESERV(NODE5,NODE5) CALL RESERV(NODE6,NODE6) CALL RESERV(NODE1,NODE5) CALL RESERV(NODE2,NODE4) CALL RESERV(NODE2,NODE5) CALL RESERV(NODE2,NODE6) CALL RESERV(NODE3,NODE6) CALL RESERV(NODE4,NODE5) CALL RESERV(NODE4,NODE6) CALL RESERV(NODE5,NODE6) CALL RESERV(NODE5,NODE1) CALL RESERV(NODE4,NODE2) CALL RESERV(NODE5,NODE2) CALL RESERV(NODE6,NODE2) CALL RESERV(NODE6,NODE3) CALL RESERV(NODE5,NODE4) CALL RESERV(NODE6,NODE4) CALL RESERV(NODE6,NODE5) NODPLC(LOC+26)=NXTRM+1 NXTRM=NXTRM+22 LOC=NODPLC(LOC) GO TO 570 C C TRANSMISSION LINES C 600 LOC=LOCATE(17) 610 IF (LOC.EQ.0) GO TO 700 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NODE3=NODPLC(LOC+4) NODE4=NODPLC(LOC+5) NI1=NODPLC(LOC+6) NI2=NODPLC(LOC+7) IBR1=IBR+1 IBR2=IBR+2 IBR=IBR+2 NODPLC(LOC+8)=IBR1 NODPLC(LOC+9)=IBR2 CALL RESERV(NODE1,NODE1) CALL RESERV(NODE1,NI1) CALL RESERV(NODE2,IBR1) CALL RESERV(NODE3,NODE3) CALL RESERV(NODE4,IBR2) CALL RESERV(NI1,NODE1) CALL RESERV(NI1,NI1) CALL RESERV(NI1,IBR1) CALL RESERV(NI2,NI2) CALL RESERV(NI2,IBR2) CALL RESERV(IBR1,NODE2) CALL RESERV(IBR1,NODE3) CALL RESERV(IBR1,NODE4) CALL RESERV(IBR1,NI1) CALL RESERV(IBR1,IBR2) CALL RESERV(IBR2,NODE1) CALL RESERV(IBR2,NODE2) CALL RESERV(IBR2,NODE4) CALL RESERV(IBR2,NI2) CALL RESERV(IBR2,IBR1) CALL RESERV(NODE3,NI2) CALL RESERV(NI2,NODE3) NUMVS=NUMVS+1 NODPLC(ISEQ+NUMVS)=LOC NODPLC(ISEQ1+NUMVS)=1 NODPLC(NEQN+NUMVS)=IBR1 NODPLC(NODEVS+NI1)=NODPLC(NODEVS+NI1)+1 NODPLC(NODEVS+NODE2)=NODPLC(NODEVS+NODE2)+1 NUMVS=NUMVS+1 NODPLC(ISEQ+NUMVS)=LOC NODPLC(ISEQ1+NUMVS)=2 NODPLC(NEQN+NUMVS)=IBR2 NODPLC(NODEVS+NI2)=NODPLC(NODEVS+NI2)+1 NODPLC(NODEVS+NODE4)=NODPLC(NODEVS+NODE4)+1 NODPLC(LOC+30)=NTLIN+1 NTLIN=NTLIN+2 LOC=NODPLC(LOC) GO TO 610 C C POLE/ZERO ANALYSIS SETUP C 700 IF (MODE.NE.3) GO TO 1000 IF (MODAC.NE.3) GO TO 1000 C C... INPUT EQUATION C IF (IPZITP.NE.41) GO TO 710 NODE1=NODPLC(IPZIN+2) NODE2=NODPLC(IPZIN+3) IBR=IBR+1 IPZEQI=IBR CALL RESERV(NODE1,IBR) CALL RESERV(NODE2,IBR) CALL RESERV(IBR,NODE1) CALL RESERV(IBR,NODE2) NUMVS=NUMVS+1 NODPLC(ISEQ+NUMVS)=IPZIN NODPLC(NEQN+NUMVS)=IBR NODPLC(NODEVS+NODE1)=NODPLC(NODEVS+NODE1)+1 NODPLC(NODEVS+NODE2)=NODPLC(NODEVS+NODE2)+1 C C... OUTPUT EQUATION C 710 IBR=IBR+1 IPZEQO=IBR IF (NODPLC(IPZOUT+5).NE.0) GO TO 720 C... VOLTAGE OUTPUT NODE1=NODPLC(IPZOUT+2) NODE2=NODPLC(IPZOUT+3) CALL RESERV(IBR,NODE1) CALL RESERV(IBR,NODE2) GO TO 800 C... CURRENT OUTPUT 720 IPTR=NODPLC(IPZOUT+2) IPTR=NODPLC(IPTR+6) CALL RESERV(IBR,IPTR) C C RESERVE ROOM FOR RHS COLUMN SWAP WITH OUTPUT C 800 IF (IPZITP.EQ.10) GO TO 810 IF (IPZITP.EQ.9) NUMEQN=NODPLC(IPZIN+6) IF (IPZITP.EQ.41) NUMEQN=IPZEQI CALL RESERV(NUMEQN,IPZEQO) GO TO 1000 810 NODE1=NODPLC(IPZIN+2) NODE2=NODPLC(IPZIN+3) CALL RESERV(NODE1,IPZEQO) CALL RESERV(NODE2,IPZEQO) C C FINISHED C 1000 RETURN END SUBROUTINE RESERV (NODE1,NODE2) C C THIS ROUTINE RECORDS THE FACT THAT THE (NODE1, NODE2) ELEMENT OF C THE CIRCUIT EQUATION COEFFICIENT MATRIX IS NONZERO. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C IF (NOGO.NE.0) GO TO 300 C... TEST FOR GROUND IF (NODE1.EQ.1) GO TO 300 IF (NODE2.EQ.1) GO TO 300 C C TEST FOR (NODE1,NODE2) MATRIX ELEMENT C LOC=ISR+NODE1 100 IF (NODPLC(LOC).EQ.0) GO TO 110 LOC=NODPLC(LOC) IF (NODPLC(LOC+1).EQ.NODE2) GO TO 300 GO TO 100 C C RESERVE (NODE1,NODE2) MATRIX ELEMENT C 110 NODPLC(NUMOFF+NODE1)=NODPLC(NUMOFF+NODE1)+1 NODPLC(NMOFFC+NODE2)=NODPLC(NMOFFC+NODE2)+1 CALL SIZMEM(NUMOFF,ISIZE) NEWLOC=NUMOFF+ISIZE+1 NODPLC(LOC)=NEWLOC CALL EXTMEM(NUMOFF,2) NODPLC(NEWLOC)=0 NODPLC(NEWLOC+1)=NODE2 C C MARK DIAGONAL C IF (NODE1.NE.NODE2) GO TO 300 NODPLC(NDIAG+NODE1)=1 C C FINISHED C 300 RETURN END SUBROUTINE REORDR C C THIS ROUTINE SWAPS ROWS IN THE COEFFICIENT MATRIX TO ELIMINATE C SINGULARITY PROBLEMS WHICH CAN BE RECOGNIZED BY EXAMINING THE CIRCUIT C TOPOLOGY. IT THEN REORDERS THE UNKNOWNS TO MINIMIZE FILLIN TERMS C WHICH OCCUR DURING LU FACTORIZATION. (TO MAXIMIZE SPARSITY). C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET, 1 MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO, 2 ITEMNO,NOSOLV,MODAC COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /DEBUG/ IDEBUG(20) COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C ALLOCATE AND INITIALIZE STORAGE C CALL GETMEM(ISWAP,NSTOP) CALL GETMEM(IEQUA,NSTOP) CALL GETMEM(IORDER,NSTOP) CALL GETMEM(JMNODE,NSTOP) CALL GETMEM(IUR,NSTOP+1) CALL GETMEM(ILC,NSTOP+1) CALL GETMEM(IUC,0) CALL GETMEM(ILR,0) C DO 10 I=1,NSTOP NODPLC(ISWAP+I)=I 10 CONTINUE CALL COPY4(NODPLC(ISWAP+1),NODPLC(IEQUA+1),NSTOP) CALL COPY4(NODPLC(ISWAP+1),NODPLC(IORDER+1),NSTOP) CALL COPY4(NODPLC(ISWAP+1),NODPLC(JMNODE+1),NSTOP) C C SWAP CURRENT EQUATIONS INTO ADMITTANCE PART OF EQUATION MATRIX C NEXTV=1 C*************************************** DIAGNOSTIC WRITE ************** IF (IDEBUG(8).LE.0) GO TO 100 WRITE (6,26) (NODPLC(NODEVS+I),I=1,NUMNOD) 26 FORMAT(" *DEBUG*: REORDR - NODEVS() = ",/,(5X,20I5)) WRITE (6,31) (NODPLC(NDIAG+I),I=1,NSTOP) 31 FORMAT(" *DEBUG*: REORDR - NDIAG() = ",/,(5X,20I5)) C*********************************************************************** C C FIND SUITABLE VOLTAGE SOURCE C 100 IF (NEXTV.GT.NUMVS) GO TO 150 IX=0 DO 130 I=NEXTV,NUMVS LOC=NODPLC(ISEQ+I) NODE=NODPLC(LOC+2) NFLAG=NODPLC(ISEQ1+I) IF (NFLAG.EQ.1) NODE=NODPLC(LOC+6) IF (NFLAG.EQ.2) NODE=NODPLC(LOC+7) IF (NODE.EQ.1) GO TO 110 IF (NODPLC(NODEVS+NODE).GE.2) GO TO 110 IF (NODPLC(NDIAG+NODE).EQ.0) GO TO 140 IX=I LOCX=LOC NODEX=NODE 110 NODE=NODPLC(LOC+3) IF (NFLAG.EQ.2) NODE=NODPLC(LOC+5) IF (NODE.EQ.1) GO TO 130 IF (NODPLC(NODEVS+NODE).GE.2) GO TO 130 120 IF (NODPLC(NDIAG+NODE).EQ.0) GO TO 140 IX=I LOCX=LOC NODEX=NODE 130 CONTINUE IF (IX.EQ.0) GO TO 590 I=IX LOC=LOCX NODE=NODEX C C RESEQUENCE VOLTAGE SOURCES C C*************************************** DIAGNOSTIC WRITE ************** 140 IF (IDEBUG(8).LE.0) GO TO 145 LOCV=NODPLC(LOC+1) WRITE (6,141) NEXTV,LOC,VALUE(LOCV),NODE,NODPLC(JUNODE+NODE), 1 NODPLC(NODEVS+NODE),NODPLC(NDIAG+NODE) 141 FORMAT(" *DEBUG*: REORDR - ROW-SWAP INFORMATION:",/, 1 " NEXTV, LOC, V(LOCV), NODE, JUNODE(), NODEVS(), NDIAG() -",/, 2 2I10,1X,A8,4I10) C*********************************************************************** 145 NODPLC(ISEQ+I)=NODPLC(ISEQ+NEXTV) NODPLC(ISEQ+NEXTV)=LOC LTEMP=NODPLC(ISEQ1+I) NODPLC(ISEQ1+I)=NODPLC(ISEQ1+NEXTV) NODPLC(ISEQ1+NEXTV)=LTEMP IBR=NODPLC(NEQN+I) NODPLC(NEQN+I)=NODPLC(NEQN+NEXTV) NODPLC(NEQN+NEXTV)=IBR NODE1=NODPLC(LOC+2) IF (LTEMP.EQ.1) NODE1=NODPLC(LOC+6) IF (LTEMP.EQ.2) NODE1=NODPLC(LOC+7) NODE2=NODPLC(LOC+3) IF (LTEMP.EQ.1) NODE2=NODPLC(LOC+3) IF (LTEMP.EQ.2) NODE2=NODPLC(LOC+5) NODPLC(NODEVS+NODE1)=NODPLC(NODEVS+NODE1)-1 NODPLC(NODEVS+NODE2)=NODPLC(NODEVS+NODE2)-1 C C SET ROW SWAP INDICATORS C L=NODPLC(ISWAP+IBR) J=NODPLC(IEQUA+NODE) NODPLC(ISWAP+J)=L NODPLC(IEQUA+L)=J NODPLC(ISWAP+IBR)=NODE NODPLC(IEQUA+NODE)=IBR NEXTV=NEXTV+1 GO TO 100 C C INITIALIZE MATRIX POINTERS C 150 NEXNOD=2 NUT=0 NLT=0 160 NODPLC(IUR+NEXNOD)=NUT+1 NODPLC(ILC+NEXNOD)=NLT+1 IF (NEXNOD.GE.NSTOP) GO TO 500 C C SELECT ROW FOR REORDERING C LOAD=NODPLC(IORDER+NEXNOD) IR=NODPLC(ISWAP+LOAD) IMIN=NODPLC(NUMOFF+IR)*NODPLC(NMOFFC+LOAD) NSTART=NEXNOD+1 DO 200 I=NSTART,NSTOP LC=NODPLC(IORDER+I) IR=NODPLC(ISWAP+LC) NRC=NODPLC(NUMOFF+IR)*NODPLC(NMOFFC+LC) IF (NRC.GE.IMIN) GO TO 200 IF (MODE.NE.3) GO TO 190 IF (MODAC.NE.3) GO TO 190 IF (I.EQ.NSTOP) GO TO 200 190 IMIN=NRC LOAD=LC 200 CONTINUE C C SET REORDER INDICATORS C IR=NODPLC(ISWAP+LOAD) NODPLC(NUMOFF+IR)=NODPLC(NUMOFF+IR)-1 NODPLC(NMOFFC+LOAD)=NODPLC(NMOFFC+LOAD)-1 LC=NODPLC(IORDER+NEXNOD) JR=NODPLC(JMNODE+LOAD) NODPLC(IORDER+JR)=LC NODPLC(JMNODE+LC)=JR NODPLC(IORDER+NEXNOD)=LOAD NODPLC(JMNODE+LOAD)=NEXNOD C C SET POINTERS FOR UPPER TRIANGLE C LOC=ISR+IR 330 IF (NODPLC(LOC).EQ.0) GO TO 340 LOC=NODPLC(LOC) IC=NODPLC(LOC+1) JC=NODPLC(JMNODE+IC) IF (JC.LE.NEXNOD) GO TO 330 NODPLC(NMOFFC+IC)=NODPLC(NMOFFC+IC)-1 CALL EXTMEM(IUC,1) NODPLC(IUC+NUT+1)=IC NUT=NUT+1 GO TO 330 C C SET POINTERS FOR LOWER TRIANGLE C 340 DO 390 JR=NSTART,NSTOP LC=NODPLC(IORDER+JR) IR=NODPLC(ISWAP+LC) LOC=ISR+IR 350 IF (NODPLC(LOC).EQ.0) GO TO 390 LOC=NODPLC(LOC) IF (NODPLC(LOC+1).NE.LOAD) GO TO 350 NODPLC(NUMOFF+IR)=NODPLC(NUMOFF+IR)-1 CALL EXTMEM(ILR,1) NODPLC(ILR+NLT+1)=LC NLT=NLT+1 C C CHECK FOR FILL-IN TERMS C NCT=NODPLC(IUR+NEXNOD) 360 IF (NCT.GE.(NUT+1)) GO TO 390 IC=NODPLC(IUC+NCT) CALL RESERV(IR,IC) NCT=NCT+1 GO TO 360 390 CONTINUE C C NEXNOD=NEXNOD+1 GO TO 160 C C REORDERING FINISHED C 500 NODPLC(IUR+NSTOP+1)=NUT+1 NODPLC(ILC+NSTOP+1)=NLT+1 IF (NUT.EQ.0) GO TO 515 DO 510 I=1,NUT J=NODPLC(IUC+I) NODPLC(IUC+I)=NODPLC(JMNODE+J) 510 CONTINUE 515 IF (NLT.EQ.0) GO TO 600 DO 520 I=1,NLT J=NODPLC(ILR+I) NODPLC(ILR+I)=NODPLC(JMNODE+J) 520 CONTINUE GO TO 600 C C ERROR - VOLTAGE-SOURCE/INDUCTOR/TRANSMISSION-LINE LOOP DETECTED ... C 590 NOGO=1 WRITE (6,591) C... LOOP SHOULD HAVE BEEN DETECTED IN TOPCHK 591 FORMAT("0*ABORT*: SPICE INTERNAL ERROR IN REORDR"/) C C FINISHED C 600 RETURN END SUBROUTINE MATLOC C C THIS ROUTINE STORES THE LOCATIONS OF THE VARIOUS MATRIX TERMS TO C WHICH THE DIFFERENT CIRCUIT ELEMENTS CONTRIBUTE. C COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET, 1 MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO, 2 ITEMNO,NOSOLV,MODAC COMMON /AC/ FSTART,FSTOP,FINCR,SKW2,REFPRL,SPW2,JACFLG,IDFREQ, 1 INOISE,NOSPRT,NOSOUT,NOSIN,IDIST,IDPRT,JPZFLG,JPZTYP, 2 IPZIN,IPZITP,IPZOUT,IPZEQO,IPZLOC(2),IPZEQI,IPOMAT(3), 3 IPIMAT(4) COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C RESISTORS C LOC=LOCATE(1) 690 IF (LOC.EQ.0) GO TO 700 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NODPLC(LOC+4)=INDEX(NODE1,NODE2) NODPLC(LOC+5)=INDEX(NODE2,NODE1) NODPLC(LOC+6)=INDEX(NODE1,NODE1) NODPLC(LOC+7)=INDEX(NODE2,NODE2) LOC=NODPLC(LOC) GO TO 690 C C CAPACITORS C 700 LOC=LOCATE(2) 710 IF (LOC.EQ.0) GO TO 720 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NODPLC(LOC+4)=INDEX(NODE1,NODE1) NODPLC(LOC+5)=INDEX(NODE1,NODE2) NODPLC(LOC+6)=INDEX(NODE2,NODE1) NODPLC(LOC+7)=INDEX(NODE2,NODE2) LOC=NODPLC(LOC) GO TO 710 C C INDUCTORS C 720 LOC=LOCATE(3) 730 IF (LOC.EQ.0) GO TO 740 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) IBR=NODPLC(LOC+4) NODPLC(LOC+5)=INDEX(NODE1,IBR) NODPLC(LOC+6)=INDEX(NODE2,IBR) NODPLC(LOC+7)=INDEX(IBR,NODE1) NODPLC(LOC+8)=INDEX(IBR,NODE2) NODPLC(LOC+9)=INDEX(IBR,IBR) LOC=NODPLC(LOC) GO TO 730 C C MUTUAL INDUCTANCES C 740 LOC=LOCATE(4) 750 IF (LOC.EQ.0) GO TO 760 NL1=NODPLC(LOC+2) NL2=NODPLC(LOC+3) IBR1=NODPLC(NL1+4) IBR2=NODPLC(NL2+4) NODPLC(LOC+4)=INDEX(IBR1,IBR2) NODPLC(LOC+5)=INDEX(IBR2,IBR1) LOC=NODPLC(LOC) GO TO 750 C C NONLINEAR VOLTAGE CONTROLLED CURRENT SOURCES C 760 LOC=LOCATE(5) 762 IF (LOC.EQ.0) GO TO 764 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NDIM=NODPLC(LOC+4) LNOD=NODPLC(LOC+6) LMAT=NODPLC(LOC+7) DO 763 I=1,NDIM NODE3=NODPLC(LNOD+1) NODE4=NODPLC(LNOD+2) LNOD=LNOD+2 NODPLC(LMAT+1)=INDEX(NODE1,NODE3) NODPLC(LMAT+2)=INDEX(NODE1,NODE4) NODPLC(LMAT+3)=INDEX(NODE2,NODE3) NODPLC(LMAT+4)=INDEX(NODE2,NODE4) LMAT=LMAT+4 763 CONTINUE LOC=NODPLC(LOC) GO TO 762 C C NONLINEAR VOLTAGE CONTROLLED VOLTAGE SOURCES C 764 LOC=LOCATE(6) 766 IF (LOC.EQ.0) GO TO 768 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NDIM=NODPLC(LOC+4) IBR=NODPLC(LOC+6) LNOD=NODPLC(LOC+7) LMAT=NODPLC(LOC+8) NODPLC(LMAT+1)=INDEX(NODE1,IBR) NODPLC(LMAT+2)=INDEX(NODE2,IBR) NODPLC(LMAT+3)=INDEX(IBR,NODE1) NODPLC(LMAT+4)=INDEX(IBR,NODE2) LMAT=LMAT+4 DO 767 I=1,NDIM NODE3=NODPLC(LNOD+1) NODE4=NODPLC(LNOD+2) LNOD=LNOD+2 NODPLC(LMAT+1)=INDEX(IBR,NODE3) NODPLC(LMAT+2)=INDEX(IBR,NODE4) LMAT=LMAT+2 767 CONTINUE LOC=NODPLC(LOC) GO TO 766 C C NONLINEAR CURRENT CONTROLLED CURRENT SOURCES C 768 LOC=LOCATE(7) 770 IF (LOC.EQ.0) GO TO 772 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NDIM=NODPLC(LOC+4) LOCVS=NODPLC(LOC+6) LMAT=NODPLC(LOC+7) DO 771 I=1,NDIM LOCVST=NODPLC(LOCVS+I) IBR=NODPLC(LOCVST+6) NODPLC(LMAT+1)=INDEX(NODE1,IBR) NODPLC(LMAT+2)=INDEX(NODE2,IBR) LMAT=LMAT+2 771 CONTINUE LOC=NODPLC(LOC) GO TO 770 C C NONLINEAR CURRENT CONTROLLED VOLTAGE SOURCES C 772 LOC=LOCATE(8) 774 IF (LOC.EQ.0) GO TO 780 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NDIM=NODPLC(LOC+4) IBR=NODPLC(LOC+6) LOCVS=NODPLC(LOC+7) LMAT=NODPLC(LOC+8) NODPLC(LMAT+1)=INDEX(NODE1,IBR) NODPLC(LMAT+2)=INDEX(NODE2,IBR) NODPLC(LMAT+3)=INDEX(IBR,NODE1) NODPLC(LMAT+4)=INDEX(IBR,NODE2) LMAT=LMAT+4 DO 775 I=1,NDIM LOCVST=NODPLC(LOCVS+I) KBR=NODPLC(LOCVST+6) NODPLC(LMAT+I)=INDEX(IBR,KBR) 775 CONTINUE LOC=NODPLC(LOC) GO TO 774 C C VOLTAGE SOURCES C 780 LOC=LOCATE(9) 790 IF (LOC.EQ.0) GO TO 800 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) IPTR=NODPLC(LOC+6) NODPLC(LOC+7)=INDEX(NODE1,IPTR) NODPLC(LOC+8)=INDEX(NODE2,IPTR) NODPLC(LOC+9)=INDEX(IPTR,NODE1) NODPLC(LOC+10)=INDEX(IPTR,NODE2) LOC=NODPLC(LOC) GO TO 790 C C DIODES C 800 LOC=LOCATE(11) 810 IF (LOC.EQ.0) GO TO 820 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NODE3=NODPLC(LOC+4) NODPLC(LOC+7)=INDEX(NODE1,NODE3) NODPLC(LOC+8)=INDEX(NODE2,NODE3) NODPLC(LOC+9)=INDEX(NODE3,NODE1) NODPLC(LOC+10)=INDEX(NODE3,NODE2) NODPLC(LOC+13)=INDEX(NODE1,NODE1) NODPLC(LOC+14)=INDEX(NODE2,NODE2) NODPLC(LOC+15)=INDEX(NODE3,NODE3) LOC=NODPLC(LOC) GO TO 810 C C TRANSISTORS C 820 LOC=LOCATE(12) 830 IF (LOC.EQ.0) GO TO 840 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NODE3=NODPLC(LOC+4) NODE4=NODPLC(LOC+5) NODE5=NODPLC(LOC+6) NODE6=NODPLC(LOC+7) NODPLC(LOC+10)=INDEX(NODE1,NODE4) NODPLC(LOC+11)=INDEX(NODE2,NODE5) NODPLC(LOC+12)=INDEX(NODE3,NODE6) NODPLC(LOC+13)=INDEX(NODE4,NODE1) NODPLC(LOC+14)=INDEX(NODE4,NODE5) NODPLC(LOC+15)=INDEX(NODE4,NODE6) NODPLC(LOC+16)=INDEX(NODE5,NODE2) NODPLC(LOC+17)=INDEX(NODE5,NODE4) NODPLC(LOC+18)=INDEX(NODE5,NODE6) NODPLC(LOC+19)=INDEX(NODE6,NODE3) NODPLC(LOC+20)=INDEX(NODE6,NODE4) NODPLC(LOC+21)=INDEX(NODE6,NODE5) NODPLC(LOC+24)=INDEX(NODE1,NODE1) NODPLC(LOC+25)=INDEX(NODE2,NODE2) NODPLC(LOC+26)=INDEX(NODE3,NODE3) NODPLC(LOC+27)=INDEX(NODE4,NODE4) NODPLC(LOC+28)=INDEX(NODE5,NODE5) NODPLC(LOC+29)=INDEX(NODE6,NODE6) LOC=NODPLC(LOC) GO TO 830 C C JFETS C 840 LOC=LOCATE(13) 850 IF (LOC.EQ.0) GO TO 860 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NODE3=NODPLC(LOC+4) NODE4=NODPLC(LOC+5) NODE5=NODPLC(LOC+6) NODPLC(LOC+9)=INDEX(NODE1,NODE4) NODPLC(LOC+10)=INDEX(NODE2,NODE4) NODPLC(LOC+11)=INDEX(NODE2,NODE5) NODPLC(LOC+12)=INDEX(NODE3,NODE5) NODPLC(LOC+13)=INDEX(NODE4,NODE1) NODPLC(LOC+14)=INDEX(NODE4,NODE2) NODPLC(LOC+15)=INDEX(NODE4,NODE5) NODPLC(LOC+16)=INDEX(NODE5,NODE2) NODPLC(LOC+17)=INDEX(NODE5,NODE3) NODPLC(LOC+18)=INDEX(NODE5,NODE4) NODPLC(LOC+20)=INDEX(NODE1,NODE1) NODPLC(LOC+21)=INDEX(NODE2,NODE2) NODPLC(LOC+22)=INDEX(NODE3,NODE3) NODPLC(LOC+23)=INDEX(NODE4,NODE4) NODPLC(LOC+24)=INDEX(NODE5,NODE5) LOC=NODPLC(LOC) GO TO 850 C C MOSFETS C 860 LOC=LOCATE(14) 870 IF (LOC.EQ.0) GO TO 900 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NODE3=NODPLC(LOC+4) NODE4=NODPLC(LOC+5) NODE5=NODPLC(LOC+6) NODE6=NODPLC(LOC+7) NODPLC(LOC+10)=INDEX(NODE1,NODE5) NODPLC(LOC+11)=INDEX(NODE2,NODE4) NODPLC(LOC+12)=INDEX(NODE2,NODE5) NODPLC(LOC+13)=INDEX(NODE2,NODE6) NODPLC(LOC+14)=INDEX(NODE3,NODE6) NODPLC(LOC+15)=INDEX(NODE4,NODE2) NODPLC(LOC+16)=INDEX(NODE4,NODE5) NODPLC(LOC+17)=INDEX(NODE4,NODE6) NODPLC(LOC+18)=INDEX(NODE5,NODE1) NODPLC(LOC+19)=INDEX(NODE5,NODE2) NODPLC(LOC+20)=INDEX(NODE5,NODE4) NODPLC(LOC+21)=INDEX(NODE5,NODE6) NODPLC(LOC+22)=INDEX(NODE6,NODE2) NODPLC(LOC+23)=INDEX(NODE6,NODE3) NODPLC(LOC+24)=INDEX(NODE6,NODE4) NODPLC(LOC+25)=INDEX(NODE6,NODE5) NODPLC(LOC+27)=INDEX(NODE1,NODE1) NODPLC(LOC+28)=INDEX(NODE2,NODE2) NODPLC(LOC+29)=INDEX(NODE3,NODE3) NODPLC(LOC+30)=INDEX(NODE4,NODE4) NODPLC(LOC+31)=INDEX(NODE5,NODE5) NODPLC(LOC+32)=INDEX(NODE6,NODE6) LOC=NODPLC(LOC) GO TO 870 C C TRANSMISSION LINES C 900 LOC=LOCATE(17) 910 IF (LOC.EQ.0) GO TO 1000 NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NODE3=NODPLC(LOC+4) NODE4=NODPLC(LOC+5) NI1=NODPLC(LOC+6) NI2=NODPLC(LOC+7) IBR1=NODPLC(LOC+8) IBR2=NODPLC(LOC+9) NODPLC(LOC+10)=INDEX(NODE1,NODE1) NODPLC(LOC+11)=INDEX(NODE1,NI1) NODPLC(LOC+12)=INDEX(NODE2,IBR1) NODPLC(LOC+13)=INDEX(NODE3,NODE3) NODPLC(LOC+14)=INDEX(NODE4,IBR2) NODPLC(LOC+15)=INDEX(NI1,NODE1) NODPLC(LOC+16)=INDEX(NI1,NI1) NODPLC(LOC+17)=INDEX(NI1,IBR1) NODPLC(LOC+18)=INDEX(NI2,NI2) NODPLC(LOC+19)=INDEX(NI2,IBR2) NODPLC(LOC+20)=INDEX(IBR1,NODE2) NODPLC(LOC+21)=INDEX(IBR1,NODE3) NODPLC(LOC+22)=INDEX(IBR1,NODE4) NODPLC(LOC+23)=INDEX(IBR1,NI1) NODPLC(LOC+24)=INDEX(IBR1,IBR2) NODPLC(LOC+25)=INDEX(IBR2,NODE1) NODPLC(LOC+26)=INDEX(IBR2,NODE2) NODPLC(LOC+27)=INDEX(IBR2,NODE4) NODPLC(LOC+28)=INDEX(IBR2,NI2) NODPLC(LOC+29)=INDEX(IBR2,IBR1) NODPLC(LOC+31)=INDEX(NODE3,NI2) NODPLC(LOC+32)=INDEX(NI2,NODE3) LOC=NODPLC(LOC) GO TO 910 C C POLE/ZERO ANALYSIS C 1000 IF (MODE.NE.3) GO TO 1200 IF (MODAC.NE.3) GO TO 1200 C C... INPUT EQUATION C IF (IPZITP.NE.41) GO TO 1110 NODE1=NODPLC(IPZIN+2) NODE2=NODPLC(IPZIN+3) IBR=IPZEQI IPIMAT(1)=INDEX(NODE1,IBR) IPIMAT(2)=INDEX(NODE2,IBR) IPIMAT(3)=INDEX(IBR,NODE1) IPIMAT(4)=INDEX(IBR,NODE2) C C... GET LOCATION OF RHS/OUTPUT COLUMN SWAP C 1110 IF (IPZITP.EQ.10) GO TO 1120 IF (IPZITP.EQ.9) NUMEQN=NODPLC(IPZIN+6) IF (IPZITP.EQ.41) NUMEQN=IPZEQI IPZLOC(1)=INDEX(NUMEQN,IPZEQO) GO TO 1130 1120 NODE1=NODPLC(IPZIN+2) NODE2=NODPLC(IPZIN+3) IPZLOC(1)=INDEX(NODE1,IPZEQO) IPZLOC(2)=INDEX(NODE2,IPZEQO) C C... OUTPUT EQUATION C 1130 IF (NODPLC(IPZOUT+5).NE.0) GO TO 1140 NODE1=NODPLC(IPZOUT+2) NODE2=NODPLC(IPZOUT+3) IPOMAT(1)=INDEX(IPZEQO,NODE1) IPOMAT(2)=INDEX(IPZEQO,NODE2) GO TO 1200 1140 IPTR=NODPLC(IPZOUT+2) IPTR=NODPLC(IPTR+6) IPOMAT(1)=INDEX(IPZEQO,IPTR) C C FINISHED C 1200 RETURN END FUNCTION INDEX(NODE1,NODE2) C C THIS ROUTINE MAPS A (ROW, COLUMN) MATRIX TERM SPECIFICATION INTO C THE OFFSET FROM THE ORIGIN OF THE MATRIX STORAGE AT WHICH THE TERM IS C ACTUALLY LOCATED. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C CHECK FOR GROUND C IF (NODE1.EQ.1) GO TO 400 IF (NODE2.EQ.1) GO TO 400 C N1=NODPLC(IEQUA+NODE1) N1=NODPLC(JMNODE+N1) N2=NODPLC(JMNODE+NODE2) C C IF (N1-N2) 100,200,300 C C UPPER TRIANGLE C 100 NS=NODPLC(IUR+N1) NE=NODPLC(IUR+N1+1) 110 IF (NS.GE.NE) GO TO 400 IF (NODPLC(IUC+NS).EQ.N2) GO TO 120 NS=NS+1 GO TO 110 120 INDEX=NSTOP+NS GO TO 500 C C DIAGONAL C 200 INDEX=NODE2 GO TO 500 C C LOWER TRIANGLE C 300 NS=NODPLC(ILC+N2) NE=NODPLC(ILC+N2+1) 310 IF (NS.GE.NE) GO TO 400 IF (NODPLC(ILR+NS).EQ.N1) GO TO 320 NS=NS+1 GO TO 310 320 INDEX=NSTOP+NUT+NS GO TO 500 C C UNUSED LOCATION C 400 INDEX=1 C C FINISHED C 500 RETURN END SUBROUTINE CODGEN C C THIS ROUTINE GENERATES MACHINE INSTRUCTIONS (FOR THE CDC 6400) TO C LU-FACTOR AND SOLVE THE SET OF CIRCUIT EQUATIONS. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /KNSTNT/ TWOPI,XLOG2,XLOG10,ROOT2,RAD,BOLTZ,CHARGE,CTOK, 1 GMIN,RELTOL,ABSTOL,VNTOL,TRTOL,CHGTOL,EPS0,EPSSIL,EPSOX COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C INITIALIZE C CALL GETMEM(MACINS,2) CALL CRUNCH LV1=MACINS+1 LVN=0 LYNL=NSTOP LYU=LYNL+NSTOP LYL=LYU+NUT CALL MINS0(GMIN,IGOOF,VALUE(LV1)) C C LU DECOMPOSTION C DO 180 I=2,NSTOP IO=NODPLC(IORDER+I) CALL EXTMEM(MACINS,4) 10 CALL MINS1(VALUE(LYNL+IO)) JSTART=NODPLC(ILC+I) JSTOP=NODPLC(ILC+I+1)-1 IF (JSTART.GT.JSTOP) GO TO 180 DO 170 J=JSTART,JSTOP CALL EXTMEM(MACINS,2) 20 CALL MINS2(VALUE(LYL+J),VALUE(LYNL+IO)) ICOL=NODPLC(ILR+J) KSTART=NODPLC(IUR+I) KSTOP=NODPLC(IUR+I+1)-1 IF (KSTART.GT.KSTOP) GO TO 170 DO 160 K=KSTART,KSTOP IROW=NODPLC(IUC+K) IF (ICOL-IROW) 30,80,50 30 L=NODPLC(IUR+ICOL+1) 40 L=L-1 IF (NODPLC(IUC+L).NE.IROW) GO TO 40 ISPOT=LYU+L GO TO 100 50 L=NODPLC(ILC+IROW+1) 60 L=L-1 IF (NODPLC(ILR+L).NE.ICOL) GO TO 60 ISPOT=LYL+L GO TO 100 80 ISPOT=LYNL+NODPLC(IORDER+IROW) 100 CALL EXTMEM(MACINS,3) 110 CALL MINS3(VALUE(ISPOT),VALUE(LYL+J),VALUE(LYU+K)) 160 CONTINUE 170 CONTINUE 180 CONTINUE C C FORWARD SUBSTITUTION C DO 230 I=2,NSTOP JSTART=NODPLC(ILC+I) JSTOP=NODPLC(ILC+I+1)-1 IF (JSTART.GT.JSTOP) GO TO 230 IO=NODPLC(IORDER+I) DO 220 J=JSTART,JSTOP JO=NODPLC(ILR+J) JO=NODPLC(IORDER+JO) CALL EXTMEM(MACINS,3) 210 CALL MINS3(VALUE(LVN+JO),VALUE(LYL+J),VALUE(LVN+IO)) 220 CONTINUE 230 CONTINUE C C BACK SUBSTITUTION C K=NSTOP+1 DO 280 I=2,NSTOP K=K-1 IO=NODPLC(IORDER+K) JSTART=NODPLC(IUR+K) JSTOP=NODPLC(IUR+K+1)-1 IF (JSTART.GT.JSTOP) GO TO 260 DO 250 J=JSTART,JSTOP JO=NODPLC(IUC+J) JO=NODPLC(IORDER+JO) CALL EXTMEM(MACINS,3) 240 CALL MINS3(VALUE(LVN+IO),VALUE(LYU+J),VALUE(LVN+JO)) 250 CONTINUE 260 CALL EXTMEM(MACINS,2) 270 CALL MINS2(VALUE(LVN+IO),VALUE(LYNL+IO)) 280 CONTINUE C C FINISHED C CALL EXTMEM(MACINS,1) 310 CALL MINS4 C C FINISHED C RETURN END IDENT MINS TITLE MACHINE INSTRUCTION GENERATION ENTRY MINS0,MINS1,MINS2,MINS3,MINS4 TITLE SPECIFICATIONS * DECK *MINS* CONTAINS A SET OF FORTRAN-CALLABLE ROUTINES WHICH * GENERATE CODE TO PERFORM AN LU DECOMPOSITION AND FORWARD/BACKWARD * SUBSTITUTION OF A SET OF LINEAR EQUATIONS IN MATRIX FORM. SPACE 3 * CALLING SEQUENCES - SPACE 1 * CALL MINS0(GMIN, IGOOF, VALUE(LV1)) * INITIALIZATION -- VALUE(LV1) IS THE FIRST AVAILABLE WORD INTO * WHICH THE GENERATED CODE CAN BE STORED. SPACE 1 * CALL MINS1(X) * GENERATED CODE IS EQUIVALENT TO * IF (ABS(X).GE.GMIN) GO TO 10 * X=GMIN * IGOOF=IGOOF+1 * 10 CONTINUE SPACE 1 * CALL MINS2(X, Y) * GENERATED CODE IS EQUIVALENT TO * X=X/Y SPACE 1 * CALL MINS3(X, Y, Z) * GENERATED CODE IS EQUIVALENT TO * X=X-Y*Z SPACE 1 * CALL MINS4 * FINAL CALL -- GENERATED CODE IS TERMINATED PROPERLY. SPACE 1 * NOTE: ALL PARAMETERS (EXCEPT FOR *GMIN* AND *IGOOF*) ARE FETCHED FROM * MEMORY ASSUMING THAT REGISTER B6 CONTAINS THE CORRECT OFFSET -- SEE * ROUTINE *CODEXC*. *CALL,ASMARG TITLE CODE TEMPLATE DEFINITIONS CODE.0 SA1 0 X1 = GMIN SA2 0 X2 = IGOOF SPACE 3 CODE.1 SA3 B6+0 LOAD X BX4 X3 MAKE A COPY AX4 59 SWING THE SIGN BIT ALL THE WAY OVER BX4 X3-X4 VOILA -- ABS(X) APPEARS IN X4 FX4 X4-X1 COMPARE TO GMIN AX4 59 SWING THAT SIGN BIT AGAIN BX5 -X4*X3 IS IT ABS(X) ... BX6 X4*X1 OR GMIN ... BX6 X5+X6 IT REALLY DOESN*T MATTER, YOU KNOW SA6 A3+0 (RE)SET X BACK INTO MEMORY MX5 59 FINAGLE EITHER A 0 OR A 1 BX5 -X5*X4 OUT OF THAT LAST MASK IX2 X2+X5 (PSEUDO) INCREMENT IGOOF WITH IT NO 0 (PADDING) SPACE 3 CODE.2 SA3 B6+0 LOAD X SA4 B6+0 LOAD Y FX6 X3/X4 X/Y, COMING UP ... NO 0 (PADDING) SA6 A3+0 STORE QUOTIENT INTO MEMORY SPACE 3 CODE.3 SA3 B6+0 LOAD X SA4 B6+0 LOAD Y SA5 B6+0 LOAD Z FX4 X4*X5 Y*Z FX6 X3-X4 X-Y*Z, BUT UNNORMALIZED NX6 X6 SO, NORMALIZE NO 0 (PADDING) SA6 A3+0 STORE RESULT AWAY SPACE 3 CODE.4 BX6 X2 RESTORE IGOOF TO MEMORY, SA6 A2 WHERE IT BELONGS JP B1 EXIT (HO-HUM) TITLE MISCELLANEOUS DEFINITIONS LODREG MACRO SB7 1 ALWAYS AND FOREVER SA1 LWA PUT ADDRESS FOR NEXT WORD OF CODE SB6 X1+B7 INTO REGISTER B6 LODREG ENDM SPACE 3 SAVADR MACRO SX6 A6 SAVE ADDRESS OF LAST WORD OF CODE SA6 A1 . DONE SAVADR ENDM SPACE 3 SETCOD MACRO CODE,NUMADR LODREG LOAD REGISTERS B6 AND B7 SA2 CODE FETCH INSTRUCTION TEMPLATE SX3 B1 ADDRESS NUMBER 1, COMING UP LX3 30 AND INTO POSITION IFGE NUMADR,2,2 DON*T FETCH NONEXISTENT ADDRESSES SX4 B2 SECOND ADDRESS, COMING UP BX3 X3+X4 MERGE EVERYTHING TOGETHER BX6 X2+X3 LIKE SO SA6 B6 ADD THE NEW INSTRUCTION TO MEMORY IFEQ NUMADR,3,5 THREE ADDRESSES TO RELOCATE SA2 A2+B7 FETCH NEXT WORD OF INSTRUCTION TEMPLATE SX3 B3 THIRD ADDRESS, COMING UP LX3 30 AND OVER EASY BX6 X2+X3 CRAM THE BITS TOGETHER SA6 A6+B7 AND DROP THE RESULT INTO MEMORY SETCOD ENDM SPACE 3 COPY MACRO NUMWRD DUP NUMWRD,3 SA2 A2+B7 MOVE ONE WORD OF THE INSTRUCTION TEMPLATE BX6 X2 . SA6 A6+B7 . DONE COPY ENDM TITLE THE REAL THING LWA BSS 1 ADDRESS OF LAST WORD OF GENERATED CODE SPACE 2 MINS0 BSS 1 ENTRY/EXIT ASMARG 3 SX6 B3 COPY THE ADDRESS OF THE LAST WORD SA6 LWA AND STORE IT AWAY SPACE 1 SETCOD CODE.0,2 SAVADR EQ MINS0 EXIT SPACE 2 MINS1 BSS 1 ENTRY/EXIT ASMARG 1 SETCOD CODE.1,1 COPY 3 SAVADR EQ MINS1 EXIT SPACE 2 MINS2 BSS 1 ENTRY/EXIT ASMARG 2 SETCOD CODE.2,2 COPY 1 SAVADR EQ MINS2 EXIT SPACE 2 MINS3 BSS 1 ENTRY/EXIT ASMARG 3 SETCOD CODE.3,3 COPY 1 SAVADR EQ MINS3 EXIT SPACE 2 MINS4 BSS 1 ENTRY/EXIT LODREG SA2 CODE.4 STORE THE FINAL WORD OF CODE BX6 X2 . SA6 B6 . DONE EQ MINS4 EXIT END OVERLAY(4,0) SUBROUTINE ACDCMP C C THIS ROUTINE PERFORMS AN LU FACTORIZATION OF THE CIRCUIT EQUATION C COEFFICIENT MATRIX. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /KNSTNT/ TWOPI,XLOG2,XLOG10,ROOT2,RAD,BOLTZ,CHARGE,CTOK, 1 GMIN,RELTOL,ABSTOL,VNTOL,TRTOL,CHGTOL,EPS0,EPSSIL,EPSOX COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C DO 100 I=2,NSTOP IO=NODPLC(IORDER+I) GDIAG=ABS(REAL(CVALUE(LYNL+IO)))+ABS(AIMAG(CVALUE(LYNL+IO))) IF (GDIAG.GE.GMIN) GO TO 10 CVALUE(LYNL+IO)=CMPLX(GMIN,0.0) IGOOF=IGOOF+1 10 JSTART=NODPLC(ILC+I) JSTOP=NODPLC(ILC+I+1)-1 IF (JSTART.GT.JSTOP) GO TO 100 DO 90 J=JSTART,JSTOP CVALUE(LYL+J)=CVALUE(LYL+J)/CVALUE(LYNL+IO) ICOL=NODPLC(ILR+J) KSTART=NODPLC(IUR+I) KSTOP=NODPLC(IUR+I+1)-1 IF (KSTART.GT.KSTOP) GO TO 90 DO 80 K=KSTART,KSTOP IROW=NODPLC(IUC+K) IF (ICOL-IROW) 20,60,40 C C FIND (ICOL,IROW) MATRIX TERM (UPPER TRIANGLE) C 20 L=NODPLC(IUR+ICOL+1) 30 L=L-1 IF (NODPLC(IUC+L).NE.IROW) GO TO 30 ISPOT=LYU+L GO TO 70 C C FIND (ICOL,IROW) MATRIX TERM (LOWER TRIANGLE) C 40 L=NODPLC(ILC+IROW+1) 50 L=L-1 IF (NODPLC(ILR+L).NE.ICOL) GO TO 50 ISPOT=LYL+L GO TO 70 C C FIND (ICOL,IROW) MATRIX TERM (DIAGONAL) C 60 ISPOT=LYNL+NODPLC(IORDER+IROW) C 70 CVALUE(ISPOT)=CVALUE(ISPOT)-CVALUE(LYL+J)*CVALUE(LYU+K) 80 CONTINUE 90 CONTINUE 100 CONTINUE RETURN END SUBROUTINE ACSOL C C THIS ROUTINE SOLVES THE CIRCUIT EQUATIONS BY PERFORMING A FORWARD C AND BACKWARD SUBSTITUTION USING THE PREVIOUSLY-COMPUTED LU FACTORS. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C FORWARD SUBSTITUTION C DO 20 I=2,NSTOP JSTART=NODPLC(ILC+I) JSTOP=NODPLC(ILC+I+1)-1 IF (JSTART.GT.JSTOP) GO TO 20 IO=NODPLC(IORDER+I) IF (REAL(CVALUE(LVN+IO)).NE.0.0) GO TO 5 IF (AIMAG(CVALUE(LVN+IO)).EQ.0.0) GO TO 20 5 DO 10 J=JSTART,JSTOP JO=NODPLC(ILR+J) JO=NODPLC(IORDER+JO) CVALUE(LVN+JO)=CVALUE(LVN+JO)-CVALUE(LYL+J)*CVALUE(LVN+IO) 10 CONTINUE 20 CONTINUE C C BACK SUBSTITUTION C K=NSTOP+1 DO 50 I=2,NSTOP K=K-1 IO=NODPLC(IORDER+K) JSTART=NODPLC(IUR+K) JSTOP=NODPLC(IUR+K+1)-1 IF (JSTART.GT.JSTOP) GO TO 40 DO 30 J=JSTART,JSTOP JO=NODPLC(IUC+J) JO=NODPLC(IORDER+JO) CVALUE(LVN+IO)=CVALUE(LVN+IO)-CVALUE(LYU+J)*CVALUE(LVN+JO) 30 CONTINUE 40 CVALUE(LVN+IO)=CVALUE(LVN+IO)/CVALUE(LYNL+IO) 50 CONTINUE RETURN END SUBROUTINE ACLOAD C C THIS ROUTINE ZEROES-OUT AND THEN LOADS THE COMPLEX COEFFICIENT C MATRIX. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET, 1 MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO, 2 ITEMNO,NOSOLV,MODAC COMMON /AC/ FSTART,FSTOP,FINCR,SKW2,REFPRL,SPW2,JACFLG,IDFREQ, 1 INOISE,NOSPRT,NOSOUT,NOSIN,IDIST,IDPRT,JPZFLG,JPZTYP, 2 IPZIN,IPZITP,IPZOUT,IPZEQO,IPZLOC(2),IPZEQI,IPOMAT(3), 3 IPIMAT(4) COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C COMPLEX CVAL C C ZERO Y MATRIX AND CURRENT VECTOR C CALL ZERO16(CVALUE(LVN+1),NSTOP+NSTOP+NUT+NLT) C C RESISTORS C LOC=LOCATE(1) 20 IF (LOC.EQ.0) GO TO 30 LOCV=NODPLC(LOC+1) VAL=VALUE(LOCV+1) LOCY=LYNL+NODPLC(LOC+6) CVALUE(LOCY)=CVALUE(LOCY)+VAL LOCY=LYNL+NODPLC(LOC+7) CVALUE(LOCY)=CVALUE(LOCY)+VAL LOCY=LYNL+NODPLC(LOC+4) CVALUE(LOCY)=CVALUE(LOCY)-VAL LOCY=LYNL+NODPLC(LOC+5) CVALUE(LOCY)=CVALUE(LOCY)-VAL LOC=NODPLC(LOC) GO TO 20 C C CAPACITORS C 30 LOC=LOCATE(2) 40 IF (LOC.EQ.0) GO TO 50 LOCV=NODPLC(LOC+1) CVAL=CMPLX(0.0,OMEGA*VALUE(LOCV+1)) LOCY=LYNL+NODPLC(LOC+4) CVALUE(LOCY)=CVALUE(LOCY)+CVAL LOCY=LYNL+NODPLC(LOC+7) CVALUE(LOCY)=CVALUE(LOCY)+CVAL LOCY=LYNL+NODPLC(LOC+5) CVALUE(LOCY)=CVALUE(LOCY)-CVAL LOCY=LYNL+NODPLC(LOC+6) CVALUE(LOCY)=CVALUE(LOCY)-CVAL LOC=NODPLC(LOC) GO TO 40 C C INDUCTORS C 50 LOC=LOCATE(3) 60 IF (LOC.EQ.0) GO TO 70 LOCV=NODPLC(LOC+1) CVAL=CMPLX(0.0,OMEGA*VALUE(LOCV+1)) LOCY=LYNL+NODPLC(LOC+9) CVALUE(LOCY)=-CVAL LOCY=LYNL+NODPLC(LOC+5) CVALUE(LOCY)=1.0 LOCY=LYNL+NODPLC(LOC+6) CVALUE(LOCY)=-1.0 LOCY=LYNL+NODPLC(LOC+7) CVALUE(LOCY)=1.0 LOCY=LYNL+NODPLC(LOC+8) CVALUE(LOCY)=-1.0 LOC=NODPLC(LOC) GO TO 60 C C MUTUAL INDUCTORS C 70 LOC=LOCATE(4) 80 IF (LOC.EQ.0) GO TO 90 LOCV=NODPLC(LOC+1) CVAL=CMPLX(0.0,OMEGA*VALUE(LOCV+1)) LOCY=LYNL+NODPLC(LOC+4) CVALUE(LOCY)=-CVAL LOCY=LYNL+NODPLC(LOC+5) CVALUE(LOCY)=-CVAL LOC=NODPLC(LOC) GO TO 80 C C NONLINEAR VOLTAGE CONTROLLED CURRENT SOURCES C 90 LOC=LOCATE(5) 95 IF (LOC.EQ.0) GO TO 100 NDIM=NODPLC(LOC+4) LMAT=NODPLC(LOC+7) LOCT=LX0+NODPLC(LOC+12)+2 DO 97 I=1,NDIM VAL=VALUE(LOCT) LOCT=LOCT+2 LOCY=LYNL+NODPLC(LMAT+1) CVALUE(LOCY)=CVALUE(LOCY)+VAL LOCY=LYNL+NODPLC(LMAT+2) CVALUE(LOCY)=CVALUE(LOCY)-VAL LOCY=LYNL+NODPLC(LMAT+3) CVALUE(LOCY)=CVALUE(LOCY)-VAL LOCY=LYNL+NODPLC(LMAT+4) CVALUE(LOCY)=CVALUE(LOCY)+VAL LMAT=LMAT+4 97 CONTINUE LOC=NODPLC(LOC) GO TO 95 C C NONLINEAR VOLTAGE CONTROLLED VOLTAGE SOURCES C 100 LOC=LOCATE(6) 105 IF (LOC.EQ.0) GO TO 110 NDIM=NODPLC(LOC+4) LMAT=NODPLC(LOC+8) LOCT=LX0+NODPLC(LOC+13)+3 LOCY=LYNL+NODPLC(LMAT+1) CVALUE(LOCY)=+1.0 LOCY=LYNL+NODPLC(LMAT+2) CVALUE(LOCY)=-1.0 LOCY=LYNL+NODPLC(LMAT+3) CVALUE(LOCY)=+1.0 LOCY=LYNL+NODPLC(LMAT+4) CVALUE(LOCY)=-1.0 LMAT=LMAT+4 DO 107 I=1,NDIM VAL=VALUE(LOCT) LOCT=LOCT+2 LOCY=LYNL+NODPLC(LMAT+1) CVALUE(LOCY)=CVALUE(LOCY)-VAL LOCY=LYNL+NODPLC(LMAT+2) CVALUE(LOCY)=CVALUE(LOCY)+VAL LMAT=LMAT+2 107 CONTINUE LOC=NODPLC(LOC) GO TO 105 C C NONLINEAR CURRENT CONTROLLED CURRENT SOURCES C 110 LOC=LOCATE(7) 115 IF (LOC.EQ.0) GO TO 120 NDIM=NODPLC(LOC+4) LMAT=NODPLC(LOC+7) LOCT=LX0+NODPLC(LOC+12)+2 DO 117 I=1,NDIM VAL=VALUE(LOCT) LOCT=LOCT+2 LOCY=LYNL+NODPLC(LMAT+1) CVALUE(LOCY)=+VAL LOCY=LYNL+NODPLC(LMAT+2) CVALUE(LOCY)=-VAL LMAT=LMAT+2 117 CONTINUE LOC=NODPLC(LOC) GO TO 115 C C NONLINEAR CURRENT CONTROLLED VOLTAGE SOURCES C 120 LOC=LOCATE(8) 125 IF (LOC.EQ.0) GO TO 140 NDIM=NODPLC(LOC+4) LMAT=NODPLC(LOC+8) LOCT=LX0+NODPLC(LOC+13)+3 LOCY=LYNL+NODPLC(LMAT+1) CVALUE(LOCY)=+1.0 LOCY=LYNL+NODPLC(LMAT+2) CVALUE(LOCY)=-1.0 LOCY=LYNL+NODPLC(LMAT+3) CVALUE(LOCY)=+1.0 LOCY=LYNL+NODPLC(LMAT+4) CVALUE(LOCY)=-1.0 LMAT=LMAT+4 DO 127 I=1,NDIM VAL=VALUE(LOCT) LOCT=LOCT+2 LOCY=LYNL+NODPLC(LMAT+I) CVALUE(LOCY)=CVALUE(LOCY)-VAL 127 CONTINUE LOC=NODPLC(LOC) GO TO 125 C C VOLTAGE SOURCES C 140 LOC=LOCATE(9) 150 IF (LOC.EQ.0) GO TO 160 LOCV=NODPLC(LOC+1) CVAL=CMPLX(VALUE(LOCV+2),VALUE(LOCV+3)) IPTR=NODPLC(LOC+6) CVALUE(LVN+IPTR)=CVAL LOCY=LYNL+NODPLC(LOC+7) CVALUE(LOCY)=CVALUE(LOCY)+1.0 LOCY=LYNL+NODPLC(LOC+8) CVALUE(LOCY)=CVALUE(LOCY)-1.0 LOCY=LYNL+NODPLC(LOC+9) CVALUE(LOCY)=CVALUE(LOCY)+1.0 LOCY=LYNL+NODPLC(LOC+10) CVALUE(LOCY)=CVALUE(LOCY)-1.0 LOC=NODPLC(LOC) GO TO 150 C C CURRENT SOURCES C 160 LOC=LOCATE(10) 170 IF (LOC.EQ.0) GO TO 200 LOCV=NODPLC(LOC+1) NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) CVAL=CMPLX(VALUE(LOCV+2),VALUE(LOCV+3)) CVALUE(LVN+NODE1)=CVALUE(LVN+NODE1)-CVAL CVALUE(LVN+NODE2)=CVALUE(LVN+NODE2)+CVAL LOC=NODPLC(LOC) GO TO 170 C C DIODES C 200 LOC=LOCATE(11) 210 IF (LOC.EQ.0) GO TO 250 LOCV=NODPLC(LOC+1) AREA=VALUE(LOCV+1) LOCM=NODPLC(LOC+5) LOCM=NODPLC(LOCM+1) LOCT=LX0+NODPLC(LOC+11) GSPR=VALUE(LOCM+2)*AREA GEQ=VALUE(LOCT+2) XCEQ=VALUE(LOCT+4)*OMEGA LOCY=LYNL+NODPLC(LOC+13) CVALUE(LOCY)=CVALUE(LOCY)+GSPR LOCY=LYNL+NODPLC(LOC+14) CVALUE(LOCY)=CVALUE(LOCY)+CMPLX(GEQ,XCEQ) LOCY=LYNL+NODPLC(LOC+15) CVALUE(LOCY)=CVALUE(LOCY)+CMPLX(GEQ+GSPR,XCEQ) LOCY=LYNL+NODPLC(LOC+7) CVALUE(LOCY)=CVALUE(LOCY)-GSPR LOCY=LYNL+NODPLC(LOC+8) CVALUE(LOCY)=CVALUE(LOCY)-CMPLX(GEQ,XCEQ) LOCY=LYNL+NODPLC(LOC+9) CVALUE(LOCY)=CVALUE(LOCY)-GSPR LOCY=LYNL+NODPLC(LOC+10) CVALUE(LOCY)=CVALUE(LOCY)-CMPLX(GEQ,XCEQ) LOC=NODPLC(LOC) GO TO 210 C C BJTS C 250 LOC=LOCATE(12) 260 IF (LOC.EQ.0) GO TO 300 LOCV=NODPLC(LOC+1) AREA=VALUE(LOCV+1) LOCM=NODPLC(LOC+8) LOCM=NODPLC(LOCM+1) LOCT=LX0+NODPLC(LOC+22) GBPR=VALUE(LOCM+4)*AREA GCPR=VALUE(LOCM+5)*AREA GEPR=VALUE(LOCM+6)*AREA XCCS=VALUE(LOCM+17)*AREA*OMEGA GPI=VALUE(LOCT+4) GMU=VALUE(LOCT+5) GM=VALUE(LOCT+6) GO=VALUE(LOCT+7) XGM=0.0 TD=VALUE(LOCM+29) IF (TD.EQ.0.0) GO TO 270 ARG=TD*OMEGA GM=GM+GO XGM=-GM*SIN(ARG) GM=GM*COS(ARG)-GO 270 XCPI=VALUE(LOCT+9)*OMEGA XCMU=VALUE(LOCT+11)*OMEGA LOCY=LYNL+NODPLC(LOC+24) CVALUE(LOCY)=CVALUE(LOCY)+GCPR LOCY=LYNL+NODPLC(LOC+25) CVALUE(LOCY)=CVALUE(LOCY)+GBPR LOCY=LYNL+NODPLC(LOC+26) CVALUE(LOCY)=CVALUE(LOCY)+GEPR LOCY=LYNL+NODPLC(LOC+27) CVALUE(LOCY)=CVALUE(LOCY)+CMPLX(GMU+GO+GCPR,XCMU+XCCS) LOCY=LYNL+NODPLC(LOC+28) CVALUE(LOCY)=CVALUE(LOCY)+CMPLX(GBPR+GPI+GMU,XCPI+XCMU) LOCY=LYNL+NODPLC(LOC+29) CVALUE(LOCY)=CVALUE(LOCY)+CMPLX(GPI+GEPR+GM+GO,XCPI+XGM) LOCY=LYNL+NODPLC(LOC+10) CVALUE(LOCY)=CVALUE(LOCY)-GCPR LOCY=LYNL+NODPLC(LOC+11) CVALUE(LOCY)=CVALUE(LOCY)-GBPR LOCY=LYNL+NODPLC(LOC+12) CVALUE(LOCY)=CVALUE(LOCY)-GEPR LOCY=LYNL+NODPLC(LOC+13) CVALUE(LOCY)=CVALUE(LOCY)-GCPR LOCY=LYNL+NODPLC(LOC+14) CVALUE(LOCY)=CVALUE(LOCY)-CMPLX(GMU-GM,XCMU-XGM) LOCY=LYNL+NODPLC(LOC+15) CVALUE(LOCY)=CVALUE(LOCY)-CMPLX(GM+GO,XGM) LOCY=LYNL+NODPLC(LOC+16) CVALUE(LOCY)=CVALUE(LOCY)-GBPR LOCY=LYNL+NODPLC(LOC+17) CVALUE(LOCY)=CVALUE(LOCY)-CMPLX(GMU,XCMU) LOCY=LYNL+NODPLC(LOC+18) CVALUE(LOCY)=CVALUE(LOCY)-CMPLX(GPI,XCPI) LOCY=LYNL+NODPLC(LOC+19) CVALUE(LOCY)=CVALUE(LOCY)-GEPR LOCY=LYNL+NODPLC(LOC+20) CVALUE(LOCY)=CVALUE(LOCY)-GO LOCY=LYNL+NODPLC(LOC+21) CVALUE(LOCY)=CVALUE(LOCY)-CMPLX(GPI+GM,XCPI+XGM) LOC=NODPLC(LOC) GO TO 260 C C JFETS C 300 LOC=LOCATE(13) 310 IF (LOC.EQ.0) GO TO 350 LOCV=NODPLC(LOC+1) AREA=VALUE(LOCV+1) LOCM=NODPLC(LOC+7) LOCM=NODPLC(LOCM+1) LOCT=LX0+NODPLC(LOC+19) GDPR=VALUE(LOCM+4)*AREA GSPR=VALUE(LOCM+5)*AREA GM=VALUE(LOCT+5) GDS=VALUE(LOCT+6) GGS=VALUE(LOCT+7) XGS=VALUE(LOCT+9)*OMEGA GGD=VALUE(LOCT+8) XGD=VALUE(LOCT+11)*OMEGA LOCY=LYNL+NODPLC(LOC+20) CVALUE(LOCY)=CVALUE(LOCY)+GDPR LOCY=LYNL+NODPLC(LOC+21) CVALUE(LOCY)=CVALUE(LOCY)+CMPLX(GGD+GGS,XGD+XGS) LOCY=LYNL+NODPLC(LOC+22) CVALUE(LOCY)=CVALUE(LOCY)+GSPR LOCY=LYNL+NODPLC(LOC+23) CVALUE(LOCY)=CVALUE(LOCY)+CMPLX(GDPR+GDS+GGD,XGD) LOCY=LYNL+NODPLC(LOC+24) CVALUE(LOCY)=CVALUE(LOCY)+CMPLX(GSPR+GDS+GM+GGS,XGS) LOCY=LYNL+NODPLC(LOC+9) CVALUE(LOCY)=CVALUE(LOCY)-GDPR LOCY=LYNL+NODPLC(LOC+10) CVALUE(LOCY)=CVALUE(LOCY)-CMPLX(GGD,XGD) LOCY=LYNL+NODPLC(LOC+11) CVALUE(LOCY)=CVALUE(LOCY)-CMPLX(GGS,XGS) LOCY=LYNL+NODPLC(LOC+12) CVALUE(LOCY)=CVALUE(LOCY)-GSPR LOCY=LYNL+NODPLC(LOC+13) CVALUE(LOCY)=CVALUE(LOCY)-GDPR LOCY=LYNL+NODPLC(LOC+14) CVALUE(LOCY)=CVALUE(LOCY)-CMPLX(GGD-GM,XGD) LOCY=LYNL+NODPLC(LOC+15) CVALUE(LOCY)=CVALUE(LOCY)-GDS-GM LOCY=LYNL+NODPLC(LOC+16) CVALUE(LOCY)=CVALUE(LOCY)-CMPLX(GGS+GM,XGS) LOCY=LYNL+NODPLC(LOC+17) CVALUE(LOCY)=CVALUE(LOCY)-GSPR LOCY=LYNL+NODPLC(LOC+18) CVALUE(LOCY)=CVALUE(LOCY)-GDS LOC=NODPLC(LOC) GO TO 310 C C MOSFETS C 350 LOC=LOCATE(14) 360 IF (LOC.EQ.0) GO TO 400 LOCV=NODPLC(LOC+1) DEVMOD=VALUE(LOCV+8) XNRM=1.0 XREV=0.0 IF (DEVMOD.GE.0.0) GO TO 370 XNRM=0.0 XREV=1.0 370 LOCM=NODPLC(LOC+8) LOCM=NODPLC(LOCM+1) LOCT=LX0+NODPLC(LOC+26) GDPR=VALUE(LOCM+6) GSPR=VALUE(LOCM+7) XCGS=VALUE(LOCT+16)*OMEGA XCGD=VALUE(LOCT+18)*OMEGA XCGB=VALUE(LOCT+20)*OMEGA GM=VALUE(LOCT+7) GDS=VALUE(LOCT+8) GMBS=VALUE(LOCT+9) GBD=VALUE(LOCT+10) XBD=VALUE(LOCT+12)*OMEGA GBS=VALUE(LOCT+11) XBS=VALUE(LOCT+14)*OMEGA LOCY=LYNL+NODPLC(LOC+27) CVALUE(LOCY)=CVALUE(LOCY)+GDPR LOCY=LYNL+NODPLC(LOC+28) CVALUE(LOCY)=CVALUE(LOCY)+CMPLX(0.0,XCGD+XCGS+XCGB) LOCY=LYNL+NODPLC(LOC+29) CVALUE(LOCY)=CVALUE(LOCY)+GSPR LOCY=LYNL+NODPLC(LOC+30) CVALUE(LOCY)=CVALUE(LOCY)+CMPLX(GBD+GBS,XBD+XBS+XCGB) LOCY=LYNL+NODPLC(LOC+31) CVALUE(LOCY)=CVALUE(LOCY)+CMPLX(GDPR+GDS+GBD+XREV*(GM+GMBS), 1 XCGD+XBD) LOCY=LYNL+NODPLC(LOC+32) CVALUE(LOCY)=CVALUE(LOCY)+CMPLX(GSPR+GDS+GBS+XNRM*(GM+GMBS), 1 XCGS+XBS) LOCY=LYNL+NODPLC(LOC+10) CVALUE(LOCY)=CVALUE(LOCY)-GDPR LOCY=LYNL+NODPLC(LOC+11) CVALUE(LOCY)=CVALUE(LOCY)-CMPLX(0.0,XCGB) LOCY=LYNL+NODPLC(LOC+12) CVALUE(LOCY)=CVALUE(LOCY)-CMPLX(0.0,XCGD) LOCY=LYNL+NODPLC(LOC+13) CVALUE(LOCY)=CVALUE(LOCY)-CMPLX(0.0,XCGS) LOCY=LYNL+NODPLC(LOC+14) CVALUE(LOCY)=CVALUE(LOCY)-GSPR LOCY=LYNL+NODPLC(LOC+15) CVALUE(LOCY)=CVALUE(LOCY)-CMPLX(0.0,XCGB) LOCY=LYNL+NODPLC(LOC+16) CVALUE(LOCY)=CVALUE(LOCY)-CMPLX(GBD,XBD) LOCY=LYNL+NODPLC(LOC+17) CVALUE(LOCY)=CVALUE(LOCY)-CMPLX(GBS,XBS) LOCY=LYNL+NODPLC(LOC+18) CVALUE(LOCY)=CVALUE(LOCY)-GDPR LOCY=LYNL+NODPLC(LOC+19) CVALUE(LOCY)=CVALUE(LOCY)+CMPLX((XNRM-XREV)*GM,-XCGD) LOCY=LYNL+NODPLC(LOC+20) CVALUE(LOCY)=CVALUE(LOCY)-CMPLX(GBD-(XNRM-XREV)*GMBS,XBD) LOCY=LYNL+NODPLC(LOC+21) CVALUE(LOCY)=CVALUE(LOCY)-GDS-XNRM*(GM+GMBS) LOCY=LYNL+NODPLC(LOC+22) CVALUE(LOCY)=CVALUE(LOCY)-CMPLX((XNRM-XREV)*GM,XCGS) LOCY=LYNL+NODPLC(LOC+23) CVALUE(LOCY)=CVALUE(LOCY)-GSPR LOCY=LYNL+NODPLC(LOC+24) CVALUE(LOCY)=CVALUE(LOCY)-CMPLX(GBS+(XNRM-XREV)*GMBS,XBS) LOCY=LYNL+NODPLC(LOC+25) CVALUE(LOCY)=CVALUE(LOCY)-GDS-XREV*(GM+GMBS) LOC=NODPLC(LOC) GO TO 360 C C TRANSMISSION LINES C 400 LOC=LOCATE(17) 410 IF (LOC.EQ.0) GO TO 1000 LOCV=NODPLC(LOC+1) Z0=VALUE(LOCV+1) Y0=1.0/Z0 TD=VALUE(LOCV+2) ARG=-OMEGA*TD CVAL=CMPLX(COS(ARG),SIN(ARG)) LOCY=LYNL+NODPLC(LOC+10) CVALUE(LOCY)=CVALUE(LOCY)+Y0 LOCY=LYNL+NODPLC(LOC+11) CVALUE(LOCY)=-Y0 LOCY=LYNL+NODPLC(LOC+12) CVALUE(LOCY)=-1.0 LOCY=LYNL+NODPLC(LOC+13) CVALUE(LOCY)=CVALUE(LOCY)+Y0 LOCY=LYNL+NODPLC(LOC+14) CVALUE(LOCY)=-1.0 LOCY=LYNL+NODPLC(LOC+15) CVALUE(LOCY)=-Y0 LOCY=LYNL+NODPLC(LOC+16) CVALUE(LOCY)=+Y0 LOCY=LYNL+NODPLC(LOC+17) CVALUE(LOCY)=+1.0 LOCY=LYNL+NODPLC(LOC+18) CVALUE(LOCY)=+Y0 LOCY=LYNL+NODPLC(LOC+19) CVALUE(LOCY)=+1.0 LOCY=LYNL+NODPLC(LOC+20) CVALUE(LOCY)=-1.0 LOCY=LYNL+NODPLC(LOC+21) CVALUE(LOCY)=-CVAL LOCY=LYNL+NODPLC(LOC+22) CVALUE(LOCY)=+CVAL LOCY=LYNL+NODPLC(LOC+23) CVALUE(LOCY)=+1.0 LOCY=LYNL+NODPLC(LOC+24) CVALUE(LOCY)=-CVAL*Z0 LOCY=LYNL+NODPLC(LOC+25) CVALUE(LOCY)=-CVAL LOCY=LYNL+NODPLC(LOC+26) CVALUE(LOCY)=+CVAL LOCY=LYNL+NODPLC(LOC+27) CVALUE(LOCY)=-1.0 LOCY=LYNL+NODPLC(LOC+28) CVALUE(LOCY)=+1.0 LOCY=LYNL+NODPLC(LOC+29) CVALUE(LOCY)=-CVAL*Z0 LOCY=LYNL+NODPLC(LOC+31) CVALUE(LOCY)=-Y0 LOCY=LYNL+NODPLC(LOC+32) CVALUE(LOCY)=-Y0 LOC=NODPLC(LOC) GO TO 410 C C REORDER RIGHT-HAND SIDE C 1000 DO 1110 I=2,NSTOP J=NODPLC(ISWAP+I) CVALUE(NDIAG+I)=CVALUE(LVN+J) 1110 CONTINUE CALL COPY16(CVALUE(NDIAG+1),CVALUE(LVN+1),NSTOP) C C FINISHED C RETURN END SUBROUTINE NOISE(LOCO) C C THIS ROUTINE COMPUTES THE NOISE DUE TO VARIOUS CIRCUIT ELEMENTS. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET, 1 MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO, 2 ITEMNO,NOSOLV,MODAC COMMON /MISCEL/ APROG(3),ATIME,ADATE,ATITLE(15),RSTATS(50), 1 IWIDTH,LWIDTH,NOPAGE COMMON /KNSTNT/ TWOPI,XLOG2,XLOG10,ROOT2,RAD,BOLTZ,CHARGE,CTOK, 1 GMIN,RELTOL,ABSTOL,VNTOL,TRTOL,CHGTOL,EPS0,EPSSIL,EPSOX COMMON /AC/ FSTART,FSTOP,FINCR,SKW2,REFPRL,SPW2,JACFLG,IDFREQ, 1 INOISE,NOSPRT,NOSOUT,NOSIN,IDIST,IDPRT,JPZFLG,JPZTYP, 2 IPZIN,IPZITP,IPZOUT,IPZEQO,IPZLOC(2),IPZEQI,IPOMAT(3), 3 IPIMAT(4) COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C DIMENSION VNO1(12),VNO2(12),VNO3(12),VNO4(12),VNO5(12),VNO6(12) DIMENSION VNTOT(12),ANAM(12),STRING(5) DIMENSION TITLN(4),V(2) COMPLEX CVAL,C(1) EQUIVALENCE (C(1),V(1),CVAL) EQUIVALENCE (V(1),VREAL),(V(2),VIMAG) DATA TITLN / 8HNOISE AN, 8HALYSIS , 8H , 8H / DATA ALSRB,ALSRC,ALSRE,ALSRS,ALSRD / 2HRB,2HRC,2HRE,2HRS,2HRD / DATA ALSIB,ALSIC,ALSID,ALSFN / 2HIB,2HIC,2HID,2HFN / DATA ALSTOT / 5HTOTAL / DATA ASLASH,ABLNK / 1H/, 1H / C C NPRNT=0 FREQ=OMEGA/TWOPI IF (ICALC.GE.2) GO TO 10 FOURKT=4.0*CHARGE*VT TWOQ=2.0*CHARGE NOPOSO=NODPLC(NOSOUT+2) NONEGO=NODPLC(NOSOUT+3) KNTLIM=LWIDTH/11 NKNTR=1 10 IF (NOSPRT.EQ.0) GO TO 30 IF (NKNTR.GT.ICALC) GO TO 30 NPRNT=1 NKNTR=NKNTR+NOSPRT CALL TITLE(0,LWIDTH,1,TITLN) WRITE (6,16) FREQ 16 FORMAT("0 FREQUENCY = ",1PE10.3," HZ"/) C C OBTAIN ADJOINT CIRCUIT SOLUTION C 30 VNRMS=0.0 CVAL=CVALUE(LVN+NOPOSO)-CVALUE(LVN+NONEGO) VOUT=SQRT(VREAL*VREAL+VIMAG*VIMAG) VOUT=AMAX1(VOUT,1.0E-20) CALL ZERO16(CVALUE(LVN+1),NSTOP) CVALUE(LVN+NOPOSO)=-1.0 CVALUE(LVN+NONEGO)=+1.0 CALL ACASOL CVALUE(LVN+1)=(0.0,0.0) C C RESISTORS C IF (JELCNT(1).EQ.0) GO TO 200 ITITLE=0 91 FORMAT(//"0**** RESISTOR SQUARED NOISE VOLTAGES (SQ V/HZ)") 100 LOC=LOCATE(1) KNTR=0 110 IF (LOC.EQ.0) GO TO 130 KNTR=KNTR+1 LOCV=NODPLC(LOC+1) ANAM(KNTR)=VALUE(LOCV) NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) CVAL=CVALUE(LVN+NODE1)-CVALUE(LVN+NODE2) VNTOT(KNTR)=(VREAL*VREAL+VIMAG*VIMAG)*FOURKT*VALUE(LOCV+1) VNRMS=VNRMS+VNTOT(KNTR) IF (KNTR.GE.KNTLIM) GO TO 140 120 LOC=NODPLC(LOC) GO TO 110 130 IF (KNTR.EQ.0) GO TO 200 140 IF (NPRNT.EQ.0) GO TO 160 IF (ITITLE.EQ.0) WRITE (6,91) ITITLE=1 WRITE (6,141) (ANAM(I),I=1,KNTR) 141 FORMAT(////,11X,12(2X,A8)) WRITE (6,151) ALSTOT,(VNTOT(I),I=1,KNTR) 151 FORMAT(1H0,A8,1P12E10.3) 160 KNTR=0 IF (LOC.NE.0) GO TO 120 C C DIODES C 200 IF (JELCNT(11).EQ.0) GO TO 300 ITITLE=0 201 FORMAT(//"0**** DIODE SQUARED NOISE VOLTAGES (SQ V/HZ)") 210 LOC=LOCATE(11) KNTR=0 220 IF (LOC.EQ.0) GO TO 240 KNTR=KNTR+1 LOCV=NODPLC(LOC+1) ANAM(KNTR)=VALUE(LOCV) NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NODE3=NODPLC(LOC+4) LOCM=NODPLC(LOC+5) LOCM=NODPLC(LOCM+1) LOCT=NODPLC(LOC+11) AREA=VALUE(LOCV+1) FNK=VALUE(LOCM+10) FNA=VALUE(LOCM+11) C C OHMIC RESISTANCE C CVAL=CVALUE(LVN+NODE1)-CVALUE(LVN+NODE3) VNO1(KNTR)=(VREAL*VREAL+VIMAG*VIMAG)*FOURKT*VALUE(LOCM+2)*AREA C C JUNCTION SHOT NOISE AND FLICKER NOISE C CVAL=CVALUE(LVN+NODE3)-CVALUE(LVN+NODE2) VTEMP=VREAL*VREAL+VIMAG*VIMAG ARG=AMAX1(ABS(VALUE(LX0+LOCT+1)),1.0E-20) VNO2(KNTR)=VTEMP*TWOQ*ARG VNO3(KNTR)=VTEMP*FNK*EXP(FNA*ALOG(ARG))/FREQ VNTOT(KNTR)=VNO1(KNTR)+VNO2(KNTR)+VNO3(KNTR) VNRMS=VNRMS+VNTOT(KNTR) IF (KNTR.GE.KNTLIM) GO TO 250 230 LOC=NODPLC(LOC) GO TO 220 240 IF (KNTR.EQ.0) GO TO 300 250 IF (NPRNT.EQ.0) GO TO 260 IF (ITITLE.EQ.0) WRITE (6,201) ITITLE=1 WRITE (6,141) (ANAM(I),I=1,KNTR) WRITE (6,151) ALSRS,(VNO1(I),I=1,KNTR) WRITE (6,151) ALSID,(VNO2(I),I=1,KNTR) WRITE (6,151) ALSFN,(VNO3(I),I=1,KNTR) WRITE (6,151) ALSTOT,(VNTOT(I),I=1,KNTR) 260 KNTR=0 IF (LOC.NE.0) GO TO 230 C C BIPOLAR JUNCTION TRANSISTORS C 300 IF (JELCNT(12).EQ.0) GO TO 400 ITITLE=0 301 FORMAT(//"0**** TRANSISTOR SQUARED NOISE VOLTAGES (SQ V/HZ)") 310 LOC=LOCATE(12) KNTR=0 320 IF (LOC.EQ.0) GO TO 340 KNTR=KNTR+1 LOCV=NODPLC(LOC+1) ANAM(KNTR)=VALUE(LOCV) NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NODE3=NODPLC(LOC+4) NODE4=NODPLC(LOC+5) NODE5=NODPLC(LOC+6) NODE6=NODPLC(LOC+7) LOCM=NODPLC(LOC+8) LOCM=NODPLC(LOCM+1) LOCT=NODPLC(LOC+22) AREA=VALUE(LOCV+1) FNK=VALUE(LOCM+26) FNA=VALUE(LOCM+27) C C EXTRINSIC RESISTANCES C C... BASE RESISTANCE CVAL=CVALUE(LVN+NODE2)-CVALUE(LVN+NODE5) VNO1(KNTR)=(VREAL*VREAL+VIMAG*VIMAG)*FOURKT*VALUE(LOCM+4)*AREA C... COLLECTOR RESISTANCE CVAL=CVALUE(LVN+NODE1)-CVALUE(LVN+NODE4) VNO2(KNTR)=(VREAL*VREAL+VIMAG*VIMAG)*FOURKT*VALUE(LOCM+5)*AREA C... EMITTER RESISTANCE CVAL=CVALUE(LVN+NODE3)-CVALUE(LVN+NODE6) VNO3(KNTR)=(VREAL*VREAL+VIMAG*VIMAG)*FOURKT*VALUE(LOCM+6)*AREA C C BASE CURRENT SHOT NOISE AND FLICKER NOISE C CVAL=CVALUE(LVN+NODE5)-CVALUE(LVN+NODE6) VTEMP=VREAL*VREAL+VIMAG*VIMAG ARG=AMAX1(ABS(VALUE(LX0+LOCT+3)),1.0E-20) VNO4(KNTR)=VTEMP*TWOQ*ARG VNO5(KNTR)=VTEMP*FNK*EXP(FNA*ALOG(ARG))/FREQ C C COLLECTOR CURRENT SHOT NOISE C CVAL=CVALUE(LVN+NODE4)-CVALUE(LVN+NODE6) VNO6(KNTR)=(VREAL*VREAL+VIMAG*VIMAG)*TWOQ*ABS(VALUE(LX0+LOCT+2)) VNTOT(KNTR)=VNO1(KNTR)+VNO2(KNTR)+VNO3(KNTR)+VNO4(KNTR)+VNO5(KNTR) 1 +VNO6(KNTR) VNRMS=VNRMS+VNTOT(KNTR) IF (KNTR.GE.KNTLIM) GO TO 350 330 LOC=NODPLC(LOC) GO TO 320 340 IF (KNTR.EQ.0) GO TO 400 350 IF (NPRNT.EQ.0) GO TO 360 IF (ITITLE.EQ.0) WRITE (6,301) ITITLE=1 WRITE (6,141) (ANAM(I),I=1,KNTR) WRITE (6,151) ALSRB,(VNO1(I),I=1,KNTR) WRITE (6,151) ALSRC,(VNO2(I),I=1,KNTR) WRITE (6,151) ALSRE,(VNO3(I),I=1,KNTR) WRITE (6,151) ALSIB,(VNO4(I),I=1,KNTR) WRITE (6,151) ALSIC,(VNO6(I),I=1,KNTR) WRITE (6,151) ALSFN,(VNO5(I),I=1,KNTR) WRITE (6,151) ALSTOT,(VNTOT(I),I=1,KNTR) 360 KNTR=0 IF (LOC.NE.0) GO TO 330 C C JFETS C 400 IF (JELCNT(13).EQ.0) GO TO 500 ITITLE=0 401 FORMAT(//"0**** JFET SQUARED NOISE VOLTAGES (SQ V/HZ)") 410 LOC=LOCATE(13) KNTR=0 420 IF (LOC.EQ.0) GO TO 440 KNTR=KNTR+1 LOCV=NODPLC(LOC+1) ANAM(KNTR)=VALUE(LOCV) NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NODE3=NODPLC(LOC+4) NODE4=NODPLC(LOC+5) NODE5=NODPLC(LOC+6) LOCM=NODPLC(LOC+7) LOCM=NODPLC(LOCM+1) LOCT=NODPLC(LOC+19) AREA=VALUE(LOCV+1) FNK=VALUE(LOCM+10) FNA=VALUE(LOCM+11) C C EXTRINSIC RESISTANCES C C... DRAIN RESISTANCE CVAL=CVALUE(LVN+NODE1)-CVALUE(LVN+NODE4) VNO1(KNTR)=(VREAL*VREAL+VIMAG*VIMAG)*FOURKT*VALUE(LOCM+4)*AREA C... SOURCE RESISTANCE CVAL=CVALUE(LVN+NODE3)-CVALUE(LVN+NODE5) VNO2(KNTR)=(VREAL*VREAL+VIMAG*VIMAG)*FOURKT*VALUE(LOCM+5)*AREA C C DRAIN CURRENT SHOT NOISE AND FLICKER NOISE C CVAL=CVALUE(LVN+NODE4)-CVALUE(LVN+NODE5) VTEMP=VREAL*VREAL+VIMAG*VIMAG VNO3(KNTR)=VTEMP*FOURKT*2.0*ABS(VALUE(LX0+LOCT+5))/3.0 ARG=AMAX1(ABS(VALUE(LX0+LOCT+3)),1.0E-20) VNO4(KNTR)=VTEMP*FNK*EXP(FNA*ALOG(ARG))/FREQ VNTOT(KNTR)=VNO1(KNTR)+VNO2(KNTR)+VNO3(KNTR)+VNO4(KNTR) VNRMS=VNRMS+VNTOT(KNTR) IF (KNTR.GE.KNTLIM) GO TO 450 430 LOC=NODPLC(LOC) GO TO 420 440 IF (KNTR.EQ.0) GO TO 500 450 IF (NPRNT.EQ.0) GO TO 460 IF (ITITLE.EQ.0) WRITE (6,401) ITITLE=1 WRITE (6,141) (ANAM(I),I=1,KNTR) WRITE (6,151) ALSRD,(VNO1(I),I=1,KNTR) WRITE (6,151) ALSRS,(VNO2(I),I=1,KNTR) WRITE (6,151) ALSID,(VNO3(I),I=1,KNTR) WRITE (6,151) ALSFN,(VNO4(I),I=1,KNTR) WRITE (6,151) ALSTOT,(VNTOT(I),I=1,KNTR) 460 KNTR=0 IF (LOC.NE.0) GO TO 430 C C MOSFETS C 500 IF (JELCNT(14).EQ.0) GO TO 600 ITITLE=0 501 FORMAT(//"0**** MOSFET SQUARED NOISE VOLTAGES (SQ V/HZ)") 510 LOC=LOCATE(14) KNTR=0 520 IF (LOC.EQ.0) GO TO 540 KNTR=KNTR+1 LOCV=NODPLC(LOC+1) ANAM(KNTR)=VALUE(LOCV) NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NODE3=NODPLC(LOC+4) NODE4=NODPLC(LOC+5) NODE5=NODPLC(LOC+6) NODE6=NODPLC(LOC+7) LOCM=NODPLC(LOC+8) LOCM=NODPLC(LOCM+1) XL=VALUE(LOCV+1)-2.0*VALUE(LOCM+20)*VALUE(LOCM+19) XW=VALUE(LOCV+2) COX=VALUE(LOCM+13)*XW*XL LOCT=NODPLC(LOC+26) FNK=VALUE(LOCM+27) FNA=VALUE(LOCM+28) FNB=1.0 C C EXTRINSIC RESISTANCES C C... DRAIN RESISTANCE CVAL=CVALUE(LVN+NODE1)-CVALUE(LVN+NODE5) VNO1(KNTR)=(VREAL*VREAL+VIMAG*VIMAG)*FOURKT*VALUE(LOCM+6) C... SOURCE RESISTANCE CVAL=CVALUE(LVN+NODE3)-CVALUE(LVN+NODE6) VNO2(KNTR)=(VREAL*VREAL+VIMAG*VIMAG)*FOURKT*VALUE(LOCM+7) C C DRAIN CURRENT SHOT NOISE AND FLICKER NOISE C CVAL=CVALUE(LVN+NODE5)-CVALUE(LVN+NODE6) VTEMP=VREAL*VREAL+VIMAG*VIMAG VNO3(KNTR)=VTEMP*FOURKT*ABS(VALUE(LX0+LOCT+7))/1.5 ARG=AMAX1(ABS(VALUE(LX0+LOCT+4)),1.0E-20) VNO4(KNTR)=VTEMP*FNK*EXP(FNA*ALOG(ARG)) 1 /(EXP(FNB*ALOG(FREQ))*COX) VNTOT(KNTR)=VNO1(KNTR)+VNO2(KNTR)+VNO3(KNTR)+VNO4(KNTR) VNRMS=VNRMS+VNTOT(KNTR) IF (KNTR.GE.KNTLIM) GO TO 550 530 LOC=NODPLC(LOC) GO TO 520 540 IF (KNTR.EQ.0) GO TO 600 550 IF (NPRNT.EQ.0) GO TO 560 IF (ITITLE.EQ.0) WRITE (6,501) ITITLE=1 WRITE (6,141) (ANAM(I),I=1,KNTR) WRITE (6,151) ALSRD,(VNO1(I),I=1,KNTR) WRITE (6,151) ALSRS,(VNO2(I),I=1,KNTR) WRITE (6,151) ALSID,(VNO3(I),I=1,KNTR) WRITE (6,151) ALSFN,(VNO4(I),I=1,KNTR) WRITE (6,151) ALSTOT,(VNTOT(I),I=1,KNTR) 560 KNTR=0 IF (LOC.NE.0) GO TO 530 C C COMPUTE EQUIVALENT INPUT NOISE VOLTAGE C 600 VNOUT=SQRT(VNRMS) VNIN=VNOUT/VOUT IF (NPRNT.EQ.0) GO TO 620 DO 610 I=1,5 STRING(I)=ABLNK 610 CONTINUE IOUTYP=1 IPOS=1 CALL OUTNAM(NOSOUT,IOUTYP,STRING,IPOS) CALL MOVE(STRING,IPOS,ASLASH,1,1) IPOS=IPOS+1 LOCV=NODPLC(NOSIN+1) ANAM1=VALUE(LOCV) CALL MOVE(STRING,IPOS,ANAM1,1,8) WRITE (6,611) VNRMS,VNOUT,STRING,VOUT,ANAM1,VNIN 611 FORMAT(////, 1 "0**** TOTAL OUTPUT NOISE VOLTAGE",9X,"= ",1PE10.3," SQ V/HZ"/, 2 1H0,40X,"= ",E10.3," V/RT HZ"/, 3 "0 TRANSFER FUNCTION VALUE:"/, 4 1H0,7X,4A8,A1,"= ",E10.3,/, 5 "0 EQUIVALENT INPUT NOISE AT ",A8," = ",E10.3," /RT HZ") C C SAVE NOISE OUTPUTS C 620 LOC=LOCATE(44) 630 IF (LOC.EQ.0) GO TO 1000 ISEQ=NODPLC(LOC+4) IF (NODPLC(LOC+5).NE.2) GO TO 640 CVALUE(LOCO+ISEQ)=VNOUT GO TO 650 640 CVALUE(LOCO+ISEQ)=VNIN 650 LOC=NODPLC(LOC) GO TO 630 C C FINISHED C 1000 RETURN END SUBROUTINE ACASOL C C THIS ROUTINE EVALUATES THE RESPONSE OF THE ADJOINT CIRCUIT BY C DOING A FORWARD/BACKWARD SUBSTITUTION STEP USING THE TRANSPOSE OF THE C CIRCUIT EQUATION COEFFICIENT MATRIX. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C EVALUATES ADJOINT RESPONSE BY DOING FORWARD/BACKWARD SUBSTITUTION ON C THE TRANSPOSE OF THE Y MATRIX C C C FORWARD SUBSTITUTION C DO 20 I=2,NSTOP IO=NODPLC(IORDER+I) CVALUE(LVN+IO)=CVALUE(LVN+IO)/CVALUE(LYNL+IO) JSTART=NODPLC(IUR+I) JSTOP=NODPLC(IUR+I+1)-1 IF (JSTART.GT.JSTOP) GO TO 20 IF (REAL(CVALUE(LVN+IO)).NE.0.0) GO TO 5 IF (AIMAG(CVALUE(LVN+IO)).EQ.0.0) GO TO 20 5 DO 10 J=JSTART,JSTOP JO=NODPLC(IUC+J) JO=NODPLC(IORDER+JO) CVALUE(LVN+JO)=CVALUE(LVN+JO)-CVALUE(LYU+J)*CVALUE(LVN+IO) 10 CONTINUE 20 CONTINUE C C BACKWARD SUBSTITUTION C K=NSTOP+1 DO 40 I=2,NSTOP K=K-1 IO=NODPLC(IORDER+K) JSTART=NODPLC(ILC+K) JSTOP=NODPLC(ILC+K+1)-1 IF (JSTART.GT.JSTOP) GO TO 40 DO 30 J=JSTART,JSTOP JO=NODPLC(ILR+J) JO=NODPLC(IORDER+JO) CVALUE(LVN+IO)=CVALUE(LVN+IO)-CVALUE(LYL+J)*CVALUE(LVN+JO) 30 CONTINUE 40 CONTINUE C C REORDER RIGHT-HAND SIDE C DO 50 I=2,NSTOP J=NODPLC(ISWAP+I) CVALUE(NDIAG+I)=CVALUE(LVN+J) 50 CONTINUE CALL COPY16(CVALUE(NDIAG+1),CVALUE(LVN+1),NSTOP) C C FINISHED C RETURN END SUBROUTINE DINIT C C THIS ROUTINE PERFORMS STORAGE-ALLOCATION AND ONE-TIME COMPUTATION C NEEDED TO DO THE SMALL-SIGNAL DISTORTION ANALYSIS. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET, 1 MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO, 2 ITEMNO,NOSOLV,MODAC COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C CALL GETMEM(LD0,NDIST) CALL GETMEM(LD1,2*(5*NSTOP)) C C BIPOLAR JUNCTION TRANSISTORS C LOC=LOCATE(12) 100 IF (LOC.EQ.0) GO TO 200 LOCV=NODPLC(LOC+1) AREA=VALUE(LOCV+1) LOCM=NODPLC(LOC+8) LOCM=NODPLC(LOCM+1) LOCT=LX0+NODPLC(LOC+22) LOCD=LD0+NODPLC(LOC+23) CSAT=VALUE(LOCM+3)*AREA OVA=VALUE(LOCM+7) TF=VALUE(LOCM+15) TR=VALUE(LOCM+16) CZBE=VALUE(LOCM+18)*AREA CZBC=VALUE(LOCM+21)*AREA PE=VALUE(LOCM+19) XME=VALUE(LOCM+20) PC=VALUE(LOCM+22) XMC=VALUE(LOCM+23) FCPE=VALUE(LOCM+28) FCPC=VALUE(LOCM+33) VBE=VALUE(LOCT) VBC=VALUE(LOCT+1) GPI=VALUE(LOCT+4) GO=VALUE(LOCT+7) GM=VALUE(LOCT+6) GMU=VALUE(LOCT+5) IF (VBE.GT.0.0) GO TO 110 EVBE=1.0 CBE=CSAT*VBE/VT GO TO 120 110 EVBE=EXP(VBE/VT) CBE=CSAT*(EVBE-1.0) 120 IF (VBC.GT.0.0) GO TO 130 EVBC=1.0 CBC=CSAT*VBC/VT ARG=1.0-VBC/PC GO TO 140 130 EVBC=EXP(VBC/VT) CBC=CSAT*(EVBC-1.0) 140 IF (VBE.GE.FCPE) GO TO 150 ARG=1.0-VBE/PE SARG=EXP(XME*ALOG(ARG)) CJEO=CZBE/SARG ARGBE=PE-VBE CJE1=XME*CJEO/ARGBE CJE2=XME*(1.0+XME)*CJE1/ARGBE GO TO 160 150 DENOM=EXP((1.0+XME)*ALOG(1.0-FCPE)) CJE1=CZBE*XME/(DENOM*PE) CJE2=0.0 160 IF (VBC.GE.FCPC) GO TO 170 ARG=1.0-VBC/PC SARG=EXP(XMC*ALOG(ARG)) CJCO=CZBC/SARG ARGBC=PC-VBC CJC1=XMC*CJCO/ARGBC CJC2=XMC*(1.0+XMC)*CJC1/ARGBC GO TO 180 170 DENOM=EXP((1.0+XMC)*ALOG(1.0-FCPC)) CJC1=CZBC*XMC/(DENOM*PC) CJC2=0.0 180 TWOVT=VT+VT GO2=(-GO+CSAT*(EVBE+EVBC)*OVA)/TWOVT GMO2=(CBE+CSAT)*OVA/VT-2.0*GO2 GM2=(GM+GO)/TWOVT-GMO2-GO2 GMU2=GMU/TWOVT IF (VBC.LE.0.0) GMU2=0.0 GPI2=GPI/TWOVT IF (VBE.LE.0.0) GPI2=0.0 CBO=TF*CSAT*EVBE/VT CBOR=TR*CSAT*EVBC/VT CB1=CBO/VT CB1R=CBOR/VT TRIVT=3.0*VT GO3=-(GO2+(CBC+CSAT)*OVA/TWOVT)/TRIVT GMO23=-3.0*GO3 GM2O3=-GMO23+(CBE+CSAT)*OVA/(VT*TWOVT) GM3=(GM2-(CBE-CBC)*OVA/TWOVT)/TRIVT GMU3=GMU2/TRIVT GPI3=GPI2/TRIVT CB2=CB1/TWOVT CB2R=CB1R/TWOVT VALUE(LOCD)=CJE1 VALUE(LOCD+1)=CJE2 VALUE(LOCD+2)=CJC1 VALUE(LOCD+3)=CJC2 VALUE(LOCD+4)=GO2 VALUE(LOCD+5)=GMO2 VALUE(LOCD+6)=GM2 VALUE(LOCD+7)=GMU2 VALUE(LOCD+8)=GPI2 VALUE(LOCD+9)=CBO VALUE(LOCD+10)=CBOR VALUE(LOCD+11)=CB1 VALUE(LOCD+12)=CB1R VALUE(LOCD+13)=GO3 VALUE(LOCD+14)=GMO23 VALUE(LOCD+15)=GM2O3 VALUE(LOCD+16)=GM3 VALUE(LOCD+17)=GMU3 VALUE(LOCD+18)=GPI3 VALUE(LOCD+19)=CB2 VALUE(LOCD+20)=CB2R LOC=NODPLC(LOC) GO TO 100 C C DIODES C 200 LOC=LOCATE(11) 210 IF (LOC.EQ.0) GO TO 300 LOCV=NODPLC(LOC+1) AREA=VALUE(LOCV+1) LOCM=NODPLC(LOC+5) LOCM=NODPLC(LOCM+1) LOCT=LX0+NODPLC(LOC+11) LOCD=LD0+NODPLC(LOC+12) CSAT=VALUE(LOCM+1)*AREA VTE=VALUE(LOCM+3)*VT TAU=VALUE(LOCM+4) CZERO=VALUE(LOCM+5)*AREA PHIB=VALUE(LOCM+6) XM=VALUE(LOCM+7) FCPB=VALUE(LOCM+12) VD=VALUE(LOCT) GEQ=VALUE(LOCT+2) EVD=1.0 IF (VD.GE.0.0) EVD=EXP(VD/VTE) IF (VD.GE.FCPB) GO TO 220 ARG=1.0-VD/PHIB SARG=EXP(XM*ALOG(ARG)) CDJO=CZERO/SARG ARGD=PHIB-VD CDJ1=XM*CDJO/ARGD CDJ2=XM*(1.0+XM)*CDJ1/ARGD GO TO 230 220 DENOM=EXP((1.0+XM)*ALOG(1.0-FCPB)) CDJ1=CZERO*XM/(DENOM*PHIB) CDJ2=0.0 230 CDBO=TAU*CSAT*EVD/VTE CDB1=CDBO/VTE TWOVTE=2.0*VTE GEQ2=GEQ/TWOVTE IF (VD.LE.0.0) GEQ2=0.0 TRIVTE=3.0*VTE GEQ3=GEQ2/TRIVTE CDB2=CDB1/TWOVTE VALUE(LOCD)=CDJ1 VALUE(LOCD+1)=CDJ2 VALUE(LOCD+2)=CDBO VALUE(LOCD+3)=CDB1 VALUE(LOCD+4)=GEQ2 VALUE(LOCD+5)=GEQ3 VALUE(LOCD+6)=CDB2 LOC=NODPLC(LOC) GO TO 210 C C FINISHED C 300 RETURN END SUBROUTINE DISTO(LOCO) C C THIS ROUTINE PERFORMS THE SMALL-SIGNAL DISTORTION ANALYSIS. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /MISCEL/ APROG(3),ATIME,ADATE,ATITLE(15),RSTATS(50), 1 IWIDTH,LWIDTH,NOPAGE COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET, 1 MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO, 2 ITEMNO,NOSOLV,MODAC COMMON /KNSTNT/ TWOPI,XLOG2,XLOG10,ROOT2,RAD,BOLTZ,CHARGE,CTOK, 1 GMIN,RELTOL,ABSTOL,VNTOL,TRTOL,CHGTOL,EPS0,EPSSIL,EPSOX COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /AC/ FSTART,FSTOP,FINCR,SKW2,REFPRL,SPW2,JACFLG,IDFREQ, 1 INOISE,NOSPRT,NOSOUT,NOSIN,IDIST,IDPRT,JPZFLG,JPZTYP, 2 IPZIN,IPZITP,IPZOUT,IPZEQO,IPZLOC(2),IPZEQI,IPOMAT(3), 3 IPIMAT(4) COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C COMPLEX DIFVN1,DIFVN2,DIFVN3,DIFVI1,DIFVI2,DIFVI3,DSGO2,DSGM2, 1 DSGMU2,DSGPI2,DSCB1,DSCB1R,DSCJE1,DSCJC1,DISTO1,DISTO2,DISTO3, 2 DSGMO2,DGM2O3,DGMO23,BEW,CEW,BCW,BE2W,CE2W,BC2W,BEW2,CEW2, 3 BCW2,BEW12,CEW12,BCW12,DSCDB1,DSCDJ1,DSG2,CVABE,CVABC,CVACE, 4 CVOUT,CVDIST DIMENSION DISTIT(4) DIMENSION VDO(2,12) COMPLEX CVDO(12) EQUIVALENCE (CVDO(1),VDO(1,1)) DATA DISTIT / 8HDISTORTI, 8HON ANALY, 8HSIS , 8H / C C ICVW1=(LD1+1)/2 ICV2W1=ICVW1+NSTOP ICVW2=ICV2W1+NSTOP ICVW12=ICVW2+NSTOP ICVADJ=ICVW12+NSTOP IPRNT=0 IF (ICALC.GE.2) GO TO 10 IDNP=NODPLC(IDIST+2) IDNN=NODPLC(IDIST+3) LOCV=NODPLC(IDIST+1) RLOAD=1.0/VALUE(LOCV+1) KNTR=1 10 IF (IDPRT.EQ.0) GO TO 30 IF (KNTR.GT.ICALC) GO TO 30 IPRNT=1 KNTR=KNTR+IDPRT CALL TITLE(0,LWIDTH,1,DISTIT) 30 FREQ1=REAL(CVALUE(LOCO+1)) FREQ2=SKW2*FREQ1 CALL COPY16(CVALUE(LVN+1),CVALUE(ICVW1+1),NSTOP) CVOUT=CVALUE(ICVW1+IDNP)-CVALUE(ICVW1+IDNN) CALL MAGPHS(CVOUT,OMAG,OPHASE) C C BEGIN THE DISTORTION ANALYSIS C DO 1000 KDISTO=1,7 CVDIST=(0.0,0.0) GO TO (1000,110,120,130,140,160,170),KDISTO 110 FREQD=2.0*FREQ1 ARG=SQRT(2.0*RLOAD*REFPRL)/(OMAG*OMAG) IF (IPRNT.EQ.0) GO TO 200 WRITE (6,111) FREQ1,FREQD,OMAG,OPHASE 111 FORMAT (///5X,*2ND HARMONIC DISTORTION*,30X,*FREQ1 = *,1PE9.2, 1 * HZ*//5X,*DISTORTION FREQUENCY *,E9.2,* HZ*,16X, 2 *MAG *,E9.3,3X,*PHS *,0PF7.2) GO TO 200 120 FREQD=3.0*FREQ1 ARG=2.0*RLOAD*REFPRL/(OMAG*OMAG*OMAG) IF (IPRNT.EQ.0) GO TO 200 WRITE (6,121) FREQ1,FREQD,OMAG,OPHASE 121 FORMAT (1H1,4X,*3RD HARMONIC DISTORTION*,30X,*FREQ1 = *,1PE9.2, 1 * HZ*//5X,*DISTORTION FREQUENCY *,E9.2,* HZ*,16X, 2 *MAG *,E9.3,3X,*PHS *,0PF7.2) GO TO 200 130 FREQD=FREQ2 GO TO 200 140 FREQD=FREQ1-FREQ2 ARG=SQRT(2.0*RLOAD*REFPRL)*SPW2/(OMAG*OMAG) IF (IPRNT.EQ.0) GO TO 200 WRITE (6,151) FREQ1,FREQ2,FREQD,OMAG,OPHASE,OW2MAG,OW2PHS 151 FORMAT (1H1,4X,*2ND ORDER INTERMODULATION DIFFERENCE COMPONENT*, 1 7X,*FREQ1 = *,1PE9.2,* HZ*,15X,*FREQ2 = *,E9.2,* HZ*// 2 5X,*DISTORTION FREQUENCY *,E9.2,* HZ*,16X,*MAG *, 3 E9.3,3X,*PHS *,0PF7.2,9X,*MAG *,1PE9.3,3X,*PHS *,0PF7.2) GO TO 200 160 FREQD=FREQ1+FREQ2 ARG=SQRT(2.0*RLOAD*REFPRL)*SPW2/(OMAG*OMAG) IF (IPRNT.EQ.0) GO TO 200 WRITE (6,161) FREQ1,FREQ2,FREQD,OMAG,OPHASE,OW2MAG,OW2PHS 161 FORMAT (1H1,4X,*2ND ORDER INTERMODULATION SUM COMPONENT*, 1 14X,*FREQ1 = *,1PE9.2,* HZ*,15X,*FREQ2 = *,E9.2,* HZ*// 2 5X,*DISTORTION FREQUENCY *,E9.2,* HZ*,16X,*MAG *, 3 E9.3,3X,*PHS *,0PF7.2,9X,*MAG *,1PE9.3,3X,*PHS *,0PF7.2) GO TO 200 170 FREQD=2.0*FREQ1-FREQ2 ARG=2.0*RLOAD*REFPRL*SPW2/(OMAG*OMAG*OMAG) IF (IPRNT.EQ.0) GO TO 200 WRITE (6,171) FREQ1,FREQ2,FREQD,OMAG,OPHASE,OW2MAG,OW2PHS 171 FORMAT (1H1,4X,*3RD ORDER INTERMODULATION DIFFERENCE COMPONENT*, 1 7X,*FREQ1 = *,1PE9.2,* HZ*,15X,*FREQ2 = *,E9.2,* HZ*// 2 5X,*DISTORTION FREQUENCY *,E9.2,* HZ*,16X,*MAG *, 3 E9.3,3X,*PHS *,0PF7.2,9X,*MAG *,1PE9.3,3X,*PHS *,0PF7.2) C C LOAD AND DECOMPOSE Y MATRIX C 200 OMEGA=TWOPI*FREQD IGOOF=0 CALL ACLOAD CALL ACDCMP IF (IGOOF.EQ.0) GO TO 220 WRITE (6,211) IGOOF,FREQD 211 FORMAT("0WARNING: UNDERFLOW ",I4," TIME(S) IN DISTORTION ANALYSIS 1 AT FREQ = ",1PE9.3," HZ") IGOOF=0 220 IF (KDISTO.EQ.4) GO TO 710 C C OBTAIN ADJOINT SOLUTION C CALL ZERO16(CVALUE(LVN+1),NSTOP) CVALUE(LVN+IDNP)=-1.0 CVALUE(LVN+IDNN)=+1.0 CALL ACASOL CVALUE(LVN+1)=(0.0,0.0) CALL COPY16(CVALUE(LVN+1),CVALUE(ICVADJ+1),NSTOP) CALL ZERO16(CVALUE(LVN+1),NSTOP) C C BJTS C IF (JELCNT(12).EQ.0) GO TO 500 ITITLE=0 301 FORMAT (////1X,*BJT DISTORTION COMPONENTS*//1X,*NAME*,11X,*GM*, 1 8X,*GPI*,7X,*GO*,8X,*GMU*,6X,*GMO2*,7X,*CB*,8X,*CBR*,7X,*CJE*, 2 7X,*CJC*,6X,*TOTAL*) 311 FORMAT (////1X,*BJT DISTORTION COMPONENTS*//1X,*NAME*,11X,*GM*, 1 8X,*GPI*,7X,*GO*,8X,*GMU*,6X,*GMO2*,7X,*CB*,8X,*CBR*,7X,*CJE*, 2 7X,*CJC*,6X,*GM203*,5X,*GMO23*,5X,*TOTAL*) 320 LOC=LOCATE(12) 330 IF (LOC.EQ.0) GO TO 500 LOCV=NODPLC(LOC+1) LOCT=LX0+NODPLC(LOC+22) LOCD=LD0+NODPLC(LOC+23) NODE1=NODPLC(LOC+5) NODE2=NODPLC(LOC+6) NODE3=NODPLC(LOC+7) CJE1=VALUE(LOCD) CJE2=VALUE(LOCD+1) CJC1=VALUE(LOCD+2) CJC2=VALUE(LOCD+3) GO2=VALUE(LOCD+4) GMO2=VALUE(LOCD+5) GM2=VALUE(LOCD+6) GMU2=VALUE(LOCD+7) GPI2=VALUE(LOCD+8) CB1=VALUE(LOCD+11) CB1R=VALUE(LOCD+12) GO3=VALUE(LOCD+13) GMO23=VALUE(LOCD+14) GM2O3=VALUE(LOCD+15) GM3=VALUE(LOCD+16) GMU3=VALUE(LOCD+17) GPI3=VALUE(LOCD+18) CB2=VALUE(LOCD+19) CB2R=VALUE(LOCD+20) BEW=CVALUE(ICVW1+NODE2)-CVALUE(ICVW1+NODE3) CEW=CVALUE(ICVW1+NODE1)-CVALUE(ICVW1+NODE3) BCW=CVALUE(ICVW1+NODE2)-CVALUE(ICVW1+NODE1) IF (KDISTO.EQ.2) GO TO 370 BE2W=CVALUE(ICV2W1+NODE2)-CVALUE(ICV2W1+NODE3) CE2W=CVALUE(ICV2W1+NODE1)-CVALUE(ICV2W1+NODE3) BC2W=CVALUE(ICV2W1+NODE2)-CVALUE(ICV2W1+NODE1) IF (KDISTO.EQ.3) GO TO 380 BEW2=CVALUE(ICVW2+NODE2)-CVALUE(ICVW2+NODE3) CEW2=CVALUE(ICVW2+NODE1)-CVALUE(ICVW2+NODE3) BCW2=CVALUE(ICVW2+NODE2)-CVALUE(ICVW2+NODE1) IF (KDISTO.EQ.5) GO TO 390 IF (KDISTO.EQ.6) GO TO 400 BEW12=CVALUE(ICVW12+NODE2)-CVALUE(ICVW12+NODE3) CEW12=CVALUE(ICVW12+NODE1)-CVALUE(ICVW12+NODE3) BCW12=CVALUE(ICVW12+NODE2)-CVALUE(ICVW12+NODE1) GO TO 410 C C CALCULATE HD2 CURRENT GENERATORS C 370 DIFVN1=0.5*CEW*CEW DIFVN2=0.5*BEW*BEW DIFVN3=0.5*BCW*BCW DSGMO2=GMO2*0.5*BEW*CEW GO TO 420 C C CALCULATE HD3 CURRENT GENERATORS C 380 DIFVI1=0.50*CEW*CE2W DIFVN1=0.25*CEW*CEW*CEW DIFVI2=0.50*BEW*BE2W DIFVN2=0.25*BEW*BEW*BEW DIFVI3=0.50*BCW*BC2W DIFVN3=0.25*BCW*BCW*BCW DSGMO2=GMO2*(BEW*CE2W+BE2W*CEW)*0.5 GO TO 430 C C CALCULATE IM2D CURRENT GENERATORS C 390 DIFVN1=CEW*CONJG(CEW2) DIFVN2=BEW*CONJG(BEW2) DIFVN3=BCW*CONJG(BCW2) DSGMO2=GMO2*0.5*(BEW*CONJG(CEW2)+CEW*CONJG(BEW2)) GO TO 420 C C CALCULATE IM2S CURRENT GENERATORS C 400 DIFVN1=CEW*CEW2 DIFVN2=BEW*BEW2 DIFVN3=BCW*BCW2 DSGMO2=GMO2*0.5*(BEW*CEW2+BEW2*CEW) GO TO 420 C C CALCULATE IM3 CURRENT GENERATORS C 410 DIFVI1=0.5*(CE2W*CONJG(CEW2)+CEW*CEW12) DIFVI2=0.5*(BE2W*CONJG(BEW2)+BEW*BEW12) DIFVI3=0.5*(BC2W*CONJG(BCW2)+BCW*BCW12) DIFVN1=CEW*CEW*CONJG(CEW2)*0.75 DIFVN2=BEW*BEW*CONJG(BEW2)*0.75 DIFVN3=BCW*BCW*CONJG(BCW2)*0.75 DSGMO2=GMO2*0.5*(CONJG(BEW2)*CE2W+BEW*CEW12+CONJG(CEW2)*BE2W+ 1 CEW*BEW12) GO TO 430 C 420 DSGO2=GO2*DIFVN1 DSGM2=GM2*DIFVN2 DSGMU2=GMU2*DIFVN3 DSGPI2=GPI2*DIFVN2 DSCB1=0.5*CB1*OMEGA*CMPLX(-AIMAG(DIFVN2),REAL(DIFVN2)) DSCB1R=0.5*CB1R*OMEGA*CMPLX(-AIMAG(DIFVN3),REAL(DIFVN3)) DSCJE1=0.5*CJE1*OMEGA*CMPLX(-AIMAG(DIFVN2),REAL(DIFVN2)) DSCJC1=0.5*CJC1*OMEGA*CMPLX(-AIMAG(DIFVN3),REAL(DIFVN3)) GO TO 440 C 430 DSGO2=2.0*GO2*DIFVI1+GO3*DIFVN1 DSGM2=2.0*GM2*DIFVI2+GM3*DIFVN2 DSGMU2=2.0*GMU2*DIFVI3+GMU3*DIFVN3 DSGPI2=2.0*GPI2*DIFVI2+GPI3*DIFVN2 DSCB1=OMEGA*(CB1*DIFVI2+CB2*DIFVN2/3.0) DSCB1=CMPLX(-AIMAG(DSCB1),REAL(DSCB1)) DSCB1R=OMEGA*(CB1R*DIFVI3+CB2R*DIFVN3/3.0) DSCB1R=CMPLX(-AIMAG(DSCB1R),REAL(DSCB1R)) DSCJE1=OMEGA*(CJE1*DIFVI2+CJE2*DIFVN2/3.0) DSCJE1=CMPLX(-AIMAG(DSCJE1),REAL(DSCJE1)) DSCJC1=OMEGA*(CJC1*DIFVI3+CJC2*DIFVN3/3.0) DSCJC1=CMPLX(-AIMAG(DSCJC1),REAL(DSCJC1)) C C DETERMINE CONTRIBUTION OF EACH DISTORTION SOURCE C 440 CVABE=CVALUE(ICVADJ+NODE2)-CVALUE(ICVADJ+NODE3) CVABC=CVALUE(ICVADJ+NODE2)-CVALUE(ICVADJ+NODE1) CVACE=CVALUE(ICVADJ+NODE1)-CVALUE(ICVADJ+NODE3) DISTO1=DSGM2+DSGO2+DSGMO2 DISTO2=DSGPI2+DSCB1+DSCJE1 DISTO3=DSGMU2+DSCB1R+DSCJC1 CVDO(1)=DSGM2*CVACE*ARG CVDO(2)=DSGPI2*CVABE*ARG CVDO(3)=DSGO2*CVACE*ARG CVDO(4)=DSGMU2*CVABC*ARG CVDO(5)=DSGMO2*CVACE*ARG CVDO(6)=DSCB1*CVABE*ARG CVDO(7)=DSCB1R*CVABC*ARG CVDO(8)=DSCJE1*CVABE*ARG CVDO(9)=DSCJC1*CVABC*ARG IF (KDISTO.EQ.3) GO TO 450 IF (KDISTO.EQ.7) GO TO 460 CVDO(10)=CVDO(1)+CVDO(2)+CVDO(3)+CVDO(4)+CVDO(5)+CVDO(6)+CVDO(7)+ 1 CVDO(8)+CVDO(9) CVDIST=CVDIST+CVDO(10) IF (IPRNT.EQ.0) GO TO 480 DO 445 J=1,10 CALL MAGPHS(CVDO(J),XMAG,XPHS) CVDO(J)=CMPLX(XMAG,XPHS) 445 CONTINUE IF (ITITLE.EQ.0) WRITE (6,301) ITITLE=1 WRITE (6,446) VALUE(LOCV),(VDO(1,J),J=1,10) 446 FORMAT(1H0,A8,*MAG*,1P12E10.3) WRITE (6,447) (VDO(2,J),J=1,10) 447 FORMAT(9X,*PHS*,12(1X,F7.2,2X)) GO TO 480 450 DGM2O3=GM2O3*CEW*BEW*BEW*0.25 DGMO23=GMO23*BEW*CEW*CEW*0.25 GO TO 470 460 DGM2O3=GM2O3*(0.5*BEW*CONJG(BEW2)*CEW+0.25*BEW*BEW*CONJG(CEW2)) DGMO23=GMO23*(0.5*CEW*CONJG(CEW2)*BEW+0.25*CEW*CEW*CONJG(BEW2)) 470 DISTO1=DISTO1+DGM2O3+DGMO23 CVDO(10)=DGM2O3*CVACE*ARG CVDO(11)=DGMO23*CVACE*ARG CVDO(12)=CVDO(1)+CVDO(2)+CVDO(3)+CVDO(4)+CVDO(5)+CVDO(6)+CVDO(7)+ 1 CVDO(8)+CVDO(9)+CVDO(10)+CVDO(11) CVDIST=CVDIST+CVDO(12) IF (IPRNT.EQ.0) GO TO 480 DO 475 J=1,12 CALL MAGPHS(CVDO(J),XMAG,XPHS) CVDO(J)=CMPLX(XMAG,XPHS) 475 CONTINUE IF (ITITLE.EQ.0) WRITE (6,311) ITITLE=1 WRITE (6,446) VALUE(LOCV),(VDO(1,J),J=1,12) WRITE (6,447) (VDO(2,J),J=1,12) 480 CVALUE(LVN+NODE1)=CVALUE(LVN+NODE1)-DISTO1+DISTO3 CVALUE(LVN+NODE2)=CVALUE(LVN+NODE2)-DISTO2-DISTO3 CVALUE(LVN+NODE3)=CVALUE(LVN+NODE3)+DISTO1+DISTO2 LOC=NODPLC(LOC) GO TO 330 C C JUNCTION DIODES C 500 IF (JELCNT(11).EQ.0) GO TO 700 ITITLE=0 501 FORMAT (////1X,*DIODE DISTORTION COMPONENTS*//1X,*NAME*, 1 11X,*GEQ*,7X,*CB*,8X,*CJ*,7X,*TOTAL*) 510 LOC=LOCATE(11) 520 IF (LOC.EQ.0) GO TO 700 LOCV=NODPLC(LOC+1) NODE1=NODPLC(LOC+2) NODE2=NODPLC(LOC+3) NODE3=NODPLC(LOC+4) LOCM=NODPLC(LOC+5) LOCM=NODPLC(LOCM+1) LOCT=LX0+NODPLC(LOC+11) LOCD=LD0+NODPLC(LOC+12) CDJ1=VALUE(LOCD) CDJ2=VALUE(LOCD+1) CDB1=VALUE(LOCD+3) GEQ2=VALUE(LOCD+4) GEQ3=VALUE(LOCD+5) CDB2=VALUE(LOCD+6) BEW=CVALUE(ICVW1+NODE3)-CVALUE(ICVW1+NODE2) IF (KDISTO.EQ.2) GO TO 540 BE2W=CVALUE(ICV2W1+NODE3)-CVALUE(ICV2W1+NODE2) IF (KDISTO.EQ.3) GO TO 550 BEW2=CVALUE(ICVW2+NODE3)-CVALUE(ICVW2+NODE2) IF (KDISTO.EQ.5) GO TO 560 IF (KDISTO.EQ.6) GO TO 570 BEW12=CVALUE(ICVW12+NODE3)-CVALUE(ICVW12+NODE2) GO TO 580 C C CALCULATE HD2 CURRENT GENERATORS C 540 DIFVN1=0.5*BEW*BEW GO TO 590 C C CALCULATE HD3 CURRENT GENERATORS C 550 DIFVI1=0.5*BEW*BE2W DIFVN1=0.25*BEW*BEW*BEW GO TO 600 C C CALCULATE IM2D CURRENT GENERATORS C 560 DIFVN1=BEW*CONJG(BEW2) GO TO 590 C C CALCULATE IM2S CURRENT GENERATORS C 570 DIFVN1=BEW*BEW2 GO TO 590 C C CALCULATE IM3 CURRENT GENERATORS C 580 DIFVI1=0.5*(BE2W*CONJG(BEW2)+BEW*BEW12) DIFVN1=BEW*BEW*CONJG(BEW2)*0.75 GO TO 600 590 DSG2=GEQ2*DIFVN1 DSCDB1=0.5*CDB1*OMEGA*CMPLX(-AIMAG(DIFVN1),REAL(DIFVN1)) DSCDJ1=0.5*CDJ1*OMEGA*CMPLX(-AIMAG(DIFVN1),REAL(DIFVN1)) GO TO 610 C 600 DSG2=2.0*GEQ2*DIFVI1+GEQ3*DIFVN1 DSCDB1=OMEGA*(CDB1*DIFVI1+CDB2*DIFVN1/3.0) DSCDB1=CMPLX(-AIMAG(DSCDB1),REAL(DSCDB1)) DSCDJ1=OMEGA*(CDJ1*DIFVI1+CDJ2*DIFVN1/3.0) DSCDJ1=CMPLX(-AIMAG(DSCDJ1),REAL(DSCDJ1)) C C DETERMINE CONTRIBUTION OF EACH DISTORTION SOURCE C 610 CVABE=CVALUE(ICVADJ+NODE3)-CVALUE(ICVADJ+NODE2) DISTO1=DSG2+DSCDB1+DSCDJ1 CVDO(1)=DSG2*CVABE*ARG CVDO(2)=DSCDB1*CVABE*ARG CVDO(3)=DSCDJ1*CVABE*ARG CVDO(4)=CVDO(1)+CVDO(2)+CVDO(3) CVDIST=CVDIST+CVDO(4) IF (IPRNT.EQ.0) GO TO 680 DO 670 J=1,4 CALL MAGPHS(CVDO(J),XMAG,XPHS) CVDO(J)=CMPLX(XMAG,XPHS) 670 CONTINUE IF (ITITLE.EQ.0) WRITE (6,501) ITITLE=1 WRITE (6,446) VALUE(LOCV),(VDO(1,J),J=1,4) WRITE (6,447) (VDO(2,J),J=1,4) 680 CVALUE(LVN+NODE2)=CVALUE(LVN+NODE2)+DISTO1 CVALUE(LVN+NODE3)=CVALUE(LVN+NODE3)-DISTO1 LOC=NODPLC(LOC) GO TO 520 C C OBTAIN TOTAL DISTORTION SOLUTION IF NECESSARY C 700 GO TO (1000,710,790,710,710,840,860),KDISTO 710 IF (KDISTO.EQ.4) GO TO 730 DO 720 I=2,NSTOP J=NODPLC(ISWAP+I) CVALUE(NDIAG+I)=CVALUE(LVN+J) 720 CONTINUE CALL COPY16(CVALUE(NDIAG+1),CVALUE(LVN+1),NSTOP) 730 CALL ACSOL CVALUE(LVN+1)=(0.0,0.0) C C STORE SOLUTION, PRINT AND STORE ANSWERS C 760 GO TO (1000,770,790,800,820,840,860),KDISTO 770 CALL COPY16(CVALUE(LVN+1),CVALUE(ICV2W1+1),NSTOP) CALL MAGPHS(CVDIST,O2MAG,O2PHS) IF (IPRNT.EQ.0) GO TO 900 O2LOG=20.0*ALOG10(O2MAG) WRITE (6,781) O2MAG,O2PHS,O2LOG 781 FORMAT (///5X,*HD2 MAGNITUDE *,1PE10.3,5X,*PHASE *,0PF7.2, 1 5X,*= *,F7.2,* DB*) GO TO 900 790 CALL MAGPHS(CVDIST,O3MAG,O3PHS) IF (IPRNT.EQ.0) GO TO 900 O3LOG=20.0*ALOG10(O3MAG) WRITE (6,791) O3MAG,O3PHS,O3LOG 791 FORMAT (///5X,*HD3 MAGNITUDE *,1PE10.3,5X,*PHASE *,0PF7.2, 1 5X,*= *,F7.2,* DB*) GO TO 900 800 CALL COPY16(CVALUE(LVN+1),CVALUE(ICVW2+1),NSTOP) CVOUT=CVALUE(ICVW2+IDNP)-CVALUE(ICVW2+IDNN) CALL MAGPHS(CVOUT,OW2MAG,OW2PHS) GO TO 1000 820 CALL COPY16(CVALUE(LVN+1),CVALUE(ICVW12+1),NSTOP) 840 CALL MAGPHS(CVDIST,O12MAG,O12PHS) IF (IPRNT.EQ.0) GO TO 900 O12LOG=20.0*ALOG10(O12MAG) IF (KDISTO.EQ.6) GO TO 850 WRITE (6,841) O12MAG,O12PHS,O12LOG 841 FORMAT (///5X,*IM2D MAGNITUDE *,1PE10.3,5X,*PHASE *,0PF7.2, 1 5X,*= *,F7.2,* DB*) GO TO 900 850 WRITE (6,851) O12MAG,O12PHS,O12LOG 851 FORMAT (///5X,*IM2S MAGNITUDE *,1PE10.3,5X,*PHASE *,0PF7.2, 1 5X,*= *,F7.2,* DB*) GO TO 900 860 CALL MAGPHS(CVDIST,O21MAG,O21PHS) IF (IPRNT.EQ.0) GO TO 900 O21LOG=20.0*ALOG10(O21MAG) WRITE (6,861) O21MAG,O21PHS,O21LOG 861 FORMAT (///5X,*IM3 MAGNITUDE *,1PE10.3,5X,*PHASE *,0PF7.2, 1 5X,*= *,F7.2,* DB*) CMA=ABS(4.0*O21MAG*COS((O21PHS-OPHASE)/RAD)) CMA=AMAX1(CMA,1.0E-20) CMP=ABS(4.0*O21MAG*SIN((O21PHS-OPHASE)/RAD)) CMP=AMAX1(CMP,1.0E-20) CMALOG=20.0*ALOG10(CMA) CMPLOG=20.0*ALOG10(CMP) WRITE (6,866) 866 FORMAT (////5X,*APPROXIMATE CROSS MODULATION COMPONENTS*) WRITE (6,871) CMA,CMALOG 871 FORMAT (/5X,*CMA MAGNITUDE *,1PE10.3,24X,*= *,0PF7.2,* DB*) WRITE (6,881) CMP,CMPLOG 881 FORMAT (/5X,*CMP MAGNITUDE *,1PE10.3,24X,*= *,0PF7.2,* DB*) C C SAVE DISTORTION OUTPUTS C 900 IFLAG=KDISTO+2 IF (IFLAG.GE.7) IFLAG=IFLAG-1 LOC=LOCATE(45) 910 IF (LOC.EQ.0) GO TO 1000 IF (NODPLC(LOC+5).NE.IFLAG) GO TO 920 ISEQ=NODPLC(LOC+4) CVALUE(LOCO+ISEQ)=CVDIST 920 LOC=NODPLC(LOC) GO TO 910 1000 CONTINUE C C FINISHED C 2000 RETURN END OVERLAY(7,0) PROGRAM OVTPVT C C THIS ROUTINE GENERATES THE REQUESTED TABULAR LISTINGS OF ANALYSIS C RESULTS. IT CALLS PLOT TO GENERATE LINE-PRINTER PLOTS. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET, 1 MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO, 2 ITEMNO,NOSOLV,MODAC COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /MISCEL/ APROG(3),ATIME,ADATE,ATITLE(15),RSTATS(50), 1 IWIDTH,LWIDTH,NOPAGE COMMON /DC/ TCSTAR,TCSTOP,TCINCR,ICVFLG,ITCELM,KSSOP,KINEL,KIDIN, 1 KOVAR,KIDOUT COMMON /AC/ FSTART,FSTOP,FINCR,SKW2,REFPRL,SPW2,JACFLG,IDFREQ, 1 INOISE,NOSPRT,NOSOUT,NOSIN,IDIST,IDPRT,JPZFLG,JPZTYP, 2 IPZIN,IPZITP,IPZOUT,IPZEQO,IPZLOC(2),IPZEQI,IPOMAT(3), 3 IPIMAT(4) COMMON /TRAN/ TSTEP,TSTOP,TSTART,DELMAX,TDMAX,FORFRE,JTRFLG COMMON /OUTINF/ STRING(15),YVAR(8),XSTART,XINCR,ITAB(8),ITYPE(8), 1 ILOGY(8),NPOINT,NUMOUT,KNTR,NUMDGT COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C COMPLEX CVAL DIMENSION PRFORM(3) DIMENSION SUBTIT(4,3) DATA SUBTIT / 8HDC TRANS, 8HFER CURV, 8HES , 8H , 1 8HTRANSIEN, 8HT ANALYS, 8HIS , 8H , 2 8HAC ANALY, 8HSIS , 8H , 8H / DATA PRFORM / 8H(1PE11.3, 8H,2X,8E00, 8H.00) / DATA APER,RPRN / 1H., 1H) / C CALL SECOND(T1) IF (ICALC.LE.0) GO TO 1000 CALL CRUNCH IF (NOGO.LT.0) GO TO 1000 C C CONSTRUCT FORMAT STATEMENT TO BE USED FOR PRINTING THE OUTPUTS C IFRACT=MAX0(NUMDGT-1,0) IFWDTH=IFRACT+9 IPOS=15 CALL ALFNUM(IFWDTH,PRFORM,IPOS) CALL MOVE(PRFORM,IPOS,APER,1,1) IPOS=IPOS+1 CALL ALFNUM(IFRACT,PRFORM,IPOS) CALL MOVE(PRFORM,IPOS,RPRN,1,1) C NOPRLN=MIN0(8,(LWIDTH-12)/IFWDTH) C IF (MODE-2) 5,10,300 5 NUMOUT=JELCNT(41)+1 GO TO 15 10 NUMOUT=JELCNT(42)+1 C C DC AND TRANSIENT ANALYSIS PRINTING C 15 LOC=LOCATE(30+MODE) 20 IF (LOC.EQ.0) GO TO 200 KNTR=MIN0(NOPRLN,NODPLC(LOC+3)) IF (KNTR.LE.0) GO TO 120 CALL TITLE(1,LWIDTH,1,SUBTIT(1,MODE)) CALL SETPRN(LOC) C C GET BUFFER SPACE C CALL GETMEM(LOCX,NPOINT) CALL GETMEM(LOCY,KNTR*NPOINT) C C INTERPOLATE OUTPUTS C CALL NTRPL8(LOCX,LOCY,NUMPNT) C C PRINT OUTPUTS C DO 100 I=1,NUMPNT XVAR=VALUE(LOCX+I) LOCYT=LOCY DO 50 K=1,KNTR YVAR(K)=VALUE(LOCYT+I) LOCYT=LOCYT+NPOINT 50 CONTINUE WRITE (6,PRFORM) XVAR,(YVAR(K),K=1,KNTR) 100 CONTINUE WRITE (6,111) 111 FORMAT(1HY) CALL CLRMEM(LOCX) CALL CLRMEM(LOCY) 120 LOC=NODPLC(LOC) GO TO 20 C C DC AND TRANSIENT ANALYSIS PLOTTING C 200 LOC=LOCATE(35+MODE) 210 IF (LOC.EQ.0) GO TO 250 KNTR=NODPLC(LOC+3) IF (KNTR.LE.0) GO TO 220 LOCV=NODPLC(LOC+1) CALL TITLE(1,LWIDTH,1,SUBTIT(1,MODE)) CALL SETPLT(LOC) C C GET BUFFER SPACE C CALL GETMEM(LOCX,NPOINT) CALL GETMEM(LOCY,KNTR*NPOINT) C C INTERPOLATE OUTPUTS AND LOAD PLOT BUFFERS C CALL NTRPL8(LOCX,LOCY,NUMPNT) CALL PLOT(NUMPNT,LOCX,LOCY,LOCV) CALL CLRMEM(LOCX) CALL CLRMEM(LOCY) 220 LOC=NODPLC(LOC) GO TO 210 C C FOURIER ANALYSIS C 250 IF (MODE.EQ.1) GO TO 1000 IF (NFOUR.EQ.0) GO TO 1000 IF (NOGO.NE.0) GO TO 1000 CALL FOURAN GO TO 1000 C C AC ANALYSIS PRINTING C 300 NUMOUT=JELCNT(43)+JELCNT(44)+JELCNT(45)+1 DO 599 ID=33,35 LOC=LOCATE(ID) 320 IF (LOC.EQ.0) GO TO 599 KNTR=MIN0(NOPRLN,NODPLC(LOC+3)) IF (KNTR.LE.0) GO TO 595 CALL TITLE(1,LWIDTH,1,SUBTIT(1,MODE)) CALL SETPRN(LOC) C C PRINT AC OUTPUTS C LOUT=(LOUTPT+1)/2 DO 590 I=1,ICALC XVAR=REAL(CVALUE(LOUT+1)) DO 500 K=1,KNTR ISEQ=ITAB(K) ISEQ=NODPLC(ISEQ+4) CVAL=CVALUE(LOUT+ISEQ) KTYPE=ITYPE(K) GO TO (450,450,430,440,450,450), KTYPE 430 YVAR(K)=REAL(CVAL) GO TO 500 440 YVAR(K)=AIMAG(CVAL) GO TO 500 450 CALL MAGPHS(CVAL,XMAG,XPHS) GO TO (460,460,430,440,470,465), KTYPE 460 YVAR(K)=XMAG GO TO 500 465 YVAR(K)=20.0*ALOG10(XMAG) GO TO 500 470 YVAR(K)=XPHS 500 CONTINUE LOUT=LOUT+NUMOUT 580 WRITE (6,PRFORM) XVAR,(YVAR(K),K=1,KNTR) 590 CONTINUE WRITE (6,111) 595 LOC=NODPLC(LOC) GO TO 320 599 CONTINUE C C AC ANALYSIS PLOTTING C DO 760 ID=38,40 LOC=LOCATE(ID) 610 IF (LOC.EQ.0) GO TO 760 KNTR=NODPLC(LOC+3) IF (KNTR.LE.0) GO TO 750 LOCV=NODPLC(LOC+1) CALL TITLE(1,LWIDTH,1,SUBTIT(1,MODE)) CALL SETPLT(LOC) C CALL GETMEM(LOCX,ICALC) CALL GETMEM(LOCY,KNTR*ICALC) C C LOAD PLOT BUFFERS C LOUT=(LOUTPT+1)/2 DO 710 I=1,ICALC XVAR=REAL(CVALUE(LOUT+1)) LOCYT=LOCY DO 700 K=1,KNTR ISEQ=ITAB(K) ISEQ=NODPLC(ISEQ+4) CVAL=CVALUE(LOUT+ISEQ) KTYPE=ITYPE(K) GO TO (670,670,650,660,670,670), KTYPE 650 YVR=REAL(CVAL) GO TO 695 660 YVR=AIMAG(CVAL) GO TO 695 670 CALL MAGPHS(CVAL,XMAG,XPHS) GO TO (680,680,650,660,690,685), KTYPE 680 YVR=ALOG10(XMAG) GO TO 695 685 YVR=20.0*ALOG10(XMAG) GO TO 695 690 YVR=XPHS 695 VALUE(LOCYT+I)=YVR LOCYT=LOCYT+ICALC 700 CONTINUE VALUE(LOCX+I)=XVAR LOUT=LOUT+NUMOUT 710 CONTINUE CALL PLOT(ICALC,LOCX,LOCY,LOCV) CALL CLRMEM(LOCX) CALL CLRMEM(LOCY) 750 LOC=NODPLC(LOC) GO TO 610 760 CONTINUE C C FINISHED C 1000 CALL CLRMEM(LOUTPT) CALL SECOND(T2) RSTATS(11)=RSTATS(11)+T2-T1 RETURN END SUBROUTINE NTRPL8(LOCX,LOCY,NUMPNT) C C THIS ROUTINE INTERPOLATES THE ANALYSIS DATA TO OBTAIN THE VALUES C PRINTED AND/OR PLOTTED, USING LAGRANGIAN INTERPOLATION WITH A POLYNO- C MIAL OF DEGREE 2. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET, 1 MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO, 2 ITEMNO,NOSOLV,MODAC COMMON /OUTINF/ STRING(15),YVAR(8),XSTART,XINCR,ITAB(8),ITYPE(8), 1 ILOGY(8),NPOINT,NUMOUT,KNTR,NUMDGT COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C XVAR=XSTART XVTOL=XINCR*1.0E-5 IPPNT=0 ICPNT=3 LOCO1=LOUTPT LOCO2=LOCO1+NUMOUT LOCO3=LOCO2+NUMOUT IF (ICALC.LE.2) GO TO 50 10 X1=VALUE(LOCO1+1) X2=VALUE(LOCO2+1) X3=VALUE(LOCO3+1) DX1X2=X1-X2 DX1X3=X1-X3 DX2X3=X2-X3 XDNOM1=1.0/(DX1X2*DX1X3) XDNOM2=-1.0/(DX1X2*DX2X3) XDNOM3=1.0/(DX2X3*DX1X3) 20 IF (XINCR.LT.0.0) GO TO 24 IF (XVAR.LE.(X3+XVTOL)) GO TO 30 GO TO 28 24 IF (XVAR.GE.(X3+XVTOL)) GO TO 30 28 IF (ICPNT.GE.ICALC) GO TO 100 ICPNT=ICPNT+1 LOCO1=LOCO2 LOCO2=LOCO3 LOCO3=LOCO2+NUMOUT GO TO 10 30 IPPNT=IPPNT+1 VALUE(LOCX+IPPNT)=XVAR DXX1=XVAR-X1 DXX2=XVAR-X2 DXX3=XVAR-X3 XFACT1=DXX2*DXX3*XDNOM1 XFACT2=DXX1*DXX3*XDNOM2 XFACT3=DXX1*DXX2*XDNOM3 LOCYT=LOCY DO 40 I=1,KNTR ISEQ=ITAB(I) ISEQ=NODPLC(ISEQ+4) V1=VALUE(LOCO1+ISEQ) V2=VALUE(LOCO2+ISEQ) V3=VALUE(LOCO3+ISEQ) YVR=V1*XFACT1+V2*XFACT2+V3*XFACT3 TOL=AMIN1(ABS(V1),ABS(V2),ABS(V3))*1.0E-10 IF (ABS(YVR).LE.TOL) YVR=0.0 VALUE(LOCYT+IPPNT)=YVR LOCYT=LOCYT+NPOINT 40 CONTINUE IF (IPPNT.GE.NPOINT) GO TO 100 XVAR=XSTART+FLOAT(IPPNT)*XINCR IF (ABS(XVAR).GE.ABS(XVTOL)) GO TO 20 XVAR=0.0 GO TO 20 C C SPECIAL HANDLING IF ICALC @ 2 C 50 IF (ICALC.EQ.2) GO TO 70 C... ICALC=1; JUST COPY OVER THE SINGLE POINT AND RETURN IPPNT=1 VALUE(LOCX+IPPNT)=XVAR LOCYT=LOCY DO 60 I=1,KNTR ISEQ=ITAB(I) ISEQ=NODPLC(ISEQ+4) VALUE(LOCYT+IPPNT)=VALUE(LOCO1+ISEQ) LOCYT=LOCYT+NPOINT 60 CONTINUE GO TO 100 C... ICALC=2; LINEAR INTERPOLATION USED 70 X1=VALUE(LOCO1+1) X2=VALUE(LOCO2+1) 80 IF (XINCR.LT.0.0) GO TO 84 IF (XVAR.GT.X2) GO TO 100 GO TO 88 84 IF (XVAR.LT.X2) GO TO 100 88 IPPNT=IPPNT+1 VALUE(LOCX+IPPNT)=XVAR LOCYT=LOCY DO 90 I=1,KNTR ISEQ=ITAB(I) ISEQ=NODPLC(ISEQ+4) V1=VALUE(LOCO1+ISEQ) V2=VALUE(LOCO2+ISEQ) YVR=V1+((XVAR-X1)/(X2-X1))*(V2-V1) TOL=AMIN1(ABS(V1),ABS(V2))*1.0E-10 IF (ABS(YVR).LE.TOL) YVR=0.0 VALUE(LOCYT+IPPNT)=YVR LOCYT=LOCYT+NPOINT 90 CONTINUE IF (IPPNT.GE.NPOINT) GO TO 100 XVAR=XSTART+FLOAT(IPPNT)*XINCR IF (ABS(XVAR).GE.ABS(XVTOL)) GO TO 80 XVAR=0.0 GO TO 80 C C RETURN C 100 NUMPNT=IPPNT RETURN END SUBROUTINE SETPRN(LOC) C C THIS ROUTINE FORMATS THE COLUMN HEADERS FOR TABULAR LISTINGS OF C OUTPUT VARIABLES. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET, 1 MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO, 2 ITEMNO,NOSOLV,MODAC COMMON /MISCEL/ APROG(3),ATIME,ADATE,ATITLE(15),RSTATS(50), 1 IWIDTH,LWIDTH,NOPAGE COMMON /DC/ TCSTAR,TCSTOP,TCINCR,ICVFLG,ITCELM,KSSOP,KINEL,KIDIN, 1 KOVAR,KIDOUT COMMON /AC/ FSTART,FSTOP,FINCR,SKW2,REFPRL,SPW2,JACFLG,IDFREQ, 1 INOISE,NOSPRT,NOSOUT,NOSIN,IDIST,IDPRT,JPZFLG,JPZTYP, 2 IPZIN,IPZITP,IPZOUT,IPZEQO,IPZLOC(2),IPZEQI,IPOMAT(3), 3 IPIMAT(4) COMMON /TRAN/ TSTEP,TSTOP,TSTART,DELMAX,TDMAX,FORFRE,JTRFLG COMMON /OUTINF/ STRING(15),YVAR(8),XSTART,XINCR,ITAB(8),ITYPE(8), 1 ILOGY(8),NPOINT,NUMOUT,KNTR,NUMDGT COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C DATA ABLNK, ATIMEX, AFREQ / 1H , 6H TIME, 6H FREQ / C C SET LIMITS DEPENDING UPON THE ANALYSIS MODE C IF (MODE-2) 10,20,30 10 XSTART=TCSTAR XINCR=TCINCR NPOINT=ICVFLG LOCE=NODPLC(ITCELM+1) ASWEEP=VALUE(LOCE) GO TO 40 20 XSTART=TSTART XINCR=TSTEP NPOINT=JTRFLG ASWEEP=ATIMEX GO TO 40 30 XSTART=FSTART XINCR=FINCR NPOINT=ICALC ASWEEP=AFREQ C C CONSTRUCT AND PRINT THE OUTPUT VARIABLE NAMES C 40 LOCT=LOC+2 IPOS=1 NPOS=IPOS+NUMDGT+8 DO 90 I=1,KNTR LOCT=LOCT+2 ITAB(I)=NODPLC(LOCT) ITYPE(I)=NODPLC(LOCT+1) CALL OUTNAM(ITAB(I),ITYPE(I),STRING,IPOS) IF (IPOS.GE.NPOS) GO TO 70 DO 60 J=IPOS,NPOS CALL MOVE(STRING,J,ABLNK,1,1) 60 CONTINUE IPOS=NPOS GO TO 80 70 CALL MOVE(STRING,IPOS,ABLNK,1,1) IPOS=IPOS+1 80 NPOS=NPOS+NUMDGT+8 90 CONTINUE CALL MOVE(STRING,IPOS,ABLNK,1,7) JSTOP=(IPOS+6)/8 WRITE (6,91) ASWEEP,(STRING(J),J=1,JSTOP) 91 FORMAT(/3X,A8,5X,14A8,A4) WRITE (6,101) 101 FORMAT(1HX/1H ) RETURN END SUBROUTINE SETPLT(LOC) C C THIS ROUTINE GENERATES THE "LEGEND" SUBHEADING USED TO IDENTIFY C INDIVIDUAL TRACES ON MULTI-TRACE LINE-PRINTER PLOTS. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET, 1 MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO, 2 ITEMNO,NOSOLV,MODAC COMMON /MISCEL/ APROG(3),ATIME,ADATE,ATITLE(15),RSTATS(50), 1 IWIDTH,LWIDTH,NOPAGE COMMON /DC/ TCSTAR,TCSTOP,TCINCR,ICVFLG,ITCELM,KSSOP,KINEL,KIDIN, 1 KOVAR,KIDOUT COMMON /AC/ FSTART,FSTOP,FINCR,SKW2,REFPRL,SPW2,JACFLG,IDFREQ, 1 INOISE,NOSPRT,NOSOUT,NOSIN,IDIST,IDPRT,JPZFLG,JPZTYP, 2 IPZIN,IPZITP,IPZOUT,IPZEQO,IPZLOC(2),IPZEQI,IPOMAT(3), 3 IPIMAT(4) COMMON /TRAN/ TSTEP,TSTOP,TSTART,DELMAX,TDMAX,FORFRE,JTRFLG COMMON /OUTINF/ STRING(15),YVAR(8),XSTART,XINCR,ITAB(8),ITYPE(8), 1 ILOGY(8),NPOINT,NUMOUT,KNTR,NUMDGT COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C DIMENSION LOGOPT(6) DATA LOGOPT / 2, 2, 1, 1, 1, 1 / DATA ABLNK, ATIMEX, AFREQ / 1H , 6H TIME, 6H FREQ / DATA PLTSYM / 8H+*\&'?<> / C C SET LIMITS DEPENDING UPON THE ANALYSIS MODE C IF (MODE-2) 10,20,30 10 XSTART=TCSTAR XINCR=TCINCR NPOINT=ICVFLG LOCE=NODPLC(ITCELM+1) ASWEEP=VALUE(LOCE) GO TO 40 20 XSTART=TSTART XINCR=TSTEP NPOINT=JTRFLG ASWEEP=ATIMEX GO TO 40 30 XSTART=FSTART XINCR=FINCR NPOINT=ICALC ASWEEP=AFREQ C C CONSTRUCT AND PRINT THE OUTPUT VARIABLES WITH CORRESPONDING PLOT C SYMBOLS C 40 LOCT=LOC+2 IF (KNTR.EQ.1) GO TO 80 WRITE (6,41) 41 FORMAT("0LEGEND:"/) DO 70 I=1,KNTR LOCT=LOCT+2 ITAB(I)=NODPLC(LOCT) IOUTYP=NODPLC(LOCT+1) ITYPE(I)=IOUTYP ILOGY(I)=1 IF (MODE.LE.2) GO TO 50 ILOGY(I)=LOGOPT(IOUTYP) 50 IPOS=1 CALL OUTNAM(ITAB(I),ITYPE(I),STRING,IPOS) CALL MOVE(STRING,IPOS,ABLNK,1,7) JSTOP=(IPOS+6)/8 CALL MOVE(ACHAR,1,PLTSYM,I,1) WRITE (6,61) ACHAR,(STRING(J),J=1,JSTOP) 61 FORMAT(1X,A1,2H: ,5A8) 70 CONTINUE 80 IF (KNTR.GE.2) GO TO 90 ITAB(1)=NODPLC(LOC+4) IOUTYP=NODPLC(LOC+5) ITYPE(1)=IOUTYP ILOGY(1)=1 IF (MODE.LE.2) GO TO 90 ILOGY(1)=LOGOPT(IOUTYP) 90 IPOS=1 CALL OUTNAM(ITAB(1),ITYPE(1),STRING,IPOS) CALL MOVE(STRING,IPOS,ABLNK,1,7) JSTOP=(IPOS+6)/8 WRITE (6,101) ASWEEP,(STRING(J),J=1,JSTOP) 101 FORMAT(1HX/3X,A8,4X,5A8) RETURN END SUBROUTINE PLOT(NUMPNT,LOCX,LOCY,LOCV) C C THIS ROUTINE GENERATES THE LINE-PRINTER PLOTS. C COMMON /MISCEL/ APROG(3),ATIME,ADATE,ATITLE(15),RSTATS(50), 1 IWIDTH,LWIDTH,NOPAGE COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET, 1 MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO, 2 ITEMNO,NOSOLV,MODAC COMMON /KNSTNT/ TWOPI,XLOG2,XLOG10,ROOT2,RAD,BOLTZ,CHARGE,CTOK, 1 GMIN,RELTOL,ABSTOL,VNTOL,TRTOL,CHGTOL,EPS0,EPSSIL,EPSOX COMMON /OUTINF/ STRING(15),YVAR(8),XSTART,XINCR,ITAB(8),ITYPE(8), 1 ILOGY(8),NPOINT,NUMOUT,KNTR,NUMDGT COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C INTEGER XOR DIMENSION YCOOR(5,8),ICOOR(8),DELPLT(8) DIMENSION AGRAPH(13),APLOT(13),ISPOT(5) DIMENSION ASYM(2),PMIN(8),JCOOR(8) DATA ISPOT / 1, 26, 51, 76, 101 / DATA ABLNK, ALETX, APER / 1H , 1HX, 1H. / DATA ASYM1, ASYM2, ARPRN / 8H(-------, 8H--------, 1H) / DATA PLTSYM / 8H+*\&'?<> / C C IF (NUMPNT.LE.0) GO TO 400 DO 5 I=1,13 AGRAPH(I)=ABLNK 5 CONTINUE DO 7 I=1,5 CALL MOVE(AGRAPH,ISPOT(I),APER,1,1) 7 CONTINUE LOCYT=LOCY LSPOT=LOCV-1 MLTSCL=0 IF (VALUE(LOCV).EQ.0.0) MLTSCL=1 DO 235 K=1,KNTR LSPOT=LSPOT+2 YMIN=VALUE(LSPOT) YMAX=VALUE(LSPOT+1) IF (YMIN.NE.0.0) GO TO 10 IF (YMAX.NE.0.0) GO TO 10 GO TO 100 10 YMIN1=AMIN1(YMIN,YMAX) YMAX1=AMAX1(YMIN,YMAX) 30 IF (ILOGY(K).EQ.1) GO TO 40 YMIN1=ALOG10(AMAX1(YMIN1,1.0E-20)) YMAX1=ALOG10(AMAX1(YMAX1,1.0E-20)) DEL=AMAX1(YMAX1-YMIN1,0.0001)/4.0 GO TO 50 40 DEL=AMAX1(YMAX1-YMIN1,1.0E-20)/4.0 50 YMIN=YMIN1 YMAX=YMAX1 GO TO 200 C C DETERMINE MAX AND MIN VALUES C 100 YMAX1=VALUE(LOCYT+1) YMIN1=YMAX1 IF (NUMPNT.EQ.1) GO TO 150 DO 110 I=2,NUMPNT YMIN1=AMIN1(YMIN1,VALUE(LOCYT+I)) YMAX1=AMAX1(YMAX1,VALUE(LOCYT+I)) 110 CONTINUE C C SCALING C 150 CALL SCALE(YMIN1,YMAX1,4,YMIN,YMAX,DEL) C C DETERMINE COORDINATES C 200 YCOOR(1,K)=YMIN PMIN(K)=YMIN SMALL=DEL*1.0E-4 IF (ABS(YCOOR(1,K)).LE.SMALL) YCOOR(1,K)=0.0 DO 210 I=1,4 YCOOR(I+1,K)=YCOOR(I,K)+DEL IF (ABS(YCOOR(I+1,K)).LE.SMALL) YCOOR(I+1,K)=0.0 210 CONTINUE IF (ILOGY(K).EQ.1) GO TO 230 DO 220 I=1,5 220 YCOOR(I,K)=EXP(XLOG10*YCOOR(I,K)) 230 DELPLT(K)=DEL/25.0 LOCYT=LOCYT+NPOINT 235 CONTINUE C C COUNT DISTINCT COORDINATES C ICOOR(1)=1 JCOOR(1)=1 NUMCOR=1 IF (KNTR.EQ.1) GO TO 290 DO 250 I=2,KNTR DO 245 J=1,NUMCOR L=JCOOR(J) C... COORDINATES ARE *EQUAL* IF THE MOST SIGNIFICANT 24 BITS AGREE DO 240 K=1,5 Y1=AND(YCOOR(K,L),COMPL(7777 7777B)) Y2=AND(YCOOR(K,I),COMPL(7777 7777B)) IF (XOR(Y1,Y2).NE.0) GO TO 245 240 CONTINUE ICOOR(I)=L GO TO 250 245 CONTINUE ICOOR(I)=I NUMCOR=NUMCOR+1 JCOOR(NUMCOR)=I 250 CONTINUE C C PRINT COORDINATES C 260 DO 280 I=1,NUMCOR ASYM(1)=ASYM1 ASYM(2)=ASYM2 IPOS=2 DO 270 J=1,KNTR IF (ICOOR(J).NE.JCOOR(I)) GO TO 270 CALL MOVE(ASYM,IPOS,PLTSYM,J,1) IPOS=IPOS+1 270 CONTINUE CALL MOVE(ASYM,IPOS,ARPRN,1,1) K=JCOOR(I) WRITE (6,271) ASYM,(YCOOR(J,K),J=1,5) 271 FORMAT(/1HX,2A8,4H----,1PE12.3,4(15X,E10.3)/26X,51(2H -)) 280 CONTINUE GO TO 300 290 WRITE (6,291) (YCOOR(J,1),J=1,5) 291 FORMAT(/1HX,20X,1PE12.3,4(15X,E10.3)/26X,51(2H -)) C C PLOTTING C 300 ASPOT=ABLNK DO 320 I=1,NUMPNT XVAR=VALUE(LOCX+I) LOCYT=LOCY CALL COPY8(AGRAPH,APLOT,13) DO 310 K=1,KNTR YVR=VALUE(LOCYT+I) KTMP=ICOOR(K) YMIN1=PMIN(KTMP) JPOINT=IFIX((YVR-YMIN1)/DELPLT(K)+0.5)+1 IF (JPOINT.LE.0) GO TO 306 IF (JPOINT.GE.102) GO TO 306 CALL MOVE(ASPOT,1,APLOT,JPOINT,1) IF (ASPOT.EQ.ABLNK) GO TO 303 IF (ASPOT.EQ.APER) GO TO 303 CALL MOVE(APLOT,JPOINT,ALETX,1,1) GO TO 306 303 CALL MOVE(APLOT,JPOINT,PLTSYM,K,1) 306 LOCYT=LOCYT+NPOINT 310 CONTINUE YVR=VALUE(LOCY+I) IF (ILOGY(1).EQ.1) GO TO 315 YVR=EXP(XLOG10*YVR) 315 WRITE (6,316) XVAR,YVR,APLOT 316 FORMAT(1X,1PE10.3,3X,E10.3,3X,13A8) 320 CONTINUE C C FINISHED C WRITE (6,331) 331 FORMAT(26X,51(2H -)//) GO TO 500 C C TOO FEW POINTS C 400 WRITE (6,401) 401 FORMAT("0WARNING: TOO FEW POINTS FOR PLOTTING"/) 500 WRITE (6,501) 501 FORMAT(1HY) RETURN END SUBROUTINE SCALE(XMIN,XMAX,N,XMINP,XMAXP,DEL) C C THIS ROUTINE DETERMINES THE "OPTIMAL" SCALE TO USE FOR THE PLOT OF C SOME OUTPUT VARIABLE. C C C ADAPTED FROM ALGORITHM 463 OF "COLLECTED ALGORITHMS OF THE CACM" C COMMON /KNSTNT/ TWOPI,XLOG2,XLOG10,ROOT2,RAD,BOLTZ,CHARGE,CTOK, 1 GMIN,RELTOL,ABSTOL,VNTOL,TRTOL,CHGTOL,EPS0,EPSSIL,EPSOX INTEGER XOR DIMENSION VINT(5) DATA VINT / 1.0,2.0,5.0,10.0,20.0 / DATA EPS / 1.0E-12 / C C C... TRAP TOO-SMALL DATA SPREAD TMIN=AND(XMIN,COMPL(777 777 777B)) TMAX=AND(XMAX,COMPL(777 777 777B)) IF (XOR(TMIN,TMAX).NE.0) GO TO 10 IF (XMIN.GE.0.0) GO TO 5 XMAX=0.5*XMIN+EPS XMIN=1.5*XMIN-EPS GO TO 10 5 XMAX=1.5*XMIN+EPS XMIN=0.5*XMIN-EPS C... FIND APPROXIMATE INTERVAL SIZE, NORMALIZED TO "1,10! 10 A=(XMAX-XMIN)/FLOAT(N) NAL=IFIX(ALOG10(A)) IF (A.LT.1.0) NAL=NAL-1 XFACT=EXP(XLOG10*FLOAT(NAL)) B=A/XFACT C... FIND CLOSEST PERMISSIBLE INTERVAL SIZE DO 20 I=1,3 IF (B.LT.(VINT(I)+EPS)) GO TO 30 20 CONTINUE I=4 C... COMPUTE INTERVAL SIZE 30 DEL=VINT(I)*XFACT FM1=XMIN/DEL M1=FM1 IF (FM1.LT.0.0) M1=M1-1 IF (ABS(FLOAT(M1)+1.0-FM1).LT.EPS) M1=M1+1 C... COMPUTE NEW MAXIMUM AND MINIMUM LIMITS XMINP=DEL*FLOAT(M1) FM2=XMAX/DEL M2=FM2+1.0 IF (FM2.LT.(-1.0)) M2=M2-1 IF (ABS(FM2+1.0-FLOAT(M2)).LT.EPS) M2=M2-1 XMAXP=DEL*FLOAT(M2) NP=M2-M1 C... CHECK WHETHER ANOTHER LOOP REQUIRED IF (NP.LE.N) GO TO 40 I=I+1 GO TO 30 C... DO FINAL ADJUSTMENTS AND CORRECT FOR ROUNDOFF ERROR(S) 40 NX=(N-NP)/2 XMINP=AMIN1(XMIN,XMINP-FLOAT(NX)*DEL) XMAXP=AMAX1(XMAX,XMINP+FLOAT(N)*DEL) RETURN END SUBROUTINE FOURAN C C THIS ROUTINE DETERMINES THE FOURIER COEFFICIENTS OF A TRANSIENT C ANALYSIS WAVEFORM. C COMMON /TABINF/ IELMNT,ISBCKT,NSBCKT,IUNSAT,NUNSAT,ITEMPS,NUMTEM, 1 ISENS,NSENS,IFOUR,NFOUR,IFIELD,ICODE,IDELIM,ICOLUM,INSIZE, 2 JUNODE,LSBKPT,NUMBKP,IORDER,JMNODE,IUR,IUC,ILC,ILR,NUMOFF,ISR, 3 NMOFFC,ISEQ,ISEQ1,NEQN,NODEVS,NDIAG,ISWAP,IEQUA,MACINS,LVNIM1, 4 LX0,LVN,LYNL,LYU,LYL,LX1,LX2,LX3,LX4,LX5,LX6,LX7,LD0,LD1,LTD, 5 LOUTPT,LPOL,LZER COMMON /CIRDAT/ LOCATE(50),JELCNT(50),NUNODS,NCNODS,NUMNOD,NSTOP, 1 NUT,NLT,NXTRM,NDIST,NTLIN,IBR,NUMVS COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS, 1 LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF COMMON /MISCEL/ APROG(3),ATIME,ADATE,ATITLE(15),RSTATS(50), 1 IWIDTH,LWIDTH,NOPAGE COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET, 1 MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO, 2 ITEMNO,NOSOLV,MODAC COMMON /KNSTNT/ TWOPI,XLOG2,XLOG10,ROOT2,RAD,BOLTZ,CHARGE,CTOK, 1 GMIN,RELTOL,ABSTOL,VNTOL,TRTOL,CHGTOL,EPS0,EPSSIL,EPSOX COMMON /TRAN/ TSTEP,TSTOP,TSTART,DELMAX,TDMAX,FORFRE,JTRFLG COMMON /OUTINF/ STRING(15),YVAR(8),XSTART,XINCR,ITAB(8),ITYPE(8), 1 ILOGY(8),NPOINT,NUMOUT,KNTR,NUMDGT COMMON /BLANK/ VALUE(64) INTEGER NODPLC(64) COMPLEX CVALUE(32) EQUIVALENCE (VALUE(1),NODPLC(1),CVALUE(1)) C C DIMENSION SINCO(9),COSCO(9) DIMENSION FORTIT(4) DATA FORTIT / 8HFOURIER , 8HANALYSIS, 8H , 8H / DATA ABLNK / 1H / C C FORPRD=1.0/FORFRE XSTART=TSTOP-FORPRD KNTR=1 XN=101.0 XINCR=FORPRD/XN NPOINT=XN CALL GETMEM(LOCX,NPOINT) CALL GETMEM(LOCY,NPOINT) DO 105 NKNT=1,NFOUR ITAB(1)=NODPLC(IFOUR+NKNT) KFROUT=ITAB(1) CALL NTRPL8(LOCX,LOCY,NUMPNT) DCCO=0.0 CALL ZERO8(SINCO,9) CALL ZERO8(COSCO,9) LOCT=LOCY+1 IPNT=0 10 YVR=VALUE(LOCT+IPNT) DCCO=DCCO+YVR FORFAC=FLOAT(IPNT)*TWOPI/XN ARG=0.0 DO 20 K=1,9 ARG=ARG+FORFAC SINCO(K)=SINCO(K)+YVR*SIN(ARG) COSCO(K)=COSCO(K)+YVR*COS(ARG) 20 CONTINUE IPNT=IPNT+1 IF (IPNT.NE.NPOINT) GO TO 10 DCCO=DCCO/XN FORFAC=2.0/XN DO 30 K=1,9 SINCO(K)=SINCO(K)*FORFAC COSCO(K)=COSCO(K)*FORFAC 30 CONTINUE CALL TITLE(0,72,1,FORTIT) IPOS=1 CALL OUTNAM(KFROUT,1,STRING,IPOS) CALL MOVE(STRING,IPOS,ABLNK,1,7) JSTOP=(IPOS+6)/8 WRITE (6,61) (STRING(J),J=1,JSTOP) 61 FORMAT(" FOURIER COMPONENTS OF TRANSIENT RESPONSE ",5A8///) WRITE (6,71) DCCO 71 FORMAT("0DC COMPONENT =",1PE12.3/, 1 "0HARMONIC FREQUENCY FOURIER NORMALIZED PHASE NO 2RMALIZED"/, 3 " NO (HZ) COMPONENT COMPONENT (DEG) PHA 4SE (DEG)"//) IKNT=1 FREQ1=FORFRE XNHARM=1.0 CALL MAGPHS(CMPLX(SINCO(1),COSCO(1)),XNORM,PNORM) PHASEN=0.0 WRITE (6,81) IKNT,FREQ1,XNORM,XNHARM,PNORM,PHASEN 81 FORMAT(I6,1PE15.3,E12.3,0PF13.6,F10.3,F12.3/) THD=0.0 DO 90 IKNT=2,9 FREQ1=FLOAT(IKNT)*FORFRE CALL MAGPHS(CMPLX(SINCO(IKNT),COSCO(IKNT)),HARM,PHASE) XNHARM=HARM/XNORM PHASEN=PHASE-PNORM THD=THD+XNHARM*XNHARM WRITE (6,81) IKNT,FREQ1,HARM,XNHARM,PHASE,PHASEN 90 CONTINUE THD=100.0*SQRT(THD) WRITE (6,101) THD 101 FORMAT (//5X,*TOTAL HARMONIC DISTORTION = *,F12.6,* PERCENT*) 105 CONTINUE CALL CLRMEM(LOCX) CALL CLRMEM(LOCY) 110 RETURN END ~eor *IDENT,BUILD *DELETE,SPICE.118,SPICE.119 *DELETE,ASMARG.3 COMPILER MICRO 1,,*RUN* DELETE IF COMPILER IS RUN *DELETE,ASMARG.6 ASMARG MACRO N ASMARG ENDM *DELETE,ASMARG.9 *DELETE,SPICE.03672 KNTLIM=MIN0((8*NOFLD),IWIDTH) *DELETE,SPICE.3909 IF (EOF,5) 10,100 *COMPILE,SPICE ~eor DIFPAIR CKT - SIMPLE DIFFERENTIAL PAIR .WIDTH IN=72 .OPT ACCT LIST NODE LVLCOD=2 .TF V(5) VIN .DC VIN -0.25 0.25 0.005 .AC DEC 10 1 10GHZ .TRAN 5NS 500NS VIN 1 0 SIN(0 0.1 5MEG) AC 1 VCC 8 0 12 VEE 9 0 -12 Q1 4 2 6 QNL Q2 5 3 6 QNL RS1 1 2 1K RS2 3 0 1K RC1 4 8 10K RC2 5 8 10K Q3 6 7 9 QNL Q4 7 7 9 QNL RBIAS 7 8 20K .MODEL QNL NPN(BF=80 RB=100 CCS=2PF TF=0.3NS TR=6NS CJE=3PF CJC=2PF + VA=50) .PRINT DC V(4) V(5) .PLOT DC V(5) .PRINT AC VM(5) VP(5) .PLOT AC VM(5) VP(5) .PRINT TRAN V(4) V(5) .PLOT TRAN V(5) .END TDO - TUNNEL DIODE OSCILLATOR .WIDTH IN=72 VBIAS 0 2 -120MV LS 2 1 2.5UH CS 1 0 100PF GTD 1 0 POLY(1) 1 0 + -3.95510115972848E-17 +1.80727308405845E-01 -2.93646217292003E+00 + +4.12669748472374E+01 -6.09649516869413E+02 +6.08207899870511E+03 + -3.73459336478768E+04 +1.44146702315112E+05 -3.53021176453665E+05 + +5.34093436084762E+05 -4.56234076434067E+05 +1.68527934888894E+05 .DC VBIAS 0 -600MV -5MV .PLOT DC I(VBIAS) (0,5MA) .TRAN 5NS 500NS 0 5NS .PLOT TRAN V(1) .OPT ACCT LIST NODE LVLCOD=2 .END RTLINV CKT - CASCADED RTL INVERTERS .WIDTH IN=72 .OPT ACCT LIST NODE LVLCOD=2 .DC VIN 0.0 2.5 0.025 .TRAN 2NS 200NS VCC 6 0 5 VIN 1 0 PULSE(0 5 2NS 2NS 2NS 80NS) RB1 1 2 10K RC1 6 3 1K Q1 3 2 0 QND RB2 3 4 10K Q2 5 4 0 QND RC2 6 5 1K .MODEL QND NPN(BF=50 RB=70 RC=40 CCS=2PF TF=0.1NS TR=10NS CJE=0.9PF + CJC=1.5PF PC=0.85 VA=50) .PRINT DC V(3) V(5) .PLOT DC V(3) .PRINT TRAN V(3) V(5) .PLOT TRAN V(3) V(5) V(1) .END SCHMITT CKT - ECL COMPATIBLE SCHMITT TRIGGER .WIDTH IN=72 .OPT ACCT LIST NODE LVLCOD=2 .TRAN 10NS 1000NS VIN 1 0 PULSE(-1.6 -1.2 10NS 400NS 400NS 100NS 10000NS) VEE 8 0 -5 RIN 1 2 50 RC1 0 3 50 R1 3 5 185 R2 5 8 760 RC2 0 6 100 RE 4 8 260 RTH1 7 8 125 RTH2 7 0 85 CLOAD 7 0 5PF Q1 3 2 4 QSTD OFF Q2 6 5 4 QSTD Q3 0 6 7 QSTD Q4 0 6 7 QSTD .MODEL QSTD NPN(IS=1.0E-16 BF=50 BR=0.1 RB=50 RC=10 TF=0.12NS TR=5NS + CJE=0.4PF PE=0.8 ME=0.4 CJC=0.5PF PC=0.8 MC=0.333 CCS=1PF VA=50) .PRINT TRAN V(1) V(3) V(5) V(6) .PLOT TRAN V(3) V(5) V(6) V(1) .END MOSMEM - MOS MEMORY CELL .WIDTH IN=72 .OPT ABSTOL=1U .OPT ACCT LIST NODE .TRAN 20NS 2US VDD 9 0 DC 5 VS 7 0 PULSE(2 0 520NS 20NS 20NS 500NS 2000NS) VW 1 0 PULSE(0 2 20NS 20NS 500NS 200NS) VWB 2 0 PULSE(2 0 20NS 20NS 20NS 2000NS 2000NS) M1 3 1 0 0 MOD W=250U L=5U M2 4 2 0 0 MOD W=250U L=5U M3 9 9 3 0 MOD W=5U L=5U M4 9 9 4 0 MOD W=5U L=5U M5 5 7 3 0 MOD W=50U L=5U M6 6 7 4 0 MOD W=50U L=5U M7 5 6 0 0 MOD W=250U L=5U M8 6 5 0 0 MOD W=250U L=5U M9 9 9 5 0 MOD W=5U L=5U M10 9 9 6 0 MOD W=5U L=5U M11 8 4 0 0 MOD W=250U L=5U M12 9 9 8 0 MOD W=5U L=5U .MODEL MOD NMOS(VTO=0.5 PHI=0.7 KP=1.0E-6 GAMMA=1.83 LAMBDA=0.115 + LEVEL=1 CGSO=1U CGDO=1U CBD=50P CBS=50P) .PRINT DC V(5) V(6) .PLOT DC V(6) .PLOT TRAN V(6) V(5) V(7) V(1) V(2) .END MOSAMP1 - MOS AMPLIFIER - DC/AC .OPTIONS ACCT ABSTOL=10N VNTOL=10N .DC VIN -60MV +6MV 0.66MV .OP .AC DEC 10 100 10MEG M1 15 15 1 32 M W=88.9U L=25.4U M2 1 1 2 32 M W=12.7U L=266.7U M3 2 2 30 32 M W=88.9U L=25.4U M4 15 5 4 32 M W=12.7U L=106.7U M5 4 4 30 32 M W=88.9U L=12.7U M6 15 15 5 32 M W=44.5U L=25.4U M7 5 0 8 32 M W=482.6U L=12.7U M8 8 2 30 32 M W=88.9U L=25.4U M9 15 15 6 32 M W=44.5U L=25.4U M10 6 21 8 32 M W=482.6U L=12.7U M11 15 6 7 32 M W=12.7U L=106.7U M12 7 4 30 32 M W=88.9U L=12.7U M13 15 10 9 32 M W=139.7U L=12.7U M14 9 11 30 32 M W=139.7U L=12.7U M15 15 15 12 32 M W=12.7U L=207.8U M16 12 12 11 32 M W=54.1U L=12.7U M17 11 11 30 32 M W=54.1U L=12.7U M18 15 15 10 32 M W=12.7U L=45.2U M19 10 12 13 32 M W=270.5U L=12.7U M20 13 7 30 32 M W=270.5U L=12.7U M21 15 10 14 32 M W=254U L=12.7U M22 14 11 30 32 M W=241.3U L=12.7U M23 15 20 16 32 M W=19U L=38.1U M24 16 14 30 32 M W=406.4U L=12.7U M25 15 15 20 32 M W=38.1U L=42.7U M26 20 16 30 32 M W=381U L=25.4U M27 20 15 66 32 M W=22.9U L=7.6U CC 7 9 40PF CL 66 0 70PF VIN 21 0 DC -30MV AC 1 VCCP 15 0 DC +15 VCCN 30 0 DC -15 VB 32 0 DC -20 .MODEL M NMOS(NSUB=2.2E15 UO=575 UCRIT=49K UEXP=0.1 TOX=0.11U XJ=2.95U + LEVEL=2 CGSO=1.5N CGDO=1.5N CBD=4.5F CBS=4.5F LD=2.4485U NSS=3.2E10) .PLOT DC V(20) .PRINT AC VDB(20) VP(20) VDB(66) VP(66) .PLOT AC VDB(20) VP(20) VDB(66) VP(66) .END MOSAMP2 - MOS AMPLIFIER - TRANSIENT .OPTIONS ACCT ABSTOL=10N VNTOL=10N .TRAN 0.1US 10US M1 15 15 1 32 M W=88.9U L=25.4U M2 1 1 2 32 M W=12.7U L=266.7U M3 2 2 30 32 M W=88.9U L=25.4U M4 15 5 4 32 M W=12.7U L=106.7U M5 4 4 30 32 M W=88.9U L=12.7U M6 15 15 5 32 M W=44.5U L=25.4U M7 5 20 8 32 M W=482.6U L=12.7U M8 8 2 30 32 M W=88.9U L=25.4U M9 15 15 6 32 M W=44.5U L=25.4U M10 6 21 8 32 M W=482.6U L=12.7U M11 15 6 7 32 M W=12.7U L=106.7U M12 7 4 30 32 M W=88.9U L=12.7U M13 15 10 9 32 M W=139.7U L=12.7U M14 9 11 30 32 M W=139.7U L=12.7U M15 15 15 12 32 M W=12.7U L=207.8U M16 12 12 11 32 M W=54.1U L=12.7U M17 11 11 30 32 M W=54.1U L=12.7U M18 15 15 10 32 M W=12.7U L=45.2U M19 10 12 13 32 M W=270.5U L=12.7U M20 13 7 30 32 M W=270.5U L=12.7U M21 15 10 14 32 M W=254U L=12.7U M22 14 11 30 32 M W=241.3U L=12.7U M23 15 20 16 32 M W=19U L=38.1U M24 16 14 30 32 M W=406.4U L=12.7U M25 15 15 20 32 M W=38.1U L=42.7U M26 20 16 30 32 M W=381U L=25.4U M27 20 15 66 32 M W=22.9U L=7.6U CC 7 9 40PF CL 66 0 70PF VIN 21 0 PULSE(0 5 1NS 1NS 1NS 5US 10US) VCCP 15 0 DC +15 VDDN 30 0 DC -15 VB 32 0 DC -20 .MODEL M NMOS(NSUB=2.2E15 UO=575 UCRIT=49K UEXP=0.1 TOX=0.11U XJ=2.95U + LEVEL=2 CGSO=1.5N CGDO=1.5N CBD=4.5F CBS=4.5F LD=2.4485U NSS=3.2E10 + KP=2E-5 PHI=0.6 ) .PRINT TRAN V(20) V(66) .PLOT TRAN V(20) V(66) .END ~eor ~eoi