C
C ====================================================================
C ======================= C O M P R O ================================
C ====================================================================
C
      SUBROUTINE COMPRO(BUFFER,BUFF,COMM,NEXT,K)
      IMPLICIT NONE
      CHARACTER*80 BUFFER,BUFF
      CHARACTER HT,CURRCHAR,NEXTCHAR,EOF
      CHARACTER*4 COMM
      INTEGER STR$FIND_FIRST_IN_SET,STR$FIND_FIRST_NOT_IN_SET
      INTEGER IBEGIN,ICOMM2,ICONT,INB,INE,INUMB,ISPACE,ISTART,K,NEXT
C
C =========================================================================
C I   NOTE: THIS COMMAND LINE INTERPERTER ASSUMES THAT COMMAND NAMES DO   I
C I   NOT CONTAIN ANY OF THE FOLLOWING CHARACTERS '.,+-0123456789'.       I
C I   REAL NUMBERS CAN BE ENTERED USING AN 'F' OR 'E' FORMAT WITH         I
C I   "D" OR "E" EXPONENT NOTATION. COMMANDS MUST BE SEPERATED FROM       I
C I   THEIR NUMERIC ARGUMENTS WITH WHITE SPACE (I.E. BLANK SPACE OR       I
C I   TAB CHARACTER). NUMERIC ARGUMENTS CAN BE SEPERATED BY WHITE         I
C I   SPACE OR COMMA. ADDITIONALLY COMMANDS MUST BE SEPERATED FROM        I
C I   PREVIOUS COMMAND W/ W/O ARGUMENTS WITH WHITE SPACE.                 I
C I   SPECIAL NOTE: COMMANDS THAT DO NOT HAVE NUMERIC ARGUMENTS CANNOT    I
C I   BE FOLLOWED BY ADDITIONAL COMMENTS UNLESS CONCATANATED WITH THE     I
C I   THE COMMAND WITH SOME CHARACTER THAT WILL NOT LEAVE WHITE SPACE     I
C I   BETWEEN THE COMMAND AND THE COMMENTS (E.G. THE UNDERSCORE)          I
C =========================================================================
C
      HT=CHAR(9)
      EOF=CHAR(26)
      NEXT=0
      COMM=' '
      IBEGIN=STR$FIND_FIRST_NOT_IN_SET(BUFFER(K:),' '//HT)
      IF(IBEGIN.EQ.0) THEN                       ! BLANK LINE
        COMM='BLAN'
        RETURN
      ENDIF
      IF(BUFFER(IBEGIN:IBEGIN).EQ.EOF) THEN      ! End of File
        COMM='ENDF'
        RETURN
      ENDIF
      ISTART=K+IBEGIN-1
      ISPACE=STR$FIND_FIRST_IN_SET(BUFFER(ISTART:),' '//HT)
      IF(ISPACE.EQ.0) THEN
        COMM=BUFFER(ISTART:)
        RETURN ! COMMAND W/O ARG AT EOL
      ENDIF
      ISPACE=ISTART+ISPACE-1
      COMM=BUFFER(ISTART:ISPACE)
      ICOMM2=STR$FIND_FIRST_NOT_IN_SET(BUFFER(ISPACE:),' '//HT)
      IF(ICOMM2.EQ.0) RETURN ! COMMAND W/O ARG AT EOL
      ICOMM2=ICOMM2+ISPACE-1
      K=ICOMM2
      BUFF=BUFFER(ICOMM2:)
      CURRCHAR=BUFFER(ICOMM2:ICOMM2)
      INUMB=STR$FIND_FIRST_IN_SET(CURRCHAR,'+-.,0123456789')
      IF(INUMB.EQ.0) THEN ! PERFORM FURTHER PARSING IN ROUTINES INPUT & GRAPHIX
        NEXT=1
        RETURN
      ELSE
        INB=ICOMM2
100     INE=STR$FIND_FIRST_NOT_IN_SET(BUFFER(INB:),
     .                                 ' ,.+-0123456789'//HT)
        IF(INE.EQ.0) RETURN          ! NOTHING FOLLOWS CMD W/ NUM ARGUMENT
        INB=INB+INE
        CURRCHAR=BUFFER(INB-1:INB-1)
        NEXTCHAR=BUFFER(INB:INB)
        ICONT=STR$FIND_FIRST_IN_SET(NEXTCHAR,'+-0123456789')
        IF((CURRCHAR .EQ. 'D' .OR. CURRCHAR .EQ. 'E') .AND.
     .        ICONT .NE.0) GOTO 100
        NEXT=1
        RETURN
      ENDIF
C
      END
C
C =====================================================================
C ======================= C O M P R O 1 ===============================
C =====================================================================
C
      SUBROUTINE COMPRO1(BUFF,IPOS,MORE)
      IMPLICIT NONE
      CHARACTER*80 BUFF,TMPSTR
      CHARACTER CURRCHAR,NEXTCHAR,HT
      INTEGER STR$FIND_FIRST_IN_SET,STR$FIND_FIRST_NOT_IN_SET
      INTEGER STR$LENGTH,IEXP,INUMB,INUME,IPOS,MORE,MORER
C
C =========================================================================
C I   ADDITION TO COMMAND PROCEDURE TO FURTHER PARSE COMMAND THAT CONTAINSI
C I   ADDITIONAL TEXT BETWEEN THE COMMAND AND ITS NUMERIC ARGUMENT.       I
C =========================================================================
C
      HT=CHAR(9)
      MORE=0
      MORER=0
      INUMB=STR$FIND_FIRST_IN_SET(BUFF,'.+-0123456789')
      MORE=STR$FIND_FIRST_NOT_IN_SET(BUFF(INUMB:),' .+-0123456789'//HT)
      IF(MORE.EQ.0) THEN
        TMPSTR=BUFF(INUMB:)
        BUFF=TMPSTR
        RETURN
      ELSE
        INUME=INUMB+MORE-1
        CURRCHAR=BUFF(INUME:INUME)
        NEXTCHAR=BUFF(INUME+1:INUME+1)
        IEXP=STR$FIND_FIRST_IN_SET(NEXTCHAR,'+-0123456789')
        IF((CURRCHAR .EQ. 'D' .OR. CURRCHAR .EQ. 'E') .AND.
     .             IEXP .NE. 0) THEN
          MORER=STR$FIND_FIRST_NOT_IN_SET(
     .                  BUFF(INUME+1:),' .+-0123456789'//HT)
          IF(MORER.EQ.0) THEN
            MORE=0
            INUME=INUME+STR$LENGTH(BUFF(INUME+1:))+1
          ELSE
            INUME=INUME+MORER
          ENDIF
        ENDIF
        TMPSTR=BUFF(INUMB:INUME-1)
        BUFF=TMPSTR
        IPOS=IPOS+INUME-1
      ENDIF
C
      END
C
C =====================================================================
C ======================== I N P U T ==================================
C =====================================================================
C
      SUBROUTINE INPUT(IDOF)
C
C =====================================================================
C I                                                                   I
C I      SUBROUTINE INPUT READS ALL THE INPUT INFORMATION FROM        I
C I      CARD SETS 2 THROUGH 10. IT ALSO READS THE INFORMATION FROM   I
C I      THE PREVIOUS RUNS IF THE PROGRAM IS RESUBMITED.              I
C I                                                                   I
C I                                                                   I
C I                                                                   I
C =====================================================================
C
      IMPLICIT NONE
      INTEGER MAX_NODES,MAX_ELEMENTS,MAX_ELEM_NODES,MAX_MAT_TYPE
      INTEGER MAX_SKEW_BC,MAX_INTFAC_NODES,MNNDF,MAX_NODES_DOF
      INTEGER STRS_STRN_REL
      PARAMETER (MAX_NODES=3000,MAX_ELEMENTS=400,MAX_ELEM_NODES=20,
     .           MAX_MAT_TYPE=10,MAX_SKEW_BC=300,MAX_INTFAC_NODES=500,
     .           MNNDF=3,MAX_NODES_DOF=MAX_NODES*MNNDF)
      INTEGER ELEM_TYPE,DIVER_STOP,GRAPHICS_INTR,OUTPUT_INTR,IDIM,IDIR
      INTEGER STR$COMPRESS,STR$LENGTH,STR$COLLAPSE,I,ICNT,ICOMMENT,ID
      INTEGER IELEM,IELEM1,IEND,IETYPE,ILENTO,INCR,INCREMENTS,INTCOD
      INTEGER IPOS,ISTART,ITERATIONS,I_GRAPH,I_IN,I_OUT,J,K,K1,K2,LELEM
      INTEGER LINCI,LINES,LTEMP,MAT,MATNUM,MORE,N,N1,NDIVER,NELEM,NEXT
      INTEGER NINODE,NIP,NIPETA,NIPSI,NIPXI,NNDF,NNEL,NNODES,NODE,NUMBER
      INTEGER IDOF(*),INFOEL,INTFAC,ISPB,M(MAX_ELEM_NODES),MATYPE,NOP
      INTEGER LSTR1,LSTR2,STR$FIND_FIRST_NOT_IN_SET,COUNT,P2X,ITMP
      REAL*8 NUX,NUY,NUZ,CONV_FAC,CST,DX,DY,DZ,ENRG1,THICK,COSTX
      REAL*8 COSTY,COSTZ,DUMMY(6),EX,EY,EZ,P,P1X,P1Y,P1Z,P2Y,P2Z
      REAL*8 P3X,P4X,P5X,RX,RY,RZ,U,WGTX,WGTY,WGTZ
      REAL*4 X,Y,Z,PSXMIN,PSXMAX,PSYMIN,PSYMAX
      CHARACTER*80 BUFFER,BUFF,TITLE,SINCI,HT*1
      CHARACTER*40 COMM*4,SELEM,STEMP,STR1,STR2
      LOGICAL LINEAR,RESTART,SYMMETRIC,GRAPHICS_OUT
C
C ==========================================================================
C I                                                                        I
C I   ALL INTERNAL FILE READS OF A SINGLE VARIABLE WERE CHANGED            I
C I   FROM '*' TO A FORMAT SPECIFICATION OF 'I20' OR 'G20.0' DEPENDING     I
C I   ON THE VARIABLE TYPE. THIS CAN ALSO BE CHANGED TO '*' IF THE         I
C I   COMPILER SUPPORTS LIST-DIRECTED I/O ON INTERNAL FILES.               I
C I                                                                        I
C I   FINAL NOTE: IF COMPLIED WITH NON LIST-DIRECTED INTERNAL FILE SUPPORT,I
C I   SEPERATE MULTIPLE NUMERIC FILEDS ON THE SAME INPUT LINE AS A COMMAND I
C I   WITH COMMAS.                                                         I
C ==========================================================================
C
C     COMMENTS CAN BE ADDED TO THE INPUT FILE BY PRECEEDING THEM WITH
C     THE TWO CHARACTER SEQUENCE '/*'.
C
      COMMON/MAIN1/U(MAX_NODES_DOF)
      COMMON/IN_IO/I_OUT,I_IN,I_GRAPH
      COMMON/INPUT1/NIPXI,NIPETA,NIPSI,NIP,INTCOD
      COMMON/INPUT2/NOP(MAX_ELEM_NODES,MAX_ELEMENTS)
      COMMON/INPUT3/X(MAX_NODES),Y(MAX_NODES),Z(MAX_NODES)
      COMMON/INPUT5/NUX(MAX_MAT_TYPE),NUY(MAX_MAT_TYPE),
     .              NUZ(MAX_MAT_TYPE),EX(MAX_MAT_TYPE),
     .              EY(MAX_MAT_TYPE),EZ(MAX_MAT_TYPE),
     .              P1X(MAX_MAT_TYPE),P1Y(MAX_MAT_TYPE),
     .              P1Z(MAX_MAT_TYPE),P2X(MAX_MAT_TYPE),
     .              P2Y(MAX_MAT_TYPE),P2Z(MAX_MAT_TYPE)
      COMMON/INPUT6/WGTX(MAX_MAT_TYPE),WGTY(MAX_MAT_TYPE),
     .              WGTZ(MAX_MAT_TYPE)
      COMMON/INPUT7/RX(MAX_NODES_DOF),RY(MAX_NODES_DOF),
     .              RZ(MAX_NODES_DOF)
      COMMON/INPUT8/NNODES,NELEM,NNDF,INCREMENTS,ITERATIONS,LINEAR,
     .              SYMMETRIC,IDIM,NINODE
      COMMON/INPUT9/THICK,STRS_STRN_REL
      COMMON/INPUTA/INFOEL(MAX_ELEMENTS)
      COMMON/INPUTB/CONV_FAC,ENRG1,NDIVER,DIVER_STOP
      COMMON/INPUTC/TITLE
      COMMON/INPUTD/COSTX(MAX_SKEW_BC),COSTY(MAX_SKEW_BC),
     .              COSTZ(MAX_SKEW_BC)
      COMMON/INPUTE/ISPB(MAX_NODES)
      COMMON/INPUTF/MATYPE(MAX_MAT_TYPE)
      COMMON/INPUTG/RESTART,OUTPUT_INTR,GRAPHICS_INTR,GRAPHICS_OUT
      COMMON/INPUTI/INTFAC(MAX_INTFAC_NODES)
      COMMON/INPUTJ/P3X(MAX_MAT_TYPE),P4X(MAX_MAT_TYPE),
     .              P5X(MAX_MAT_TYPE)
      COMMON/POINTS/P(4 , 2)
      COMMON/POSTS/PSXMIN,PSXMAX,PSYMIN,PSYMAX
C
      DATA MATNUM /1/
C
C       ICNT = COUTER FOR THE 'ISPB' ARRAY WHICH DETERMINES WHERE
C       TO LOOK FOR THE DIRECTION COSINES OF THE SKEW BOUNDARY IN
C       THE 'COSTX', 'COSTY' AND 'COSTZ' ARRAYS.
C
      ICNT = 1
      HT=CHAR(9)
C
C          READ THE COMMAND LINE BUFFER
C
  100 IPOS = 1
      READ(I_IN , 101 ,END=1000,ERR=2000) BUFFER
      ICOMMENT=INDEX(BUFFER,'/*')
      IF(ICOMMENT.NE.0) THEN
        COUNT=STR$FIND_FIRST_NOT_IN_SET(BUFFER(:ICOMMENT),' /'//HT)
        IF(COUNT.EQ.0) GOTO 100
        BUFFER(ICOMMENT:)=' '
      END IF
      ILENTO=STR$COMPRESS(BUFFER,BUFFER)
      IF(ILENTO.EQ.0) GOTO 100
      CALL STR$UPCASE(BUFFER,BUFFER)
  101 FORMAT(A80)
  105 CALL COMPRO(BUFFER,BUFF,COMM,N,IPOS)
      ASSIGN 100 TO NEXT
C
C          EXTRACT THE FIRST FOUR CHARACTERS OF THE BUFFER AND REPLACE
C          ALL OTHER CHARACERS BY A BLANK EXCEPT NUMBERS 1-9.
C
      IF (COMM.EQ.'TITL') THEN
        GO TO 200
      ELSE IF (COMM.EQ.'COOR'.OR.COMM.EQ.'NODE'.OR.COMM.EQ.'JOIN'
     .         .OR.COMM.EQ. 'NODA') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
        GO TO 300
      ELSE IF (COMM.EQ.'MEMB'.OR.COMM.EQ.'INCI'.OR.COMM.EQ.'CONE') THEN
        IF(N.EQ.1) CALL COMPRO1(BUFF,IPOS,MORE)
        GO TO 400
      ELSE IF (COMM.EQ.'SKEW') THEN
        IF(N.EQ.1) CALL COMPRO1(BUFF,IPOS,MORE)
        GO TO 500
      ELSE IF (COMM.EQ.'DISP') THEN
        IF(N.EQ.1) CALL COMPRO1(BUFF,IPOS,MORE)
        GO TO 600
      ELSE IF (COMM.EQ.'LOAD') THEN
        IF(N.EQ.1) CALL COMPRO1(BUFF,IPOS,MORE)
        GO TO 700
      ELSE IF (COMM.EQ.'GRAP') THEN
        IF(N.EQ.1) CALL COMPRO1(BUFF,IPOS,MORE)
C       READ(BUFF , *, ERR = 2000) GRAPHICS_INTR
        READ(BUFF , '(I20)' , ERR = 2000) GRAPHICS_INTR
        GRAPHICS_OUT=.TRUE.
        CALL GRAPHX(I_IN,I_OUT)
        GO TO 100
      ELSE IF (COMM.EQ.'BOUN') THEN
        IF(N.EQ.1) CALL COMPRO1(BUFF,IPOS,MORE)
        GO TO 900
      ELSE IF (COMM.EQ.'MATE') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) MATNUM
        READ(BUFF , '(I20)' , ERR = 2000) MATNUM
        IF(MATNUM.GT.MAX_MAT_TYPE) THEN
          WRITE(STR1,'(I39)')MATNUM
          WRITE(STR2,'(I39)')MAX_MAT_TYPE
          LSTR1=STR$COLLAPSE(STR1,STR1)
          LSTR2=STR$COLLAPSE(STR2,STR2)
          WRITE(I_OUT,*)'NUMBER OF MATERIAL TYPES ('//STR1(:LSTR1)//
     .                  ') EXCEEDS ALLOWABLE (MAX_MAT_TYPE='//
     .                  STR2(:LSTR2)//'). PROGRAM TERMINATED'
          WRITE(*,*)'NUMBER OF MATERIAL TYPES ('//STR1(:LSTR1)//
     .                  ') EXCEEDS ALLOWABLE (MAX_MAT_TYPE='//
     .                  STR2(:LSTR2)//'). PROGRAM TERMINATED'
          STOP
        ENDIF
      ELSE IF (COMM.EQ.'STOP') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , END=2000) DIVER_STOP
        READ(BUFF , '(I20)' , END=2000) DIVER_STOP
      ELSE IF (COMM.EQ.'LINE') THEN
        IF(N.EQ.1) ASSIGN 105 TO NEXT
        LINEAR = .TRUE.
      ELSE IF (COMM.EQ.'NONL') THEN
        IF(N.EQ.1) ASSIGN 105 TO NEXT
        LINEAR = .FALSE.
      ELSE IF (COMM.EQ.'NONS') THEN
        IF(N.EQ.1) ASSIGN 105 TO NEXT
        SYMMETRIC = .FALSE.
      ELSE IF (COMM.EQ.'SYMM') THEN
        IF(N.EQ.1) ASSIGN 105 TO NEXT
        SYMMETRIC = .TRUE.
      ELSE IF (COMM.EQ.'IRON') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) INTCOD
        READ(BUFF , '(I20)' , ERR = 2000) INTCOD
      ELSE IF (COMM.EQ.'NIPX') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) NIPXI
        READ(BUFF , '(I20)' , ERR = 2000) NIPXI
        IF(NIPXI.GT.3) THEN
          WRITE(STR1,'(I39)')NIPXI
          LSTR1=STR$COLLAPSE(STR1,STR1)
          WRITE(I_OUT,*)'NIPXI='//STR1(:LSTR1)//' EXCEEDS ALLOWABLE '//
     .                  'VALUE OF 3. PROGRAM TERMINATED'
          WRITE(*,*)'NIPXI='//STR1(:LSTR1)//' EXCEEDS ALLOWABLE '
     .                  //'VALUE OF 3. PROGRAM TERMINATED'
          STOP
        ENDIF
      ELSE IF (COMM.EQ.'NIPE') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) NIPETA
        READ(BUFF , '(I20)' , ERR = 2000) NIPETA
        IF(NIPETA.GT.3) THEN
          WRITE(STR1,'(I39)')NIPETA
          LSTR1=STR$COLLAPSE(STR1,STR1)
          WRITE(I_OUT,*)'NIPETA='//STR1(:LSTR1)//' EXCEEDS ALLOWABLE '//
     .                  'VALUE OF 3. PROGRAM TERMINATED'
          WRITE(*,*)'NIPETA='//STR1(:LSTR1)//' EXCEEDS ALLOWABLE '
     .                  //'VALUE OF 3. PROGRAM TERMINATED'
          STOP
        ENDIF
      ELSE IF (COMM.EQ.'NIPS') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) NIPSI
        READ(BUFF , '(I20)' , ERR = 2000) NIPSI
        IF(NIPSI.GT.3) THEN
          WRITE(STR1,'(I39)')NIPSI
          LSTR1=STR$COLLAPSE(STR1,STR1)
          WRITE(I_OUT,*)'NIPSI='//STR1(:LSTR1)//' EXCEEDS ALLOWABLE '//
     .                  'VALUE OF 3. PROGRAM TERMINATED'
          WRITE(*,*)'NIPSI='//STR1(:LSTR1)//' EXCEEDS ALLOWABLE '
     .                  //'VALUE OF 3. PROGRAM TERMINATED'
          STOP
        ENDIF
      ELSE IF (COMM.EQ.'THIC') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) THICK
        READ(BUFF , '(G20.0)' , ERR = 2000) THICK
      ELSE IF (COMM.EQ.'DIME') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) IDIM
        READ(BUFF , '(I20)' , ERR = 2000) IDIM
        IF(IDIM.GT.3) THEN
          WRITE(STR1,'(I39)')IDIM
          LSTR1=STR$COLLAPSE(STR1,STR1)
          WRITE(I_OUT,*)'IDIM='//STR1(:LSTR1)//' EXCEEDS ALLOWABLE '//
     .                  'VALUE OF 3. PROGRAM TERMINATED'
          WRITE(*,*)'IDIM='//STR1(:LSTR1)//' EXCEEDS ALLOWABLE '
     .                  //'VALUE OF 3. PROGRAM TERMINATED'
          STOP
        ENDIF
        NNDF = IDIM
      ELSE IF (COMM.EQ.'ITER') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) ITERATIONS
        READ(BUFF , '(I20)' , ERR = 2000) ITERATIONS
      ELSE IF (COMM.EQ.'INCR') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) INCREMENTS
        READ(BUFF , '(I20)' , ERR = 2000) INCREMENTS
      ELSE IF (COMM.EQ.'CONV') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) CONV_FAC
        READ(BUFF , '(G20.0)' , ERR = 2000) CONV_FAC
      ELSE IF (COMM.EQ.'FACL') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
        WRITE(I_OUT,*)' COMMAND: '//COMM//' IS UNSUPPORTED. IGNORED'
        PRINT*,' COMMAND: '//COMM//' IS UNSUPPORTED. IGNORED'
      ELSE IF (COMM.EQ.'FACH') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
        WRITE(I_OUT,*)' COMMAND: '//COMM//' IS UNSUPPORTED. IGNORED'
        PRINT*,' COMMAND: '//COMM//' IS UNSUPPORTED. IGNORED'
      ELSE IF (COMM.EQ.'NU') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) NUX(MATNUM)
        READ(BUFF , '(G20.0)' , ERR = 2000) NUX(MATNUM)
      ELSE IF (COMM.EQ.'E') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) EX(MATNUM)
        READ(BUFF , '(G20.0)' , ERR = 2000) EX(MATNUM)
      ELSE IF (COMM.EQ.'WX') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) WGTX(MATNUM)
        READ(BUFF , '(G20.0)' , ERR = 2000) WGTX(MATNUM)
      ELSE IF (COMM.EQ.'WY') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF, * , ERR = 2000) WGTY(MATNUM)
        READ(BUFF, '(G20.0)' , ERR = 2000) WGTY(MATNUM)
      ELSE IF (COMM.EQ.'WZ') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) WGTZ(MATNUM)
        READ(BUFF , '(G20.0)' , ERR = 2000) WGTZ(MATNUM)
      ELSE IF (COMM.EQ.'TYPE') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) MATYPE( MATNUM )
        READ(BUFF , '(I20)' , ERR = 2000) MATYPE( MATNUM )
      ELSE IF(COMM.EQ.'YIEL') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) P1Z( MATNUM )
        READ(BUFF , '(G20.0)' , ERR = 2000) P1Z( MATNUM )
