SUBROUTINE FILLTR
      USE WINTERACTER
      USE IFPORT
      USE BLKMAP
      CHARACTER(LEN=256)  :: FILTER,FNAME
      CHARACTER(LEN=80)   :: DATAIN,OPTIONS
      CHARACTER(LEN=96)   :: LOCDIR
      CHARACTER(LEN=3)    :: SUB
      INTEGER INOUTL,NOUTL,OUTPOL
      INTEGER   NTRIAN(5000,2),TWO,ZERO,ntrans(5000)
      INTEGER*2 RESULT
      LOGICAL EXISTS
      do k=1,80
        options(k:k)=' '
      enddo
      TWO=2
      ZERO=0
      INOUTL=22
      OUTPOL=23
      VOID = - 1.0E+10 
      VDX = - 1.0E+9 

!
!      get filename
    
!       FILTER ="Data files|*.dat;*.txt;*.map|Map file -- *.map|*.map|"
!       CALL WSelectFile(FILTER,PromptOn+DirChange+Appendext,FNAME,'Load data file')

!       IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
!           OPEN(INOUTL,FILE=FNAME,STATUS='OLD')
!           CALL IlowerCase(FNAME)
!           CALL GETSUB(FNAME,SUB)
!           IF(SUB .EQ. 'map') then
!             IMAPIN=1
!           ELSE
!             IMAPIN=0
!           ENDIF
!       ELSE
!         WRITE(*,*) 'ERROR NO FILE'
!       ENDIF
       IMAPIN=1
!      read outline 
!
       IF(IMAPIN .EQ. 1) THEN
        OPEN(113,FORM='BINARY',STATUS='SCRATCH')
        WRITE(113) XMAP,YMAP
        REWIND (113)
         DO K=1,5000
           IF(XMAP(K) .LT. VDX) THEN
             NOUTL=K-1
             GO TO 90
           ENDIF
         ENDDO
90       CONTINUE         
       ELSE
!       IF(IMAPIN .EQ. 1) READ(INOUTL,'(A80)') DATAIN
         DO K=1,5000
             READ(INOUTL,'(A80)') DATAIN
             IF(DATAIN(1:3) .EQ. 'END'  .OR.  DATAIN(1:3) .EQ. 'end') then
             NOUTL=K-1
             GO TO 100
           ELSE
             READ(DATAIN,*) XMAP(K),YMAP(K)
           ENDIF
         ENDDO
100      CONTINUE         
       ENDIF
       IF(XMAP(NOUTL) .EQ. XMAP(1)  .AND.  YMAP(NOUTL) .EQ. YMAP(1)) THEN
         XMAP(NOUTL)=VOID
         YMAP(NOUTL)=VOID
         NOUTL=NOUTL-1
         LOOPC=1
       ELSE
         LOOPC=0
       ENDIF

       DO J=1, NOUTL
         NTRIAN(J,1)=J
         NTRIAN(J,2)=J+1
       ENDDO
       NTRIAN(NOUTL,2)=1
       JC=NOUTL
!      read contours
       NOUTBE=NOUTL+1
       NOUTT=NOUTL
       DO N=1,100
         if(imapin .eq. 1) then
           noutb=noutt+2+LOOPC
           ncnt=0
           DO K=NOUTB,5000
             if(k .eq. noutb) then
               if(xmap(k) .lt. vdx) go to 300
             endif
             IF(XMAP(K) .LT. VDX) THEN
               NOUTT=K-1
               GO TO 110
             ENDIF
             ncnt=ncnt+1
           ENDDO
110        CONTINUE         
         else             
           READ(INOUTL,'(A80)', END=300) DATAIN
           IF(DATAIN(1:3) .EQ. 'END') GO TO 300
           NOUTB=NOUTT+1
           NCNT=0
           DO K=NOUTB,5000
             READ(INOUTL,'(A80)') DATAIN
             IF(DATAIN(1:3) .EQ. 'END'  .OR.  DATAIN(1:3) .EQ. 'end') then
               NOUTT=K-1
               GO TO 200
             ELSE
               READ(DATAIN,*) XMAP(K),YMAP(K)
               NCNT=NCNT+1
             ENDIF
           ENDDO
200        CONTINUE   
         endif
         IF(XMAP(NOUTT) .EQ. XMAP(NOUTB)  .AND.  YMAP(NOUTT) .EQ. YMAP(NOUTB)) THEN
           XMAP(NOUTT)=VOID
           YMAP(NOUTT)=VOID
           NOUTT=NOUTT-1
           LOOPC=1
         ELSE
           LOOPC=0
         ENDIF
         JC=NOUTB-1
         JCB=JC+1
         DO J=NOUTBE, NOUTBE+NCNT-2-LOOPC
           JC=JC+1
           NTRIAN(J,1)=JC
           NTRIAN(J,2)=JC+1
         ENDDO
         IF(LOOPC .EQ. 1) THEN
           NTRIAN(NOUTBE+NCNT-2,1)=JC+1
           NTRIAN(NOUTBE+NCNT-2,2)=JCB
           NOUTBE=NOUTBE+NCNT-1
         ELSE
           NOUTBE=NOUTBE+NCNT-1
         ENDIF
         JC=JC+1
       ENDDO
