!IPK  LAST UPDATE SEP 23 2015  ADD TESTING FOR CHNAGED ELEMENTS/NODES
!     last update Sept 20 1999
!     Last change:  IPK  13 Jan 98   10:05 am                           
!ipk  last update Nov 18 1997                                           
!ipk  last update Oct 24 1996                                           
      SUBROUTINE REFB 
!                                                                       
!  Routines to control refinement of elements                           
!                                                                       
      USE BLK1MOD

      INCLUDE 'BFILES.I90'
!      INCLUDE 'BLK1.COM' 
!                                                                       
      CHARACTER*1 ANS,ANSW(10) 
      DATA ANSW/'f','l','s','t','v','n',' ','m',' ','q'/ 
!                                                                       
!  Draw box around selections                                           
!                                                                       
  100 CONTINUE 
      NHTP=8 
      NMESS=0 
      NBRR=0 
      CALL HEDR 
!                                                                       
!  Get answer                                                           
!                                                                       
!ipk jan98                                                              
  210 continue 
      call wrtbox(idelv) 
      call xyloc(XPT,YPT,ANS,IBOX) 
      IF(IRMAIN .EQ. 1) RETURN 
!ipk jan98  add option for deleting elevation on move                   
      IF(IBOX .EQ. 7  .or.  ANS .eq. 'e') THEN 
        IDELV=MOD(IDELV+1,2) 
        GO TO 210 
      ENDIF 
      IF(ANS .EQ. 'c') THEN 
        if(ibox .eq. 0) go to 210
        ANS=ANSW(IBOX) 
      ENDIF 
!                                                                       
!  Element generation                                                   
!                                                                       
      IF (ANS .EQ. 'f')  THEN 
!                                                                       
!  Refine elements by four                                              
!                                                                       
        IECHG=0 
!IPK MAY03
        ICHG=0
        CALL REFIN(0)
        IRDONE=0
        IF(IRMAIN .EQ. 1) RETURN 
!                                                                       
      ELSEIF (ANS .EQ. 'l')  THEN 
!                                                                       
!  Refine elements by two long                                          
!                                                                       
        IECHG=0 
!IPK MAY03
        ICHG=0
        CALL REFIN(1) 
        IRDONE=0
        IF(IRMAIN .EQ. 1) RETURN 
!                                                                       
      ELSEIF (ANS .EQ. 's')  THEN 
!                                                                       
!  Refine elements by two short                                         
!                                                                       
        IECHG=0 
!IPK MAY03
        ICHG=0
        CALL REFIN(2) 
        IRDONE=0
        IF(IRMAIN .EQ. 1) RETURN 
!                                                                       
!                                                                       
      ELSEIF (ANS .EQ. 't')  THEN 
!                                                                       
!  Refine elements by splitting quads                                   
!                                                                       
        IECHG=0 
!IPK MAY03
        ICHG=0
        CALL REFIN(3) 
        IRDONE=0
        IF(IRMAIN .EQ. 1) RETURN 
!                                                                       
!                                                                       
      ELSEIF (ANS .EQ. 'v')  THEN 
!                                                                       
!  Reverse element diagonals for quads                                  
!                                                                       
        IECHG=0 
!IPK MAY03
        ICHG=0
        CALL REFIN(4) 
        IRDONE=0
        IF(IRMAIN .EQ. 1) RETURN 
!                                                                       
      ELSEIF (ANS .EQ. 'n')  THEN 
!                                                                       
!  Clean up element refinement                                          
!                                                                       
        IECHG=0 
!IPK MAY03
        ICHG=0
        CALL CLENUP(0) 
        IRDONE=0
        IF(IRMAIN .EQ. 1) RETURN 
!                                                                       
      ELSEIF (ANS .EQ. 'm')  THEN 
        IF(IRMAIN .EQ. 1) RETURN 
!
!  simplify layout                                  
!                                                                       
        IECHG=0 
!IPK MAY03
        ICHG=0
        CALL SMFY !  
        IRDONE=0
      ELSEIF (ANS .EQ. 'q') THEN 
        CALL WRTOUT(0) !


        RETURN 
!                                                                       
!  Look again                                                           
!                                                                       
      ENDIF 
      GO TO 100 
      END                                           
!                                                                       
      SUBROUTINE REFIN(ITYPT) 
!                                                                       
!  Routine to refine elements                                           
!                                                                       
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 

      INCLUDE 'TXFRM.COM'
!IPK MAY02       COMMON  /TXFRM/  XS, YS, TXSCAL 
!                                                                       
      DIMENSION NTRAN(9),IELGB(8) 
      CHARACTER*1 IFLAG 
      DIST(N1,N2)=SQRT((CORD(N1,1)-CORD(N2,1))**2                       &
     &                +(CORD(N1,2)-CORD(N2,2))**2)                      
!                           
      ITYP=ITYPT                                            
      IF(NEFL .GT. 0) GO TO 150 
!ipk may94 change so that refine does not change display                
!      DO 2 I=1,9                                                       
!        IPSW(I)=0                                                      
!    2 CONTINUE                                                         
!      IPSW(4)=1                                                        
!      CALL PLOTOT                                                      
!ipk may94 end changes                                                  
    3 CONTINUE 
      NHTP=0 
      NMESS=12 
      NBRR=3 
      CALL HEDR 
!                                                                       
!  Write out                                                            
!                                                                       
      NEFL=0 
    4 CONTINUE 
      IBOX=1 
      CALL PROX(XC,YC,NE,XX,YY,IELEM,IFLAG,IESKP,IBOX) 
      IF(IRMAIN .EQ. 1) RETURN 
!                                                                       
      IF (IFLAG .EQ. 'c')  THEN 
        NEFL=NEFL+1 
        NEFLAG(NEFL)=IELEM 
        CALL FILLEM(IELEM) 
      ELSEIF (IFLAG .EQ. 'U')  THEN 
		NEFLAG(NEFL)=0
	    NEFL=NEFL-1
		CALL PLOTOT(1)
		CALL HEDR
		DO IELEM=1,NEFL
          CALL FILLEM(NEFLAG(IELEM)) 
		ENDDO
!                                                                       
!      ELSEIF(IFLAG .EQ. 'r') THEN                                      
!          CALL PLOTS(0)                                                
!          CALL PLOTOT                                                  
!          GO TO 4                                                      
      ELSEIF(IFLAG .EQ. 'q'  .OR.  IFLAG .EQ. 'e') THEN 
          GO TO 152 
!                                                                       
      ELSE 
!IPK JAN98         WRITE(*,*)  CHAR(7),CHAR(7)                          
      ENDIF 
!                                                                       
      GOTO 4 
!                                                                       
!                                                                       
  150 CONTINUE 
!      IPSWO=IPSW                                                       
!      IPSW=4                                                           
!      CALL PLOTS(0)                                                    
!ipk oct96      DO 151 I=1,9                                            
!ipk oct96        IPSW(I)=0                                             
!ipk oct96  151 CONTINUE                                                
!ipk oct96      IPSW(4)=1                                               
                                                                        
!ipk nov97 add (1)                                                      
      CALL PLOTOT(1) 
