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