!     Last change:  IPK   2 Mar 1999   12:58 pm
!IPK  NEW ROUTINE OCT 23 1996                                           
      SUBROUTINE CCLINE(ISW) 
!                                                                       
!  Generate continuity lines                                            
!                                                                       
      USE BLK1MOD 
      USE BLK2MOD 
!      INCLUDE 'BLK1.COM'
!      INCLUDE 'BLK2.COM' 
      CHARACTER*1  IFLAG 
      DIMENSION XLIN(350),YLIN(350),INODE1(350) 
!      DIMENSION ICN(MAXP) 
      LOGICAL             :: OPENED
      DO J=1,MAXP 
        ICN(J)=0 
      ENDDO 

      IF(ISW .EQ. 1) THEN
        call opencln(ipos)
	    if(ipos .eq. 0) return
	  ELSE
	    ipos=2
	  ENDIF
!                                                                       
!     First sort out the potential midsides                             
!     Note that transition elements caues a problem                     
!     Find these first                                                  
      DO N=1,NE 
        IF(NCORN(N) .EQ. 5  .AND.  IMAT(N) .LT. 901) THEN 
!                                                                       
!     We have a transition  mark node number as if it were corner       
!                                                                       
          ICN(NOP(N,3))=1 
          ICN(NOP(N,1))=2 
          ICN(NOP(N,4))=2 
          ICN(NOP(N,5))=2 
        ELSE 
!                                                                       
!     Store ICN = 2 for corner nodes                                    
!                                                                       
          NCN=NCORN(N) 
!IPKOCT93          IF(IMAT(N) .GT. 900) THEN                            
          IF(IMAT(N) .GT. 900  .AND.  IMAT(N) .LT. 904) THEN 
            MST=1 
          ELSE 
            MST=2 
          ENDIF 
          DO M=1,NCN,MST 
            ICN(NOP(N,M))=2 
          ENDDO 
        ENDIF 
      ENDDO 
                                                                        
!                                                                       
!  Get connections                                                      
!                                                                       
      CALL NTONCON(ipos) 
  100 CONTINUE 
      NHTP=0 
      NMESS=26 
      NBRR=8 
      NTRACT=0
      
      CALL HEDR 
      NCLL=0
!                                                                       
!  Get first point                                                      
!                                                                       
  110 CONTINUE 
      K=1 
      CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE1(1),IFLAG,INSKP,IBOX) 
      if(inode1(1) .eq. 0) go to 110      
      IF(IRMAIN .EQ. 1) THEN
          NTRACT=0
          RETURN 
      ENDIF
      IF(IFLAG .EQ. 'q') THEN 
        NTRACT=0  
        GO TO 500 
      ENDIF
!IPK JAN01 
      IF(IBOX .EQ. 7  .OR.  IFLAG .EQ. 'n'  .or.   &
         IBOX .EQ. 5  .OR.  IFLAG .EQ. 'd') THEN 
        ipos=ncll+1
        CALL GETCLN(ipos)
!IPK JAN02
        IF(ISW .EQ. 1) THEN
          IF(IPOS .EQ. 0) THEN
            DO NCLL=1,140
              DO KK=1,350
                ICCLN(NCLL,KK)=0
              ENDDO
            ENDDO
            NCLM=0
          ELSE
            ncll=ipos
            DO KK=1,350
              ICCLN(NCLL,KK)=0
            ENDDO
            IF(NCLM .EQ. NCLL) NCLM=NCLM-1
          ENDIF  
          GO TO 100
		ENDIF
      ENDIF
      IF(ICN(INODE1(1)) .NE. 2) THEN 
        NMESS=28 
        CALL HEDR 
        GO TO  110 
      ENDIF 
         
      NBRR=5 
      NMESS=27 
      CALL HEDR 
      fpn=inode1(1) 
      CALL NUMBR(0.5,7.2,0.2,FPN,0.0,-1) 
      call pltnod(inode1(1),0) 
!                                                                       
!  Get second point                                                     
!                                                                       
  150 CONTINUE 
      K=K+1 
  160 CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE1(K),IFLAG,INSKP,IBOX) 
      IF(IRMAIN .EQ. 1) THEN
          NTRACT=0
          RETURN 
      ENDIF
      IF(IFLAG .EQ. 'q') THEN 
        NTRACT=0
        GO TO 500 
      ENDIF 
      NMESS=26 
      CALL HEDR 
      IF(IBOX .EQ. 6  .OR.  IFLAG .EQ. 'b' ) THEN 
        K=K-2 
        GO TO 150 
      ELSEIF(IBOX .EQ. 7  .OR.  IFLAG .EQ. 'n') THEN 
        KL=K-2 

        IF(ISW .EQ. 1) THEN

!IPK  Get continuity line number
          ipos=ncll+1
          CALL GETCLN(ipos)
          ncll=ipos
          IF(NCLL .EQ. 0) GO TO 500    
        ENDIF
