
!     Last change:  IPK  12 Jan 98    1:44 pm                           
!                                                                       
      SUBROUTINE GNODE 
!                                                                       
!     Routine to create a series of nodes along a line                  
!                                                                       
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 

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

      REAL*8 GRIDX(150),GRIDY(150),ALX,ALY,ATX,ATY,ALXX(1000),ALYY(1000),ALWD(1000)
      REAL*8 BLXX(1000),BLYY(1000),BLWD(1000)
      INTEGER ITYPBC(1000)
!                                                                       
      CHARACTER*1  IFLAG 
      data itime/0/
      
      if(itime .eq. 0) then
      nh=1
      itime=1
      endif
4     CONTINUE 
      CALL FORMLINEMENU(ITYP,I1D,I2D,IFIN,XLENGTH)
      IF(I1D .EQ. -999) RETURN
      IF(ITYP .EQ. 1) THEN
        NHTP = 0 
        NMESS = 6 
        NBRR = 3 
        CALL HEDR 
!                                                                       
!     Get screen coordinates of each end of line                        
!                                                                       
    7   CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX) 
        ALX=XTEMP
        ALY=YTEMP
        IF(IRMAIN .EQ. 1) RETURN 
!                                                                       
        IF(IFLAG .EQ. 'q'  .OR.  (IFLAG .EQ. 'c'  .AND. IBOX .EQ. 10))THEN 
           CALL WRTOUT(0) 
           RETURN 
        ENDIF 
!                                                                       
!  Exit input                                                           
!                                                                       
    9   CONTINUE
        CALL PLOTT(XTEMP,YTEMP,3) 
        CALL PLOTT(XTEMP,YTEMP,2) 
        CALL HEDR 
!                                                                       
        CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX) 
        ATX=XTEMP
        ATY=YTEMP
        IF(IRMAIN .EQ. 1) RETURN 
!                                                                       
        CALL PLOTT(XTEMP,YTEMP,3) 
        CALL PLOTT(XTEMP,YTEMP,2) 
!                                                                       
!     Define number of nodes in a line                                  
!                                                                       
        NBRR = 0 
        NMESS=45
        CALL HEDR 
        NMESS = 7 
        call getint(nh) 
!      READ(*,*) NH                                                     
        NINT=NH-1 
!                                                                       
!     zero GRIDX and GRIDY to hold generated coordinates                
!                                                                       
        DO  N=1,NH 
          GRIDX(N)=0. 
          GRIDY(N)=0. 
        END DO 
!                                                                       
!     Interpolate points onto line                                      
!                                                                       
        CALL INTERP(GRIDX,GRIDY,1,NH,1,ALX,ALY,ATX,ATY,NINT,0) 
!                                                                       
!     Copy points into the coordinate array                             
!                                                                       
        DO N=1,NH 
!                                                                       
!     Find next blank node in CORD                                      
!                                                                       
          CALL GETNOD(J) 
!                                                                       
!     Store GRIDX and GRIDY into it                                     
!                                                                       
          CORD(J,1) = GRIDX(N) 
          CORD(J,2) = GRIDY(N) 
          INEW(J) = 1 
          INSKP(J) = 0 
!                                                                       
          XUSR(J) = GRIDX(N)*TXSCAL - XS 
          YUSR(J) = GRIDY(N)*TXSCAL - YS 
!                                                                       
!     Display point                                                     
!                                                                       
          CALL PLTNOD(J,1) 
!                                                                       
        END DO 
      ELSE
        IF(IFIN .EQ. 0) THEN
          NHTP = 0 
          NMESS = 6 
          NBRR = 3 
          CALL HEDR 
!                                                                       
!     Get screen coordinates of each end of line                        
!              
          DO J=1,1000
            CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX) 
            IF(IFLAG .EQ. 'q'  .or.  ibox .eq. 10) go to 300
            ALXX(J)=XTEMP
            ALYY(J)=YTEMP
            JPTS=J
          ENDDO
300       CONTINUE
        ELSE
          CALL FILEDAT(ALXX,ALYY,ALWD,JPTS,BLXX,BLYY,BLWD,NPTSB,ITYPBC)
          DO J=1,JPTS
            ALXX(J)=(ALXX(J)+XS)/TXSCAL
            ALYY(J)=(ALYY(J)+YS)/TXSCAL
          ENDDO
        ENDIF
!    COMPUTE OVERALL LENGTH
      
        TOTLEN=0.
        DO J=1,JPTS-1
          TOTLEN=TOTLEN+SQRT((ALXX(J+1)-ALXX(J))**2+(ALYY(J+1)-ALYY(J))**2)
        ENDDO
