!----------------------------------------------------------------elevint
       subroutine elevint(XX,YY,soln) 
!----------------------------------------------------------------------c
! purpose:                                                             c
!         To interpolate elevation from map data.                      c
!----------------------------------------------------------------------c
! Input data:                                                          c
!            (XX, YY) -- a coordinate                                   
!----------------------------------------------------------------------c
! Output data:                                                         c
!             soln  -- elevation value                                 c
!----------------------------------------------------------------------c
      USE BLKMAP
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 

      INCLUDE 'TXFRM.COM'
!IPK MAY02       COMMON  /TXFRM/  XS, YS, TXSCAL 

      INTEGER LISTM,NLIST 
      DIMENSION NLIST(200),ADIST(200)
      DIMENSION LISTM(1000),listt(60,4),nlf(4),icomp(4),xnear(4) 
!      common /mapc/imap(maxpl) 
!                                                                       
!  Establish size for range                                             
!                                                                       
      JS=1 
      K=0 
      KPT=0 
      DO 120 J=1,MAXPTS 
!                                                                       
!  Determine how long each line is                                      
!                                                                       
        MLEN=J-JS 
!       print *,XMAP(J),VDX,MAXPTS,MLEN,J,JS                            
        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 
              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 
!                                                                       
!  Estimate areal density to get 100 points                             
!                                                                       
      ADEN=AMAP*40./(FLOAT(KPT)*TXSCAL**2) 
!                                                                       
!  Find square coverage                                                 
!                                                                       
      XNEARS=SQRT(ADEN) 
      xnearo=xnears 
!                                                                       
!  initialize range                                                     
!                                                                       
      ict=0 
      xnears=xnearo 
      do nang=1,4 
        XNEAR(nang)=XNEARO 
        icomp(nang)=0 
      enddo 
!                                                                       
!  set imap to zero to start or -1 if no value                          
!                                                                       
  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 
!                                                                       
!  initialize list and completeness test                                
!                                                                       
      do nang=1,4 
        icomp(nang)=0 
        do n=1,50 
          listt(n,nang)=0 
        enddo 
      enddo 
!                                                                       
!  start processing                                                     
!                                                                       
  280 continue 
!                                                                       
!  check for completeness intialize counter                             
!                                                                       
      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                                              
!                                                                       
        DO 300 N=1,NMAP 
!                                                                       
!  skip if no useful value                                              
!                                                                       
          if(imap(n) .eq. -1) go to 300 
!                                                                       
!  use nang if we have been through before                              
!                                                                       
          if(imap(n) .gt. 0) then 
              nang=imap(n) 
!                                                                       
!  skip to end if done                                                  
!                                                                       
              if(icomp(nang) .eq. 1) then 
                go to 300 
              endif 
!                                                                       
!  otherwise check range skipping out if out of range                   
!                                                                       
              d1=cmap(n,1)-XX 
              d2=cmap(n,2)-YY 
              IF(ABS(D1) .GT. XNEAR(NANG)) THEN 
                IMAP(N)=-1 
                GO TO 300 
              ELSEIF(ABS(D2) .GT. XNEAR(NANG)) THEN 
                IMAP(N)=-1 
                GO TO 300 
              ENDIF 
!                                                                       
!  process new point checking range and setting direction               
!                                                                       
            else 
              d1=cmap(n,1)-XX 
              d2=cmap(n,2)-YY 
              IF(ABS(D1) .LT. XNEAR(1)) THEN 
                IF(ABS(D2) .LT. XNEAR(1)) THEN 
                  if(d1 .lt. 0) then 
                    if(d2 .lt. 0) then 
                      imap(n)=3 
                      nang=3 
                    else 
                      imap(n)=2 
                      nang=2 
                    endif 
                  elseif(d2 .lt. 0) then 
                    imap(n)=4 
                    nang=4 
                  else 
                    imap(n)=1 
                    nang=1 
                  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 
            endif 
!                                                                       
!   save value if total less then 50                                    
!                                                                       
            NLF(NANG)=NLF(NANG)+1 
            IF(NLF(NANG) .LT. 51) THEN 
              LISTT(NLF(NANG),NANG)=N 
            ENDIF 
  300   CONTINUE 
!                                                                       
!   now reset range if we need to                                       
!                                                                       
        ictz=0 
        do nang=1,4 
          if(nlf(nang) .gt. 50) then 
            rat=sqrt(45./nlf(nang)) 
            if(rat .lt. 0.2) rat=0.2 
            xnear(nang)=xnear(nang)*rat 
          elseif(nlf(nang) .eq. 0) then 
            if(xnear(nang) .eq. xnears) then 
              ictz=ictz+1 
            else 
              icomp(nang)=1 
            endif 
          else 
            icomp(nang)=1 
          endif 
        enddo 
        if(ictz .gt. 1) then 
          do nang=1,4 
            xnear(nang)=xnear(nang)*2. 
            xnears=xnears*2. 
          enddo 
          if(xnear(1) .lt. 4.) then 
            go to 220 
          endif 
        endif 
!                                                                       
!  go back and try again                                                
!                                                                       
        go to 280 
      endif 
!                                                                       
!  finished  now compact list                                           
!                                                                       
      nlg=0 
      do nang=1,4 
        nlim=nlf(nang) 
        if(nlim .eq. 0) then 
          nlim=50 
        endif 
        do nlgg=1,nlim 
          if(listt(nlgg,nang) .gt. 0) then 
            nlg=nlg+1 
            listm(nlg)=listt(nlgg,nang) 
          endif 
        enddo 
      enddo 
!                                                                       
!-----perform interpolation                                             
!                                                                       
      SOLN=-9999.0 
      CALL GRIDIN(XX,YY,SOLN,LISTM,NLG) 
      return 
      END                                           
