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)
80C REAL
81 my_real
82 . X21GA, Y21GA, Z21GA, X31GA, Y31GA, Z31GA,
83 . X41GA, Y41GA, Z41GA
84C-----------------------------------------------
85 DO i=1,6
86 ii(i) = nel*(i-1)
87 ENDDO
88C
89 DO i=jft,jlt
90 sti(i) = zero
91 stir(i)= zero
92 x21ga=x2g(i)-x1g(i)
93 y21ga=y2g(i)-y1g(i)
94 z21ga=z2g(i)-z1g(i)
95 x31ga=x3g(i)-x1g(i)
96 y31ga=y3g(i)-y1g(i)
97 z31ga=z3g(i)-z1g(i)
98 x41ga=x4g(i)-x1g(i)
99 y41ga=y4g(i)-y1g(i)
100 z41ga=z4g(i)-z1g(i)
101C
102 x2(i)=e1x(i)*x21ga+e1y(i)*y21ga+e1z(i)*z21ga
103 y2(i)=e2x(i)*x21ga+e2y(i)*y21ga+e2z(i)*z21ga
104 y3(i)=e2x(i)*x31ga+e2y(i)*y31ga+e2z(i)*z31ga
105 x3(i)=e1x(i)*x31ga+e1y(i)*y31ga+e1z(i)*z31ga
106 x4(i)=e1x(i)*x41ga+e1y(i)*y41ga+e1z(i)*z41ga
107 y4(i)=e2x(i)*x41ga+e2y(i)*y41ga+e2z(i)*z41ga
108 z2(i)=e3x(i)*x21ga+e3y(i)*y21ga+e3z(i)*z21ga
109 ENDDO
110C
111 IF (ismstr == 11) THEN
112 DO i=jft,jlt
113 IF(abs(offg(i)) == one)offg(i)=sign(two,offg(i))
114 ux1(i) = zero
115 uy1(i) = zero
116 ux2(i) = zero
117 uy2(i) = zero
118 ux3(i) = zero
119 uy3(i) = zero
120 ux4(i) = zero
121 uy4(i) = zero
122 IF(abs(offg(i)) == two)THEN
123 ux2(i) = x2(i)-smstr(ii(1)+i)
124 uy2(i) = y2(i)-smstr(ii(2)+i)
125 ux3(i) = x3(i)-smstr(ii(3)+i)
126 uy3(i) = y3(i)-smstr(ii(4)+i)
127 ux4(i) = x4(i)-smstr(ii(5)+i)
128 uy4(i) = y4(i)-smstr(ii(6)+i)
129 x2(i) = smstr(ii(1)+i)
130 y2(i) = smstr(ii(2)+i)
131 x3(i) = smstr(ii(3)+i)
132 y3(i) = smstr(ii(4)+i)
133 x4(i) = smstr(ii(5)+i)
134 y4(i) = smstr(ii(6)+i)
135 z2(i) = zero
136 ELSE
137 smstr(ii(1)+i)=x2(i)
138 smstr(ii(2)+i)=y2(i)
139 smstr(ii(3)+i)=x3(i)
140 smstr(ii(4)+i)=y3(i)
141 smstr(ii(5)+i)=x4(i)
142 smstr(ii(6)+i)=y4(i)
143 ENDIF
144 ENDDO
145 ELSEIF(ismstr == 1.OR.ismstr == 2)THEN
146 DO i=jft,jlt
147 IF(abs(offg(i)) == two)THEN
148 x2(i)=smstr(ii(1)+i)
149 y2(i)=smstr(ii(2)+i)
150 x3(i)=smstr(ii(3)+i)
151 y3(i)=smstr(ii(4)+i)
152 x4(i)=smstr(ii(5)+i)
153 y4(i)=smstr(ii(6)+i)
154 z2(i)=zero
155 ELSE
156 smstr(ii(1)+i)=x2(i)
157 smstr(ii(2)+i)=y2(i)
158 smstr(ii(3)+i)=x3(i)
159 smstr(ii(4)+i)=y3(i)
160 smstr(ii(5)+i)=x4(i)
161 smstr(ii(6)+i)=y4(i)
162 ENDIF
163 ENDDO
164 IF (ismstr == 1) THEN
165 DO i=jft,jlt
166 IF (offg(i) == one) offg(i)=two
167 ENDDO
168 ENDIF
169 ENDIF
170C
171 DO 40 i=jft,jlt
172 px1(i)= half*(y2(i)-y4(i))
173 py1(i)= half*(x4(i)-x2(i))
174 px2(i)= half* y3(i)
175 py2(i)=-half* x3(i)
176 40 CONTINUE
177C
178 DO i=jft,jlt
179 area(i)= max(two*(py2(i)*px1(i)-py1(i)*px2(i)),em20)
180 a_i(i) = one / area(i)
181 ENDDO
182C
183C CALCULATION FOR HOURGLASS VECTORS
184C
185 DO i=jft,jlt
186 vhx(i)=(-x2(i)+x3(i)-x4(i))/area(i)
187 vhy(i)=(-y2(i)+y3(i)-y4(i))/area(i)
188 ENDDO
189C-----------
190 RETURN
191 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