!      IPSW=IPSWO                                                       
!                                                                       
!  Define NEF and process elements                                      
!                                                                       
  152 CONTINUE 

      DO N=1,NE
        DO M=1,8
          NOPSV(N,M)=NOP(N,M)
        ENDDO
          IMATSV(N)=IMAT(N)
      ENDDO
      NPUNDO=0
      NEUNDO=0
      NESAV=NE
      NEFSAV=NENTRY
      IF(NENTRY .GT. 0) THEN
        DO N=1,NENTRY
          DO M=1,3
            NEFSV(N,M)=NEF(N,M)
          ENDDO
        ENDDO
      ENDIF
	  ITYPSV=ITYP
      DO 250 NN=1,NEFL 
        ITYP=ITYPSV
        N=NEFLAG(NN) 
        IF(IMAT(N) .GT. 900 .AND. IMAT(N) .LT. 904) GO TO 250
!        IF(IMAT(N) .EQ. 999) ITYP=1
        NCN=NCORN(N) 
!                                                                       
!  Split a one-dimensional element in two                               
!                                                                       
        IF(NCN .EQ. 3) THEN 
          N1=NOP(N,1) 
          N2=NOP(N,2) 
          N3=NOP(N,3) 
          IF(NOP(N,2) .EQ. 0) THEN 
            CALL GETNOD(N2) 
            NPUNDO=NPUNDO+1
            NODDEL(NPUNDO)=N2
          ELSEIF(INEW(N2) .EQ. 1) THEN 
            GO TO 153 
          ENDIF 
          CORD(N2,1)=(CORD(N1,1)+CORD(N3,1))/2. 
          CORD(N2,2)=(CORD(N1,2)+CORD(N3,2))/2. 
		  IF(LOCK(N1) .EQ.  1  .AND.  LOCK(N3) .EQ. 1) LOCK(N2)=1
          XUSR(N2) = CORD(N2,1)*TXSCAL - XS 
          YUSR(N2) = CORD(N2,2)*TXSCAL - YS 
          INEW(N2) = 1 
          INSKP(N2) =0 
  153     CALL GETELM(NEM) 
          NEUNDO=NEUNDO+1
          IELDEL(NEUNDO)=NEM
          NOP(NEM,3)=N3 
          NOP(N,2)=0 
          NOP(N,3)=N2 
          NOP(NEM,1)=N2 
          NOP(NEM,2)=0. 
          NOP(NEM,3)=N3 
          IMAT(NEM)=IMAT(N) 
          IESKP(NEM)=0 
          NCORN(NEM)=3 
!ipk jan98                                                              
          IF(IDELV .EQ. 1) then 
            WD(N2)=-9999. 
            WIDTH(N2)=0. 
            SS1(N2)=0. 
            SS2(N2)=0. 
            WIDS(N2)=0. 
          ELSE 
            WD(N2)=(WD(N1)+WD(N3))/2. 
            WIDTH(N2)=(WIDTH(N1)+WIDTH(N3))/2. 
            SS1(N2)=(SS1(N1)+SS1(N3))/2. 
            SS2(N2)=(SS2(N1)+SS2(N3))/2. 
            WIDS(N2)=(WIDS(N1)+WIDS(N3))/2. 
            IF(ICRIN .EQ. 23) CALL COMPWGT(0)
          ENDIF 
          GO TO 250 
        ENDIF 
!                                                                       
!  Setup for each type of refinement                                    
!
!ipk jan08                                                                       
        IF(ITYP .EQ. 0) THEN 
!                                                                       
!  Full refinement all nodes are eligible                               
!                                                                       
!          IF(imat(n) .eq. 999) then
!            IELGB(2)=2 
!            IELGB(4)=0 
!            IELGB(6)=2 
!            IELGB(8)=0 
!          ELSE
            DO M=2,NCN 
              IELGB(M)=1 
            ENDDO
!		  ENDIF
        ELSEIF(ITYP .EQ. 1  .OR.  ITYP .EQ. 2) THEN 
!                                                                       
!  Setup for long or short side refinement                              
!                                                                       
          IF(ITYP .EQ. 1) THEN 
            DISTLL=0. 
            DISTL=0. 
          ELSE 
            DISTLL=-VOID 
            DISTL=-VOID 
          ENDIF 
!                                                                       
!  Sort out longest or shortest sides                                   
!                                                                       
          DO 165 M=2,NCN,2 
            IELGB(M)=0 
            N1=NOP(N,M-1) 
            N2=MOD(M,NCN)+1 
            N2=NOP(N,N2) 
            DSEP=DIST(N1,N2) 
            IF(ITYP .EQ. 1) THEN 
              IF(DISTLL .LT. DSEP) THEN 
!   Separation greater DISTLL                                           
                IF(DISTLL .GT. 0.) THEN 
!   DISTLL already exists then move it down the line                    
                  DISTL=DISTLL 
                  NDS=NDSS 
                ENDIF 
!   Save separation                                                     
                DISTLL=DSEP 
                NDSS=M 
                GO TO 165 
              ELSEIF(DISTL .LT. DSEP) THEN 
!   2nd longest                                                         
                DISTL=DSEP 
                NDS=M 
              ENDIF 
            ELSE 
              IF(DSEP .LT. DISTLL) THEN 
!   Separation less than DISTLL                                         
                IF(DISTLL .LT. -VDX) THEN 
!   DISTLL already exists then move it up the line                      
                  DISTL=DISTLL 
                  NDS=NDSS 
                ENDIF 
                DISTLL=DSEP 
                NDSS=M 
                GO TO 165 
              ELSEIF(DSEP .LT. DISTL) THEN 
!   2nd shortest                                                        
                DISTL=DSEP 
                NDS=M 
              ENDIF 
            ENDIF 
  165     CONTINUE 
          IELGB(NDSS)=2 
          IELGB(NDS)=2 
        ELSEIF(ITYP .EQ. 3) THEN 
!ipk jan98          IF(NCN .EQ. 8) CALL SPLIT(N)                        
          IF(NCN .GT. 5) CALL SPLIT(N) 
          GO TO 250 
        ELSEIF(ITYP .EQ. 4) THEN 
          NPL=NEFLAG(NN+1) 
          CALL REVERS(N,NPL) 
          GO TO 255 
        ENDIF 
!                                                                       
!  Loop through element sides                                           
!                                                                       
        DO 200 M=2,NCN,2 
          IF(IELGB(M) .EQ. 0) GO TO 200 
          N1=NOP(N,M-1) 
          N3=MOD(M+1,NCN) 
          N3=NOP(N,N3) 
!                                                                       
!  Search table for N1                                                  
!                                                                       
          IF(NENTRY .EQ. 0) GO TO 182 
          DO 180 J=1,NENTRY 
            IF(N1 .EQ. NEF(J,3)  .AND.  N3 .EQ. NEF(J,1)) THEN 
!                                                                       
!  We have found match so use this info                                 
!                                                                       
              NOP(N,M)=NEF(J,2) 
!                                                                       
!  For regular ops remove value in NEF(J,1) so that it seems blank and s
!  otherwise set value negative                                         
              IF(IELGB(M) .EQ. 1) THEN 
                NEF(J,1)=0 
              ELSE 
                NEF(J,1)=-NEF(J,1) 
              ENDIF 
              GO TO 200 
            ENDIF 
  180     CONTINUE 
  182     CONTINUE 
