C$DEBUG
C     PCGRPG
C       AC-GWAP 
C
C
      USE DFLIB
      INTEGER(2) STATUS
      REAL*8 X,Y,H,VXX,VYY,TIME,ALF,QL,BL,QQ,DD
      TYPE (XYCOORD) XY
      CHARACTER*4 HED(20)
      CHARACTER*20 FNAM10
      COMMON / SPEC /XMIN,YMIN,XMAX,YMAX
      COMMON / VIEW / IPLX,IPLY,LPLX,LPLY,DDPX,DDPY
      COMMON / SCOL / VMAX,VSCAL,ALSCAL,AWSCAL     
      common /plot / NPLOT,IOX,IOY,IOPEN,PPX0,PPY0,PDDPX,PDDPY
      COMMON /SCREN/IXIW,IYIW,IXLW,IYLW,IXIC,IYIC,IXLC,IYLC
      DATA  IXIW,IYIW,IXLW,IYLW,IXIC,IYIC,IXLC,IYLC/
     &      0,0,599,470,1,1,97,25/
      DIMENSION X(5000),Y(5000),H(5000),KX(5000,5),
     &          VXX(5000),VYY(5000)
      DIMENSION IS(5000,2),XM(5000),YM(5000),IB(5000)
      result=SETEXITQQ(QWIN$EXITNOPERSIST)
      NUMDAT=5000
      NUMSUF=5000
      ISWT=0
      IFSUF=0
C      CALL TEXCLS
      CALL CLEARSCREEN($GCLEARSCREEN)
      CALL SETVIEWPORT(INT2(IXIW),INT2(IYIW),INT2(IXLW),INT2(IYLW))
      CALL SETTEXTWINDOW(INT2(1),INT2(1),INT2(25),INT2(97))
      status=setbkcolor(15)
      call color(0)
      WRITE(*,*)
      WRITE(*,*)
      WRITE(*,1)
    1 FORMAT('**********************************************'/
     &       '* This program is for AC-GWAP .              *'/
     &       '*  It uses the 5th file inWORK.LST.          *'/
     &       '*                               by Y.Shinshi *'/
     &       '*   NUMNP= upto 5000                         *'/
     &       '*   NUMEL= upto 5000                         *'/
     &       '*--------------------------------------------*'/
     &       '*   TEXT AREA     (1,1)-(25､97)              *'/
     &       '*   Graphic AREA  (0,0)-(599,470)            *'/
     &       '*                               Yes/0  No/1  *'/
     &       '**********************************************')
      READ(*,*) ICH
      CALL TEXCLS
      CALL CLEARSCREEN($GCLEARSCREEN)
        OPEN (98,FILE='WORK.LST', STATUS='OLD',FORM='FORMATTED')
        READ(98,1000)FNAM10
        READ(98,1000)FNAM10
        READ(98,1000)FNAM10
        READ(98,1000)FNAM10
 1000 FORMAT(A)        
      OPEN (10,FILE=FNAM10, STATUS='OLD',FORM='UNFORMATTED')
C      OPEN(3,FILE='PLOTT.OUT',STATUS='UNKNOWN',FORM='FORMATTED')
        READ(10) HED
C          WRITE(*,*)'1'
        READ(10) NUMNP
C          WRITE(*,*)'2'
        READ(10) (X(I),Y(I),QL,BL,KB,I=1,NUMNP)
C          WRITE(*,*)'3'
        READ(10) NUMEL
C          WRITE(*,*)'4'
        READ(10) (KX(I,1),KX(I,2),KX(I,3),KX(I,4),
     &                   KX(I,5),ALF,I=1,NUMEL)
C          WRITE(*,*)'5'
C
C      CALL LOCATE (10,10)
      CALL COLOR(1)
        WRITE(*,*) HED
        WRITE(*,*) '節点総数　',NUMNP,'  要素総数　',NUMEL
      CALL COLOR(7)
        WRITE(*,*)''
       WRITE(*,*)'               デ−タ−ＯＫ？　Ｙ／０　Ｎ／１'
      WRITE(*,*)''
      READ(*,*)IFLAG
      IF( IFLAG .NE. 0 ) STOP 1111
      CALL CLEARSCREEN($GCLEARSCREEN)
      CALL SETTEXTWINDOW(INT2(IYIC),INT2(IXLC-20),INT2(IYLC),INT2(IXLC))
      CALL SETVIEWPORT(INT2(IXIW),INT2(IYIW),INT2(IXLW),INT2(IYLW))
        CALL LINEW(IXIW+1,IYIW+1,IXIW+1,IYLW-1,3,0,0,0,0)
        CALL LINEW(IXIW+1,IYLW-1,IXLW-1,IYLW-1,3,0,0,0,0)
        CALL LINEW(IXLW-1,IYLW-1,IXLW-1,IYIW+1,3,0,0,0,0)
        CALL LINEW(IXLW-1,IYIW+1,IXIW+1,IYIW+1,3,0,0,0,0)
