!IPK  LAST UPDATE SEP 23 2015  ADD TESTING FOR REORDERING
      SUBROUTINE ORDALL

      INCLUDE 'BFILES.I90'
      COMMON /HEDS/ NP,NE,NHTP,NMESS,NBRR,IPSW(15),IRMAIN,ISCRN,icolon(12),IQSW(2),IRDISP,ntempin,igfgsw,igfgswb,ICRIN,IPW1,WIDEL,WIDSCL,itrianout

      ISWALL=1
      nmess=45
     
      CALL GETINT(ISWALL)
      IF(ISWALL .EQ. 0) ISWALL=1
	  ISW=0
      CALL REORD(ISW,ISWALL)
      CALL WMessageBox(0,4,1,'REORDERING COMPLETE',' ')

      IRDONE=1
      
	  RETURN

	  END



!IPK  LAST UPDATE JULY 11 2005 FIX BUG IN REORDERING
!ipk  last update Nov 18 1996                                           
!     Last change:  IPK  12 Jan 98    2:06 pm                           
!ipk  last update Jan 6 1997 disallow negative sums                     
      SUBROUTINE ADDORD(ISW) 
!                                                                       
!  Enter reordering sequence                                            
!                                                                       
      USE WINTERACTER
      USE BLK1MOD
      INCLUDE 'BFILES.I90'

!      INCLUDE 'BLK1.COM' 
!iPK APR94
      COMMON /RECOD/ IRECD,TSPC
!      dimension ilisttmp(100)
!                                                                       
      CHARACTER*1  IFLAG 
      CHARACTER*14  HEADR 
      CHARACTER*60  STRELS 
      CHARACTER*80  LIND 
!      INTEGER*2 IPAG,NT                                                
      DATA MULTPG/0/ 
      DATA STRELS/' You have tried to reorder before executing "FILL"'/ 
      DATA XPRT/0./
!                                                                       
!  Test to make sure fill has been executed.                            
!                                                                       
      IF(ISW .NE. 1) THEN 
        DO 70 N=1,NE 
          IF(IMAT(N) .GT. 0) THEN 
            DO 60 M=2,NCORN(N),2 
!ipkoct93                                                               
              if(imat(n) .gt. 900) go to 60 
              IF(NOP(N,M) .EQ. 0) THEN 
         	  	CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,          &
	    'You have tried to reorder before executing "FILL"'//CHAR(13) &
      //'Reordering terminated',&
	    'UNABLE TO REORDER')
!                CALL SYMBL(0.,7.30,0.20,STRELS,0.,60) 
                RETURN 
              ENDIF 
   60       CONTINUE 
          ENDIF 
   70   CONTINUE 
      ENDIF 
!                                                                       
!                                                                       
      IF(ISW .EQ. 0) THEN 
!                                                                       
!  Change screens if possible                                           
!                                                                       
        IF(MULTPG .EQ. 1) THEN 
!          IPAG=1                                                       
!          NT=SETACTIVEPAGE(IPAG)                                       
!          NT=SETVISUALPAGE(IPAG)                                       
        ELSE 
          CALL CLSCRN 
          CALL SETD(23) 
        ENDIF 
        ISWW=0
        CALL WCursorShape(CurHourGlass )
        ISWALL=0
        CALL REORD(ISWW,ISWALL)
        IRDONE=1
!IPK AUG05        CALL REORD(ISWW) 
        CALL WCursorShape(CurArrow )
!                                                                       
!  Restore screen                                                       
!                                                                       
!pk jan98        WRITE(*,*) 'Press "Return" to restore grapical screen' 

        CALL SHOWORD
!        WRITE(LIND,6002) 
! 6002    FORMAT( 'Press "Return" to restore grapical screen') 
!         call rblue 
!         call symbl                                                     &
!     &   (1.1,3.0,0.20,LIND,0.0,80)                                     
!         ndig=1 
!         CALL GTCHARX(IFLAG,NDIG,5.0,7.6) 
                                                                        
!ipk jan98        READ(*,'(A)') IFLAG                                   
        IF(MULTPG .EQ. 1) THEN 
          IPAG=0 
!          NT=SETACTIVEPAGE(IPAG)                                       
!          NT=SETVISUALPAGE(IPAG)                                       
        ELSE 
          CALL CLSCRN 
          CALL SETD(2) 
!            CALL PLOTS(0)                                              
!ipk nov97 add (1)                                                      
          CALL PLOTOT(1) 
          do n=1,ne 
            nn=iem(n) 
            if(imat(nn) .ne. 0  .AND. IESKP(NN) .EQ. 0) then 
                                                                        
              call fillemC(nn,MOD(N/25,15)) 
            endif 
