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