PROGRAM PLOTFLE
C=======================================================================
C   FINITE ELEMENT GRAPHICS FOR TWO-DIMENSIONAL CFD SOLUTIONS
C            ELEMENT TYPE: FOUR-NODED ISOPARAMETRIC ELEMENT
C         ORIGINAL CODE: NSEQ8GRA.FOR, EIJI FUKUMORI, JULY 1985
C=======================================================================
      PARAMETER ( MXE=24000,MXN=25000,MXB=6000, ND=4 )
C=======================================================================
      IMPLICIT REAL*8 ( A-H , O-Z )
C                                ARRAYS
      CHARACTER*12 INPFILE
      DIMENSION S(ND), B(2,ND)
      DIMENSION NODEX(MXE,ND)
      DIMENSION IBNDFX(MXB),IBNDFY(MXB),BVX(MXB),BVY(MXB)
      DIMENSION XCOORD(MXN),YCOORD(MXN),U(MXN),V(MXN),IB(MXE,ND),
     * UU(MXN), VV(MXN), DIVV(MXN),TAUXX(MXN), TAUYY(MXN), TAUXY(MXN)
      COMMON / DOMAIN / XMIN, XMAX, YMIN , YMAX
C=======================================================================
      DATA INPFILE /'STATIC.DAT'/
C=======================================================================
      WRITE(*,*)' STATIC GRAPHICS PROGRAM'
      WRITE (*,*)' READING IN DATA FILES'
      CALL INPUT ( MXE,MXN,MXB,ND,NE,NNODE,NBFX,NBFY,YOUNG,POISSON,
     * NODEX,XCOORD,YCOORD,U,V,IBNDFX,IBNDFY,BVX,BVY,NF,INPFILE,
     * DIVV, TAUXX,TAUYY,TAUXY )
C=======================================================================
      CALL MINMAX ( MXN, NNODE, XCOORD, XMIN , XMAX )
      CALL MINMAX ( MXN, NNODE, YCOORD, YMIN , YMAX )
      WRITE (*,*)' MAX & MIN IN X-COORDINATE: ', XMAX, XMIN
      WRITE (*,*)' MAX & MIN IN Y-COORDINATE: ', YMAX, YMIN
      IF ( XMAX-XMIN .LE. 0. ) STOP' OBJECT HAS NO LENGTH IN XCOORD.'
      IF ( YMAX-YMIN .LE. 0. ) STOP' OBJECT HAS NO LENGTH IN YCOORD.'
C=======================================================================
      NMENU = 6
   10 CALL MENU ( ITYPE )
      IF ( ITYPE .EQ. 1 ) CALL PLTEL4 ( ND,MXE,MXN,NODEX,NE,
     *                    XCOORD,YCOORD, NNODE,IB )
      IF ( ITYPE .EQ. 2 ) CALL PLTUV ( MXN,NNODE,XCOORD,YCOORD,U,V,NE,
     *                    MXE,ND,NODEX,UU, VV, YOUNG,POISSON,IB )
      IF ( ITYPE .EQ. 3 ) CALL PLTMISES  (MXE,MXN,ND,NE,NNODE,NODEX,
     *                    XCOORD,YCOORD,DIVV,S,B, IB )
      IF ( ITYPE .EQ. 4 ) CALL PLTTAUXX (MXE,MXN,ND,NE,NNODE,NODEX,
     *                    XCOORD,YCOORD,TAUXX,S,B, IB )
      IF ( ITYPE .EQ. 5 ) CALL PLTTAUYY (MXE,MXN,ND,NE,NNODE,NODEX,
     *                    XCOORD,YCOORD,TAUYY,S,B, IB )
      IF ( ITYPE .EQ. 6 ) CALL PLTTAUXY (MXE,MXN,ND,NE,NNODE,NODEX,
     *                    XCOORD,YCOORD,TAUXY,S,B, IB )
      IF (ITYPE.GT.NMENU ) STOP 'TERMINATION'
      IF (ITYPE.LE.0) STOP 'TERMINATION'
      GO TO 10
      END
