      SUBROUTINE GRELV 
!                                                                       
!     THIS ROUTINE COMPUTES THE GRIDDED ELEVATION 
!                                                                       
      use winteracter
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 
      INCLUDE  'TXFRM.COM' 
!-                                                                      

      include 'd.inc'

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

      TYPE(WIN_MESSAGE) :: MESSAGE
      INTEGER           :: IERR,ISET
      REAL              :: ASET
      DATA NXP,NYP/30,20/
	  DATA ITIM/0/

	  IF(ITIM .EQ. 0) THEN
	    NX=NXP+2
		NY=NYP+2
		ITIM=0
	  ENDIF

      call wdialogload(IDD_GETINTP)
      ierr=infoerror(1)

      CALL WDialogSelect(IDD_GETINTP)
      ierr=infoerror(1)

  100 continue
      NXP=NX-2
	  NYP=NY-2
	  XGR=XGRID*TXSCAL
	  YGR=YGRID*TXSCAL
      CALL WDialogPutINTEGER(IDF_INTEGER1,NXP)
      CALL WDialogPutINTEGER(IDF_INTEGER2,NYP)
      CALL WDialogPutREAL(IDF_REAL1,XGR)
      CALL WDialogPutREAL(IDF_REAL2,YGR)

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

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


              CALL WDialogGetINTEGER(IDF_INTEGER1,NXP)
              CALL WDialogGetINTEGER(IDF_INTEGER2,NYP)
              CALL WDialogGetREAL(IDF_REAL1,XGR)
              CALL WDialogGetREAL(IDF_REAL2,YGR)
			  GO TO 200
          else
              NRECC=0
          endif

        enddo

  200 CONTINUE
      NX=NXP+2
	  NY=NYP+2
      XGRID=XGR/TXSCAL
	  YGRID=YGR/TXSCAL
!-                                                                      
      AXMAX = HSIZE
      AYMAX =  7.0 
      if(xgrid .eq. 0.) then
        XGRID = AXMAX/FLOAT(NX-3) 
	  ELSE
	    NX=(AXMAX/XGRID+0.5)+3
	  ENDIF
	  IF(YGRID .EQ. 0.) THEN
        YGRID = AYMAX/FLOAT(NY-3) 
	  ELSE
	    NY=(AYMAX/YGRID+0.5)+3
	  ENDIF

      IF(NX .GT. MAXGRD  .OR.  NY .GT. MAXGRD) THEN
	  	  CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,          &
	    'Maximum number of interpolation points exceeded '//CHAR(13) &
	  //'Choose a lower resolution.',           &
	    'Warning')
		go to 100
	  endif

      CALL LOCATE 
!                                                                       
      CALL POINTEL 

      RETURN 
      END                                           

      SUBROUTINE POINTEL
!*********************************** .....POINTS.....                   
!-                                                                      
!......SUBROUTINE TO EVALUATE FUNCTION AT GRID POINTS                   
!-                                                                      
!-                                                                      
      USE WINTERACTER
      USE BLK1MOD

      include 'd.inc'

      INCLUDE  'TXFRM.COM' 
!                                                                       
      REAL*8 XN,DNX,DNY 
      DOUBLE PRECISION XG,YG,XK,YK,XP,YP
!      INCLUDE 'BLK1.COM' 
!      INCLUDE 'BLKV1.COM' 
!      INCLUDE 'BLKV2.COM' 
      INCLUDE 'BFILES.I90'
!-                                                                      
!ipk jul94      DIMENSION X(8),Y(8)                                     
      DIMENSION X(9),Y(9) 
      CHARACTER(LEN=255)  :: FNAME,FNAMR
      CHARACTER(LEN=256) :: FILTER
      CHARACTER(LEN=3)    :: SUB,SUB1
!-                                                                      
      DATA TOL/0.01/ 
!-                                                                      

!-                                                                      
!......LOOP ON ALL GRID POINTS                                          
!-               
      FILTER = 'Map file *.map|*.map|'
      CALL WSelectFile(FILTER,SaveDialog+PromptOn,FNAME,'Save Map File')

      IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN

		CALL IlowerCase(FNAME)
        CALL GETSUB(FNAME,SUB)
        OPEN(199,FILE=FNAME,STATUS='UNKNOWN')
		WRITE(199,8000)
 8000   FORMAT('2,0.')
	  ELSE
	    RETURN
	  ENDIF
                                                       
      DO 1000 NN=1,NX 
      DO 950 MM=1,NY 
      N=IGRID(NN,MM) 
      IF(N.EQ.0) GO TO 950 
        HGN=0. 
  250 CONTINUE 
