OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sigrota_xfe.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "mvsiz_p.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine sigrota_xfe (elbuf_str, xfem_str, jft, jlt, nft, ilay, nel, ity, iel_crk, iadc_crk, iadtg_crk, ixfem, icrk, nlay, sig, ivisc, crkedge)

Function/Subroutine Documentation

◆ sigrota_xfe()

subroutine sigrota_xfe ( type (elbuf_struct_), target elbuf_str,
type (elbuf_struct_), target xfem_str,
integer jft,
integer jlt,
integer nft,
integer ilay,
integer nel,
integer ity,
integer, dimension(*) iel_crk,
integer, dimension(4,*) iadc_crk,
integer, dimension(3,*) iadtg_crk,
integer ixfem,
integer icrk,
integer nlay,
sig,
integer ivisc,
type (xfem_edge_), dimension(*) crkedge )

Definition at line 33 of file sigrota_xfe.F.

37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE elbufdef_mod
41 USE crackxfem_mod
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C G l o b a l P a r a m e t e r s
48C-----------------------------------------------
49#include "com04_c.inc"
50#include "mvsiz_p.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER JFT,JLT,NFT,NEL,ILAY,ITY,IXFEM,ICRK,NLAY,IVISC,
55 . IEL_CRK(*),IADC_CRK(4,*),IADTG_CRK(3,*)
56 my_real
57 . sig(mvsiz,5)
58C
59 TYPE (elbuf_struct_), TARGET :: elbuf_str
60 TYPE (ELBUF_STRUCT_), TARGET :: XFEM_STR
61 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER I,II,J,N,I1,ELCRK,ILAYCRK,
66 . IADC1,IADC2,IADC3,IADC4,JJ(5)
67 my_real
68 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
69 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
70 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
71 . x21(mvsiz), y21(mvsiz), z21(mvsiz),
72 . x31(mvsiz), y31(mvsiz), z31(mvsiz),
73 . x32(mvsiz), y32(mvsiz), z32(mvsiz),
74 . x42(mvsiz), y42(mvsiz), z42(mvsiz),
75 . e1x(mvsiz), e1y(mvsiz), e1z(mvsiz),
76 . e2x(mvsiz), e2y(mvsiz), e2z(mvsiz),
77 . e3x(mvsiz), e3y(mvsiz), e3z(mvsiz),
78 . e11(mvsiz),e12(mvsiz),e13(mvsiz),
79 . e21(mvsiz),e22(mvsiz),e23(mvsiz), dir(nel,2),
80 . v1,v2,v3,vr,vs,aa,bb,suma
81 my_real,
82 . DIMENSION(:) ,POINTER :: dir10,dir1
83 TYPE(G_BUFEL_) ,POINTER :: GBUF
84 TYPE(L_BUFEL_) ,POINTER :: LBUF
85c
86 TYPE(L_BUFEL_) ,POINTER :: XLBUF
87C=======================================================================
88 IF (nlay > 1) THEN ! (IXFEM == 1) - multilayer
89 dir10 => elbuf_str%BUFLY(ilay)%DIRA ! uncracked layer (tag standard elem)
90 dir1 => xfem_str%BUFLY(ilay)%DIRA ! cracked layer (tag phantom elem)
91 ELSE ! (IXFEM == 2)
92 dir10 => elbuf_str%BUFLY(1)%DIRA
93 dir1 => xfem_str%BUFLY(1)%DIRA
94 ENDIF
95!
96 DO i=1,5
97 jj(i) = nel*(i-1)
98 ENDDO
99!
100C---------------------
101 IF (ity == 3) THEN
102C---------------------
103C shells 4 nodes
104C---------------------
105 DO i=jft,jlt
106 n=nft+i
107 elcrk = iel_crk(n)
108 iadc1 = iadc_crk(1,elcrk)
109 iadc2 = iadc_crk(2,elcrk)
110 iadc3 = iadc_crk(3,elcrk)
111 iadc4 = iadc_crk(4,elcrk)
112C--------------
113C COORDINATES:
114C--------------
115C node 1:
116 x1(i) = crkavx(icrk)%X(1,iadc1)
117 y1(i) = crkavx(icrk)%X(2,iadc1)
118 z1(i) = crkavx(icrk)%X(3,iadc1)
119C node 2:
120 x2(i) = crkavx(icrk)%X(1,iadc2)
121 y2(i) = crkavx(icrk)%X(2,iadc2)
122 z2(i) = crkavx(icrk)%X(3,iadc2)
123C node 3:
124 x3(i) = crkavx(icrk)%X(1,iadc3)
125 y3(i) = crkavx(icrk)%X(2,iadc3)
126 z3(i) = crkavx(icrk)%X(3,iadc3)
127C node 4:
128 x4(i) = crkavx(icrk)%X(1,iadc4)
129 y4(i) = crkavx(icrk)%X(2,iadc4)
130 z4(i) = crkavx(icrk)%X(3,iadc4)
131 ENDDO
132C
133 DO i=jft,jlt
134 e1x(i)= x2(i)+x3(i)-x1(i)-x4(i)
135 e1y(i)= y2(i)+y3(i)-y1(i)-y4(i)
136 e1z(i)= z2(i)+z3(i)-z1(i)-z4(i)
137 e2x(i)= x3(i)+x4(i)-x1(i)-x2(i)
138 e2y(i)= y3(i)+y4(i)-y1(i)-y2(i)
139 e2z(i)= z3(i)+z4(i)-z1(i)-z2(i)
140 e3x(i)=e1y(i)*e2z(i)-e1z(i)*e2y(i)
141 e3y(i)=e1z(i)*e2x(i)-e1x(i)*e2z(i)
142 e3z(i)=e1x(i)*e2y(i)-e1y(i)*e2x(i)
143 ENDDO
144C
145 DO i=jft,jlt
146 e11(i) = e1x(i)
147 e12(i) = e1y(i)
148 e13(i) = e1z(i)
149 e21(i) = e2x(i)
150 e22(i) = e2y(i)
151 e23(i) = e2z(i)
152 ENDDO
153C
154 DO i=jft,jlt
155 suma=e2x(i)*e2x(i)+e2y(i)*e2y(i)+e2z(i)*e2z(i)
156 e1x(i) = e1x(i)*suma + e2y(i)*e3z(i)-e2z(i)*e3y(i)
157 e1y(i) = e1y(i)*suma + e2z(i)*e3x(i)-e2x(i)*e3z(i)
158 e1z(i) = e1z(i)*suma + e2x(i)*e3y(i)-e2y(i)*e3x(i)
159 ENDDO
160C
161 DO i=jft,jlt
162 suma=e1x(i)*e1x(i)+e1y(i)*e1y(i)+e1z(i)*e1z(i)
163 suma=one/max(sqrt(suma),em20)
164 e1x(i)=e1x(i)*suma
165 e1y(i)=e1y(i)*suma
166 e1z(i)=e1z(i)*suma
167 ENDDO
168C
169 DO i=jft,jlt
170 suma=e3x(i)*e3x(i)+e3y(i)*e3y(i)+e3z(i)*e3z(i)
171 suma=one/max(sqrt(suma),em20)
172 e3x(i)=e3x(i)*suma
173 e3y(i)=e3y(i)*suma
174 e3z(i)=e3z(i)*suma
175 e2x(i)=e3y(i)*e1z(i)-e3z(i)*e1y(i)
176 e2y(i)=e3z(i)*e1x(i)-e3x(i)*e1z(i)
177 e2z(i)=e3x(i)*e1y(i)-e3y(i)*e1x(i)
178 ENDDO
179C
180 DO i=jft,jlt
181 suma=e2x(i)*e2x(i)+e2y(i)*e2y(i)+e2z(i)*e2z(i)
182 suma=one/max(sqrt(suma),em20)
183 e2x(i)=e2x(i)*suma
184 e2y(i)=e2y(i)*suma
185 e2z(i)=e2z(i)*suma
186 ENDDO
187 ELSE
188C---------------------
189C shells 3 nodes
190C---------------------
191 DO i=jft,jlt
192 n=nft+i
193 elcrk = iel_crk(n+numelc)
194 iadc1 = iadtg_crk(1,elcrk)
195 iadc2 = iadtg_crk(2,elcrk)
196 iadc3 = iadtg_crk(3,elcrk)
197C--------------
198C COORDINATES:
199C--------------
200C node 1:
201 x1(i) = crkavx(icrk)%X(1,iadc1)
202 y1(i) = crkavx(icrk)%X(2,iadc1)
203 z1(i) = crkavx(icrk)%X(3,iadc1)
204C node 2:
205 x2(i) = crkavx(icrk)%X(1,iadc2)
206 y2(i) = crkavx(icrk)%X(2,iadc2)
207 z2(i) = crkavx(icrk)%X(3,iadc2)
208C node 3:
209 x3(i) = crkavx(icrk)%X(1,iadc3)
210 y3(i) = crkavx(icrk)%X(2,iadc3)
211 z3(i) = crkavx(icrk)%X(3,iadc3)
212 ENDDO
213C
214 DO i=jft,jlt
215 x21(i)=x2(i)-x1(i)
216 y21(i)=y2(i)-y1(i)
217 z21(i)=z2(i)-z1(i)
218 x31(i)=x3(i)-x1(i)
219 y31(i)=y3(i)-y1(i)
220 z31(i)=z3(i)-z1(i)
221 x32(i)=x3(i)-x2(i)
222 y32(i)=y3(i)-y2(i)
223 z32(i)=z3(i)-z2(i)
224 ENDDO
225C
226 DO i=jft,jlt
227 e11(i) = x21(i)
228 e12(i) = y21(i)
229 e13(i) = z21(i)
230 e21(i) = x31(i)
231 e22(i) = y31(i)
232 e23(i) = z31(i)
233 ENDDO
234C
235 DO i=jft,jlt
236 e1x(i)= x21(i)
237 e1y(i)= y21(i)
238 e1z(i)= z21(i)
239 suma = sqrt(e1x(i)*e1x(i)+e1y(i)*e1y(i)+e1z(i)*e1z(i))
240 suma = one/max(suma,em20)
241 e1x(i)=e1x(i)*suma
242 e1y(i)=e1y(i)*suma
243 e1z(i)=e1z(i)*suma
244 ENDDO
245C
246 DO i=jft,jlt
247 e3x(i)=y31(i)*z32(i)-z31(i)*y32(i)
248 e3y(i)=z31(i)*x32(i)-x31(i)*z32(i)
249 e3z(i)=x31(i)*y32(i)-y31(i)*x32(i)
250 suma = sqrt(e3x(i)*e3x(i)+e3y(i)*e3y(i)+e3z(i)*e3z(i))
251 suma = one/max(suma,em20)
252 e3x(i)=e3x(i)*suma
253 e3y(i)=e3y(i)*suma
254 e3z(i)=e3z(i)*suma
255 ENDDO
256C
257 DO i=jft,jlt
258 e2x(i)=e3y(i)*e1z(i)-e3z(i)*e1y(i)
259 e2y(i)=e3z(i)*e1x(i)-e3x(i)*e1z(i)
260 e2z(i)=e3x(i)*e1y(i)-e3y(i)*e1x(i)
261 suma = sqrt(e2x(i)*e2x(i)+e2y(i)*e2y(i)+e2z(i)*e2z(i))
262 suma = one/max(suma,em20)
263 e2x(i)=e2x(i)*suma
264 e2y(i)=e2y(i)*suma
265 e2z(i)=e2z(i)*suma
266 ENDDO
267 ENDIF ! IF (ITY == 3)
268C--------------------------------------------------
269 DO i=jft,jlt
270 elcrk = iel_crk(n)
271 IF (ity == 7) elcrk = iel_crk(n+numelc)
272 ilaycrk = crkedge(ilay)%LAYCUT(elcrk)
273 IF (ilaycrk == 0 .OR. abs(ilaycrk) == 1) THEN ! uncracked layer or
274c just cracked
275 aa = dir10(i)
276 bb = dir10(i + nel)
277 ELSE ! cracked layer
278 aa = dir1(i)
279 bb = dir1(i + nel)
280 ENDIF
281 v1 = aa*e11(i) + bb*e21(i)
282 v2 = aa*e12(i) + bb*e22(i)
283 v3 = aa*e13(i) + bb*e23(i)
284 vr=v1*e1x(i)+v2*e1y(i)+v3*e1z(i)
285 vs=v1*e2x(i)+v2*e2y(i)+v3*e2z(i)
286 suma=sqrt(vr*vr + vs*vs)
287 dir(i,1) = vr/suma
288 dir(i,2) = vs/suma
289 ENDDO
290C
291 IF (nlay > 1) THEN
292C uncracked layer
293 lbuf => elbuf_str%BUFLY(ilay)%LBUF(1,1,1)
294C cracked layer
295 xlbuf => xfem_str%BUFLY(ilay)%LBUF(1,1,1)
296 ELSE
297C uncracked layer
298 lbuf => elbuf_str%BUFLY(1)%LBUF(1,1,ilay)
299C cracked layer
300 xlbuf => xfem_str%BUFLY(1)%LBUF(1,1,ilay)
301 ENDIF
302C
303 DO i=jft,jlt
304 n=nft+i
305 elcrk = iel_crk(n)
306 IF (ity == 7) elcrk = iel_crk(n+numelc)
307 ilaycrk = crkedge(ilay)%LAYCUT(elcrk)
308 IF (ilaycrk == 0 .OR. abs(ilaycrk) == 1) THEN ! uncracked layer or
309c just cracked
310 DO j=1,5
311 sig(i,j) = lbuf%SIG(jj(j) + i)
312 ENDDO
313 ELSE ! cracked layer
314 DO j=1,5
315 sig(i,j) = xlbuf%SIG(jj(j) + i)
316 ENDDO
317 ENDIF
318 ENDDO
319C
320 IF (ivisc > 0) THEN
321 DO i=jft,jlt
322 n=nft+i
323 elcrk = iel_crk(n)
324 IF (ity == 7) elcrk = iel_crk(n+numelc)
325 ilaycrk = crkedge(ilay)%LAYCUT(elcrk)
326 IF (ilaycrk == 0 .OR. abs(ilaycrk) == 1) THEN ! uncracked layer or
327c just cracked
328 DO j = 1,5
329 sig(i,j) = sig(i,j) + lbuf%VISC(jj(j)+i)
330 ENDDO
331 ELSE ! cracked layer
332 DO j=1,5
333 sig(i,j) = sig(i,j) + xlbuf%VISC(jj(j)+i)
334 ENDDO
335 ENDIF
336 ENDDO
337 ENDIF ! IF (IVISC > 0)
338C
339 CALL urotov(jft,jlt,sig,dir,nel)
340!! temporary replaced by (the same) UROTOV() in order to do not affect
341!! the other multidimensional buffer ARRAYS which are still not modified
342!! CALL UROTO(JFT,JLT,SIG,DIR)
343C
344C-----------------------------------------------
345 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
crackxfem_mod
Definition crackxfem_mod.F:121
crackxfem_mod::crkavx
type(xfem_avx_), dimension(:), allocatable crkavx
Definition crackxfem_mod.F:163
urotov
subroutine urotov(jft, jlt, sig, dir, nel)
Definition uroto.F:79