OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cndleni.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 cndleni (pm, geo, stifn, stifr, ixc, thk, ihbe, igeo, sh4tree, aldt, uparam, ipm, nlay, pm_stack, isubstack, strc, area, imat, iprop, dtel, x2l, x3l, x4l, y2l, y3l, y4l, igeo_stack, group_param)

Function/Subroutine Documentation

◆ cndleni()

subroutine cndleni ( pm,
geo,
stifn,
stifr,
integer, dimension(nixc,*) ixc,
thk,
integer ihbe,
integer, dimension(npropgi,*) igeo,
integer, dimension(ksh4tree,*) sh4tree,
aldt,
uparam,
integer, dimension(npropmi,*) ipm,
integer nlay,
pm_stack,
integer isubstack,
strc,
area,
integer imat,
integer iprop,
dtel,
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 cndleni.F.

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