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