1!$Id:$
2      subroutine tiefor(id,f,ip,ndf,numnp)
3
4!      * * F E A P * * A Finite Element Analysis Program
5
6!....  Copyright (c) 1984-2017: Regents of the University of California
7!                               All rights reserved
8
9!-----[--.----+----.----+----.-----------------------------------------]
10!      Purpose: Procedure to connect nodes which have same coordinates.
11
12!      Inputs:
13!         id(ndf,*)  - Equation number list
14!         ip(*)      - Node numbers for ties
15!         ndf        - Number dof/node
16!         numnp      - Number of nodes in mesh
17
18!      Outputs:
19!         f(ndf,*)   - Forces after tie accounted for
20!-----[--.----+----.----+----.-----------------------------------------]
21
22      implicit  none
23
24      include  'iofile.h'
25
26      integer   ndf, numnp, i, j, k
27      integer   id(ndf,*),ip(numnp)
28      real*8    f(ndf,*)
29
30      save
31
32!     Set force/b.c. to tie nodes
33
34      do k = 1,numnp
35        j = ip(k)
36        if(k.ne.j) then
37          do i = 1,ndf
38            f(i,k) = f(i,k) + f(i,j)
39            f(i,j) = f(i,k)
40          end do
41        endif
42      end do
43
44!     Delete equations and forces for all unused nodes from a tie
45
46      do j = 1,numnp
47        if(ip(j).ne.j) then
48          do i = 1,ndf
49            if(id(i,j).eq.0 .and. id(i,ip(j)).lt.-999) then
50              id(i,ip(j)) = 0
51              f (i,ip(j)) = f(i,j)
52            endif
53            id(i,j) = 1
54            f (i,j) = 0.0d0
55          end do
56        endif
57      end do
58
59      end
60