!    ESTIMATE NUMBER OF ELEMENTS
        NELTS=TOTLEN*TXSCAL/XLENGTH+1
        XLENGTH=TOTLEN*TXSCAL/NELTS
!    GET NEW NODE LOCATIONS AND CREAT ELEMENT
        CALL GETNOD(J) 
        JKP=J
!                                                                       
!     Store GRIDX and GRIDY into it                                     
!                                                                       
        CORD(J,1) = ALXX(1) 
        CORD(J,2) = ALYY(1)
        IF(ALWD(1).GT. 0.) THEN
          WIDTH(J)=ALWD(1)
        ENDIF
        INEW(J) = 1 
        INSKP(J) = 0 
!                                                                       
        XUSR(J) = ALXX(1)*TXSCAL - XS 
        YUSR(J) = ALYY(1)*TXSCAL - YS 
!                                                                       
!     Display point                                                     
!              
        CALL PLTNOD(J,1) 
        JPTC=2
        XLENGTHR=XLENGTH/TXSCAL
        XCUR=ALXX(1)
        YCUR=ALYY(1)
        DO N=1,NELTS
  500     ANGLEL=ATAN2(ALYY(JPTC)-ALYY(JPTC-1),ALXX(JPTC)-ALXX(JPTC-1))
          XNEXT=XCUR+XLENGTHR*COS(ANGLEL)
          YNEXT=YCUR+XLENGTHR*SIN(ANGLEL)
          IF(ALXX(JPTC)-ALXX(JPTC-1) .NE. 0.) THEN
            FRAC=(XNEXT-ALXX(JPTC-1))/(ALXX(JPTC)-ALXX(JPTC-1))
          ELSE
            FRAC=(YNEXT-ALYY(JPTC-1))/(ALYY(JPTC)-ALYY(JPTC-1))
          ENDIF
          IF(FRAC .GT. 1.  .AND.  JPTC .LT. JPTS) THEN
            XLENGTHR=XLENGTHR-SQRT((ALXX(JPTC)-XCUR)**2+(ALYY(JPTC)-YCUR)**2)
            XCUR=ALXX(JPTC)
            YCUR=ALYY(JPTC)
            JPTC=JPTC+1
            GO TO 500
          ENDIF
!     GET NEW LOCATION
          
          CALL GETNOD(J) 

          IF(ALWD(1).GT. 0.) THEN
            WIDTH(J)=ALWD(JPTC-1)+FRAC*(ALWD(JPTC)-ALWD(JPTC-1))
          ENDIF
!                                                                       
!     Store GRIDX and GRIDY into it                                     
!                                                                       
          CORD(J,1) = XNEXT
          CORD(J,2) = YNEXT
          INEW(J) = 1 
          INSKP(J) = 0 
!                                                                       
          XUSR(J) = XNEXT*TXSCAL - XS 
          YUSR(J) = YNEXT*TXSCAL - YS 
!                                                                       
!     Display point                                                     
!                                                                       
          CALL PLTNOD(J,1) 
          XCUR=XNEXT
          YCUR=YNEXT
          XLENGTHR=XLENGTH/TXSCAL
          
          IF(I1D .EQ. 1 .OR. I2D .EQ. 1) THEN
            IF(N .EQ. 1) THEN
              J1=JKP 
              IF(ALWD(1) .NE. 0.) GO TO 600
              call nodedisp(jKP)
            ENDIF
            IF(ALWD(1) .NE. 0.) GO TO 600
            WIDTH(J)=WIDTH(J1)
            WD(J)=WD(J1)
            SS1(J)=SS1(J1)
            SS2(J)=SS2(J1)
            WIDS(J)=WIDS(J1)
            WIDBS(J)=WIDBS(J1)
            SSO(J)=SSO(J1)
            BS1(J)=BS1(J1)
600         call getelm(k)
            NOP(K,1)=J1
            NOP(K,2)=0
		    NOP(K,3)=J
		    NCORN(K)=3
		    IMAT(K)=1
            IESKP(K) = 0 
            NE = MAX(K,NE) 
            IERC=0 
            CALL PLTELM(K,IERC) 
 		    J1=J
          ENDIF 
          
        ENDDO
      ENDIF
      
      IF(I2D .EQ. 1) CALL FORM999(1,1)
      

!        GO TO 4 
!                                                                       
      END                                           
      SUBROUTINE INTERP(GRIDX,GRIDY,NL,NH,INT,ALX,ALY,ATX,ATY,NINT,ISWT) 
