      SUBROUTINE SETRNG(XNEARS,NMAP)

      USE BLKMAP
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 

      INCLUDE 'TXFRM.COM'
!IPK MAY02       COMMON  /TXFRM/  XS, YS, TXSCAL 
!                                                                       
!  Establish size for range                                             
!                                                                       
      JS=1 
      K=0 
      KPT=0 
	  VDX=-1.E9
      write(90,*) 'maxpts', maxpts
      DO 120 J=1,MAXPTS+1 
!                                                                       
!  Determine how long each line is                                      
!                                                                       
        MLEN=J-JS 
!        write(90,*) 'mlen',j,js,mlen,xmap(j),nmap,vdx
!		write(90,*) j,js,mlen,cmap(j,1),xmap(j),vdx,maxpts
        IF(XMAP(J) .LT. VDX) THEN 
!IPK NOV05        IF(CMAP(J,1) .LT. VDX) THEN 
!                                                                       
!  Now check it.                                                        
!                                                                       
          K=K+1 
          IF(MLEN .GT. 1) THEN 
!            LTP=LINTYP(K)                                              
            DO 110 M=1,MLEN 
!              write(191,*) j,m,js+m-1,nmap
              IF(VAL(JS+M-1) .GT. -9000.) THEN 
                KPT=KPT+1 
              ENDIF 
  110       CONTINUE 
          ENDIF 
          NMAP=J 
          IF(MLEN .EQ. 0) GO TO 130 
          JS=J+1 
          go to 120 
        ENDIF 
        cxcur=xmap(j) 
        cycur=ymap(j) 
  120 END DO 
  130 CONTINUE 
      write(90,*) 'number of points forming map',nmap 
      write(90,*) 'last map coordinates',cxcur,cycur 
!                                                                       
!  Estimate areal density to get 100 points                             
!                                                                       
      ADEN=AMAP*40./(FLOAT(KPT)*TXSCAL**2) 
!                                                                       
!  Find square coverage                                                 
!                                                                       
      XNEARS=SQRT(ADEN) 
      xnearo=xnears 
      xnearf=xnears 
!ipk sep97   xnearo forms the current value xnearp is limiting plus side
      XNEARP=XNEARS 
!      xnears=2.0                                                       
      WRITE(90,*) 'Radius for nearby points',XNEARS 
      RETURN
      END

      SUBROUTINE SETELV(XNEARS,NMAP,M,ISWT)

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

!      common /mapc/imap(maxpl),NCRS(MAXPL)
!      dimension ccmap(maxpl)

      DIMENSION LISTM(1000),listt(1600,4),nlf(4),icomp(4),xnear(4) 
      dimension xnearkp(4)


      DATA ITIME/0/ 
      
      IF(.NOT. ALLOCATED(CCMAP)) THEN
        ALLOCATE (CCMAP(MAXPL))
      ENDIF
      call WcursorShape(CurHourGlass)


!ipk feb94 change logic to allow 4 passes and check angles              
!                                                                       
!    initialize range                                                   
!                                                                       
        ict=0 
!ipk sep97        xnears=xnearo                                         
        xnearo=xnears 
        xnearp=xnears 
        xnearf=xnears 
        write(90,*) 'working node',m 
        do nang=1,4 
          XNEAR(nang)=XNEARS 
          xnearkp(nang)=0.
          icomp(nang)=0 
        enddo 
!                                                                       
!    set imap to zero to start or -1 if no value                        
!                                                                       
!IPK MAY97 INITIALIZE COUNTER                                           
        ntime=0 
  220   continue 

        do n=1,nmap 
          if(cmap(n,1) .lt. vdx) then 
            imap(n)=-1 
          elseif(val(n) .lt. -9000.) then 
            imap(n)=-1 
          else 
            imap(n)=0 
          endif 
        enddo 
!                                                                       
!ipk sep97 Sortlist of map points in increasing x except for single poin
!                                                                       
        IF(ielvsw .EQ. 0  .AND. ISWT .NE. 1) THEN 
!ipk mar99
          do n=1,nmap
            ccmap(n)=cmap(n,1)
          enddo
          CALL SORTMAP(CCMAP,NCRS,NMAP,IMAP) 
          ielvsw=1 
!          DO N=1,NMAP                                                  
!            WRITE(90,*) N,CMAP(NCRS(N),1),IMAP(NCRS(N))                
!          ENDDO                                                        
        ENDIF 
!ipk sep97 end addition                                                 
!                                                                       
!    initialize list and completeness test                              
!                                                                       
        do nang=1,4 
          icomp(nang)=0 
          do n=1,1600 
            listt(n,nang)=0 
          enddo 
        enddo 
!                                                                       
!    start processing                                                   
!                                                                       
  280   continue 
!                                                                       
!    check for completeness intialize counter                           
!                                                                       
        ict=0 
        do nang=1,4 
          if(icomp(nang) .eq. 0) then 
            nlf(nang)=0 
          else 
            ict=ict+1 
          endif 
        enddo 
!                                                                       
!    if ict = 4 we are done                                             
!                                                                       
        if(ict .lt. 4) then 
