      SUBROUTINE ADD999(ISWT9,NELC)

!    add type 999 elements to all 1-d elements
    
      USE BLK1MOD
      USE BLK2MOD
      COMMON ISEQ(4000,10),LIST1(2000),LIST2(2000),J1OLD(20),J2OLD(20)
      INCLUDE 'TXFRM.COM'

      IF(.NOT. ALLOCATED(IUSEDM)) THEN
        ALLOCATE (IUSEDM(MAXE))
        IUSEDM=0
      ENDIF
      IF(.NOT. ALLOCATED(HSET)) THEN
        ISWTH=0
      ELSE
        ISWTH=1
      ENDIF
!    loop on elements looking for 1-d
      PI2=3.14159/2.
      
      NTEMPLC=0
      NCM=MAXECON 
      NCMi=MAXECON 
      IUSEDM=0
      DO N=1,NE
        IF(IMAT(N) .NE. 999) CYCLE
        CALL KCON(0)
        GO TO 75
      ENDDO
      GO TO 90
   75 CONTINUE     
      DO N=1,NE
        IF(IMAT(N) .EQ. 999) THEN
          DO J=1,NCMi
            IF(NCORN(ICON(N,J)) .EQ. 3) THEN
              M=ICON(N,J)  
              IF(NOP(M,1) .EQ. NOP(N,1)  .AND.  NOP(M,3) .EQ. NOP(N,3)   .OR.&
                NOP(M,1) .EQ. NOP(N,3)  .AND.  NOP(M,3) .EQ. NOP(N,1)) THEN
                IUSEDM(ICON(N,J))=1
                GO TO 80
              ENDIF
            ENDIF
          ENDDO
        ENDIF
   80   CONTINUE
      ENDDO
90    n=1
      ICL=0
      do k=1,10
        iseqp=2000
        iseqm=2000
        do ns=n,ne
          if(imat(ns) .eq. 0  .or.  (imat(ns) .ge. 900  .and.  imat(ns) .lt. 2000)) cycle
          if(ncorn(ns) .gt. 3) cycle
          if(IUSEDM(ns) .eq. 1) cycle
!    renumber elements to put them in order
          N=NS
          N1=NOP(NS,1)
          N3=NOP(NS,3)
          iseq(iseqp,k)=ns
          IUSEDM(n)=1
          go to 100
        enddo
        go to 200
  100   continue   
!    search for element connected to n1 or n3
        do m=1,ne
          if(imat(ns) .eq. 0  .or.  (imat(ns) .ge. 900  .and.  imat(ns) .lt. 2000)) cycle
!          if(imat(m) .gt. 0  .and.  imat(m) .lt. 900) then
            if(ncorn(m) .lt. 4) then
              if(IUSEDM(m) .eq. 1) cycle
              if(nop(m,1) .eq. n3) then
                IUSEDM(m)=1
                iseqp=iseqp+1
                iseq(iseqp,k)=m
!                n1=nop(m,1)
                n3=nop(m,3)
                n=m
                go to 100
              elseif(nop(m,1) .eq. n1) then
                nop(m,1)=nop(m,3)
                nop(m,3)=n1
                IUSEDM(m)=1
                iseqm=iseqm-1
                iseq(iseqm,k)=m
                n1=nop(m,1)
!                n3=nop(m,3)
                n=m
                go to 100
              elseif(nop(m,3) .eq. n1) then
                IUSEDM(m)=1  
                iseqm=iseqm-1
                iseq(iseqm,k)=m
                n1=nop(m,1)
!                n3=nop(m,3)
                n=m
                go to 100
              elseif(nop(m,3) .eq. n3) then
                nop(m,3)=nop(m,1)
                nop(m,1)=n3
                IUSEDM(m)=1
                iseqp=iseqp+1
                iseq(iseqp,k)=m
!                n1=nop(m,1)
                n3=nop(m,3)
                n=m
                go to 100
              endif
            endif
!          endif
        enddo
      enddo          
