OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
srcoor3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "vect01_c.inc"
#include "scr05_c.inc"
#include "scr18_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine srcoor3 (x, ixs, v, w, gama0, gama, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, vx1, vx2, vx3, vx4, vx5, vx6, vx7, vx8, vy1, vy2, vy3, vy4, vy5, vy6, vy7, vy8, vz1, vz2, vz3, vz4, vz5, vz6, vz7, vz8, vd2, vis, offg, off, sav, rho, rhoo, r11, r12, r13, r21, r22, r23, r31, r32, r33, nc1, nc2, nc3, nc4, nc5, nc6, nc7, nc8, ngl, mxt, ngeo, ioutprt, vgax, vgay, vgaz, vga2, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8, xdp, x0, y0, z0, nel, xgax, xgay, xgaz, xgxa2, xgya2, xgza2, xgxya, xgyza, xgzxa, iparg, gama_r)

Function/Subroutine Documentation

◆ srcoor3()

subroutine srcoor3 ( x,
integer, dimension(nixs,*) ixs,
v,
w,
gama0,
gama,
x1,
x2,
x3,
x4,
x5,
x6,
x7,
x8,
y1,
y2,
y3,
y4,
y5,
y6,
y7,
y8,
z1,
z2,
z3,
z4,
z5,
z6,
z7,
z8,
vx1,
vx2,
vx3,
vx4,
vx5,
vx6,
vx7,
vx8,
vy1,
vy2,
vy3,
vy4,
vy5,
vy6,
vy7,
vy8,
vz1,
vz2,
vz3,
vz4,
vz5,
vz6,
vz7,
vz8,
vd2,
vis,
offg,
off,
double precision, dimension(nel,21) sav,
rho,
rhoo,
r11,
r12,
r13,
r21,
r22,
r23,
r31,
r32,
r33,
integer, dimension(*) nc1,
integer, dimension(*) nc2,
integer, dimension(*) nc3,
integer, dimension(*) nc4,
integer, dimension(*) nc5,
integer, dimension(*) nc6,
integer, dimension(*) nc7,
integer, dimension(*) nc8,
integer, dimension(*) ngl,
integer, dimension(*) mxt,
integer, dimension(*) ngeo,
integer ioutprt,
vgax,
vgay,
vgaz,
vga2,
double precision, dimension(*) xd1,
double precision, dimension(*) xd2,
double precision, dimension(*) xd3,
double precision, dimension(*) xd4,
double precision, dimension(*) xd5,
double precision, dimension(*) xd6,
double precision, dimension(*) xd7,
double precision, dimension(*) xd8,
double precision, dimension(*) yd1,
double precision, dimension(*) yd2,
double precision, dimension(*) yd3,
double precision, dimension(*) yd4,
double precision, dimension(*) yd5,
double precision, dimension(*) yd6,
double precision, dimension(*) yd7,
double precision, dimension(*) yd8,
double precision, dimension(*) zd1,
double precision, dimension(*) zd2,
double precision, dimension(*) zd3,
double precision, dimension(*) zd4,
double precision, dimension(*) zd5,
double precision, dimension(*) zd6,
double precision, dimension(*) zd7,
double precision, dimension(*) zd8,
double precision, dimension(3,*) xdp,
double precision, dimension(mvsiz,8) x0,
double precision, dimension(mvsiz,8) y0,
double precision, dimension(mvsiz,8) z0,
integer nel,
xgax,
xgay,
xgaz,
xgxa2,
xgya2,
xgza2,
xgxya,
xgyza,
xgzxa,
integer, dimension(*) iparg,
gama_r )

Definition at line 41 of file srcoor3.F.

