OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25trc_edg.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!|| i25trc_edg ../engine/source/interfaces/intsort/i25trc_edg.F
25!||--- called by ------------------------------------------------------
26!|| i25main_tri ../engine/source/interfaces/intsort/i25main_tri.F
27!||--- uses -----------------------------------------------------
28!|| tri7box ../engine/share/modules/tri7box.F
29!||====================================================================
30 SUBROUTINE i25trc_edg(
31 1 NEDGE,I_STOK,CAND_S,CAND_M,
32 2 CAND_P,CAND_A,NIN,NEDGE_L,IFQ,
33 3 CAND_FX ,CAND_FY,CAND_FZ,IFPEN)
34C-----------------------------------------------
35 USE tri7box
36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40C-----------------------------------------------
41C C o m m o n B l o c k s
42C-----------------------------------------------
43#include "assert.inc"
44C-----------------------------------------------
45C role of the routine:
46C ===================
47C sorting on N of CAND_S CAND_M CAND_F
48C and elimination of bouncing nodes
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER :: I_STOK,NEDGE,NIN,NEDGE_L,IFQ
53 INTEGER :: CAND_S(I_STOK),CAND_M(I_STOK),CAND_A(*),IFPEN(*)
54 my_real
55 . cand_p(*),cand_fx(*) ,cand_fy(*) ,cand_fz(*)
56C-----------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 INTEGER I,N,NN,K,E,CAND_T,
60 . IGET(I_STOK),IPUT(I_STOK)
61 my_real
62 . cand_tf
63C=======================================================================
64C
65
66 DO n=1,nedge+3
67 cand_a(n) = 0
68 ENDDO
69
70 DO i=1,i_stok
71 nn = cand_s(i)
72 e = cand_m(i)
73
74 assert(cand_s(i) > 0)
75 assert(cand_s(i) <= nedge) ! ici nedge = nedge + nedge_remote
76
77
78C IF(NN<=NEDGE_L)THEN
79 IF (ifq == 0) THEN
80 IF(cand_p(i)==zero)THEN
81 cand_s(i) = nedge+1
82 ENDIF
83 ELSE
84 IF(ifpen(i)==0.AND.cand_p(i)==zero)THEN
85 cand_s(i) = nedge+1
86 ENDIF
87 ENDIF
88C ELSE ! remote
89C ENDIF
90 ENDDO
91
92C=======================================================================
93C CAND_A : DENOMBREMENT DE CHAQUE NODE C APRES 300 CAND_A[3:NEDGE+3] : occurrence DES NODES [1:NEDGE+1]
94C=======================================================================
95 DO i=1,i_stok
96 nn = cand_s(i) + 2
97 cand_a(nn) = cand_a(nn) + 1
98 ENDDO
99
100C=======================================================================
101C CAND_A : ADDRESS DE CHAQUE NODE C APRES 400 CAND_A[2:NEDGE+2] : ADDRESS DES NODES [1:NEDGE+1]
102C=======================================================================
103 cand_a(1) = 1
104 cand_a(2) = 1
105 DO n=3,nedge+2
106 cand_a(n) = cand_a(n) + cand_a(n-1)
107 ENDDO
108C=======================================================================
109C IPUT(I) ADDRESS OU DOIT ALLER I
110C IGET(K) ADDRESS D'OU DOIT VENIR K
111C APRES 500 CAND_A[1:NEDGE+1] : ADDRESS DES NODES [1:NEDGE+1]
112C=======================================================================
113 DO i=1,i_stok
114 nn = cand_s(i) + 1
115 k = cand_a(nn)
116 iput(i) = k
117 iget(k) = i
118 assert(i > 0)
119 assert(k > 0)
120 assert(nn < nedge + 4 )
121 cand_a(nn) = cand_a(nn) + 1
122 ENDDO
123C=======================================================================
124C TRI DE CAND_S CAND_M CAND_P
125C on increasing N
126C PERMUTATION 1 PASSE
127C=============================================
128 DO k=1,i_stok
129 i = iget(k)
130 assert(i > 0)
131C
132 cand_t = cand_s(k)
133 cand_s(k) = cand_s(i)
134 cand_s(i) = cand_t
135C
136 cand_t = cand_m(k)
137 cand_m(k) = cand_m(i)
138 cand_m(i) = cand_t
139C
140 cand_tf = cand_p(k)
141 cand_p(k) = cand_p(i)
142 cand_p(i) = cand_tf
143C
144 cand_tf = cand_fx(k)
145 cand_fx(k) = cand_fx(i)
146 cand_fx(i) = cand_tf
147C
148 cand_tf = cand_fy(k)
149 cand_fy(k) = cand_fy(i)
150 cand_fy(i) = cand_tf
151C
152 cand_tf = cand_fz(k)
153 cand_fz(k) = cand_fz(i)
154 cand_fz(i) = cand_tf
155C
156 cand_t = ifpen(k)
157 ifpen(k) = ifpen(i)
158 ifpen(i) = cand_t
159C
160 iput(i) = iput(k)
161 assert(iput(i) > 0)
162 assert(iput(i) <= i_stok)
163 iget(iput(i)) = i
164
165 ENDDO
166C=======================================================================
167C CAND_A[NEDGE+1] : ADDRESS DE NEDGE+1
168C=======================================================================
169 i_stok = cand_a(nedge+1) - 1
170 cand_a(nedge+2) = cand_a(nedge+1)
171C
172 RETURN
173 END
i25trc_edg
subroutine i25trc_edg(nedge, i_stok, cand_s, cand_m, cand_p, cand_a, nin, nedge_l, ifq, cand_fx, cand_fy, cand_fz, ifpen)
Definition i25trc_edg.F:34