1!$Id:$
2      subroutine comproa(numnp, nen, nen1, ndf, ix, id,
3     &                   ic, ielc, ir, kp, bycol, wdiag, all)
4
5!      * * F E A P * * A Finite Element Analysis Program
6
7!....  Copyright (c) 1984-2017: Regents of the University of California
8!                               All rights reserved
9
10!-----[--.----+----.----+----.-----------------------------------------]
11!      Purpose:  Compute number of locations needed for equation
12!                connection list.
13
14!      Inputs:
15!         numnp      -  Number of nodes in mesh
16!         nen        -  Maximum number of nodes on any element
17!         nen1       -  Dimension for 'ix' array
18!         ndf        -  Number of unknowns at each node.
19!         ix(nen1,*) -  List of nodes connected to each element
20!         id         -  Active unknowns at each node.
21!         ic         -  Pointer for ielc list
22!         ielc(*)    -  Holds set of elements connected to each node.
23!         bycol      -  Storage by columns if true
24!         wdiag      -  Include diagonal if true
25!         all        -  All terms in row/col if true
26
27!      Working vector:
28!         ir(*)      -  Row number of each nonzero in stiffness matrix.
29
30!      Outputs:
31!         kp         -  Dimension of IR array.
32!-----[--.----+----.----+----.-----------------------------------------]
33      implicit  none
34
35      include  'compac.h'
36      include  'pointer.h'
37      include  'comblk.h'
38
39      logical   bycol, wdiag, all
40      integer   i, j, ne, nep, neq, nn
41      integer   numnp, nen, nen1, ndf, kp, kpo, kpf
42      integer   ix(nen1,*), id(ndf,*), ic(*), ir(*), ielc(*)
43
44      save
45
46!     Set up compressed profile pointers.
47
48      neq = 0
49      do i = 1, numnp
50        do j = 1,ndf
51          neq = max(neq,id(j,i))
52        end do ! j
53      end do ! i
54
55!     Zero temporary array to start
56
57      do j = 1,neq
58        ir(j) = 0
59      end do ! j
60
61!     Do all equations
62
63      kp  = 0
64      nep = 1
65      do i = 1, neq
66        ne  = ic(i)
67        kpo = 1
68        kpf = 0
69        do j = nep, ne
70          nn = ielc(j)
71
72!         Check element type(>0: FE, <0: contact)
73
74          if(nn.gt.0) then
75            call comelm(id,ix(1,nn), ir, ndf,nen,  kpo,kpf,i,
76     &                  bycol,wdiag,all)
77          else
78            write(*,*) ' **ERROR** Incorrect COMPROa Type'
79          endif
80
81!         End element tests
82
83        end do ! j
84
85!       Zero entry for next row/column check
86
87        do j = 1,kpf
88          ir(j) = 0
89        end do ! j
90
91!       Accumulate required storage pointer
92
93        kp  = kp + kpf ! returns total storage for sparse matrix
94        nep = ne + 1
95      end do ! i
96
97      end
98