OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s6cderi3.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/.
23C
24!||====================================================================
25!|| s6cderi3 ../starter/source/elements/thickshell/solide6c/s6cderi3.F
26!||--- called by ------------------------------------------------------
27!|| s6cinit3 ../starter/source/elements/thickshell/solide6c/s6cinit3.F
28!|| s6zinit3 ../starter/source/elements/solid/solide6z/s6zinit3.F90
29!||--- calls -----------------------------------------------------
30!|| ancmsg ../starter/source/output/message/message.F
31!|| slen ../starter/source/elements/solid/solide/slen.F
32!||--- uses -----------------------------------------------------
33!|| message_mod ../starter/share/message_module/message_mod.F
34!||====================================================================
35 SUBROUTINE s6cderi3(NEL ,VOL ,GEO ,VZL ,NGL, DELTAX, DET,
36 . X1, X2, X3, X4, X5, X6,
37 . Y1, Y2, Y3, Y4, Y5, Y6,
38 . Z1, Z2, Z3, Z4, Z5, Z6)
39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE message_mod
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C G l o b a l P a r a m e t e r s
49C-----------------------------------------------
50#include "mvsiz_p.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "param_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER NEL,NGL(*)
59 my_real
60 . VOL(*), GEO(NPROPG,*),VZL(*), DELTAX(*), DET(*)
61 my_real
62 . x1(*), x2(*), x3(*), x4(*), x5(*), x6(*),
63 . y1(*), y2(*), y3(*), y4(*), y5(*), y6(*),
64 . z1(*), z2(*), z3(*), z4(*), z5(*), z6(*)
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER I, NFAC
69 my_real
70 . X21(MVSIZ) , X31(MVSIZ) , X41(MVSIZ) , X54(MVSIZ),X64(MVSIZ),
71 . y21(mvsiz) , y31(mvsiz) , y41(mvsiz) , y54(mvsiz),y64(mvsiz),
72 . z21(mvsiz) , z31(mvsiz) , z41(mvsiz) , z54(mvsiz),z64(mvsiz),
73 . jac1(mvsiz), jac2(mvsiz) ,jac3(mvsiz),
74 . jac4(mvsiz), jac5(mvsiz) ,jac6(mvsiz),
75 . jac7(mvsiz), jac8(mvsiz) ,jac9(mvsiz),
76 . jac_59_68(mvsiz), jac_67_49(mvsiz), jac_48_57(mvsiz)
77
78 my_real
79 . xioff(mvsiz), aream(mvsiz),
80 . atest(mvsiz), area(6,mvsiz)
81
82C=======================================================================
83
84 DO i=1,nel
85 x21(i)=x2(i)-x1(i)
86 x31(i)=x3(i)-x1(i)
87 x41(i)=x4(i)-x1(i)
88 x54(i)=x5(i)-x4(i)
89 x64(i)=x6(i)-x4(i)
90C
91 y21(i)=y2(i)-y1(i)
92 y31(i)=y3(i)-y1(i)
93 y41(i)=y4(i)-y1(i)
94 y54(i)=y5(i)-y4(i)
95 y64(i)=y6(i)-y4(i)
96C
97 z21(i)=z2(i)-z1(i)
98 z31(i)=z3(i)-z1(i)
99 z41(i)=z4(i)-z1(i)
100 z54(i)=z5(i)-z4(i)
101 z64(i)=z6(i)-z4(i)
102 ENDDO
103
104 DO i=1,nel
105C-------ri.xi---->ksi--------
106 jac1(i)=x21(i)+x54(i)
107 jac2(i)=y21(i)+y54(i)
108 jac3(i)=z21(i)+z54(i)
109 ENDDO
110
111 DO i=1,nel
112C-------si.xi--->eta--------
113 jac4(i)=x31(i)+x64(i)
114 jac5(i)=y31(i)+y64(i)
115 jac6(i)=z31(i)+z64(i)
116C-------ti.xi----zeta-------
117 jac7(i)=third*(x41(i)+x5(i)-x2(i)+x6(i)-x3(i))
118 jac8(i)=third*(y41(i)+y5(i)-y2(i)+y6(i)-y3(i))
119 jac9(i)=third*(z41(i)+z5(i)-z2(i)+z6(i)-z3(i))
120 ENDDO
121
122 DO i=1,nel
123 jac_59_68(i)=jac5(i)*jac9(i)-jac6(i)*jac8(i)
124 jac_67_49(i)=jac6(i)*jac7(i)-jac4(i)*jac9(i)
125 jac_48_57(i)=jac4(i)*jac8(i)-jac5(i)*jac7(i)
126 ENDDO
127C
128 DO i=1,nel
129 det(i)=one_over_8*(jac1(i)*jac_59_68(i)+jac2(i)*jac_67_49(i)+jac3(i)*jac_48_57(i))
130 vol(i)=det(i)
131 ENDDO
132C
133 DO i=1,nel
134 IF(det(i)>zero) cycle
135 CALL ancmsg(msgid=245,
136 . msgtype=msgerror,
137 . anmode=aninfo,
138 . i1=ngl(i))
139 ENDDO
140
141 DO i=1,nel
142 vzl(i) = fourth*(jac9(i)*(x54(i)*y64(i)-x21(i)*y31(i)-x64(i)*y54(i)+x31(i)*y21(i))
143 . -jac8(i)*(x54(i)*z64(i)+x31(i)*z21(i)-x21(i)*z31(i)-x64(i)*z54(i))
144 . +jac7(i)*(y54(i)*z64(i)+y31(i)*z21(i)-y21(i)*z31(i)-y64(i)*z54(i)))
145C
146 ENDDO
147 DO i=1,nel
148 xioff(i)=one
149 aream(i)=zero
150 ENDDO
151C
152 CALL slen(x1,x2,x5,x4,y1,y2,y4,y5,z1,z2,z5,z4,1, area, aream)
153 CALL slen(x2,x5,x6,x3,y2,y5,y6,y3,z2,z5,z6,z3,2, area, aream)
154 CALL slen(x1,x4,x6,x3,y1,y4,y6,y3,z1,z4,z6,z3,3, area, aream)
155 CALL slen(x1,x2,x3,x3,y1,y2,y3,y3,z1,z2,z3,z3,4, area, aream)
156 CALL slen(x4,x5,x6,x6,y4,y5,y6,y6,z4,z5,z6,z6,5, area, aream)
157C
158 DO i=1,nel
159 atest(i)=em4*aream(i)
160 nfac=0
161 IF(area(1,i)<atest(i)) nfac=nfac+1
162 IF(area(2,i)<atest(i)) nfac=nfac+1
163 IF(area(3,i)<atest(i)) nfac=nfac+1
164 IF(area(4,i)<atest(i)) nfac=nfac+1
165 IF(area(5,i)<atest(i)) nfac=nfac+1
166 IF(nfac>=2) xioff(i)=ep03
167 ENDDO
168 DO i=1,nel
169 deltax(i)=four*det(i)*xioff(i)/sqrt(aream(i))
170 ENDDO
171C---
172 RETURN
173 END SUBROUTINE s6cderi3
subroutine area(d1, x, x2, y, y2, eint, stif0)
subroutine slen(x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, j, area, aream)
Definition slen.F:31
subroutine s6cderi3(nel, vol, geo, vzl, ngl, deltax, det, x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6, z1, z2, z3, z4, z5, z6)
Definition s6cderi3.F:39
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