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