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