!-                                                                      
!......DETERMINE ELEMENT TYPE                                           
!-                                                                      
!IPKOCT93 ADD                                                           
      NCN=8 
      IT=1 

      IF(NOP(N,7).NE.0) GO TO 275 
      NCN=6 
      IT=2 
  275 CONTINUE 
!-                                                                      
!......ESTABLISH LOCAL COORDINATES FOR EACH NODE POINT                  
!-                                                                      
      K1=NOP(N,1) 
      X(1)=0. 
      Y(1)=0. 
      DO 300 K=2,NCN 
      K2=NOP(N,K) 
      X(K)=CORD(K2,1)-CORD(K1,1) 
      Y(K)=CORD(K2,2)-CORD(K1,2) 
  300 END DO 
!-                                                                      
!......ESTABLISH LOCAL COORDINATES OF DESIRED POINT                     
!-                                                                      
      XP=FLOAT(NN-2)*XGRID
	  XRL=XP*TXSCAL-XS
	  XP=XP-CORD(K1,1) 
      YP=FLOAT(MM-2)*YGRID
      YRL=YP*TXSCAL-YS
	  YP=YP-CORD(K1,2) 
      XG=0. 
      YG=0. 
!-                                                                      
!......ITERATE TO FIND LOCAL COORDINATE                                 
!-                                                                      
      DO 400 ITER=1,10 
        DXKDX=0. 
        DXKDY=0. 
        DYKDX=0. 
        DYKDY=0. 
        XK=-XP 
        YK=-YP 
        DO 350 K=2,NCN 
          XK=XK+XN(IT,K,XG,YG)*X(K) 
          YK=YK+XN(IT,K,XG,YG)*Y(K) 
          DXKDX=DXKDX+DNX(IT,K,XG,YG)*X(K) 
          DYKDX=DYKDX+DNX(IT,K,XG,YG)*Y(K) 
          DXKDY=DXKDY+DNY(IT,K,XG,YG)*X(K) 
          DYKDY=DYKDY+DNY(IT,K,XG,YG)*Y(K) 
  350   END DO 
        DET=DXKDX*DYKDY-DXKDY*DYKDX 
        DX=(-DYKDY*XK+DXKDY*YK)/DET 
        DY=( DYKDX*XK-DXKDX*YK)/DET 
        XG=XG+DX 
        YG=YG+DY 
        IF(ABS(DX).LT.TOL .AND. ABS(DY).LT.TOL) GO TO 420 
  400 END DO 
!-                                                                      
!......NOW EVALUATE GRID POINT                                          
!-                                                                      
  420 CONTINUE 
      DO 450 K=1,NCN 
        J=NOP(N,K) 
        HGN=HGN+XN(IT,K,XG,YG)*WD(J) 
  450 END DO 
      WRITE(199,9800) XRL,YRL,HGN
 9800 FORMAT(F14.2',',F14.2,',',F14.3)
  950 END DO 
 1000 END DO 
!     IF(NVEL .EQ. 1) WRITE(6,9803) ((UGRID(NN,MM),MM=1,32),            
!    1NN=1,32)                                                          
!     IF(NVEL .EQ. 1) WRITE(6,9803) ((VGRID(NN,MM),MM=1,32),            
!    1NN=1,32)                                                          
 9803 FORMAT(8E12.4) 
!      WRITE(6,9802)((GRID(NN,MM),MM=1,16),NN=1,16)                      
!9802 FORMAT(16F8.2)                                                    
      WRITE(199,8001)
 8001 FORMAT('END')
	  WRITE(199,8001) 
      RETURN 
      END                                           

!                                                                       
      SUBROUTINE LOCATE 
!*********************************** .....LOCATE.....                   
!-                                                                      
!......LOCATE ESTABLISHES ELEMENT NUMBERS FOR ALL GRID POINTS           
!-                                                                      
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 
!      INCLUDE 'BLKV1.COM' 
!      INCLUDE 'BLKV2.COM' 
      INCLUDE 'BFILES.I90'
