OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_quad_tensor.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ h3d_quad_tensor()

subroutine h3d_quad_tensor ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
quad_tensor,
integer, dimension(nparg,*) iparg,
integer itens,
integer, dimension(*) invert,
integer nelcut,
integer, dimension(*) el2fa,
tens,
epsdot,
integer, dimension(*) iadp,
integer nbpart,
integer, dimension(nspmd,*) iadg,
x,
integer, dimension(nixq,*) ixq,
integer, dimension(npropgi,*) igeo,
integer, dimension(nixtg,*) ixtg,
integer, dimension(npropmi,*) ipm,
type (stack_ply) stack,
integer, dimension(*) id_elem,
integer info1,
integer info2,
integer, dimension(*) is_written_quad,
integer, dimension(*) ipartq,
integer, dimension(*) iparttg,
integer layer_input,
integer ipt_input,
integer ply_input,
integer gauss_input,
integer iuvar_input,
integer, dimension(*) h3d_part,
character(len=ncharline100) keyword,
integer ir_input,
integer is_input,
integer it_input )

Definition at line 37 of file h3d_quad_tensor.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
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