C      STOP 0000
      CALL SURFM(KX,IS,IB,X,Y,NUMEL,NUMSUF,NUMDAT,NUMNP)
C
 1100 CALL SPECFC(X,Y,KX,IS,IB,XM,YM,NUMNP,NUMEL,NUMSUF,NUMDAT,NUMELP)
C
      CALL CLEARSCREEN($GCLEARSCREEN)
      CALL TEXCLS
      CALL PLWV1
      CALL TEXCLS
      CALL LOCATE(10,10)
      CALL MESH(X,Y,KX,IS,IB,NUMSUF,NUMNP,NUMEL,NUMDAT,NUMELP)
      CALL LOCATE(28,5)
      WRITE(*,*)'Is the mesh OK?'
      write(*,*)'  Yes/0 No/1'
      READ(*,*)IFLAG
       IF( IFLAG .EQ. 1 ) STOP 2222
      CALL CLEARSCREEN($GCLEARSCREEN)
 1600 CONTINUE
       NPLOT=1
C      WRITE(*,*)'-----  ON PLOTTER  Y/0 N/1 '
C      READ(*,*)NPLOT
C       IF( NPLOT.EQ.0 )WRITE(3,'(A2)')'H '
      CALL SURFPL(X,Y,IS,NUMSUF,NUMNP,NUMDAT,NUMELP)
      IF( NUMSUF.EQ.0)CALL MESH(X,Y,KX,IS,IB,NUMSUF,NUMNP,
     &                                        NUMEL,NUMDAT,NUMELP)
      CALL ZOON
C
 3100 IF( ISWT .NE. 0 ) GO TO 3111 
      READ(10,END=3300)LA,TIME
      READ(10)(KD,H(I),QQ,I=1,NUMNP)
      READ(10)(VXX(I),VYY(I),DD,I=1,NUMEL)
 3111 ISWT=0
      CALL TEXCLS
      CALL LOCATE(10,10)
      WRITE(*,3000) LA
 3000 FORMAT(' T-STEP=',I5)
      WRITE(*,3001) TIME
 3001 FORMAT(' TIME=',E10.3)
      WRITE(*,3002)
 3002 FORMAT(' Yes/0 Next/1')
      READ(*,*) M
      IF( M .EQ. 1 ) GO TO 3100
      GO TO 3200
 3300 STOP 999
C
 3200 CALL VECT(X,Y,VXX,VYY,XM,YM,IB,KX,NUMNP,NUMEL,NUMDAT,NUMELP)
      CALL PLOCNT(X,Y,H,KX,IB,NUMNP,NUMEL,NUMELP,NUMDAT,2)
 2200 CONTINUE
      CALL TEXCLS
      CALL LOCATE(10,20)
      WRITE(*,*)' Try One More'
      WRITE(*,*)' YES/0 NO/1'
      READ(*,*) IRECL 
      IF( IRECL.EQ. 1 ) GO TO 1200
 1500 CALL TEXCLS
      CALL CLEARSCREEN($GCLEARSCREEN)
      CALL LOCATE(10,2)
      WRITE(*,*)' Change drawing'
      WRITE(*,*)'       Region - 1'
      WRITE(*,*)' Draw'
      WRITE(*,*)'  Vect/Count. - 2'
      WRITE(*,*)' Read next'
      WRITE(*,*)'  time step   - 3'
      READ(*,*)ISWT
      IF( ISWT .EQ. 1 ) GO TO 1100
      IF( ISWT .EQ. 2 ) GO TO 1600
      IF( ISWT .EQ. 3 ) ISWT=0
      IF( ISWT .EQ. 0 ) GO TO 3100
      GO TO 1500
 1200 WRITE(*,*)'  OK  GOOOOODDD !!!!' 
      STOP
      END
      SUBROUTINE SPECFC(X,Y,KX,IS,IB,XM,YM,NUMNP,NUMEL,NUMSUF,NUMDAT,
     %                  NUMELP)
C     IMPLICIT INTEGER*2 (I-N) 
C      INTEGER*2 NUMNP,NUMEL,KX 
      REAL*8 X,Y,H,VXX,VYY
      CHARACTER*80 CMET
      DIMENSION X(NUMDAT),Y(NUMDAT),IS(NUMDAT,2),XM(NUMDAT),YM(NUMDAT),
     %          IB(NUMDAT),KX(NUMDAT,5)
      COMMON / SPEC /XMIN,YMIN,XMAX,YMAX
      COMMON / VIEW / IPLX,IPLY,LPLX,LPLY,DDPX,DDPY
      common /plot / NPLOT,IOX,IOY,IOPEN,PPX0,PPY0,PDDPX,PDDPY
      COMMON /SCREN/IXIW,IYIW,IXLW,IYLW,IXIC,IYIC,IXLC,IYLC
C
      CALL TEXCLS
      NUMELP=NUMEL 
      DO 70 I=1,NUMEL
      XM(I)=0.0
      YM(I)=0.0
       M=4
       IF( KX(I,3) .EQ. KX(I,4)) M=3
       DO 71 J=1,M
