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 DE LA ROUTINE:
51C ===================
52C TRI sur N de CAND_S CAND_M CAND_F
53C et elimination des noeuds en rebond
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, I_ST0,N,NN,K,E,CAND_X,
66 . IGET(I_STOK),IPUT(I_STOK)
67 my_real
68 . CAND_XF
69 INTEGER EIDS
70C=======================================================================
71C
72
73 DO n=1,nedge+3
74 cand_a(n) = 0
75 ENDDO
76
77 DO i=1,i_stok
78 nn = cand_s(i)
79 e = cand_m(i)
80
81 assert(cand_s(i) > 0)
82 assert(cand_s(i) <= nedge) ! ici nedge = nedge + nedge_remote
83 debug_e2e(eids == d_es,cand_p(1,i))
84 debug_e2e(eids == d_es,cand_p(2,i))
85 debug_e2e(eids == d_es,cand_p(3,i))
86 debug_e2e(eids == d_es,cand_p(4,i))
87
88C IF(NN<=NEDGE_L)THEN
89 IF (ifq == 0) THEN
90 IF(cand_p(1,i)==zero.AND.
91 . cand_p(2,i)==zero.AND.
92 . cand_p(3,i)==zero.AND.
93 . cand_p(4,i)==zero)THEN
94 cand_s(i) = nedge+1
95 ENDIF
96 ELSE
97 IF(ifpen(i)==0.AND.cand_p(1,i)==zero.AND.
98 . cand_p(2,i)==zero.AND.
99 . cand_p(3,i)==zero.AND.
100 . cand_p(4,i)==zero)THEN
101 cand_s(i) = nedge+1
102 ENDIF
103 ENDIF
104C ELSE ! remote
105C ENDIF
106 ENDDO
107
108C=======================================================================
109C CAND_A : DENOMBREMENT DE CHAQUE NOEUD
110C APRES 300 CAND_A[3:NEDGE+3] : OCCURENCE DES NOEUDS [1:NEDGE+1]
111C=======================================================================
112 DO i=1,i_stok
113 nn = cand_s(i) + 2
114 cand_a(nn) = cand_a(nn) + 1
115 ENDDO
116
117C=======================================================================
118C CAND_A : ADRESSE DE CHAQUE NOEUD
119C APRES 400 CAND_A[2:NEDGE+2] : ADRESSE DES NOEUDS [1:NEDGE+1]
120C=======================================================================
121 cand_a(1) = 1
122 cand_a(2) = 1
123 DO n=3,nedge+2
124 cand_a(n) = cand_a(n) + cand_a(n-1)
125 ENDDO
126C=======================================================================
127C IPUT(I) ADRESSE OU DOIT ALLER I
128C IGET(K) ADRESSE D'OU DOIT VENIR K
129C APRES 500 CAND_A[1:NEDGE+1] : ADRESSE DES NOEUDS [1:NEDGE+1]
130C=======================================================================
131 DO i=1,i_stok
132 nn = cand_s(i) + 1
133 k = cand_a(nn)
134 assert(k > 0)
135 assert(nn > 0)
136 iput(i) = k
137 iget(k) = i
138 cand_a(nn) = cand_a(nn) + 1
139 ENDDO
140C=======================================================================
141C TRI DE CAND_S CAND_M CAND_P
142C SUR N CROISSANT
143C PERMUTATION 1 PASSE
144C=============================================
145 DO k=1,i_stok
146 i = iget(k)
147 assert(i > 0)
148C
149 cand_x = cand_s(k)
150 cand_s(k) = cand_s(i)
151 cand_s(i) = cand_x
152C
153 cand_x = cand_m(k)
154 cand_m(k) = cand_m(i)
155 cand_m(i) = cand_x
156C
157 cand_xf = cand_p(1,k)
158 cand_p(1,k) = cand_p(1,i)
159 cand_p(1,i) = cand_xf
160C
161 cand_xf = cand_p(2,k)
162 cand_p(2,k) = cand_p(2,i)
163 cand_p(2,i) = cand_xf
164C
165 cand_xf = cand_p(3,k)
166 cand_p(3,k) = cand_p(3,i)
167 cand_p(3,i) = cand_xf
168C
169 cand_xf = cand_p(4,k)
170 cand_p(4,k) = cand_p(4,i)
171 cand_p(4,i) = cand_xf
172C
173 cand_xf = cand_fx(1,k)
174 cand_fx(1,k) = cand_fx(1,i)
175 cand_fx(1,i) = cand_xf
176C
177 cand_xf = cand_fx(2,k)
178 cand_fx(2,k) = cand_fx(2,i)
179 cand_fx(2,i) = cand_xf
180C
181 cand_xf = cand_fx(3,k)
182 cand_fx(3,k) = cand_fx(3,i)
183 cand_fx(3,i) = cand_xf
184C
185 cand_xf = cand_fx(4,k)
186 cand_fx(4,k) = cand_fx(4,i)
187 cand_fx(4,i) = cand_xf
188C
189 cand_xf = cand_fy(1,k)
190 cand_fy(1,k) = cand_fy(1,i)
191 cand_fy(1,i) = cand_xf
192C
193 cand_xf = cand_fy(2,k)
194 cand_fy(2,k) = cand_fy(2,i)
195 cand_fy(2,i) = cand_xf
196C
197 cand_xf = cand_fy(3,k)
198 cand_fy(3,k) = cand_fy(3,i)
199 cand_fy(3,i) = cand_xf
200C
201 cand_xf = cand_fy(4,k)
202 cand_fy(4,k) = cand_fy(4,i)
203 cand_fy(4,i) = cand_xf
204C
205 cand_xf = cand_fz(1,k)
206 cand_fz(1,k) = cand_fz(1,i)
207 cand_fz(1,i) = cand_xf
208C
209 cand_xf = cand_fz(2,k)
210 cand_fz(2,k) = cand_fz(2,i)
211 cand_fz(2,i) = cand_xf
212C
213 cand_xf = cand_fz(3,k)
214 cand_fz(3,k) = cand_fz(3,i)
215 cand_fz(3,i) = cand_xf
216C
217 cand_xf = cand_fz(4,k)
218 cand_fz(4,k) = cand_fz(4,i)
219 cand_fz(4,i) = cand_xf
220C
221 cand_x = ifpen(k)
222 ifpen(k) = ifpen(i)
223 ifpen(i) = cand_x
224C
225 iput(i) = iput(k)
226
227 assert(iput(i) > 0)
228 assert(iput(i) <= i_stok)
229
230 iget(iput(i)) = i
231 ENDDO
232C=======================================================================
233C CAND_A[NEDGE+1] : ADRESSE DE NEDGE+1
234C=======================================================================
235 i_stok = cand_a(nedge+1) - 1
236 cand_a(nedge+2) = cand_a(nedge+1)
237C
238 RETURN
239 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