PROGRAM MVG4FILE
C=======================================================================
C                      FINITE ELEMENT GRAPHICS FOR
C           TIME DEPENDENT TWO-DIMENSIONAL POTENTIAL PROBLEMS
C            ELEMENT TYPE: FOUR-NODED ISOPARAMETRIC ELEMENT
C             CREATE FILES CONTAINING XY-COORDINTE VALUES
C         ORIGINAL CODE: NSEQ8GRA.FOR, EIJI FUKUMORI, JULY 1985
C                   FEBRUARY 05, 2013
C=======================================================================
      INCLUDE 'PARAM.DAT'
      IMPLICIT REAL*8 ( A-H , O-Z )
CCCCCCCCC      PARAMETER ( MXE=30000,MXN=33000,MXB=10000,ND=4)
C                                ARRAYS
      DIMENSION NODEX(MXE,ND),ISEG(MXE,ND)
      DIMENSION IBND(MXB), BV(MXB), ITYPE(MXB)
      DIMENSION XCOORD(MXN),YCOORD(MXN),P(MXN)
      DIMENSION S(ND), BX(2,ND)
C=======================================================================
      WRITE(*,*)' POTENTIAL GRAPHICS PROGRAM'
C
      CALL INPUT ( MXE,MXN,MXB,ND,NE,NNODE,NB,NODEX,XCOORD,YCOORD,
     *             P,IBND,ITYPE, BV )      
C=======================================================================
      CALL PLTEL4 ( ND,MXE,MXN,NODEX,NE,XCOORD,YCOORD )
      CALL POTENTL (MXE,MXN,ND,NE,NNODE,NODEX,XCOORD,YCOORD,P,S,BX)
      STOP 'NORMAL TERMINATION'
      END
C
C
      SUBROUTINE INPUT ( MXE,MXN,MXB,ND,NE,NNODE,NB,NODEX,XCOORD,
     * YCOORD,P,IBND,ITYPE, BV )
      IMPLICIT REAL*8 ( A-H , O-Z )
      DIMENSION NODEX(MXE,ND),XCOORD(MXN),YCOORD(MXN),IBND(MXB),
     * P(MXN),ITYPE(MXB),BV(MXB)
      LOGICAL YES
C========> FILE INQUIRE
      INQUIRE ( FILE='NEWINPUT.DAT', EXIST=YES )
      IF ( .NOT.YES ) STOP 'FILE DOES NOT EXIST'
      OPEN ( 1, FILE='NEWINPUT.DAT', STATUS='OLD' )
      READ (1,*) 
      READ (1,*) 
C========> ELEMENT
      READ (1,*) NE
      DO I = 1 , NE
      READ (1,*) IEL, ( NODEX(IEL,J), J = 1 , ND )
      END DO
C========> COORDINATES
      READ (1,*) NNODE
      DO I = 1 , NNODE
      READ (1,*) NODE, XCOORD(NODE) , YCOORD(NODE)
      END DO
C========> BOUNDARY CONDITIONS
      READ(1,*) NB
      DO I = 1 , NB
      READ (1,*) IBND(I) , ITYPE(I), BV(I)
      END DO
      CLOSE (1)
C========> POTENTIAL VALUE FILENAME=SOLUTION.BIN
      OPEN (1,FILE='SOLUTION.BIN',STATUS='UNKNOWN',FORM='UNFORMATTED')
      READ (1) ( P(I) , I=1,NNODE )
      CLOSE (1)
      RETURN
      END
C
C
      SUBROUTINE POTENTL ( MXE,MXN,ND,NE,NNODE,NODEX,XCOORD,YCOORD,
     *   P,S,B )
      IMPLICIT REAL*8 ( A-H , O-Z )
      DIMENSION S(ND),NODEX(MXE,ND),XCOORD(MXN),YCOORD(MXN),
     *                                   B(2,ND),P(MXN)
      CHARACTER FILENAME*12
      FILENAME = 'POTENTAL.OUT'
      CALL PLTLGO ( FILENAME )
      CALL CONTOUR (MXE,MXN,ND,NE,NNODE,NODEX,XCOORD,YCOORD,S,B,P )
      CALL PLTEXT
      RETURN
      END
C
C
      SUBROUTINE CONTOUR (MXE,MXN,ND,NE,NNODE,NODEX,XCOORD,YCOORD,S,B,P)
      IMPLICIT REAL*8 ( A-H , O-Z )
      DIMENSION NODEX(MXE,ND),XCOORD(MXN),YCOORD(MXN),P(MXN),
     *                                         S(ND),B(2,ND)
      NSTEP = 20
      CALL MINMAX ( MXN, NNODE, P, PPMIN, PPMAX )
      DS = ( PPMAX - PPMIN ) / NSTEP
      I = PPMIN/DS
      PPMIN = I*DS
      CALL BOUND ( MXE,MXN,ND,NE,NODEX,XCOORD,YCOORD )
      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 ( ND, DS, NSTEP, PPMIN, B, S )
      END DO
      RETURN
      END
