OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
tensor0.F File Reference
#include "implicit_f.inc"
#include "vect01_c.inc"
#include "com01_c.inc"
#include "sphcom.inc"
#include "param_c.inc"
#include "scr17_c.inc"
#include "task_c.inc"
#include "spmd_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine tensor0 (elbuf_tab, iparg, itens, pm, el2fa, nbf, tens, epsdot, iadp, nbpart, x, iadg, ipart, ipartsp, ipm)

Function/Subroutine Documentation

◆ tensor0()

subroutine tensor0 ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg,*) iparg,
integer itens,
pm,
integer, dimension(*) el2fa,
integer nbf,
tens,
epsdot,
integer, dimension(*) iadp,
integer nbpart,
x,
integer, dimension(nspmd,*) iadg,
integer, dimension(lipart1,*) ipart,
integer, dimension(*) ipartsp,
integer, dimension(npropmi,*) ipm )

Definition at line 36 of file tensor0.F.

40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE initbuf_mod
44 USE elbufdef_mod
45 USE my_alloc_mod
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 "vect01_c.inc"
54#include "com01_c.inc"
55#include "sphcom.inc"
56#include "param_c.inc"
57#include "scr17_c.inc"
58#include "task_c.inc"
59#include "spmd_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63C REAL
64 my_real
65 . tens(6,*),epsdot(6,*),pm(npropm,*),x(3,*)
66 INTEGER IPARG(NPARG,*),ITENS, EL2FA(*),IADG(NSPMD,*),
67 . NBF,IADP(*),NBPART,IPART(LIPART1,*),IPARTSP(*),IPM(NPROPMI,*)
68 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
69C-----------------------------------------------
70C REAL
71 my_real
72 . g11,g22,g33,g12,g21,g23,g32,g13,g31,
73 . l11,l22,l33,l12,l21,l23,l32,l13,l31,
74 . s11,s22,s33,s12,s21,s23,s32,s13,s31
75 REAL R4(18)
76 REAL,DIMENSION(:),ALLOCATABLE :: WA
77
78 INTEGER I,II, NG, NEL, IPT, MT1,IADD, N, J, MLW,
79 . NN1,NN2,IPRT,BUF, ISTRAIN, NUVAR, NUVARR,JJ(6)
80 TYPE(G_BUFEL_) ,POINTER :: GBUF
81 TYPE(L_BUFEL_) ,POINTER :: LBUF
82C=======================================================================
83 CALL my_alloc(wa,6*nbf)
84 DO 5 j=1,18
85 r4(j) = zero
86 5 CONTINUE
87C
88 nn1 = 1
89 nn2 = nn1 + (numsph+maxpjet)
90C
91 DO 490 ng=1,ngroup
92 CALL initbuf(iparg ,ng ,
93 2 mlw ,nel ,nft ,iad ,ity ,
94 3 npt ,jale ,ismstr ,jeul ,jtur ,
95 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
96 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
97 6 irep ,iint ,igtyp ,israt ,isrot ,
98 7 icsen ,isorth ,isorthg ,ifailure,jsms )
99 lft=1
100 llt=nel
101!
102 DO i=1,6
103 jj(i) = nel*(i-1)
104 ENDDO
105!
106 IF (ity == 51) THEN
107C-----------------------------------------------
108C PARTICULES SPH.
109C-----------------------------------------------
110 gbuf => elbuf_tab(ng)%GBUF
111 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
112 iprt=ipartsp(1 + nft)
113 mt1 =ipart(1,iprt)
114 IF(itens == 1)THEN
115C-----------------------------------------------
116C STRESS
117C-----------------------------------------------
118 DO i=lft,llt
119 n = i + nft
120 IF(el2fa(nn1+n)/=0)THEN
121 tens(1,el2fa(nn1+n)) = gbuf%SIG(jj(1) + i)
122 tens(2,el2fa(nn1+n)) = gbuf%SIG(jj(2) + i)
123 tens(3,el2fa(nn1+n)) = gbuf%SIG(jj(3) + i)
124 tens(4,el2fa(nn1+n)) = gbuf%SIG(jj(4) + i)
125 tens(5,el2fa(nn1+n)) = gbuf%SIG(jj(5) + i)
126 tens(6,el2fa(nn1+n)) = gbuf%SIG(jj(6) + i)
127 ENDIF
128 ENDDO
129 ELSEIF(itens == 4.AND.mlw == 24.
130 . and.nint(pm(56,mt1)) == 1)THEN
131C-----------------------------------------------
132C CRACKS
133C-----------------------------------------------
134 IF(isorth==0)THEN
135 DO i=lft,llt
136 n = i + nft
137 tens(1,el2fa(nn1+n)) = lbuf%DGLO(jj(1) + i)
138 tens(2,el2fa(nn1+n)) = lbuf%DGLO(jj(2) + i)
139 tens(3,el2fa(nn1+n)) = lbuf%DGLO(jj(3) + i)
140 tens(4,el2fa(nn1+n)) = lbuf%DGLO(jj(4) + i)
141 tens(5,el2fa(nn1+n)) = lbuf%DGLO(jj(5) + i)
142 tens(6,el2fa(nn1+n)) = lbuf%DGLO(jj(6) + i)
143 ENDDO
144 ELSE
145 DO i=lft,llt
146 n = i + nft
147 l11 = lbuf%DGLO(jj(1) + i)
148 l21 = lbuf%DGLO(jj(2) + i)
149 l31 = lbuf%DGLO(jj(3) + i)
150 l12 = lbuf%DGLO(jj(4) + i)
151 l22 = lbuf%DGLO(jj(5) + i)
152 l32 = lbuf%DGLO(jj(6) + i)
153 l13 = l21*l32-l31*l22
154 l23 = l31*l12-l11*l32
155 l33 = l11*l22-l21*l12
156 g11 = gbuf%GAMA(jj(1) + i)
157 g21 = gbuf%GAMA(jj(2) + i)
158 g31 = gbuf%GAMA(jj(3) + i)
159 g12 = gbuf%GAMA(jj(4) + i)
160 g22 = gbuf%GAMA(jj(5) + i)
161 g32 = gbuf%GAMA(jj(6) + i)
162 g13 = g21*g32-g31*g22
163 g23 = g31*g12-g11*g32
164 g33 = g11*g22-g21*g12
165 s11 =l11*g11+l12*g12+l13*g13
166 s12 =l11*g21+l12*g22+l13*g23
167 s13 =l11*g31+l12*g32+l13*g33
168 s21 =l12*g11+l22*g12+l23*g13
169 s22 =l12*g21+l22*g22+l23*g23
170 s23 =l12*g31+l22*g32+l23*g33
171 s31 =l13*g11+l23*g12+l33*g13
172 s32 =l13*g21+l23*g22+l33*g23
173 s33 =l13*g31+l23*g32+l33*g33
174 tens(1,el2fa(nn1+n)) = g11*s11+g12*s21+g13*s31
175 tens(2,el2fa(nn1+n)) = g21*s12+g22*s22+g23*s32
176 tens(3,el2fa(nn1+n)) = g31*s13+g32*s23+g33*s33
177 tens(4,el2fa(nn1+n)) = g11*s12+g12*s22+g13*s32
178 tens(5,el2fa(nn1+n)) = g21*s13+g22*s23+g23*s33
179 tens(6,el2fa(nn1+n)) = g11*s13+g12*s23+g13*s33
180 ENDDO
181 END IF
182 ELSEIF(itens == 2)THEN
183C-----------------------------------------------
184C STRAIN
185C-----------------------------------------------
186 iprt=ipartsp(1 + nft)
187 mt1 =ipart(1,iprt)
188 istrain= iparg(44,ng)
189 nuvar = ipm(8,mt1)
190 nuvarr = ipm(221,mt1)
191 IF (mlw>=28.AND.mlw/=49)THEN
192 DO i=lft,llt
193 n = i + nft
194 tens(1,el2fa(nn1+n)) = lbuf%STRA(jj(1) + i)
195 tens(2,el2fa(nn1+n)) = lbuf%STRA(jj(2) + i)
196 tens(3,el2fa(nn1+n)) = lbuf%STRA(jj(3) + i)
197 tens(4,el2fa(nn1+n)) = lbuf%STRA(jj(4) + i)*half
198 tens(5,el2fa(nn1+n)) = lbuf%STRA(jj(5) + i)*half
199 tens(6,el2fa(nn1+n)) = lbuf%STRA(jj(6) + i)*half
200 ENDDO
201 ELSEIF(mlw == 14)THEN
202 DO i=lft,llt
203 n = i + nft
204 tens(1,el2fa(nn1+n)) = lbuf%EPE(jj(1) + i)
205 tens(2,el2fa(nn1+n)) = lbuf%EPE(jj(2) + i)
206 tens(3,el2fa(nn1+n)) = lbuf%EPE(jj(3) + i)
207 tens(4,el2fa(nn1+n)) = zero
208 tens(5,el2fa(nn1+n)) = zero
209 tens(6,el2fa(nn1+n)) = zero
210 ENDDO
211 ELSEIF(mlw == 24)THEN
212 DO i=lft,llt
213 n = i + nft
214 tens(1,el2fa(nn1+n)) = lbuf%STRA(jj(1) + i)
215 tens(2,el2fa(nn1+n)) = lbuf%STRA(jj(2) + i)
216 tens(3,el2fa(nn1+n)) = lbuf%STRA(jj(3) + i)
217 tens(4,el2fa(nn1+n)) = lbuf%STRA(jj(4) + i)*half
218 tens(5,el2fa(nn1+n)) = lbuf%STRA(jj(5) + i)*half
219 tens(6,el2fa(nn1+n)) = lbuf%STRA(jj(6) + i)*half
220 ENDDO
221 ELSEIF(istrain == 1)THEN
222 IF(mlw/=14.AND.mlw/=24.AND.mlw<28.OR.
223 . mlw == 49)THEN
224 DO i=lft,llt
225 n = i + nft
226 tens(1,el2fa(nn1+n)) = lbuf%STRA(jj(1) + i)
227 tens(2,el2fa(nn1+n)) = lbuf%STRA(jj(2) + i)
228 tens(3,el2fa(nn1+n)) = lbuf%STRA(jj(3) + i)
229 tens(4,el2fa(nn1+n)) = lbuf%STRA(jj(4) + i)*half
230 tens(5,el2fa(nn1+n)) = lbuf%STRA(jj(5) + i)*half
231 tens(6,el2fa(nn1+n)) = lbuf%STRA(jj(6) + i)*half
232 ENDDO
233 ELSE
234 DO i=lft,llt
235 tens(1,el2fa(nn1+n)) = zero
236 tens(2,el2fa(nn1+n)) = zero
237 tens(3,el2fa(nn1+n)) = zero
238 tens(4,el2fa(nn1+n)) = zero
239 tens(5,el2fa(nn1+n)) = zero
240 tens(6,el2fa(nn1+n)) = zero
241 ENDDO
242 ENDIF
243 ENDIF
244 ELSEIF (itens == 5) THEN
245C-----------------------------------------------
246C PLASTIC STRAIN TENSOR
247C-----------------------------------------------
248 IF (mlw == 24) THEN
249 DO i=lft,llt
250 n = i + nft
251 tens(1,el2fa(nn1+n)) = lbuf%PLA(jj(1) + i + nel)
252 tens(2,el2fa(nn1+n)) = lbuf%PLA(jj(2) + i + nel)
253 tens(3,el2fa(nn1+n)) = lbuf%PLA(jj(3) + i + nel)
254 tens(4,el2fa(nn1+n)) = lbuf%PLA(jj(4) + i + nel)*half
255 tens(5,el2fa(nn1+n)) = lbuf%PLA(jj(5) + i + nel)*half
256 tens(6,el2fa(nn1+n)) = lbuf%PLA(jj(6) + i + nel)*half
257 ENDDO
258 ENDIF ! IF (MLW == 24)
259c-----------
260 ELSE
261C-----------------------------------------------
262C
263C-----------------------------------------------
264 DO i=lft,llt
265 n = i + nft
266 IF(el2fa(nn1+n)/=0)THEN
267 tens(1,el2fa(nn1+n)) = zero
268 tens(2,el2fa(nn1+n)) = zero
269 tens(3,el2fa(nn1+n)) = zero
270 tens(4,el2fa(nn1+n)) = zero
271 tens(5,el2fa(nn1+n)) = zero
272 tens(6,el2fa(nn1+n)) = zero
273 ENDIF
274 ENDDO
275 ENDIF
276C-----------------------------------------------
277 ELSE
278 ENDIF
279 490 CONTINUE
280 500 CONTINUE
281C-----------------------------------------------
282 IF (nspmd == 1)THEN
283 DO n=1,nbf
284 r4(1) = tens(1,n)
285 r4(2) = tens(2,n)
286 r4(3) = tens(3,n)
287 r4(4) = tens(4,n)
288 r4(5) = tens(5,n)
289 r4(6) = tens(6,n)
290 CALL write_r_c(r4,6)
291 ENDDO
292 ELSE
293 DO n = 1, nbf
294 wa(6*n-5) = tens(1,n)
295 wa(6*n-4) = tens(2,n)
296 wa(6*n-3) = tens(3,n)
297 wa(6*n-2) = tens(4,n)
298 wa(6*n-1) = tens(5,n)
299 wa(6*n ) = tens(6,n)
300 ENDDO
301
302 IF(ispmd == 0) THEN
303 buf = numsphg*6
304 ELSE
305 buf = 1
306 ENDIF
307 CALL spmd_r4get_partn(6,6*nbf,nbpart,iadg,wa,buf)
308 ENDIF
309C
310C-------------
311 600 CONTINUE
312C-------------
313 DEALLOCATE(wa)
314 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
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
spmd_r4get_partn
subroutine spmd_r4get_partn(size, nbf_l, nbpart, iadg, wal, buf)
Definition spmd_r4get_partn.F:47
write_r_c
void write_r_c(float *w, int *len)
Definition write_routtines.c:519