!                                                                       
!  Trace along line                                                     
!           
        NTRACT=1
        IF(KL .GT. 0) THEN
          DO LS=1,KL 
            CALL TRACE(INODE1(LS),INODE1(LS+1)) 
          ENDDO
        ELSE
          NTRACT=1
          ITRAC(1)=INODE1(1) 
        ENDIF
!                                                                       
!  Output line to file                                                  
!                                                                       
!       WRITE(90,6000) (ITRAC(KK),KK=1,NTRAC) 
!ipk jan01
        INQUIRE(98, OPENED=OPENED)
        if(opened) then
         IF(IPOS .EQ. 1) THEN
          DO KK=1,NTRACT
           WRITE(98,6001) ITRAC(KK),XUSR(ITRAC(KK)),YUSR(ITRAC(KK))
6001       FORMAT('NODE',I7,2F15.3)            
          ENDDO
         ELSE
          WRITE(98,6000) NCLL,(ITRAC(KK),KK=1,NTRACT) 
         ENDIF
        endif
!IPK JAN01
 6000   FORMAT('CC1',I5,9I8/('CC2',5X,9I8)) 
        DO KK=1,NTRACT 
          XLIN(KK)=CORD(ITRAC(KK),1) 
          YLIN(KK)=CORD(ITRAC(KK),2) 
        ENDDO

!ipk jan01
!   Save to an array by line number
!
        IF(ISW .EQ. 1) THEN
          DO KK=1,NTRACT
            ICCLN(NCLL,KK)=ITRAC(KK)
          ENDDO    
          IF(NCLL .GT. NCLM) NCLM=NCLL
        ENDIF

        CALL RRED
!ipk jan01
        CALL THICKL 
        CALL DASHLN(XLIN,YLIN,NTRACT,0) 
!ipk jan01

        CALL THINL
!                                                                       
!  Go to get another line                                               
!   
        IF(ISW .EQ. 2) RETURN                                                                    
        GO TO 100 
      ELSE 
        IF(ICN(INODE1(K)) .NE. 2) THEN 
          NMESS=27 
          CALL HEDR 
          GO TO  160 
        ENDIF 
        KL=K-1 
!                                                                       
!  Trace along line                                                     
!                                                                       
        call pltnod(inode1(1),0) 
        NTRACT=1
        DO LS=1,KL 
          CALL TRACE(INODE1(LS),INODE1(LS+1)) 
          call pltnod(inode1(ls+1),0) 
        ENDDO 
        if(ntracT .gt. 0) then
          DO KK=1,NTRACT 
            if(itrac(kk) .eq. 0) go to 300
            XLIN(KK)=CORD(ITRAC(KK),1) 
            YLIN(KK)=CORD(ITRAC(KK),2) 
          ENDDO 
          CALL RRED
!ipk jan01
          CALL THICKL 
          CALL DASHLN(XLIN,YLIN,NTRACT,0)
!ipk jan01
          CALL THINL
        endif 
  300   CONTINUE
        fpn=inode1(KL+1) 
        CALL NUMBR(0.5+KL*0.5,7.2,0.2,FPN,0.0,-1) 
!                                                                       
!  Get another point                                                    
!                                                                       
        GO TO 150 
      ENDIF 
!                                                                       
!  Exit                                                                 
!                                                                       
  500 CONTINUE 
      END                                           
      SUBROUTINE NTONCON(ipos) 
!                                                                       
!  Generate Connections                                                 
!                                                                       
      USE BLK1MOD 
      USE BLK2MOD 
!      INCLUDE 'BLK1.COM' 
!      INCLUDE 'BLK2.COM' 
!                                                                       
!  Initialize to zero                                                   
!                                                                       
      NCM=MAXECON 
      DO N=1,NP 
        DO L=1,NCM 
          NECON(N,L)=0 
        ENDDO 
      ENDDO 
!                                                                       
!  Loop on elements                                                     
!                                                                       
      DO N=1,NE 
!                                                                       
!  Check to see that this element is active                             
!                                                                       
        IF(IMAT(N) .NE. 0) THEN 
          NCN=NCORN(N) 
!                                                                       
!  Search to see if connection M and K made                             
!                                                                       

!         DO M=1,NCN,2
          DO M=1,NCN,ipos

 
!            IF(M .GT. NCN-1) GO TO 200                                 
!           K=M+2 
            K=M+ipos 
            IF(K .GT. NCN) K=1 
            DO L=1,NCM 
              IF(NECON(NOP(N,M),L) .EQ. 0) THEN 
!                                                                       
!  This is new connection                                               
!                                                                       
                NECON(NOP(N,M),L)=NOP(N,K) 
                GO TO 150 
              ELSEIF(NECON(NOP(N,M),L) .EQ. NOP(N,K)) THEN 
!                                                                       
!  This is an old connection                                            
!                                                                       
                GO TO 150 
              ENDIF 
            ENDDO 
  150       CONTINUE 
!                                                                       
!  Now look in the revers direction                                     
!                                                                       
            DO L=1,NCM 
              IF(NECON(NOP(N,K),L) .EQ. 0) THEN 
                NECON(NOP(N,K),L)=NOP(N,M) 
