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