!IPK  NEW ROUTINE SEP 9 2006                                           
      SUBROUTINE FORM999(ISWT9,iswtw,NELC)
!                                                                       
!  Generate continuity lines                                            
!                      

	  USE WINTERACTER
      USE BLK1MOD
      USE BLK2MOD 
      include 'd.inc'
                                                 
!      INCLUDE 'BLK1.COM'
!      INCLUDE 'BLK2.COM' 
      INCLUDE 'TXFRM.COM'
      CHARACTER*1  IFLAG 
      DIMENSION DIRL(5000),IPROCES(MAXE)
!
! Declare window-type and message variables
!
      TYPE(WIN_STYLE)    :: WINDOW

      TYPE(WIN_MESSAGE) :: MESSAGE

      integer  :: N1,N2,N3,IERR

      DATA SPAC/10./,ieltyp/1/,ielsw/1/,iensw/0/

!      DIST(N1,N2)=SQRT((CORD(N1,1)-CORD(N2,1))**2                       &
!     &                +(CORD(N1,2)-CORD(N2,2))**2)                      
!      PROJ(N1,N2,DR)= (CORD(N2,1)-CORD(N1,1))*COS(DR)+(CORD(N2,2)-CORD(N1,2))*SIN(DR)
!
!       WRITE(150,*) 'IN FORM999',ISWT9,iswtw,NELC
!       FLUSH(150)
       if(iswtw .eq. 1) THEN
         IFRMEL=0
	      IGTWEL=0
          CALL ADD999(ISWT9,NELC)
          RETURN
       ENDIF
      CALL WMessageBox(YesNo, QuestionIcon, 1,'Are 1-D elements already formed?','1-D  ELEMENTS') 

!   If answer 'Yes'  set ifrmel to 0
!
      IF (WInfoDialog(4) .EQ. 2) then
	    IFRMEL=1
!NO
!        WRITE(150,*) 'GOING TO FROM1DEL'
!       FLUSH(150)
  	    CALL FORM1DEL
!        WRITE(150,*) 'BACK FROM FROM1DEL'
!       FLUSH(150)

      ELSE
!YES
	    IFRMEL=0


        CALL WMessageBox(YesNo, QuestionIcon, 1,'Is width data available?','WIDTH DATA') 
	  
!   If answer 'Yes'  set igtwel to 0
!
        IF (WInfoDialog(4) .EQ. 2) then
!NO
	      IGTWEL=1
  	      CALL SETWID
!          WRITE(150,*) 'BACK FROM SETWID'
!       FLUSH(150)
        ELSE
!YES
	      IGTWEL=0
!          CALL CCLINE(2)
!          WRITE(150,*) 'GOING TO ADD999'
!       FLUSH(150)
!  temp may20     
          CALL ADD999(ISWT9,NELC)
!  tep may20        GO TO 100
!          WRITE(150,*) 'BACK FROM ADD999'
!       FLUSH(150)
          CALL HEDR
          RETURN
        ENDIF 
        
100     CONTINUE  

      ENDIF    

!  GET NODAL CONNECTIONS
!      WRITE(150,*) 'ABOUT TO GO TO NDNECON'
!       FLUSH(150)
      IERR=0
      CALL NDNECON(IERR)

!  START ALONG LINE OF ELEMENTS

      DO N=1,NTRAC

  	    N1=ITRAC(N)
		IF(N .GT. 1) THEN
		  N0=ITRAC(N-1)
		ENDIF
		IF(N .LT. NTRAC) THEN
	  	  N2=ITRAC(N+1)
		ENDIF

!  Get direction

		IF(N .EQ. 1) THEN
          DIRX=XUSR(N2)-XUSR(N1)
	      DIRY=YUSR(N2)-YUSR(N1)
	      DIRL(N)=ATAN2(DIRX,-DIRY)
 	    ELSEIF(N .EQ. NTRAC) THEN
          DIRX=XUSR(N1)-XUSR(N0)
	      DIRY=YUSR(N1)-YUSR(N0)
		  DIRL(N)=ATAN2(DIRX,-DIRY)
		ELSE
          DIRX=XUSR(N2)-XUSR(N0)
	      DIRY=YUSR(N2)-YUSR(N0)
		  DIRL(N)=ATAN2(DIRX,-DIRY)
        ENDIF
	  ENDDO

!  Move nodes apart adding new numbers
      NNEL=6
      DO N=1,NTRAC
