OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s4refsta3.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!|| s4refsta3 ../starter/source/elements/solid/solide4/s4refsta3.F
25!||--- called by ------------------------------------------------------
26!|| initia ../starter/source/elements/initia/initia.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| fretitl2 ../starter/source/starter/freform.F
30!|| mmain ../starter/source/materials/mat_share/mmain.F
31!|| s4defo3 ../starter/source/elements/solid/solide4/s4defo3.F
32!|| s4defot3 ../starter/source/elements/solid/solide4/s4refsta3.F
33!|| s4deri3 ../starter/source/elements/solid/solide4/s4deri3.F
34!|| s4orth3 ../starter/source/elements/solid/solide4/s4orth3.F
35!|| s4ortht3 ../starter/source/elements/solid/solide4/s4orth3.F
36!|| s4repiso3 ../starter/source/elements/solid/solide4/s4repiso3.F
37!|| s4repisot3 ../starter/source/elements/solid/solide4/s4repiso3.F
38!|| s4rota3 ../starter/source/elements/solid/solide4/s4rota3.F
39!|| s4rotat3 ../starter/source/elements/solid/solide4/s4rota3.F
40!|| sortho3 ../starter/source/elements/solid/solide/sortho3.F
41!|| srho3 ../starter/source/elements/solid/solide/srho3.F
42!||--- uses -----------------------------------------------------
43!|| message_mod ../starter/share/message_module/message_mod.F
44!||====================================================================
45 SUBROUTINE s4refsta3(ELBUF_STR,IXS ,PM ,GEO ,IPARG ,
46 . IPM ,IGEO ,SKEW ,X ,XREFS ,
47 . NEL ,IPARTS ,IPART ,BUFMAT ,MAT_PARAM,
48 . NPF ,TF ,NUMMAT )
49C-----------------------------------------------
50C M o d u l e s
51C-----------------------------------------------
52 USE mat_elem_mod
53 USE message_mod
54 USE names_and_titles_mod , ONLY : nchartitle
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 "param_c.inc"
68#include "scr03_c.inc"
69#include "scr17_c.inc"
70#include "vect01_c.inc"
71C-----------------------------------------------
72C D u m m y A r g u m e n t s
73C-----------------------------------------------
74 INTEGER ,INTENT(IN) :: NUMMAT
75 INTEGER IXS(NIXS,*), IPARG(*),IPARTS(*),IGEO(NPROPGI,*),
76 . IPM(NPROPMI,*),IPART(LIPART1,*), NPF(*)
77 INTEGER NEL
78 my_real
79 . pm(npropm,*), x(3,*), xrefs(8,3,*), geo(npropg,*),
80 . skew(lskew,*), bufmat(*), tf(*)
81 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
82 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
83C-----------------------------------------------
84C L o c a l V a r i a b l e s
85C-----------------------------------------------
86 INTEGER I, N, JHBE, IMAT,IGTYP, ITRS, ISTRA, IPID, IBID,
87 . NITSAV,JJ(6)
88 INTEGER ID
89 CHARACTER(LEN=NCHARTITLE)::TITR
90 INTEGER MAT(MVSIZ), PID(MVSIZ), NGL(MVSIZ),
91 . ix1(mvsiz), ix2(mvsiz), ix3(mvsiz), ix4(mvsiz)
92 double precision
93 . xr(mvsiz,8) ,yr(mvsiz,8) ,zr(mvsiz,8) ,
94 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
95 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
96 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),voldp(mvsiz)
97 my_real
98 . rx(mvsiz) ,ry(mvsiz) ,rz(mvsiz) ,
99 . sx(mvsiz) ,sy(mvsiz) ,sz(mvsiz) ,
100 . tx(mvsiz) ,ty(mvsiz) ,tz(mvsiz) ,
101 . e1x(mvsiz),e1y(mvsiz),e1z(mvsiz),
102 . e2x(mvsiz),e2y(mvsiz),e2z(mvsiz),
103 . e3x(mvsiz),e3y(mvsiz),e3z(mvsiz),
104 . px1(mvsiz) ,px2(mvsiz) ,px3(mvsiz), px4(mvsiz),
105 . py1(mvsiz) ,py2(mvsiz) ,py3(mvsiz), py4(mvsiz),
106 . pz1(mvsiz) ,pz2(mvsiz) ,pz3(mvsiz), pz4(mvsiz),
107 . mfxx(mvsiz), mfxy(mvsiz), mfyx(mvsiz),
108 . mfyy(mvsiz), mfyz(mvsiz), mfzy(mvsiz),
109 . mfzz(mvsiz), mfzx(mvsiz), mfxz(mvsiz),
110 . voln(mvsiz), dvol(mvsiz),
111 . vxl(mvsiz,8),vyl(mvsiz,8),vzl(mvsiz,8),
112 . vx1(mvsiz),vx2(mvsiz),vx3(mvsiz),vx4(mvsiz),
113 . vy1(mvsiz),vy2(mvsiz),vy3(mvsiz),vy4(mvsiz),
114 . vz1(mvsiz),vz2(mvsiz),vz3(mvsiz),vz4(mvsiz),
115 . dxx(mvsiz),dxy(mvsiz),dxz(mvsiz),
116 . dyx(mvsiz),dyy(mvsiz),dyz(mvsiz),
117 . dzx(mvsiz),dzy(mvsiz),dzz(mvsiz),
118 . d1(mvsiz),d2(mvsiz),d3(mvsiz),d4(mvsiz),d5(mvsiz),d6(mvsiz),
119 . s1(mvsiz),s2(mvsiz),s3(mvsiz),s4(mvsiz),s5(mvsiz),s6(mvsiz),
120 . wxx(mvsiz), wyy(mvsiz), wzz(mvsiz),vbid(lveul,mvsiz)
121 my_real
122 . fac, xt, yt, zt, a11, a12, a13, a21, a22, a23, a31, a32, a33,jac(10,mvsiz)
123 my_real
124 . deltax(mvsiz), volu(mvsiz)
125c----
126 TYPE(g_bufel_) ,POINTER :: GBUF
127 TYPE(L_BUFEL_) ,POINTER :: LBUF
128C-----------------------------------------------
129C S o u r c e L i n e s
130C=======================================================================
131 gbuf => elbuf_str%GBUF
132 lbuf => elbuf_str%BUFLY(1)%LBUF(1,1,1)
133 jhbe = iparg(23)
134 jcvt = iparg(37)
135 igtyp = iparg(38)
136 istra = iparg(44)
137 ibid = 0
138C
139 nitsav=nitrs
140!
141 DO i=1,6
142 jj(i) = nel*(i-1)
143 ENDDO
144!
145C-----Case total strain, rather for computing Eint, stress will also be calculated at T=0 of Engine
146C-----but NITRS=1, for nonlinear elastic, Eint is too approximative
147 IF (ismstr >= 10 ) nitrs=10
148C----------------------------
149 IF (mtn == 35 .OR. mtn == 38 .OR. mtn == 42 .OR. mtn == 70)THEN
150 IF (jcvt > 0) THEN
151 ipid = ixs(nixs-1,1)
152 id = igeo(1,ipid)
153 CALL fretitl2(titr,igeo(npropgi-ltitr+1,ipid),ltitr)
154 CALL ancmsg(msgid=906,
155 . msgtype=msgerror,
156 . anmode=aninfo_blind_2,
157 . i1=id,
158 . c1=titr)
159 ENDIF
160C----------------------------
161C Connectivities, PID, Mid N
162C----------------------------
163 mat(1) = 0
164 DO i=lft,llt
165 n = nft+i
166 mat(i)=ixs(1,n)
167 pid(i)=ixs(nixs-1,n)
168 ngl(i)=ixs(nixs,n)
169 ix1(i)=ixs(2,n)
170 ix2(i)=ixs(4,n)
171 ix3(i)=ixs(7,n)
172 ix4(i)=ixs(6,n)
173 END DO
174 imat = mat(1)
175C----------------------------
176C Coordinates
177C----------------------------
178 DO i=lft,llt
179 n = nft+i
180 xt = xrefs(4,1,n)
181 yt = xrefs(4,2,n)
182 zt = xrefs(4,3,n)
183 xr(i,1) = xrefs(1,1,n)-xt
184 yr(i,1) = xrefs(1,2,n)-yt
185 zr(i,1) = xrefs(1,3,n)-zt
186 xr(i,2) = xrefs(2,1,n)-xt
187 yr(i,2) = xrefs(2,2,n)-yt
188 zr(i,2) = xrefs(2,3,n)-zt
189 xr(i,3) = xrefs(3,1,n)-xt
190 yr(i,3) = xrefs(3,2,n)-yt
191 zr(i,3) = xrefs(3,3,n)-zt
192 xr(i,4) = zero
193 yr(i,4) = zero
194 zr(i,4) = zero
195 END DO
196C-----Case total strain calculated in global sys
197C Isoparametric bench
198 CALL s4repisot3(xr(1,1) ,xr(1,2) ,xr(1,3) ,xr(1,4) ,
199 . yr(1,1) ,yr(1,2) ,yr(1,3) ,yr(1,4) ,
200 . zr(1,1) ,zr(1,2) ,zr(1,3) ,zr(1,4) ,
201 . rx ,ry ,rz ,
202 . sx ,sy ,sz ,
203 . tx ,ty ,tz )
204c CALL SREPLOC3(
205 CALL sortho3(
206 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
207 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
208
209 IF (igtyp == 6 .AND. jhbe /=24) THEN
210 CALL s4ortht3(jhbe ,gbuf%GAMA,nel,
211 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
212 . xr(1,1) ,xr(1,2) ,xr(1,3) ,xr(1,4) ,
213 . yr(1,1) ,yr(1,2) ,yr(1,3) ,yr(1,4) ,
214 . zr(1,1) ,zr(1,2) ,zr(1,3) ,zr(1,4) )
215 ENDIF
216C----------------------------
217C Config initiale
218C----------------------------
219 DO i=lft,llt
220 xt = x(1,ix4(i))
221 yt = x(2,ix4(i))
222 zt = x(3,ix4(i))
223 x1(i)=x(1,ix1(i))-xt
224 y1(i)=x(2,ix1(i))-yt
225 z1(i)=x(3,ix1(i))-zt
226 x2(i)=x(1,ix2(i))-xt
227 y2(i)=x(2,ix2(i))-yt
228 z2(i)=x(3,ix2(i))-zt
229 x3(i)=x(1,ix3(i))-xt
230 y3(i)=x(2,ix3(i))-yt
231 z3(i)=x(3,ix3(i))-zt
232 x4(i)=zero
233 y4(i)=zero
234 z4(i)=zero
235 END DO
236C Isoparametric bench
237 CALL s4repiso3(x1 ,x2 ,x3 ,x4 ,
238 . y1 ,y2 ,y3 ,y4 ,
239 . z1 ,z2 ,z3 ,z4 ,
240 . rx ,ry ,rz ,
241 . sx ,sy ,sz ,
242 . tx ,ty ,tz )
243c CALL SREPLOC3(
244 CALL sortho3(
245 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
246 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
247c CALL S4ROTA3(E1X ,E2X ,E3X ,E1Y ,E2Y ,E3Y ,E1Z ,E2Z ,E3Z ,
248c . X1 ,X2 ,X3 ,X4 ,
249c . Y1 ,Y2 ,Y3 ,Y4 ,
250c . Z1 ,Z2 ,Z3 ,Z4 )
251 IF (igtyp == 6 .AND. jhbe /=24) THEN
252 CALL s4orth3(jhbe ,gbuf%GAMA,nel,
253 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
254 . x1 ,x2 ,x3 ,x4 ,
255 . y1 ,y2 ,y3 ,y4 ,
256 . z1 ,z2 ,z3 ,z4 )
257 ENDIF
258C----------------------------
259C Returns the reference in global frame.
260C----------------------------
261c CALL S4ROTAT3(E1X ,E1Y ,E1Z ,E2X ,E2Y ,E2Z ,E3X ,E3Y ,E3Z ,
262c . XR(1,1) ,XR(1,2) ,XR(1,3) ,XR(1,4) ,
263c . YR(1,1) ,YR(1,2) ,YR(1,3) ,YR(1,4) ,
264c . ZR(1,1) ,ZR(1,2) ,ZR(1,3) ,ZR(1,4) )
265C------
266 DO i=lft,llt
267 n = nft+i
268 xt = xrefs(4,1,n)
269 yt = xrefs(4,2,n)
270 zt = xrefs(4,3,n)
271 xr(i,1) = xrefs(1,1,n)-xt
272 yr(i,1) = xrefs(1,2,n)-yt
273 zr(i,1) = xrefs(1,3,n)-zt
274 xr(i,2) = xrefs(2,1,n)-xt
275 yr(i,2) = xrefs(2,2,n)-yt
276 zr(i,2) = xrefs(2,3,n)-zt
277 xr(i,3) = xrefs(3,1,n)-xt
278 yr(i,3) = xrefs(3,2,n)-yt
279 zr(i,3) = xrefs(3,3,n)-zt
280 xr(i,4) = zero
281 yr(i,4) = zero
282 zr(i,4) = zero
283 END DO
284C
285 fac = one/float(nitrs)
286 DO i=lft,llt
287 xt=x(1,ix4(i))
288 yt=x(2,ix4(i))
289 zt=x(3,ix4(i))
290 vx1(i)=(x(1,ix1(i))-xt-xr(i,1))*fac
291 vy1(i)=(x(2,ix1(i))-yt-yr(i,1))*fac
292 vz1(i)=(x(3,ix1(i))-zt-zr(i,1))*fac
293 vx2(i)=(x(1,ix2(i))-xt-xr(i,2))*fac
294 vy2(i)=(x(2,ix2(i))-yt-yr(i,2))*fac
295 vz2(i)=(x(3,ix2(i))-zt-zr(i,2))*fac
296 vx3(i)=(x(1,ix3(i))-xt-xr(i,3))*fac
297 vy3(i)=(x(2,ix3(i))-yt-yr(i,3))*fac
298 vz3(i)=(x(3,ix3(i))-zt-zr(i,3))*fac
299 vx4(i)=zero
300 vy4(i)=zero
301 vz4(i)=zero
302 END DO
303C----------------------------
304C deformation : reference -> initial
305C----------------------------
306 DO itrs=1,nitrs
307C
308 fac = float(itrs)
309C--------in global sys
310 IF (ismstr >= 10) THEN
311 CALL s4deri3(voln ,vbid ,geo ,igeo ,rx ,
312 . ry ,rz ,sx ,sy ,
313 . sz ,tx ,ty ,tz ,
314 . xr(1,1) ,xr(1,2) ,xr(1,3) ,xr(1,4) ,
315 . yr(1,1) ,yr(1,2) ,yr(1,3) ,yr(1,4) ,
316 . zr(1,1) ,zr(1,2) ,zr(1,3) ,zr(1,4) ,
317 . px1 ,px2 ,px3 ,px4 ,
318 . py1 ,py2 ,py3 ,py4 ,
319 . pz1 ,pz2 ,pz3 ,pz4 ,gbuf%JAC_I,
320 . deltax ,volu ,ngl ,pid ,mat ,
321 . pm ,voldp )
322 CALL s4defot3(
323 . px1, px2, px3, px4,
324 . py1, py2, py3, py4,
325 . pz1, pz2, pz3, pz4,
326 . vx1, vx2, vx3, vx4,
327 . vy1, vy2, vy3, vy4,
328 . vz1, vz2, vz3, vz4,
329 . mfxx, mfxy, mfxz, mfyx, mfyy, mfyz, mfzx, mfzy, mfzz)
330 DO i=lft,llt
331 mfxx(i)=fac*mfxx(i)
332 mfyy(i)=fac*mfyy(i)
333 mfzz(i)=fac*mfzz(i)
334 mfxy(i)=fac*mfxy(i)
335 mfxz(i)=fac*mfxz(i)
336 mfyx(i)=fac*mfyx(i)
337 mfyz(i)=fac*mfyz(i)
338 mfzx(i)=fac*mfzx(i)
339 mfzy(i)=fac*mfzy(i)
340 ENDDO
341C ------ to be done for orth, for the moment no orth law is available with total strain
342C IF (IGTYP == 6) THEN
343C ENDIF
344 END IF !(ISMSTR == 10 .OR. ISMSTR == 12) THEN
345 DO i=lft,llt
346 x1(i)=xr(i,1)+fac*vx1(i)
347 y1(i)=yr(i,1)+fac*vy1(i)
348 z1(i)=zr(i,1)+fac*vz1(i)
349 x2(i)=xr(i,2)+fac*vx2(i)
350 y2(i)=yr(i,2)+fac*vy2(i)
351 z2(i)=zr(i,2)+fac*vz2(i)
352 x3(i)=xr(i,3)+fac*vx3(i)
353 y3(i)=yr(i,3)+fac*vy3(i)
354 z3(i)=zr(i,3)+fac*vz3(i)
355 x4(i)=xr(i,4)+fac*vx4(i)
356 y4(i)=yr(i,4)+fac*vy4(i)
357 z4(i)=zr(i,4)+fac*vz4(i)
358 END DO
359C-----------
360C Isoparametric bench
361 CALL s4repiso3(x1 ,x2 ,x3 ,x4 ,
362 . y1 ,y2 ,y3 ,y4 ,
363 . z1 ,z2 ,z3 ,z4 ,
364 . rx ,ry ,rz ,
365 . sx ,sy ,sz ,
366 . tx ,ty ,tz )
367C
368c CALL SREPLOC3(
369 IF (ismstr == 1 .OR. ismstr == 11) THEN
370 DO i=lft,llt
371 x1(i)=xr(i,1)
372 y1(i)=yr(i,1)
373 z1(i)=zr(i,1)
374 x2(i)=xr(i,2)
375 y2(i)=yr(i,2)
376 z2(i)=zr(i,2)
377 x3(i)=xr(i,3)
378 y3(i)=yr(i,3)
379 z3(i)=zr(i,3)
380 x4(i)=xr(i,4)
381 y4(i)=yr(i,4)
382 z4(i)=zr(i,4)
383 END DO
384 END IF
385 IF (ismstr >= 10) THEN
386C----------- in global system for total strain
387 DO i=lft,llt
388 e1x(i) = one
389 e1y(i) = zero
390 e1z(i) = zero
391 e2x(i) = zero
392 e2y(i) = one
393 e2z(i) = zero
394 e3x(i) = zero
395 e3y(i) = zero
396 e3z(i) = one
397 END DO
398 ELSE
399 CALL sortho3(
400 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
401 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
402C
403 CALL s4rota3(e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
404 . x1 ,x2 ,x3 ,x4 ,
405 . y1 ,y2 ,y3 ,y4 ,
406 . z1 ,z2 ,z3 ,z4 )
407 END IF !(ISMSTR >= 10) THEN
408C
409 IF (igtyp == 6 .AND. jhbe /=24) THEN
410 CALL s4orth3(jhbe ,gbuf%GAMA ,nel,
411 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
412 . x1 ,x2 ,x3 ,x4 ,
413 . y1 ,y2 ,y3 ,y4 ,
414 . z1 ,z2 ,z3 ,z4 )
415 ENDIF
416C-----------
417 CALL s4deri3(voln ,vbid ,geo ,igeo ,rx ,
418 . ry ,rz ,sx ,sy ,
419 . sz ,tx ,ty ,tz ,
420 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
421 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
422 . px1 ,px2 ,px3 ,px4 ,
423 . py1 ,py2 ,py3 ,py4 ,
424 . pz1 ,pz2 ,pz3 ,pz4 ,jac,
425 . deltax ,volu ,ngl ,pid ,mat,
426 . pm ,voldp )
427C-----------
428 DO i=lft,llt
429 vxl(i,1)=vx1(i)
430 vyl(i,1)=vy1(i)
431 vzl(i,1)=vz1(i)
432 vxl(i,2)=vx2(i)
433 vyl(i,2)=vy2(i)
434 vzl(i,2)=vz2(i)
435 vxl(i,3)=vx3(i)
436 vyl(i,3)=vy3(i)
437 vzl(i,3)=vz3(i)
438 vxl(i,4)=vx4(i)
439 vyl(i,4)=vy4(i)
440 vzl(i,4)=vz4(i)
441 ENDDO
442 CALL s4rotat3(e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
443 . vxl(1,1) ,vxl(1,2) ,vxl(1,3) ,vxl(1,4) ,
444 . vyl(1,1) ,vyl(1,2) ,vyl(1,3) ,vyl(1,4) ,
445 . vzl(1,1) ,vzl(1,2) ,vzl(1,3) ,vzl(1,4) )
446C-----calculate Dij anyway to get EINT
447C-----(small strain is not taken account here, if do it, should also modify SRHO3)
448 CALL s4defo3(
449 . px1, px2, px3, px4,
450 . py1, py2, py3, py4,
451 . pz1, pz2, pz3, pz4,
452 . vxl(1,1), vxl(1,2), vxl(1,3), vxl(1,4),
453 . vyl(1,1), vyl(1,2), vyl(1,3), vyl(1,4),
454 . vzl(1,1), vzl(1,2), vzl(1,3), vzl(1,4),
455 . dxx, dxy, dxz, dyx, dyy, dyz, dzx, dzy, dzz,
456 . d4, d5, d6 ,wxx, wyy, wzz)
457C-----------
458 CALL srho3(pm, gbuf%VOL, gbuf%RHO, gbuf%EINT, dxx,
459 . dyy, dzz, voln, dvol, mat)
460 DO i=lft,llt
461 s1(i) = gbuf%SIG(jj(1) + i)
462 s2(i) = gbuf%SIG(jj(2) + i)
463 s3(i) = gbuf%SIG(jj(3) + i)
464 s4(i) = gbuf%SIG(jj(4) + i)
465 s5(i) = gbuf%SIG(jj(5) + i)
466 s6(i) = gbuf%SIG(jj(6) + i)
467 END DO
468C-----------
469 CALL mmain(pm ,elbuf_str,ixs ,nixs ,x ,
470 2 geo ,iparg ,nel ,skew ,bufmat ,
471 3 ipart ,iparts ,nummat ,mat_param,
472 4 imat ,ipm ,ngl ,pid ,npf ,
473 5 tf ,mfxx ,mfxy ,mfxz ,mfyx ,
474 6 mfyy ,mfyz ,mfzx ,mfzy ,mfzz ,
475 7 rx ,ry ,rz ,sx ,sy ,
476 8 sz ,gbuf%GAMA,voln ,dvol ,s1 ,
477 b s2 ,s3 ,s4 ,s5 ,s6 ,
478 9 dxx ,dyy ,dzz ,d4 ,d5 ,
479 a d6 ,wxx ,wyy ,wzz )
480 ENDDO
481C-----------
482c stress -> global coordinates
483 DO i=lft,llt
484 s1(i) = gbuf%SIG(jj(1) + i)
485 s2(i) = gbuf%SIG(jj(2) + i)
486 s3(i) = gbuf%SIG(jj(3) + i)
487 s4(i) = gbuf%SIG(jj(4) + i)
488 s5(i) = gbuf%SIG(jj(5) + i)
489 s6(i) = gbuf%SIG(jj(6) + i)
490 a11 = s1(i)*e1x(i)+s4(i)*e2x(i)+s6(i)*e3x(i)
491 a12 = s1(i)*e1y(i)+s4(i)*e2y(i)+s6(i)*e3y(i)
492 a13 = s1(i)*e1z(i)+s4(i)*e2z(i)+s6(i)*e3z(i)
493 a21 = s4(i)*e1x(i)+s2(i)*e2x(i)+s5(i)*e3x(i)
494 a22 = s4(i)*e1y(i)+s2(i)*e2y(i)+s5(i)*e3y(i)
495 a23 = s4(i)*e1z(i)+s2(i)*e2z(i)+s5(i)*e3z(i)
496 a31 = s6(i)*e1x(i)+s5(i)*e2x(i)+s3(i)*e3x(i)
497 a32 = s6(i)*e1y(i)+s5(i)*e2y(i)+s3(i)*e3y(i)
498 a33 = s6(i)*e1z(i)+s5(i)*e2z(i)+s3(i)*e3z(i)
499 s1(i) = e1x(i)*a11 + e2x(i)*a21 + e3x(i)*a31
500 s2(i) = e1y(i)*a12 + e2y(i)*a22 + e3y(i)*a32
501 s3(i) = e1z(i)*a13 + e2z(i)*a23 + e3z(i)*a33
502 s4(i) = e1x(i)*a12 + e2x(i)*a22 + e3x(i)*a32
503 s5(i) = e1y(i)*a13 + e2y(i)*a23 + e3y(i)*a33
504 s6(i) = e1x(i)*a13 + e2x(i)*a23 + e3x(i)*a33
505 gbuf%SIG(jj(1) + i) = s1(i)
506 gbuf%SIG(jj(2) + i) = s2(i)
507 gbuf%SIG(jj(3) + i) = s3(i)
508 gbuf%SIG(jj(4) + i) = s4(i)
509 gbuf%SIG(jj(5) + i) = s5(i)
510 gbuf%SIG(jj(6) + i) = s6(i)
511 END DO
512c strain -> global coordinates
513 IF (istra > 0) THEN
514 DO i=lft,llt
515 d1(i) = lbuf%STRA(jj(1) + i)
516 d2(i) = lbuf%STRA(jj(2) + i)
517 d3(i) = lbuf%STRA(jj(3) + i)
518 d4(i) = lbuf%STRA(jj(4) + i)*half
519 d5(i) = lbuf%STRA(jj(5) + i)*half
520 d6(i) = lbuf%STRA(jj(6) + i)*half
521 a11 = d1(i)*e1x(i)+d4(i)*e2x(i)+d6(i)*e3x(i)
522 a12 = d1(i)*e1y(i)+d4(i)*e2y(i)+d6(i)*e3y(i)
523 a13 = d1(i)*e1z(i)+d4(i)*e2z(i)+d6(i)*e3z(i)
524 a21 = d4(i)*e1x(i)+d2(i)*e2x(i)+d5(i)*e3x(i)
525 a22 = d4(i)*e1y(i)+d2(i)*e2y(i)+d5(i)*e3y(i)
526 a23 = d4(i)*e1z(i)+d2(i)*e2z(i)+d5(i)*e3z(i)
527 a31 = d6(i)*e1x(i)+d5(i)*e2x(i)+d3(i)*e3x(i)
528 a32 = d6(i)*e1y(i)+d5(i)*e2y(i)+d3(i)*e3y(i)
529 a33 = d6(i)*e1z(i)+d5(i)*e2z(i)+d3(i)*e3z(i)
530 d1(i) = e1x(i)*a11 + e2x(i)*a21 + e3x(i)*a31
531 d2(i) = e1y(i)*a12 + e2y(i)*a22 + e3y(i)*a32
532 d3(i) = e1z(i)*a13 + e2z(i)*a23 + e3z(i)*a33
533 d4(i) = e1x(i)*a12 + e2x(i)*a22 + e3x(i)*a32
534 d5(i) = e1y(i)*a13 + e2y(i)*a23 + e3y(i)*a33
535 d6(i) = e1x(i)*a13 + e2x(i)*a23 + e3x(i)*a33
536 lbuf%STRA(jj(1) + i) = d1(i)
537 lbuf%STRA(jj(2) + i) = d2(i)
538 lbuf%STRA(jj(3) + i) = d3(i)
539 lbuf%STRA(jj(4) + i) = d4(i)*two
540 lbuf%STRA(jj(5) + i) = d5(i)*two
541 lbuf%STRA(jj(6) + i) = d6(i)*two
542 ENDDO
543 ENDIF
544C-----
545 ENDIF
546C ======================================================================
547 nitrs=nitsav
548 RETURN
549 END SUBROUTINE s4refsta3
550c
551!||====================================================================
552!|| s4defot3 ../starter/source/elements/solid/solide4/s4refsta3.F
553!||--- called by ------------------------------------------------------
554!|| s4refsta3 ../starter/source/elements/solid/solide4/s4refsta3.F
555!||====================================================================
556 SUBROUTINE s4defot3(
557 . PX1, PX2, PX3, PX4, PY1, PY2, PY3, PY4,
558 . PZ1, PZ2, PZ3, PZ4, VX1, VX2, VX3, VX4,
559 . VY1, VY2, VY3, VY4, VZ1, VZ2, VZ3, VZ4,
560 . DXX, DXY, DXZ, DYX, DYY, DYZ, DZX, DZY,
561 . DZZ)
562C-----------------------------------------------
563C I m p l i c i t T y p e s
564C-----------------------------------------------
565#include "implicit_f.inc"
566C-----------------------------------------------
567C D u m m y A r g u m e n t s
568C-----------------------------------------------
569 my_real
570 . vx1(*), vx2(*), vx3(*), vx4(*),
571 . vy1(*), vy2(*), vy3(*), vy4(*),
572 . vz1(*), vz2(*), vz3(*), vz4(*),
573 . px1(*), px2(*), px3(*), px4(*),
574 . py1(*), py2(*), py3(*), py4(*),
575 . pz1(*), pz2(*), pz3(*), pz4(*),
576 . dxx(*), dxy(*), dxz(*),
577 . dyx(*), dyy(*), dyz(*),
578 . dzx(*), dzy(*), dzz(*)
579C-----------------------------------------------
580C C o m m o n B l o c k s
581C-----------------------------------------------
582#include "vect01_c.inc"
583C-----------------------------------------------
584C L o c a l V a r i a b l e s
585C-----------------------------------------------
586 INTEGER I
587C-----------------------------------------------
588C 12
589 DO I=lft,llt
590 dxx(i)=px1(i)*vx1(i)+px2(i)*vx2(i)+
591 . px3(i)*vx3(i)+px4(i)*vx4(i)
592 dyy(i)=py1(i)*vy1(i)+py2(i)*vy2(i)+
593 . py3(i)*vy3(i)+py4(i)*vy4(i)
594 dzz(i)=pz1(i)*vz1(i)+pz2(i)*vz2(i)+
595 . pz3(i)*vz3(i)+pz4(i)*vz4(i)
596 dxy(i)=py1(i)*vx1(i)+py2(i)*vx2(i)+
597 . py3(i)*vx3(i)+py4(i)*vx4(i)
598 dxz(i)=pz1(i)*vx1(i)+pz2(i)*vx2(i)+
599 . pz3(i)*vx3(i)+pz4(i)*vx4(i)
600 dyx(i)=px1(i)*vy1(i)+px2(i)*vy2(i)+
601 . px3(i)*vy3(i)+px4(i)*vy4(i)
602 dyz(i)=pz1(i)*vy1(i)+pz2(i)*vy2(i)+
603 . pz3(i)*vy3(i)+pz4(i)*vy4(i)
604 dzx(i)=px1(i)*vz1(i)+px2(i)*vz2(i)+
605 . px3(i)*vz3(i)+px4(i)*vz4(i)
606 dzy(i)=py1(i)*vz1(i)+py2(i)*vz2(i)+
607 . py3(i)*vz3(i)+py4(i)*vz4(i)
608 ENDDO
609C-----------
610 RETURN
611 END
my_real
#define my_real
Definition cppsort.cpp:32
mmain
subroutine mmain(pm, elbuf_str, ix, nix, x, geo, iparg, nel, skew, bufmat, ipart, ipartel, nummat, matparam, imat, ipm, ngl, pid, npf, tf, mfxx, mfxy, mfxz, mfyx, mfyy, mfyz, mfzx, mfzy, mfzz, rx, ry, rz, sx, sy, sz, gama, voln, dvol, s1, s2, s3, s4, s5, s6, dxx, dyy, dzz, d4, d5, d6, wxx, wyy, wzz)
Definition mmain.F:43
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
s4ortht3
subroutine s4ortht3(jhbe, gama, nel, r11, r12, r13, r21, r22, r23, r31, r32, r33, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4)
Definition s4orth3.F:136
s4orth3
subroutine s4orth3(jhbe, gama, nel, r11, r12, r13, r21, r22, r23, r31, r32, r33, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4)
Definition s4orth3.F:33
s4refsta3
subroutine s4refsta3(elbuf_str, ixs, pm, geo, iparg, ipm, igeo, skew, x, xrefs, nel, iparts, ipart, bufmat, mat_param, npf, tf, nummat)
Definition s4refsta3.F:49
s4defot3
subroutine s4defot3(px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, vx1, vx2, vx3, vx4, vy1, vy2, vy3, vy4, vz1, vz2, vz3, vz4, dxx, dxy, dxz, dyx, dyy, dyz, dzx, dzy, dzz)
Definition s4refsta3.F:562
s4repiso3
subroutine s4repiso3(x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, rx, ry, rz, sx, sy, sz, tx, ty, tz)
Definition s4repiso3.F:34
s4repisot3
subroutine s4repisot3(x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, rx, ry, rz, sx, sy, sz, tx, ty, tz)
Definition s4repiso3.F:96
s4rota3
subroutine s4rota3(r11, r12, r13, r21, r22, r23, r31, r32, r33, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4)
Definition s4rota3.F:32
s4rotat3
subroutine s4rotat3(r11, r12, r13, r21, r22, r23, r31, r32, r33, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4)
Definition s4rota3.F:99
s4defo3
subroutine s4defo3(px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, vx1, vx2, vx3, vx4, vy1, vy2, vy3, vy4, vz1, vz2, vz3, vz4, dxx, dxy, dxz, dyx, dyy, dyz, dzx, dzy, dzz, d4, d5, d6, wxx, wyy, wzz)
Definition s4defo3.F:34
s4deri3
subroutine s4deri3(vol, veul, geo, igeo, rx, ry, rz, sx, sy, sz, tx, ty, tz, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, jac_i, deltax, det, ngl, ngeo, mxt, pm, voldp)
Definition s4deri3.F:47
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
srho3
subroutine srho3(pm, volo, rhon, eint, dxx, dyy, dzz, voln, dvol, mat)
Definition srho3.F:31
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799