OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
agrad3.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!|| agrad3 ../starter/source/ale/ale3d/agrad3.F
25!||--- called by ------------------------------------------------------
26!|| matini ../starter/source/materials/mat_share/matini.F
27!||--- uses -----------------------------------------------------
28!||====================================================================
29 SUBROUTINE agrad3(IXS,X,ALE_CONNECTIVITY,GRAD,NEL)
30C-----------------------------------------------
31C D e s c r i p t i o n
32C-----------------------------------------------
33C This subroutine computes 3D gradients at element faces for ALE
34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37 USE ale_connectivity_mod
38 use element_mod , only : nixs
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C G l o b a l P a r a m e t e r s
45C-----------------------------------------------
46#include "mvsiz_p.inc"
47#include "com04_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER,INTENT(IN) :: NEL,IXS(NIXS,NUMELS)
52 my_real,INTENT(IN) :: x(3,numnod)
53 my_real,INTENT(INOUT) :: grad(nel,6)
54 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "vect01_c.inc"
59C-----------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62 INTEGER I, II, IE, IV1, IV2, IV3, IV4, IV5, IV6, IAD1
63 my_real x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
64 . x5(mvsiz), x6(mvsiz), x7(mvsiz), x8(mvsiz),
65 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
66 . y5(mvsiz), y6(mvsiz), y7(mvsiz), y8(mvsiz),
67 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
68 . z5(mvsiz), z6(mvsiz), z7(mvsiz), z8(mvsiz),
69 . xc(mvsiz), yc(mvsiz), zc(mvsiz),
70 . n1x(mvsiz), n2x(mvsiz), n3x(mvsiz),
71 . n4x(mvsiz), n5x(mvsiz), n6x(mvsiz),
72 . n1y(mvsiz), n2y(mvsiz), n3y(mvsiz),
73 . n4y(mvsiz), n5y(mvsiz), n6y(mvsiz),
74 . n1z(mvsiz), n2z(mvsiz), n3z(mvsiz),
75 . n4z(mvsiz), n5z(mvsiz), n6z(mvsiz),
76 . dd1(mvsiz), dd2(mvsiz), dd3(mvsiz),
77 . dd4(mvsiz), dd5(mvsiz), dd6(mvsiz),
78 . d1x(mvsiz), d2x(mvsiz), d3x(mvsiz),
79 . d4x(mvsiz), d5x(mvsiz), d6x(mvsiz),
80 . d1y(mvsiz), d2y(mvsiz), d3y(mvsiz),
81 . d4y(mvsiz), d5y(mvsiz), d6y(mvsiz),
82 . d1z(mvsiz), d2z(mvsiz), d3z(mvsiz),
83 . d4z(mvsiz), d5z(mvsiz), d6z(mvsiz)
84C-----------------------------------------------
85C C o m m o n B l o c k s
86C-----------------------------------------------
87
88C ---- COORDINATES -----------------------------
89 DO i=lft,llt
90 ii=i+nft
91 x1(i)=x(1,ixs(2,ii))
92 y1(i)=x(2,ixs(2,ii))
93 z1(i)=x(3,ixs(2,ii))
94 !
95 x2(i)=x(1,ixs(3,ii))
96 y2(i)=x(2,ixs(3,ii))
97 z2(i)=x(3,ixs(3,ii))
98 !
99 x3(i)=x(1,ixs(4,ii))
100 y3(i)=x(2,ixs(4,ii))
101 z3(i)=x(3,ixs(4,ii))
102 !
103 x4(i)=x(1,ixs(5,ii))
104 y4(i)=x(2,ixs(5,ii))
105 z4(i)=x(3,ixs(5,ii))
106 !
107 x5(i)=x(1,ixs(6,ii))
108 y5(i)=x(2,ixs(6,ii))
109 z5(i)=x(3,ixs(6,ii))
110 !
111 x6(i)=x(1,ixs(7,ii))
112 y6(i)=x(2,ixs(7,ii))
113 z6(i)=x(3,ixs(7,ii))
114 !
115 x7(i)=x(1,ixs(8,ii))
116 y7(i)=x(2,ixs(8,ii))
117 z7(i)=x(3,ixs(8,ii))
118 !
119 x8(i)=x(1,ixs(9,ii))
120 y8(i)=x(2,ixs(9,ii))
121 z8(i)=x(3,ixs(9,ii))
122 END DO
123
124C ---- NORMAL VECTORS ON FACES (*2.)------------
125 DO i=lft,llt
126 n1x(i)=(y3(i)-y1(i))*(z2(i)-z4(i)) - (z3(i)-z1(i))*(y2(i)-y4(i))
127 n1y(i)=(z3(i)-z1(i))*(x2(i)-x4(i)) - (x3(i)-x1(i))*(z2(i)-z4(i))
128 n1z(i)=(x3(i)-x1(i))*(y2(i)-y4(i)) - (y3(i)-y1(i))*(x2(i)-x4(i))
129C
130 n2x(i)=(y7(i)-y4(i))*(z3(i)-z8(i)) - (z7(i)-z4(i))*(y3(i)-y8(i))
131 n2y(i)=(z7(i)-z4(i))*(x3(i)-x8(i)) - (x7(i)-x4(i))*(z3(i)-z8(i))
132 n2z(i)=(x7(i)-x4(i))*(y3(i)-y8(i)) - (y7(i)-y4(i))*(x3(i)-x8(i))
133C
134 n3x(i)=(y6(i)-y8(i))*(z7(i)-z5(i)) - (z6(i)-z8(i))*(y7(i)-y5(i))
135 n3y(i)=(z6(i)-z8(i))*(x7(i)-x5(i)) - (x6(i)-x8(i))*(z7(i)-z5(i))
136 n3z(i)=(x6(i)-x8(i))*(y7(i)-y5(i)) - (y6(i)-y8(i))*(x7(i)-x5(i))
137C
138 n4x(i)=(y2(i)-y5(i))*(z6(i)-z1(i)) - (z2(i)-z5(i))*(y6(i)-y1(i))
139 n4y(i)=(z2(i)-z5(i))*(x6(i)-x1(i)) - (x2(i)-x5(i))*(z6(i)-z1(i))
140 n4z(i)=(x2(i)-x5(i))*(y6(i)-y1(i)) - (y2(i)-y5(i))*(x6(i)-x1(i))
141C
142 n5x(i)=(y7(i)-y2(i))*(z6(i)-z3(i)) - (z7(i)-z2(i))*(y6(i)-y3(i))
143 n5y(i)=(z7(i)-z2(i))*(x6(i)-x3(i)) - (x7(i)-x2(i))*(z6(i)-z3(i))
144 n5z(i)=(x7(i)-x2(i))*(y6(i)-y3(i)) - (y7(i)-y2(i))*(x6(i)-x3(i))
145C
146 n6x(i)=(y8(i)-y1(i))*(z4(i)-z5(i)) - (z8(i)-z1(i))*(y4(i)-y5(i))
147 n6y(i)=(z8(i)-z1(i))*(x4(i)-x5(i)) - (x8(i)-x1(i))*(z4(i)-z5(i))
148 n6z(i)=(x8(i)-x1(i))*(y4(i)-y5(i)) - (y8(i)-y1(i))*(x4(i)-x5(i))
149C
150 xc(i) = (x1(i)+x2(i)+x3(i)+x4(i)+x5(i)+x6(i)+x7(i)+x8(i))
151 yc(i) = (y1(i)+y2(i)+y3(i)+y4(i)+y5(i)+y6(i)+y7(i)+y8(i))
152 zc(i) = (z1(i)+z2(i)+z3(i)+z4(i)+z5(i)+z6(i)+z7(i)+z8(i))
153 END DO
154
155C ---- DISTANCES BETWEEN ELEMS (*8.)------------
156 DO i=lft,llt
157 ie =nft+i
158 iad1 = ale_connectivity%ee_connect%iad_connect(ie)
159 iv1 = ale_connectivity%ee_connect%connected(iad1 + 1 - 1)
160 iv2 = ale_connectivity%ee_connect%connected(iad1 + 2 - 1)
161 iv3 = ale_connectivity%ee_connect%connected(iad1 + 3 - 1)
162 iv4 = ale_connectivity%ee_connect%connected(iad1 + 4 - 1)
163 iv5 = ale_connectivity%ee_connect%connected(iad1 + 5 - 1)
164 iv6 = ale_connectivity%ee_connect%connected(iad1 + 6 - 1)
165C
166 IF(iv1 <= 0) iv1=ie
167 IF(iv2 <= 0) iv2=ie
168 IF(iv3 <= 0) iv3=ie
169 IF(iv4 <= 0) iv4=ie
170 IF(iv5 <= 0) iv5=ie
171 IF(iv6 <= 0) iv6=ie
172 d1x(i) = - xc(i)
173 . +x(1,ixs(2,iv1))+x(1,ixs(3,iv1))+x(1,ixs(4,iv1))+x(1,ixs(5,iv1))
174 . +x(1,ixs(6,iv1))+x(1,ixs(7,iv1))+x(1,ixs(8,iv1))+x(1,ixs(9,iv1))
175 d1y(i) = - yc(i)
176 . +x(2,ixs(2,iv1))+x(2,ixs(3,iv1))+x(2,ixs(4,iv1))+x(2,ixs(5,iv1))
177 . +x(2,ixs(6,iv1))+x(2,ixs(7,iv1))+x(2,ixs(8,iv1))+x(2,ixs(9,iv1))
178 d1z(i) = - zc(i)
179 . +x(3,ixs(2,iv1))+x(3,ixs(3,iv1))+x(3,ixs(4,iv1))+x(3,ixs(5,iv1))
180 . +x(3,ixs(6,iv1))+x(3,ixs(7,iv1))+x(3,ixs(8,iv1))+x(3,ixs(9,iv1))
181 d2x(i) = - xc(i)
182 . +x(1,ixs(2,iv2))+x(1,ixs(3,iv2))+x(1,ixs(4,iv2))+x(1,ixs(5,iv2))
183 . +x(1,ixs(6,iv2))+x(1,ixs(7,iv2))+x(1,ixs(8,iv2))+x(1,ixs(9,iv2))
184 d2y(i) = - yc(i)
185 . +x(2,ixs(2,iv2))+x(2,ixs(3,iv2))+x(2,ixs(4,iv2))+x(2,ixs(5,iv2))
186 . +x(2,ixs(6,iv2))+x(2,ixs(7,iv2))+x(2,ixs(8,iv2))+x(2,ixs(9,iv2))
187 d2z(i) = - zc(i)
188 . +x(3,ixs(2,iv2))+x(3,ixs(3,iv2))+x(3,ixs(4,iv2))+x(3,ixs(5,iv2))
189 . +x(3,ixs(6,iv2))+x(3,ixs(7,iv2))+x(3,ixs(8,iv2))+x(3,ixs(9,iv2))
190 d3x(i) = - xc(i)
191 . +x(1,ixs(2,iv3))+x(1,ixs(3,iv3))+x(1,ixs(4,iv3))+x(1,ixs(5,iv3))
192 . +x(1,ixs(6,iv3))+x(1,ixs(7,iv3))+x(1,ixs(8,iv3))+x(1,ixs(9,iv3))
193 d3y(i) = - yc(i)
194 . +x(2,ixs(2,iv3))+x(2,ixs(3,iv3))+x(2,ixs(4,iv3))+x(2,ixs(5,iv3))
195 . +x(2,ixs(6,iv3))+x(2,ixs(7,iv3))+x(2,ixs(8,iv3))+x(2,ixs(9,iv3))
196 d3z(i) = - zc(i)
197 . +x(3,ixs(2,iv3))+x(3,ixs(3,iv3))+x(3,ixs(4,iv3))+x(3,ixs(5,iv3))
198 . +x(3,ixs(6,iv3))+x(3,ixs(7,iv3))+x(3,ixs(8,iv3))+x(3,ixs(9,iv3))
199 d4x(i) = - xc(i)
200 . +x(1,ixs(2,iv4))+x(1,ixs(3,iv4))+x(1,ixs(4,iv4))+x(1,ixs(5,iv4))
201 . +x(1,ixs(6,iv4))+x(1,ixs(7,iv4))+x(1,ixs(8,iv4))+x(1,ixs(9,iv4))
202 d4y(i) = - yc(i)
203 . +x(2,ixs(2,iv4))+x(2,ixs(3,iv4))+x(2,ixs(4,iv4))+x(2,ixs(5,iv4))
204 . +x(2,ixs(6,iv4))+x(2,ixs(7,iv4))+x(2,ixs(8,iv4))+x(2,ixs(9,iv4))
205 d4z(i) = - zc(i)
206 . +x(3,ixs(2,iv4))+x(3,ixs(3,iv4))+x(3,ixs(4,iv4))+x(3,ixs(5,iv4))
207 . +x(3,ixs(6,iv4))+x(3,ixs(7,iv4))+x(3,ixs(8,iv4))+x(3,ixs(9,iv4))
208 d5x(i) = - xc(i)
209 . +x(1,ixs(2,iv5))+x(1,ixs(3,iv5))+x(1,ixs(4,iv5))+x(1,ixs(5,iv5))
210 . +x(1,ixs(6,iv5))+x(1,ixs(7,iv5))+x(1,ixs(8,iv5))+x(1,ixs(9,iv5))
211 d5y(i) = - yc(i)
212 . +x(2,ixs(2,iv5))+x(2,ixs(3,iv5))+x(2,ixs(4,iv5))+x(2,ixs(5,iv5))
213 . +x(2,ixs(6,iv5))+x(2,ixs(7,iv5))+x(2,ixs(8,iv5))+x(2,ixs(9,iv5))
214 d5z(i) = - zc(i)
215 . +x(3,ixs(2,iv5))+x(3,ixs(3,iv5))+x(3,ixs(4,iv5))+x(3,ixs(5,iv5))
216 . +x(3,ixs(6,iv5))+x(3,ixs(7,iv5))+x(3,ixs(8,iv5))+x(3,ixs(9,iv5))
217 d6x(i) = - xc(i)
218 . +x(1,ixs(2,iv6))+x(1,ixs(3,iv6))+x(1,ixs(4,iv6))+x(1,ixs(5,iv6))
219 . +x(1,ixs(6,iv6))+x(1,ixs(7,iv6))+x(1,ixs(8,iv6))+x(1,ixs(9,iv6))
220 d6y(i) = - yc(i)
221 . +x(2,ixs(2,iv6))+x(2,ixs(3,iv6))+x(2,ixs(4,iv6))+x(2,ixs(5,iv6))
222 . +x(2,ixs(6,iv6))+x(2,ixs(7,iv6))+x(2,ixs(8,iv6))+x(2,ixs(9,iv6))
223 d6z(i) = - zc(i)
224 . +x(3,ixs(2,iv6))+x(3,ixs(3,iv6))+x(3,ixs(4,iv6))+x(3,ixs(5,iv6))
225 . +x(3,ixs(6,iv6))+x(3,ixs(7,iv6))+x(3,ixs(8,iv6))+x(3,ixs(9,iv6))
226 END DO
227
228 DO i=lft,llt
229 dd1(i)=d1x(i)**2+d1y(i)**2+d1z(i)**2
230 dd2(i)=d2x(i)**2+d2y(i)**2+d2z(i)**2
231 dd3(i)=d3x(i)**2+d3y(i)**2+d3z(i)**2
232 dd4(i)=d4x(i)**2+d4y(i)**2+d4z(i)**2
233 dd5(i)=d5x(i)**2+d5y(i)**2+d5z(i)**2
234 dd6(i)=d6x(i)**2+d6y(i)**2+d6z(i)**2
235 END DO
236
237C ---- GRADIENT * SURFACE-----------------------
238 DO i=lft,llt
239!! warning: GRAD --> SIG within buffer
240 grad(i,1)= four*(d1x(i)*n1x(i)+d1y(i)*n1y(i)+d1z(i)*n1z(i)) / max(em15,dd1(i))
241 grad(i,2)= four*(d2x(i)*n2x(i)+d2y(i)*n2y(i)+d2z(i)*n2z(i)) / max(em15,dd2(i))
242 grad(i,3)= four*(d3x(i)*n3x(i)+d3y(i)*n3y(i)+d3z(i)*n3z(i)) / max(em15,dd3(i))
243 grad(i,4)= four*(d4x(i)*n4x(i)+d4y(i)*n4y(i)+d4z(i)*n4z(i)) / max(em15,dd4(i))
244 grad(i,5)= four*(d5x(i)*n5x(i)+d5y(i)*n5y(i)+d5z(i)*n5z(i)) / max(em15,dd5(i))
245 grad(i,6)= four*(d6x(i)*n6x(i)+d6y(i)*n6y(i)+d6z(i)*n6z(i)) / max(em15,dd6(i))
246 END DO
247C-----------------------------------------------
248 RETURN
249 END
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
ale_connectivity_mod
Definition ale_connectivity_mod.F:225
agrad3
subroutine agrad3(ixs, x, ale_connectivity, grad, nel)
Definition agrad3.F:30
ale_connectivity_mod::t_ale_connectivity
Definition ale_connectivity_mod.F:256