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,I1,II,J,NG,NEL,NPTR,NPTS,NPTT,NLAY,L,IFAIL,ILAY,
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 PID(MVSIZ),MAT(MVSIZ),MATLY(MVSIZ*100),FAILG(100,MVSIZ),
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 REAL R4
109 TYPE(G_BUFEL_) ,POINTER :: GBUF
110 TYPE(L_BUFEL_) ,POINTER :: LBUF
111 TYPE(BUF_LAY_) ,POINTER :: BUFLY
112 TYPE(BUF_FAIL_) ,POINTER :: FBUF
113 my_real,
114 . DIMENSION(:), POINTER :: uvar
115 TYPE(L_BUFEL_) ,POINTER :: LBUF1,LBUF2,LBUF3,LBUF4
116C-----------------------------------------------
117 nn1 = 1
118 nn2 = 1
119 nn3 = nn2 + numels
120 nn4 = nn3 + isph3d*(numsph+maxpjet)
121C-----------------------------------------------
122 DO 490 ng=1,ngroup
123 gbuf => elbuf_tab(ng)%GBUF
124 istrain = iparg(44,ng)
125 isolnod = iparg(28,ng)
126 ivisc = iparg(61,ng)
127 CALL initbuf(iparg ,ng ,
128 2 mlw ,nel ,nft ,iad ,ity ,
129 3 npt ,jale ,ismstr ,jeul ,jtur ,
130 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
131 5 nvaux ,jpor ,kcvt ,jclose ,jplasol ,
132 6 irep ,iint ,igtyp ,israt ,isrot ,
133 7 icsen ,isorth ,isorthg ,ifailure,jsms )
134!
135 DO i=1,6
136 jj(i) = nel*(i-1)
137 ENDDO
138!
139 IF(mlw /= 13) THEN
140C-----------------------------------------------
141C SPH
142C-----------------------------------------------
143 IF (ity == 51) THEN
144
145 gbuf => elbuf_tab(ng)%GBUF
146 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
147 iprt=ipartsp(1 + nft)
148 mt1 =ipart(1,iprt)
149
150 DO i=1,nel
151 id_elem(nft+i) = kxsp(nisp,nft+i)
152 IF( h3d_part(ipartsp(nft+i)) == 1) iok_part(i) = 1
153 is_written_tensor(i) = 0
154 ENDDO
155
156 DO i=1,nel
157 evar(1,i) = zero
158 evar(2,i) = zero
159 evar(3,i) = zero
160 evar(4,i) = zero
161 evar(5,i) = zero
162 evar(6,i) = zero
163 ENDDO
164
165C-----------------------------------------------
166 IF (keyword == 'TENS/STRESS') THEN
167C-----------------------------------------------
168C STRESS
169 DO i=1,nel
170 evar(1,i) = gbuf%SIG(jj(1) + i)
171 evar(2,i) = gbuf%SIG(jj(2) + i)
172 evar(3,i) = gbuf%SIG(jj(3) + i)
173 evar(4,i) = gbuf%SIG(jj(4) + i)
174 evar(5,i) = gbuf%SIG(jj(5) + i)
175 evar(6,i) = gbuf%SIG(jj(6) + i)
176 is_written_tensor(i) = 1
177 ENDDO
178C-----------------------------------------------
179 ELSEIF (keyword == 'TENS/STRAIN') THEN
180C-----------------------------------------------
181C STRAIN
182 iprt=ipartsp(1 + nft)
183 mt1 =ipart(1,iprt)
184 istrain= iparg(44,ng)
185 nuvar = ipm(8,mt1)
186 nuvarr = ipm(221,mt1)
187 IF (mlw>=28.AND.mlw/=49)THEN
188 DO i=1,nel
189 evar(1,i) = lbuf%STRA(jj(1) + i)
190 evar(2,i) = lbuf%STRA(jj(2) + i)
191 evar(3,i) = lbuf%STRA(jj(3) + i)
192 evar(4,i) = lbuf%STRA(jj(4) + i)*half
193 evar(5,i) = lbuf%STRA(jj(5) + i)*half
194 evar(6,i) = lbuf%STRA(jj(6) + i)*half
195 is_written_tensor(i) = 1
196 ENDDO
197 ELSEIF(mlw == 14)THEN
198 DO i=1,nel
199 evar(1,i) = lbuf%EPE(jj(1) + i)
200 evar(2,i) = lbuf%EPE(jj(2) + i)
201 evar(3,i) = lbuf%EPE(jj(3) + i)
202 evar(4,i) = zero
203 evar(5,i) = zero
204 evar(6,i) = zero
205 is_written_tensor(i) = 1
206 ENDDO
207 ELSEIF(mlw == 24)THEN
208 DO i=1,nel
209 evar(1,i) = lbuf%STRA(jj(1) + i)
210 evar(2,i) = lbuf%STRA(jj(2) + i)
211 evar(3,i) = lbuf%STRA(jj(3) + i)
212 evar(4,i) = lbuf%STRA(jj(4) + i)*half
213 evar(5,i) = lbuf%STRA(jj(5) + i)*half
214 evar(6,i) = lbuf%STRA(jj(6) + i)*half
215 is_written_tensor(i) = 1
216 ENDDO
217 ELSEIF(istrain == 1)THEN
218 IF(mlw/=14.AND.mlw/=24.AND.mlw<28.OR.
219 . mlw == 49)THEN
220 DO i=1,nel
221 evar(1,i) = lbuf%STRA(jj(1) + i)
222 evar(2,i) = lbuf%STRA(jj(2) + i)
223 evar(3,i) = lbuf%STRA(jj(3) + i)
224 evar(4,i) = lbuf%STRA(jj(4) + i)*half
225 evar(5,i) = lbuf%STRA(jj(5) + i)*half
226 evar(6,i) = lbuf%STRA(jj(6) + i)*half
227 is_written_tensor(i) = 1
228 ENDDO
229 ENDIF
230 ENDIF
231C-----------------------------------------------
232 ELSEIF (keyword == 'TENS/DAMA') THEN
233C-----------------------------------------------
234C CRACKS
235 IF (mlw == 24. and. nint(pm(56,mt1)) == 1) THEN
236 IF(isorth==0)THEN
237 DO i=1,nel
238 evar(1,i) = lbuf%DGLO(jj(1) + i)
239 evar(2,i) = lbuf%DGLO(jj(2) + i)
240 evar(3,i) = lbuf%DGLO(jj(3) + i)
241 evar(4,i) = lbuf%DGLO(jj(4) + i)
242 evar(5,i) = lbuf%DGLO(jj(5) + i)
243 evar(6,i) = lbuf%DGLO(jj(6) + i)
244 is_written_tensor(i) = 1
245 ENDDO
246 ELSE
247 DO i=1,nel
248 l11 = lbuf%DGLO(jj(1) + i)
249 l21 = lbuf%DGLO(jj(2) + i)
250 l31 = lbuf%DGLO(jj(3) + i)
251 l12 = lbuf%DGLO(jj(4) + i)
252 l22 = lbuf%DGLO(jj(5) + i)
253 l32 = lbuf%DGLO(jj(6) + i)
254 l13 = l21*l32-l31*l22
255 l23 = l31*l12-l11*l32
256 l33 = l11*l22-l21*l12
257 g11 = gbuf%GAMA(jj(1) + i)
258 g21 = gbuf%GAMA(jj(2) + i)
259 g31 = gbuf%GAMA(jj(3) + i)
260 g12 = gbuf%GAMA(jj(4) + i)
261 g22 = gbuf%GAMA(jj(5) + i)
262 g32 = gbuf%GAMA(jj(6) + i)
263 g13 = g21*g32-g31*g22
264 g23 = g31*g12-g11*g32
265 g33 = g11*g22-g21*g12
266 s11 =l11*g11+l12*g12+l13*g13
267 s12 =l11*g21+l12*g22+l13*g23
268 s13 =l11*g31+l12*g32+l13*g33
269 s21 =l12*g11+l22*g12+l23*g13
270 s22 =l12*g21+l22*g22+l23*g23
271 s23 =l12*g31+l22*g32+l23*g33
272 s31 =l13*g11+l23*g12+l33*g13
273 s32 =l13*g21+l23*g22+l33*g23
274 s33 =l13*g31+l23*g32+l33*g33
275 evar(1,i) = g11*s11+g12*s21+g13*s31
276 evar(2,i) = g21*s12+g22*s22+g23*s32
277 evar(3,i) = g31*s13+g32*s23+g33*s33
278 evar(4,i) = g11*s12+g12*s22+g13*s32
279 evar(5,i) = g21*s13+g22*s23+g23*s33
280 evar(6,i) = g11*s13+g12*s23+g13*s33
281 is_written_tensor(i) = 1
282 ENDDO
283 END IF
284 END IF
285 ENDIF
286
287 CALL h3d_write_tensor(iok_part,is_written_sph,sph_tensor,nel,0,nft,
288 . evar,is_written_tensor)
289C
290C-----------------------------------------------
291 ENDIF
292C
293 ENDIF ! mlw /= 13
294490 CONTINUE
295C-----------
296 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:997
names_and_titles_mod::ncharline100
integer, parameter ncharline100
Definition names_and_titles_mod.F:1002
schlieren_mod
Definition schlieren_mod.F:46
stack_mod
Definition stack_mod.F:72