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_vox1 ../starter/source/interfaces/inter3d1/i11sto.F
25!||--- called by ------------------------------------------------------
26!|| i11trivox1 ../starter/source/interfaces/inter3d1/i11trivox1.F
27!||--- calls -----------------------------------------------------
28!|| i11pen3_vox1 ../starter/source/interfaces/inter3d1/i11pen3.F
29!||====================================================================
30 SUBROUTINE i11sto_vox1(
31 1 J_STOK,IRECTS,IRECTM,X ,II_STOK,
32 4 CAND_N,CAND_E,NSN ,NOINT ,MARGE ,
33 5 I_MEM ,PROV_N,PROV_E,MULTIMP,ADDCM ,
34 4 CHAINE,IADFIN,GAPMIN,DRAD ,IGAP ,
35 5 GAP_S ,GAP_M ,GAP_S_L,GAP_M_L,DGAPLOAD)
36C============================================================================
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 "mvsiz_p.inc"
45C-----------------------------------------------
46C D u m m y A r g u m e n t s
47C-----------------------------------------------
48 INTEGER I_MEM,MULTIMP,IADFIN
49 INTEGER J_STOK,NSN,NOINT,II_STOK, IGAP
50 INTEGER IRECTS(2,*),IRECTM(2,*),CAND_N(*),CAND_E(*)
51 INTEGER PROV_N(MVSIZ),PROV_E(MVSIZ),IAD0(MVSIZ),ADDCM(*),
52 . CHAINE(2,*)
53 my_real
54 . x(3,*), gapmin, drad, marge
55 my_real , INTENT(IN) :: dgapload
56 my_real
57 . gap_s(*), gap_m(*), gap_s_l(*), gap_m_l(*)
58C-----------------------------------------------
59C L o c a l V a r i a b l e s
60C-----------------------------------------------
61 INTEGER I,J,K_STOK,I_STOK,IAD,CONT
62C REAL
63 my_real
64 . PENE(MVSIZ)
65C-----------------------------------------------
66 CALL i11pen3_vox1(j_stok ,prov_n ,prov_e ,gapmin ,drad ,
67 . marge ,gap_s ,gap_m ,gap_s_l,gap_m_l ,
68 . igap ,x ,irects ,irectm ,pene ,
69 . dgapload)
70C-----------------------------------------------
71 k_stok = 0
72 i_stok = ii_stok
73C-----------------------------------------------
74C elimination des couples deja trouves dans 1 boite precedente
75C-----------------------------------------------
76 DO i=1,j_stok
77 IF(pene(i)/=0.0)THEN
78 iad=addcm(prov_e(i))
79 j=0
80 DO WHILE(iad/=0.AND.j<multimp*nsn)
81 j=j+1
82 IF(chaine(1,iad)==prov_n(i))THEN
83 pene(i) = zero
84 iad=0
85 ELSE
86 iad0(i)=iad
87 iad=chaine(2,iad)
88 ENDIF
89 ENDDO
90 IF(pene(i)/=zero)THEN
91 k_stok = k_stok + 1
92 IF(i_stok+k_stok>multimp*nsn) THEN
93 i_mem = 2
94 RETURN
95 ENDIF
96 iadfin=iadfin+1
97 chaine(1,iadfin)=prov_n(i)
98 chaine(2,iadfin)=0
99 IF(addcm(prov_e(i))==0)THEN
100 addcm(prov_e(i))=iadfin
101 ELSE
102 chaine(2,iad0(i))=iadfin
103 ENDIF
104 ENDIF
105 ENDIF
106 ENDDO
107C
108 IF(k_stok==0)RETURN
109C
110 ii_stok = i_stok + k_stok
111C-----------------------------------------------
112C stockage des couples candidats
113C-----------------------------------------------
114 DO i=1,j_stok
115 IF(pene(i)/=zero)THEN
116 i_stok = i_stok + 1
117 cand_n(i_stok) = prov_n(i)
118 cand_e(i_stok) = prov_e(i)
119 ENDIF
120 ENDDO
121C-----------------------------------------------
122 RETURN
123 END
124!||====================================================================
125!|| i11sto ../starter/source/interfaces/inter3d1/i11sto.F
126!||--- called by ------------------------------------------------------
127!|| i11buc1 ../starter/source/interfaces/inter3d1/i11buc1.F
128!|| i11tri ../starter/source/interfaces/inter3d1/i11tri.F
129!||--- calls -----------------------------------------------------
130!|| i11pen3 ../starter/source/interfaces/inter3d1/i11pen3.F
131!||====================================================================
132 SUBROUTINE i11sto(
133 1 J_STOK,IRECTS,IRECTM,X ,II_STOK,
134 4 CAND_N,CAND_E,NSN ,NOINT ,TZINF ,
135 5 I_MEM ,PROV_N,PROV_E,MULTIMP,ADDCM,
136 4 CHAINE,IADFIN)
137C============================================================================
138C cette routine est appelee par : I11TRI(/inter3d1/i11tri.F)
139C----------------------------------------------------------------------------
140C cette routine appelle : I11PEN3(/inter3d1/i11pen3.F)
141C============================================================================
142C-----------------------------------------------
143C I m p l i c i t T y p e s
144C-----------------------------------------------
145#include "implicit_f.inc"
146C-----------------------------------------------
147C G l o b a l P a r a m e t e r s
148C-----------------------------------------------
149#include "mvsiz_p.inc"
150C-----------------------------------------------
151C D u m m y A r g u m e n t s
152C-----------------------------------------------
153 INTEGER I_MEM,MULTIMP,IADFIN
154 INTEGER J_STOK,NSN,NOINT,II_STOK
155 INTEGER IRECTS(2,*),IRECTM(2,*),CAND_N(*),CAND_E(*)
156 INTEGER PROV_N(MVSIZ),PROV_E(MVSIZ),IAD0(MVSIZ),ADDCM(*),
157 . CHAINE(2,*)
158 my_real
159 . X(3,*),TZINF
160C-----------------------------------------------
161C L o c a l V a r i a b l e s
162C-----------------------------------------------
163 INTEGER I,J,K_STOK,I_STOK,IAD,CONT
164 my_real
165 . pene(mvsiz)
166C-----------------------------------------------
167 CALL i11pen3(j_stok ,prov_n,prov_e,tzinf ,x ,
168 . irects ,irectm ,pene )
169C-----------------------------------------------
170 k_stok = 0
171 i_stok = ii_stok
172C-----------------------------------------------
173C elimination des couples deja trouves dans 1 boite precedente
174C-----------------------------------------------
175 DO i=1,j_stok
176 IF(pene(i)/=0.0)THEN
177 iad=addcm(prov_e(i))
178 j=0
179 DO WHILE(iad/=0.AND.j<multimp*nsn)
180 j=j+1
181 IF(chaine(1,iad)==prov_n(i))THEN
182 pene(i) = zero
183 iad=0
184 ELSE
185 iad0(i)=iad
186 iad=chaine(2,iad)
187 ENDIF
188 ENDDO
189 IF(pene(i)/=zero)THEN
190 k_stok = k_stok + 1
191 IF(i_stok+k_stok>multimp*nsn) THEN
192 i_mem = 2
193 RETURN
194 ENDIF
195 iadfin=iadfin+1
196 chaine(1,iadfin)=prov_n(i)
197 chaine(2,iadfin)=0
198 IF(addcm(prov_e(i))==0)THEN
199 addcm(prov_e(i))=iadfin
200 ELSE
201 chaine(2,iad0(i))=iadfin
202 ENDIF
203 ENDIF
204 ENDIF
205 ENDDO
206C
207 IF(k_stok==0)RETURN
208C
209 ii_stok = i_stok + k_stok
210C-----------------------------------------------
211C stockage des couples candidats
212C-----------------------------------------------
213 DO i=1,j_stok
214 IF(pene(i)/=zero)THEN
215 i_stok = i_stok + 1
216 cand_n(i_stok) = prov_n(i)
217 cand_e(i_stok) = prov_e(i)
218 ENDIF
219 ENDDO
220C-----------------------------------------------
221 RETURN
222 END
my_real
#define my_real
Definition cppsort.cpp:32
i11pen3
subroutine i11pen3(jlt, cand_n, cand_e, gap, x, irects, irectm, pene)
Definition i11pen3.F:155
i11pen3_vox1
subroutine i11pen3_vox1(jlt, cand_s, cand_m, gapmin, drad, marge, gap_s, gap_m, gap_s_l, gap_m_l, igap, x, irects, irectm, pene, dgapload)
Definition i11pen3.F:32
i11sto
subroutine i11sto(j_stok, irects, irectm, x, ii_stok, cand_n, cand_e, nsn, noint, tzinf, i_mem, prov_n, prov_e, multimp, addcm, chaine, iadfin)
Definition i11sto.F:137
i11sto_vox1
subroutine i11sto_vox1(j_stok, irects, irectm, x, ii_stok, cand_n, cand_e, nsn, noint, marge, i_mem, prov_n, prov_e, multimp, addcm, chaine, iadfin, gapmin, drad, igap, gap_s, gap_m, gap_s_l, gap_m_l, dgapload)
Definition i11sto.F:36