       SUBROUTINE crgrid
       USE BLK1MOD
       USE BLKMAP
       REAL*8 GRIDX,GRIDY,GRIDXL,GRIDYL,XL,YL,ANGD,GETANG1,A,B,C,D
       INTEGER*2 IGSKP
	   dimension XL(1500,3),YL(1500,3),mappt(2),XL1(500),XL2(500)
       INCLUDE 'TXFRM.COM'
       COMMON /GBLK/ GRIDX(MAXPGEN),GRIDY(MAXPGEN),GRIDXL(MAXPGEN),GRIDYL(MAXPGEN)&
                   ,IGSKP(MAXPGEN),NRL,NRT,NYP,IGRIDE(MAXPGEN)
!
!    define line numbers in map file
!
       ITEST=1
       CALL PANELGENBLK(NY,XSZ,KL1,KL2,ISW1,ISW2,ITEST)
       JS=1 
!                                                                       
       K=0 
       KL=1
       CALL RCyan 
       DO 20 J=1,MAXPTS 
         MLEN=J-JS 
         IF(XMAP(J) .LE. VDX  .or. j .eq. maxpts) THEN 
           IF(J .EQ. MAXPTS  .AND. XMAP(J) .GT. VDX) MLEN=MLEN+1
!                                                                                                                             
!                                                                       
           K=K+1
           IF(K .EQ. KL2) THEN
             DO KK=1,MLEN
               XL(KK,1)=XMAP(KK+JS-1)  
               YL(KK,1)=YMAP(KK+JS-1)
             ENDDO
             IF(ISW2 .EQ. 1) THEN
               DO KK=MLEN,1,-1
                 XL(KK,3)=XL(MLEN-KK+1,1)  
                 YL(KK,3)=YL(MLEN-KK+1,1)  
               ENDDO
               DO KK=1,MLEN
                 XL(KK,1)=XL(KK,3)  
                 YL(KK,1)=YL(KK,3)  
               ENDDO
             ENDIF
             MAPPT(1)=MLEN
           ENDIF
           IF(K .EQ. KL1) THEN
             DO KK=1,MLEN
               XL(KK,2)=XMAP(KK+JS-1)  
               YL(KK,2)=YMAP(KK+JS-1)
             ENDDO
             IF(ISW1 .EQ. 1) THEN
               DO KK=MLEN,1,-1
                 XL(KK,3)=XL(MLEN-KK+1,2)  
                 YL(KK,3)=YL(MLEN-KK+1,2)  
               ENDDO
               DO KK=1,MLEN
                 XL(KK,2)=XL(KK,3)  
                 YL(KK,2)=YL(KK,3)  
               ENDDO
             ENDIF
             MAPPT(2)=MLEN
           ENDIF
           JS=J+1
           KL=2
         ENDIF
    20 CONTINUE
       K1=1
       K2=2
!
!    compute line length
!
      XL1=0.
	  nlpts1=mappt(k1)
      do n=2,nlpts1
        XL1(n)=XL1(n-1)+SQRT((XL(N,1)-XL(n-1,1))**2+(YL(n,1)-YL(n-1,1))**2)
      enddo     
      XL2=0.
	  nlpts2=mappt(k2)
      do n=2,nlpts2
        XL2(n)=XL2(n-1)+SQRT((XL(N,2)-XL(n-1,2))**2+(YL(n,2)-YL(n-1,2))**2)
      enddo 
      xmean=(XL1(nlpts1)+XL2(nlpts2))/2.	 
!
!    get size spacing
!
	  along=xmean/xsz
	  NX=(along+0.99)

      NXP=NX+1 
      NYP=NY+1 
      NRL=NX*NYP+1 
      NRT=NXP*NYP 

      DO N=1,NE
        DO M=1,8
          NOPSV(N,M)=NOP(N,M)
        ENDDO
          IMATSV(N)=IMAT(N)
      ENDDO
      NESAV=NE
      NEFSAV=NENTRY
      NPUNDO=NRT
                                                                       
!     Initialize GRIDX and GRIDY                                        
                                                                       
      DO N=1,NRT 
        GRIDX(N)=0. 
!        GRIDY(N)=0. 
        IGSKP(N)=0 
      END DO 
!
!    calculate lengths
!
      xalong1=XL1(nlpts1)/NX
	  xalong2=XL2(nlpts2)/NX