C
C
      SUBROUTINE MENU ( ITYPE )
      WRITE (*,*)'----------------------------------------------------'
      WRITE (*,*)'   ID #                   MENU'
      WRITE (*,*)'===================================================='
      WRITE (*,*)'    0 OR LESS          TERMINATION'
      WRITE (*,*)'    1          FINITE ELEMENT DISCRETIZATION'
      WRITE (*,*)'    2               DISPLACEMENT VECTOR'
      WRITE (*,*)'    3              MISES-HENCKY CRITERION'
      WRITE (*,*)'    4              STRESS, TAUXX, CONTOUR'
      WRITE (*,*)'    5              STRESS, TAUYY, CONTOUR'
      WRITE (*,*)'    6              STRESS, TAUXY, CONTOUR'
      WRITE (*,*)'    7 OR MORE          TERMINATION'
      WRITE (*,*)'----------------------------------------------------'
      WRITE (*,*)' TYPE IN ID # = '
      READ (*,*) ITYPE
      RETURN
      END
C
C
      SUBROUTINE INPUT ( MXE,MXN,MXB,ND,NE,NNODE,NBFX,NBFY,YOUNG,
     * POISSON,NODEX,XCOORD,YCOORD,U,V,IBNDFX,IBNDFY,BVX,BVY,
     * NF,INPFILE,DIVV, TAUXX,TAUYY,TAUXY )
      IMPLICIT REAL*8 ( A-H , O-Z )
      DIMENSION NODEX(MXE,ND),XCOORD(MXN),YCOORD(MXN),U(MXN),
     * V(MXN),IBNDFX(MXB),IBNDFY(MXB),BVX(MXB),BVY(MXB)
      DIMENSION DIVV(MXN), TAUXX(MXN), TAUYY(MXN), TAUXY(MXN)
      CHARACTER*12 INPFILE, STRESSFL, DSPFILE
      LOGICAL YES
      WRITE (*,*)' READING IN STATIC.DAT DATA FILES'
C========> FILENAME INPFILE SEE MAIN PROGRAM
      INQUIRE ( FILE=INPFILE, EXIST=YES )
      IF ( YES ) THEN
      OPEN ( 1, FILE=INPFILE, STATUS='OLD' )
      ELSE
      WRITE (*,*)' INPUT FILE DOES NOT EXIST'
      STOP
      ENDIF
C========> PARAMETERS
      READ (1,*) YOUNG,  POISSON
C========> ELEMENTS
      READ (1,*) NE
                    IF ( NE    .GT. MXE) STOP'ERROR #1'
                    IF ( NE    .LE. 0  ) STOP'NE    =0'
      DO I = 1 , NE
      READ (1,*) IEL, ( NODEX(IEL,J), J = 1 , ND )
      END DO
C========> FILENAME COORDINATES OF NODAL POINTS
      READ (1,*) NNODE
                    IF ( NNODE .GT. MXN) STOP'ERROR #2'
                    IF ( NNODE .LE. 0  ) STOP'NNODE =0'
      DO I = 1 , NNODE
      READ (1,*) NODE, XCOORD(NODE) , YCOORD(NODE)
      END DO
C========> DIRICHLET TYPE BOUNDARY CONDITIONS
      READ (1,*) NBFX
                    IF ( NBFX  .GT. MXB) STOP'NBFX>MXB'
                    IF ( NBFX  .LT. 1  ) STOP'NBFX<1'
      DO I = 1 , NBFX
      READ (1,*) IBNDFX(I) , BVX(I)
      END DO
      READ (1,*) NBFY
                    IF ( NBFY  .GT. MXB) STOP'NBFY  .GT. MXB'
                    IF ( NBFY  .LT. 1  ) STOP'NBFY<1'
      DO I = 1 , NBFY
      READ (1,*) IBNDFY(I) , BVY(I)
      END DO
      CLOSE (1)
C========> FILENAME STRESS DATA    TAUXX, TAUYY, TAUXY, DIVV
      WRITE (*,*)' READING IN STRESS.DAT DATA FILES'
      STRESSFL = 'STRESS.DAT'
      INQUIRE ( FILE=STRESSFL, EXIST=YES )
      IF ( YES ) THEN
      OPEN ( 1, FILE=STRESSFL, STATUS='OLD' )
      ELSE
      WRITE (*,*)' STRESS FILE DOES NOT EXIST'
      STOP
      ENDIF
      READ(1,*)
      READ(1,*)
      DO NODE = 1 , NNODE
      READ (1,*) I, TAUXX(I) , TAUYY(I) , TAUXY(I) , DIVV(I)
      END DO
      CLOSE (1)
