OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
srcoor3.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| srcoor3 ../engine/source/elements/solid/solide/srcoor3.F
25!||--- called by ------------------------------------------------------
26!|| s8cforc3 ../engine/source/elements/thickshell/solide8c/s8cforc3.F
27!|| s8eforc3 ../engine/source/elements/solid/solide8e/s8eforc3.F
28!|| s8zforc3 ../engine/source/elements/solid/solide8z/s8zforc3.F
29!|| scforc3 ../engine/source/elements/thickshell/solidec/scforc3.F
30!|| sforc3 ../engine/source/elements/solid/solide/sforc3.F
31!|| szforc3 ../engine/source/elements/solid/solidez/szforc3.F
32!||--- calls -----------------------------------------------------
33!|| scortho3 ../engine/source/elements/thickshell/solidec/scortho3.F
34!|| sorthdir3 ../engine/source/elements/solid/solide/sorthdir3.F
35!|| sortho3 ../engine/source/elements/solid/solide/sortho3.F
36!|| srepiso3 ../engine/source/elements/solid/solide/srepiso3.F
37!|| srrota3 ../engine/source/elements/solid/solide/srrota3.F
38!||====================================================================
39 SUBROUTINE srcoor3(X ,IXS ,V ,W ,GAMA0 ,GAMA ,
40 . X1 ,X2 ,X3 ,X4 ,X5 ,X6 ,X7 ,X8 ,
41 . Y1 ,Y2 ,Y3 ,Y4 ,Y5 ,Y6 ,Y7 ,Y8 ,
42 . Z1 ,Z2 ,Z3 ,Z4 ,Z5 ,Z6 ,Z7 ,Z8 ,
43 . VX1 ,VX2 ,VX3 ,VX4 ,VX5 ,VX6 ,VX7 ,VX8 ,
44 . VY1 ,VY2 ,VY3 ,VY4 ,VY5 ,VY6 ,VY7 ,VY8 ,
45 . VZ1 ,VZ2 ,VZ3 ,VZ4 ,VZ5 ,VZ6 ,VZ7 ,VZ8 ,
46 . VD2 ,VIS ,OFFG ,OFF ,SAV ,RHO ,RHOO ,R11 ,
47 . R12 ,R13 ,R21 ,R22 ,R23 ,R31 ,R32 ,R33 ,
48 . NC1 ,NC2 ,NC3 ,NC4 ,NC5 ,NC6 ,NC7 ,NC8 ,
49 . NGL ,MXT ,NGEO ,IOUTPRT,VGAX ,VGAY ,VGAZ ,VGA2 ,
50 . XD1 ,XD2 ,XD3 ,XD4 ,XD5 ,XD6 ,XD7 ,XD8 ,
51 . YD1 ,YD2 ,YD3 ,YD4 ,YD5 ,YD6 ,YD7 ,YD8 ,
52 . ZD1 ,ZD2 ,ZD3 ,ZD4 ,ZD5 ,ZD6 ,ZD7 ,ZD8 ,
53 . XDP ,X0 ,Y0 ,Z0 ,NEL ,XGAX ,XGAY ,XGAZ ,
54 . XGXA2,XGYA2 ,XGZA2 ,XGXYA ,XGYZA ,XGZXA ,IPARG ,GAMA_R)
55C-----------------------------------------------
56C I m p l i c i t T y p e s
57C-----------------------------------------------
58#include "implicit_f.inc"
59C-----------------------------------------------
60C G l o b a l P a r a m e t e r s
61C-----------------------------------------------
62#include "mvsiz_p.inc"
63C-----------------------------------------------
64C C o m m o n B l o c k s
65C-----------------------------------------------
66#include "vect01_c.inc"
67#include "scr05_c.inc"
68#include "scr18_c.inc"
69C-----------------------------------------------
70C D u m m y A r g u m e n t s
71C-----------------------------------------------
72 INTEGER NEL
73C REAL
74 my_real
75 . X(3,*),V(3,*),W(3,*), VIS(*),
76 . X1(*), X2(*), X3(*), X4(*), X5(*), X6(*), X7(*), X8(*),
77 . Y1(*), Y2(*), Y3(*), Y4(*), Y5(*), Y6(*), Y7(*), Y8(*),
78 . Z1(*), Z2(*), Z3(*), Z4(*), Z5(*), Z6(*), Z7(*), Z8(*),
79 . VX1(*), VX2(*), VX3(*), VX4(*), VX5(*), VX6(*), VX7(*), VX8(*),
80 . VY1(*), VY2(*), VY3(*), VY4(*), VY5(*), VY6(*), VY7(*), VY8(*),
81 . VZ1(*), VZ2(*), VZ3(*), VZ4(*), VZ5(*), VZ6(*), VZ7(*), VZ8(*),
82 . VD2(*), OFFG(*), OFF(*), RHO(*), RHOO(*),
83 . R11(MVSIZ),R12(MVSIZ),R13(MVSIZ),
84 . R21(MVSIZ),R22(MVSIZ),R23(MVSIZ),
85 . R31(MVSIZ),R32(MVSIZ),R33(MVSIZ),
86 . GAMA0(NEL,6),GAMA(MVSIZ,6) ,VGAX(*), VGAY(*), VGAZ(*), VGA2(*),
87 . xgax(*), xgay(*), xgaz(*),
88 . xgxa2(mvsiz),xgya2(mvsiz),xgza2(mvsiz),
89 . xgxya(mvsiz),xgyza(mvsiz),xgzxa(mvsiz),gama_r(nel,6)
90 INTEGER IXS(NIXS,*), MXT(*), NGL(*),NGEO(*),IPARG(*),
91 . NC1(*),NC2(*),NC3(*),NC4(*),NC5(*),NC6(*),NC7(*),NC8(*)
92 INTEGER IOUTPRT
93
94 DOUBLE PRECISION
95 . XDP(3,*),X0(MVSIZ,8),Y0(MVSIZ,8),Z0(MVSIZ,8),SAV(NEL,21),
96 . XD1(*), XD2(*), XD3(*), XD4(*), XD5(*), XD6(*), XD7(*), XD8(*),
97 . YD1(*), YD2(*), YD3(*), YD4(*), YD5(*), YD6(*), YD7(*), YD8(*),
98 . ZD1(*), ZD2(*), ZD3(*), ZD4(*), ZD5(*), ZD6(*), ZD7(*), ZD8(*)
99C-----------------------------------------------
100C L o c a l V a r i a b l e s
101C-----------------------------------------------
102 INTEGER I
103
104 DOUBLE PRECISION
105 . xdl, ydl, zdl
106
107C REAL
108 my_real
109 . dt05
110 my_real
111 . g11,g12,g13,
112 . g21,g22,g23,
113 . g31,g32,g33,
114 . t11,t12,t13,
115 . t21,t22,t23,
116 . t31,t32,t33,
117 . rx(mvsiz) , ry(mvsiz) , rz(mvsiz) ,
118 . sx(mvsiz) , sy(mvsiz) , sz(mvsiz) ,
119 . tx(mvsiz) , ty(mvsiz) , tz(mvsiz)
120 my_real
121 . xl(mvsiz),yl(mvsiz),zl(mvsiz)
122 my_real
123 . off_l
124C=======================================================================
125 off_l = zero
126C
127 DO i=lft,llt
128 vis(i)=zero
129 ngeo(i)=ixs(10,i)
130 ngl(i)=ixs(11,i)
131 mxt(i)=ixs(1,i)
132 nc1(i)=ixs(2,i)
133 nc2(i)=ixs(3,i)
134 nc3(i)=ixs(4,i)
135 nc4(i)=ixs(5,i)
136 nc5(i)=ixs(6,i)
137 nc6(i)=ixs(7,i)
138 nc7(i)=ixs(8,i)
139 nc8(i)=ixs(9,i)
140 rhoo(i)=rho(i)
141 ENDDO
142C----------------------------
143C NODAL COORDINATES |
144C----------------------------
145 IF(iresp==1)THEN
146 DO i=lft,llt
147 xd1(i)=xdp(1,nc1(i))
148 yd1(i)=xdp(2,nc1(i))
149 zd1(i)=xdp(3,nc1(i))
150 xd2(i)=xdp(1,nc2(i))
151 yd2(i)=xdp(2,nc2(i))
152 zd2(i)=xdp(3,nc2(i))
153 xd3(i)=xdp(1,nc3(i))
154 yd3(i)=xdp(2,nc3(i))
155 zd3(i)=xdp(3,nc3(i))
156 xd4(i)=xdp(1,nc4(i))
157 yd4(i)=xdp(2,nc4(i))
158 zd4(i)=xdp(3,nc4(i))
159 xd5(i)=xdp(1,nc5(i))
160 yd5(i)=xdp(2,nc5(i))
161 zd5(i)=xdp(3,nc5(i))
162 xd6(i)=xdp(1,nc6(i))
163 yd6(i)=xdp(2,nc6(i))
164 zd6(i)=xdp(3,nc6(i))
165 xd7(i)=xdp(1,nc7(i))
166 yd7(i)=xdp(2,nc7(i))
167 zd7(i)=xdp(3,nc7(i))
168 xd8(i)=xdp(1,nc8(i))
169 yd8(i)=xdp(2,nc8(i))
170 zd8(i)=xdp(3,nc8(i))
171 ENDDO
172 ELSE
173 DO i=lft,llt
174 xd1(i)=x(1,nc1(i))
175 yd1(i)=x(2,nc1(i))
176 zd1(i)=x(3,nc1(i))
177 xd2(i)=x(1,nc2(i))
178 yd2(i)=x(2,nc2(i))
179 zd2(i)=x(3,nc2(i))
180 xd3(i)=x(1,nc3(i))
181 yd3(i)=x(2,nc3(i))
182 zd3(i)=x(3,nc3(i))
183 xd4(i)=x(1,nc4(i))
184 yd4(i)=x(2,nc4(i))
185 zd4(i)=x(3,nc4(i))
186 xd5(i)=x(1,nc5(i))
187 yd5(i)=x(2,nc5(i))
188 zd5(i)=x(3,nc5(i))
189 xd6(i)=x(1,nc6(i))
190 yd6(i)=x(2,nc6(i))
191 zd6(i)=x(3,nc6(i))
192 xd7(i)=x(1,nc7(i))
193 yd7(i)=x(2,nc7(i))
194 zd7(i)=x(3,nc7(i))
195 xd8(i)=x(1,nc8(i))
196 yd8(i)=x(2,nc8(i))
197 zd8(i)=x(3,nc8(i))
198 ENDDO
199 ENDIF
200C-----------
201 DO i=lft,llt
202 vx1(i)=v(1,nc1(i))
203 vy1(i)=v(2,nc1(i))
204 vz1(i)=v(3,nc1(i))
205 vx2(i)=v(1,nc2(i))
206 vy2(i)=v(2,nc2(i))
207 vz2(i)=v(3,nc2(i))
208 vx3(i)=v(1,nc3(i))
209 vy3(i)=v(2,nc3(i))
210 vz3(i)=v(3,nc3(i))
211 vx4(i)=v(1,nc4(i))
212 vy4(i)=v(2,nc4(i))
213 vz4(i)=v(3,nc4(i))
214 vx5(i)=v(1,nc5(i))
215 vy5(i)=v(2,nc5(i))
216 vz5(i)=v(3,nc5(i))
217 vx6(i)=v(1,nc6(i))
218 vy6(i)=v(2,nc6(i))
219 vz6(i)=v(3,nc6(i))
220 vx7(i)=v(1,nc7(i))
221 vy7(i)=v(2,nc7(i))
222 vz7(i)=v(3,nc7(i))
223 vx8(i)=v(1,nc8(i))
224 vy8(i)=v(2,nc8(i))
225 vz8(i)=v(3,nc8(i))
226 ENDDO
227C-----------
228C Prepare les sorties par part.
229C-----------
230 IF (ioutprt /= 0) THEN
231 DO i=lft,llt
232 vgax(i)=vx1(i)+vx2(i)+vx3(i)+vx4(i)+vx5(i)+vx6(i)+vx7(i)+vx8(i)
233 vgay(i)=vy1(i)+vy2(i)+vy3(i)+vy4(i)+vy5(i)+vy6(i)+vy7(i)+vy8(i)
234 vgaz(i)=vz1(i)+vz2(i)+vz3(i)+vz4(i)+vz5(i)+vz6(i)+vz7(i)+vz8(i)
235 vga2(i)=vx1(i)*vx1(i)+vx2(i)*vx2(i)+vx3(i)*vx3(i)+vx4(i)*vx4(i)
236 1 +vx5(i)*vx5(i)+vx6(i)*vx6(i)+vx7(i)*vx7(i)+vx8(i)*vx8(i)
237 2 +vy1(i)*vy1(i)+vy2(i)*vy2(i)+vy3(i)*vy3(i)+vy4(i)*vy4(i)
238 3 +vy5(i)*vy5(i)+vy6(i)*vy6(i)+vy7(i)*vy7(i)+vy8(i)*vy8(i)
239 4 +vz1(i)*vz1(i)+vz2(i)*vz2(i)+vz3(i)*vz3(i)+vz4(i)*vz4(i)
240 5 +vz5(i)*vz5(i)+vz6(i)*vz6(i)+vz7(i)*vz7(i)+vz8(i)*vz8(i)
241 ENDDO
242 IF(iparg(80)==1) THEN
243 DO i=lft,llt
244 xgax(i)=xd1(i)+xd2(i)+xd3(i)+xd4(i)+xd5(i)+xd6(i)+xd7(i)+xd8(i)
245 xgay(i)=yd1(i)+yd2(i)+yd3(i)+yd4(i)+yd5(i)+yd6(i)+yd7(i)+yd8(i)
246 xgaz(i)=zd1(i)+zd2(i)+zd3(i)+zd4(i)+zd5(i)+zd6(i)+zd7(i)+zd8(i)
247 xgxa2(i)=xd1(i)**2+xd2(i)**2+xd3(i)**2+xd4(i)**2
248 1 +xd5(i)**2+xd6(i)**2+xd7(i)**2+xd8(i)**2
249 xgya2(i)=yd1(i)**2+yd2(i)**2+yd3(i)**2+yd4(i)**2
250 1 +yd5(i)**2+yd6(i)**2+yd7(i)**2+yd8(i)**2
251 xgza2(i)=zd1(i)**2+zd2(i)**2+zd3(i)**2+zd4(i)**2
252 1 +zd5(i)**2+zd6(i)**2+zd7(i)**2+zd8(i)**2
253 xgxya(i)=xd1(i)*yd1(i)+xd2(i)*yd2(i)+xd3(i)*yd3(i)+xd4(i)*yd4(i)
254 1 +xd5(i)*yd5(i)+xd6(i)*yd6(i)+xd7(i)*yd7(i)+xd8(i)*yd8(i)
255 xgyza(i)=yd1(i)*zd1(i)+yd2(i)*zd2(i)+yd3(i)*zd3(i)+yd4(i)*zd4(i)
256 1 +yd5(i)*zd5(i)+yd6(i)*zd6(i)+yd7(i)*zd7(i)+yd8(i)*zd8(i)
257 xgzxa(i)=zd1(i)*xd1(i)+zd2(i)*xd2(i)+zd3(i)*xd3(i)+zd4(i)*xd4(i)
258 1 +zd5(i)*xd5(i)+zd6(i)*xd6(i)+zd7(i)*xd7(i)+zd8(i)*xd8(i)
259 ENDDO
260 ENDIF
261 ENDIF
262C-----------
263C REPERE CONVECTE (ITERATIONS).
264C-----------
265 CALL srepiso3(
266 1 xd1, xd2, xd3, xd4,
267 2 xd5, xd6, xd7, xd8,
268 3 yd1, yd2, yd3, yd4,
269 4 yd5, yd6, yd7, yd8,
270 5 zd1, zd2, zd3, zd4,
271 6 zd5, zd6, zd7, zd8,
272 7 rx, ry, rz, sx,
273 8 sy, sz, tx, ty,
274 9 tz, nel)
275C---
276 IF (jhbe == 14 .OR. jhbe == 24) THEN
277 CALL sortho3(
278 1 rx, ry, rz, sx,
279 2 sy, sz, tx, ty,
280 3 tz, r12, r13, r11,
281 4 r22, r23, r21, r32,
282 5 r33, r31, nel)
283 ELSEIF (jhbe == 15 ) THEN
284 CALL scortho3(
285 1 rx, ry, rz, sx,
286 2 sy, sz, tx, ty,
287 3 tz, r11, r12, r13,
288 4 r21, r22, r23, r31,
289 5 r32, r33, nel)
290 ELSE
291 CALL sortho3(
292 1 rx, ry, rz, sx,
293 2 sy, sz, tx, ty,
294 3 tz, r11, r12, r13,
295 4 r21, r22, r23, r31,
296 5 r32, r33, nel)
297 ENDIF
298C------stocker [R] in %GAMA_R--------------
299 gama_r(lft:llt,1) = r11(lft:llt) ! Dir1_x
300 gama_r(lft:llt,2) = r21(lft:llt) ! Dir1_y
301 gama_r(lft:llt,3) = r31(lft:llt) ! Dir1_z
302 gama_r(lft:llt,4) = r12(lft:llt) ! Dir2_x
303 gama_r(lft:llt,5) = r22(lft:llt) ! Dir2_y
304 gama_r(lft:llt,6) = r32(lft:llt) ! Dir2_z
305C-------sauf thick shells --------------
306 IF (igtyp /= 21 .AND. igtyp /= 22) THEN
307 IF (isorth == 0) THEN
308 DO i=lft,llt
309 gama(i,1) = one
310 gama(i,2) = zero
311 gama(i,3) = zero
312 gama(i,4) = zero
313 gama(i,5) = one
314 gama(i,6) = zero
315 ENDDO
316 ELSE
317 CALL sorthdir3(
318 1 rx, ry, rz, sx,
319 2 sy, sz, tx, ty,
320 3 tz, r11, r12, r13,
321 4 r21, r22, r23, r31,
322 5 r32, r33, gama0, gama,
323 6 nel, irep)
324 ENDIF
325 ENDIF
326C-----------
327C PASSAGE AU REPERE CONVECTE.
328C-----------
329C X=RX' <=> X'=t(R)X chgt de base.
330 IF((ismstr<=4.OR.(ismstr==12.AND.idtmin(1)==3)).AND.jlag>0) THEN
331 DO i=lft,llt
332 IF(abs(offg(i)) > one)THEN
333 xd1(i)=sav(i,1)
334 yd1(i)=sav(i,2)
335 zd1(i)=sav(i,3)
336 xd2(i)=sav(i,4)
337 yd2(i)=sav(i,5)
338 zd2(i)=sav(i,6)
339 xd3(i)=sav(i,7)
340 yd3(i)=sav(i,8)
341 zd3(i)=sav(i,9)
342 xd4(i)=sav(i,10)
343 yd4(i)=sav(i,11)
344 zd4(i)=sav(i,12)
345 xd5(i)=sav(i,13)
346 yd5(i)=sav(i,14)
347 zd5(i)=sav(i,15)
348 xd6(i)=sav(i,16)
349 yd6(i)=sav(i,17)
350 zd6(i)=sav(i,18)
351 xd7(i)=sav(i,19)
352 yd7(i)=sav(i,20)
353 zd7(i)=sav(i,21)
354 xd8(i)=zero
355 yd8(i)=zero
356 zd8(i)=zero
357 off(i) = abs(offg(i))-one
358 off_l = min(off_l,offg(i))
359 ELSE
360 xdl=r11(i)*xd1(i)+r21(i)*yd1(i)+r31(i)*zd1(i)
361 ydl=r12(i)*xd1(i)+r22(i)*yd1(i)+r32(i)*zd1(i)
362 zdl=r13(i)*xd1(i)+r23(i)*yd1(i)+r33(i)*zd1(i)
363 xd1(i)=xdl
364 yd1(i)=ydl
365 zd1(i)=zdl
366 xdl=r11(i)*xd2(i)+r21(i)*yd2(i)+r31(i)*zd2(i)
367 ydl=r12(i)*xd2(i)+r22(i)*yd2(i)+r32(i)*zd2(i)
368 zdl=r13(i)*xd2(i)+r23(i)*yd2(i)+r33(i)*zd2(i)
369 xd2(i)=xdl
370 yd2(i)=ydl
371 zd2(i)=zdl
372 xdl=r11(i)*xd3(i)+r21(i)*yd3(i)+r31(i)*zd3(i)
373 ydl=r12(i)*xd3(i)+r22(i)*yd3(i)+r32(i)*zd3(i)
374 zdl=r13(i)*xd3(i)+r23(i)*yd3(i)+r33(i)*zd3(i)
375 xd3(i)=xdl
376 yd3(i)=ydl
377 zd3(i)=zdl
378 xdl=r11(i)*xd4(i)+r21(i)*yd4(i)+r31(i)*zd4(i)
379 ydl=r12(i)*xd4(i)+r22(i)*yd4(i)+r32(i)*zd4(i)
380 zdl=r13(i)*xd4(i)+r23(i)*yd4(i)+r33(i)*zd4(i)
381 xd4(i)=xdl
382 yd4(i)=ydl
383 zd4(i)=zdl
384 xdl=r11(i)*xd5(i)+r21(i)*yd5(i)+r31(i)*zd5(i)
385 ydl=r12(i)*xd5(i)+r22(i)*yd5(i)+r32(i)*zd5(i)
386 zdl=r13(i)*xd5(i)+r23(i)*yd5(i)+r33(i)*zd5(i)
387 xd5(i)=xdl
388 yd5(i)=ydl
389 zd5(i)=zdl
390 xdl=r11(i)*xd6(i)+r21(i)*yd6(i)+r31(i)*zd6(i)
391 ydl=r12(i)*xd6(i)+r22(i)*yd6(i)+r32(i)*zd6(i)
392 zdl=r13(i)*xd6(i)+r23(i)*yd6(i)+r33(i)*zd6(i)
393 xd6(i)=xdl
394 yd6(i)=ydl
395 zd6(i)=zdl
396 xdl=r11(i)*xd7(i)+r21(i)*yd7(i)+r31(i)*zd7(i)
397 ydl=r12(i)*xd7(i)+r22(i)*yd7(i)+r32(i)*zd7(i)
398 zdl=r13(i)*xd7(i)+r23(i)*yd7(i)+r33(i)*zd7(i)
399 xd7(i)=xdl
400 yd7(i)=ydl
401 zd7(i)=zdl
402 xdl=r11(i)*xd8(i)+r21(i)*yd8(i)+r31(i)*zd8(i)
403 ydl=r12(i)*xd8(i)+r22(i)*yd8(i)+r32(i)*zd8(i)
404 zdl=r13(i)*xd8(i)+r23(i)*yd8(i)+r33(i)*zd8(i)
405 xd8(i)=xdl
406 yd8(i)=ydl
407 zd8(i)=zdl
408 off(i) = abs(offg(i))
409 off_l = min(off_l,offg(i))
410 ENDIF
411 ENDDO
412 IF((ismstr==12.AND.idtmin(1)==3).AND.jlag>0) THEN
413 DO i=lft,llt
414 IF(abs(offg(i)) > one)THEN
415 xdl=r11(i)*xd1(i)+r21(i)*yd1(i)+r31(i)*zd1(i)
416 ydl=r12(i)*xd1(i)+r22(i)*yd1(i)+r32(i)*zd1(i)
417 zdl=r13(i)*xd1(i)+r23(i)*yd1(i)+r33(i)*zd1(i)
418 xd1(i)=xdl
419 yd1(i)=ydl
420 zd1(i)=zdl
421 xdl=r11(i)*xd2(i)+r21(i)*yd2(i)+r31(i)*zd2(i)
422 ydl=r12(i)*xd2(i)+r22(i)*yd2(i)+r32(i)*zd2(i)
423 zdl=r13(i)*xd2(i)+r23(i)*yd2(i)+r33(i)*zd2(i)
424 xd2(i)=xdl
425 yd2(i)=ydl
426 zd2(i)=zdl
427 xdl=r11(i)*xd3(i)+r21(i)*yd3(i)+r31(i)*zd3(i)
428 ydl=r12(i)*xd3(i)+r22(i)*yd3(i)+r32(i)*zd3(i)
429 zdl=r13(i)*xd3(i)+r23(i)*yd3(i)+r33(i)*zd3(i)
430 xd3(i)=xdl
431 yd3(i)=ydl
432 zd3(i)=zdl
433 xdl=r11(i)*xd4(i)+r21(i)*yd4(i)+r31(i)*zd4(i)
434 ydl=r12(i)*xd4(i)+r22(i)*yd4(i)+r32(i)*zd4(i)
435 zdl=r13(i)*xd4(i)+r23(i)*yd4(i)+r33(i)*zd4(i)
436 xd4(i)=xdl
437 yd4(i)=ydl
438 zd4(i)=zdl
439 xdl=r11(i)*xd5(i)+r21(i)*yd5(i)+r31(i)*zd5(i)
440 ydl=r12(i)*xd5(i)+r22(i)*yd5(i)+r32(i)*zd5(i)
441 zdl=r13(i)*xd5(i)+r23(i)*yd5(i)+r33(i)*zd5(i)
442 xd5(i)=xdl
443 yd5(i)=ydl
444 zd5(i)=zdl
445 xdl=r11(i)*xd6(i)+r21(i)*yd6(i)+r31(i)*zd6(i)
446 ydl=r12(i)*xd6(i)+r22(i)*yd6(i)+r32(i)*zd6(i)
447 zdl=r13(i)*xd6(i)+r23(i)*yd6(i)+r33(i)*zd6(i)
448 xd6(i)=xdl
449 yd6(i)=ydl
450 zd6(i)=zdl
451 xdl=r11(i)*xd7(i)+r21(i)*yd7(i)+r31(i)*zd7(i)
452 ydl=r12(i)*xd7(i)+r22(i)*yd7(i)+r32(i)*zd7(i)
453 zdl=r13(i)*xd7(i)+r23(i)*yd7(i)+r33(i)*zd7(i)
454 xd7(i)=xdl
455 yd7(i)=ydl
456 zd7(i)=zdl
457 xdl=r11(i)*xd8(i)+r21(i)*yd8(i)+r31(i)*zd8(i)
458 ydl=r12(i)*xd8(i)+r22(i)*yd8(i)+r32(i)*zd8(i)
459 zdl=r13(i)*xd8(i)+r23(i)*yd8(i)+r33(i)*zd8(i)
460 xd8(i)=xdl
461 yd8(i)=ydl
462 zd8(i)=zdl
463 END IF
464 ENDDO
465 END IF
466C
467 ELSE ! Ismstr = 4
468 DO i=lft,llt
469 xdl=r11(i)*xd1(i)+r21(i)*yd1(i)+r31(i)*zd1(i)
470 ydl=r12(i)*xd1(i)+r22(i)*yd1(i)+r32(i)*zd1(i)
471 zdl=r13(i)*xd1(i)+r23(i)*yd1(i)+r33(i)*zd1(i)
472 xd1(i)=xdl
473 yd1(i)=ydl
474 zd1(i)=zdl
475 xdl=r11(i)*xd2(i)+r21(i)*yd2(i)+r31(i)*zd2(i)
476 ydl=r12(i)*xd2(i)+r22(i)*yd2(i)+r32(i)*zd2(i)
477 zdl=r13(i)*xd2(i)+r23(i)*yd2(i)+r33(i)*zd2(i)
478 xd2(i)=xdl
479 yd2(i)=ydl
480 zd2(i)=zdl
481 xdl=r11(i)*xd3(i)+r21(i)*yd3(i)+r31(i)*zd3(i)
482 ydl=r12(i)*xd3(i)+r22(i)*yd3(i)+r32(i)*zd3(i)
483 zdl=r13(i)*xd3(i)+r23(i)*yd3(i)+r33(i)*zd3(i)
484 xd3(i)=xdl
485 yd3(i)=ydl
486 zd3(i)=zdl
487 xdl=r11(i)*xd4(i)+r21(i)*yd4(i)+r31(i)*zd4(i)
488 ydl=r12(i)*xd4(i)+r22(i)*yd4(i)+r32(i)*zd4(i)
489 zdl=r13(i)*xd4(i)+r23(i)*yd4(i)+r33(i)*zd4(i)
490 xd4(i)=xdl
491 yd4(i)=ydl
492 zd4(i)=zdl
493 xdl=r11(i)*xd5(i)+r21(i)*yd5(i)+r31(i)*zd5(i)
494 ydl=r12(i)*xd5(i)+r22(i)*yd5(i)+r32(i)*zd5(i)
495 zdl=r13(i)*xd5(i)+r23(i)*yd5(i)+r33(i)*zd5(i)
496 xd5(i)=xdl
497 yd5(i)=ydl
498 zd5(i)=zdl
499 xdl=r11(i)*xd6(i)+r21(i)*yd6(i)+r31(i)*zd6(i)
500 ydl=r12(i)*xd6(i)+r22(i)*yd6(i)+r32(i)*zd6(i)
501 zdl=r13(i)*xd6(i)+r23(i)*yd6(i)+r33(i)*zd6(i)
502 xd6(i)=xdl
503 yd6(i)=ydl
504 zd6(i)=zdl
505 xdl=r11(i)*xd7(i)+r21(i)*yd7(i)+r31(i)*zd7(i)
506 ydl=r12(i)*xd7(i)+r22(i)*yd7(i)+r32(i)*zd7(i)
507 zdl=r13(i)*xd7(i)+r23(i)*yd7(i)+r33(i)*zd7(i)
508 xd7(i)=xdl
509 yd7(i)=ydl
510 zd7(i)=zdl
511 xdl=r11(i)*xd8(i)+r21(i)*yd8(i)+r31(i)*zd8(i)
512 ydl=r12(i)*xd8(i)+r22(i)*yd8(i)+r32(i)*zd8(i)
513 zdl=r13(i)*xd8(i)+r23(i)*yd8(i)+r33(i)*zd8(i)
514 xd8(i)=xdl
515 yd8(i)=ydl
516 zd8(i)=zdl
517 off(i) = abs(offg(i))
518 off_l = min(off_l,offg(i))
519 ENDDO
520C
521 ENDIF ! ISMSTR
522C-----------
523C PASSAGE AU REPERE ORTHOTROPE.
524C-----------
525 IF (isorth/=0 .AND. jhbe/=24 .AND. jhbe/=222 .AND. jhbe/=14
526 . .AND. jhbe/=15) THEN
527C------save for SAV update
528 IF(ismstr <= 3) THEN
529 DO i=lft,llt
530 x0(i,1) = xd1(i)
531 y0(i,1) = yd1(i)
532 z0(i,1) = zd1(i)
533 x0(i,2) = xd2(i)
534 y0(i,2) = yd2(i)
535 z0(i,2) = zd2(i)
536 x0(i,3) = xd3(i)
537 y0(i,3) = yd3(i)
538 z0(i,3) = zd3(i)
539 x0(i,4) = xd4(i)
540 y0(i,4) = yd4(i)
541 z0(i,4) = zd4(i)
542 x0(i,5) = xd5(i)
543 y0(i,5) = yd5(i)
544 z0(i,5) = zd5(i)
545 x0(i,6) = xd6(i)
546 y0(i,6) = yd6(i)
547 z0(i,6) = zd6(i)
548 x0(i,7) = xd7(i)
549 y0(i,7) = yd7(i)
550 z0(i,7) = zd7(i)
551 x0(i,8) = xd8(i)
552 y0(i,8) = yd8(i)
553 z0(i,8) = zd8(i)
554 END DO
555 END IF
556C
557 DO i=lft,llt
558C Extration de G tq Xortho=Transpose(G) Xcvt
559C =Transpose(G) Transpose(R) Xglobal.
560 g11=gama(i,1)
561 g21=gama(i,2)
562 g31=gama(i,3)
563 g12=gama(i,4)
564 g22=gama(i,5)
565 g32=gama(i,6)
566 g13=g21*g32-g31*g22
567 g23=g31*g12-g11*g32
568 g33=g11*g22-g21*g12
569C
570 xdl=g11*xd1(i)+g21*yd1(i)+g31*zd1(i)
571 ydl=g12*xd1(i)+g22*yd1(i)+g32*zd1(i)
572 zdl=g13*xd1(i)+g23*yd1(i)+g33*zd1(i)
573 xd1(i)=xdl
574 yd1(i)=ydl
575 zd1(i)=zdl
576 xdl=g11*xd2(i)+g21*yd2(i)+g31*zd2(i)
577 ydl=g12*xd2(i)+g22*yd2(i)+g32*zd2(i)
578 zdl=g13*xd2(i)+g23*yd2(i)+g33*zd2(i)
579 xd2(i)=xdl
580 yd2(i)=ydl
581 zd2(i)=zdl
582 xdl=g11*xd3(i)+g21*yd3(i)+g31*zd3(i)
583 ydl=g12*xd3(i)+g22*yd3(i)+g32*zd3(i)
584 zdl=g13*xd3(i)+g23*yd3(i)+g33*zd3(i)
585 xd3(i)=xdl
586 yd3(i)=ydl
587 zd3(i)=zdl
588 xdl=g11*xd4(i)+g21*yd4(i)+g31*zd4(i)
589 ydl=g12*xd4(i)+g22*yd4(i)+g32*zd4(i)
590 zdl=g13*xd4(i)+g23*yd4(i)+g33*zd4(i)
591 xd4(i)=xdl
592 yd4(i)=ydl
593 zd4(i)=zdl
594 xdl=g11*xd5(i)+g21*yd5(i)+g31*zd5(i)
595 ydl=g12*xd5(i)+g22*yd5(i)+g32*zd5(i)
596 zdl=g13*xd5(i)+g23*yd5(i)+g33*zd5(i)
597 xd5(i)=xdl
598 yd5(i)=ydl
599 zd5(i)=zdl
600 xdl=g11*xd6(i)+g21*yd6(i)+g31*zd6(i)
601 ydl=g12*xd6(i)+g22*yd6(i)+g32*zd6(i)
602 zdl=g13*xd6(i)+g23*yd6(i)+g33*zd6(i)
603 xd6(i)=xdl
604 yd6(i)=ydl
605 zd6(i)=zdl
606 xdl=g11*xd7(i)+g21*yd7(i)+g31*zd7(i)
607 ydl=g12*xd7(i)+g22*yd7(i)+g32*zd7(i)
608 zdl=g13*xd7(i)+g23*yd7(i)+g33*zd7(i)
609 xd7(i)=xdl
610 yd7(i)=ydl
611 zd7(i)=zdl
612 xdl=g11*xd8(i)+g21*yd8(i)+g31*zd8(i)
613 ydl=g12*xd8(i)+g22*yd8(i)+g32*zd8(i)
614 zdl=g13*xd8(i)+g23*yd8(i)+g33*zd8(i)
615 xd8(i)=xdl
616 yd8(i)=ydl
617 zd8(i)=zdl
618C MATRICE DE PASSAGE GLOBAL -> ORTHOTROPE.
619 t11=r11(i)*g11+r12(i)*g21+r13(i)*g31
620 t12=r11(i)*g12+r12(i)*g22+r13(i)*g32
621 t13=r11(i)*g13+r12(i)*g23+r13(i)*g33
622 t21=r21(i)*g11+r22(i)*g21+r23(i)*g31
623 t22=r21(i)*g12+r22(i)*g22+r23(i)*g32
624 t23=r21(i)*g13+r22(i)*g23+r23(i)*g33
625 t31=r31(i)*g11+r32(i)*g21+r33(i)*g31
626 t32=r31(i)*g12+r32(i)*g22+r33(i)*g32
627 t33=r31(i)*g13+r32(i)*g23+r33(i)*g33
628 r11(i)=t11
629 r12(i)=t12
630 r13(i)=t13
631 r21(i)=t21
632 r22(i)=t22
633 r23(i)=t23
634 r31(i)=t31
635 r32(i)=t32
636 r33(i)=t33
637 ENDDO
638 ENDIF
639
640c copy and cast XD (DP) to C(SP) to assure coherence between XD et X
641 DO i=lft,llt
642 x1(i)= xd1(i)
643 y1(i)= yd1(i)
644 z1(i)= zd1(i)
645 x2(i)= xd2(i)
646 y2(i)= yd2(i)
647 z2(i)= zd2(i)
648 x3(i)= xd3(i)
649 y3(i)= yd3(i)
650 z3(i)= zd3(i)
651 x4(i)= xd4(i)
652 y4(i)= yd4(i)
653 z4(i)= zd4(i)
654 x5(i)= xd5(i)
655 y5(i)= yd5(i)
656 z5(i)= zd5(i)
657 x6(i)= xd6(i)
658 y6(i)= yd6(i)
659 z6(i)= zd6(i)
660 x7(i)= xd7(i)
661 y7(i)= yd7(i)
662 z7(i)= zd7(i)
663 x8(i)= xd8(i)
664 y8(i)= yd8(i)
665 z8(i)= zd8(i)
666 ENDDO
667C-----------
668C PASSAGE DES VITESSES AU REPERE CONVECTE (OU ORTHOTROPE).
669C-----------
670 CALL srrota3(
671 1 r11, r12, r13, r21,
672 2 r22, r23, r31, r32,
673 3 r33, vx1, vx2, vx3,
674 4 vx4, vx5, vx6, vx7,
675 5 vx8, vy1, vy2, vy3,
676 6 vy4, vy5, vy6, vy7,
677 7 vy8, vz1, vz2, vz3,
678 8 vz4, vz5, vz6, vz7,
679 9 vz8, nel)
680
681
682
683
684 IF(off_l < zero)THEN
685 DO i=lft,llt
686 IF(offg(i) < zero)THEN
687 vx1(i)=zero
688 vy1(i)=zero
689 vz1(i)=zero
690 vx2(i)=zero
691 vy2(i)=zero
692 vz2(i)=zero
693 vx3(i)=zero
694 vy3(i)=zero
695 vz3(i)=zero
696 vx4(i)=zero
697 vy4(i)=zero
698 vz4(i)=zero
699 vx5(i)=zero
700 vy5(i)=zero
701 vz5(i)=zero
702 vx6(i)=zero
703 vy6(i)=zero
704 vz6(i)=zero
705 vx7(i)=zero
706 vy7(i)=zero
707 vz7(i)=zero
708 vx8(i)=zero
709 vy8(i)=zero
710 vz8(i)=zero
711 ENDIF
712 ENDDO
713 ENDIF
714C-----------
715 DO i=lft,llt
716 vd2(i)=zero
717 ENDDO
718C-----------
719 RETURN
720 END
srcoor3
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)
Definition srcoor3.F:55
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:42
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