FTN66,Y,J,E 
*************************************************************** 
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  ALL RIGHTS     * 
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE-  * 
* REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * 
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.   * 
*************************************************************** 
*  NAME:   OVTPT                      * 
*  SOURCE: 92091-18008                * 
*  RELOC:  92091-16008                * 
*  PGMR:   C. GEBER                   * 
*************************************** 
$PAGE 
$EMA /BLANK/
$CDS ON 
      SUBROUTINE FOURAN 
     + ,92091-16008 REV.5000 <890418.1141>
      IMPLICIT REAL*8 (A-H,O-Z) 
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   IMYNL,IMVN,LCVN,NSNOD,NSMAT,NSVAL,ICNOD,ICMAT,ICVAL, 
     6   LOUTPT,LPOL,LZER,IRSWPF,IRSWPR,ICSWPF,ICSWPR,IRPT,JCPT,
     7   IROWNO,JCOLNO,NTTBR,NTTAR,LVNTMP 
      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/ ATIME,APROG(3),ADATE,ATITLE(10),DEFL,DEFW,DEFAD,
     1  DEFAS,RSTATS(50),IWIDTH,LWIDTH,NOPAGE 
      COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET,
     1   XMU,MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO,
     2   ITEMNO,NOSOLV,MODAC,IPIV,IVMFLG,IPOSTP,ISCRCH,IOFILE 
      COMMON /KNSTNT/ TWOPI,XLOG2,XLOG10,ROOT2,RAD,BOLTZ,CHARGE,CTOK, 
     1   GMIN,RELTOL,ABSTOL,VNTOL,TRTOL,CHGTOL,EPS0,EPSSIL,EPSOX, 
     2   PIVTOL,PIVREL
      COMMON /TRAN/ TSTEP,TSTOP,TSTART,DELMAX,TDMAX,FORFRE,JTRFLG 
      COMMON /OUTINF/ XINCR,STRING(15),XSTART,YVAR(8),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 SINCO(9),COSCO(9) 
      DIMENSION FORTIT(4) 
      DATA FORTIT / 8HFOURIER , 8HANALYSIS, 8H        , 8H         /
      DATA ABLNK / 1H  /
$PAGE 
      FORPRD=1.0D0/FORFRE 
      XSTART=TSTOP-FORPRD 
      KNTR=1
      XN=101.0D0
      XINCR=FORPRD/XN 
      NPOINT=XN 
      CALL GETM8(LOCX,NPOINT) 
      CALL GETM8(LOCY,NPOINT) 
      DO 105 NKNT=1,NFOUR 
      ITAB(1)=NODPLC(IFOUR+NKNT)
      KFROUT=ITAB(1)
      CALL NTRPL8(LOCX,LOCY,NUMPNT) 
      DCCO=0.0D0
      CALL ZERO8(SINCO,9) 
      CALL ZERO8(COSCO,9) 
      LOCT=LOCY+1 
      IPNT=0
   10 YVR=VALUE(LOCT+IPNT)
      DCCO=DCCO+YVR 
      FORFAC=DFLOAT(IPNT)*TWOPI/XN
      ARG=0.0D0 
      DO 20 K=1,9 
      ARG=ARG+FORFAC
      SINCO(K)=SINCO(K)+YVR*DSIN(ARG) 
      COSCO(K)=COSCO(K)+YVR*DCOS(ARG) 
   20 CONTINUE
      IPNT=IPNT+1 
      IF (IPNT.NE.NPOINT) GO TO 10
      DCCO=DCCO/XN
      FORFAC=2.0D0/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 =',1PD12.3/,
     1   '0HARMONIC   FREQUENCY    FOURIER    NORMALIZED    PHASE     NO
     2RMALIZED'/, 
     3   '    NO         (HZ)     COMPONENT    COMPONENT    (DEG)    PHA
     4SE (DEG)'//)
      IKNT=1
      FREQ1=FORFRE
      XNHARM=1.0D0
      CALL MAGPHS(CMPLX(SNGL(SINCO(1)),SNGL(COSCO(1))),XNORM,PNORM) 
      PHASEN=0.0D0
      WRITE (6,81) IKNT,FREQ1,XNORM,XNHARM,PNORM,PHASEN 
   81 FORMAT(I6,1PD15.3,D12.3,0PF13.6,F10.3,F12.3/) 
      THD=0.0D0 
      DO 90 IKNT=2,9
      FREQ1=DFLOAT(IKNT)*FORFRE 
      CALL MAGPHS(CMPLX(SNGL(SINCO(IKNT)),SNGL(COSCO(IKNT))), 
     1   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.0D0*DSQRT(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 
$EMA /BLANK/                            
      SUBROUTINE NTRPL8( LOCX , LOCY , NUMPNT ) 
     + ,92091-16008 REV.5000 <890418.1141>  
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE INTERPOLATES THE ANALYSIS DATA TO OBTAIN THE VALUES
C PRINTED AND/OR PLOTTED, USING LINEAR INTERPOLATION. 
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   IMYNL,IMVN,LCVN,NSNOD,NSMAT,NSVAL,ICNOD,ICMAT,ICVAL, 
     6   LOUTPT,LPOL,LZER,IRSWPF,IRSWPR,ICSWPF,ICSWPR,IRPT,JCPT,
     7   IROWNO,JCOLNO,NTTBR,NTTAR,LVNTMP 
      COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET,
     1   XMU,MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO,
     2   ITEMNO,NOSOLV,MODAC,IPIV,IVMFLG,IPOSTP,ISCRCH,IOFILE 
      COMMON /OUTINF/ XINCR,STRING(15),XSTART,YVAR(8),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))