C========> FILENAME DISPLACE.MNT
      DSPFILE = 'DISPLACE.MNT'
      EXFILE = 'NEW'
      INQUIRE ( FILE=DSPFILE, EXIST=YES )
      IF ( YES ) THEN
      OPEN ( 1, FILE=DSPFILE, STATUS='OLD',FORM='UNFORMATTED' )
      ELSE
      WRITE (*,*)' DISPLACE.MNT FILE DOES NOT EXIST'
      STOP
      ENDIF
      READ (1) ( U(I) , I = 1 , NNODE )
      READ (1) ( V(I) , I = 1 , NNODE )
      CLOSE (1)
      RETURN
      END
C
C
      SUBROUTINE PLTUV (MXN,NNODE,XCOORD,YCOORD,U,V,NE,MXE,ND,NODEX,
     *                  UU, VV, VISCO, FLMDA,IB )
      IMPLICIT REAL*8 ( A-H , O-Z )
      DIMENSION XCOORD(MXN),YCOORD(MXN),U(MXN),V(MXN),NODEX(MXE,ND),
     * UU(MXN), VV(MXN), IB(MXE,ND)
      CHARACTER FILENAME*8
      COMMON / PLOTTING / FILENAME
      COMMON / DOMAIN / XMIN, XMAX, YMIN, YMAX
      FILENAME = "DISPLACE"
      DATA AL / 0.9D0 /
      RATIO = 0.05
      RMAX = 0.
      DO I = 1 , NNODE
      RMAX = DMAX1 ( RMAX, U(I)*U(I)+V(I)*V(I) )
      END DO
      IF ( RMAX .EQ. 0. ) RETURN
      RMAX = DSQRT ( RMAX )
      CALL MINMAX ( MXN, NNODE, U, UMIN, UMAX )
      CALL MINMAX ( MXN, NNODE, V, VMIN, VMAX )
      FACT = RATIO * DMAX1 ( (YMAX-YMIN) , (XMAX-XMIN) ) / RMAX
      DO I = 1 , NNODE
      UU(I) = XCOORD(I) +  U(I) * FACT * AL
      VV(I) = YCOORD(I) +  V(I) * FACT * AL
      END DO
      CALL MINMAX ( MXN, NNODE, UU, XMIN , XMAX )
      CALL MINMAX ( MXN, NNODE, VV, YMIN , YMAX )
C
C-------- START PLOT
      CALL PLTLGO
      WRITE(*,200) VISCO, FLMDA, UMIN, UMAX, VMIN, VMAX
      IC = 1
      CALL BOUND ( MXE,MXN,ND,NE,NODEX,UU,VV,IB,IC )
      CALL JCOLOR ( 6 )
      IC = 1
      CALL BOUND ( MXE,MXN,ND,NE,NODEX,XCOORD,YCOORD,IB,IC )
      CALL PLTEXT
C
  200 FORMAT ( 1X, 'VELOCITY'/1X,'VECTOR PLOT'/
     * 1X,'CURRENT VALUES:'/1X,'VISCO=',G10.3/
     * 1X,'FLMDA=',G10.3,20(/),1X,'UMIN=',G10.3/
     * 1X,'UMAX=',G10.3/ 1X,'VMIN=',G10.3/1X, 'VMAX=',G10.3 )
      RETURN
      END
C
C
      SUBROUTINE BOUND (MXE,MXN,ND,NE,NODEX,XCOORD,YCOORD,IB,IC)
      IMPLICIT REAL*8 ( A-H , O-Z )
      DIMENSION XCOORD(MXN),YCOORD(MXN),NODEX(MXE,ND),IB(MXE,ND)
C---------- IF IC=0, BOUNDARY LINE ONLY
C---------- IF IC=1, ELEMENTS
C--------- INITIALIZATION
      DO I = 1 , NE
      DO J = 1 , ND
      IB(I,J) = 0
      END DO
      END DO