C         WRITE(*,*)'I,J',I,J
      XM(I)=XM(I)+X(KX(I,J))/M
      YM(I)=YM(I)+Y(KX(I,J))/M
   71 CONTINUE
   70 IB(I)=I   
C      WRITE(*,*) (X(I),Y(I),I=1,NUMNP)
      XMIN=X(1)
      YMIN=Y(1)
      XMAX=X(1)
      YMAX=Y(1)
      DO 10 I=2,NUMNP
      IF( X(I) .LT. XMIN ) XMIN=X(I)
      IF( Y(I) .LT. YMIN ) YMIN=Y(I)
      IF( X(I) .GT. XMAX ) XMAX=X(I)
      IF( Y(I) .GT. YMAX ) YMAX=Y(I)
   10 CONTINUE
      CALL TEXCLS
      CALL LOCATE(10,2)
      WRITE(*,*)' XMIN '
      write(*,'(A1,E10.3)')' ',XMIN
      write(*,*)' YMIN '
      write(*,'(A1,E10.3)')' ',YMIN
      WRITE(*,*)' XMAX '
      write(*,'(A1,E10.3)')' ',XMAX
      write(*,*)' YMAX '
      write(*,'(A1,E10.3)')' ',YMAX
      write(*,*)' Specify'
      WRITE(*,*)' region y/0 n/1'
      READ(*,*) NNNN
      IF( NNNN .NE. 0 ) GO TO 20
   30 CMET=' Input min.X & Y '
      WRITE(*,*)CMET
      READ(*,*) XMIN,YMIN 
      CMET=' Input max.X & Y '
      WRITE(*,*)CMET
      READ(*,*) XMAX,YMAX 
      CALL TEXCLS
      IF( XMAX .LE. XMIN .OR. YMAX .LE. YMIN ) GO TO 30
      N = 0
      DO 60 I=1,NUMEL
       M=4
       IF( KX(I,3).EQ. KX(I,4)) M=3
       L = 0
       DO 61 J=1,M
        IJ=KX(I,J)
         XX=(XMAX-X(IJ))*(X(IJ)-XMIN)
         YY=(YMAX-Y(IJ))*(Y(IJ)-YMIN)
       IF( XX.GE. 0.0 .AND.YY .GE.0.0 ) L=L+1
   61  CONTINUE
       IF( L.EQ. 0 ) GO TO 60
C       IF( L.NE. M ) GO TO 60
       N=N+1
       IB(N)=I
   60 CONTINUE
       NUMELP=N
   20 CONTINUE
      CALL TEXCLS
      IPLX=IXIW+9
      IPLY=IYIW+9
      LPLX=IXLW-9
      LPLY=IYLW-9
      CALL LOCATE(10,2)
c      CMET=' Specify --- Ｇｒａｐｈｉｃ領域を指定しますか？Ｙ／０ ＮＯ／１'
c      WRITE(*,*)CMET
c      CMET='--------  指定なければ (10,10)-(580,390) '
c      WRITE(*,*)CMET
c      READ(*,*) NNNN
c      IF( NNNN .NE. 0 ) GO TO 100    
c  110 CMET='−−−Ｘ，Ｙ座標の最小値を入力せよ．0<=IPLX(IPLY)<639(399)'
c      WRITE(*,*)CMET
c      READ(*,*) IPLX,IPLY 
c      CMET='−−−Ｘ，Ｙ座標の最大値を入力せよ．0<LPLX(LPLY)<=639(399)'
c      WRITE(*,*)CMET
c      READ(*,*) LPLX,LPLY
c      CALL TEXCLS 
c      IF( LPLX .LE. IPLX .OR. LPLY .LE. IPLY ) GO TO 110
c      IF( IPLX .LT. 10    .OR. IPLY .LT. 10    ) GO TO 110
c      IF( LPLX .GT. 630  .OR. LPLY .GT. 390  ) GO TO 110
  100 CONTINUE
      CALL PLWV1
      CALL PPLWV1
      RETURN
      END 
      SUBROUTINE MESH(X,Y,KX,IS,IB,NUMSUF,NUMNP,NUMEL,NUMDAT,NUMELP)
C     IMPLICIT INTEGER*2 (I-N) 
C      INTEGER*2 NUMNP,NUMEL,KX 
      REAL*8 X,Y,H,VXX,VYY
      DIMENSION X(NUMDAT),Y(NUMDAT),IS(NUMDAT,2),IB(NUMDAT),KX(NUMDAT,5)
      COMMON / SPEC /XMIN,YMIN,XMAX,YMAX
      COMMON / VIEW / IPLX,IPLY,LPLX,LPLY,DDPX,DDPY
      common /plot / NPLOT,IOX,IOY,IOPEN,PPX0,PPY0,PDDPX,PDDPY
      CALL TEXCLS
      DO 10 II=1,NUMELP
       I=IB(II)
       IF( KX(I,5) .LE. 0 ) GO TO 10
       NCON=4
      IF( KX(I,3) .EQ. KX(I,4)) NCON=3
       DO 20 J=1,NCON
       J1=J
       J2=J+1
       IF(J2 .GT. NCON ) J2=1
       J1=KX(I,J1)
       J2=KX(I,J2)
       X1=X(J1)
       Y1=Y(J1) 
       X2=X(J2)
       Y2=Y(J2) 
       CALL LINEP(X1,Y1,X2,Y2 ,     1,   0,   0,    0  ,0)
   20 CONTINUE
   10 CONTINUE
      RETURN
      END
      SUBROUTINE SURFPL(X,Y,IS,NUMSUF,NUMNP,NUMDAT,NUMELP)
      USE DFLIB