!      copy to a file
300    CONTINUE      
       OPEN(OUTPOL,FILE='TEST.POLY', STATUS='UNKNOWN')
       ncnt=0
       DO K=1,NOUTT
         if(xmap(k) .lt. vdx) cycle
         ncnt=ncnt+1
         ntrans(k)=ncnt
       ENDDO
       WRITE(OUTPOL,*) NCNT,TWO,ZERO,ZERO
       ncnt=0
       DO K=1,noutt
         if(xmap(k) .lt. vdx) cycle
         ncnt=ncnt+1
         WRITE(OUTPOL,*) ncnt,XMAP(K),YMAP(K)
       ENDDO
       WRITE(OUTPOL,*) NOUTBE-1,ZERO
       DO J=1, NOUTBE-1
         WRITE(OUTPOL,*) J,ntrans(NTRIAN(J,1)),ntrans(NTRIAN(J,2))
       ENDDO
       WRITE(OUTPOL,*) ZERO
       FLUSH (OUTPOL)
       REWIND (OUTPOL)
       CLOSE (OUTPOL)
!       close (inoutl)
!      setup options
    
!       OPTIONS = ' -pqa5000V TEST'
       OPTIONS(1:3) = ' -p'
       nct=3
       iswq=1
       iswy=0
       id1=100
       CALL PANELFILLT(ISWQ,ISWY,ID1)

       IF(ISWQ .EQ. 1) THEN
         NCT=NCT+1
         OPTIONS(NCT:NCT)='q'
       ENDIF
       IF(ISWY .EQ. 1) THEN
         NCT=NCT+1
         OPTIONS(NCT:NCT)='q'
       ENDIF
       ID1=ID1**2/2
       WRITE(OPTIONS(NCT+1:NCT+12),'(''a'',I6.6,'' TEST'')') ID1
!      go to TRIANGLE

        INQUIRE (FILE = 'test.1.ele', EXIST = exists)
        if(exists) then
          open(77,file= 'test.1.ele')
          close(77,status='DELETE')
        ENDIF

        INQUIRE (FILE = 'test.1.node', EXIST = exists)
        if(exists) then
          open(77,file= 'test.1.node')
          close(77,status='DELETE')
        ENDIF

        INQUIRE (FILE = 'test.1.poly', EXIST = exists)
        if(exists) then
          open(77,file= 'test.1.poly')
          close(77,status='DELETE')
        ENDIF
        INQUIRE (FILE = "C:\Program Files\RMA\TRIANGLE.EXE", EXIST = exists) 
        if(.not. exists) then
          INQUIRE (FILE = "TRIANGLE.EXE", EXIST = exists) 
          if(.not. exists) then
            CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'TRIANGLE is not available in '//CHAR(13)//&
                           'C:\Program Files\RMA\ directory'//CHAR(13)//'Do you wish to define directory?'&
            ,'WARNING TRIANGLE IS NOT AVAILABLE')

!   If answer 'No', return
!
            IF (WInfoDialog(4).EQ.2) return
            CALL GETDIR(LOCDIR)
          else
            LOCDIR(1:8)='TRIANGLE'
!            WRITE(155,*) LOCDIR
            RESULT= RUNQQ(LOCDIR, OPTIONS)
            GO TO 600
          endif
        endif
        
       RESULT= RUNQQ("C:\Program Files\RMA\TRIANGLE", OPTIONS)
!       RESULT= RUNQQ("TRIANGLE", OPTIONS)
600    CONTINUE       
       IF(IMAPIN .EQ. 1) THEN
         READ(113) XMAP,YMAP
         CLOSE (113)
       ENDIF 
       IIN=10
       OPEN(IIN,FILE='TEST.1.ELE', STATUS='OLD')
       
       CALL GETNEWFIL(IIN,0,1,1)
 
       
!      finish up
       RETURN
       END

      SUBROUTINE PANELFILLT(N1,N2,N3)

      use winteracter
      implicit none
      SAVE

      include 'D.inc'
      INCLUDE 'BFILES.I90'

!
! Declare window-type and message variables
!
      TYPE(WIN_STYLE)    :: WINDOW

      TYPE(WIN_MESSAGE) :: MESSAGE

      integer  :: N1,N2,N3,IERR,ITIME
!      real     :: 
!      character*3 ::
      DATA ITIME/0/
!      IF(ITIME .EQ. 0) THEN
!        ITIME=1
!        N1=1
!        N2=0
!        N3=100
!      ENDIF
      
      call wdialogload(IDD_FTRIAN)
      ierr=infoerror(1)

      CALL WDialogPutCheckBox(idf_check1,n1)
      CALL WDialogPutCheckBox(idf_check2,n2)
      CALL WDialogPutInteger(idf_integer1,n3)


      CALL WDialogSelect(IDD_FTRIAN)
      ierr=infoerror(1)

      CALL WDialogShow(-1,-1,0,Modal)
      ierr=infoerror(1)
      
      IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
        CALL WDialogGetCheckBox(idf_check1,n1)
        CALL WDialogGetCheckBox(idf_check2,n2)
        CALL WDialogGetInteger(idf_integer1,n3)
      ELSEIF(WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
        N3=-1     
      ENDIF
      RETURN
      END