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

      call supert(XMAP1,YMAP1,NVERT) 

        NELTS=1 
                                                                        
      NVERTM=NVERT-3 

!     Sort points into ascending x order

      CALL SORTDB(XMAP1,NKEY,NVERTM) 

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


        if(mod(NN,2500) .eq. 0) then 
          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(XMAP1(N) .LT. VDX9) GO TO 500
                                                                        
        IF(NN .LT. NVERTM) THEN 
          DO KK=NN+1,NVERTM 
            K=NKEY(KK) 
            IF(K .NE. 0) THEN 
              IF(XMAP1(N) .EQ. XMAP1(K)) THEN 
                IF(YMAP1(N) .EQ. YMAP1(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(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(XMAP1,YMAP1,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 
!ipk dec17 add wd              
            CALL FORMT(XMAP1,YMAP1,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,XMAP1(j),YMAP1(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