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