!            if(mod(n,200) .eq. 0) then                                 
!              READ(*,'(A)') IFLAG                                      
!            endif                                                      
          enddo 
        ENDIF 
      ELSEIF(ISW .EQ. 1) THEN 
  100   continue
!  100   WRITE(HEADR,5000) NLST 
! 5000 FORMAT(' NLIST = ',I5) 
!        NHTP = 0 
!        NMESS = 13 
!        NBRR = 0 
!        CALL HEDR 
!        CALL SYMBL(0.,7.50,0.20,HEADR,0.,14) 
!        XPRT=3.2 
!                                                                       
!  Form element reordering list by clicking on elements with cursor     
!                                                                       
 5001 FORMAT(I10) 
!        CALL GETINT(NLIST) 
!        READ(*,5001,ERR=220) NLIST                                     
!                                                                       
!  Find element nearest cursor                                          
!                                                                       
        J=0 
  200   IBOX=1 
        NMESS = 12 
        NBRR = 9 
        CALL HEDR 
        CALL PLOTORDS
        INREORD=1
        CALL PROX(XC,YC,NE,XX,YY,IELEM,IFLAG,IESKP,IBOX)
        INREORD=0
        CALL PLOTORDS
!        write(90,*) 'reord'
!        write(90,'(i10,a10)') ibox,iflag 
        IF(IRMAIN .EQ. 1) THEN
          DO J=1,100
            ilisttmp (j)=0
          ENDDO
          RETURN 
        ENDIF
  210   IF(IFLAG .EQ. 'c'  .and.  ibox .ne. 7) THEN 
          CALL FILLEM(IELEM) 
          XPRT=XPRT+0.5 
          IF(XPRT .GT. HSIZE) XPRT=0. 
          FPN= IELEM 
          CALL NUMBR(XPRT,7.20,0.20,FPN,0.0,-1) 
          J=J+1
          ilisttmp (j)=ielem
!          ILIST(NLIST,J)=IELEM 
          GO TO 200 
        ELSEIF (IFLAG .EQ. 'U')  THEN 
          ilisttmp (j)=0
	      J=J-1
		  CALL PLOTOT(1)
		  CALL HEDR
		  DO IELEM=1,J
            CALL FILLEM(ILISTTMP(IELEM)) 
		  ENDDO
		  GO TO 200
        ELSEIF(IFLAG .EQ. 'e') THEN 
!          LLIST(NLIST)=J 
          nlist=nlst+1
          call getnlist(nlist)
          LLIST(NLIST)=J 
          do i=1,j
            ilist(nlist,i)=ilisttmp(i)
          enddo
          IF(NLIST .GT. NLST) NLST=NLIST 
          DO J=1,100
            ilisttmp (j)=0
          ENDDO
          GO TO 100 
        ELSEIF(IFLAG .EQ. 'a'  .or. ibox .eq. 7) THEN 
          nlist=nlst+1
          IF(IRECD .NE.2) call getnlist(nlist)
          LLIST(NLIST)=J 
          do i=1,j
            ilist(nlist,i)=ilisttmp(i)
          enddo
          IF(NLIST .GT. NLST) NLST=NLIST 
          DO J=1,100
            ilisttmp (j)=0
          ENDDO
          GO TO 100 
        ELSEIF(IFLAG .EQ. 'q') THEN 
!          LLIST(NLIST)=J 
!          IF(NLIST .GT. NLST) NLST=NLIST 
!          CALL REORD(NLIST)                                            
!         CALL WRTOUT(0)                                                
          DO J=1,100
            ilisttmp (j)=0
          ENDDO
        ENDIF 
      ELSEIF(ISW .EQ. 2) THEN 
!                                                                       
!  Change screens if possible                                           
!                                                                       
        IF(MULTPG .EQ. 1) THEN 
          IPAG=1 
!          NT=SETACTIVEPAGE(IPAG)                                       
!          NT=SETVISUALPAGE(IPAG)                                       
        ELSE 
          CALL CLSCRN 
          CALL SETD(23) 
        ENDIF 
        ISWW=NLIST
		ISWALL=0 
        CALL REORD(ISWW,ISWALL) 
!IPK AUG05        CALL REORD(ISWW) 
!                                                                       
!  Restore screen                                                       
!                                                                       
!IPK JAN98        WRITE(*,*) 'Press "Return" to restore grapical screen'
!IPK JAN98        READ(*,'(A)') IFLAG                                   
         CALL SHOWORD
!         WRITE(LIND,6002) 
!         call symbl                                                     &
!     &   (1.1,3.0,0.20,LIND,0.0,80)                                     
!         ndig=1 
!         CALL GTCHARX(IFLAG,NDIG,5.0,7.6) 
        IF(MULTPG .EQ. 1) THEN 
          IPAG=0 
