subroutine coastalfix(egridval,rawval,sm,hlat,hlon,im,jm,nm,nxin,nyin)
      				
!
!============================================================================
!
! Subroutine written 6 June 2000 to hopefully fix once and for all the
! coastal "smearing" problem seen in soil fields that are bilinearly
! interpolated onto the Eta model's e-grid.  
!
! This routine will make an effort to avoid interpolating soil values
! that are corrupted by being overly close to the coast.  If any of
! the neighbor input points are water, new values of the soil fields
! are calculated as an average of the surrounding non-water points.  
! Not perfect, but better than it was.
!
! This subroutine takes its inspiration (and the nearest neighbor code)
! from the SFCEDAS routine of M. Ek and K. Mitchell.
!
!============================================================================

        implicit none
	integer::im,jm,nm,nxin,nyin
!%%%%	real egridval(0:im+1,0:jm+1,nm,14),rawval(nxin,nyin,14)
!!!!!!	
	real,dimension(0:im+1,0:jm+1,nm,14) :: egridval
	real,dimension(nxin,nyin,14) :: rawval
!!!!!!!!!!!!!!	
	real,dimension(0:im+1,0:jm+1,nm)::sm,hlat,hlon,hlatd,hlond,redo
	real rsum(8),aphd,almd,x,y,tmphold
	integer icount(8),kradul,nsoil,i,j,n,ii,ji,krad,jy,ix,ir,k,itot
	real::r2d,dtr,pi
	parameter (r2d=57.2957795)
	parameter (dtr=3.141592654/180.)
	parameter (pi=3.141592654)
	parameter (nsoil=4)

	KRADUL=1
      print*,'KRADUL',KRADUL

	write(6,*) 'rawval land/sea mask '
	do J=NYIN,1,-10
	write(6,643) (rawval(I,J,1),I=1,NXIN,13)
	enddo
  643	format(30(f3.0))


!
!  Begin looping through e-grid domain
!	
	redo=0.

        do n=1,nm
	DO 200 J=1,JM
	DO 100 I=1,IM

! IF NON LAND-MASS POINT ON OUTPUT GRID, SKIP TO END OF LOOP (100)
!
          IF ((SM(I,J,n) .GT. 0.9)) GOTO 100

! DETERMINE LAT/LON OF TARGET (output) GRID POINT
!
           aphd=hlat(i,j,n)
           almd=hlon(i,j,n)
	   if(almd.ge.2.*pi)then
	      almd=almd-2.*pi
           else if(almd.lt.0)then
	      almd=almd+2.*pi
           endif
!
! DETERMINE NEAREST NEIGHBOR FROM INPUT GRID
!
	   x=almd*0.5*nxin/pi+1.
	   y=aphd*(nyin-1)/pi+(nyin+1)*0.5

	II=INT(X+0.5)
	JI=INT(Y+0.5)

!	rawval has land/sea mask opposite to that of sm (i.e., water=0.)
!
! SEARCH FOR ANY SURROUNDING WATER POINTS (TO A LIMIT OF KRAD=KRADUL)
!
	DO 50 KRAD=1,KRADUL 
        DO 40 JY = JI-KRAD,JI+KRAD 
        DO 30 IX = II-KRAD,II+KRAD
!
!-----------------------------------------------------------------------
! CHECK TO SEE IF THIS NEAREST NEIGHBOR (IX,JY) STILL WITHIN IMI,JMI
! DOMAIN
!
          IF ( (IX .LT. 1) .OR. (IX .GT. NXIN) .OR.  &
               (JY .LT. 1) .OR. (JY .GT. NYIN) )  THEN
		GOTO 30
	  ENDIF

! IS THIS NEIGHBOR POINT WATER?  IF SO THE VALUE HERE IS SUSPICIOUS
!
!	write(6,*) 'NN , rawval ', IX,JY,rawval(ix,jy,1)
!
          IF ( rawval(IX,JY,1) .lt. 0.4) THEN
		redo(i,j,n)=1.
  	       goto 52
	  ENDIF

  30      CONTINUE
  40      CONTINUE
  50      CONTINUE
!
!-----------------------------------------------------------------------
!
  52	continue

        IF (redo(i,j,n) .eq. 1) THEN

!	write(6,*) 'redoing at ', i,j

	icount=0
	rsum=0.

	DO 55 KRAD=1,KRADUL
        DO 45 JY=JI-KRAD,JI+KRAD
        DO 35 IX=II-KRAD,II+KRAD
!
            IF ( (IX .LT. 1) .OR. (IX .GT. NXIN) .OR.  &
                 (JY .LT. 1) .OR. (JY .GT. NYIN) )  THEN
                    GOTO 35
            ENDIF
!
! MAKE SURE THIS POSSIBLE REPLACEMENT ISN'T WATER
!
            IF ( rawval(IX,JY,1) .lt. 0.4) THEN
                  goto 35
            ELSE

	      do IR=1,8
	        rsum(IR)=rsum(IR)+rawval(IX,JY,IR+4)
		icount(IR)=icount(IR)+1
		enddo
			
            ENDIF

!	
  35      CONTINUE
  45      CONTINUE
  55      CONTINUE

          DO 70 K=1,NSOIL
	    tmphold=egridval(I,J,n,2*K+3)
!mp
	if (icount(2*K-1) .gt. 0) then
            egridval(I,J,n,2*K+3)=rsum(2*K-1)/icount(2*K-1)
	endif

	if (icount(K) .eq. 0 .and. K .eq. 1) then
!	write(6,*) 'NO VALID POINTS....KEEP ORIGINAL VALUE!!!! '
	endif

	if (icount(2*K) .gt. 0) egridval(I,J,n,2*K+4)=rsum(2*K)/icount(2*K)

	    if (abs(tmphold-egridval(I,J,n,2*K+3)).gt. 5.) then
!	     write(6,*) 'soil temp: old,new ',i,j,n,tmphold,egridval(I,J,n,2*K+3)
	    endif
  70      CONTINUE

	ENDIF

 100	CONTINUE
 200	CONTINUE
        enddo
	
	itot=0

        do n=1,nm
	do J=1,jm
	do I=1,im
	itot=itot+redo(i,j,n)
	enddo
	enddo
	enddo


	write(6,*) 'replaced soil values at : ', itot, ' points'

	RETURN
	END