C
C  ===================================================================
C  ======================== I N P L O T===============================
C  ===================================================================
C
      SUBROUTINE INPLOT(NELEM)
      IMPLICIT NONE
      INTEGER MAX_NODES,MAX_ELEMENTS,MAX_ELEM_NODES,MAX_ELEM_BOUND
      INTEGER MAX_LINES
      PARAMETER (MAX_NODES=3000,MAX_ELEMENTS=400,MAX_ELEM_NODES=20,
     .           MAX_ELEM_BOUND=48,MAX_LINES=3000)
      INTEGER ELNUM,ELEM_TYPE,STRS_STRN_REL,ICODE,ISTART,ISTOP
      INTEGER ITHICK,J1,J2,K1,K2,LINES,MATNUM,NELEM,NLINES,NN,NODE
      INTEGER IE,IREP,IS,IVE,IVS,NOP,OUTPUT_INTR,GRAPHICS_INTR
      INTEGER I_OUT,I_IN,I_GRAPH,STR$COLLAPSE,LSTR1,LSTR2
      REAL*4 D,DMAG,FMAG,PSXMAX,PSXMIN,PSYMAX,PSYMIN,SX,SY,XL,XR,XRM
      REAL*4 XVL,XVR,YB,YRM,YT,YVB,YVT,ZF,EPS,CLR_FAC
      LOGICAL CONTOURS,RESTART,GRAPHICS_OUT
      CHARACTER*40 STR1,STR2
      COMMON/INPUT2/NOP(MAX_ELEM_NODES,MAX_ELEMENTS)
      COMMON/GRAPH1/IS(MAX_ELEM_BOUND),IE(MAX_ELEM_BOUND)
      COMMON/GRAPH2/IVS(MAX_LINES),IVE(MAX_LINES)
      COMMON/GRAPH3/XL,XR,YB,YT,ZF,D
      COMMON/GRAPH4/XVL,XVR,YVB,YVT,SX,SY
      COMMON/GRAPH5/FMAG,DMAG,CONTOURS,ITHICK,NLINES
      COMMON/IREP1/IREP(MAX_LINES)
      COMMON/POSTS/PSXMIN,PSXMAX,PSYMIN,PSYMAX
      COMMON/INPUTG/RESTART,OUTPUT_INTR,GRAPHICS_INTR,GRAPHICS_OUT
      COMMON/IN_IO/I_OUT,I_IN,I_GRAPH
C
      DATA EPS,CLR_FAC /1.0E-20,0.05/
C
C     CHECK COORDINATES OF WORLD VIEWPORT FOR VALIDITY AND INCREASE
C     TO ALLOW FOR COORDINATES OF DEFORMED GEOMETRY
C
      XRM=XR-XL
      YRM=YT-YB
      IF(XRM .LE. EPS) THEN
        XL=PSXMIN
        XR=PSXMAX
        XRM=XR-XL
      ENDIF
      IF(YRM .LE. EPS) THEN
        YB=PSYMIN
        YT=PSYMAX
        YRM=YT-YB
      ENDIF
      XL=XL-CLR_FAC*FMAG*ABS(XRM)
      XR=XR+CLR_FAC*FMAG*ABS(XRM)
      YB=YB-CLR_FAC*FMAG*ABS(YRM)
      YT=YT+CLR_FAC*FMAG*ABS(YRM)
C
C       DETERMINE THE FACTORS FOR THE WINDOW TO VIEWPORT MAPPING
C
      SX = (XVR - XVL)/(XR - XL)
      SY = (YVT - YVB)/(YT - YB)
C
C       TO PRESERVE PROPORTIONALITY USE THE SMALLEST OF THE SX AND SY
C       IN BOTH X AND Y DIRECTIONS
C
      IF (SX.GT.SY) THEN
        SX = SY
      ELSE
        SY = SX
      END IF
C
C       INITIALIZE THE PLOTTING DEVICE
C
      CALL IDENT
      CALL JOBPLT
C      CALL PLOT(1.,1.,-3)
      CALL VTHICK( ITHICK )
C
C       DETERMINE THE LINE AND THE NODE CONNECTIVITY OF THE MESH
C
      DO ELNUM = 1 , NELEM
        CALL ELINFO(ELNUM,ELEM_TYPE,NN,MATNUM,STRS_STRN_REL,
     .              ISTART,LINES)
        ISTOP = ISTART + LINES - 1
        DO K2 = ISTART , ISTOP
          J1 = NOP(IS( K2 ), ELNUM)
          J2 = NOP(IE( K2 ), ELNUM)
          ICODE = 0
          DO K1 = 1 , NLINES
            IF (J2.EQ.IVS(K1).OR.J2.EQ.IVE(K1)) THEN
              IF (J1.EQ.IVE(K1).OR.J1.EQ.IVS(K1)) THEN
                IREP( K1 ) = IREP( K1 ) + 1
                ICODE = 1
              END IF
            END IF
          END DO
          IF (ICODE.EQ.0) THEN
            NLINES = NLINES + 1
            IF(NLINES.GT.MAX_LINES) THEN
              WRITE(STR1,'(I39)')NLINES
              WRITE(STR2,'(I39)')MAX_LINES
              LSTR1=STR$COLLAPSE(STR1,STR1)
              LSTR2=STR$COLLAPSE(STR2,STR2)
              WRITE(I_OUT,*)'NUMBER OF LINES IN MESH ('//STR1(:LSTR1)//
     .            ') EXCEEDES ALLOWABLE (MAX_LINES='//STR2(:LSTR2)//').'
     .            //' REMAINING GRAPHICAL OUTPUT SKIPPED.'
              WRITE(*,*)'NUMBER OF LINES IN MESH ('//STR1(:LSTR1)//
     .            ') EXCEEDES ALLOWABLE (MAX_LINES='//STR2(:LSTR2)//').'
     .            //' REMAINING GRAPHICAL OUTPUT SKIPPED.'
              GRAPHICS_OUT=.FALSE.
              RETURN
            ENDIF
            IREP( NLINES ) = IREP( NLINES ) + 1
            IVS( NLINES ) = J1
            IVE( NLINES ) = J2
          END IF
        END DO
        DO K1 = 1 , NN
          NODE = NOP(K1 , ELNUM)
          IREP( NODE ) = IREP( NODE ) + 32
        END DO
      END DO