!                                                                       
!  Define a node, enter it, initialize it, and make entry in NEF        
!                           
          IF(IMAT(N) .EQ. 999  .AND.  (M .EQ. 4  .OR.  M .EQ. 8)) GO TO 200
		                                              
          IF(NOP(N,M) .EQ. 0) THEN 
            CALL GETNOD(N2) 
            NPUNDO=NPUNDO+1
            NODDEL(NPUNDO)=N2
            NOP(N,M)=N2 
            CORD(N2,1)=(CORD(N1,1)+CORD(N3,1))/2. 
            CORD(N2,2)=(CORD(N1,2)+CORD(N3,2))/2. 
  		    IF(LOCK(N1) .EQ.  1  .AND.  LOCK(N3) .EQ. 1) LOCK(N2)=1
            XUSR(N2) = CORD(N2,1)*TXSCAL - XS 
            YUSR(N2) = CORD(N2,2)*TXSCAL - YS 
            INEW(N2) = 1 
            INSKP(N2) =0 
          ELSE 
            N2=NOP(N,M) 
            IF(INEW(N2) .NE. 1) THEN 
              CORD(N2,1)=(CORD(N1,1)+CORD(N3,1))/2. 
              CORD(N2,2)=(CORD(N1,2)+CORD(N3,2))/2. 
              XUSR(N2) = CORD(N2,1)*TXSCAL - XS 
              YUSR(N2) = CORD(N2,2)*TXSCAL - YS 
              INEW(N2) = 1 
              INSKP(N2) =0 
            ENDIF 
          ENDIF 
!ipk jan98                                                              
          IF(IDELV .EQ. 1) then 
            WD(N2)=-9999. 
          ELSE 
            WD(N2)=(WD(N1)+WD(N3))/2. 
          ENDIF 
  	 	  IF(M .EQ. 2  .AND.  IMAT(N) .EQ. 999) THEN
            WIDTH(N2)=(WIDTH(N1)+WIDTH(N3))/2. 
            SS1(N2)=(SS1(N1)+SS1(N3))/2. 
            SS2(N2)=(SS2(N1)+SS2(N3))/2. 
            WIDS(N2)=(WIDS(N1)+WIDS(N3))/2. 
          ELSE
            WIDTH(N2)=0. 
            SS1(N2)=0. 
            SS2(N2)=0. 
            WIDS(N2)=0. 
	      ENDIF
          NENTRY=NENTRY+1 
          NEF(NENTRY,1)=N1 
          NEF(NENTRY,2)=N2 
          NEF(NENTRY,3)=N3 
  200   CONTINUE 
        IF(ITYP .GT. 0) GO TO 250 
!                                                                       
!  Copy NOP into temporary NTRAN for processing then delete element     
!                                                                       
        DO 220 K=1,8 
          NTRAN(K)=NOP(N,K) 
          NOP(N,K)=0 
  220   CONTINUE 
        NRMAT=IMAT(N) 
        IMAT(N)=0 
        IESKP(N)=-1 
        NTYP=1 
        NELAST= MIN(NELAST,N) 
        IF(NCN .EQ. 8) THEN
		  IF(NRMAT .EQ. 999) THEN
		    IF(NTRAN(2) .EQ. 0) THEN
              CALL GETNOD(N2) 
              NPUNDO=NPUNDO+1
              NODDEL(NPUNDO)=N2
			  N1=NTRAN(1)
			  N3=NTRAN(3)
              CORD(N2,1)=(CORD(N1,1)+CORD(N3,1))/2.         
              CORD(N2,2)=(CORD(N1,2)+CORD(N3,2))/2.           
              INEW(N2)  = 1 
              IF(LOCK(N1) .EQ.  1  .AND.  LOCK(N3) .EQ. 1) LOCK(N2)=1
			  NTRAN(2)=N2
              WD(N2)=(WD(N1)+WD(N3))/2. 
              WIDTH(N2)=(WIDTH(N1)+WIDTH(N3))/2. 
              SS1(N2)=(SS1(N1)+SS1(N3))/2. 
              SS2(N2)=(SS2(N1)+SS2(N3))/2. 
              WIDS(N2)=(WIDS(N1)+WIDS(N3))/2. 
			ENDIF
			IF(NTRAN(6) .EQ. 0) THEN
              CALL GETNOD(N6) 
              NPUNDO=NPUNDO+1
              NODDEL(NPUNDO)=N6
			  N5=NTRAN(5)
			  N7=NTRAN(7)
              CORD(N6,1)=(CORD(N5,1)+CORD(N7,1))/2.         
              CORD(N6,2)=(CORD(N5,2)+CORD(N7,2))/2.           
              INEW(N6)  = 1
              IF(LOCK(N5) .EQ.  1  .AND.  LOCK(N7) .EQ. 1) LOCK(N6)=1
			  NTRAN(6)=N6 
              WD(N6)=(WD(N5)+WD(N7))/2. 
              WIDTH(N6)=(WIDTH(N5)+WIDTH(N7))/2. 
              SS1(N6)=(SS1(N5)+SS1(N7))/2. 
              SS2(N6)=(SS2(N5)+SS2(N7))/2. 
              WIDS(N6)=(WIDS(N5)+WIDS(N7))/2. 
			ENDIF
            CALL GETELM(NEM) 
            NEUNDO=NEUNDO+1
            IELDEL(NEUNDO)=NEM
            NOP(NEM,1)=NTRAN(1)
			NOP(NEM,3)=NTRAN(2)
			NOP(NEM,5)=NTRAN(6)
  	  	    NOP(NEM,7)=NTRAN(7)
            IMAT(NEM)=999
            IESKP(NEM)=0 
            NCORN(NEM)=8
            CALL GETELM(NEM) 
            NEUNDO=NEUNDO+1
            IELDEL(NEUNDO)=NEM
            NOP(NEM,1)=NTRAN(2)
			NOP(NEM,3)=NTRAN(3)
			NOP(NEM,5)=NTRAN(5)
  	  	    NOP(NEM,7)=NTRAN(6)
            IMAT(NEM)=999
            IESKP(NEM)=0 
            NCORN(NEM)=8
		  ELSE 
            CALL GETNOD(N2) 
            NPUNDO=NPUNDO+1
            NODDEL(NPUNDO)=N2
            CORD(N2,1)=(CORD(NTRAN(1),1)+CORD(NTRAN(3),1)               &
     &                 +CORD(NTRAN(5),1)+CORD(NTRAN(7),1))/4.           
            CORD(N2,2)=(CORD(NTRAN(1),2)+CORD(NTRAN(3),2)               &
     &                 +CORD(NTRAN(5),2)+CORD(NTRAN(7),2))/4.           
            INEW(N2)  = 1 
            IF(LOCK(NTRAN(1)) .EQ.  1  .AND.  LOCK(NTRAN(3)) .EQ. 1  .AND. &
 &			   LOCK(NTRAN(5)) .EQ.  1  .AND.  LOCK(NTRAN(7)) .EQ. 1) LOCK(N2)=1

!ipk jan98                                                              
            IF(IDELV .EQ. 1) then 
              WD(N2)=-9999. 
            ELSE 
              WD(N2)    =(WD(NTRAN(1))+WD(NTRAN(3))                     &
     &                 +WD(NTRAN(5))+WD(NTRAN(7)))/4.                   
            ENDIF 
            WIDTH(N2)=0. 
            SS1(N2)=0. 
            SS2(N2)=0. 
            WIDS(N2)=0. 
            XUSR(N2) = CORD(N2,1)*TXSCAL - XS 
            YUSR(N2) = CORD(N2,2)*TXSCAL - YS 
            NTRAN(9)=N2 
            INSKP(N2)=0 
            CALL RGEN(NTRAN,NTYP,NRMAT) 
		  ENDIF
        ELSE 
          CALL TGEN(NTRAN,NTYP,NRMAT) 
        ENDIF 
        IF(MOD(NN,20) .EQ. 0) THEN 