$PAGE 
C 
C  FOR DC TRANSFER CURVE, NO INTERPOLATION NECESSARY
C 
      IF (MODE.NE.1) GO TO 4
      NUMPNT=ICALC
      LOCO=LOUTPT 
      DO 3 I=1,NUMPNT 
      LOCYT=LOCY
      VALUE(LOCX+I)=VALUE(LOCO+1) 
      DO 2 K=1,KNTR 
      ISEQ=ITAB(K)
      ISEQ=NODPLC(ISEQ+4) 
      VALUE(LOCYT+I)=VALUE(LOCO+ISEQ) 
      LOCYT=LOCYT+NPOINT
    2 CONTINUE
      LOCO=LOCO+NUMOUT
    3 CONTINUE
      RETURN
    4 CONTINUE
      XVAR=XSTART 
      XVTOL=XINCR*1.0D-5
      IPPNT=0 
      ICPNT=2 
      LOCO1=LOUTPT
      LOCO2=LOCO1+NUMOUT
      IF (ICALC.LT.2) GO TO 50
   10 X1=VALUE(LOCO1+1) 
      X2=VALUE(LOCO2+1) 
      DX1X2=X1-X2 
   20 IF (XINCR.LT.0.0D0) GO TO 24
      IF (XVAR.LE.(X2+XVTOL)) GO TO 30
      GO TO 28
   24 IF (XVAR.GE.(X2+XVTOL)) GO TO 30
   28 IF (ICPNT.GE.ICALC) GO TO 100 
      ICPNT=ICPNT+1 
      LOCO1=LOCO2 
      LOCO2=LOCO1+NUMOUT
      GO TO 10
   30 IPPNT=IPPNT+1 
      VALUE(LOCX+IPPNT)=XVAR
      DXX1=XVAR-X1
      LOCYT=LOCY
      DO 40 I=1,KNTR
      ISEQ=ITAB(I)
      ISEQ=NODPLC(ISEQ+4) 
      V1=VALUE(LOCO1+ISEQ)
      V2=VALUE(LOCO2+ISEQ)
      YVR=V1+(V1-V2)*DXX1/DX1X2 
      TOL=DMIN1(DABS(V1),DABS(V2))*1.0D-10
      IF (DABS(YVR).LE.TOL) YVR=0.0D0 
      VALUE(LOCYT+IPPNT)=YVR
      LOCYT=LOCYT+NPOINT
   40 CONTINUE
      IF (IPPNT.GE.NPOINT) GO TO 100
      XVAR=XSTART+DFLOAT(IPPNT)*XINCR 
      IF (DABS(XVAR).GE.DABS(XVTOL)) GO TO 20 
      XVAR=0.0D0
      GO TO 20
