text:
      PROGRAM NASTPLOT
C
CDC   PROGRAM NASPLOT (INPUT,OUTPUT,TAPE5=INPUT,TAPE6=OUTPUT,
CDC                    TAPE13,TAPE14,TAPE15,TAPE16,TAPE17)
C
C     A STAND-ALONE TRANSLATOR PROGRAM (NASTPLOT or NASPLOT) TO
C     INTERPRET THE NASTRAN GENERAL PURPOSE PLOTTER FILE (OR TAPE)
C
C     THIS ROUTINE SHOULD NOT BE COMPILED AND INCLUDED IN NASTRAN
C     LIBRARY
C     THIS NASTPLOT PACKAGE INCLUDES THE FOLLOWING SUBROUTINES/AND
C     ENTRY POINTS
C
C          GETCMD, DRWAXS/ENDAXS, DRWKHR/ENDCHR, DRWLIN/ENDLIN,
C          TXNPEN, TXINIT/TXFINS, TXPLOT, PSINIT/PSFINS/PSTRKE,
C          PSLINE, PSCHAR/PSENDC
C     IF TEKTRONIX PLOT-10 TCS AND ADVANCED GRAPHING II PACKAGES ARE
C     AVAILABLE IN THE COMPUTER SYSTEM. THE NEXT SUBROUTINES ARE USED
C          NASTEK, PFRAME
C     (ACTIVATE NASTEK AND PFRAME BY REPLACE C+ BY 2 BLANKS IN FIRST 2
C     COLUMNS OF TEXT BELOW)
C
C     IF PLOT-10 AND ADVANCED GRAPHING II ARE NOT AVAILABLE, THE LINES
C     BETWEEN LABELS 250 AND 260 SHOULD BE COMMENTED OUT OR DELETED.
C
C     INPUT FILE: NASTRAN PLT1 OR PLT2 FILE
C     PLOTTER   : TEKTRONIX OR POSTSCRIPT FILE(S)
C
C     ***************************************************************
C     *   DO NOT COMPILE THIS PROGRAM NOR INSERT ALL RELOCATABLES   *
C     *   INTO NASTRAN LIBRARY                                      *
C     *   (HOWEVER. IT DOES NO HARM)                                *
C     ***************************************************************
C
C     THE PLOTTING SECTION OF THIS PROGRAM IS PLOTTER DEPENDENT.
C     CURRENTLY TEKTRONIX PLOTTER OR POSTSCRIPT PRINTER ARE USED.
C     ALL SUPPORTING ROUTINES WITH PREFIX 'TX' ARE TEKTRONIX ASSOCIATED
C     AND THOSE WITH PREFIX 'PS' ARE POSTSCRIPT ASSOCIATED. THE 'PS'
C     ROUTINES USE ONLY STANDARD FORTRAN COMMANDS.
C
C     SUBROUTINE GETCMD IS USED ONLY WHEN MACHINE THAT GENERATED THE
C     PLOT FILE AND THE MACHINE THAT IS NOW READING THE PLOT FILE HAVE
C     DIFFERENT NUMBER OF BITS PER COMPUTER WORD.
C     CURRENTLY GETCMD IS NOT WORKING.
C
C     A PC VERSION (MS-DOS/BASIC WITH GRAHPIC) IS ALSO AVAILABLE WHICH
C     USES ONLY PLT1 FILE. NO SPECIAL HARDWARE OR SOFTWARE ARE NEEDED.
C
C     WRITTEN BY G.CHAN/UNISYS, 3/1991
C
C
C     THE '$' ON A FORMAT LINE IS VAX SPECIAL. IT SHOULD BE DELETED IN
C     ALL NON-VAX MACHINES.
C
C     VAX ONLY: SEE THE OPEN STATEMENT AFTER STA. 600 FOR STANDARD OUT-
C     PUT LIST FILE.
C
C     CDC ONLY: DELETE THE 'EOF' ON-LINE FUNCTION,
C               RE-ACTIVATE THE ON-LINE 'ISHFT' FUNCTION BELOW, AND
C               SET 'AA' AND 'BB' TO REAL, NOT D.P.
C
      IMPLICIT INTEGER (A-Z)
      LOGICAL      CHRSET,LINSET,AXSSET,VAX,IBM,TEK,PSC,NOTYET,FOUND,
     1             ADOT,LUX,DEBUG
      INTEGER      Z(3000),W(30)
      REAL         XFACT,YFACT,XSIZE,YSIZE,SX,SY,SCALE,CSCAL
      REAL*8       AA,BB
CCDC  REAL         AA,BB
      CHARACTER*1  TEMP,ESC,NUMB1(10),CHR1(5),BLNK1,STP1,NXT1,NA1(32),
     1             KD,KP,KL,KT,K1,K2,KB,KI,KU,KC,KV,KX,KY,KP1,KL1,KT1,
     2             K12,KN1,KS1,KH,STR,AL1,KA1,KR1,KNUM(2),KNUM1,BELL,
     3             KQ1,DorS,A1Z(26)
      CHARACTER*4  NAM4,BLNK4,STOP4,CHR4
      CHARACTER*32 NAM32,MACH32,MACH33
      CHARACTER    CLEAR*2,KNUM2*2,MACH3*3,XX3*3,NUMB10*10,DATE13*13,
     1             FMT500*8,A2Z*26
      COMMON       CMND,CNTRL,R,S,T,U,XFACT,YFACT,XMAX,YMAX,XHI,YHI,
     1             XLO,YLO,PENCHG,PENCNT,OLDPEN,PENNO(99)
      COMMON /IO/  IN,NOUT
      COMMON /EC/  ESC,CLEAR
      COMMON /QQ/  BI,BO,WRD,BYT,DUM(22)
      COMMON /PS/  LU,SCALE,JOUNT,NBUFF,ONCE,CSCAL,CHRPOS
      EQUIVALENCE  (NUMB1(1),NUMB10), (BLNK4,BLNK1), (CHR1(1),CHR4),
     1             (NAM4,NAM32,NA1(1)), (MACH3,MACH32), (Z(1),W(1)),
     2             (KNUM(1),KNUM1,KNUM2), (A1Z(1),A2Z)
      DATA         CHRSET,LINSET,AXSSET,TEK,PSC  / 5*.FALSE.     /,
     1             NOLINE,SELECT,PLOTID,DEBUG / 2*0, -1, .TRUE.  /,
     2             XSIZE,YSIZE,YES,NO,KQ1 / 1.2, 1., 1HY,1HN, 'q'/,
     3             STR,BLNK4,NUMB10 / '*', '    ',  '1234567890' /,
     4             AA,BB,FMT500     / 1.D-21, 1.D-25, '(3000A1)' /,
     5             STP1,NXT1,DATE13 / 'S', 'N', 'OCT. 27, 1990'  /,
     6             KD,KP,KL,KT,KB   / '.', 'P', 'L', 'T', ' '    /,
     7             KH,KP1,KL1,KT1,K1/ 'H', 'p', 'l', 't', '1'    /,
     8             KI,KU,KC,KV,KX   / 'I', 'U', 'C', 'V', 'X'    /,
     9             KY,K2,XX3,AL1,KA1/ 'Y', '2', 'UNX','A','a'    /,
     O             KN1,KS1,SYY,SNN  / 'n', 's', 1Hy, 1Hn         /,
     1             T4,T3,T2,T1,KR1  / 10000,  1000, 100, 10, 'R' /,
     2             MACH32   / 'VAX/TEKTRONIX COMPUTER GRAPHIC  ' /,
     3             MACH33   / 'VAX/POSTSCRIPT COMPUTER GRAPHIC ' /,
     4             STOP4,A2Z/ 'STOP','ABCDEFGHIJKLMNOPQRSTUVWXYZ'/,
     5             DorS     / '.'                                /,
     6             MASK     / '000000FF'X                        /
C    6             MASK     / X'000000FF', Z000000FF,  63,  511
C                               UNIX     ,   IBM    , CDC, UNIVAC
C
C     SUMMARY OF PROGRAM'S VARIABLES:
C
C       VAX = .TURE. IF CURRENT MACHINE IS A  VAX, .FALSE. OTHERWISE
C       IBM = .TURE. IF CURRENT MACHINE IS AN IBM, .FALSE. OTHERWISE
C       TEK = .TRUE., TEKTRONIX SCREEN PLOT
C       PSC = .TURE., POSTSCRIPT FILES GENERATION
C      MASK = A MASK USED TO PICK UP THE LAST CHARACTER OF A WORD
C             (MACHINE DEPENDENT)
C       NBS = NO OF BITS TO BE SHIFTED
C           = 24 = 3*8, FOR IBM, VAX
C           = 54 = 9*6, FOR CDC
C           = 27 = 3*9, FOR UNIVAC
C       K12 = 1 OR 2 FOR 'PLT1' OR 'PLT2' FILE
C       PID = 0, IF PLOT FILE DOES NOT HAVE A PLOT-ID FRAME,
C           = 1, OTHERWISE
C       ALL = 'Y', STACK ALL PLOTS INTO ONE POSTSCRIPT FILE
C           = 'N', OTHERWISE.   (= 0, UNDEFINED STATUS)
C        BI = NO. OF BITS PER WORD OF CURRENT COMPUTER RUNNING NASTPLOT
C        BO = NO. OF BITS PER WORD OF THE COMPUTER WHICH GENERATED THE
C             PLT1 OR PLT2 TILE
C       FIL = INPUT  FILE UNIT FOR PLT1 OR PLT2    (FRMTTD, SQUNTL)
C       LU  = OUTPUT FILE UNIT FOR POSTSCRIPT FILE (FRMTTD, SQUNTL)
C      LUX  = IF .TRUE. AND ALL = 'N', LU UNIT NUMBER INCREASES BY 1
C             EACH TIME A NEW POSTSCRIPT FILE IS GENERATED
C       IN  = SYSTEM INPUT  FILE, UNIT 5
C      NOUT = SYSTEM OUTPUT FILE, UNIT 6
C    LUOPEN = 0, NO LU FILE OPENED.  = 1, LU FILE ALREADY OPENED
C    NOLINE = 1, ADD "%!" LINE AT THE BEGINNING OF A POSTSCRIPT FILE
C           = 0, NO SUCH LINE ADDED
C    CHRPOS = 0, TYPING CHARACTERS ON POSTCRIPT FILE WILL BE STRUNG
C             TOGETHER FOR ONE OUTPUT COMMAND
C           = 1, (VIA POSTSCRIPT HELP ONLY) EACH TYPING CHARACTER IS
C             SENT OUT AS A POSTSCRIPT COMMAND
C       RL  = RECORD LENGTH IN WORDS
C       NW  = NO. OF WORDS PER PLOT COMMNAD
C       JID = WORD LOCATION OF PLOT ID NUMBER IN RECORD
C       DOT = LOCATION OF '.' IN THE INPUT FILE NAME
C      DorS = '.' OR '/', ON FILE NAME
C      ADOT = FLAG FOR THE ORIGINAL FILE NAME THAT HAS A DOT, OR NO DOT
C      NREC = NO. OF PHYSICAL RECORDS READ FROM INPUT FILE FIL
C       NRC = ECHO CONTROL = NO. RECORDS/ECHO
C     JOUNT = NO. OF POSTSCRIPT OUTPUT LINES ACCUMULATED AFTER 'stroke'
C     NBUFF = POSTCRIPT BUFFER SIZE (BETWEEN 'stroke')
C       KK  = A COUNTER - NO. OF RECORDS READ ON THE PLOT TAPE
C    NOTYET = .TRUE. WHEN 1ST NEW PLOT COMMAND HAS NOT FULLY PROCESSED
C       PNO = SEQUENTIAL PLOT FRAME NUMBER ON PLOT TAPE
C     FOUND = .TURE. WHEN A NEW PLOT FOUND ON PLOT TAPE (CMND=1)
C    SELECT = PLOT ID NO. USER SELECTED FOR PLOTTING
C    LASTSL = PLOT ID NO. LAST SELECTED BY USER
C     NPLOT = NO. OF PLOTS ACCUMULATED IN THE POSTSCRIPT FILE
C    PLOTID = CURRENT PLOT ID NO. FOUND ON PLOT TAPE
C     (NOTE - PLOT ID ON PLOT TAPE IS NOT RELIABLE. THE TAPE MAY HAVE
C             MISSING PLOT ID, AND IT COULD HAVE TWO PLOT ID 1)
C
      EOF(J) = 0*J
C     ISHFT(W,I) = SHIFT(W,-I)
C
C     INITIALIZE MACHINE DEPENDENT CONSTANTS:
C
CCDC  BI    = 6
CUNV  BI    = 9
      BI    = 8
      NBS   = 24
      ADOT  = .TRUE.
      LUX   = .FALSE.
      VAX   = .TRUE.
      IBM   = .FALSE.
C
C     GENERAL INITIALIZATION:
C
      IF (AA*AA .GT. BB*BB) VAX = .FALSE.
      IF (BI .EQ. 6) NBS = 54
      IF (BI .EQ. 9) NBS = 27
      IF (BI .NE. 8) ADOT = .FALSE.
      IF (.NOT. VAX) MACH3 = XX3
C
      IN    = 5
      NOUT  = 6
      FIL   = 13
      LU    = 14
      NBUFF = 500
      WRD   = 1
      BYT   = 4
      SCALE = 0.54
      CSCAL = 13.0
      NPLOT = 0
      ALL   = 0
      HELP  = 0
      CHRPOS= 0
      PSALL = 0
      LUOPEN= 0
      ESC   = CHAR(27)
      CLEAR = ESC//CHAR(12)
      BELL  = CHAR(7)
      GO TO 20