!                                                                       
!    loop through map points                                            
!                                                                       
!ipk sep97 change loop                                                  
          do nang=1,4 
            nlf(nang)=0 
            icomp(nang)=0 
          enddo 
          IFND=0 
          NN=0 
  285     NN=NN+1 
          IF(NN .GT. NMAP) GO TO 305 
!          DO 300 NNN=1,NMAP                                             
          N=NN
          if(val(n) .lt. -9990.) go to 285 
          IF(ISWT .EQ. 1) GO TO 297 
          IF(IFND .EQ. 1) GO TO 295 
          IF(XNEARO .LT. XNEARF) THEN 
            IFND=1 
            GO TO 294 
          ENDIF 
                                                                        
!IPK SEP97 START SEARCH                                                 
          NLOCA=NMAP/2 
          NSTEPS=NMAP/2 
290       CONTINUE 
    
!          WRITE(90,*) 'elvset-164',NLOCA
!          write(90,*) NSTEPS,NCRS(NLOCA)                         
!            WRITE(90,*) CMAP(NCRS(NLOCA),1),CORD(M,1),XNEAR(1)           
          NCUR=NCRS(NLOCA) 
!         IF(CMAP(NCUR,1) .GT. 1.E34) THEN                              
!  WE ARE AOUT OF RANGE                                                 
!           GO TO                                                       
!         ENDIF                                                         
          IF(CMAP(NCUR,1)+XNEARO .LT. CORD(M,1).and. val(ncur) .gt. -9000.) THEN 
! still below     increase nloca                                        
            NSTEPS=NSTEPS/2 
            IF(NSTEPS .EQ. 0) THEN 
!  we are there                                                         
              NLOCA=NLOCA-1 
              IFND=1 
              GO TO 293 
            ENDIF 
            NLOCA=NLOCA+NSTEPS 
            GO TO 290 
          ELSE 
!  too great      decrease nloca                                        
            NSTEPS=(NSTEPS+1)/2 
            NLOCA=NLOCA-NSTEPS 
            IF(NLOCA .LE. 0) THEN 
              NLOCA=0 
              IFND=1 
              GO TO 293 
            ENDIF 
            GO TO 290 
          ENDIF 
  293     NLOCS=NLOCA 
!            WRITE(90,*) 'elvset-201',NLOCA,NSTEPS,NCRS(NLOCA)                         
!           WRITE(90,*) CMAP(NCRS(NLOCA),1),CORD(M,1),XNEAR(1)
          GO TO 295 
  294     NLOCA=NLOCS 
  295     CONTINUE 
          NLOCA=NLOCA+1
          if(nloca .gt. nmap) go to 305 
          NCUR=NCRS(NLOCA) 
!                                                                       
!      test to see if we are past area                                  
!                                                                       
          if(ncur .eq. 0) go to 305
          IF(CMAP(NCUR,1)-XNEARP .GT. CORD(M,1)) GO TO 305 
          if(val(ncur) .lt. -9000.) go to 295
          N=NCUR 
  297     CONTINUE 
          d1=cmap(n,1)-cord(m,1) 
          d2=cmap(n,2)-cord(m,2) 
!ipk may97                IF(ABS(D1) .LT. XNEAR(1)) THEN                
!ipk may97                  IF(ABS(D2) .LT. XNEAR(1)) THEN              
          IF(ABS(D1) .LT. max(XNEARO,xnearp)) THEN 
            IF(ABS(D2) .LT. max(XNEARO,xnearp)) THEN 
              if(d1 .lt. 0) then 
                if(d2 .lt. 0) then 
                  nang=3 
                  if(abs(d1) .lt. xnear(NANG)  .and.                    &
     &                 abs(d2) .lt. xnear(NANG)) then                   
                    imap(n)=3 
                  else 
                    imap(n)=-1 
                    go to 300 
                  endif 
                else 
                  nang=2 
                  if(abs(d1) .lt. xnear(NANG)  .and.                    &
     &               abs(d2) .lt. xnear(NANG)) then                     
                    imap(n)=2 
                  else 
                    imap(n)=-1 
                    go to 300 
                  endif 
                endif 
              elseif(d2 .lt. 0) then 
                nang=4 
                if(abs(d1) .lt. xnear(NANG)  .and.                      &
     &            abs(d2) .lt. xnear(NANG)) then                        
                  imap(n)=4 
                else 
                  imap(n)=-1 
                  go to 300 
                endif 
              else 
                nang=1 
                if(abs(d1) .lt. xnear(NANG)  .and.                      &
     &            abs(d2) .lt. xnear(NANG)) then                        
                  imap(n)=1 
                else 
                  imap(n)=-1 
                  go to 300 
                endif 
              endif 
!                                                                       
!     set to skip out if out of range                                   
!                                                                       
            else 
              imap(n)=-1 
              go to 300 
            endif 
          else 
            imap(n)=-1 
            go to 300 
          endif 
!                                                                       
!IPK SEP97 END MAJOR REWRITE                                            
!                                                                       
!      save value if total less then 50                                 
!                                                                       
          NLF(NANG)=NLF(NANG)+1 
          IF(NLF(NANG) .LT. 101) THEN 
            LISTT(NLF(NANG),NANG)=N 
          ENDIF 
  300     CONTINUE 
          GO TO 285 
  305     CONTINUE 