!
!    compute cords along the edges
!
      XALONG=0.
      XXALONG=0.
      GRIDX(1)=XL(1,1)
      GRIDY(1)=YL(1,1)
      GRIDX(NYP)=XL(1,2)
      GRIDY(NYP)=YL(1,2)
      NRT=NXP*NYP
  	  NX1=2
      NX2=2
      NCR=1
      DO N=NY+2,NRT,NYP
        NCR=NCR+1
	    XALONG=XALONG+XALONG1
	    DO M=NX1,NLPTS1
	      IF(XALONG .LT. XL1(M)) THEN
		    M1=M
		    GO TO 200
     	  ENDIF
	    ENDDO
  200	CONTINUE
        FRAC1=(XALONG-XL1(M1-1))/(XL1(M1)-XL1(M1-1))
		GRIDX(N)=XL(m1-1,1)+FRAC1*(XL(m1,1)-XL(m1-1,1))
		GRIDY(N)=YL(m1-1,1)+FRAC1*(YL(m1,1)-YL(m1-1,1))
        NX1=M1		
	    XXALONG=XXALONG+XALONG2
	    DO M=NX2,NLPTS2
	      IF(XXALONG .LT. XL2(M)) THEN
		    M2=M
		    GO TO 250
     	  ENDIF
	    ENDDO
  250	CONTINUE
        FRAC1=(XXALONG-XL2(M2-1))/(XL2(M2)-XL2(M2-1))
		GRIDX(N+NY)=XL(m2-1,2)+FRAC1*(XL(m2,2)-XL(m2-1,2))
		GRIDY(N+NY)=YL(m2-1,2)+FRAC1*(YL(m2,2)-YL(m2-1,2))
        NX2=M2	
        
        ANGD1=GETANG1(GRIDX(N-NY-1),GRIDY(N-NY-1),GRIDX(N),GRIDY(N),GRIDX(N+NY),GRIDY(N+NY))
        ANGD2=GETANG1(GRIDX(N),GRIDY(N),GRIDX(N+NY),GRIDY(N+NY),GRIDX(N-1),GRIDY(N-1))
        ANGM1=(ANGD1+180-ANGD2)/2.
!        WRITE(151,*) N,ANGD1,ANGD2,ANGM1
        IF(ITEST .EQ. 1) THEN
          XALONGKP=XALONG
          XXALONGKP=XXALONG
!          write(151,*) 'b',xalong,xxalong
          IF(ANGM1 .GT. 100. .OR. ANGM1 .LT. 80.) THEN
            IF(ANGM1 .GT. 100) THEN
              XALONG=XALONG+XALONG1/2.
              XXALONG=XXALONG-XALONG2/2.
            ELSE
              XALONG=XALONG-XALONG1/2.
              XXALONG=XXALONG+XALONG2/2.
            ENDIF
!            WRITE(151,*) 'a',XALONG,XXALONG
            itag=0
  275       CONTINUE
	        DO M=1,NLPTS1
	          IF(XALONG .LT. XL1(M)) THEN
		        M1=M
	  	        GO TO 300
     	      ENDIF
	        ENDDO
  300	    CONTINUE
            FRAC1=(XALONG-XL1(M1-1))/(XL1(M1)-XL1(M1-1))
	   	    GRIDX(N)=XL(m1-1,1)+FRAC1*(XL(m1,1)-XL(m1-1,1))
	        GRIDY(N)=YL(m1-1,1)+FRAC1*(YL(m1,1)-YL(m1-1,1))
            NX1=M1
            DO M=1,NLPTS2
  	          IF(XXALONG .LT. XL2(M)) THEN
		        M2=M
		        GO TO 350
              ENDIF
	        ENDDO
  350	    CONTINUE
            FRAC1=(XXALONG-XL2(M2-1))/(XL2(M2)-XL2(M2-1))
		    GRIDX(N+NY)=XL(m2-1,2)+FRAC1*(XL(m2,2)-XL(m2-1,2))
		    GRIDY(N+NY)=YL(m2-1,2)+FRAC1*(YL(m2,2)-YL(m2-1,2))
            NX2=M2	
            ANGD3=GETANG1(GRIDX(N-NY-1),GRIDY(N-NY-1),GRIDX(N),GRIDY(N),GRIDX(N+NY),GRIDY(N+NY))
            ANGD4=GETANG1(GRIDX(N),GRIDY(N),GRIDX(N+NY),GRIDY(N+NY),GRIDX(N-1),GRIDY(N-1))
            ANGM2=(ANGD3+180-ANGD4)/2.
!            WRITE(151,*) N,ANGD3,ANGD4,ANGM2
            if(itag .eq. itest) go to 375
            IF(ANGM1 .LT.  80. .AND.  ANGM2 .GT. 100.) THEN
              FRAC=(ANGM2-90)/(ANGM2-ANGM1)
              XALONG=XALONG+XALONG1/2.*FRAC
              XXALONG=XXALONG-XALONG2/2.*FRAC
              itag=1
!              WRITE(151,*) XALONG,XXALONG
              GO TO 275
            ELSEIF(ANGM1 .GT.  100. .AND.  ANGM2 .LT. 80.) THEN
              FRAC=(90-ANGM2)/(ANGM1-ANGM2)
              XALONG=XALONG-XALONG1/2.*FRAC
              XXALONG=XXALONG+XALONG2/2.*FRAC
              itag=1
!              WRITE(151,*) XALONG,XXALONG
              GO TO 275
!              WRITE(151,*) XALONG,XXALONG
            ENDIF  
            XALONG1=(XL1(nlpts1)-XALONG)/(NXP-NCR)
            XALONG2=(XL2(nlpts2)-XXALONG)/(NXP-NCR)
   375      continue     
          ENDIF
        ENDIF
      ENDDO