!          NT=SETACTIVEPAGE(IPAG)                                       
!          NT=SETVISUALPAGE(IPAG)                                       
        ELSE 
          CALL CLSCRN 
          CALL SETD(2) 
!            CALL PLOTS(0)                                              
!ipk nov97 add (1)                                                      
          CALL PLOTOT(1) 
        ENDIF 
      ENDIF 
  220 RETURN 
      END                                           
      SUBROUTINE REORD (ISW,ISWALL) 
!                                                                       
!     DRIVING ROUTINE TO REORDER ELEMENTS                               
!                                                                       
      USE BLK1MOD
      USE BLK2MOD 
!      INCLUDE 'BLK1.COM' 
!      INCLUDE 'BLK2.COM' 
!                                                                       
!     INITIALIZE                                                        
!                                                                       
      IF(IECHG .EQ. 0) THEN 
        NCM=MAXECON 
        NCMI=MAXECON 
        NAD=0 
        MP=0 
        IPASS=1 
!                                                                       
!     GET TABLE OF ELEMENT CONNECTIONS                                  
!                                                                       
        CALL KCON(0)
!                                                                       
!     SETUP NELIM.   IDENTIFIES 3 NODE ELEMENTS OR JUNCTIONS WHEN = 1   
!                                                                       
        DO 250 N=1,NE 
          IF(IMAT(N) .NE. 0) THEN 
!ipkoct93                                                               
            IF(NCORN(N) .EQ. 3  .OR.  (IMAT(N) .GT. 900  .and.          &
     &         ncorn(n) .ne. 8)) THEN                                   
              NELIM(N)=1 
            ELSE 
              NELIM(N)=0 
            ENDIF 
          ELSE 
            NELIM(N)=1 
          ENDIF 
  250   CONTINUE 
        IECHG=1 
!IPK MAY03
        ICHG=0

!                                                                       
!     PROCESS INITIAL ORDER                                             
!                                                                       
        IF(ISW .EQ. 0) THEN 
          CALL ORDER(ISWALL) 
          ISW=ISW+1 
        ENDIF 
      ENDIF 
      IF(ISW .EQ. 0) ISW=1 
!                                                                       
!     OTHERWISE RESET MLIST                                             
!                                                                       
  305 DO 310 N=1,NAE 
        MLIST(N)=0 
  310 END DO 
!                                                                       
!     SET STARTING SEQUENCE                                             
!                                                                       

!IPK AUG05
      IF(ISWALL .EQ. 0) THEN

        NN=1
        DO 320 N=1,NAE 
          MLIST(NN)=ILIST(ISW,N)
          IF(NN .GT. 1) THEN 
            IF(MLIST(NN) .EQ. MLIST(NN-1)) THEN
              NN=NN-1
            ENDIF
!IPK JUL05 FIX BUG MOVE DOWN          NN=NN+1
          ENDIF
          NN=NN+1
!        write(90,*) 'Entries forming start of list',n,mlist(n)        
          IF(MLIST(N) .EQ. 0) GO TO 325 
  320   END DO
      ELSE
  322   CONTINUE
        IF(MOD(ISW,ISWALL) .EQ. 0) THEN
	      MLIST(1)=ISW
        ELSE
          ISW=ISW+1
          GO TO 322
        ENDIF

	  ENDIF
!                                                                       
  325 MP=0 
      NAD=0 
!                                                                       
!     RESET NODE TO ELEMENT LIST                                        
!                                                                       
      DO 340 N=1,NP 
        DO 335 M=1,NCM 
          IF(NECON(N,M) .EQ. 0) GO TO 338 
  335   CONTINUE 
  338   NDELM(N)=M-1 
  340 END DO 
!                                                                       
!     RESET ELEMENT CONNECTIONS                                         
!                                                                       
      DO 350 N=1,NE 
        DO 350 M=1,NCMI 
        ICON(N,M)=IABS(ICON(N,M)) 
  350 CONTINUE 
!                                                                       
!     GO TO PROCESS THIS SEQUENCE                                       
!                                                                       
      IF(MLIST(1) .GT. 0) THEN 
        CALL ORDER(ISWALL) 
        ISW=ISW+1 
      ELSE 
        GO TO 600 
      ENDIF 
      IF(ISWALL .EQ. 0) THEN
	    IF(ISW .GT. NLST) GO TO 600 
	  ELSE
        WRITE(90,*) MLIST(1),MTSUMSV(NSEQ),NFWSV(NSEQ),IEM(1),MRSUM

	    IF(ISW .GT. NE) GO TO 600
	  ENDIF
      GO TO 305 
