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