!                                                                       
!  Compress NEF for later use                                           
!                                                                       
          NCT=0 
          DO 245 N=1,NENTRY 
            IF(NEF(N,1) .NE. 0) THEN 
              NCT=NCT+1 
              NEF(NCT,1)=NEF(N,1) 
              NEF(NCT,2)=NEF(N,2) 
              NEF(NCT,3)=NEF(N,3) 
            ENDIF 
  245     CONTINUE 
          NENTRY=NCT 
        ENDIF 
  250 END DO 
  255 CONTINUE 
      IF(ITYP .GT. 2) THEN 
!ipk nov97 add (1)                                                      
        call plotot(1) 
        NEFL=0 
        RETURN 
      ENDIF 
!                                                                       
!  Process the ITYP = 1 or 2 situation                                  
!                                                                       
      IF(ITYP .GT. 0) THEN 
        CALL CLENUP(ITYP) 
      ENDIF 
!                                                                       
!  Search for left over entries NEF                                     
!                                                                       
      DO 600 I=1,NENTRY 
        DO 500 N=1,NE 
          IF(IMAT(N) .EQ. 0) GO TO 500 
          NCN=NCORN(N) 

!ipk sep99 add test for line element

          if(ncn .eq. 3) then
            if(nef(i,2) .eq. nop(n,2)) go to 600
              go to 500
          endif
!                                                                       
!  Loop on sides                                                        
!
          DO 400 K=2,NCN,2 
            IF(NOP(N,K-1) .EQ. NEF(I,3)) THEN 
              KP=MOD(K+1,NCN) 
              IF(NOP(N,KP) .EQ. ABS(NEF(I,1))) THEN 
!                                                                       
!  We have a match, quit search for this entry                          
!                                                                       
                GO TO 600 
              ENDIF 
            ENDIF 
  400     CONTINUE 
  500   CONTINUE 
!                                                                       
!  No match this must be a boundary eliminate NEF value                 
!                                                                       
        NEF(I,1)=0 
        NEF(I,3)=0 
  600 END DO 
!                                                                       
!  Now compress remaining NEF for later use                             
!                                                                       
      NCT=0 
      DO 700 N=1,NENTRY 
        IF(NEF(N,1) .GT. 0) THEN 
          NCT=NCT+1 
          NEF(NCT,1)=NEF(N,1) 
          NEF(NCT,2)=NEF(N,2) 
          NEF(NCT,3)=NEF(N,3) 
        ENDIF 
  700 END DO 
      NENTRY=NCT 
      NEFL=0 
      RETURN 
      END                                           
!                                                                       
      SUBROUTINE CLENUP(ITYP) 
!                                                                       
!  Clean up transitions on the boundary of the refined area             
!                                                                       
!                                                                       
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 

      INCLUDE 'TXFRM.COM'
!IPK MAY02       COMMON  /TXFRM/  XS, YS, TXSCAL 
!                                                                       
      DIMENSION NTEMP(9),NTRAN(9),NSWT(8) 
!                                                                       
!  First loop through elements looking for transitions                  
!                                                                       
      IF(ITYP .EQ. 0) THEN 
        NEO=NE 
      ELSE 
        NEO=NEFL 
      ENDIF 
!	  DO KN=1,NEO
!	  WRITE(234,*) KN,NEFLAG(KN),NEF(KN,1),NEF(KN,2),NEF(KN,3)
!	  ENDDO
      DO 500 KN=1,NEO 
        IF(ITYP .EQ. 0) THEN 
          N=KN 
          IF(IMAT(N) .EQ. 0) GO TO 500 
        ELSE 
          N=NEFLAG(KN) 
        ENDIF 
        NCN=NCORN(N) 

!ipk sep99 add test for line element

        if(ncn .eq. 3) then
          do i=1,nentry
            if(nop(n,2) .eq. nef(i,2)) then
              CALL GETELM(NEM) 
              NEUNDO=NEUNDO+1
              IELDEL(NEUNDO)=NEM
              nop(nem,1)=nef(I,2)
              nop(nem,3)=nef(I,3)
              imat(nem)=imat(n)
              ncorn(nem)=3
              IESKP(NEM)=0 
              IERC=0 
              CALL PLTELM(NEM,IERC) 
              nop(n,2)=0
              nop(n,3)=nef(I,2)
              go to 500
            endif
          enddo
          go to 500
        endif
!                                                                       
!  Loop on sides                                                        
!                                                                       
        IFND=0 
        NSWT(8)=0 
        DO 400 K=2,NCN,2 
!                                                                       
!  Search for left over entry in NEF                                    
!                                                                       
          DO 350 I=1,NENTRY 
            IF(NOP(N,K-1) .EQ. NEF(I,3)) THEN 
              KP=MOD(K+1,NCN) 
              IF(NOP(N,KP) .EQ. ABS(NEF(I,1))) THEN 
!                                                                       
!  We have a match, start building TEMP                                 
!                                                                       
                NTEMP(K-1)=NEF(I,3) 
                NTEMP(K)=NEF(I,2) 
                NSWT(K)=1 
                IFND=1 
                GO TO 400 
              ENDIF 
            ENDIF 
            IF(ITYP .GT. 0) THEN 
              IF(NOP(N,K-1) .EQ. ABS(NEF(I,1))) THEN 
                KP=MOD(K+1,NCN) 
                IF(NOP(N,KP) .EQ. NEF(I,3)) THEN 
!                                                                       
!  We have a match, start building TEMP                                 
!                                                                       
                  NTEMP(K-1)=ABS(NEF(I,1)) 
                  NTEMP(K)=NEF(I,2) 
                  NSWT(K)=1 
                  IFND=1 
                  GO TO 400 
                ENDIF 
              ENDIF 
            ENDIF 
  350     CONTINUE 
!                                                                       
!  No match copy old values                                             
!                                                                       
          NTEMP(K-1)=NOP(N,K-1) 
          NTEMP(K)=NOP(N,K) 
          NSWT(K)=0 
  400   CONTINUE 
        IF(IFND .EQ. 0) GO TO 500 
!                                                                       
!  Now test for match                                                   
!                                                                       
        NTOT=NSWT(2)+NSWT(4)+NSWT(6)+NSWT(8) 
        IF(NTOT .EQ. 0) GO TO 500 
!                                                                       
!  Delete element                                                       
!                                                                       
        DO 420 K=1,8 
          NOP(N,K)=0 
  420   CONTINUE 
        NRMAT=IMAT(N) 
        IMAT(N)=0 
        NELAST=MIN(NELAST,N) 
!                                                                       
!  Work with triangles first                                            
!                                                                       
        IF(NCN .EQ. 6) THEN 
!                                                                       
!  Determine transition type and prepare to rotate connections          
!                                                                       
          IF(NTOT .EQ. 1) THEN 
            NTYP=3 
            IF(NSWT(2) .EQ. 1) THEN 
              ISHIFT=0 
            ELSEIF(NSWT(4) .EQ. 1) THEN 
              ISHIFT=2 
            ELSEIF(NSWT(6) .EQ. 1) THEN 
              ISHIFT=4 
            ENDIF 
          ELSEIF(NTOT .EQ. 2) THEN 
            NTYP=2 
            IF(NSWT(2) .EQ. 0) THEN 
              ISHIFT=2 
            ELSEIF(NSWT(4) .EQ. 0) THEN 
              ISHIFT=4 
            ELSEIF(NSWT(6) .EQ. 0) THEN 
              ISHIFT=0 
            ENDIF 
          ELSE 
            NTYP=1 
            ISHIFT=0 
          ENDIF 
