OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cderi3.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!|| cderi3 ../engine/source/elements/shell/coque/cderi3.F
25!||--- called by ------------------------------------------------------
26!|| cforc3 ../engine/source/elements/shell/coque/cforc3.F
27!|| cforc3_crk ../engine/source/elements/xfem/cforc3_crk.F
28!||====================================================================
29 SUBROUTINE cderi3(
30 1 JFT, JLT, SMSTR, OFFG,
31 2 STI, STIR, AREA, PX1,
32 3 PX2, PY1, PY2, X2,
33 4 X3, X4, Y2, Y3,
34 5 Y4, Z2, X1G, X2G,
35 6 X3G, X4G, Y1G, Y2G,
36 7 Y3G, Y4G, Z1G, Z2G,
37 8 Z3G, Z4G, E1X, E1Y,
38 9 E1Z, E2X, E2Y, E2Z,
39 A E3X, E3Y, E3Z, VHX,
40 B VHY, A_I, UX1, UX2,
41 C UX3, UX4, UY1, UY2,
42 D UY3, UY4, NEL, ISMSTR)
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 D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER, INTENT(IN) :: ISMSTR
55 INTEGER JFT, JLT,NEL
56 my_real
57 . PX1(*), PX2(*), PY1(*), PY2(*),
58 . OFFG(*),STI(*), STIR(*)
59 my_real
60 . X2(MVSIZ), X3(MVSIZ), X4(MVSIZ),AREA(MVSIZ),
61 . Y2(MVSIZ), Y3(MVSIZ), Y4(MVSIZ), Z2(MVSIZ),
62 . X1G(MVSIZ), X2G(MVSIZ), X3G(MVSIZ), X4G(MVSIZ),
63 . Y1G(MVSIZ), Y2G(MVSIZ), Y3G(MVSIZ), Y4G(MVSIZ),
64 . Z1G(MVSIZ), Z2G(MVSIZ), Z3G(MVSIZ), Z4G(MVSIZ),
65 . E1X(MVSIZ), E1Y(MVSIZ), E1Z(MVSIZ),
66 . E2X(MVSIZ), E2Y(MVSIZ), E2Z(MVSIZ),
67 . e3x(mvsiz), e3y(mvsiz), e3z(mvsiz),
68 . vhx(mvsiz), vhy(mvsiz), a_i(mvsiz),
69 . ux1(mvsiz),ux2(mvsiz),ux3(mvsiz),ux4(mvsiz),
70 . uy1(mvsiz),uy2(mvsiz),uy3(mvsiz),uy4(mvsiz)
71 double precision
72 . smstr(*)
73C-----------------------------------------------
74C C o m m o n B l o c k s
75C-----------------------------------------------
76C-----------------------------------------------
77C L o c a l V a r i a b l e s
78C-----------------------------------------------
79 INTEGER I,II(6),J
80C REAL
81 my_real
82 . X21G(MVSIZ), Y21G(MVSIZ), Z21G(MVSIZ), X31G(MVSIZ),
83 . Y31G(MVSIZ), Z31G(MVSIZ),
84 . x41g(mvsiz), y41g(mvsiz), z41g(mvsiz)
85 my_real
86 . x21ga, y21ga, z21ga, x31ga, y31ga, z31ga,
87 . x41ga, y41ga, z41ga
88C-----------------------------------------------
89 DO i=1,6
90 ii(i) = nel*(i-1)
91 ENDDO
92C
93 DO i=jft,jlt
94 sti(i) = zero
95 stir(i)= zero
96 x21ga=x2g(i)-x1g(i)
97 y21ga=y2g(i)-y1g(i)
98 z21ga=z2g(i)-z1g(i)
99 x31ga=x3g(i)-x1g(i)
100 y31ga=y3g(i)-y1g(i)
101 z31ga=z3g(i)-z1g(i)
102 x41ga=x4g(i)-x1g(i)
103 y41ga=y4g(i)-y1g(i)
104 z41ga=z4g(i)-z1g(i)
105C
106 x2(i)=e1x(i)*x21ga+e1y(i)*y21ga+e1z(i)*z21ga
107 y2(i)=e2x(i)*x21ga+e2y(i)*y21ga+e2z(i)*z21ga
108 y3(i)=e2x(i)*x31ga+e2y(i)*y31ga+e2z(i)*z31ga
109 x3(i)=e1x(i)*x31ga+e1y(i)*y31ga+e1z(i)*z31ga
110 x4(i)=e1x(i)*x41ga+e1y(i)*y41ga+e1z(i)*z41ga
111 y4(i)=e2x(i)*x41ga+e2y(i)*y41ga+e2z(i)*z41ga
112 z2(i)=e3x(i)*x21ga+e3y(i)*y21ga+e3z(i)*z21ga
113 ENDDO
114C
115 IF (ismstr == 11) THEN
116 DO i=jft,jlt
117 IF(abs(offg(i)) == one)offg(i)=sign(two,offg(i))
118 ux1(i) = zero
119 uy1(i) = zero
120 ux2(i) = zero
121 uy2(i) = zero
122 ux3(i) = zero
123 uy3(i) = zero
124 ux4(i) = zero
125 uy4(i) = zero
126 IF(abs(offg(i)) == two)THEN
127 ux2(i) = x2(i)-smstr(ii(1)+i)
128 uy2(i) = y2(i)-smstr(ii(2)+i)
129 ux3(i) = x3(i)-smstr(ii(3)+i)
130 uy3(i) = y3(i)-smstr(ii(4)+i)
131 ux4(i) = x4(i)-smstr(ii(5)+i)
132 uy4(i) = y4(i)-smstr(ii(6)+i)
133 x2(i) = smstr(ii(1)+i)
134 y2(i) = smstr(ii(2)+i)
135 x3(i) = smstr(ii(3)+i)
136 y3(i) = smstr(ii(4)+i)
137 x4(i) = smstr(ii(5)+i)
138 y4(i) = smstr(ii(6)+i)
139 z2(i) = zero
140 ELSE
141 smstr(ii(1)+i)=x2(i)
142 smstr(ii(2)+i)=y2(i)
143 smstr(ii(3)+i)=x3(i)
144 smstr(ii(4)+i)=y3(i)
145 smstr(ii(5)+i)=x4(i)
146 smstr(ii(6)+i)=y4(i)
147 ENDIF
148 ENDDO
149 ELSEIF(ismstr == 1.OR.ismstr == 2)THEN
150 DO i=jft,jlt
151 IF(abs(offg(i)) == two)THEN
152 x2(i)=smstr(ii(1)+i)
153 y2(i)=smstr(ii(2)+i)
154 x3(i)=smstr(ii(3)+i)
155 y3(i)=smstr(ii(4)+i)
156 x4(i)=smstr(ii(5)+i)
157 y4(i)=smstr(ii(6)+i)
158 z2(i)=zero
159 ELSE
160 smstr(ii(1)+i)=x2(i)
161 smstr(ii(2)+i)=y2(i)
162 smstr(ii(3)+i)=x3(i)
163 smstr(ii(4)+i)=y3(i)
164 smstr(ii(5)+i)=x4(i)
165 smstr(ii(6)+i)=y4(i)
166 ENDIF
167 ENDDO
168 IF (ismstr == 1) THEN
169 DO i=jft,jlt
170 IF (offg(i) == one) offg(i)=two
171 ENDDO
172 ENDIF
173 ENDIF
174C
175 DO 40 i=jft,jlt
176 px1(i)= half*(y2(i)-y4(i))
177 py1(i)= half*(x4(i)-x2(i))
178 px2(i)= half* y3(i)
179 py2(i)=-half* x3(i)
180 40 CONTINUE
181C
182 DO i=jft,jlt
183 area(i)= max(two*(py2(i)*px1(i)-py1(i)*px2(i)),em20)
184 a_i(i) = one / area(i)
185 ENDDO
186C
187C CALCUL POUR VECTEURS HOURGLASS
188C
189 DO i=jft,jlt
190 vhx(i)=(-x2(i)+x3(i)-x4(i))/area(i)
191 vhy(i)=(-y2(i)+y3(i)-y4(i))/area(i)
192 ENDDO
193C-----------
194 RETURN
195 END
cderi3
subroutine cderi3(jft, jlt, smstr, offg, sti, stir, area, px1, px2, py1, py2, x2, x3, x4, y2, y3, y4, z2, x1g, x2g, x3g, x4g, y1g, y2g, y3g, y4g, z1g, z2g, z3g, z4g, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, vhx, vhy, a_i, ux1, ux2, ux3, ux4, uy1, uy2, uy3, uy4, nel, ismstr)
Definition cderi3.F:43
max
#define max(a, b)
Definition macros.h:21