!                                                                       
!     Routine to fill GRIDX and GRIDY by interpolation                  
!     NL = START OF GENERATED
!     NH = END OF GENERATED
!     INT = INTERVAL      
!     ALX, ALY =  START LOC
!     ATX, ATY =  END LOC      
!     NINT = NUMBER OF POINTS
!     ISWT = 0  BASELINE   = 1 APPLY CHANGES
!IPK MAY02
      REAL*8 GRIDX(NH),GRIDY(NH),ALX,ALY,ATX,ATY
!                                                                       
!     Compute intervals                                                 
!                                                                       
      XINT=(ATX-ALX)/FLOAT(NINT) 
      YINT=(ATY-ALY)/FLOAT(NINT) 
!                                                                       
!     Generate points                                                   
!                                                                       
      IF(ISWT .EQ. 0) THEN 
        KP=0 
        DO 200 K=NL,NH,INT 
          IF(KP .EQ. 0) THEN 
            GRIDX(K)=ALX 
            GRIDY(K)=ALY 
          ELSE 
            GRIDX(K)=GRIDX(KP)+XINT 
            GRIDY(K)=GRIDY(KP)+YINT 
          ENDIF 
          KP=K 
  200   CONTINUE 
      ELSE 
        XAD=ALX 
        YAD=ALY 
        KP=0 
        DO 220 K=NL,NH,INT 
          IF(KP .EQ. 0) THEN 
            GRIDX(K)=GRIDX(K)+XAD 
            GRIDY(K)=GRIDY(K)+YAD 
          ELSE 
            XAD=XAD+XINT 
            YAD=YAD+YINT 
            GRIDX(K)=GRIDX(K)+XAD 
            GRIDY(K)=GRIDY(K)+YAD 
          ENDIF 
          KP=K 
  220   CONTINUE 
      ENDIF 
      RETURN 
      END                                           
      SUBROUTINE GEL 
!                                                                       
!     Routine to create a block of elements                             
!                                                                       

      USE WINTERACTER
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 

      include 'd.inc'


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

      REAL*8 GRIDX,GRIDY,ALX,ALY,BLX,BLY,ARX,ARY,BRX,BRY,GRIDXL,GRIDYL
      INTEGER*2 IGSKP
      COMMON /GBLK/ GRIDX(MAXPGEN),GRIDY(MAXPGEN),GRIDXL(MAXPGEN),GRIDYL(MAXPGEN)&
                   ,IGSKP(MAXPGEN),NRL,NRT,NYP,IGRIDE(MAXPGEN)
!                                                                       
      CHARACTER*1  IFLAG 
      data itime/0/
      
      if(itime .eq. 0) then
      nx=0
      ny=0
      itime=1
      endif

      CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to use'//&
          CHAR(13)//'existing nodes?' ,&
         'ELEMENT CREATION OPTION')
!
!   If answer 'No',  point to location
!
       IF (WInfoDialog(4) .EQ. 2) then
         noptcr=0
         GO TO 4
       else
         noptcr=1
         go to 1100
       END IF

    4 CONTINUE 
      NHTP=0 
      NMESS=8 
      NBRR = 3 
      CALL HEDR 
!                                                                       
!     Get screen coordinates of each end of line                        
!                                                                       
    7 CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX) 
      ALX=XTEMP
      ALY=YTEMP
      IF(IRMAIN .EQ. 1) RETURN 
!                                                                       
      IF(IFLAG .EQ. 'q'  .OR.  (IFLAG .EQ. 'c'  .AND. IBOX .EQ. 10))THEN 
         CALL WRTOUT(0) 
         RETURN 
      elseif(iflag .eq. 'n') then 
        call getfpna(XTEMP) 
        call getfpna(YTEMP) 
      ENDIF 
!                                                                       
!  Exit input                                                           
!                                                                       
  9   CONTINUE
!      CALL PLOTT(XTEMP,YTEMP,3)
!      CALL PLOTT(XTEMP,YTEMP,2) 
      siz=0.1
      call drawcr(xtemp,ytemp,siz)
      NBRR=0 
      CALL HEDR 
      CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX) 
      ARX=XTEMP
      ARY=YTEMP
      if(iflag .eq. 'n') then 
        call getfpna(XTEMP) 
        call getfpna(YTEMP) 
      endif 
      IF(IRMAIN .EQ. 1) RETURN 