C 
C  SPECIAL HANDLING IF ICALC = 1
C 
C...  ICALC=1;  JUST COPY OVER THE SINGLE POINT AND RETURN
C 
   50 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 
C  RETURN 
C 
  100 NUMPNT=IPPNT
      RETURN
      END 
$EMA /BLANK/
      SUBROUTINE OVTPVT 
     + ,92091-16008 REV.5000 <890418.1141>
      IMPLICIT REAL*8 (A-H,O-Z) 
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   IMYNL,IMVN,LCVN,NSNOD,NSMAT,NSVAL,ICNOD,ICMAT,ICVAL, 
     6   LOUTPT,LPOL,LZER,IRSWPF,IRSWPR,ICSWPF,ICSWPR,IRPT,JCPT,
     7   IROWNO,JCOLNO,NTTBR,NTTAR,LVNTMP 
      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   XMU,MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO,
     2   ITEMNO,NOSOLV,MODAC,IPIV,IVMFLG,IPOSTP,ISCRCH,IOFILE 
      COMMON /FLAGS/ IPRNTA,IPRNTL,IPRNTM,IPRNTN,IPRNTO,LIMTIM,LIMPTS,
     1   LVLCOD,LVLTIM,ITL1,ITL2,ITL3,ITL4,ITL5,IGOOF,NOGO,KEOF 
      COMMON /MISCEL/ ATIME,APROG(3),ADATE,ATITLE(10),DEFL,DEFW,DEFAD,
     1  DEFAS,RSTATS(50),IWIDTH,LWIDTH,NOPAGE 
      COMMON /DC/ TCSTAR(2),TCSTOP(2),TCINCR(2),ICVFLG,ITCELM(2),KSSOP, 
     1   KINEL,KIDIN,KOVAR,KIDOUT 
      COMMON /AC/ FSTART,FSTOP,FINCR,SKW2,REFPRL,SPW2,JACFLG,IDFREQ,
     1   INOISE,NOSPRT,NOSOUT,NOSIN,IDIST,IDPRT 
      COMMON /TRAN/ TSTEP,TSTOP,TSTART,DELMAX,TDMAX,FORFRE,JTRFLG 
      COMMON /OUTINF/ XINCR,STRING(15),XSTART,YVAR(8),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) / 
$PAGE 
      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) 
      IF (MODE-2) 50,60,300 
   50 NUMOUT=JELCNT(41)+1 
      GO TO 70
   60 NUMOUT=JELCNT(42)+1 