C
      DO IEL = 1 , NE-1
      DO ISEG = 1 , ND
       IF ( IB(IEL,ISEG) .EQ. 0 ) THEN
        IS = ISEG
        IE = ISEG+1
        IF ( IS .EQ. ND ) IE = 1
        IS = NODEX(IEL,IS)
        IE = NODEX(IEL,IE)
        DO JEL = IEL+1 , NE
        DO JSEG = 1 , ND
         IF ( IB(JEL,JSEG) .EQ. 0 ) THEN
          JS = JSEG
          JE = JSEG+1
          IF ( JS .EQ. ND ) JE = 1
          JS = NODEX(JEL,JS)
          JE = NODEX(JEL,JE)
           IF ( (IS .EQ. JE) .AND. (IE .EQ. JS) ) THEN
            IF ( IC .EQ. 0 ) IB(IEL,ISEG) = 1
            IB(JEL,JSEG) = 1
           END IF
         END IF
        END DO
        END DO
       END IF
      END DO
      END DO
C
      DO IEL = 1 , NE
      DO ISEG = 1 , ND
      IF ( IB(IEL,ISEG) .EQ. 0 ) THEN
      IS = ISEG
      IE = ISEG+1
      IF ( IS .EQ. ND ) IE = 1
      IS = NODEX(IEL,IS)
      IE = NODEX(IEL,IE)
      CALL XMOVE ( XCOORD(IS) , YCOORD(IS) )
      CALL XDRAW ( XCOORD(IE) , YCOORD(IE) )
      END IF
      END DO
      END DO
      RETURN
      END
C
C
      SUBROUTINE MINMAX ( MXN, NNODE, Q, QMIN, QMAX )
      IMPLICIT REAL*8 ( A-H , O-Z )
      DIMENSION Q(MXN)
      QMIN = Q(1)
      QMAX = Q(1)
      DO I = 1 , NNODE
      QMIN = DMIN1 ( QMIN , Q(I) )
      QMAX = DMAX1 ( QMAX , Q(I) )
      END DO
      RETURN
      END
C
C
      SUBROUTINE PLTEL4 (ND,MXE,MXN,NODEX,NE,XCOORD,YCOORD,
     *                   NNODE,IB)
      IMPLICIT REAL*8 ( A-H , O-Z )
      DIMENSION  NODEX(MXE,ND),XCOORD(MXN),YCOORD(MXN),IB(MXE,ND)
      CHARACTER FILENAME*8
      COMMON / PLOTTING / FILENAME
      COMMON / DOMAIN / XMIN, XMAX, YMIN, YMAX
      FILENAME = "ELEMENT"
      CALL PLTLGO
      WRITE (*,200) NE, NNODE, XMIN, XMAX, YMIN, YMAX
      IC = 1
      CALL BOUND ( MXE,MXN,ND,NE,NODEX,XCOORD,YCOORD,IB,IC )
      CALL PLTEXT
  200 FORMAT ( 1X,'FINITE ELEMENT'/ 1X,'DISCRETIZATION'/
     * 1X,'NE=', I5 / 1X,'NNODE=', I5, /
     * 1X,'XMIN=',G10.3 / 1X,'XMAX=',G10.3 /
     * 1X,'YMIN=',G10.3 / 1X,'YMAX=',G10.3 )
      RETURN
      END
C
C
      SUBROUTINE PLTMISES ( MXE,MXN,ND,NE,NNODE,NODEX, XCOORD,YCOORD,
     *   DIVV,S,B,IB )
      IMPLICIT REAL*8 ( A-H , O-Z )
      DIMENSION S(ND),NODEX(MXE,ND),XCOORD(MXN),YCOORD(MXN),IB(MXE,ND),
     * B(2,ND),DIVV(MXN)
      CHARACTER FILENAME*8
      COMMON / PLOTTING / FILENAME
      COMMON / DOMAIN / XMIN, XMAX, YMIN, YMAX
      COMMON / PORT / TMIN, TMAX  / INCREM / DT
      FILENAME = "MISES"
      CALL MINMAX ( MXN, NNODE, DIVV, TMIN, TMAX )
      CALL CONTOUR ( MXE,MXN,ND,NE,NNODE,NODEX,XCOORD,YCOORD,S,B,IB,
     *               DIVV )
      WRITE(*,200) TMIN, TMAX, DT
      CALL PLTEXT
  200 FORMAT ( 1X,'DIVERGENCE FIELD:'/ 1X,'BLUE=ZERO'/
     * 1X, 'RED=CONVERGE'/ 1X, 'GREEN=DIVERGE',
     * 21(/),1X, 'CURRENT VALUES:' / 1X, 'MIN=',G10.3/
     * 1X, 'MAX=',G10.3 / 1X,'DS=',G10.3 )
      RETURN 
      END
