OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i7rcurv.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!|| i7normn ../engine/source/interfaces/int07/i7rcurv.F
25!||--- called by ------------------------------------------------------
26!|| i7mainf ../engine/source/interfaces/int07/i7mainf.F
27!||====================================================================
28 SUBROUTINE i7normn(NRTM,IRECT,NUMNOD,X,NOD_NORMAL,
29 . NMN ,MSR )
30C-----------------------------------------------
31C I m p l i c i t T y p e s
32C-----------------------------------------------
33#include "implicit_f.inc"
34C-----------------------------------------------
35C D u m m y A r g u m e n t s
36C-----------------------------------------------
37 INTEGER NRTM,NUMNOD,IRECT(4,NRTM),NMN,MSR(*)
38C REAL
39 my_real
40 . x(3,numnod), nod_normal(3,numnod)
41C-----------------------------------------------
42C L o c a l V a r i a b l e s
43C-----------------------------------------------
44 INTEGER I ,J ,N1,N2,N3,N4
45 my_real
46 . surfx,surfy,surfz,x13,y13,z13,x24,y24,z24,aaa
47C-----------------------------------------------
48
49C optimisable en spmd si ajout flag pour routine de comm, spmd_exchange_n
50 DO n1=1,numnod
51 nod_normal(1,n1) = zero
52 nod_normal(2,n1) = zero
53 nod_normal(3,n1) = zero
54 END DO
55
56 DO i=1,nrtm
57 n1 = irect(1,i)
58 n2 = irect(2,i)
59 n3 = irect(3,i)
60 n4 = irect(4,i)
61
62 x13 = x(1,n3) - x(1,n1)
63 y13 = x(2,n3) - x(2,n1)
64 z13 = x(3,n3) - x(3,n1)
65
66 x24 = x(1,n4) - x(1,n2)
67 y24 = x(2,n4) - x(2,n2)
68 z24 = x(3,n4) - x(3,n2)
69
70 surfx = y13*z24 - z13*y24
71 surfy = z13*x24 - x13*z24
72 surfz = x13*y24 - y13*x24
73
74 aaa=one/max(em30,sqrt(surfx*surfx+surfy*surfy+surfz*surfz))
75 surfx = surfx * aaa
76 surfy = surfy * aaa
77 surfz = surfz * aaa
78
79 nod_normal(1,n1) = nod_normal(1,n1) + surfx
80 nod_normal(2,n1) = nod_normal(2,n1) + surfy
81 nod_normal(3,n1) = nod_normal(3,n1) + surfz
82 nod_normal(1,n2) = nod_normal(1,n2) + surfx
83 nod_normal(2,n2) = nod_normal(2,n2) + surfy
84 nod_normal(3,n2) = nod_normal(3,n2) + surfz
85 nod_normal(1,n3) = nod_normal(1,n3) + surfx
86 nod_normal(2,n3) = nod_normal(2,n3) + surfy
87 nod_normal(3,n3) = nod_normal(3,n3) + surfz
88 nod_normal(1,n4) = nod_normal(1,n4) + surfx
89 nod_normal(2,n4) = nod_normal(2,n4) + surfy
90 nod_normal(3,n4) = nod_normal(3,n4) + surfz
91 ENDDO
92
93 RETURN
94 END
95C
96!||====================================================================
97!|| i7normnp ../engine/source/interfaces/int07/i7rcurv.F
98!||--- called by ------------------------------------------------------
99!|| i7mainf ../engine/source/interfaces/int07/i7mainf.F
100!||--- calls -----------------------------------------------------
101!|| myqsort ../common_source/tools/sort/myqsort.F
102!|| spmd_i7curvcom ../engine/source/mpi/interfaces/spmd_i7curvcom.F
103!||====================================================================
104 SUBROUTINE i7normnp(NRTM ,IRECT ,NUMNOD ,X ,NOD_NORMAL,
105 . NMN ,MSR ,LENT ,MAXCC,ISDSIZ ,
106 . IRCSIZ,IAD_ELEM,FR_ELEM,ITAG )
107C-----------------------------------------------
108C I m p l i c i t T y p e s
109C-----------------------------------------------
110#include "implicit_f.inc"
111C-----------------------------------------------
112C C o m m o n B l o c k s
113C-----------------------------------------------
114#include "com01_c.inc"
115ctmp+1
116C-----------------------------------------------
117C D u m m y A r g u m e n t s
118C-----------------------------------------------
119 INTEGER NRTM,NUMNOD,NMN,MAXCC,LENT,
120 . IRECT(4,NRTM),MSR(*),
121 . IAD_ELEM(2,*),FR_ELEM(*),ISDSIZ(*),IRCSIZ(*),ITAG(*)
122C REAL
123 my_real
124 . x(3,numnod), nod_normal(3,numnod)
125C-----------------------------------------------
126C L o c a l V a r i a b l e s
127C-----------------------------------------------
128 INTEGER I ,J ,N1,N2,N3,N4, IAD, LENR, LENS, CC, ERROR,
129 . ADSKYT(0:NUMNOD+1)
130 my_real
131 . surfx,surfy,surfz,x13,y13,z13,x24,y24,z24,aaa,
132 . fskyt(3,lent), fskyt2(maxcc), perm(maxcc)
133C-----------------------------------------------
134 adskyt(0) = 1
135 adskyt(1) = 1
136 DO n1=1,numnod
137 adskyt(n1+1) = adskyt(n1)+itag(n1)
138 itag(n1) = adskyt(n1)
139 nod_normal(1,n1) = zero
140 nod_normal(2,n1) = zero
141 nod_normal(3,n1) = zero
142 END DO
143
144 DO i=1,nrtm
145 n1 = irect(1,i)
146 n2 = irect(2,i)
147 n3 = irect(3,i)
148 n4 = irect(4,i)
149
150 x13 = x(1,n3) - x(1,n1)
151 y13 = x(2,n3) - x(2,n1)
152 z13 = x(3,n3) - x(3,n1)
153
154 x24 = x(1,n4) - x(1,n2)
155 y24 = x(2,n4) - x(2,n2)
156 z24 = x(3,n4) - x(3,n2)
157
158 surfx = y13*z24 - z13*y24
159 surfy = z13*x24 - x13*z24
160 surfz = x13*y24 - y13*x24
161
162 aaa=one/max(em30,sqrt(surfx*surfx+surfy*surfy+surfz*surfz))
163 surfx = surfx * aaa
164 surfy = surfy * aaa
165 surfz = surfz * aaa
166
167 iad = adskyt(n1)
168 adskyt(n1) = adskyt(n1)+1
169 fskyt(1,iad) = surfx
170 fskyt(2,iad) = surfy
171 fskyt(3,iad) = surfz
172 iad = adskyt(n2)
173 adskyt(n2) = adskyt(n2)+1
174 fskyt(1,iad) = surfx
175 fskyt(2,iad) = surfy
176 fskyt(3,iad) = surfz
177 iad = adskyt(n3)
178 adskyt(n3) = adskyt(n3)+1
179 fskyt(1,iad) = surfx
180 fskyt(2,iad) = surfy
181 fskyt(3,iad) = surfz
182 iad = adskyt(n4)
183 adskyt(n4) = adskyt(n4)+1
184 fskyt(1,iad) = surfx
185 fskyt(2,iad) = surfy
186 fskyt(3,iad) = surfz
187 END DO
188C
189 IF(nspmd>1) THEN
190 lenr = ircsiz(nspmd+1)*3+iad_elem(1,nspmd+1)-iad_elem(1,1)
191 lens = isdsiz(nspmd+1)*3+iad_elem(1,nspmd+1)-iad_elem(1,1)
192 CALL spmd_i7curvcom(iad_elem,fr_elem,adskyt,fskyt,
193 . isdsiz,ircsiz,itag ,lenr ,lens )
194 END IF
195C
196C tri par packet des normales
197C
198 DO n1 = 1, numnod
199 n2 = adskyt(n1-1)
200 n3 = adskyt(n1)-1
201 n4 = n3-n2+1
202 IF(n4>1)THEN ! cas N contribution => tri
203 DO j = 1, 3
204 DO cc = n2, n3
205 fskyt2(cc-n2+1) = fskyt(j,cc)
206 END DO
207C IF(N4>MAXCC)print*,'error cc:',n4,maxcc
208 CALL myqsort(n4,fskyt2,perm,error)
209 DO cc = n2, n3
210 nod_normal(j,n1) = nod_normal(j,n1) + fskyt2(cc-n2+1)
211 END DO
212 END DO
213 ELSEIF(n4==1)THEN ! cas 1 seule contribution => direct
214 nod_normal(1,n1) = fskyt(1,n2)
215 nod_normal(2,n1) = fskyt(2,n2)
216 nod_normal(3,n1) = fskyt(3,n2)
217 END IF
218 END DO
219C
220 RETURN
221 END
222C
223!||====================================================================
224!|| i7norme ../engine/source/interfaces/int07/i7rcurv.F
225!||--- called by ------------------------------------------------------
226!|| i7mainf ../engine/source/interfaces/int07/i7mainf.F
227!||====================================================================
228 SUBROUTINE i7norme(NMNFT, NMNLT, NOD_NORMAL, MSR )
229C-----------------------------------------------
230C I m p l i c i t T y p e s
231C-----------------------------------------------
232#include "implicit_f.inc"
233C-----------------------------------------------
234C D u m m y A r g u m e n t s
235C-----------------------------------------------
236 INTEGER NMNFT, NMNLT, MSR(*)
237C REAL
238 my_real
239 . nod_normal(3,*)
240C-----------------------------------------------
241C L o c a l V a r i a b l e s
242C-----------------------------------------------
243 INTEGER I ,N1
244 my_real
245 . SURFX,SURFY,SURFZ,AAA
246C-----------------------------------------------
247
248 DO i=nmnft,nmnlt
249 n1 = msr(i)
250 surfx = nod_normal(1,n1)
251 surfy = nod_normal(2,n1)
252 surfz = nod_normal(3,n1)
253
254 aaa=one/max(em30,sqrt(surfx*surfx+surfy*surfy+surfz*surfz))
255 surfx = surfx * aaa
256 surfy = surfy * aaa
257 surfz = surfz * aaa
258
259 nod_normal(1,n1) = surfx
260 nod_normal(2,n1) = surfy
261 nod_normal(3,n1) = surfz
262 END DO
263
264 RETURN
265 END
266C
267!||====================================================================
268!|| i7rcurv ../engine/source/interfaces/int07/i7rcurv.F
269!||--- called by ------------------------------------------------------
270!|| i7mainf ../engine/source/interfaces/int07/i7mainf.f
271!||====================================================================
272 SUBROUTINE i7rcurv(NRTMFT,NRTMLT ,X ,NOD_NORMAL ,IRECT ,
273 . RCURV ,NRADM ,ANGLM ,ANGLT )
274C-----------------------------------------------
275C I m p l i c i t T y p e s
276C-----------------------------------------------
277#include "implicit_f.inc"
278#include "comlock.inc"
279C-----------------------------------------------
280C D u m m y A r g u m e n t s
281C-----------------------------------------------
282 INTEGER NRTMFT, NRTMLT , IRECT(4,*), NRADM
283C REAL
284 my_real
285 . X(3,*), NOD_NORMAL(3,*), RCURV(*), ANGLM(*), ANGLT
286C-----------------------------------------------
287C L o c a l V a r i a b l e s
288C-----------------------------------------------
289 INTEGER I ,N1, N2, N3, N4
290 my_real
291 . X1, X2, X3, X4,
292 . Y1, Y2, Y3, Y4,
293 . z1, z2, z3, z4,
294 . nnx1, nnx2, nnx3, nnx4,
295 . nny1, nny2, nny3, nny4,
296 . nnz1, nnz2, nnz3, nnz4,
297 . surfx, surfy, surfz,
298 . erx, ery, erz, dnx, dny, dnz, dnt, ll, aaa, rr,
299 . x13, y13, z13, x24, y24, z24, nx, ny, nz, cc
300C-----------------------------------------------
301 rcurv(nrtmft:nrtmlt) = ep30
302 anglm(nrtmft:nrtmlt) = ep30
303
304 DO i=nrtmft, nrtmlt
305 n1=irect(1,i)
306 n2=irect(2,i)
307 n3=irect(3,i)
308 n4=irect(4,i)
309
310 x1=x(1,n1)
311 y1=x(2,n1)
312 z1=x(3,n1)
313
314 x2=x(1,n2)
315 y2=x(2,n2)
316 z2=x(3,n2)
317
318 x3=x(1,n3)
319 y3=x(2,n3)
320 z3=x(3,n3)
321
322 x4=x(1,n4)
323 y4=x(2,n4)
324 z4=x(3,n4)
325
326 nnx1=nod_normal(1,n1)
327 nny1=nod_normal(2,n1)
328 nnz1=nod_normal(3,n1)
329
330 nnx2=nod_normal(1,n2)
331 nny2=nod_normal(2,n2)
332 nnz2=nod_normal(3,n2)
333
334 nnx3=nod_normal(1,n3)
335 nny3=nod_normal(2,n3)
336 nnz3=nod_normal(3,n3)
337
338 nnx4=nod_normal(1,n4)
339 nny4=nod_normal(2,n4)
340 nnz4=nod_normal(3,n4)
341
342C-------
343 erx = (x2+x3)-(x1+x4)
344 ery = (y2+y3)-(y1+y4)
345 erz = (z2+z3)-(z1+z4)
346
347C Longueur vraie = LL/2
348 ll = sqrt(erx*erx+ery*ery+erz*erz)
349 aaa = one / ll
350 erx = erx*aaa
351 ery = ery*aaa
352 erz = erz*aaa
353
354 dnx= (nnx2+nnx3)-(nnx1+nnx4)
355 dny= (nny2+nny3)-(nny1+nny4)
356 dnz= (nnz2+nnz3)-(nnz1+nnz4)
357C
358C DN vraie = DNT/2
359 dnt=(dnx*erx+dny*ery+dnz*erz)
360
361 rr=ll/max(em20,abs(dnt))
362 rcurv(i)=min(rcurv(i),rr)
363C-------
364 erx = (x4+x3)-(x1+x2)
365 ery = (y4+y3)-(y1+y2)
366 erz = (z4+z3)-(z1+z2)
367
368C Longueur vraie = LL/2
369 ll = sqrt(erx*erx+ery*ery+erz*erz)
370 aaa = one / ll
371 erx = erx*aaa
372 ery = ery*aaa
373 erz = erz*aaa
374
375 dnx= (nnx4+nnx3)-(nnx1+nnx2)
376 dny= (nny4+nny3)-(nny1+nny2)
377 dnz= (nnz4+nnz3)-(nnz1+nnz2)
378C
379C DN vraie = DNT/2
380 dnt=(dnx*erx+dny*ery+dnz*erz)
381
382 rr=ll/(nradm*max(em20,abs(dnt)))
383 rcurv(i)=min(rcurv(i),rr)
384C-------
385C-------
386C-------
387C Angles.
388C-------
389 x13 = x3 - x1
390 y13 = y3 - y1
391 z13 = z3 - z1
392
393 x24 = x4 - x2
394 y24 = y4 - y2
395 z24 = z4 - z2
396
397 surfx = y13*z24 - z13*y24
398 surfy = z13*x24 - x13*z24
399 surfz = x13*y24 - y13*x24
400
401 aaa=one/max(em30,sqrt(surfx*surfx+surfy*surfy+surfz*surfz))
402 surfx = surfx * aaa
403 surfy = surfy * aaa
404 surfz = surfz * aaa
405
406 cc=(surfx*nnx1+surfy*nny1+surfz*nnz1)/max(em20,anglt)
407 anglm(i)=min(anglm(i),cc)
408
409 cc=(surfx*nnx2+surfy*nny2+surfz*nnz2)/max(em20,anglt)
410 anglm(i)=min(anglm(i),cc)
411
412 cc=(surfx*nnx3+surfy*nny3+surfz*nnz3)/max(em20,anglt)
413 anglm(i)=min(anglm(i),cc)
414
415 cc=(surfx*nnx4+surfy*nny4+surfz*nnz4)/max(em20,anglt)
416 anglm(i)=min(anglm(i),cc)
417 ENDDO
418
419 RETURN
420 END
my_real
#define my_real
Definition cppsort.cpp:32
i7mainf
subroutine i7mainf(timers, ipari, x, a, ale_connectivity, xcell, icodt, fsav, v, ms, dt2t, neltst, ityptst, itab, stifn, fskyi, isky, fcont, nin, lindmax, kinet, jtask, nb_jlt, nb_jlt_new, nb_stok_n, elbuf_tab, niskyfi, newfront, nstrf, secfcum, igroups, icontact, viscn, num_imp, ns_imp, ne_imp, ind_imp, fsavsub, nrtmdim, igrbric, eminx, ixs, ixs16, ixs20, fncont, ftcont, iad_elem, fr_elem, rcontact, acontact, pcontact, temp, fthe, ftheskyi, pm, iparg, iad17, mskyi_sms, iskyi_sms, nodnx_sms, ms0, qfricint, npc, tf, condn, condnskyi, intbuf_tab, nodadt_therm, theaccfact, fbsav6, isensint, dimfb, ixig3d, kxig3d, wige, knot, igeo, multi_fvm, h3d_data, intbuf_fric_tab, knotlocpc, knotlocel, itask, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, dgaploadint, s_loadpinter, interefric, s_xcell_remote, xcell_remote)
Definition i7mainf.F:89
i7rcurv
subroutine i7rcurv(nrtmft, nrtmlt, x, nod_normal, irect, rcurv, nradm, anglm, anglt)
Definition i7rcurv.F:274
i7normnp
subroutine i7normnp(nrtm, irect, numnod, x, nod_normal, nmn, msr, lent, maxcc, isdsiz, ircsiz, iad_elem, fr_elem, itag)
Definition i7rcurv.F:107
i7normn
subroutine i7normn(nrtm, irect, numnod, x, nod_normal, nmn, msr)
Definition i7rcurv.F:30
i7norme
subroutine i7norme(nmnft, nmnlt, nod_normal, msr)
Definition i7rcurv.F:229
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
myqsort
subroutine myqsort(n, a, perm, error)
Definition myqsort.F:51
spmd_i7curvcom
subroutine spmd_i7curvcom(iad_elem, fr_elem, adskyt, fskyt, isdsiz, ircsiz, itag, lenr, lens)
Definition spmd_i7curvcom.F:38