OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i11sto.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!|| i11sto_vox ../engine/source/interfaces/intsort/i11sto.f
25!||--- called by ------------------------------------------------------
26!|| i11trivox ../engine/source/interfaces/intsort/i11trivox.F
27!||--- calls -----------------------------------------------------
28!|| i11pen3_vox ../engine/source/interfaces/intsort/i11pen3.f
29!||--- uses -----------------------------------------------------
30!|| tri7box ../engine/share/modules/tri7box.F
31!||====================================================================
32 SUBROUTINE i11sto_vox(
33 1 J_STOK,IRECTS,IRECTM,X ,II_STOK,
34 2 CAND_S,CAND_M,NSN4 ,NOINT ,MARGE,
35 3 I_MEM ,PROV_S,PROV_M,ESHIFT,ADDCM ,
36 4 CHAINE,NRTS, ITAB ,IFPEN ,IFORM ,
37 5 GAPMIN,DRAD ,IGAP ,GAP_S ,GAP_M ,
38 7 GAP_S_L, GAP_M_L ,DGAPLOAD)
39
40C============================================================================
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE tri7box
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49#include "comlock.inc"
50C-----------------------------------------------
51C G l o b a l P a r a m e t e r s
52C-----------------------------------------------
53#include "mvsiz_p.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER I_MEM, NRTS, NIN, ITAB(*)
58 INTEGER J_STOK,NSN4,NOINT,IFORM,IGAP
59 INTEGER IRECTS(2,*),IRECTM(2,*),CAND_S(*),CAND_M(*),ADDCM(*),
60 . CHAINE(2,*),IFPEN(*),II_STOK
61 INTEGER PROV_S(MVSIZ),PROV_M(MVSIZ),ESHIFT
62C REAL
63 my_real
64 . x(3,*), gapmin, marge,
65 . gap_s(*), gap_m(*), gap_s_l(*), gap_m_l(*)
66 my_real , INTENT(IN) :: dgapload,drad
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70 INTEGER I,J,K_STOK,I_STOK,IAD0,IAD,IADFIN
71 INTEGER I_STOK_FIRST
72C REAL
73 my_real
74 . pene(mvsiz)
75C-----------------------------------------------
76 k_stok=0
77
78c CALL I11PEN3(J_STOK ,PROV_S,PROV_M,TZINF ,X ,
79c . IRECTS ,IRECTM,PENE ,NRTS )
80 CALL i11pen3_vox(j_stok ,prov_s ,prov_m ,gapmin ,drad ,
81 . marge ,gap_s ,gap_m ,gap_s_l,gap_m_l ,
82 . igap ,x ,irects ,irectm ,pene ,
83 . nrts ,dgapload)
84
85C-----------------------------------------------
86C il faut un lock sur toute la boucle (modification de chaine)
87#include "lockon.inc"
88C-----------------------------------------------
89C elimination des couples deja trouves : une edge
90C escclave peut occuper plusieurs voxels. enbalyant les voxels
91C de l'edge main pour trouver les seconds correspondantes
92C on peut donc trouver plusieurs occurence de l'edge second.
93C-----------------------------------------------
94 i_stok = ii_stok
95 DO i=1,j_stok
96 IF(pene(i)>zero)THEN
97 iad=addcm(prov_m(i))
98 j=0
99 DO WHILE(iad/=0.AND.j<nsn4)
100 j=j+1
101 IF(chaine(1,iad)==prov_s(i))THEN
102 pene(i) = zero
103 iad=0
104 ELSE
105 iad0=iad
106 iad=chaine(2,iad)
107 ENDIF
108 ENDDO
109 IF(pene(i)>zero)THEN
110 k_stok = k_stok + 1
111 iadfin=ii_stok+1
112 IF(iadfin>nsn4) THEN
113 i_mem = 2
114#include "lockoff.inc"
115 RETURN
116 ENDIF
117 ii_stok = iadfin
118 chaine(1,iadfin)=prov_s(i)
119 chaine(2,iadfin)=0
120 IF(addcm(prov_m(i))==0)THEN
121 addcm(prov_m(i))=iadfin
122 ELSE
123 chaine(2,iad0)=iadfin
124 ENDIF
125 ENDIF
126 ENDIF
127 ENDDO
128 IF(k_stok==0) THEN
129#include "lockoff.inc"
130 RETURN
131 ENDIF
132
133 i_stok_first = i_stok
134 DO i=1,j_stok
135 IF(pene(i)>zero)THEN
136 i_stok = i_stok + 1
137 cand_s(i_stok) = prov_s(i)
138 cand_m(i_stok) = prov_m(i)+eshift
139c IFPEN(I_STOK) = 0
140 ENDIF
141 END DO
142
143 IF (iform==2 .AND. i_stok > i_stok_first) ifpen(i_stok_first+1:i_stok)=0
144
145C-----------------------------------------------
146#include "lockoff.inc"
147 RETURN
148 END
149
150
151
152
153C OLD ROUTINE
154!||====================================================================
155!|| i11sto ../engine/source/interfaces/intsort/i11sto.F
156!||--- called by ------------------------------------------------------
157!|| i11tri ../engine/source/interfaces/intsort/i11tri.F
158!||--- calls -----------------------------------------------------
159!|| i11pen3 ../engine/source/interfaces/intsort/i11pen3.F
160!||--- uses -----------------------------------------------------
161!|| tri7box ../engine/share/modules/tri7box.F
162!||====================================================================
163 SUBROUTINE i11sto(
164 1 J_STOK,IRECTS,IRECTM,X ,II_STOK,
165 2 CAND_S,CAND_M,NSN4 ,NOINT ,TZINF ,
166 3 I_MEM ,PROV_S,PROV_M,ESHIFT,ADDCM,
167 4 CHAINE,NRTS, ITAB ,IFPEN ,IFORM)
168C============================================================================
169C-----------------------------------------------
170C M o d u l e s
171C-----------------------------------------------
172 USE tri7box
173C-----------------------------------------------
174C I m p l i c i t T y p e s
175C-----------------------------------------------
176#include "implicit_f.inc"
177#include "comlock.inc"
178C-----------------------------------------------
179C G l o b a l P a r a m e t e r s
180C-----------------------------------------------
181#include "mvsiz_p.inc"
182C-----------------------------------------------
183C D u m m y A r g u m e n t s
184C-----------------------------------------------
185 INTEGER I_MEM, NRTS, NIN, ITAB(*)
186 INTEGER J_STOK,NSN4,NOINT,IFORM
187 INTEGER IRECTS(2,*),IRECTM(2,*),CAND_S(*),CAND_M(*),ADDCM(*),
188 . CHAINE(2,*),IFPEN(*),II_STOK
189 INTEGER PROV_S(MVSIZ),PROV_M(MVSIZ),ESHIFT
190C REAL
191 my_real
192 . X(3,*),TZINF
193C-----------------------------------------------
194C L o c a l V a r i a b l e s
195C-----------------------------------------------
196 INTEGER I,J,K_STOK,I_STOK,IAD0,IAD,IADFIN
197 INTEGER I_STOK_FIRST
198C REAL
199 my_real
200 . pene(mvsiz)
201C-----------------------------------------------
202 k_stok=0
203
204 CALL i11pen3(j_stok ,prov_s,prov_m,tzinf ,x ,
205 . irects ,irectm,pene ,nrts )
206C-----------------------------------------------
207C il faut un lock sur toute la boucle (modification de chaine)
208#include "lockon.inc"
209C-----------------------------------------------
210C elimination des couples deja trouves : une edge
211C escclave peut occuper plusieurs voxels. enbalyant les voxels
212C de l'edge main pour trouver les seconds correspondantes
213C on peut donc trouver plusieurs occurence de l'edge second.
214C-----------------------------------------------
215 i_stok = ii_stok
216 DO i=1,j_stok
217 IF(pene(i)>zero)THEN
218 iad=addcm(prov_m(i))
219 j=0
220 DO WHILE(iad/=0.AND.j<nsn4)
221 j=j+1
222 IF(chaine(1,iad)==prov_s(i))THEN
223 pene(i) = zero
224 iad=0
225 ELSE
226 iad0=iad
227 iad=chaine(2,iad)
228 ENDIF
229 ENDDO
230 IF(pene(i)>zero)THEN
231 k_stok = k_stok + 1
232 iadfin=ii_stok+1
233 IF(iadfin>nsn4) THEN
234 i_mem = 2
235#include "lockoff.inc"
236 RETURN
237 ENDIF
238 ii_stok = iadfin
239 chaine(1,iadfin)=prov_s(i)
240 chaine(2,iadfin)=0
241 IF(addcm(prov_m(i))==0)THEN
242 addcm(prov_m(i))=iadfin
243 ELSE
244 chaine(2,iad0)=iadfin
245 ENDIF
246 ENDIF
247 ENDIF
248 ENDDO
249
250 IF(k_stok==0) THEN
251#include "lockoff.inc"
252 RETURN
253 ENDIF
254
255 i_stok_first = i_stok
256 DO i=1,j_stok
257 IF(pene(i)>zero)THEN
258 i_stok = i_stok + 1
259 cand_s(i_stok) = prov_s(i)
260 cand_m(i_stok) = prov_m(i)+eshift
261c IFPEN(I_STOK) = 0
262 ENDIF
263 END DO
264
265 IF (iform==2 .AND. i_stok > i_stok_first) ifpen(i_stok_first+1:i_stok)=0
266
267C-----------------------------------------------
268#include "lockoff.inc"
269 RETURN
270 END
271
272
273
my_real
#define my_real
Definition cppsort.cpp:32
i11pen3_vox
subroutine i11pen3_vox(jlt, cand_s, cand_m, gapmin, drad, marge, gap_s, gap_m, gap_s_l, gap_m_l, igap, x, irects, irectm, pene, nrts, dgapload)
Definition i11pen3.F:34
i11sto
subroutine i11sto(j_stok, irects, irectm, x, ii_stok, cand_s, cand_m, nsn4, noint, tzinf, i_mem, prov_s, prov_m, eshift, addcm, chaine, nrts, itab, ifpen, iform)
Definition i11sto.F:168
i11sto_vox
subroutine i11sto_vox(j_stok, irects, irectm, x, ii_stok, cand_s, cand_m, nsn4, noint, marge, i_mem, prov_s, prov_m, eshift, addcm, chaine, nrts, itab, ifpen, iform, gapmin, drad, igap, gap_s, gap_m, gap_s_l, gap_m_l, dgapload)
Definition i11sto.F:39
i11pen3
subroutine i11pen3(jlt, cand_n, cand_e, gap, x, irects, irectm, pene)
Definition i11pen3.F:155