!                                                                       
12    CONTINUE
!      CALL PLOTT(XTEMP,YTEMP,3) 
!      CALL PLOTT(XTEMP,YTEMP,2) 
      call drawcr(xtemp,ytemp,siz)
      CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX) 
      BRX=XTEMP
      BRY=YTEMP
      if(iflag .eq. 'n') then 
        call getfpna(XTEMP) 
        call getfpna(YTEMP) 
      endif 
      IF(IRMAIN .EQ. 1) RETURN 
!                                                                       
   16 CONTINUE
!      CALL PLOTT(XTEMP,YTEMP,3) 
!      CALL PLOTT(XTEMP,YTEMP,2) 
      call drawcr(xtemp,ytemp,siz)
      CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX) 
      BLX=XTEMP
      BLY=YTEMP
      if(iflag .eq. 'n') then 
        call getfpna(XTEMP) 
        call getfpna(YTEMP) 
      endif 
      IF(IRMAIN .EQ. 1) RETURN
!                                                                       
   20 CONTINUE 
!      CALL PLOTT(XTEMP,YTEMP,3) 
!      CALL PLOTT(XTEMP,YTEMP,2) 
      call drawcr(xtemp,ytemp,siz)
      go to 25
      
1100  continue
      CALL PROX(CORD(1,1),CORD(1,2),NP,xx,yy,INODE1,IFLAG,INSKP,IBOX) 
      ALX=CORD(INODE1,1)
      ALY=CORD(INODE1,2)
      CALL PROX(CORD(1,1),CORD(1,2),NP,xx,yy,INODE2,IFLAG,INSKP,IBOX) 
      ARX=CORD(INODE2,1)
      ARY=CORD(INODE2,2)
      CALL PROX(CORD(1,1),CORD(1,2),NP,xx,yy,INODE3,IFLAG,INSKP,IBOX) 
      BRX=CORD(INODE3,1)
      BRY=CORD(INODE3,2)
      CALL PROX(CORD(1,1),CORD(1,2),NP,xx,yy,INODE4,IFLAG,INSKP,IBOX) 
      BLX=CORD(INODE4,1)
      BLY=CORD(INODE4,2)

!                                                                       
!     Define number of elements along x and y sides                     
!                                                                       
   25 CONTINUE
      NMESS=45
      CALL HEDR 
      NMESS = 9 
      call getint(nx) 
!      READ(*,*) NX                                                     
      NMESS=45
      CALL HEDR 
      NMESS = 10 
      call getint(ny) 
!      READ(*,*) NY                                                     
      NXP=NX+1 
      NYP=NY+1 
      NRL=NX*NYP+1 
      NRT=NXP*NYP 

! ipk jul01 test for limit exceeded
      if(nrt .gt. maxpgen) then
        call panelegn
        go to 25
      endif

      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 100 N=1,NRT 
        GRIDX(N)=0. 
        GRIDY(N)=0. 
        IGSKP(N)=0 
  100 END DO 
!                                                                       
!     Interpolate left and right side                                   
!                                                                       
      CALL INTERP(GRIDX,GRIDY,1,NYP,1,ALX,ALY,BLX,BLY,NY,0) 
      CALL INTERP(GRIDX,GRIDY,NRL,NRT,1,ARX,ARY,BRX,BRY,NY,0) 
!                                                                       
!     plot points                                                       
!                                                                       
      DO 200 N=1,NYP
!IPK MAY02 
        XTEMP=GRIDX(N)
        YTEMP=GRIDY(N)
        GRIDXL(N) = GRIDX(N)*TXSCAL - XS 
        GRIDYL(N) = GRIDY(N)*TXSCAL - YS 
        CALL PLOTT(XTEMP,YTEMP,3)
        CALL PLOTT(XTEMP,YTEMP,2) 
        FPN = N 
        CALL RRed 
!        CALL NUMBR(XTEMP,YTEMP,0.20,FPN,0.0,-1)
        siz=0.1
        call drawcr(xtemp,ytemp,siz)
        CALL RBlue 
  200 END DO 
      DO 220 N=NRL,NRT 
!IPK MAY02
        XTEMP=GRIDX(N)
        YTEMP=GRIDY(N)
        GRIDXL(N) = GRIDX(N)*TXSCAL - XS 
        GRIDYL(N) = GRIDY(N)*TXSCAL - YS 
        CALL PLOTT(XTEMP,YTEMP,3)
        CALL PLOTT(XTEMP,YTEMP,2) 
        FPN = N 
        CALL RRed 
!       CALL NUMBR(XTEMP,YTEMP,0.20,FPN,0.0,-1) 
        call drawcr(xtemp,ytemp,siz)
        CALL RBlue 
  220 END DO 