!                                                                       
!     PRINT FINAL ORDER                                                 
!                                                                       
  600 WRITE(90,6040) (IEM(K),K=1,NAE) 
 6040 FORMAT(//' SELECTED ELEMENT ORDER'/(10I6)) 
!                                                                       
!     RETURN TO MAIN                                                    
!                                                                       
      RETURN 
      END                                           
      SUBROUTINE ORDER(ISWALL) 
!                                                                       
!     FIND ORDER AND FRONT SUM FOR A GIVEN START POINT                  
!                                                                       
      USE BLK1MOD
      USE BLK2MOD 
!      INCLUDE 'BLK1.COM' 
!      INCLUDE 'BLK2.COM' 
!                                                                       
!     SET LIST OF INCORPORATED NODES                                    
!                                                                       
      DO 200 N=1,NP 
  200 NINC(N)=0 
!                                                                       
!     SET COUNTER ON ELEMENTS                                           
!                                                                       
      KNT=0 
      MTSUM=0 
!ipk feb97 add mtsum1                                                   
      mtsum1=0 
!IPK MAY94 LINE ADDED                                                   
      NFWSAV=0 
!                                                                       
!     PROCESS THROUGH ELEMENTS                                          
!                                                                       
  300 CONTINUE 
!                                                                       
!     SET MLIST FROM INPUT IF NON-ZERO WE MUST FIND KREC                
!                                                                       
      KREC=MLIST(KNT+1) 
!                                                                       
!     GET NEXT ELEMENT TO ADDED                                         
!                                                                       
      CALL MOVFNT(KREC,ISWALL)

!ipk mar04       
      IF(KREC .lt. 0) THEN
	    write(90,*) 'krec',knt,mlist(knt)
        MTSUM=9999999999999
        MTSUM1=9999999999999
        GO TO 310
      ENDIF
!                                                                       
!     SAVE SELECTED VALUE                                               
!                                                                       
      MLIST(KNT+1)=KREC 
      KNT=KNT+1 
!                                                                       
!     UPDATE FRONT AND CONNECTION TABLES                                
!                                                                       
      CALL UPFNT(KREC) 
!      WRITE(91,9000) KREC,MTSUM,MSUM,MP,NAD                            
! 9000 FORMAT('  KREC     MTSUM      MSUM   MP  NAD'/I6,2I15,2I5) 
!                                                                       
!     TEST FOR FULL SET OF ELEMENTS                                     
!                                                                       
      IF (KNT.LT.NAE) GO TO 300 
!                                                                       
!     FOR COMPLETE ORDER CHECK IF IT IS IMPROVEMENT                     
!           
!IPK MAR04     
  310 CONTINUE                                                       
      CALL CHKOUT(ISWALL) 
!                                                                       
!     FINISHED                                                          
!                                                                       
      RETURN 
      END                                           
      SUBROUTINE MOVFNT(KREC,ISWALL) 
!                                                                       
!     GET ELEMENT THAT INCREASES FRONT WIDTH LEAST                      
!                                                                       
      USE BLK1MOD
      USE BLK2MOD 
!      INCLUDE 'BLK1.COM' 
!      INCLUDE 'BLK2.COM'
	  INTEGER*8 MSAV,MSA 
      CHARACTER*80 LIND 
      CHARACTER*1 JUNK 
!                                                                       
!     INITIALIZE                                                        
!                                                                       
      MSAV=99999999 
      NSN=99999 
!                                                                       
!     SKIP IF KREC ALREADY DEFINED                                      
!                                                                       
      IF(KREC .GT. 0) GO TO 310 
!                                                                       
!     SEARCH ADJACENT ELEMENTS                                          
!                                                                       
      NTST=NITST 
  260 NFD=0 
      if(nad .eq. 0) then 
!IPK JAN98        write(*,*) 'nad in trouble type q and press return,enxt(1)',enxt(1)   
!IPK JAN98        read(*,*) njunk                                       
!ipk mar04        WRITE(LIND,6002)krec,nsn 
!ipk mar04 6002    FORMAT( 'NAD =0 illegal connection. krec,nsn',2i5,'Type q to exit') 
!ipk mar04         call symbl                                                     &
!ipk mar04     &   (1.1,3.0,0.20,LIND,0.0,80)                                     
!ipk mar04         ndig=1 
!ipk mar04         CALL GTCHARX(JUNK,NDIG,5.0,7.6) 
!ipk mar04        stop 
        IF(ISWALL .GT. 0) THEN
		  KREC=-1
		  RETURN
		ENDIF
		write(90,*) nae
		write(90,'(5(i7,i6))') (n,mlist(n),n=1,ne)
	  	CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,          &
	    'No active adjacent elements found  '//CHAR(13) &
	  //'Possible network error.'//CHAR(13) &
      //'or erroneous starting element'//CHAR(13) &
      //'Reordering terminated',&
	    'ERROR')
        krec=-1
        return
      endif 
      DO 300 K=1,NAD 
        NEL=ENXT(K) 
        IF(NTST .EQ. 0) GO TO 270 
        IF(NELIM(NEL) .EQ. 1) GO TO 300 
  270   CONTINUE 
        NFD=1 