C
      END
C
C  ===================================================================
C  ======================== P L O T E R ==============================
C  ===================================================================
C
      SUBROUTINE PLOTER(NNODES,NELEM,NNDF,IDIM,NINODE)
C
C  ===================================================================
C  I                                                                 I
C  I    SUBROUTINE PLOTER IS DESIGNED TO PLOT THE MESH BEFORE AND    I
C  I    AFTER THE ANALYSIS HAS BEEN PERFORMED, FOR BOTH THE EIGHT    I
C  I    AND THE FOUR NODE ELEMENTS                                   I
C  I                                                                 I
C  I    DMAG  =  MAGNIFICATION FACTOR TO BE USED FOR DISPLACEMENTS   I
C  I    FMAG  =  MAGNIFICATION FACTOR TO BE USED FOR GEOMETRY        I
C  I    NE    =  NUMBER OF ELEMENTS IN THE MESH                      I
C  I    NN    =  NUMBER OF NODES FOR EACH ELEMENT                    I
C  I    X(I)  =  X-COORDINATE OF THE NODE                            I
C  I    Y(I)  =  Y-COORDINATE OF THE NODE                            I
C  I    Z(I)  =  Z-COORDINATE OF THE NODE                            I
C  I                                                                 I
C  ===================================================================
C
      IMPLICIT NONE
      INTEGER MAX_NODES,MAX_ELEMENTS,MAX_ELEM_NODES,MAX_ELEM_BOUND
      INTEGER MAX_LINES,NFRAME,MNNDF,MAX_NODES_DOF,MAX_CONT_SEGS
      INTEGER STRS_STRN_REL,AXISYMMETRIC
      PARAMETER (AXISYMMETRIC=3)
      PARAMETER (MAX_NODES=3000,MAX_ELEMENTS=400,MAX_ELEM_NODES=20,
     .           MAX_ELEM_BOUND=48,MAX_LINES=3000,MAX_CONT_SEGS=100)
      PARAMETER (NFRAME=10,MNNDF=3,MAX_NODES_DOF=MAX_NODES*MNNDF)
      REAL*4 X,Y,Z,DMAG,FMAG,R,RISE,RUN,SLOPE,V1,V2,VCONT,VCONT1
      REAL*4 VH,VINTR,VL,VMAX,VMAX1,VMIN,VMIN1,X1,X2,XE,XS,Y1,Y2,YE
      REAL*4 XC(MAX_CONT_SEGS),XXE(MAX_CONT_SEGS),XXS(MAX_CONT_SEGS)
      REAL*4 YC(MAX_CONT_SEGS),YYE(MAX_CONT_SEGS),YYS(MAX_CONT_SEGS)
      REAL*4 YS,ZE,ZS,VLEGND(10),ZERO,EPS,SYM_HT
      INTEGER ELNUM,STR$LENGTH,ELEM_TYPE,ICODE,ICOOR
      INTEGER ID1,ID2,IDENT1,IDENT2,IDIM,IFRAME,IFTL,INCREM,INFRAME
      INTEGER INTGPN,IPTYPE,IR,IR1,IRLINE,ISTART,ISTOP
      INTEGER ITHICK,IVEND,IVSTR,K1,K2,K3,LDEV,LDEV1,LDEV2,LDEV3,LDEV4
      INTEGER LDEVST,LE,LE1,LE2,LINES,LNUM,LNUM1,LS,LS2,LSN,MATNUM
      INTEGER NCLS,NCONT,NELEM,NINODE,NIT,NLINES,NIP
      INTEGER NN,NNDF,NNODES,NODE,NODE1,NODE2,IE,IREP,IS,IVE,IVS,IYIEL
      INTEGER LEGEND(10),LNEND(MAX_LINES),LNSTR(MAX_LINES),NOP
      INTEGER NIPXI,NIPETA,NIPSI,INTCOD,OUTPUT_INTR,GRAPHICS_INTR
      INTEGER I_OUT,I_IN,I_GRAPH,STR$COLLAPSE,LSTR1,LSTR2
      REAL*8 UTOTAL,XIP,YIP,ZIP,UXIP,UYIP,UZIP,THICK
C
C     NOTE:  ARRAY "VALUE" HAS TO BE DIMENSIONED 'NFRAME' TIMES THE
C            MAXIMUM NUMBER OF NODES.
C
      REAL*4 VALUE(NFRAME*MAX_NODES)
      LOGICAL LOGIC,CONTOURS,RESTART,GRAPHICS_OUT
      CHARACTER*80 AXFRAME_TITLE(NFRAME)*40,LEGSTR(5)
      CHARACTER*40 FRAME_TITLE(NFRAME),STR1,STR2
      COMMON/INPUT1/NIPXI,NIPETA,NIPSI,NIP,INTCOD
      COMMON/INPUT2/NOP(MAX_ELEM_NODES,MAX_ELEMENTS)
      COMMON/GRAPH1/IS(MAX_ELEM_BOUND),IE(MAX_ELEM_BOUND)
      COMMON/GRAPH2/IVS(MAX_LINES),IVE(MAX_LINES)
      COMMON/IREP1/IREP(MAX_LINES)
      COMMON/INPUT3/X(MAX_NODES),Y(MAX_NODES),Z(MAX_NODES)
      COMMON/DEVICE/LDEV1,LDEV2,LDEV3,LDEV4,LDEV,LDEVST
      COMMON/MAIN2/UTOTAL(MAX_NODES_DOF)
      COMMON/GRAPH5/FMAG,DMAG,CONTOURS,ITHICK,NLINES
      COMMON/PLAST1/IYIEL(MAX_ELEMENTS)
      COMMON/CONTR1/INCREM,NIT
      COMMON/INPUT9/THICK,STRS_STRN_REL
      COMMON/INPUTG/RESTART,OUTPUT_INTR,GRAPHICS_INTR,GRAPHICS_OUT
      COMMON/IN_IO/I_OUT,I_IN,I_GRAPH