!                                                                       
!     Interpolate bottom and top sides                                  
!                                                                       
      CALL INTERP(GRIDX,GRIDY,1,NRL,NYP,ALX,ALY,ARX,ARY,NX,0) 
      CALL INTERP(GRIDX,GRIDY,NYP,NRT,NYP,BLX,BLY,BRX,BRY,NX,0) 
!                                                                       
!     plot points                                                       
!                                                                       
      DO 240 N=1,NRL,NYP 
!IPK MAY02
        XTEMP=GRIDX(N)
        YTEMP=GRIDY(N)
        GRIDXL(N) = GRIDX(N)*TXSCAL - XS 
        GRIDYL(N) = GRIDY(N)*TXSCAL - YS 
        CALL PLOTT(XTEMP,YTEMP,3) 
        CALL PLOTT(XTEMP,YTEMP,2) 
        FPN = N 
        CALL RRed 
!        CALL NUMBR(XTEMP,YTEMP,0.20,FPN,0.0,-1) 
        call drawcr(xtemp,ytemp,siz)
        CALL RBlue 
  240 END DO 
      DO 260 N=NYP,NRT,NYP 
!IPK MAY02
        XTEMP=GRIDX(N)
        YTEMP=GRIDY(N)
        GRIDXL(N) = GRIDX(N)*TXSCAL - XS 
        GRIDYL(N) = GRIDY(N)*TXSCAL - YS 
        CALL PLOTT(XTEMP,YTEMP,3) 
        CALL PLOTT(XTEMP,YTEMP,2) 
        FPN = N 
        CALL RRed 
!        CALL NUMBR(XTEMP,YTEMP,0.20,FPN,0.0,-1) 
        call drawcr(xtemp,ytemp,siz)
        CALL RBlue 
  260 END DO 
!                                                                       
!     Interpolate interior points                                       
!                                                                       
      DO 300 M=2,NYP 
        NFS=NRL+M-1 
      CALL INTERP(GRIDX,GRIDY,M,NFS,NYP,GRIDX(M),GRIDY(M),GRIDX(NFS)    &
     &    ,GRIDY(NFS),NX,0) 
        DO N=M,NFS
          XTEMP=GRIDX(N)
          YTEMP=GRIDY(N)
          GRIDXL(N) = GRIDX(N)*TXSCAL - XS 
          GRIDYL(N) = GRIDY(N)*TXSCAL - YS 
          CALL RRed 
          call drawcr(xtemp,ytemp,siz)
          CALL RBlue 
        ENDDO
  300 END DO 
  305 CONTINUE 
      NMESS=11 
      NBRR=10 
      CALL HEDR 
310 IBOX=1 
      ip=0
      CALL PROX(GRIDX(1),GRIDY(1),NRT,XX,YY,IP,IFLAG,IGSKP,IBOX)
      IF(IBOX .NE. 6  .and.  (ip .gt. 0  .and.  ip .le. nrt)) THEN
        XKP=GRIDX(IP)
        YKP=GRIDY(IP)
        IPK=IP
      ENDIF
      IF(IRMAIN .EQ. 1  .OR.  IBOX .EQ. 7) RETURN 
      IF(IFLAG .EQ. 'q') THEN 
        GO TO 400 
      ENDIF 
      DO N=1,NRT
        GRIDX(N)=(GRIDXL(N)+XS)/TXSCAL
        GRIDY(N)=(GRIDYL(N)+YS)/TXSCAL
      ENDDO
      IF(IBOX .EQ. 6) THEN
        XX=XKP
        YY=YKP
        IP=IPK
        GO TO 315
      ENDIF
      write(90,*) 'back prox irdisp',IRDISP
      IF(IRDISP .EQ. 1) THEN
        CALL PLTPT
      ENDIF
!                                                                       
!  Get screen coordinate of new node location                           
!                                                                       
      CALL XYLOC(XX,YY,IFLAG,IBOX) 
       write(90,*) 'back xyloc irdisp',IRDISP
      IF(IRMAIN .EQ. 1  .OR.  IBOX .EQ. 7) RETURN 
 315  IF(IRDISP .EQ. 1) THEN
        DO N=1,NRT
          GRIDX(N)=(GRIDXL(N)+XS)/TXSCAL
          GRIDY(N)=(GRIDYL(N)+YS)/TXSCAL
        ENDDO
        CALL PLTPT
      ENDIF