!                                                                       
      COMMON XS(4,3),YS(4,3),XM(4,3),ROOT(10) 
!                                                                       
      VOID=1.E+20 
      NPTS= 7 
      DS=1./(FLOAT(NPTS)-1.) 
      DO 340 N=1,MAXGRD 
      DO 340 M=1,MAXGRD 
  340 IGRID(N,M)=0 
!-                                                                      
!....... PROCESS EACH ELEMENT                                           
!-                                                                      
      DO 900 N=1,NE 
      IF(IESKP(N) .NE. 0) GO TO 900 
      IF(IMAT(N).LE.0) GO TO 900 
      IF(NOP(N,6) .EQ. 0) GO TO 900 
      XMINN=VOID 
      YMINN=VOID 
      XMAXX=-VOID 
      YMAXX=-VOID 
!-                                                                      
!...... TRACE AROUND EACH SIDE FOR MAX AND MIN LOCATIONS                
!-                                                                      
      NCN=8 
      IF(NOP(N,7).EQ.0) NCN=6 
      NSIDE=NCN/2 
      K=0 
      DO 600 M=1,NCN,2 
      K=K+1 
      M1=NOP(N,M) 
      M2=NOP(N,M+1) 
      M3=MOD(M+2,NCN) 
      M3=NOP(N,M3) 
      XS(K,1)=CORD(M1,1) 
      XS(K,2)=CORD(M2,1) 
      XS(K,3)=CORD(M3,1) 
      YS(K,1)=CORD(M1,2) 
      YS(K,2)=CORD(M2,2) 
      YS(K,3)=CORD(M3,2) 
      XM(K,1)=2.*XS(K,1)-4.*XS(K,2)+2.*XS(K,3) 
      XM(K,2)=-3.*XS(K,1)+4.*XS(K,2)-XS(K,3) 
      XM(K,3)=XS(K,1) 
!-                                                                      
!..... WORK ALONG BOUNDARY OF ELEMENT                                   
!-                                                                      
      S=0. 
      DO 550 J=1,NPTS 
      XN1=(1.-S)*(1.-2.*S) 
      XN2=4.*(1.-S)*S 
      XN3=S*(2.*S-1.) 
      X=XN1*XS(K,1)+XN2*XS(K,2)+XN3*XS(K,3) 
      Y=XN1*YS(K,1)+XN2*YS(K,2)+XN3*YS(K,3) 
      IF(X.LT.XMINN) XMINN=X 
      IF(X.GT.XMAXX) XMAXX=X 
      IF(Y.LT.YMINN) YMINN=Y 
      IF(Y.GT.YMAXX) YMAXX=Y 
      S=S+DS 
  550 END DO 
  600 END DO 
!-                                                                      
!...... ESTABLISH GRID FRAMEWORK                                        
!-                                                                      
      XLH=XMINN/XGRID 
      XRH=XMAXX/XGRID 
      YBT=YMINN/YGRID 
      YTP=YMAXX/YGRID 
      IXL=XLH+2.999 
      IXT=XRH+2.001 
      IYL=YBT+2.999 
      IYT=YTP+2.001 
      IERR=0 
!$$$                                                                    
      IF(IXL.LT.0) IERR=1 
      IF (IXL .LT. 1)  IXL = 1 
      IF(IYL.LT.0) IERR=1 
      IF (IYL .LT. 1)  IYL = 1 
      IF(IXT.GT.NX) IERR=1 
      IF (IXT .GT. NX)  IXT = NX 
      IF(IYT.GT.NY) IERR=1 
      IF (IYT .GT. NY)  IYT = NY 
!                                                                       
      IF(IERR.EQ.0) GO TO  620 
