OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
egrad3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "vect01_c.inc"
#include "tabsiz_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine egrad3 (ixs, x, ale_connect, grad, veul)

Function/Subroutine Documentation

◆ egrad3()

subroutine egrad3 ( integer, dimension(nixs,sixs/nixs), intent(in) ixs,
dimension(3,sx/3), intent(in) x,
type(t_ale_connectivity), intent(in) ale_connect,
dimension(6,*), intent(inout) grad,
dimension(lveul,*), intent(in) veul )

Definition at line 30 of file egrad3.F.

31C-----------------------------------------------
32C M o d u l e s
33C-----------------------------------------------
34 USE ale_connectivity_mod
35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39C-----------------------------------------------
40C G l o b a l P a r a m e t e r s
41C-----------------------------------------------
42#include "mvsiz_p.inc"
43C-----------------------------------------------
44C C o m m o n B l o c k s
45C-----------------------------------------------
46#include "param_c.inc"
47#include "vect01_c.inc"
48#include "tabsiz_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52! SPMD CASE : SIXS >= NIXS*NUMELS (SIXS = NIXQ*NUMELS_L+NIXS*NQVOIS_L)
53! IXS(1:NIXS, 1:NUMELS) local elems
54! (1:NIXS, NUMELQ+1:) additional elems (also on adjacent domains but connected to the boundary of the current domain)
55!
56! SPMD CASE : SX >= 3*NUMNOD (SX = 3*(NUMNOD_L+NRCVVOIS_L))
57! X(1:3,1:NUMNOD) : local nodes
58! (1:3, NUMNOD+1:) additional nodes (also on adjacent domains but connected to the boundary of the current domain)
59C-----------------------------------------------
60 INTEGER,INTENT(IN) :: IXS(NIXS,SIXS/NIXS)
61 my_real,INTENT(IN) :: x(3,sx/3), veul(lveul,*)
62 my_real,INTENT(INOUT) :: grad(6,*)
63 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
64C-----------------------------------------------
65C L o c a l V a r i a b l e s
66C-----------------------------------------------
67 INTEGER I, II, IE, IV1, IV2, IV3, IV4, IV5, IV6
68 my_real x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz), x5(mvsiz), x6(mvsiz), x7(mvsiz), x8(mvsiz),
69 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz), y5(mvsiz), y6(mvsiz), y7(mvsiz), y8(mvsiz), z1(mvsiz),
70 . z2(mvsiz), z3(mvsiz), z4(mvsiz), z5(mvsiz), z6(mvsiz), z7(mvsiz), z8(mvsiz), xc(mvsiz), yc(mvsiz),
71 . zc(mvsiz), n1x(mvsiz), n2x(mvsiz), n3x(mvsiz), n4x(mvsiz), n5x(mvsiz), n6x(mvsiz), n1y(mvsiz),
72 . n2y(mvsiz), n3y(mvsiz), n4y(mvsiz), n5y(mvsiz), n6y(mvsiz), n1z(mvsiz), n2z(mvsiz), n3z(mvsiz),
73 . n4z(mvsiz), n5z(mvsiz), n6z(mvsiz), dd1(mvsiz), dd2(mvsiz), dd3(mvsiz), dd4(mvsiz), dd5(mvsiz),
74 . dd6(mvsiz), d1x(mvsiz), d2x(mvsiz), d3x(mvsiz), d4x(mvsiz), d5x(mvsiz), d6x(mvsiz), d1y(mvsiz),
75 . d2y(mvsiz), d3y(mvsiz), d4y(mvsiz), d5y(mvsiz), d6y(mvsiz), d1z(mvsiz), d2z(mvsiz), d3z(mvsiz),
76 . d4z(mvsiz), d5z(mvsiz), d6z(mvsiz)
77 INTEGER :: IAD2
78C-----------------------------------------------
79C S o u r c e L i n e s
80C-----------------------------------------------
81 DO i=lft,llt
82 ii=i+nft
83 x1(i)=x(1,ixs(2,ii))
84 y1(i)=x(2,ixs(2,ii))
85 z1(i)=x(3,ixs(2,ii))
86
87 x2(i)=x(1,ixs(3,ii))
88 y2(i)=x(2,ixs(3,ii))
89 z2(i)=x(3,ixs(3,ii))
90
91 x3(i)=x(1,ixs(4,ii))
92 y3(i)=x(2,ixs(4,ii))
93 z3(i)=x(3,ixs(4,ii))
94
95 x4(i)=x(1,ixs(5,ii))
96 y4(i)=x(2,ixs(5,ii))
97 z4(i)=x(3,ixs(5,ii))
98
99 x5(i)=x(1,ixs(6,ii))
100 y5(i)=x(2,ixs(6,ii))
101 z5(i)=x(3,ixs(6,ii))
102
103 x6(i)=x(1,ixs(7,ii))
104 y6(i)=x(2,ixs(7,ii))
105 z6(i)=x(3,ixs(7,ii))
106
107 x7(i)=x(1,ixs(8,ii))
108 y7(i)=x(2,ixs(8,ii))
109 z7(i)=x(3,ixs(8,ii))
110
111 x8(i)=x(1,ixs(9,ii))
112 y8(i)=x(2,ixs(9,ii))
113 z8(i)=x(3,ixs(9,ii))
114 ENDDO
115C-------------------------------------------
116C NORMAL VECTORS ( N = 2S.n where |n|=1)
117C-------------------------------------------
118 DO i=lft,llt
119 ii=i+nft
120
121 n1x(i)=veul(14,ii)
122 n2x(i)=veul(15,ii)
123 n3x(i)=veul(16,ii)
124 n4x(i)=veul(17,ii)
125 n5x(i)=veul(18,ii)
126 n6x(i)=veul(19,ii)
127
128 n1y(i)=veul(20,ii)
129 n2y(i)=veul(21,ii)
130 n3y(i)=veul(22,ii)
131 n4y(i)=veul(23,ii)
132 n5y(i)=veul(24,ii)
133 n6y(i)=veul(25,ii)
134
135 n1z(i)=veul(26,ii)
136 n2z(i)=veul(27,ii)
137 n3z(i)=veul(28,ii)
138 n4z(i)=veul(29,ii)
139 n5z(i)=veul(30,ii)
140 n6z(i)=veul(31,ii)
141
142 xc(i) = (x1(i)+x2(i)+x3(i)+x4(i)+x5(i)+x6(i)+x7(i)+x8(i))
143 yc(i) = (y1(i)+y2(i)+y3(i)+y4(i)+y5(i)+y6(i)+y7(i)+y8(i))
144 zc(i) = (z1(i)+z2(i)+z3(i)+z4(i)+z5(i)+z6(i)+z7(i)+z8(i))
145 ENDDO
146C------------------------------------------
147C DISTANCE BETWEEN ELEMS ( * 8. )
148C------------------------------------------
149 DO i=lft,llt
150 ie =nft+i
151 iad2 = ale_connect%ee_connect%iad_connect(ie)
152 iv1 = ale_connect%ee_connect%connected(iad2 + 1 - 1)
153 IF(iv1 <= 0) iv1=ie
154 d1x(i) = - xc(i)
155 . +x(1,ixs(2,iv1))+x(1,ixs(3,iv1))+x(1,ixs(4,iv1))+x(1,ixs(5,iv1))
156 . +x(1,ixs(6,iv1))+x(1,ixs(7,iv1))+x(1,ixs(8,iv1))+x(1,ixs(9,iv1))
157 d1y(i) = - yc(i)
158 . +x(2,ixs(2,iv1))+x(2,ixs(3,iv1))+x(2,ixs(4,iv1))+x(2,ixs(5,iv1))
159 . +x(2,ixs(6,iv1))+x(2,ixs(7,iv1))+x(2,ixs(8,iv1))+x(2,ixs(9,iv1))
160 d1z(i) = - zc(i)
161 . +x(3,ixs(2,iv1))+x(3,ixs(3,iv1))+x(3,ixs(4,iv1))+x(3,ixs(5,iv1))
162 . +x(3,ixs(6,iv1))+x(3,ixs(7,iv1))+x(3,ixs(8,iv1))+x(3,ixs(9,iv1))
163 ENDDO
164 DO i=lft,llt
165 ie =nft+i
166 iad2 = ale_connect%ee_connect%iad_connect(ie)
167 iv2 = ale_connect%ee_connect%connected(iad2 + 2 - 1)
168 IF(iv2 <= 0) iv2=ie
169 d2x(i) = - xc(i)
170 . +x(1,ixs(2,iv2))+x(1,ixs(3,iv2))+x(1,ixs(4,iv2))+x(1,ixs(5,iv2))
171 . +x(1,ixs(6,iv2))+x(1,ixs(7,iv2))+x(1,ixs(8,iv2))+x(1,ixs(9,iv2))
172 d2y(i) = - yc(i)
173 . +x(2,ixs(2,iv2))+x(2,ixs(3,iv2))+x(2,ixs(4,iv2))+x(2,ixs(5,iv2))
174 . +x(2,ixs(6,iv2))+x(2,ixs(7,iv2))+x(2,ixs(8,iv2))+x(2,ixs(9,iv2))
175 d2z(i) = - zc(i)
176 . +x(3,ixs(2,iv2))+x(3,ixs(3,iv2))+x(3,ixs(4,iv2))+x(3,ixs(5,iv2))
177 . +x(3,ixs(6,iv2))+x(3,ixs(7,iv2))+x(3,ixs(8,iv2))+x(3,ixs(9,iv2))
178 ENDDO
179 DO i=lft,llt
180 ie =nft+i
181 iad2 = ale_connect%ee_connect%iad_connect(ie)
182 iv3 = ale_connect%ee_connect%connected(iad2 + 3 - 1)
183 IF(iv3 <= 0) iv3=ie
184 d3x(i) = - xc(i)
185 . +x(1,ixs(2,iv3))+x(1,ixs(3,iv3))+x(1,ixs(4,iv3))+x(1,ixs(5,iv3))
186 . +x(1,ixs(6,iv3))+x(1,ixs(7,iv3))+x(1,ixs(8,iv3))+x(1,ixs(9,iv3))
187 d3y(i) = - yc(i)
188 . +x(2,ixs(2,iv3))+x(2,ixs(3,iv3))+x(2,ixs(4,iv3))+x(2,ixs(5,iv3))
189 . +x(2,ixs(6,iv3))+x(2,ixs(7,iv3))+x(2,ixs(8,iv3))+x(2,ixs(9,iv3))
190 d3z(i) = - zc(i)
191 . +x(3,ixs(2,iv3))+x(3,ixs(3,iv3))+x(3,ixs(4,iv3))+x(3,ixs(5,iv3))
192 . +x(3,ixs(6,iv3))+x(3,ixs(7,iv3))+x(3,ixs(8,iv3))+x(3,ixs(9,iv3))
193 ENDDO
194 DO i=lft,llt
195 ie =nft+i
196 iad2 = ale_connect%ee_connect%iad_connect(ie)
197 iv4 = ale_connect%ee_connect%connected(iad2 + 4 - 1)
198 IF(iv4 <= 0) iv4=ie
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 ENDDO
209 DO i=lft,llt
210 ie =nft+i
211 iad2 = ale_connect%ee_connect%iad_connect(ie)
212 iv5 = ale_connect%ee_connect%connected(iad2 + 5 - 1)
213 IF(iv5 <= 0) iv5=ie
214 d5x(i) = - xc(i)
215 . +x(1,ixs(2,iv5))+x(1,ixs(3,iv5))+x(1,ixs(4,iv5))+x(1,ixs(5,iv5))
216 . +x(1,ixs(6,iv5))+x(1,ixs(7,iv5))+x(1,ixs(8,iv5))+x(1,ixs(9,iv5))
217 d5y(i) = - yc(i)
218 . +x(2,ixs(2,iv5))+x(2,ixs(3,iv5))+x(2,ixs(4,iv5))+x(2,ixs(5,iv5))
219 . +x(2,ixs(6,iv5))+x(2,ixs(7,iv5))+x(2,ixs(8,iv5))+x(2,ixs(9,iv5))
220 d5z(i) = - zc(i)
221 . +x(3,ixs(2,iv5))+x(3,ixs(3,iv5))+x(3,ixs(4,iv5))+x(3,ixs(5,iv5))
222 . +x(3,ixs(6,iv5))+x(3,ixs(7,iv5))+x(3,ixs(8,iv5))+x(3,ixs(9,iv5))
223 ENDDO
224 DO i=lft,llt
225 ie =nft+i
226 iad2 = ale_connect%ee_connect%iad_connect(ie)
227 iv6 = ale_connect%ee_connect%connected(iad2 + 6 - 1)
228 IF(iv6 <= 0) iv6=ie
229 d6x(i) = - xc(i)
230 . +x(1,ixs(2,iv6))+x(1,ixs(3,iv6))+x(1,ixs(4,iv6))+x(1,ixs(5,iv6))
231 . +x(1,ixs(6,iv6))+x(1,ixs(7,iv6))+x(1,ixs(8,iv6))+x(1,ixs(9,iv6))
232 d6y(i) = - yc(i)
233 . +x(2,ixs(2,iv6))+x(2,ixs(3,iv6))+x(2,ixs(4,iv6))+x(2,ixs(5,iv6))
234 . +x(2,ixs(6,iv6))+x(2,ixs(7,iv6))+x(2,ixs(8,iv6))+x(2,ixs(9,iv6))
235 d6z(i) = - zc(i)
236 . +x(3,ixs(2,iv6))+x(3,ixs(3,iv6))+x(3,ixs(4,iv6))+x(3,ixs(5,iv6))
237 . +x(3,ixs(6,iv6))+x(3,ixs(7,iv6))+x(3,ixs(8,iv6))+x(3,ixs(9,iv6))
238 ENDDO
239
240 ! DiX = 8.dx[i]
241 ! DiY = 8.dy[i]
242 ! DiZ = 8.dz[i]
243 ! => DDi = 64 (dx^2 + dy^2 + dz^2)
244 DO i=lft,llt
245 dd1(i)=d1x(i)**2+d1y(i)**2+d1z(i)**2
246 dd2(i)=d2x(i)**2+d2y(i)**2+d2z(i)**2
247 dd3(i)=d3x(i)**2+d3y(i)**2+d3z(i)**2
248 dd4(i)=d4x(i)**2+d4y(i)**2+d4z(i)**2
249 dd5(i)=d5x(i)**2+d5y(i)**2+d5z(i)**2
250 dd6(i)=d6x(i)**2+d6y(i)**2+d6z(i)**2
251 ENDDO
252C---------------------------------
253C GRADIENTS * SURFACES
254C Ni=2Sn, |n|=1
255C DiX = 8.dx[i], DiY = 8.dy[i], DiZ = 8.dz[i],
256C DDi = 64 (dx^2 + dy^2 + dz^2)
257C Finally
258C GRADi = Si . < di,ni > / di^2
259C where di is the distance between the centers of the two elements (current and adjacent #i)
260C---------------------------------
261 DO i=lft,llt
262 grad(1,i)= four*(d1x(i)*n1x(i)+d1y(i)*n1y(i)+d1z(i)*n1z(i)) / max(em15,dd1(i))
263 grad(2,i)= four*(d2x(i)*n2x(i)+d2y(i)*n2y(i)+d2z(i)*n2z(i)) / max(em15,dd2(i))
264 grad(3,i)= four*(d3x(i)*n3x(i)+d3y(i)*n3y(i)+d3z(i)*n3z(i)) / max(em15,dd3(i))
265 grad(4,i)= four*(d4x(i)*n4x(i)+d4y(i)*n4y(i)+d4z(i)*n4z(i)) / max(em15,dd4(i))
266 grad(5,i)= four*(d5x(i)*n5x(i)+d5y(i)*n5y(i)+d5z(i)*n5z(i)) / max(em15,dd5(i))
267 grad(6,i)= four*(d6x(i)*n6x(i)+d6y(i)*n6y(i)+d6z(i)*n6z(i)) / max(em15,dd6(i))
268 ENDDO
269C---------------------------------
270 RETURN
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