C
      DATA FRAME_TITLE /'(STRESS: X)','(STRESS: Y)','(STRESS: XY)',
     .                  '(STRESS: Z)','(STRAIN: X)','(STRAIN: Y)',
     .                  '(STRAIN: XY)','(STRAIN: Z)',
     .                  '(VOLUMETRIC STRAINS)','(WORK)' /
      DATA AXFRAME_TITLE /'(STRESS: R)','(STRESS: Z)','(STRESS: RZ)',
     .                  '(STRESS: THETA)','(STRAIN: R)','(STRAIN: Z)',
     .                  '(STRAIN: RZ)','(STRAIN: THETA)',
     .                  '(VOLUMETRIC STRAINS)','(WORK)' /
      DATA ZERO,EPS,SYM_HT/0.0,1.0E-20,0.1/
C
C       IR = MAXIMUM NUMBER OF REPETITIONS FOR SURFACE LINES
C
      IR = IDIM - 1
C
C ----- IDENTIFY EACH NODE BY A DIAMOND
C
      DO NODE = 1 , NNODES
        ID1 = NNDF*(NODE - 1)
        XS = X( NODE )*FMAG + UTOTAL( ID1 + 1 )*DMAG
        YS = Y( NODE )*FMAG + UTOTAL( ID1 + 2 )*DMAG
        CALL VIEW2(XS,YS,SYM_HT,5)
      END DO
      DO ELNUM = 1 , NELEM
        CALL ELINFO(ELNUM,ELEM_TYPE,NN,MATNUM,STRS_STRN_REL,
     .              ISTART,LINES)
        DO INTGPN = 1 , NIP
          LOGIC = BTEST(IYIEL( ELNUM ) , INTGPN)
          IF (LOGIC) THEN
            CALL COORD1(ELNUM,NN,INTGPN,XIP,YIP,ZIP)
            CALL COORD2(ELNUM,NN,INTGPN,NNDF,UXIP,UYIP,UZIP)
            XS = XIP*FMAG + UXIP*DMAG
            YS = YIP*FMAG + UYIP*DMAG
            CALL VIEW2(XS,YS,SYM_HT,11)
          END IF
        END DO
      END DO
      DO K1 = 1 , NLINES
        NODE1 = IVS( K1 )
        NODE2 = IVE( K1 )
        ID1 = NNDF*(NODE1 - 1)
        ID2 = NNDF*(NODE2 - 1)
        XS = X( NODE1 )*FMAG + UTOTAL( ID1 + 1 )*DMAG
        YS = Y( NODE1 )*FMAG + UTOTAL( ID1 + 2 )*DMAG
        XE = X( NODE2 )*FMAG + UTOTAL( ID2 + 1 )*DMAG
        YE = Y( NODE2 )*FMAG + UTOTAL( ID2 + 2 )*DMAG
        IF (IDIM.EQ.3) THEN
          ZS = Z( NODE1 )*FMAG + UTOTAL( ID1 + 3 )*DMAG
          ZE = Z( NODE2 )*FMAG + UTOTAL( ID2 + 3 )*DMAG
        ELSE
          ZS = ZERO
          ZE = ZERO
        END IF
        CALL CLIP(XS,YS,ZS,1.,XE,YE,ZE,1.)
      END DO
      CALL EOPLOT(0)
      IF (.NOT.CONTOURS.OR.INCREM.EQ.0) RETURN
      CALL EXTRAP(NELEM,NNODES,VALUE,IPTYPE)
      IF(IPTYPE.EQ.1)INFRAME=9
      IF(IPTYPE.EQ.2)INFRAME=10
      DO IFRAME=1,INFRAME
        CALL NNUM0
C
C        DRAW THE BOUNDARY OF THE MESH
C
        DO 50 K1 = 1 , NLINES
          IRLINE = IAND(IREP(K1),31)
          IF (IRLINE.GT.IR) GO TO 50
          NODE1 = IVS( K1 )
          NODE2 = IVE( K1 )
          ID1 = NNDF*(NODE1 - 1)
          ID2 = NNDF*(NODE2 - 1)
          XS = X( NODE1 )*FMAG + UTOTAL( ID1 + 1 )*DMAG
          YS = Y( NODE1 )*FMAG + UTOTAL( ID1 + 2 )*DMAG
          XE = X( NODE2 )*FMAG + UTOTAL( ID2 + 1 )*DMAG
          YE = Y( NODE2 )*FMAG + UTOTAL( ID2 + 2 )*DMAG
          IF (IDIM.EQ.3) THEN
            ZS=Z(NODE1)*FMAG+UTOTAL(ID1+3)*DMAG
            ZE=Z(NODE2)*FMAG+UTOTAL(ID2+3)*DMAG
          ELSE
            ZS=ZERO
            ZE=ZERO
          END IF
          CALL CLIP(XS,YS,ZS,1.,XE,YE,ZE,1.)
 50     CONTINUE
C
C        DRAW THE CURVED BOUNDARY OF THE DIE IF THERE IS ONE.
C
        IF (NINODE.GT.0) CALL CURVE
C
C        DRAW THE CONTOUR LINES
C
        IVSTR=(IFRAME-1)*NNODES+1
        IVEND=IFRAME*NNODES
        VMIN= VALUE(IVSTR)
        VMAX= VALUE(IVSTR)
        DO K1=IVSTR,IVEND
          VMIN=AMIN1(VMIN,VALUE(K1))
          VMAX=AMAX1(VMAX,VALUE(K1))
        END DO