C
C
      SUBROUTINE PLTSAI ( ND, DS, NSTEP, START, CRD, S )
      IMPLICIT REAL*8 ( A-H , O-Z )
      DIMENSION CRD(2,ND), S(ND)
      IF ( NSTEP .EQ. 0 ) RETURN
      DO LEVEL = 1 , NSTEP
      SXY = START + (LEVEL-1) * DS
      K = 1
      DO I = 1 , ND
      J = I + 1
      IF ( I .EQ. ND ) J = 1
      IF ( (S(I)-SXY)*(S(J)-SXY) .LT. 0 ) THEN
           T=(SXY-S(I))/(S(J)-S(I))
           X0=CRD(1,J)*T+(1.D0-T)*CRD(1,I)
           Y0=CRD(2,J)*T+(1.D0-T)*CRD(2,I)
           IF ( K .GT. 0 ) THEN
                CALL XMOVE ( X0, Y0 )
           ELSE
                CALL XDRAW ( X0, Y0 )
           END IF
           K = -K
      END IF
      END DO
      END DO
      RETURN
      END
C
C
      SUBROUTINE BOUND ( MXE,MXN,ND,NE,NODEX,XCOORD,YCOORD )
      IMPLICIT REAL*8 ( A-H , O-Z )
      DIMENSION XCOORD(MXN),YCOORD(MXN),NODEX(MXE,ND)
      LOGICAL LINE
C
      DO IEL = 1 , NE
      DO I = 1 , ND
      LINE = .TRUE.
      J = I + 1
      IF ( I .EQ. ND ) J = 1
C
      DO JEL = 1 , NE
      IF ( IEL .NE. JEL ) THEN
      DO II = 1 , ND
      JJ = II + 1
      IF ( II .EQ. ND ) JJ = 1
      IF ( NODEX(IEL,I).EQ.NODEX(JEL,JJ) .AND.
     *     NODEX(IEL,J).EQ.NODEX(JEL,II) ) THEN
      LINE = .FALSE.
      EXIT
      END IF
      END DO
      END IF
      IF ( .NOT. LINE ) EXIT
      END DO
      IF ( LINE ) THEN
      CALL XMOVE ( XCOORD(NODEX(IEL,I)),YCOORD(NODEX(IEL,I)) )
      CALL XDRAW ( XCOORD(NODEX(IEL,J)),YCOORD(NODEX(IEL,J)) )
      END IF
C
      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 = AMIN1 ( QMIN , Q(I) )
      QMAX = AMAX1 ( QMAX , Q(I) )
      END DO
      RETURN
      END
C
C
      SUBROUTINE PLTEL4 ( ND,MXE,MXN,NODEX,NE,XCOORD,YCOORD )
      IMPLICIT REAL*8 ( A-H , O-Z )
      DIMENSION  NODEX(MXE,ND),XCOORD(MXN),YCOORD(MXN)
      CHARACTER FILENAME*12
      FILENAME = "ELEMENT.OUT"
      CALL PLTLGO (FILENAME)
      DO I = 1 , NE
      DO J = 1 , ND-1
      CALL XMOVE ( XCOORD(NODEX(I,J  )),YCOORD(NODEX(I,J  )) )
      CALL XDRAW ( XCOORD(NODEX(I,J+1)),YCOORD(NODEX(I,J+1)) )
      END DO
      CALL XMOVE ( XCOORD(NODEX(I,ND )),YCOORD(NODEX(I,ND )) )
      CALL XDRAW ( XCOORD(NODEX(I, 1 )),YCOORD(NODEX(I, 1 )) )
      END DO
      CALL PLTEXT
      RETURN
      END
C
C======================== GRAPHICS RUTINES =============================
      SUBROUTINE PLTLGO ( FILENAME )
      IMPLICIT REAL*8 ( A-H , O-Z )
      CHARACTER FILENAME*12
      OPEN ( 1, FILE=FILENAME, STATUS='UNKNOWN' )
      RETURN
      END
C
C
      SUBROUTINE PLTEXT
      CLOSE (1)
      RETURN
      END
C
C
      SUBROUTINE XMOVE ( X , Y )
      IMPLICIT REAL*8 ( A-H , O-Z )
      WRITE (1,*) X , Y
      RETURN
      END
C
C
      SUBROUTINE XDRAW ( X , Y )
      IMPLICIT REAL*8 ( A-H , O-Z )
      WRITE (1,*) X , Y
      WRITE (1,*)
      RETURN
      END