C
C     READ ISOTROPIC HARDENING PARAMETER
C
      ELSE IF(COMM.EQ.'ISOT') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) P1Y( MATNUM )
        READ(BUFF , '(G20.0)' , ERR = 2000) P1Y( MATNUM )
C
C     READ KINEMATIC HARDENING PARAMETER
C
      ELSE IF(COMM.EQ.'KINE') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) P1X( MATNUM )
        READ(BUFF , '(G20.0)' , ERR = 2000) P1X( MATNUM )
C
C     READ CONTROL PARAMETER FOR KINEMATIC HARDENING (0 OR 1)
C
      ELSE IF(COMM.EQ.'BETA') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) ITMP
        READ(BUFF , '(I20.0)' , ERR = 2000) ITMP
        IF(ABS(ITMP).GT.0) THEN
          P2X(MATNUM)=1
        ELSE
          P2X(MATNUM)=0
        ENDIF
      ELSE IF(COMM.EQ.'DAMA') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) P3X( MATNUM )
        READ(BUFF , '(G20.0)' , ERR = 2000) P3X( MATNUM )
      ELSE IF(COMM.EQ.'COEF') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) P4X( MATNUM )
        READ(BUFF , '(G20.0)' , ERR = 2000) P4X( MATNUM )
      ELSE IF(COMM.EQ.'DBBE') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) P5X( MATNUM )
        READ(BUFF , '(G20.0)' , ERR = 2000) P5X( MATNUM )
      ELSE IF(COMM.EQ.'REST') THEN
        IF(N.EQ.1) ASSIGN 105 TO NEXT
        RESTART = .TRUE.
      ELSE IF(COMM.EQ.'OUTP') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) OUTPUT_INTR
        READ(BUFF , '(I20)' , ERR = 2000) OUTPUT_INTR
      ELSE IF(COMM.EQ.'INTE') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
        GO TO 1100
      ELSE IF (COMM.EQ.'PAX') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) P(1 , 1)
        READ(BUFF , '(G20.0)' , ERR = 2000) P(1 , 1)
      ELSE IF(COMM.EQ.'PAY') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) P(1 , 2)
        READ(BUFF , '(G20.0)' , ERR = 2000) P(1 , 2)
      ELSE IF(COMM.EQ.'PBX') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) P(2 , 1)
        READ(BUFF , '(G20.0)' , ERR = 2000) P(2 , 1)
      ELSE IF(COMM.EQ.'PBY') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) P(2 , 2)
        READ(BUFF , '(G20.0)' , ERR = 2000) P(2 , 2)
      ELSE IF(COMM.EQ.'RAX') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) P(3 , 1)
        READ(BUFF , '(G20.0)' , ERR = 2000) P(3 , 1)
      ELSE IF(COMM.EQ.'RAY') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) P(3 , 2)
        READ(BUFF , '(G20.0)' , ERR = 2000) P(3 , 2)
      ELSE IF(COMM.EQ.'RBX') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) P(4 , 1)
        READ(BUFF , '(G20.0)' , ERR = 2000) P(4 , 1)
      ELSE IF(COMM.EQ.'RBY') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) P(4 , 2)
        READ(BUFF , '(G20.0)' , ERR = 2000) P(4 , 2)
      ELSE IF(COMM.EQ.'BLAN') THEN
        GOTO 100
      ELSE IF(COMM.EQ.'ENDF') THEN
        RETURN
      ELSE
        WRITE(I_OUT , 160) COMM
 160    FORMAT(1X,'COMMAND ''',A,''' IS NOT RECOGNIZED BY *DNA*')
        GO TO 2000
      END IF
      GO TO NEXT
C
C ----- READ THE TITLE OF THE PROGRAM (CARD SET1)
C
C 200 READ(BUFF , * , ERR = 2000) NUMBER
  200 READ(BUFF , '(I20)' , ERR = 2000) NUMBER
      DO K = 1 , NUMBER
        READ(I_IN , 101) TITLE
        WRITE(I_OUT , '(1X,A)') TITLE
      END DO
      GO TO NEXT
C
C ----- READ AND GENERATE THE NODAL COORDINATES
C
  300 I=0
C     READ(BUFF , * , ERR = 2000) NNODES
      READ(BUFF , '(I20)' , ERR = 2000) NNODES
      IF(NNODES.GT.MAX_NODES) THEN
        WRITE(STR1,'(I39)')NNODES
        WRITE(STR1,'(I39)')MAX_NODES
        LSTR1=STR$COLLAPSE(STR1,STR1)
        LSTR2=STR$COLLAPSE(STR2,STR2)
        WRITE(I_OUT,*)'NUMBER OF NODES ('//STR1(:LSTR1)//') EXCEEDES '//
     .                'ALLOWABLE (MAX_NODES='//STR2(:LSTR2)//'). '//
     .                'PROGRAM TERMINATED'
        WRITE(*,*)'NUMBER OF NODES ('//STR1(:LSTR1)//') EXCEEDES '//
     .                'ALLOWABLE (MAX_NODES='//STR2(:LSTR2)//'). '//
     .                'PROGRAM TERMINATED'
        STOP
      ENDIF
  310 READ (I_IN , *,ERR=2000) K,(DUMMY( IDIR ) , IDIR = 1 , IDIM),INCR
      X( K ) = DUMMY( 1 )
      Y( K ) = DUMMY( 2 )
      Z( K ) = DUMMY( 3 )
      I=I+1
      IF (INCR.EQ.0) GO TO 330
      N=(K-K1)/INCR
      DX=(X(K)-X(K1))/N
      DY=(Y(K)-Y(K1))/N
      DZ=(Z(K)-Z(K1))/N
      K2=K-INCR
      DO J=K1,K2,INCR
        N1=(J-K1)/INCR
        X(J)=X(K1)+N1*DX
        Y(J)=Y(K1)+N1*DY
        Z(J)=Z(K1)+N1*DZ
        I=I+1
      END DO
      I=I-1
  330 K1=K
      IF(I.LT.NNODES) GO TO 310
      WRITE(I_OUT , 6009)
      PSXMIN=X(1)
      PSXMAX=X(1)
      PSYMIN=Y(1)
      PSYMAX=Y(1)
      DO K1 = 1 , NNODES
        PSXMIN=AMIN1(PSXMIN,X(K1))
        PSXMAX=AMAX1(PSXMAX,X(K1))
        PSYMIN=AMIN1(PSYMIN,Y(K1))
        PSYMAX=AMAX1(PSYMAX,Y(K1))
        WRITE(I_OUT , 5004)K1,X( K1 ),Y( K1 ),Z( K1 )
      END DO
      GO TO NEXT
C
C ----- READ AND WRITE AND GENERATE THE ELEMENTS
C
  400 I = 0
C     READ(BUFF , * , ERR = 2000) NELEM
      READ(BUFF , '(I20)' , ERR = 2000) NELEM
      IF(NELEM.GT.MAX_ELEMENTS) THEN
        WRITE(STR1,'(I39)')NELEM
        WRITE(STR1,'(I39)')MAX_ELEMENTS
        LSTR1=STR$COLLAPSE(STR1,STR1)
        LSTR2=STR$COLLAPSE(STR2,STR2)
        WRITE(I_OUT,*)'NUMBER OF ELEMENTS ('//STR1(:LSTR1)//') EXCEEDES'
     .                //' ALLOWABLE (MAX_ELEMENTS='//STR2(:LSTR2)//').'
     .                //' PROGRAM TERMINATED'
        WRITE(*,*)'NUMBER OF ELEMENTS ('//STR1(:LSTR1)//') EXCEEDES'
     .                //' ALLOWABLE (MAX_ELEMENTS='//STR2(:LSTR2)//').'
     .                //' PROGRAM TERMINATED'
        STOP
      ENDIF
  410 READ(I_IN ,*,ERR=2000) K,ELEM_TYPE,NNEL,(NOP(NODE,K),NODE=1,NNEL),
     .               MAT,INCR
      IETYPE=ELEM_TYPE
      STRS_STRN_REL = ELEM_TYPE/1000
      STRS_STRN_REL = ELEM_TYPE - STRS_STRN_REL*1000
      STRS_STRN_REL = STRS_STRN_REL/100
      ELEM_TYPE = ELEM_TYPE/1000
      ELEM_TYPE = ELEM_TYPE*100 + NNEL
      IF (ELEM_TYPE.LT.300) THEN
        IF (NNEL.EQ.4) THEN
          ISTART = 1
          LINES  = 4
        ELSE
          ISTART = 5
          LINES  = 8
        END IF
      ELSE IF(ELEM_TYPE.GT.300) THEN
        IF (NNEL.EQ.8) THEN
          ISTART = 13
          LINES  = 12
        ELSE IF(NNEL.EQ.20) THEN
          ISTART = 25
          LINES = 24
        END IF
      END IF
C
C     NOTE: INFOEL IS ASSUMED( AND MUST BE) AN INTEGER*4 ARRAY.
C     THE QUANITIES MAT,NNEL,ELEM_TYPE,STRS_STRN_REL,ISTART,AND LINES ARE
C     PACKED INTO EACH ELEMENT OF INFOEL ARRAY. THE PACKING
C     SEQUENCE IS AS FOLLOWS:
C         ITEM          BITS
C         -----         ----
C          MAT          0-2
C         NNEL          3-7
C         ELEM_TYPE     8-16
C         STRS_STRN_REL 17-19
C         ISTART        20-25
C         LINES         26-31
C
      I = I + 1
      INFOEL( K ) = MAT + NNEL*8 + ELEM_TYPE*256 + STRS_STRN_REL*131072
     .              + ISTART*1048576 + LINES*67108864
      IF(INCR.EQ.0) THEN
        K1 = K
      ELSE
        K2 = (K - K1)/INCR
        DO NODE = 1 , NNEL
          M( NODE ) = (NOP(NODE , K ) - NOP(NODE , K1))/K2
        END DO
        DO IELEM = K1+INCR , K-INCR , INCR
          INFOEL( IELEM ) = INFOEL( K )
          I = I + 1
          IELEM1 = IELEM - INCR
          DO NODE = 1 , NNEL
            NOP(NODE , IELEM) = NOP(NODE , IELEM1) + M( NODE )
          END DO
        END DO
      END IF
      IF(I.LT.NELEM) GO TO 410
      WRITE(I_OUT,'(//1X,T18,A,I5,A)')'ELEMENT INCIDENCES (ELEMENT'//
     .   ' TYPE:',IETYPE,')'
      WRITE(I_OUT,'(1X,A,4X,A)')'ELEMENT NO.','INCIDENCES'
      DO I=1,NELEM
        SINCI=' '
        WRITE(SELEM,'(I20)')I
        LELEM=STR$COLLAPSE(SELEM,SELEM)
        DO K=1,NNEL
          WRITE(STEMP,'(I20)')NOP(K,I)
          LTEMP=STR$COLLAPSE(STEMP,STEMP)
          SINCI(STR$LENGTH(SINCI)+1:)=' '//STEMP(:LTEMP)
        END DO
        LINCI=STR$LENGTH(SINCI)
        WRITE(I_OUT,'(2X,A10,4X,A)')SELEM(:LELEM),SINCI(:LINCI)
      END DO
      GO TO NEXT
C
C ----- READ THE DIRECTION ANGLES OF SKEW B.C.'S
C
  500 CST = 3.141592653589793/180.
C     READ(BUFF , * , ERR = 2000) NUMBER
      READ(BUFF , '(I20)' , ERR = 2000) NUMBER
      IF(NUMBER.GT.MAX_SKEW_BC) THEN
        WRITE(STR1,'(I39)')NUMBER
        WRITE(STR1,'(I39)')MAX_SKEW_BC
        LSTR1=STR$COLLAPSE(STR1,STR1)
        LSTR2=STR$COLLAPSE(STR2,STR2)
        WRITE(I_OUT,*)'NUMBER OF SKEW BC''S ('//STR1(:LSTR1)//') '
     .                //'EXCEEDES ALLOWABLE (MAX_SKEW_BC='//STR2(:LSTR2)
     .                //'). PROGRAM TERMINATED'
        WRITE(*,*)'NUMBER OF SKEW BC''S ('//STR1(:LSTR1)//') '
     .                //'EXCEEDES ALLOWABLE (MAX_SKEW_BC='//STR2(:LSTR2)
     .                //'). PROGRAM TERMINATED'
        STOP
      ENDIF
      DO K1 = 1 , NUMBER
        READ(I_IN , *,ERR=2000)K,DUMMY(1),DUMMY(2),DUMMY(3)
        IF (ISPB( K ).EQ.0) THEN
          ISPB( K ) = ICNT
          K2 = ICNT
          ICNT = ICNT + 1
        ELSE IF (ISPB( K ).LT.0) THEN
          ISPB( K ) = -ISPB( K )
          K2 = ISPB( K )
        ELSE IF (ISPB( K ).GT.0) THEN
          WRITE(I_OUT , 6003) K
          STOP
        END IF
        COSTX( K2 ) = DCOS(DUMMY( 1 )*CST)
        COSTY( K2 ) = DCOS(DUMMY( 2 )*CST)
        COSTZ( K2 ) = DCOS(DUMMY( 3 )*CST)
      END DO
      GO TO NEXT
C
C ----- READ AND WRITE THE APPLIED DISPLACEMENTS
C
C 600 READ(BUFF , * , ERR = 2000) NUMBER
  600 READ(BUFF , '(I20)' , ERR = 2000) NUMBER
      IF((NUMBER*NNDF).GT.MAX_NODES_DOF) THEN
        WRITE(STR1,'(I39)')NUMBER
        WRITE(STR1,'(I39)')MAX_NODES_DOF
        LSTR1=STR$COLLAPSE(STR1,STR1)
        LSTR2=STR$COLLAPSE(STR2,STR2)
        WRITE(I_OUT,*)'NUMBER OF APPLIED DISP ('//STR1(:LSTR1)//') '
     .                //'EXCEEDES ALLOWABLE (MAX_NODES_DOF='
     .                //STR2(:LSTR2)//'). PROGRAM TERMINATED'
        WRITE(*,*)'NUMBER OF APPLIED DISP ('//STR1(:LSTR1)//') '
     .                //'EXCEEDES ALLOWABLE (MAX_NODES_DOF='
     .                //STR2(:LSTR2)//'). PROGRAM TERMINATED'
        STOP
      ENDIF
      DO I = 1 , NUMBER
        READ(I_IN , *,ERR=2000)K,(DUMMY(K1),K1 = 1 , NNDF)
        DO IDIR = 1 , NNDF
          ID = NNDF*(K - 1) + IDIR
          U( ID ) = DUMMY( IDIR )
        END DO
      END DO
      GO TO NEXT
C
C ----- READ AND WRITE THE APPLIED FORCE LOADS (CARD SET 9)
C
C 700 READ(BUFF , * , ERR = 2000) NUMBER
  700 READ(BUFF , '(I20)' , ERR = 2000) NUMBER
      IF(NUMBER.GT.NNODES) THEN
        WRITE(STR1,'(I39)')NUMBER
        WRITE(STR2,'(I39)')NNODES
        LSTR1=STR$COLLAPSE(STR1,STR1)
        LSTR2=STR$COLLAPSE(STR2,STR2)
        WRITE(I_OUT,*)'WARNING!!!! NUMBER OF NODAL LOADS SPECIFIED ('//
     .                 STR1(:LSTR1)//') EXCEEDES NUMBER OF NODES ('//
     .                 STR2(:LSTR2)//')'
        WRITE(*,*)'WARNING!!!! NUMBER OF NODAL LOADS SPECIFIED ('//
     .                 STR1(:LSTR1)//') EXCEEDES NUMBER OF NODES ('//
     .                 STR2(:LSTR2)//')'
      ENDIF
      IF(NUMBER.GT.MAX_NODES) THEN
        WRITE(STR1,'(I39)')NUMBER
        WRITE(STR2,'(I39)')MAX_NODES
        LSTR1=STR$COLLAPSE(STR1,STR1)
        LSTR2=STR$COLLAPSE(STR2,STR2)
        WRITE(I_OUT,*)'NUMBER OF NODAL LOADS ('//STR1(:LSTR1)//') '//
     .              'EXCEEDES ALLOWABLE (MAX_NODES='//STR2(:LSTR2)//
     .                '). PROGRAM TERMINATED'
        WRITE(*,*)'NUMBER OF NODAL LOADS ('//STR1(:LSTR1)//') '//
     .              'EXCEEDES ALLOWABLE (MAX_NODES='//STR2(:LSTR2)//
     .                '). PROGRAM TERMINATED'
        STOP
      ENDIF
      WRITE(I_OUT,'(//1X,T25,A)')'NODAL LOADS'
      WRITE(I_OUT,'(1X,A,10X,A,2(14X,A))')'NODE NUMBER','X','Y','Z'
      DO K1 = 1 , NUMBER
        READ(I_IN , *,ERR=2000) K2,RX(K2),RY(K2),RZ(K2)
        WRITE(I_OUT,'(4X,I5,7X,3(G13.4,4X))')K2,RX(K2),RY(K2),RZ(K2)
      END DO
      GO TO NEXT
C
C ----- READ AND GENERATE THE BOUNDARY CONDITION CODES
C
  900 I = 0
C     READ(BUFF , * , ERR = 2000) NUMBER
      READ(BUFF , '(I20)' , ERR = 2000) NUMBER
      IF(NUMBER.GT.NNODES) THEN
        WRITE(STR1,'(I39)')NUMBER
        WRITE(STR2,'(I39)')NNODES
        LSTR1=STR$COLLAPSE(STR1,STR1)
        LSTR2=STR$COLLAPSE(STR2,STR2)
        WRITE(I_OUT,*)'WARNING!!!! NUMBER OF BOUN COND SPECIFIED ('//
     .                 STR1(:LSTR1)//') EXCEEDES NUMBER OF NODES ('//
     .                 STR2(:LSTR2)//')'
        WRITE(*,*)'WARNING!!!! NUMBER OF BOUN COND SPECIFIED ('//
     .                 STR1(:LSTR1)//') EXCEEDES NUMBER OF NODES ('//
     .                 STR2(:LSTR2)//')'
      ENDIF
      IF(NUMBER.GT.MAX_NODES) THEN
        WRITE(STR1,'(I39)')NUMBER
        WRITE(STR2,'(I39)')MAX_NODES
        LSTR1=STR$COLLAPSE(STR1,STR1)
        LSTR2=STR$COLLAPSE(STR2,STR2)
        WRITE(I_OUT,*)'NUMBER OF BOUN COND ('//STR1(:LSTR1)//') '//
     .              'EXCEEDES ALLOWABLE (MAX_NODES='//STR2(:LSTR2)//
     .                '). PROGRAM TERMINATED'
        WRITE(*,*)'NUMBER OF BOUN COND ('//STR1(:LSTR1)//') '//
     .              'EXCEEDES ALLOWABLE (MAX_NODES='//STR2(:LSTR2)//
     .                '). PROGRAM TERMINATED'
        STOP
      ENDIF
  910 READ (I_IN , *,ERR=2000) K,(M(IDIR),IDIR=1,NNDF),INCR
      DO IDIR = 1 , NNDF
        ID = NNDF*(K - 1) + IDIR
        IDOF( ID ) = M( IDIR )
      END DO
      I = I + 1
      IF(INCR.EQ.0) THEN
        K1 = K
      ELSE
        ISTART = K1 + INCR
        IEND   = K - INCR
        DO J = ISTART , IEND , INCR
          I = I + 1
          DO IDIR = 1 , NNDF
            ID = NNDF*(J - 1) + IDIR
            IDOF( ID ) = M( IDIR )
          END DO
        END DO
      END IF
      IF (I.LT.NUMBER) GO TO 910
      GO TO NEXT
C
C ----- READ AND GENERATE THE INTERFACE NODES
C
 1100 I = 0
C     READ(BUFF , * , ERR = 2000) NINODE
      READ(BUFF , '(I20)' , ERR = 2000) NINODE
      IF(NINODE.GT.MAX_INTFAC_NODES) THEN
        WRITE(STR1,'(I39)')NINODE
        WRITE(STR2,'(I39)')MAX_INTFAC_NODES
        LSTR1=STR$COLLAPSE(STR1,STR1)
        LSTR2=STR$COLLAPSE(STR2,STR2)
        WRITE(I_OUT,*)'NUMBER OF INTERFACE NODES ('//STR1(:LSTR1)//') '
     .                //'EXCEEDS ALLOWABLE (MAX_INTFAC_NODES='//
     .                STR2(:LSTR2)//'). PROGRAM TERMINATED'
        WRITE(*,*)'NUMBER OF INTERFACE NODES ('//STR1(:LSTR1)//') '
     .                //'EXCEEDS ALLOWABLE (MAX_INTFAC_NODES='//
     .                STR2(:LSTR2)//'). PROGRAM TERMINATED'
        STOP
      ENDIF
 1110 READ (I_IN , *,ERR=2000) K,INCR
      IF(INCR.EQ.0) THEN
        I = I + 1
        INTFAC( I ) = K
        IF (ISPB( K ).EQ.0) THEN
          ISPB( K ) = -ICNT
          ICNT = ICNT + 1
        END IF
      ELSE
        ISTART = INTFAC( I ) + INCR
        IEND   = K
        DO J = ISTART , IEND , INCR
          IF (ISPB( J ).EQ.0) THEN
            ISPB( J ) = -ICNT
            ICNT = ICNT + 1
          END IF
          I = I + 1
          INTFAC( I ) = J
        END DO
      END IF
      IF (I.LT.NINODE) GO TO 1110
      GO TO NEXT
 2000 STOP 'Error reading input file'
 1000 RETURN
 5004 FORMAT(I5,1P,3G20.10)
 6002 FORMAT(//,1X,'PHYSICAL DIMENSION = ',I3/1X,'NUMBER OF NODES = ',
     .  I6/1X,'NUMBER OF ELEMENTS = ',I6/1X,'NUMBER OF NODAL D.O.F. = ',
     .  I6/,
     .  1X,'NUMBER OF APPLIED NODAL LOADS = ',I6/1X,'NUMBER OF IMPOSED'
     .  ,' NODAL DISPLACEMENTS = ',I6/1X,'NUMBER OF SKEW BOUNDARIES = ',
     .  I6/1X,'INTEGRATION CODE = ',I6/1X,'NUMBER OF LOAD INCREMENTS = '
     .  ,I6/1X,'GEOMETRIC LINEAR/NONLINEAR CODE = ',I6/1X,'MAXIMUM ',
     .  'NUMBER OF ITERATION ALLOWED = ',I6/1X,'FACTOR = ',F14.7)
 6003 FORMAT(/1X,'>>>>>>> PROGRAM STOPPED DUE TO MULTIPLE DEFINITIONS'/
     .      9X,'OF THE SKEW DIRECTION FOR NODE ',I4)
 6009 FORMAT(/,20X,'COORDINATES OF THE NODES'/' NODE NO.',11X,'X',
     .       19X,'Y',19X,'Z'/)
C
      END
C
C =====================================================================
C ======================== G R A P H X ===============================
C =====================================================================
C
      SUBROUTINE GRAPHX(I_IN,I_OUT)
C
C     READ IN PARAMETERS FOR GRAPHICAL OUTPUT
C     PARAMETERS:
C           DMAG   - MAGNIFICATION FACTOR FOR DISPLACEMENTS
C           FMAG   - MAGNIFICATION FACTOR FOR ORIGINAL GEOMETRY
C           XL     - LOWER LEFT X-COOR OF WINDOW IN WORLD COORDINATES
C           YB     - LOWER LEFT Y-COOR OF WINDOW IN WORLD COORDINATES
C           XR     - UPPER RIGHT X-COOR OF WINDOW IN WORLD COORDINATES
C           YT     - UPPER RIGHT Y-COOR OF WINDOW IN WORLD COORDINATES
C           XVL    - LOWER LEFT X-COOR OF VIEWPORT IN DEVICE COORDINATES
C           YVB    - LOWER LEFT Y-COOR OF VIEWPORT IN DEVICE COORDINATES
C           XVR    - UPPER RIGHT X-COOR OF VIEWPORT IN DEVICE COORDINATES
C           YVT    - UPPER RIGHT Y-COORD OF VIEWPORT IN DEVICE COORDINATES
C           ITHICK - THICKNESS OF ALL LINES TO BE DRAWN
C
C     NOTE: THE VIEWPORT COORDINATES ARE IGNORED. THEY REMAIN FOR COMPABILITY
C           WITH PREVIOUS INPUT FILES WRITTEN FOR THE BENSON PLOTTER.
C
      IMPLICIT NONE
      CHARACTER*80 BUFFER,BUFF,HT*1
      CHARACTER*4 COMM
      INTEGER STR$COMPRESS,ICOMMENT,ICOMP,IPOS,ITHICK,I_IN,I_OUT,MORE
      INTEGER N,NEXT,NLINES,COUNT,STR$FIND_FIRST_NOT_IN_SET
      REAL*4 D,SX,SY,XL,XR,XVL,XVR,YB,YT,YVB,YVT,ZF,DMAG,FMAG
      LOGICAL CONTOURS
      COMMON/GRAPH3/XL,XR,YB,YT,ZF,D
      COMMON/GRAPH4/XVL,XVR,YVB,YVT,SX,SY
      COMMON/GRAPH5/FMAG,DMAG,CONTOURS,ITHICK,NLINES
C
C     SET THE VIEWPORT COORDINATES IN INCHES MULTIPLIED BY 1000. THIS
C     WILL ALLOW MOVEMENTS ON THE PAGE TO ONE THOUSANDTH OF AN INCH
C     GIVING AN APPARENT RESOLUTION OF 1000 PIXELS/INCH. THE TRUE
C     RESOLUTION WILL BE DEVICE DEPENDENT. THE PAGE DIMENSIONS HAVE BEEN
C     DECREASED BY 500 MILLI-INCHES TO LEAVE A 250 MILL-INCH BORDER
C     ALL AROUND.
C
      HT=CHAR(9)
      XVL=250
      YVB=2000   ! INCREASE BY 1.5 INCH FOR LEGEND + .25 INCH FOR BORDER
      XVR=8000
      YVT=10500
C
C          READ THE COMMAND LINE BUFFER
C
C     SEE COMMENTS IN ROUTINE INPUT REGARDING LIST-DIRECTED I/O ON
C     INTERNAL FILES.
C
  100 IPOS = 1
      READ(I_IN , 101 ,END=1000) BUFFER
      ICOMMENT=INDEX(BUFFER,'/*')
      IF(ICOMMENT.NE.0) THEN
        COUNT=STR$FIND_FIRST_NOT_IN_SET(BUFFER(:ICOMMENT),' /'//HT)
        IF(COUNT.EQ.0) GOTO 100
        BUFFER(ICOMMENT:)=' '
      END IF
      CALL STR$UPCASE(BUFFER,BUFFER)
      ICOMP=STR$COMPRESS(BUFFER,BUFFER)
  101 FORMAT(A80)
  105 CALL COMPRO(BUFFER,BUFF,COMM,N,IPOS)
      ASSIGN 100 TO NEXT
      IF (COMM.EQ.'FMAG') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) FMAG
        READ(BUFF , '(G20.0)' , ERR = 2000) FMAG
      ELSE IF(COMM.EQ.'DMAG') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) DMAG
        READ(BUFF , '(G20.0)' , ERR = 2000) DMAG
      ELSE IF(COMM.EQ.'CONT') THEN
        IF(N.EQ.1) ASSIGN 105 TO NEXT
        CONTOURS = .TRUE.
      ELSE IF(COMM.EQ.'WL') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) XL
        READ(BUFF , '(G20.0)' , ERR = 2000) XL
      ELSE IF(COMM.EQ.'WR') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) XR
        READ(BUFF , '(G20.0)' , ERR = 2000) XR
      ELSE IF(COMM.EQ.'WT') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) YT
        READ(BUFF , '(G20.0)' , ERR = 2000) YT
      ELSE IF(COMM.EQ.'WB') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) YB
        READ(BUFF , '(G20.0)' , ERR = 2000) YB
      ELSE IF(COMM.EQ.'VL') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
        WRITE(I_OUT,*)'COMMAND ''VL'' IGNORED. LEFT X-COOR'//
     .       ' OF VIEWPORT PERMANENTLY SET TO 0.25 INCHES'
        PRINT*,'COMMAND ''VL'' IGNORED. LEFT X-COOR'//
     .       ' OF VIEWPORT PERMANENTLY SET TO 0.25 INCHES'
C       READ(BUFF , * , ERR = 2000) XVL
C       READ(BUFF , '(G20.0)' , ERR = 2000) XVL
      ELSE IF(COMM.EQ.'VR') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
        WRITE(I_OUT,*)'COMMAND ''VR'' IGNORED. RIGHT X-COOR'//
     .       ' OF VIEWPORT PERMANENTLY SET TO 8.00 INCHES'
        PRINT*,'COMMAND ''VR'' IGNORED. RIGHT X-COOR'//
     .       ' OF VIEWPORT PERMANENTLY SET TO 8.00 INCHES'
C       READ(BUFF , * , ERR = 2000) XVR
C       READ(BUFF , '(G20.0)' , ERR = 2000) XVR
      ELSE IF(COMM.EQ.'VT') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
        WRITE(I_OUT,*)'COMMAND ''VT'' IGNORED. TOP Y-COOR'//
     .       ' OF VIEWPORT PERMANENTLY SET TO 10.50 INCHES'
        PRINT*,'COMMAND ''VT'' IGNORED. TOP Y-COOR'//
     .       ' OF VIEWPORT PERMANENTLY SET TO 10.50 INCHES'
C       READ(BUFF , * , ERR = 2000) YVT
C       READ(BUFF , '(G20.0)' , ERR = 2000) YVT
      ELSE IF(COMM.EQ.'VB') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
        WRITE(I_OUT,*)'COMMAND ''VB'' IGNORED. BOTTOM Y-COOR'//
     .       ' OF VIEWPORT PERMANENTLY SET TO 1.75 INCHES'
        PRINT*,'COMMAND ''VB'' IGNORED. BOTTOM Y-COOR'//
     .       ' OF VIEWPORT PERMANENTLY SET TO 1.75 INCHES'
C       READ(BUFF , * , ERR = 2000) YVB
C       READ(BUFF , '(G20.0)' , ERR = 2000) YVB
      ELSE IF(COMM.EQ.'LINE') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
C       READ(BUFF , * , ERR = 2000) ITHICK
        READ(BUFF , '(I20)' , ERR = 2000) ITHICK
      ELSE IF (COMM.EQ.'ANGL') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
        WRITE(I_OUT,*)'COMMAND: '//COMM//' IS UNSUPPORTED. IGNORED'
        PRINT*,'COMMAND: '//COMM//' IS UNSUPPORTED. IGNORED'
      ELSE IF (COMM.EQ.'HIGH') THEN
        IF(N.EQ.1)THEN
          CALL COMPRO1(BUFF,IPOS,MORE)
          IF(MORE.NE.0)ASSIGN 105 TO NEXT
        ENDIF
        WRITE(I_OUT,*)'COMMAND: '//COMM//' IS UNSUPPORTED. IGNORED'
        PRINT*,'COMMAND: '//COMM//' IS UNSUPPORTED. IGNORED'
      ELSE IF(COMM.EQ.'BLAN') THEN
        GOTO 100
      ELSE IF(COMM.EQ.'END') THEN
        RETURN
      ELSE
        WRITE(I_OUT , 200) COMM
 200    FORMAT(1X,'>>>>>>> COMMAND "',A4,'" IS NOT RECOGNIZED BY'
     .    ,' ROUTINE GRAPHX')
        GO TO 2000
      END IF
      GO TO NEXT
 1000 RETURN
 2000 STOP 'Error reading input file'
C
      END
C
C ====================================================================
C ======================== O U T P U T ===============================
C ====================================================================
C
      SUBROUTINE OUTPUT(I_OUT)
      IMPLICIT NONE
      INTEGER MAT_ELAS,MAT_PLAS,MAT_ELAS_DAM,MAT_PLAS_DAM
      INTEGER MAX_NODES,MAX_MAT_TYPE,MAX_GAUSS_PTS,MNNDF,MAX_NODES_DOF
      INTEGER STRS_STRN_REL,AXISYMMETRIC
      PARAMETER (AXISYMMETRIC=3)
      PARAMETER (MAT_ELAS=1,MAT_PLAS=2,MAT_ELAS_DAM=3,MAT_PLAS_DAM=4)
      PARAMETER (MAX_NODES=3000,MAX_MAT_TYPE=10,MAX_GAUSS_PTS=27,
     .           MNNDF=3,MAX_NODES_DOF=MAX_NODES*MNNDF)
      INTEGER ELNUM,ELEM_TYPE,IA,IDIM,IEND,IF1,IF2,IFOR,IFOR1
      INTEGER INCREMENTS,INTGPN,ISTART,ITERATIONS,I_OUT,K1,K2,K3,LDEV
      INTEGER LDEV1,LDEV10,LDEV2,LDEV3,LDEV4,LDEV5,LDEV6,LDEV7,LDEV8
      INTEGER LDEV9,LDEVST,LINES,MATNUM,NELEM,NINODE,NIP
      INTEGER NNDF,NNEL,NNODES,MATYPE
      INTEGER NIPXI,NIPETA,NIPSI,INTCOD
      LOGICAL LINEAR,SYMMETRIC
      REAL*8 STRESS(6),STRAIN(6),COORDS(3),FORCES(6),DISPL(6),THICK
      REAL*8 STRPLA(6),STRELA(6),RE,UTOTAL,WGTX,WGTY,WGTZ
      REAL*8 TSELA(6,MAX_GAUSS_PTS),TSTRS(6,MAX_GAUSS_PTS)
      REAL*8 TSTRN(6,MAX_GAUSS_PTS)
      COMMON/INPUT1/NIPXI,NIPETA,NIPSI,NIP,INTCOD
      COMMON/INPUT6/WGTX(MAX_MAT_TYPE),WGTY(MAX_MAT_TYPE),
     .              WGTZ(MAX_MAT_TYPE)
      COMMON/INPUT8/NNODES,NELEM,NNDF,INCREMENTS,ITERATIONS,LINEAR,
     .              SYMMETRIC,IDIM,NINODE
      COMMON/INPUT9/THICK,STRS_STRN_REL
      COMMON/INPUTF/MATYPE(MAX_MAT_TYPE)
      COMMON/DEVICE/LDEV1,LDEV2,LDEV3,LDEV4,LDEV,LDEVST
      COMMON/DEV1/LDEV5,LDEV6,LDEV7,LDEV8,LDEV9,LDEV10
      COMMON/MAIN2/UTOTAL(MAX_NODES_DOF)
      COMMON/MAIN4/RE(MAX_NODES_DOF)
C
      DO ELNUM = 1 , NELEM
        CALL ELINFO(ELNUM,ELEM_TYPE,NNEL,MATNUM,STRS_STRN_REL,
     .              ISTART,LINES)
        IF (ELEM_TYPE.GT.300) THEN
          ASSIGN 3001 TO IFOR
          ASSIGN 3101 TO IFOR1
          IF (MATYPE( MATNUM ).EQ.MAT_PLAS) THEN
            ASSIGN 3102 TO IF1
          ELSE
            ASSIGN 3002 TO IF1
          END IF
          ASSIGN 3003 TO IF2
          IEND = 6
        ELSE IF(STRS_STRN_REL.EQ.AXISYMMETRIC) THEN
          ASSIGN 2001 TO IFOR
          ASSIGN 2101 TO IFOR1
          IF (MATYPE( MATNUM ).EQ.MAT_PLAS) THEN
            ASSIGN 2104 TO IF1
          ELSE
            ASSIGN 2004 TO IF1
          END IF
          ASSIGN 2005 TO IF2
          IEND = 4
        ELSE
          ASSIGN 2001 TO IFOR
          ASSIGN 2101 TO IFOR1
          IF (MATYPE( MATNUM ).EQ.MAT_PLAS) THEN
            ASSIGN 2102 TO IF1
          ELSE
            ASSIGN 2002 TO IF1
          END IF
          ASSIGN 2003 TO IF2
          IEND = 4
        END IF
        IF (MATYPE(MATNUM).EQ.MAT_ELAS) THEN
          DO K1 = 1 , NIP
            READ(LDEV1)(TSTRS(IA,K1),IA=1,6),(TSTRN(IA,K1),IA=1,6)
          END DO
        ELSE IF (MATYPE(MATNUM).EQ.MAT_PLAS) THEN
          DO K1 = 1 , NIP
            READ(LDEV1)(TSTRS(IA,K1),IA=1,6),(TSTRN(IA,K1),IA=1,6),
     .                (TSELA(IA,K1),IA=1,6)
          END DO
        END IF
        WRITE(I_OUT , 5002) ELNUM
        WRITE(I_OUT , IF1)
        DO INTGPN = 1 , NIP
          CALL COORD1(ELNUM,NNEL,INTGPN,COORDS(1),COORDS(2),COORDS(3))
          DO IA=1,6
            STRAIN(IA)=TSTRN(IA,INTGPN)
          ENDDO
          WRITE(I_OUT , IFOR) INTGPN,(COORDS(K1),K1=1,IDIM),
     .                        (STRAIN(K1),K1=1,IEND)
          IF (MATYPE(MATNUM).EQ.MAT_PLAS) THEN
            DO IA=1,6
              STRELA(IA)=TSELA(IA,INTGPN)
            ENDDO
            DO K1 = 1 , IEND
              STRPLA( K1 ) = STRAIN( K1 ) - STRELA( K1 )
            END DO
            WRITE(I_OUT ,IFOR1) (STRELA(K1),K1=1,IEND)
            WRITE(I_OUT ,IFOR1) (STRPLA(K1),K1=1,IEND)
          END IF
        END DO
        WRITE(I_OUT , IF2)
        DO INTGPN = 1 , NIP
          CALL COORD1(ELNUM,NNEL,INTGPN,COORDS(1),COORDS(2),COORDS(3))
          DO IA=1,6
            STRESS(IA)=TSTRS(IA,INTGPN)
          ENDDO
          WRITE(I_OUT , IFOR) INTGPN,(COORDS(K1),K1=1,IDIM),
     .                        (STRESS(K1),K1=1,IEND)
        END DO
      END DO
      WRITE(I_OUT , 6009)
      DO K1 = 1 , NNODES
        DO K2 = 1 , NNDF
          K3 = (K1 -1)*NNDF + K2
          FORCES( K2 ) = RE( K3 )
        END DO
        WRITE(I_OUT , 5004) K1,(FORCES(K2),K2 = 1 , NNDF)
      END DO
      WRITE(I_OUT , 6007)
      DO K1 = 1 , NNODES
        DO K2 = 1 , NNDF
          K3 = (K1 -1)*NNDF + K2
          DISPL( K2 ) = UTOTAL( K3 )
        END DO
        WRITE(I_OUT , 5004) K1,(DISPL( K2 ),K2 = 1 , NNDF)
      END DO
 2001 FORMAT(I4,1P,6G14.5)
 2101 FORMAT(32X,1P,4G14.5)
 2002 FORMAT(50X,'STRAIN COMPONENTS'/1X,'POINT',5X,'X',14X,'Y',
     .12X,'EXX',11X,'EYY',11X,'EXY',11X,'EZZ')
 2102 FORMAT(70X,'STRAIN COMPONENTS'/1X,'POINT',5X,'X',14X,'Y',
     .7X,' TOTAL_X   ',3X,' TOTAL_Y   ',3X,' TOTAL_XY   ',2X,
     .' TOTAL_Z   '/
     .34X,' ELAST_X',6X,' ELAST_Y',6X,' ELAST_XY',5X,' ELAST_Z'/
     .34X,' PLAST_X',6X,' PLAST_Y',6X,' PLAST_XY',5X,' PLAST_Z')
 2003 FORMAT(70X,'STRESS COMPONENTS'/1X,'POINT',5X,'X',14X,'Y',
     .12X,'SXX',11X,'SYY',11X,'SXY',11X,'SZZ')
 2004 FORMAT(50X,'STRAIN COMPONENTS'/1X,'POINT',5X,'X',14X,'Y',
     .11X,'ER ',11X,'EY ',11X,'ERY',11X,'ET ')
 2104 FORMAT(70X,'STRAIN COMPONENTS'/1X,'POINT',5X,'X',14X,'Y',
     .7X,' TOTAL_R   ',3X,' TOTAL_Y   ',3X,' TOTAL_RY   ',2X,
     .' TOTAL_T   '/
     .34X,' ELAST_R',6X,' ELAST_Y',6X,' ELAST_RY',5X,' ELAST_T'/
     .34X,' PLAST_R',6X,' PLAST_Y',6X,' PLAST_RY',5X,' PLAST_T')
 2005 FORMAT(50X,'STRESS COMPONENTS'/1X,'POINT',5X,'X',14X,'Y',
     .12X,'SR ',11X,'SY ',11X,'SRY',11X,'ST ')
 3001 FORMAT(I3,1P,9G14.5)
 3101 FORMAT(45X,1P,6G14.5)
 3002 FORMAT(50X,'STRAIN COMPONENTS'/1X,'POINT',5X,'X',13X,'Y',13X,
     .'Z',11X,'EXX',11X,'EYY',11X,'EZZ',11X,'EXY',11X,'EYZ',11X,'EXZ')
 3102 FORMAT(50X,'STRAIN COMPONENTS'/1X,'POINT',5X,'X',13X,'Y',
     .14X,'Z',7X,' TOTAL_X   ',3X,' TOTAL_Y   ',3X,' TOTAL_Z   ',2X,
     .' TOTAL_XY   ',2X,' TOTAL_YZ   ',2X,' TOTAL_XZ   '/
     .48X,' ELAST_X',6X,' ELAST_Y',6X,' ELAST_Z',5X,' ELAST_XY',5X,
     .' ELAST_YZ',5X,' ELAST_XZ'/
     .48X,' PLAST_X',6X,' PLAST_Y',6X,' PLAST_Z',5X,' PLAST_XY',5X,
     .' PLAST_YZ',5X,' PLAST_XZ')
 3003 FORMAT(50X,'STRESS COMPONENTS'/1X,'POINT',5X,'X',13X,'Y',13X,
     .'Z',11X,'SXX',11X,'SYY',11X,'SZZ',11X,'SXY',11X,'SYZ',11X,'SXZ')
 5002 FORMAT(20X,'**********',' ELEMENT=',I5,' **********')
 5004 FORMAT(I5,1P,3G20.10)
 5005 FORMAT(I3,9(1X,G12.9))
 6007 FORMAT(20X,'DISPLACEMENT OF THE NODES'/' NODE NO.',10X,'UX',
     .18X,'UY',18X,'UZ')
 6008 FORMAT(45X,'TOTAL PLASTIC WORK AT GAUSSIAN POINTS'/11X,'P1',
     .11X,'P1',11X,'P3',11X,'P4',11X,'P5',11X,'P6',11X,'P7',11X,'P8'
     .,11X,'P9')
 6009 FORMAT(20X,'REACTIONS AT THE NODES'/' NODE NO.',10X,'RX',
     .18X,'RY',18X,'RZ')
 6010 FORMAT(20X,'POINTS THAT HAVE YIELDED'/12X,'P1',5X,'P2',5X,'P3',
     .5X,'P4',5X,'P5',5X,'P6',5X,'P7',5X,'P8',5X,'P9')
C
      END
C
C ===========================================================================
C ================= P O S T S C R I P T __ D R I V E R ======================
C ===========================================================================
C I                                                                         I
C I   THIS SUBROUTINE SERVES AS A POSTSCRIPT DRIVER TO WRITE A POSTSCRIPT   I
C I   FILE FOR THE GRAPHICAL OUTPUT THAT WAS ROUTED TO THE BENSON PLOTTER.  I
C I   THE FORMER PLOTTER ROUTINES IDENT,EOJOB,JOBPLT,PLOT,VTHICK,EOPLOT,    I
C I   SYMBOL, AND NUMBER AS USED IN THIS PROGRAM ARE IMPLEMENTED AS         I
C I   ENTRY STATEMENTS IN THIS SUBROUTINE.                                  I
C ===========================================================================
C
      SUBROUTINE POSTSCRIPT_DRIVER
      IMPLICIT NONE
      CHARACTER STRING_OUT*500,TMPSTR*100,LEGSTR(8)*80,FCN_OUT*256
      CHARACTER*20 SX_OUT,SY_OUT,STHICK,SHT,SFPN,SANG,FMT,CURR_FONT
      CHARACTER*60 FILENAME,FONTS_USED,DATE_TIME*30,SPSXV*20
      CHARACTER SPAGE*7,COMMAND*20,SSYM*5
      CHARACTER*20 SXORG,CURR_THICK,LAST_FONT*60
C     CHARACTER SDATE*9,STIME*8  ! VAX DATE/TIME
      CHARACTER*7 HOUR,MINU,SEC,HUNSEC,YEAR,DAY,MONTH(12)*3 ! MICROSOFT
      INTEGER*2 IHR,IMIN,ISEC,I100TH,IYR,IMON,IDAY          ! DATE/TIME
      INTEGER X_OUT,Y_OUT,STR$LENGTH,STR$COLLAPSE,STR$COMPRESS
      INTEGER STR$FIND_FIRST_IN_SET_R,PAGE,CURR_XORG
      INTEGER IDTL,IDUMMY,IFPN,IHT,IPEN,IPSXV,ISYM,ITHICK,I_GRAPH,I_IN
      INTEGER I_OUT,LANG,LCOM,LCTHICK,LFCN_OUT,LFN,LFON,LFPN,LHT
      INTEGER LINE_OUT,LL1,LL2,LL3,LL4,LL5,LLFNT,LOUT,LPAGE,LPSXV,LSO
      INTEGER LTHK,LXORG,LX_OUT,LY_OUT,I1,I2,I3,I4,I5,I6
      REAL*4 ANG,CURR_HT,D,FPN,HT,SX,X
      REAL*4 XL,XR,XVL,XVR,Y,YB,YT,YVB,YVT,ZF,SY,RDUMMY
      LOGICAL GRAPH_OPEN,NEWPAGE
      COMMON/GRAPH3/XL,XR,YB,YT,ZF,D
      COMMON/GRAPH4/XVL,XVR,YVB,YVT,SX,SY
      COMMON/IN_IO/I_OUT,I_IN,I_GRAPH
C
      SAVE STRING_OUT,PAGE,LINE_OUT,CURR_FONT,CURR_HT,GRAPH_OPEN,NEWPAGE
     . ,SPSXV,LPSXV,CURR_XORG,CURR_THICK,LCTHICK,LAST_FONT,LLFNT
      DATA MONTH/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG',
     .           'SEP','OCT','NOV','DEC'/
      DATA PAGE /0/, FMT /'(1X,TL1,A)'/, STRING_OUT / ' '/
      DATA CURR_FONT /' '/ ! INITIALIZE CURRENT FONT TO BE NULL
      DATA FONTS_USED /' '/ ! INITIALIZE FONTS USED TO BE NULL
      DATA CURR_XORG /1/ ! NOT THE TRUE X-ORGIN HAS TO BE COMPUTED
C                        ! BUT WILL NOT BE SET AT 0
C
C ======================== E N T R Y    I D E N T =====================
C
      ENTRY IDENT
      ASSIGN 200 TO LINE_OUT
C     CALL DATE(SDATE)    ! VAX DATE ROUTINE
C     CALL TIME(STIME)    ! VAX TIME ROUTINE
      CALL GETTIM(IHR,IMIN,ISEC,I100TH)  ! MICROSOFT TIME ROUTINE
      CALL GETDAT(IYR,IMON,IDAY)         ! MICROSOFT DATE ROUTINE
      INQUIRE(I_GRAPH,NAME=FILENAME,OPENED=GRAPH_OPEN)
      IF(.NOT. GRAPH_OPEN)THEN
        PRINT*,'CANNOT WRITE TO GRAPH FILE'
        WRITE(I_OUT,FMT)'CANNOT WRITE TO GRAPH FILE'
        RETURN
      ENDIF
C           MICROSOFT DATE/TIME STRING ; NEXT 14 LINES
      WRITE(HOUR,'(I7)')IHR
      WRITE(MINU,'(I7)')IMIN
      WRITE(SEC,'(I7)')ISEC
      WRITE(HUNSEC,'(I7)')I100TH
      WRITE(YEAR,'(I7)')IYR
      WRITE(DAY,'(I7)')IDAY
      I1=STR$COLLAPSE(HOUR,HOUR)
      I2=STR$COLLAPSE(MINU,MINU)
      I3=STR$COLLAPSE(SEC,SEC)
      I4=STR$COLLAPSE(HUNSEC,HUNSEC)
      I5=STR$COLLAPSE(YEAR,YEAR)
      I6=STR$COLLAPSE(DAY,DAY)
      DATE_TIME=DAY(:I6)//'-'//MONTH(IMON)//'-'//YEAR(:I5)//'    '//
     .        HOUR(:I1)//':'//MINU(:I2)//':'//SEC(:I3)//':'//HUNSEC(:I4)
C     DATE_TIME=SDATE//'    '//STIME   ! VAX DATE/TIME STRING
C     CALL FDATE_(DATE_TIME)           ! UNIX XL FORTRAN DATE/TIME STRING
      LFN=STR$COLLAPSE(FILENAME,FILENAME)
      IDTL=STR$LENGTH(DATE_TIME)
      WRITE(I_GRAPH,FMT)'%!PS-Adobe-3.0'
      WRITE(I_GRAPH,FMT)'%%Creator: DNA Finite Element Program'
      WRITE(I_GRAPH,FMT)'%%Title: '//FILENAME(:LFN)
      WRITE(I_GRAPH,FMT)'%%CreationDate: '//DATE_TIME(:IDTL)
      WRITE(I_GRAPH,FMT)'%%BoundingBox: 18 18 576 756'
      WRITE(I_GRAPH,FMT)'%%DocumentFonts: (atend)'
      WRITE(I_GRAPH,FMT)'%%Pages: (atend)'
      WRITE(I_GRAPH,FMT)'%%EndComments'
      WRITE(I_GRAPH,FMT)'%%BeginProlog'
      WRITE(I_GRAPH,FMT)'/bd{bind def} bind def /l{lineto}bd '//
     .                  '/m{moveto}bd /t{translate}bd /s{show}bd'
      WRITE(I_GRAPH,FMT)'/slw{5 mul setlinewidth}bd '//
     .                  '/SYMFONT{/Symbol findfont}bd'
      WRITE(I_GRAPH,FMT)'/TEXTFONT{/Helvetica findfont}bd'//
     .                  ' /FONTSIZE{scalefont setfont}bd'
      WRITE(I_GRAPH,FMT)'/st{stroke}bd '//
     .                  '/gs{gsave}bd /gr{grestore}bd'//
     .                  ' /r{rotate}bd /c{currentpoint}bd'
      WRITE(I_GRAPH,FMT)'/lsm{l c st m}bd /lst{l c st t}bd '//
     .                  '/rm{rmoveto}bd'
      WRITE(I_GRAPH,FMT)'/center{dup stringwidth pop 7750 exch '//
     .                  'sub 2 div 0 rm s}bd'
      WRITE(I_GRAPH,FMT)'/censym{dup gs newpath 0 0 m true charpath'//
     .                  ' flattenpath pathbbox'
      WRITE(I_GRAPH,FMT)'2 div -1 mul /ht exch def 2'//
     .                  ' div -1 mul /wd exch def pop pop gr}bd'
      WRITE(I_GRAPH,FMT)'%%EndProlog'
C     TRY TO CENTER THE GRAPH ON THE PAGE HORIZONTALLY
      IPSXV = INT((XVR-XVL-SX*(XR - XL))/2+XVL)
      WRITE(SPSXV,'(I20)')IPSXV
      LPSXV=STR$COLLAPSE(SPSXV,SPSXV)
      PAGE=PAGE+1
      WRITE(SPAGE,'(I7)')PAGE
      LPAGE=STR$COLLAPSE(SPAGE,SPAGE)
      WRITE(I_GRAPH,FMT)
      WRITE(I_GRAPH,FMT)'%%Page: '//SPAGE(:LPAGE)//' '//SPAGE(:LPAGE)
      WRITE(I_GRAPH,FMT)'%%BeginPageSetup'
      WRITE(I_GRAPH,FMT)'/pgsave save def 0.072 0.072 scale '//
     .                   SPSXV(:LPSXV)//' 0 t'
      CURR_THICK='1'
      LCTHICK=1
      WRITE(I_GRAPH,FMT)'1 setlinejoin 1 setlinecap 0 setgray 1 slw'
      WRITE(I_GRAPH,FMT)'%%EndPageSetup'
      NEWPAGE=.FALSE.
      CURR_XORG=1
      RETURN
C
C ======================== E N T R Y    J O B P L T ===================
C
      ENTRY JOBPLT
      RETURN
C
C ======================== E N T R Y    P L O T =======================
C
      ENTRY PLOT(X,Y,IPEN)
      IF(.NOT. GRAPH_OPEN)THEN
        PRINT*,'CANNOT WRITE TO GRAPH FILE'
        WRITE(I_OUT,FMT)'CANNOT WRITE TO GRAPH FILE'
        RETURN
      ENDIF
      IF(NEWPAGE) THEN
        PAGE=PAGE+1
        WRITE(SPAGE,'(I7)')PAGE
        LPAGE=STR$COLLAPSE(SPAGE,SPAGE)
        WRITE(I_GRAPH,FMT)
        WRITE(I_GRAPH,FMT)'%%Page: '//SPAGE(:LPAGE)//' '//SPAGE(:LPAGE)
        WRITE(I_GRAPH,FMT)'%%BeginPageSetup'
        WRITE(I_GRAPH,FMT)'/pgsave save def 0.072 0.072 scale '//
     .                     SPSXV(:LPSXV)//' 0 t'
        WRITE(I_GRAPH,FMT)'1 setlinejoin 1 setlinecap 0 setgray '//
     .     CURR_THICK(:LCTHICK)//' slw'
        WRITE(I_GRAPH,FMT)'%%EndPageSetup'
        NEWPAGE=.FALSE.
        CURR_XORG=1
        CURR_FONT=' '
        CURR_HT=0
      ENDIF
      SXORG=' '
      LXORG=1
      IF(CURR_XORG.EQ.0) THEN
        CURR_XORG=1
        SXORG=' '//SPSXV(:LPSXV)//' 0 t '
        LXORG=STR$LENGTH(SXORG)
      ENDIF
      X_OUT=INT(X)
      Y_OUT=INT(Y)
      WRITE(SX_OUT,'(I20)')X_OUT
      WRITE(SY_OUT,'(I20)')Y_OUT
      LX_OUT=STR$COLLAPSE(SX_OUT,SX_OUT)
      LY_OUT=STR$COLLAPSE(SY_OUT,SY_OUT)
      IF(IPEN.EQ.3) THEN
        COMMAND='m'
      ELSEIF(IPEN.EQ.2)THEN
        COMMAND='lsm'
      ELSEIF(IPEN.EQ.-3) THEN
        COMMAND='t'
      ELSEIF(IPEN.EQ.-2)THEN
        COMMAND='lst'
      ENDIF
      LCOM=STR$COMPRESS(COMMAND,COMMAND)
      FCN_OUT=SXORG(:LXORG)//SX_OUT(:LX_OUT)//' '//SY_OUT(:LY_OUT)//
     .        ' '//COMMAND(:LCOM)
      LFCN_OUT=STR$LENGTH(FCN_OUT)
      GOTO LINE_OUT
C
C ======================== E N T R Y    V T H I C K ===================
C
      ENTRY VTHICK(ITHICK)
      IF(.NOT. GRAPH_OPEN)THEN
        PRINT*,'CANNOT WRITE TO GRAPH FILE'
        WRITE(I_OUT,FMT)'CANNOT WRITE TO GRAPH FILE'
        RETURN
      ENDIF
      IF(NEWPAGE) THEN
        PAGE=PAGE+1
        WRITE(SPAGE,'(I7)')PAGE
        LPAGE=STR$COLLAPSE(SPAGE,SPAGE)
        WRITE(I_GRAPH,FMT)
        WRITE(I_GRAPH,FMT)'%%Page: '//SPAGE(:LPAGE)//' '//SPAGE(:LPAGE)
        WRITE(I_GRAPH,FMT)'%%BeginPageSetup'
        WRITE(I_GRAPH,FMT)'/pgsave save def 0.072 0.072 scale '//
     .                     SPSXV(:LPSXV)//' 0 t'
        WRITE(I_GRAPH,FMT)'1 setlinejoin 1 setlinecap 0 setgray '
        WRITE(I_GRAPH,FMT)'%%EndPageSetup'
        NEWPAGE=.FALSE.
        CURR_XORG=1
        CURR_FONT=' '
        CURR_HT=0
      ENDIF
      WRITE(STHICK,'(I20)')ITHICK
      LTHK=STR$COLLAPSE(STHICK,STHICK)
      CURR_THICK=STHICK
      LCTHICK=LTHK
      FCN_OUT=' '//STHICK(:LTHK)//' slw'
      LFCN_OUT=STR$LENGTH(FCN_OUT)
      GOTO LINE_OUT
C
C ======================== E N T R Y    S Y M B O L ===================
C
      ENTRY SYMBOL(X,Y,HT,ISYM,RDUMMY,IDUMMY)
      RDUMMY=RDUMMY
      IDUMMY=IDUMMY
      IF(.NOT. GRAPH_OPEN)THEN
        PRINT*,'CANNOT WRITE TO GRAPH FILE'
        WRITE(I_OUT,FMT)'CANNOT WRITE TO GRAPH FILE'
        RETURN
      ENDIF
      IF(NEWPAGE) THEN
        PAGE=PAGE+1
        WRITE(SPAGE,'(I7)')PAGE
        LPAGE=STR$COLLAPSE(SPAGE,SPAGE)
        WRITE(I_GRAPH,FMT)
        WRITE(I_GRAPH,FMT)'%%Page: '//SPAGE(:LPAGE)//' '//SPAGE(:LPAGE)
        WRITE(I_GRAPH,FMT)'%%BeginPageSetup'
        WRITE(I_GRAPH,FMT)'/pgsave save def 0.072 0.072 scale '//
     .                     SPSXV(:LPSXV)//' 0 t'
        WRITE(I_GRAPH,FMT)'1 setlinejoin 1 setlinecap 0 setgray '//
     .        CURR_THICK(:LCTHICK)//' slw'
        WRITE(I_GRAPH,FMT)'%%EndPageSetup'
        NEWPAGE=.FALSE.
        CURR_XORG=1
        CURR_FONT=' '
        CURR_HT=0
      ENDIF
      SXORG=' '
      LXORG=1
      IF(CURR_XORG.EQ.0) THEN
        CURR_XORG=1
        SXORG=' '//SPSXV(:LPSXV)//' 0 t '
        LXORG=STR$LENGTH(SXORG)
      ENDIF
      X_OUT=INT(X)
      Y_OUT=INT(Y)
      IHT=NINT(HT*1000)
      IF(ISYM.EQ.5) SSYM='\250'      ! MICROSOFT & VAX FORTRAN
      IF(ISYM.EQ.11) SSYM='\267'     ! MICROSOFT & VAX FORTRAN
C     IF(ISYM.EQ.5) SSYM='\\250'     ! UNIX XL FORTRAN
C     IF(ISYM.EQ.11) SSYM='\\267'    ! UNIX XL FORTRAN
      WRITE(SX_OUT,'(I20)')X_OUT
      WRITE(SY_OUT,'(I20)')Y_OUT
      WRITE(SHT,'(I20)')IHT
      LX_OUT=STR$COLLAPSE(SX_OUT,SX_OUT)
      LY_OUT=STR$COLLAPSE(SY_OUT,SY_OUT)
      LHT=STR$COLLAPSE(SHT,SHT)
      IF(CURR_FONT.NE.'Symbol') THEN
        CURR_FONT='Symbol'
        CURR_HT=HT
        LAST_FONT='SYMBOL '//SHT(:LHT)//' FONTSIZE'
        LLFNT=STR$LENGTH(LAST_FONT)
        IF(INDEX(FONTS_USED,'Symbol').EQ.0) THEN
          FONTS_USED(STR$LENGTH(FONTS_USED)+1:)=' Symbol'
          LFON=STR$LENGTH(FONTS_USED)
        ENDIF
        FCN_OUT=SXORG(:LXORG)//SX_OUT(:LX_OUT)//' '//SY_OUT(:LY_OUT)//
     .          ' m SYMFONT '//SHT(:LHT)//' FONTSIZE ('//SSYM//
     .          ') censym wd ht rm s'
      ELSE
        FCN_OUT=SXORG(:LXORG)//SX_OUT(:LX_OUT)//' '//SY_OUT(:LY_OUT)//
     .          ' m ('//SSYM//') wd ht rm s'
      ENDIF
      LFCN_OUT=STR$LENGTH(FCN_OUT)
      GOTO LINE_OUT
C
C ======================== E N T R Y    N U M B E R ===================
C
      ENTRY NUMBER(X,Y,HT,FPN,ANG,IDUMMY)
      IDUMMY=IDUMMY
      IF(.NOT. GRAPH_OPEN)THEN
        PRINT*,'CANNOT WRITE TO GRAPH FILE'
        WRITE(I_OUT,FMT)'CANNOT WRITE TO GRAPH FILE'
        RETURN
      ENDIF
      IF(NEWPAGE) THEN
        PAGE=PAGE+1
        WRITE(SPAGE,'(I7)')PAGE
        LPAGE=STR$COLLAPSE(SPAGE,SPAGE)
        WRITE(I_GRAPH,FMT)
        WRITE(I_GRAPH,FMT)'%%Page: '//SPAGE(:LPAGE)//' '//SPAGE(:LPAGE)
        WRITE(I_GRAPH,FMT)'%%BeginPageSetup'
        WRITE(I_GRAPH,FMT)'/pgsave save def 0.072 0.072 scale '//
     .                     SPSXV(:LPSXV)//' 0 t'
        WRITE(I_GRAPH,FMT)'1 setlinejoin 1 setlinecap 0 setgray '//
     .         CURR_THICK(:LCTHICK)//' slw'
        WRITE(I_GRAPH,FMT)'%%EndPageSetup'
        NEWPAGE=.FALSE.
        CURR_XORG=1
        CURR_FONT=' '
        CURR_HT=0
      ENDIF
      SXORG=' '
      LXORG=1
      IF(CURR_XORG.EQ.0) THEN
        CURR_XORG=1
        SXORG=' '//SPSXV(:LPSXV)//' 0 t '
        LXORG=STR$LENGTH(SXORG)
      ENDIF
      X_OUT=INT(X)
      Y_OUT=INT(Y)
      IHT=NINT(HT*1000)
      IFPN=NINT(FPN)
      WRITE(SX_OUT,'(I20)')X_OUT
      WRITE(SY_OUT,'(I20)')Y_OUT
      WRITE(SHT,'(I20)')IHT
      WRITE(SFPN,'(I20)')IFPN
      WRITE(SANG,'(F20.6)')ANG
      LX_OUT=STR$COLLAPSE(SX_OUT,SX_OUT)
      LY_OUT=STR$COLLAPSE(SY_OUT,SY_OUT)
      LHT=STR$COLLAPSE(SHT,SHT)
      LFPN=STR$COLLAPSE(SFPN,SFPN)
      LANG=STR$COLLAPSE(SANG,SANG)
      IF(CURR_FONT.NE.'Helvetica' .OR. CURR_HT .NE. HT) THEN
        CURR_FONT='Helvetica'
        CURR_HT=HT
        LAST_FONT='SYMFONT '//SHT(:LHT)//' FONTSIZE'
        LLFNT=STR$LENGTH(LAST_FONT)
        IF(INDEX(FONTS_USED,'Helvetica') .EQ. 0) THEN
          FONTS_USED(STR$LENGTH(FONTS_USED)+1:)=' Helvetica'
          LFON=STR$LENGTH(FONTS_USED)
        ENDIF
        FCN_OUT=SXORG(:LXORG)//SX_OUT(:LX_OUT)//' '//
     .          SY_OUT(:LY_OUT)//' m SYMFONT '//SHT(:LHT)//
     .          ' FONTSIZE gs '//SANG(:LANG)//' r ('//
     .          SFPN(:LFPN)//') s gr'
      ELSE
        FCN_OUT=SXORG(:LXORG)//SX_OUT(:LX_OUT)//' '//
     .          SY_OUT(:LY_OUT)//' m gs '//SANG(:LANG)//
     .          ' r ('//SFPN(:LFPN)//') s gr'
      ENDIF
      LFCN_OUT=STR$LENGTH(FCN_OUT)
      GOTO LINE_OUT
C
C ================== E N T R Y    L E G E N D __ O U T ================
C
      ENTRY LEGEND_OUT(LEGSTR)
      IF(.NOT. GRAPH_OPEN)THEN
        PRINT*,'CANNOT WRITE TO GRAPH FILE'
        WRITE(I_OUT,FMT)'CANNOT WRITE TO GRAPH FILE'
        RETURN
      ENDIF
      IF(NEWPAGE) THEN
        PAGE=PAGE+1
        WRITE(SPAGE,'(I7)')PAGE
        LPAGE=STR$COLLAPSE(SPAGE,SPAGE)
        WRITE(I_GRAPH,FMT)
        WRITE(I_GRAPH,FMT)'%%Page: '//SPAGE(:LPAGE)//' '//SPAGE(:LPAGE)
        WRITE(I_GRAPH,FMT)'%%BeginPageSetup'
        WRITE(I_GRAPH,FMT)'/pgsave save def 0.072 0.072 scale'
        WRITE(I_GRAPH,FMT)'1 setlinejoin 1 setlinecap 0 setgray'
        WRITE(I_GRAPH,FMT)LAST_FONT(:LLFNT)
        WRITE(I_GRAPH,FMT)'%%EndPageSetup'
        NEWPAGE=.FALSE.
        CURR_XORG=0
        CURR_FONT=' '
        CURR_HT=0
      ENDIF
      LSO=STR$LENGTH(STRING_OUT)
      IF(LSO.NE.0) WRITE(I_GRAPH,FMT)STRING_OUT(:LSO)
      STRING_OUT=' '
      LL1=STR$LENGTH(LEGSTR(1))
      LL2=STR$LENGTH(LEGSTR(2))
      LL3=STR$LENGTH(LEGSTR(3))
      LL4=STR$LENGTH(LEGSTR(4))
      LL5=MAX(STR$LENGTH(LEGSTR(5)),LL4)
      IF(CURR_FONT.NE.'Helvetica' .OR. CURR_HT .NE. 12) THEN
        CURR_FONT='Helvetica'
        CURR_HT=12
        IF(INDEX(FONTS_USED,'Helvetica').EQ.0) THEN
          FONTS_USED(STR$LENGTH(FONTS_USED)+1:)=' Helvetica'
          LFON=STR$LENGTH(FONTS_USED)
        ENDIF
        WRITE(I_GRAPH,FMT)'TEXTFONT 10 1000 mul 72 div FONTSIZE'
      ENDIF
      WRITE(I_GRAPH,FMT)SPSXV(:LPSXV)//' -1 mul 0 t 3 slw newpath '//
     .                  '250 250 m 0 1500 rlineto 7750 0 rlineto '//
     .                  '0 -1500 '
      WRITE(I_GRAPH,FMT)'rlineto closepath st 1 slw'
      WRITE(I_GRAPH,FMT)'250 1440 m ('//LEGSTR(1)(:LL1)//') center'
      WRITE(I_GRAPH,FMT)'250 985 m ('//LEGSTR(2)(:LL2)//') center'
      WRITE(I_GRAPH,FMT)'250 679 m ('//LEGSTR(3)(:LL3)//') center'
      WRITE(I_GRAPH,FMT)'250 526 m ('//LEGSTR(4)(:LL4)//') center'
      WRITE(I_GRAPH,FMT)'250 373 m ('//LEGSTR(5)(:LL5)//') center'
      RETURN
C
C ======================== E N T R Y    E O P L O T ===================
C
      ENTRY EOPLOT(IDUMMY)
      IDUMMY=IDUMMY
      IF(.NOT. GRAPH_OPEN)THEN
        PRINT*,'CANNOT WRITE TO GRAPH FILE'
        WRITE(I_OUT,FMT)'CANNOT WRITE TO GRAPH FILE'
        RETURN
      ENDIF
      LSO=STR$LENGTH(STRING_OUT)
      IF(LSO.NE.0) WRITE(I_GRAPH,FMT)STRING_OUT(:LSO)
      WRITE(I_GRAPH,FMT)SPSXV(:LPSXV)//' -1 mul 0 t '
      WRITE(I_GRAPH,FMT)'7750 140 m TEXTFONT 6 1000 mul 72 div '//
     .                  'FONTSIZE (Page '//SPAGE(:LPAGE)//')s'
      WRITE(I_GRAPH,FMT)'pgsave restore showpage'
      STRING_OUT=' '
      NEWPAGE=.TRUE.
      RETURN
C
C ======================== E N T R Y    E O J O B =====================
C
      ENTRY EOJOB
      WRITE(SPAGE,'(I7)')PAGE
      LPAGE=STR$COLLAPSE(SPAGE,SPAGE)
      WRITE(I_GRAPH,FMT)
      WRITE(I_GRAPH,FMT)'%%Trailer'
      WRITE(I_GRAPH,FMT)'%%DocumentFonts: '//FONTS_USED(:LFON)
      WRITE(I_GRAPH,FMT)'%%Pages: '//SPAGE(:LPAGE)
      WRITE(I_GRAPH,FMT)'%%EOF'
      CLOSE(I_GRAPH)
      RETURN
200   LSO=STR$LENGTH(STRING_OUT)
      STRING_OUT(LSO+1:)=FCN_OUT(:LFCN_OUT)
210   LSO=STR$LENGTH(STRING_OUT)
      IF(LSO.GT.78) THEN
        LOUT=STR$FIND_FIRST_IN_SET_R(STRING_OUT(:78),' ')
        TMPSTR=STRING_OUT(LOUT+1:)
        STRING_OUT(LOUT+1:)=' '
        WRITE(I_GRAPH,FMT)STRING_OUT(:LOUT)
        STRING_OUT=TMPSTR
        GOTO 210
      ENDIF
C
      END