C
C     SELECT TEKTRONIX PLOT OR POSTCRIPT FILE
C
   10 CDC = EOF(IN)
   20 WRITE  (NOUT,25)
   25 FORMAT (//,' ENTER PLOTTER SELECTION, TEKTRONIX OR POSTSCRIPT? ',
     1       '(T,P,q,S,HELP) ',$)
      READ   (IN,30,END=10) TEMP
   30 FORMAT (A1)
      IF (TEMP .EQ. KH) GO TO 60
      IF (TEMP.EQ.KS1 .OR. TEMP.EQ.STP1) GO TO 1050
      IF (TEMP.NE.KT .AND. TEMP.NE.KT1 .AND. TEMP.NE.KP .AND.
     1    TEMP.NE.KQ1) GO TO 20
      IF (TEMP.EQ.KT .OR. TEMP.EQ.KT1) TEK = .TRUE.
      IF (TEMP.EQ.KP .OR. TEMP.EQ.KQ1) PSC = .TRUE.
      IF (TEMP .EQ. KQ1) NOLINE = 1
      IF (TEK) DEBUG = .FALSE.
      IF (PSC) MACH32 = MACH33
      IF (.NOT.PSC .OR. HELP.EQ.0) GO TO 80
      HELP = 0
      WRITE  (NOUT,40)
   40 FORMAT (//,' ADDITIONAL HELP MESSAGES (POSTSCRIPT ONLY) -', //1X,
     1        'OVERALL PLOT SIZE IS CONTROLLED BY PLOT SCALE, AND CHAR',
     2        'ACTER SIZE CAN BE CHANGED', /4X,'BY CHARACTER SCALE, ',
     3        'ONLY IF ORIGINAL PLOT INCLUDES TYPING CAPABILITY', /,
     4        ' PostScript EFFICIENY IS GREATLY IMPROVED IF TYPING',
     5        ' CAPABILITY IS INCLUDED IN THE', /4X,
     6        'ORIGINAL PLOT. (see NASTRAN PLOTTER card)', //,
     7        ' FOUR CHARACTER TYPING SYMBOLS HAVE BEEN CHANGED', /,
     8        '    CHARACTER      NASTRAN         POSTCSRIPT   ', /,
     9        '      CODE         ORIGINAL        EQUIVALENCE  ', /,
     O        '    ---------    -------------    --------------', /,
     1        '     49 (6)      SMALL CIRCLE     BIG SOLID DOT ', /,
     2        '     50 (7)      SMALL SQUARE     SQUARE-CIRCLE ', /,
     3        '     51 (8)      SMALL DIAMOND    DAGGER        ', /,
     4        '     52 (9)      SMALL TRIANGLE   DOUBLE-DAGGER ', //,
     5        ' IF CHARACTERS ARE POSITIONED BADLY, ENTER * ON NEXT',
     6        ' COMMAND', //,
     7        ' YOU MAY ENTER ''ALL'' FOR THE PLOT NO. TO BE PLOTTED')
      IF (VAX) WRITE (NOUT,45)
   45 FORMAT (/,' WHEN FINISH, SEND PostScript FILE(S) OUT TO PRINTER',
     1        ' WITHOUT HEADER PAGE using', /4X,'PRINT/NOFLAG option')
      WRITE  (NOUT,50)
   50 FORMAT (/,' HIT C/R TO CONTINUE ',$)
      READ (IN,30,END=55) TEMP
      IF (TEMP .EQ. STR) CHRPOS = 1
      GO TO 80
   55 CDC = EOF(IN)
      GO TO 80
C
C     HELP MESSAGES
C
   60 HELP = 1
      WRITE  (NOUT,70)
   70 FORMAT (/,' ENTER "S" TO STOP',
     1        /,' ENTER "T" FOR TEKTRONIX SCREEN PLOTTER',
     2        /,' ENTER "P" or "q" TO GENERATE POSTCRIPT FILE(S)',
     3        /,'    IF "P", POSTCRIPT FILE(S) BEGINS WITH A "%!" LINE',
     4        /,'    IF "q", NO "%!" LINE ADDED',
     5        /,'    (THIS "%!" LINE IS NEEDED IN SOME UNIX MACHINES, ',
     6        'AND OTHERS DON''T)', //1X,
     7        'INPUT FILE NAME MUST BE fname.PLT1 or fname.PLT2',
     8        /,' PLOT FRAME NUMBER IS USED TO SPECIFIED WHICH PLOT TO',
     9        ' BE PLOTTED.',  /,' IF FRAME NO. IS NOT PRESENT ON ',
     O        'ORIGINAL TAPE, SEQUENTIAL FRAME COUNT IS USED')
      GO TO 20
