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 36 of file h3d_quad_tensor.F.

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 IF( ilay == -1 .AND. ir == -1 .AND. is == -1 .AND. 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 IF (jcvt == 0 .OR. 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 ELSEIF ( ilay == -1 .AND. iabs(it) == 1 .AND. ir >= 0 .AND.
298 . ir <= nptr .AND. is >= 0 .AND. 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 IF (jcvt == 0 .OR. 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 IF( ilay == -1 .AND. ir == -1 .AND. is == -1 .AND. 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 ELSEIF ( ilay == -1 .AND. iabs(it) == 1 .AND. ir >= 0 .AND.
341 . ir <= nptr .AND. is >= 0 .AND. 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 IF( ilay == -1 .AND. ir == -1 .AND. is == -1 .AND. 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 IF (jcvt == 0 .OR. 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 ELSEIF ( ilay == -1 .AND. iabs(it) == 1 .AND. ir >= 0 .AND.
383 . ir <= nptr .AND. is >= 0 .AND. 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 IF (jcvt == 0 .OR. 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
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: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