200   continue
!      do n=990,1005
!        write(150,*) n,(iseq(n,m),m=1,5)
!      enddo
      NETEMP=NE    
          
      do k=1,10
        nss=0
        do ns=1,4000
          if(iseq(ns,k) .eq. 0) cycle
          n=iseq(ns,k)
          N1=NOP(N,1)
          N2=NOP(N,2)
          N3=NOP(N,3)
                      
          if(nss .eq. 0) then
            ELDIR=ATAN2(YUSR(N3)-YUSR(N1),XUSR(N3)-XUSR(N1))
            CALL GETNOD(J1) 
            INEW(J1) = 1 
            INSKP(J1) =0 
            IF(ISWTH .EQ. 1) THEN
              WD(J1)=HSET(N1,3)
            ELSE
              WD(J1)=-9999.
            ENDIF
            CALL GETNOD(J2) 
            INEW(J2) = 1 
            INSKP(J2) =0 
            IF(ISWTH .EQ. 1) THEN
              WD(J2)=HSET(N1,1)
            ELSE
              WD(J2)=-9999.
            ENDIF
            
!            XUSR(J1)=+WIDTHD(N1)/2.*COS(ELDIR-PI2)+XUSR(N1)
!            YUSR(J1)=+WIDTHD(N1)/2.*SIN(ELDIR-PI2)+YUSR(N1)
            XUSR(J1)=+WIDTH(N1)/2.*COS(ELDIR-PI2)+XUSR(N1)
            YUSR(J1)=+WIDTH(N1)/2.*SIN(ELDIR-PI2)+YUSR(N1)
            CORD(J1,1)=(XUSR(J1)+XS)/TXSCAL
            CORD(J1,2)=(YUSR(J1)+YS)/TXSCAL
            IF(ISWT9 .EQ. 2) THEN
              WD(J1)=WD(N1)
            ENDIF  
            nnn=iseq(ns+1,k)
            if(nnn .eq. 0) then 
              ELDIR=ATAN2(YUSR(N3)-YUSR(N1),XUSR(N3)-XUSR(N1))
            else
              n4=nop(nnn,3)
              ELDIR=ATAN2(YUSR(N4)-YUSR(N1),XUSR(N4)-XUSR(N1))
            endif
!            XUSR(J2)=+WIDTHD(N1)/2.*COS(ELDIR+PI2)+XUSR(N1)
!            YUSR(J2)=+WIDTHD(N1)/2.*SIN(ELDIR+PI2)+YUSR(N1)
            XUSR(J2)=+WIDTH(N1)/2.*COS(ELDIR+PI2)+XUSR(N1)
            YUSR(J2)=+WIDTH(N1)/2.*SIN(ELDIR+PI2)+YUSR(N1)
            CORD(J2,1)=(XUSR(J2)+XS)/TXSCAL
            CORD(J2,2)=(YUSR(J2)+YS)/TXSCAL
            IF(ISWT9 .EQ. 2) THEN
              WD(J2)=WD(N1)
            ENDIF  
            nss=1
          else
            nnn=iseq(ns+1,k)
            if(nnn .eq. 0) then 
              ELDIR=ATAN2(YUSR(N3)-YUSR(N1),XUSR(N3)-XUSR(N1))
            else
              n4=nop(nnn,3)
              ELDIR=ATAN2(YUSR(N4)-YUSR(N1),XUSR(N4)-XUSR(N1))
            endif
          endif
          N0=N1
!    get two node numbers and store in ntempc
          CALL GETNOD(J3) 
            INEW(J3) = 1 
            INSKP(J3) =0 
            IF(ISWTH .EQ. 1) THEN
              WD(J3)=HSET(N3,3)
            ELSE
              WD(J3)=-9999.
            ENDIF
          CALL GETNOD(J4)
            INEW(J4) = 1 
            INSKP(J4) =0 
            IF(ISWTH .EQ. 1) THEN
              WD(J4)=HSET(N3,1)
            ELSE
              WD(J4)=-9999.
            ENDIF
          IF(J4 .GT. NP) NP=J4
          nn= imat(n)
          if(nn .gt. 1999) then