C
C     GET PLOT FILE FILENAME AND OPEN PLOT FILE
C
   80 WRITE  (NOUT,90) MACH32,DATE13
   90 FORMAT (//////33X,4H****, /31X,1H*,6X,1H*, /30X,1H*,8X,1H*,
     1       /30X,'*   N A S T P L O T',
     2       /30X,1H*,8X,1H*, /31X,1H*,6X,1H*, /33X,4H****,
     3       ///7X,A32,'   SYSTEM RELEASE - ',A13,
     4       //7X,'WRITTEN BY UNISYS/',17X,'FOR COSMIC', /11X,
     5       'NASTRAN MAINTENANCE GROUP',6X,'UNIVERSITY OF GEORGIA',
     6       /11X,'HUNTSVILLE, ALABAMA',12X,'ATHENS, GEORGIA 30602',
     7       /42X,'PHONE (708) 542-3265', ////7X,
     8       '*** AT THE END OF EACH PLOT, HIT C/R TO CONTINUE ***',
     9       /18X,3H===,15X,3H===)
  100 CDC = EOF(IN)
      WRITE  (NOUT,110) DorS
  110 FORMAT (//,' ENTER NAME OF PLOT FILE (e.g. TEST',A1,'PLT1): ',$)
      READ   (IN,115,END=100) NAM32
  115 FORMAT (A32)
      IF (NAM4.EQ.BLNK4 .OR. NAM4.EQ.STOP4) GO TO 1000
C
C     CHECK PLT1 OR PLT2 TAPE
C
      I = 33
  120 I = I - 1
      IF (I .LE. 0) GO TO 1000
      IF (NA1(I) .EQ. KB) GO TO 120
      IF ((NA1(I ).EQ.K1 .OR. NA1(I).EQ.K2) .AND. NA1(I-4).EQ.DorS .AND.
     1   (NA1(I-1).EQ.KT .OR. NA1(I-1).EQ.KT1) .AND.
     2   (NA1(I-2).EQ.KL .OR. NA1(I-2).EQ.KL1) .AND.
     3   (NA1(I-3).EQ.KP .OR. NA1(I-3).EQ.KP1)) GO TO 140
C
C     IMPROPER INPUT FILE NAME
C
      WRITE  (NOUT,130) DorS,DorS,(NA1(J),J=1,I)
  130 FORMAT (/,' FILE ERROR - This program uses only FNAME',A1,'PLT1 ',
     1        'or FNAME',A1,'PLT2 file', 5X,33A1)
      IF (.NOT.ADOT) WRITE (NOUT,135) DorS,DorS
  135 FORMAT (' ADD ',A1,'PLT1 or ',A1,'PLT2 TO THE FILE NAME CORRES',
     1        'PONDING TO YOUR ORIGINAL', /1X,'NASTRAN PLOT FILE SPEC')
      IF (IBM) WRITE (NOUT,137)
  137 FORMAT (' USE A SLASH IF FILE IS A DATA SET NAME, OR NO SLASH IF',
     1        ' IT IS A DDNAME')
      GO TO 100
C
C     INITIALIZE PARAMETERS FOR PLT1 OR PLT2 OF RECORDS:
C     REMOVE '.PLTi' IF ORIGINAL FILE NAME CONTAINS NO FILE EXTENSION
C
  140 DOT = I - 4
      IF (ADOT) GO TO 150
      DO 145 J = DOT,I
  145 NA1(J) = KB
  150 K12 = K1
      IF (NA1(I) .EQ. K2) K12 = K2
      RL  = 30
      NW  = 6
      NRC = 500
      JID = 3
      IF (K12 .EQ. K1) GO TO 160
      RL  = 3000
      NW  = 30
      NRC = 30
      JID = 6
      IF (.NOT.VAX) JID = 3
C     THE ABOVE LINE MAY REQUIRE VERIFICAION ????
C
C     OPEN INPUT PLT1 OR PLT2 FILE
C
C     PLT1: RECORD LENGTH IS IN 130  BYTES (30 DATA WORDS)
C           FILE WAS CREATED SEQUENTIAL, FORMATTED, CARRIAGE CONTROL
C     PLT2: RECORD LENGTH IS IN 3000 BYTES
C           FILE WAS CREATED SEQUENTIAL, FORMATTED, NO CARRIAGE CONTROL,
C           AND 3000 BYTE LONG RECORDSIZE
C
  160 OPEN (UNIT=FIL,FILE=NAM32,ERR=850,STATUS='OLD',FORM='FORMATTED',
     1      ACCESS='SEQUENTIAL',
     2                          RECL=RL)
      IF (K12 .EQ. K1) GO TO 200
C
C     IF PLT2 IS USED, INQUIRE WHAT MACHINE THE TAPE WAS GENERATED
C
  170 CDC = EOF(IN)
      WRITE  (NOUT,180) K12
  180 FORMAT (/,' FROM WHAT MACHINE WAS THIS PLT',A1,' FILE GENERATED?',
     1        /,' (Ibm,Univac,Cdc,Vax,uniX,craY): ',$)
      READ (IN,30,END=170) TEMP
      IF (TEMP.NE.KI .AND. TEMP.NE.KU .AND. TEMP.NE.KC .AND.
     1    TEMP.NE.KV .AND. TEMP.NE.KX .AND. TEMP.NE.KY) GO TO 170
      BO = 8
      IF (TEMP .EQ. KU) BO = 9
      IF (TEMP .EQ. KC) BO = 6
C     IF (BO .EQ. BI) GO TO 200
      IF (BO .EQ.  8) GO TO 200
      WRITE  (NOUT,190)
  190 FORMAT (//,' *** THIS NASTPLOT VERSION CAN NOT PROCESS PLOT TAPE',
     1       ' GENERATED FROM A', /5X,'UNIVAC OR CDC MACHINE')
      GO TO 1000
C
C     CHECK PROSCRIPT PLOTTER SCALE AND
C     INQUIRE SINGLE OR MULTIPLE POSTSCRIPT OUTPUT FILES
C
  200 IF (TEK) GO TO 250
      IF (.NOT.PSC) GO TO 280
      WRITE  (NOUT,210) SCALE,CSCAL
  210 FORMAT (/,' CURRENT PLOT SCALE AND CHARACTER SCALE ARE',2F6.2,
     1        1H;, /,' ENTER NEW SCALES (2F6.2) or C/R ',$)
      READ   (IN,220,ERR=230) SX,SY
  220 FORMAT (2F6.2)
      IF (SX .GT. 0.01) SCALE = SX
      IF (SY .GT. 0.01) CSCAL = SY
C
  230 CDC = EOF(IN)
      WRITE  (NOUT,240) K12
  240 FORMAT (/,' IF PLT',A1,' HAS MULTIPLE PLOTS, STACK ALL PLOTS IN',
     1        ' ONE POSTSCRIPT FILE? (Y,N) ',$)
      READ (IN,30,END=230) ALL
      IF (ALL .EQ. SYY) ALL = YES
      IF (ALL .EQ. SNN) ALL = NO
      IF (ALL .EQ. YES) GO TO 280
      IF (ALL .NE.  NO) GO TO 230
      GO TO 280
C
C     IF MACHINE IS VAX, EQUIPPED WITH TEKTRONIX PLOT-10 TSC AND
C     ADVANCED GRAPHING II PACKAGES, CALL NASTEK TO DO THE JOB
C
  250 CONTINUE
C     IF (.NOT.VAX) GO TO 260
      WRITE  (NOUT,255)
  255 FORMAT (/,' PLOT-10 TCS AND ADVANCED GRAPHING II PACKAGES ON YOUR'
     1,       ' VAX SYSTEM? (Y/N) ',$)
      READ (IN,30) J
      IF (J .NE. YES) GO TO 260
      I = 5
      J = 30
      IF (K12 .EQ. K1) GO TO 257
      I = 100
      J = 3000
  257 CONTINUE
C+    CALL NASTEK (*1050,FIL,I,Z,J)
      CLOSE (UNIT=FIL)
      GO TO 1000
C
C     CHECK TEKTRONIX HORIZ. AND VERTICAL AXES
C
  260 WRITE  (NOUT,265) XSIZE,YSIZE
  265 FORMAT (/,' CURRENT FRAME SIZE IS:  X-AXIS=',F6.2,' Y-AXIS=',F6.2,
     1        /,' ENTER NEW SIZES (2F6.2) or C/R: ',$)
      READ   (IN,220,ERR=275) SX,SY
      IF (SX .GT. 0.01) XSIZE = SX
      IF (SY .GT. 0.01) YSIZE = SY
      IF (YSIZE .LE. 32.0) GO TO 280
      WRITE  (NOUT,270)
  270 FORMAT (' MAXIMUM LENGTH FOR Y-AXIS IS 32.0 INCHES')
      GO TO 250
  275 CDC = EOF(IN)
C
C     LOOK FOR PLOT ID-FRAME IN Z(n). IF IT IS FOUND, REPLACE THE PLOT
C     NUMBER IN Z(JID) BY ZERO.  n IS 19 FOR PLT1 AND n IS 90 FOR PLT2.
C     SET PID FLAG TO 1 IF PLOT ID-FRAME DOES EXIST. OTHERWISE ZERO
C     (PLOT ID-FRAME IS THE PLOT WITH MANY HORIZONTAL LINES, AND USER
C     ID AT MID PAGE)
C
  280 REWIND FIL
      PLOTID = -1
      LASTSL = -1
      PNO = 0
      KK  = 1
      IF (K12 .EQ. K2) GO TO 290
      READ (FIL,460,END=900) W
      IF (W(19)-16) 300,320,300
C
  290 READ (FIL,FMT500,END=900) Z
C
C       NEXT DO LOOP LOCATES '16' ON PLT2 FILE
C       (IT WAS FOUND ON THE 90TH WORD)
C
C       DO 295 I = 1,99
C       L = IAND(Z(I),MASK)
C       WRITE  (NOUT,292) I,L
C 292   FORMAT ('  WORD',I3,' = ',I7)
C 295   CONTINUE
C
      IF (IAND(Z(90),MASK) .EQ. 16) GO TO 320
  300 WRITE  (NOUT,310) K12
  310 FORMAT (/,' THERE IS NO PLOT ID FRAME (PLOT NO. 0) ON USER''S ',
     1       'PLT',A1,' FILE',/)
      PID = 0
      GO TO 350
  320 PID = 1
      Z(JID) = 0
C
C     ON THE PLOT FILE AS GENERATED BY NASTRAN, BOTH PLOT ID-FRAME AND
C     THE FIRST STRUCTURE PLOT ARE PLOT NUMBER 1.  TREAT THE PLOT ID-
C     FRAME AS PLOT NUMBER 0 THROUGHOUT THIS NASTPLOT PROGRAM
C
      WRITE  (NOUT,330) K12
  330 FORMAT (/,' THERE IS A PLOT ID FRAME (PLOT NUMBER 0) ON USER''S ',
     1        'PLT',A1,' FILE')
      GO TO 350
C
  340 WRITE (NOUT,310)
C
C     INQUIRE WHICH PLOT TO BE PLOTTED (SELECT)
C     (ALLOW 5-DIGIT PLOT NO, CAN BE LEFT OR RIGHT AJUSTED)
C
  350 WRITE  (NOUT,360)
  360 FORMAT (//,' ENTER PLOT NUMBER TO BE PLOTTED, ''NEXT'' or ',
     1        '''STOP'' ',$)
      READ   (IN,370,END=350) CHR1
  370 FORMAT (5A1)
      IF (CHR4 .EQ. BLNK4) GO TO 350
      SELECT = -99
      IF (PSC .AND. (CHR1(1).EQ.AL1 .OR. CHR1(1).EQ.KA1)) PSALL = 1
      IF (PSALL.NE.0 .OR. CHR1(1).EQ.NXT1 .OR. CHR1(1).EQ.KN1) GO TO 510
      IF (CHR1(1).EQ.STP1 .OR. CHR1(1).EQ.KS1) GO TO 1010
      SELECT = 0
      TEN = 1
      K   = 5
      DO 410 J = 1,5
      IF (CHR1(K) .EQ. BLNK1) GO TO 410
      DO 380 I = 1,10
      IF (CHR1(K) .EQ. NUMB1(I)) GO TO 400
  380 CONTINUE
      WRITE  (NOUT,390)
  390 FORMAT (/5X,'...INPUT ERROR')
      GO TO 350
  400 IF (I .EQ. 10) I = 0
      SELECT = SELECT + I*TEN
      TEN = TEN*10
  410 K   = K - 1
      FOUND = .FALSE.
      IF (SELECT     .LT. 0) GO TO 900
      IF (SELECT+PID .EQ. 0) GO TO 340
      IF (LASTSL    .EQ. -2) GO TO 510
      IF (SELECT - LASTSL) 950,420,510
  420 CDC = EOF(IN)
      WRITE  (NOUT,430) LASTSL
  430 FORMAT (' LAST PLOT WAS PLOT NO.',I3,'.   ARE YOU SURE? (Y,N) ',$)
      READ (IN,30,END=420) J
      IF (J.EQ.YES .OR. J.EQ.SYY) GO TO 950
      IF (J.NE.NO .AND. J.NE.SNN) GO TO 420
      GO TO 350
C
C     SEARCH PLOT TAPE FOR PLOT SELECTED
C     UP TO 2 DIGITS ONLY FOR PLOT ID
C
  440 IF (K12 .EQ. K2) GO TO 490
  450 READ   (FIL,460,END=900) W
  460 FORMAT (5(2I3,4I5))
      KK = KK + 1
      IF (DEBUG .AND. MOD(KK,NRC) .EQ. 0) WRITE (NOUT,470) KK
  470 FORMAT (10X,'...SEARCHING',I6,' RECORDS')
  480 FORMAT (10X,'...WORKING  ',I6,' RECORDS PROCESSED')
      IF (W(1) .NE. 1) GO TO 450
      GO TO 510
  490 READ   (FIL,FMT500,END=900) Z
C 500 FORMAT (3000A1)
      KK = KK + 1
      IF (DEBUG .AND. MOD(KK,NRC) .EQ. 0) WRITE (NOUT,470) KK
      IF (.NOT.VAX .AND. ISHFT(Z(1),NBS).NE.1) GO TO 490
      IF (     VAX .AND. IAND(Z(4),MASK).NE.1) GO TO 490
C
C     WRITE  (NOUT,505) JID,(Z(J),J=1,9)
C 505 FORMAT (' JID =',I3,',  FIRST 9 BYTES OF NEW-PLOT RECORD = ',
C    1        /12X,9I7)
C
      IF (.NOT.VAX) PLOTID = ISHFT(Z(JID-1),NBS)*10 + ISHFT(Z(JID),NBS)
      IF (     VAX) PLOTID = IAND(Z(JID+1),MASK)*10 + IAND(Z(JID),MASK)
C
C     SELECT WAS SET TO -99 IF USER WANTS THE NEXT PLOT, OR
C     USER REQUEST ALL PLOTS ON POSTSCRIPT
C
  510 IF (K12.NE.K2 .OR. LASTSL.EQ.-2) PLOTID = Z(JID)
C     IF (DEBUG) WRITE (NOUT,545) PLOTID
      IF (SELECT .EQ. -99) SELECT = PLOTID
      IF (LASTSL .EQ. -2 ) LASTSL = -1
      IF (PLOTID.GE.0 .OR. PSALL.NE.0) IF (PLOTID-SELECT) 440,540,520
      IF (PNO+PID .EQ. SELECT) GO TO 540
      PNO = PNO + 1
      GO TO 440
C
C     INPUT TAPE MAY NOT SPECIFY PLOT NO.
C
  520 CDC = EOF(IN)
      WRITE  (NOUT,530) PLOTID,SELECT
  530 FORMAT (/,' PLOT NO.',I4,' JUST FOUND. INPUT TAPE MAY NOT USE ',
     1       'OR SPECIFY PLOT NO.',I4,
     2        /,' CONTINUE SEARCHING or REWIND TAPE? (Y,N,R) ',$)
      READ (IN,30,END=520) TEMP
      IF (TEMP .EQ. KR1) GO TO 950
      IF (TEMP .EQ. KY ) GO TO 440
      GO TO 350
C
C     MATCHING PLOT NUMBER JUST FOUND.
C     SET N1 FOR THE 900 LOOP, THAT POINTS TO THE 2ND PLOT COMMAND
C
  540 FOUND  = .TRUE.
      PLOTID = SELECT
      IF (PLOTID .EQ. -1) PLOTID = 0
      IF (DEBUG) WRITE (NOUT,545) PLOTID
  545 FORMAT (13X,'PLOT NO =',I5,'  FOUND')
      NOTYET = .TRUE.
      NREC   = KK
      N1     = 7
      IF (K12 .EQ. K2) N1 = 1
      IF (PSC) GO TO 550
C
C     INITIALIZE TEKRONIX:
C
      CALL TXINIT
      XHI    = 0
      YHI    = 0
      PENCHG = 0
      PENCNT = 0
      OLDPEN = 0
      GO TO 620
C
C     INITIALIZE POSTCRIPT:
C
  550 NPLOT  = NPLOT + 1
      JOUNT  = 0
      ONCE   =-1
      IF (ADOT) GO TO 560
      IF (ALL .EQ. YES) IF (LUOPEN) 590,555,590
  555 NA1(DOT) = A1Z(NPLOT)
      GO TO 585
  560 KNUM1  = KB
      KNUM(2)= KB
      IF (ALL .EQ. YES) IF (LUOPEN) 590,580,590
      IF (NPLOT .LT. 10) WRITE (KNUM1,565) NPLOT
      IF (NPLOT .GE. 10) WRITE (KNUM2,570) NPLOT
  565 FORMAT (I1)
  570 FORMAT (I2)
  580 NA1(DOT+2) = KNUM1
      NA1(DOT+3) = KNUM(2)
      NA1(DOT+4) = KB
  585 OPEN (UNIT=LU,FILE=NAM32,FORM='FORMATTED',STATUS='NEW',ERR=870
C    1     )
     1     ,CARRIAGECONTROL='LIST')   ! RECOMMANDED FOR VAX TO GENERATE
C                                     ! STANDARD LIST FILE
      LUOPEN = 1
  590 CALL PSINIT (NOLINE)
      IF (ALL .EQ. YES) NOLINE = 1
      GO TO 620
C
  600 NREC = NREC + 1
      IF (PSC .AND. DEBUG .AND. MOD(NREC,NRC).EQ.0)
     1    WRITE (NOUT,480) NREC
C
C     READ NEXT RECORD
C
      IF (K12 .EQ. K2) GO TO 610
      READ (FIL,460,END=900) W
      GO TO 620
  610 READ (FIL,FMT500,END=900) Z
C
C     INTERCHANGE BYTE ORDER IF MACHINE IS VAX
C
  620 KK = KK + 1
      IF (K12.EQ.K1 .OR. .NOT.VAX) GO TO 640
      DO 630 I = 1,RL,4
      J      = Z(I  )
      Z(I  ) = Z(I+3)
      Z(I+3) = J
      J      = Z(I+1)
      Z(I+1) = Z(I+2)
      Z(I+2) = J
  630 CONTINUE
C
C     PROCESS ONE PHYSICAL PLOT RECORD
C
  640 DO 800 N = N1,RL,NW
C
C     GET NEXT COMMAND,
C
      IF (K12 .EQ. K2) GO TO 650
C
C     PLT1 FILE: TOTAL OF 5 PLOT COMMANDS/RECORD
C
      CMND  = W(N)
      IF (CMND .EQ. 0) GO TO 810
      CNTRL = W(N+1)
      R = W(N+2)
      S = W(N+3)
      T = W(N+4)
      U = W(N+5)
      GO TO 680
C
C     PLT2 FILE:  TOTAL OF 100 PLOT COMMANDS/RECORD
C     EACH PLOT COMMAND IS 30 BYTE LONG, AND DATA IN FIRST 22 BYTES
C
  650 IF (BI .EQ. BO) GO TO 660
      CALL GETCMD (Z)
      GO TO 680
C
  660 N22  = N + 21
      DO 670 J = N,N22
      IF (     VAX) Z(J) = IAND(Z(J), MASK)
      IF (.NOT.VAX) Z(J) = ISHFT(Z(J),-NBS)
  670 CONTINUE
      CMND  = Z(N)
      IF (CMND .EQ. 0) GO TO 810
      CNTRL = Z(N+1)
      R = Z(N+ 2)*T4 + Z(N+ 3)*T3 + Z(N+ 4)*T2 + Z(N+ 5)*T1 + Z(N+ 6)
      S = Z(N+ 7)*T4 + Z(N+ 8)*T3 + Z(N+ 9)*T2 + Z(N+10)*T1 + Z(N+11)
      T = Z(N+12)*T4 + Z(N+13)*T3 + Z(N+14)*T2 + Z(N+15)*T1 + Z(N+16)
      U = Z(N+17)*T4 + Z(N+18)*T3 + Z(N+19)*T2 + Z(N+20)*T1 + Z(N+21)
      IF (.NOT.NOTYET) GO TO 680
      NOTYET =.FALSE.
      XMAX = S
      YMAX = T
      XFACT= XSIZE/XMAX
      YFACT= YSIZE/YMAX
      XLO  = XMAX
      YLO  = YMAX
      GO TO 800
C
C     CMND =  0, NON-OPERATION. A PADDING COMMANDS OF ALL ZEROS
C          =  1, START-NEW-PLOT. R IS THE PLOT NUMBER
C          =  2, SELECT-CAMERA. CNTRL=1 FILM ONLY, =2 HARDCOPY, =3 BOTH
C          =  3, SKIP-TO-A-NEW-FRAME. CNTRL=1,2,3 SAME AS CMND=2
C                AT LEAST ONE CMND=3 COMMAND AFTER A CMND=1 COMMAND AND
C                BEFORE NEXT CMND=1
C          =  4, TYPE-CHARACTER
C          =  5, DRAW-LINE
C          =  6, DRAW-AXIS
C          = 14, 15, 16, SAME AS 4, 5, 6
C                THESE COMMANDS INDICATE FIRST OF A SERIES OF 4, 5, OR
C                6 COMMNADS THAT FOLLOW
C     CMND = 2,3 ARE FOR MICROFILM PLOTTER ONLY. THEY ARE NOT USED
C                IN THIS NASPLT PROGRAM
C
C     CNTRL= A PEN NO., OR A LINE DENSITY, OR A CAMERA NO, OR A POINTER
C            INTO A LIST OF CHARACTERS AND SYMBOL (TABLE 1 OF THE
C            USER'S MANUAL, P.4.4-5)
C
C     R,S,T,U = DATA VALUES
C
C
C
C     NOTE, CMND=1 (START-NEW-PLOT) ALWAYS LOCATES ON THE FIRST COMMAND
C     OF A PLOT RECORD
C     IGNORE CMND =2 OR 3, WHICH ARE FOR MICROFILM PLOTTER ONLY
C
  680 IF (CMND .NE. 1) GO TO 720
      IF (N    .NE. 1) WRITE (NOUT,685) BELL,BELL,BELL,N,CNTRL
  685 FORMAT (1X,3A1,/,'0*** LOGIC ERROR. NEW PLOT FOUND AT MIDDLE OF ',
     1        'RECORD', /5X,'N =',I5,',  PLOT NO.',I5)
C
C     END OF PREVIOUS PLOT
C
      WRITE  (NOUT,690) BELL
  690 FORMAT (1X,A1)
      IF (TEK) GO TO 710
      CALL PSTRKE
      CALL PSFINS
      IF (ALL .EQ. YES) GO TO 695
      CLOSE (UNIT=LU)
      IF (LUX) LU = LU + 1
      LUOPEN = 0
  695 WRITE  (NOUT,700) PLOTID,K12
  700 FORMAT (/,' A PLOT WAS GENERATED FROM PLOT NO.',I3,' OF THE PLT',
     1        A1,' FILE',/)
      IF (K12  .EQ. K2) BACKSPACE FIL
      LASTSL = SELECT
      SELECT = R
      PLOTID = R
      IF (PSALL) 540,350,540
C
  710 READ (IN,30,END=715) J
  715 CDC = EOF(IN)
      CALL TXFINS
      GO TO 350
C
  720 IF (CMND .LE. 3) GO TO 800
C
C     CHECK FOR NEW CHARACTER, LINE, OR AXIS SET
C
      IF (CMND.LT.14 .OR. CMND.GT.16) GO TO 730
      IF (CMND .EQ. 14) CHRSET = .TRUE.
      IF (CMND .EQ. 15) LINSET = .TRUE.
      IF (CMND .EQ. 16) AXSSET = .TRUE.
      CMNDX = CMND
      CMND  = CMND - 10
C
C     CHECK FOR END OF CHARACTER, LINE, OR AXIS SET
C
  730 IF (.NOT.PSC) GO TO 740
      IF (CHRSET .AND. CMND.NE.4) CALL PSENDC (CHRSET,CMNDX)
      IF (CMND .NE. 4) GO TO 750
      CALL PSCHAR (CHRSET,CMNDX)
      GO TO 800
  740 IF (CHRSET .AND. CMND.NE.4) CALL ENDKHR (CHRSET)
      IF (LINSET .AND. CMND.NE.5) CALL ENDLIN (LINSET)
      IF (AXSSET .AND. CMND.NE.6) CALL ENDAXS (AXSSET)
C
  750 IF (CMND-5) 760,770,790
C         CMND  =  4   5   6
C           or    14  15  16
C
  760 IF (TEK) CALL DRWKHR (CHRSET)
      GO TO 800
  770 IF (PSC) GO TO 780
      CALL DRWLIN (LINSET)
      GO TO 800
  780 CALL PSLINE
      GO TO 800
  790 IF (PSC) GO TO 780
      CALL DRWAXS (AXSSET)
  800 CONTINUE
C
C     LOOP BACK FOR MORE PLOT RECORDS FROM PLOT FILE
C     SESET N1 FOR THE 900 LOOP, THAT POINTS TO THE 1ST PLOT COMMAND
C
  810 N1 = 1
      GO TO 600
C
C     PLOT FILE NOT FOUND. TRY AGAIN
C
  850 WRITE  (NOUT,860) NAM32
  860 FORMAT (/,' *** NO SUCH INPUT FILE ',A32)
      IF (IBM) WRITE (NOUT,137)
      GO TO 100
C
  870 WRITE  (NOUT,880) NAM32
  880 FORMAT (//,' *** CAN NOT OPEN OUTPUT FILE - ',A32,
     1        /5X,'JOB ABORTED')
      CLOSE (UNIT=FIL)
      GO TO 1050
C
C     EOF ENCOUNTERED
C
  900 WRITE (NOUT,690) BELL
      IF (PLOTID.EQ.-1 .OR. .NOT.FOUND) GO TO 920
      IF (PSC) GO TO 910
      READ (IN,30,END=905) J
  905 CDC = EOF(IN)
      CALL TXFINS
      GO TO 920
  910 J = 0
      IF (CHRSET) CALL PSENDC (CHRSET,J)
      CALL PSTRKE
      CALL PSFINS
      IF (ALL .EQ. YES) GO TO 915
      CLOSE (UNIT=LU)
      IF (LUX) LU = LU + 1
      LUOPEN = 0
  915 IF (NPLOT .GT. 0) WRITE (NOUT,700) PLOTID,K12
  920 IF (.NOT.FOUND) WRITE (NOUT,930) SELECT
  930 FORMAT (/,' PLOT NO.',I4,' DOES NOT EXIST')
  940 WRITE  (NOUT,945) PLOTID,K12
  945 FORMAT (/,' EOF ENCOUNTERED. THERE ARE ONLY',I3,' PLOTS ON ',
     1       'USER''S PLT',A1,' FILE', /,
     2       ' START ALL OVER PLOTTING AGAIN? (Y,N) ',$)
      READ (IN,30,END=940) J
      IF (J.EQ.NO   .OR. J.EQ.SNN) GO TO 1010
      IF (J.NE.YES .AND. J.NE.SYY) GO TO  920
      SELECT = -1
C
C     START ALL OVER AGAIN
C
  950 REWIND FIL
      KK    = 0
      PSALL = 0
      PNO   = 0
      PLOTID=-1
      LASTSL=-2
      IF (K12 .EQ. K1) READ (FIL,   460,END=1010) W
      IF (K12 .EQ. K2) READ (FIL,FMT500,END=1010) Z
      IF (PID .EQ.  0) GO TO 960
      Z(JID) = 0
      GO TO 970
  960 IF (K12 .EQ. K1) GO TO 970
      IF (.NOT.VAX) Z(JID) = ISHFT(Z(JID-1),NBS)*10 + ISHFT(Z(JID),NBS)
      IF (     VAX) Z(JID) = IAND(Z(JID+1),MASK)*10 + IAND(Z(JID),MASK)
  970 IF (SELECT) 350,510,510
C
C     JOB DONE. TIDY UP ALL LOOSE ENDS
C
 1000 WRITE (NOUT,1020)
      GO TO 1050
 1010 CLOSE (UNIT=FIL)
      IF (ALL.EQ.YES .AND. LUOPEN.EQ.1) CLOSE (UNIT=LU)
      WRITE  (NOUT,1020)
 1020 FORMAT (//5X,'*** JOB DONE ***')
      IF (.NOT.PSC .OR. NPLOT.LE.0) GO TO 1050
      KC = KB
      IF (NPLOT .GT. 1) KC = STP1
      IF (ALL .EQ. YES) GO TO 1030
      NA1(DOT+3) = KB
      IF (NPLOT .LE. 1) GO TO 1030
      NA1(DOT+2) = STR
      KB = STP1
 1030 WRITE  (NOUT,1040) NPLOT,KC,KB,NAM32
 1040 FORMAT (//4X,I2,' PLOT FILE',A1,' GENERATED. SEND THE FOLLOWING ',
     1       'PostScript FILE',A1, /5X,'TO PRINTER - ',A32)
C
 1050 CONTINUE
      END
C
C     =================================================================
C
      SUBROUTINE GETCMD (Z)
C
C     THIS SUBROUTINE GET THE PLOT COMMAND
C
C     THIS SUBROUTINE IS NEEDED ONLY WHEN THE MACHINE READING THE PLT2
C     TAPE AND THE MACHINE WHO WROTE THE PLT2 TAPE, HAVE DIFFERENT
C     NUMBER OF BITS PER BYTE, NBPB
C     E.G.  NBPB IS 6 FOR CDC, 8 FOR VAX AND IBM, AND 9 FOR UNIVAC
C
C     BI = NBPB ON WRITING COMPUTER
C     BO = NBPB ON READING COMPUTER
C
      IMPLICIT INTEGER (A-Z)
      INTEGER     Z(1),Q(1)
      COMMON /QQ/ BI,BO,WRD,BYT,PC,CI,R4,R3,R2,R1,R0,S4,S3,S2,S1,S0,
     1            T4,T3,T2,T1,T0,U4,U3,U2,U1,U0
      COMMON      CMND,CTRL,R,S,T,U
      EQUIVALENCE (Q(1),PC)
      DATA   MAX/ 3000 /
C
      IF (BI .EQ. BO) STOP ' NO NEED TO CALL GETCMD'
      IF (BI .NE. BO) STOP ' PRESENTLY, GETCMD DOES NOT WORK'
C
C     GET 30-BYTE COMMAND INTO 30 INTEGERS
C     THE FOLLOWING LOGIC IS FACTITIOUS
C
      IF (BI.EQ.8 .AND. BO.EQ.6) GO TO 1110
C
C     NBPC OF 6 INTO NBPC OF 8
C
      DO 1100 I = 1,30
      Q(I) = Z(WRD)
      IF (BYT .EQ.   0) WRD = WRD + 1
      IF (BYT .EQ.   0) BYT = 6
      IF (WRD .GT. MAX) WRD = 1
 1100 BYT = BYT - 1
      GO TO 1130
C
C     NBPC OF 8 INTO NBPC OF 6
C
 1110 DO 1120 I = 1,30
      Q(I) = Z(WRD)
      IF (BYT .EQ.   0) WRD = WRD + 1
      IF (BYT .EQ.   0) BYT = 8
      IF (WRD .GT. MAX) WRD = 1
 1120 BYT = BYT - 1
C
 1130 CMND = PC
      CTRL = CI
      R    = R4*10000 + R3*1000 + R2*100 + R1*10 + R0
      S    = S4*10000 + S3*1000 + S2*100 + S1*10 + S0
      T    = T4*10000 + T3*1000 + T2*100 + T1*10 + T0
      U    = U4*10000 + U3*1000 + U2*100 + U1*10 + U0
      RETURN
      END
C
C     =================================================================
C
      SUBROUTINE DRWAXS (AXSSET)
C
      IMPLICIT INTEGER (A-Z)
      REAL     XFACT,YFACT,X,Y
      LOGICAL  AXSSET,P16
      COMMON   CMND,CNTRL,R,S,T,U,XFACT,YFACT,XMAX,YMAX,XHI,YHI,XLO,YLO,
     1         PENCHG,PENCNT,OLDPEN,PENNO(99)
      DATA     AXSCNT,P16 / 0, .TRUE. /
C
C     CHECK FOR INITIAL COMMAND = 16
C
      IF (AXSSET) GO TO 1150
      AXSSET = .TRUE.
      P16    = .FALSE.
C
C     CHECK COORDINATES AGAINST MAX & MIN ENCOUNTERED SO FAR
C
 1150 XHI = MAX(R,T,XHI)
      YHI = MAX(S,U,YHI)
      XLO = MIN(R,T,XLO)
      YLO = MIN(S,U,YLO)
C
C     CHECK FOR A PEN CHANGE AND/OR NEW PEN ID
C
      IF (CNTRL .EQ. OLDPEN) GO TO 1180
      CALL TXNPEN (CNTRL)
      PENCHG = PENCHG + 1
      IF (PENCNT .GE. 99) GO TO 1170
      PENCNT = PENCNT + 1
      PENNO(PENCNT) = CNTRL
      IF (PENCNT .LE. 1) GO TO 1170
      DO 1160 N = 2,PENCNT
      IF (PENNO(PENCNT) .NE. PENNO(N-1)) GO TO 1160
      PENCNT = PENCNT -1
      GO TO 1170
 1160 CONTINUE
 1170 OLDPEN = CNTRL
 1180 AXSCNT = AXSCNT + 1
C
C     MOVE PLOTTER PEN TO BEGINNING OF AXIS
C
      X = XFACT*FLOAT(R)
      Y = YFACT*FLOAT(S)
      CALL TXPLOT (X,Y,3)
C
C     DRAW AXIS ON PLOTTING SURFACE
C
      X = XFACT*FLOAT(T)
      Y = YFACT*FLOAT(U)
      CALL TXPLOT (X,Y,2)
      RETURN
C
C
      ENTRY ENDAXS (AXSSET)
C     =====================
C
C     REINITILIZE COMMANDS
C
      P16    = .TRUE.
      AXSCNT =  0
      AXSSET = .FALSE.
      RETURN
      END
C
C     =================================================================
C
      SUBROUTINE DRWKHR (CHRSET)
C
      IMPLICIT  INTEGER (A-Z)
      LOGICAL   CHRSET
      REAL      XFACT,YFACT,X,Y,ANGLE,HITE
      CHARACTER CHR94*52,CHRSAV*57,BLNK1,QUES1
      DIMENSION CHRCOD(53)
      COMMON    CMND,CNTRL,R,S,T,U,XFACT,YFACT,XMAX,YMAX,XHI,YHI,XLO,YLO
      DATA      LINE,SAVCNT,CHRCNT,UNKCNT / 1, 0, 0, 0/
      DATA      CHRSAV,BLNK1,QUES1    / ' ', ' ', '?' /
      DATA      CHR94 /
     1          '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ()+-*/=.,$" O[<^'/
      DATA      CHRCOD /32,33,34,35,36,37,38,39,40,41,
     1                  49,50,51,52,53,54,55,56,57,58,59,60,61,
     2                  62,63,64,65,66,67,68,69,70,71,72,73,74,
     3                  24,25,27,29,26,31,45,30,28,20,23,
     4                  16, 1, 0, 5, 2,47/
C
C     CHECK FOR INITIAL COMMAND = 14
C
      IF (CHRSET) GO TO 1200
      CHRSET = .TRUE.
      LINE   = LINE + 1
C
C     UPDATE COUNTER & POINTER
C
 1200 SAVCNT = SAVCNT + 1
      CHRCNT = CHRCNT + 1
C
C     STORE CHARACTER IN STRING CHRSAV
C
      IF (CNTRL.LE.52 .AND. CNTRL.GT.0) GO TO 1210
      CHRSAV(SAVCNT:SAVCNT) = QUES1
      CODE   = CHRCOD(53)
      UNKCNT = UNKCNT + 1
      GO TO 1220
C
 1210 CHRSAV(SAVCNT:SAVCNT) = CHR94(CNTRL:CNTRL)
      CODE = CHRCOD(CNTRL)
C
C     IF CHRSAV STRING IS FULL, PRINT IT
C
 1220 IF (SAVCNT .NE. 57) GO TO 1230
      CHRSAV = BLNK1
      SAVCNT = 0
      LINE   = LINE + 1
C
C     COMPARE (X,Y) WITH MAX & MIN ENCOUNTERED SO FAR
C
 1230 XHI = MAX(XHI,R)
      YHI = MAX(YHI,S)
      XLO = MIN(XLO,R)
      YLO = MIN(YLO,S)
C
C     DRAW CHARACTER ON PLOTTER
C
      X     = XFACT*FLOAT(R)
      Y     = YFACT*FLOAT(S)
      HITE  = 0.08*XFACT*100.0
      ANGLE = 0.0
C
C     BRING IN NASTRAN SYMBOL ROUTINE IF IT IS NEEDED
C
C     CALL SYMBOL (X,Y,HITE,CODE,ANGLE,-1)
      RETURN
C
C
      ENTRY ENDKHR (CHRSET)
C     =====================
C
C     PRINT OUT CONTENTS OF CHRSAV & COUNTERS
C     REINITIALIZE
C
      LINE   = 1
      CHRSAV = BLNK1
      CHRSET = .FALSE.
      SAVCNT = 0
      CHRCNT = 0
      UNKCNT = 0
      RETURN
      END
C
C     =================================================================
C
      SUBROUTINE DRWLIN (LINSET)
C
      IMPLICIT INTEGER (A-Z)
      REAL     XFACT,YFACT,X,Y,OLDX,OLDY
      LOGICAL  LINSET,P15,LINPRV
      COMMON   CMND,CNTRL,R,S,T,U,XFACT,YFACT,XMAX,YMAX,XHI,YHI,XLO,YLO,
     1         PENCHG,PENCNT,OLDPEN,PENNO(99)
      DATA     LINCNT,P15,LINPRV / 0,.TRUE.,.FALSE. /
C
C     CHECK FOR INITIAL COMMAND = 15
C
      IF (LINSET) GO TO 1250
      LINSET = .TRUE.
      P15    = .FALSE.
C
C     CHECK COORDINATES AGAINST MAX & MIN ENCOUNTERED SO FAR
C
 1250 XHI  = MAX(R,T,XHI)
      YHI  = MAX(S,U,YHI)
      XLO  = MIN(R,T,XLO)
      YLO  = MIN(S,U,YLO)
      FILL = 0
C
C     CHECK FOR A PEN CHANGE AND/OR NEW PEN ID
C
      IF (CNTRL .EQ. OLDPEN) GO TO 1280
      IF (CNTRL .GT.     31) FILL = 1
      IF (CNTRL.EQ.0 .AND. OLDPEN .GT.31) IFILL = 1
      CALL TXNPEN (CNTRL)
      PENCHG = PENCHG + 1
      IF (PENCNT .GE. 99) GO TO 1270
      PENCNT = PENCNT + 1
      PENNO(PENCNT) = CNTRL
      IF (PENCNT .LE. 1) GO TO 1270
      DO 1260 N = 2,PENCNT
      IF (PENNO(PENCNT) .NE. PENNO(N-1)) GO TO 1260
      PENCNT = PENCNT - 1
      GO TO 1270
 1260 CONTINUE
 1270 OLDPEN = CNTRL
 1280 LINCNT = LINCNT + 1
      X = XFACT*FLOAT(R)
      Y = YFACT*FLOAT(S)
      I = 3
      IF (FILL .EQ. 1) I = -3
C
C     IF FILL = 1 THEN START TO FILL ELEMENT
C
      IF (.NOT.LINPRV .OR. X.NE.OLDX .OR. Y.NE.OLDY) CALL TXPLOT (X,Y,I)
C
C     DRAW LINE ON PLOTTER SURFACE
C
      X = XFACT*FLOAT(T)
      Y = YFACT*FLOAT(U)
C
C     IF CNTRL = 0 CLOSE ELEMENT AND FILL
C
      J = 2
      IF (CNTRL.EQ.0 .AND. IFILL.EQ.1) J = -2
      IF (J .EQ. -2) IFILL = 0
      CALL TXPLOT (X,Y,J)
C
C     REMEMBER POSITION FOR NEXT SUCCESSIVE DRAWLINE COMMAND
C
      OLDX   = X
      OLDY   = Y
      LINPRV = .TRUE.
      RETURN
C
C
      ENTRY ENDLIN (LINSET)
C     =====================
C
C     CHECK FOR INITIAL COMMAND=15, AND PRINT "DRAW LINES" SUMMARY
C     REINITIALIZE
C
      P15    = .TRUE.
      LINCNT =  0
      LINSET = .FALSE.
      LINPRV = .FALSE.
      RETURN
      END
C
C     =================================================================
C
      SUBROUTINE TXNPEN (CNTRL)
C
C     TEKTRONIX PEN AND COLOR CONTROL
C
      INTEGER     CNTRL
      CHARACTER   ESC*1,CLEAR*2,LINCLR*4
      COMMON /IO/ IN,NOUT
      COMMON /EC/ ESC,CLEAR
C
C     CHANGE COLOR BY PEN NUMBER.
C
      IF (CNTRL .GT. 15) GO TO 1460
      GO TO (1310,1320,1330,1340,1350,1360,1370,1380,1390,1400,
     1       1410,1420,1430,1440,1450), CNTRL
 1310 LINCLR = ESC//'ML1'
      GO TO 1620
 1320 LINCLR = ESC//'ML2'
      GO TO 1620
 1330 LINCLR = ESC//'ML3'
      GO TO 1620
 1340 LINCLR = ESC//'ML4'
      GO TO 1620
 1350 LINCLR = ESC//'ML5'
      GO TO 1620
 1360 LINCLR = ESC//'ML6'
      GO TO 1620
 1370 LINCLR = ESC//'ML7'
      GO TO 1620
 1380 LINCLR = ESC//'ML8'
      GO TO 1620
 1390 LINCLR = ESC//'ML9'
      GO TO 1620
 1400 LINCLR = ESC//'ML:'
      GO TO 1620
 1410 LINCLR = ESC//'ML;'
      GO TO 1620
 1420 LINCLR = ESC//'ML<'
      GO TO 1620
 1430 LINCLR = ESC//'ML='
      GO TO 1620
 1440 LINCLR = ESC//'ML>'
      GO TO 1620
 1450 LINCLR = ESC//'ML?'
      GO TO 1620
C
 1460 IF (CNTRL .LT. 32) RETURN
      J = CNTRL - 31
      GO TO (1470,1480,1490,1500,1510,1520,1530,1540,1550,1560,
     1       1570,1580,1590,1600,1610), J
 1470 LINCLR = ESC//'MP!'
      GO TO 1620
 1480 LINCLR = ESC//'MP"'
      GO TO 1620
 1490 LINCLR = ESC//'MP#'
      GO TO 1620
 1500 LINCLR = ESC//'MP$'
      GO TO 1620
 1510 LINCLR = ESC//'MP%'
      GO TO 1620
 1520 LINCLR = ESC//'MP&'
      GO TO 1620
 1530 LINCLR = ESC//'MP'//CHAR(39)
      GO TO 1620
 1540 LINCLR = ESC//'MP('
      GO TO 1620
 1550 LINCLR = ESC//'MP)'
      GO TO 1620
 1560 LINCLR = ESC//'MP*'
      GO TO 1620
 1570 LINCLR = ESC//'MP+'
      GO TO 1620
 1580 LINCLR = ESC//'MP,'
      GO TO 1620
 1590 LINCLR = ESC//'MP-'
      GO TO 1620
 1600 LINCLR = ESC//'MP.'
      GO TO 1620
 1610 LINCLR = ESC//'MP/'
 1620 WRITE  (NOUT,1630) LINCLR
 1630 FORMAT (1X,A4)
      RETURN
      END
C
C     =================================================================
C
      SUBROUTINE TXINIT
C
C     THIS ROUTINE INITIALIZES THE TEKTRONIX GRAPHIC MODE AND CLEARS
C     THE PREVIOUS PLOT OFF THE SCREEN.
C
      CHARACTER   ESC*1,CLEAR*2,INDEX(15)*12
      CHARACTER*4 TMODE,EMODE,LINCLR
      COMMON /IO/ IN,NOUT
      COMMON /EC/ ESC,CLEAR
C
      LINCLR = ESC//'ML1'
      TMODE  = ESC//'%!0'
C
C     SET THE COLOR REGISTERS. FROM RED TO BLUE.
C
      INDEX( 1) = ESC//'TG1410F40'
      INDEX( 2) = ESC//'TG142G8B8F4'
      INDEX( 3) = ESC//'TG143H<B8F4'
      INDEX( 4) = ESC//'TG144I6C2F4'
      INDEX( 5) = ESC//'TG145J:B8F4'
      INDEX( 6) = ESC//'TG146K4C<F4'
      INDEX( 7) = ESC//'TG147K4D6E0'
      INDEX( 8) = ESC//'TG148L8B8F4'
      INDEX( 9) = ESC//'TG149O0C2F4'
      INDEX(10) = ESC//'TG14:P>B8F4'
      INDEX(11) = ESC//'TG14;Q8C2F4'
      INDEX(12) = ESC//'TG14<R7B8F4'
      INDEX(13) = ESC//'TG14=S;B8F4'
      INDEX(14) = ESC//'TG14>U1C2F4'
      INDEX(15) = ESC//'TG14?0C2F4'
C
      WRITE  (NOUT,1700) TMODE,CLEAR
 1700 FORMAT (1X,A4,A2)
      WRITE  (NOUT,1710) (INDEX(I),I=1,15)
 1710 FORMAT (1X,A12)
      WRITE  (NOUT,1700) LINCLR
      RETURN
C
C
      ENTRY TXFINS
C     ============
C
C     THIS ROUTINE INITIALIZES THE EDIT MODE AND CLEARS THE PREVIOUS
C     PLOT OFF THE TEKTRONIC SCREEN.
C
      LINCLR = ESC//'ML1'
      EMODE  = ESC//'%!2'
      WRITE  (NOUT,1720) CLEAR,LINCLR,EMODE
 1720 FORMAT (1X,A2,A4,A4)
      RETURN
      END
C
C     =================================================================
C
      SUBROUTINE TXPLOT (X,Y,N)
C
C     THIS SUBROUTINE CHANGES COORDINATES INTO TEXTRONIX COORDINATES
C
      INTEGER     N,NUMBER(2),CON(12,2),ADE(5),TWO(12)
      REAL        X,Y
      CHARACTER   ESC*1,CLEAR*2,PANEND*3,ASC*5
      CHARACTER*8 PSTART,PEND,PANST
      COMMON /IO/ IN,NOUT
      COMMON /EC/ ESC,CLEAR
      DATA   TWO/ 1,2,4,8,16,32,64,128,256,512,1024,2048 /
C
      IX = NINT(X*3071.0)
      IY = NINT(Y*3071.0)
C
      NUMBER(1) = IX
      NUMBER(2) = IY
C
C     CONVERTS TWO INTEGER VALUES INTO TEKTRONIX TYPE ADE (ASCII TO
C     DECIMAL EQUIVALENT) CHARACTERS
C
      DO 1820 K = 1,2
      IDIGIT = 0
C
      I = 12
      DO 1810 J = 1,12
      IF (TWO(I)-NUMBER(K) .GT. 0) GO TO 1800
      IDIGIT = 1
      NUMBER(K) = NUMBER(K) - TWO(I)
 1800 CON(I,K) = IDIGIT
      IDIGIT = 0
 1810 I = I - 1
 1820 CONTINUE
C
      ADE(1) = 32
      ADE(2) = 96
      ADE(3) = 96
      ADE(4) = 32
      ADE(5) = 64
C
      I = 12
      DO 1830 J = 8,12
      IF (CON(I,1) .EQ. 1) ADE(4) = ADE(4) + TWO(I-7)
 1830 I = I - 1
      ASC(4:4) = CHAR(ADE(4))
C
      I = 7
      DO 1840 J = 3,7
      IF (CON(I,1) .EQ. 1) ADE(5) = ADE(5) + TWO(I-2)
 1840 I = I - 1
      ASC(5:5) = CHAR(ADE(5))
C
      I = 2
      DO 1850 J = 1,2
      IF (CON(I,1) .EQ. 1) ADE(2) = ADE(2) + TWO(I)
 1850 I = I - 1
C
C     IS THERE A LINE MISSING HERE? SOMETHING SUCH AS
C     ASC(?:?) = CHAR(ADE(2))???   G.C  9/90
C
      I = 12
      DO 1860 J = 8,12
      IF (CON(I,2) .EQ. 1) ADE(1) = ADE(1) + TWO(I-7)
 1860 I = I - 1
      ASC(1:1) = CHAR(ADE(1))
C
      I = 7
      DO 1870 J = 3,7
      IF (CON(I,2) .EQ. 1) ADE(3) = ADE(3) + TWO(I-2)
 1870 I = I - 1
      ASC(3:3) = CHAR(ADE(3))
C
      I = 2
      DO 1880 J = 1,2
      IF (CON(I,2) .EQ. 1) ADE(2) = ADE(2) + TWO(I)
 1880 I = I - 1
      ASC(2:2) = CHAR(ADE(2))
C
C     END OF CONVERSION
C
      PSTART = ESC//'LF'//ASC
      PEND   = ESC//'LG'//ASC
      PANST  = ESC//'LP'//ASC
      PANEND = ESC//'LE'
C
      IF (N .EQ.  3) WRITE (NOUT,1890) PSTART
      IF (IABS(N) .EQ. 2) WRITE (NOUT,1890) PEND
      IF (N .EQ. -3) WRITE (NOUT,1890) PANST
      IF (N .EQ. -2) WRITE (NOUT,1900) PANEND
 1890 FORMAT (1X,A8)
 1900 FORMAT (1X,A3)
      RETURN
      END
C
C     =================================================================
C
      SUBROUTINE PSINIT (NOLINE)
C
C     POSTSCRIPT NEW PLOT ROUTINE
C
C     ON A 8 X 11 (HORIZ X VERT) PAGE, THE ORIGIN IS AT THE LOWER LEFT
C     CONNER. NOW TO CENTER THE PLOT HORIZONTALLY ALONG THE 11 IN. EDGE,
C     MOVE THE ORIGIN 589 UNITS TO THE RIGHT, 116 UNITS UP, AND ROTATE
C     THE PAPER BY 90 DEGREE.
C
      COMMON /PS/ LU,DUMMY(6)
C
      IF (NOLINE .EQ. 0) WRITE (LU,1950)
      WRITE  (LU,1960)
 1950 FORMAT ('%!')
 1960 FORMAT ('589 116 translate', /,'90 rotate')
      RETURN
C
C
      ENTRY PSFINS
C     ============
C
C     CLOSE ROUTINE
C
      WRITE  (LU,1970)
 1970 FORMAT ('showpage')
      RETURN
C
C
      ENTRY PSTRKE
C     ============
C
C     STROKE ROUTINE
C
      WRITE  (LU,1980)
 1980 FORMAT ('stroke')
      RETURN
      END
C
C     =================================================================
C
      SUBROUTINE PSLINE
C
C     POSTSCRIPT LINE ROUTINE
C
      INTEGER     R,S,T,U
      REAL        SCALE
      CHARACTER*7 MT,LT
      COMMON      CMND,CTRL,R,S,T,U
      COMMON /PS/ LU,SCALE,JOUNT,NBUFF,DUMMY(3)
      DATA    MT, LT /' moveto', ' lineto' /
C
      R = R*SCALE
      S = S*SCALE
      T = T*SCALE
      U = U*SCALE
      WRITE  (LU,2000) R,S,MT, T,U,LT
 2000 FORMAT (2I5,A7, /,2I5,A7)
      JOUNT = JOUNT + 1
      IF (JOUNT .LE. NBUFF) RETURN
      CALL PSTRKE
      JOUNT = 0
      RETURN
      END
C
C     =================================================================
C
      SUBROUTINE PSCHAR (CHRSET,CMNDX)
C
C     PUT CHARACTERS INTO ONE STRING IF APPLICABLE. UP TO 70 CHARACTERS.
C
C     IF CMNDS=4 AT 2120 IS REMOVED, NO CHARACTER STRING WILL BE FORMED,
C     AND EACH CHARACTER WILL BE POSITIONED AND TYPED INDIVIDUALLY
C
      IMPLICIT INTEGER (A-Z)
      LOGICAL     CHRSET
      REAL        SCALE,CSCAL
      CHARACTER   CHR94*48,BSS0*2
      CHARACTER*1 SAVE(76),SHOW(6),BS,S0,S2,S3,S5,S6,S7,BS0(2)
      COMMON      CMND,CNTRL,R,S,T
      COMMON /PS/ LU,SCALE,JOUNT,NBUFF,ONCE,CSCAL,CHRPOS
      EQUIVALENCE (BS0(1),BSS0,BS),(BS0(2),S0)
      DATA        SHOW  / ')',' ','s','h','o','w' /
      DATA        BSS0,S2,S3,S5,S6,S7 / '\0','2','3','5','6','7'/
      DATA        CHR94 /
     1           '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ()+-*/=.,$" ' /
C                 000000000111111111122222222223333333333444444444
C                          0         0         0         0       8
C                 49-52 = SPECIAL CHARACTERS
C                 FROM NASTRAN USER NANUAL P. 4.4-5
C
      IF (ONCE .NE. -1) GO TO 2110
      ONCE = 0
      WRITE  (LU,2100) CSCAL
 2100 FORMAT ('/Courier-Bold findfont',F5.1,' scalefont setfont')
C
C     CORRECTION FOR CHARACTER X-Y POSITION.
C     FROM CHARACTER CENTER TO CHARACTER LOWER LEFT CORNER
C
      DELY = 8*T/2 + 1
      DELX = DELY*2/3 + 1
      GO TO 2120
C
 2110 IF (CMNDX .EQ. 14) GO TO 2200
      IF (ONCE  .GT.  0) GO TO 2140
 2120 IF (CHRPOS .EQ. 0) CMNDX = 4
      R  = (R-DELX)*SCALE
      S  = (S-DELY)*SCALE
      WRITE  (LU,2130) R,S
 2130 FORMAT (2I5,' moveto')
      JOUNT = JOUNT + 1
      COUNT = 0
      ONCE  = 1
C
 2140 COUNT = COUNT + 1
      SAVE(COUNT) = SHOW(2)
      IF (CNTRL.GE.49 .AND. CNTRL.LE.52) GO TO 2150
      IF (COUNT.LE.70 .AND. CNTRL.GE.1 .AND. CNTRL.LE.48)
     1    SAVE(COUNT) = CHR94(CNTRL:CNTRL)
      GO TO 2170
C
C     SPECIAL SYMBOLS (USER'S MANUAL P. 4.4-5)
C                 NASTRAN         POSTCSRIPT
C     CNTRL       ORIGINAL        EQUIVALENCE
C     -----     -------------    --------------
C       49      SMALL CIRCLE     BIG SOLID DOT
C       50      SMALL SQUARE     SQUATE-CIRCLE
C       51      SMALL DIAMOND    DAGGER
C       52      SMALL TRIANGLE   DOUBLE-DAGGER
C
C     SINCE THESE SYMBOLS MAY BE PART OF A TEXT, TO ACTUALLY DRAW THESE
C     NASTRAN ORIGINAL SYMBOLS IS NOT RECOMMENDED
C
 2150 IF (COUNT+3 .GT. 70) GO TO 2170
      SAVE(COUNT  ) = BS
      SAVE(COUNT+1) = S2
      SAVE(COUNT+2) = S6
      COUNT = COUNT + 3
      IF (CNTRL .NE. 50) GO TO 2160
      SAVE(COUNT-1) = S5
      SAVE(COUNT  ) = S0
      GO TO 2170
 2160 IF (CNTRL .EQ. 49) SAVE(COUNT) = S7
      IF (CNTRL .EQ. 51) SAVE(COUNT) = S2
      IF (CNTRL .EQ. 52) SAVE(COUNT) = S3
 2170 RETURN
C
C
      ENTRY PSENDC (CHRSET,CMNDX)
C     ===========================
C
 2200 IF (COUNT-1) 2270,2210,2230
 2210 WRITE  (LU,2220) SAVE(1)
 2220 FORMAT (1H(,A1,6H) show)
      GO TO 2260
 2230 DO 2240 J = 1,6
 2240 SAVE(COUNT+J) = SHOW(J)
      COUNT = COUNT + 6
      WRITE  (LU,2250) (SAVE(J),J=1,COUNT)
 2250 FORMAT (1H(,76A1)
 2260 COUNT = 0
      ONCE  = 0
      JOUNT = JOUNT + 1
      IF (JOUNT .LE. NBUFF) GO TO 2270
      CALL PSTRKE
      JOUNT = 0
 2270 IF (CMNDX.EQ.14 .AND. CMND.EQ.4) GO TO 2120
      CHRSET = .FALSE.
      RETURN
      END
C
C     =================================================================
C
C+    SUBROUTINE NASTEK (*,FIL,NR,IBUFF,NBUFF)
C
C     NASTEK - INTERACTIVE DISPLAY OF NASTRAN-GENERATED PLOTS - NOV83
C                                                       REVISED APR86
C
C     NASTEK PLOTS NASTRAN-GENERATED PLT1 OR PLT2 FILES ON TEKTRONIX
C     4010 AND 4050 SERIES TERMINALS, AND RUNS ON VAX-11 COMPUTERS.
C
C     THE USER CAN
C           - PLOT ALL FRAMES SEQUENTIALLY W/AUTOMATIC HARDCOPY OR PLOT
C             ANY FRAME HE CHOOSES
C           - SET A SCALE FACTOR TO SHRINK OR ENLARGE THE PLOTS
C           - DRAW WITH SOLID, DASHED, OR DOTTED LINES IF THE PEN
C             PARAMETER WAS USED IN NASTRAN
C
C     INPUT - THE NASTRAN-GENERATED PLT1 OR PLT2 FILE.
C           - FIVE USER-DEFINED VALUES WHICH ARE INPUT BY THE USER
C             IN RESPONSE TO QUESTIONS ASKED BY NASTEK.
C
C     NASTEK IS WRITTEN IN VAX FORTRAN 77 WITH SUBROUTINES FROM THE
C     TEKTRONIX PLOT-10 TCS AND ADVANCED GRAPHING II PACKAGES.
C
C     VARIABLES
C     CHANGE - CHANGING PLOT OPTION?
C     CHAR   - CHARACTER ARRAY
C     CI     - NASTRAN CONTROL INDEX
C     CSIZE  - CHARACTER SIZE FOR QUESTIONS, NOTES, ETC
C     CURFR  - COUNTER FOR CURRENT FRAME NUMBER IN PLT1 OR PLT2 FILE
C     FR     - USER FRAME NUMBER TO BE PLOTTED
C     IB     - INDEX FOR IBUFF
C     IBUFF  - USED TO READ IN AND UNPACK PLT1 OR PLT2 FILE
C     NBUFF  - LENGTH OF IBUFF ARRAY, EITHER 30 OR 3000
C     LEN2X  - HALF THE WIDTH  OF FRAME IN SCREEN COORDINATES
C     LEN2Y  - HALF THE HEIGHT OF FRAME IN SCREEN COORDINATES
C     MAXFR  - MAXIMUM NUMBER OF FRAMES IN PLT1 OR PLT2 FILE
C     MINX,MINY,MAXX,MAXY,MMINX,MMINY,MMAXX,MMAXY - SCREEN COORDINATES
C     NUM    - STRING OF ASCII NUMBERS USED TO OUTPUT A NUMBER
C     OLDT,OLDU - LAST POSITION DRAWN TO
C     PC     - NASTRAN PLOT COMMAND  0 - NO OPERATION
C                                    1 - START NEW PLOT
C                                  2,3 - NOT USED IN NASTEK
C                                    4 - PRINT A CHARACTER
C                                  5,6 - DRAW A LINE
C     PLOTID - HAS PLOTID FRAME BEEN PLOTTED
C     PLOTOP - PLOT OPTION, 1 CHOOSING, 2 AUTOMATIC
C     FIL    - NASTRAN-GENERATED PLOT FILE, PLT1 OR PLT2
C     NR     - NO. OF PLOT COMMANDS PER FILE RECORD
C            = 5 FOR PLT1, AND 100 FOR PLT2 FILE
C     R,S,T,U,RSTU - NASTRAN COORDINATES
C     RMIN,SMIN,RMAX,SMAX - NASTRAN COORDINATES
C     SCALE  - SCALE FACTOR > 0
C     SEARCH - SEARCHING FOR A FRAME?
C     SIZE   - CHARACTER SIZE ON PLOTS
C     SYM    - SYMBOL SIZES IN NASTRAN COORDINATES
C     TERMT  - TERMINAL TYPE
C     XCEN,YCEN - CENTER OF FRAME IN SCREEN COORDINATES
C     XCS,YCS   - 1/2 WIDTH AND HEIGHT FOR CHARACTER IN NASTRAN
C              COORDINATES USED TO MOVE THE CHARACTERS DOWN AND TO THE
C              LEFT SO THAT THEY ARE CENTERED WRT THE NASTRAN COORDINATE
C              GIVING THEIR LOCATION
C     XFAC,YFAC - SCALE FACTORS FOR CHARACTER SIZE DEPENDING ON USER
C              SCALE FACTOR
C
C     WRITTEN BY: ROBERT LIPMAN
C                 DAVID TAYLOR NAVAL SHIP RESEARCH AND DEVELOPMENT
C                 CENTER, NUMERICAL STRUCTURAL MECHANICS BRANCH
C                 CODE 1844
C                 BETHESDA, MARYLAND  20084-5000
C                 (202)-227-1922
C
C     MODIFIED BY G.CHAN/UNISYS IN AREAS WHERE PLOT COMMANDS ARE READ
C     OFF PLT1 OR PLT2 FILE, IN DECODING THE COMMANDS, AND IN REPLACING
C     THE IF-THEN-ELSE-ENDIF STUFFS BY THE OLD STYLE SIMPLE 'IF' FORTRAN
C     THE FANZY IF-THEN-ELSE-ENDIF STUFFS ARE EASY ONLY TO THE ORIGINAL
C     DEVELOPER, AND IS VERY HARD FOR ANOTHER READER TO FOLLOW. UPDATING
C     THE PROGRAM BECOMES VERY DIFFICULT.  3/93
C
C+    LOGICAL        SEARCH,CHANGE,PLOTID
C+    INTEGER        IBUFF(NBUFF),PC,CI,PLOTOP,FR,CURFR,PLTX,PLT1,PLT2,
C+   1               FIL,XCEN,YCEN,CSIZE,TERMT
C+    REAL           RSTU(4),CHAR(48)
C+    COMMON /FRAME/ MMINX,MMINY,MMAXY,MMAXX,RSTU,SCALE,CURFR,
C+   1               XCEN,YCEN,RMIN,RMAX,SMIN,SMAX,TERMT,XCS,YCS,
C+   2               SYM1,SYM2,SYM3,SYM7,CSIZE
C+    EQUIVALENCE    (RSTU(1),R),(RSTU(2),S),(RSTU(3),T),(RSTU(4),U),
C+   1               (NO,CHAR(24))
C+    DATA    CHAR /
C+   1               1H0, 1H1, 1H2, 1H3, 1H4, 1H5, 1H6, 1H7, 1H8, 1H9,
C+   2               1HA, 1HB, 1HC, 1HD, 1HE, 1HF, 1HG, 1HH, 1HI, 1HJ,
C+   3               1HK, 1HL, 1HM, 1HN, 1HO, 1HP, 1HQ, 1HR, 1HS, 1HT,
C+   4               1HU, 1HV, 1HW, 1HX, 1HY, 1HZ, 1H(, 1H), 1H+, 1H-,
C+   5               1H*, 1H/, 1H=, 1H., 1H,, 1H$, 1H', 1H   /
C+    DATA    NOUT , IN / 6,5/,  PLT1,PLT2,NN / 4HPLT1, 4HPLT2, 1Hn  /
C
C+    PLTX = PLT1
C+    IF (NR .EQ. 100) PLTX = PLT2
C+    NCOM = NBUFF/NR
C
C     INITIALIZE THE TERMINAL
C
C+ 10 WRITE  (NOUT,20)
C+ 20 FORMAT (/,' ENTER THE TERMINAL BAUD RATE? ',$)
C+    READ (IN,30,ERR=10) IBAUD
C+ 30 FORMAT (I5)
C+    IF (IBAUD.NE.300  .AND. IBAUD.NE.1200 .AND. IBAUD.NE.4800 .AND.
C+   1    IBAUD.NE.9600 .AND. IBAUD.NE.109200) GO TO 10
C+    CALL INITT (IBAUD/10)
C+    CALL TERM  (3,4096)
C
C     INITIALIZE SOME VARIABLES
C
C+    CHANGE =.FALSE.
C+    OLDT   = 1.E30
C+    OLDU   = 1.E30
C
C     SET MAXIMUM SIZE OF FRAME IN SCREEN COORDINATES
C     3014/3900 = 8.5/11
C
C+    MMINX = 0
C+    MMINY = 0
C+    MMAXX = 3900
C+    MMAXY = 3014
C+    XCEN  = (MMAXX + MMINX)/2
C+    YCEN  = (MMAXY + MMINY)/2
C
C     START OUTPUT
C
C+    CALL CHRSIZ (4)
C+    TERMT = 0
C+ 40 CALL NEWPAG
C+    IF (TERMT .NE. 0) CALL CHRSIZ (CSIZE)
C+    CALL ANMODE
C
C     PRINT SOME NOTES
C
C+    IF (TERMT .NE. 0) GO TO 80
C
C     INSERT NOTES HERE
C
C     GET TERMINAL TYPE FROM USER
C
C+ 50 WRITE  (NOUT,60)
C+ 60 FORMAT (/,' ENTER THE TEKTRONIX TERMINAL TYPE', /,
C+   1           ' 1 - 4014, 4015, 4054', /,
C+   2           ' 2 - 4016', /,
C+   3           ' 3 - 4010, 4012, 4013, 4051, 4052', /,' ? ',$)
C+    READ (IN,70,ERR=50) TERMT
C+ 70 FORMAT (I1)
C+    IF (TERMT.EQ.0 .OR. TERMT.GE.4) GO TO 50
C+    IF (TERMT .EQ. 1) CSIZE = 4
C+    IF (TERMT .EQ. 2) CSIZE = 3
C+    IF (TERMT .EQ. 3) CSIZE = 1
C+    IF (TERMT .LE. 2) CALL CHRSIZ (CSIZE)
C
C+ 80 REWIND FIL
C+    IB     = NBUFF
C+    CURFR  =-1
C+    MAXFR  = 100000
C+    PLOTID = .FALSE.
C+    SEARCH = .TRUE.
C+    FR     = 0
C
C     GET PLOTTING OPTION FROM USER
C
C+ 90 WRITE  (NOUT,100)
C+100 FORMAT (/,' ENTER A PLOTTING OPTION', /,
C+   1          ' 1 - PLOT ANY FRAME OF YOUR CHOICE', /,
C+   2          ' 2 - PLOT AUTOMATICALLY, ALL FRAMES SEQUENTIALLY WITH',
C+   3          ' HARDCOPY', /,' ? ',$)
C+    READ (IN,70,ERR=90) PLOTOP
C+    IF (PLOTOP.NE.1 .AND. PLOTOP.NE.2) GO TO 90
C
C     PRINT NOTES
C
C+    IF (PLOTOP .EQ. 1) WRITE (NOUT,110)
C+110 FORMAT (/,' NOTE - WHEN ASKED ''PLOT FRAME NUMBER ?'' ENTER',
C+   1        /9X,'ANY FRAME NUMBER TO PLOT THAT FRAME OR',
C+   2        /9X,' 0 TO PLOT THE NEXT FRAME, OR',
C+   3        /8X,'-1 TO RESTART NASTEK, OR',
C+   4        /8X,'-2 TO END NASTPLOT')
C+    IF (PLOTOP .EQ. 2) WRITE (NOUT,120)
C+120 FORMAT (/' NOTE - AFTER ALL FRAMES ARE PLOTTED THE PROGRAM',
C+   1        /8X,'WILL ASK ''RESTART NASTPLOT (Y/N) ?''')
C
C     GET SCALE FACTOR FROM USER
C
C+130 WRITE  (NOUT,140)
C+140 FORMAT (/' ENTER A SCALE FACTOR (SCALE>0)',
C+   1        /' =1 NORMAL',
C+   2        /' >1 ENLARGE ALL FRAMES',
C+   3        /' <1 SHRINK ALL FRAMES',/,' ? ',$)
C+    READ (IN,150,ERR=130) SCALE
C+150 FORMAT (F7.3)
C+    IF (SCALE.LT.0.01 .OR. SCALE.GT.999.) GO TO 130
C
C     BRANCH DEPENDING ON IF RESTARTED AND PLOT OPTION
C
C+    IF (.NOT.CHANGE) GO TO 160
C+    CHANGE = .FALSE.
C+    IF (PLOTOP .EQ. 1) GO TO 340
C
C     READ PLT1 OR PLT2 FILE AND UNPACK ONE RECORD WITH NR COMMNADS
C
C+160 IF (IB .LE. NBUFF) GO TO 280
C+    IB = 1 - NCOM
C+    READ (FIL,170,END=180,ERR=260) IBUFF
C+170 FORMAT (3000A1)
C+    GO TO 280
C
C     EOF FOUND ON PLOT FILE, REWIND IT IF NOT EMPTY
C
C+180 IF (MAXFR .EQ. 100000) MAXFR = CURFR
C+    IF (MAXFR .NE. -1) GO TO 200
C+    WRITE  (NOUT,190) PLTX
C+190 FORMAT (/,' *ERROR*  THIS IS NOT A ',A4,' FILE, TRY AGAIN')
C+    RETURN 1
C
C+200 REWIND FIL
C+    CURFR = -1
C+    IB    = NBUFF
C
C     EOF ON PLOT FILE, PLOTOP=1 AND SEARCHING THEN FRAME NOT FOUND,
C     TRY AGAIN
C
C+    IF (PLOTOP .EQ. 2) GO TO 220
C+    IF (.NOT.SEARCH) GO TO 340
C+    SEARCH = .FALSE.
C+    WRITE  (NOUT,210) MAXFR
C+210 FORMAT (25X,'MAXIMUM FRAME NUMBER IS',I4,', TRY AGAIN')
C+    GO TO 340
C
C     EOF ON PLOT FILE, PLOTOP=2, OPTION TO RESTART NASTPLOT
C
C+220 CALL BELL
C+    CALL HDCOPY
C+    CALL MOVABS (0,3120)
C+    IF (TERMT .LE. 2) CALL CHRSIZ (CSIZE)
C+    CALL ANMODE
C+230 WRITE  (NOUT,240)
C+240 FORMAT (' RESTART NASTPLOT (Y/N) ? ',$)
C+    READ   (IN,250,ERR=230) NY
C+250 FORMAT (A1)
C+    IF (NY.EQ.NO .OR. NY.EQ.NN) GO TO 500
C+    GO TO 40
C
C     ERROR WHILE READING PLT1 OR PLT2 FILE
C
C+260 WRITE  (NOUT,270) PLTX
C+270 FORMAT (/' *ERROR*  READING ',A4,'  FILE')
C+    GO TO 500
C
C     GET A PLOT COMMAND AND DECIDE IF ITS OK
C
C+280 IB = IB + NCOM
C+    PC = IBUFF(IB)
C+    IF (PC.LE.0 .OR. PC.GE.17 .OR. (PC.NE.1.AND.SEARCH)) GO TO 160
C
C     GET CONTROL INDEX, RSTU
C
C+    CI = IBUFF(IB+1)
C+    IF (PLTX .EQ. PLT1) GO TO 310
C+    J1 = 3
C+    DO 300 I = 1,4
C+    J2 = J1 + 4
C+    RSTU(I) = 0.0
C+    DO 290 J = J1,J2
C+    RSTU(I) = RSTU(I)*10. + IBUFF(J+IB)
C+290 CONTINUE
C+300 J1 = J1 + 5
C+    GO TO 320
C
C+310 R = IBUFF(IB+2)
C+    S = IBUFF(IB+3)
C+    T = IBUFF(IB+4)
C+    U = IBUFF(IB+5)
C
C     BRANCH ON A PLOT COMMAND
C
C+320 GO TO (330,160,160,430,490,490,160,160,160,160,
C+   1       160,160,160,430,490,490,500), PC
C
C     START OF A NEW PLOT IN PLOT FILE
C
C+330 CURFR = CURFR + 1
C
C     IF SEARCHING FOR A FRAME, HAVE WE FOUND IT?
C
C+    IF (.NOT.SEARCH) GO TO 340
C
C     FRAME HAS BEEN FOUND, START PLOTTING, PLOTID FRAME IS PLOTTED ONCE
C     IF FRAME NOT FOUND, GO TO 40
C
C+    IF (CURFR .NE. FR) GO TO 160
C+    SEARCH = .FALSE.
C+    IF (CURFR .NE. 0) GO TO 420
C+    IF (PLOTID) GO TO 340
C+    PLOTID =.TRUE.
C+    GO TO 420
C
C     NOT SEARCHING FOR A FRAME, PREVIOUS PLOT IS FINISHED
C     PLOTOP=1, GET FRAME NUMBER FROM USER
C
C+340 IF (PLOTOP .EQ. 2) GO TO 410
C+    CALL BELL
C+    CALL MOVABS (0,3120)
C+    IF (TERMT .LE. 2) CALL CHRSIZ (CSIZE)
C+350 CALL ANMODE
C+    WRITE  (NOUT,360)
C+360 FORMAT (' PLOT FRAME NUMBER ? ',$)
C+    READ (IN,370,ERR=350) FR
C+370 FORMAT (I2)
C+    IF (FR.EQ.0 .AND. CURFR.EQ.-1) FR = 1
C+    IF (.NOT.(FR.LT.-2 .OR. FR.GT.MAXFR)) GO TO 390
C+    WRITE  (NOUT,380)
C+380 FORMAT (' TRY AGAIN')
C+    CALL BELL
C+    GO TO 350
C
C     BRANCH DEPENDING ON NEW FRAME NUMBER
C     -1 - RESTART NASTEK
C     -2 - END NASTEK
C      0 OR CURRENT FRAME NUMBER - PLOT THAT FRAME
C     ELSE SEARCH FOR THE FRAME
C
C+390 IF (FR .EQ.  0) FR = CURFR
C+    IF (FR .NE. -1) GO TO 400
C+    CHANGE = .TRUE.
C+    GO TO 40
C+400 IF (FR .EQ. -2) GO TO 500
C+    IF (FR .EQ. CURFR) GO TO 420
C+    SEARCH =.TRUE.
C+    IF (FR .GE. CURFR) GO TO 160
C+    CURFR = -1
C+    REWIND FIL
C+    IB = 1 - NCOM
C+    GO TO 160
C
C     PLOTOP = 2, MAKE HARDCOPY
C
C+410 CALL BELL
C+    CALL HDCOPY
C
C     START PLOTTING A FRAME BY DRAWING A BOX
C
C+420 CONTINUE
C+    CALL PFRAME
C+    GO TO 160
C
C     PRINT A CHARACTER OR SYMBOL BASED ON THE CONTROL INDEX,
C     DON'T PRINT IT IF IT IS OUTSIDE THE BOX
C
C+430 IF (CI.LT.1 .OR. CI.GT.48) GO TO 440
C+    R = R - XCS
C+    S = S - YCS
C+    IF (R.LT.RMIN .OR. R.GT.RMAX .OR. S.LT.SMIN .OR. S.GT.SMAX)
C+   1    GO TO 160
C+    CALL MOVEA (R,S)
C+    CALL A1OUT (1,CHAR(CI))
C+440 IF (CI .GT. 52) GO TO 160
C+    IF (R.LT.RMIN .OR. R.GT.RMAX .OR. S.LT.SMIN .OR. S.GT.SMAX)
C+   1    GO TO 160
C+    CALL MOVEA (R,S)
C+    IF (CI-50) 450,460,470
C
C     CIRCLE SYMBOL
C
C+450 CALL MOVER (-SYM1,   0.)
C+    CALL DRAWR ( SYM3, SYM7)
C+    CALL DRAWR ( SYM7, SYM3)
C+    CALL DRAWR ( SYM7,-SYM3)
C+    CALL DRAWR ( SYM3,-SYM7)
C+    CALL DRAWR (-SYM3,-SYM7)
C+    CALL DRAWR (-SYM7,-SYM3)
C+    CALL DRAWR (-SYM7, SYM3)
C+    CALL DRAWR (-SYM3, SYM7)
C+    GO TO 160
C
C     SQUARE SYMBOL
C
C+460 CALL MOVER (-SYM1, SYM1)
C+    CALL DRAWR ( SYM2,   0.)
C+    CALL DRAWR (   0.,-SYM2)
C+    CALL DRAWR (-SYM2,   0.)
C+    CALL DRAWR (   0., SYM2)
C+    GO TO 160
C
C     DIAMOND SYMBOL
C
C+470 IF (CI .EQ. 52) GO TO 480
C+    CALL MOVER (   0., SYM1)
C+    CALL DRAWR ( SYM1,-SYM1)
C+    CALL DRAWR (-SYM1,-SYM1)
C+    CALL DRAWR (-SYM1, SYM1)
C+    CALL DRAWR ( SYM1, SYM1)
C+    GO TO 160
C
C     TRIANGLE SYMBOL
C
C+480 CALL MOVER (   0., SYM1)
C+    CALL DRAWR ( SYM1,-SYM2)
C+    CALL DRAWR (-SYM2,   0.)
C+    CALL DRAWR ( SYM1, SYM2)
C+    GO TO 160
C
C     DRAW LINE DEPENDING ON CONTROL INDEX, NO MOVE IF OLD END IS NEW
C     START
C     CI = 1, SOLID,      PEN 1
C        = 2, DOTTED,     PEN 2
C        = 3, DASH-DOT,   PEN 3
C        = 4, SHORT-DASH, PEN 4
C        = 5, LONG-DASH,  PEN 5
C
C+490 IF (CI.LT.1 .OR. CI.GT.5) CI = 1
C+    IF (OLDT.NE.R .OR. OLDU.NE.S) CALL MOVEA (R,S)
C+    CALL DASHA (T,U,CI-1)
C+    OLDT = T
C+    OLDU = U
C+    GO TO 160
C
C     JOB DONE
C
C+500 RETURN
C+    END
C
C     =================================================================
C
C+     SUBROUTINE PFRAME
C
C     THIS ROUTINE IS CALLED ONLY BY NASTEK
C
C     GIVEN THE NASTRAN SIZE OF THE FRAME (S,T), FIT A FRAME ON THE
C     TEKTRONIX SCREEN AND DRAW A BOX AROUND IT
C
C+    INTEGER        CURFR,XCEN,YCEN,NUM(4),SIZE,TERMT
C+    REAL           RSTU(4),XFAC(4),YFAC(4)
C+    COMMON /FRAME/ MMINX,MMINY,MMAXY,MMAXX,RSTU,SCALE,CURFR,
C+   1               XCEN,YCEN,RMIN,RMAX,SMIN,SMAX,TERMT,XCS,YCS,
C+   2               SYM1,SYM2,SYM3,SYM7,CSIZE
C+    EQUIVALENCE    (RSTU(1),R),(RSTU(2),S),(RSTU(3),T),(RSTU(4),U)
C+    DATA    XFAC / 1.9 ,1.64,1.1 ,1./
C+    DATA    YFAC / 1.94,1.68,1.12,1./
C
C     (1) FIND SIZE OF STANDARD BOX
C
C+    MINX = MMINX
C+    MINY = MMINY
C+    MAXY = MMAXY
C+    IF (T .NE. 0.) GO TO 10
C+    WRITE (NOUT,15) S,T
C+    GO TO 120
C+ 10 MAXX = MINX + MAXY*(S/T)
C+    IF (MAXX .LE. MMAXX) GO TO 30
C+    MAXX = MMAXX
C+    IF (S .NE. 0.) GO TO 20
C+    WRITE  (NOUT,15) S,T
C+ 15 FORMAT (/,' *ERROR*  EITHER S=0 OR T=0',2(1P,E9.2))
C+    GO TO 120
C+ 20 MAXY  = MAXX*(T/S)
C+ 30 LEN2X = (MAXX-MINX)/2
C+    LEN2Y = (MAXY-MINY)/2
C
C     (2) SCALE AND CENTER THE BOX
C
C+    IF (SCALE.GT.1. .AND. CURFR.NE.0) GO TO 40
C+    TEMP = 1.
C+    IF (CURFR .NE. 0) TEMP = SCALE
C+    MINX = XCEN - LEN2X*TEMP
C+    MAXX = XCEN + LEN2X*TEMP
C+    MINY = YCEN - LEN2Y*TEMP
C+    MAXY = YCEN + LEN2Y*TEMP
C+    RMIN = 0.
C+    RMAX = S
C+    SMIN = 0.
C+    SMAX = T
C+    GO TO 50
C+ 40 IF (SCALE .LE. 1.) GO TO 50
C+    MINX = XCEN - LEN2X
C+    MAXX = XCEN + LEN2X
C+    MINY = YCEN - LEN2Y
C+    MAXY = YCEN + LEN2Y
C+    RMIN = S*(1.-1./SCALE)/2.
C+    RMAX = S*(1.+1./SCALE)/2.
C+    SMIN = T*(1.-1./SCALE)/2.
C+    SMAX = T*(1.+1./SCALE)/2.
C
C     (3) DRAW A BOX AROUND THE FRAME, AND SET SCREEN AND VIRTUAL WINDOW
C
C+ 50 CALL ANMODE
C+    CALL NEWPAG
C+    IF (.NOT.(MAXX.LE.MINX .OR. MAXY.LE.MINY .OR. RMAX.LE.RMIN .OR.
C+   1    SMAX.LE.SMIN)) GO TO 60
C+    CALL ANMODE
C+    WRITE  (NOUT,55) MINX,MAXX,MINY,MAXY,RMIN,RMAX,SMIN,SMAX
C+ 55 FORMAT (/,' *ERROR*  SOME OF THE MINS>=MAXS',/4I9,/4(1P,E9.3))
C+ 60 IF (MAXX .NE. MINX) GO TO 70
C+    CALL ANMODE
C+    WRITE  (NOUT,65) MAXX,MINX
C+ 65 FORMAT (/,' *ERROR*  MAXX=MINX',2I6)
C+    GO TO 120
C+ 70 CALL DWINDO (RMIN,RMAX,SMIN,SMAX)
C+    CALL TWINDO (MINX,MAXX,MINY,MAXY)
C+    CALL MOVABS (MINX,MINY)
C+    CALL DRWABS (MINX,MAXY)
C+    CALL DRWABS (MAXX,MAXY)
C+    CALL DRWABS (MAXX,MINY)
C+    CALL DRWABS (MINX,MINY)
C
C     (4) PRINT THE FRAME NUMBER AND SCALE IN THE LOWER RIGHT CORNER
C
C     CSIZE = 1,2,3,4
C
C+    IY = 75
C+    IF (TERMT .GT. 2) GO TO 80
C+    CALL CHRSIZ (CSIZE)
C+    IY = 40
C
C+ 80 FCURFR = CURFR
C+    CALL IFORM  (FCURFR,4,NUM,32)
C+    CALL MOVABS (MAXX+15,MINY+IY)
C+    CALL ANSTR  (4,NUM)
C
C+    ND = 0
C+    IF (SCALE .LT. 10.0) ND = 2
C+    IF (SCALE .LT. 100.) ND = 1
C+    CALL FFORM  (SCALE,4,ND,NUM,32)
C+    CALL MOVABS (MAXX+15,MINY)
C+    CALL ANSTR  (4,NUM)
C
C     (5) FIND CHARACTER SIZE IN NASTRAN COORDINATES
C
C     THE NASTRAN COORDINATES FROM THE PLOT FILE ARE THE LOCATIONS
C     OF THE CENTER OF A CHARACTER. HALF THE WIDTH AND HEIGHT
C     (XCS,YCS) OF THE SIZE OF A CHARACTER MUST BE SUBTRACTED FROM
C     THE NASTRAN COORDINATES TO PRINT THEM IN THE PROPER LOCATION.
C
C+    XCS = 7.7*(RMAX-RMIN)/(MAXX-MINX)
C+    YCS = 1.8*XCS
C
C     SET SYMBOL SIZE
C
C+    SYM1 = YCS*SCALE
C+    SYM2 = 2.0*YCS*SCALE
C+    SYM3 = 0.3*YCS*SCALE
C+    SYM7 = 0.7*YCS*SCALE
C
C     SET AND SCALE CHARACTER SIZE
C
C+    SIZE = 1
C+    IF (TERMT .GT. 2) GO TO 90
C+    IF (SCALE.LT.1.1 .OR. CURFR.EQ.0) SIZE = 4
C+    IF (SCALE .LT. 1.7)  SIZE = 3
C+    IF (SCALE .LT. 1.8)  SIZE = 2
C+    IF (TERMT.EQ.2 .AND. SIZE.EQ.4) SIZE = 3
C+    CALL CHRSIZ (SIZE)
C+ 90 XCS = XCS*XFAC(SIZE)
C+    YCS = YCS*YFAC(SIZE)
C+    IF (CURFR .NE. 0) GO TO 100
C+    XCS = -XCS
C+    YCS = -YCS
C
C+100 RETURN
C
C     ERROR
C
C+120 STOP 'ERROR IN PFRAME/NASTEK/NASTPLOT'
C+    END


text:
! This routine solves the linear system A X = B using the SVD technique
! The diagonal elements of the covariance matrix are returned in B
!
Subroutine SVD_solve(NP, SVD_threshold, A, B, X, Zeroed)
  USE nr
  USE Debug_module
  Implicit None
  Integer :: NP, i_param, j_param
  Real, Dimension (NP) :: X, B
  Real, Dimension (NP,NP) :: A
  Real(kind=8), Dimension (NP) :: Xdp, Bdp, W
  Real(kind=8), Dimension (NP,NP) :: Adp, V
  Logical, Dimension (NP) :: Zeroed
  Real :: Wmax, SVD_threshold
!
  Adp=A
  Bdp=B
  Call SVDcmp(Adp, W, V)
  If (Debug_errorflags(flag_svdcmp) .ge. 1) then
     X(:)=0.
     Call Debug_Log('Error in svdcmp... returning from SVD_solve with X=0',2)
     Return
  End if
  Wmax=Maxval(W)
  Zeroed(1:NP)=.FALSE.
  Do i_param=1, NP
     If (W(i_param) .lt. SVD_threshold*Wmax) then
        W(i_param)=0.
        Zeroed(i_param)=.TRUE.
     End if
  End do
  Call SVBKSB(Adp, W, V, Bdp, Xdp)
  B=Bdp
  X=Xdp
  A=Adp
  B(1:NP)=0.
  Do i_param=1, NP
     Do j_param=1, NP
        If (.not. Zeroed(j_param)) Then
           If (Abs(V(i_param,j_param)) .gt. .1) then
!          If there is a significant contribution from this w(j_param) to
!          the B(i_param), then add it.
!        Numerical recipes formula
!              B(i_param)=B(i_param)+V(i_param,j_param)*V(i_param,j_param)/ &
!                   (W(j_param)*W(j_param))
!        Diagonal of A^-1 calculated from A=UWV^t => A^-1=V(1/w)U^t
              B(i_param)=B(i_param)+&
                   V(i_param, j_param)*A(i_param, j_param)/W(j_param)
           End if
        Else
!          If there is a significant contribution from a zeroed eigenvalue
!          to the B(i_param), then make it infinity.
           If (Abs(V(i_param,j_param)) .gt. .1) &
                B(i_param)=100.
        End if
     End do
  End do
!  B(1:NP)=Sqrt(B(1:NP))
  Return
!
End Subroutine SVD_solve

max_stars_repo_name: aasensio/DeepLearning

max_issues_repo_name: aasensio/DeepLearning

max_forks_repo_name: aasensio/DeepLearning


text:
module default_btp_factory_module
    use :: util_api, only : &
            string, &
            dictionary, &
            add_prefix_to_priorities

    use :: tensor_permute_api, only : &
            tensor_permute_factory

    use :: batched_tensor_permute_dev, only : &
            btp_factory, &
            batched_tensor_permute, &
            simple_loops_btp_driver

    implicit none
    private

    public :: default_btp_factory

    type, extends(btp_factory) :: default_btp_factory
    contains
        procedure :: create_from_key => create_from_key
        procedure :: get_available_btp_drivers => get_available_btp_drivers
        procedure :: build => build
        procedure, private :: count_available_drivers => count_available_drivers
    end type default_btp_factory

    character(len=*), parameter :: btp_driver_key = "btp_driver"
    character(len=*), parameter :: default_btp_driver = "simple_loops"
    character(len=*), parameter :: prefix = "btp-"
contains
    subroutine build(this, btp, options, priorities)
        class(default_btp_factory), intent(in) :: this
        class(batched_tensor_permute), intent(inout) :: btp
        type(dictionary), intent(in), optional :: options
        type(string), dimension(:), intent(in), optional :: priorities

        type(string), dimension(:), allocatable :: local_priorities

        local_priorities = add_prefix_to_priorities(prefix, priorities)

        select type (btp)
        type is (simple_loops_btp_driver)
            call tensor_permute_factory%create(btp%driver, options=options, priorities=local_priorities)
        class default
            error stop "default_btp_factory::build:Unknown btp implementation."
        end select
    end subroutine build

    subroutine create_from_key(this, btp, key)
        class(default_btp_factory), intent(in) :: this
        class(batched_tensor_permute), allocatable, intent(inout) :: btp
        type(string), intent(in) :: key

        select case (key%char_array)
        case ("simple_loops")
            btp = simple_loops_btp_driver()
        case default
            error stop "default_btp_factory::create_from_key:Not a valid btp driver: "//key%char_array
        end select
    end subroutine create_from_key

    function get_available_btp_drivers(this) result(drivers)
        class(default_btp_factory), intent(in) :: this
        type(string), dimension(:), allocatable :: drivers

        allocate(drivers(this%count_available_drivers()))

        drivers(1) = "simple_loops"
    end function get_available_btp_drivers

    integer function count_available_drivers(this)
        class(default_btp_factory), intent(in) :: this

        count_available_drivers = 1
    end function count_available_drivers
end module default_btp_factory_module

max_stars_repo_name: cheshyre/ntcl-algorithms

max_issues_repo_name: cheshyre/ntcl-algorithms

max_forks_repo_name: cheshyre/ntcl-algorithms


text:
      SUBROUTINE CPYIAR (SIZE,FROM,TO)

C  CPYIAR copies the contents of an array of a given size to
C  another array.

C  Input parameters:
C    SIZE : number of elements to copy
C    TO   : source array
C  Output parameter:
C    FROM : destination array

      INTEGER   SIZE,I
      REAL      FROM(*), TO(*)

      DO 100 I = 1, SIZE
        TO(I) = FROM(I)
100   CONTINUE
      END

ext: f


text:
		     Using MPI FFTW from Fortran

FFTW 2.1.3 contains *experimental* wrapper functions for calling the
MPI FFTW routines from Fortran.  We are interested in feedback on the
wrapper interface, as well as on whether or not these routines work
for you.  The interface may change in future releases.

You should first read the "Calling FFTW from Fortran" section of the
FFTW manual, as most of what is said there also applies here.  You
should also read the "MPI FFTW" section of the manual.

Wrapper routines:

The wrapper routines have the same names as the corresponding FFTW
routines, but prefixed with "fftw_f77" or "rfftw_f77"
(e.g. fftw_f77_mpi_create_plan).  The parameters are the same, with
the following exceptions:

1) The caveats described in "Calling FFTW from Fortran" hold here as
well; e.g. function return values become the first parameter.