C     IMPLICIT INTEGER*2 (I-N) 
C      INTEGER*2 NUMNP,NUMEL,KX 
      REAL*8 X,Y
      DIMENSION X(NUMDAT),Y(NUMDAT),IS(NUMDAT,2)
      COMMON / SPEC /XMIN,YMIN,XMAX,YMAX
      COMMON / VIEW / IPLX,IPLY,LPLX,LPLY,DDPX,DDPY
      common /plot / NPLOT,IOX,IOY,IOPEN,PPX0,PPY0,PDDPX,PDDPY
      IF( NUMSUF.EQ. 0 ) GO TO 40
C      WRITE(*,*)'  LAST SURF ',IS(NUMSUF,1),IS(NUMSUF,2)
C      CALL CLEARSCREEN($GCLEARSCREEN)
      DO 30 I=1,NUMSUF
      J1=IS(I,1)
      J2=IS(I,2) 
       X1=X(J1)
       Y1=Y(J1) 
       X2=X(J2)
       Y2=Y(J2)
       IF((X1-XMIN).LT.0.0  .OR. (XMAX-X1) .LT.0.0 ) GO TO 30
       IF((X2-XMIN).LT.0.0  .OR. (XMAX-X2) .LT.0.0 ) GO TO 30
       IF((Y1-YMIN).LT.0.0  .OR. (YMAX-Y1) .LT.0.0 ) GO TO 30
       IF((Y2-YMIN).LT.0.0  .OR. (YMAX-Y2) .LT.0.0 ) GO TO 30
       CALL LINEP(X1,Y1,X2,Y2 ,     5,   0,   0,    0  ,0)
   30 CONTINUE
   40 RETURN
      END  
      SUBROUTINE VECT(X,Y,VXX,VYY,XM,YM,IB,KX,NUMNP,NUMEL,NUMDAT,NUMELP)
C     IMPLICIT INTEGER*2 (I-N) 
C      INTEGER*2 NUMNP,NUMEL,KX 
      REAL*8 X,Y,VXX,VYY
      COMMON / SPEC /XMIN,YMIN,XMAX,YMAX
      COMMON / VIEW / IPLX,IPLY,LPLX,LPLY,DDPX,DDPY
      COMMON / SCOL / VMAX,VSCAL,ALSCAL,AWSCAL     
      common /plot / NPLOT,IOX,IOY,IOPEN,PPX0,PPY0,PDDPX,PDDPY
      DIMENSION X(NUMDAT),Y(NUMDAT),VXX(NUMDAT),VYY(NUMDAT)
      DIMENSION XM(NUMDAT),YM(NUMDAT),IB(NUMDAT),KX(NUMDAT,5)
C
      VXMAX=0.0
      VYMAX=0.0
      DO 10 II=1,NUMELP
      I=IB(II)
       IF( KX(I,5) .LE. 0 ) GO TO 10
      VV1=VXX(I)*VXX(I)
      VV2=VYY(I)*VYY(I)
        IF( VV1 .GT. VXMAX ) VXMAX=VV1
        IF( VV2 .GT. VYMAX ) VYMAX=VV2
   10 CONTINUE
      VMAX=SQRT(VXMAX+VYMAX)
      VXMAX=SQRT(VXMAX)
      VYMAX=SQRT(VYMAX)
      CALL TEXCLS
      CALL LOCATE(10,1)
      WRITE(*,1) VMAX,VXMAX,VYMAX
    1 FORMAT(" Vmax=",E10.3/" Vxmax=",E10.3,/" Vymax=",E10.3) 
      WRITE(*,*)' How many dot is Vmax?'
      WRITE(*,*)' IF 0, Non-drawing'
      READ(*,*) SCALE       
      CALL TEXCLS
      IF( SCALE .EQ. 0.0 ) RETURN
      SCALX=SCALE/VMAX
      SCALY=SCALE/VMAX
      DO 100 II=1,NUMELP
       I=IB(II)
       IF( KX(I,5) .LE. 0 ) GO TO 100
        VX=VXX(I)*SCALX/DDPX
        VY=VYY(I)*SCALY/DDPY
        VX=XM(I)+VX
        VY=YM(I)+VY
       CALL LINEP(XM(I),YM(I),VX,VY ,     6,   0,   0,    0  ,0)
       CALL PSET(VX,VY,5)
  100 CONTINUE
      RETURN
      END  
      SUBROUTINE ZOON
