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 33 of file h3d_oned_tensor.F.

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