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