!            XUSR(J3)=+WIDTHD(N3)/2.*COS(ELDIR-PI2)+XUSR(N3)
!            YUSR(J3)=+WIDTHD(N3)/2.*SIN(ELDIR-PI2)+YUSR(N3)
!            XUSR(J4)=+WIDTHD(N3)/2.*COS(ELDIR+PI2)+XUSR(N3)
!            YUSR(J4)=+WIDTHD(N3)/2.*SIN(ELDIR+PI2)+YUSR(N3)
            XUSR(J3)=+WIDTH(N3)/2.*COS(ELDIR-PI2)+XUSR(N3)
            YUSR(J3)=+WIDTH(N3)/2.*SIN(ELDIR-PI2)+YUSR(N3)
            XUSR(J4)=+WIDTH(N3)/2.*COS(ELDIR+PI2)+XUSR(N3)
            YUSR(J4)=+WIDTH(N3)/2.*SIN(ELDIR+PI2)+YUSR(N3)
          ELSEIF(KID(nn,1) .NE. 0) THEN
            JR2=KID(IMAT(N),2)
            JR1=KID(IMAT(N),3)
            JR4=KID(IMAT(N),4)
            JR3=KID(IMAT(N),5)
            XUSR(J1)=XUSR(JR1)
            YUSR(J1)=YUSR(JR1)
            XUSR(J2)=XUSR(JR2)
            YUSR(J2)=YUSR(JR2)
            XUSR(J3)=XUSR(JR3)
            YUSR(J3)=YUSR(JR3)
            XUSR(J4)=XUSR(JR4)
            YUSR(J4)=YUSR(JR4)
!            nop(n-1,7)=jr3
          ELSE
!            XUSR(J3)=+WIDTHD(N3)/2.*COS(ELDIR-PI2)+XUSR(N3)
!            YUSR(J3)=+WIDTHD(N3)/2.*SIN(ELDIR-PI2)+YUSR(N3)
!            XUSR(J4)=+WIDTHD(N3)/2.*COS(ELDIR+PI2)+XUSR(N3)
!            YUSR(J4)=+WIDTHD(N3)/2.*SIN(ELDIR+PI2)+YUSR(N3)
            XUSR(J3)=+WIDTH(N3)/2.*COS(ELDIR-PI2)+XUSR(N3)
            YUSR(J3)=+WIDTH(N3)/2.*SIN(ELDIR-PI2)+YUSR(N3)
            XUSR(J4)=+WIDTH(N3)/2.*COS(ELDIR+PI2)+XUSR(N3)
            YUSR(J4)=+WIDTH(N3)/2.*SIN(ELDIR+PI2)+YUSR(N3)
          ENDIF
                
          CORD(J3,1)=(XUSR(J3)+XS)/TXSCAL
          CORD(J3,2)=(YUSR(J3)+YS)/TXSCAL
          CORD(J4,1)=(XUSR(J4)+XS)/TXSCAL
          CORD(J4,2)=(YUSR(J4)+YS)/TXSCAL
          IF(ISWT9 .EQ. 2) THEN
             WD(J3)=WD(N3)
             WD(J4)=WD(N3)
          ENDIF
350       CONTINUE            
         CALL GETELM(I3) 
!   RECORD IN LIST FOR FUTURE
         ICL=ICL+1
         LIST1(ICL)=I3
         LIST2(I3)=icl
         NCORN(I3) = 8
          IESKP(I3) = 0 
          NOP(I3,1)=J1
          NOP(I3,3)=J3
          NOP(I3,5)=N3
          NOP(I3,6)=N2
          NOP(I3,7)=N1
          IF(ISWT9 .EQ. 0) THEN
            IMAT(I3)=999
          ELSE
            IMAT(I3)=IMAT(N)
          ENDIF
          CALL GETELM(I4)
!   RECORD IN LIST FOR FUTURE
         ICL=ICL+1
         LIST1(ICL)=I4
         LIST2(I4)=-icl
          NCORN(I4) = 8
          IESKP(I4) = 0 
          IF(I4 .GT. NETEMP) NETEMP=I4 
          IMAT(I4)=999
          NOP(I4,1)=J4
          NOP(I4,2)= 0
          NOP(I4,3)=J2
          NOP(I4,5)=N1
          NOP(I4,6)=N2
          NOP(I4,7)=N3
          IF(ISWT9 .EQ. 0) THEN
            IMAT(I4)=999
          ELSE
            IMAT(I4)=IMAT(N)
            CALL DELTEL(N)
          ENDIF
          J2=J4
          J1=J3
        ENDDO  
      enddo
      NE=NETEMP
      ICLM=ICL
      NELCT=2
