
!     Last change:  IPK  12 Jan 98    1:44 pm                           
!                                                                       
      SUBROUTINE GNODE(ITYPC)
!                                                                       
!     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,CURRENTX,CURRENTY,X11,Y11
      INTEGER IREF(2000),JREF(2000)
!                                                                       
      CHARACTER*1  IFLAG 
      data itime/0/
      if(itime .eq. 0) then
        ALLOCATE(ALXX(2000),ALYY(2000),ALWD(2000),BLXX(2000),BLYY(2000),BLWD(2000)&
        ,CNX(2000,4),CNY(2000,4),ITYPBC(2000),XBRLEN(2000),HLEFT(2000),HMID(2000),HRIGHT(2000)&
        ,HSET(MAXP,3),IRTYP(2000),WIDTHD(2000))
        nh=1
        itime=1
      endif
4       CONTINUE 
      IF(ITYPC .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
        KID=0
        ITYP=2
        CALL FORMLINEMENU(ITYP,I1D,I2D,IFIN,XLENGTH,ITYPIN,NELC,NBRID)
        IF(I1D .EQ. -999) RETURN        
        IF(IFIN .EQ. 0) THEN
          NHTP = 0 
          NMESS = 6 
          NBRR = 3 
          CALL HEDR 
!                                                                       
!     Get screen coordinates of each end of line                        
!              
          DO J=1,2000
            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(JPTS,NBRID)
        ENDIF
!    SORT OUT A NEW ORDER
     
       IREF=1
       CURRENTX=ALXX(1)
       CURRENTY=ALYY(1)
       KS=2
       KSP=1
       DO J=2,JPTS
         IF(JPTSB .GT. 0) THEN
            IF(KSP .LE. JPTSB) THEN
              DO K=KSP,JPTSB
                TOTLEN=SQRT((ALXX(J)-CURRENTX)**2+(ALYY(J)-CURRENTY)**2)
                TOTLENB=SQRT((BLXX(K)-CURRENTX)**2+(BLYY(K)-CURRENTY)**2)
                IF(ABS(TOTLENB - TOTLEN) .LT. 1.0) THEN
!   THIS IS A BREAKPOINT
                  IREF(KS)=-K
                  KS=KS+1
                  KSP=KSP+1
                  CURRENTX=BLXX(K)
                  CURRENTY=BLYY(K)
                  GO TO 320
                ENDIF
                IF(TOTLENB .LT. TOTLEN) THEN 
!   THIS IS A BREAKPOINT
                  IREF(KS)=-K
                  KS=KS+1
                  KSP=KSP+1
                  CURRENTX=BLXX(K)
                  CURRENTY=BLYY(K)
                  GO TO 310
                ELSE
                  IREF(KS)=J
                  KS=KS+1
                  CURRENTX=ALXX(J)
                  CURRENTY=ALYY(J)
                  GO TO 320
                ENDIF
310             CONTINUE
              ENDDO
            ELSE
315           CONTINUE            
              IREF(KS)=J
              KS=KS+1
              CURRENTX=ALXX(J)
              CURRENTY=ALYY(J)
            ENDIF            
320         CONTINUE
         ELSE
           IREF(KS)=J
           IF(KS .LT. JPTS)KS=KS+1
           CURRENTX=ALXX(J)
           CURRENTY=ALYY(J)
         ENDIF
           
       ENDDO
!       IREF(KS)=JPTS
       IF(IFIN .GT. 0) THEN
         IREF(KS)=JPTS
         DO K=KS,1,-1
           IF(IREF(K) .LT. 0) THEN
             ALXX(K)=BLXX(-IREF(K))
             ALYY(K)=BLYY(-IREF(K))
             ALWD(K)=BLWD(-IREF(K))
             HMID(K)=BLWD(-IREF(K))
             HLEFT(K)=HMID(K)
             HRIGHT(K)=HMID(K)
           ELSE
             ALXX(K)=ALXX(IREF(K))
             ALYY(K)=ALYY(IREF(K))
             ALWD(K)=ALWD(IREF(K))
             HMID(K)=HMID(IREF(K))
             HLEFT(K)=HLEFT(IREF(K))
             HRIGHT(K)=HRIGHT(IREF(K))
           ENDIF
         ENDDO
         DO J=1,KS
           ALXX(J)=(ALXX(J)+XS)/TXSCAL
           ALYY(J)=(ALYY(J)+YS)/TXSCAL
         ENDDO
         DO J=1,KS
           BLXX(J)=(BLXX(J)+XS)/TXSCAL
           BLYY(J)=(BLYY(J)+YS)/TXSCAL
         ENDDO
!       KS=KS-1
       ENDIF
       JST=1
       JKP=0
       K=2
 321   IF(IREF(K) .LT. 0) THEN
 323      IF(IREF(K+1) .GT. 0) THEN
            IREF(K+1)=0
            K=K+1
            GO TO 323
          ELSE
            K=K+2
            IF(K .GE. KS) GO TO 325
            GO TO 321
          ENDIF
        ELSE
          K=K+1
          IF(K .GE. KS) GO TO 325
          GO TO 321
        ENDIF
325     CONTINUE
       KC=0
       DO K=1,KS
         IF(IREF(K) .EQ. 0) CYCLE
         KC=KC+1
         JREF(KC)=IREF(K)
         ALXX(KC)=ALXX(K)
         ALYY(KC)=ALYY(K)
         ALWD(KC)=ALWD(K)
         HLEFT(KC)=HLEFT(K)
         HMID(KC)=HMID(K)
         HRIGHT(KC)=HRIGHT(K)
       ENDDO
       IREF=JREF
       KS=KC
       ICTYP=NBRID
       KFS=1
       DO K=1,KS
         III=K
         X11=ALXX(III)*TXSCAL - XS
         Y11=ALYY(III)*TXSCAL - XS
       ENDDO
       DO K=2,KS
        IF(IREF(K) .LT. 0  .OR. K .EQ. KS) THEN
         !  IF(K .LT. KS) THEN
         !   IF(IREF(K) .LT. 0 .AND. IREF(K+1) .GT. 0) THEN
         !     ITYPB=ICTYP+1
         !     ICTYP=ICTYP+1
         !   ELSE
         !     ITYPB=ITYPIN
         !   ENDIF
         !  ELSE
         !    ITYPB=ITYPIN
         !  ENDIF
             IF(KFS .EQ. 2  .OR.  JPTSB .EQ. 0) THEN
               ITYPB=ICTYP
               ICTYP=ICTYP+1
               KFS=1
             ELSE
               KFS=KFS+1
               ITYPB=ITYPIN
           ENDIF
           IF(ITYPB .GT. NBRID-1) THEN
             ICTT=(ITYPB-NBRID+1)*2
             ICTT=ITYPBC(ICTT)
             IRTYP(ITYPB)=ICTT             
           ELSE
              ICTT=0
              IRTYP(ITYPB)=0
           ENDIF
           JEND=K
           XLENGTHP=XLENGTH
!    GO AND FORM A LINE
!           IF(ICTT .EQ. 2) XLENGTHP=XBRLEN((ITYPB-39)*2)
           CALL FORMLINEL(I1D,I2D,JST,JEND,JKP,XLENGTHP,ITYPB,ICTT)
           JST=JEND
         ENDIF
       ENDDO
       IF(I2D .EQ. 1) CALL FORM999(1,1,NELC)
      ENDIF
      

!        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 'BFILES.I90'
!      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 
          IRDONE=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,ITYPIN,NELC,NBRID)
      

      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,ITYPIN,NELC,NBRID
      real     :: XLENGTH
