OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i20rcurv.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "comlock.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i20normn (nrtm, irect, numnod, x, nod_normal, nmn, msr, nln, nlg)
subroutine i20normnp (nrtm, irect, numnod, x, nod_normal, nmn, msr, lent, maxcc, isdsiz, ircsiz, iad_elem, fr_elem, itag, nln, nlg)
subroutine i20norme (nmnft, nmnlt, nod_normal, msr, nln, nlg)
subroutine i20rcurv (nrtmft, nrtmlt, x, nod_normal, irect, rcurv, nradm, anglm, anglt, nln, nlg)

Function/Subroutine Documentation

◆ i20norme()

subroutine i20norme ( integer nmnft,
integer nmnlt,
nod_normal,
integer, dimension(*) msr,
integer nln,
integer, dimension(nln) nlg )

Definition at line 243 of file i20rcurv.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21

◆ i20normn()

subroutine i20normn ( integer nrtm,
integer, dimension(4,nrtm) irect,
integer numnod,
x,
nod_normal,
integer nmn,
integer, dimension(*) msr,
integer nln,
integer, dimension(nln) nlg )

Definition at line 28 of file i20rcurv.F.

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
42 my_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
48 my_real
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

◆ i20normnp()

subroutine i20normnp ( integer nrtm,
integer, dimension(4,nrtm) irect,
integer numnod,
x,
nod_normal,
integer nmn,
integer, dimension(*) msr,
integer lent,
integer maxcc,
integer, dimension(*) isdsiz,
integer, dimension(*) ircsiz,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) itag,
integer nln,
integer, dimension(nln) nlg )

Definition at line 113 of file i20rcurv.F.

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
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

◆ i20rcurv()

subroutine i20rcurv ( integer nrtmft,
integer nrtmlt,
x,
nod_normal,
integer, dimension(4,*) irect,
rcurv,
integer nradm,
anglm,
anglt,
integer nln,
integer, dimension(nln) nlg )

Definition at line 288 of file i20rcurv.F.

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
min
#define min(a, b)
Definition macros.h:20