OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cdkderii.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!|| cdkderii ../starter/source/elements/sh3n/coquedk/cdkderii.F
25!||--- called by ------------------------------------------------------
26!|| cdkinit3 ../starter/source/elements/sh3n/coquedk/cdkinit3.F
27!||--- uses -----------------------------------------------------
28!||====================================================================
29 SUBROUTINE cdkderii(JFT ,JLT,PM ,GEO ,PX2,PY2,PX3,PY3,
30 . STIFN ,STIFR ,IXTG ,THK ,SH3TREE ,
31 . ALDT ,UPARAM ,IPM ,IGEO,PM_STACK,
32 . ISUBSTACK,STRTG,GROUP_PARAM,
33 . IMAT,IPROP,AREA, DT ,
34 . X1G ,X2G ,X3G ,Y1G ,Y2G ,Y3G ,
35 . Z1G ,Z2G ,Z3G ,E1X ,E2X ,E3X ,
36 . E1Y ,E2Y ,E3Y ,E1Z ,E2Z ,E3Z )
37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE group_param_mod
41 use element_mod , only : nixtg
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C G l o b a l P a r a m e t e r s
48C-----------------------------------------------
49#include "mvsiz_p.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "param_c.inc"
54#include "remesh_c.inc"
55#include "vect01_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER JFT, JLT,ISUBSTACK,IMAT,IPROP
60 INTEGER IXTG(NIXTG,*), SH3TREE(KSH3TREE,*),IPM(NPROPMI,*),
61 . IGEO(NPROPGI,*),PM_STACK(20,*)
62 my_real
63 . PM(NPROPM,*), GEO(NPROPG,*), PX2(*),PX3(*),PY2(*),PY3(*),
64 . STIFN(*),STIFR(*),THK(*),ALDT(*),UPARAM(*),STRTG(*),
65 . X1G(MVSIZ), X2G(MVSIZ), X3G(MVSIZ),
66 . y1g(mvsiz), y2g(mvsiz), y3g(mvsiz),
67 . z1g(mvsiz), z2g(mvsiz), z3g(mvsiz),
68 . e1x(mvsiz), e1y(mvsiz), e1z(mvsiz),
69 . e2x(mvsiz), e2y(mvsiz), e2z(mvsiz),
70 . e3x(mvsiz), e3y(mvsiz), e3z(mvsiz)
71 TYPE (GROUP_PARAM_) :: GROUP_PARAM
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 INTEGER I, NG, N,IADB,IGTYP,
76 . IGMAT,IPGMAT
77 my_real
78 . x21g(mvsiz), y21g(mvsiz), z21g(mvsiz),
79 . x31g(mvsiz), y31g(mvsiz), z31g(mvsiz),
80 . x32g(mvsiz), y32g(mvsiz), z32g(mvsiz),
81 . x2(mvsiz), x3(mvsiz), y2(mvsiz),y3(mvsiz),
82 . dt(mvsiz), area(mvsiz),fac, almin,
83 . viscmx, a11, g, sti,stir,viscdef,gmax,
84 . al1, al2, al3, almax, ssp,young,nu,rho,areai,
85 .
86 . a11r
87C=======================================================================
88 DO i=jft,jlt
89 x21g(i) = x2g(i)-x1g(i)
90 y21g(i) = y2g(i)-y1g(i)
91 z21g(i) = z2g(i)-z1g(i)
92 x31g(i) = x3g(i)-x1g(i)
93 y31g(i) = y3g(i)-y1g(i)
94 z31g(i) = z3g(i)-z1g(i)
95 x32g(i) = x3g(i)-x2g(i)
96 y32g(i) = y3g(i)-y2g(i)
97 z32g(i) = z3g(i)-z2g(i)
98 ENDDO
99c
100 DO i=jft,jlt
101 x2(i)=e1x(i)*x21g(i)+e1y(i)*y21g(i)+e1z(i)*z21g(i)
102 y2(i)=e2x(i)*x21g(i)+e2y(i)*y21g(i)+e2z(i)*z21g(i)
103 y3(i)=e2x(i)*x31g(i)+e2y(i)*y31g(i)+e2z(i)*z31g(i)
104 x3(i)=e1x(i)*x31g(i)+e1y(i)*y31g(i)+e1z(i)*z31g(i)
105 ENDDO
106C
107C global material
108C
109 igtyp = igeo(11,iprop)
110 igmat = igeo(98,iprop)
111 ipgmat = 700
112C
113 IF(mtn == 19)THEN
114 viscdef=fourth
115 ELSEIF(mtn == 25.OR.mtn == 27 .OR. mtn == 125 .OR. mtn == 127)THEN
116 viscdef=fiveem2
117 ELSE
118 viscdef=zero
119 ENDIF
120c
121 DO 40 i=jft,jlt
122 al1 = x2(i) * x2(i) + y2(i) * y2(i)
123 al2 = (x3(i)-x2(i)) * (x3(i)-x2(i)) +
124 . (y3(i)-y2(i)) * (y3(i)-y2(i))
125 al3 = x3(i) * x3(i) + y3(i) * y3(i)
126 almax = max(al1,al2,al3)
127 nu =pm(21,imat)
128 almin = min(al1,al2,al3)
129 fac =one+zep6*(1+nu)*thk(i)*thk(i)/almin
130 almax = almax*fac
131 IF(igtyp == 11 .AND. igmat > 0) THEN
132 ssp = geo(ipgmat +9 ,iprop)
133 ELSEIF(igtyp == 52 .OR.
134 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0)) THEN
135 ssp = pm_stack(9 ,isubstack)
136 ELSE
137 IF(mtn<=28)THEN
138 ssp=pm(27,imat)
139 ELSEIF (mtn == 42) THEN
140 rho = pm(1 ,imat)
141 nu = pm(21,imat)
142 gmax = pm(22,imat)
143 a11 = gmax*(one + nu)/(one - nu**2)
144 ssp = max(ssp, sqrt(a11/rho))
145 ELSEIF (mtn == 69) THEN
146 iadb = ipm(7,imat)-1
147 nu = uparam(iadb+14)
148 gmax = uparam(iadb+1)*uparam(iadb+6)
149 . + uparam(iadb+2)*uparam(iadb+7)
150 . + uparam(iadb+3)*uparam(iadb+8)
151 . + uparam(iadb+4)*uparam(iadb+9)
152 . + uparam(iadb+5)*uparam(iadb+10)
153 rho = pm(1,imat)
154 a11 = gmax*(one + nu)/(one - nu**2)
155 ssp = max(ssp, sqrt(a11/rho))
156 ELSEIF (mtn == 65) THEN
157 rho =pm(1,imat)
158 young=pm(20,imat)
159 ssp=sqrt(young/rho)
160 ELSE
161 rho =pm(1,imat)
162 young=pm(20,imat)
163 nu =pm(21,imat)
164 ssp=sqrt(young/(one-nu*nu)/rho)
165 ENDIF
166 ENDIF
167 viscmx = group_param%VISC_DM
168 IF (viscmx == zero) viscmx = viscdef
169 IF(mtn == 1.OR.mtn == 2.OR.mtn == 3.OR.
170 . mtn == 22.OR.mtn == 23)viscmx=zero
171 viscmx=sqrt(1.+viscmx*viscmx)-viscmx
172 aldt(i)= two*area(i)*viscmx / sqrt(almax)
173 dt(i) = aldt(i) / ssp
174 40 CONTINUE
175C-----------------
176C DT NODAL
177C-----------------
178 ipgmat = 700
179 IF(nadmesh==0)THEN
180 IF(igtyp == 11 .AND. igmat > 0) THEN
181 DO i=jft,jlt
182 a11 = geo(ipgmat + 5 ,iprop)
183 a11r = geo(ipgmat + 7 ,iprop)
184 g = geo(ipgmat + 4 ,iprop)
185 fac = area(i)* thk(i) / (aldt(i))**2
186 sti = fac * a11
187 stir =one_over_12*fac* a11r*thk(i)**2
188 stifn(ixtg(2,i))=stifn(ixtg(2,i))+sti
189 stifn(ixtg(3,i))=stifn(ixtg(3,i))+sti
190 stifn(ixtg(4,i))=stifn(ixtg(4,i))+sti
191 stifr(ixtg(2,i))=stifr(ixtg(2,i))+stir
192 stifr(ixtg(3,i))=stifr(ixtg(3,i))+stir
193 stifr(ixtg(4,i))=stifr(ixtg(4,i))+stir
194 strtg(i) = stir
195 END DO
196 ELSEIF(igtyp == 52 .OR.
197 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0)) THEN
198 DO i=jft,jlt
199 a11 = pm_stack(5 ,isubstack)
200 a11r = pm_stack(7 ,isubstack)
201 g = pm_stack(4 ,isubstack)
202 fac = area(i)* thk(i) / (aldt(i))**2
203 sti = fac * a11
204 stir =one_over_12*fac* a11r*thk(i)**2
205 stifn(ixtg(2,i))=stifn(ixtg(2,i))+sti
206 stifn(ixtg(3,i))=stifn(ixtg(3,i))+sti
207 stifn(ixtg(4,i))=stifn(ixtg(4,i))+sti
208 stifr(ixtg(2,i))=stifr(ixtg(2,i))+stir
209 stifr(ixtg(3,i))=stifr(ixtg(3,i))+stir
210 stifr(ixtg(4,i))=stifr(ixtg(4,i))+stir
211 strtg(i) = stir
212 END DO
213 ELSE
214 DO i=jft,jlt
215 a11 =geo(ipgmat +5 ,iprop)
216 a11r =geo(ipgmat +7 ,iprop)
217 g =geo(ipgmat +4 ,iprop)
218 fac =area(i)* thk(i) / (aldt(i))**2
219 sti =fac* a11
220 stir =one_over_12*fac* a11r*thk(i)**2
221 stifn(ixtg(2,i))=stifn(ixtg(2,i))+sti
222 stifn(ixtg(3,i))=stifn(ixtg(3,i))+sti
223 stifn(ixtg(4,i))=stifn(ixtg(4,i))+sti
224 stifr(ixtg(2,i))=stifr(ixtg(2,i))+stir
225 stifr(ixtg(3,i))=stifr(ixtg(3,i))+stir
226 stifr(ixtg(4,i))=stifr(ixtg(4,i))+stir
227 strtg(i) = stir
228 END DO
229 ENDIF
230 ELSE
231 IF(igtyp == 11 .AND. igmat > 0 )THEN
232 DO i=jft,jlt
233 n=nft+i
234 IF(sh3tree(3,n) >= 0)THEN
235 a11 =geo(ipgmat +5 ,iprop)
236 a11r =geo(ipgmat +7 ,iprop)
237 g =geo(ipgmat +4 ,iprop)
238!! STI = AREA(I) * THK(I) * A11 / (ALDT(I))**2
239!! STIR = STI * THK(I) * THK(I) / 12.
240 fac =area(i)* thk(i) / (aldt(i))**2
241 sti =fac* a11
242 stir =one_over_12*fac* a11r*thk(i)**2
243 stifn(ixtg(2,i))=stifn(ixtg(2,i))+sti
244 stifn(ixtg(3,i))=stifn(ixtg(3,i))+sti
245 stifn(ixtg(4,i))=stifn(ixtg(4,i))+sti
246 stifr(ixtg(2,i))=stifr(ixtg(2,i))+stir
247 stifr(ixtg(3,i))=stifr(ixtg(3,i))+stir
248 stifr(ixtg(4,i))=stifr(ixtg(4,i))+stir
249 strtg(i) = stir
250 END IF
251 END DO
252 ELSEIF(igtyp == 52 .OR.
253 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0)) THEN
254 DO i=jft,jlt
255 n=nft+i
256 IF(sh3tree(3,n) >= 0)THEN
257 a11 = pm_stack(5 ,isubstack)
258 a11r = pm_stack(7 ,isubstack)
259 g = pm_stack(4 ,isubstack)
260 fac =area(i)* thk(i) / (aldt(i))**2
261 sti =fac* a11
262 stir =one_over_12*fac* a11r*thk(i)**2
263 stifn(ixtg(2,i))=stifn(ixtg(2,i))+sti
264 stifn(ixtg(3,i))=stifn(ixtg(3,i))+sti
265 stifn(ixtg(4,i))=stifn(ixtg(4,i))+sti
266 stifr(ixtg(2,i))=stifr(ixtg(2,i))+stir
267 stifr(ixtg(3,i))=stifr(ixtg(3,i))+stir
268 stifr(ixtg(4,i))=stifr(ixtg(4,i))+stir
269 strtg(i) = stir
270 END IF
271 END DO
272 ELSE
273 DO i=jft,jlt
274 n=nft+i
275 IF(sh3tree(3,n) >= 0)THEN
276 a11 =pm(24,imat)
277 g =pm(22,imat)
278 sti = area(i) * thk(i) * a11 / (aldt(i))**2
279 stir = sti * thk(i) * thk(i) / 12.
280 stifn(ixtg(2,i))=stifn(ixtg(2,i))+sti
281 stifn(ixtg(3,i))=stifn(ixtg(3,i))+sti
282 stifn(ixtg(4,i))=stifn(ixtg(4,i))+sti
283 stifr(ixtg(2,i))=stifr(ixtg(2,i))+stir
284 stifr(ixtg(3,i))=stifr(ixtg(3,i))+stir
285 stifr(ixtg(4,i))=stifr(ixtg(4,i))+stir
286 strtg(i) = stir
287 END IF
288 END DO
289 ENDIF
290 END IF
291C
292C---------------------------------------------------------
293 IF(ismstr/=3)THEN
294 DO 50 i=jft,jlt
295 px2(i) = zero
296 py2(i) = zero
297 px3(i) = zero
298 py3(i) = zero
299 50 CONTINUE
300 ELSE
301C---------------------------------------------------------
302C
303 DO i=jft,jlt
304 areai=half/area(i)
305 px2(i)=y3(i)*areai
306 py2(i)=-x3(i)*areai
307 px3(i)=-y2(i)*areai
308 py3(i)=x2(i)*areai
309 ENDDO
310C
311 DO 80 i=jft,jlt
312 ng=iprop
313 IF (geo(5,ng) == zero) GOTO 80
314 geo(5,ng)= min(geo(5,ng),dt(i))
315 80 CONTINUE
316 ENDIF
317C
318C---------------------------------------------------------
319 RETURN
320C
321 END
cdkderii
subroutine cdkderii(jft, jlt, pm, geo, px2, py2, px3, py3, stifn, stifr, ixtg, thk, sh3tree, aldt, uparam, ipm, igeo, pm_stack, isubstack, strtg, group_param, imat, iprop, area, dt, x1g, x2g, x3g, y1g, y2g, y3g, z1g, z2g, z3g, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
Definition cdkderii.F:37
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