$PAGE 
C 
C  DC AND TRANSIENT ANALYSIS PRINTING 
C 
   70 LOC=LOCATE(30+MODE) 
   80 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 GETM8(LOCX,NPOINT) 
      CALL GETM8(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 90 K=1,KNTR
      YVAR(K)=VALUE(LOCYT+I)
      LOCYT=LOCYT+NPOINT
   90 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 80
$PAGE 
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 GETM8(LOCX,NPOINT) 
      CALL GETM8(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 
********************************************************************
* 
*     DC AND TRANSIENT ANALYSIS BINARY FILE OUTPUT
* 
  250 LOC = LOCATE(45+MODE) 
      CALL DCTGRP(ITAB,ITYPE,KNTR,LOC,NPOINT) 
C 
C  FOURIER ANALYSIS 
C 
  260 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
* 
********************************************************************
$PAGE 
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 
      DO 590 I=1,ICALC
      XVAR=DBLE(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)=DBLE(REAL(CVAL))
      GO TO 500 
  440 YVAR(K)=DBLE(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.0D0*DLOG10(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
$PAGE 
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)
      CALL GETM8(LOCX,ICALC)
      CALL GETM8(LOCY,KNTR*ICALC) 
C 
C     LOAD PLOT BUFFERS 
C 
      LOUT=LOUTPT 
      DO 710 I=1,ICALC
      XVAR=DBLE(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=DBLE(REAL(CVAL))
      GO TO 695 
  660 YVR=DBLE(AIMAG(CVAL)) 
      GO TO 695 
  670 CALL MAGPHS(CVAL,XMAG,XPHS) 
      GO TO (680,680,650,660,690,685), KTYPE
  680 YVR=DLOG10(XMAG)
      GO TO 695 
  685 YVR=20.0D0*DLOG10(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
$PAGE 
********************************************************************
* 
*     AC ANALYSES BINARY FILE OUTPUT
* 
      DO 800 ID=48,50 
          LOC = LOCATE(ID)
          CALL ACGRP(KNTR,LOC,LOUTPT,NPOINT,NUMOUT) 
  800 CONTINUE
* 
********************************************************************
C 
C  FINISHED 
C 
 1000 CALL CLRMEM(LOUTPT) 
      CALL SECOND(T2) 
      RSTATS(11)=RSTATS(11)+T2-T1 
      RETURN
      END 
$EMA /BLANK/
      SUBROUTINE PLOT( NUMPNT , LOCX , LOCY , LOCV )
     + ,92091-16008 REV.5000 <890418.1141>
      IMPLICIT REAL*8 (A-H,O-Z) 
C 
C     THIS ROUTINE GENERATES THE LINE-PRINTER PLOTS.
C 
      COMMON /MISCEL/ ATIME,APROG(3),ADATE,ATITLE(10),DEFL,DEFW,DEFAD,
     1  DEFAS,RSTATS(50),IWIDTH,LWIDTH,NOPAGE 
      COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET,
     1   XMU,MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO,
     2   ITEMNO,NOSOLV,MODAC,IPIV,IVMFLG,IPOSTP,ISCRCH,IOFILE 
      COMMON /KNSTNT/ TWOPI,XLOG2,XLOG10,ROOT2,RAD,BOLTZ,CHARGE,CTOK, 
     1   GMIN,RELTOL,ABSTOL,VNTOL,TRTOL,CHGTOL,EPS0,EPSSIL,EPSOX, 
     2   PIVTOL,PIVREL
      COMMON /OUTINF/ XINCR,STRING(15),XSTART,YVAR(8),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 
      INTEGER IXXOR 
      DIMENSION YCOOR(5,8),ICOOR(8),DELPLT(8) 
      DIMENSION AGRAPH(13),APLOT(13)
      DIMENSION ASYM(2),PMIN(8),JCOOR(8)
      DATA ABLNK, ALETX, APER / 1H , 1HX, 1H. / 
      DATA ASYM1, ASYM2, ARPRN / 8H(-------, 8H--------, 1H) /
      DATA PLTSYM / 8H*+=$0<>? /
C 
      IWIDE=1 
      NWIDE=101 
      NWIDE4=25 
      IF (LWIDTH.GT.80) GO TO 3 
      IWIDE=0 
      NWIDE=57
      NWIDE4=14 
    3 IF (NUMPNT.LE.0) GO TO 400
      DO 5 I=1,13 
      AGRAPH(I)=ABLNK 
    5 CONTINUE
      DO 7 I=1,5
      ISPOT=1+NWIDE4*(I-1)
      CALL MOVE(AGRAPH,ISPOT,APER,1,1)
    7 CONTINUE
$PAGE 
      LOCYT=LOCY
      LSPOT=LOCV-1
      MLTSCL=0
      IF (VALUE(LOCV).EQ.0.0D0) MLTSCL=1
      DO 235 K=1,KNTR 
      LSPOT=LSPOT+2 
      YMIN=VALUE(LSPOT) 
      YMAX=VALUE(LSPOT+1) 
      IF (YMIN.NE.0.0D0) GO TO 10 
      IF (YMAX.NE.0.0D0) GO TO 10 
      GO TO 100 
   10 YMIN1=DMIN1(YMIN,YMAX)
      YMAX1=DMAX1(YMIN,YMAX)
   30 IF (ILOGY(K).EQ.1) GO TO 40 
      YMIN1=DLOG10(DMAX1(YMIN1,1.0D-20))
      YMAX1=DLOG10(DMAX1(YMAX1,1.0D-20))
      DEL=DMAX1(YMAX1-YMIN1,0.0001D0)/4.0D0 
      GO TO 50
   40 DEL=DMAX1(YMAX1-YMIN1,1.0D-20)/4.0D0
   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=DMIN1(YMIN1,VALUE(LOCYT+I)) 
      YMAX1=DMAX1(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.0D-4
      IF (DABS(YCOOR(1,K)).LE.SMALL) YCOOR(1,K)=0.0D0 
      DO 210 I=1,4
      YCOOR(I+1,K)=YCOOR(I,K)+DEL 
      IF (DABS(YCOOR(I+1,K)).LE.SMALL) YCOOR(I+1,K)=0.0D0 
  210 CONTINUE
      IF (ILOGY(K).EQ.1) GO TO 230
      DO 220 I=1,5
  220 YCOOR(I,K)=DEXP(XLOG10*YCOOR(I,K))
  230 DELPLT(K)=DEL/DFLOAT(NWIDE4)
      LOCYT=LOCYT+NPOINT
  235 CONTINUE
$PAGE 
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 
C...  COORDINATES ARE *EQUAL* IF THE MOST SIGNIFICANT 24 BITS AGREE 
C 
      DO 240 K=1,5
C 
C  TEMPORARILY CHECK 'EQUALITY' THIS WAY
C 
      Y1=YCOOR(K,I) 
      Y2=YCOOR(K,L) 
      IF (Y1.EQ.0.0D0.AND.Y2.EQ.0.0D0) GO TO 240
      IF (DABS((Y1-Y2)/DMAX1(DABS(Y1),DABS(Y2))).GE.1.0D-7) 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)
      IF (IWIDE.NE.0) WRITE(6,271) ASYM,(YCOOR(J,K),J=1,5)  
  271 FORMAT(/1HX,2A8,4H----,1PD12.3,4(15X,D10.3)/26X,51(2H -)) 
      IF (IWIDE.EQ.0) WRITE(6,273) ASYM,(YCOOR(J,K),J=1,5)  
  273 FORMAT(/1HX,2A8,1X,1PD10.3,3(4X,D10.3),1X,D10.3/22X,29(2H -)) 
  280 CONTINUE
      GO TO 300 
  290 IF (IWIDE.NE.0) WRITE(6,291) (YCOOR(J,1),J=1,5) 
  291 FORMAT(/1HX,20X,1PD12.3,4(15X,D10.3)/26X,51(2H -))
      IF (IWIDE.EQ.0) WRITE(6,293) (YCOOR(J,1),J=1,5) 
  293 FORMAT(/1HX,15X,1PD12.3,3(4X,D10.3),1X,D10.3/22X,29(2H -))
$PAGE 
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=IDINT((YVR-YMIN1)/DELPLT(K)+0.5D0)+1 
      IF (JPOINT.LE.0) GO TO 306
      IF (JPOINT.GT.NWIDE) GO TO 306
      CALL MOVE(ASPOT,1,APLOT,JPOINT,1) 
      IF (IXXOR(ASPOT,ABLNK).EQ.0) GO TO 303  
      IF (IXXOR(ASPOT,APER).EQ.0) 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=DEXP(XLOG10*YVR)
  315 IF (IWIDE.NE.0) WRITE(6,316) XVAR,YVR,APLOT 
  316 FORMAT(1X,1PD10.3,3X,D10.3,3X,13A8) 
      IF (IWIDE.EQ.0) WRITE(6,317) XVAR,YVR,(APLOT(K),K=1,8)  
  317 FORMAT(1X,1PD10.3,1X,D10.3,1X,7A8,A1) 
  320 CONTINUE
C 
C  FINISHED 
C 
      IF (IWIDE.NE.0) WRITE(6,331)  
  331 FORMAT(26X,51(2H -)//)
      IF (IWIDE.EQ.0) WRITE(6,332)  
  332 FORMAT(22X,29(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 ) 
     + ,92091-16008 REV.5000 <890418.1141>
      IMPLICIT REAL*8 (A-H,O-Z) 
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, 
     2   PIVTOL,PIVREL
      INTEGER IXXOR 
      DIMENSION VINT(5) 
      DATA VINT / 1.0D0,2.0D0,5.0D0,10.0D0,20.0D0 / 
      DATA EPS / 1.0D-12 /
C 
C...  TRAP TOO-SMALL DATA SPREAD
C 
C  TEMPORILY CHECK 'EQUALITY' THIS WAY
C 
      IF (XMIN.EQ.0.0D0.AND.XMAX.EQ.0.0D0) GO TO 4
      IF (DABS((XMAX-XMIN)/DMAX1(DABS(XMIN),DABS(XMAX))).GE.1.0D-4) 
     1  GO TO 10
    4 CONTINUE
      IF (XMIN.GE.0.0D0) GO TO 5
      XMAX=0.5D0*XMIN+EPS 
      XMIN=1.5D0*XMIN-EPS 
      GO TO 10
    5 XMAX=1.5D0*XMIN+EPS 
      XMIN=0.5D0*XMIN-EPS 
C 
C...  FIND APPROXIMATE INTERVAL SIZE, NORMALIZED TO [1,10]
C 
   10 A=(XMAX-XMIN)/DFLOAT(N) 
      NAL=IDINT(DLOG10(A))
      IF (A.LT.1.0D0) NAL=NAL-1 
      XFACT=DEXP(XLOG10*DFLOAT(NAL))
      B=A/XFACT 
C 
C...  FIND CLOSEST PERMISSIBLE INTERVAL SIZE
C 
      DO 20 I=1,3 
      IF (B.LT.(VINT(I)+EPS)) GO TO 30
   20 CONTINUE
      I=4 
$PAGE 
C 
C...  COMPUTE INTERVAL SIZE 
C 
   30 DEL=VINT(I)*XFACT 
      FM1=XMIN/DEL
      M1=FM1
      IF (FM1.LT.0.0D0) M1=M1-1 
      IF (DABS(DFLOAT(M1)+1.0D0-FM1).LT.EPS) M1=M1+1
C 
C...  COMPUTE NEW MAXIMUM AND MINIMUM LIMITS
C 
      XMINP=DEL*DFLOAT(M1)
      FM2=XMAX/DEL
      M2=FM2+1.0D0
      IF (FM2.LT.(-1.0D0)) M2=M2-1
      IF (DABS(FM2+1.0D0-DFLOAT(M2)).LT.EPS) M2=M2-1
      XMAXP=DEL*DFLOAT(M2)
      NP=M2-M1
C 
C...  CHECK WHETHER ANOTHER LOOP REQUIRED 
C 
      IF (NP.LE.N) GO TO 40 
      I=I+1 
      GO TO 30
C 
C...  DO FINAL ADJUSTMENTS AND CORRECT FOR ROUNDOFF ERROR(S)
C 
   40 NX=(N-NP)/2 
      XMINP=DMIN1(XMIN,XMINP-DFLOAT(NX)*DEL)
      XMAXP=DMAX1(XMAX,XMINP+DFLOAT(N)*DEL) 
      RETURN
      END 
$EMA /BLANK/
      SUBROUTINE SETPRN( LOC )
     + ,92091-16008 REV.5000 <890418.1141>
      IMPLICIT REAL*8 (A-H,O-Z) 
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   IMYNL,IMVN,LCVN,NSNOD,NSMAT,NSVAL,ICNOD,ICMAT,ICVAL, 
     6   LOUTPT,LPOL,LZER,IRSWPF,IRSWPR,ICSWPF,ICSWPR,IRPT,JCPT,
     7   IROWNO,JCOLNO,NTTBR,NTTAR,LVNTMP 
      COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET,
     1   XMU,MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO,
     2   ITEMNO,NOSOLV,MODAC,IPIV,IVMFLG,IPOSTP,ISCRCH,IOFILE 
      COMMON /MISCEL/ ATIME,APROG(3),ADATE,ATITLE(10),DEFL,DEFW,DEFAD,
     1  DEFAS,RSTATS(50),IWIDTH,LWIDTH,NOPAGE 
      COMMON /DC/ TCSTAR(2),TCSTOP(2),TCINCR(2),ICVFLG,ITCELM(2),KSSOP, 
     1   KINEL,KIDIN,KOVAR,KIDOUT 
      COMMON /AC/ FSTART,FSTOP,FINCR,SKW2,REFPRL,SPW2,JACFLG,IDFREQ,
     1   INOISE,NOSPRT,NOSOUT,NOSIN,IDIST,IDPRT 
      COMMON /TRAN/ TSTEP,TSTOP,TSTART,DELMAX,TDMAX,FORFRE,JTRFLG 
      COMMON /OUTINF/ XINCR,STRING(15),XSTART,YVAR(8),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))
      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(1)
      XINCR=TCINCR(1) 
      NPOINT=ICVFLG 
      ITEMP=ITCELM(1) 
      LOCE=NODPLC(ITEMP+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
$PAGE 
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 
$EMA /BLANK/                            
      SUBROUTINE SETPLT( LOC )
     + ,92091-16008 REV.5000 <890418.1141>  
      IMPLICIT REAL*8 (A-H,O-Z) 
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   IMYNL,IMVN,LCVN,NSNOD,NSMAT,NSVAL,ICNOD,ICMAT,ICVAL, 
     6   LOUTPT,LPOL,LZER,IRSWPF,IRSWPR,ICSWPF,ICSWPR,IRPT,JCPT,
     7   IROWNO,JCOLNO,NTTBR,NTTAR,LVNTMP 
      COMMON /STATUS/ OMEGA,TIME,DELTA,DELOLD(7),AG(7),VT,XNI,EGFET,
     1   XMU,MODE,MODEDC,ICALC,INITF,METHOD,IORD,MAXORD,NONCON,ITERNO,
     2   ITEMNO,NOSOLV,MODAC,IPIV,IVMFLG,IPOSTP,ISCRCH,IOFILE 
      COMMON /MISCEL/ ATIME,APROG(3),ADATE,ATITLE(10),DEFL,DEFW,DEFAD,
     1  DEFAS,RSTATS(50),IWIDTH,LWIDTH,NOPAGE 
      COMMON /DC/ TCSTAR(2),TCSTOP(2),TCINCR(2),ICVFLG,ITCELM(2),KSSOP, 
     1   KINEL,KIDIN,KOVAR,KIDOUT 
      COMMON /AC/ FSTART,FSTOP,FINCR,SKW2,REFPRL,SPW2,JACFLG,IDFREQ,
     1   INOISE,NOSPRT,NOSOUT,NOSIN,IDIST,IDPRT 
      COMMON /TRAN/ TSTEP,TSTOP,TSTART,DELMAX,TDMAX,FORFRE,JTRFLG 
      COMMON /OUTINF/ XINCR,STRING(15),XSTART,YVAR(8),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))
      DIMENSION LOGOPT(6) 
      DATA LOGOPT / 2, 2, 1, 1, 1, 1 /
      DATA ABLNK, ATIMEX, AFREQ / 1H , 6H  TIME, 6H  FREQ / 
      DATA PLTSYM / 8H*+=$0<>? /
C 
C  SET LIMITS DEPENDING UPON THE ANALYSIS MODE
C 
      IF (MODE-2) 10,20,30
   10 XSTART=TCSTAR(1)
      XINCR=TCINCR(1) 
      NPOINT=ICVFLG 
      ITEMP=ITCELM(1) 
      LOCE=NODPLC(ITEMP+1)
      ASWEEP=VALUE(LOCE)
      GO TO 40
   20 XSTART=TSTART 
      XINCR=TSTEP 
      NPOINT=JTRFLG 
      ASWEEP=ATIMEX 
      GO TO 40
$PAGE 
   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 