!                                                                       
!     now reset range if we need to                                     
!                                                                       
          ictz=0 
!             write(90,*) '   '
!             write(90,*) ntime
!             write(90,*) 'nlf',nlf
!              write(90,*) 'xnear',xnear
          do nang=1,4 
            if(nlf(nang) .gt. 150) then 
!             rat=sqrt((45.+ntime*3.)/nlf(nang)) 
!              if(rat .lt. 0.2) rat=0.2 
              rat=sqrt(0.1+0.06*ntime)
              xnearkp(nang)=xnear(nang)
              xnear(nang)=xnear(nang)*rat 
!ipk may97            elseif(nlf(nang) .eq. 0) then                     
            elseif(nlf(nang) .lt. 2) then 
!ipk may97              if(xnear(nang) .eq. xnears) then                
              ictz=ictz+1 
!ipk may97              else                                            
!ipk may97                icomp(nang)=1                                 
!ipk may97              endif                                           
            else 
              icomp(nang)=1 
            endif 
          enddo 
          xnearf=xnearo 
!              write(90,*) 'ntime,ictz,xnear',ntime,ictz
!              write(90,*) 'icomp',icomp
!              write(90,*) 'xneara',xnear
          if(ictz .gt. 0) then 
            do nang=1,4 
              if(nlf(nang) .lt. 2)  then
                if(xnearkp(nang) .gt. 0.) then
                  xnear(nang)=xnearkp(nang)
                else 
                  xnear(nang)=xnear(nang)*1.5
                endif
                if(nang .eq. 2  .or.  nang .eq. 3) then 
                  if(xnear(nang) .gt. xnearo) xnearo=xnear(nang) 
                endif 
                if(nang .eq. 1  .or.  nang .eq. 4) then 
                  if(xnear(nang) .gt. xnearp) xnearp=xnear(nang) 
                endif 
              endif 
!ipk may97              xnears=xnears*2.                                
!              write(90,*) 'nang,xnear',nang,xnear(nang)                
!              write(90,*) 'xnearo,xnearp',xnearo,xnearp                
                                                                        
            enddo 
!ipk sep97          xnears=xnears*2.                                    
            ntime=ntime+1 
            if(ntime .lt. 12) go to 220 
!              go to 220                                                
!            endif                                                      
          endif 
!                                                                       
!      go back and try again                                            
!                                                                       
!ipk may97          go to 280                                           
          ntime=ntime+1 
          if(ntime .lt. 16) go to 280 
        endif 
!                                                                       
!      finished  now compact list                                       
!                                                                       
        do nang=1,4                                                    
!         write(90,*)'nang',nang,nlf(nang),xnear(nang)                 
         enddo                                                          
        nlg=0 
        do nang=1,4 
          nlim=nlf(nang) 
!ipksep97          if(nlim .eq. 0) then                                 
!ipksep97            nlim=50                                            
!ipk sep97          endif                                               
!ipk sep97 chnage limit and act only if nlim > 0                        
!         write(90,*) 'nlim',nlim
          if(nlim .gt. 1600) nlim=1600 
          if(nlim .gt. 0) then 
            do nlgg=1,nlim 
              if(listt(nlgg,nang) .gt. 0) then
                if(nlg .eq. 1000) nlg=999 
                nlg=nlg+1 
                listm(nlg)=listt(nlgg,nang) 
              endif 
            enddo 
          endif 
        enddo
!          write(90,*) nlg                                                
!          write(90,*) m,(listm(n),n=1,nlg),xnear                         
!ipk feb94 end changes
!          do n=1,nmap                                                  
!          write(90,*) n,cmap(n,1),cmap(n,2),val(n)
!          enddo
!          write(90,*) 'LIST MAP POINTS NEAR ',M,CORD(M,1),CORD(M,2)     
!          DO N=1,NLG                                                    
!            WRITE(90,*) listm(n),CMAP(LISTM(N),1),CMAP(LISTM(N),2),val(listm(n))      
!          ENDDO                                                         
!        read(*,*) n234                                                 
                                                                        
!IPK JUL98        CALL GRIDIN(M,SOLN,LISTM,NLG)                         
         XXX=CORD(M,1) 
         YYY=CORD(M,2) 
        CALL GRIDIN(XXX,YYY,SOLN,LISTM,NLG) 
        IF(IRMAIN .EQ. 1) then
          call WcursorShape(CurArrow)
  	  	  RETURN 
		endif
        WD(M)=SOLN 
        FPN = WD(M)*10. 
        X = CORD(M,1) 
        Y = CORD(M,2) - .11 
        IF(X .GT. 0.  .AND.  X .LT. HSIZE  .AND.                         &
     &     Y .GT. 0.  .AND.  Y .LT. 7.5) THEN                           
          CALL RRED 
          CALL NUMBR(X,Y,0.1,FPN,0.0,-1) 
        ENDIF 
!        call WcursorShape(0)
          call WcursorShape(CurArrow)
        RETURN
        END