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