OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cdkfint_reg_ini.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| cdkfint_reg_ini ../starter/source/elements/sh3n/coquedk/cdkfint_reg_ini.F
25!||--- called by ------------------------------------------------------
26!|| nlocal_init_sta ../starter/source/materials/fail/nlocal_init_sta.F
27!||--- calls -----------------------------------------------------
28!|| cdkevec3 ../starter/source/elements/sh3n/coquedk/cdkevec3.F
29!|| cnloc_matini ../starter/source/materials/mat_share/cnloc_matini.F
30!||--- uses -----------------------------------------------------
31!|| message_mod ../starter/share/message_module/message_mod.F
32!||====================================================================
33 SUBROUTINE cdkfint_reg_ini(ELBUF_TAB,NLOC_DMG ,AREA ,IXTG ,
34 . DT_NL ,X ,XREFTG ,NFT ,
35 . NEL ,NG ,IPM ,BUFMAT ,
36 . TIME ,FAILURE )
37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE elbufdef_mod
41 USE message_mod
42 USE nlocal_reg_mod
43 use element_mod , only : nixtg
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "param_c.inc"
52#include "com01_c.inc"
53#include "com04_c.inc"
54#include "scr03_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 TYPE(elbuf_struct_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
59 TYPE (NLOCAL_STR_) , TARGET :: NLOC_DMG
60 INTEGER IXTG(NIXTG,*),NFT,NEL,NG,IPM(NPROPMI,*)
61 my_real ,DIMENSION(NUMELC+NUMELTG),INTENT(IN) ::
62 . area
63 my_real
64 . x(3,*),xreftg(3,3,*),dt_nl,bufmat(*),time
65 LOGICAL :: FAILURE
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 INTEGER :: IMAT,NDOF,L_NLOC,N1,N2,N3,
70 . K,I,NPTR,NPTS,IR,IS,NDNOD
71 INTEGER, DIMENSION(NEL) :: POS1,POS2,POS3
72 my_real
73 . le_min,len,damp,dens,ntn_unl,ntn_vnl,
74 . ntvar,z01(11,11),wf1(11,11),zn1(12,11),b1,b2,b3,
75 . nth1,nth2,bth1,bth2,k1,k12,k2,sspnl,le_max
76 my_real, DIMENSION(:,:), ALLOCATABLE :: var_reg,vpred
77 my_real,
78 . DIMENSION(:), POINTER :: fnl,unl,vnl,dnl,mnl,thck
79 my_real, DIMENSION(NEL) :: x1,x2,x3,y1,y2,y3,
80 . px1,py1,px2,py2,e1x,e2x,e3x,e1y,e2y,e3y,e1z,e2z,e3z,
81 . x2l,y2l,x3l,y3l,z1,z2,z3,surf,offg,
82 . vols,btb11,btb12,btb13,btb22,btb23,btb33
83 TYPE(buf_nloc_),POINTER :: BUFNL
84 my_real, DIMENSION(:,:), POINTER ::
85 . MASSTH,FNLTH,VNLTH,UNLTH
86 ! Position of integration points in the thickness
87 DATA z01/
88 1 0. ,0. ,0. ,0. ,0. ,
89 1 0. ,0. ,0. ,0. ,0. ,0. ,
90 2 -.5 ,0.5 ,0. ,0. ,0. ,
91 2 0. ,0. ,0. ,0. ,0. ,0. ,
92 3 -.5 ,0. ,0.5 ,0. ,0. ,
93 3 0. ,0. ,0. ,0. ,0. ,0. ,
94 4 -.5 ,-.1666667,0.1666667,0.5 ,0. ,
95 4 0. ,0. ,0. ,0. ,0. ,0. ,
96 5 -.5 ,-.25 ,0. ,0.25 ,0.5 ,
97 5 0. ,0. ,0. ,0. ,0. ,0. ,
98 6 -.5 ,-.3 ,-.1 ,0.1 ,0.3 ,
99 6 0.5 ,0. ,0. ,0. ,0. ,0. ,
100 7 -.5 ,-.3333333,-.1666667,0.0 ,0.1666667,
101 7 0.3333333,0.5 ,0. ,0. ,0. ,0. ,
102 8 -.5 ,-.3571429,-.2142857,-.0714286,0.0714286,
103 8 0.2142857,0.3571429,0.5 ,0. ,0. ,0. ,
104 9 -.5 ,-.375 ,-.25 ,-.125 ,0.0 ,
105 9 0.125 ,0.25 ,0.375 ,0.5 ,0. ,0. ,
106 a -.5 ,-.3888889,-.2777778,-.1666667,-.0555555,
107 a 0.0555555,0.1666667,0.2777778,0.3888889,0.5 ,0. ,
108 b -.5 ,-.4 ,-.3 ,-.2 ,-.1 ,
109 b 0. ,0.1 ,0.2 ,0.3 ,0.4 ,0.5 /
110 ! Weight of integration in the thickness
111 DATA wf1/
112 1 1. ,0. ,0. ,0. ,0. ,
113 1 0. ,0. ,0. ,0. ,0. ,0. ,
114 2 0.5 ,0.5 ,0. ,0. ,0. ,
115 2 0. ,0. ,0. ,0. ,0. ,0. ,
116 3 0.25 ,0.5 ,0.25 ,0. ,0. ,
117 3 0. ,0. ,0. ,0. ,0. ,0. ,
118 4 0.1666667,0.3333333,0.3333333,0.1666667,0. ,
119 4 0. ,0. ,0. ,0. ,0. ,0. ,
120 5 0.125 ,0.25 ,0.25 ,0.25 ,0.125 ,
121 5 0. ,0. ,0. ,0. ,0. ,0. ,
122 6 0.1 ,0.2 ,0.2 ,0.2 ,0.2 ,
123 6 0.1 ,0. ,0. ,0. ,0. ,0. ,
124 7 0.0833333,0.1666667,0.1666667,0.1666667,0.1666667,
125 7 0.1666667,0.0833333,0. ,0. ,0. ,0. ,
126 8 0.0714286,0.1428571,0.1428571,0.1428571,0.1428571,
127 8 0.1428571,0.1428571,0.0714286,0. ,0. ,0. ,
128 9 0.0625 ,0.125 ,0.125 ,0.125 ,0.125 ,
129 9 0.125 ,0.125 ,0.125 ,0.0625 ,0. ,0. ,
130 a 0.0555556,0.1111111,0.1111111,0.1111111,0.1111111,
131 a 0.1111111,0.1111111,0.1111111,0.1111111,0.0555556,0. ,
132 b 0.05 ,0.1 ,0.1 ,0.1 ,0.1 ,
133 b 0.1 ,0.1 ,0.1 ,0.1 ,0.1 ,0.05 /
134 ! Position of nodes in the shell thickness
135 DATA zn1/
136 1 0. ,0. ,0. ,0. ,0. ,0. ,
137 1 0. ,0. ,0. ,0. ,0. ,0. ,
138 2 -.5 ,0.5 ,0. ,0. ,0. ,0. ,
139 2 0. ,0. ,0. ,0. ,0. ,0. ,
140 3 -.5 ,-.25 ,0.25 ,0.5 ,0. ,0. ,
141 3 0. ,0. ,0. ,0. ,0. ,0. ,
142 4 -.5 ,-.3333333,0. ,0.3333333,0.5 ,0. ,
143 4 0. ,0. ,0. ,0. ,0. ,0. ,
144 5 -.5 ,-.375 ,-0.125 ,0.125 ,0.375 ,0.5 ,
145 5 0. ,0. ,0. ,0. ,0. ,0. ,
146 6 -.5 ,-.4 ,-.2 ,0.0 ,0.2 ,0.4 ,
147 6 0.5 ,0. ,0. ,0. ,0. ,0. ,
148 7 -.5 ,-.4166667,-.25 ,-.0833333,0.0833333,0.25 ,
149 7 0.4166667,0.5 ,0. ,0. ,0. ,0. ,
150 8 -.5 ,-.4285715,-.2857143,-.1428572,0.0 ,0.1428572,
151 8 0.2857143,0.4285715,0.5 ,0. ,0. ,0. ,
152 9 -.5 ,-.4375 ,-.3125 ,-.1875 ,-.0625 ,0.0625 ,
153 9 0.1875 ,0.3125 ,0.4375 ,0.5 ,0. ,0. ,
154 a -.5 ,-.4444444,-.3333333,-.2222222,-.1111111,0. ,
155 a 0.1111111,0.2222222,0.3333333,0.4444444,0.5 ,0. ,
156 b -.5 ,-.45 ,-.35 ,-.25 ,-.15 ,-.05 ,
157 b 0.05 ,0.15 ,0.25 ,0.35 ,0.45 ,0.5 /
158C=======================================================================
159 ! Size of the non-local vectors
160 l_nloc = nloc_dmg%L_NLOC
161 ! Pointing the non-local forces vector
162 fnl => nloc_dmg%FNL(1:l_nloc,1)
163 vnl => nloc_dmg%VNL(1:l_nloc)
164 dnl => nloc_dmg%DNL(1:l_nloc)
165 unl => nloc_dmg%UNL(1:l_nloc)
166 mnl => nloc_dmg%MASS(1:l_nloc)
167 ! Number of the material law
168 imat = ixtg(1,1+nft)
169 ! Minimal length
170 le_min = sqrt((four/sqrt(three))*minval(area(numelc+nft+1:numelc+nft+nel)))
171 ! Number of integration points
172 ndof = elbuf_tab(ng)%BUFLY(1)%NPTT
173 ! Thickness of the shell
174 thck => elbuf_tab(ng)%GBUF%THK(1:nel)
175 ! Global minimal length
176 IF (ndof>1) THEN
177 le_min = min(le_min,minval(thck(1:nel))/ndof)
178 ENDIF
179 ! Non-local internal length
180 len = nloc_dmg%LEN(imat)
181 ! Maximal length of convergence
182 le_max = nloc_dmg%LE_MAX(imat)
183 ! Non-local damping
184 damp = nloc_dmg%DAMP(imat)
185 ! Non-local density
186 dens = nloc_dmg%DENS(imat)
187 ! Non-local sound speed
188 sspnl = nloc_dmg%SSPNL(imat)
189 ! Non-local timestep
190 dt_nl = min(dt_nl,0.5d0*((two*min(le_min,le_max)*sqrt(three*dens))/
191 . (sqrt(twelve*(len**2)+(min(le_min,le_max)**2)))))
192 ! Allocation of the velocities predictor
193 IF (ndof>1) THEN
194 IF (ndof > 2) THEN
195 ALLOCATE(vpred(nel,ndof+1))
196 ndnod = ndof+1
197 ELSE
198 ALLOCATE(vpred(nel,ndof))
199 ndnod = ndof
200 ENDIF
201 ENDIF
202 ! Number of integration points in the surface of the element
203 nptr = elbuf_tab(ng)%NPTR
204 npts = elbuf_tab(ng)%NPTS
205 ! Variable to regularize
206 IF (.NOT.ALLOCATED(var_reg)) ALLOCATE(var_reg(nel,ndof))
207c
208 ! Computation of kinematical data
209# include "vectorize.inc"
210 DO i = 1,nel
211 ! Coordinates of the nodes of the element
212 IF (nxref == 0) THEN
213 x1(i)=x(1,ixtg(2,nft+i))
214 y1(i)=x(2,ixtg(2,nft+i))
215 z1(i)=x(3,ixtg(2,nft+i))
216 x2(i)=x(1,ixtg(3,nft+i))
217 y2(i)=x(2,ixtg(3,nft+i))
218 z2(i)=x(3,ixtg(3,nft+i))
219 x3(i)=x(1,ixtg(4,nft+i))
220 y3(i)=x(2,ixtg(4,nft+i))
221 z3(i)=x(3,ixtg(4,nft+i))
222 ELSE
223 x1(i)=xreftg(1,1,nft+i)
224 y1(i)=xreftg(1,2,nft+i)
225 z1(i)=xreftg(1,3,nft+i)
226 x2(i)=xreftg(2,1,nft+i)
227 y2(i)=xreftg(2,2,nft+i)
228 z2(i)=xreftg(2,3,nft+i)
229 x3(i)=xreftg(3,1,nft+i)
230 y3(i)=xreftg(3,2,nft+i)
231 z3(i)=xreftg(3,3,nft+i)
232 ENDIF
233c
234 ! Recovering the nodes of the non-local element
235 n1 = nloc_dmg%IDXI(ixtg(2,nft+i))
236 n2 = nloc_dmg%IDXI(ixtg(3,nft+i))
237 n3 = nloc_dmg%IDXI(ixtg(4,nft+i))
238 ! Recovering the positions of the first d.o.fs of each nodes
239 pos1(i) = nloc_dmg%POSI(n1)
240 pos2(i) = nloc_dmg%POSI(n2)
241 pos3(i) = nloc_dmg%POSI(n3)
242 ENDDO
243c
244 ! Loop over Gauss points in the thickness
245 DO k = 1,ndof
246 ! Loop over element
247# include "vectorize.inc"
248 DO i = 1,nel
249 var_reg(i,k) = third*(dnl(pos1(i)+k-1)
250 . + dnl(pos2(i)+k-1)
251 . + dnl(pos3(i)+k-1))
252 ENDDO
253 ENDDO
254c
255 CALL cdkevec3(1 ,nel ,surf,
256 . x1 ,x2 ,x3 ,y1 ,y2 ,
257 . y3 ,z1 ,z2 ,z3 ,
258 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,
259 . e1z ,e2z ,e3z )
260C
261 ! Filling internal variable data of the non-local material
262 CALL cnloc_matini(elbuf_tab(ng),nel ,ipm ,
263 . bufmat ,time ,var_reg ,
264 . failure )
265C
266 !-----------------------------------------------------------------------
267 ! Computation of the element volume and the BtB matrix product
268 !-----------------------------------------------------------------------
269 ! Loop over elements
270# include "vectorize.inc"
271 DO i=1,nel
272c
273 ! Computation of the shape functions derivatives
274 x2l(i) = e1x(i)*(x2(i)-x1(i))+e1y(i)*(y2(i)-y1(i))+e1z(i)*(z2(i)-z1(i))
275 y2l(i) = e2x(i)*(x2(i)-x1(i))+e2y(i)*(y2(i)-y1(i))+e2z(i)*(z2(i)-z1(i))
276 y3l(i) = e2x(i)*(x3(i)-x1(i))+e2y(i)*(y3(i)-y1(i))+e2z(i)*(z3(i)-z1(i))
277 x3l(i) = e1x(i)*(x3(i)-x1(i))+e1y(i)*(y3(i)-y1(i))+e1z(i)*(z3(i)-z1(i))
278c
279 ! Computation of the shape functions derivatives
280 px1(i) = (y2l(i)-y3l(i))*(half/surf(i))
281 py1(i) = (x3l(i)-x2l(i))*(half/surf(i))
282 px2(i) = y3l(i)*(half/surf(i))
283 py2(i) = -x3l(i)*(half/surf(i))
284c
285 ! Computation of the product BtxB
286 btb11(i) = px1(i)**2 + py1(i)**2
287 btb12(i) = -px1(i)**2 + py1(i)*py2(i)
288 btb13(i) = -py1(i)*(py1(i)+py2(i))
289 btb22(i) = px1(i)**2 + py2(i)**2
290 btb23(i) = -py2(i)*(py1(i)+py2(i))
291 btb33(i) = (py1(i)+py2(i))**2
292c
293 ! Computation of the element volume
294 vols(i) = area(numelc+nft+i)*thck(i)
295c
296 ! To check if element is not broken
297 offg(i) = elbuf_tab(ng)%GBUF%OFF(i)
298 ENDDO
299c
300 !-----------------------------------------------------------------------
301 ! Pre-treatment non-local regularization in the thickness
302 !-----------------------------------------------------------------------
303 ! Only if NDOF > 1
304 IF ((ndof > 1).AND.(len>zero)) THEN
305c
306 ! Pointing the non-local values in the thickness of the corresponding element
307 bufnl => elbuf_tab(ng)%NLOC(1,1)
308c
309 ! Pointing the non-local values in the thickness of the corresponding element
310 massth => bufnl%MASSTH(1:nel,1:ndnod)
311 unlth => bufnl%UNLTH(1:nel ,1:ndnod)
312 vnlth => bufnl%VNLTH(1:nel ,1:ndnod)
313 fnlth => bufnl%FNLTH(1:nel ,1:ndnod)
314c
315 DO k = 1,ndnod
316 DO i = 1,nel
317 ! Prediction of the velocities
318 vpred(i,k) = vnlth(i,k) - (fnlth(i,k)/massth(i,k))*(dt_nl/two)
319 ENDDO
320 ENDDO
321 DO k = 1,ndnod
322 DO i = 1,nel
323 ! Resetting non-local forces
324 fnlth(i,k) = zero
325 ENDDO
326 ENDDO
327c
328 ! Computation of non-local forces in the shell thickness
329 DO k = 1, ndof
330c
331 ! Computation of shape functions value
332 IF ((ndof==2).AND.(k==2)) THEN
333 nth1 = (z01(k,ndof) - zn1(k,ndof))/(zn1(k-1,ndof) - zn1(k,ndof))
334 nth2 = (z01(k,ndof) - zn1(k-1,ndof)) /(zn1(k,ndof) - zn1(k-1,ndof))
335 ELSE
336 nth1 = (z01(k,ndof) - zn1(k+1,ndof))/(zn1(k,ndof) - zn1(k+1,ndof))
337 nth2 = (z01(k,ndof) - zn1(k,ndof)) /(zn1(k+1,ndof) - zn1(k,ndof))
338 ENDIF
339c
340 ! Loop over elements
341 DO i = 1,nel
342 ! Computation of B-matrix values
343 IF ((ndof==2).AND.(k==2)) THEN
344 bth1 = (one/(zn1(k-1,ndof) - zn1(k,ndof)))*(one/thck(i))
345 bth2 = (one/(zn1(k,ndof) - zn1(k-1,ndof)))*(one/thck(i))
346 ELSE
347 bth1 = (one/(zn1(k,ndof) - zn1(k+1,ndof)))*(one/thck(i))
348 bth2 = (one/(zn1(k+1,ndof) - zn1(k,ndof)))*(one/thck(i))
349 ENDIF
350c
351 ! Computation of the non-local K matrix
352 k1 = (len**2)*(bth1**2) + nth1**2
353 k12 = (len**2)*(bth1*bth2)+ (nth1*nth2)
354 k2 = (len**2)*(bth2**2) + nth2**2
355c
356 ! Computation of the non-local forces
357 IF ((ndof==2).AND.(k==2)) THEN
358 fnlth(i,k-1) = fnlth(i,k-1) + (k1*unlth(i,k-1) + k12*unlth(i,k)
359 . + damp*((nth1**2)*vpred(i,k-1)
360 . + (nth1*nth2)*vpred(i,k))
361 . - (nth1*var_reg(i,k)))*vols(i)*wf1(k,ndof)
362 fnlth(i,k) = fnlth(i,k) + (k12*unlth(i,k-1) + k2*unlth(i,k)
363 . + damp*(nth1*nth2*vpred(i,k-1)
364 . + (nth2**2)*vpred(i,k))
365 . - nth2*var_reg(i,k))*vols(i)*wf1(k,ndof)
366 ELSE
367 fnlth(i,k) = fnlth(i,k) + (k1*unlth(i,k) + k12*unlth(i,k+1)
368 . + damp*((nth1**2)*vpred(i,k)
369 . + (nth1*nth2)*vpred(i,k+1))
370 . - (nth1*var_reg(i,k)))*vols(i)*wf1(k,ndof)
371 fnlth(i,k+1) = fnlth(i,k+1) + (k12*unlth(i,k) + k2*unlth(i,k+1)
372 . + damp*(nth1*nth2*vpred(i,k)
373 . + (nth2**2)*vpred(i,k+1))
374 . - nth2*var_reg(i,k))*vols(i)*wf1(k,ndof)
375 ENDIF
376 ENDDO
377 ENDDO
378c
379 DO k = 1,ndnod
380 DO i = 1,nel
381 ! Updating the non-local in-thickness velocities
382 vnlth(i,k) = vnlth(i,k) - (fnlth(i,k)/massth(i,k))*dt_nl
383 ENDDO
384 ENDDO
385c
386 DO k = 1,ndnod
387 DO i = 1,nel
388 ! Computing the non-local in-thickness cumulated values
389 unlth(i,k) = unlth(i,k) + vnlth(i,k)*dt_nl
390 ENDDO
391 ENDDO
392c
393 ! Transfer at the integration point
394 DO k = 1, ndof
395 !Computation of shape functions value
396 IF ((ndof==2).AND.(k==2)) THEN
397 nth1 = (z01(k,ndof) - zn1(k,ndof))/(zn1(k-1,ndof) - zn1(k,ndof))
398 nth2 = (z01(k,ndof) - zn1(k-1,ndof)) /(zn1(k,ndof) - zn1(k-1,ndof))
399 ELSE
400 nth1 = (z01(k,ndof) - zn1(k+1,ndof))/(zn1(k,ndof) - zn1(k+1,ndof))
401 nth2 = (z01(k,ndof) - zn1(k,ndof)) /(zn1(k+1,ndof) - zn1(k,ndof))
402 ENDIF
403 ! Loop over elements
404 DO i = 1,nel
405 !Integration points non-local variables
406 IF ((ndof==2).AND.(k==2)) THEN
407 var_reg(i,k) = nth1*unlth(i,k-1) + nth2*unlth(i,k)
408 ELSE
409 var_reg(i,k) = nth1*unlth(i,k) + nth2*unlth(i,k+1)
410 ENDIF
411 ENDDO
412 ENDDO
413c
414 DO ir = 1,nptr
415 DO is = 1,npts
416 bufnl => elbuf_tab(ng)%NLOC(ir,is)
417 bufnl%MASSTH(1:nel,1:ndnod) = elbuf_tab(ng)%NLOC(1,1)%MASSTH(1:nel,1:ndnod)
418 bufnl%MASSTH(1:nel,1:ndnod) = elbuf_tab(ng)%NLOC(1,1)%UNLTH(1:nel,1:ndnod)
419 bufnl%MASSTH(1:nel,1:ndnod) = elbuf_tab(ng)%NLOC(1,1)%VNLTH(1:nel,1:ndnod)
420 bufnl%MASSTH(1:nel,1:ndnod) = elbuf_tab(ng)%NLOC(1,1)%FNLTH(1:nel,1:ndnod)
421 ENDDO
422 ENDDO
423 ENDIF
424c
425 !-----------------------------------------------------------------------
426 ! Computation of the elementary non-local forces
427 !-----------------------------------------------------------------------
428 ! Loop over integration points in the thickness
429 DO k = 1,ndof
430c
431 ! Computation of non-local forces
432# include "vectorize.inc"
433 DO i = 1,nel
434c
435 ! If the element is not broken
436 IF (offg(i) > zero) THEN
437c
438 ! Computing the product BtB*UNL
439 b1 = ((len**2)*vols(i))*wf1(k,ndof)*(btb11(i)*unl(pos1(i)+k-1) + btb12(i)*unl(pos2(i)+k-1)
440 . + btb13(i)*unl(pos3(i)+k-1))
441 b2 = ((len**2)*vols(i))*wf1(k,ndof)*(btb12(i)*unl(pos1(i)+k-1) + btb22(i)*unl(pos2(i)+k-1)
442 . + btb23(i)*unl(pos3(i)+k-1))
443 b3 = ((len**2)*vols(i))*wf1(k,ndof)*(btb13(i)*unl(pos1(i)+k-1) + btb23(i)*unl(pos2(i)+k-1)
444 . + btb33(i)*unl(pos3(i)+k-1))
445 ! Computing the product NtN*UNL
446 ntn_unl = ((unl(pos1(i)+k-1) + unl(pos2(i)+k-1) + unl(pos3(i)+k-1))*third*third)*vols(i)*wf1(k,ndof)
447 ! Computing the product DAMP*NtN*VNL!
448 ntn_vnl = ((vnl(pos1(i)+k-1) + vnl(pos2(i)+k-1) + vnl(pos3(i)+k-1))*third*third)*damp*vols(i)*wf1(k,ndof)
449 ! Introducing the internal variable to be regularized
450 ntvar = var_reg(i,k)*third*vols(i)*wf1(k,ndof)
451 !Computing the elementary non-local forces
452 fnl(pos1(i)+k-1) = fnl(pos1(i)+k-1) - (ntn_unl + ntn_vnl - ntvar + b1)
453 fnl(pos2(i)+k-1) = fnl(pos2(i)+k-1) - (ntn_unl + ntn_vnl - ntvar + b2)
454 fnl(pos3(i)+k-1) = fnl(pos3(i)+k-1) - (ntn_unl + ntn_vnl - ntvar + b3)
455 ELSE
456 ! Non-local absorbing forces
457 fnl(pos1(i)+k-1) = fnl(pos1(i)+k-1) -
458 . wf1(k,ndof)*dens*sspnl*vnl(pos1(i)+k-1)*sqrt((four/sqrt(three))*(le_max**2))*thck(i)
459 fnl(pos2(i)+k-1) = fnl(pos2(i)+k-1) -
460 . wf1(k,ndof)*dens*sspnl*vnl(pos2(i)+k-1)*sqrt((four/sqrt(three))*(le_max**2))*thck(i)
461 fnl(pos3(i)+k-1) = fnl(pos3(i)+k-1) -
462 . wf1(k,ndof)*dens*sspnl*vnl(pos3(i)+k-1)*sqrt((four/sqrt(three))*(le_max**2))*thck(i)
463 ENDIF
464 ENDDO
465 ENDDO
466c -------------------
467 IF (ALLOCATED(var_reg)) DEALLOCATE(var_reg)
468 IF (ALLOCATED(vpred)) DEALLOCATE(vpred)
469 END
cdkevec3
subroutine cdkevec3(jft, jlt, area, x1, x2, x3, y1, y2, y3, z1, z2, z3, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
Definition cdkevec3.F:38
cdkfint_reg_ini
subroutine cdkfint_reg_ini(elbuf_tab, nloc_dmg, area, ixtg, dt_nl, x, xreftg, nft, nel, ng, ipm, bufmat, time, failure)
Definition cdkfint_reg_ini.F:37
cnloc_matini
subroutine cnloc_matini(elbuf_str, nel, ipm, bufmat, time, varnl, failure)
Definition cnloc_matini.F:38
my_real
#define my_real
Definition cppsort.cpp:32
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
min
#define min(a, b)
Definition macros.h:20
message_mod
Definition message_mod.F:1257
nlocal_reg_mod
Definition nlocal_reg_mod.F:119