C
C       ADJUST THE VMAX AND VMIN SO THAT CONTOURS CLOSE TO THESE VALUES
C       ARE ALSO GENERATED.
C
        VMIN1=VMIN
        VMAX1=VMAX
        VMAX=VMAX-ABS(VMAX)/50.
        VMIN=VMIN+ABS(VMIN)/50.
        VINTR=(VMAX-VMIN)/9.
        VCONT=VMIN
        K3=0
        DO NCONT=0,9
          K3=K3+1
          VLEGND(K3)=VCONT
          LEGEND(K3)=NCONT
          NCLS=0
          DO ELNUM=1,NELEM
            CALL ELINFO(ELNUM,ELEM_TYPE,NN,MATNUM,STRS_STRN_REL,ISTART,
     .                  LINES)
            ISTOP=ISTART+LINES-1
            ICODE=0
            DO K1=ISTART,ISTOP
              NODE1=NOP(IS(K1),ELNUM)
              NODE2=NOP(IE(K1),ELNUM)
              ID1=NODE1+IVSTR-1
              ID2=NODE2+IVSTR-1
              V1=VALUE(ID1)
              V2=VALUE(ID2)
              VH=AMAX1(V1,V2)
              VL=AMIN1(V1,V2)
              IF (VCONT.EQ.VL.OR.VCONT.EQ.VH) THEN
                VCONT1=VCONT+VCONT/10000.
              ELSE
                VCONT1=VCONT
              END IF
              IF (VCONT.GT.VL.AND.VCONT.LT.VH) THEN
                R=(VCONT1-V1)/(V2-V1)
                IDENT1=NNDF*(NODE1-1)
                IDENT2=NNDF*(NODE2-1)
                X1=X(NODE1)*FMAG+UTOTAL(IDENT1+1)*DMAG
                X2=X(NODE2)*FMAG+UTOTAL(IDENT2+1)*DMAG
                Y1=Y(NODE1)*FMAG+UTOTAL(IDENT1+2)*DMAG
                Y2=Y(NODE2)*FMAG+UTOTAL(IDENT2+2)*DMAG
                IF (ICODE.EQ.0) THEN
                  XS=X1+R*(X2-X1)
                  YS=Y1+R*(Y2-Y1)
                  CALL GETLIN(NODE1,NODE2,NLINES,LNUM1)
                  ICODE=1
                ELSE
                  NCLS=NCLS+1
                  IF(NCLS.GT.MAX_CONT_SEGS) THEN
                    WRITE(STR1,'(I39)')NCLS
                    WRITE(STR2,'(I39)')MAX_CONT_SEGS
                    LSTR1=STR$COLLAPSE(STR1,STR1)
                    LSTR2=STR$COLLAPSE(STR2,STR2)
                    WRITE(I_OUT,*)'NUMBER OF CONTOUR SEGMENTS ('//
     .               STR1(:LSTR1)//') EXCEEDS ALLOWABLE (MAX_CONT_SEGS='
     .               //STR2(:LSTR2)//'). REMAINGING SEGMENTS IGNORED'
                    WRITE(*,*)'NUMBER OF CONTOUR SEGMENTS ('//
     .               STR1(:LSTR1)//') EXCEEDS ALLOWABLE (MAX_CONT_SEGS='
     .               //STR2(:LSTR2)//'). REMAINGING SEGMENTS IGNORED'
                    NCLS=MAX_CONT_SEGS
                    GOTO 60
                  ENDIF
                  XXS(NCLS)=XS
                  YYS(NCLS)=YS
                  XXE(NCLS)=X1+R*(X2-X1)
                  YYE(NCLS)=Y1+R*(Y2-Y1)
                  CALL GETLIN(NODE1,NODE2,NLINES,LNUM)
                  LNEND(NCLS)=LNUM
                  LNSTR(NCLS)=LNUM1
                  ICODE=0
                END IF
              END IF
60            CONTINUE
            END DO
          END DO
C
C        SEARCH FOR THE CONTOUR LINES WHICH CROSS THE BOUNDARIES
C
          DO 120 K1 = 1 , NCLS
            IR1 = 0
            IF (LNSTR( K1 ).EQ.0) GO TO 120
            IF (IAND(IREP(LNSTR( K1 )),31).EQ.1) THEN
              XC( 1 ) = XXS( K1 )
              YC( 1 ) = YYS( K1 )
              XC( 2 ) = XXE( K1 )
              YC( 2 ) = YYE( K1 )
              IR1 = 1
              LE = LNEND( K1 )
              LSN = LNSTR( K1 )
              LNSTR( K1 ) = 0
            ELSE IF(IAND(IREP(LNEND( K1 )),31).EQ.1) THEN
              XC( 2 ) = XXS( K1 )
              YC( 2 ) = YYS( K1 )
              XC( 1 ) = XXE( K1 )
              YC( 1 ) = YYE( K1 )
              LE = LNSTR( K1 )
              LSN = LNEND( K1 )
              LNSTR( K1 ) = 0
              IR1 = 1
            END IF
            IF (IR1.EQ.1) THEN
              ICOOR = 2
 100          CONTINUE
              DO 110 K2 = 1 , NCLS
                LS2 = LNSTR( K2 )
                IF (K2.EQ.K1.OR.LS2.EQ.0) GO TO 110
                LE2 = LNEND( K2 )
                IF (LS2.EQ.LE) THEN
                  ICOOR = ICOOR + 1
                  XC( ICOOR ) = XXE( K2 )
                  YC( ICOOR ) = YYE( K2 )
                  LE = LNEND( K2 )
                  LNSTR( K2 ) = 0
                  IF (IAND(IREP( LE ),31).EQ.1) THEN
                    CALL DLINE(XC,YC,ICOOR-1)
                    RISE=YC(ICOOR)-YC(1)
                    RUN=XC(ICOOR)-XC(1)
                    IF(ABS(RUN).LE.EPS.AND.ABS(RISE).LE.EPS)THEN
                      SLOPE=ZERO
                    ELSE
                      SLOPE=ATAN2(RISE,RUN)
                    ENDIF
                    CALL NUMLIN(XC(1),YC(1),NCONT,SLOPE)
                    CALL NUMLIN(XC(ICOOR),YC(ICOOR),NCONT,SLOPE)
                    GO TO 120
                  END IF
                  GO TO 100
                ELSE IF(LE2.EQ.LE) THEN
                  ICOOR = ICOOR + 1
                  XC( ICOOR ) = XXS( K2 )
                  YC( ICOOR ) = YYS( K2 )
                  LE = LNSTR( K2 )
                  LNSTR( K2 ) = 0
                  IF (IAND(IREP( LE ),31).EQ.1) THEN
                    CALL DLINE(XC,YC,ICOOR-1)
                    RISE=YC(ICOOR)-YC(1)
                    RUN=XC(ICOOR)-XC(1)
                    IF(ABS(RUN).LE.EPS.AND.ABS(RISE).LE.EPS)THEN
                      SLOPE=ZERO
                    ELSE
                      SLOPE=ATAN2(RISE,RUN)
                    ENDIF
                    CALL NUMLIN(XC(1),YC(1),NCONT,SLOPE)
                    CALL NUMLIN(XC(ICOOR),YC(ICOOR),NCONT,SLOPE)
                    GO TO 120
                  END IF
                  GO TO 100
                END IF
 110          CONTINUE
            END IF
 120      CONTINUE