C
C
      SUBROUTINE PLTTAUXX (MXE,MXN,ND,NE,NNODE,NODEX,XCOORD,YCOORD,
     *                     TAUXX,S,B, IB )
      IMPLICIT REAL*8 ( A-H , O-Z )
      DIMENSION NODEX(MXE,ND),XCOORD(MXN),YCOORD(MXN),TAUXX(MXN),
     *          S(ND),B(2,ND),IB(MXE,ND)
      CHARACTER FILENAME*8
      COMMON / PLOTTING / FILENAME
      COMMON / DOMAIN / XMIN, XMAX, YMIN, YMAX
      COMMON / PORT / QMIN, QMAX / INCREM / DP
      FILENAME = "STRESSXX"
      CALL MINMAX ( MXN, NNODE, TAUXX, QMIN, QMAX )
      CALL CONTOUR ( MXE, MXN,ND,NE,NNODE,NODEX,XCOORD,YCOORD,S,B,IB,
     *               TAUXX )
      WRITE(*,200)
      WRITE(*,210) QMIN, QMAX, DP
      CALL PLTEXT
  200 FORMAT ( 1X,'TAUXX CONTOUR'/1X,'BLUE=ZERO'/1X,'RED=-'/
     *         1X,'GREEN=+',19(/) )
  210 FORMAT ( 1X,'CURRENT VALUES:'/1X,'PMIN=', G10.3/
     * 1X, 'PMAX=',G10.3 / 1X,'DP=',G10.3 )
      RETURN
      END
C
C
      SUBROUTINE PLTTAUYY ( MXE,MXN,ND,NE,NNODE,NODEX,XCOORD,YCOORD,
     *                     TAUYY,S,B, IB )
      IMPLICIT REAL*8 ( A-H , O-Z )
      DIMENSION NODEX(MXE,ND),XCOORD(MXN),YCOORD(MXN),TAUYY(MXN),
     *          S(ND),B(2,ND),IB(MXE,ND)
      CHARACTER FILENAME*8
      COMMON / PLOTTING / FILENAME
      COMMON / DOMAIN / XMIN, XMAX, YMIN, YMAX
      COMMON / PORT / QMIN, QMAX / INCREM / DP
      FILENAME = "STRESSYY"
      CALL MINMAX ( MXN, NNODE, TAUYY, QMIN, QMAX )
      CALL CONTOUR ( MXE, MXN,ND,NE,NNODE,NODEX,XCOORD,YCOORD,S,B,IB,
     *               TAUYY )
      WRITE(*,200)
      WRITE(*,210) QMIN, QMAX, DP
      CALL PLTEXT
  200 FORMAT ( 1X,'TAUYY CONTOUR'/1X,'BLUE=ZERO'/1X,'RED=-'/
     *         1X,'GREEN=+',19(/) )
  210 FORMAT ( 1X,'CURRENT VALUES:'/1X,'PMIN=', G10.3/
     * 1X, 'PMAX=',G10.3 / 1X,'DP=',G10.3 )
      RETURN
      END