!                                                                       
!       GET SUMS FOR NEL                                                
!                                                                       
        CALL SUMIT(NEL) 
!                                                                       
!       MSA IS THE AVERAGE PER NODE ADDED                               
!                                                                       
        MSA=MSUM 
!       MSA=9999999                                                     
        IF(NDP .GT. 1) MSA=(MSUM+NDP/2)/NDP 
!                                                                       
!       CHECK IF IT IS LESS                                             
!                                                                       
        IF (MSA.GT.MSAV) GO TO 300 
        IF (MSA.LT.MSAV) GO TO 280 
!                                                                       
!       IF EQUAL TAKE CASE WITH LEAST NODES ADDED                       
!                                                                       
        IF (NDP.GE.NSN) GO TO 300 
  280   KREC=NEL 
        NSN=NDP 
        MSAV=MSA 
  300 END DO 
      IF(NFD .EQ. 0) THEN 
        NTST=0 
        GO TO 260 
      ENDIF 
  310 CONTINUE 
!                                                                       
!     GET INFORMATION AGAIN FOR SELECTED ELEMENT                        
!                                                                       
      CALL SUMIT(KREC) 
!IPK MAY94 ADD A LINE                                                   
      IF(NFWS .GT. NFWSAV) NFWSAV=NFWS 
      IF(MSUM .EQ. 9999999) MSUM=0 
      MTSUM=MTSUM+MSUM 
!ipk feb97 add pseudo double precision                                  
  320 continue 
!      if(mtsum .gt. 100000000) then 
!        mtsum1=mtsum1+1 
!        mtsum=mtsum-100000000 
!        go to 320 
!      endif 
!                                                                       
!     UPDATE LIST OF NODES IN FRONT                                     
!                                                                       
      MPN=MP 
      IF (MP.EQ.0) GO TO 420 
      IF (NDP.EQ.0) GO TO 420 
!                                                                       
!     REMOVE THE DROPPED NODES                                          
!           
!      ict2=ict2+1         
!     write(88,*) ict2,'z',krec,ndp,(ndrop(n),n=1,ndp)                                                   
      DO 400 N=1,NDP 
!                                                                       
!       FIND THE NODE TO BE DROPPED IN LIST                             
!                                                                       
        DO 390 M=1,MP 
          IF (LIST(M).NE.NDROP(N)) GO TO 390 
          LIST(M)=-LIST(M) 
          GO TO 400 
  390   CONTINUE 
  400 END DO 
!                                                                       
!     NOW DROP THEM                                                     
!                                                                       
      MPN=0 
      DO 410 M=1,MP 
        IF (LIST(M).LT.0) GO TO 410 
        MPN=MPN+1 
        LIST(MPN)=LIST(M) 
  410 END DO 
!                                                                       
!     NOW ADD NEWLY GENERATED NODES                                     
!                                                                       
      IF (NNEW.EQ.0) GO TO 435 
  420 DO 430 M=1,NNEW 
!                                                                       
!       FIRST SEE IF LNEW IS IN DROP LIST                               
!                                                                       
        IF(NDP .EQ. 0) GO TO 428 
        DO 425 N=1,NDP 
          IF(LNEW(M) .EQ. NDROP(N)) GO TO 430 
  425   CONTINUE 
  428   CONTINUE 
        MPN=MPN+1 
        LIST(MPN)=LNEW(M) 
        K=LNEW(M) 
        NINC(K)=1 
  430 END DO 
!                                                                       
!     REDUCE COUNT OF ELEMENTS ACQUIRED AT THE NODES OF THE ELEMENT     
!                                                                       
  435 CONTINUE 
      MP=MPN 
!	  ict1=ict1+1
!      write(85,*) ict1,'x',krec,mp,(list(n),n=1,mp)
      DO 440 K=1,8 
        N=NOP(KREC,K) 
        IF (N.EQ.0) GO TO 440 
        NDELM(N)=NDELM(N)-1 
  440 END DO 
      RETURN 
      END                                           
      SUBROUTINE UPFNT(KREC) 
!                                                                       
!     DEFINE NEW INFO ON FRONT                                          
!                                                                       
      USE BLK1MOD
      USE BLK2MOD 
