OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
nloc_dmg_init.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!||====================================================================
25!|| nloc_dmg_init ../starter/source/materials/fail/nloc_dmg_init.F
26!||--- called by ------------------------------------------------------
27!|| initia ../starter/source/elements/initia/initia.F
28!||--- calls -----------------------------------------------------
29!|| ancmsg ../starter/source/output/message/message.F
30!||--- uses -----------------------------------------------------
31!|| message_mod ../starter/share/message_module/message_mod.F
32!||====================================================================
33 SUBROUTINE nloc_dmg_init(ELBUF_TAB,NLOC_DMG ,IPARG ,IXC ,
34 . IXS ,IXTG ,AREA ,DTELEM ,
35 . NUMEL ,IPM ,X ,XREFS ,
36 . XREFC ,XREFTG ,BUFMAT ,PM )
37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE my_alloc_mod
41 USE elbufdef_mod
42 USE message_mod
43 USE nlocal_reg_mod
44 USE inoutfile_mod
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "param_c.inc"
53#include "com01_c.inc"
54#include "com04_c.inc"
55#include "scr15_c.inc"
56#include "units_c.inc"
57#include "r2r_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER NUMEL
62 INTEGER IPARG(NPARG,NGROUP),IXS(NIXS,*),IXC(NIXC,*),IXTG(NIXTG,*)
63 INTEGER IPM(NPROPMI,*)
64 TYPE(elbuf_struct_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
65 TYPE (NLOCAL_STR_) , TARGET :: NLOC_DMG
66 my_real,
67 . DIMENSION(NUMELC+NUMELTG),INTENT(IN) :: area
68 my_real,
69 . DIMENSION(NUMEL), INTENT(INOUT) :: dtelem
70 my_real
71 . x(3,*),xrefc(4,3,*),xreftg(3,3,*),xrefs(8,3,*),bufmat(*),
72 . pm(npropm,*)
73 TARGET bufmat
74C-----------------------------------------------
75C L o c a l V a r i a b l e s
76C-----------------------------------------------
77 CHARACTER FILNAM*109, KEYA*80, KEYA2*80
78 CHARACTER(len=2148) :: TMP_NAME
79 LOGICAL :: ENG_FILE
80 INTEGER I,J,K,NG,NEL,NFT,ITY,NPTT,ILOC,INOD,NNOD,NDEPAR,IMAT,
81 . l_nloc,pos,ndd,isolid,n,numels_nl,igtyp,numelc_nl,nddmax,
82 . numeltg_nl,nptr,npts,ir,is,isolnod,io_err1,len_tmp_name,
83 . ideb,iadbuf,matsize,error,nelen_max,posn
84 INTEGER, DIMENSION(8) :: IDXND,NODE_ID
85 INTEGER, DIMENSION(:,:), ALLOCATABLE :: TAGNOD,SOLNOD
86 INTEGER, DIMENSION(:), ALLOCATABLE :: INDX,IDXI,NMAT,NDDL,
87 . posi,itri,index,tagtet,tagpent,islnod,nelen,itrin,idelem,
88 . iaddn
89 INTEGER, DIMENSION(:,:), POINTER :: IADS
90 my_real
91 . DENS, DTMIN, LEN, SSPNL,NTH1, NTH2,
92 . z01(11,11), wf1(11,11), zn1(12,11),damp,ws,le_min,
93 . dtsca_ams,dtsca_cst_ams,le_max,ssp,
94 . dtmini_ams,dtmini_cst_ams,dtmini
95 my_real, DIMENSION(:,:), ALLOCATABLE ::
96 . warn_lenght
97 my_real, DIMENSION(:) , ALLOCATABLE ::
98 . voln, volu, volnod, volsort
99 my_real ,DIMENSION(:) , POINTER ::
100 . vol, thck, uparam
101 TYPE(buf_nloc_), POINTER :: BUFNL
102 TYPE(buf_nlocts_), POINTER :: BUFNLTS
103 my_real, DIMENSION(:,:), POINTER ::
104 . massth
105 LOGICAL, DIMENSION(8) :: BOOL
106 ! Damping ratio ZETA
107 ! ZETA = 0 : Undamped
108 ! 0 < ZETA < 1 : Underdamped
109 ! ZETA = 1 : Critically damped
110 ! ZETA > 1 : Overdamped
111 my_real, PARAMETER :: zeta = 0.2d0
112 ! Safety coefficient for non-local stability vs mechanical stability
113 ! (here we have a good compromise to find, DENS must be as low as
114 ! possible but sufficiently high to avoid the decrease of the timestep)
115 my_real, PARAMETER :: csta = 40.0d0
116 ! Position of integration points in the 2D shell thickness
117 DATA z01/
118 1 0. ,0. ,0. ,0. ,0. ,
119 1 0. ,0. ,0. ,0. ,0. ,0. ,
120 2 -.5 ,0.5 ,0. ,0. ,0. ,
121 2 0. ,0. ,0. ,0. ,0. ,0. ,
122 3 -.5 ,0. ,0.5 ,0. ,0. ,
123 3 0. ,0. ,0. ,0. ,0. ,0. ,
124 4 -.5 ,-.1666667,0.1666667,0.5 ,0. ,
125 4 0. ,0. ,0. ,0. ,0. ,0. ,
126 5 -.5 ,-.25 ,0. ,0.25 ,0.5 ,
127 5 0. ,0. ,0. ,0. ,0. ,0. ,
128 6 -.5 ,-.3 ,-.1 ,0.1 ,0.3 ,
129 6 0.5 ,0. ,0. ,0. ,0. ,0. ,
130 7 -.5 ,-.3333333,-.1666667,0.0 ,0.1666667,
131 7 0.3333333,0.5 ,0. ,0. ,0. ,0. ,
132 8 -.5 ,-.3571429,-.2142857,-.0714286,0.0714286,
133 8 0.2142857,0.3571429,0.5 ,0. ,0. ,0. ,
134 9 -.5 ,-.375 ,-.25 ,-.125 ,0.0 ,
135 9 0.125 ,0.25 ,0.375 ,0.5 ,0. ,0. ,
136 a -.5 ,-.3888889,-.2777778,-.1666667,-.0555555,
137 a 0.0555555,0.1666667,0.2777778,0.3888889,0.5 ,0. ,
138 b -.5 ,-.4 ,-.3 ,-.2 ,-.1 ,
139 b 0. ,0.1 ,0.2 ,0.3 ,0.4 ,0.5 /
140 ! Weights of integration in the 2D shell thickness
141 DATA wf1/
142 1 1. ,0. ,0. ,0. ,0. ,
143 1 0. ,0. ,0. ,0. ,0. ,0. ,
144 2 0.5 ,0.5 ,0. ,0. ,0. ,
145 2 0. ,0. ,0. ,0. ,0. ,0. ,
146 3 0.25 ,0.5 ,0.25 ,0. ,0. ,
147 3 0. ,0. ,0. ,0. ,0. ,0. ,
148 4 0.1666667,0.3333333,0.3333333,0.1666667,0. ,
149 4 0. ,0. ,0. ,0. ,0. ,0. ,
150 5 0.125 ,0.25 ,0.25 ,0.25 ,0.125 ,
151 5 0. ,0. ,0. ,0. ,0. ,0. ,
152 6 0.1 ,0.2 ,0.2 ,0.2 ,0.2 ,
153 6 0.1 ,0. ,0. ,0. ,0. ,0. ,
154 7 0.0833333,0.1666667,0.1666667,0.1666667,0.1666667,
155 7 0.1666667,0.0833333,0. ,0. ,0. ,0. ,
156 8 0.0714286,0.1428571,0.1428571,0.1428571,0.1428571,
157 8 0.1428571,0.1428571,0.0714286,0. ,0. ,0. ,
158 9 0.0625 ,0.125 ,0.125 ,0.125 ,0.125 ,
159 9 0.125 ,0.125 ,0.125 ,0.0625 ,0. ,0. ,
160 a 0.0555556,0.1111111,0.1111111,0.1111111,0.1111111,
161 a 0.1111111,0.1111111,0.1111111,0.1111111,0.0555556,0. ,
162 b 0.05 ,0.1 ,0.1 ,0.1 ,0.1 ,
163 b 0.1 ,0.1 ,0.1 ,0.1 ,0.1 ,0.05 /
164 ! Position of nodes in the 2D shell thickness
165 DATA zn1/
166 1 0. ,0. ,0. ,0. ,0. ,0. ,
167 1 0. ,0. ,0. ,0. ,0. ,0. ,
168 2 -.5 ,0.5 ,0. ,0. ,0. ,0. ,
169 2 0. ,0. ,0. ,0. ,0. ,0. ,
170 3 -.5 ,-.25 ,0.25 ,0.5 ,0. ,0. ,
171 3 0. ,0. ,0. ,0. ,0. ,0. ,
172 4 -.5 ,-.3333333,0. ,0.3333333,0.5 ,0. ,
173 4 0. ,0. ,0. ,0. ,0. ,0. ,
174 5 -.5 ,-.375 ,-0.125 ,0.125 ,0.375 ,0.5 ,
175 5 0. ,0. ,0. ,0. ,0. ,0. ,
176 6 -.5 ,-.4 ,-.2 ,0.0 ,0.2 ,0.4 ,
177 6 0.5 ,0. ,0. ,0. ,0. ,0. ,
178 7 -.5 ,-.4166667,-.25 ,-.0833333,0.0833333,0.25 ,
179 7 0.4166667,0.5 ,0. ,0. ,0. ,0. ,
180 8 -.5 ,-.4285715,-.2857143,-.1428572,0.0 ,0.1428572,
181 8 0.2857143,0.4285715,0.5 ,0. ,0. ,0. ,
182 9 -.5 ,-.4375 ,-.3125 ,-.1875 ,-.0625 ,0.0625 ,
183 9 0.1875 ,0.3125 ,0.4375 ,0.5 ,0. ,0. ,
184 a -.5 ,-.4444444,-.3333333,-.2222222,-.1111111,0. ,
185 a 0.1111111,0.2222222,0.3333333,0.4444444,0.5 ,0. ,
186 b -.5 ,-.45 ,-.35 ,-.25 ,-.15 ,-.05 ,
187 b 0.05 ,0.15 ,0.25 ,0.35 ,0.45 ,0.5 /
188 my_real
189 . w_gauss(9,9),a_gauss(9,9),z_gauss(10,9)
190 ! Weights of integration points in the thickshell thickness
191 DATA w_gauss /
192 1 2. ,0. ,0. ,
193 1 0. ,0. ,0. ,
194 1 0. ,0. ,0. ,
195 2 1. ,1. ,0. ,
196 2 0. ,0. ,0. ,
197 2 0. ,0. ,0. ,
198 3 0.555555555555556,0.888888888888889,0.555555555555556,
199 3 0. ,0. ,0. ,
200 3 0. ,0. ,0. ,
201 4 0.347854845137454,0.652145154862546,0.652145154862546,
202 4 0.347854845137454,0. ,0. ,
203 4 0. ,0. ,0. ,
204 5 0.236926885056189,0.478628670499366,0.568888888888889,
205 5 0.478628670499366,0.236926885056189,0. ,
206 5 0. ,0. ,0. ,
207 6 0.171324492379170,0.360761573048139,0.467913934572691,
208 6 0.467913934572691,0.360761573048139,0.171324492379170,
209 6 0. ,0. ,0. ,
210 7 0.129484966168870,0.279705391489277,0.381830050505119,
211 7 0.417959183673469,0.381830050505119,0.279705391489277,
212 7 0.129484966168870,0. ,0. ,
213 8 0.101228536290376,0.222381034453374,0.313706645877887,
214 8 0.362683783378362,0.362683783378362,0.313706645877887,
215 8 0.222381034453374,0.101228536290376,0. ,
216 9 0.081274388361574,0.180648160694857,0.260610696402935,
217 9 0.312347077040003,0.330239355001260,0.312347077040003,
218 9 0.260610696402935,0.180648160694857,0.081274388361574/
219 ! Position of integration points in the thickshell thickness
220 DATA a_gauss /
221 1 0. ,0. ,0. ,
222 1 0. ,0. ,0. ,
223 1 0. ,0. ,0. ,
224 2 -.577350269189626,0.577350269189626,0. ,
225 2 0. ,0. ,0. ,
226 2 0. ,0. ,0. ,
227 3 -.774596669241483,0. ,0.774596669241483,
228 3 0. ,0. ,0. ,
229 3 0. ,0. ,0. ,
230 4 -.861136311594053,-.339981043584856,0.339981043584856,
231 4 0.861136311594053,0. ,0. ,
232 4 0. ,0. ,0. ,
233 5 -.906179845938664,-.538469310105683,0. ,
234 5 0.538469310105683,0.906179845938664,0. ,
235 5 0. ,0. ,0. ,
236 6 -.932469514203152,-.661209386466265,-.238619186083197,
237 6 0.238619186083197,0.661209386466265,0.932469514203152,
238 6 0. ,0. ,0. ,
239 7 -.949107912342759,-.741531185599394,-.405845151377397,
240 7 0. ,0.405845151377397,0.741531185599394,
241 7 0.949107912342759,0. ,0. ,
242 8 -.960289856497536,-.796666477413627,-.525532409916329,
243 8 -.183434642495650,0.183434642495650,0.525532409916329,
244 8 0.796666477413627,0.960289856497536,0. ,
245 9 -.968160239507626,-.836031107326636,-.613371432700590,
246 9 -.324253423403809,0. ,0.324253423403809,
247 9 0.613371432700590,0.836031107326636,0.968160239507626/
248 ! Position of nodes in the thickshell thickness
249 DATA z_gauss /
250 1 0. ,0. ,0. ,
251 1 0. ,0. ,0. ,
252 1 0. ,0. ,0. ,
253 1 0. ,
254 2 -1. ,0. ,1. ,
255 2 0. ,0. ,0. ,
256 2 0. ,0. ,0. ,
257 2 0. ,
258 3 -1. ,-.549193338482966,0.549193338482966,
259 3 1. ,0. ,0. ,
260 3 0. ,0. ,0. ,
261 3 0. ,
262 4 -1. ,-.600558677589454,0. ,
263 4 0.600558677589454,1. ,0. ,
264 4 0. ,0. ,0. ,
265 4 0. ,
266 5 -1. ,-.812359691877328,-.264578928334038,
267 5 0.264578928334038,0.812359691877328,1. ,
268 5 0. ,0. ,0. ,
269 5 0. ,
270 6 -1. ,-.796839450334708,-.449914286274731,
271 6 0. ,0.449914286274731,0.796839450334708,
272 6 1. ,0. ,0. ,
273 6 0. ,
274 7 -1. ,-.898215824685518,-.584846546513270,
275 7 -.226843756241524,0.226843756241524,0.584846546513270,
276 7 0.898215824685518,1. ,0. ,
277 7 0. ,
278 8 -1. ,-.878478166955581,-.661099443664978,
279 8 -.354483526205989,0. ,0.354483526205989,
280 8 0.661099443664978,0.878478166955581,1. ,
281 8 0. ,
282 9 -1. ,-.936320479015252,-.735741735638020,
283 9 -.491001129763160,-.157505717044458,0.157505717044458,
284 9 0.491001129763160,0.735741735638020,0.936320479015252,
285 9 1. /
286C=======================================================================
287 ! If the non-local method is not used
288 IF (nloc_dmg%IMOD == 0) THEN
289 nloc_dmg%NNOD = 0
290 nloc_dmg%L_NLOC = 0
291 nloc_dmg%NUMELS_NL = 0
292 nloc_dmg%NUMELC_NL = 0
293 nloc_dmg%NUMELTG_NL = 0
294 nloc_dmg%NDDMAX = 0
295 IF (.NOT.ALLOCATED(nloc_dmg%DENS)) ALLOCATE(nloc_dmg%DENS(0))
296 IF (.NOT.ALLOCATED(nloc_dmg%DAMP)) ALLOCATE(nloc_dmg%DAMP(0))
297 IF (.NOT.ALLOCATED(nloc_dmg%LEN)) ALLOCATE(nloc_dmg%LEN(0))
298 IF (.NOT.ALLOCATED(nloc_dmg%LE_MAX)) ALLOCATE(nloc_dmg%LE_MAX(0))
299 IF (.NOT.ALLOCATED(nloc_dmg%SSPNL)) ALLOCATE(nloc_dmg%SSPNL(0))
300 IF (.NOT.ALLOCATED(nloc_dmg%INDX)) ALLOCATE(nloc_dmg%INDX(0))
301 IF (.NOT.ALLOCATED(nloc_dmg%POSI)) ALLOCATE(nloc_dmg%POSI(0))
302 IF (.NOT.ALLOCATED(nloc_dmg%IDXI)) ALLOCATE(nloc_dmg%IDXI(0))
303 IF (.NOT.ALLOCATED(nloc_dmg%ADDCNE)) ALLOCATE(nloc_dmg%ADDCNE(0))
304 IF (.NOT.ALLOCATED(nloc_dmg%CNE)) ALLOCATE(nloc_dmg%CNE(0))
305 IF (.NOT.ALLOCATED(nloc_dmg%IADS)) ALLOCATE(nloc_dmg%IADS(0,0))
306 IF (.NOT.ALLOCATED(nloc_dmg%IADC)) ALLOCATE(nloc_dmg%IADC(0,0))
307 IF (.NOT.ALLOCATED(nloc_dmg%IADTG)) ALLOCATE(nloc_dmg%IADTG(0,0))
308 IF (.NOT.ALLOCATED(nloc_dmg%MASS)) ALLOCATE(nloc_dmg%MASS(0))
309 IF (.NOT.ALLOCATED(nloc_dmg%MASS0)) ALLOCATE(nloc_dmg%MASS0(0))
310 IF (.NOT.ALLOCATED(nloc_dmg%FNL)) ALLOCATE(nloc_dmg%FNL(0,0))
311 IF (.NOT.ALLOCATED(nloc_dmg%VNL)) ALLOCATE(nloc_dmg%VNL(0))
312 IF (.NOT.ALLOCATED(nloc_dmg%VNL_OLD)) ALLOCATE(nloc_dmg%VNL_OLD(0))
313 IF (.NOT.ALLOCATED(nloc_dmg%DNL)) ALLOCATE(nloc_dmg%DNL(0))
314 IF (.NOT.ALLOCATED(nloc_dmg%UNL)) ALLOCATE(nloc_dmg%UNL(0))
315 IF (.NOT.ALLOCATED(nloc_dmg%STIFNL)) ALLOCATE(nloc_dmg%STIFNL(0,0))
316 IF (.NOT.ALLOCATED(nloc_dmg%FSKY)) ALLOCATE(nloc_dmg%FSKY(0,0))
317 IF (.NOT.ALLOCATED(nloc_dmg%STSKY)) ALLOCATE(nloc_dmg%STSKY(0,0))
318 IF (.NOT.ALLOCATED(nloc_dmg%IAD_ELEM)) ALLOCATE(nloc_dmg%IAD_ELEM(0))
319 IF (.NOT.ALLOCATED(nloc_dmg%IAD_SIZE)) ALLOCATE(nloc_dmg%IAD_SIZE(0))
320 IF (.NOT.ALLOCATED(nloc_dmg%FR_ELEM)) ALLOCATE(nloc_dmg%FR_ELEM(0))
321c
322 ! If non-local method is used
323 ELSE
324c
325 ! Writing header
326 WRITE(istdo,'(A)') ' .. NON-LOCAL STRUCTURE INITIALIZATION'
327c
328 ! Allocation of tables
329 ALLOCATE( tagnod(numnod,3) )
330 ALLOCATE( indx(numnod) )
331 ALLOCATE( idxi(numnod) )
332 ALLOCATE( nddl(numnod) )
333 ALLOCATE( nmat(numnod) )
334 ALLOCATE( posi(numnod+1) )
335 ALLOCATE( islnod(numels))
336 ALLOCATE( solnod(8,numels))
337 ALLOCATE( volu(numels+numelc+numeltg) )
338 ALLOCATE( volnod(numels+numelc+numeltg))
339 ALLOCATE( tagtet(numels) )
340 ALLOCATE( tagpent(numels))
341 ALLOCATE( nelen(numnod))
342 ALLOCATE( index(numels+numelc+numeltg) )
343 ALLOCATE( itri(numels+numelc+numeltg) )
344C
345 IF (nsubdom > 0) THEN
346C-- multidomains - original nummat is used
347 matsize = nummat0
348 ELSE
349 matsize = nummat
350 ENDIF
351 CALL my_alloc(warn_lenght,matsize,3)
352c
353 ! Initialization of variables
354 volu(1:numels+numelc+numeltg) = zero
355 volnod(1:numels+numelc+numeltg) = zero
356 index(1:numels+numelc+numeltg) = 0
357 itri(1:numels+numelc+numeltg) = 0
358 tagnod(1:numnod,1:3) = 0
359 tagtet(1:numels) = 0
360 tagpent(1:numels) = 0
361 nelen(1:numnod) = 0
362 numels_nl = 0
363 numelc_nl = 0
364 numeltg_nl = 0
365 nddmax = 0
366 warn_lenght(1:matsize,1:3) = zero
367c
368 ! Computation of the volume of elements
369 DO ng=1,ngroup
370 ! Flag for non-local regularization
371 iloc = iparg(78,ng)
372 ! Property
373 igtyp = iparg(38,ng)
374 ! Number of elements in the group
375 nel = iparg(2,ng)
376 IF (iloc > 0) THEN
377 ! First element of the group
378 nft = iparg(3,ng)
379 ! Type of elements
380 ity = iparg(5,ng)
381 ! Formulation of the elements (under-integrated,fully integrated,...)
382 isolid = iparg(23,ng)
383 ! For brick elements
384 IF (ity == 1) THEN
385 ! Non-supported property
386 IF ((igtyp /= 14).AND.(igtyp /= 6).AND.(igtyp /= 20).AND.(igtyp /= 21)) THEN
387 CALL ancmsg(msgid=1661,msgtype=msgerror,
388 . anmode=aninfo_blind,i1=igtyp)
389 ENDIF
390 ! To detect tetra elements
391 isolnod = iparg(28,ng)
392 ! Volume of the element
393 vol => elbuf_tab(ng)%GBUF%VOL(1:nel)
394 ! Index and sorting table
395 DO k = 1,nel
396 index(numels_nl+k) = k + nft
397 itri(k+nft) = ixs(11,k+nft)
398 volu(k+nft) = vol(k)
399 ENDDO
400 ! Counting non-local solid elements
401 numels_nl = numels_nl + nel
402 ! Number of layers
403 nptt = elbuf_tab(ng)%NLAY
404 ! Material Law ID
405 imat = ixs(1,1+nft)
406 ! Tetra 4 element
407 IF (isolnod == 4) THEN
408 ! Loop over elements
409 DO i=1,nel
410 ! Tag tetra element
411 tagtet(i+nft) = 1
412 ! Loop over tetra nodes
413 DO j=1,4
414 ! Number of the nodes
415 IF (j == 1) k = 2
416 IF (j == 2) k = 4
417 IF (j == 3) k = 7
418 IF (j == 4) k = 6
419 inod = ixs(k,i+nft)
420 ! Count the elements attached to the node
421 nelen(inod) = nelen(inod) + 1
422 ! Tag the node as non-local
423 tagnod(inod,1) = 1
424 ! Tag the number of additional d.o.fs
425 tagnod(inod,2) = 1
426 ! If already written and different => error
427 IF ((tagnod(inod,3) /= 0).AND.(tagnod(inod,3) /= imat)) THEN
428 CALL ancmsg(msgid=1656,msgtype=msgerror,
429 . anmode=aninfo_blind_1,i1=inod,i2=imat,i3=tagnod(inod,3))
430 ENDIF
431 ! Tag the material law id of the node
432 tagnod(inod,3) = imat
433 ! Nodal volume contribution of current element
434 volnod(i+nft) = fourth*vol(i)
435 ENDDO
436 ENDDO
437 ! Penta 6 element
438 ELSEIF (isolnod == 6) THEN
439 ! Loop over elements
440 DO i=1,nel
441 ! Tag penta element
442 tagpent(i+nft) = 1
443 ! Loop over penta nodes
444 DO j=1,6
445 ! Number of the nodes
446 k = j + 1
447 IF (j == 4) k = 6
448 IF (j == 5) k = 7
449 IF (j == 6) k = 8
450 inod = ixs(k,i+nft)
451 ! Count the elements attached to the node
452 nelen(inod) = nelen(inod) + 1
453 ! Tag the node as non-local
454 tagnod(inod,1) = 1
455 ! Tag the number of additional d.o.fs
456 tagnod(inod,2) = nptt
457 ! If already written and different => error
458 IF ((tagnod(inod,3) /= 0).AND.(tagnod(inod,3) /= imat)) THEN
459 CALL ancmsg(msgid=1656,msgtype=msgerror,
460 . anmode=aninfo_blind_1,i1=inod,i2=imat,i3=tagnod(inod,3))
461 ENDIF
462 ! Tag the material law id of the node
463 tagnod(inod,3) = imat
464 ! Nodal volume contribution of current element
465 volnod(i+nft) = one_over_6*vol(i)
466 ENDDO
467 ENDDO
468 ! Brick element
469 ELSEIF (isolnod == 8) THEN
470 ! Loop over elements
471 DO i = 1,nel
472 ! Reset counters
473 islnod(i+nft) = 0
474 solnod(1:8,i+nft) = 0
475 ! Loop over brick nodes to save nodes IDs
476 DO j=1,8
477 node_id(j) = ixs(1+j,i+nft)
478 ENDDO
479 ! Sort and find only effective nodes IDs (to detect degenerated bricks)
480 CALL myqsort_int(8,node_id,idxnd,error)
481 bool(1:8) = .false.
482 bool(idxnd(1)) = .true.
483 DO j=2,8
484 IF (node_id(j) /= node_id(j-1)) THEN
485 bool(idxnd(j))=.true.
486 ENDIF
487 ENDDO
488 ! Store effective nodes to compute masses
489 DO j = 1,8
490 IF (bool(j)) THEN
491 islnod(i+nft) = islnod(i+nft) + 1
492 solnod(islnod(i+nft),i+nft) = ixs(1+j,i+nft)
493 ENDIF
494 ENDDO
495 ! Loop over brick nodes
496 DO j = 1,islnod(i+nft)
497 ! Number of the nodes
498 inod = solnod(j,i+nft)
499 ! Count the elements attached to the node
500 nelen(inod) = nelen(inod) + 1
501 ! Tag the node as non-local
502 tagnod(inod,1) = 1
503 ! Tag the number of additional d.o.fs
504 IF (igtyp == 20 .OR. igtyp == 21) THEN
505 tagnod(inod,2) = nptt
506 ELSE
507 tagnod(inod,2) = 1
508 ENDIF
509 ! If already written and different => error
510 IF ((tagnod(inod,3) /= 0).AND.(tagnod(inod,3) /= imat)) THEN
511 CALL ancmsg(msgid=1656,msgtype=msgerror,
512 . anmode=aninfo_blind_1,i1=inod,i2=imat,i3=tagnod(inod,3))
513 ENDIF
514 ! Tag the material law id of the node
515 tagnod(inod,3) = imat
516 ! Nodal volume contribution of current element
517 volnod(i+nft) = (one/islnod(i+nft))*vol(i)
518 ENDDO
519 ENDDO
520 ELSE
521 ! Quadratic formulations not supported
522 CALL ancmsg(msgid=1659,msgtype=msgerror,
523 . anmode=aninfo_blind)
524 ENDIF
525 ! For 4-nodes shell elements
526 ELSEIF (ity == 3) THEN
527 ! Non-supported property
528 IF ((igtyp /= 1).AND.(igtyp /= 9)) THEN
529 CALL ancmsg(msgid=1662,msgtype=msgerror,
530 . anmode=aninfo_blind,i1=igtyp)
531 ENDIF
532 ! Beginning value in index table
533 ideb = numels
534 ! Index and sorting table
535 DO k = 1,nel
536 index(ideb+numelc_nl+k) = k + nft
537 itri(ideb+k+nft) = ixc(7,k+nft)
538 ENDDO
539 ! Counting non-local shell elements
540 numelc_nl = numelc_nl + nel
541 ! Number of integration points in the thickness
542 nptt = iparg(6,ng)
543 ! Material law ID
544 imat = ixc(1,1+nft)
545 ! Thickness of the shell element
546 thck => elbuf_tab(ng)%GBUF%THK(1:nel)
547 ! Loop over elements
548 DO i = 1,nel
549 ! Loop over shell element nodes
550 DO j = 1,4
551 ! Node number
552 k = j + 1
553 inod = ixc(k,i+nft)
554 ! Count the elements attached to the node
555 nelen(inod) = nelen(inod) + 1
556 ! Tag the node as non-local
557 tagnod(inod,1) = 1
558 ! If already written and different => error
559 IF ((tagnod(inod,2) /= 0).AND.(tagnod(inod,2) /= nptt)) THEN
560 CALL ancmsg(msgid=1657,msgtype=msgerror,
561 . anmode=aninfo_blind_1,i1=inod,i2=nptt,i3=tagnod(inod,2))
562 ENDIF
563 ! Tag the number of additional d.o.fs (= NPTT)
564 tagnod(inod,2) = nptt
565 ! If already written and different => error
566 IF ((tagnod(inod,3) /= 0).AND.(tagnod(inod,3) /= imat)) THEN
567 CALL ancmsg(msgid=1656,msgtype=msgerror,
568 . anmode=aninfo_blind_1,i1=inod,i2=imat,i3=tagnod(inod,3))
569 ENDIF
570 ! Tag the material law ID
571 tagnod(inod,3) = imat
572 ! Nodal volume contribution of current element
573 volnod(ideb+i+nft) = fourth * area(nft+i) * thck(i)
574 ENDDO
575 ENDDO
576 ! For 3-nodes shell elements
577 ELSEIF (ity == 7) THEN
578 ! Non-supported property
579 IF ((igtyp /= 1).AND.(igtyp /= 9)) THEN
580 CALL ancmsg(msgid=1662,msgtype=msgerror,
581 . anmode=aninfo_blind,i1=igtyp)
582 ENDIF
583 ! Beginning value in index table
584 ideb = numels+numelc
585 ! Index and sorting table
586 DO k = 1,nel
587 index(ideb+numeltg_nl+k) = k + nft
588 itri(ideb+k+nft) = ixtg(6,k+nft)
589 ENDDO
590 ! Counting non-local triangle shell elements
591 numeltg_nl = numeltg_nl + nel
592 ! Number of integration point in the shell thickness
593 nptt = iparg(6,ng)
594 ! Material law ID
595 imat = ixtg(1,1+nft)
596 ! Thickness of the shell
597 thck => elbuf_tab(ng)%GBUF%THK(1:nel)
598 ! Loop over elements
599 DO i = 1,nel
600 ! loop over the nodes of the shell
601 DO j = 1,3
602 ! Number of the node
603 k = j + 1
604 inod = ixtg(k,i+nft)
605 ! Count the elements attached to the node
606 nelen(inod) = nelen(inod) + 1
607 ! Tag the node as non-local
608 tagnod(inod,1) = 1
609 ! If already written and different => error
610 IF ((tagnod(inod,2) /= zero).AND.(tagnod(inod,2) /= nptt)) THEN
611 CALL ancmsg(msgid=1657,msgtype=msgerror,
612 . anmode=aninfo_blind_1,i1=inod,i2=nptt,i3=tagnod(inod,2))
613 ENDIF
614 ! Tag the number of additional d.o.fs (= NPTT)
615 tagnod(inod,2) = nptt
616 ! If already written and different => error
617 IF ((tagnod(inod,3) /= zero).AND.(tagnod(inod,3) /= imat)) THEN
618 CALL ancmsg(msgid=1656,msgtype=msgerror,
619 . anmode=aninfo_blind_1,i1=inod,i2=imat,i3=tagnod(inod,3))
620 ENDIF
621 ! Tag the material law ID
622 tagnod(inod,3) = imat
623 ! Nodal volume contribution of current element
624 volnod(ideb+i+nft) = third * area(numelc+nft+i) * thck(i)
625 ENDDO
626 ENDDO
627 ! For all other types of elements
628 ELSE
629 CALL ancmsg(msgid=1658,msgtype=msgerror,
630 . anmode=aninfo_blind,i1=ity)
631 ENDIF
632 ENDIF
633 ENDDO
634C
635 ! Checking if a DT option is set in the engine file
636 dtmini_ams = zero
637 dtmini_cst_ams = zero
638 filnam = rootnam(1:rootlen)//'_0001.rad'
639 len_tmp_name = infile_name_len+rootlen+9
640 tmp_name = infile_name(1:infile_name_len)//filnam(1:rootlen+9)
641 INQUIRE(file = tmp_name,exist = eng_file)
642 IF (eng_file) THEN
643 ! Opening the engine file
644 OPEN(unit=71,file=tmp_name(1:len_tmp_name),
645 . access='SEQUENTIAL',status='OLD',iostat=io_err1)
646 ! Reading keywords
647 10 READ(71,'(A)',END=20) keya
648 !/DT/AMS
649 IF(keya(1:7)=='/DT/AMS') THEN
650 30 READ(71,'(A)') keya
651 IF ((keya(1:1)=='#').OR.(keya(1:1)=='$')) THEN
652 GOTO 30
653 ELSE
654 backspace(71)
655 ENDIF
656 READ(71,*) dtsca_ams,dtmini_ams
657 IF (dtsca_ams == zero) dtsca_ams = zep9
658 ENDIF
659 !/DT/CST_AMS
660 IF(keya(1:11)=='/DT/CST_AMS') THEN
661 40 READ(71,'(A)') keya
662 IF ((keya(1:1)=='#').OR.(keya(1:1)=='$')) THEN
663 GOTO 40
664 ELSE
665 backspace(71)
666 ENDIF
667 READ(71,*) dtsca_cst_ams,dtmini_cst_ams
668 IF (dtsca_cst_ams == zero) dtsca_cst_ams = zep9
669 ENDIF
670 ! Back to read the keywords
671 GOTO 10
672 20 CONTINUE
673 ! Closing the file
674 CLOSE(71)
675 ELSE
676 ! No engine file has been found
677 CALL ancmsg(msgid=1730,
678 . msgtype=msgwarning,
679 . anmode=aninfo_blind_2,
680 . c1=rootnam(1:rootlen)//'_0001.rad')
681 ENDIF
682 ! Maximum of the minimal timesteps
683 dtmini = max(dtmini_ams,dtmini_cst_ams)
684C
685 ! Data on non-local nodes
686 nnod = 0 ! Total number of non-local nodes
687 l_nloc = 0 ! Length of the non-local vectors
688 indx(1:numnod) = 0 ! Index of non-local nodes
689 nddl(1:numnod) = 0 ! Number of additional d.o.fs for non-local nodes
690 posi(1:numnod+1) = 0 ! Position of the first degree of freedom for non-local nodes
691 nmat(1:numnod) = 0 ! Material of the non-local nodes
692 idxi(1:numnod) = 0 ! inversed of the index table
693 DO i=1,numnod
694 IF (tagnod(i,1) == 1) THEN
695 nnod = nnod + 1
696 indx(nnod) = i
697 nddl(nnod) = tagnod(i,2)
698 nmat(nnod) = tagnod(i,3)
699 posi(nnod) = l_nloc + 1
700 idxi(i) = nnod
701 l_nloc = l_nloc + tagnod(i,2)
702 ENDIF
703 ENDDO
704 posi(nnod + 1) = l_nloc + 1 ! Last value of the position
705C
706 ! Sorting tables
707 ! -> Sorting solid elements
708 IF ((numels>0).AND.(numels_nl>0)) CALL quicksort_i2(itri, index, 1, numels_nl)
709 ! -> Sorting shell elements
710 IF ((numelc>0).AND.(numelc_nl>0)) CALL quicksort_i2(itri, index, numels+1, numels+numelc_nl)
711 ! -> Sorting triangle elements
712 IF ((numeltg>0).AND.(numeltg_nl>0)) CALL quicksort_i2(itri, index, numels+numelc+1, numels+numelc+numeltg_nl)
713C
714 ! Sorting table for PARITH/ON nodal volume computation
715 ALLOCATE(iaddn(nnod))
716 iaddn(1:nnod) = 0
717 posn = 0
718 ! -> Address of the first element attached to the node
719 DO i = 1,numnod
720 IF (tagnod(i,1) == 1) THEN
721 n = idxi(i)
722 iaddn(n) = posn + 1
723 posn = posn + nelen(i)
724 ENDIF
725 ENDDO
726 ! -> Size of the element connectivity table
727 nelen_max = sum(nelen(1:numnod))
728 ALLOCATE(idelem(nelen_max))
729 idelem(1:nelen_max) = 0
730 ! -> Reshape the counter table of attached elements
731 IF (ALLOCATED(nelen)) DEALLOCATE(nelen)
732 ALLOCATE(nelen(nnod))
733 nelen(1:nnod) = 0
734C
735 ! Assembling the volume per node always in the same order
736 ! and automatic computation of the non-local density, and the non-local damping
737 DO j = 1, numels_nl+numelc_nl+numeltg_nl
738 ! Solid elements
739 IF (j<=numels_nl) THEN
740 ! Number of the element
741 i = index(j)
742 ! Material number
743 imat = ixs(1,i)
744 ! Soundspeed
745 ssp = sqrt(((third*pm(20,imat)/(one - pm(21,imat)*two)) + four_over_3*pm(22,imat))/pm(1,imat))
746 ! Element characteristic length
747 le_min = (volu(i))**third
748 IF (tagtet(i)>0) THEN
749 ! Loop over element nodes
750 DO k = 1,4
751 IF (k == 1) n = idxi(ixs(2,i))
752 IF (k == 2) n = idxi(ixs(4,i))
753 IF (k == 3) n = idxi(ixs(7,i))
754 IF (k == 4) n = idxi(ixs(6,i))
755 ! Update the number of elements attached to the node
756 nelen(n) = nelen(n) + 1
757 ! Save the corresponding element internal number
758 idelem(iaddn(n)+nelen(n)-1) = i
759 ENDDO
760 ELSEIF (tagpent(i)>0) THEN
761 ! Loop over element nodes
762 DO k = 1,6
763 n = idxi(ixs(k+1,i))
764 IF (k == 4) n = idxi(ixs(6,i))
765 IF (k == 5) n = idxi(ixs(7,i))
766 IF (k == 6) n = idxi(ixs(8,i))
767 ! Update the number of elements attached to the node
768 nelen(n) = nelen(n) + 1
769 ! Save the corresponding element internal number
770 idelem(iaddn(n)+nelen(n)-1) = i
771 ENDDO
772 ELSE
773 ! Loop over element nodes
774 DO k = 1,islnod(i)
775 n = idxi(solnod(k,i))
776 ! Update the number of elements attached to the node
777 nelen(n) = nelen(n) + 1
778 ! Save the corresponding element internal number
779 idelem(iaddn(n)+nelen(n)-1) = i
780 ENDDO
781 ENDIF
782 ! Shell elements
783 ELSEIF (j<=numels_nl+numelc_nl) THEN
784 ! Number of the element
785 i = index(numels+j-numels_nl)
786 ! Loop over nodes of the element
787 DO k = 1,4
788 n = idxi(ixc(k+1,i))
789 ! Update the number of elements attached to the node
790 nelen(n) = nelen(n) + 1
791 ! Save the corresponding element internal number
792 idelem(iaddn(n)+nelen(n)-1) = i
793 ENDDO
794 ! Material number
795 imat = ixc(1,i)
796 ! Soundspeed
797 ssp = sqrt(pm(24,imat)/pm(1,imat))
798 ! Element characteristic length
799 le_min = sqrt(area(i))
800 ! Triangle elements
801 ELSEIF (j<=numels_nl+numelc_nl+numeltg_nl) THEN
802 ! Number of the element
803 i = index(numels+numelc+j-numels_nl-numelc_nl)
804 ! Loop over nodes of the element
805 DO k = 1,3
806 n = idxi(ixtg(k+1,i))
807 ! Update the number of elements attached to the node
808 nelen(n) = nelen(n) + 1
809 ! Save the corresponding element internal number
810 idelem(iaddn(n)+nelen(n)-1) = i
811 ENDDO
812 ! Material number
813 imat = ixtg(1,i)
814 ! Soundspeed
815 ssp = sqrt(pm(24,imat)/pm(1,imat))
816 ! Element characteristic length
817 le_min = sqrt((four/sqrt(three))*area(numelc + i))
818 ENDIF
819 ! Recovering the non-local internal length
820 len = nloc_dmg%LEN(imat)
821 ! computing the theoretical maximal length
822 le_max = nloc_dmg%LE_MAX(imat)
823 IF (le_max == zero) THEN
824 nloc_dmg%LE_MAX(imat) = le_min
825 le_max = le_min
826 ENDIF
827 ! Computation of the minimal timestep
828 dtmin = max(le_max/ssp,dtmini)
829 ! Computation of the non-local density
830 dens = csta*(((len/max(le_max,em20))**2 + (one/twelve))*(dtmin**2))
831 IF (le_min > le_max) THEN
832 warn_lenght(imat,1) = one
833 warn_lenght(imat,2) = le_max
834 warn_lenght(imat,3) = le_min
835 ENDIF
836 ! Computation of non-local damping
837 IF ((dens < nloc_dmg%DENS(imat)).OR.(nloc_dmg%DENS(imat) == zero)) THEN
838 ! Computation of the damping parameter (homogeneous to a time value)
839 damp = two*zeta*sqrt((four*(len/max(le_max,em20))**2 + third)*dens)
840 ! Saving non-local parameters (storing the maximal value)
841 nloc_dmg%DENS(imat) = max(dens,zero)
842 nloc_dmg%DAMP(imat) = max(damp,zero)
843 ENDIF
844 ! Computation of the initial non-local sound-speed
845 sspnl = (sqrt(twelve*(len**2) + (le_min)**2))/(two*sqrt(three*dens))
846 IF ((sspnl < nloc_dmg%SSPNL(imat)).OR.(nloc_dmg%SSPNL(imat) == zero)) THEN
847 nloc_dmg%SSPNL(imat) = max(sspnl,zero)
848 ENDIF
849 ENDDO
850c
851 ! Parith/on assembly of the nodal volume
852 ALLOCATE(voln(nnod))
853 voln(1:nnod) = zero
854 ALLOCATE(itrin(maxval(nelen(1:nnod))))
855 ALLOCATE(volsort(maxval(nelen(1:nnod))))
856 ! Loop over non-local nodes
857 DO n = 1,nnod
858 ! Copy element nodal volume contribution of each attached elements
859 volsort(1:nelen(n)) = volnod(idelem(iaddn(n):iaddn(n)+nelen(n)-1))
860 ! Sort by increasing volume value
861 CALL myqsort(nelen(n),volsort(1:nelen(n)),itrin(1:nelen(n)),error)
862 ! Loop over attached elements
863 DO k = 1, nelen(n)
864 ! Add the sorted element nodal volume contribution
865 voln(n) = voln(n) + volsort(k)
866 ENDDO
867 ENDDO
868c
869 ! Checking non-local length consistency with mesh size
870 DO i = 1, matsize
871 IF (warn_lenght(i,1) > zero) THEN
872 CALL ancmsg(msgid=1812,msgtype=msgwarning,
873 . anmode=aninfo_blind_1,i1=ipm(1,i),r1=nloc_dmg%LEN(i),
874 . r2=warn_lenght(i,2),r3=warn_lenght(i,3))
875 ENDIF
876 ENDDO
877c
878 ! Printing out non-local parameters
879 WRITE(iout,1800)
880 DO i = 1, matsize
881 IF (nloc_dmg%DENS(i) > zero) THEN
882 WRITE(iout,1900) ipm(1,i),nloc_dmg%LEN(i),nloc_dmg%LE_MAX(i),nloc_dmg%DENS(i),nloc_dmg%DAMP(i)
883 ENDIF
884 ENDDO
885c
886 ! Maximal number of additional d.o.fs
887 nddmax = maxval(nddl(1:nnod))
888c
889 ! Saving non-local parameters
890 nloc_dmg%NNOD = nnod
891 nloc_dmg%L_NLOC = l_nloc
892 nloc_dmg%NUMELS_NL = numels_nl
893 nloc_dmg%NUMELC_NL = numelc_nl
894 nloc_dmg%NUMELTG_NL = numeltg_nl
895 nloc_dmg%NDDMAX = nddmax
896c
897 ! Allocation of non-local tables
898 CALL my_alloc(nloc_dmg%INDX,nnod)
899 CALL my_alloc(nloc_dmg%POSI,nnod+1)
900 CALL my_alloc(nloc_dmg%IDXI,numnod)
901 CALL my_alloc(nloc_dmg%MASS,l_nloc)
902 CALL my_alloc(nloc_dmg%MASS0,l_nloc)
903 CALL my_alloc(nloc_dmg%VNL,l_nloc)
904 CALL my_alloc(nloc_dmg%VNL_OLD,l_nloc)
905 CALL my_alloc(nloc_dmg%DNL,l_nloc)
906 CALL my_alloc(nloc_dmg%UNL,l_nloc)
907 IF (.NOT.ALLOCATED(nloc_dmg%STIFNL)) ALLOCATE(nloc_dmg%STIFNL(l_nloc,1))
908 IF (.NOT.ALLOCATED(nloc_dmg%FNL)) ALLOCATE(nloc_dmg%FNL(l_nloc,1))
909 IF (.NOT.ALLOCATED(nloc_dmg%FSKY)) ALLOCATE(nloc_dmg%FSKY(0,0))
910 IF (.NOT.ALLOCATED(nloc_dmg%STSKY)) ALLOCATE(nloc_dmg%STSKY(0,0))
911 IF (.NOT.ALLOCATED(nloc_dmg%IAD_SIZE)) ALLOCATE(nloc_dmg%IAD_SIZE(0))
912 IF (.NOT.ALLOCATED(nloc_dmg%IAD_ELEM)) ALLOCATE(nloc_dmg%IAD_ELEM(0))
913 IF (.NOT.ALLOCATED(nloc_dmg%FR_ELEM)) ALLOCATE(nloc_dmg%FR_ELEM(0))
914c
915 ! Initializing non-local tables
916 nloc_dmg%INDX(1:nnod) = indx(1:nnod)
917 nloc_dmg%POSI(1:nnod+1) = posi(1:nnod+1)
918 nloc_dmg%IDXI(1:numnod) = idxi(1:numnod)
919 nloc_dmg%FNL(1:l_nloc,1) = zero
920 nloc_dmg%VNL(1:l_nloc) = zero
921 nloc_dmg%VNL_OLD(1:l_nloc) = zero
922 nloc_dmg%DNL(1:l_nloc) = zero
923 nloc_dmg%UNL(1:l_nloc) = zero
924 nloc_dmg%STIFNL(1:l_nloc,1) = zero
925c
926 ! Computing non-local masses
927 DO i=1,nnod
928 ndd = nddl(i)
929 pos = posi(i)
930 dens = nloc_dmg%DENS(nmat(i))
931 DO j = pos,pos+ndd-1
932 ! For brick elements
933 IF (ity == 1) THEN
934 IF (ndd > 1) THEN
935 nloc_dmg%MASS(j) = half*w_gauss(j-pos+1,ndd)*voln(i)*dens
936 nloc_dmg%MASS0(j) = half*w_gauss(j-pos+1,ndd)*voln(i)*dens
937 ELSE
938 nloc_dmg%MASS(j) = voln(i)*dens
939 nloc_dmg%MASS0(j) = voln(i)*dens
940 ENDIF
941 ! For shell and triangle elements
942 ELSEIF ((ity == 3).OR.(ity == 7)) THEN
943 nloc_dmg%MASS(j) = wf1(j-pos+1,ndd)*voln(i)*dens
944 nloc_dmg%MASS0(j) = wf1(j-pos+1,ndd)*voln(i)*dens
945 ENDIF
946 ENDDO
947 ENDDO
948c
949 ! Computing non-local masses in the thickness for shell elements only
950 DO ng=1,ngroup
951 ! Non-local flag
952 iloc = iparg(78,ng)
953 ! Type of elements
954 ity = iparg(5,ng)
955 ! First element position
956 nft = iparg(3,ng)
957 ! If the elements are non-local and are shells or triangles
958 IF ((iloc > 0).AND.((ity == 3).OR.(ity == 7))) THEN
959 ! Number of the material
960 IF (ity == 3) THEN
961 imat = ixc(1,1+nft)
962 ndepar = 0
963 ELSEIF (ity == 7) THEN
964 imat = ixtg(1,1+nft)
965 ndepar = numelc
966 ENDIF
967 ! Non-local density
968 dens = nloc_dmg%DENS(imat)
969 ! Number of the elements inside the group
970 nel = iparg(2,ng)
971 ! Number of integration points in the R direction
972 nptr = elbuf_tab(ng)%NPTR
973 ! Number of integration points in the S direction
974 npts = elbuf_tab(ng)%NPTS
975 ! Weight of integration in the plane of the shell
976 ws = one/(npts*nptr)
977 ! Number of integration points in the shell thickness
978 nptt = iparg(6,ng)
979 ! Thickness of the shells
980 thck => elbuf_tab(ng)%GBUF%THK(1:nel)
981 ! Non-local in the thickness only if NPTT>1
982 IF (nptt>1) THEN
983 ! Loop over integration points in the shell surface
984 DO ir = 1, nptr
985 DO is = 1, npts
986 bufnl => elbuf_tab(ng)%NLOC(ir,is)
987 massth => bufnl%MASSTH
988 ! Loop over integration points in the shell thickness
989 DO k = 1, nptt
990 IF ((nptt==2).AND.(k==2)) THEN
991 nth1 = (z01(k,nptt) - zn1(k,nptt))/
992 . (zn1(k-1,nptt) - zn1(k,nptt))
993 nth2 = (z01(k,nptt) - zn1(k-1,nptt))/
994 . (zn1(k,nptt) - zn1(k-1,nptt))
995 ELSE
996 nth1 = (z01(k,nptt) - zn1(k+1,nptt))/
997 . (zn1(k,nptt) - zn1(k+1,nptt))
998 nth2 = (z01(k,nptt) - zn1(k,nptt))/
999 . (zn1(k+1,nptt) - zn1(k,nptt))
1000 ENDIF
1001 ! Loop over elements
1002 DO i=1,nel
1003 IF ((nptt==2).AND.(k==2)) THEN
1004 massth(i,k-1) = massth(i,k-1) +
1005 . (nth1**2 + nth1*nth2)*dens*area(ndepar+nft+i)*thck(i)*ws*wf1(k,nptt)
1006 massth(i,k) = massth(i,k) +
1007 . (nth2**2 + nth1*nth2)*dens*area(ndepar+nft+i)*thck(i)*ws*wf1(k,nptt)
1008 ELSE
1009 massth(i,k) = massth(i,k) +
1010 . (nth1**2 + nth1*nth2)*dens*area(ndepar+nft+i)*thck(i)*ws*wf1(k,nptt)
1011 massth(i,k+1) = massth(i,k+1) +
1012 . (nth2**2 + nth1*nth2)*dens*area(ndepar+nft+i)*thck(i)*ws*wf1(k,nptt)
1013 ENDIF
1014 ENDDO
1015 ENDDO
1016 ENDDO
1017 ENDDO
1018 ENDIF
1019 ELSEIF ((iloc > 0).AND.((ity == 1).AND.(elbuf_tab(ng)%NLAY > 1))) THEN
1020 ! Number of the material
1021 imat = ixs(1,1+nft)
1022 ! Non-local density
1023 dens = nloc_dmg%DENS(imat)
1024 ! Number of the elements inside the group
1025 nel = iparg(2,ng)
1026 ! Number of integration points in the R direction
1027 nptr = elbuf_tab(ng)%NPTR
1028 ! Number of integration points in the S direction
1029 npts = elbuf_tab(ng)%NPTS
1030 ! Number of integration points in the shell thickness
1031 nptt = elbuf_tab(ng)%NLAY
1032 ! Volume of the element
1033 vol => elbuf_tab(ng)%GBUF%VOL(1:nel)
1034 ! Non-local in the thickness only if NPTT>1
1035 ! -> Loop over integration points in the shell surface
1036 DO ir = 1, nptr
1037 DO is = 1, npts
1038 bufnlts => elbuf_tab(ng)%NLOCTS(ir,is)
1039 massth => bufnlts%MASSTH
1040 ! Loop over integration points in the shell thickness
1041 DO k = 1, nptt
1042 nth1 = (a_gauss(k,nptt) - z_gauss(k+1,nptt))/
1043 . (z_gauss(k,nptt) - z_gauss(k+1,nptt))
1044 nth2 = (a_gauss(k,nptt) - z_gauss(k,nptt))/
1045 . (z_gauss(k+1,nptt) - z_gauss(k,nptt))
1046 ! Loop over elements
1047 DO i=1,nel
1048 massth(i,k) = massth(i,k) +
1049 . (nth1**2 + nth1*nth2)*dens*vol(i)*half*w_gauss(k,nptt)
1050 . *half*w_gauss(ir,nptr)*half*w_gauss(is,npts)
1051 massth(i,k+1) = massth(i,k+1) +
1052 . (nth2**2 + nth1*nth2)*dens*vol(i)*half*w_gauss(k,nptt)
1053 . *half*w_gauss(ir,nptr)*half*w_gauss(is,npts)
1054 ENDDO
1055 ENDDO
1056 ENDDO
1057 ENDDO
1058 ENDIF
1059 ENDDO
1060c
1061 ! Initialization of non-local fields and variables
1062 ! IF (ISIGI /= 0) THEN
1063 ! WRITE(ISTDO,'(A)') ' .. NON-LOCAL FIELDS INITIALIZATION'
1064 ! CALL NLOCAL_INIT_STA(ELBUF_TAB,NLOC_DMG ,IPARG ,IXC ,
1065 ! . IXS ,IXTG ,AREA ,X ,
1066 ! . XREFS ,XREFC ,XREFTG ,IPM ,
1067 ! . BUFMAT )
1068 ! ENDIF
1069c
1070 ENDIF
1071c
1072 ! Tables deallocation
1073 IF (ALLOCATED(tagnod)) DEALLOCATE(tagnod)
1074 IF (ALLOCATED(indx)) DEALLOCATE(indx)
1075 IF (ALLOCATED(idxi)) DEALLOCATE(idxi)
1076 IF (ALLOCATED(nddl)) DEALLOCATE(nddl)
1077 IF (ALLOCATED(nmat)) DEALLOCATE(nmat)
1078 IF (ALLOCATED(posi)) DEALLOCATE(posi)
1079 IF (ALLOCATED(index)) DEALLOCATE(index)
1080 IF (ALLOCATED(itri)) DEALLOCATE(itri)
1081 IF (ALLOCATED(tagtet)) DEALLOCATE(tagtet)
1082 IF (ALLOCATED(tagpent)) DEALLOCATE(tagpent)
1083 IF (ALLOCATED(islnod)) DEALLOCATE(islnod)
1084 IF (ALLOCATED(solnod)) DEALLOCATE(solnod)
1085 IF (ALLOCATED(voln)) DEALLOCATE(voln)
1086 IF (ALLOCATED(volu)) DEALLOCATE(volu)
1087 IF (ALLOCATED(warn_lenght)) DEALLOCATE(warn_lenght)
1088 IF (ALLOCATED(nelen)) DEALLOCATE(nelen)
1089 IF (ALLOCATED(idelem)) DEALLOCATE(idelem)
1090 IF (ALLOCATED(iaddn)) DEALLOCATE(iaddn)
1091 IF (ALLOCATED(itrin)) DEALLOCATE(itrin)
1092 IF (ALLOCATED(volsort)) DEALLOCATE(volsort)
1093 IF (ALLOCATED(volnod)) DEALLOCATE(volnod)
1094c
1095c-----------
1096 1800 FORMAT(
1097 . 5x,' NON-LOCAL PARAMETERS '/
1098 . 5x,'----------------------'/
1099 . 5x,' MATERIAL ID',5x, ' LENGTH',5x, 'CONV. LE_MAX',5x,' DENSITY',5x,' damping'/
1100 . 5X,' ',5X, ' ',5X, ' ',5X,' (auto-set)',5X,' (auto-set)'/)
1101 1900 FORMAT(
1102 . 5X,I12,5X,ES12.4,5X,ES12.4,5X,ES12.4,5X,ES12.4/)
1103 RETURN
1104 END
my_real
#define my_real
Definition cppsort.cpp:32
damping
subroutine damping(nodft, nodlt, v, vr, a, ar, damp, ms, in, igrnod, dim, itask, weight, tagslv_rby, wfext)
Definition damping.F:882
the
end diagonal values have been computed in the(sparse) matrix id.SOL
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
max
#define max(a, b)
Definition macros.h:21
myqsort
subroutine myqsort(n, a, perm, error)
Definition myqsort.F:51
myqsort_int
subroutine myqsort_int(n, a, perm, error)
Definition myqsort_int.F:36
inoutfile_mod
Definition inoutfile_mod.F:96
inoutfile_mod::infile_name_len
integer infile_name_len
Definition inoutfile_mod.F:114
inoutfile_mod::infile_name
character(len=infile_char_len) infile_name
Definition inoutfile_mod.F:116
message_mod
Definition message_mod.F:1249
nlocal_reg_mod
Definition nlocal_reg_mod.F:117
nloc_dmg_init
subroutine nloc_dmg_init(elbuf_tab, nloc_dmg, iparg, ixc, ixs, ixtg, area, dtelem, numel, ipm, x, xrefs, xrefc, xreftg, bufmat, pm)
Definition nloc_dmg_init.F:37
quicksort_i2
recursive subroutine quicksort_i2(a, idx, first, last)
Definition quicksort.F:153
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
tagnod
subroutine tagnod(ix, nix, nix1, nix2, numel, iparte, tagbuf, npart)
Definition tagnod.F:29