C
C        SEARCH FOR THE CONTOUR LINES WHICH FORM A CLOSED LOOP INSIDE
C        THE MESH REGION.
C
          DO 150 K1 = 1 , NCLS
            LS = LNSTR( K1 )
            LE = LS
            IF (LS.NE.0) THEN
              XC( 1 ) = XXS( K1 )
              YC( 1 ) = YYS( K1 )
              XC( 2 ) = XXE( K1 )
              YC( 2 ) = YYE( K1 )
              LE1 = LNEND( K1 )
              LNSTR( K1 ) = 0
              ICOOR = 2
 130          CONTINUE
              DO 140 K2 = 1 , NCLS
                LS2 = LNSTR( K2 )
                IF (K2.EQ.K1.OR.LS2.EQ.0) GO TO 140
                LE2 = LNEND( K2 )
                IF (LS2.EQ.LE1) THEN
                  ICOOR = ICOOR + 1
                  XC( ICOOR ) = XXE( K2 )
                  YC( ICOOR ) = YYE( K2 )
                  LE1 = LNEND( K2 )
                  LNSTR( K2 ) = 0
                  IF (LE1.EQ.LE.AND.ICOOR.GT.3) THEN
                    CALL DLINE(XC,YC,ICOOR-1)
                    CALL NUMLIN(XC(ICOOR),YC(ICOOR),NCONT,ZERO)
                    GO TO 150
                  END IF
                  GO TO 130
                ELSE IF(LE2.EQ.LE1) THEN
                  ICOOR = ICOOR + 1
                  XC( ICOOR ) = XXS( K2 )
                  YC( ICOOR ) = YYS( K2 )
                  LE1 = LNSTR( K2 )
                  LNSTR( K2 ) = 0
                  IF (LE1.EQ.LE.AND.ICOOR.GT.3) THEN
                    CALL DLINE(XC,YC,ICOOR-1)
                    CALL NUMLIN(XC(ICOOR),YC(ICOOR),NCONT,ZERO)
                    GO TO 150
                  END IF
                  GO TO 130
                END IF
 140          CONTINUE
            END IF
 150      CONTINUE
          VCONT = VCONT + VINTR
        END DO
        CALL PLTNUM
        IF(STRS_STRN_REL.EQ.AXISYMMETRIC) THEN
          IFTL=STR$LENGTH(AXFRAME_TITLE(IFRAME))
          WRITE(LEGSTR(1) , 1002)IFRAME,AXFRAME_TITLE(IFRAME)(:IFTL),
     .                         INCREM
        ELSE
          IFTL=STR$LENGTH(FRAME_TITLE(IFRAME))
          WRITE(LEGSTR(1) , 1002)IFRAME,FRAME_TITLE(IFRAME)(:IFTL),
     .                         INCREM
        ENDIF
        WRITE(LEGSTR(2) , 1003)VMIN1,VMAX1
        WRITE(LEGSTR(3) , 1001)(LEGEND(K1),VLEGND(K1),K1 = 1 , 4)
        WRITE(LEGSTR(4) , 1001)(LEGEND(K1),VLEGND(K1),K1 = 5 , 8)
        WRITE(LEGSTR(5) , 1001)(LEGEND(K1),VLEGND(K1),K1 = 9 , 10)
        CALL LEGEND_OUT(LEGSTR)
        CALL EOPLOT(0)
      END DO
 1001 FORMAT(1X,I1,' = ',E11.4,6X,I1,' = ',E11.4,6X,I1,' = ',E11.4,
     .       6X,I1,' = ',E11.4)
 1002 FORMAT(1X,'LEGEND FOR FRAME NUMBER ',I3,' ',A,' AT LOAD STEP ',I3)
 1003 FORMAT(1X,'MINIMUM = ',E11.4,6X,'MAXIMUM = ',E11.4)
C
      END
C
C ======================================================================
C ========================== G E T L I N ===============================
C ======================================================================
C
      SUBROUTINE GETLIN(NODE1,NODE2,NLINES,LNUM)
      IMPLICIT NONE
      INTEGER MAX_LINES,K1,LNUM,NLINES,NODE1,NODE2,IVE,IVS
      PARAMETER (MAX_LINES=3000)
      COMMON/GRAPH2/IVS(MAX_LINES),IVE(MAX_LINES)
C
      DO K1 = 1 , NLINES
        IF (NODE1.EQ.IVS( K1 ).OR.NODE1.EQ.IVE( K1 )) THEN
          IF (NODE2.EQ.IVE( K1 ).OR.NODE2.EQ.IVS( K1 )) THEN
            LNUM = K1
            RETURN
          END IF
        END IF
      END DO
C
      END
C
C ======================================================================
C ========================== D L I N E =================================
C ======================================================================
C
      SUBROUTINE DLINE(XC,YC,NLIN)
      IMPLICIT NONE
      INTEGER K1,NLIN
      REAL*4 XC(*),YC(*),XE,XS,YE,YS
C
      XS = XC( 1 )
      YS = YC( 1 )
      DO K1 = 2 , NLIN+1
        XE = XC( K1 )
        YE = YC( K1 )
        CALL CLIP(XS,YS,0.,1.,XE,YE,0.,1.)
        XS = XE
        YS = YE
      END DO
C
      END
C
C ======================================================================
C ========================= N U M L I N ================================
C ======================================================================
C
      SUBROUTINE NUMLIN(XE,YE,NCONT,THETA)
      IMPLICIT NONE
      INTEGER MAX_CONT_LINES
      PARAMETER (MAX_CONT_LINES=100)
      REAL*4 ANGLE,FPN,HEIGHT,TDIF,THETA,TOL,X1,X2,XDIF
      REAL*4 XE,Y1,Y2,YDIF,YE,XVL,XVR,YVB,YVT,SX,SY
      REAL*4 XNUM(MAX_CONT_LINES),YNUM(MAX_CONT_LINES),
     .       SLOPE(MAX_CONT_LINES)
      INTEGER NUMVAL(MAX_CONT_LINES),ICODE,NNUM,K1,K2,NCONT
      INTEGER I_OUT,I_IN,I_GRAPH,STR$COLLAPSE,LSTR1,LSTR2
      CHARACTER*40 STR1,STR2
      COMMON/GRAPH4/XVL,XVR,YVB,YVT,SX,SY
      COMMON/IN_IO/I_OUT,I_IN,I_GRAPH