!      INCLUDE 'BLK1.COM' 
!      INCLUDE 'BLK2.COM' 
!                                                                       
!     SET ICON ENTRIES NEGATIVE TO SAY THIS ELEMENT ALREADY ADDED       
!                                                                       
      DO 450 M=1,NCMI 
        K=ICON(KREC,M) 
        IF (K.EQ.0) GO TO 460 
        IF (K.LT.0) GO TO 450 
        DO 430 J=1,NCMI 
          IF (ICON(K,J).NE.KREC) GO TO 430 
          ICON(K,J)=-ICON(K,J) 
          GO TO 450 
  430   CONTINUE 
  450 END DO 
!                                                                       
!     UPDATE LIST OF ELEMENTS STILL IN FRONT                            
!                                                                       
  460 MNAD=0 
!                                                                       
!     FIRST ELIMINATE KREC                                              
!                                                                       
      IF(NAD .EQ. 0) GO TO 510 
      DO 500 K=1,NAD 
        IF (ENXT(K).EQ.KREC) GO TO 500 
        MNAD=MNAD+1 
        ENXT(MNAD)=ENXT(K) 
  500 END DO 
  510 CONTINUE 
      NAD=MNAD 
!                                                                       
!     NOW ADD NEW ELEMENTS                                              
!                                                                       
      DO 520 J=1,NCMI 
        K=ICON(KREC,J) 
        IF (K.LE.0) GO TO 520 
!                                                                       
!       CHECK OF  -K- ALREADY IN LIST                                   
!                                                                       
        DO 515 M=1,NAD 
          IF(K .EQ. ENXT(M)) GO TO 520 
  515   CONTINUE 
        MNAD=MNAD+1 
        ENXT(MNAD)=K 
  520 END DO 
      NAD=MNAD 
      RETURN 
      END                                           
      SUBROUTINE SUMIT(NEL) 
!                                                                       
!     DEVELOP SUMS FOR MAKING ELIMINATION CHOICE                        
!                  
      USE BLK1MOD
      USE BLK2MOD 
      INTEGER*8 MSUMP                                                     
!      INCLUDE 'BLK1.COM' 
!      INCLUDE 'BLK2.COM' 
!                                                                       
!     LOCATE NEW NODES                                                  
!                                                                       
      NDP=0 
      NNEW=0 
      DO 280 K=1,8 
        N=NOP(NEL,K) 
        IF (N.EQ.0) GO TO 280 
!                                                                       
!       TEST WHETHER THIS NODE ALREADY INCORPORATED                     
!                                                                       
        IF (NINC(N).EQ.1) GO TO 260 
        NNEW=NNEW+1 
        LNEW(NNEW)=N 
!                                                                       
!       NOW TEST IF THE NODE IS COMPLETELY FORMED                       
!                                                                       
  260   IF (NDELM(N).GT.1) GO TO 280 
        NDP=NDP+1 
        NDROP(NDP)=N 
  280 END DO 
!                                                                       
!     IMMEDIATELY ON ADDING NEW FRONT SIZE IS                           
!                                                                       
      NFW=MP+NNEW 
!IPK MAY94 ADD A LINE                                                   
      NFWS=NFW 
!                                                                       
!     NOW TAKE OUT ALL WE CAN                                           
!                                                                       
      MSUM=99999999 
!     MSUM=0                                                            
      IF(NDP .EQ. 0) RETURN 
      MSUMP=0 
      DO 300 K=1,NDP 
          MSUMP=MSUMP+NFW**2 
          NFW=NFW-1 
  300 END DO 
      msum=msump 
      if(msum .gt. 99999999) THEN
	        write(90,*) ndp,msum,nfw,nel
	  ENDIF
      RETURN 
      END                                           
      SUBROUTINE CHKOUT(ISWALL) 
!                                                                       
!     CHECK FINAL TOTAL SAVE ORDER IF BETTER                            
!                                                                       
      USE BLK1MOD
      USE BLK2MOD 
!      INCLUDE 'BLK1.COM' 
!      INCLUDE 'BLK2.COM' 
      CHARACTER*80 LIND 
!                                                                       
      DATA ITIME/0/ 
      IF(ITIME .EQ. 0) THEN 
!        call rblue 
!        call clscrn 
!        YT=7.5 
!        WRITE(90,6010) mtsum1,MTSUM,NFWSAV 
!        WRITE(LIND,6010)   mtsum1,MTSUM,NFWSAV 
!        WRITE(90,6010)    MTSUM,NFWSAV 
!        WRITE(LIND,6010)  MTSUM,NFWSAV 
!           call symbl                                                   &
!     &     (0.1,YT,0.20,LIND,0.0,80)                                    
        NSEQ=0
        MTSUMSV(NSEQ)=MTSUM
        NFWSV(NSEQ)=NFWSAV