C     IMPLICIT INTEGER*2 (I-N) 
      COMMON / SPEC /XMIN,YMIN,XMAX,YMAX
      COMMON / VIEW / IPLX,IPLY,LPLX,LPLY,DDPX,DDPY
      common /plot / NPLOT,IOX,IOY,IOPEN,PPX0,PPY0,PDDPX,PDDPY
       CALL LINEP(XMIN,YMIN,XMAX,YMIN ,     7,   1,   0,    0  ,0)
       CALL LINEP(XMIN,YMIN,XMIN,YMAX ,     7,   1,   0,    0  ,0)
       CALL LINEP(XMAX,YMAX,XMAX,YMIN ,     7,   1,   0,    0  ,0)
       CALL LINEP(XMAX,YMAX,XMIN,YMAX ,     7,   1,   0,    0  ,0)
      RETURN
      END
      SUBROUTINE PLWV1
C     IMPLICIT INTEGER*2 (I-N) 
      COMMON / SPEC /XMIN,YMIN,XMAX,YMAX
      COMMON / VIEW / IPLX,IPLY,LPLX,LPLY,DDPX,DDPY
      common /plot / NPLOT,IOX,IOY,IOPEN,PPX0,PPY0,PDDPX,PDDPY
C      
        DDPX=(LPLX-IPLX)/(XMAX-XMIN)
        DDPY=(LPLY-IPLY)/(YMAX-YMIN)
      RETURN
      END  
      SUBROUTINE PLWV2( X,Y,IX,IY )
C     IMPLICIT INTEGER*2 (I-N) 
      COMMON / SPEC /XMIN,YMIN,XMAX,YMAX
      COMMON / VIEW / IPLX,IPLY,LPLX,LPLY,DDPX,DDPY
      common /plot / NPLOT,IOX,IOY,IOPEN,PPX0,PPY0,PDDPX,PDDPY
C
C      
        X2=IPLX+DDPX*(X-XMIN)
        Y2=IPLY+DDPY*(YMAX-Y)       
        IX=IFIX(X2)
        IY=IFIX(Y2)
      RETURN
      END  
      SUBROUTINE PPLWV1
C     IMPLICIT INTEGER*2 (I-N) 
      COMMON / SPEC /XMIN,YMIN,XMAX,YMAX
      common /plot / NPLOT,IOX,IOY,IOPEN,PPX0,PPY0,PDDPX,PDDPY
C      
        CALL TEXCLS
        CALL LOCATE(10,10)
         NPLOT=1
C        WRITE(*,*)'---- ＰＬＯＴＴＥＲに作図しますか　Ｙ／０　Ｎ／１'
C        READ(*,*) NPLOT
C         IF( NPLOT .GT. 0 ) GO TO 200
C        WRITE(*,*)'---- ＰＬＯＴＴＥＲの原点座標(X0,Y0) cm ？'
C        READ(*,*) PPX0,PPY0
C        WRITE(*,*)'---- 作図の軸長さ(XL,YL) cm ？'
C        READ(*,*) PPXL,PPYL
C        PPX0=PPX0*100
C        PPY0=PPY0*100
C        PPXL=PPXL*100
C        PPYL=PPYL*100
C        PDDPX=PPXL/(XMAX-XMIN)
C        PDDPY=PPYL/(YMAX-YMIN)
  200 RETURN
      END  
      SUBROUTINE PPLWV2( X,Y,IX,IY )
C     IMPLICIT INTEGER*2 (I-N) 
      COMMON / SPEC /XMIN,YMIN,XMAX,YMAX
      common /plot / NPLOT,IOX,IOY,IOPEN,PPX0,PPY0,PDDPX,PDDPY
C
C      
        X2=PPX0+PDDPX*(X-XMIN)
        Y2=PPY0+PDDPY*(Y-YMIN)       
        IX=IFIX(X2)
        IY=IFIX(Y2)
      RETURN
      END  
      SUBROUTINE LINEP(XI,YI,XL,YL,ICOL,IMOD,ISSWI,IS1,IS2)
      USE DFLIB
      INTEGER(2) STATUS,COLOR,OLDCOLOR
      TYPE (XYCOORD) XY
      TYPE (WINDOWCONFIG) WC
      COMMON / SPEC /XMIN,YMIN,XMAX,YMAX
      COMMON / VIEW / IPLX,IPLY,LPLX,LPLY,DDPX,DDPY
      common /plot / NPLOT,IOX,IOY,IOPEN,PPX0,PPY0,PDDPX,PDDPY
      CHARACTER*20 WP
      CALL PLWV2(XI,YI,IXI,IYI)
      CALL PLWV2(XL,YL,IXL,IYL)
      CALL MOVETO(INT2(IXI),INT2(IYI),XY)
      STATUS=GETWINDOWCONFIG(WC)
      COLOR = ICOL
      OLDCOLOR=SETCOLOR(COLOR)
      STATUS= LINETO(INT2(IXL),INT2(IYL))