C
      SAVE HEIGHT,NNUM,XNUM,YNUM,NUMVAL,SLOPE
C
      HEIGHT = 0.1
      NNUM = NNUM + 1
      IF(NNUM.GT.MAX_CONT_LINES) THEN
        WRITE(STR1,'(I39)')NNUM
        WRITE(STR2,'(I39)')MAX_CONT_LINES
        LSTR1=STR$COLLAPSE(STR1,STR1)
        LSTR2=STR$COLLAPSE(STR2,STR2)
        WRITE(I_OUT,*)'NUMBER OF CONTOUR LINES ('//STR1(:LSTR1)//') '//
     .       'EXCEEDS ALLOWABLE (MAX_CONT_LINES='//STR2(:LSTR2)//'). '//
     .       'REMAINING CONTOUR LINES NOT DRAWN'
        WRITE(*,*)'NUMBER OF CONTOUR LINES ('//STR1(:LSTR1)//') '//
     .       'EXCEEDS ALLOWABLE (MAX_CONT_LINES='//STR2(:LSTR2)//'). '//
     .       'REMAINING CONTOUR LINES NOT DRAWN'
        NNUM=MAX_CONT_LINES
        RETURN
      ENDIF
      SLOPE(NNUM) = THETA
      XNUM( NNUM ) = XE - HEIGHT * COS(THETA)
      YNUM( NNUM ) = YE + HEIGHT * SIN(THETA)
      NUMVAL( NNUM ) = NCONT
      RETURN
C
C ======================== E N T R Y    P L T N U M ===================
C
      ENTRY PLTNUM
      ANGLE = 90.
      TOL = 1.6*HEIGHT/SX
      FPN = FLOAT(NUMVAL( 1 ))
      CALL VIEW3(XNUM( 1 ),YNUM( 1 ),HEIGHT,FPN,SLOPE(1),-1)
      DO K1 = 2 , NNUM
        ICODE = 0
        X1 = XNUM( K1 )
        Y1 = YNUM( K1 )
        DO K2 = 1 , K1 - 1
          IF (NUMVAL(K2).GE.0) THEN
            X2 = XNUM( K2 )
            Y2 = YNUM( K2 )
            XDIF = X1 - X2
            YDIF = Y1 - Y2
            TDIF = SQRT(XDIF**2 + YDIF**2)
            IF (TDIF.LT.TOL) ICODE = 1
          END IF
        END DO
        IF (ICODE.EQ.0) THEN
          FPN = FLOAT(NUMVAL( K1 ))
          CALL VIEW3(X1,Y1,HEIGHT,FPN,SLOPE(K1),-1)
        ELSE
          NUMVAL( K1 ) = -1
        END IF
      END DO
      RETURN
C
C ======================== E N T R Y    N N U M 0 =====================
C
      ENTRY NNUM0
      NNUM = 0
C
      END
C
C ======================================================================
C =========================== C L I P ==================================
C ======================================================================
C
      SUBROUTINE CLIP(X1,Y1,Z1,W1,X2,Y2,Z2,W2)
      IMPLICIT NONE
      INTEGER ZOR,ZAND,ICK,IZ,IZ1,IZ2,IZAND,IZOR,IZONE
      REAL*4 CNST,D,W1,W2,WW,X1,X2,XL,XR,XX,Y1,Y2,YB,YT,YY,Z1,Z2,ZF
      COMMON/GRAPH3/XL,XR,YB,YT,ZF,D
      EQUIVALENCE (IZOR,ZOR),(IZAND,ZAND)
C
      IF (W1.EQ.1..AND.W2.EQ.1.) GO TO 90
      IF (Z1.GT.ZF.AND.Z2.GT.ZF) RETURN
      IF(Z1.LE.ZF.AND.Z2.LE.ZF) GO TO 90
      CNST = (ZF - Z1)/(Z1 - Z2)
      XX = X1 + CNST*(X1 - X2)
      YY = Y1 + CNST*(Y1 - Y2)
      WW = (1. - ZF/D)
      IF (Z1.GT.ZF) THEN
        X1 = XX
        Y1 = YY
        W1 = WW
      ELSE IF(Z2.GT.ZF) THEN
        X2 = XX
        Y2 = YY
        W2 = WW
      END IF
  90  X1 = X1/W1
      Y1 = Y1/W1
      X2 = X2/W2
      Y2 = Y2/W2
      IZ1 = IZONE(X1 , Y1)
      IZ2 = IZONE(X2 , Y2)
 100  ZOR = IOR(IZ1 , IZ2)
      IF (IZOR.NE.0) GO TO 400
 200  CALL VIEW1(X1,Y1,3)
      CALL VIEW1(X2,Y2,2)
      RETURN
 400  ZAND = IAND(IZ1 , IZ2)
      IF (IZAND.NE.0) RETURN
      ZAND = IAND(ZOR ,  1)
      IF (IZAND.EQ.0) GO TO 900
      XX = XL
      ICK = 1
 500  YY = Y1 + (Y2 - Y1)/(X2 - X1)*(XX - X1)
 600  IZ = IZONE(XX , YY)
      ZAND = IAND(IZ1 , ICK)
      IF (IZAND.NE.0) GO TO 800
 700  X2 = XX
      Y2 = YY
      IZ2 = IZ
      GO TO 100
 800  X1 = XX
      Y1 = YY
      IZ1 = IZ
      GO TO 100
 900  ZAND = IAND(ZOR , 2)
      IF (IZAND.EQ.0) GO TO 1000
      XX = XR
      ICK = 2
      GO TO 500
 1000 ZAND = IAND(ZOR , 4)
      IF (IZAND.EQ.0) GO TO 1200
      YY = YB
      ICK = 4
 1100 XX = X1 + (X2 - X1)/(Y2 - Y1)*(YY - Y1)
      GO TO 600
 1200 YY = YT
      ICK = 8
      GO TO 1100