2) The MPI transform routines take a "work" parameter, which can be
NULL in C.  Since there is no way to pass NULL from Fortran, the work
parameter is followed by an *extra* parameter, use_work, which should
be either 0 or 1.  If use_work is 0, then the work parameter is
ignored (just like passing NULL in C), and if use_work is 1, the work
parameter should be an array of the same size as the local data (just
like when work is non-NULL in C).

3) Use the following definitions:

      integer FFTW_TRANSPOSED_ORDER, FFTW_NORMAL_ORDER
      parameter(FFTW_TRANSPOSED_ORDER=1, FFTW_NORMAL_ORDER=0)

      integer FFTW_SCRAMBLED_INPUT, FFTW_SCRAMBLED_OUTPUT
      parameter(FFTW_SCRAMBLED_INPUT=8192)
      parameter(FFTW_SCRAMBLED_OUTPUT=16384)

MPI Communicator Parameters:

It's not clear how one passes MPI_Comm parameters from Fortran to C.
Your feedback on how this can be done in various MPI implementations
would be appreciated--especially ways for the configure script to
automatically detect how it is being done.

MPICH, for example, has an MPI_Comm_f2c macro that is used to convert
between the two representations--the configure script detects this and
uses it if available.

Otherwise, we currently ignore the comm parameter and use a default of
MPI_COMM_WORLD.

Allocating Arrays:

Just as in C, you have to call FFTW at runtime to find out the portion
of the array local to each process (using fftw_f77_mpi_local_sizes,
etcetera).  This means, however, that you have to allocate your data
(and work) arrays dynamically.  There are a few options for doing this:

1) Use Fortran 90, which allows dynamically-allocated arrays.

2) Use a "compile-twice" scheme: Run the program once to get & output
the local size by calling the *_mpi_local_sizes routine.  Then,
substitute this value into the array declaration and recompile.  Since
the local size may be different on different processors, and you only
compile one executable, you will need to take the maximum of the local
sizes when declaring the array.

3) Use C.

max_stars_repo_name: albertsgrc/ftdock-opt

max_issues_repo_name: albertsgrc/ftdock-opt

max_forks_repo_name: albertsgrc/ftdock-opt