!                                                                       
!  Establish difference from movement                                   
!                                                                       
      ALX=XX-GRIDX(IP) 
      ALY=YY-GRIDY(IP) 
      CALL PLOTT(XX,YY,3) 
      CALL PLOTT(XX,YY,2) 
      FPN = IP 
!      CALL RRed 
!      CALL NUMBR(XX,YY,0.20,FPN,0.0,-1) 
!      CALL RBlue 
!                                                                       
!     Find location on boundary                                         
!                                                                       
      IF(IP .LE. NYP) THEN 
!     Left boundary                                                     
        NLW=IP 
        NUP=NRL+IP-1 
        NSTP=NYP 
        BLX=0. 
        BLY=0. 
        NS=NX 
      ELSEIF(IP .GE. NRL) THEN 
!     Right boundary                                                    
        NLW=IP-NX*NYP 
        NUP=IP 
        NSTP=NYP 
        BLX=ALX 
        BLY=ALY 
        ALX=0. 
        ALY=0. 
        NS=NX 
      ELSE 
        LINENO=(IP-1)/NYP 
        IF(IP-LINENO*NYP .EQ. 1) THEN 
!       Lower boundary                                                  
          NLW=IP 
          NUP=IP+NY 
          NSTP=1 
          BLX=0. 
          BLY=0. 
          NS=NY 
        ELSEIF(IP-LINENO*NYP .EQ. NYP) THEN 
!       Upper boundary                                                  
          NLW=IP-NY 
          NUP=IP 
          NSTP=1 
          BLX=ALX 
          BLY=ALY 
          ALX=0. 
          ALY=0. 
          NS=NY 
        ELSE 
          GO TO 305 
        ENDIF 
    ENDIF 
!                                                                       
!     Interpolate change along x line                                   
!   14935011
      IF(IRGB .EQ. 14935011) THEN
        call rgrey
      ELSE
        CALL RWHITEB
      ENDIF
      do n=1,nrt
        XTEMP=gridx(n)
        YTEMP=gridy(n)
        call drawcr(xtemp,ytemp,siz)
      enddo
      CALL RRed 
      CALL INTERP(GRIDX,GRIDY,NLW,NUP,NSTP,ALX,ALY,BLX,BLY,NS,1)
      do n=1,nrt
        XTEMP=gridx(n)
        YTEMP=gridy(n)
        call drawcr(xtemp,ytemp,siz)
        GRIDXL(N) = GRIDX(N)*TXSCAL - XS 
        GRIDYL(N) = GRIDY(N)*TXSCAL - YS 
      enddo
      call Rblue
      GO TO 310 
!                                                                       
!     Copy points into cord array                                       
!                                                                       
  400 CONTINUE 
      DO 500 N=1,NRT 
!                                                                       
!     Find next blank node in CORD                                      
!                                                                       
        IF(NOPTCR .EQ. 1) THEN
          IF(N .EQ. 1) THEN
            NODDEL(N)=0
            GO TO 500
          ELSEIF(N .EQ. NYP) THEN
            NODDEL(N)=0
            GO TO 500
          ELSEIF(N .EQ. 1+NYP*NX) THEN
            NODDEL(N)=0
            GO TO 500
          ELSEIF(N .EQ. NRT) THEN
            NODDEL(N)=0
            GO TO 500
          ENDIF
        ENDIF
        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 
!                                                                       
        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)
          IF(I .EQ. 1  .AND.  J .EQ. 1  .AND. NOPTCR .EQ. 1) THEN
            NOP(K,1)=INODE1
          ELSE
            NOP(K,1)=IGRIDE((I-1)*NYP+J)
          ENDIF
          NOP(K,2)=0 
          IF(I .EQ. NX  .AND.  J .EQ. 1  .AND. NOPTCR .EQ. 1) THEN
            NOP(K,3)=INODE2
          ELSE
            NOP(K,3)=IGRIDE(I*NYP+J)
          ENDIF
          NOP(K,4)=0 
          IF(I .EQ. NX  .AND.  J .EQ. NY  .AND. NOPTCR .EQ. 1) THEN
            NOP(K,5)=INODE3
          ELSE
            NOP(K,5)=IGRIDE(I*NYP+J+1) 
          ENDIF
          NOP(K,6)=0 
          IF(I .EQ. 1  .AND.  J .EQ. NY  .AND. NOPTCR .EQ. 1) THEN
            NOP(K,7)=INODE4
          ELSE
            NOP(K,7)=IGRIDE((I-1)*NYP+J+1) 
          ENDIF
          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 UNDO(IYES)