C      IF( NPLOT .GT.0 ) GO TO 10
C       IPEN=MOD(ICL,3)+1
C       IF( IPEN .EQ. IOPEN ) GO TO 30 
C        WRITE(WP,'(A2,I1)')'J ',IPEN
C        WRITE(3,'(A20)')WP
C       IOPEN=IPEN
C   30 CALL PPLWV2(XI,YI,IPXI,IPYI)
C      IF( IPXI.EQ.IOX .AND. IPYI.EQ.IOY )GO TO 60
C        WRITE(WP,'(A2,I6,A1,I6)')'M ',IPXI,',',IPYI
C        WRITE(3,'(A20)')WP
C   60  CALL PPLWV2(XL,YL,IPXL,IPYL)
C         WRITE(WP,'(A2,I6,A1,I6)')'D ',IPXL,',',IPYL
C        IOX=IPXL
C        IOY=IPYL
C        WRITE(3,'(A20)')WP
  10  RETURN
      END
      SUBROUTINE LINEW(IXI,IYI,IXL,IYL,ICOL,IMOD,ISSWI,IS1,IS2)
      USE DFLIB
      INTEGER(2) STATUS,COLOR,OLDCOLOR
      TYPE (XYCOORD) XY
      TYPE (WINDOWCONFIG) WC
C     IMPLICIT INTEGER*2 (I-N) 
      COMMON / SPEC /XMIN,YMIN,XMAX,YMAX
      COMMON / VIEW / IPLX,IPLY,LPLX,LPLY,DDPX,DDPY
      common /plot / NPLOT,IOX,IOY,IOPEN,PPX0,PPY0,PDDPX,PDDPY
      CHARACTER*20 WP
       CALL MOVETO(INT2(IXI),INT2(IYI),XY)
       STATUS=GETWINDOWCONFIG(WC)
       COLOR = ICOL
       OLDCOLOR=SETCOLOR(COLOR)
      STATUS= LINETO(INT2(IXL),INT2(IYL))
  10  RETURN
      END
      SUBROUTINE PSET(XI,YI,ICOL)
      USE DFLIB
      INTEGER(2) STATUS
      INTEGER(2) COLOR,OLDCOLOR,DUMMY
      TYPE (XYCOORD) XY
      TYPE (WINDOWCONFIG) WC
C     IMPLICIT INTEGER*2 (I-N) 
      COMMON / SPEC /XMIN,YMIN,XMAX,YMAX
      COMMON / VIEW / IPLX,IPLY,LPLX,LPLY,DDPX,DDPY
      CALL PLWV2(XI,YI,IXI,IYI)
      STATUS=GETWINDOWCONFIG(WC)
      COLOR = ICOL
      OLDCOLOR=SETCOLOR(COLOR)
      DUMMY=ELLIPSE($GFILLINTERIOR,
     &            INT2(IXI)-1,INT2(IYI)-1,INT2(IXI)+1,INT2(IYI)+1)
C      CALL MOVETO(INT2(IXI),INT2(IYI),XY)
      RETURN
      END
      SUBROUTINE PLOCNT(X,Y,P,KX,IB,
     1                  NUMNP,NUMEL,NUMELP,NUMDAT,ICOL)
C     IMPLICIT INTEGER*2 (I-N) 
C      INTEGER*2 NUMNP,NUMEL,KX 
      REAL*8 X,Y,P
      COMMON / SPEC /XMIN,YMIN,XMAX,YMAX
      COMMON / VIEW / IPLX,IPLY,LPLX,LPLY,DDPX,DDPY
      common /plot / NPLOT,IOX,IOY,IOPEN,PPX0,PPY0,PDDPX,PDDPY
C-----------------------------------------------------------------------
      DIMENSION X(NUMDAT),Y(NUMDAT),KX(NUMDAT,5),H(3),
     1          KA(11),P(NUMDAT),VCNT(11),IB(NUMDAT)