57 use element_mod , only : nixs
58C-----------------------------------------------
59C I m p l i c i t T y p e s
60C-----------------------------------------------
61#include "implicit_f.inc"
62C-----------------------------------------------
63C G l o b a l P a r a m e t e r s
64C-----------------------------------------------
65#include "mvsiz_p.inc"
66C-----------------------------------------------
67C C o m m o n B l o c k s
68C-----------------------------------------------
69#include "vect01_c.inc"
70#include "scr05_c.inc"
71#include "scr18_c.inc"
72C-----------------------------------------------
73C D u m m y A r g u m e n t s
74C-----------------------------------------------
75 INTEGER NEL
76C REAL
77 my_real
78 . x(3,*),v(3,*),w(3,*), vis(*),
79 . x1(*), x2(*), x3(*), x4(*), x5(*), x6(*), x7(*), x8(*),
80 . y1(*), y2(*), y3(*), y4(*), y5(*), y6(*), y7(*), y8(*),
81 . z1(*), z2(*), z3(*), z4(*), z5(*), z6(*), z7(*), z8(*),
82 . vx1(*), vx2(*), vx3(*), vx4(*), vx5(*), vx6(*), vx7(*), vx8(*),
83 . vy1(*), vy2(*), vy3(*), vy4(*), vy5(*), vy6(*), vy7(*), vy8(*),
84 . vz1(*), vz2(*), vz3(*), vz4(*), vz5(*), vz6(*), vz7(*), vz8(*),
85 . vd2(*), offg(*), off(*), rho(*), rhoo(*),
86 . r11(mvsiz),r12(mvsiz),r13(mvsiz),
87 . r21(mvsiz),r22(mvsiz),r23(mvsiz),
88 . r31(mvsiz),r32(mvsiz),r33(mvsiz),
89 . gama0(nel,6),gama(mvsiz,6) ,vgax(*), vgay(*), vgaz(*), vga2(*),
90 . xgax(*), xgay(*), xgaz(*),
91 . xgxa2(mvsiz),xgya2(mvsiz),xgza2(mvsiz),
92 . xgxya(mvsiz),xgyza(mvsiz),xgzxa(mvsiz),gama_r(nel,6)
93 INTEGER IXS(NIXS,*), MXT(*), NGL(*),NGEO(*),IPARG(*),
94 . NC1(*),NC2(*),NC3(*),NC4(*),NC5(*),NC6(*),NC7(*),NC8(*)
95 INTEGER IOUTPRT
96
97 DOUBLE PRECISION
98 . XDP(3,*),X0(MVSIZ,8),Y0(MVSIZ,8),Z0(MVSIZ,8),SAV(NEL,21),
99 . XD1(*), XD2(*), XD3(*), XD4(*), XD5(*), XD6(*), XD7(*), XD8(*),
100 . YD1(*), YD2(*), YD3(*), YD4(*), YD5(*), YD6(*), YD7(*), YD8(*),
101 . ZD1(*), ZD2(*), ZD3(*), ZD4(*), ZD5(*), ZD6(*), ZD7(*), ZD8(*)
102C-----------------------------------------------
103C L o c a l V a r i a b l e s
104C-----------------------------------------------
105 INTEGER I
106
107 double precision
108 . xdl, ydl, zdl
109
110C REAL
111 my_real
112 . g11,g12,g13,
113 . g21,g22,g23,
114 . g31,g32,g33,
115 . t11,t12,t13,
116 . t21,t22,t23,
117 . t31,t32,t33,
118 . rx(mvsiz) , ry(mvsiz) , rz(mvsiz) ,
119 . sx(mvsiz) , sy(mvsiz) , sz(mvsiz) ,
120 . tx(mvsiz) , ty(mvsiz) , tz(mvsiz)
121 my_real
122 . off_l
123C=======================================================================
124 off_l = zero
125C
126 DO i=lft,llt
127 vis(i)=zero
128 ngeo(i)=ixs(10,i)
129 ngl(i)=ixs(11,i)
130 mxt(i)=ixs(1,i)
131 nc1(i)=ixs(2,i)
132 nc2(i)=ixs(3,i)
133 nc3(i)=ixs(4,i)
134 nc4(i)=ixs(5,i)
135 nc5(i)=ixs(6,i)
136 nc6(i)=ixs(7,i)
137 nc7(i)=ixs(8,i)
138 nc8(i)=ixs(9,i)
139 rhoo(i)=rho(i)
140 ENDDO
141C----------------------------
142C NODAL COORDINATES |
143C----------------------------
144 IF(iresp==1)THEN
145 DO i=lft,llt
146 xd1(i)=xdp(1,nc1(i))
147 yd1(i)=xdp(2,nc1(i))
148 zd1(i)=xdp(3,nc1(i))
149 xd2(i)=xdp(1,nc2(i))
150 yd2(i)=xdp(2,nc2(i))
151 zd2(i)=xdp(3,nc2(i))
152 xd3(i)=xdp(1,nc3(i))
153 yd3(i)=xdp(2,nc3(i))
154 zd3(i)=xdp(3,nc3(i))
155 xd4(i)=xdp(1,nc4(i))
156 yd4(i)=xdp(2,nc4(i))
157 zd4(i)=xdp(3,nc4(i))
158 xd5(i)=xdp(1,nc5(i))
159 yd5(i)=xdp(2,nc5(i))
160 zd5(i)=xdp(3,nc5(i))
161 xd6(i)=xdp(1,nc6(i))
162 yd6(i)=xdp(2,nc6(i))
163 zd6(i)=xdp(3,nc6(i))
164 xd7(i)=xdp(1,nc7(i))
165 yd7(i)=xdp(2,nc7(i))
166 zd7(i)=xdp(3,nc7(i))
167 xd8(i)=xdp(1,nc8(i))
168 yd8(i)=xdp(2,nc8(i))
169 zd8(i)=xdp(3,nc8(i))
170 ENDDO
171 ELSE
172 DO i=lft,llt
173 xd1(i)=x(1,nc1(i))
174 yd1(i)=x(2,nc1(i))
175 zd1(i)=x(3,nc1(i))
176 xd2(i)=x(1,nc2(i))
177 yd2(i)=x(2,nc2(i))
178 zd2(i)=x(3,nc2(i))
179 xd3(i)=x(1,nc3(i))
180 yd3(i)=x(2,nc3(i))
181 zd3(i)=x(3,nc3(i))
182 xd4(i)=x(1,nc4(i))
183 yd4(i)=x(2,nc4(i))
184 zd4(i)=x(3,nc4(i))
185 xd5(i)=x(1,nc5(i))
186 yd5(i)=x(2,nc5(i))
187 zd5(i)=x(3,nc5(i))
188 xd6(i)=x(1,nc6(i))
189 yd6(i)=x(2,nc6(i))
190 zd6(i)=x(3,nc6(i))
191 xd7(i)=x(1,nc7(i))
192 yd7(i)=x(2,nc7(i))
193 zd7(i)=x(3,nc7(i))
194 xd8(i)=x(1,nc8(i))
195 yd8(i)=x(2,nc8(i))
196 zd8(i)=x(3,nc8(i))
197 ENDDO
198 ENDIF
199C-----------
200 DO i=lft,llt
201 vx1(i)=v(1,nc1(i))
202 vy1(i)=v(2,nc1(i))
203 vz1(i)=v(3,nc1(i))
204 vx2(i)=v(1,nc2(i))
205 vy2(i)=v(2,nc2(i))
206 vz2(i)=v(3,nc2(i))
207 vx3(i)=v(1,nc3(i))
208 vy3(i)=v(2,nc3(i))
209 vz3(i)=v(3,nc3(i))
210 vx4(i)=v(1,nc4(i))
211 vy4(i)=v(2,nc4(i))
212 vz4(i)=v(3,nc4(i))
213 vx5(i)=v(1,nc5(i))
214 vy5(i)=v(2,nc5(i))
215 vz5(i)=v(3,nc5(i))
216 vx6(i)=v(1,nc6(i))
217 vy6(i)=v(2,nc6(i))
218 vz6(i)=v(3,nc6(i))
219 vx7(i)=v(1,nc7(i))
220 vy7(i)=v(2,nc7(i))
221 vz7(i)=v(3,nc7(i))
222 vx8(i)=v(1,nc8(i))
223 vy8(i)=v(2,nc8(i))
224 vz8(i)=v(3,nc8(i))
225 ENDDO
226C-----------
227C prepares outputs by part.
228C-----------
229 IF (ioutprt /= 0) THEN
230 DO i=lft,llt
231 vgax(i)=vx1(i)+vx2(i)+vx3(i)+vx4(i)+vx5(i)+vx6(i)+vx7(i)+vx8(i)
232 vgay(i)=vy1(i)+vy2(i)+vy3(i)+vy4(i)+vy5(i)+vy6(i)+vy7(i)+vy8(i)
233 vgaz(i)=vz1(i)+vz2(i)+vz3(i)+vz4(i)+vz5(i)+vz6(i)+vz7(i)+vz8(i)
234 vga2(i)=vx1(i)*vx1(i)+vx2(i)*vx2(i)+vx3(i)*vx3(i)+vx4(i)*vx4(i)
235 1 +vx5(i)*vx5(i)+vx6(i)*vx6(i)+vx7(i)*vx7(i)+vx8(i)*vx8(i)
236 2 +vy1(i)*vy1(i)+vy2(i)*vy2(i)+vy3(i)*vy3(i)+vy4(i)*vy4(i)
237 3 +vy5(i)*vy5(i)+vy6(i)*vy6(i)+vy7(i)*vy7(i)+vy8(i)*vy8(i)
238 4 +vz1(i)*vz1(i)+vz2(i)*vz2(i)+vz3(i)*vz3(i)+vz4(i)*vz4(i)
239 5 +vz5(i)*vz5(i)+vz6(i)*vz6(i)+vz7(i)*vz7(i)+vz8(i)*vz8(i)
240 ENDDO
241 IF(iparg(80)==1) THEN
242 DO i=lft,llt
243 xgax(i)=xd1(i)+xd2(i)+xd3(i)+xd4(i)+xd5(i)+xd6(i)+xd7(i)+xd8(i)
244 xgay(i)=yd1(i)+yd2(i)+yd3(i)+yd4(i)+yd5(i)+yd6(i)+yd7(i)+yd8(i)
245 xgaz(i)=zd1(i)+zd2(i)+zd3(i)+zd4(i)+zd5(i)+zd6(i)+zd7(i)+zd8(i)
246 xgxa2(i)=xd1(i)**2+xd2(i)**2+xd3(i)**2+xd4(i)**2
247 1 +xd5(i)**2+xd6(i)**2+xd7(i)**2+xd8(i)**2
248 xgya2(i)=yd1(i)**2+yd2(i)**2+yd3(i)**2+yd4(i)**2
249 1 +yd5(i)**2+yd6(i)**2+yd7(i)**2+yd8(i)**2
250 xgza2(i)=zd1(i)**2+zd2(i)**2+zd3(i)**2+zd4(i)**2
251 1 +zd5(i)**2+zd6(i)**2+zd7(i)**2+zd8(i)**2
252 xgxya(i)=xd1(i)*yd1(i)+xd2(i)*yd2(i)+xd3(i)*yd3(i)+xd4(i)*yd4(i)
253 1 +xd5(i)*yd5(i)+xd6(i)*yd6(i)+xd7(i)*yd7(i)+xd8(i)*yd8(i)
254 xgyza(i)=yd1(i)*zd1(i)+yd2(i)*zd2(i)+yd3(i)*zd3(i)+yd4(i)*zd4(i)
255 1 +yd5(i)*zd5(i)+yd6(i)*zd6(i)+yd7(i)*zd7(i)+yd8(i)*zd8(i)
256 xgzxa(i)=zd1(i)*xd1(i)+zd2(i)*xd2(i)+zd3(i)*xd3(i)+zd4(i)*xd4(i)
257 1 +zd5(i)*xd5(i)+zd6(i)*xd6(i)+zd7(i)*xd7(i)+zd8(i)*xd8(i)
258 ENDDO
259 ENDIF
260 ENDIF
261C-----------
262C convected frame (ITERATIONS).
263C-----------
264 CALL srepiso3(
265 1 xd1, xd2, xd3, xd4,
266 2 xd5, xd6, xd7, xd8,
267 3 yd1, yd2, yd3, yd4,
268 4 yd5, yd6, yd7, yd8,
269 5 zd1, zd2, zd3, zd4,
270 6 zd5, zd6, zd7, zd8,
271 7 rx, ry, rz, sx,
272 8 sy, sz, tx, ty,
273 9 tz, nel)
274C---
275 IF (jhbe == 14 .OR. jhbe == 24) THEN
276 CALL sortho3(
277 1 rx, ry, rz, sx,
278 2 sy, sz, tx, ty,
279 3 tz, r12, r13, r11,
280 4 r22, r23, r21, r32,
281 5 r33, r31, nel)
282 ELSEIF (jhbe == 15 ) THEN
283 CALL scortho3(
284 1 rx, ry, rz, sx,
285 2 sy, sz, tx, ty,
286 3 tz, r11, r12, r13,
287 4 r21, r22, r23, r31,
288 5 r32, r33, nel)
289 ELSE
290 CALL sortho3(
291 1 rx, ry, rz, sx,
292 2 sy, sz, tx, ty,
293 3 tz, r11, r12, r13,
294 4 r21, r22, r23, r31,
295 5 r32, r33, nel)
296 ENDIF
297C------stocker [R] in %GAMA_R--------------
298 gama_r(lft:llt,1) = r11(lft:llt) ! Dir1_x
299 gama_r(lft:llt,2) = r21(lft:llt) ! Dir1_y
300 gama_r(lft:llt,3) = r31(lft:llt) ! Dir1_z
301 gama_r(lft:llt,4) = r12(lft:llt) ! Dir2_x
302 gama_r(lft:llt,5) = r22(lft:llt) ! Dir2_y
303 gama_r(lft:llt,6) = r32(lft:llt) ! Dir2_z
304C-------sauf thick shells --------------
305 IF (igtyp /= 21 .AND. igtyp /= 22) THEN
306 IF (isorth == 0) THEN
307 DO i=lft,llt
308 gama(i,1) = one
309 gama(i,2) = zero
310 gama(i,3) = zero
311 gama(i,4) = zero
312 gama(i,5) = one
313 gama(i,6) = zero
314 ENDDO
315 ELSE
316 CALL sorthdir3(
317 1 rx, ry, rz, sx,
318 2 sy, sz, tx, ty,
319 3 tz, r11, r12, r13,
320 4 r21, r22, r23, r31,
321 5 r32, r33, gama0, gama,
322 6 nel, irep)
323 ENDIF
324 ENDIF
325C-----------
326C Change to the convected frame.
327C-----------
328C X=RX' <=> X'=t(R)X chgt de base.
329 IF((ismstr<=4.OR.(ismstr==12.AND.idtmin(1)==3)).AND.jlag>0) THEN
330 DO i=lft,llt
331 IF(abs(offg(i)) > one)THEN
332 xd1(i)=sav(i,1)
333 yd1(i)=sav(i,2)
334 zd1(i)=sav(i,3)
335 xd2(i)=sav(i,4)
336 yd2(i)=sav(i,5)
337 zd2(i)=sav(i,6)
338 xd3(i)=sav(i,7)
339 yd3(i)=sav(i,8)
340 zd3(i)=sav(i,9)
341 xd4(i)=sav(i,10)
342 yd4(i)=sav(i,11)
343 zd4(i)=sav(i,12)
344 xd5(i)=sav(i,13)
345 yd5(i)=sav(i,14)
346 zd5(i)=sav(i,15)
347 xd6(i)=sav(i,16)
348 yd6(i)=sav(i,17)
349 zd6(i)=sav(i,18)
350 xd7(i)=sav(i,19)
351 yd7(i)=sav(i,20)
352 zd7(i)=sav(i,21)
353 xd8(i)=zero
354 yd8(i)=zero
355 zd8(i)=zero
356 off(i) = abs(offg(i))-one
357 off_l = min(off_l,offg(i))
358 ELSE
359 xdl=r11(i)*xd1(i)+r21(i)*yd1(i)+r31(i)*zd1(i)
360 ydl=r12(i)*xd1(i)+r22(i)*yd1(i)+r32(i)*zd1(i)
361 zdl=r13(i)*xd1(i)+r23(i)*yd1(i)+r33(i)*zd1(i)
362 xd1(i)=xdl
363 yd1(i)=ydl
364 zd1(i)=zdl
365 xdl=r11(i)*xd2(i)+r21(i)*yd2(i)+r31(i)*zd2(i)
366 ydl=r12(i)*xd2(i)+r22(i)*yd2(i)+r32(i)*zd2(i)
367 zdl=r13(i)*xd2(i)+r23(i)*yd2(i)+r33(i)*zd2(i)
368 xd2(i)=xdl
369 yd2(i)=ydl
370 zd2(i)=zdl
371 xdl=r11(i)*xd3(i)+r21(i)*yd3(i)+r31(i)*zd3(i)
372 ydl=r12(i)*xd3(i)+r22(i)*yd3(i)+r32(i)*zd3(i)
373 zdl=r13(i)*xd3(i)+r23(i)*yd3(i)+r33(i)*zd3(i)
374 xd3(i)=xdl
375 yd3(i)=ydl
376 zd3(i)=zdl
377 xdl=r11(i)*xd4(i)+r21(i)*yd4(i)+r31(i)*zd4(i)
378 ydl=r12(i)*xd4(i)+r22(i)*yd4(i)+r32(i)*zd4(i)
379 zdl=r13(i)*xd4(i)+r23(i)*yd4(i)+r33(i)*zd4(i)
380 xd4(i)=xdl
381 yd4(i)=ydl
382 zd4(i)=zdl
383 xdl=r11(i)*xd5(i)+r21(i)*yd5(i)+r31(i)*zd5(i)
384 ydl=r12(i)*xd5(i)+r22(i)*yd5(i)+r32(i)*zd5(i)
385 zdl=r13(i)*xd5(i)+r23(i)*yd5(i)+r33(i)*zd5(i)
386 xd5(i)=xdl
387 yd5(i)=ydl
388 zd5(i)=zdl
389 xdl=r11(i)*xd6(i)+r21(i)*yd6(i)+r31(i)*zd6(i)
390 ydl=r12(i)*xd6(i)+r22(i)*yd6(i)+r32(i)*zd6(i)
391 zdl=r13(i)*xd6(i)+r23(i)*yd6(i)+r33(i)*zd6(i)
392 xd6(i)=xdl
393 yd6(i)=ydl
394 zd6(i)=zdl
395 xdl=r11(i)*xd7(i)+r21(i)*yd7(i)+r31(i)*zd7(i)
396 ydl=r12(i)*xd7(i)+r22(i)*yd7(i)+r32(i)*zd7(i)
397 zdl=r13(i)*xd7(i)+r23(i)*yd7(i)+r33(i)*zd7(i)
398 xd7(i)=xdl
399 yd7(i)=ydl
400 zd7(i)=zdl
401 xdl=r11(i)*xd8(i)+r21(i)*yd8(i)+r31(i)*zd8(i)
402 ydl=r12(i)*xd8(i)+r22(i)*yd8(i)+r32(i)*zd8(i)
403 zdl=r13(i)*xd8(i)+r23(i)*yd8(i)+r33(i)*zd8(i)
404 xd8(i)=xdl
405 yd8(i)=ydl
406 zd8(i)=zdl
407 off(i) = abs(offg(i))
408 off_l = min(off_l,offg(i))
409 ENDIF
410 ENDDO
411 IF((ismstr==12.AND.idtmin(1)==3).AND.jlag>0) THEN
412 DO i=lft,llt
413 IF(abs(offg(i)) > one)THEN
414 xdl=r11(i)*xd1(i)+r21(i)*yd1(i)+r31(i)*zd1(i)
415 ydl=r12(i)*xd1(i)+r22(i)*yd1(i)+r32(i)*zd1(i)
416 zdl=r13(i)*xd1(i)+r23(i)*yd1(i)+r33(i)*zd1(i)
417 xd1(i)=xdl
418 yd1(i)=ydl
419 zd1(i)=zdl
420 xdl=r11(i)*xd2(i)+r21(i)*yd2(i)+r31(i)*zd2(i)
421 ydl=r12(i)*xd2(i)+r22(i)*yd2(i)+r32(i)*zd2(i)
422 zdl=r13(i)*xd2(i)+r23(i)*yd2(i)+r33(i)*zd2(i)
423 xd2(i)=xdl
424 yd2(i)=ydl
425 zd2(i)=zdl
426 xdl=r11(i)*xd3(i)+r21(i)*yd3(i)+r31(i)*zd3(i)
427 ydl=r12(i)*xd3(i)+r22(i)*yd3(i)+r32(i)*zd3(i)
428 zdl=r13(i)*xd3(i)+r23(i)*yd3(i)+r33(i)*zd3(i)
429 xd3(i)=xdl
430 yd3(i)=ydl
431 zd3(i)=zdl
432 xdl=r11(i)*xd4(i)+r21(i)*yd4(i)+r31(i)*zd4(i)
433 ydl=r12(i)*xd4(i)+r22(i)*yd4(i)+r32(i)*zd4(i)
434 zdl=r13(i)*xd4(i)+r23(i)*yd4(i)+r33(i)*zd4(i)
435 xd4(i)=xdl
436 yd4(i)=ydl
437 zd4(i)=zdl
438 xdl=r11(i)*xd5(i)+r21(i)*yd5(i)+r31(i)*zd5(i)
439 ydl=r12(i)*xd5(i)+r22(i)*yd5(i)+r32(i)*zd5(i)
440 zdl=r13(i)*xd5(i)+r23(i)*yd5(i)+r33(i)*zd5(i)
441 xd5(i)=xdl
442 yd5(i)=ydl
443 zd5(i)=zdl
444 xdl=r11(i)*xd6(i)+r21(i)*yd6(i)+r31(i)*zd6(i)
445 ydl=r12(i)*xd6(i)+r22(i)*yd6(i)+r32(i)*zd6(i)
446 zdl=r13(i)*xd6(i)+r23(i)*yd6(i)+r33(i)*zd6(i)
447 xd6(i)=xdl
448 yd6(i)=ydl
449 zd6(i)=zdl
450 xdl=r11(i)*xd7(i)+r21(i)*yd7(i)+r31(i)*zd7(i)
451 ydl=r12(i)*xd7(i)+r22(i)*yd7(i)+r32(i)*zd7(i)
452 zdl=r13(i)*xd7(i)+r23(i)*yd7(i)+r33(i)*zd7(i)
453 xd7(i)=xdl
454 yd7(i)=ydl
455 zd7(i)=zdl
456 xdl=r11(i)*xd8(i)+r21(i)*yd8(i)+r31(i)*zd8(i)
457 ydl=r12(i)*xd8(i)+r22(i)*yd8(i)+r32(i)*zd8(i)
458 zdl=r13(i)*xd8(i)+r23(i)*yd8(i)+r33(i)*zd8(i)
459 xd8(i)=xdl
460 yd8(i)=ydl
461 zd8(i)=zdl
462 END IF
463 ENDDO
464 END IF
465C
466 ELSE ! Ismstr = 4
467 DO i=lft,llt
468 xdl=r11(i)*xd1(i)+r21(i)*yd1(i)+r31(i)*zd1(i)
469 ydl=r12(i)*xd1(i)+r22(i)*yd1(i)+r32(i)*zd1(i)
470 zdl=r13(i)*xd1(i)+r23(i)*yd1(i)+r33(i)*zd1(i)
471 xd1(i)=xdl
472 yd1(i)=ydl
473 zd1(i)=zdl
474 xdl=r11(i)*xd2(i)+r21(i)*yd2(i)+r31(i)*zd2(i)
475 ydl=r12(i)*xd2(i)+r22(i)*yd2(i)+r32(i)*zd2(i)
476 zdl=r13(i)*xd2(i)+r23(i)*yd2(i)+r33(i)*zd2(i)
477 xd2(i)=xdl
478 yd2(i)=ydl
479 zd2(i)=zdl
480 xdl=r11(i)*xd3(i)+r21(i)*yd3(i)+r31(i)*zd3(i)
481 ydl=r12(i)*xd3(i)+r22(i)*yd3(i)+r32(i)*zd3(i)
482 zdl=r13(i)*xd3(i)+r23(i)*yd3(i)+r33(i)*zd3(i)
483 xd3(i)=xdl
484 yd3(i)=ydl
485 zd3(i)=zdl
486 xdl=r11(i)*xd4(i)+r21(i)*yd4(i)+r31(i)*zd4(i)
487 ydl=r12(i)*xd4(i)+r22(i)*yd4(i)+r32(i)*zd4(i)
488 zdl=r13(i)*xd4(i)+r23(i)*yd4(i)+r33(i)*zd4(i)
489 xd4(i)=xdl
490 yd4(i)=ydl
491 zd4(i)=zdl
492 xdl=r11(i)*xd5(i)+r21(i)*yd5(i)+r31(i)*zd5(i)
493 ydl=r12(i)*xd5(i)+r22(i)*yd5(i)+r32(i)*zd5(i)
494 zdl=r13(i)*xd5(i)+r23(i)*yd5(i)+r33(i)*zd5(i)
495 xd5(i)=xdl
496 yd5(i)=ydl
497 zd5(i)=zdl
498 xdl=r11(i)*xd6(i)+r21(i)*yd6(i)+r31(i)*zd6(i)
499 ydl=r12(i)*xd6(i)+r22(i)*yd6(i)+r32(i)*zd6(i)
500 zdl=r13(i)*xd6(i)+r23(i)*yd6(i)+r33(i)*zd6(i)
501 xd6(i)=xdl
502 yd6(i)=ydl
503 zd6(i)=zdl
504 xdl=r11(i)*xd7(i)+r21(i)*yd7(i)+r31(i)*zd7(i)
505 ydl=r12(i)*xd7(i)+r22(i)*yd7(i)+r32(i)*zd7(i)
506 zdl=r13(i)*xd7(i)+r23(i)*yd7(i)+r33(i)*zd7(i)
507 xd7(i)=xdl
508 yd7(i)=ydl
509 zd7(i)=zdl
510 xdl=r11(i)*xd8(i)+r21(i)*yd8(i)+r31(i)*zd8(i)
511 ydl=r12(i)*xd8(i)+r22(i)*yd8(i)+r32(i)*zd8(i)
512 zdl=r13(i)*xd8(i)+r23(i)*yd8(i)+r33(i)*zd8(i)
513 xd8(i)=xdl
514 yd8(i)=ydl
515 zd8(i)=zdl
516 off(i) = abs(offg(i))
517 off_l = min(off_l,offg(i))
518 ENDDO
519C
520 ENDIF ! ISMSTR
521C-----------
522C PASSAGE AU ORTHOTROPIC FRAME.
523C-----------
524 IF (isorth/=0 .AND. jhbe/=24 .AND. jhbe/=222 .AND. jhbe/=14
525 . .AND. jhbe/=15) THEN
526C------save for SAV update
527 IF(ismstr <= 3) THEN
528 DO i=lft,llt
529 x0(i,1) = xd1(i)
530 y0(i,1) = yd1(i)
531 z0(i,1) = zd1(i)
532 x0(i,2) = xd2(i)
533 y0(i,2) = yd2(i)
534 z0(i,2) = zd2(i)
535 x0(i,3) = xd3(i)
536 y0(i,3) = yd3(i)
537 z0(i,3) = zd3(i)
538 x0(i,4) = xd4(i)
539 y0(i,4) = yd4(i)
540 z0(i,4) = zd4(i)
541 x0(i,5) = xd5(i)
542 y0(i,5) = yd5(i)
543 z0(i,5) = zd5(i)
544 x0(i,6) = xd6(i)
545 y0(i,6) = yd6(i)
546 z0(i,6) = zd6(i)
547 x0(i,7) = xd7(i)
548 y0(i,7) = yd7(i)
549 z0(i,7) = zd7(i)
550 x0(i,8) = xd8(i)
551 y0(i,8) = yd8(i)
552 z0(i,8) = zd8(i)
553 END DO
554 END IF
555C
556 DO i=lft,llt
557C Extration de G tq Xortho=Transpose(G) Xcvt
558C =Transpose(G) Transpose(R) Xglobal.
559 g11=gama(i,1)
560 g21=gama(i,2)
561 g31=gama(i,3)
562 g12=gama(i,4)
563 g22=gama(i,5)
564 g32=gama(i,6)
565 g13=g21*g32-g31*g22
566 g23=g31*g12-g11*g32
567 g33=g11*g22-g21*g12
568C
569 xdl=g11*xd1(i)+g21*yd1(i)+g31*zd1(i)
570 ydl=g12*xd1(i)+g22*yd1(i)+g32*zd1(i)
571 zdl=g13*xd1(i)+g23*yd1(i)+g33*zd1(i)
572 xd1(i)=xdl
573 yd1(i)=ydl
574 zd1(i)=zdl
575 xdl=g11*xd2(i)+g21*yd2(i)+g31*zd2(i)
576 ydl=g12*xd2(i)+g22*yd2(i)+g32*zd2(i)
577 zdl=g13*xd2(i)+g23*yd2(i)+g33*zd2(i)
578 xd2(i)=xdl
579 yd2(i)=ydl
580 zd2(i)=zdl
581 xdl=g11*xd3(i)+g21*yd3(i)+g31*zd3(i)
582 ydl=g12*xd3(i)+g22*yd3(i)+g32*zd3(i)
583 zdl=g13*xd3(i)+g23*yd3(i)+g33*zd3(i)
584 xd3(i)=xdl
585 yd3(i)=ydl
586 zd3(i)=zdl
587 xdl=g11*xd4(i)+g21*yd4(i)+g31*zd4(i)
588 ydl=g12*xd4(i)+g22*yd4(i)+g32*zd4(i)
589 zdl=g13*xd4(i)+g23*yd4(i)+g33*zd4(i)
590 xd4(i)=xdl
591 yd4(i)=ydl
592 zd4(i)=zdl
593 xdl=g11*xd5(i)+g21*yd5(i)+g31*zd5(i)
594 ydl=g12*xd5(i)+g22*yd5(i)+g32*zd5(i)
595 zdl=g13*xd5(i)+g23*yd5(i)+g33*zd5(i)
596 xd5(i)=xdl
597 yd5(i)=ydl
598 zd5(i)=zdl
599 xdl=g11*xd6(i)+g21*yd6(i)+g31*zd6(i)
600 ydl=g12*xd6(i)+g22*yd6(i)+g32*zd6(i)
601 zdl=g13*xd6(i)+g23*yd6(i)+g33*zd6(i)
602 xd6(i)=xdl
603 yd6(i)=ydl
604 zd6(i)=zdl
605 xdl=g11*xd7(i)+g21*yd7(i)+g31*zd7(i)
606 ydl=g12*xd7(i)+g22*yd7(i)+g32*zd7(i)
607 zdl=g13*xd7(i)+g23*yd7(i)+g33*zd7(i)
608 xd7(i)=xdl
609 yd7(i)=ydl
610 zd7(i)=zdl
611 xdl=g11*xd8(i)+g21*yd8(i)+g31*zd8(i)
612 ydl=g12*xd8(i)+g22*yd8(i)+g32*zd8(i)
613 zdl=g13*xd8(i)+g23*yd8(i)+g33*zd8(i)
614 xd8(i)=xdl
615 yd8(i)=ydl
616 zd8(i)=zdl
617C MATRICE DE PASSAGE GLOBAL -> ORTHOTROPE.
618 t11=r11(i)*g11+r12(i)*g21+r13(i)*g31
619 t12=r11(i)*g12+r12(i)*g22+r13(i)*g32
620 t13=r11(i)*g13+r12(i)*g23+r13(i)*g33
621 t21=r21(i)*g11+r22(i)*g21+r23(i)*g31
622 t22=r21(i)*g12+r22(i)*g22+r23(i)*g32
623 t23=r21(i)*g13+r22(i)*g23+r23(i)*g33
624 t31=r31(i)*g11+r32(i)*g21+r33(i)*g31
625 t32=r31(i)*g12+r32(i)*g22+r33(i)*g32
626 t33=r31(i)*g13+r32(i)*g23+r33(i)*g33
627 r11(i)=t11
628 r12(i)=t12
629 r13(i)=t13
630 r21(i)=t21
631 r22(i)=t22
632 r23(i)=t23
633 r31(i)=t31
634 r32(i)=t32
635 r33(i)=t33
636 ENDDO
637 ENDIF
638
639c copy and cast XD (DP) to C(SP) to assure coherence between XD et X
640 DO i=lft,llt
641 x1(i)= xd1(i)
642 y1(i)= yd1(i)
643 z1(i)= zd1(i)
644 x2(i)= xd2(i)
645 y2(i)= yd2(i)
646 z2(i)= zd2(i)
647 x3(i)= xd3(i)
648 y3(i)= yd3(i)
649 z3(i)= zd3(i)
650 x4(i)= xd4(i)
651 y4(i)= yd4(i)
652 z4(i)= zd4(i)
653 x5(i)= xd5(i)
654 y5(i)= yd5(i)
655 z5(i)= zd5(i)
656 x6(i)= xd6(i)
657 y6(i)= yd6(i)
658 z6(i)= zd6(i)
659 x7(i)= xd7(i)
660 y7(i)= yd7(i)
661 z7(i)= zd7(i)
662 x8(i)= xd8(i)
663 y8(i)= yd8(i)
664 z8(i)= zd8(i)
665 ENDDO
666C-----------
667C transfer of velocities to the convected (or orthotropic) frame.
668C-----------
669 CALL srrota3(
670 1 r11, r12, r13, r21,
671 2 r22, r23, r31, r32,
672 3 r33, vx1, vx2, vx3,
673 4 vx4, vx5, vx6, vx7,
674 5 vx8, vy1, vy2, vy3,
675 6 vy4, vy5, vy6, vy7,
676 7 vy8, vz1, vz2, vz3,
677 8 vz4, vz5, vz6, vz7,
678 9 vz8, nel)
679
680
681
682
683 IF(off_l < zero)THEN
684 DO i=lft,llt
685 IF(offg(i) < zero)THEN
686 vx1(i)=zero
687 vy1(i)=zero
688 vz1(i)=zero
689 vx2(i)=zero
690 vy2(i)=zero
691 vz2(i)=zero
692 vx3(i)=zero
693 vy3(i)=zero
694 vz3(i)=zero
695 vx4(i)=zero
696 vy4(i)=zero
697 vz4(i)=zero
698 vx5(i)=zero
699 vy5(i)=zero
700 vz5(i)=zero
701 vx6(i)=zero
702 vy6(i)=zero
703 vz6(i)=zero
704 vx7(i)=zero
705 vy7(i)=zero
706 vz7(i)=zero
707 vx8(i)=zero
708 vy8(i)=zero
709 vz8(i)=zero
710 ENDIF
711 ENDDO
712 ENDIF
713C-----------
714 DO i=lft,llt
715 vd2(i)=zero
716 ENDDO
717C-----------
718 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
sorthdir3
subroutine sorthdir3(rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, gama0, gama, nel, irep)
Definition sorthdir3.F:43
sortho3
subroutine sortho3(rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z)
Definition sortho3.F:33
srepiso3
subroutine srepiso3(x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, rx, ry, rz, sx, sy, sz, tx, ty, tz, f1x, f1y, f1z, f2x, f2y, f2z)
Definition srepiso3.F:35
srrota3
subroutine srrota3(r11, r12, r13, r21, r22, r23, r31, r32, r33, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8)
Definition srrota3.F:33
scortho3
subroutine scortho3(x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z)
Definition scortho3.F:34