OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_quad_tensor.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!||====================================================================
25!|| h3d_quad_tensor ../engine/source/output/h3d/h3d_results/h3d_quad_tensor.F
26!||--- called by ------------------------------------------------------
27!|| genh3d ../engine/source/output/h3d/h3d_results/genh3d.F
28!||--- calls -----------------------------------------------------
29!|| h3d_write_tensor ../engine/source/output/h3d/h3d_results/h3d_write_tensor.F
30!|| qrota_group ../engine/source/output/anim/generate/qrota_group.F
31!||--- uses -----------------------------------------------------
32!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
33!|| element_mod ../common_source/modules/elements/element_mod.F90
34!|| names_and_titles_mod ../common_source/modules/names_and_titles_mod.f
35!|| stack_mod ../engine/share/modules/stack_mod.F
36!||====================================================================
37 SUBROUTINE h3d_quad_tensor(ELBUF_TAB,QUAD_TENSOR,IPARG ,ITENS ,INVERT,NELCUT,
38 2 EL2FA ,TENS ,EPSDOT,IADP ,
39 3 NBPART,IADG ,X ,IXQ ,
40 4 IGEO ,IXTG ,IPM ,STACK,ID_ELEM ,INFO1,
41 5 INFO2 ,IS_WRITTEN_QUAD,IPARTQ ,IPARTTG ,LAYER_INPUT ,IPT_INPUT ,
42 6 PLY_INPUT,GAUSS_INPUT,IUVAR_INPUT,H3D_PART, KEYWORD,
43 7 IR_INPUT ,IS_INPUT ,IT_INPUT )
44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE elbufdef_mod
48 USE stack_mod
49 USE names_and_titles_mod, ONLY: ncharline100
50 use element_mod , only : nixq,nixtg
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "mvsiz_p.inc"
59C-----------------------------------------------
60#include "com01_c.inc"
61#include "com04_c.inc"
62#include "param_c.inc"
63C-----------------------------------------------
64C D u m m y A r g u m e n t s
65C-----------------------------------------------
66 INTEGER IPARG(NPARG,*),ITENS,INVERT(*),
67 . EL2FA(*),IXQ(NIXQ,*), IGEO(NPROPGI,*),
68 . NELCUT,IADP(*),NBPART,IADG(NSPMD,*),
69 . IXTG(NIXTG,*),IPM(NPROPMI,*),ID_ELEM(*),
70 . INFO1,INFO2,IS_WRITTEN_QUAD(*),IPARTQ(*),IPARTTG(*),H3D_PART(*),
71 . LAYER_INPUT ,IPT_INPUT,GAUSS_INPUT,PLY_INPUT,IUVAR_INPUT,II,
72 . ir_input,is_input,it_input
73C REAL
74 my_real
75 . tens(3,*),epsdot(6,*),x(3,*),quad_tensor(6,*)
76 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
77 TYPE (STACK_PLY) :: STACK
78 CHARACTER(LEN=NCHARLINE100) :: KEYWORD
79C-----------------------------------------------
80C L o c a l V a r i a b l e s
81C-----------------------------------------------
82C REAL
83 my_real
84 . a1,a2,a3,thk,y1,y2,y3,y4,z1,z2,z3,z4,
85 . sy,sz,ty,tz,suma,r11,r12,r13,r21,r22,
86 . r23,r31,r32,r33,s1,s2,s4,t1,t2,t3,t4,ct,cs,
87 . g22,g23,g32,g33,t22,t23,t32,t33
88 my_real
89 . sige(mvsiz,5)
90 my_real
91 . evar(6,mvsiz), gama(6,mvsiz)
92
93 INTEGER I, NG, NEL, NFT, ITY, LFT, NPT,
94 . n,j,llt,mlw,istrain,il,ir,is,it,nptr,npts,nlay,
95 . ipid,i1,i2,ns1,ns2,istre,
96 . nn1,nn2,nn3,nn4,nn5,nn6,nn7,nn8,nn9,nn10,nni,n0,
97 . ihbe,irep,buf,npg,k,isrot,nuvarv,ivisc,
98 . ipmat,igtyp,matly,isubstack,iigeo,iadi,ipmat_iply,
99 . npt_all,nptt,ilay,ius,id_ply,ipang,ippos,ipthk,offset,iselect,
100 . iply,iuvar,iad,jale,jturb,jcvt,nc1,nc2,nc3,nc4,isorth
101 INTEGER IOK_PART(MVSIZ), JJ(6), IS_WRITTEN_TENSOR(MVSIZ)
102C
103
104 TYPE(G_BUFEL_) ,POINTER :: GBUF
105 TYPE(L_BUFEL_) ,POINTER :: LBUF
106 my_real,
107 . DIMENSION(:), POINTER :: uvar
108C-----------------------------------------------
109 ilay = layer_input
110 iuvar = iuvar_input
111 ir = ir_input
112 is = is_input
113 it = it_input
114c
115 DO i=1,numelq
116 is_written_quad(i) = 0
117 ENDDO
118c a corriger
119 nn3 = 0
120c
121 DO ng=1,ngroup
122
123 mlw = iparg(1,ng)
124 nel = iparg(2,ng)
125 nft = iparg(3,ng)
126 npt = iparg(6,ng)
127 ity = iparg(5,ng)
128 igtyp = iparg(38,ng)
129 isrot = iparg(41,ng)
130 istrain = iparg(44,ng)
131 isubstack = iparg(71,ng)
132 isorth = iparg(42,ng)
133 jcvt = iparg(37,ng)
134 lft=1
135 llt=nel
136 iok_part(1:nel) = 0
137c
138 nptr = elbuf_tab(ng)%NPTR
139 npts = elbuf_tab(ng)%NPTS
140 nptt = elbuf_tab(ng)%NPTT
141c
142 IF (mlw /= 13) THEN
143 nft =iparg(3,ng)
144 iad =iparg(4,ng)
145 isubstack = iparg(71,ng)
146 ivisc = iparg(61,ng)
147 iok_part(1:nel) = 0
148!
149 DO i=1,6
150 jj(i) = nel*(i-1)
151 ENDDO
152c
153 evar(1:6,1:nel) = zero
154 is_written_tensor(1:nel) = 0
155C-----------------------------------------------
156C QUAD
157C-----------------------------------------------
158 IF(ity == 2)THEN
159
160 gbuf => elbuf_tab(ng)%GBUF
161 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
162 uvar => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)%VAR
163 jale=(iparg(7,ng)+iparg(11,ng))
164 jturb=iparg(12,ng)*jale
165c
166 DO i=1,nel
167 id_elem(nft+i) = ixq(nixq,nft+i)
168 IF( h3d_part(ipartq(nft+i)) == 1) iok_part(i) = 1
169 ENDDO
170c
171 DO i=1,nel
172 IF (isorth == 0) THEN
173 gama(1,i)=one
174 gama(2,i)=zero
175 gama(3,i)=zero
176 gama(4,i)=zero
177 gama(5,i)=one
178 gama(6,i)=zero
179 ELSE
180 gama(1,i)=gbuf%GAMA(jj(1) + i)
181 gama(2,i)=gbuf%GAMA(jj(2) + i)
182 gama(3,i)=gbuf%GAMA(jj(3) + i)
183 gama(4,i)=gbuf%GAMA(jj(4) + i)
184 gama(5,i)=gbuf%GAMA(jj(5) + i)
185 gama(6,i)=gbuf%GAMA(jj(6) + i)
186 ENDIF
187 ENDDO
188C-----------------------------------------------
189 IF (keyword == 'TENS/STRESS') THEN
190C-----------------------------------------------
191C---------------------------------------------
192C in 2d the stresses are:
193C 1=YY 2=ZZ 3=TT 4=YZ 5=0 6=0
194C IN CONTRADICTION WITH X=T
195C---------------------------------------------
196c ILAYER=NULL IR=NULL IS=NULL IT=NULL
197 IF( ilay == -1 .AND. ir == -1 .AND. is == -1 .AND. it == -1 )THEN
198 DO i=1,nel
199 ii = 6*(i-1)
200 evar(1,i) = gbuf%SIG(jj(1) + i)
201 evar(2,i) = gbuf%SIG(jj(2) + i)
202 evar(4,i) = gbuf%SIG(jj(4) + i)
203 is_written_tensor(i) = 1
204 ENDDO
205c
206 IF(ivisc > 0) THEN
207 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
208 DO i=1,nel
209 ii = 6*(i-1)
210 evar(1,i) =evar(1,i)+ lbuf%VISC(jj(1) + i)
211 evar(2,i) =evar(2,i)+ lbuf%VISC(jj(2) + i)
212 evar(4,i) =evar(4,i)+ lbuf%VISC(jj(4) + i)
213 ENDDO
214 ENDIF
215c
216 IF( nfilsol /= 0 .AND. gbuf%G_FILL /= 0 ) THEN
217 DO i=1,nel
218 evar(1,i) = evar(1,i) * gbuf%FILL(i)
219 evar(2,i) = evar(2,i) * gbuf%FILL(i)
220 evar(4,i) = evar(4,i) * gbuf%FILL(i)
221 ENDDO
222 ENDIF
223
224 IF (jcvt == 0 .OR. isorth /= 0) THEN
225C OUTPUT TENSOR STORED IN GLOBAL SYSTEM TO BE TRANSFERRED IN THE ELEMENT LOCAL ONE
226 CALL qrota_group(
227 1 x, ixq(1,nft+1),jcvt, evar,
228 2 gbuf%GAMA, nel, isorth)
229 ENDIF
230c
231 ELSEIF ( ilay == -1 .AND. iabs(it) == 1 .AND. ir >= 0 .AND.
232 . ir <= nptr .AND. is >= 0 .AND. is <= npts) THEN
233c
234 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,1)
235 DO i=1,nel
236 ii = 6*(i-1)
237 evar(1,i) = lbuf%SIG(jj(1) + i)
238 evar(2,i) = lbuf%SIG(jj(2) + i)
239 evar(4,i) = lbuf%SIG(jj(4) + i)
240 is_written_tensor(i) = 1
241 ENDDO
242c
243 IF(ivisc > 0) THEN
244 DO i=1,nel
245 ii = 6*(i-1)
246 evar(1,i) =evar(1,i)+ lbuf%VISC(jj(1) + i)
247 evar(2,i) =evar(2,i)+ lbuf%VISC(jj(2) + i)
248 evar(4,i) =evar(4,i)+ lbuf%VISC(jj(4) + i)
249 ENDDO
250 ENDIF
251c
252 IF( nfilsol /= 0 .AND. gbuf%G_FILL /= 0 ) THEN
253 DO i=1,nel
254 evar(1,i) = evar(1,i) * gbuf%FILL(i)
255 evar(2,i) = evar(2,i) * gbuf%FILL(i)
256 evar(4,i) = evar(4,i) * gbuf%FILL(i)
257 ENDDO
258 ENDIF
259c
260 IF (jcvt == 0 .OR. isorth /= 0) THEN
261C OUTPUT TENSOR STORED IN GLOBAL SYSTEM TO BE TRANSFERRED IN THE ELEMENT LOCAL ONE
262 CALL qrota_group(
263 1 x, ixq(1,nft+1),jcvt, evar,
264 2 gbuf%GAMA, nel, isorth)
265 ENDIF
266c
267 ENDIF
268c
269C-----------------------------------------------
270 ELSEIF (keyword == 'TENS/STRAIN') THEN
271C-----------------------------------------------
272 IF( ilay == -1 .AND. ir == -1 .AND. is == -1 .AND. it == -1 )THEN
273c
274 DO i=1,nel
275 n = i + nft
276 DO is=1,npts
277 DO it=1,nptt
278 DO ir=1,nptr
279 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
280 evar(1,i) = evar(1,i) + lbuf%STRA(jj(1) + i)/npt
281 evar(2,i) = evar(2,i) + lbuf%STRA(jj(2) + i)/npt
282 evar(4,i) = evar(4,i) + lbuf%STRA(jj(4) + i)*half/npt
283 is_written_tensor(i) = 1
284 ENDDO
285 ENDDO
286 ENDDO
287 ENDDO
288
289 IF (jcvt == 0 .OR. isorth /= 0) THEN
290C OUTPUT TENSOR STORED IN GLOBAL SYSTEM TO BE TRANSFERRED IN THE ELEMENT LOCAL ONE
291 CALL qrota_group(
292 1 x, ixq(1,nft+1),jcvt, evar,
293 2 gbuf%GAMA, nel, isorth)
294 ENDIF
295c
296 ELSEIF ( ilay == -1 .AND. iabs(it) == 1 .AND. ir >= 0 .AND.
297 . ir <= nptr .AND. is >= 0 .AND. is <= npts) THEN
298c
299 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,1)
300 DO i=1,nel
301 n = i + nft
302 evar(1,i) = evar(1,i) + lbuf%STRA(jj(1) + i)
303 evar(2,i) = evar(2,i) + lbuf%STRA(jj(2) + i)
304 evar(4,i) = evar(4,i) + lbuf%STRA(jj(4) + i)
305 is_written_tensor(i) = 1
306 ENDDO
307
308 IF (jcvt == 0 .OR. isorth /= 0) THEN
309C OUTPUT TENSOR STORED IN GLOBAL SYSTEM TO BE TRANSFERRED IN THE ELEMENT LOCAL ONE
310 CALL qrota_group(
311 1 x, ixq(1,nft+1),jcvt, evar,
312 2 gbuf%GAMA, nel, isorth)
313 ENDIF
314c
315 ENDIF
316c
317C-----------------------------------------------
318 ELSEIF (keyword == 'TENS/DAMA') THEN
319C-----------------------------------------------
320 IF( ilay == -1 .AND. ir == -1 .AND. is == -1 .AND. it == -1 )THEN
321c
322 DO i=1,nel
323 n = i + nft
324 DO is=1,npts
325 DO it=1,nptt
326 DO ir=1,nptr
327 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
328 IF(elbuf_tab(ng)%BUFLY(1)%L_DGLO > 0) THEN
329 evar(1,i) = evar(1,i)+lbuf%DGLO(jj(1) + i)/npt
330 evar(2,i) = evar(2,i)+lbuf%DGLO(jj(2) + i)/npt
331 evar(4,i) = evar(4,i)+lbuf%DGLO(jj(4) + i)/npt
332 is_written_tensor(i) = 1
333 ENDIF
334 ENDDO
335 ENDDO
336 ENDDO
337 ENDDO
338c
339 ELSEIF ( ilay == -1 .AND. iabs(it) == 1 .AND. ir >= 0 .AND.
340 . ir <= nptr .AND. is >= 0 .AND. is <= npts) THEN
341c
342 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,1)
343 IF (elbuf_tab(ng)%BUFLY(1)%L_DGLO > 0) THEN
344 DO i=1,nel
345 n = i + nft
346 evar(1,i) = evar(1,i)+lbuf%DGLO(jj(1) + i)
347 evar(2,i) = evar(2,i)+lbuf%DGLO(jj(2) + i)
348 evar(4,i) = evar(4,i)+lbuf%DGLO(jj(4) + i)
349 is_written_tensor(i) = 1
350 ENDDO
351 ENDIF
352c
353 ENDIF
354C-----------------------------------------------
355 ELSEIF (keyword == 'TENS/EPSP') THEN
356C-----------------------------------------------
357 IF( ilay == -1 .AND. ir == -1 .AND. is == -1 .AND. it == -1 )THEN
358c
359 DO i=1,nel
360 n = i + nft
361 DO is=1,npts
362 DO it=1,nptt
363 DO ir=1,nptr
364 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
365 evar(1,i) = evar(1,i) + lbuf%PLA(jj(1) + i + nel)/npt
366 evar(2,i) = evar(2,i) + lbuf%PLA(jj(2) + i + nel)/npt
367 evar(4,i) = evar(4,i) + lbuf%PLA(jj(4) + i + nel)*half/npt
368 is_written_tensor(i) = 1
369 ENDDO
370 ENDDO
371 ENDDO
372 ENDDO
373
374 IF (jcvt == 0 .OR. isorth /= 0) THEN
375C OUTPUT TENSOR STORED IN GLOBAL SYSTEM TO BE TRANSFERRED IN THE ELEMENT LOCAL ONE
376 CALL qrota_group(
377 1 x, ixq(1,nft+1),jcvt, evar,
378 2 gbuf%GAMA, nel, isorth)
379 ENDIF
380c
381 ELSEIF ( ilay == -1 .AND. iabs(it) == 1 .AND. ir >= 0 .AND.
382 . ir <= nptr .AND. is >= 0 .AND. is <= npts) THEN
383c
384 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,1)
385 DO i=1,nel
386 n = i + nft
387 evar(1,i) = evar(1,i) + lbuf%PLA(jj(1) + i + nel)
388 evar(2,i) = evar(2,i) + lbuf%PLA(jj(2) + i + nel)
389 evar(4,i) = evar(4,i) + lbuf%PLA(jj(4) + i + nel)
390 is_written_tensor(i) = 1
391 ENDDO
392
393 IF (jcvt == 0 .OR. isorth /= 0) THEN
394C OUTPUT TENSOR STORED IN GLOBAL SYSTEM TO BE TRANSFERRED IN THE ELEMENT LOCAL ONE
395 CALL qrota_group(
396 1 x, ixq(1,nft+1),jcvt, evar,
397 2 gbuf%GAMA, nel, isorth)
398 ENDIF
399c
400 ENDIF
401 ENDIF
402C-----------------------------------------------
403 CALL h3d_write_tensor(iok_part,is_written_quad,quad_tensor,nel,0,nft,
404 . evar,is_written_tensor)
405C---------------------------------------------------------------------------
406c IF (KEYWORD == 'NEWKEY') THEN ! New Output Example
407C---------------------------------------------------------------------------
408c ILAYER=NULL NPT=NULL
409c IF ( ILAY == -1 .AND. IPT == -1 .AND. IPLY == -1) THEN
410c DO I=1,NEL
411c VALUE(I) =
412c ENDDO
413c PLY=IPLY NPT=IPT
414c ELSEIF ( IPLY > 0 .AND. IPT <= MPT .AND. IPT > 0 ) THEN
415c IF (IGTYP == 17 .OR. IGTYP == 51 .OR. IGTYP == 52) THEN
416c
417c ENDIF
418c
419c PLY=NULL ILAYER=ILAY NPT=IPT
420c ELSEIF (IPLY == -1 .AND. ILAY <= NLAY .AND. ILAY > 0 .AND. IPT <= MPT .AND. IPT > 0 ) THEN
421c IF (IGTYP == 51 .OR. IGTYP == 52) THEN
422c
423c ENDIF
424c PLY=NULL ILAYER=IL NPT=NULL
425c ELSEIF (IPLY == -1 .AND. ILAY <= NLAY .AND. ILAY > 0 .AND. IPT == -1 ) THEN
426c IF (IGTYP == 10 .OR. IGTYP == 11 .OR. IGTYP == 16 .OR. IGTYP == 17) THEN
427c
428c ELSEIF (IGTYP == 51 .OR. IGTYP == 52) THEN
429c
430c ENDIF
431c PLY=NULL ILAYER=NULL NPT=IPT
432c ELSEIF ( IPT <= MPT .AND. IPT > 0) THEN
433c IF (IGTYP == 1 .OR. IGTYP == 9) THEN
434c
435c ENDIF
436c ENDIF
437 ENDIF ! IF(ITY == 2)
438 ENDIF ! IF (MLW /= 13)
439 ENDDO
440C-----------------------------------------------
441C
442 RETURN
443 END
my_real
#define my_real
Definition cppsort.cpp:32
h3d_quad_tensor
subroutine h3d_quad_tensor(elbuf_tab, quad_tensor, iparg, itens, invert, nelcut, el2fa, tens, epsdot, iadp, nbpart, iadg, x, ixq, igeo, ixtg, ipm, stack, id_elem, info1, info2, is_written_quad, ipartq, iparttg, layer_input, ipt_input, ply_input, gauss_input, iuvar_input, h3d_part, keyword, ir_input, is_input, it_input)
Definition h3d_quad_tensor.F:44
h3d_write_tensor
subroutine h3d_write_tensor(iok_part, is_written, tensor, nel, offset, nft, value, is_written_tensor)
Definition h3d_write_tensor.F:35
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::ncharline100
integer, parameter ncharline100
Definition names_and_titles_mod.F:1007
stack_mod
Definition stack_mod.F:75
qrota_group
subroutine qrota_group(x, ixq, kcvt, tens, gama, nel, isorth)
Definition qrota_group.F:33