OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i20curv.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!|| i20norms ../engine/source/interfaces/int20/i20curv.F
25!||--- called by ------------------------------------------------------
26!|| i20mainf ../engine/source/interfaces/int20/i20mainf.F
27!||====================================================================
28 SUBROUTINE i20norms(NRTM,IRECT,NUMNOD,X,NOD_NORMAL,
29 2 NMN ,MSR ,NLN,NLG,GAP_SH,
30 3 IAD_ELEM,FR_ELEM,NSV,NSN)
31C-----------------------------------------------
32C I m p l i c i t T y p e s
33C-----------------------------------------------
34#include "implicit_f.inc"
35C-----------------------------------------------
36C C o m m o n B l o c k s
37C-----------------------------------------------
38#include "com01_c.inc"
39C-----------------------------------------------
40C D u m m y A r g u m e n t s
41C-----------------------------------------------
42 INTEGER NRTM,NUMNOD,IRECT(4,NRTM),NMN,MSR(*),NLN,NLG(NLN)
43 INTEGER IAD_ELEM(2,*),FR_ELEM(*),NOD_NORMAL(3,NUMNOD),NSV(*),NSN
44C REAL
45 my_real
46 . x(3,numnod), gap_sh(*)
47C-----------------------------------------------
48C L o c a l V a r i a b l e s
49C-----------------------------------------------
50 INTEGER I ,J ,N1,N2,N3,N4
51 my_real
52 . surfx,surfy,surfz,x12,y12,z12,x23,y23,z23,
53 . x34,y34,z34,x41,y41,z41,aaa,si,co
54C-----------------------------------------------
55
56 DO i=1,nmn
57 n1 = nlg(msr(i))
58 nod_normal(1,n1) = 0
59 nod_normal(2,n1) = 0
60 nod_normal(3,n1) = 0
61 END DO
62 DO i=1,nsn
63 n1 = nlg(nsv(i))
64 nod_normal(1,n1) = 0
65 nod_normal(2,n1) = 0
66 nod_normal(3,n1) = 0
67 ENDDO
68 IF(nspmd > 1)THEN
69 DO i=1,nspmd
70 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
71 n1 = fr_elem(j)
72 nod_normal(1,n1) = 0
73 nod_normal(2,n1) = 0
74 nod_normal(3,n1) = 0
75 END DO
76 END DO
77 END IF
78
79 DO i=1,nrtm
80c test pour ne prendre en compte que les solides
81 IF(gap_sh(i)/=zero)THEN
82 n1 = nlg(irect(1,i))
83 n2 = nlg(irect(2,i))
84 n3 = nlg(irect(3,i))
85 n4 = nlg(irect(4,i))
86
87
88 x41 = x(1,n1) - x(1,n4)
89 y41 = x(2,n1) - x(2,n4)
90 z41 = x(3,n1) - x(3,n4)
91
92 x12 = x(1,n2) - x(1,n1)
93 y12 = x(2,n2) - x(2,n1)
94 z12 = x(3,n2) - x(3,n1)
95
96 x23 = x(1,n3) - x(1,n2)
97 y23 = x(2,n3) - x(2,n2)
98 z23 = x(3,n3) - x(3,n2)
99
100 surfx = y41*z12 - z41*y12
101 surfy = z41*x12 - x41*z12
102 surfz = x41*y12 - y41*x12
103 co = x41*x12 + y41*y12 + z41*z12
104 si = sqrt(surfx*surfx+surfy*surfy+surfz*surfz)
105c AAA = ATAN2(SI,-CO)*TWO/PI/MAX(EM30,SI)
106 aaa = ep07*atan2(si,-co)/max(em30,si)
107 nod_normal(1,n1) = nod_normal(1,n1) + nint(surfx*aaa)
108 nod_normal(2,n1) = nod_normal(2,n1) + nint(surfy*aaa)
109 nod_normal(3,n1) = nod_normal(3,n1) + nint(surfz*aaa)
110
111 surfx = y12*z23 - z12*y23
112 surfy = z12*x23 - x12*z23
113 surfz = x12*y23 - y12*x23
114 co = x12*x23 + y12*y23 + z12*z23
115 si = sqrt(surfx*surfx+surfy*surfy+surfz*surfz)
116c AAA = ATAN2(SI,-CO)*TWO/PI/MAX(EM30,SI)
117 aaa = ep07*atan2(si,-co)/max(em30,si)
118 nod_normal(1,n2) = nod_normal(1,n2) + nint(surfx*aaa)
119 nod_normal(2,n2) = nod_normal(2,n2) + nint(surfy*aaa)
120 nod_normal(3,n2) = nod_normal(3,n2) + nint(surfz*aaa)
121
122 IF(n3 /= n4)THEN
123 x34 = x(1,n4) - x(1,n3)
124 y34 = x(2,n4) - x(2,n3)
125 z34 = x(3,n4) - x(3,n3)
126 surfx = y23*z34 - z23*y34
127 surfy = z23*x34 - x23*z34
128 surfz = x23*y34 - y23*x34
129 co = x23*x34 + y23*y34 + z23*z34
130 si = sqrt(surfx*surfx+surfy*surfy+surfz*surfz)
131c AAA = ATAN2(SI,-CO)*TWO/PI/MAX(EM30,SI)
132 aaa = ep07*atan2(si,-co)/max(em30,si)
133 nod_normal(1,n3) = nod_normal(1,n3) + nint(surfx*aaa)
134 nod_normal(2,n3) = nod_normal(2,n3) + nint(surfy*aaa)
135 nod_normal(3,n3) = nod_normal(3,n3) + nint(surfz*aaa)
136
137 surfx = y34*z41 - z34*y41
138 surfy = z34*x41 - x34*z41
139 surfz = x34*y41 - y34*x41
140 co = x34*x41 + y34*y41 + z34*z41
141 si = sqrt(surfx*surfx+surfy*surfy+surfz*surfz)
142c AAA = ATAN2(SI,-CO)*TWO/PI/MAX(EM30,SI)
143 aaa = ep07*atan2(si,-co)/max(em30,si)
144 nod_normal(1,n4) = nod_normal(1,n4) + nint(surfx*aaa)
145 nod_normal(2,n4) = nod_normal(2,n4) + nint(surfy*aaa)
146 nod_normal(3,n4) = nod_normal(3,n4) + nint(surfz*aaa)
147 ELSE
148 surfx = y23*z41 - z23*y41
149 surfy = z23*x41 - x23*z41
150 surfz = x23*y41 - y23*x41
151 co = x41*x23 + y41*y23 + z41*z23
152 si = sqrt(surfx*surfx+surfy*surfy+surfz*surfz)
153c AAA = ATAN2(SI,-CO)*TWO/PI/MAX(EM30,SI)
154 aaa = ep07*atan2(si,-co)/max(em30,si)
155 nod_normal(1,n3) = nod_normal(1,n3) + nint(surfx*aaa)
156 nod_normal(2,n3) = nod_normal(2,n3) + nint(surfy*aaa)
157 nod_normal(3,n3) = nod_normal(3,n3) + nint(surfz*aaa)
158 ENDIF
159 ENDIF
160 ENDDO
161
162 RETURN
163 END
164!||====================================================================
165!|| i20normsp ../engine/source/interfaces/int20/i20curv.F
166!||--- calls -----------------------------------------------------
167!|| myqsort ../common_source/tools/sort/myqsort.F
168!|| spmd_i7curvcom ../engine/source/mpi/interfaces/spmd_i7curvcom.F
169!||====================================================================
170 SUBROUTINE i20normsp(NRTM ,IRECT ,NUMNOD ,X ,NOD_NORMAL,
171 . NMN ,MSR ,LENT ,MAXCC,ISDSIZ ,
172 . IRCSIZ,IAD_ELEM,FR_ELEM,ITAG ,NLN,NLG,
173 . GAP_SH)
174C-----------------------------------------------
175C I m p l i c i t T y p e s
176C-----------------------------------------------
177#include "implicit_f.inc"
178C-----------------------------------------------
179C C o m m o n B l o c k s
180C-----------------------------------------------
181#include "com01_c.inc"
182ctmp+1
183C-----------------------------------------------
184C D u m m y A r g u m e n t s
185C-----------------------------------------------
186 INTEGER NRTM,NUMNOD,NMN,MAXCC,LENT,
187 . IRECT(4,NRTM),MSR(*),NLN,NLG(NLN),
188 . IAD_ELEM(2,*),FR_ELEM(*),ISDSIZ(*),IRCSIZ(*),ITAG(*)
189C REAL
190 my_real
191 . x(3,numnod), nod_normal(3,numnod),gap_sh(*)
192C-----------------------------------------------
193C L o c a l V a r i a b l e s
194C-----------------------------------------------
195 INTEGER I ,J ,N1,N2,N3,N4, IAD, LENR, LENS, CC, ERROR,
196 . ADSKYT(0:NUMNOD+1)
197 my_real
198 . SURFX,SURFY,SURFZ,X12,Y12,Z12,X23,Y23,Z23,
199 . X34,Y34,Z34,X41,Y41,Z41,AAA,SI,CO,
200 . fskyt(3,lent), fskyt2(maxcc), perm(maxcc)
201C-----------------------------------------------
202 adskyt(0) = 1
203 adskyt(1) = 1
204 DO n1=1,numnod
205 adskyt(n1+1) = adskyt(n1)+itag(n1)
206 itag(n1) = adskyt(n1)
207 nod_normal(1,n1) = zero
208 nod_normal(2,n1) = zero
209 nod_normal(3,n1) = zero
210 END DO
211
212 DO i=1,nrtm
213 n1 = nlg(irect(1,i))
214 n2 = nlg(irect(2,i))
215 n3 = nlg(irect(3,i))
216 n4 = nlg(irect(4,i))
217c test pour ne prendre en compte que les solides
218 IF(gap_sh(i)/=zero)THEN
219
220c X13 = X(1,N3) - X(1,N1)
221c Y13 = X(2,N3) - X(2,N1)
222c Z13 = X(3,N3) - X(3,N1)
223
224c X24 = X(1,N4) - X(1,N2)
225c Y24 = X(2,N4) - X(2,N2)
226c Z24 = X(3,N4) - X(3,N2)
227
228c SURFX = Y13*Z24 - Z13*Y24
229c SURFY = Z13*X24 - X13*Z24
230c SURFZ = X13*Y24 - Y13*X24
231
232 x41 = x(1,n1) - x(1,n4)
233 y41 = x(2,n1) - x(2,n4)
234 z41 = x(3,n1) - x(3,n4)
235
236 x12 = x(1,n2) - x(1,n1)
237 y12 = x(2,n2) - x(2,n1)
238 z12 = x(3,n2) - x(3,n1)
239
240 x23 = x(1,n3) - x(1,n2)
241 y23 = x(2,n3) - x(2,n2)
242 z23 = x(3,n3) - x(3,n2)
243
244 surfx = y41*z12 - z41*y12
245 surfy = z41*x12 - x41*z12
246 surfz = x41*y12 - y41*x12
247 co = x41*x12 + y41*y12 + z41*z12
248 si = sqrt(surfx*surfx+surfy*surfy+surfz*surfz)
249 aaa = atan2(si,-co)*two/pi/max(em30,si)
250
251 iad = adskyt(n1)
252 adskyt(n1) = adskyt(n1)+1
253 fskyt(1,iad) = surfx*aaa
254 fskyt(2,iad) = surfy*aaa
255 fskyt(3,iad) = surfz*aaa
256
257 surfx = y12*z23 - z12*y23
258 surfy = z12*x23 - x12*z23
259 surfz = x12*y23 - y12*x23
260 co = x12*x23 + y12*y23 + z12*z23
261 si = sqrt(surfx*surfx+surfy*surfy+surfz*surfz)
262 aaa = atan2(si,-co)*two/pi/max(em30,si)
263
264 iad = adskyt(n2)
265 adskyt(n2) = adskyt(n2)+1
266 fskyt(1,iad) = surfx*aaa
267 fskyt(2,iad) = surfy*aaa
268 fskyt(3,iad) = surfz*aaa
269
270 IF(n3 /= n4)THEN
271
272 x34 = x(1,n4) - x(1,n3)
273 y34 = x(2,n4) - x(2,n3)
274 z34 = x(3,n4) - x(3,n3)
275 surfx = y23*z34 - z23*y34
276 surfy = z23*x34 - x23*z34
277 surfz = x23*y34 - y23*x34
278 co = x23*x34 + y23*y34 + z23*z34
279 si = sqrt(surfx*surfx+surfy*surfy+surfz*surfz)
280 aaa = atan2(si,-co)*two/pi/max(em30,si)
281
282 iad = adskyt(n3)
283 adskyt(n3) = adskyt(n3)+1
284 fskyt(1,iad) = surfx*aaa
285 fskyt(2,iad) = surfy*aaa
286 fskyt(3,iad) = surfz*aaa
287
288 surfx = y34*z41 - z34*y41
289 surfy = z34*x41 - x34*z41
290 surfz = x34*y41 - y34*x41
291 co = x34*x41 + y34*y41 + z34*z41
292 si = sqrt(surfx*surfx+surfy*surfy+surfz*surfz)
293 aaa = atan2(si,-co)*two/pi/max(em30,si)
294
295 iad = adskyt(n4)
296 adskyt(n4) = adskyt(n4)+1
297 fskyt(1,iad) = surfx*aaa
298 fskyt(2,iad) = surfy*aaa
299 fskyt(3,iad) = surfz*aaa
300
301 ELSE
302
303 surfx = y23*z41 - z23*y41
304 surfy = z23*x41 - x23*z41
305 surfz = x23*y41 - y23*x41
306 co = x41*x23 + y41*y23 + z41*z23
307 si = sqrt(surfx*surfx+surfy*surfy+surfz*surfz)
308 aaa = atan2(si,-co)*two/pi/max(em30,si)
309
310 iad = adskyt(n3)
311 adskyt(n3) = adskyt(n3)+1
312 fskyt(1,iad) = surfx*aaa
313 fskyt(2,iad) = surfy*aaa
314 fskyt(3,iad) = surfz*aaa
315
316 iad = adskyt(n4)
317 adskyt(n4) = adskyt(n4)+1
318 fskyt(1,iad) = zero
319 fskyt(2,iad) = zero
320 fskyt(3,iad) = zero
321
322 END IF
323
324 ELSE
325
326 iad = adskyt(n1)
327 adskyt(n1) = adskyt(n1)+1
328 fskyt(1,iad) = zero
329 fskyt(2,iad) = zero
330 fskyt(3,iad) = zero
331 iad = adskyt(n2)
332 adskyt(n2) = adskyt(n2)+1
333 fskyt(1,iad) = zero
334 fskyt(2,iad) = zero
335 fskyt(3,iad) = zero
336 iad = adskyt(n3)
337 adskyt(n3) = adskyt(n3)+1
338 fskyt(1,iad) = zero
339 fskyt(2,iad) = zero
340 fskyt(3,iad) = zero
341 iad = adskyt(n4)
342 adskyt(n4) = adskyt(n4)+1
343 fskyt(1,iad) = zero
344 fskyt(2,iad) = zero
345 fskyt(3,iad) = zero
346
347 ENDIF
348
349 END DO
350C
351 IF(nspmd > 1) THEN
352 lenr = ircsiz(nspmd+1)*3+iad_elem(1,nspmd+1)-iad_elem(1,1)
353 lens = isdsiz(nspmd+1)*3+iad_elem(1,nspmd+1)-iad_elem(1,1)
354 CALL spmd_i7curvcom(iad_elem,fr_elem,adskyt,fskyt,
355 . isdsiz,ircsiz,itag ,lenr ,lens )
356 END IF
357C
358C tri par packet des normales
359C
360 DO n1 = 1, numnod
361 n2 = adskyt(n1-1)
362 n3 = adskyt(n1)-1
363 n4 = n3-n2+1
364 IF(n4>1)THEN ! cas N contribution => tri
365 DO j = 1, 3
366 DO cc = n2, n3
367 fskyt2(cc-n2+1) = fskyt(j,cc)
368 END DO
369 CALL myqsort(n4,fskyt2,perm,error)
370 DO cc = n2, n3
371 nod_normal(j,n1) = nod_normal(j,n1) + fskyt2(cc-n2+1)
372 END DO
373 END DO
374 ELSEIF(n4==1)THEN ! cas 1 seule contribution => direct
375 nod_normal(1,n1) = fskyt(1,n2)
376 nod_normal(2,n1) = fskyt(2,n2)
377 nod_normal(3,n1) = fskyt(3,n2)
378 END IF
379 END DO
380 RETURN
381 END
382!||====================================================================
383!|| i20norm ../engine/source/interfaces/int20/i20curv.F
384!||--- called by ------------------------------------------------------
385!|| i20mainf ../engine/source/interfaces/int20/i20mainf.F
386!||====================================================================
387 SUBROUTINE i20norm(NRTM,IRECT,NUMNOD,X,NOD_NORMAL,
388 . NMN ,MSR ,NLN,NLG)
389C-----------------------------------------------
390C I m p l i c i t T y p e s
391C-----------------------------------------------
392#include "implicit_f.inc"
393C-----------------------------------------------
394C C o m m o n B l o c k s
395C-----------------------------------------------
396C-----------------------------------------------
397C D u m m y A r g u m e n t s
398C-----------------------------------------------
399 INTEGER NRTM,NUMNOD,IRECT(4,NRTM),NMN,MSR(*),NLN,NLG(NLN)
400 my_real
401 . X(3,NUMNOD), NOD_NORMAL(3,NUMNOD)
402C-----------------------------------------------
403C L o c a l V a r i a b l e s
404C-----------------------------------------------
405 INTEGER I ,J ,N1,N2,N3,N4
406 my_real
407 . surfx,surfy,surfz,x13,y13,z13,x24,y24,z24,aaa
408C-----------------------------------------------
409
410
411C optimisable en spmd si ajout flag pour routine de comm, spmd_exchange_n
412 DO n1=1,numnod
413 nod_normal(1,n1) = zero
414 nod_normal(2,n1) = zero
415 nod_normal(3,n1) = zero
416 END DO
417
418 DO i=1,nrtm
419 n1 = irect(1,i)
420 n2 = irect(2,i)
421 n3 = irect(3,i)
422 n4 = irect(4,i)
423 IF(nln/=0)THEN
424 n1 = nlg(n1)
425 n2 = nlg(n2)
426 n3 = nlg(n3)
427 n4 = nlg(n4)
428 ENDIF
429
430 x13 = x(1,n3) - x(1,n1)
431 y13 = x(2,n3) - x(2,n1)
432 z13 = x(3,n3) - x(3,n1)
433
434 x24 = x(1,n4) - x(1,n2)
435 y24 = x(2,n4) - x(2,n2)
436 z24 = x(3,n4) - x(3,n2)
437
438 surfx = y13*z24 - z13*y24
439 surfy = z13*x24 - x13*z24
440 surfz = x13*y24 - y13*x24
441
442 aaa=one/max(em30,sqrt(surfx*surfx+surfy*surfy+surfz*surfz))
443 surfx = surfx * aaa
444 surfy = surfy * aaa
445 surfz = surfz * aaa
446
447 nod_normal(1,n1) = nod_normal(1,n1) + surfx
448 nod_normal(2,n1) = nod_normal(2,n1) + surfy
449 nod_normal(3,n1) = nod_normal(3,n1) + surfz
450 nod_normal(1,n2) = nod_normal(1,n2) + surfx
451 nod_normal(2,n2) = nod_normal(2,n2) + surfy
452 nod_normal(3,n2) = nod_normal(3,n2) + surfz
453 nod_normal(1,n3) = nod_normal(1,n3) + surfx
454 nod_normal(2,n3) = nod_normal(2,n3) + surfy
455 nod_normal(3,n3) = nod_normal(3,n3) + surfz
456 nod_normal(1,n4) = nod_normal(1,n4) + surfx
457 nod_normal(2,n4) = nod_normal(2,n4) + surfy
458 nod_normal(3,n4) = nod_normal(3,n4) + surfz
459 ENDDO
460
461 RETURN
462 END
463C
464!||====================================================================
465!|| i20normp ../engine/source/interfaces/int20/i20curv.F
466!||--- called by ------------------------------------------------------
467!|| i20mainf ../engine/source/interfaces/int20/i20mainf.F
468!||--- calls -----------------------------------------------------
469!|| myqsort ../common_source/tools/sort/myqsort.F
470!|| spmd_i7curvcom ../engine/source/mpi/interfaces/spmd_i7curvcom.F
471!||====================================================================
472 SUBROUTINE i20normp(NRTM ,IRECT ,NUMNOD ,X ,NOD_NORMAL,
473 . NMN ,MSR ,LENT ,MAXCC,ISDSIZ ,
474 . IRCSIZ,IAD_ELEM,FR_ELEM,ITAG ,NLN,NLG)
475C-----------------------------------------------
476C I m p l i c i t T y p e s
477C-----------------------------------------------
478#include "implicit_f.inc"
479C-----------------------------------------------
480C C o m m o n B l o c k s
481C-----------------------------------------------
482#include "com01_c.inc"
483ctmp+1
484C-----------------------------------------------
485C D u m m y A r g u m e n t s
486C-----------------------------------------------
487 INTEGER NRTM,NUMNOD,NMN,MAXCC,LENT,
488 . IRECT(4,NRTM),MSR(*),NLN,NLG(NLN),
489 . IAD_ELEM(2,*),FR_ELEM(*),ISDSIZ(*),IRCSIZ(*),ITAG(*)
490C REAL
491 my_real
492 . X(3,NUMNOD), NOD_NORMAL(3,NUMNOD)
493C-----------------------------------------------
494C L o c a l V a r i a b l e s
495C-----------------------------------------------
496 INTEGER I ,J ,N1,N2,N3,N4, IAD, LENR, LENS, CC, ERROR,
497 . ADSKYT(0:NUMNOD+1)
498 my_real
499 . surfx,surfy,surfz,x13,y13,z13,x24,y24,z24,aaa,
500 . fskyt(3,lent), fskyt2(maxcc), perm(maxcc)
501C-----------------------------------------------
502 adskyt(0) = 1
503 adskyt(1) = 1
504 DO n1=1,numnod
505 adskyt(n1+1) = adskyt(n1)+itag(n1)
506 itag(n1) = adskyt(n1)
507 nod_normal(1,n1) = zero
508 nod_normal(2,n1) = zero
509 nod_normal(3,n1) = zero
510 END DO
511
512 DO i=1,nrtm
513 n1 = irect(1,i)
514 n2 = irect(2,i)
515 n3 = irect(3,i)
516 n4 = irect(4,i)
517 IF(nln/=0)THEN
518 n1 = nlg(n1)
519 n2 = nlg(n2)
520 n3 = nlg(n3)
521 n4 = nlg(n4)
522 ENDIF
523
524 x13 = x(1,n3) - x(1,n1)
525 y13 = x(2,n3) - x(2,n1)
526 z13 = x(3,n3) - x(3,n1)
527
528 x24 = x(1,n4) - x(1,n2)
529 y24 = x(2,n4) - x(2,n2)
530 z24 = x(3,n4) - x(3,n2)
531
532 surfx = y13*z24 - z13*y24
533 surfy = z13*x24 - x13*z24
534 surfz = x13*y24 - y13*x24
535
536 aaa=one/max(em30,sqrt(surfx*surfx+surfy*surfy+surfz*surfz))
537
538 iad = adskyt(n1)
539 adskyt(n1) = adskyt(n1)+1
540 fskyt(1,iad) = surfx * aaa
541 fskyt(2,iad) = surfy * aaa
542 fskyt(3,iad) = surfz * aaa
543 iad = adskyt(n2)
544 adskyt(n2) = adskyt(n2)+1
545 fskyt(1,iad) = surfx * aaa
546 fskyt(2,iad) = surfy * aaa
547 fskyt(3,iad) = surfz * aaa
548 iad = adskyt(n3)
549 adskyt(n3) = adskyt(n3)+1
550 fskyt(1,iad) = surfx * aaa
551 fskyt(2,iad) = surfy * aaa
552 fskyt(3,iad) = surfz * aaa
553 iad = adskyt(n4)
554 adskyt(n4) = adskyt(n4)+1
555 fskyt(1,iad) = surfx * aaa
556 fskyt(2,iad) = surfy * aaa
557 fskyt(3,iad) = surfz * aaa
558 END DO
559C
560 IF(nspmd>1) THEN
561 lenr = ircsiz(nspmd+1)*3+iad_elem(1,nspmd+1)-iad_elem(1,1)
562 lens = isdsiz(nspmd+1)*3+iad_elem(1,nspmd+1)-iad_elem(1,1)
563 CALL spmd_i7curvcom(iad_elem,fr_elem,adskyt,fskyt,
564 . isdsiz,ircsiz,itag ,lenr ,lens )
565 END IF
566C
567C tri par packet des normales
568C
569 DO n1 = 1, numnod
570 n2 = adskyt(n1-1)
571 n3 = adskyt(n1)-1
572 n4 = n3-n2+1
573 IF(n4>1)THEN ! cas N contribution => tri
574 DO j = 1, 3
575 DO cc = n2, n3
576 fskyt2(cc-n2+1) = fskyt(j,cc)
577 END DO
578 CALL myqsort(n4,fskyt2,perm,error)
579 DO cc = n2, n3
580 nod_normal(j,n1) = nod_normal(j,n1) + fskyt2(cc-n2+1)
581 END DO
582 END DO
583 ELSEIF(n4==1)THEN ! cas 1 seule contribution => direct
584 nod_normal(1,n1) = fskyt(1,n2)
585 nod_normal(2,n1) = fskyt(2,n2)
586 nod_normal(3,n1) = fskyt(3,n2)
587 END IF
588 END DO
589C
590 RETURN
591 END
592C
593!||====================================================================
594!|| i20cmaj ../engine/source/interfaces/int20/i20curv.f
595!||--- called by ------------------------------------------------------
596!|| i20dst3 ../engine/source/interfaces/int20/i20dst3.F
597!||====================================================================
598 SUBROUTINE i20cmaj(JLT ,CMAJ ,IRECT ,NOD_NORMAL,CAND_E,
599 2 X1 ,X2 ,X3 ,X4 ,NLN ,
600 3 Y1 ,Y2 ,Y3 ,Y4 ,NLG ,
601 4 Z1 ,Z2 ,Z3 ,Z4 ,
602 5 NNX1 ,NNX2 ,NNX3 ,NNX4 ,
603 6 NNY1 ,NNY2 ,NNY3 ,NNY4 ,
604 7 NNZ1 ,NNZ2 ,NNZ3 ,NNZ4 )
605c
606c + tmaj
607c / \
608c tmax/__ \
609c / \_\
610c 0-------0---> r
611c
612c
613c borne max:
614c (r+1)t1' = (r-1)t'2
615c r = - (t1' + t'2)/(t1'-t'2)
616c r = e
617c tmaj = (e+1)t1' = (e-1)t'2
618c => en 2D t = t'max => Z = (Lmax/2)t'max
619c
620c vecteurs:Z,L,N
621c Z^2 = (L/2.N)^2(L/2)^2 / (N^2(L/2)^2 - (L/2.N)^2)
622c Z^2 = (L.N)^2 L^2 / 4(N^2 L^2 - (L.N)^2)
623c
624C-----------------------------------------------
625C I m p l i c i t T y p e s
626C-----------------------------------------------
627#include "implicit_f.inc"
628C-----------------------------------------------
629C G l o b a l P a r a m e t e r s
630C-----------------------------------------------
631#include "mvsiz_p.inc"
632C-----------------------------------------------
633C D u m m y A r g u m e n t s
634C-----------------------------------------------
635 INTEGER JLT ,IRECT(4,*),CAND_E(*),NLN,NLG(NLN)
636C REAL
637 my_real
638 . NNX1(MVSIZ), NNX2(MVSIZ), NNX3(MVSIZ), NNX4(MVSIZ),
639 . NNY1(MVSIZ), NNY2(MVSIZ), NNY3(MVSIZ), NNY4(MVSIZ),
640 . NNZ1(MVSIZ), NNZ2(MVSIZ), NNZ3(MVSIZ), NNZ4(MVSIZ),
641 . X1(MVSIZ), X2(MVSIZ), X3(MVSIZ), X4(MVSIZ),
642 . Y1(MVSIZ), Y2(MVSIZ), Y3(MVSIZ), Y4(MVSIZ),
643 . Z1(MVSIZ), Z2(MVSIZ), Z3(MVSIZ), Z4(MVSIZ),
644 . CMAJ(MVSIZ),NOD_NORMAL(3,*)
645C-----------------------------------------------
646C L o c a l V a r i a b l e s
647C-----------------------------------------------
648 INTEGER I , IX,L
649 my_real
650 . x12,y12,z12,x23,y23,z23,x34,y34,z34,x41,y41,z41,
651 . l12l12,l23l23,l34l34,l41l41,n1n1,n2n2,n3n3,n4n4,nl,
652 . n1l12n1l12,n2l12n2l12,n2l23n2l23,n3l23n3l23,
653 . n3l34n3l34,n4l34n4l34,n4l41n4l41,n1l41n1l41,aaa
654C-----------------------------------------------
655
656 DO i=1,jlt
657 l = cand_e(i)
658
659
660 ix = nlg(irect(1,l))
661 nnx1(i)=nod_normal(1,ix)
662 nny1(i)=nod_normal(2,ix)
663 nnz1(i)=nod_normal(3,ix)
664
665 ix = nlg(irect(2,l))
666 nnx2(i)=nod_normal(1,ix)
667 nny2(i)=nod_normal(2,ix)
668 nnz2(i)=nod_normal(3,ix)
669
670 ix = nlg(irect(3,l))
671 nnx3(i)=nod_normal(1,ix)
672 nny3(i)=nod_normal(2,ix)
673 nnz3(i)=nod_normal(3,ix)
674
675 ix = nlg(irect(4,l))
676 nnx4(i)=nod_normal(1,ix)
677 nny4(i)=nod_normal(2,ix)
678 nnz4(i)=nod_normal(3,ix)
679
680 x12 = x2(i) - x1(i)
681 y12 = y2(i) - y1(i)
682 z12 = z2(i) - z1(i)
683
684 x23 = x3(i) - x2(i)
685 y23 = y3(i) - y2(i)
686 z23 = z3(i) - z2(i)
687
688 x34 = x4(i) - x3(i)
689 y34 = y4(i) - y3(i)
690 z34 = z4(i) - z3(i)
691
692 x41 = x1(i) - x4(i)
693 y41 = y1(i) - y4(i)
694 z41 = z1(i) - z4(i)
695
696 l12l12 = x12*x12 + y12*y12 + z12*z12
697 l23l23 = x23*x23 + y23*y23 + z23*z23
698 l34l34 = x34*x34 + y34*y34 + z34*z34
699 l41l41 = x41*x41 + y41*y41 + z41*z41
700
701 n1n1 = nnx1(i)*nnx1(i)
702 + + nny1(i)*nny1(i)
703 + + nnz1(i)*nnz1(i)
704 n2n2 = nnx2(i)*nnx2(i)
705 + + nny2(i)*nny2(i)
706 + + nnz2(i)*nnz2(i)
707 n3n3 = nnx3(i)*nnx3(i)
708 + + nny3(i)*nny3(i)
709 + + nnz3(i)*nnz3(i)
710 n4n4 = nnx4(i)*nnx4(i)
711 + + nny4(i)*nny4(i)
712 + + nnz4(i)*nnz4(i)
713
714 nl = nnx1(i)*x12
715 + + nny1(i)*y12
716 + + nnz1(i)*z12
717 n1l12n1l12 = nl*nl
718 nl = nnx2(i)*x12
719 + + nny2(i)*y12
720 + + nnz2(i)*z12
721 n2l12n2l12 = nl*nl
722 nl = nnx2(i)*x23
723 + + nny2(i)*y23
724 + + nnz2(i)*z23
725 n2l23n2l23 = nl*nl
726 nl = nnx3(i)*x23
727 + + nny3(i)*y23
728 + + nnz3(i)*z23
729 n3l23n3l23 = nl*nl
730 nl = nnx3(i)*x34
731 + + nny3(i)*y34
732 + + nnz3(i)*z34
733 n3l34n3l34 = nl*nl
734 nl = nnx4(i)*x34
735 + + nny4(i)*y34
736 + + nnz4(i)*z34
737 n4l34n4l34 = nl*nl
738 nl = nnx4(i)*x41
739 + + nny4(i)*y41
740 + + nnz4(i)*z41
741 n4l41n4l41 = nl*nl
742 nl = nnx1(i)*x41
743 + + nny1(i)*y41
744 + + nnz1(i)*z41
745 n1l41n1l41 = nl*nl
746
747c Z^2 = (L.N)^2 L^2 / 4(N^2 L^2 - (L.N)^2)
748 aaa = max(n1l12n1l12*l12l12 / (n1n1*l12l12 - n1l12n1l12),
749 . n2l12n2l12*l12l12 / (n2n2*l12l12 - n2l12n2l12),
750 . n2l23n2l23*l23l23 / (n2n2*l23l23 - n2l23n2l23),
751 . n3l23n3l23*l23l23 / (n3n3*l23l23 - n3l23n3l23),
752 . n3l34n3l34*l34l34 / (n3n3*l34l34 - n3l34n3l34),
753 . n4l34n4l34*l34l34 / (n4n4*l34l34 - n4l34n4l34),
754 . n4l41n4l41*l41l41 / (n4n4*l41l41 - n4l41n4l41),
755 . n1l41n1l41*l41l41 / (n1n1*l41l41 - n1l41n1l41))
756 cmaj(i) = half*sqrt(aaa)
757
758 ENDDO
759
760 RETURN
761 END
762!||====================================================================
763!|| i20normcnt ../engine/source/interfaces/int20/i20curv.F
764!||--- called by ------------------------------------------------------
765!|| i20mainf ../engine/source/interfaces/int20/i20mainf.F
766!||====================================================================
767 SUBROUTINE i20normcnt(NRTM ,IRECT ,NUMNOD,ITAG ,LENT ,
768 2 MAXCC ,NLN ,NLG )
769C-----------------------------------------------
770C I m p l i c i t T y p e s
771C-----------------------------------------------
772#include "implicit_f.inc"
773C-----------------------------------------------
774C D u m m y A r g u m e n t s
775C-----------------------------------------------
776 INTEGER NRTM,NUMNOD,LENT,MAXCC,NLN,NLG(NLN),
777 . IRECT(4,NRTM),ITAG(*)
778C REAL
779C-----------------------------------------------
780C L o c a l V a r i a b l e s
781C-----------------------------------------------
782 INTEGER I ,J ,N1, N2, N3, N4, IERROR, IAD, SIZ, NB,
783 . MSGTYP
784C-----------------------------------------------
785C
786 DO N1=1,numnod
787 itag(n1) = 0
788 END DO
789
790 DO i=1,nrtm
791 n1 = irect(1,i)
792 n2 = irect(2,i)
793 n3 = irect(3,i)
794 n4 = irect(4,i)
795 n1 = nlg(n1)
796 n2 = nlg(n2)
797 n3 = nlg(n3)
798 n4 = nlg(n4)
799 itag(n1) = itag(n1) + 1
800 itag(n2) = itag(n2) + 1
801 itag(n3) = itag(n3) + 1
802 itag(n4) = itag(n4) + 1
803 END DO
804C
805 lent = 0
806 maxcc = 0
807 DO n1=1,numnod
808 lent = lent + itag(n1)
809 maxcc = max(maxcc,itag(n1))
810 END DO
811C
812 RETURN
813 END
my_real
#define my_real
Definition cppsort.cpp:32
i20cmaj
subroutine i20cmaj(jlt, cmaj, irect, nod_normal, cand_e, x1, x2, x3, x4, nln, y1, y2, y3, y4, nlg, z1, z2, z3, z4, nnx1, nnx2, nnx3, nnx4, nny1, nny2, nny3, nny4, nnz1, nnz2, nnz3, nnz4)
Definition i20curv.F:605
i20normp
subroutine i20normp(nrtm, irect, numnod, x, nod_normal, nmn, msr, lent, maxcc, isdsiz, ircsiz, iad_elem, fr_elem, itag, nln, nlg)
Definition i20curv.F:475
i20norms
subroutine i20norms(nrtm, irect, numnod, x, nod_normal, nmn, msr, nln, nlg, gap_sh, iad_elem, fr_elem, nsv, nsn)
Definition i20curv.F:31
i20norm
subroutine i20norm(nrtm, irect, numnod, x, nod_normal, nmn, msr, nln, nlg)
Definition i20curv.F:389
i20normsp
subroutine i20normsp(nrtm, irect, numnod, x, nod_normal, nmn, msr, lent, maxcc, isdsiz, ircsiz, iad_elem, fr_elem, itag, nln, nlg, gap_sh)
Definition i20curv.F:174
i20normcnt
subroutine i20normcnt(nrtm, irect, numnod, itag, lent, maxcc, nln, nlg)
Definition i20curv.F:769
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
nl
character *2 function nl()
Definition message.F:2354