!      IF(IYES .EQ. 1) THEN
!        DO N=1,NEUNDO
!          J=IELDEL(N)
!          CALL DELTEL(J)
!        ENDDO
!        DO N=1,NPUNDO
!          J=NODDEL(N)
!          CALL DELETN(J)
!        ENDDO
!      ENDIF
       CALL WRTOUT(0) 
       RETURN 
       END                                           

      SUBROUTINE PLTPT

      USE BLK1MOD
      INCLUDE 'TXFRM.COM'
!      INCLUDE 'BLK1.COM'

!IPK MAY02
      REAL*8 GRIDX,GRIDY,GRIDXL,GRIDYL
      INTEGER*2 IGSKP

      COMMON /GBLK/ GRIDX(MAXPGEN),GRIDY(MAXPGEN),GRIDXL(MAXPGEN),GRIDYL(MAXPGEN)&
                   ,IGSKP(MAXPGEN),NRL,NRT,NYP,IGRIDE(MAXPGEN)

        DO N=1,NRT
          GRIDX(N)=(GRIDXL(N)+XS)/TXSCAL
          GRIDY(N)=(GRIDYL(N)+YS)/TXSCAL
        ENDDO

!                                                                       
!     plot points                                                       
!                                                                       
      DO N=1,NYP 
!IPK MAY02
        XTEMP=GRIDX(N)
        YTEMP=GRIDY(N)
        CALL PLOTT(XTEMP,YTEMP,3) 
        CALL PLOTT(XTEMP,YTEMP,2) 
        FPN = N 
        CALL RRed 
!        CALL NUMBR(XTEMP,YTEMP,0.20,FPN,0.0,-1) 
        siz=0.1
        call drawcr(xtemp,ytemp,siz)
        CALL RBlue 
      END DO 
      DO N=NRL,NRT 
!IP MAY02
        XTEMP=GRIDX(N)
        YTEMP=GRIDY(N)
        CALL PLOTT(XTEMP,YTEMP,3) 
        CALL PLOTT(XTEMP,YTEMP,2) 
        FPN = N 
        CALL RRed 
!        CALL NUMBR(XTEMP,YTEMP,0.20,FPN,0.0,-1) 
        call drawcr(xtemp,ytemp,siz)
        CALL RBlue 
      END DO 
!                                                                       
!     plot points                                                       
!                                                                       
      DO N=1,NRL,NYP 
!IPK MAY02
        XTEMP=GRIDX(N)
        YTEMP=GRIDY(N)
        CALL PLOTT(XTEMP,YTEMP,3) 
        CALL PLOTT(XTEMP,YTEMP,2) 
        FPN = N 
        CALL RRed 
!        CALL NUMBR(XTEMP,YTEMP,0.20,FPN,0.0,-1) 
        call drawcr(xtemp,ytemp,siz)
        CALL RBlue 
      END DO 
      DO N=NYP,NRT,NYP 
!IPK MAY02
        XTEMP=GRIDX(N)
        YTEMP=GRIDY(N)
        CALL PLOTT(XTEMP,YTEMP,3) 
        CALL PLOTT(XTEMP,YTEMP,2) 
        FPN = N 
        CALL RRed 
!        CALL NUMBR(XTEMP,YTEMP,0.20,FPN,0.0,-1) 
        call drawcr(xtemp,ytemp,siz)
        CALL RBlue 
      END DO 
      RETURN
      END

      subroutine panelegn

      USE WINTERACTER

      CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'You have requested '//&
             ' more than the allowable number of nodes.'//CHAR(13)//'The model will return '// &
            'to allow new numbers to be input','Limit error')
