!IPK  NEW ROUTINE SEP 9 2006                                           
      SUBROUTINE SPLITN
!                                                                       
!  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(350),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)
!
      icln=1
      dirsplIt=0.
      ieltyp=1
      ientyp=1
      SPAC=10.
      call wdialogload(IDD_DISPLIT)
      ierr=infoerror(1)

      CALL WDialogSelect(IDD_DISPLIT)
      ierr=infoerror(1)

      call wdialogputradiobutton(idf_radio1)
      CALL WDialogPutinteger(IDF_INTEGER3,icln)
      CALL WDialogPutReal(IDF_REAL1,SPAC)
      CALL WDialogPutinteger(IDF_INTEGER2,IELTYP)
      call wdialogputcheckbox(IDF_check1,ielsw)
      call wdialogputcheckbox(IDF_check2,iensw)
      CALL WDialogPutinteger(IDF_INTEGER6,IENTYP)
      CALL WDialogPutReal(IDF_REAL2,DIRSPLIT)
      CALL WDialogShow(-1,-1,0,Modal)
      ierr=infoerror(1)

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

            call wdialoggetradiobutton(idf_radio1,iswr)
            CALL WDialogGetinteger(IDF_INTEGER3,icln)              
            CALL WDialogGetREAL(IDF_REAL1,SPAC)
            CALL WDialogGetinteger(IDF_INTEGER2,IELTYP)
            call wdialogGetcheckbox(IDF_check1,ielsw)
            call wdialogGetcheckbox(IDF_check2,iensw)
            CALL WDialogGetinteger(IDF_INTEGER6,IENTYP)
            CALL WDialogGetREAL(IDF_REAL2,DIRSPLIT)
            GO TO 100
		  ENDIF

      enddo

100   CONTINUE

      if(iswr .eq. 1) then
        CALL CCLINE(2)
      else
        DO KK=1,350
          if(iccln(icln,KK) .eq. 0) then
            ntract=kk-1
            go to 102
          endif
          itrac(kk)=ICCLN(icln,KK)
        enddo
102     continue         
      endif
      DO N=1,NTRACT

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

!  Get direction

		  IF(N .EQ. 1) THEN
		    IF(NTRACT .GT. 1) THEN
              DIRX=XUSR(N2)-XUSR(N1)
	          DIRY=YUSR(N2)-YUSR(N1)
		      DIRL(N)=ATAN2(DIRX,-DIRY)
            ELSE
			  DIRL(N)=DIRSPLIT
			ENDIF
		  ELSEIF(N .EQ. NTRACT) 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

      DO N=1,NTRACT
		  N1=ITRAC(N)
          CALL GETNOD(J) 
		  JTRAC(N)=J
		  XUSR(J)=XUSR(N1)-SPAC/2.*COS(DIRL(N))
		  YUSR(J)=YUSR(N1)-SPAC/2.*SIN(DIRL(N))
          CORD(J,1)=(XUSR(J)+XS)/TXSCAL
          CORD(J,2)=(YUSR(J)+YS)/TXSCAL
          INEW(J)=1
          INSKP(J) = 0 

		  XUSR(N1)=XUSR(N1)+SPAC/2.*COS(DIRL(N))
		  YUSR(N1)=YUSR(N1)+SPAC/2.*SIN(DIRL(N))
          CORD(N1,1)=(XUSR(N1)+XS)/TXSCAL
          CORD(N1,2)=(YUSR(N1)+YS)/TXSCAL
          WD(J)=WD(N1) 
          WIDTH(J)=WIDTH(N1) 
          SS1(J)=SS1(N1) 
          SS2(J)=SS2(N1) 
          WIDS(J)=WIDS(N1) 
          WIDBS(J)=WIDBS(N1)
          SSO(J)=SSO(N1)
   	  ENDDO


!     Form list of elements connected to nodes
      IERR=0
      CALL NDNECON(IERR)

!  find each element

      IPROCES=0

      IF(NTRACT .GT. 1) THEN
       DO N=1,NTRACT-1
        DO K=1,NDELM(ITRAC(N))
	      J=NECON(ITRAC(N),K)
!		  IF(IPROCES(J) .EQ. 0) THEN
		    IJ=0
		    II=0
            DO L=1,NCORN(J),2
		      IF(NOP(J,L) .EQ. ITRAC(N)  .or.  NOP(J,L) .EQ. JTRAC(N)) II=L
			  IF(NOP(J,L) .EQ. ITRAC(N+1)) IJ=L
		    ENDDO
		    IF(IJ .NE. 0) THEN
		      IF(IJ .LT. II  .OR.  (II  .EQ. 1  .and.  ij .ne. 3) ) THEN
			    IF(II .EQ. NCORN(J)-1  .AND.  IJ .EQ.  1) GO TO 200   
!  MATCH FOUND
                NOP(J,II)= JTRAC(N)
			    NOP(J,IJ)= JTRAC(N+1)
                IPROCES(J)=1
			    GO TO 300
              ENDIF
  200         CONTINUE
              IPROCES(J)=1
		    ENDIF
  300       CONTINUE