!                                                                       
!  Now rotate so that first mid node is refined                         
!                                                                       
          DO 430 K=1,NCN 
            KS=MOD(K+ISHIFT,NCN) 
            IF(KS .EQ. 0) KS=NCN 
            NTRAN(K)=NTEMP(KS) 
  430     CONTINUE 
!                                                                       
!  Now generate transition refined elements                             
!                                                                       
          CALL TGEN(NTRAN,NTYP,NRMAT) 
!                                                                       
!  Now work on quadrilateral elements                                   
!                                                                       
        ELSE 
!                                                                       
!  Determine transition type and prepare to rotate connections          
!                                                                       
          IF(NTOT .EQ. 1) THEN 
            NTYP=2 
            IF(NSWT(2) .EQ. 1) THEN 
              ISHIFT=0 
            ELSEIF(NSWT(4) .EQ. 1) THEN 
              ISHIFT=2 
            ELSEIF(NSWT(6) .EQ. 1) THEN 
              ISHIFT=4 
            ELSEIF(NSWT(8) .EQ. 1) THEN 
              ISHIFT=6 
            ENDIF 
          ELSEIF(NTOT .EQ. 2) THEN 
            IF(NSWT(2) .EQ. 1) THEN 
              IF(NSWT(4) .EQ. 1) THEN 
                NTYP=3 
                ISHIFT=0 
              ELSEIF(NSWT(6) .EQ. 1) THEN 
                NTYP=4 
                ISHIFT=0 
              ELSE 
                NTYP=3 
                ISHIFT=6 
              ENDIF 
            ELSEIF(NSWT(4) .EQ. 1) THEN 
              IF(NSWT(6) .EQ. 1) THEN 
                NTYP=3 
                ISHIFT=2 
              ELSEIF(NSWT(8) .EQ. 1) THEN 
                NTYP=4 
                ISHIFT=2 
              ENDIF 
            ELSE 
              NTYP=3 
              ISHIFT=4 
            ENDIF 
          ELSEIF(NTOT .EQ. 3) THEN 
            NTYP=5 
            IF(NSWT(2) .EQ. 0) THEN 
              ISHIFT=2 
            ELSEIF(NSWT(4) .EQ. 0) THEN 
              ISHIFT=4 
            ELSEIF(NSWT(6) .EQ. 0) THEN 
              ISHIFT=6 
            ELSEIF(NSWT(8) .EQ. 0) THEN 
              ISHIFT=0 
            ENDIF 
          ELSE 
            NTYP=1 
            ISHIFT=0 
          ENDIF 
!                                                                       
!  Now rotate so that first mid node is refined                         
!                                                                       
          DO 450 K=1,NCN 
            KS=MOD(K+ISHIFT,NCN) 
            IF(KS .EQ. 0) KS=NCN 
            NTRAN(K)=NTEMP(KS) 
  450     CONTINUE 
!                                                                       
          IF(NTYP .EQ. 1  .OR.  NTYP .EQ. 5) THEN 
!                                                                       
!  If appropriate  define a new node at the centroid                    
!                                                                       
            CALL GETNOD(N2) 
            NPUNDO=NPUNDO+1
            NODDEL(NPUNDO)=N2
            CORD(N2,1)=(CORD(NTEMP(1),1)+CORD(NTEMP(3),1)               &
     &                 +CORD(NTEMP(5),1)+CORD(NTEMP(7),1))/4.           
            CORD(N2,2)=(CORD(NTEMP(1),2)+CORD(NTEMP(3),2)               &
     &                 +CORD(NTEMP(5),2)+CORD(NTEMP(7),2))/4.           
            IF(LOCK(NTEMP(1)) .EQ.  1  .AND.  LOCK(NTEMP(3)) .EQ. 1  .AND. &
 &			   LOCK(NTEMP(5)) .EQ.  1  .AND.  LOCK(NTEMP(7)) .EQ. 1) LOCK(N2)=1
            INEW(N2)  = 1 
!ipk jan98                                                              
            IF(IDELV .EQ. 1) then 
              WD(N2)=-9999. 
            ELSE 
              WD(N2)=    (WD(NTEMP(1))+WD(NTEMP(3))                     &
     &                 +WD(NTEMP(5))+WD(NTEMP(7)))/4.                   
            ENDIF 
            WIDTH(N2)=0. 
            SS1(N2)=0. 
            SS2(N2)=0. 
            WIDS(N2)=0. 
            XUSR(N2) = CORD(N2,1)*TXSCAL - XS 
            YUSR(N2) = CORD(N2,2)*TXSCAL - YS 
            NTRAN(9)=N2 
            INSKP(N2)=0 
!                                                                       
!  Now generate transition refined elements                             
!                                                                       
          ENDIF 
          CALL RGEN(NTRAN,NTYP,NRMAT) 
        ENDIF 
  500 END DO 
      IF(ITYP .EQ. 0) THEN 
        NENTRY=0 
      ELSE 
        DO 600 I=1,NENTRY 
          IF(NEF(I,1) .LT. 0) NEF(I,1)=0 
  600   CONTINUE 
      ENDIF 
      RETURN 
      END                                           
!                                                                       
      SUBROUTINE RGEN(NTRAN,NTYP,NRMAT) 
!                                                                       
!  Routine to refine quadrilateral elements                             
!                                                                       
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 
!                                                                       
!  IRGEN contains pointers to the various connections                   
!                                                                       
      INTEGER*2 IRGEN 
      DIMENSION NTRAN(9),IRGEN(8,5,5) 
!                                                                       
!      DATA IRGEN /1,0,2,0,9,0,8,0,3,0,4,0,9,0,2,0,5,0,6,0,9,0,4,0,      &
!     &            7,0,8,0,9,0,6,0,8*0,                                  &
      DATA IRGEN /1,0,2,0,9,0,8,0,2,0,3,0,4,0,9,0,9,0,4,0,5,0,6,0,      &
     &            8,0,9,0,6,0,7,0,8*0,                                  &
     &            1,0,2,0,7,8,0,0,3,4,5,0,2,0,0,0,5,6,7,0,2,0,0,0,16*0, &
     &            1,0,2,0,7,8,0,0,3,0,4,0,2,0,0,0,5,6,7,0,4,0,0,0,      &
     &            7,0,2,0,4,0,0,0,8*0,                                  &
     &            1,0,2,0,6,0,7,8,2,0,3,4,5,0,6,0,24*0,                 &
     &            1,0,2,0,9,0,0,0,3,0,4,0,9,0,2,0,5,0,6,0,9,0,4,0,      &
     &            7,0,9,0,6,0,0,0,7,8,1,0,9,0,0,0/                      