!                                                                       
!  This is new connection                                               
!                                                                       
                GO TO 175 
              ELSEIF(NECON(NOP(N,K),L) .EQ. NOP(N,M)) THEN 
!                                                                       
!  This is an old connection                                            
!                                                                       
                GO TO 175 
              ENDIF 
            ENDDO 
  175       CONTINUE 
          ENDDO 
        ENDIF 
  200   CONTINUE 
      ENDDO 
                                                                        
!                                                                       
      RETURN 
      END                                           
      SUBROUTINE TRACE(INODE1,INODE2) 
!                                                                       
!  Generate continuity lines                                            
!                                                                       
      USE BLK1MOD 
      USE BLK2MOD 
!      INCLUDE 'BLK1.COM' 
!      INCLUDE 'BLK2.COM' 
      DIST(N,M)=(cord(n,1)-cord(m,1))**2+(cord(n,2)-cord(m,2))**2 
!                                                                       
!  Start at INODE1                                                      
!                                                                       
      ITRAC(NTRACT)=INODE1 
      LAT=INODE1 
  100 CONTINUE 
!                                                                       
!  Look for new nearer node to INODE2                                   
!                                                                       
      CURR=1.E30 
      LAT1=0 
      DO K=1,NCM 
        LATTMP=NECON(LAT,K) 
        IF(LATTMP .NE. 0) THEN 
          IF(DIST(INODE2,LATTMP) .LT. CURR) THEN 
            LAT1=LATTMP 
            CURR=DIST(INODE2,LATTMP) 
          ENDIF 
        ELSE 
          GO TO 150 
        ENDIF 
      ENDDO 
  150 CONTINUE 
      IF(LAT1 .EQ. 0) RETURN 
      NTRACT=NTRACT+1 
      ITRAC(NTRACT)=LAT1 
      IF(LAT1 .EQ. INODE2) RETURN 
      IF(NTRACT .GT. 350) RETURN 
      LAT=LAT1 
      GO TO 100 
      END                                           

      subroutine opencln(ipos)
      use winteracter

      implicit none

      include 'd.inc'
      CHARACTER(LEN=255)  :: FNAME
      CHARACTER(LEN=3)    :: SUB
      LOGICAL             :: OPENED
      INTEGER             :: IPOS,IERR

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

      TYPE(WIN_MESSAGE) :: MESSAGE

      INQUIRE(98, OPENED=OPENED)
      if(.not. opened) then
        CALL WSelectFile(ID_STRING8,SaveDialog+PromptOn,FNAME,'Save continuity line')
 
        IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN

          SUB='cln'
          CALL ADDSUB(FNAME,SUB)
          open(98,file=fname, form='formatted', status='unknown')
        ENDIF
      endif

      call wdialogload(IDD_DIALOG08)
      ierr=infoerror(1)


      call wdialogputRadioButton(idf_radio1)


      CALL WDialogSelect(IDD_DIALOG08)
      ierr=infoerror(1)
 
      CALL WDialogShow(-1,-1,0,Modal)
      ierr=infoerror(1)
      

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

          call wdialoggetradiobutton(idf_radio1,ipos)
          ipos=3-ipos
          return
         endif
         ipos= 0
         RETURN
      enddo
      ipos= 2
      RETURN
      END


!ipk jan01
      subroutine getcln(ipos)
      use winteracter

      implicit none

      include 'd.inc'

      INTEGER             :: IPOS,IERR

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

      TYPE(WIN_MESSAGE) :: MESSAGE


      call wdialogload(IDD_DIALOG010)
      ierr=infoerror(1)

      CALL WDialogSelect(IDD_DIALOG010)
      ierr=infoerror(1)

      CALL WDialogPutINTEGER(IDF_INTEGER1,IPOS)

      write(90,*) 'iposin',ipos 
      CALL WDialogShow(-1,-1,0,Modal)
      ierr=infoerror(1)
      
      do
         IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN

            CALL WDialogGetINTEGER(IDF_INTEGER1,IPOS)
            write(90,*) 'iposout',ipos

          return
         endif
		 return
      enddo

      RETURN
      END
      SUBROUTINE CHKLIN 
!                                                                       
!  Generate continuity lines                                            
!                                                                       
      USE BLK1MOD 
      USE BLK2MOD 
!      INCLUDE 'BLK1.COM'
!      INCLUDE 'BLK2.COM'

      IPOS=2
      CALL NTONCON(ipos) 

      DO I=1,NCLM
        NTRACT=1
		ITRAC(1)=ICCLN(I,1)
        DO J=1,350 
		  INODE1=ICCLN(I,J)
		  INODE2=ICCLN(I,J+1)
		  IF(INODE2 .EQ. 0) GO TO 300
          CALL TRACE(INODE1,INODE2) 
        ENDDO
  300   DO J=1,NTRACT
          ICCLN(I,J)=ITRAC(J)
        ENDDO
      ENDDO

	  RETURN
	  END 