!
!
!    check if points ok  allow for move
!    
!
!    form elements and other coordinates
!
!                                                                       
!     Interpolate interior points                                       
!                                                                       
      DO M=1,NRT,NYP 
        NFS=NRL+M-1 
      CALL INTERP(GRIDX,GRIDY,M,M+NY,1,GRIDX(M),GRIDY(M),GRIDX(M+NY)    &
     &    ,GRIDY(M+NY),NY,0) 
        DO N=M,M+NY
          GRIDXL(N)=GRIDX(N)
          GRIDYL(N)=GRIDY(N)
          GRIDX(N) =(GRIDXL(N)+XS)/TXSCAL 
          GRIDY(N) =(GRIDYL(N)+YS)/TXSCAL
          XTEMP=GRIDX(N)
          YTEMP=GRIDY(N)
          SIZ=0.1
          CALL RRed 
          call drawcr(xtemp,ytemp,siz)
          CALL RBlue 
        ENDDO
      END DO 
!
!    query for depths
!
!
!    query for happY
      DO 500 N=1,NRT 
!                                                                       
!     Find next blank node in CORD                                      
!                                                                       
        CALL GETNOD(J)
        NODDEL(N)=J 
!                                                                       
!     Store GRIDX and GRIDY into it                                     
!                                                                       
        CORD(J,1) = GRIDX(N) 
        CORD(J,2) = GRIDY(N) 
        IGRIDE(N) = J 
        INEW(J) = 1 
        INSKP(J) = 0 
        WD(J)=-9999.
!                                                                       
        XUSR(J) = GRIDX(N)*TXSCAL - XS 
        YUSR(J) = GRIDY(N)*TXSCAL - YS 
!                                                                       
!     Display point                                                     
!                                                                       
        CALL PLTNOD(J,1) 
!                                                                       
  500 END DO 
!                                                                       
!     Generate elements                                                 
!                                                                       
      CALL GETELM(K) 
      IECHG=0 
!                                                                       
      DO 600 I=1,NX 
        DO 590 J=1,NY 
          CALL GETELM(K)
          NOP(K,1)=IGRIDE((I-1)*NYP+J)
          NOP(K,2)=0 
          NOP(K,3)=IGRIDE(I*NYP+J)
          NOP(K,4)=0 
          NOP(K,5)=IGRIDE(I*NYP+J+1) 
          NOP(K,6)=0 
          NOP(K,7)=IGRIDE((I-1)*NYP+J+1) 
          NOP(K,8)=0 
          IMAT(K)=1 
!          IF(K .GT. NE) NE=K                                           
          NCORN(K)=8 
          IESKP(K)=0 
!IPK JAN98                                                              
          IERC=0 
          CALL PLTELM(K,IERC) 
  590   CONTINUE 
  600 END DO 
       CALL WRTOUT(0) 
	  RETURN
      end
    
      REAL*8 FUNCTION GETANG1(X1,Y1,X2,Y2,X3,Y3)
      REAL*8 X1,Y1,X2,Y2,X3,Y3,CAN
      C=SQRT((X2-X1)**2+(Y2-Y1)**2)
      B=SQRT((X3-X2)**2+(Y3-Y2)**2)
      A=SQRT((X1-X3)**2+(Y1-Y3)**2) 
      CAN=(B**2+C**2-A**2)/(2.*B*C)
      GETANG1=DACOSD(CAN)
      RETURN
      END
    
     SUBROUTINE PANELgenblk(N1,XL,N2,N3,ISW1,ISW2,ITEST)

      use winteracter

      implicit none

      include 'D.inc'

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

      TYPE(WIN_MESSAGE) :: MESSAGE

      integer  :: N1,N2,N3,IERR,IFIRST,ISW1,ISW2,ITEST
      real     :: XL
      character*3 :: sub
      DATA IFIRST/0/
      
      IF(IFIRST .EQ. 0) THEN
        IFIRST=1
        N1=1
        N2=1
        N3=2
        XL=5.
        isw1=0
        isw2=0
      ENDIF
      call wdialogload(IDD_GENBLK)
      ierr=infoerror(1)

      CALL WDialogPutInteger(idf_integer1,n1)
      CALL WDialogPutInteger(idf_integer2,n2)
      CALL WDialogPutInteger(idf_integer3,n3)
      CALL WDialogPutInteger(idf_integer5,ITEST)
      CALL WDialogPutReal(idf_real1,xl)
      CALL WDialogPutCheckBox(idf_check1,isw1)
      CALL WDialogPutCheckBox(idf_check2,isw2)
      CALL WDialogSelect(IDD_GENBLK)
      ierr=infoerror(1)

      CALL WDialogShow(-1,-1,0,Modal)
      ierr=infoerror(1)
      
      IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
        CALL WDialogGetInteger(idf_integer1,n1)
        CALL WDialogGetInteger(idf_integer2,n2)
        CALL WDialogGetInteger(idf_integer3,n3)
        CALL WDialogGetReal(idf_real1,xl)
        CALL WDialogGetInteger(idf_integer5,ITEST)
        CALL WDialogGetCheckBox(idf_check1,isw1)
        CALL WDialogGetCheckBox(idf_check2,isw2)

      
      ENDIF
      RETURN
      END
    