!
!   If answer 'Yes', execute
!
      IF (WInfoDialog(4) .EQ. 1) then
         return
      ENDIF
      return
      end
      SUBROUTINE FORMLINEMENU(ITYP,I1D,I2D,IFIN,XLENGTH)
      

      use winteracter

      implicit none
      SAVE

      include 'D.inc'
      INCLUDE 'BFILES.I90'
      DATA ITIME/0/

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

      TYPE(WIN_MESSAGE) :: MESSAGE

      integer  :: ITYP,I1D,IERR,ITIME,I2D,IFIN
      real     :: XLENGTH
      character*3 :: sub
      DATA ITIME/0/
      IF(ITIME .EQ. 0) THEN
        XLENGTH=100.
        ITIME=1
        I1D=0
        I2D=1
        IFIN=1
      ENDIF

      

      call wdialogload(IDD_FORMLINE)
      ierr=infoerror(1)

      call wdialogputRadioButton(idf_radio1)
      call wdialogputcheckbox(IDF_CHECK1,I1D)
      call wdialogputcheckbox(IDF_CHECK2,I2D)
      call wdialogputcheckbox(IDF_CHECK3,IFIN)
      CALL WDialogPutREAL(idf_REAL1,XLENGTH)


      CALL WDialogSelect(IDD_FORMLINE)
      ierr=infoerror(1)

      CALL WDialogShow(-1,-1,0,Modal)
      ierr=infoerror(1)
      DO
        IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
          call wdialogGetRadioButton(idf_radio1,ITYP)
          call wdialogGetCheckBox(idf_check1,I1D)
          call wdialogGetCheckBox(idf_check2,I2D)
          call wdialogGetCheckBox(idf_check3,IFIN)
          CALL WDialogGetREAL(idf_REAL1,XLENGTH)
          RETURN
        ELSEIF(WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN 
          I1D=-999
          RETURN
        ENDIF
      ENDDO
      RETURN
      END

      SUBROUTINE FILEDAT(ALXX,ALYY,ALWD,NPTS,BLXX,BLYY,BLWD,NPTSB,ITYPBC)
      USE WINTERACTER
      USE DFLIB
!
!
! Define some parameters to match those in the resource file
!
      include 'd.inc'
      REAL*8 ALXX(*),ALYY(*),ALWD(*),BLXX(*),BLYY(*),BLWD(*)
      INTEGER ITYPBC(*)
      REAL*8 ATMPAR
      CHARACTER(LEN=255)  :: FNAME,FILTER
      CHARACTER(LEN=3)    :: SUB
      CHARACTER ID*8,DLIN*72
        IINALN=45
        Filter='ALIGNMENT file  -- *.dat|'

        CALL WSelectFile(Filter,PromptOn,FNAME,'Open Alignment File')
 
        IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN

   	      CALL IlowerCase(FNAME)
	      CALL GETSUB(FNAME,SUB)
          OPEN(IINALN,FILE=FNAME,STATUS='OLD',action='read')
        ELSE
          RETURN
        ENDIF
        DO K=1,1000
          CALL GINPT(IINALN,ID,DLIN)
          IF(ID(1:3) .EQ. 'XYW') THEN
            READ(DLIN,*) ALXX(K),ALYY(K),ALWD(K)
          ELSEIF(ID(1:3) .EQ. 'XY ') THEN
            READ(DLIN,*) ALXX(K),ALYY(K)
            ALWD(K)=0.
          ELSE
            NPTS=K-1
            GOTO 200
          ENDIF
        ENDDO
200     CONTINUE           
        READ(IINALN,'(A8)') ID
        IF(ID(1:7) .EQ. 'ENDFILE') RETURN
      
        CALL GETBRIDCUL(BLXX,BLYY,BLWD,NPTSB,ITYPBC)
        DO K=1,1000
          ATMPAR=BLXX(K)
          BLXX(K)=ALXX(K)
          ALXX(K)=ATMPAR
          ATMPAR=BLYY(K)
          BLYY(K)=ALYY(K)
          ALYY(K)=ATMPAR
        ENDDO
        NTEMP=NPTSB
        NPTSB=NPTS
        NPTS=NTEMP
        RETURN
        END
        SUBROUTINE GETBRIDCUL(BLXX,BLYY,BLWD,NPTSB,ITYPBC)
        CHARACTER(LEN=140)  :: DLINLARGE
        DIMENSION TEMP(7)
        REAL*8 BLXX(*),BLYY(*),BLWD(*)
        INTEGER ITYPBC(*)
        KK=1
        DO K=1,1000
          CALL GINPT1(IINALN,DLINLARGE)
          READ(DLINLARGE(7:140),*) ID,(TEMP(J),J=1,6)
          IF(DLINLARGE(1:6) .EQ. 'CULVERT') THEN
            ITYPBC(KK)=1
          ELSEIF(DLINLARGE(1:6) .EQ. 'BRIDGE ') THEN
            ITYPBC(KK)=2
          ELSEIF(DLINLARGE(1:6) .EQ. 'ENDFIL') THEN
            NPTSB=KK
          ENDIF
          BLXX(KK)=TEMP(1)
          BLYY(KK)=TEMP(2)
          BLWD(KK)=TEMP(3)
          KK=KK+1
          BLXX(KK)=TEMP(4)
          BLYY(KK)=TEMP(5)
          BLWD(KK)=TEMP(6)
          
        ENDDO
        RETURN
        END
        

    