OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25trc_e2s.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_e2s ../engine/source/interfaces/intsort/i25trc_e2s.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_e2s(
31 1 NEDGE,I_STOK,CAND_S,CAND_M,
32 2 CAND_P,CAND_A,NIN,NEDGE_L,
33 3 LEDGE,IFQ,CAND_FX ,
34 4 CAND_FY,CAND_FZ,IFPEN)
35C-----------------------------------------------
36 USE tri7box
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C G l o b a l P a r a m e t e r s
43C-----------------------------------------------
44#include "assert.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "param_c.inc"
49C-----------------------------------------------
50C role of the routine:
51C ===================
52C sorting on N of CAND_S CAND_M CAND_F
53C and elimination of bouncing nodes
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER I_STOK,NEDGE,NIN,NEDGE_L,IFQ
58 INTEGER CAND_S(I_STOK),CAND_M(I_STOK),CAND_A(*),IFPEN(*)
59 INTEGER LEDGE(NLEDGE,NEDGE)
60 my_real
61 . cand_p(4,*),cand_fx(4,*) ,cand_fy(4,*) ,cand_fz(4,*)
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER I,N,NN,K,E,CAND_X,
66 . IGET(I_STOK),IPUT(I_STOK)
67 my_real
68 . CAND_XF
69C=======================================================================
70C
71
72 DO n=1,nedge+3
73 cand_a(n) = 0
74 ENDDO
75
76 DO i=1,i_stok
77 nn = cand_s(i)
78 e = cand_m(i)
79
80 assert(cand_s(i) > 0)
81 assert(cand_s(i) <= nedge) ! ici nedge = nedge + nedge_remote
82 debug_e2e(eids == d_es,cand_p(1,i))
83 debug_e2e(eids == d_es,cand_p(2,i))
84 debug_e2e(eids == d_es,cand_p(3,i))
85 debug_e2e(eids == d_es,cand_p(4,i))
86
87C IF(NN<=NEDGE_L)THEN
88 IF (ifq == 0) THEN
89 IF(cand_p(1,i)==zero.AND.
90 . cand_p(2,i)==zero.AND.
91 . cand_p(3,i)==zero.AND.
92 . cand_p(4,i)==zero)THEN
93 cand_s(i) = nedge+1
94 ENDIF
95 ELSE
96 IF(ifpen(i)==0.AND.cand_p(1,i)==zero.AND.
97 . cand_p(2,i)==zero.AND.
98 . cand_p(3,i)==zero.AND.
99 . cand_p(4,i)==zero)THEN
100 cand_s(i) = nedge+1
101 ENDIF
102 ENDIF
103C ELSE ! remote
104C ENDIF
105 ENDDO
106
107C=======================================================================
108C CAND_A : DENOMBREMENT DE CHAQUE NODE C APRES 300 CAND_A[3:NEDGE+3] : occurrence DES NODES [1:NEDGE+1]
109C=======================================================================
110 DO i=1,i_stok
111 nn = cand_s(i) + 2
112 cand_a(nn) = cand_a(nn) + 1
113 ENDDO
114
115C=======================================================================
116C CAND_A : ADDRESS DE CHAQUE NODE C APRES 400 CAND_A[2:NEDGE+2] : ADDRESS DES NODES [1:NEDGE+1]
117C=======================================================================
118 cand_a(1) = 1
119 cand_a(2) = 1
120 DO n=3,nedge+2
121 cand_a(n) = cand_a(n) + cand_a(n-1)
122 ENDDO
123C=======================================================================
124C IPUT(I) ADDRESS OU DOIT ALLER I
125C IGET(K) ADDRESS D'OU DOIT VENIR K
126C APRES 500 CAND_A[1:NEDGE+1] : ADDRESS DES NODES [1:NEDGE+1]
127C=======================================================================
128 DO i=1,i_stok
129 nn = cand_s(i) + 1
130 k = cand_a(nn)
131 assert(k > 0)
132 assert(nn > 0)
133 iput(i) = k
134 iget(k) = i
135 cand_a(nn) = cand_a(nn) + 1
136 ENDDO
137C=======================================================================
138C TRI DE CAND_S CAND_M CAND_P
139C on increasing N
140C PERMUTATION 1 PASSE
141C=============================================
142 DO k=1,i_stok
143 i = iget(k)
144 assert(i > 0)
145C
146 cand_x = cand_s(k)
147 cand_s(k) = cand_s(i)
148 cand_s(i) = cand_x
149C
150 cand_x = cand_m(k)
151 cand_m(k) = cand_m(i)
152 cand_m(i) = cand_x
153C
154 cand_xf = cand_p(1,k)
155 cand_p(1,k) = cand_p(1,i)
156 cand_p(1,i) = cand_xf
157C
158 cand_xf = cand_p(2,k)
159 cand_p(2,k) = cand_p(2,i)
160 cand_p(2,i) = cand_xf
161C
162 cand_xf = cand_p(3,k)
163 cand_p(3,k) = cand_p(3,i)
164 cand_p(3,i) = cand_xf
165C
166 cand_xf = cand_p(4,k)
167 cand_p(4,k) = cand_p(4,i)
168 cand_p(4,i) = cand_xf
169C
170 cand_xf = cand_fx(1,k)
171 cand_fx(1,k) = cand_fx(1,i)
172 cand_fx(1,i) = cand_xf
173C
174 cand_xf = cand_fx(2,k)
175 cand_fx(2,k) = cand_fx(2,i)
176 cand_fx(2,i) = cand_xf
177C
178 cand_xf = cand_fx(3,k)
179 cand_fx(3,k) = cand_fx(3,i)
180 cand_fx(3,i) = cand_xf
181C
182 cand_xf = cand_fx(4,k)
183 cand_fx(4,k) = cand_fx(4,i)
184 cand_fx(4,i) = cand_xf
185C
186 cand_xf = cand_fy(1,k)
187 cand_fy(1,k) = cand_fy(1,i)
188 cand_fy(1,i) = cand_xf
189C
190 cand_xf = cand_fy(2,k)
191 cand_fy(2,k) = cand_fy(2,i)
192 cand_fy(2,i) = cand_xf
193C
194 cand_xf = cand_fy(3,k)
195 cand_fy(3,k) = cand_fy(3,i)
196 cand_fy(3,i) = cand_xf
197C
198 cand_xf = cand_fy(4,k)
199 cand_fy(4,k) = cand_fy(4,i)
200 cand_fy(4,i) = cand_xf
201C
202 cand_xf = cand_fz(1,k)
203 cand_fz(1,k) = cand_fz(1,i)
204 cand_fz(1,i) = cand_xf
205C
206 cand_xf = cand_fz(2,k)
207 cand_fz(2,k) = cand_fz(2,i)
208 cand_fz(2,i) = cand_xf
209C
210 cand_xf = cand_fz(3,k)
211 cand_fz(3,k) = cand_fz(3,i)
212 cand_fz(3,i) = cand_xf
213C
214 cand_xf = cand_fz(4,k)
215 cand_fz(4,k) = cand_fz(4,i)
216 cand_fz(4,i) = cand_xf
217C
218 cand_x = ifpen(k)
219 ifpen(k) = ifpen(i)
220 ifpen(i) = cand_x
221C
222 iput(i) = iput(k)
223
224 assert(iput(i) > 0)
225 assert(iput(i) <= i_stok)
226
227 iget(iput(i)) = i
228 ENDDO
229C=======================================================================
230C CAND_A[NEDGE+1] : ADDRESS DE NEDGE+1
231C=======================================================================
232 i_stok = cand_a(nedge+1) - 1
233 cand_a(nedge+2) = cand_a(nedge+1)
234C
235 RETURN
236 END
i25trc_e2s
subroutine i25trc_e2s(nedge, i_stok, cand_s, cand_m, cand_p, cand_a, nin, nedge_l, ledge, ifq, cand_fx, cand_fy, cand_fz, ifpen)
Definition i25trc_e2s.F:35