OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cdleni.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "remesh_c.inc"
#include "vect01_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine cdleni (pm, geo, stifn, stifr, ixc, px1, px2, py1, py2, thk, igeo, dt, sh4tree, aldt, uparam, ipm, nlay, pm_stack, isubstack, strc, area, imat, iprop, x2l, x3l, x4l, y2l, y3l, y4l, igeo_stack, group_param)

Function/Subroutine Documentation

◆ cdleni()

subroutine cdleni ( pm,
geo,
stifn,
stifr,
integer, dimension(nixc,*) ixc,
px1,
px2,
py1,
py2,
thk,
integer, dimension(npropgi,*) igeo,
dt,
integer, dimension(ksh4tree,*) sh4tree,
aldt,
uparam,
integer, dimension(npropmi,*) ipm,
integer nlay,
pm_stack,
integer isubstack,
strc,
area,
integer imat,
integer iprop,
x2l,
x3l,
x4l,
y2l,
y3l,
y4l,
integer, dimension(4*npt_stack+2,*) igeo_stack,
type (group_param_) group_param )

Definition at line 29 of file cdleni.F.

36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE group_param_mod
40 use element_mod , only : nixc
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C G l o b a l P a r a m e t e r s
47C-----------------------------------------------
48#include "mvsiz_p.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "param_c.inc"
53#include "remesh_c.inc"
54#include "vect01_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER IMAT,IPROP
59 INTEGER IXC(NIXC,*), IGEO(NPROPGI,*), SH4TREE(KSH4TREE,*),
60 . IPM(NPROPMI,*),NLAY,ISUBSTACK,IGEO_STACK(4*NPT_STACK+2,*)
61 my_real
62 . pm(npropm,*), geo(npropg,*),stifn(*),stifr(*),uparam(*),
63 . px1(*),px2(*),py1(*),py2(*),thk(*),dt(*),aldt(*),pm_stack(20,*),
64 . area(mvsiz), strc(*),
65 . x2l(mvsiz),x3l(mvsiz),x4l(mvsiz),y2l(mvsiz),y3l(mvsiz),y4l(mvsiz)
66 TYPE (GROUP_PARAM_) :: GROUP_PARAM
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70 INTEGER I,N, IMT, IPMAT, IGTYP,IPPID,IADB,
71 . IGMAT,IPGMAT,IPOS,NIP,MLAWLY
72 my_real
73 . ssp(mvsiz), al1(mvsiz),al(mvsiz), almin(mvsiz),
74 . al2(mvsiz), al3(mvsiz), al4(mvsiz), al5(mvsiz), al6(mvsiz)
75 my_real
76 . viscmx,a11,a11r,b1,b2,vv,sti,stir,viscdef,dtdyn,rho,
77 . young,nu,gmax,fac,z0
78 my_real, DIMENSION(MVSIZ) :: zoffset
79C======================================================================|
80 igtyp = nint(geo(12,iprop))
81 igmat = igeo(98,iprop)
82 ipgmat = 700
83 ssp(lft:llt) = zero
84 z0 = geo(199,iprop)
85 zoffset(lft:llt) = zero
86 SELECT CASE(igtyp)
87 CASE (1,9,10,11,16)
88 DO i=lft,llt
89 zoffset(i) = z0
90 ENDDO
91 CASE (17,51,52)
92 ipos = igeo(99,iprop)
93 IF(ipos == 2) THEN
94 DO i=lft,llt
95 zoffset(i) = z0 - half*thk(i)
96 ENDDO
97 ELSEIF (ipos== 3 .OR. ipos == 4) THEN
98 DO i=lft,llt
99 z0= half*thk(i)
100 zoffset(i) = z0
101 ENDDO
102 ENDIF
103 CASE DEFAULT
104 zoffset(lft:llt) = zero
105 END SELECT
106c
107 IF ((igtyp == 11 .AND. igmat < 0) .OR. igtyp == 16) THEN
108 ipmat = 100
109 IF (mtn <= 28) THEN
110 DO i=lft,llt
111 DO n=1,npt
112 imt = igeo(ipmat+n,iprop)
113 ssp(i)=max(ssp(i),pm(27,imt))
114 ENDDO
115 ENDDO
116 ELSEIF (mtn == 42) THEN
117 DO i=lft,llt
118 DO n=1,npt
119 imt = igeo(ipmat+n,iprop)
120 rho = pm(1,imt)
121 nu = pm(21,imt)
122 gmax = pm(22,imt)
123 a11 = gmax*(one + nu)/(one - nu**2)
124 ssp(i)= max(ssp(i), sqrt(a11/rho))
125 ENDDO
126 ENDDO
127 ELSEIF (mtn == 69) THEN
128 DO i=lft,llt
129 DO n=1,npt
130 imt = igeo(ipmat+n,iprop)
131 iadb = ipm(7,imt)-1
132 nu = uparam(iadb+14)
133 gmax = uparam(iadb+1)*uparam(iadb+6)
134 . + uparam(iadb+2)*uparam(iadb+7)
135 . + uparam(iadb+3)*uparam(iadb+8)
136 . + uparam(iadb+4)*uparam(iadb+9)
137 . + uparam(iadb+5)*uparam(iadb+10)
138 rho = pm(1,imt)
139 a11 = gmax*(one + nu)/(one - nu**2)
140 ssp(i)=max(ssp(i), sqrt(a11/rho))
141 ENDDO
142 ENDDO
143 ELSEIF (mtn == 65) THEN
144 DO i=lft,llt
145 DO n=1,npt
146 imt = igeo(ipmat+n,iprop)
147 rho =pm(1,imt)
148 young=pm(20,imt)
149 ssp(i)=max(ssp(i), sqrt(young/rho))
150 ENDDO
151 ENDDO
152 ELSE
153 DO i=lft,llt
154 DO n=1,npt
155 imt = igeo(ipmat+n,iprop)
156 rho =pm(1,imt)
157 young=pm(20,imt)
158 nu =pm(21,imt)
159 ssp(i)=max(ssp(i), sqrt(young/(one-nu*nu)/rho))
160 ENDDO
161 ENDDO
162 ENDIF
163 ELSEIF(igtyp == 11 .AND. igmat > 0) THEN
164 DO i=lft,llt
165 ssp(i) = geo(ipgmat +9 ,iprop)
166 ENDDO
167 ELSEIF(igtyp == 52 .OR.
168 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0)) THEN
169 DO i=lft,llt
170 ssp(i) = pm_stack(9 ,isubstack)
171 ENDDO
172 ELSEIF(igtyp == 17 .AND. igmat < 0) THEN
173 ippid = 100
174 nip = npt
175 ipmat = 2 + nip
176 IF(mtn<=28)THEN
177 DO i=lft,llt
178 DO n=1,nip
179 imt = igeo_stack(ipmat + n,isubstack)
180 ssp(i)=max(ssp(i),pm(27,imt))
181 ENDDO
182 ENDDO
183 ELSEIF (mtn == 42) THEN
184 DO i=lft,llt
185 DO n=1,nip
186 imt = igeo_stack(ipmat + n,isubstack)
187 rho = pm(1,imt)
188 nu = pm(21,imt)
189 gmax = pm(22,imt)
190 a11 = gmax*(one + nu)/(one - nu**2)
191 ssp(i)= max(ssp(i), sqrt(a11/rho))
192 ENDDO
193 ENDDO
194 ELSEIF (mtn == 69) THEN
195 DO i=lft,llt
196 DO n=1,nip
197 imt = igeo_stack(ipmat + n,isubstack)
198 iadb = ipm(7,imt)-1
199 nu = uparam(iadb+14)
200 gmax = uparam(iadb+1)*uparam(iadb+6)
201 . + uparam(iadb+2)*uparam(iadb+7)
202 . + uparam(iadb+3)*uparam(iadb+8)
203 . + uparam(iadb+4)*uparam(iadb+9)
204 . + uparam(iadb+5)*uparam(iadb+10)
205 rho = pm(1,imt)
206 a11 = gmax*(one + nu)/(one - nu**2)
207 ssp(i)=max(ssp(i), sqrt(a11/rho))
208 ENDDO
209 ENDDO
210 ELSEIF (mtn == 69) THEN
211 DO i=lft,llt
212 DO n=1,nip
213 imt = igeo_stack(ipmat + n,isubstack)
214 iadb = ipm(7,imt)-1
215 nu = uparam(iadb+14)
216 gmax = uparam(iadb+1)*uparam(iadb+6)
217 . + uparam(iadb+2)*uparam(iadb+7)
218 . + uparam(iadb+3)*uparam(iadb+8)
219 . + uparam(iadb+4)*uparam(iadb+9)
220 . + uparam(iadb+5)*uparam(iadb+10)
221 rho = pm(1,imt)
222 a11 = gmax*(one + nu)/(one - nu**2)
223 ssp(i)=max(ssp(i), sqrt(a11/rho))
224 ENDDO
225 ENDDO
226 ELSEIF (mtn == 65) THEN
227 DO i=lft,llt
228 DO n=1,nip
229 imt = igeo_stack(ipmat + n,isubstack)
230 rho =pm(1,imt)
231 young=pm(20,imt)
232 ssp(i)=max(ssp(i), sqrt(young/rho))
233 ENDDO
234 ENDDO
235 ELSE
236 DO i=lft,llt
237 DO n=1,nip
238 imt = igeo_stack(ipmat + n,isubstack)
239 rho =pm(1,imt)
240 young=pm(20,imt)
241 nu =pm(21,imt)
242 ssp(i)=max(ssp(i), sqrt(young/(one-nu*nu)/rho))
243 ENDDO
244 ENDDO
245 ENDIF
246 ELSEIF(igtyp == 51 .AND. igmat < 0) THEN
247 nip = nlay
248 ipmat = 2 + nlay
249 DO i=lft,llt
250 DO n=1,nip
251 imt = igeo_stack(ipmat + n,isubstack)
252 mlawly = nint(pm(19,imt))
253 IF (mlawly <= 28) THEN
254 ssp(i)=max(ssp(i),pm(27,imt))
255 ELSEIF (mlawly == 42) THEN
256 rho = pm(1,imt)
257 nu = pm(21,imt)
258 gmax = pm(22,imt)
259 a11 = gmax*(one + nu)/(one - nu**2)
260 ssp(i)= max(ssp(i), sqrt(a11/rho))
261 ELSEIF (mlawly == 69) THEN
262 iadb = ipm(7,imt)-1
263 nu = uparam(iadb+14)
264 gmax = uparam(iadb+1)*uparam(iadb+6)
265 . + uparam(iadb+2)*uparam(iadb+7)
266 . + uparam(iadb+3)*uparam(iadb+8)
267 . + uparam(iadb+4)*uparam(iadb+9)
268 . + uparam(iadb+5)*uparam(iadb+10)
269 rho = pm(1,imt)
270 a11 = gmax*(one + nu)/(one - nu**2)
271 ssp(i)=max(ssp(i), sqrt(a11/rho))
272 ELSEIF (mlawly == 65) THEN
273 rho =pm(1,imt)
274 young=pm(20,imt)
275 ssp(i)=max(ssp(i), sqrt(young/rho))
276 ELSE
277 rho =pm(1,imt)
278 young=pm(20,imt)
279 nu =pm(21,imt)
280 ssp(i)=max(ssp(i), sqrt(young/(one-nu*nu)/rho))
281 ENDIF
282 ENDDO
283 ENDDO
284c
285 ELSEIF (mtn<=28)THEN
286 DO i=lft,llt
287 ssp(i)=pm(27,imat)
288 ENDDO
289 ELSEIF (mtn == 42) THEN
290 DO i=lft,llt
291 rho = pm(1,imat)
292 nu = pm(21,imat)
293 gmax = pm(22,imat)
294 a11 = gmax*(one + nu)/(one - nu**2)
295 ssp(i)= max(ssp(i), sqrt(a11/rho))
296 ENDDO
297 ELSEIF (mtn == 69) THEN
298 DO i=lft,llt
299 iadb = ipm(7,imat)-1
300 nu = uparam(iadb+14)
301 gmax = uparam(iadb+1)*uparam(iadb+6)
302 . + uparam(iadb+2)*uparam(iadb+7)
303 . + uparam(iadb+3)*uparam(iadb+8)
304 . + uparam(iadb+4)*uparam(iadb+9)
305 . + uparam(iadb+5)*uparam(iadb+10)
306 rho = pm(1,imat)
307 a11 = gmax*(one + nu)/(one - nu**2)
308 ssp(i)=max(ssp(i), sqrt(a11/rho))
309 ENDDO
310 ELSEIF (mtn == 65) THEN
311 DO i=lft,llt
312 rho =pm(1,imat)
313 young =pm(20,imat)
314 ssp(i)=sqrt(young/rho)
315 ENDDO
316 ELSE
317 DO i=lft,llt
318 rho =pm(1,imat)
319 young=pm(20,imat)
320 nu =pm(21,imat)
321 ssp(i)=sqrt(young/(one-nu*nu)/rho)
322 ENDDO
323 ENDIF
324C
325 DO 20 i=lft,llt
326 al1(i)= x2l(i) * x2l(i) + y2l(i) * y2l(i)
327 al2(i)=(x3l(i)-x2l(i))*(x3l(i)-x2l(i))+(y3l(i)-y2l(i))*(y3l(i)-y2l(i))
328 al3(i)=(x4l(i)-x3l(i))*(x4l(i)-x3l(i))+(y4l(i)-y3l(i))*(y4l(i)-y3l(i))
329 al4(i)= x4l(i) * x4l(i) + y4l(i) * y4l(i)
330 al5(i)=(x4l(i)-x2l(i))*(x4l(i)-x2l(i))+(y4l(i)-y2l(i))*(y4l(i)-y2l(i))
331 al6(i)= x3l(i) * x3l(i) + y3l(i) * y3l(i)
332 20 CONTINUE
333C
334 DO 30 i=lft,llt
335 al(i)= min(al1(i),al2(i),al3(i),al4(i),al5(i),al6(i))
336 IF(al3(i) == zero) al(i)= min(al1(i),al2(i),al4(i))
337 almin(i)=sqrt(al(i))
338 30 CONTINUE
339C
340 IF(mtn == 19)THEN
341 viscdef=fourth
342 ELSEIF(mtn == 25.OR.mtn == 27 .OR. mtn == 125 .OR. mtn == 127)THEN
343 viscdef=fiveem2
344 ELSE
345 viscdef=zero
346 ENDIF
347C
348 viscmx = group_param%VISC_DM
349 IF (viscmx == zero) viscmx = viscdef
350 IF (mtn == 1 .OR.mtn == 2.OR.mtn == 3.OR.
351 . mtn == 22.OR.mtn == 23) viscmx=zero
352 viscmx = sqrt(one + viscmx*viscmx) - viscmx
353 DO i=lft,llt
354 dtdyn = area(i)/sqrt(max(al5(i),al6(i)))
355 aldt(i) = max(dtdyn,almin(i))
356 dt(i) = aldt(i)*viscmx/ssp(i)
357 ENDDO
358C----------------------------------------------------------
359C DT NODAL
360C----------------------------------------------------------
361 ipgmat = 700
362 IF(nadmesh == 0)THEN
363 IF (igtyp == 11 .AND. igmat > 0) THEN
364 DO i=lft,llt
365 a11 =geo(ipgmat + 5,iprop)
366 a11r =geo(ipgmat + 7,iprop)
367 b1 = px1(i)*px1(i)+py1(i)*py1(i)
368 b2 = px2(i)*px2(i)+py2(i)*py2(i)
369 vv = viscmx * viscmx
370 fac = max(b1,b2) / (area(i) * vv)
371 sti = fac * thk(i) * a11
372 stir = fac*a11r * thk(i)*(thk(i)**2 + area(i))*one_over_12
373 stifn(ixc(2,i))=stifn(ixc(2,i))+sti
374 stifn(ixc(3,i))=stifn(ixc(3,i))+sti
375 stifn(ixc(4,i))=stifn(ixc(4,i))+sti
376 stifn(ixc(5,i))=stifn(ixc(5,i))+sti
377 stifr(ixc(2,i))=stifr(ixc(2,i))+stir
378 stifr(ixc(3,i))=stifr(ixc(3,i))+stir
379 stifr(ixc(4,i))=stifr(ixc(4,i))+stir
380 stifr(ixc(5,i))=stifr(ixc(5,i))+stir
381 strc(i) = stir
382 ENDDO
383 ELSEIF(igtyp == 52 .OR.
384 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0 )) THEN
385 DO i=lft,llt
386 a11 = pm_stack(5 ,isubstack)
387 a11r = pm_stack(7 ,isubstack)
388 b1 = px1(i)*px1(i)+py1(i)*py1(i)
389 b2 = px2(i)*px2(i)+py2(i)*py2(i)
390 vv = viscmx * viscmx
391 fac = max(b1,b2) / (area(i) * vv)
392 sti = fac * thk(i) * a11
393 stir = fac*a11r * thk(i)*((thk(i)**2 + area(i))*one_over_12 +
394 . zoffset(i)*zoffset(i) )
395 stifn(ixc(2,i))=stifn(ixc(2,i))+sti
396 stifn(ixc(3,i))=stifn(ixc(3,i))+sti
397 stifn(ixc(4,i))=stifn(ixc(4,i))+sti
398 stifn(ixc(5,i))=stifn(ixc(5,i))+sti
399 stifr(ixc(2,i))=stifr(ixc(2,i))+stir
400 stifr(ixc(3,i))=stifr(ixc(3,i))+stir
401 stifr(ixc(4,i))=stifr(ixc(4,i))+stir
402 stifr(ixc(5,i))=stifr(ixc(5,i))+stir
403 strc(i) = stir
404 ENDDO
405 ELSE
406 DO i=lft,llt
407 a11 =pm(24,imat)
408 b1 = px1(i)*px1(i)+py1(i)*py1(i)
409 b2 = px2(i)*px2(i)+py2(i)*py2(i)
410 vv = viscmx * viscmx
411 sti = max(b1,b2)
412 . * thk(i) * a11 / (area(i) * vv)
413 stir = sti * (thk(i)*thk(i) + area(i)) / 12.
414 stifn(ixc(2,i))=stifn(ixc(2,i))+sti
415 stifn(ixc(3,i))=stifn(ixc(3,i))+sti
416 stifn(ixc(4,i))=stifn(ixc(4,i))+sti
417 stifn(ixc(5,i))=stifn(ixc(5,i))+sti
418 stifr(ixc(2,i))=stifr(ixc(2,i))+stir
419 stifr(ixc(3,i))=stifr(ixc(3,i))+stir
420 stifr(ixc(4,i))=stifr(ixc(4,i))+stir
421 stifr(ixc(5,i))=stifr(ixc(5,i))+stir
422 strc(i) = stir
423 ENDDO
424 ENDIF
425 ELSE
426 IF(igtyp == 11 .AND. igmat > 0) THEN
427 DO i=lft,llt
428 n=nft+i
429 IF(sh4tree(3,n) >= 0)THEN
430 a11 =geo(ipgmat + 5,iprop)
431 a11r =geo(ipgmat + 7,iprop)
432 b1 = px1(i)*px1(i)+py1(i)*py1(i)
433 b2 = px2(i)*px2(i)+py2(i)*py2(i)
434 vv = viscmx * viscmx
435 fac = max(b1,b2) / (area(i) * vv)
436 sti = fac * thk(i) * a11
437 stir = fac * a11r * thk(i)*(thk(i)**2 + area(i))*one_over_12
438 stifn(ixc(2,i))=stifn(ixc(2,i))+sti
439 stifn(ixc(3,i))=stifn(ixc(3,i))+sti
440 stifn(ixc(4,i))=stifn(ixc(4,i))+sti
441 stifn(ixc(5,i))=stifn(ixc(5,i))+sti
442 stifr(ixc(2,i))=stifr(ixc(2,i))+stir
443 stifr(ixc(3,i))=stifr(ixc(3,i))+stir
444 stifr(ixc(4,i))=stifr(ixc(4,i))+stir
445 stifr(ixc(5,i))=stifr(ixc(5,i))+stir
446 strc(i) = stir
447 END IF
448 END DO
449 ELSEIF(igtyp == 52 .OR.
450 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0 )) THEN
451 DO i=lft,llt
452 n=nft+i
453 IF(sh4tree(3,n) >= 0)THEN
454 a11 = pm_stack(5 ,isubstack)
455 a11r = pm_stack(7 ,isubstack)
456 b1 = px1(i)*px1(i)+py1(i)*py1(i)
457 b2 = px2(i)*px2(i)+py2(i)*py2(i)
458 vv = viscmx * viscmx
459 fac = max(b1,b2) / (area(i) * vv)
460 sti = fac * thk(i) * a11
461 stir = fac * a11r * thk(i)*((thk(i)**2 + area(i))*one_over_12 +
462 . zoffset(i)*zoffset(i) )
463 stifn(ixc(2,i))=stifn(ixc(2,i))+sti
464 stifn(ixc(3,i))=stifn(ixc(3,i))+sti
465 stifn(ixc(4,i))=stifn(ixc(4,i))+sti
466 stifn(ixc(5,i))=stifn(ixc(5,i))+sti
467 stifr(ixc(2,i))=stifr(ixc(2,i))+stir
468 stifr(ixc(3,i))=stifr(ixc(3,i))+stir
469 stifr(ixc(4,i))=stifr(ixc(4,i))+stir
470 stifr(ixc(5,i))=stifr(ixc(5,i))+stir
471 strc(i) = stir
472 END IF
473 END DO
474
475 ELSE
476 DO i=lft,llt
477 n=nft+i
478 IF(sh4tree(3,n) >= 0)THEN
479 a11 =pm(24,imat)
480 b1 = px1(i)*px1(i)+py1(i)*py1(i)
481 b2 = px2(i)*px2(i)+py2(i)*py2(i)
482 vv = viscmx * viscmx
483 sti = max(b1,b2)
484 . * thk(i) * a11 / (area(i) * vv)
485 stir = sti * (thk(i)*thk(i) + area(i)) / 12.
486 stifn(ixc(2,i))=stifn(ixc(2,i))+sti
487 stifn(ixc(3,i))=stifn(ixc(3,i))+sti
488 stifn(ixc(4,i))=stifn(ixc(4,i))+sti
489 stifn(ixc(5,i))=stifn(ixc(5,i))+sti
490 stifr(ixc(2,i))=stifr(ixc(2,i))+stir
491 stifr(ixc(3,i))=stifr(ixc(3,i))+stir
492 stifr(ixc(4,i))=stifr(ixc(4,i))+stir
493 stifr(ixc(5,i))=stifr(ixc(5,i))+stir
494 strc(i) = stir
495 END IF
496 END DO
497 ENDIF
498 END IF
499C----------------------------------------------------------
500 IF(ismstr == 3)THEN
501 DO i=lft,llt
502 IF(geo(5,iprop)/=zero)geo(5,iprop)= min(geo(5,iprop),dt(i))
503 ENDDO
504 ELSE
505 DO i=lft,llt
506 px1(i)= zero
507 px2(i)= zero
508 py1(i)= zero
509 py2(i)= zero
510 ENDDO
511 ENDIF
512C
513 RETURN
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
max
#define max(a, b)
Definition macros.h:21