!        WRITE(150,*) 'STARTING NTRAC ITRAC',N,ITRAC(N)
        N1=ITRAC(N)
        DO M=1,NNEL/2
          CALL GETNOD(J) 
		  JTRAC(N,M)=J
		  XUSR(J)=XUSR(N1)-(WIDTH(N1)*M)/(NNEL)*COS(DIRL(N))
		  YUSR(J)=YUSR(N1)-(WIDTH(N1)*M)/(NNEL)*SIN(DIRL(N))
          CORD(J,1)=(XUSR(J)+XS)/TXSCAL
          CORD(J,2)=(YUSR(J)+YS)/TXSCAL
          INEW(J)=1
          INSKP(J) = 0 
          WD(J)=-9999.
          WIDTH(J)=0.
          SS1(J)=0.
          SS2(J)=0.
          WIDS(J)=0.
          WIDBS(J)=0.
          SSO(J)=0.

          CALL GETNOD(J1) 
		  KTRAC(N,M)=J1
		  XUSR(J1)=XUSR(N1)+(WIDTH(N1)*M)/NNEL*COS(DIRL(N))
		  YUSR(J1)=YUSR(N1)+(WIDTH(N1)*M)/NNEL*SIN(DIRL(N))
          CORD(J1,1)=(XUSR(J1)+XS)/TXSCAL
          CORD(J1,2)=(YUSR(J1)+YS)/TXSCAL
          INEW(J1)=1
          INSKP(J1) = 0 
          WD(J1)=-9999.
          WIDTH(J1)=0.
          SS1(J1)=0.
          SS2(J1)=0.
          WIDS(J1)=0.
          WIDBS(J1)=0.
          SSO(J1)=0.
        ENDDO  
   	  ENDDO
      DO N=1,NTRAC-1
        DO M=1,NNEL/2  
          CALL GETELM(J)
          IF(M .EQ. 1) THEN
	  	    NOP(J,1)=ITRAC(N+1)
		    NOP(J,3)=ITRAC(N)
		    NOP(J,5)=JTRAC(N,1)
		    NOP(J,7)=JTRAC(N+1,1)
          ELSE  
		    NOP(J,1)=JTRAC(N+1,M-1)
		    NOP(J,3)=JTRAC(N,M-1)
		    NOP(J,5)=JTRAC(N,M)
		    NOP(J,7)=JTRAC(N+1,M)
          ENDIF          
		  NOP(J,2)=0
		  NOP(J,4)=0
		  NOP(J,6)=0
		  NOP(J,8)=0
		  IMAT(J)=999
          NCORN(J) = 8
          IESKP(J) = 0 
          CALL GETELM(J)
          IF(M .EQ. 1) THEN
  		    NOP(J,1)=ITRAC(N)
	  	    NOP(J,3)=ITRAC(N+1)
		    NOP(J,5)=KTRAC(N+1,1)
		    NOP(J,7)=KTRAC(N,1)
          ELSE  
		    NOP(J,1)=KTRAC(N,M-1)
		    NOP(J,3)=KTRAC(N+1,M-1)
		    NOP(J,5)=KTRAC(N+1,M)
		    NOP(J,7)=KTRAC(N,M)
          ENDIF
		  NOP(J,2)=0
		  NOP(J,4)=0
		  NOP(J,6)=0
		  NOP(J,8)=0
		  IMAT(J)=999 
          NCORN(J) = 8
          IESKP(J) = 0 
          NE = MAX(J,NE) 
        ENDDO
      ENDDO  
      NE = MAX(J,NE) 
      RETURN
	  END

      SUBROUTINE FORM1DEL

	  USE WINTERACTER
      USE BLK1MOD
      USE BLK2MOD 
      include 'd.inc'
                                                 
!      INCLUDE 'BLK1.COM'
!      INCLUDE 'BLK2.COM' 
      INCLUDE 'TXFRM.COM'
      CHARACTER*1  IFLAG 
!
! Declare window-type and message variables
!
      TYPE(WIN_STYLE)    :: WINDOW

      TYPE(WIN_MESSAGE) :: MESSAGE

      integer  :: N1,N2,N3,IERR

      CALL WMessageBox(YesNo, QuestionIcon, 1,'Are 1-D nodes already defined?','FORM 1-D  ELEMENTS') 

!   If answer 'Yes'  set ifrmel to 0
!
      IF (WInfoDialog(4) .ne. 2) then
        
! yes
        CALL FRMEL(1)
      ELSE
! no
        CALL WMessageBox(YesNo, QuestionIcon, 1,'Use same width etc properties ?','FORM 1-D  ELEMENTS') 

!   If answer 'Yes'  set IGWID=1
!
        IF (WInfoDialog(4) .ne. 2) then
        
! yes
          IGWID=1
        ELSE
		  IGWID=0