!          ENDIF
        ENDDO
       ENDDO

      ENDIF

      DO N=1,NTRACT
        DO K=1,NDELM(ITRAC(N))
	      J=NECON(ITRAC(N),K)
		  IF(IPROCES(J) .EQ. 0) THEN
		    II=0
            DO L=1,NCORN(J),2
		      IF(NOP(J,L) .EQ. ITRAC(N)) II=L
		    ENDDO
		    IF(II .NE. 0) THEN
			  A0P=-9999.
			  A0M=9999.
			  B0P=-9999.
			  B0M=9999.
			  DO L=1,NCORN(J),2
 	 	        IF(II .NE. NOP(J,L)) THEN
		 	      ITEST=NOP(J,L)
			    ENDIF
			    A1=PROJ(ITEST,ITRAC(N),DIRL(N))
				IF(A1 .GT.  A0P) A0P=A1
				IF(A1 .LT.  A0M) A0M=A1
	            B1=PROJ(ITEST,JTRAC(N),DIRL(N))
				IF(B1 .GT.  B0P) B0P=B1
				IF(B1 .LT.  B0M) B0M=B1
              ENDDO
              IF(ABS(A0M) .GT. ABS(A0P)) THEN
			    A0P=A0M
				B0P=B0M
			  ENDIF
			  IF(ABS(A0P) .GT. ABS(B0P)) THEN  
			      NOP(J,II)= JTRAC(N)
   	          ENDIF
              IPROCES(J)=1
			ENDIF
          ENDIF
        ENDDO
      ENDDO
        IERR=0
        CALL NDNECON(IERR)

      IF(IELSW .EQ. 0) GO TO 400
!  form new elements

      DO N=1,NTRACT-1
        CALL GETELM(J)
		NOP(J,1)=JTRAC(N)
		NOP(J,3)=JTRAC(N+1)
		NOP(J,5)=ITRAC(N+1)
		NOP(J,7)=ITRAC(N)
		NOP(J,2)=0
		NOP(J,4)=0
		NOP(J,6)=0
		NOP(J,8)=0
		IMAT(J)=IELTYP 
        NCORN(J) = 8
        IESKP(J) = 0 
        NE = MAX(J,NE) 
	  ENDDO

  400 CONTINUE

      if(iensw .gt. 0) then 



!     start at first node
        IF(NDELM(ITRAC(1)) .GT. 1) THEN
          DO K=1,NDELM(ITRAC(1))
            J=NECON(ITRAC(1),K)
            DO KZ=1,NCORN(J),2
			  IF(NOP(J,KZ) .EQ. ITRAC(1)) THEN
			    K1=KZ
				GO TO 500
			  ENDIF
			ENDDO
  500       KK=K1-2
            IF(KK .LT. 0) KK=NCORN(J)-1
			KUP=NOP(J,KK)
            DO KZ=1,NDELM(KUP)
  	  	  	  JJ=NECON(KUP,KZ)
			  DO KY=1,NCORN(JJ),2
			    IF(NOP(JJ,KY) .EQ. KUP) THEN
			      K2=KY
				  GO TO 550
			    ENDIF
			  ENDDO
  550         KL=K2-2
              IF(KL .LT. 0) KL=NCORN(JJ)-1
			  IF(NOP(JJ,KL) .EQ.  JTRAC(1)) THEN
			    GO TO 600
			  ENDIF
			ENDDO
		  ENDDO

!    FOUND A MATCH

  600     CONTINUE
          CALL GETELM(JK)
          NOP(JK,1)=ITRAC(1)
		  NOP(JK,3)=KUP
		  NOP(JK,5)=JTRAC(1)
 		  NOP(JK,2)=0
		  NOP(JK,4)=0
		  NOP(JK,6)=0
		  IMAT(JK)=IENTYP 
          NCORN(JK) = 6
          IESKP(JK) = 0 
          NE = MAX(JK,NE) 
		ENDIF

        IF(NDELM(ITRAC(NTRACT)) .GT. 1) THEN
          DO K=1,NDELM(ITRAC(NTRACT))
            J=NECON(ITRAC(NTRACT),K)
            DO KZ=1,NCORN(J),2
			  IF(NOP(J,KZ) .EQ. ITRAC(NTRACT)) THEN
			    K1=KZ
				GO TO 650
			  ENDIF
			ENDDO
  650       KK=K1+2
            IF(KK .GT. NCORN(J)) KK=1
			KUP=NOP(J,KK)
            DO KK=1,NDELM(KUP)
			  JJ=NECON(KUP,KK)
			  DO KY=1,NCORN(JJ),2
			    IF(NOP(JJ,KY) .EQ. KUP) THEN
			      K2=KY
				  GO TO 700
			    ENDIF
			  ENDDO
  700         KL=K2+2
              IF(KL .GT. NCORN(JJ)) KL=1
			  IF(NOP(JJ,KL) .EQ.  JTRAC(NTRACT)) THEN
			    GO TO 750
 			  ENDIF
			ENDDO
		  ENDDO
		  GO TO 800

!    FOUND A MATCH

  750     CONTINUE
          CALL GETELM(JK)

          NOP(JK,1)=JTRAC(NTRACT)
		  NOP(JK,3)=KUP
		  NOP(JK,5)=ITRAC(NTRACT)
  		  NOP(JK,2)=0
		  NOP(JK,4)=0
		  NOP(JK,6)=0
		  IMAT(JK)=IENTYP 
          NCORN(JK) = 6
          IESKP(JK) = 0 
          NE = MAX(JK,NE) 
		ENDIF

      endif

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