1!$Id:$
2      subroutine dasble(s,p,ld,jp,ns,neqs,afl,bfl,  b,al,au,ad)
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: Assemble symmetric/unsymmetric arrays for 'DATRI'
11
12!      Inputs:
13!         s(ns,ns) - Element array to assemble
14!         p(ns)    - Element vector to assemble
15!         ld(ns)   - Local to Globasl equation numbers for assemble
16!         jp(*)    - Pointer array for upper/lower parts of A array.
17!         ns       - Size of element arrays
18!         neqs     - Number of equations in A which are symmetric
19!         afl      - If true, assemble A array
20!         bfl      - If true, assemble B vector
21
22!      Outputs:
23!         b(*)     - Assembled right hand side B vector
24!         al(*)    - Assembled lower part of A array
25!         au(*)    - Assembled upper part of A array
26!         ad(*)    - Assembled diagonal part of A array
27!-----[--.----+----.----+----.-----------------------------------------]
28      implicit  none
29
30      include  'compac.h'
31      include  'compas.h'
32      include  'setups.h'
33
34      include  'pointer.h'
35      include  'comblk.h'
36
37      logical   afl, alfl, bfl
38      integer   i, ii, j, jj, je, ns, neqs
39
40      integer   ld(ns),jp(*)
41      real*8    al(*),au(*),ad(*),b(*),s(ns,ns),p(ns)
42
43      save
44
45!     Assemble matrix
46
47      if(solver.and.afl) then
48
49!       Check for compressed assembly
50
51        if(compfl) then
52
53          if(neqs.gt.1) then
54            alfl = .false.
55          else
56            alfl = .true.
57          endif
58
59!         Compressed stiffness assembly
60
61          if(castif) then
62            call cassem(ad,au,al,s,mr(np(94)),mr(np(93)),
63     &                  ld,ns,alfl,kbycol,kdiag,kall)
64
65!         Compressed damping assembly
66
67          elseif(cadamp) then
68            call cassem(ad,au,al,s,mr(np(204)),mr(np(203)),
69     &                  ld,ns,alfl,cbycol,cdiag,call)
70
71!         Compressed mass assembly
72
73          elseif(camass) then
74            call cassem(ad,au,al,s,mr(np(91)),mr(np(90)),
75     &                  ld,ns,alfl,mbycol,mdiag,mall)
76
77!         Compressed user assembly
78
79          elseif(causer) then
80            call cassem(ad,au,al,s,mr(np(152)),mr(np(151)),
81     &                  ld,ns,alfl,ubycol,udiag,uall)
82          endif
83
84        else
85
86!       Loop through rows to perform assembly
87
88          je = jp(neqs)
89          do i = 1,ns
90            if(ld(i).gt.0) then
91              ii = ld(i) + 1
92
93!             Loop through columns to perform assembly
94
95              do j = 1,ns
96                if(ld(j).eq.ld(i)) then
97                  ad(ld(i)) = ad(ld(i)) + s(i,j)
98                elseif(ld(j).gt.ld(i)) then
99                  jj = ii + jp(ld(j)) - ld(j)
100                  au(jj) = au(jj) + s(i,j)
101                  if(ld(j).gt.neqs) then
102                    al(jj-je) = al(jj-je) + s(j,i)
103                  endif
104                endif
105              end do
106            endif
107          end do
108        endif
109      endif
110
111!     Assemble a vector
112
113      if(solver.and.bfl) then
114        do i = 1,ns
115          if(ld(i).gt.0) b(ld(i))  = b(ld(i))  + p(i)
116        end do
117      endif
118
119!     User supplied assembler
120
121      if(.not.solver) then
122        call uasble(s,p,ld,ns,afl,bfl,b)
123      endif
124
125      end
126