400   CONTINUE 
      CALL FILM(1)
      call KCON(0)

      do n=1,ne
        
        if(imat(n) .eq. 2000) then
          nm=nop(n,4)
          if(necon(nm,1) .eq. n) then
            nat=necon(nm,2)
          else
            nat=necon(nm,1)
          endif
          if(list2(n) .gt. 0) then
            nm=nop(n,4)
            if(necon(nm,1) .eq. n) then
              nat=necon(nm,2)
            else
              nat=necon(nm,1)
            endif
            n1=nop(nat,7)
            n2=nop(nat,1)
            j1=nop(n,5)
            j2=nop(n,7)
            j3=nop(n,1)
            j4=nop(n,3)
          else
            nm=nop(n,8)
            if(necon(nm,1) .eq. n) then
              nat=necon(nm,2)
            else
              nat=necon(nm,1)
            endif
            n1=nop(nat,3)
            n2=nop(nat,5)
            j1=nop(n,1)
            j2=nop(n,3)
            j3=nop(n,5)
            j4=nop(n,7)
          endif  
          xusr(j1)=xusr(n1)
          yusr(j1)=yusr(n1)
          cord(j1,1)=cord(n1,1)
          cord(j1,2)=cord(n1,2)
          xusr(j2)=xusr(n1)
          yusr(j2)=yusr(n1)
          cord(j2,1)=cord(n1,1)
          cord(j2,2)=cord(n1,2)
          xusr(j3)=xusr(n2)
          yusr(j3)=yusr(n2)
          cord(j3,1)=cord(n2,1)
          cord(j3,2)=cord(n2,2)
          xusr(j4)=xusr(n2)
          yusr(j4)=yusr(n2)
          cord(j4,1)=cord(n2,1)
          cord(j4,2)=cord(n2,2)
        elseif(imat(n) .eq. 2001) then
          if(list2(n) .gt. 0) then
            nm=nop(n,8)
            if(necon(nm,1) .eq. n) then
              nat=necon(nm,2)
            else
              nat=necon(nm,1)
            endif
            n1=nop(nat,5)
            n2=nop(nat,3)
            j1=nop(n,5)
            j2=nop(n,7)
            j3=nop(n,1)
            j4=nop(n,3)
          else
            nm=nop(n,4)
            if(necon(nm,1) .eq. n) then
              nat=necon(nm,2)
            else
              nat=necon(nm,1)
            endif
            n1=nop(nat,1)
            n2=nop(nat,7)
            j1=nop(n,1)
            j2=nop(n,3)
            j3=nop(n,5)
            j4=nop(n,7)
          endif
          xusr(j1)=xusr(n1)
          yusr(j1)=yusr(n1)
          cord(j1,1)=cord(n1,1)
          cord(j1,2)=cord(n1,2)
          xusr(j2)=xusr(n1)
          yusr(j2)=yusr(n1)
          cord(j2,1)=cord(n1,1)
          cord(j2,2)=cord(n1,2)
          xusr(j3)=xusr(n2)
          yusr(j3)=yusr(n2)
          cord(j3,1)=cord(n2,1)
          cord(j3,2)=cord(n2,2)
          xusr(j4)=xusr(n2)
          yusr(j4)=yusr(n2)
          cord(j4,1)=cord(n2,1)
          cord(j4,2)=cord(n2,2)
        endif
      enddo
  450 CALL DELETM(0) 
      IF(NELC .LE. NELCT) THEN
      NMESS=47     
      CALL GETINT(NNEL)
      IF(NNEL .EQ. 2) GO TO 470
!                               Loop on newly created elements only   
        DO K=1,ICL,2
!                               work in pairs          
          N1=LIST1(K)
          N2=LIST1(K+1)
          NMT=IMAT(N1)
!                               temporarily get corner limits I1,I2,I3,I4
          I1=NOP(N1,1)
          I2=NOP(N2,3)          
          I3=NOP(N1,3)
          I4=NOP(N2,1)
