      SUBROUTINE TRIANG
                        						                                                
      USE WINTERACTER
      USE BLKMAP
      USE BLK1MOD
!      INCLUDE 'BLK1.COM'

      DATA VOID10/-1.E10/,SPAC/0.0/
			                                                           
      NELTS=0 
      NVERT=MAXPTS
      NINTV=1
      CALL TRIANOPT(NINTV,SPAC)

    
!   FIRST WRITE EXISTING MAP TO SCRATCH
      OPEN(99,FORM='BINARY',STATUS='SCRATCH')
 
      CALL WRTMAP(99)
      REWIND 99
      
      DO N=1,NVERT
        IF(MOD(N-1,NINTV) .EQ. 0) THEN
          IMAP(N)=1
	    ELSE
	      IMAP(N)=0
	    ENDIF
	  ENDDO

      IF(SPAC .GT. 0.) THEN
	    DO N=1,NVERT
	      IF(IMAP(N) .EQ. 1) THEN
  	  	    IF(N .LT. NVERT) THEN
		      DO M=N+1,NVERT
                DISQ=(XMAP(M)-XMAP(N))**2+(YMAP(M)-YMAP(N))**2 
			    IF(DISQ .LT. SPAC**2) THEN
			      IMAP(M)=0
				ENDIF
		      ENDDO
		    ENDIF
		  ENDIF
	    ENDDO
      ENDIF
      NN=0
      DO N=1,NVERT
        IF(IMAP(N) .GT. 0) THEN
          NN=NN+1
          XMAP(NN)=XMAP(N)
          YMAP(NN)=YMAP(N)
          IMAP(NN)=IMAP(N)
        ENDIF
      ENDDO
      NVERT=NN
!      WRITE(185,*) 'NEW NVERT',NVERT


      call WcursorShape(CurHourGlass)
      CALL DELAUNAY(NVERT) 
      call WcursorShape(CurArrow)


      RETURN
      END 
                                                                        
                                                                        
                                                                        
!     Last change:  IPK   2 Feb 2003    6:25 pm                         
      SUBROUTINE DELAUNAY(NVERT) 
      
      USE BLKMAP
      USE BLK1MOD
!	  INCLUDE 'BLK1.COM'                                                             
      CHARACTER*80 LIND
	  CHARACTER*1 ANS
      DATA VDX9/-9.E9/,NEDGE/0/
                                                                        
!     Get location of supertriangle                                     
                                                                        
      iprt=0
      ngap=0
      YLV=7.5
      
                                                                        

      call supert(XMAP,YMAP,NVERT) 

        NELTS=1 
                                                                        
      NVERTM=NVERT-3 
      IF(NVERT .GT. MAXP) THEN
        DEALLOCATE (NKEY)
        ALLOCATE (NKEY(NVERT))
        NKEY=0
      ENDIF

!     Sort points into ascending x order

      CALL SORTDB(XMAP,NKEY,NVERTM) 

!     Loop on the vertices                                              
                                                                        
      DO NN=1,NVERT-3 

!        IF(MOD(NN,5) .EQ. 0) WRITE(185,*) 'LOOP',NN
        if(mod(NN,2500) .eq. 0) then 
          WRITE(90,*) NN,' points processed'
          ylv=ylv-0.3 
          if(ylv .lt. 0.1) then 
            ylv=7.9 
            call clscrn 
          endif 
          write(lind,6010) NN 
 6010     format(i8,' points processed') 
          call symbl                                                   &
     &     (1.1,ylv,0.20,LIND,0.0,80)                                   
        endif 

!     process next point                                                                        

        N=NKEY(NN) 

!     Skip out if inactive point
        IF(N .EQ. 0) GO TO 500
        IF(IMAP(N) .EQ. 0) GO TO 500                                                                        
  	    IF(XMAP(N) .LT. VDX9) GO TO 500
	    IF(VAL(N) .LT. -9000.) GO TO 500 
!        IF(NN .GT. 1700.  .AND.  MOD(NN,5) .EQ. 0) WRITE(185,*) 'N',N,IMAP(N),XMAP(N),VAL(N)
                                                                        
!        WRITE(45,*) NN,N,NVERT,XMAP(N),YMAP(N) 
        IF(NN .LT. NVERTM) THEN 
          DO KK=NN+1,NVERTM 
            K=NKEY(KK) 