!      elseif(mtsum1 .gt. mrsum1) then 
!        WRITE(90,6020) mtsum1,MTSUM,NFWSAV 
!        WRITE(LIND,6020) mtsum1,MTSUM,NFWSAV 
!        YT=YT-0.3 
!           call symbl                                                   &
!     &     (0.1,YT,0.20,LIND,0.0,80)                                    
!        RETURN 
!      elseif(mtsum1 .eq. mrsum1) then 
!IPK AUG05      ELSE
      ELSEIF(ISWALL .EQ. 0) THEN
        NSEQ=NSEQ+1
        MTSUMSV(NSEQ)=MTSUM
        NFWSV(NSEQ)=NFWSAV
        if(mtsum .ge. mrsum  .AND. MRSUM .GT. 0) then 
!          WRITE(90,6020) mtsum1,MTSUM,NFWSAV 
!          WRITE(LIND,6020) mtsum1,MTSUM,NFWSAV 
!          WRITE(90,6020)   MTSUM,NFWSAV 
!          WRITE(LIND,6020) MTSUM,NFWSAV 
!          YT=YT-0.3 
!           call symbl                                                   &
!     &     (0.1,YT,0.20,LIND,0.0,80)                                    
          RETURN 
        else 
!          WRITE(90,6020) mtsum1,MTSUM,NFWSAV 
!          WRITE(LIND,6020) mtsum1,MTSUM,NFWSAV 
!          WRITE(90,6020)   MTSUM,NFWSAV 
!          WRITE(LIND,6020) MTSUM,NFWSAV 
!          YT=YT-0.3 
!           call symbl                                                   &
!     &     (0.1,YT,0.20,LIND,0.0,80)                                    
        endif 
!      ELSE 
!        WRITE(90,6020) mtsum1,MTSUM,NFWSAV 
!        WRITE(LIND,6020) mtsum1,MTSUM,NFWSAV 
!        WRITE(90,6020)   MTSUM,NFWSAV 
!        WRITE(LIND,6020) MTSUM,NFWSAV 
!        YT=YT-0.3 
!        call symbl                                                      &
!     &     (0.1,YT,0.20,LIND,0.0,80)                                    
      ELSE
!        NSEQ=NSEQ+1
        if(mtsum .ge. mrsum  .AND. MRSUM .GT. 0) then 
        NSEQ=0
        MTSUMSV(NSEQ)=MTSUM
        NFWSV(NSEQ)=NFWSAV
          RETURN 
        ELSE
        NSEQ=0
        MTSUMSV(NSEQ)=MTSUM
        NFWSV(NSEQ)=NFWSAV
        endif 
      ENDIF 
!      mrsum1=mtsum1 
      MRSUM=MTSUM 
      ITIME=1 
! 6010 FORMAT('ORDERING SUM, ORIGINAL ELEMENT ORDER, MAX FRONT'          &
!     &,I4,I8.8,I7)                                                        
! 6020 FORMAT('ORDERING SUM,           LATEST START POINT, MAX FRONT'          &
!     &,I4,I8.8,I7)                                                        
 6010 FORMAT('ORDERING SUM, ORIGINAL ELEMENT ORDER, MAX FRONT'          &
     &,I12,I7)                                                        
 6020 FORMAT('ORDERING SUM,           LATEST START POINT, MAX FRONT'          &
     &,I12,I7)                                                        
!ipk feb97 end changes                                                  
!                                                                       
!     COPY ORDER                                                        
!                                                                       
      DO 300 N=1,NAE 
        IEM(N)=MLIST(N) 
  300 END DO 
!                                                                       
!     FILL IEM ARRAY                                                    
!                                                                       
      NAEP=NAE+1 
      DO 400 N=1,NE 
        IF(IMAT(N) .EQ. 0) THEN 
          IEM(NAEP)=N 
          NAEP=NAEP+1 
        ENDIF 
  400 END DO 
      RETURN 
      END                                           
      SUBROUTINE KCON(isw1) 
!                                                                       
!     ESTABLISH ELEMENT CONNECTED TO ELEMENT TABLE                      
!                                                                       
      USE BLK1MOD
      USE BLK2MOD 
!      INCLUDE 'BLK1.COM' 
!      INCLUDE 'BLK2.COM' 
!                                                                       
!     INITIALIZE                                                        
!                                                                       
      DO 200 J=1,NCM 
        DO 200 N=1,NP 
  200   NECON(N,J)=0 
      DO 210 J=1,NCMI 
        DO 210 M=1,NE 
  210   ICON(M,J)=0 
      DO 230 N=1,NP 
  230 NDELM(N)=0 
!                                                                       
!     FORM TABLE OF ELEMENTS CONNECTED TO EACH NODE                     
!                                                                       
      DO 300 M=1,NE 
        IF(IMAT(M) .EQ. 0) GO TO 300 
		if(isw1 .eq. 1) then
		  if(imat(m) .eq. 999) go to 300
		endif
        DO 280 K=1,8 
          N=NOP(M,K) 
          IF (N .GT. 0) THEN 
            NDELM(N)=NDELM(N)+1 
            J=NDELM(N) 
            NECON(N,J)=M 
