OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_oned_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_oned_tensor (elbuf_tab, ifunc, iparg, geo, ixt, ixp, ixr, pm, anim, oned_tensor, id_elem, ity_elem, info1, info2, is_written_oned, ipartt, ipartp, ipartr, h3d_part, keyword, x, d, ipt_input)

Function/Subroutine Documentation

◆ h3d_oned_tensor()

subroutine h3d_oned_tensor ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer ifunc,
integer, dimension(nparg,*) iparg,
geo,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
pm,
anim,
oned_tensor,
integer, dimension(*) id_elem,
integer, dimension(*) ity_elem,
integer info1,
integer info2,
integer, dimension(*) is_written_oned,
integer, dimension(*) ipartt,
integer, dimension(*) ipartp,
integer, dimension(*) ipartr,
integer, dimension(*) h3d_part,
character(ncharline100) keyword,
x,
d,
integer ipt_input )

Definition at line 34 of file h3d_oned_tensor.F.

40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE elbufdef_mod
44 USE names_and_titles_mod, ONLY: ncharline100
45 use element_mod , only : nixt,nixr,nixp
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "mvsiz_p.inc"
54#include "com01_c.inc"
55#include "com04_c.inc"
56#include "param_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60C REAL
61 my_real
62 . pm(npropm,*), geo(npropg,*),
63 . anim(*),oned_tensor(6,*),x(3,*),d(3,*)
64 INTEGER IPARG(NPARG,*),
65 . IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),IFUNC,
66 . NANIM1D_L,
67 . IS_WRITTEN_ONED(*),ID_ELEM(*),ITY_ELEM(*),
68 . IPARTT(*) ,IPARTP(*),IPARTR(*),H3D_PART(*)
69 INTEGER INFO1, INFO2, IPT_INPUT
70C
71 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
72 CHARACTER(NCHARLINE100)::KEYWORD
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76C REAL
77 my_real
78 . evar(6,mvsiz),
79 . off, p, vonm2, vonm, s1, s2, s12, s3, value(3),
80 . a1,b1,b2,b3,yeq,f1,m1,m2,m3, xm,
81 . for, area, feq, eplas, rho0, a0, xx1, yy1, zz1, al0
82 INTEGER I, NG, NEL, NFT, ITY, NPT,
83 . IADD, N, J, LLT, MLW, NB1, NB2, NB3, NB4, NB5,
84 . NB6, NB7, NB8, NB9, NB10, NB11, NB12, NB13, NB14, NB15,
85 . NB16, LLL,NUVAR,IGTYP,
86 . ISTRAIN,NN, K1, K2,JTURB,MT,JALE, IMID, IALEL,IPID,
87 . NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10,NF,
88 . OFFSET,K,INC,KK,IHBE,ISROT,ILAYER,IR,IS,JJ(6),IOK_PART(MVSIZ),
89 . IS_WRITTEN_TENSOR(MVSIZ),N1, N2, IPT
90
91C
92 TYPE(G_BUFEL_) ,POINTER :: GBUF
93 TYPE(BUF_LAY_) ,POINTER :: BUFLY
94 TYPE(L_BUFEL_),POINTER :: LBUF
95C-----------------------------------------------
96C
97 nn1 = 1
98 nn3 = 1
99 nn4 = nn3
100 nn5 = nn4
101 nn6 = nn5
102 nn7 = nn6 + numelt
103 nn8 = nn7 + numelp
104 nn9 = nn8 + numelr
105 nn10= nn9
106C
107 DO ng=1,ngroup
108 mlw =iparg(1,ng)
109 nel =iparg(2,ng)
110 ity =iparg(5,ng)
111 igtyp =iparg(38,ng)
112C---
113 gbuf => elbuf_tab(ng)%GBUF
114C---
115 nft =iparg(3,ng)
116 npt = iparg(6,ng)
117!
118 DO i=1,3
119 jj(i) = nel*(i-1)
120 ENDDO
121
122 evar(1:6,1:nel) = zero
123 is_written_tensor(1:nel) = 0
124c
125 IF (ity == 4) offset = 0
126 IF (ity == 5) offset = numelt
127 IF (ity == 6) offset = numelt+numelp
128c
129 DO i=1,nel
130 IF (ity == 4) THEN
131 id_elem(offset+nft+i) = ixt(nixt,nft+i)
132 ity_elem(offset+nft+i) = 4
133 IF( h3d_part(ipartt(nft+i)) == 1) iok_part(i) = 1
134 ELSEIF (ity == 5) THEN
135 id_elem(offset+nft+i) = ixp(nixp,nft+i)
136 ity_elem(offset+nft+i) = 5
137 IF( h3d_part(ipartp(nft+i)) == 1) iok_part(i) = 1
138 ELSEIF (ity == 6) THEN
139 id_elem(offset+nft+i) = ixr(nixr,nft+i)
140 ity_elem(offset+nft+i) = 6
141 IF( h3d_part(ipartr(nft+i)) == 1) iok_part(i) = 1
142 ENDIF
143 ENDDO
144
145 ipt = ipt_input
146
147 IF(ity==4 .OR. ity==5 .OR. ity==6)THEN
148 DO i=1,nel
149 oned_tensor(1:6,offset+nft+i) = zero ! Default = zero in all cases !
150 ENDDO
151 ENDIF
152C-----------------------------------------------
153C TRUSS
154C-----------------------------------------------
155 IF(ity==4)THEN
156C--------------------------------------------------
157 IF (keyword == 'TEST') THEN
158C--------------------------------------------------
159 DO i=1,nel
160 evar(1,i) = zero
161 evar(2,i) = zero
162 evar(3,i) = zero
163 evar(4,i) = zero
164 evar(5,i) = zero
165 evar(6,i) = zero
166 is_written_tensor(i) = 1
167 ENDDO
168C--------------------------------------------------
169c ELSEIF (KEYWORD == '') THEN
170C--------------------------------------------------
171c DO I=1,NEL
172c VALUE(1) =
173c VALUE(2) =
174c VALUE(3) =
175c ENDDO
176C--------------------------------------------------
177 ELSEIF (keyword == 'TENS/STRESS') THEN
178C--------------------------------------------------
179 DO i=1,nel
180 for = gbuf%FOR(i)
181 area = gbuf%AREA(i)
182 evar(1,i) = for/area
183 is_written_tensor(i) = 1
184 ENDDO
185C--------------------------------------------------
186 ELSEIF (keyword == 'TENS/STRAIN') THEN
187C--------------------------------------------------
188 DO i=1,nel
189 evar(1,i) = gbuf%STRA(i)
190 is_written_tensor(i) = 1
191 ENDDO
192 ENDIF
193C-----------------------------------------------
194C POUTRES
195C-----------------------------------------------
196 ELSEIF(ity==5)THEN
197C--------------------------------------------------
198 IF (keyword == 'TENS/STRESS') THEN
199C--------------------------------------------------
200c NPT=NULL
201 IF(ipt < 0) THEN
202 DO i=1,nel
203 n = i + nft
204 evar(1,i) = gbuf%FOR(jj(1)+i) / geo(1,ixp(5,n))
205 evar(4,i) = gbuf%FOR(jj(2)+i) / geo(1,ixp(5,n))
206 evar(6,i) = gbuf%FOR(jj(3)+i) / geo(1,ixp(5,n))
207 is_written_tensor(i) = 1
208 ENDDO
209c NPT=IPT
210 ELSEIF(ipt > 0 .AND. ipt <= npt) THEN
211 ilayer = 1
212 bufly => elbuf_tab(ng)%BUFLY(ilayer)
213 IF (bufly%L_SIG > 0) THEN
214 lbuf => bufly%LBUF(1,1,ipt)
215 DO i=1,nel
216 evar(1,i) = lbuf%SIG(jj(1)+i)
217 evar(4,i) = lbuf%SIG(jj(2)+i)
218 evar(6,i) = lbuf%SIG(jj(3)+i)
219 is_written_tensor(i) = 1
220 ENDDO
221 END IF !(BUFLY%L_SIG > 0) THEN
222 ENDIF
223C--------------------------------------------------
224 ELSEIF (keyword == 'TENS/STRAIN') THEN
225C--------------------------------------------------
226c NPT=NULL
227 IF(ipt < 0 .AND. npt > 0) THEN
228 ilayer = 1
229 bufly => elbuf_tab(ng)%BUFLY(ilayer)
230 IF (bufly%L_STRA > 0) THEN
231 DO ipt = 1,npt
232 lbuf => bufly%LBUF(1,1,ipt)
233 DO i=1,nel
234 evar(1,i) =evar(1,i)+ lbuf%STRA(jj(1)+i)/npt
235 evar(4,i) =evar(4,i)+ lbuf%STRA(jj(2)+i)/npt
236 evar(6,i) =evar(6,i)+ lbuf%STRA(jj(3)+i)/npt
237 is_written_tensor(i) = 1
238 ENDDO
239 ENDDO
240 END IF !(BUFLY%L_STRA > 0) THEN
241c NPT=IPT
242 ELSEIF(ipt > 0 .AND. ipt <= npt) THEN
243 ilayer = 1
244 bufly => elbuf_tab(ng)%BUFLY(ilayer)
245 lbuf => bufly%LBUF(1,1,ipt)
246 IF (bufly%L_STRA > 0) THEN
247 DO i=1,nel
248 evar(1,i) = lbuf%STRA(jj(1)+i)
249 evar(4,i) = lbuf%STRA(jj(2)+i)
250 evar(6,i) = lbuf%STRA(jj(3)+i)
251 is_written_tensor(i) = 1
252 ENDDO
253 END IF !(BUFLY%L_STRA > 0) THEN
254 ENDIF !IPT
255C--------------------------------------------------
256 ELSEIF (keyword == 'TENS/STRAIN/MAX') THEN
257C--------------------------------------------------
258 DO ipt = 1,npt
259 ilayer = 1
260 bufly => elbuf_tab(ng)%BUFLY(ilayer)
261 lbuf => bufly%LBUF(1,1,ipt)
262 IF (bufly%L_STRA > 0) THEN
263 DO i=1,nel
264 evar(1,i) =max(evar(1,i), abs(lbuf%STRA(jj(1)+i)))
265 evar(4,i) =max(evar(4,i), abs(lbuf%STRA(jj(2)+i)))
266 evar(6,i) =max(evar(6,i), abs(lbuf%STRA(jj(3)+i)))
267 is_written_tensor(i) = 1
268 ENDDO
269 END IF !(BUFLY%L_STRA > 0) THEN
270 ENDDO
271C--------------------------------------------------
272 ELSEIF (keyword == 'TENS/STRAIN/TMAX') THEN
273C--------------------------------------------------
274 DO i=1,nel
275 evar(1,i) =gbuf%MAXEPS(jj(1)+i)
276 evar(4,i) =gbuf%MAXEPS(jj(2)+i)
277 evar(6,i) =gbuf%MAXEPS(jj(3)+i)
278 is_written_tensor(i) = 1
279 ENDDO
280C--------------------------------------------------
281C--------------------------------------------------
282c ELSEIF (KEYWORD == '') THEN
283C--------------------------------------------------
284c DO I=1,NEL
285c VALUE(1) =
286c VALUE(2) =
287c VALUE(3) =
288c ENDDO
289 ENDIF
290C-----------------------------------------------
291C RESSORTS
292C-----------------------------------------------
293 ELSEIF(ity==6)THEN
294C--------------------------------------------------
295 IF (keyword == 'TEST') THEN
296C--------------------------------------------------
297 DO i=1,nel
298 evar(1,i) = zero
299 evar(2,i) = zero
300 evar(3,i) = zero
301 evar(4,i) = zero
302 evar(5,i) = zero
303 evar(6,i) = zero
304 is_written_tensor(i) = 1
305 ENDDO
306C--------------------------------------------------
307c ELSEIF (KEYWORD == '') THEN
308C--------------------------------------------------
309c DO I=1,NEL
310c VALUE(1) =
311c VALUE(2) =
312c VALUE(3) =
313c ENDDO
314 ENDIF
315 ENDIF
316C-----------------------------------------------
317 IF(ity==4 .OR. ity==5 .OR. ity==6)THEN
318 CALL h3d_write_tensor(iok_part,is_written_oned,oned_tensor,nel,offset,nft,
319 . evar,is_written_tensor)
320 ENDIF
321C
322 ENDDO
323
324 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
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
max
#define max(a, b)
Definition macros.h:21
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
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