C
      END
C
C ======================================================================
C =========================== I Z O N E ================================
C ======================================================================
C
      INTEGER FUNCTION IZONE(X,Y)
      IMPLICIT NONE
      REAL*4 D,X,XL,XR,Y,YB,YT,ZF
      COMMON/GRAPH3/XL,XR,YB,YT,ZF,D
C
      IZONE = 0
      IF (X.LT.XL) IZONE = 1
      IF (X.GT.XR) IZONE = 2
      IF (Y.LT.YB) IZONE = IZONE + 4
      IF (Y.GT.YT) IZONE = IZONE + 8
C
      END
C
C ======================================================================
C =========================== V I E W ==================================
C ======================================================================
C
      SUBROUTINE VIEW(X,Y,IPEN)
      IMPLICIT NONE
      INTEGER ICODE,IPEN,ISYM
      REAL*4 ANGLE,D,FPN,HEIGHT,SX,SY,X,XL,XR,XV,XVL,XVR,Y,YB,YT,YV
      REAL*4 YVB,YVT,ZF
      COMMON/GRAPH3/XL,XR,YB,YT,ZF,D
      COMMON/GRAPH4/XVL,XVR,YVB,YVT,SX,SY
C
C ======================== E N T R Y    V I E W 1 =====================
C
      ENTRY VIEW1(X,Y,IPEN)
      XV = SX*(X - XL) + XVL
      YV = SY*(Y - YB) + YVB
      CALL PLOT(XV,YV,IPEN)
      RETURN
C
C ======================== E N T R Y    V I E W 2 =====================
C
      ENTRY VIEW2(X,Y,HEIGHT,ISYM)
      IF (X.LT.XL.OR.X.GT.XR.OR.Y.LT.YB.OR.Y.GT.YT) RETURN
      XV = SX*(X - XL) + XVL
      YV = SY*(Y - YB) + YVB
      CALL SYMBOL(XV,YV,HEIGHT,ISYM,0.,-1)
      RETURN
C
C ======================== E N T R Y    V I E W 3 =====================
C
      ENTRY VIEW3(X,Y,HEIGHT,FPN,ANGLE,ICODE)
      IF (X.LT.XL.OR.X.GT.XR.OR.Y.LT.YB.OR.Y.GT.YT) RETURN
      XV = SX*(X - XL) + XVL
      YV = SY*(Y - YB) + YVB
      CALL NUMBER(XV,YV,HEIGHT,FPN,ANGLE,ICODE)
C
      END
C
C ======================================================================
C =========================== E X T R A P ==============================
C ======================================================================
C
      SUBROUTINE EXTRAP(NELEM,NNODES,VALUE,IPTYPE)
      IMPLICIT NONE
      INTEGER NFRAME,MAT_ELAS,MAT_PLAS,MAT_ELAS_DAM,MAT_PLAS_DAM
      INTEGER MAX_NODES,MAX_ELEMENTS,MAX_ELEM_NODES,MAX_MAT_TYPE
      INTEGER MAX_LINES
      PARAMETER (NFRAME=10)
      PARAMETER (MAT_ELAS=1,MAT_PLAS=2,MAT_ELAS_DAM=3,MAT_PLAS_DAM=4)
      PARAMETER (MAX_NODES=3000,MAX_ELEMENTS=400,MAX_ELEM_NODES=20)
      PARAMETER (MAX_MAT_TYPE=10,MAX_LINES=3000)
      REAL*8 A,ETA,WORK,XI,AWORK(9),CENTER(6)
      REAL*8 SIGXI(9),STRAIN(6),STRELA(6),STRESS(6),STRN(6,9),STRS(6,9)
      REAL*8 VOLUMS(9),N(MAX_ELEM_NODES),SIGETA(9),SHAPE(9,9)
      REAL*4 VALUE(*)
      INTEGER ELNUM,ELEM_TYPE,SAVED_ETYPE,STRS_STRN_REL
      INTEGER ID,ID1,IEND,INTGPN,IPTYPE,IRNODE,ISTART,IT,K1,K2,NIP
      INTEGER K3,LDEV,LDEV1,LDEV2,LDEV3,LDEV4,LDEVST,LINES,MATNUM,NELEM
      INTEGER NN,NNODES,NODE,INT22,INT33,IREP,IVE,IVS,MATYPE,NOP
      INTEGER NIPXI,NIPETA,NIPSI,INTCOD
      COMMON/INPUT1/NIPXI,NIPETA,NIPSI,NIP,INTCOD
      COMMON/INPUT2/NOP(MAX_ELEM_NODES,MAX_ELEMENTS)
      COMMON/INPUTF/MATYPE(MAX_MAT_TYPE)
      COMMON/DEVICE/LDEV1,LDEV2,LDEV3,LDEV4,LDEV,LDEVST
      COMMON/GRAPH2/IVS(MAX_LINES),IVE(MAX_LINES)
      COMMON/IREP1/IREP(MAX_LINES)
      COMMON/EXTRP1/INT33(9),INT22(4)
C
      DATA SIGXI/-1.,1.,1.,-1.,0.,1.,0.,-1.,0./
      DATA SIGETA/-1.,-1.,1.,1.,-1.,0.,1.,0.,0./
