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 33 of file sigrota.F.

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