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

Go to the source code of this file.

Functions/Subroutines

subroutine h3d_sph_tensor (elbuf_tab, sph_tensor, iparg, itens, kxsp, pm, el2fa, nbf, tens, epsdot, nbpart, x, iadg, ipart, ipartsp, isph3d, ipm, igeo, id_elem, is_written_sph, h3d_part, keyword)

Function/Subroutine Documentation

◆ h3d_sph_tensor()

subroutine h3d_sph_tensor ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
sph_tensor,
integer, dimension(nparg,*) iparg,
integer itens,
integer, dimension(nisp,*) kxsp,
pm,
integer, dimension(*) el2fa,
integer nbf,
tens,
epsdot,
integer nbpart,
x,
integer, dimension(nspmd,*) iadg,
integer, dimension(lipart1,*) ipart,
integer, dimension(*) ipartsp,
integer isph3d,
integer, dimension(npropmi,*) ipm,
integer, dimension(npropgi,*) igeo,
integer, dimension(*) id_elem,
integer, dimension(*) is_written_sph,
integer, dimension(*) h3d_part,
character(len=ncharline100) keyword )

Definition at line 37 of file h3d_sph_tensor.F.

43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE initbuf_mod
47 USE elbufdef_mod
48 USE schlieren_mod
49 USE stack_mod
50 USE names_and_titles_mod, ONLY: ncharline100
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 "vect01_c.inc"
59#include "mvsiz_p.inc"
60#include "com01_c.inc"
61#include "com04_c.inc"
62#include "sphcom.inc"
63#include "param_c.inc"
64#include "scr17_c.inc"
65C-----------------------------------------------
66C D u m m y A r g u m e n t s
67C-----------------------------------------------
68C REAL
69 my_real
70 . sph_tensor(6,*), tens(6,*),epsdot(6,*),pm(npropm,*),x(3,*)
71 INTEGER IPARG(NPARG,*),ITENS,
72 . KXSP(NISP,*),EL2FA(*),IADG(NSPMD,*),IPM(NPROPMI,*),
73 . NBF,NBPART,IPART(LIPART1,*),IPARTSP(*),
74 . ISPH3D,IGEO(NPROPGI,*),IS_WRITTEN_SPH(*),ID_ELEM(*),
75 . H3D_PART(*)
76 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
77 CHARACTER(LEN=NCHARLINE100):: KEYWORD
78C-----------------------------------------------
79C L o c a l V a r i a b l e s
80C-----------------------------------------------
81 my_real
82 . evar(6,mvsiz)
83 my_real
84 . off, p,vonm2,s1,s2,s3,VALUE,dmgmx,fac,
85 . dir1_1,dir1_2,dir2_1,dir2_2,aa,bb,v1,v2,v3,x21,x32,x34,
86 . x41,y21,y32,y34,y41,z21,z32,z34,z41,suma,vr,vs,x31,y31,
87 . z31,e11,e12,e13,e21,e22,e23,sum,area,x2l,var,
88 . e1x,e1y,e1z,e2x,e2y,e2z,e3x,e3y,e3z,rx,ry,rz,sx,sy,sz,
89 . vg(5),vly(5),ve(5),s4,s5,s6,vonm, gama(6),evar_tmp(6),
90 . a1
91 my_real
92 . g11,g22,g33,g12,g21,g23,g32,g13,g31,
93 . l11,l22,l33,l12,l21,l23,l32,l13,l31,
94 . s11,s22,s33,s12,s21,s23,s32,s13,s31
95 INTEGER I, NG, NEL,
96 . IR,IS,IT,IL,MLW, NUVAR,IUS,LENF,PTF,PTM,PTS,NFAIL,
97 . N,NN,K,K1,K2,JTURB,MT,IMID,IALEL,IPID,ISH3N,NNI,
98 . NN1,NN2,NN3,NN4,NN5,NN6,NN9,NF,BUF,NVARF,
99 . IHBE,NPTM,NPG, MPT,IPT,IADD,IADR,IPMAT,IFAILT,
100 . IIGEO,IADI,ISUBSTACK,ITHK,
101 . ID_PLY,NB_PLYOFF,NUVARR
102 INTEGER
103 . PTE(4),PTP(4),PTMAT(4),PTVAR(4),NPT_ALL,IPLY,
104 . ID_ELEM_TMP(MVSIZ),NIX,ISOLNOD,IVISC,NPTG,TSHELL,TSH_ORT,
105 . ISTRAIN,KCVT,IOR_TSH,MT1,ICSIG,PTI,IOK,IPRT,IOK_PART(MVSIZ),
106 . JJ(6),IS_WRITTEN_TENSOR(MVSIZ)
107
108
109 TYPE(G_BUFEL_) ,POINTER :: GBUF
110 TYPE(L_BUFEL_) ,POINTER :: LBUF
111
112C-----------------------------------------------
113 nn1 = 1
114 nn2 = 1
115 nn3 = nn2 + numels
116 nn4 = nn3 + isph3d*(numsph+maxpjet)
117C-----------------------------------------------
118 DO 490 ng=1,ngroup
119 gbuf => elbuf_tab(ng)%GBUF
120 istrain = iparg(44,ng)
121 isolnod = iparg(28,ng)
122 ivisc = iparg(61,ng)
123 CALL initbuf(iparg ,ng ,
124 2 mlw ,nel ,nft ,iad ,ity ,
125 3 npt ,jale ,ismstr ,jeul ,jtur ,
126 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
127 5 nvaux ,jpor ,kcvt ,jclose ,jplasol ,
128 6 irep ,iint ,igtyp ,israt ,isrot ,
129 7 icsen ,isorth ,isorthg ,ifailure,jsms )
130!
131 DO i=1,6
132 jj(i) = nel*(i-1)
133 ENDDO
134!
135 IF(mlw /= 13) THEN
136C-----------------------------------------------
137C SPH
138C-----------------------------------------------
139 IF (ity == 51) THEN
140
141 gbuf => elbuf_tab(ng)%GBUF
142 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
143 iprt=ipartsp(1 + nft)
144 mt1 =ipart(1,iprt)
145
146 DO i=1,nel
147 id_elem(nft+i) = kxsp(nisp,nft+i)
148 IF( h3d_part(ipartsp(nft+i)) == 1) iok_part(i) = 1
149 is_written_tensor(i) = 0
150 ENDDO
151
152 DO i=1,nel
153 evar(1,i) = zero
154 evar(2,i) = zero
155 evar(3,i) = zero
156 evar(4,i) = zero
157 evar(5,i) = zero
158 evar(6,i) = zero
159 ENDDO
160
161C-----------------------------------------------
162 IF (keyword == 'TENS/STRESS') THEN
163C-----------------------------------------------
164C STRESS
165 DO i=1,nel
166 evar(1,i) = gbuf%SIG(jj(1) + i)
167 evar(2,i) = gbuf%SIG(jj(2) + i)
168 evar(3,i) = gbuf%SIG(jj(3) + i)
169 evar(4,i) = gbuf%SIG(jj(4) + i)
170 evar(5,i) = gbuf%SIG(jj(5) + i)
171 evar(6,i) = gbuf%SIG(jj(6) + i)
172 is_written_tensor(i) = 1
173 ENDDO
174C-----------------------------------------------
175 ELSEIF (keyword == 'TENS/STRAIN') THEN
176C-----------------------------------------------
177C STRAIN
178 iprt=ipartsp(1 + nft)
179 mt1 =ipart(1,iprt)
180 istrain= iparg(44,ng)
181 nuvar = ipm(8,mt1)
182 nuvarr = ipm(221,mt1)
183 IF (mlw>=28.AND.mlw/=49)THEN
184 DO i=1,nel
185 evar(1,i) = lbuf%STRA(jj(1) + i)
186 evar(2,i) = lbuf%STRA(jj(2) + i)
187 evar(3,i) = lbuf%STRA(jj(3) + i)
188 evar(4,i) = lbuf%STRA(jj(4) + i)*half
189 evar(5,i) = lbuf%STRA(jj(5) + i)*half
190 evar(6,i) = lbuf%STRA(jj(6) + i)*half
191 is_written_tensor(i) = 1
192 ENDDO
193 ELSEIF(mlw == 14)THEN
194 DO i=1,nel
195 evar(1,i) = lbuf%EPE(jj(1) + i)
196 evar(2,i) = lbuf%EPE(jj(2) + i)
197 evar(3,i) = lbuf%EPE(jj(3) + i)
198 evar(4,i) = zero
199 evar(5,i) = zero
200 evar(6,i) = zero
201 is_written_tensor(i) = 1
202 ENDDO
203 ELSEIF(mlw == 24)THEN
204 DO i=1,nel
205 evar(1,i) = lbuf%STRA(jj(1) + i)
206 evar(2,i) = lbuf%STRA(jj(2) + i)
207 evar(3,i) = lbuf%STRA(jj(3) + i)
208 evar(4,i) = lbuf%STRA(jj(4) + i)*half
209 evar(5,i) = lbuf%STRA(jj(5) + i)*half
210 evar(6,i) = lbuf%STRA(jj(6) + i)*half
211 is_written_tensor(i) = 1
212 ENDDO
213 ELSEIF(istrain == 1)THEN
214 IF(mlw/=14.AND.mlw/=24.AND.mlw<28.OR.
215 . mlw == 49)THEN
216 DO i=1,nel
217 evar(1,i) = lbuf%STRA(jj(1) + i)
218 evar(2,i) = lbuf%STRA(jj(2) + i)
219 evar(3,i) = lbuf%STRA(jj(3) + i)
220 evar(4,i) = lbuf%STRA(jj(4) + i)*half
221 evar(5,i) = lbuf%STRA(jj(5) + i)*half
222 evar(6,i) = lbuf%STRA(jj(6) + i)*half
223 is_written_tensor(i) = 1
224 ENDDO
225 ENDIF
226 ENDIF
227C-----------------------------------------------
228 ELSEIF (keyword == 'TENS/DAMA') THEN
229C-----------------------------------------------
230C CRACKS
231 IF (mlw == 24. and. nint(pm(56,mt1)) == 1) THEN
232 IF(isorth==0)THEN
233 DO i=1,nel
234 evar(1,i) = lbuf%DGLO(jj(1) + i)
235 evar(2,i) = lbuf%DGLO(jj(2) + i)
236 evar(3,i) = lbuf%DGLO(jj(3) + i)
237 evar(4,i) = lbuf%DGLO(jj(4) + i)
238 evar(5,i) = lbuf%DGLO(jj(5) + i)
239 evar(6,i) = lbuf%DGLO(jj(6) + i)
240 is_written_tensor(i) = 1
241 ENDDO
242 ELSE
243 DO i=1,nel
244 l11 = lbuf%DGLO(jj(1) + i)
245 l21 = lbuf%DGLO(jj(2) + i)
246 l31 = lbuf%DGLO(jj(3) + i)
247 l12 = lbuf%DGLO(jj(4) + i)
248 l22 = lbuf%DGLO(jj(5) + i)
249 l32 = lbuf%DGLO(jj(6) + i)
250 l13 = l21*l32-l31*l22
251 l23 = l31*l12-l11*l32
252 l33 = l11*l22-l21*l12
253 g11 = gbuf%GAMA(jj(1) + i)
254 g21 = gbuf%GAMA(jj(2) + i)
255 g31 = gbuf%GAMA(jj(3) + i)
256 g12 = gbuf%GAMA(jj(4) + i)
257 g22 = gbuf%GAMA(jj(5) + i)
258 g32 = gbuf%GAMA(jj(6) + i)
259 g13 = g21*g32-g31*g22
260 g23 = g31*g12-g11*g32
261 g33 = g11*g22-g21*g12
262 s11 =l11*g11+l12*g12+l13*g13
263 s12 =l11*g21+l12*g22+l13*g23
264 s13 =l11*g31+l12*g32+l13*g33
265 s21 =l12*g11+l22*g12+l23*g13
266 s22 =l12*g21+l22*g22+l23*g23
267 s23 =l12*g31+l22*g32+l23*g33
268 s31 =l13*g11+l23*g12+l33*g13
269 s32 =l13*g21+l23*g22+l33*g23
270 s33 =l13*g31+l23*g32+l33*g33
271 evar(1,i) = g11*s11+g12*s21+g13*s31
272 evar(2,i) = g21*s12+g22*s22+g23*s32
273 evar(3,i) = g31*s13+g32*s23+g33*s33
274 evar(4,i) = g11*s12+g12*s22+g13*s32
275 evar(5,i) = g21*s13+g22*s23+g23*s33
276 evar(6,i) = g11*s13+g12*s23+g13*s33
277 is_written_tensor(i) = 1
278 ENDDO
279 END IF
280 END IF
281 ENDIF
282
283 CALL h3d_write_tensor(iok_part,is_written_sph,sph_tensor,nel,0,nft,
284 . evar,is_written_tensor)
285C
286C-----------------------------------------------
287 ENDIF
288C
289 ENDIF ! mlw /= 13
290490 CONTINUE
291C-----------
292 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
initbuf_mod
Definition initbuf.F:160
initbuf_mod::initbuf
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)
Definition initbuf.F:261
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
schlieren_mod
Definition schlieren_mod.F:46
stack_mod
Definition stack_mod.F:75