C
      DO K1=1,NFRAME*NNODES
        VALUE(K1) = 0.
      END DO
      SAVED_ETYPE=0
      DO ELNUM=1,NELEM
        CALL ELINFO(ELNUM,ELEM_TYPE,NN,MATNUM,STRS_STRN_REL,
     .              ISTART,LINES)
        IF (ELEM_TYPE.NE.SAVED_ETYPE) THEN
          IF (ELEM_TYPE.LT.300) THEN
            IF (NIP.EQ.4) THEN
              A=1.73205080756887653D0
              IT=2104
            ELSE
              A=1.29099444873580604D0
              IT=2109
            END IF
            DO K1=1,NN
              XI=SIGXI(K1)*A
              ETA=SIGETA(K1)*A
              CALL N2D(XI,ETA,N,IT)
              IF (NIP.EQ.4) THEN
                DO K2=1,NIP
                  SHAPE(INT22(K2),K1)=N(K2)
                END DO
              ELSE
                DO K2=1,NIP
                  SHAPE(INT33(K2),K1)=N(K2)
                END DO
              END IF
            END DO
            IEND=4
          ELSE
            RETURN
          END IF
        END IF
        SAVED_ETYPE=ELEM_TYPE
        DO INTGPN=1,NIP
          IF (MATYPE(MATNUM).EQ.MAT_ELAS) THEN
            READ(LDEV1) STRESS,STRAIN
            IPTYPE=1
          ELSE IF((MATYPE(MATNUM).EQ.MAT_PLAS)) THEN
            READ(LDEV1)STRESS,STRAIN,STRELA,CENTER,WORK
            AWORK(INTGPN)=WORK
            IPTYPE=2
          END IF
          VOLUMS(INTGPN)=(STRESS(1)+STRESS(2)+STRESS(4))/3.0D0
          DO K1=1,IEND
            STRS(K1,INTGPN)=STRESS(K1)
            STRN(K1,INTGPN)=STRAIN(K1)
          END DO
        END DO
C
C     OBTAIN INFORMATION FOR FRAMES #1-#4 (STRESS: X,Y,XY,Z)
C
        DO K1=1,NN
          NODE=NOP(K1,ELNUM)
          DO K2=1,IEND
            ID=(K2-1)*NNODES+NODE
            DO K3=1,NIP
              VALUE(ID)=VALUE(ID)+STRS(K2,K3)*SHAPE(K3,K1)
            END DO
          END DO
        END DO
C
C     OBTAIN INFORMATION FOR FRAMES #5-#8 (STRAIN: X,Y,XY,Z)
C
        DO K1=1,NN
          NODE=NOP(K1,ELNUM)
          DO K2=1,IEND
            ID=(IEND+K2-1)*NNODES+NODE
            DO K3=1,NIP
              VALUE(ID)=VALUE(ID)+STRN(K2,K3)*SHAPE(K3,K1)
            END DO
          END DO
        END DO
C
C     OBTAIN INFORMATION FOR FRAME #9 (VOLUMETRIC STRAIN)
C
        ID1=2*IEND*NNODES
        DO K1=1,NN
          ID=ID1+NOP(K1,ELNUM)
          DO K3=1,NIP
            VALUE(ID)=VALUE(ID)+VOLUMS(K3)*SHAPE(K3,K1)
          END DO
        END DO
C
C     OBTAIN INFORMATION FOR FRAME #10 (WORK)
C
        IF(IPTYPE.EQ.2) THEN
          ID1=(2*IEND+1)*NNODES
          DO K1=1,NN
            ID=ID1+NOP(K1,ELNUM)
            DO K3=1,NIP
              VALUE(ID)=VALUE(ID)+AWORK(K3)*SHAPE(K3,K1)
            END DO
          END DO
        ENDIF
      END DO
C
C     NORMALIZE VALUES
C
      DO K2=1,NFRAME
        ID1=(K2-1)*NNODES
        DO NODE=1,NNODES
          IRNODE=IREP(NODE)/32
          ID=ID1+NODE
          VALUE(ID)=VALUE(ID)/IRNODE
        END DO
      END DO
      CALL REWIN
C
      END
C
C =====================================================================
C ======================== C O O R D ==================================
C =====================================================================
C
      SUBROUTINE COORD
      IMPLICIT NONE
      INTEGER MAX_NODES,MAX_ELEMENTS,MAX_ELEM_NODES,MAX_GAUSS_PTS,MNNDF
      INTEGER MAX_NODES_DOF
      PARAMETER (MAX_NODES=3000,MAX_ELEMENTS=400,MAX_ELEM_NODES=20,
     .           MAX_GAUSS_PTS=27,MNNDF=3,MAX_NODES_DOF=MAX_NODES*MNNDF)
      REAL*4 X,Y,Z
      REAL*8 N,NXI,NETA,NSI,U(MNNDF),UXIP,UYIP,UZIP,X1,Y1,Z1,UTOTAL
      INTEGER ELNUM,ID,INTGPN,K,K1,NNDF,NNEL,NOP
      COMMON/MAIN2/UTOTAL(MAX_NODES_DOF)
      COMMON/INPUT2/NOP(MAX_ELEM_NODES,MAX_ELEMENTS)
      COMMON/INPUT3/X(MAX_NODES),Y(MAX_NODES),Z(MAX_NODES)
      COMMON/ISHAP1/N(MAX_ELEM_NODES,MAX_GAUSS_PTS),
     .              NXI(MAX_ELEM_NODES,MAX_GAUSS_PTS),
     .              NETA(MAX_ELEM_NODES,MAX_GAUSS_PTS),
     .              NSI(MAX_ELEM_NODES,MAX_GAUSS_PTS)
C
C ======================== E N T R Y    C O O R D 1 ===================
C
      ENTRY COORD1(ELNUM,NNEL,INTGPN,X1,Y1,Z1)
      X1 = 0.D0
      Y1 = 0.D0
      Z1 = 0.D0
      DO K = 1 , NNEL
        X1 = X1 + N(K , INTGPN)*X(NOP(K , ELNUM))
        Y1 = Y1 + N(K , INTGPN)*Y(NOP(K , ELNUM))
        Z1 = Z1 + N(K , INTGPN)*Z(NOP(K , ELNUM))
      END DO
      RETURN
C
C ======================== E N T R Y    C O O R D 2 ===================
C
      ENTRY COORD2(ELNUM,NNEL,INTGPN,NNDF,UXIP,UYIP,UZIP)
      U( 1 ) = 0.D0
      U( 2 ) = 0.D0
      U( 3 ) = 0.D0
      DO K = 1 , NNEL
        DO ID = 1 , NNDF
          K1 = NNDF*(NOP(K , ELNUM) - 1) + ID
          U( ID ) = U( ID ) + N(K , INTGPN)*UTOTAL( K1 )
        END DO
      END DO
      UXIP = U( 1 )
      UYIP = U( 2 )
      UZIP = U( 3 )
C
      END
