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 DE LA ROUTINE:
52C ===================
53C TRI sur N de CAND_N CAND_E CAND_F
54C et elimination des noeuds en rebond
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, I_ST0,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 NOEUDS 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 NOEUD
259C APRES 300 CAND_A[3:NSN+3] : OCCURENCE DES NOEUDS [1:NSN+1]
260C=======================================================================
261 DO 300 i=1,i_stok
262 nn = cand_n(i) + 2
263 cand_a(nn) = cand_a(nn) + 1
264 300 CONTINUE
265C=======================================================================
266C CAND_A : ADRESSE DE CHAQUE NOEUD
267C APRES 400 CAND_A[2:NSN+2] : ADRESSE DES NOEUDS [1:NSN+1]
268C=======================================================================
269 cand_a(1) = 1
270 cand_a(2) = 1
271 DO 400 n=3,nsn+2
272 400 cand_a(n) = cand_a(n) + cand_a(n-1)
273C=======================================================================
274C IPUT(I) ADRESSE OU DOIT ALLER I
275C IGET(K) ADRESSE D'OU DOIT VENIR K
276C APRES 500 CAND_A[1:NSN+1] : ADRESSE DES NOEUDS [1:NSN+1]
277C=======================================================================
278 DO 500 i=1,i_stok
279 nn = cand_n(i) + 1
280 k = cand_a(nn)
281 iput(i) = k
282 iget(k) = i
283 cand_a(nn) = cand_a(nn) + 1
284 500 CONTINUE
285C=======================================================================
286C TRI DE CAND_N CAND_E CAND_P
287C SUR N CROISSANT
288C PERMUTATION 1 PASSE
289C=======================================================================
290 DO n=1,num_imp
291 k=ind_imp(n)
292 i = iput(k)
293 ind_imp(n)=i
294 END DO
295
296 IF(ifq>0.AND.(inacti==5.OR.inacti==6.OR.inacti==7).AND.itied/=0)THEN
297 DO k=1,i_stok
298 i = iget(k)
299C
300 cand_t = cand_n(k)
301 cand_n(k) = cand_n(i)
302 cand_n(i) = cand_t
303C
304 cand_t = cand_e(k)
305 cand_e(k) = cand_e(i)
306 cand_e(i) = cand_t
307C------
308 cand_tf = cand_f(1,k)
309 cand_f(1,k) = cand_f(1,i)
310 cand_f(1,i) = cand_tf
311C
312 cand_tf = cand_f(2,k)
313 cand_f(2,k) = cand_f(2,i)
314 cand_f(2,i) = cand_tf
315C
316 cand_tf = cand_f(3,k)
317 cand_f(3,k) = cand_f(3,i)
318 cand_f(3,i) = cand_tf
319C
320 cand_tf = cand_f(4,k)
321 cand_f(4,k) = cand_f(4,i)
322 cand_f(4,i) = cand_tf
323C
324 cand_tf = cand_f(5,k)
325 cand_f(5,k) = cand_f(5,i)
326 cand_f(5,i) = cand_tf
327C
328 cand_tf = cand_f(6,k)
329 cand_f(6,k) = cand_f(6,i)
330 cand_f(6,i) = cand_tf
331C
332 cand_tf = cand_f(7,k)
333 cand_f(7,k) = cand_f(7,i)
334 cand_f(7,i) = cand_tf
335C
336 cand_tf = cand_f(8,k)
337 cand_f(8,k) = cand_f(8,i)
338 cand_f(8,i) = cand_tf
339C------ Fx
340 cand_tf = cand_fx(k)
341 cand_fx(k) = cand_fx(i)
342 cand_fx(i) = cand_tf
343C------ Fy
344 cand_tf = cand_fy(k)
345 cand_fy(k) = cand_fy(i)
346 cand_fy(i) = cand_tf
347C------ Fz
348 cand_tf = cand_fz(k)
349 cand_fz(k) = cand_fz(i)
350 cand_fz(i) = cand_tf
351C
352 cand_tf = cand_p(k)
353 cand_p(k) = cand_p(i)
354 cand_p(i) = cand_tf
355C
356 cand_t = ifpen(k)
357 ifpen(k) = ifpen(i)
358 ifpen(i) = cand_t
359C
360 iput(i) = iput(k)
361 iget(iput(i)) = i
362 ENDDO
363 ELSEIF(ifq>0.AND.(inacti==5.OR.inacti==6.OR.inacti==7))THEN
364 DO k=1,i_stok
365 i = iget(k)
366C
367 cand_t = cand_n(k)
368 cand_n(k) = cand_n(i)
369 cand_n(i) = cand_t
370C
371 cand_t = cand_e(k)
372 cand_e(k) = cand_e(i)
373 cand_e(i) = cand_t
374C------ Fx
375 cand_tf = cand_fx(k)
376 cand_fx(k) = cand_fx(i)
377 cand_fx(i) = cand_tf
378C------ Fy
379 cand_tf = cand_fy(k)
380 cand_fy(k) = cand_fy(i)
381 cand_fy(i) = cand_tf
382C------ Fz
383 cand_tf = cand_fz(k)
384 cand_fz(k) = cand_fz(i)
385 cand_fz(i) = cand_tf
386C
387 cand_tf = cand_p(k)
388 cand_p(k) = cand_p(i)
389 cand_p(i) = cand_tf
390C
391 cand_t = ifpen(k)
392 ifpen(k) = ifpen(i)
393 ifpen(i) = cand_t
394C
395 iput(i) = iput(k)
396 iget(iput(i)) = i
397 ENDDO
398 ELSEIF(ifq>0.AND.itied/=0)THEN
399 DO k=1,i_stok
400 i = iget(k)
401C
402 cand_t = cand_n(k)
403 cand_n(k) = cand_n(i)
404 cand_n(i) = cand_t
405C
406 cand_t = cand_e(k)
407 cand_e(k) = cand_e(i)
408 cand_e(i) = cand_t
409C------
410 cand_tf = cand_f(1,k)
411 cand_f(1,k) = cand_f(1,i)
412 cand_f(1,i) = cand_tf
413C
414 cand_tf = cand_f(2,k)
415 cand_f(2,k) = cand_f(2,i)
416 cand_f(2,i) = cand_tf
417C
418 cand_tf = cand_f(3,k)
419 cand_f(3,k) = cand_f(3,i)
420 cand_f(3,i) = cand_tf
421C
422 cand_tf = cand_f(4,k)
423 cand_f(4,k) = cand_f(4,i)
424 cand_f(4,i) = cand_tf
425C
426 cand_tf = cand_f(5,k)
427 cand_f(5,k) = cand_f(5,i)
428 cand_f(5,i) = cand_tf
429C
430 cand_tf = cand_f(6,k)
431 cand_f(6,k) = cand_f(6,i)
432 cand_f(6,i) = cand_tf
433C
434 cand_tf = cand_f(7,k)
435 cand_f(7,k) = cand_f(7,i)
436 cand_f(7,i) = cand_tf
437C
438 cand_tf = cand_f(8,k)
439 cand_f(8,k) = cand_f(8,i)
440 cand_f(8,i) = cand_tf
441C------ Fx
442 cand_tf = cand_fx(k)
443 cand_fx(k) = cand_fx(i)
444 cand_fx(i) = cand_tf
445C------ Fy
446 cand_tf = cand_fy(k)
447 cand_fy(k) = cand_fy(i)
448 cand_fy(i) = cand_tf
449C------ Fz
450 cand_tf = cand_fz(k)
451 cand_fz(k) = cand_fz(i)
452 cand_fz(i) = cand_tf
453C
454 cand_t = ifpen(k)
455 ifpen(k) = ifpen(i)
456 ifpen(i) = cand_t
457C
458 iput(i) = iput(k)
459 iget(iput(i)) = i
460 ENDDO
461 ELSEIF(ifq>0)THEN
462 DO k=1,i_stok
463 i = iget(k)
464C
465 cand_t = cand_n(k)
466 cand_n(k) = cand_n(i)
467 cand_n(i) = cand_t
468C
469 cand_t = cand_e(k)
470 cand_e(k) = cand_e(i)
471 cand_e(i) = cand_t
472C------ Fx
473 cand_tf = cand_fx(k)
474 cand_fx(k) = cand_fx(i)
475 cand_fx(i) = cand_tf
476C------ Fy
477 cand_tf = cand_fy(k)
478 cand_fy(k) = cand_fy(i)
479 cand_fy(i) = cand_tf
480C------ Fz
481 cand_tf = cand_fz(k)
482 cand_fz(k) = cand_fz(i)
483 cand_fz(i) = cand_tf
484 cand_t = ifpen(k)
485 ifpen(k) = ifpen(i)
486 ifpen(i) = cand_t
487C
488 iput(i) = iput(k)
489 iget(iput(i)) = i
490 ENDDO
491 ELSEIF((inacti==5.OR.inacti==6.OR.inacti==7).AND.itied/=0)THEN
492 DO k=1,i_stok
493 i = iget(k)
494C
495 cand_t = cand_n(k)
496 cand_n(k) = cand_n(i)
497 cand_n(i) = cand_t
498C
499 cand_t = cand_e(k)
500 cand_e(k) = cand_e(i)
501 cand_e(i) = cand_t
502C------
503 cand_tf = cand_f(1,k)
504 cand_f(1,k) = cand_f(1,i)
505 cand_f(1,i) = cand_tf
506C
507 cand_tf = cand_f(2,k)
508 cand_f(2,k) = cand_f(2,i)
509 cand_f(2,i) = cand_tf
510C
511 cand_tf = cand_f(3,k)
512 cand_f(3,k) = cand_f(3,i)
513 cand_f(3,i) = cand_tf
514C
515 cand_tf = cand_f(4,k)
516 cand_f(4,k) = cand_f(4,i)
517 cand_f(4,i) = cand_tf
518C
519 cand_tf = cand_f(5,k)
520 cand_f(5,k) = cand_f(5,i)
521 cand_f(5,i) = cand_tf
522C
523 cand_tf = cand_f(6,k)
524 cand_f(6,k) = cand_f(6,i)
525 cand_f(6,i) = cand_tf
526C
527 cand_tf = cand_f(7,k)
528 cand_f(7,k) = cand_f(7,i)
529 cand_f(7,i) = cand_tf
530C
531 cand_tf = cand_f(8,k)
532 cand_f(8,k) = cand_f(8,i)
533 cand_f(8,i) = cand_tf
534C
535 cand_tf = cand_p(k)
536 cand_p(k) = cand_p(i)
537 cand_p(i) = cand_tf
538C
539 iput(i) = iput(k)
540 iget(iput(i)) = i
541 ENDDO
542 ELSEIF(inacti==5.OR.inacti==6.OR.inacti==7)THEN
543 DO k=1,i_stok
544 i = iget(k)
545C
546 cand_t = cand_n(k)
547 cand_n(k) = cand_n(i)
548 cand_n(i) = cand_t
549C
550 cand_t = cand_e(k)
551 cand_e(k) = cand_e(i)
552 cand_e(i) = cand_t
553C
554 cand_tf = cand_p(k)
555 cand_p(k) = cand_p(i)
556 cand_p(i) = cand_tf
557C
558 iput(i) = iput(k)
559 iget(iput(i)) = i
560 ENDDO
561 ELSEIF(itied/=0)THEN
562 DO k=1,i_stok
563 i = iget(k)
564C
565 cand_t = cand_n(k)
566 cand_n(k) = cand_n(i)
567 cand_n(i) = cand_t
568C
569 cand_t = cand_e(k)
570 cand_e(k) = cand_e(i)
571 cand_e(i) = cand_t
572C------
573 cand_tf = cand_f(1,k)
574 cand_f(1,k) = cand_f(1,i)
575 cand_f(1,i) = cand_tf
576C
577 cand_tf = cand_f(2,k)
578 cand_f(2,k) = cand_f(2,i)
579 cand_f(2,i) = cand_tf
580C
581 cand_tf = cand_f(3,k)
582 cand_f(3,k) = cand_f(3,i)
583 cand_f(3,i) = cand_tf
584C
585 cand_tf = cand_f(4,k)
586 cand_f(4,k) = cand_f(4,i)
587 cand_f(4,i) = cand_tf
588C
589 cand_tf = cand_f(5,k)
590 cand_f(5,k) = cand_f(5,i)
591 cand_f(5,i) = cand_tf
592C
593 cand_tf = cand_f(6,k)
594 cand_f(6,k) = cand_f(6,i)
595 cand_f(6,i) = cand_tf
596C
597 cand_tf = cand_f(7,k)
598 cand_f(7,k) = cand_f(7,i)
599 cand_f(7,i) = cand_tf
600C
601 cand_tf = cand_f(8,k)
602 cand_f(8,k) = cand_f(8,i)
603 cand_f(8,i) = cand_tf
604C
605 iput(i) = iput(k)
606 iget(iput(i)) = i
607 ENDDO
608 ELSEIF(num_imp>0)THEN
609 DO k=1,i_stok
610 i = iget(k)
611C
612 cand_t = cand_n(k)
613 cand_n(k) = cand_n(i)
614 cand_n(i) = cand_t
615C
616 cand_t = cand_e(k)
617 cand_e(k) = cand_e(i)
618 cand_e(i) = cand_t
619C
620 cand_tf = cand_p(k)
621 cand_p(k) = cand_p(i)
622 cand_p(i) = cand_tf
623C
624 iput(i) = iput(k)
625 iget(iput(i)) = i
626 ENDDO
627 ELSE
628 DO k=1,i_stok
629 i = iget(k)
630C
631 cand_t = cand_n(k)
632 cand_n(k) = cand_n(i)
633 cand_n(i) = cand_t
634C
635 cand_t = cand_e(k)
636 cand_e(k) = cand_e(i)
637 cand_e(i) = cand_t
638C
639 iput(i) = iput(k)
640 iget(iput(i)) = i
641 ENDDO
642
643 ENDIF
644C=======================================================================
645C CAND_A[NSN+1] : ADRESSE DE NSN+1
646C=======================================================================
647 i_stok = cand_a(nsn+1) - 1
648 cand_a(nsn+2) = cand_a(nsn+1)
649C
650 RETURN
651 END
652
653
654!||====================================================================
655!|| i24trc ../engine/source/interfaces/intsort/i7trc.f
656!||--- called by ------------------------------------------------------
657!|| i24main_tri ../engine/source/interfaces/intsort/i24main_tri.F
658!||--- uses -----------------------------------------------------
659!|| tri7box ../engine/share/modules/tri7box.F
660!||====================================================================
661 SUBROUTINE i24trc(
662 1 NSN,I_STOK,CAND_N,CAND_E,CAND_A,NIN,NSNL,IRTLM,NSV,ITAB,
663 2 MSEGLO,MSEGTYP)
664C-----------------------------------------------
665 USE tri7box
666C-----------------------------------------------
667C I m p l i c i t T y p e s
668C-----------------------------------------------
669#include "implicit_f.inc"
670C-----------------------------------------------
671C C o m m o n B l o c k s
672C-----------------------------------------------
673C ROLE DE LA ROUTINE:
674C ===================
675C TRI sur N de CAND_N CAND_E CAND_F
676C et elimination des noeuds en rebond
677C-----------------------------------------------
678C D u m m y A r g u m e n t s
679C-----------------------------------------------
680 INTEGER I_STOK,NSN,CAND_T,NIN
681 INTEGER CAND_N(*),CAND_E(*),CAND_A(*),
682 * NSNL,IRTLM(2,*),NSV(*),ITAB(*),MSEGLO(*),MSEGTYP(*)
683C-----------------------------------------------
684C L o c a l V a r i a b l e s
685C-----------------------------------------------
686 INTEGER I, I_ST0,N,NN,K,E,
687 . iget(i_stok),iput(i_stok),count,i_st_sav,ish,sym_surf
688C=======================================================================
689C
690
691 DO n=1,nsn+3
692 cand_a(n) = 0
693 ENDDO
694
695 i_st_sav=i_stok
696 count=0
697 DO i=1,i_stok
698 nn = cand_n(i)
699 e = cand_e(i)
700
701C The symmetric surface on shell elements must be kept
702C On solids, the symmetric is the same
703
704 ish = msegtyp(e)
705 IF (ish > 0)THEN
706 sym_surf = mseglo(ish)
707 ELSE
708 sym_surf = mseglo(e)
709 ENDIF
710
711 IF(nn<=nsnl)THEN
712 IF( iabs(irtlm(1,nn))/=mseglo(e) .AND. iabs(irtlm(1,nn)) /= sym_surf ) THEN
713 cand_n(i) = nsn+1
714 ELSE
715 count=count+1
716 ENDIF
717 ELSE
718 IF(iabs(irtlm_fi(nin)%P(1,nn-nsnl)) /= mseglo(e) .AND.
719 * iabs(irtlm_fi(nin)%P(1,nn-nsnl)) /= sym_surf )THEN
720 cand_n(i) = nsn+1
721 ELSE
722 count=count+1
723 ENDIF
724 ENDIF
725 ENDDO
726
727C=======================================================================
728C CAND_A : DENOMBREMENT DE CHAQUE NOEUD
729C APRES 300 CAND_A[3:NSN+3] : OCCURENCE DES NOEUDS [1:NSN+1]
730C=======================================================================
731 DO i=1,i_stok
732 nn = cand_n(i) + 2
733 cand_a(nn) = cand_a(nn) + 1
734 ENDDO
735
736C=======================================================================
737C CAND_A : ADRESSE DE CHAQUE NOEUD
738C APRES 400 CAND_A[2:NSN+2] : ADRESSE DES NOEUDS [1:NSN+1]
739C=======================================================================
740 cand_a(1) = 1
741 cand_a(2) = 1
742 DO n=3,nsn+2
743 cand_a(n) = cand_a(n) + cand_a(n-1)
744 ENDDO
745C=======================================================================
746C IPUT(I) ADRESSE OU DOIT ALLER I
747C IGET(K) ADRESSE D'OU DOIT VENIR K
748C APRES 500 CAND_A[1:NSN+1] : ADRESSE DES NOEUDS [1:NSN+1]
749C=======================================================================
750 DO i=1,i_stok
751 nn = cand_n(i) + 1
752 k = cand_a(nn)
753 iput(i) = k
754 iget(k) = i
755 cand_a(nn) = cand_a(nn) + 1
756 ENDDO
757C=======================================================================
758C TRI DE CAND_N CAND_E CAND_P
759C SUR N CROISSANT
760C PERMUTATION 1 PASSE
761C=============================================
762 DO k=1,i_stok
763 i = iget(k)
764C
765 cand_t = cand_n(k)
766 cand_n(k) = cand_n(i)
767 cand_n(i) = cand_t
768C
769 cand_t = cand_e(k)
770 cand_e(k) = cand_e(i)
771 cand_e(i) = cand_t
772C
773 iput(i) = iput(k)
774 iget(iput(i)) = i
775 ENDDO
776C=======================================================================
777C CAND_A[NSN+1] : ADRESSE DE NSN+1
778C=======================================================================
779 i_stok = cand_a(nsn+1) - 1
780 cand_a(nsn+2) = cand_a(nsn+1)
781C
782 RETURN
783 END
784
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:664
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