!                                                                       
      DO 300 N=1,5 
        IF(IRGEN(1,N,NTYP) .EQ. 0) GO TO 310 
        CALL GETELM(NEM) 
          NEUNDO=NEUNDO+1
          IELDEL(NEUNDO)=NEM
        DO 250 K=1,7,2 
          INN=IRGEN(K,N,NTYP) 
          INP=IRGEN(K+1,N,NTYP) 
          IF(INN .GT. 0) INN=NTRAN(INN) 
          IF(INP .GT. 0) INP=NTRAN(INP) 
          NOP(NEM,K)=INN 
          NOP(NEM,K+1)=INP 
  250   CONTINUE 
        IF(NOP(NEM,7) .EQ. 0) THEN 
          NCORN(NEM)=6 
        ELSE 
          NCORN(NEM)=8 
        ENDIF 
        IMAT(NEM)=NRMAT 
        IESKP(NEM)=0 
!IPK JAN98                                                              
        IERC=0 
        CALL PLTELM(NEM,IERC) 
  300 END DO 
  310 CONTINUE 
      RETURN 
      END                                           
!                                                                       
      SUBROUTINE TGEN(NTRAN,NTYP,NRMAT) 
!                                                                       
!  Routine to refine triangular elements                                
!                                                                       
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 
!                                                                       
!  ITGEN contains pointers to the various connections                   
!                                                                       
      INTEGER*2 ITGEN 
      DIMENSION NTRAN(9),ITGEN(8,4,3) 
!                                                                       
      DATA ITGEN /1,0,2,0,6,0,0,0,3,0,4,0,2,0,0,0,                      &
     &            5,0,6,0,4,0,0,0,2,0,4,0,6,0,0,0,                      &
     &            1,0,2,0,4,0,5,6,2,0,3,0,4,0,0,0,16*0,                 &
     &            1,0,2,0,5,6,0,0,3,4,5,0,2,0,0,0,16*0/                 
!                                                                       
      DO 300 N=1,4 
        IF(ITGEN(1,N,NTYP) .EQ. 0) GO TO 310 
          CALL GETELM(NEM) 
          NEUNDO=NEUNDO+1
          IELDEL(NEUNDO)=NEM
        DO 250 K=1,7,2 
          INN=ITGEN(K,N,NTYP) 
          INP=ITGEN(K+1,N,NTYP) 
          IF(INN .GT. 0) INN=NTRAN(INN) 
          IF(INP .GT. 0) INP=NTRAN(INP) 
          NOP(NEM,K)=INN 
          NOP(NEM,K+1)=INP 
  250   CONTINUE 
        IF(NOP(NEM,7) .EQ. 0) THEN 
          NCORN(NEM)=6 
        ELSE 
          NCORN(NEM)=8 
        ENDIF 
        IMAT(NEM)=NRMAT 
        IESKP(NEM)=0 
        IERC=0 
        CALL PLTELM(NEM,IERC) 
  300 END DO 
  310 CONTINUE 
      RETURN 
      END                                           
      SUBROUTINE SPLIT(N) 
!                                                                       
!  Routine to split quadrilateral  elements in two                      
!                                                                       
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 

      INCLUDE 'TXFRM.COM'
!IPK MAY02       COMMON  /TXFRM/  XS, YS, TXSCAL 
!                                                                       
      DIST(N1,N2)=SQRT((CORD(N1,1)-CORD(N2,1))**2                       &
     &                +(CORD(N1,2)-CORD(N2,2))**2)                      
      if(nop(n,7) .eq. 0) go to 100 
!                                                                       
!  Loop around element looking for longest diagonal                     
!                                                                       
      L1=NOP(N,1) 
      L5=NOP(N,5) 
      D15=DIST(L1,L5) 
      L3=NOP(N,3) 
      L7=NOP(N,7) 
      D37=DIST(L3,L7) 
      CALL GETELM(NEM) 
          NEUNDO=NEUNDO+1
          IELDEL(NEUNDO)=NEM
      IF(D15 .LT. D37) THEN 
        NOP(NEM,1)=L1 
        NOP(NEM,2)=0 
        NOP(NEM,3)=L5 
        NOP(NEM,4)=NOP(N,6) 
        NOP(NEM,5)=L7 
        NOP(NEM,6)=NOP(N,8) 
        IMAT(NEM)=IMAT(N) 
        IESKP(NEM)=0 
        NCORN(NEM)=6 
        NOP(N,6)=0 
        NOP(N,7)=0 
        NOP(N,8)=0 
        NCORN(N)=6 
      ELSE 
        NOP(NEM,1)=L3 
        NOP(NEM,2)=NOP(N,4) 
        NOP(NEM,3)=L5 
        NOP(NEM,4)=NOP(N,6) 
        NOP(NEM,5)=L7 
        NOP(NEM,6)=0 
        IMAT(NEM)=IMAT(N) 
        IESKP(NEM)=0 
        NCORN(NEM)=6 
        NOP(N,4)=0 
        NOP(N,5)=L7 
        NOP(N,6)=NOP(N,8) 
        NOP(N,7)=0 
        NOP(N,8)=0 
        NCORN(N)=6 
      ENDIF 
                                                                        
!      call plotot                                                      
      RETURN 
  100 continue 
!                                                                       
!    triangle split                                                     
!                                                                       
      l1=nop(n,1) 
      l3=nop(n,3) 
      l5=nop(n,5) 
      d13=dist(l1,l3) 
      d35=dist(l3,l5) 
      d51=dist(l5,l1) 
      CALL GETELM(NEM) 
          NEUNDO=NEUNDO+1
          IELDEL(NEUNDO)=NEM
      IMAT(NEM)=IMAT(N) 
      IESKP(NEM)=0 
      NCORN(NEM)=6 
      write(90,*) l1,l3,l5,d13,d35,d51,nentry 
      if(d13 .gt. d35) then 
        if(d13 .gt. d51) then 
!                                                                       
!  Search table for L1                                                  
!                                                                       
          IF(NENTRY .NE. 0) THEN 
            DO  J=1,NENTRY 
              IF(L1 .EQ. NEF(J,3)  .AND.  L3 .EQ. NEF(J,1)) THEN 
!                                                                       
!  We have found match so use this info                                 
!                                                                       
                NOP(N,2)=NEF(J,2) 
                NEWND=NEF(J,2) 
!                                                                       
!  For regular ops remove value in NEF(J,1) so that it seems blank and s
!  otherwise set value negative                                         
!               IF(IELGB(2) .EQ. 1) THEN                                
!                 NEF(J,1)=0                                            
!               ELSE                                                    
                  NEF(J,1)=-NEF(J,1) 
!               ENDIF                                                   
                GO TO 200 
              ENDIF 
            ENDDO 
          ENDIF 
!                                                                       
!  Define a node, enter it, initialize it, and make entry in NEF        
!                                                                       
          IF(NOP(N,2) .EQ. 0) THEN 
            CALL GETNOD(NEWND) 
            NPUNDO=NPUNDO+1
            NODDEL(NPUNDO)=NEWND
            NOP(N,2)=NEWND 
            CORD(NEWND,1)=(CORD(L1,1)+CORD(L3,1))/2. 
            CORD(NEWND,2)=(CORD(L1,2)+CORD(L3,2))/2. 
            XUSR(NEWND) = CORD(NEWND,1)*TXSCAL - XS 
            YUSR(NEWND) = CORD(NEWND,2)*TXSCAL - YS 
            INEW(NEWND) = 1 
            IF(LOCK(L1) .EQ.  1  .AND.  LOCK(L3) .EQ. 1 ) LOCK(NEWND)=1

            INSKP(NEWND) =0 
          ELSE 
            NEWND=NOP(N,2) 
            IF(INEW(NEWND) .NE. 1) THEN 
              CORD(NEWND,1)=(CORD(L1,1)+CORD(L3,1))/2. 
              CORD(NEWND,2)=(CORD(L1,2)+CORD(L3,2))/2. 
              XUSR(NEWND) = CORD(NEWND,1)*TXSCAL - XS 
              YUSR(NEWND) = CORD(NEWND,2)*TXSCAL - YS 
              INEW(NEWND) = 1 
              INSKP(NEWND) =0 
            ENDIF 
          ENDIF 
