OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i7rcurv.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 i7normn (nrtm, irect, numnod, x, nod_normal, nmn, msr)
subroutine i7normnp (nrtm, irect, numnod, x, nod_normal, nmn, msr, lent, maxcc, isdsiz, ircsiz, iad_elem, fr_elem, itag)
subroutine i7norme (nmnft, nmnlt, nod_normal, msr)
subroutine i7rcurv (nrtmft, nrtmlt, x, nod_normal, irect, rcurv, nradm, anglm, anglt)

Function/Subroutine Documentation

◆ i7norme()

subroutine i7norme ( integer nmnft,
integer nmnlt,
nod_normal,
integer, dimension(*) msr )

Definition at line 228 of file i7rcurv.F.

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

◆ i7normn()

subroutine i7normn ( integer nrtm,
integer, dimension(4,nrtm) irect,
integer numnod,
x,
nod_normal,
integer nmn,
integer, dimension(*) msr )

Definition at line 28 of file i7rcurv.F.

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 ,N1,N2,N3,N4
45 my_real
46 . surfx,surfy,surfz,x13,y13,z13,x24,y24,z24,aaa
47C-----------------------------------------------
48
49C Optimizable in SPMD If Addition Flag for 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

◆ i7normnp()

subroutine i7normnp ( 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 )

Definition at line 104 of file i7rcurv.F.

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 sorting normals by packet
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 ! Case 1 single 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
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

◆ i7rcurv()

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

Definition at line 272 of file i7rcurv.F.

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