OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
srcoor3_imp.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_imp ../engine/source/elements/solid/solide8s/srcoor3_imp.F
25!||--- called by ------------------------------------------------------
26!|| s8sforc3 ../engine/source/elements/solid/solide8s/s8sforc3.F
27!||--- calls -----------------------------------------------------
28!|| crframe_imp ../engine/source/elements/solid/solide8s/crframe_imp.F
29!|| crtrans_imp ../engine/source/elements/solid/solide8s/crtrans_imp.F
30!|| getuloc ../engine/source/elements/solid/solide8s/getuloc.F
31!|| s8sav3_imp ../engine/source/elements/solid/solide8s/s8sav3_imp.F
32!|| s8xref_imp ../engine/source/elements/solid/solide8s/s8xref_imp.F
33!||====================================================================
34 SUBROUTINE srcoor3_imp(X ,IXS ,V ,W ,GAMA0 ,GAMA ,
35 . X1 ,X2 ,X3 ,X4 ,X5 ,X6 ,X7 ,X8 ,
36 . Y1 ,Y2 ,Y3 ,Y4 ,Y5 ,Y6 ,Y7 ,Y8 ,
37 . Z1 ,Z2 ,Z3 ,Z4 ,Z5 ,Z6 ,Z7 ,Z8 ,
38 . VX1 ,VX2 ,VX3 ,VX4 ,VX5 ,VX6 ,VX7 ,VX8 ,
39 . VY1 ,VY2 ,VY3 ,VY4 ,VY5 ,VY6 ,VY7 ,VY8 ,
40 . VZ1 ,VZ2 ,VZ3 ,VZ4 ,VZ5 ,VZ6 ,VZ7 ,VZ8 ,
41 . VD2 ,VIS ,OFFG ,OFF ,SAV ,RHO ,RHOO ,R ,
42 . NC1 ,NC2 ,NC3 ,NC4 ,NC5 ,NC6 ,NC7 ,NC8 ,
43 . NGL ,MXT ,NGEO ,IOUTPRT,VGAX ,VGAY ,VGAZ ,VGA2 ,
44 . XD1 ,XD2 ,XD3 ,XD4 ,XD5 ,XD6 ,XD7 ,XD8 ,
45 . YD1 ,YD2 ,YD3 ,YD4 ,YD5 ,YD6 ,YD7 ,YD8 ,
46 . ZD1 ,ZD2 ,ZD3 ,ZD4 ,ZD5 ,ZD6 ,ZD7 ,ZD8 ,
47 . XDP ,X0 ,Y0 ,Z0 ,NEL ,TRM ,XREF ,
48 . ULX1 ,ULX2 ,ULX3 ,ULX4 ,ULX5 ,ULX6 ,ULX7 ,ULX8 ,
49 . ULY1 ,ULY2 ,ULY3 ,ULY4 ,ULY5 ,ULY6 ,ULY7 ,ULY8 ,
50 . ULZ1 ,ULZ2 ,ULZ3 ,ULZ4 ,ULZ5 ,ULZ6 ,ULZ7 ,ULZ8 ,
51 . XGAX ,XGAY ,XGAZ ,XGXA2 ,XGYA2 ,XGZA2 ,XGXYA ,XGYZA ,
52 . XGZXA ,IPARG)
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C G l o b a l P a r a m e t e r s
59C-----------------------------------------------
60#include "mvsiz_p.inc"
61C-----------------------------------------------
62C C o m m o n B l o c k s
63C-----------------------------------------------
64#include "vect01_c.inc"
65#include "scr05_c.inc"
66#include "scr18_c.inc"
67#include "impl1_c.inc"
68#include "com08_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 . R(3,3,MVSIZ),
84!
85 . RD11(MVSIZ),RD12(MVSIZ),RD13(MVSIZ),
86 . RD21(MVSIZ),RD22(MVSIZ),RD23(MVSIZ),
87 . RD31(MVSIZ),RD32(MVSIZ),RD33(MVSIZ),
88 . RR11,RR12,RR13,
89 . RR21,RR22,RR23,
90 . rr31,rr32,rr33,
91
92 . gama0(nel,6),gama(mvsiz,6) ,vgax(*), vgay(*), vgaz(*), vga2(*),
93 . xgax(*), xgay(*), xgaz(*),
94 . xgxa2(mvsiz),xgya2(mvsiz),xgza2(mvsiz),
95 . xgxya(mvsiz),xgyza(mvsiz),xgzxa(mvsiz)
96 INTEGER IXS(NIXS,*), MXT(*), NGL(*),NGEO(*),IPARG(*),
97 . NC1(*),NC2(*),NC3(*),NC4(*),NC5(*),NC6(*),NC7(*),NC8(*)
98 INTEGER IOUTPRT
99
100 DOUBLE PRECISION
101 . XDP(3,*),SAV(NEL,21),X0(MVSIZ,8),Y0(MVSIZ,8),Z0(MVSIZ,8),
102 . XD1(MVSIZ), XD2(MVSIZ), XD3(MVSIZ), XD4(MVSIZ),
103 . XD5(MVSIZ), XD6(MVSIZ), XD7(MVSIZ), XD8(MVSIZ),
104 . YD1(MVSIZ), YD2(MVSIZ), YD3(MVSIZ), YD4(MVSIZ),
105 . YD5(MVSIZ), YD6(MVSIZ), YD7(MVSIZ), YD8(MVSIZ),
106 . ZD1(MVSIZ), ZD2(MVSIZ), ZD3(MVSIZ), ZD4(MVSIZ),
107 . ZD5(MVSIZ), ZD6(MVSIZ), ZD7(MVSIZ), ZD8(MVSIZ),
108 . ULX1(MVSIZ), ULX2(MVSIZ), ULX3(MVSIZ), ULX4(MVSIZ),
109 . ULX5(MVSIZ), ULX6(MVSIZ), ULX7(MVSIZ), ULX8(MVSIZ),
110 . ULY1(MVSIZ), ULY2(MVSIZ), ULY3(MVSIZ), ULY4(MVSIZ),
111 . ULY5(MVSIZ), ULY6(MVSIZ), ULY7(MVSIZ), ULY8(MVSIZ),
112 . ULZ1(MVSIZ), ULZ2(MVSIZ), ULZ3(MVSIZ), ULZ4(MVSIZ),
113 . ULZ5(MVSIZ), ULZ6(MVSIZ), ULZ7(MVSIZ), ULZ8(MVSIZ),
114 . trm(nel,24,24), ul, vl, wl, ug, vg, wg, xref(nel,21)
115C-----------------------------------------------
116C L o c a l V a r i a b l e s
117C-----------------------------------------------
118 INTEGER I,j
119
120 DOUBLE PRECISION
121 . XDL, YDL, ZDL, INVJ(MVSIZ,9),
122 . V1(MVSIZ,9), V2(MVSIZ,9), V3(MVSIZ,9), V4(MVSIZ,9),
123 . V5(MVSIZ,9), V6(MVSIZ,9), V7(MVSIZ,9), V8(MVSIZ,9)
124
125C REAL
126 my_real
127 . DT05
128 my_real
129 . G11,G12,G13,
130 . G21,G22,G23,
131 . G31,G32,G33,
132 . T11,T12,T13,
133 . T21,T22,T23,
134 . T31,T32,T33,
135 . RX(MVSIZ) , RY(MVSIZ) , RZ(MVSIZ) ,
136 . sx(mvsiz) , sy(mvsiz) , sz(mvsiz) ,
137 . tx(mvsiz) , ty(mvsiz) , tz(mvsiz)
138 my_real
139 . xl(mvsiz),yl(mvsiz),zl(mvsiz)
140 my_real
141 . off_l
142C=======================================================================
143C
144C
145 off_l = zero
146C
147 DO i=lft,llt
148 vis(i)=zero
149 ngeo(i)=ixs(10,i)
150 ngl(i)=ixs(11,i)
151 mxt(i)=ixs(1,i)
152 nc1(i)=ixs(2,i)
153 nc2(i)=ixs(3,i)
154 nc3(i)=ixs(4,i)
155 nc4(i)=ixs(5,i)
156 nc5(i)=ixs(6,i)
157 nc6(i)=ixs(7,i)
158 nc7(i)=ixs(8,i)
159 nc8(i)=ixs(9,i)
160 rhoo(i)=rho(i)
161 ENDDO
162C----------------------------
163C NODAL COORDINATES |
164C----------------------------
165 IF(iresp==1)THEN
166 DO i=lft,llt
167 xd1(i)=xdp(1,nc1(i))
168 yd1(i)=xdp(2,nc1(i))
169 zd1(i)=xdp(3,nc1(i))
170 xd2(i)=xdp(1,nc2(i))
171 yd2(i)=xdp(2,nc2(i))
172 zd2(i)=xdp(3,nc2(i))
173 xd3(i)=xdp(1,nc3(i))
174 yd3(i)=xdp(2,nc3(i))
175 zd3(i)=xdp(3,nc3(i))
176 xd4(i)=xdp(1,nc4(i))
177 yd4(i)=xdp(2,nc4(i))
178 zd4(i)=xdp(3,nc4(i))
179 xd5(i)=xdp(1,nc5(i))
180 yd5(i)=xdp(2,nc5(i))
181 zd5(i)=xdp(3,nc5(i))
182 xd6(i)=xdp(1,nc6(i))
183 yd6(i)=xdp(2,nc6(i))
184 zd6(i)=xdp(3,nc6(i))
185 xd7(i)=xdp(1,nc7(i))
186 yd7(i)=xdp(2,nc7(i))
187 zd7(i)=xdp(3,nc7(i))
188 xd8(i)=xdp(1,nc8(i))
189 yd8(i)=xdp(2,nc8(i))
190 zd8(i)=xdp(3,nc8(i))
191 ENDDO
192 ELSE
193 DO i=lft,llt
194 xd1(i)=x(1,nc1(i))
195 yd1(i)=x(2,nc1(i))
196 zd1(i)=x(3,nc1(i))
197 xd2(i)=x(1,nc2(i))
198 yd2(i)=x(2,nc2(i))
199 zd2(i)=x(3,nc2(i))
200 xd3(i)=x(1,nc3(i))
201 yd3(i)=x(2,nc3(i))
202 zd3(i)=x(3,nc3(i))
203 xd4(i)=x(1,nc4(i))
204 yd4(i)=x(2,nc4(i))
205 zd4(i)=x(3,nc4(i))
206 xd5(i)=x(1,nc5(i))
207 yd5(i)=x(2,nc5(i))
208 zd5(i)=x(3,nc5(i))
209 xd6(i)=x(1,nc6(i))
210 yd6(i)=x(2,nc6(i))
211 zd6(i)=x(3,nc6(i))
212 xd7(i)=x(1,nc7(i))
213 yd7(i)=x(2,nc7(i))
214 zd7(i)=x(3,nc7(i))
215 xd8(i)=x(1,nc8(i))
216 yd8(i)=x(2,nc8(i))
217 zd8(i)=x(3,nc8(i))
218 ENDDO
219 ENDIF
220C-----------
221 DO i=lft,llt
222 vx1(i)=v(1,nc1(i))
223 vy1(i)=v(2,nc1(i))
224 vz1(i)=v(3,nc1(i))
225 vx2(i)=v(1,nc2(i))
226 vy2(i)=v(2,nc2(i))
227 vz2(i)=v(3,nc2(i))
228 vx3(i)=v(1,nc3(i))
229 vy3(i)=v(2,nc3(i))
230 vz3(i)=v(3,nc3(i))
231 vx4(i)=v(1,nc4(i))
232 vy4(i)=v(2,nc4(i))
233 vz4(i)=v(3,nc4(i))
234 vx5(i)=v(1,nc5(i))
235 vy5(i)=v(2,nc5(i))
236 vz5(i)=v(3,nc5(i))
237 vx6(i)=v(1,nc6(i))
238 vy6(i)=v(2,nc6(i))
239 vz6(i)=v(3,nc6(i))
240 vx7(i)=v(1,nc7(i))
241 vy7(i)=v(2,nc7(i))
242 vz7(i)=v(3,nc7(i))
243 vx8(i)=v(1,nc8(i))
244 vy8(i)=v(2,nc8(i))
245 vz8(i)=v(3,nc8(i))
246 ENDDO
247C-----------
248C Prepare les sorties par part.
249C-----------
250 IF (ioutprt /= 0) THEN
251 DO i=lft,llt
252 vgax(i)=vx1(i)+vx2(i)+vx3(i)+vx4(i)+vx5(i)+vx6(i)+vx7(i)+vx8(i)
253 vgay(i)=vy1(i)+vy2(i)+vy3(i)+vy4(i)+vy5(i)+vy6(i)+vy7(i)+vy8(i)
254 vgaz(i)=vz1(i)+vz2(i)+vz3(i)+vz4(i)+vz5(i)+vz6(i)+vz7(i)+vz8(i)
255 vga2(i)=vx1(i)*vx1(i)+vx2(i)*vx2(i)+vx3(i)*vx3(i)+vx4(i)*vx4(i)
256 1 +vx5(i)*vx5(i)+vx6(i)*vx6(i)+vx7(i)*vx7(i)+vx8(i)*vx8(i)
257 2 +vy1(i)*vy1(i)+vy2(i)*vy2(i)+vy3(i)*vy3(i)+vy4(i)*vy4(i)
258 3 +vy5(i)*vy5(i)+vy6(i)*vy6(i)+vy7(i)*vy7(i)+vy8(i)*vy8(i)
259 4 +vz1(i)*vz1(i)+vz2(i)*vz2(i)+vz3(i)*vz3(i)+vz4(i)*vz4(i)
260 5 +vz5(i)*vz5(i)+vz6(i)*vz6(i)+vz7(i)*vz7(i)+vz8(i)*vz8(i)
261 ENDDO
262 IF(iparg(80)==1) THEN
263 DO i=lft,llt
264 xgax(i)=x1(i)+x2(i)+x3(i)+x4(i)+x5(i)+x6(i)+x7(i)+x8(i)
265 xgay(i)=y1(i)+y2(i)+y3(i)+y4(i)+y5(i)+y6(i)+y7(i)+y8(i)
266 xgaz(i)=z1(i)+z2(i)+z3(i)+z4(i)+z5(i)+z6(i)+z7(i)+z8(i)
267 xgxa2(i)=x1(i)**2+x2(i)**2+x3(i)**2+x4(i)**2
268 1 +x5(i)**2+x6(i)**2+x7(i)**2+x8(i)**2
269 xgya2(i)=y1(i)**2+y2(i)**2+y3(i)**2+y4(i)**2
270 1 +y5(i)**2+y6(i)**2+y7(i)**2+y8(i)**2
271 xgza2(i)=z1(i)**2+z2(i)**2+z3(i)**2+z4(i)**2
272 1 +z5(i)**2+z6(i)**2+z7(i)**2+z8(i)**2
273 xgxya(i)=x1(i)*y1(i)+x2(i)*y2(i)+x3(i)*y3(i)+x4(i)*y4(i)
274 1 +x5(i)*y5(i)+x6(i)*y6(i)+x7(i)*y7(i)+x8(i)*y8(i)
275 xgyza(i)=y1(i)*z1(i)+y2(i)*z2(i)+y3(i)*z3(i)+y4(i)*z4(i)
276 1 +y5(i)*z5(i)+y6(i)*z6(i)+y7(i)*z7(i)+y8(i)*z8(i)
277 xgzxa(i)=z1(i)*x1(i)+z2(i)*x2(i)+z3(i)*x3(i)+z4(i)*x4(i)
278 1 +z5(i)*x5(i)+z6(i)*x6(i)+z7(i)*x7(i)*z8(i)*x8(i)
279 ENDDO
280 ENDIF
281 ENDIF
282C
283 IF(inconv == 1) THEN ! Debut de pas
284c IF(IMCONV == 1) THEN ! Debut de pas
285 IF(ismstr == 1) THEN
286 DO i=lft,llt
287 IF (offg(i) >= 1 ) offg(i) = 1 ! A verifier avec qqun: Je ne suis pas sur de l'endroit ou offg doit etre maj
288 ENDDO
289 IF (dt1 == zero) THEN
290 CALL s8sav3_imp(
291 1 offg, sav, xd1, xd2,
292 2 xd3, xd4, xd5, xd6,
293 3 xd7, xd8, yd1, yd2,
294 4 yd3, yd4, yd5, yd6,
295 5 yd7, yd8, zd1, zd2,
296 6 zd3, zd4, zd5, zd6,
297 7 zd7, zd8, nel)
298 ENDIF
299 ELSE
300 CALL s8sav3_imp(
301 1 offg, sav, xd1, xd2,
302 2 xd3, xd4, xd5, xd6,
303 3 xd7, xd8, yd1, yd2,
304 4 yd3, yd4, yd5, yd6,
305 5 yd7, yd8, zd1, zd2,
306 6 zd3, zd4, zd5, zd6,
307 7 zd7, zd8, nel)
308 ENDIF !(ISMSTR == 1)
309 ENDIF !(INCONV == 1)
310! fin ajout qz
311C-----------
312C REPERE CONVECTE
313C-----------
314 IF((ismstr<=4.OR.(ismstr==12.AND.idtmin(1)==3)).AND.jlag>0) THEN
315 DO i=lft,llt
316 IF(abs(offg(i)) > one)THEN
317 off(i) = abs(offg(i))-one
318 off_l = min(off_l,offg(i))
319 ELSE
320 off(i) = abs(offg(i))
321 off_l = min(off_l,offg(i))
322 ENDIF
323 ENDDO
324 IF((ismstr==12.AND.idtmin(1)==3).AND.jlag>0) THEN
325 DO i=lft,llt
326 IF(abs(offg(i)) > one)THEN
327 END IF
328 ENDDO
329 END IF
330C
331 ELSE ! Ismstr = 4
332 DO i=lft,llt
333 off(i) = abs(offg(i))
334 off_l = min(off_l,offg(i))
335 ENDDO
336C
337 ENDIF ! ISMSTR
338
339 CALL crframe_imp(
340 1 sav, invj, xd1, xd2,
341 2 xd3, xd4, xd5, xd6,
342 3 xd7, xd8, yd1, yd2,
343 4 yd3, yd4, yd5, yd6,
344 5 yd7, yd8, zd1, zd2,
345 6 zd3, zd4, zd5, zd6,
346 7 zd7, zd8, r, nel)
347
348! !! POUR COMPARAISON AVEC LA FORMULATION CLASSIQUE RADIOSS
349! CALL SREPISO3(
350! . XD1, XD2, XD3, XD4, XD5, XD6, XD7, XD8,
351! . YD1, YD2, YD3, YD4, YD5, YD6, YD7, YD8,
352! . ZD1, ZD2, ZD3, ZD4, ZD5, ZD6, ZD7, ZD8,
353! . RX, RY, RZ, SX, SY, SZ, TX, TY, TZ )
354! CALL SORTHO3(
355! . RX , RY , RZ , SX , SY , SZ , TX , TY , TZ ,
356! . RD12, RD13, RD11, RD22, RD23, RD21, RD32, RD33, RD31) !isolid14
357!! . RD11, RD12, RD13, RD21, RD22, RD23, RD31, RD32, RD33) !isolid17
358!
359! !!DO I=LFT,LLT
360! I = LLT
361! RR11= R(1,1,I)*RD11(I)+R(2,1,I)*RD21(I)+R(3,1,I)*RD31(I)
362! RR12= R(1,2,I)*RD11(I)+R(2,2,I)*RD21(I)+R(3,2,I)*RD31(I)
363! RR13= R(1,3,I)*RD11(I)+R(2,3,I)*RD21(I)+R(3,3,I)*RD31(I)
364! RR21= R(1,1,I)*RD12(I)+R(2,1,I)*RD22(I)+R(3,1,I)*RD32(I)
365! RR22= R(1,2,I)*RD12(I)+R(2,2,I)*RD22(I)+R(3,2,I)*RD32(I)
366! rr23= r(1,3,i)*rd12(i)+r(2,3,i)*rd22(i)+r(3,3,i)*rd32(i)
367! RR31= R(1,1,I)*RD13(I)+R(2,1,I)*RD23(I)+R(3,1,I)*RD33(I)
368! RR32= R(1,2,I)*RD13(I)+R(2,2,I)*RD23(I)+R(3,2,I)*RD33(I)
369! RR33= R(1,3,I)*RD13(I)+R(2,3,I)*RD23(I)+R(3,3,I)*RD33(I)
370! print*,'REPERE Pour Fint: ',I
371! write(*,'(3(3(1X,1PE10.3),6X))')R(1,1,I),R(1,2,I),R(1,3,I),RD11(I),RD12(I),RD13(I),RR11,RR12,RR13
372! write(*,'(3(3(1X,1PE10.3),6X))')r(2,1,i),r(2,2,i),r(2,3,i),rd21(i),rd22(i),rd23(i),rr21,rr22,rr23
373! write(*,'(3(3(1X,1PE10.3),6X))')R(3,1,I),R(3,2,I),R(3,3,I),RD31(I),RD32(I),RD33(I),RR31,RR32,RR33
374
375 CALL crtrans_imp(
376 1 sav, invj, xd1, xd2,
377 2 xd3, xd4, xd5, xd6,
378 3 xd7, xd8, yd1, yd2,
379 4 yd3, yd4, yd5, yd6,
380 5 yd7, yd8, zd1, zd2,
381 6 zd3, zd4, zd5, zd6,
382 7 zd7, zd8, v1, v2,
383 8 v3, v4, v5, v6,
384 9 v7, v8, r, trm,
385 a nel)
386
387 IF(ismstr == 1)THEN
388 IF(tt == zero) THEN
389 CALL s8xref_imp(
390 1 offg, xref, xd1, xd2,
391 2 xd3, xd4, xd5, xd6,
392 3 xd7, xd8, yd1, yd2,
393 4 yd3, yd4, yd5, yd6,
394 5 yd7, yd8, zd1, zd2,
395 6 zd3, zd4, zd5, zd6,
396 7 zd7, zd8, r, nel)
397 ENDIF
398 CALL getuloc(
399 1 xref, xd1, xd2,
400 2 xd3, xd4, xd5, xd6,
401 3 xd7, xd8, yd1, yd2,
402 4 yd3, yd4, yd5, yd6,
403 5 yd7, yd8, zd1, zd2,
404 6 zd3, zd4, zd5, zd6,
405 7 zd7, zd8, ulx1, ulx2,
406 8 ulx3, ulx4, ulx5, ulx6,
407 9 ulx7, ulx8, uly1, uly2,
408 a uly3, uly4, uly5, uly6,
409 b uly7, uly8, ulz1, ulz2,
410 c ulz3, ulz4, ulz5, ulz6,
411 d ulz7, ulz8, r, nel)
412 ELSE
413!!sb pour verification
414! CALL GETVLOC(TRM,
415! . VX1, VX2, VX3, VX4, VX5, VX6, VX7, VX8,
416! . VY1, VY2, VY3, VY4, VY5, VY6, VY7, VY8,
417! . VZ1, VZ2, VZ3, VZ4, VZ5, VZ6, VZ7, VZ8,
418! . ULX1,ULX2,ULX3,ULX4,ULX5,ULX6,ULX7,ULX8,
419! . ULY1,ULY2,ULY3,ULY4,ULY5,ULY6,ULY7,ULY8,
420! . ulz1,ulz2,ulz3,ulz4,ulz5,ulz6,ulz7,ulz8,
421! . R11, R21, R31, R12, R22, R32, R13, R23, R33,
422! . R, NEL)
423 CALL getuloc(
424 1 sav, xd1, xd2,
425 2 xd3, xd4, xd5, xd6,
426 3 xd7, xd8, yd1, yd2,
427 4 yd3, yd4, yd5, yd6,
428 5 yd7, yd8, zd1, zd2,
429 6 zd3, zd4, zd5, zd6,
430 7 zd7, zd8, ulx1, ulx2,
431 8 ulx3, ulx4, ulx5, ulx6,
432 9 ulx7, ulx8, uly1, uly2,
433 a uly3, uly4, uly5, uly6,
434 b uly7, uly8, ulz1, ulz2,
435 c ulz3, ulz4, ulz5, ulz6,
436 d ulz7, ulz8, r, nel)
437 ENDIF
438!
439! CALL SREPISO3(
440! . XD1, XD2, XD3, XD4, XD5, XD6, XD7, XD8,
441! . YD1, YD2, YD3, YD4, YD5, YD6, YD7, YD8,
442! . zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8,
443! . RX, RY, RZ, SX, SY, SZ, TX, TY, TZ )
444!C---
445! IF (JHBE == 14 .OR. JHBE == 24) THEN
446! CALL SORTHO3(
447! . RX , RY , RZ , SX , SY , SZ , TX , TY , TZ ,
448! . R12, R13, R11, R22, R23, R21, R32, R33, R31)
449! ELSEIF (jhbe == 15 ) THEN
450! CALL SCORTHO3(
451! . RX , RY , RZ , SX , SY , SZ , TX , TY , TZ ,
452! . R11, R12, R13, R21, R22, R23, R31, R32, R33)
453! ELSE
454! CALL SORTHO3(
455! . RX , RY , RZ , SX , SY , SZ , TX , TY , TZ ,
456! . R11, R12, R13, R21, R22, R23, R31, R32, R33)
457! ENDIF
458!C-------sauf thick shells --------------
459! IF (IGTYP /= 21 .AND. IGTYP /= 22) THEN
460! IF (ISORTH == 0) THEN
461! DO I=LFT,LLT
462! GAMA(I,1) = ONE
463! GAMA(I,2) = ZERO
464! GAMA(I,3) = ZERO
465! GAMA(I,4) = ZERO
466! GAMA(I,5) = ONE
467! GAMA(I,6) = ZERO
468! ENDDO
469! ELSE
470! CALL SORTHDIR3(
471! . RX ,RY ,RZ ,SX ,SY ,SZ ,TX ,TY ,TZ ,
472! . r11 ,r12 ,r13 ,r21 ,r22 ,r23 ,r31 ,r32 ,r33 ,
473! . GAMA0,GAMA )
474! ENDIF
475! ENDIF
476c Recuperer les coordonnees courantes
477 DO i=lft,llt
478 x1(i)= xd1(i)
479 y1(i)= yd1(i)
480 z1(i)= zd1(i)
481 x2(i)= xd2(i)
482 y2(i)= yd2(i)
483 z2(i)= zd2(i)
484 x3(i)= xd3(i)
485 y3(i)= yd3(i)
486 z3(i)= zd3(i)
487 x4(i)= xd4(i)
488 y4(i)= yd4(i)
489 z4(i)= zd4(i)
490 x5(i)= xd5(i)
491 y5(i)= yd5(i)
492 z5(i)= zd5(i)
493 x6(i)= xd6(i)
494 y6(i)= yd6(i)
495 z6(i)= zd6(i)
496 x7(i)= xd7(i)
497 y7(i)= yd7(i)
498 z7(i)= zd7(i)
499 x8(i)= xd8(i)
500 y8(i)= yd8(i)
501 z8(i)= zd8(i)
502 ENDDO
503!C-----------
504!C PASSAGE AU REPERE CONVECTE.
505!C-----------
506!sb ne s'applique que dans le cas des petites deformations (ismstr = 1)
507! il faut voir ce qu'il faut faire dans les autres cas
508 IF(ismstr == 1)THEN
509 DO i = lft,llt
510 xd1(i) = zero
511 yd1(i) = zero
512 zd1(i) = zero
513 xd2(i) = sav(i,1)
514 yd2(i) = sav(i,2)
515 zd2(i) = sav(i,3)
516 xd3(i) = sav(i,4)
517 yd3(i) = sav(i,5)
518 zd3(i) = sav(i,6)
519 xd4(i) = sav(i,7)
520 yd4(i) = sav(i,8)
521 zd4(i) = sav(i,9)
522 xd5(i) = sav(i,10)
523 yd5(i) = sav(i,11)
524 zd5(i) = sav(i,12)
525 xd6(i) = sav(i,13)
526 yd6(i) = sav(i,14)
527 zd6(i) = sav(i,15)
528 xd7(i) = sav(i,16)
529 yd7(i) = sav(i,17)
530 zd7(i) = sav(i,18)
531 xd8(i) = sav(i,19)
532 yd8(i) = sav(i,20)
533 zd8(i) = sav(i,21)
534 ENDDO
535 ELSE IF(ismstr == 2 .OR. ismstr == 4) THEN
536 DO i=lft,llt
537 ug = xd2(i)-xd1(i)
538 vg = yd2(i)-yd1(i)
539 wg = zd2(i)-zd1(i)
540 ul = r(1,1,i)*ug+r(2,1,i)*vg+r(3,1,i)*wg
541 vl = r(1,2,i)*ug+r(2,2,i)*vg+r(3,2,i)*wg
542 wl = r(1,3,i)*ug+r(2,3,i)*vg+r(3,3,i)*wg
543 xd2(i) = ul
544 yd2(i) = vl
545 zd2(i) = wl
546
547 ug = xd3(i)-xd1(i)
548 vg = yd3(i)-yd1(i)
549 wg = zd3(i)-zd1(i)
550 ul = r(1,1,i)*ug+r(2,1,i)*vg+r(3,1,i)*wg
551 vl = r(1,2,i)*ug+r(2,2,i)*vg+r(3,2,i)*wg
552 wl = r(1,3,i)*ug+r(2,3,i)*vg+r(3,3,i)*wg
553 xd3(i) = ul
554 yd3(i) = vl
555 zd3(i) = wl
556
557 ug = xd4(i)-xd1(i)
558 vg = yd4(i)-yd1(i)
559 wg = zd4(i)-zd1(i)
560 ul = r(1,1,i)*ug+r(2,1,i)*vg+r(3,1,i)*wg
561 vl = r(1,2,i)*ug+r(2,2,i)*vg+r(3,2,i)*wg
562 wl = r(1,3,i)*ug+r(2,3,i)*vg+r(3,3,i)*wg
563 xd4(i) = ul
564 yd4(i) = vl
565 zd4(i) = wl
566
567 ug = xd5(i)-xd1(i)
568 vg = yd5(i)-yd1(i)
569 wg = zd5(i)-zd1(i)
570 ul = r(1,1,i)*ug+r(2,1,i)*vg+r(3,1,i)*wg
571 vl = r(1,2,i)*ug+r(2,2,i)*vg+r(3,2,i)*wg
572 wl = r(1,3,i)*ug+r(2,3,i)*vg+r(3,3,i)*wg
573 xd5(i) = ul
574 yd5(i) = vl
575 zd5(i) = wl
576
577 ug = xd6(i)-xd1(i)
578 vg = yd6(i)-yd1(i)
579 wg = zd6(i)-zd1(i)
580 ul = r(1,1,i)*ug+r(2,1,i)*vg+r(3,1,i)*wg
581 vl = r(1,2,i)*ug+r(2,2,i)*vg+r(3,2,i)*wg
582 wl = r(1,3,i)*ug+r(2,3,i)*vg+r(3,3,i)*wg
583 xd6(i) = ul
584 yd6(i) = vl
585 zd6(i) = wl
586
587 ug = xd7(i)-xd1(i)
588 vg = yd7(i)-yd1(i)
589 wg = zd7(i)-zd1(i)
590 ul = r(1,1,i)*ug+r(2,1,i)*vg+r(3,1,i)*wg
591 vl = r(1,2,i)*ug+r(2,2,i)*vg+r(3,2,i)*wg
592 wl = r(1,3,i)*ug+r(2,3,i)*vg+r(3,3,i)*wg
593 xd7(i) = ul
594 yd7(i) = vl
595 zd7(i) = wl
596
597 ug = xd8(i)-xd1(i)
598 vg = yd8(i)-yd1(i)
599 wg = zd8(i)-zd1(i)
600 ul = r(1,1,i)*ug+r(2,1,i)*vg+r(3,1,i)*wg
601 vl = r(1,2,i)*ug+r(2,2,i)*vg+r(3,2,i)*wg
602 wl = r(1,3,i)*ug+r(2,3,i)*vg+r(3,3,i)*wg
603 xd8(i) = ul
604 yd8(i) = vl
605 zd8(i) = wl
606
607 xd1(i)=zero
608 yd1(i)=zero
609 zd1(i)=zero
610 ENDDO
611 ENDIF
612C-----------
613C PASSAGE DES VITESSES AU REPERE CONVECTE (OU ORTHOTROPE).
614C-----------
615! CALL SRROTA3(
616! . r11, r12, r13, r21, r22, r23, r31, r32, r33,
617! . VX1, VX2, VX3, VX4, VX5, VX6, VX7, VX8,
618! . VY1, VY2, VY3, VY4, VY5, VY6, VY7, VY8,
619! . VZ1, VZ2, VZ3, VZ4, VZ5, VZ6, VZ7, VZ8)
620
621
622
623
624 IF(off_l < zero)THEN
625 DO i=lft,llt
626 IF(offg(i) < zero)THEN
627 vx1(i)=zero
628 vy1(i)=zero
629 vz1(i)=zero
630 vx2(i)=zero
631 vy2(i)=zero
632 vz2(i)=zero
633 vx3(i)=zero
634 vy3(i)=zero
635 vz3(i)=zero
636 vx4(i)=zero
637 vy4(i)=zero
638 vz4(i)=zero
639 vx5(i)=zero
640 vy5(i)=zero
641 vz5(i)=zero
642 vx6(i)=zero
643 vy6(i)=zero
644 vz6(i)=zero
645 vx7(i)=zero
646 vy7(i)=zero
647 vz7(i)=zero
648 vx8(i)=zero
649 vy8(i)=zero
650 vz8(i)=zero
651 ENDIF
652 ENDDO
653 ENDIF
654C-----------
655 DO i=lft,llt
656 vd2(i)=zero
657 ENDDO
658C-----------
659 RETURN
660 END
crframe_imp
subroutine crframe_imp(sav, invj, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8, r, nel)
Definition crframe_imp.F:36
crtrans_imp
subroutine crtrans_imp(sav, invj, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8, v1, v2, v3, v4, v5, v6, v7, v8, r, trm, nel)
Definition crtrans_imp.F:41
getuloc
subroutine getuloc(sav, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8, ulx1, ulx2, ulx3, ulx4, ulx5, ulx6, ulx7, ulx8, uly1, uly2, uly3, uly4, uly5, uly6, uly7, uly8, ulz1, ulz2, ulz3, ulz4, ulz5, ulz6, ulz7, ulz8, r, nel)
Definition getuloc.F:43
min
#define min(a, b)
Definition macros.h:20
s8sav3_imp
subroutine s8sav3_imp(offg, sav, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8, nel)
Definition s8sav3_imp.F:36
s8xref_imp
subroutine s8xref_imp(offg, xref, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8, r, nel)
Definition s8xref_imp.F:38
srcoor3_imp
subroutine srcoor3_imp(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, r, 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, trm, xref, ulx1, ulx2, ulx3, ulx4, ulx5, ulx6, ulx7, ulx8, uly1, uly2, uly3, uly4, uly5, uly6, uly7, uly8, ulz1, ulz2, ulz3, ulz4, ulz5, ulz6, ulz7, ulz8, xgax, xgay, xgaz, xgxa2, xgya2, xgza2, xgxya, xgyza, xgzxa, iparg)
Definition srcoor3_imp.F:53