!            IF(NN .GT. 1700) WRITE(185,*) 'NKEY',K,KK

            IF(K .NE. 0) THEN 
              IF(XMAP(N) .EQ. XMAP(K)) THEN 
                IF(YMAP(N) .EQ. YMAP(K)) THEN 
                  WRITE(45,*) 'IDENT',N,K 
                  NKEY(KK)=0 
                ENDIF 
              ELSE 
                GO TO 200 
              ENDIF 
            ENDIF 
  200       CONTINUE 
          ENDDO 
        ENDIF 
                                                                        
!     Set edge buffers to zero                                          
!        IF(NN .GT. 1700  .AND.  MOD(NN,5) .EQ. 0) WRITE(185,*) 'AFTER 200 NEDGE',NEDGE
                                                                        
        IF(NEDGE .GT. 0) THEN 
          DO J=1,NEDGE 
            IEDGE(J,1)=0 
            IEDGE(J,2)=0 
          END DO 
        ELSE 
          DO J=1,100 
            IEDGE(J,1)=0 
            IEDGE(J,2)=0 
          END DO 
        ENDIF 
        NEDGE=0 
                                                                        
!     test for point in circumcircle                                    
                                                                        
        DO J=1,NELTS 
          CALL INSIDCIRC(XMAP,YMAP,J,N,ISWT) 
                                                                        
!     If inside process edges                                           
                                                                        
          IF(ISWT .EQ. 1) THEN 
            CALL PROCESS(J,NEDGE,NGAP)                                 
          ENDIF 
        END DO 
                                                                        
!     Setup to form new triangles                                       

        CALL SETEDG(NEDGE)
                                                              
!     Now form triangles as needed                                      
                                                                        
        DO J=1,NEDGE 
          IF(IEDGE(J,1) .NE. 0) THEN 
            CALL FORMT(XMAP,YMAP,J,N,NGAP,KK,WD)                           
          ENDIF 
        END DO 

        NEDGE=0 
        if(iprt .eq. 0) go to 500 
        DO J=1,NELTS 
          IF(NOPEL(J,1) .GT. 0) THEN 
            WRITE(3,'(2i5,2i10,19x,''1'')') J,(NOPEL(J,K),K=1,3) 
          ENDIF 
        END DO 
                                                                        

        IF(NN .EQ. 1) THEN 
            write(41,'('' 9999'')') 
          do j=1,nvert 
              write(41,'(i10,2f20.4,F10.3)') j,XMAP(j),YMAP(j),VAL(J) 
          enddo 
          write(41,'(''      9999'')') 
          write(41,'('' 9999'')') 
          write(41,'(''    0                    NENTRY'')') 
          write(41,'(''    0                    NCLM'')') 
          WRITE(41,'(''ENDDATA'')') 
        ENDIF 
  500   continue 
      END DO 
                                                                        
!     Get rid of elements from super point                              
                                                                        
      CALL RIDPOINT(NVERT) 
                                                                        
      RETURN 
      END SUBROUTINE 
                                                                        
      SUBROUTINE TRIANOPT(NINTV,SPAC)

	  USE WINTERACTER
      include 'd.inc'

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

      TYPE(WIN_MESSAGE) :: MESSAGE
      
      INTEGER            :: NINTV
      INTEGER           :: IERR
	  REAL              :: SPAC
      CHARACTER*1       :: IFLAG

      call wdialogload(IDD_TRIAN)
      ierr=infoerror(1)

      CALL WDialogSelect(IDD_TRIAN)
      ierr=infoerror(1)

      CALL WDialogPutInteger(IDF_INTEGER1,NINTV)
      CALL WDialogPutReal(IDF_REAL1,SPAC)

      CALL WDialogShow(-1,-1,0,Modal)
      ierr=infoerror(1)

        do
!
          IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN


              CALL WDialogGetINTEGER(IDF_INTEGER1,NINTV)
              IF(NINTV .EQ. 0)   NINTV=1
              CALL WDialogGetREAL(IDF_REAL1,SPAC)
		  ELSE
		      SPAC=0.0
			  NINTV=1
	      ENDIF
		  RETURN
        enddo
	  RETURN
	  END                                                                     
   