! no
        ENDIF

        CALL WMessageBox(OKCancel, 4, 1,'Click on each node to form elements?'//CHAR(13)// &
          'Then click quit to continue','FORM 1-D  ELEMENTS') 
		JREF=0
		NTRAC=0
        NHTP=0
        NBRR=3
        NMESS=15
        CALL HEDR

  100   CONTINUE
        CALL XYLOC(XX,YY,IFLAG,IBOX) 
        IF(IRMAIN .EQ. 1) RETURN 
        IF(IFLAG .EQ. 'q'  .OR.  (IFLAG .EQ. 'c'  .AND. IBOX .EQ. 10))THEN 
          GO TO 200 
        ENDIF 
!                                                                       
        IF (IFLAG .EQ. 'c')  THEN 
!                                                                       
          call getnod(j)
		  NTRAC=NTRAC+1
		  ITRAC(NTRAC)=J
          INSKP(J)=0 
          CORD(J,1) = XX 
          CORD(J,2) = YY 
          INEW(J) = 1 
!                                                                       
          XUSR(J) = XX*TXSCAL - XS 
          YUSR(J) = YY*TXSCAL - YS 
          IF (J .GT. NP)  NP = J 
		  call pltnod(j,1)
		  IF(JREF .EQ.0) THEN
            WIDTH(J)=50.
 	 	    call nodedisp(j)
		  ELSE
            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)
            IF(IGWID .EQ. 0) THEN
     	      call nodedisp(j)
			ENDIF
            CALL PLTNOD(J,0)
		    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) 

		  ENDIF
		  J1=J
		  JREF=1
          GO TO 100
		ENDIF
      ENDIF    

  200 CONTINUE
      call clscrn
      CALL PLOTOT(1)
      NHTP=1
      NMESS=0
      NBRR=0
	  CALL HEDR
	  RETURN
	  END

	  SUBROUTINE SETWID

	    CALL FRMEL(0)
	  RETURN
	  END

	  SUBROUTINE FRMEL(ISW)

	  USE WINTERACTER
      USE BLK1MOD
      USE BLK2MOD 
      include 'd.inc'
                                                 
!      INCLUDE 'BLK1.COM'
!      INCLUDE 'BLK2.COM' 
      INCLUDE 'TXFRM.COM'
      CHARACTER*1  IFLAG 
!
! Declare window-type and message variables
!
      TYPE(WIN_STYLE)    :: WINDOW

      TYPE(WIN_MESSAGE) :: MESSAGE

      integer  :: N1,N2,N3,IERR

       NHTP=0
       NBRR=3
       NMESS=15
       CALL HEDR

      IF(ISW .EQ. 1) THEN
        CALL WMessageBox(YesNo, QuestionIcon, 1,'Is width data available?','WIDTH DATA') 
	  
!   If answer 'Yes'  set igtwel to 0
!
        IF (WInfoDialog(4) .EQ. 2) then
!NO
	      IGTWEL=1
        ELSE
!YES
	      IGTWEL=0
        ENDIF    
      ELSE

	    IGTWEL=1
	  ENDIF
      
	  IF(IGTWEL .EQ. 1) THEN
        CALL WMessageBox(YesNo, QuestionIcon, 1,'Use same width etc properties ?','FORM 1-D  ELEMENTS') 

!   If answer 'Yes'  set IGWID=1
!
        IF (WInfoDialog(4) .ne. 2) then
        
! yes
          IGWID=1
        ELSE
		  IGWID=0
! no
        ENDIF
      ENDIF
      NTRAC=0
  100 CONTINUE
      CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,J,IFLAG,INSKP,IBOX) 
      IF(IRMAIN .EQ. 1) RETURN 
      IF(IFLAG .EQ. 'q'  .OR.  (IFLAG .EQ. 'c'  .AND. IBOX .EQ. 10))THEN 
        GO TO 200 
      ENDIF 
!                                                                       
      IF (IFLAG .EQ. 'c')  THEN 
!                                                                       
  	    IF(IGTWEL .EQ. 1) THEN
		  IF(NTRAC .EQ. 0) THEN
 	 	    call nodedisp(j)
		  ELSE
            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)
		    IF(IGWID .EQ. 0) THEN
    	      call nodedisp(j)
			ENDIF
		  ENDIF
        ENDIF
        CALL PLTNOD(J,0)
!		IF(ISW .EQ. 1) THEN
        if(ntrac .ne. 0) then
          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) 
        ENDIF
		J1=J
  	  	NTRAC=NTRAC+1
        ITRAC(NTRAC)=J
	    GO TO 100
      ENDIF
  200 CONTINUE
	  RETURN
	  END