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

Go to the source code of this file.

Functions/Subroutines

subroutine sigrota (jft, jlt, nft, ipt, nel, ns1, x, ixc, elbuf_str, sig, ity, ixtg, ihbe, istrain, ivisc)

Function/Subroutine Documentation

◆ sigrota()

subroutine sigrota ( integer jft,
integer jlt,
integer nft,
integer ipt,
integer nel,
integer ns1,
x,
integer, dimension(nixc,*) ixc,
type (elbuf_struct_), target elbuf_str,
sig,
integer ity,
integer, dimension(nixtg,*) ixtg,
integer ihbe,
integer istrain,
integer ivisc )

Definition at line 34 of file sigrota.F.

38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE elbufdef_mod
42 use element_mod , only : nixc,nixtg
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C G l o b a l P a r a m e t e r s
49C-----------------------------------------------
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, IPT, NS1, IXC(NIXC,*),
55 . ITY, IXTG(NIXTG,*),IHBE ,ISTRAIN ,IVISC
56 my_real x(3,*), sig(mvsiz,5)
57 TYPE (elbuf_struct_), TARGET :: elbuf_str
58C-----------------------------------------------
59C L o c a l V a r i a b l e s
60C-----------------------------------------------
61 INTEGER I, J, N, NLAY, NPTR, NPTS, NPG, IR, IS, JJ(5), IDRAPE, IGTYP
62 my_real
63 . x1(nel), x2(nel), x3(nel), x4(nel),
64 . y1(nel), y2(nel), y3(nel), y4(nel),
65 . z1(nel), z2(nel), z3(nel), z4(nel),
66 . x21(nel), y21(nel), z21(nel),
67 . x31(nel), y31(nel), z31(nel),
68 . x32(nel), y32(nel), z32(nel),
69 .
70 . e1x(nel), e1y(nel), e1z(nel),
71 . e2x(nel), e2y(nel), e2z(nel),
72 . e3x(nel), e3y(nel), e3z(nel),
73 . e11(nel),e12(nel),e13(nel),
74 . e21(nel),e22(nel),e23(nel), dir(nel,2),
75 .
76 . v1,v2,v3,vr,vs,aa,bb,suma
77 my_real,
78 . DIMENSION(:) , POINTER :: dir1
79
80 TYPE(L_BUFEL_) , POINTER :: LBUF
81
82C=======================================================================
83 nptr = elbuf_str%NPTR
84 npts = elbuf_str%NPTS
85 nlay = elbuf_str%NLAY
86 npg = nptr*npts
87 idrape = elbuf_str%IDRAPE
88 igtyp = elbuf_str%IGTYP
89 IF(idrape > 0 .AND. (igtyp == 51 .OR. igtyp == 52))THEN
90 IF (nlay > 1) THEN
91 dir1 => elbuf_str%BUFLY(ipt)%LBUF_DIR(1)%DIRA
92 ELSE
93 dir1 => elbuf_str%BUFLY(1)%LBUF_DIR(1)%DIRA
94 ENDIF
95 ELSE
96 IF (nlay > 1) THEN
97 dir1 => elbuf_str%BUFLY(ipt)%DIRA
98 ELSE
99 dir1 => elbuf_str%BUFLY(1)%DIRA
100 ENDIF
101 ENDIF
102c
103!
104 DO i=1,5
105 jj(i) = nel*(i-1)
106 ENDDO
107!
108 IF (ity == 3) THEN
109C---------------------
110C shells 4 nodes
111C---------------------
112 DO i=jft,jlt
113 n=nft+i
114 x1(i)=x(1,ixc(2,n))
115 y1(i)=x(2,ixc(2,n))
116 z1(i)=x(3,ixc(2,n))
117 x2(i)=x(1,ixc(3,n))
118 y2(i)=x(2,ixc(3,n))
119 z2(i)=x(3,ixc(3,n))
120 x3(i)=x(1,ixc(4,n))
121 y3(i)=x(2,ixc(4,n))
122 z3(i)=x(3,ixc(4,n))
123 x4(i)=x(1,ixc(5,n))
124 y4(i)=x(2,ixc(5,n))
125 z4(i)=x(3,ixc(5,n))
126 ENDDO
127 DO i=jft,jlt
128 e1x(i)= x2(i)+x3(i)-x1(i)-x4(i)
129 e1y(i)= y2(i)+y3(i)-y1(i)-y4(i)
130 e1z(i)= z2(i)+z3(i)-z1(i)-z4(i)
131 e2x(i)= x3(i)+x4(i)-x1(i)-x2(i)
132 e2y(i)= y3(i)+y4(i)-y1(i)-y2(i)
133 e2z(i)= z3(i)+z4(i)-z1(i)-z2(i)
134 e3x(i)=e1y(i)*e2z(i)-e1z(i)*e2y(i)
135 e3y(i)=e1z(i)*e2x(i)-e1x(i)*e2z(i)
136 e3z(i)=e1x(i)*e2y(i)-e1y(i)*e2x(i)
137 ENDDO
138 DO i=jft,jlt
139 e11(i) = e1x(i)
140 e12(i) = e1y(i)
141 e13(i) = e1z(i)
142 e21(i) = e2x(i)
143 e22(i) = e2y(i)
144 e23(i) = e2z(i)
145 ENDDO
146C
147 DO i=jft,jlt
148 suma=e2x(i)*e2x(i)+e2y(i)*e2y(i)+e2z(i)*e2z(i)
149 e1x(i) = e1x(i)*suma + e2y(i)*e3z(i)-e2z(i)*e3y(i)
150 e1y(i) = e1y(i)*suma + e2z(i)*e3x(i)-e2x(i)*e3z(i)
151 e1z(i) = e1z(i)*suma + e2x(i)*e3y(i)-e2y(i)*e3x(i)
152 ENDDO
153C
154 DO i=jft,jlt
155 suma=e1x(i)*e1x(i)+e1y(i)*e1y(i)+e1z(i)*e1z(i)
156 suma=one/max(sqrt(suma),em20)
157 e1x(i)=e1x(i)*suma
158 e1y(i)=e1y(i)*suma
159 e1z(i)=e1z(i)*suma
160 ENDDO
161 DO i=jft,jlt
162 suma=e3x(i)*e3x(i)+e3y(i)*e3y(i)+e3z(i)*e3z(i)
163 suma=one/max(sqrt(suma),em20)
164 e3x(i)=e3x(i)*suma
165 e3y(i)=e3y(i)*suma
166 e3z(i)=e3z(i)*suma
167 e2x(i)=e3y(i)*e1z(i)-e3z(i)*e1y(i)
168 e2y(i)=e3z(i)*e1x(i)-e3x(i)*e1z(i)
169 e2z(i)=e3x(i)*e1y(i)-e3y(i)*e1x(i)
170 ENDDO
171 DO i=jft,jlt
172 suma=e2x(i)*e2x(i)+e2y(i)*e2y(i)+e2z(i)*e2z(i)
173 suma=one/max(sqrt(suma),em20)
174 e2x(i)=e2x(i)*suma
175 e2y(i)=e2y(i)*suma
176 e2z(i)=e2z(i)*suma
177 ENDDO
178 ELSE
179C---------------------
180C shells 3 nodes
181C---------------------
182 DO i=jft,jlt
183 n=nft+i
184 x1(i)=x(1,ixtg(2,n))
185 y1(i)=x(2,ixtg(2,n))
186 z1(i)=x(3,ixtg(2,n))
187 x2(i)=x(1,ixtg(3,n))
188 y2(i)=x(2,ixtg(3,n))
189 z2(i)=x(3,ixtg(3,n))
190 x3(i)=x(1,ixtg(4,n))
191 y3(i)=x(2,ixtg(4,n))
192 z3(i)=x(3,ixtg(4,n))
193 ENDDO
194C
195 DO i=jft,jlt
196 x21(i)=x2(i)-x1(i)
197 y21(i)=y2(i)-y1(i)
198 z21(i)=z2(i)-z1(i)
199 x31(i)=x3(i)-x1(i)
200 y31(i)=y3(i)-y1(i)
201 z31(i)=z3(i)-z1(i)
202 x32(i)=x3(i)-x2(i)
203 y32(i)=y3(i)-y2(i)
204 z32(i)=z3(i)-z2(i)
205 ENDDO
206C
207 DO i=jft,jlt
208 e11(i) = x21(i)
209 e12(i) = y21(i)
210 e13(i) = z21(i)
211 e21(i) = x31(i)
212 e22(i) = y31(i)
213 e23(i) = z31(i)
214 ENDDO
215C
216 DO i=jft,jlt
217 e1x(i)= x21(i)
218 e1y(i)= y21(i)
219 e1z(i)= z21(i)
220 suma = sqrt(e1x(i)*e1x(i)+e1y(i)*e1y(i)+e1z(i)*e1z(i))
221 suma=one/max(suma,em20)
222 e1x(i)=e1x(i)*suma
223 e1y(i)=e1y(i)*suma
224 e1z(i)=e1z(i)*suma
225 ENDDO
226C
227 DO i=jft,jlt
228 e3x(i)=y31(i)*z32(i)-z31(i)*y32(i)
229 e3y(i)=z31(i)*x32(i)-x31(i)*z32(i)
230 e3z(i)=x31(i)*y32(i)-y31(i)*x32(i)
231 suma = sqrt(e3x(i)*e3x(i)+e3y(i)*e3y(i)+e3z(i)*e3z(i))
232 suma = one/max(suma,em20)
233 e3x(i)=e3x(i)*suma
234 e3y(i)=e3y(i)*suma
235 e3z(i)=e3z(i)*suma
236 ENDDO
237C
238 DO i=jft,jlt
239 e2x(i)=e3y(i)*e1z(i)-e3z(i)*e1y(i)
240 e2y(i)=e3z(i)*e1x(i)-e3x(i)*e1z(i)
241 e2z(i)=e3x(i)*e1y(i)-e3y(i)*e1x(i)
242 suma = sqrt(e2x(i)*e2x(i)+e2y(i)*e2y(i)+e2z(i)*e2z(i))
243 suma = one/max(suma,em20)
244 e2x(i)=e2x(i)*suma
245 e2y(i)=e2y(i)*suma
246 e2z(i)=e2z(i)*suma
247 ENDDO
248 ENDIF
249C--------------------------------------------------
250 DO i=jft,jlt
251 aa = dir1(i)
252 bb = dir1(i + nel)
253 v1 = aa*e11(i) + bb*e21(i)
254 v2 = aa*e12(i) + bb*e22(i)
255 v3 = aa*e13(i) + bb*e23(i)
256 vr=v1*e1x(i)+v2*e1y(i)+v3*e1z(i)
257 vs=v1*e2x(i)+v2*e2y(i)+v3*e2z(i)
258 suma=sqrt(vr*vr + vs*vs)
259 dir(i,1) = vr/suma
260 dir(i,2) = vs/suma
261 ENDDO
262C
263 IF (ihbe == 11) THEN
264 DO i=jft,jlt
265 DO j = 1,5
266 sig(i,j) = zero
267 ENDDO
268 ENDDO
269 DO i=jft,jlt
270 DO ir=1,nptr
271 DO is=1,npts
272 IF (nlay > 1) THEN
273 lbuf => elbuf_str%BUFLY(ipt)%LBUF(ir,is,1)
274 ELSE
275 lbuf => elbuf_str%BUFLY(1)%LBUF(ir,is,ipt)
276 ENDIF
277 DO j = 1,5
278 sig(i,j) = sig(i,j) + lbuf%SIG(jj(j) + i)/npg
279 ENDDO
280 ENDDO
281 ENDDO
282 ENDDO
283 IF (ivisc > 0 ) THEN
284 DO i=jft,jlt
285 DO ir=1,nptr
286 DO is=1,npts
287 IF (nlay > 1) THEN
288 lbuf => elbuf_str%BUFLY(ipt)%LBUF(ir,is,1)
289 ELSE
290 lbuf => elbuf_str%BUFLY(1)%LBUF(ir,is,ipt)
291 ENDIF
292 DO j = 1,5
293 sig(i,j) = sig(i,j) + lbuf%VISC(jj(j) + i)/npg
294 ENDDO
295 ENDDO
296 ENDDO
297 ENDDO
298 ENDIF
299 ELSE
300 IF (nlay > 1) THEN
301 lbuf => elbuf_str%BUFLY(ipt)%LBUF(1,1,1)
302 ELSE
303 lbuf => elbuf_str%BUFLY(1)%LBUF(1,1,ipt)
304 ENDIF
305 DO i=jft,jlt
306 DO j = 1,5
307 sig(i,j) = lbuf%SIG(jj(j) + i)
308 ENDDO
309 ENDDO
310 IF (ivisc > 0) THEN
311 DO i=jft,jlt
312 DO j = 1,5
313 sig(i,j) = sig(i,j) + lbuf%VISC(jj(j) + i)
314 ENDDO
315 ENDDO
316 ENDIF
317 ENDIF
318C
319 CALL urotov(jft,jlt,sig,dir,nel)
320!! temporary replaced by (the same) UROTOV() in order to do not affect
321!! the other multidimensional buffer ARRAYS which are still not modified
322!! CALL UROTO(JFT,JLT,SIG,DIR)
323C
324C-----------------------------------------------
325 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
urotov
subroutine urotov(jft, jlt, sig, dir, nel)
Definition uroto.F:79