!                               Delete nodes in middle
          JJ=NOP(N1,7)
          JK=NOP(N1,5)
          CALL DELETN(JJ)
          IF(K .EQ. ICL-1) THEN
            CALL DELETN(JK)
          ENDIF
!          CALL DELTEL(N1)
!          CALL DELTEL(N2)
!                               Get x and y increments
          DX1=(XUSR(I2)-XUSR(I1))/NNEL
          DY1=(YUSR(I2)-YUSR(I1))/NNEL
          DX2=(XUSR(I4)-XUSR(I3))/NNEL
          DY2=(YUSR(I4)-YUSR(I3))/NNEL
          
!                               loop on new elements across section
          J1OLD(1)=I1
          J2OLD(1)=I3
          IF(K .GT. 1) THEN
            DO L=1,NNEL+1
              J1OLD(L+1)=J2OLD(L+1)
            ENDDO
          ENDIF
!                               loop to creat nodes across section            
          DO L=1,NNEL
!                               Create new nodes for first in sequence
            IF(K .EQ. 1) THEN    
              IF(L .LT. NNEL) THEN
                CALL GETNOD(JNEW)
                J1OLD(L+1)=JNEW
                NP=MAX(NP,J1OLD(L+1))
                XUSR(J1OLD(L+1))=XUSR(J1OLD(L))+DX1
                YUSR(J1OLD(L+1))=YUSR(J1OLD(L))+DY1
                CORD(J1OLD(L+1),1)=(XUSR(J1OLD(L+1))+XS)/TXSCAL
                CORD(J1OLD(L+1),2)=(YUSR(J1OLD(L+1))+YS)/TXSCAL
                INEW(J1OLD(L+1))=1
                INSKP(J1OLD(L+1)) = 0 
                WD(J1OLD(L+1))=-9999.
                WIDTH(J1OLD(L+1))=0.
                SS1(J1OLD(L+1))=0.
                SS2(J1OLD(L+1))=0.
                WIDS(J1OLD(L+1))=0.
                WIDBS(J1OLD(L+1))=0.
                SSO(J1OLD(L+1))=0.
              ELSE
                J1OLD(L+1)=I2
              ENDIF
            ENDIF  
!                               save forward nodes as list
            IF(L .LT. NNEL) THEN
              CALL GETNOD(JNEW)
              J2OLD(L+1)=JNEW
              NP=MAX(NP,J2OLD(L+1))
              XUSR(J2OLD(l+1))=XUSR(J2OLD(L))+DX2
              YUSR(J2OLD(L+1))=YUSR(J2OLD(L))+DY2
              CORD(J2OLD(L+1),1)=(XUSR(J2OLD(L+1))+XS)/TXSCAL
              CORD(J2OLD(L+1),2)=(YUSR(J2OLD(L+1))+YS)/TXSCAL
              INEW(J2OLD(L+1))=1
              INSKP(J2OLD(L+1)) = 0 
              WD(J2OLD(L+1))=-9999.
              WIDTH(J2OLD(L+1))=0.
              SS1(J2OLD(L+1))=0.
              SS2(J2OLD(L+1))=0.
              WIDS(J2OLD(L+1))=0.
              WIDBS(J2OLD(L+1))=0.
              SSO(J2OLD(L+1))=0.
            ELSE
              J2OLD(L+1)=I4
            ENDIF
!                               Connect elements from list
            CALL GETELM(NEA)
            NE=MAX(NE,NEA)
            NOP(NEA,1)=J1OLD(L)
            NOP(NEA,3)=J2OLD(L)
            NOP(NEA,5)=J2OLD(L+1)
            NOP(NEA,7)=J1OLD(L+1)
            NOP(NEA,2)=0
            NOP(NEA,4)=0
            NOP(NEA,6)=0
            NOP(NEA,8)=0
            IMAT(NEA)=NMT
            NCORN(NEA) = 8
            IESKP(NEA) = 0         
          ENDDO
        ENDDO 