!      character*3 :: sub
!      DATA ITIME/0/
!      IF(ITIME .EQ. 0) THEN
        XLENGTH=250.
        ITIME=1
        I1D=0
        I2D=1
        IFIN=1
        ITYPIN=30
        NELC=2
        NBRID=40
!        idf_radio1=2
 !     ENDIF

      

      call wdialogload(IDD_FORMLINE)
      ierr=infoerror(1)

      call wdialogputRadioButton(idf_radio2)
      call wdialogputRadioButton(idf_radio3)
      CALL WDialogPutREAL(idf_REAL1,XLENGTH)
      CALL WDialogPutInteger(idf_INTEGER1,ITYPIN)
      call wdialogPutCheckBox(idf_check3,IFIN)
      CALL WDialogPutInteger(idf_INTEGER2,NELC)
      CALL WDialogPutInteger(idf_INTEGER3,NBRID)


      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 wdialogGetRadioButton(idf_radio3,I1D)
          call wdialogGetCheckBox(idf_check3,IFIN)
          CALL WDialogGetREAL(idf_REAL1,XLENGTH)
          CALL WDialogGetInteger(idf_INTEGER1,ITYPIN)
          CALL WDialogGetInteger(idf_INTEGER2,NELC)
          CALL WDialogGetInteger(idf_INTEGER3,NBRID)
          if(I1D .eq. 1) then
            I1D=0
            I2D=0
          ELSEIF(I1D .EQ. 2) THEN
            I1D=1
            I2D=0
          ELSEIF(I1D .EQ. 3) THEN
            I1D=0
            I2D=1
          ENDIF
          RETURN
        ELSEIF(WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN 
          I1D=-999
          RETURN
        ENDIF
      ENDDO
      RETURN
      END

      SUBROUTINE FILEDAT(JPTS,NBRID)
      USE WINTERACTER
      USE DFLIB
      USE BLK1MOD
!
!
! Define some parameters to match those in the resource file
!
      include 'd.inc'
      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,2000
          CALL GINPT(IINALN,ID,DLIN)
          IF(ID(1:3) .EQ. 'XYW') THEN
            READ(DLIN,*) ALXX(K),ALYY(K),ALWD(K),HLEFT(K),HMID(K),HRIGHT(K)
          ELSEIF(ID(1:3) .EQ. 'XY ') THEN
            READ(DLIN,*) ALXX(K),ALYY(K)
            ALWD(K)=0.
          ELSE
            JPTS=K-1
            BACKSPACE(IINALN)
            GOTO 200
          ENDIF
        ENDDO
200     CONTINUE           
        READ(IINALN,'(A8)') ID
        IF(ID(1:7) .EQ. 'ENDFILE') RETURN
      
        CALL GETBRIDCUL(IINALN,NBRID)
!        K=(JPTSB-2)/2+2
!        ALXX(K)=ALXX(2)
!        ALYY(K)=ALYY(2)
!         JPTS=K
!         DO K=2,JPTSB-2,2
!           ALXX(K+1)=(BLXX(K)+BLXX(K+1))/2.
!           ALYY(K+1)=(BLYY(K)+BLYY(K+1))/2.
!           ALWD(K+1)=(BLWD(K)+BLWD(K+1))/2.
!         ENDDO
         
!        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=JPTSB
!        JPTSB=JPTS
!       NPTS=NTEMP
        RETURN
        END
        SUBROUTINE GETBRIDCUL(IINALN,NBRID)
        USE BLK1MOD
        INCLUDE 'TXFRM.COM'
        CHARACTER(LEN=140)  :: DLINLARGE
        CHARACTER(LEN=8)    :: IDN,ID
        REAL*8 TEMP(9),CPX,CPY,XCEN,YCEN,CW
        KID=0
        PI=3.14159
        KK=1
        DO K=1,2000
          CALL GINPT1(IINALN,DLINLARGE)
          IF(DLINLARGE(1:7) .EQ. 'CULVERT') THEN
            READ(DLINLARGE(9:140),*) idn,(TEMP(J),J=2,9)
            ITYPBC(KK)=1
            ITYPBC(KK+1)=1
            XCEN=(TEMP(2)+TEMP(4))/2.
            YCEN=(TEMP(3)+TEMP(5))/2.
            CW=TEMP(9)*TEMP(8)/2.
            IF(KK .EQ. 1) THEN
              CPX=ALXX(1)
              CPY=ALYY(1)
            ELSE
              CPX=BLXX(KK-1)
              CPY=BLYY(KK-1)
            ENDIF
            DNORM=ATAN2(YCEN-CPY,XCEN-CPX)
            IF(DNORM .LT. 0.) DNORM=DNORM+PI
            IF(DNORM .GT. PI) DNORM=DNORM-PI
            BLXX(KK)=XCEN-CW*COS(DNORM)
            BLYY(KK)=YCEN-CW*SIN(DNORM)
            BLWD(KK)=TEMP(7)
            CNX(KK,1)=BLXX(KK)-TEMP(6)/2.*COS(DNORM-PI/2.)
            CNX(KK,2)=BLXX(KK)+TEMP(6)/2.*COS(DNORM-PI/2.)
            CNY(KK,1)=BLYY(KK)-TEMP(6)/2.*SIN(DNORM-PI/2.)
            CNY(KK,2)=BLYY(KK)+TEMP(6)/2.*SIN(DNORM-PI/2.)
            KPT=NBRID+KK/2
            KID(KPT,1)=KK
            DO KLM=1,2
              CALL GETNOD(J)
              KID(KPT,KLM+1)=J
              INEW(J) = 1 
              INSKP(J) =0 
              XUSR(J)=CNX(KK,KLM)
              YUSR(J)=CNY(KK,KLM)
              CORD(J,1)=(XUSR(J)+XS)/TXSCAL
              CORD(J,2)=(YUSR(J)+YS)/TXSCAL
            ENDDO
            
            KK=KK+1
            BLXX(KK)=XCEN+CW*COS(DNORM)
            BLYY(KK)=YCEN+CW*SIN(DNORM)
            BLWD(KK)=TEMP(7)
            CNX(KK-1,3)=BLXX(KK)-TEMP(6)/2.*COS(DNORM-PI/2.)
            CNX(KK-1,4)=BLXX(KK)+TEMP(6)/2.*COS(DNORM-PI/2.)
            CNY(KK-1,3)=BLYY(KK)-TEMP(6)/2.*SIN(DNORM-PI/2.)
            CNY(KK-1,4)=BLYY(KK)+TEMP(6)/2.*SIN(DNORM-PI/2.)

            DO KLM=3,4
              CALL GETNOD(J)
              KID(KPT,KLM+1)=J
              INEW(J) = 1 
              INSKP(J) =0 
              XUSR(J)=CNX(KK-1,KLM)
              YUSR(J)=CNY(KK-1,KLM)
              CORD(J,1)=(XUSR(J)+XS)/TXSCAL
              CORD(J,2)=(YUSR(J)+YS)/TXSCAL
            ENDDO
            KK=KK+1
          ELSEIF(DLINLARGE(1:6) .EQ. 'BRIDGE') THEN
            READ(DLINLARGE(7:140),*) IDN,(TEMP(J),J=1,7)
            ITYPBC(KK)=2
            ITYPBC(KK+1)=2
            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)
            XBRLEN(KK)=SQRT((BLXX(KK)-BLXX(KK-1))**2+(BLYY(KK)-BLYY(KK-1))**2)
            KK=KK+1
!            READ(DLINLARGE(8:140),*) ID,(TEMP(J),J=1,6)
          ELSEIF(DLINLARGE(1:7) .EQ. 'ENDFILE') THEN
            JPTSB=KK-1
            GO TO 200
          ENDIF
        ENDDO
200     CONTINUE 
        RETURN
        END
        

    