!      WRITE(6,9989) N                                                  
! 9989 FORMAT(///'   ERROR STOP FOR ELEMENT',I5)                        
!      WRITE(6,9990)  (K,(XS(K,M),YS(K,M),XM(K,M),M=1,3),K=1,NSIDE)     
! 9990 FORMAT(I10,9E13.4)                                               
!      WRITE(6,9992) XLH,XRH,YBT,YTP,IXL,IXT,IYL,IYT                    
! 9992 FORMAT(4F20.6,4I8)                                               
!$$$      STOP                                                          
  620 CONTINUE 
!-                                                                      
!...... FIND INTERSECTIONS FOR HORIZONTAL GRID LINE                     
!-                                                                      
      DO 800 M=IYL,IYT 
      Y=(M-2)*YGRID 
      IL=0 
      DO 700 K=1,NSIDE 
      A=2.*YS(K,1)-4.*YS(K,2)+2.*YS(K,3) 
      B=-3.*YS(K,1)+4.*YS(K,2)-YS(K,3) 
      C=YS(K,1)-Y 
      SQ=B**2-4.*A*C 
      IF(ABS(A).LT.0.01) GO TO 650 
      IF(SQ.GT..001) GO TO 660 
      IF(SQ.LT.-.001) GO TO 700 
      S=-B/(2.*A) 
      IF(S.LT.0. .OR.  S.GT.1.0) GO TO 700 
      IL=IL+1 
      ROOT(IL)=XM(K,1)*S**2+XM(K,2)*S+XM(K,3) 
      IL=IL+1 
      ROOT(IL)=ROOT(IL-1) 
      GO TO 700 
  650 IF(ABS(B).LT. 0.001) GO TO 700 
      S=-C/B 
      GO TO 670 
  660 CONTINUE 
      S=(-B+SQRT(SQ))/(2.*A) 
      IF(S.LT.0. .OR.  S.GT.1.0) GO TO 665 
      IL=IL+1 
      ROOT(IL)=XM(K,1)*S**2+XM(K,2)*S+XM(K,3) 
  665 S=(-B-SQRT(SQ))/(2.*A) 
  670 CONTINUE 
      IF(S.LT.0. .OR.  S.GT.1.0) GO TO 700 
      IL=IL+1 
      ROOT(IL)=XM(K,1)*S**2+XM(K,2)*S+XM(K,3) 
  700 END DO 
      IF(IL.GT.0) GO TO 705 
      DO 703 K=1,NSIDE 
      IF(ABS(YS(K,3)-Y).LT.0.05) GO TO 704 
  703 END DO 
      GO TO 800 
  704 IL=2 
      ROOT(1)=XS(K,3)-0.05 
      ROOT(2)=XS(K,3)+0.05 
  705 CONTINUE 
      CALL SORTE(ROOT,IL) 
!      ISET=0                                                           
      IC=1 
!-                                                                      
!....... LOCATE VALUES INTO IGRID                                       
!-                                                                      
 9908 FORMAT(I10,F20.2) 
 9997 FORMAT(5F20.4) 
      DO 750 K=IXL,IXT 
      X=(K-2)*XGRID 
  710 CONTINUE 
      IF(X.LE.ROOT(IC)) GO TO 720 
      IC=IC+1 
      IF(IC.GT.IL) GO TO 800 
      GO TO 710 
  720 IF(MOD(IC,2).EQ.0) IGRID(K,M)=N 
  750 END DO 
  800 END DO 
  900 END DO 
!CC      WRITE(*,9800) ((IGRID(N,M),N=1,20),M=1,20)                     
 9800 FORMAT(20I3) 
      RETURN 
      END                                           
!                                                                       
      SUBROUTINE SORTE(A,N) 
!*********************************** .....SORT.....                     
!-                                                                      
!......SORT IS A SIMPLE SHELL SORT ROUTINE                              
!-                                                                      
!     SHELL SORT                                                        
      SAVE 
!                                                                       
      DIMENSION A(*) 
      IF(N.LT.2) RETURN 
      ID = N 
  100 ID = ID / 2 
  110 IB = 1 
  120 GO TO 200 
  130 IB = IB + 1 
      IF( IB .LE. ID ) GO TO 200 
      IF( ID .GT. 1 ) GO TO 100 
      RETURN 
  200 I = IB 
  210 K = I + ID 
  220 IF( A(I) .LE. A(K) ) GO TO 250 
      T = A(K) 
      A(K) = A(I) 
      J = I 
  230 K = J - ID 
      IF( K .LT. 1 ) GO TO 240 
      IF( T .GT. A(K) ) GO TO 240 
      A(J) = A(K) 
      J = K 
      GO TO 230 
  240 A(J) = T 
  250 I = I + ID 
      IF( I + ID .LE. N ) GO TO 210 
      GO TO 130 
      END                                           
!                                                                       
