OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i7trc.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!|| i7trc ../engine/source/interfaces/intsort/i7trc.F
25!||--- called by ------------------------------------------------------
26!|| i20main_tri ../engine/source/interfaces/intsort/i20main_tri.F
27!|| i7main_tri ../engine/source/interfaces/intsort/i7main_tri.F
28!|| inter_trc_7 ../engine/source/interfaces/int07/inter_trc_7.F
29!||--- uses -----------------------------------------------------
30!|| tri7box ../engine/share/modules/tri7box.F
31!||====================================================================
32 SUBROUTINE i7trc(
33 1 NSN ,I_STOK ,CAND_N ,CAND_E ,
34 2 CAND_P ,CAND_FX ,CAND_FY,CAND_FZ,
35 3 CAND_A ,IFPEN ,INACTI ,IFQ ,
36 4 NUM_IMP,IND_IMP ,STFNS ,NIN ,
37 5 NSNL ,ITIED ,CAND_F )
38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE tri7box
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "com08_c.inc"
50C-----------------------------------------------
51C role of the routine:
52C ===================
53C sorting on N of CAND_N CAND_E CAND_F
54C and elimination of bouncing nodes
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER I_STOK,NSN,INACTI,IFQ,NUM_IMP,IND_IMP(*),
59 . NIN, NSNL, ITIED
60 INTEGER CAND_N(*),CAND_E(*),CAND_A(*), IFPEN(*),
61 . CAND_T
62C REAL
63 my_real
64 . cand_fx(*),cand_fy(*),cand_fz(*),cand_p(*),cand_tf,
65 . stfns(*),cand_f(8,*)
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 INTEGER I,N,NN,K,NI,
70 . IGET(I_STOK),IPUT(I_STOK)
71C=======================================================================
72C
73 DO 100 N=1,nsn+3
74 100 cand_a(n) = 0
75C=======================================================================
76C LES NODES DELETES DEVIENNENT NSN+1
77C=======================================================================
78C------for travelling nodes detected in imp_solv-----
79 IF(num_imp>0)THEN
80 DO i=1,i_stok
81 iput(i)=0
82 END DO
83 DO n=1,num_imp
84 i= ind_imp(n)
85 iput(i)=1
86 END DO
87 IF(ifq>0)THEN
88C
89 IF((inacti==5.OR.inacti==6.OR.inacti==7)
90 . .AND.tt==zero)THEN
91 DO i=1,i_stok
92 ifpen(i)=1
93 END DO
94 END IF
95C
96 DO i=1,i_stok
97 IF(ifpen(i) == 0.AND.iput(i)==0) THEN
98 cand_n(i) = nsn+1
99 ELSEIF(tt>zero)THEN
100 !case IDEL>0 + IFQ if element is deleted
101 !at previous cycle IFEN should be updated
102 ni = cand_n(i)
103 IF(ni>nsnl) THEN
104 !remote node
105 ni = ni-nsnl
106 IF((stifi(nin)%P(ni) == 0.0).AND.iput(i)==0)THEN
107 ifpen(i) = 0
108 cand_n(i) = nsn+1
109 ENDIF
110 ELSE
111 !local node
112 IF((stfns(ni) == 0.0).AND.iput(i)==0)THEN
113 ifpen(i) = 0
114 cand_n(i) = nsn+1
115 ENDIF
116 ENDIF
117 ENDIF
118 ENDDO
119 ELSEIF(inacti==5.OR.inacti==6.OR.inacti==7)THEN
120 DO i=1,i_stok
121 IF(cand_p(i)==zero.AND.iput(i)==0)THEN
122 cand_n(i) = nsn+1
123 ENDIF
124 ENDDO
125 ELSE
126 DO i=1,i_stok
127 IF(iput(i) == 0) THEN
128 cand_n(i) = nsn+1
129 ENDIF
130 ENDDO
131 ENDIF
132 ELSEIF(ifq>0)THEN
133C
134 IF((inacti==5.OR.inacti==6.OR.inacti==7)
135 . .AND.tt==zero)THEN
136 DO i=1,i_stok
137 ifpen(i)=1
138 END DO
139 END IF
140
141 IF(itied==0)THEN
142 DO i=1,i_stok
143
144 IF(ifpen(i) == 0) THEN
145 cand_n(i) = nsn+1
146 ELSEIF(tt>zero)THEN
147 !case IDEL>0 + IFQ if element is deleted
148 !at previous cycle IFEN should be updated
149 ni = cand_n(i)
150 IF(ni>nsnl) THEN
151 !remote node
152 ni = ni-nsnl
153 IF(stifi(nin)%P(ni) == zero)THEN
154 ifpen(i) = 0
155 cand_n(i) = nsn+1
156 ENDIF
157 ELSE
158 !local node
159 IF(stfns(ni) == zero)THEN
160 ifpen(i) = 0
161 cand_n(i) = nsn+1
162 ENDIF
163 ENDIF
164 ENDIF
165 ENDDO
166 ELSE
167 DO i=1,i_stok
168
169 IF(ifpen(i) == 0 .AND. cand_f(1,i) == zero) THEN
170 cand_n(i) = nsn+1
171 ELSEIF(tt>zero)THEN
172 !case IDEL>0 + IFQ if element is deleted
173 !at previous cycle IFEN should be updated
174 ni = cand_n(i)
175 IF(ni>nsnl) THEN
176 !remote node
177 ni = ni-nsnl
178 IF(stifi(nin)%P(ni) == zero)THEN
179 ifpen(i) = 0
180 cand_f(1,i) = zero
181 cand_n(i) = nsn+1
182 ENDIF
183 ELSE
184 !local node
185 IF(stfns(ni) == zero)THEN
186 ifpen(i) = 0
187 cand_f(1,i) = zero
188 cand_n(i) = nsn+1
189 ENDIF
190 ENDIF
191 ENDIF
192 ENDDO
193 END IF
194
195 ELSEIF(inacti==5.OR.inacti==6.OR.inacti==7)THEN
196 IF(itied == 0)THEN
197 DO i=1,i_stok
198 IF(cand_p(i)==zero)THEN
199 cand_n(i) = nsn+1
200 ENDIF
201 ENDDO
202 ELSE
203 DO i=1,i_stok
204 IF(cand_p(i)==zero .AND. cand_f(1,i) == zero)THEN
205 cand_n(i) = nsn+1
206 ELSEIF(tt>zero)THEN
207 !case IDEL>0 + ITIED if element is deleted
208 !at previous cycle CAND_F should be updated
209 ni = cand_n(i)
210 IF(ni>nsnl) THEN
211 !remote node
212 ni = ni-nsnl
213 IF(stifi(nin)%P(ni) == zero)THEN
214 cand_f(1,i) = zero
215 cand_n(i) = nsn+1
216 ENDIF
217 ELSE
218 !local node
219 IF(stfns(ni) == zero)THEN
220 cand_f(1,i) = zero
221 cand_n(i) = nsn+1
222 ENDIF
223 ENDIF
224 ENDIF
225 ENDDO
226 END IF
227 ELSEIF(itied/=0)THEN
228 DO i=1,i_stok
229 IF(cand_f(1,i)==zero)THEN
230 cand_n(i) = nsn+1
231 ELSEIF(tt>zero)THEN
232 !case IDEL>0 + ITIED if element is deleted
233 !at previous cycle CAND_F should be updated
234 ni = cand_n(i)
235 IF(ni>nsnl) THEN
236 !remote node
237 ni = ni-nsnl
238 IF(stifi(nin)%P(ni) == zero)THEN
239 cand_f(1,i) = zero
240 cand_n(i) = nsn+1
241 ENDIF
242 ELSE
243 !local node
244 IF(stfns(ni) == zero)THEN
245 cand_f(1,i) = zero
246 cand_n(i) = nsn+1
247 ENDIF
248 ENDIF
249 ENDIF
250 ENDDO
251 ELSE
252 DO i=1,i_stok
253
254 cand_n(i) = nsn+1
255 ENDDO
256 ENDIF
257C=======================================================================
258C CAND_A : DENOMBREMENT DE CHAQUE NODE C APRES 300 CAND_A[3:NSN+3] : occurrence DES NODES [1:NSN+1]
259C=======================================================================
260 DO 300 i=1,i_stok
261 nn = cand_n(i) + 2
262 cand_a(nn) = cand_a(nn) + 1
263 300 CONTINUE
264C=======================================================================
265C CAND_A : ADDRESS DE CHAQUE NODE C APRES 400 CAND_A[2:NSN+2] : ADDRESS DES NODES [1:NSN+1]
266C=======================================================================
267 cand_a(1) = 1
268 cand_a(2) = 1
269 DO 400 n=3,nsn+2
270 400 cand_a(n) = cand_a(n) + cand_a(n-1)
271C=======================================================================
272C IPUT(I) ADDRESS OU DOIT ALLER I
273C IGET(K) ADDRESS D'OU DOIT VENIR K
274C APRES 500 CAND_A[1:NSN+1] : ADDRESS DES NODES [1:NSN+1]
275C=======================================================================
276 DO 500 i=1,i_stok
277 nn = cand_n(i) + 1
278 k = cand_a(nn)
279 iput(i) = k
280 iget(k) = i
281 cand_a(nn) = cand_a(nn) + 1
282 500 CONTINUE
283C=======================================================================
284C TRI DE CAND_N CAND_E CAND_P
285C on increasing N
286C PERMUTATION 1 PASSE
287C=======================================================================
288 DO n=1,num_imp
289 k=ind_imp(n)
290 i = iput(k)
291 ind_imp(n)=i
292 END DO
293
294 IF(ifq>0.AND.(inacti==5.OR.inacti==6.OR.inacti==7).AND.itied/=0)THEN
295 DO k=1,i_stok
296 i = iget(k)
297C
298 cand_t = cand_n(k)
299 cand_n(k) = cand_n(i)
300 cand_n(i) = cand_t
301C
302 cand_t = cand_e(k)
303 cand_e(k) = cand_e(i)
304 cand_e(i) = cand_t
305C------
306 cand_tf = cand_f(1,k)
307 cand_f(1,k) = cand_f(1,i)
308 cand_f(1,i) = cand_tf
309C
310 cand_tf = cand_f(2,k)
311 cand_f(2,k) = cand_f(2,i)
312 cand_f(2,i) = cand_tf
313C
314 cand_tf = cand_f(3,k)
315 cand_f(3,k) = cand_f(3,i)
316 cand_f(3,i) = cand_tf
317C
318 cand_tf = cand_f(4,k)
319 cand_f(4,k) = cand_f(4,i)
320 cand_f(4,i) = cand_tf
321C
322 cand_tf = cand_f(5,k)
323 cand_f(5,k) = cand_f(5,i)
324 cand_f(5,i) = cand_tf
325C
326 cand_tf = cand_f(6,k)
327 cand_f(6,k) = cand_f(6,i)
328 cand_f(6,i) = cand_tf
329C
330 cand_tf = cand_f(7,k)
331 cand_f(7,k) = cand_f(7,i)
332 cand_f(7,i) = cand_tf
333C
334 cand_tf = cand_f(8,k)
335 cand_f(8,k) = cand_f(8,i)
336 cand_f(8,i) = cand_tf
337C------ Fx
338 cand_tf = cand_fx(k)
339 cand_fx(k) = cand_fx(i)
340 cand_fx(i) = cand_tf
341C------ Fy
342 cand_tf = cand_fy(k)
343 cand_fy(k) = cand_fy(i)
344 cand_fy(i) = cand_tf
345C------ Fz
346 cand_tf = cand_fz(k)
347 cand_fz(k) = cand_fz(i)
348 cand_fz(i) = cand_tf
349C
350 cand_tf = cand_p(k)
351 cand_p(k) = cand_p(i)
352 cand_p(i) = cand_tf
353C
354 cand_t = ifpen(k)
355 ifpen(k) = ifpen(i)
356 ifpen(i) = cand_t
357C
358 iput(i) = iput(k)
359 iget(iput(i)) = i
360 ENDDO
361 ELSEIF(ifq>0.AND.(inacti==5.OR.inacti==6.OR.inacti==7))THEN
362 DO k=1,i_stok
363 i = iget(k)
364C
365 cand_t = cand_n(k)
366 cand_n(k) = cand_n(i)
367 cand_n(i) = cand_t
368C
369 cand_t = cand_e(k)
370 cand_e(k) = cand_e(i)
371 cand_e(i) = cand_t
372C------ Fx
373 cand_tf = cand_fx(k)
374 cand_fx(k) = cand_fx(i)
375 cand_fx(i) = cand_tf
376C------ Fy
377 cand_tf = cand_fy(k)
378 cand_fy(k) = cand_fy(i)
379 cand_fy(i) = cand_tf
380C------ Fz
381 cand_tf = cand_fz(k)
382 cand_fz(k) = cand_fz(i)
383 cand_fz(i) = cand_tf
384C
385 cand_tf = cand_p(k)
386 cand_p(k) = cand_p(i)
387 cand_p(i) = cand_tf
388C
389 cand_t = ifpen(k)
390 ifpen(k) = ifpen(i)
391 ifpen(i) = cand_t
392C
393 iput(i) = iput(k)
394 iget(iput(i)) = i
395 ENDDO
396 ELSEIF(ifq>0.AND.itied/=0)THEN
397 DO k=1,i_stok
398 i = iget(k)
399C
400 cand_t = cand_n(k)
401 cand_n(k) = cand_n(i)
402 cand_n(i) = cand_t
403C
404 cand_t = cand_e(k)
405 cand_e(k) = cand_e(i)
406 cand_e(i) = cand_t
407C------
408 cand_tf = cand_f(1,k)
409 cand_f(1,k) = cand_f(1,i)
410 cand_f(1,i) = cand_tf
411C
412 cand_tf = cand_f(2,k)
413 cand_f(2,k) = cand_f(2,i)
414 cand_f(2,i) = cand_tf
415C
416 cand_tf = cand_f(3,k)
417 cand_f(3,k) = cand_f(3,i)
418 cand_f(3,i) = cand_tf
419C
420 cand_tf = cand_f(4,k)
421 cand_f(4,k) = cand_f(4,i)
422 cand_f(4,i) = cand_tf
423C
424 cand_tf = cand_f(5,k)
425 cand_f(5,k) = cand_f(5,i)
426 cand_f(5,i) = cand_tf
427C
428 cand_tf = cand_f(6,k)
429 cand_f(6,k) = cand_f(6,i)
430 cand_f(6,i) = cand_tf
431C
432 cand_tf = cand_f(7,k)
433 cand_f(7,k) = cand_f(7,i)
434 cand_f(7,i) = cand_tf
435C
436 cand_tf = cand_f(8,k)
437 cand_f(8,k) = cand_f(8,i)
438 cand_f(8,i) = cand_tf
439C------ Fx
440 cand_tf = cand_fx(k)
441 cand_fx(k) = cand_fx(i)
442 cand_fx(i) = cand_tf
443C------ Fy
444 cand_tf = cand_fy(k)
445 cand_fy(k) = cand_fy(i)
446 cand_fy(i) = cand_tf
447C------ Fz
448 cand_tf = cand_fz(k)
449 cand_fz(k) = cand_fz(i)
450 cand_fz(i) = cand_tf
451C
452 cand_t = ifpen(k)
453 ifpen(k) = ifpen(i)
454 ifpen(i) = cand_t
455C
456 iput(i) = iput(k)
457 iget(iput(i)) = i
458 ENDDO
459 ELSEIF(ifq>0)THEN
460 DO k=1,i_stok
461 i = iget(k)
462C
463 cand_t = cand_n(k)
464 cand_n(k) = cand_n(i)
465 cand_n(i) = cand_t
466C
467 cand_t = cand_e(k)
468 cand_e(k) = cand_e(i)
469 cand_e(i) = cand_t
470C------ Fx
471 cand_tf = cand_fx(k)
472 cand_fx(k) = cand_fx(i)
473 cand_fx(i) = cand_tf
474C------ Fy
475 cand_tf = cand_fy(k)
476 cand_fy(k) = cand_fy(i)
477 cand_fy(i) = cand_tf
478C------ Fz
479 cand_tf = cand_fz(k)
480 cand_fz(k) = cand_fz(i)
481 cand_fz(i) = cand_tf
482 cand_t = ifpen(k)
483 ifpen(k) = ifpen(i)
484 ifpen(i) = cand_t
485C
486 iput(i) = iput(k)
487 iget(iput(i)) = i
488 ENDDO
489 ELSEIF((inacti==5.OR.inacti==6.OR.inacti==7).AND.itied/=0)THEN
490 DO k=1,i_stok
491 i = iget(k)
492C
493 cand_t = cand_n(k)
494 cand_n(k) = cand_n(i)
495 cand_n(i) = cand_t
496C
497 cand_t = cand_e(k)
498 cand_e(k) = cand_e(i)
499 cand_e(i) = cand_t
500C------
501 cand_tf = cand_f(1,k)
502 cand_f(1,k) = cand_f(1,i)
503 cand_f(1,i) = cand_tf
504C
505 cand_tf = cand_f(2,k)
506 cand_f(2,k) = cand_f(2,i)
507 cand_f(2,i) = cand_tf
508C
509 cand_tf = cand_f(3,k)
510 cand_f(3,k) = cand_f(3,i)
511 cand_f(3,i) = cand_tf
512C
513 cand_tf = cand_f(4,k)
514 cand_f(4,k) = cand_f(4,i)
515 cand_f(4,i) = cand_tf
516C
517 cand_tf = cand_f(5,k)
518 cand_f(5,k) = cand_f(5,i)
519 cand_f(5,i) = cand_tf
520C
521 cand_tf = cand_f(6,k)
522 cand_f(6,k) = cand_f(6,i)
523 cand_f(6,i) = cand_tf
524C
525 cand_tf = cand_f(7,k)
526 cand_f(7,k) = cand_f(7,i)
527 cand_f(7,i) = cand_tf
528C
529 cand_tf = cand_f(8,k)
530 cand_f(8,k) = cand_f(8,i)
531 cand_f(8,i) = cand_tf
532C
533 cand_tf = cand_p(k)
534 cand_p(k) = cand_p(i)
535 cand_p(i) = cand_tf
536C
537 iput(i) = iput(k)
538 iget(iput(i)) = i
539 ENDDO
540 ELSEIF(inacti==5.OR.inacti==6.OR.inacti==7)THEN
541 DO k=1,i_stok
542 i = iget(k)
543C
544 cand_t = cand_n(k)
545 cand_n(k) = cand_n(i)
546 cand_n(i) = cand_t
547C
548 cand_t = cand_e(k)
549 cand_e(k) = cand_e(i)
550 cand_e(i) = cand_t
551C
552 cand_tf = cand_p(k)
553 cand_p(k) = cand_p(i)
554 cand_p(i) = cand_tf
555C
556 iput(i) = iput(k)
557 iget(iput(i)) = i
558 ENDDO
559 ELSEIF(itied/=0)THEN
560 DO k=1,i_stok
561 i = iget(k)
562C
563 cand_t = cand_n(k)
564 cand_n(k) = cand_n(i)
565 cand_n(i) = cand_t
566C
567 cand_t = cand_e(k)
568 cand_e(k) = cand_e(i)
569 cand_e(i) = cand_t
570C------
571 cand_tf = cand_f(1,k)
572 cand_f(1,k) = cand_f(1,i)
573 cand_f(1,i) = cand_tf
574C
575 cand_tf = cand_f(2,k)
576 cand_f(2,k) = cand_f(2,i)
577 cand_f(2,i) = cand_tf
578C
579 cand_tf = cand_f(3,k)
580 cand_f(3,k) = cand_f(3,i)
581 cand_f(3,i) = cand_tf
582C
583 cand_tf = cand_f(4,k)
584 cand_f(4,k) = cand_f(4,i)
585 cand_f(4,i) = cand_tf
586C
587 cand_tf = cand_f(5,k)
588 cand_f(5,k) = cand_f(5,i)
589 cand_f(5,i) = cand_tf
590C
591 cand_tf = cand_f(6,k)
592 cand_f(6,k) = cand_f(6,i)
593 cand_f(6,i) = cand_tf
594C
595 cand_tf = cand_f(7,k)
596 cand_f(7,k) = cand_f(7,i)
597 cand_f(7,i) = cand_tf
598C
599 cand_tf = cand_f(8,k)
600 cand_f(8,k) = cand_f(8,i)
601 cand_f(8,i) = cand_tf
602C
603 iput(i) = iput(k)
604 iget(iput(i)) = i
605 ENDDO
606 ELSEIF(num_imp>0)THEN
607 DO k=1,i_stok
608 i = iget(k)
609C
610 cand_t = cand_n(k)
611 cand_n(k) = cand_n(i)
612 cand_n(i) = cand_t
613C
614 cand_t = cand_e(k)
615 cand_e(k) = cand_e(i)
616 cand_e(i) = cand_t
617C
618 cand_tf = cand_p(k)
619 cand_p(k) = cand_p(i)
620 cand_p(i) = cand_tf
621C
622 iput(i) = iput(k)
623 iget(iput(i)) = i
624 ENDDO
625 ELSE
626 DO k=1,i_stok
627 i = iget(k)
628C
629 cand_t = cand_n(k)
630 cand_n(k) = cand_n(i)
631 cand_n(i) = cand_t
632C
633 cand_t = cand_e(k)
634 cand_e(k) = cand_e(i)
635 cand_e(i) = cand_t
636C
637 iput(i) = iput(k)
638 iget(iput(i)) = i
639 ENDDO
640
641 ENDIF
642C=======================================================================
643C CAND_A[NSN+1] : ADDRESS DE NSN+1
644C=======================================================================
645 i_stok = cand_a(nsn+1) - 1
646 cand_a(nsn+2) = cand_a(nsn+1)
647C
648 RETURN
649 END
650
651
652!||====================================================================
653!|| i24trc ../engine/source/interfaces/intsort/i7trc.F
654!||--- called by ------------------------------------------------------
655!|| i24main_tri ../engine/source/interfaces/intsort/i24main_tri.F
656!||--- uses -----------------------------------------------------
657!|| tri7box ../engine/share/modules/tri7box.F
658!||====================================================================
659 SUBROUTINE i24trc(
660 1 NSN,I_STOK,CAND_N,CAND_E,CAND_A,NIN,NSNL,IRTLM,NSV,ITAB,
661 2 MSEGLO,MSEGTYP)
662C-----------------------------------------------
663 USE tri7box
664C-----------------------------------------------
665C I m p l i c i t T y p e s
666C-----------------------------------------------
667#include "implicit_f.inc"
668C-----------------------------------------------
669C C o m m o n B l o c k s
670C-----------------------------------------------
671C role of the routine:
672C ===================
673C sorting on N of CAND_N CAND_E CAND_F
674C and elimination of bouncing nodes
675C-----------------------------------------------
676C D u m m y A r g u m e n t s
677C-----------------------------------------------
678 INTEGER I_STOK,NSN,CAND_T,NIN
679 INTEGER CAND_N(*),CAND_E(*),CAND_A(*),
680 * NSNL,IRTLM(2,*),NSV(*),ITAB(*),MSEGLO(*),MSEGTYP(*)
681C-----------------------------------------------
682C L o c a l V a r i a b l e s
683C-----------------------------------------------
684 INTEGER I,N,NN,K,E,
685 . iget(i_stok),iput(i_stok),count,i_st_sav,ish,sym_surf
686C=======================================================================
687C
688
689 DO n=1,nsn+3
690 cand_a(n) = 0
691 ENDDO
692
693 i_st_sav=i_stok
694 count=0
695 DO i=1,i_stok
696 nn = cand_n(i)
697 e = cand_e(i)
698
699C The symmetric surface on shell elements must be kept
700C On solids, the symmetric is the same
701
702 ish = msegtyp(e)
703 IF (ish > 0)THEN
704 sym_surf = mseglo(ish)
705 ELSE
706 sym_surf = mseglo(e)
707 ENDIF
708
709 IF(nn<=nsnl)THEN
710 IF( iabs(irtlm(1,nn))/=mseglo(e) .AND. iabs(irtlm(1,nn)) /= sym_surf ) THEN
711 cand_n(i) = nsn+1
712 ELSE
713 count=count+1
714 ENDIF
715 ELSE
716 IF(iabs(irtlm_fi(nin)%P(1,nn-nsnl)) /= mseglo(e) .AND.
717 * iabs(irtlm_fi(nin)%P(1,nn-nsnl)) /= sym_surf )THEN
718 cand_n(i) = nsn+1
719 ELSE
720 count=count+1
721 ENDIF
722 ENDIF
723 ENDDO
724
725C=======================================================================
726C CAND_A : DENOMBREMENT DE CHAQUE NODE C APRES 300 CAND_A[3:NSN+3] : occurrence DES NODES [1:NSN+1]
727C=======================================================================
728 DO i=1,i_stok
729 nn = cand_n(i) + 2
730 cand_a(nn) = cand_a(nn) + 1
731 ENDDO
732
733C=======================================================================
734C CAND_A : ADDRESS DE CHAQUE NODE C APRES 400 CAND_A[2:NSN+2] : ADDRESS DES NODES [1:NSN+1]
735C=======================================================================
736 cand_a(1) = 1
737 cand_a(2) = 1
738 DO n=3,nsn+2
739 cand_a(n) = cand_a(n) + cand_a(n-1)
740 ENDDO
741C=======================================================================
742C IPUT(I) ADDRESS OU DOIT ALLER I
743C IGET(K) ADDRESS D'OU DOIT VENIR K
744C APRES 500 CAND_A[1:NSN+1] : ADDRESS DES NODES [1:NSN+1]
745C=======================================================================
746 DO i=1,i_stok
747 nn = cand_n(i) + 1
748 k = cand_a(nn)
749 iput(i) = k
750 iget(k) = i
751 cand_a(nn) = cand_a(nn) + 1
752 ENDDO
753C=======================================================================
754C TRI DE CAND_N CAND_E CAND_P
755C on increasing N
756C PERMUTATION 1 PASSE
757C=============================================
758 DO k=1,i_stok
759 i = iget(k)
760C
761 cand_t = cand_n(k)
762 cand_n(k) = cand_n(i)
763 cand_n(i) = cand_t
764C
765 cand_t = cand_e(k)
766 cand_e(k) = cand_e(i)
767 cand_e(i) = cand_t
768C
769 iput(i) = iput(k)
770 iget(iput(i)) = i
771 ENDDO
772C=======================================================================
773C CAND_A[NSN+1] : ADDRESS DE NSN+1
774C=======================================================================
775 i_stok = cand_a(nsn+1) - 1
776 cand_a(nsn+2) = cand_a(nsn+1)
777C
778 RETURN
779 END
780
my_real
#define my_real
Definition cppsort.cpp:32
i24trc
subroutine i24trc(nsn, i_stok, cand_n, cand_e, cand_a, nin, nsnl, irtlm, nsv, itab, mseglo, msegtyp)
Definition i7trc.F:662
i7trc
subroutine i7trc(nsn, i_stok, cand_n, cand_e, cand_p, cand_fx, cand_fy, cand_fz, cand_a, ifpen, inacti, ifq, num_imp, ind_imp, stfns, nin, nsnl, itied, cand_f)
Definition i7trc.F:38
tri7box::irtlm_fi
type(int_pointer2), dimension(:), allocatable irtlm_fi
Definition tri7box.F:533
tri7box::stifi
type(real_pointer), dimension(:), allocatable stifi
Definition tri7box.F:449