C
C
      SUBROUTINE PLTTAUXY ( MXE,MXN,ND,NE,NNODE,NODEX,XCOORD,YCOORD,
     *                      TAUXY,S,B, IB )
      IMPLICIT REAL*8 ( A-H , O-Z )
      DIMENSION NODEX(MXE,ND),XCOORD(MXN),YCOORD(MXN),TAUXY(MXN),
     *          S(ND),B(2,ND),IB(MXE,ND)
      CHARACTER FILENAME*8
      COMMON / PLOTTING / FILENAME
      COMMON / DOMAIN / XMIN, XMAX, YMIN, YMAX
      COMMON / PORT / QMIN, QMAX / INCREM / DP
      FILENAME = "STRESSXY"
      CALL MINMAX ( MXN, NNODE, TAUXY, QMIN, QMAX )
      CALL CONTOUR ( MXE, MXN,ND,NE,NNODE,NODEX,XCOORD,YCOORD,S,B,IB,
     *               TAUXY )
      WRITE(*,200)
      WRITE(*,210) QMIN, QMAX, DP
      CALL PLTEXT
  200 FORMAT ( 1X,'TAUXY CONTOUR'/1X,'BLUE=ZERO'/1X,'RED=-'/
     *         1X,'GREEN=+',19(/) )
  210 FORMAT ( 1X,'CURRENT VALUES:'/1X,'PMIN=', G10.3/
     * 1X, 'PMAX=',G10.3 / 1X,'DP=',G10.3 )
      RETURN
      END
C
C
      SUBROUTINE CONTOUR (MXE,MXN,ND,NE,NNODE,NODEX,XCOORD,YCOORD,
     *                    S, B, IB, P )
      IMPLICIT REAL*8 ( A-H , O-Z )
      DIMENSION NODEX(MXE,ND), XCOORD(MXN),YCOORD(MXN), P(MXN),
     *          S(ND), B(2,ND), IB(MXE,ND)
      COMMON / PORT / PPMIN, PPMAX, / INCREM / DS
      IF ( PPMAX .EQ. PPMIN ) RETURN
      WRITE(*,*)' TYPE IN NUMBER OF CONTOUR LINES(N=20 ABOUT RIGHT)'
      WRITE(*,*)' N=0 FOR QUIT, MAX N = 99'
      WRITE(*,*)' N='
      READ (*,*) NSTEP
      IF ( NSTEP .LE. 0  ) RETURN
      IF ( NSTEP .GT. 99 ) RETURN
      NSTEP = NSTEP/2*2 + 1
      DS = ( PPMAX - PPMIN ) / NSTEP
      PPMIN = INT ( PPMIN/DS ) * DS
      CALL PLTLGO
      CALL JCOLOR ( 9 )
      IC = 0
      CALL BOUND ( MXE,MXN,ND,NE,NODEX,XCOORD,YCOORD,IB,IC )
      DO IEL = 1 , NE
      DO I   = 1 , ND
      B(1,I) = XCOORD(NODEX(IEL,I))
      B(2,I) = YCOORD(NODEX(IEL,I))
      S(I)   =      P(NODEX(IEL,I))
      END DO
      CALL PLTSAI ( DS, NSTEP, PPMIN, B, S )
      CALL PLTSAI ( DS,     1,  0.D0, B, S )
      END DO
      RETURN
      END
C
C
      SUBROUTINE PLTSAI ( DS, NSTEP, START, CRD, SS )
      IMPLICIT REAL*8 ( A-H , O-Z )
      DIMENSION CRD(2,4), SS(4), X(4), Y(4), S(4)
      X(3) = ( CRD(1,1) + CRD(1,2) + CRD(1,3) + CRD(1,4) ) / 4.
      Y(3) = ( CRD(2,1) + CRD(2,2) + CRD(2,3) + CRD(2,4) ) / 4.
      S(3) = ( SS(1) + SS(2) + SS(3) + SS(4) ) / 4.
      SMAX = DMAX1 ( SS(1), SS(2), SS(3), SS(4) )
      SMIN = DMIN1 ( SS(1), SS(2), SS(3), SS(4) )
      DO 52 LEVEL = 1 , NSTEP
      SXY = START + (LEVEL-1) * DS
      IF ( (SMAX-SXY)*(SMIN-SXY) .LT. 0 ) THEN
      IF ( SXY .LT. 0. ) CALL JCOLOR (  9 )
      IF ( SXY .GT. 0. ) CALL JCOLOR ( 10 )
      IF ( SXY .EQ. 0. ) CALL JCOLOR ( 12 )
      DO 60 IEL = 1 , 4
      X(1) = CRD(1,IEL)
      Y(1) = CRD(2,IEL)
      S(1) = SS(IEL)
      IF ( IEL .EQ. 4 ) THEN
      X(2) = CRD(1,1)
      Y(2) = CRD(2,1)
      S(2) = SS(1)
      ELSE
      X(2) = CRD(1,IEL+1)
      Y(2) = CRD(2,IEL+1)
      S(2) = SS   (IEL+1)
      ENDIF
      X(4) = X(1)
      Y(4) = Y(1)
      S(4) = S(1)
      K = 0
      DO 70 ISG = 1 , 3
      IF ( S(ISG  ) .LT. SXY ) GO TO 30
      IF ( S(ISG+1) .LT. SXY ) GO TO 40
      GO TO 70
   30 IF ( S(ISG+1) .LT. SXY ) GO TO 70
   40 T = ( SXY - S(ISG) ) / ( S(ISG+1) - S(ISG) )
      X0 = X(ISG+1)*T + (1.- T)*X(ISG)
      Y0 = Y(ISG+1)*T + (1.- T)*Y(ISG)
      IF ( K .EQ. 0 ) GO TO 71
      CALL XDRAW ( X0, Y0 )
      GO TO 60
   71 CALL XMOVE ( X0, Y0 )
      K = 1
   70 CONTINUE
   60 CONTINUE
      ENDIF
   52 CONTINUE
      RETURN
      END
