1!$Id:$
2      subroutine plocal(ld,eq,id,ix,ie,iedof,xl,ul,tl,ub, x,f,u,ud,
3     &                  t,un,dun, nrot, dfl, jsw)
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: Set local arrays for each element
12
13!      Inputs:
14!        eq(*)    - Global equation numbers
15!        id(*)    - Boundary restraints
16!        ie(*)    - Element descriptor parameters
17!        iedof(*) - Element descriptor parameters
18!        x(*)     - Global nodal coordinates
19!        f(*)     - Global nodal forces/displacements
20!        u(*)     - Global nodal solution parameters
21!        ud(*)    - Global nodal rate parameters
22!        t(*)     - Global temp variables
23!        dfl      - Set to assemble reactions if true
24!        jsw      - Switching parameter
25
26!      Scratch
27!        ubl(*)   - Local array for boundary displacements
28
29!      Outputs:
30!        ld(*)    - Element global equation numbers
31!        xl(*)    - Element nodal coordinates
32!        ul(*)    - Element nodal solution parameters
33!        tl(*)    - Element temp values
34!        ub(*)    - Element boundary displacement modify values
35!        un,dun   - Boundary modification indicators
36!        nrot     - Number dof's with rotated directions
37!-----[--.----+----.----+----.-----------------------------------------]
38      implicit   none
39
40      include   'cdata.h'
41      include   'cdat1.h'
42      include   'corset.h'
43      include   'crotas.h'
44      include   'ddata.h'
45      include   'eldata.h'
46      include   'fdata.h'
47      include   'mdata.h'
48      include   'pglob1.h'
49      include   'qudshp.h'
50      include   'rdata.h'
51      include   'rdat0.h'
52      include   'sdata.h'
53      include   'setups.h'
54      include   'pointer.h'
55      include   'comblk.h'
56
57      logical    dfl
58      integer    nrot, jsw, i,j,k, iid,ild
59      integer    ld(nst),eq(ndf,*),id(ndf,*),ix(*),ie(*),iedof(ndf,*)
60      real*8     un(*),dun(*), ang
61      real*8     xl(ndm,*),ul(ndf,nen,*),tl(*), ub(*), ubl(20)
62      real*8     x(ndm,*),f(ndf,*),u(ndf,*),ud(*),t(*)
63
64      save
65
66!     Zero array used to store local displ, veloc, and accel
67
68      do i = 1,nst
69        ld(i) = 0
70        ub(i) = 0.0d0
71      end do ! i
72
73      do k = 1,7
74        do j = 1,nen
75          do i = 1,ndf
76            ul(i,j,k) = 0.0d0
77          end do ! i
78        end do ! j
79      end do ! k
80
81!     Zero array used to store local tl and coordinates
82
83      do i = 1,nen
84        tl(i) = 0.0d0
85        do j = 1,ndm
86          xl(j,i) = 0.0d0
87        end do ! j
88      end do ! i
89
90      do j = 1,ndf
91        un(j)  =  0.0d0
92        dun(j) =  0.0d0
93      end do ! j
94
95!     Set up local nodal rotation array for inclined b.c.
96
97      call pangl(ix,nen,hr(np(46)),hr(np(45)),nrot)
98
99!     Set element type
100
101      eltyp = ix(nen+7)  ! N.B. FE elements have negative type
102      elty2 = ix(nen+8)  ! Used for NURBS 2-d & 3-d
103      elty3 = ix(nen+9)  ! Used for NURBS 3-d
104
105!     Set individual nodal values
106
107      do i = 1,nen
108
109        if(ix(i).gt.0) then
110
111!         Set up localized solution parameters
112
113          iid = ix(i)*ndf - ndf
114          ild =     i*ndf - ndf
115          nel = i
116          tl(i) = t(ix(i))
117          do j = 1,ndm
118            xl(j,i) = x(j,ix(i))
119          end do ! j
120          if(eltyp.gt.0 .or. nurbfl) then
121            hr(np(264)+i-1) = hr(np(263)+ix(i)-1)  ! NURB weight
122          endif
123          do j = 1,ndf
124            ubl(j) = u(j,ix(i))
125          end do ! j
126          ang = hr(np(46)+i-1)
127          if(ang.ne.0.0d0) then
128            call upang(ia(1,iel),ang,ubl,ndf,1)
129            if(ir(1,iel).gt.0) then
130              call upang(ir(1,iel),ang,ubl,ndf,1)
131            endif
132          endif
133          do j = 1,ndf
134            if(iedof(j,i).gt.0) then
135
136!             Set solution, total increment, last increment
137
138              ul(j,i,1) = u(iedof(j,i),ix(i))
139              ul(j,i,2) = u(iedof(j,i),ix(i)+numnp)
140              ul(j,i,3) = u(iedof(j,i),ix(i)+numnp*2)
141
142!             Set dynamics solutions
143
144              if(fl(9)) then
145                k = iid+iedof(j,i)
146                if(nrk.gt.0) then
147                  ul(j,i,1) = ud(nrkn+k)
148                endif
149
150                if(jsw.eq.13) then
151                  ul(j,i,1) = u(iedof(j,i),ix(i))
152                  ul(j,i,4) = ud(k)
153                else
154                  if(nrc.gt.0) ul(j,i,4) = ud(nrcn+k)
155                  if(nrm.gt.0) ul(j,i,5) = ud(nrmn+k)
156                endif
157
158!               Set velocity at t_n
159
160                ul(j,i,6) = ud(nrvn+k)
161
162!             Set acceleration for specified shift
163
164              elseif(shflg) then
165                ul(j,i,5) = -shift*ul(j,i,1)
166              endif
167
168              un(j) = max(un(j),abs(u(iedof(j,i),ix(i))))
169
170!             Set increment for specified boundary values
171
172              if( id(iedof(j,i),ix(i)).gt.0) then
173                ub(j+ild) = f(iedof(j,i),ix(i)) - ubl(iedof(j,i))
174                dun(j)    = max(dun(j),abs(ub(j+ild)))
175              endif
176
177!             Set local/global map for assembly step
178
179              if(dfl) then
180
181!               Set k for reactions
182
183                k = iid + iedof(j,i)
184              else
185
186!               Set k for assembly
187
188                k = eq(iedof(j,i),ix(i))
189              endif
190
191!             Form assembly array
192
193              ld(j+ild) = k
194
195            endif
196          end do ! j
197
198        endif
199      end do ! i
200
201      end
202