!ipkoct93          ELSE                                                 
!ipkoct93            GO TO 300                                          
          ENDIF 
  280   CONTINUE 
  300 END DO 
!      do n=1,np
!        write(87,'(31i6)') n,(necon(n,j),j=1,ncmi) 
!	  enddo 
!      write(89,*) 'yy'
!      DO N=1,NP
!      WRITE(89,*) 'NDELM',N,NDELM(N)
!	  ENDDO
!                                                                       
!     CONVERT TABLE TO ELEMENT TO ELEMENT CONNECTION                    
!                                                                       
      DO 600 N=1,NP 
!                                                                       
!       PLACE PAIRS OF ENTRIES FOR EACH NODE INTO APPROPRIATE ROWS      
!                                                                       
        NL=NDELM(N)-1 
!                                                                       
!       SKIP OUT WHEN ONE ELEMENT OR LESS NODE                          
!                                                                       
        IF (NL.LE.0) GO TO 600 
        DO 420 J=1,NL 
          M=NECON(N,J) 
!                                                                       
!         PROCESS SECOND ELEMENT IN A GIVEN ROW                         
!                                                                       
          DO 370 K=J+1,NL+1 
            MR=NECON(N,K) 
            MS=M 
!                                                                       
!           PROCESS EACH DIRECTION OF CONNECTION                        
!                                                                       
            DO 360 MX=1,2 
!                                                                       
!             SEARCH IN CASE CONNECTION ALREADY FOUND                   
!                                                                       
              DO 350 L=1,NCMI 
                IF (ICON(MS,L).NE.0) GO TO 345 
                ICON(MS,L)=MR 
                GO TO 355 
  345           IF (ICON(MS,L).EQ.MR) GO TO 355 
  350         CONTINUE 
!                                                                       
!             REVERSE MR-MS FOR SECOND PASS                             
!                                                                       
  355         CONTINUE 
              MS=MR 
              MR=M 
  360       CONTINUE 
!                                                                       
!           END LOOP ON SECOND ELEMENT                                  
!                                                                       
  370     CONTINUE 
!                                                                       
!         END LOOP ON FIRST ELEMENT                                     
!                                                                       
  420   CONTINUE 
!                                                                       
!       END LOOP FOR THIS NODE                                          
!                                                                       
  600 END DO 

!      do n=1,ne
!        write(86,'(31i6)') n,(icon(n,j),j=1,ncmi) 
!	  enddo 



!                                                                       
!     PROCESS TO FIND NUMBER OF ACTIVE ELEMENTS                         
!                                                                       
      NAE=0 
      NTE=NE+1 
      DO 700 M=1,NE 
        IF (IMAT(M) .LT. 1) GO TO 650 
        NAE=NAE+1 
        MLIST(NAE)=M 
        GO TO 700 
  650   NTE=NTE-1 
        MLIST(NTE)=M 
  700 END DO 
      RETURN 
      END                                           

!ipk jan01
      subroutine getnlist(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_DIALOG001)
      ierr=infoerror(1)

      CALL WDialogSelect(IDD_DIALOG001)
      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

!ipk jan04
      subroutine SHOWORD
      use winteracter


      USE BLK1MOD
      USE BLK2MOD 
!      INCLUDE 'BLK1.COM'
!      INCLUDE 'BLK2.COM'

      include 'd.inc'

      INTEGER             :: IERR
      CHARACTER*6 SCOL1(101)
      CHARACTER*18 SCOL2(101)
      CHARACTER*8 SCOL3(101)

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

      TYPE(WIN_MESSAGE) :: MESSAGE


      call wdialogload(IDD_ORDEROUT)
      ierr=infoerror(1)

      CALL WDialogSelect(IDD_ORDEROUT)
      ierr=infoerror(1)
      DO I=0,NSEQ
        WRITE(SCOL1(I+1),'(I4)') I
        WRITE(SCOL2(I+1),'(I16)') MTSUMSV(I)
        WRITE(SCOL3(I+1),'(I8)') NFWSV(I)
      ENDDO

      CALL WGridPutString(IDF_GRID1,1,SCOL1,NSEQ+1)
      CALL WGridPutString(IDF_GRID1,2,SCOL2,NSEQ+1)
      CALL WGridPutString(IDF_GRID1,3,SCOL3,NSEQ+1)

      CALL WDialogShow(-1,-1,0,Modal)
      ierr=infoerror(1)
      
      do
         IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN

 
          return
         endif
      enddo

      RETURN
      END