470     CONTINUE          
        do n=1,ne
          if(imat(n) .gt. 1000) then
            CALL DELTEL(n) 
          endif
        enddo
        RETURN
      ENDIF
        DO I=1,ICLM,2
          NEL=LIST1(I)
          IF(IMAT(NEL) .EQ. 0) CYCLE
          IF(I .GT. 1) THEN
            J3=J4
          ELSE
            CALL GETNOD(J3) 
            XUSR(J3)=(XUSR(NOP(NEL,7))+XUSR(NOP(NEL,1)))/2.
            YUSR(J3)=(YUSR(NOP(NEL,7))+YUSR(NOP(NEL,1)))/2.
            CORD(J3,1)=(XUSR(J3)+XS)/TXSCAL
            CORD(J3,2)=(YUSR(J3)+YS)/TXSCAL
            WD(J3)=(WD(NOP(NEL,1))+WD(NOP(NEL,7)))/2.
            INEW(J3) = 1 
            INSKP(J3) =0 
            IF(J3 .GT. NP) NP=J3
          ENDIF
            
          CALL GETNOD(J4)
          XUSR(J4)=(XUSR(NOP(NEL,3))+XUSR(NOP(NEL,5)))/2.
          YUSR(J4)=(YUSR(NOP(NEL,3))+YUSR(NOP(NEL,5)))/2.
          CORD(J4,1)=(XUSR(J4)+XS)/TXSCAL
          CORD(J4,2)=(YUSR(J4)+YS)/TXSCAL
          WD(J4)=(WD(NOP(NEL,3))+WD(NOP(NEL,5)))/2.
          INEW(J4) = 1 
          INSKP(J4) =0 
          IF(J4 .GT. NP) NP=J4
          CALL GETELM(I3)
!   RECORD IN LIST FOR FUTURE
          ICL=ICL+1
          LIST1(ICL)=I3
          NCORN(I3) = 8
          IESKP(I3) = 0 
          IF(I3 .GT. NETEMP) NETEMP=I3
          NOP(I3,5)=J4
          NOP(I3,7)=J3
          NOP(I3,1)=NOP(NEL,1)
          NOP(I3,3)=NOP(NEL,3)
          NOP(NEL,1)=J3
          NOP(NEL,3)=J4
          IMAT(I3)=IMAT(NEL)

          NEL=LIST1(I+1)
          IF(IMAT(NEL) .EQ. 0) CYCLE
          IF(I .GT. 1) THEN
            J3A=J4A
          ELSE
            CALL GETNOD(J3A) 
            XUSR(J3A)=(XUSR(NOP(NEL,3))+XUSR(NOP(NEL,5)))/2.
            YUSR(J3A)=(YUSR(NOP(NEL,3))+YUSR(NOP(NEL,5)))/2.
            CORD(J3A,1)=(XUSR(J3A)+XS)/TXSCAL
            CORD(J3A,2)=(YUSR(J3A)+YS)/TXSCAL
            WD(J3A)=(WD(NOP(NEL,3))+WD(NOP(NEL,5)))/2.
            INEW(J3A) = 1 
            INSKP(J3A) =0 
            IF(J3A .GT. NP) NP=J3A
          ENDIF      
          CALL GETNOD(J4A)
          XUSR(J4A)=(XUSR(NOP(NEL,1))+XUSR(NOP(NEL,7)))/2.
          YUSR(J4A)=(YUSR(NOP(NEL,1))+YUSR(NOP(NEL,7)))/2.
          CORD(J4A,1)=(XUSR(J4A)+XS)/TXSCAL
          CORD(J4A,2)=(YUSR(J4A)+YS)/TXSCAL
          WD(J4A)=(WD(NOP(NEL,1))+WD(NOP(NEL,7)))/2.
          INEW(J4A) = 1 
          INSKP(J4A) =0 
          IF(J4A .GT. NP) NP=J4A
          CALL GETELM(I3)
!   RECORD IN LIST FOR FUTURE
          ICL=ICL+1
          LIST1(ICL)=I3
          NCORN(I3) = 8
          IESKP(I3) = 0 
          IF(I3 .GT. NETEMP) NETEMP=I3
          NOP(I3,1)=J4A
          NOP(I3,3)=J3A
          NOP(I3,5)=NOP(NEL,5)
          NOP(I3,7)=NOP(NEL,7)
          NOP(NEL,5)=J3A
          NOP(NEL,7)=J4A
          IMAT(I3)=IMAT(NEL)

        ENDDO
        NELCT=NELCT*2
        GO TO 450
!      RETURN
      END
    