C
      CALL TEXCLS
      CALL LOCATE(15,0)
      WRITE(*,*)' Input contoure information'
 1120 WRITE(*,1000)
 1000 FORMAT(1H0,' How many contoures?',$)
      READ(*,*) NCNT
      IF( NCNT .GT. 11 ) GO TO 1120
      IF( NCNT .LE . 0 ) RETURN
      AMAX=-1.0E20
      AMIN=+1.0E20
      DO 1400 I=1,NUMNP
      PP=P(I)
       IF( X(I).LT.XMIN .OR. X(I).GT. XMAX ) GO TO 1400
       IF( Y(I).LT.YMIN .OR. Y(I).GT. YMAX ) GO TO 1400
      IF( PP .LT. AMIN ) AMIN=PP
      IF( PP .GT. AMAX ) AMAX=PP
 1400 CONTINUE
      WRITE(*,*)' Max.head',AMAX
      WRITE(*,*)' Min.head',AMIN
      DO 1200 I=1,NCNT
      WRITE(*,1300) I
 1300 FORMAT(1H0,' Values of contoures No.',I5)
      READ(*,*) VCNT(I)
 1200 CONTINUE
      WRITE(*,40)
   40 FORMAT(//' ***** PLOT CONTOUR VALUE *****  '/)
      WRITE(*,50)(VCNT(I),I=1,NCNT)
   50 FORMAT(1X,10E10.3)
C
C ----SEARCH PLOT ELEMENT NUMBER
C
      DO 70 IN=1,NUMELP
      I=IB(IN)
       IF( KX(I,5) .LE. 0 ) GO TO 70 
      I1 = KX(I,1)
      I2 = KX(I,2)
      I3 = KX(I,3)
      I4 = KX(I,4)
      AMAX = P(I1) !+Y(I1)*IPPP
      AMIN = AMAX
      H(1) = P(I2) !+Y(I2)*IPPP
      H(2) = P(I3) !+Y(I3)*IPPP
      H(3) = P(I4) !+Y(I4)*IPPP
      DO 80 J=1,3
      IF(H(J) .GT. AMAX) AMAX = H(J)
      IF(H(J) .LT. AMIN) AMIN = H(J)
   80 CONTINUE
      DO 90 J=1,NCNT
C      WRITE(*,*)'  AMIN',AMIN,'  AMAX ',AMAX
      IF(VCNT(J) .LT. AMIN .OR. VCNT(J) .GT. AMAX) GO TO 90
C      WRITE(*,*)'  C-VALE  ',VCNT(J)
      CALL CLINE(X,Y,P,KX,VCNT(J),NUMDAT,I,IPPP,ICOL)
   90 CONTINUE
   70 CONTINUE
      RETURN
      END
      SUBROUTINE CLINE(X,Y,P,KX,VO,NUMDAT,I,IPPP,ICOL)
C     IMPLICIT INTEGER*2 (I-N) 
C      INTEGER*2 NUMNP,NUMEL,KX 
      REAL*8 X,Y,P
      common /plot / NPLOT,IOX,IOY,IOPEN,PPX0,PPY0,PDDPX,PDDPY
      DIMENSION X(NUMDAT),Y(NUMDAT),P(NUMDAT),KX(NUMDAT,5),
     1          H(4,2),L(4,2)
C----------------------------------------------------------------------
C      WRITE(*,*)'   CHECK INSERT CLINE '
      NT = 1
      L(1,1) = KX(I,1)
      L(2,1) = KX(I,2)
      L(3,1) = KX(I,3)
      L(4,1) = L(1,1)
      IF(KX(I,3) .EQ. KX(I,4)) GO TO 100
      NT = 2
      L(1,2) = L(1,1)
      L(2,2) = L(3,1)
      L(3,2) = KX(I,4)
      L(4,2) = L(1,1)
  100 DO 2 K=1,NT
      DO 2 J=1,4
      H(J,K) = P(L(J,K)) !+IPPP*Y(L(J,K))
    2 CONTINUE
      S = 1.0E-10
      DO 110 IT=1,NT
      LCNT = 0
      DO 10 N=1,3
      M = N + 1
      NN = L(N,IT)
      MM = L(M,IT)
      D1 = H(N,IT) - H(M,IT)
      D2 = H(N,IT) - VO
      IF(ABS(D1) .GT. S .OR. ABS(D2) .GT. S) GO TO 40
  200 SX = X(NN)
      SY = Y(NN)
      EX = X(MM)
      EY = Y(MM)
      GO TO 80
   40 D = (H(N,IT) - VO)*(H(M,IT) - VO)
C IMAI@IGEOL
C      IF(D .GT. 0.0) GO TO 10
      IF(D .GT. -S) GO TO 10
      LCNT = LCNT + 1
      EX = X(MM) + (VO-H(M,IT))*(X(NN)-X(MM))/(H(N,IT)-H(M,IT))
      EY = Y(MM) + (VO-H(M,IT))*(Y(NN)-Y(MM))/(H(N,IT)-H(M,IT))
      DEX=(X(MM)-EX)*(X(NN)-EX)
      DEY=(Y(MM)-EY)*(Y(NN)-EY)
C IMAI@IGEOL
C      IF( DEX .GT. 0.0 ) GO TO 200
C      IF( DEY .GT. 0.0 ) GO TO 200
      IF( DEX .GT. S ) GO TO 200
      IF( DEY .GT. S ) GO TO 200
      IF(LCNT .EQ. 2) GO TO 60
      SX = EX
      SY = EY
      GO TO 10
   60 D = H(N,IT) - VO
      IF(ABS(D) .LT. S) GO TO 70
   80 CALL LINEP(SX,SY,EX,EY,ICOL,0,0,0,0)
      GO TO 10
   70 LCNT = 1
   10 CONTINUE
  110 CONTINUE
      RETURN
      END
      SUBROUTINE TEXCLS
      USE DFLIB
      CHARACTER*80 CMET
C      TYPE(RCCOORD) CURPOS
C       WRITE(*,*)'-------------- IN TEXCLS'
C       READ(*,*)ICH
C      CALL LOCATE(25,0)
C      WRITE(CMET,10)
C   10 FORMAT(80(' '))
C      DO I=1,4
C      WRITE(*,*) CMET
C      END DO
C       CALL CLEARSCREEN($GWINDOW)
        CALL SCROLLTEXTWINDOW(INT2(100))
C      WRITE(*,*)'-------------- OUT TEXCLS'
      RETURN
      END
      SUBROUTINE COLOR(N)
      USE DFLIB
      INTEGER(2) oldtc
C     IMPLICIT INTEGER*2 (I-N) 
      IF( N.LT.0 )  N=1
      IF( N.GT.15 ) N=15
C      N=30+N
C      WRITE(*,'(1H ,a1,a1,I2,a1)') CHAR(27),'[',N,'m'
C
c      N=0 
      oldtc = SETTEXTCOLOR(INT2(N))
      RETURN
      END
      SUBROUTINE LOCATE(NL,NNC)
      USE DFLIB
      TYPE(RCCOORD) CURPOS
C     IMPLICIT INTEGER*2 (I-N) 
      COMMON /SCREN/IXIW,IYIW,IXLW,IYLW,IXIC,IYIC,IXLC,IYLC
C      WRITE(*,'(1H ,2a1,I2,a1,I2,a1)') CHAR(27),'[',NL,';',NC,'H'
        NC = NNC
        IF( NC .LT. IXLC-19 ) NC=IXLC-19
        IF( NC .GT. IXLC    ) NC=IXLC
      CALL SETTEXTPOSITION(INT2(NL),INT2(IXIC),CURPOS)
      RETURN
      END
      SUBROUTINE SURFM ( KX,KSUF,IB,X,Y,NUMELP,NUMSUF,NUMDAT,
     %                                            NUMNP)
      USE DFLIB
C     IMPLICIT INTEGER*2 (I-N) 
C      INTEGER*2 NUMNP,NUMEL,KX 
      REAL*8 X,Y
      DIMENSION KX(NUMDAT,5),KSUF(NUMDAT,2),IB(NUMDAT),X(NUMDAT),
     %          Y(NUMDAT)
C
C      STOP 1223
      CALL TEXCLS
      write(*,*)'Searching surface'
      write(*,*)'elements yes/0 no/1'
      read(*,*)iflag
      if( iflag .ne. 1 ) go to 210
      NUMSUF=0
       go to 300
  210 CONTINUE
      CALL TEXCLS
      CALL LOCATE(18,71)
      WRITE(*,*)'Now searching'
C      CALL COLOR(5)
C---- SEARCH NODAL POINTS OF LINE(CONSTRUCTION OF CIRCUMFERENCE) -------
      DO 5 L=1,NUMELP
      IF(KX(L,5).GT.0) GO TO 6
   5  CONTINUE
      WRITE(*,*)'---- Element material Erro '
      stop 3333
   6  M = 4
      IF( KX(L,3).EQ.KX(L,4)) M=3
      DO 10 I=1,M-1
      KSUF(I,1)=KX(L,I)
  10  KSUF(I,2)=KX(L,I+1)
      KSUF(M,1)=KX(L,M)
      KSUF(M,2)=KX(L,1)  
      DO 100 II=L+1,NUMELP
      I=II
        CALL LOCATE(20,71)
        write(*,20) II
   20 FORMAT(' element No.',I5)
      IF( KX(I,5) .LE. 0) GO TO 100
      NUS = 4
      IF( KX(I,3).EQ.KX(I,4)) NUS=3
      DO 110 J=1,NUS
      K1 = KX(I,J)
      J2 = J + 1
      IF( J2 .GT. NUS ) J2 = J2 - NUS
      K2 = KX(I,J2)
      IF( K1 .EQ. K2 ) GO TO 110
      MMM=0
      DO 120 KK=1,M
      IF( KSUF(KK,1).EQ.K1 .AND.KSUF(KK,2).EQ.K2 )GOTO 200
      IF( KSUF(KK,1).EQ.K2 .AND.KSUF(KK,2).EQ.K1 )GOTO 200
  120 CONTINUE
      M=M+1
       IF( M.GT.NUMDAT) GO TO 400
      KSUF(M,1)=K1    
      KSUF(M,2)=K2
       GO TO 110
  200 KSUF(KK,1)=KSUF(M,1)    
      KSUF(KK,2)=KSUF(M,2)
       M=M-1
  110 CONTINUE 
  100 CONTINUE  
  400 IF(M .LE. NUMDAT )GO TO 170
      WRITE(*,160)M,NUMSUF
  160 FORMAT(' NUMSUF=',I5/
     &       ' INPUT =',I5)
      STOP 5555
C
  170 CONTINUE
       NUMSUF=M
      CALL COLOR(7)
  300 RETURN
      END 