!ipk jan98                                                              
          IF(IDELV .EQ. 1) then 
            WD(NEWND)=-9999. 
          ELSE 
            WD(NEWND)=(WD(L1)+WD(L3))/2. 
          ENDIF 
          WIDTH(NEWND)=0. 
          SS1(NEWND)=0. 
          SS2(NEWND)=0. 
          WIDS(NEWND)=0. 
          NENTRY=NENTRY+1 
          NEF(NENTRY,1)=L1 
          NEF(NENTRY,2)=NEWND 
          NEF(NENTRY,3)=L3 
  200     CONTINUE 
                                                                        
          nop(nem,1)=nop(n,1) 
          nop(nem,3)=newnd 
          nop(nem,5)=nop(n,5) 
          nop(nem,6)=nop(n,6) 
          nop(n,1)=newnd 
          nop(n,2)=0 
          nop(n,6)=0 
        else 
                                                                        
!                                                                       
!  Search table for L5                                                  
!                                                                       
          IF(NENTRY .NE. 0) THEN 
            DO  J=1,NENTRY 
              IF(L5 .EQ. NEF(J,3)  .AND.  L1 .EQ. NEF(J,1)) THEN 
!                                                                       
!  We have found match so use this info                                 
!                                                                       
                NOP(N,2)=NEF(J,2) 
                NEWND=NEF(J,2) 
!                                                                       
!  For regular ops remove value in NEF(J,1) so that it seems blank and s
!  otherwise set value negative                                         
!               IF(IELGB(2) .EQ. 1) THEN                                
!                 NEF(J,1)=0                                            
!               ELSE                                                    
                  NEF(J,1)=-NEF(J,1) 
!               ENDIF                                                   
                GO TO 300 
              ENDIF 
            ENDDO 
          ENDIF 
!                                                                       
!  Define a node, enter it, initialize it, and make entry in NEF        
!                                                                       
          IF(NOP(N,6) .EQ. 0) THEN 
            CALL GETNOD(NEWND) 
            NPUNDO=NPUNDO+1
            NODDEL(NPUNDO)=NEWND
            NOP(N,6)=NEWND 
            CORD(NEWND,1)=(CORD(L5,1)+CORD(L1,1))/2. 
            CORD(NEWND,2)=(CORD(L5,2)+CORD(L1,2))/2. 
            XUSR(NEWND) = CORD(NEWND,1)*TXSCAL - XS 
            YUSR(NEWND) = CORD(NEWND,2)*TXSCAL - YS 
            INEW(NEWND) = 1 
            IF(LOCK(L1) .EQ.  1  .AND.  LOCK(L5) .EQ. 1) LOCK(NEWND)=1
            INSKP(NEWND) =0 
          ELSE 
            NEWND=NOP(N,6) 
            IF(INEW(NEWND) .NE. 1) THEN 
              CORD(NEWND,1)=(CORD(L5,1)+CORD(L1,1))/2. 
              CORD(NEWND,2)=(CORD(L5,2)+CORD(L1,2))/2. 
              XUSR(NEWND) = CORD(NEWND,1)*TXSCAL - XS 
              YUSR(NEWND) = CORD(NEWND,2)*TXSCAL - YS 
              INEW(NEWND) = 1 
              INSKP(NEWND) =0 
            ENDIF 
          ENDIF 
!ipk jan98                                                              
          IF(IDELV .EQ. 1) then 
            WD(NEWND)=-9999. 
          ELSE 
            WD(NEWND)=(WD(L5)+WD(L1))/2. 
          ENDIF 
          WIDTH(NEWND)=0. 
          SS1(NEWND)=0. 
          SS2(NEWND)=0. 
          WIDS(NEWND)=0. 
          NENTRY=NENTRY+1 
          NEF(NENTRY,1)=L5 
          NEF(NENTRY,2)=NEWND 
          NEF(NENTRY,3)=L1 
  300     CONTINUE 
                                                                        
          nop(nem,1)=nop(n,1) 
          nop(nem,2)=nop(n,2) 
          nop(nem,3)=nop(n,3) 
          nop(nem,5)=newnd 
          nop(n,1)=newnd 
          nop(n,2)=0 
          nop(n,6)=0 
        endif 
      elseif(d35 .gt. d51) then 
                                                                        
!                                                                       
!  Search table for L3                                                  
!                                                                       
        IF(NENTRY .NE. 0) THEN 
          DO  J=1,NENTRY 
            IF(L3 .EQ. NEF(J,3)  .AND.  L5 .EQ. NEF(J,1)) THEN 
!                                                                       
!  We have found match so use this info                                 
!                                                                       
              NOP(N,4)=NEF(J,2) 
              NEWND=NEF(J,2) 
!                                                                       
!  For regular ops remove value in NEF(J,1) so that it seems blank and s
!  otherwise set value negative                                         
!               IF(IELGB(2) .EQ. 1) THEN                                
!                 NEF(J,1)=0                                            
!               ELSE                                                    
              NEF(J,1)=-NEF(J,1) 
!               ENDIF                                                   
              GO TO 400 
            ENDIF 
          ENDDO 
        ENDIF 
!                                                                       
!  Define a node, enter it, initialize it, and make entry in NEF        
!                                                                       
        IF(NOP(N,4) .EQ. 0) THEN 
          CALL GETNOD(NEWND) 
            NPUNDO=NPUNDO+1
            NODDEL(NPUNDO)=NEWND
          NOP(N,4)=NEWND 
          CORD(NEWND,1)=(CORD(L3,1)+CORD(L5,1))/2. 
          CORD(NEWND,2)=(CORD(L3,2)+CORD(L5,2))/2. 
          XUSR(NEWND) = CORD(NEWND,1)*TXSCAL - XS 
          YUSR(NEWND) = CORD(NEWND,2)*TXSCAL - YS 
          INEW(NEWND) = 1 
          IF(LOCK(L3) .EQ.  1  .AND.  LOCK(L5) .EQ. 1) LOCK(NEWND)=1
          INSKP(NEWND) =0 
        ELSE 
          NEWND=NOP(N,4) 
          IF(INEW(NEWND) .NE. 1) THEN 
            CORD(NEWND,1)=(CORD(L3,1)+CORD(L5,1))/2. 
            CORD(NEWND,2)=(CORD(L3,2)+CORD(L5,2))/2. 
            XUSR(NEWND) = CORD(NEWND,1)*TXSCAL - XS 
            YUSR(NEWND) = CORD(NEWND,2)*TXSCAL - YS 
            INEW(NEWND) = 1 
            INSKP(NEWND) =0 
          ENDIF 
        ENDIF 
