OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
tensorc.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!|| tensorc ../starter/source/output/anim/tensorc.F
25!||--- called by ------------------------------------------------------
26!|| genani1 ../starter/source/output/anim/genani1.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!||====================================================================
30 SUBROUTINE tensorc(ELBUF_TAB,IPARG,ITENS,
31 2 INVERT,NELCUT,EL2FA,NBF ,TENS ,
32 3 IADP ,NBF_L,NBPART,
33 4 X ,IXC ,IGEO ,IXTG )
34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37 USE elbufdef_mod
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "com01_c.inc"
46#include "com04_c.inc"
47#include "param_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER IPARG(NPARG,*),ITENS, INVERT(*),
52 . EL2FA(*),IXC(NIXC,*), IGEO(NPROPGI,*),
53 . NELCUT,NBF,IADP(*),NBF_L,NBPART,
54 . ixtg(nixtg,*)
55 REAL WA(3*NBF_L)
56 my_real
57 . TENS(3,*), X(3,*)
58 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
59C-----------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62C REAL
63 my_real
64 . off, fac, a1, a2, a3, thk
65 REAL R4(18)
66 INTEGER I,J,I1,I2,N, NG, NEL, NFT, ITY, LFT, NPT, IL,IPT,NLAY,
67 . LLT, MLW, ISTRAIN, ISTRE,
68 . n0,nni,nn1,nn2,nn3,nn4,nn5,nn6,nn7,nn8,nn9,ii(8)
69 TYPE(g_bufel_) ,POINTER :: GBUF
70 TYPE(L_BUFEL_) ,POINTER :: LBUF
71 TYPE(BUF_LAY_) ,POINTER :: BUFLY
72C=======================================================================
73 DO j=1,18
74 r4(j) = zero
75 ENDDO
76 istre = 0
77C
78 nn1 = 1
79 nn2 = nn1
80 nn3 = nn2
81 nn4 = nn3 + numelq
82 nn5 = nn4 + numelc
83 nn6 = nn5 + numeltg
84 nn7 = nn6
85 nn8 = nn7
86 nn9 = nn8
87C
88 DO ng=1,ngroup
89 mlw = iparg(1,ng)
90 nel = iparg(2,ng)
91 nft = iparg(3,ng)
92 ity = iparg(5,ng)
93 lft = 1
94 llt = nel
95!
96 DO j=1,8 ! length max of GBUF%G_STRA = 8
97 ii(j) = nel*(j-1)
98 ENDDO
99!
100C-----------------------------------------------
101 IF(ity == 2)THEN
102C QUAD
103C-----------------------------------------------
104 DO i=lft,llt
105 n = i + nft
106 tens(1,el2fa(nn3+n)) = zero
107 tens(2,el2fa(nn3+n)) = zero
108 tens(3,el2fa(nn3+n)) = zero
109 ENDDO
110C-----------------------------------------------
111 ELSEIF(ity == 3.OR.ity == 7)THEN
112C COQUES
113C-----------------------------------------------
114 gbuf => elbuf_tab(ng)%GBUF
115 nlay = elbuf_tab(ng)%NLAY
116 npt = iabs(iparg(6,ng))
117 istrain = iparg(44,ng)
118C
119 fac = zero
120 a1 = zero
121 a2 = zero
122 a3 = zero
123 istre = 1
124c
125c STRAIN
126c
127 IF (itens == 5) THEN
128 istre = 0
129 a1 = zero
130 a2 = zero
131 IF (istrain == 1) THEN
132 a1 = one
133 ENDIF
134 ELSEIF (itens == 6) THEN
135 istre = 0
136 a1 = zero
137 a2 = zero
138 IF (istrain == 1) THEN
139 a2 = one
140 ENDIF
141 ELSEIF (itens == 7) THEN
142 istre = 0
143 a1 = zero
144 a2 = zero
145 IF (istrain == 1) THEN
146 a1 = one
147 a2 = half
148 ENDIF
149 ELSEIF (itens == 8) THEN
150 istre = 0
151 a1 = zero
152 a2 = zero
153 IF (istrain == 1) THEN
154 a1 = one
155 a2 = -half
156 ENDIF
157 ELSEIF (itens >= 201 .AND. itens <= 300) THEN
158 istre = 0
159 a1 = zero
160 a2 = zero
161 IF (istrain == 1 .AND. npt /= 0) THEN
162 ipt = min(npt,itens - 200)
163 a1 = one
164 a2 = half*(((2*ipt-one)/npt)-one)
165 ENDIF
166 ENDIF ! IF (ITENS == 5)
167 ENDIF ! IF(ITY == 2)
168C------------------------
169C STRAIN RATE (ne fonctionne pas : pas d'EPSDOT)
170C------------------------
171 IF (ity == 3) THEN
172 n0 = 0
173 nni = nn4
174 ELSE
175 n0 = numelc
176 nni = nn5
177 ENDIF
178c-----------------------------------------------------------
179 IF (istre == 1) THEN
180C------------------------
181C STRESS
182C------------------------
183 IF (itens == 1) THEN
184 DO i=lft,llt
185 n = i + nft
186 DO j = 1,3
187 r4(j) = gbuf%FOR(ii(j)+i)
188 ENDDO
189 r4(3) = r4(3) * invert(el2fa(nni+n))
190 tens(1,el2fa(nni+n)) = r4(1)
191 tens(2,el2fa(nni+n)) = r4(2)
192 tens(3,el2fa(nni+n)) = r4(3)
193 ENDDO
194 ELSEIF (itens == 2) THEN
195 DO i=lft,llt
196 n = i + nft
197 DO j = 1,3
198 r4(j) = gbuf%MOM(ii(j)+i)
199 ENDDO
200 r4(3) = r4(3) * invert(el2fa(nni+n))
201 tens(1,el2fa(nni+n)) = r4(1)
202 tens(2,el2fa(nni+n)) = r4(2)
203 tens(3,el2fa(nni+n)) = r4(3)
204 ENDDO
205 ELSEIF (itens == 3) THEN
206 IF (mlw == 1) THEN
207 DO i=lft,llt
208 n = i + nft
209 DO j = 1,3
210 r4(j) = gbuf%FOR(ii(j)+i) + six*gbuf%MOM(ii(j)+i)
211 ENDDO
212 r4(3) = r4(3) * invert(el2fa(nni+n))
213 tens(1,el2fa(nni+n)) = r4(1)
214 tens(2,el2fa(nni+n)) = r4(2)
215 tens(3,el2fa(nni+n)) = r4(3)
216 ENDDO
217 ELSEIF (mlw == 3.OR.mlw == 23) THEN
218 DO i=lft,llt
219 n = i + nft
220 DO j = 1,3
221 r4(j) = gbuf%FOR(ii(j)+i)
222 ENDDO
223 r4(3) = r4(3) * invert(el2fa(nni+n))
224 tens(1,el2fa(nni+n)) = r4(1)
225 tens(2,el2fa(nni+n)) = r4(2)
226 tens(3,el2fa(nni+n)) = r4(3)
227 ENDDO
228 ELSEIF (mlw == 2 .OR. mlw == 19 .OR.
229 . mlw == 22 .OR. mlw == 25 .OR.
230 . mlw == 27 .OR. mlw == 32 .OR.
231 . mlw == 36 .OR. mlw == 15) THEN
232 IF (nlay > 1) THEN
233 bufly => elbuf_tab(ng)%BUFLY(npt)
234 DO i=lft,llt
235 n = i + nft
236 i1 = (i-1) * 5
237 DO j = 1,3
238 r4(j) = bufly%SIGPT(i1+j)
239 ENDDO
240 r4(3) = r4(3) * invert(el2fa(nni+n))
241 tens(1,el2fa(nni+n)) = r4(1)
242 tens(2,el2fa(nni+n)) = r4(2)
243 tens(3,el2fa(nni+n)) = r4(3)
244 ENDDO
245 ELSE
246 bufly => elbuf_tab(ng)%BUFLY(1)
247 DO i=lft,llt
248 n = i + nft
249 i1 = (i-1) * 5
250 DO j = 1,3
251 r4(j) = bufly%SIGPT((npt-1)*nel*5 + i1 + j)
252 ENDDO
253 r4(3) = r4(3) * invert(el2fa(nni+n))
254 tens(1,el2fa(nni+n)) = r4(1)
255 tens(2,el2fa(nni+n)) = r4(2)
256 tens(3,el2fa(nni+n)) = r4(3)
257 ENDDO
258 ENDIF ! IF (NLAY > 1)
259 ENDIF ! IF (MLW == 1)
260c
261 ELSEIF (itens == 4) THEN
262 IF (mlw == 1) THEN
263 DO i=lft,llt
264 n = i + nft
265 DO j = 1,3
266 r4(j) = gbuf%FOR(ii(j)+i) - six*gbuf%MOM(ii(j)+i)
267 ENDDO
268 r4(3) = r4(3) * invert(el2fa(nni+n))
269 tens(1,el2fa(nni+n)) = r4(1)
270 tens(2,el2fa(nni+n)) = r4(2)
271 tens(3,el2fa(nni+n)) = r4(3)
272 ENDDO
273 ELSEIF (mlw == 3.OR.mlw == 23) THEN
274 DO i=lft,llt
275 n = i + nft
276 DO j = 1,3
277 r4(j) = gbuf%FOR(ii(j)+i)
278 ENDDO
279 r4(3) = r4(3) * invert(el2fa(nni+n))
280 tens(1,el2fa(nni+n)) = r4(1)
281 tens(2,el2fa(nni+n)) = r4(2)
282 tens(3,el2fa(nni+n)) = r4(3)
283 ENDDO
284 ELSEIF (mlw == 2.OR.mlw == 19.OR.
285 . mlw == 22.OR.mlw == 25.OR.
286 . mlw == 27.OR.mlw == 32.OR.
287 . mlw == 36.OR.mlw == 15)THEN
288 bufly => elbuf_tab(ng)%BUFLY(1)
289 DO i=lft,llt
290 n = i + nft
291 i1 = (i-1) * 5
292 DO j = 1,3
293 r4(j) = bufly%SIGPT(i1+j)
294 ENDDO
295 r4(3) = r4(3) * invert(el2fa(nni+n))
296 tens(1,el2fa(nni+n)) = r4(1)
297 tens(2,el2fa(nni+n)) = r4(2)
298 tens(3,el2fa(nni+n)) = r4(3)
299 ENDDO
300 ENDIF ! IF (MLW == 1)
301 ELSEIF (itens>=101.AND.itens<=200) THEN
302 IF (mlw == 1.OR.mlw == 3.OR.mlw == 23) THEN
303 DO i=lft,llt
304 n = i + nft
305 DO j = 1,3
306 r4(j) = gbuf%FOR(ii(j)+i)
307 ENDDO
308 r4(3) = r4(3) * invert(el2fa(nni+n))
309 tens(1,el2fa(nni+n)) = r4(1)
310 tens(2,el2fa(nni+n)) = r4(2)
311 tens(3,el2fa(nni+n)) = r4(3)
312 ENDDO
313 ELSEIF (mlw == 2.OR.mlw == 19.OR.
314 . mlw == 22.OR.mlw == 25.OR.
315 . mlw == 27.OR.mlw == 32.OR.
316 . mlw == 36.OR.mlw == 15) THEN
317 ipt = min(npt,itens-100)
318 IF (nlay > 1) THEN
319 bufly => elbuf_tab(ng)%BUFLY(ipt)
320 DO i=lft,llt
321 n = i + nft
322 i1 = (i-1) * 5
323 DO j = 1,3
324 r4(j) = bufly%SIGPT(i1+j)
325 ENDDO
326 r4(3) = r4(3) * invert(el2fa(nni+n))
327 tens(1,el2fa(nni+n)) = r4(1)
328 tens(2,el2fa(nni+n)) = r4(2)
329 tens(3,el2fa(nni+n)) = r4(3)
330 ENDDO
331 ELSE
332 bufly => elbuf_tab(ng)%BUFLY(1)
333 DO i=lft,llt
334 n = i + nft
335 i1 = (i-1) * 5
336 DO j = 1,3
337 r4(j) = bufly%SIGPT((ipt-1)*nel*5 + i1 + j)
338 ENDDO
339 r4(3) = r4(3) * invert(el2fa(nni+n))
340 tens(1,el2fa(nni+n)) = r4(1)
341 tens(2,el2fa(nni+n)) = r4(2)
342 tens(3,el2fa(nni+n)) = r4(3)
343 ENDDO
344 ENDIF ! IF (nlay > 1)
345 ENDIF ! IF (MLW == 1.OR.MLW == 3.OR.MLW == 23)
346 ENDIF ! IF (ITENS == 1)
347C------------------------
348 ELSEIF (istre == 0 .AND. gbuf%G_STRA > 0) THEN
349C------------------------
350C STRAIN
351C------------------------
352 DO i=lft,llt
353 n = i + nft
354 thk = gbuf%THK(i)
355 IF (itens /= 6) THEN
356 DO j=1,3
357 r4(j) = a1*gbuf%STRA(ii(j)+i) + a2*gbuf%STRA(ii(j)+i) * thk
358 ENDDO
359 ELSE
360 DO j=1,3
361 r4(j) = gbuf%STRA(ii(j)+i)
362 ENDDO
363 ENDIF
364 r4(3) = r4(3) * invert(el2fa(nni+n)) * half
365 tens(1,el2fa(nni+n)) = r4(1)
366 tens(2,el2fa(nni+n)) = r4(2)
367 tens(3,el2fa(nni+n)) = r4(3)
368 ENDDO
369 ENDIF ! IF (ISTRE == 1)
370 ENDDO ! DO NG=1,NGROUP
371C-----------------------------------------------
372 DO n=1,nbf
373 r4(1) = tens(1,n)
374 r4(2) = tens(2,n)
375 r4(3) = tens(3,n)
376 CALL write_r_c(r4,3)
377 ENDDO
378C-----------------------------------------------
379 IF (nelcut > 0) THEN
380 DO i=1,nelcut
381 CALL write_r_c(r4,3)
382 ENDDO
383 ENDIF
384C-----------
385 RETURN
386 END
min
#define min(a, b)
Definition macros.h:20
tensorc
subroutine tensorc(elbuf_tab, iparg, itens, invert, nelcut, el2fa, nbf, tens, iadp, nbf_l, nbpart, x, ixc, igeo, ixtg)
Definition tensorc.F:34
write_r_c
void write_r_c(float *w, int *len)
Definition write_routtines.c:519