C
C======================== GRAPHICS RUTINES =============================
      SUBROUTINE PLTLGO
      IMPLICIT REAL*8 ( A-H , O-Z )
      CHARACTER FILENAME*8
      COMMON / DOMAIN / XMIN , XMAX , YMIN , YMAX
      COMMON / PENDOMAIN / IXMIN , IXMAX , IYMIN , IYMAX
      COMMON / PLOTTING / FILENAME, RMAGNI, DIGITS
      DIGITS = 99999.D0
      OPEN ( 1, FILE=FILENAME, STATUS='UNKNOWN' )
      RMAGNI = DMAX1 ( XMAX-XMIN, YMAX-YMIN )
      IXMIN =  DIGITS
      IYMIN =  DIGITS
      IXMAX = -DIGITS
      IYMAX = -DIGITS
      RETURN
      END
C
C
      SUBROUTINE PLTEXT
      COMMON / PENDOMAIN / IXMIN , IXMAX , IYMIN , IYMAX
      WRITE(1,'(4I7)') IXMIN , IXMAX , IYMIN , IYMAX
      CLOSE (1)
      RETURN
      END
C
C
      SUBROUTINE JCOLOR ( I )
      RETURN
      END
C
C
      SUBROUTINE XMOVE ( X , Y )
      IMPLICIT REAL*8 ( A-H , O-Z )
      COMMON / DOMAIN / XMIN , XMAX , YMIN , YMAX
      COMMON / PENDOMAIN / IXMIN , IXMAX , IYMIN , IYMAX
      COMMON / PLOTTING / FILENAME, RMAGNI, DIGITS
      COMMON / PENMOVE /IXMOVE, IYMOVE
      IXMOVE = (X-XMIN)/RMAGNI*DIGITS
      IYMOVE = (Y-YMIN)/RMAGNI*DIGITS
      IXMIN = MIN0 ( IXMIN, IXMOVE )
      IXMAX = MAX0 ( IXMAX, IXMOVE )
      IYMIN = MIN0 ( IYMIN, IYMOVE )
      IYMAX = MAX0 ( IYMAX, IYMOVE )
      RETURN
      END
C
C
      SUBROUTINE XDRAW ( X , Y )
      IMPLICIT REAL*8 ( A-H , O-Z )
      COMMON / PENDOMAIN / IXMIN , IXMAX , IYMIN , IYMAX
      COMMON / DOMAIN / XMIN , XMAX , YMIN , YMAX
      COMMON / PLOTTING / FILENAME, RMAGNI, DIGITS
      COMMON / PENMOVE /IXMOVE, IYMOVE
      IX = (X-XMIN)/RMAGNI*DIGITS
      IY = (Y-YMIN)/RMAGNI*DIGITS
      WRITE(1,'(4I7)') IXMOVE, IYMOVE, IX, IY
      IXMIN = MIN0 ( IXMIN, IX )
      IXMAX = MAX0 ( IXMAX, IX )
      IYMIN = MIN0 ( IYMIN, IY )
      IYMAX = MAX0 ( IYMAX, IY )
      RETURN
      END