!ipk jan98                                                              
         IF(IDELV .EQ. 1) then 
          WD(NEWND)=-9999. 
        ELSE 
          WD(NEWND)=(WD(L3)+WD(L5))/2. 
        ENDIF 
        WIDTH(NEWND)=0. 
        SS1(NEWND)=0. 
        SS2(NEWND)=0. 
        WIDS(NEWND)=0. 
        NENTRY=NENTRY+1 
        NEF(NENTRY,1)=L3 
        NEF(NENTRY,2)=NEWND 
        NEF(NENTRY,3)=L5 
  400   CONTINUE 
                                                                        
        nop(nem,1)=nop(n,1) 
        nop(nem,2)=nop(n,2) 
        nop(nem,3)=nop(n,3) 
        nop(nem,5)=newnd 
        nop(n,3)=newnd 
        nop(n,2)=0 
        nop(n,4)=0 
      else 
                                                                        
!                                                                       
!  Search table for L5                                                  
!                                                                       
        IF(NENTRY .NE. 0) THEN 
          DO  J=1,NENTRY 
            IF(L5 .EQ. NEF(J,3)  .AND.  L1 .EQ. NEF(J,1)) THEN 
!                                                                       
!  We have found match so use this info                                 
!                                                                       
              NOP(N,2)=NEF(J,2) 
              NEWND=NEF(J,2) 
!                                                                       
!  For regular ops remove value in NEF(J,1) so that it seems blank and s
!  otherwise set value negative                                         
!               IF(IELGB(2) .EQ. 1) THEN                                
!                 NEF(J,1)=0                                            
!               ELSE                                                    
              NEF(J,1)=-NEF(J,1) 
!               ENDIF                                                   
              GO TO 500 
            ENDIF 
          ENDDO 
        ENDIF 
!                                                                       
!  Define a node, enter it, initialize it, and make entry in NEF        
!                                                                       
        IF(NOP(N,6) .EQ. 0) THEN 
          CALL GETNOD(NEWND) 
            NPUNDO=NPUNDO+1
            NODDEL(NPUNDO)=NEWND
          NOP(N,6)=NEWND 
          CORD(NEWND,1)=(CORD(L5,1)+CORD(L1,1))/2. 
          CORD(NEWND,2)=(CORD(L5,2)+CORD(L1,2))/2. 
          XUSR(NEWND) = CORD(NEWND,1)*TXSCAL - XS 
          YUSR(NEWND) = CORD(NEWND,2)*TXSCAL - YS 
          INEW(NEWND) = 1 
          IF(LOCK(L1) .EQ.  1  .AND.  LOCK(L5) .EQ. 1) LOCK(NEWND)=1
          INSKP(NEWND) =0 
        ELSE 
          NEWND=NOP(N,6) 
          IF(INEW(NEWND) .NE. 1) THEN 
            CORD(NEWND,1)=(CORD(L5,1)+CORD(L1,1))/2. 
            CORD(NEWND,2)=(CORD(L5,2)+CORD(L1,2))/2. 
            XUSR(NEWND) = CORD(NEWND,1)*TXSCAL - XS 
            YUSR(NEWND) = CORD(NEWND,2)*TXSCAL - YS 
            INEW(NEWND) = 1 
            INSKP(NEWND) =0 
          ENDIF 
        ENDIF 
!ipk jan98                                                              
        IF(IDELV .EQ. 1) then 
          WD(NEWND)=-9999. 
        ELSE 
          WD(NEWND)=(WD(L5)+WD(L1))/2. 
        ENDIF 
        WIDTH(NEWND)=0. 
        SS1(NEWND)=0. 
        SS2(NEWND)=0. 
        WIDS(NEWND)=0. 
        NENTRY=NENTRY+1 
        NEF(NENTRY,1)=L5 
        NEF(NENTRY,2)=NEWND 
        NEF(NENTRY,3)=L1 
  500   CONTINUE 
                                                                        
        nop(nem,1)=nop(n,1) 
        nop(nem,2)=nop(n,2) 
        nop(nem,3)=nop(n,3) 
        nop(nem,5)=newnd 
        nop(n,1)=newnd 
        nop(n,2)=0 
        nop(n,6)=0 
      endif 
      return 
      END                                           
      SUBROUTINE REVERS(N1,N2) 
!                                                                       
!  Routine to reverse diagonal of two quadrilateral elements            
!                                                                       
      USE BLK1MOD
      USE BLK2MOD
!      INCLUDE 'BLK1.COM' 

      INCLUDE 'TXFRM.COM'
!IPK MAY02       COMMON  /TXFRM/  XS, YS, TXSCAL 
!                                                                       
!  Search for common nodes on the elements                              
!                                                                       
      DO 300 M=1,NCORN(N1),2 
        J=NOP(N1,M) 
        DO 250 MM=1,NCORN(N2),2 
          JJ=NOP(N2,MM) 
          IF(JJ .EQ. J) THEN 
!                                                                       
!  We have a match find the other nodes around element                  
!                                                                       
            MID1=M+1 
            JMID1=NOP(N1,MID1) 
            write(90,*) n1,mid1,jmid1 
            MID2=M+3 
            IF(M .EQ. 5) MID2=2 
            JMID2=NOP(N1,MID2) 
            MID3=M+5 
            IF(MID3 .GT. 6) MID3=MID3-6 
            JMID3=NOP(N1,MID3) 
!                                                                       
!  Now find the other node                                              
!                                                                       
            M1=M+2 
            IF(M1 .GT. 6) M1=1 
            J1=NOP(N1,M1) 
            MM1=MM-2 
            IF(MM1 .LT. 1) MM1=5 
            JJ1=NOP(N2,MM1) 
            IF(J1 .EQ. JJ1) THEN 
!                                                                       
!  We have the other match find nodes around the element                
!                                                                       
              MID4=MM+1 
              JMID4=NOP(N2,MID4) 
              MID5=MM+3 
              IF(MM .EQ. 5) MID5=2 
              JMID5=NOP(N2,MID5) 
              M2=9-M-M1 
              MM2=9-MM-MM1 
              J2=NOP(N1,M2) 
              JJ2=NOP(N2,MM2) 
              NOP(N1,1)=J2 
              NOP(N1,2)=JMID3 
              NOP(N1,3)=J 
              NOP(N1,4)=JMID4 
              NOP(N1,5)=JJ2 
              NOP(N1,6)=JMID1 
              NOP(N2,1)=JJ2 
              NOP(N2,2)=JMID5 
              NOP(N2,3)=J1 
              NOP(N2,4)=JMID2 
              NOP(N2,5)=J2 
              NOP(N2,6)=JMID1 
       write(90,*) (nop(n1,i),i=1,6) 
       write(90,*) (nop(n2,i),i=1,6)
              if(jmid1 .gt. 0) then 
                CORD(JMID1,1) = (CORD(J2,1)+CORD(JJ2,1))/2.0 
                CORD(JMID1,2) = (CORD(J2,2)+CORD(JJ2,2))/2.0 
                XUSR(JMID1) = CORD(JMID1,1)*TXSCAL - XS 
                YUSR(JMID1) = CORD(JMID1,2)*TXSCAL - YS 
                IF(NECON(JMID2,1) .EQ. N1) NECON(JMID2,1)=N2
                IF(NECON(JMID2,2) .EQ. N1) NECON(JMID2,2)=N2
                IF(NECON(JMID4,1) .EQ. N2) NECON(JMID4,1)=N1
                IF(NECON(JMID4,2) .EQ. N2) NECON(JMID4,2)=N1
              endif
              GO TO 350 
            ENDIF 
          ENDIF 
  250   CONTINUE 
  300 END DO 
  350 CONTINUE 
!     CALL PLOTOT                                                       
      RETURN 
      END                                           
