OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25buce_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!|| i25buce_edg ../starter/source/interfaces/inter3d1/i25buce_edg.F
25!||--- called by ------------------------------------------------------
26!|| inint3 ../starter/source/interfaces/inter3d1/inint3.F
27!||--- calls -----------------------------------------------------
28!|| i25trivox_edg ../starter/source/interfaces/inter3d1/i25trivox_edg.F
29!||--- uses -----------------------------------------------------
30!|| message_mod ../starter/share/message_module/message_mod.F
31!|| tri7box ../starter/share/modules1/tri7box.F
32!||====================================================================
33 SUBROUTINE i25buce_edg(
34 1 X ,IRECT ,INACTI ,NSN ,
35 2 NMN ,CANDM_E2E ,CANDS_E2E ,
36 3 GAP ,NOINT ,II_STOK ,MULNSNE ,BMINMA ,
37 4 MARGE ,VMAXDT ,DRAD ,ESHIFT ,NEDGE_T ,
38 5 SSHIFT ,NRTM_T ,STFM ,STFN ,
39 6 NCONT ,GAP_M ,ITASK ,BGAPEMX ,
40 7 I_MEM ,ITAB ,MBINFLG ,EBINFLG ,LL_STOK ,
41 8 MULNSNS ,ILEV ,CAND_A ,CAND_P ,IGAP0 ,
42 9 FLAGREMNODE,KREMNOD,REMNOD ,S_REMNODE_EDG,
43 A IGAP ,GAP_M_L ,IEDGE ,NEDGE ,MSEGTYP,
44 B LEDGE ,ADMSR,EDG_BISECTOR,VTX_BISECTOR,
45 C CANDM_E2S ,CANDS_E2S,CAND_B ,CAND_PS ,GAPE ,
46 D GAP_E_L ,DGAPLOAD,FLAG_REMOVED_NODE,
47 E S_KREMNODE_E2S,S_REMNODE_E2S,KREMNODE_E2S,REMNODE_E2S,
48 F S_KREMNODE_EDG)
49C============================================================================
50C M o d u l e s
51C-----------------------------------------------
52 USE tri7box
53 USE message_mod
54C-----------------------------------------------
55C I m p l i c i t T y p e s
56C-----------------------------------------------
57#include "implicit_f.inc"
58C-----------------------------------------------
59C C o m m o n B l o c k s
60C-----------------------------------------------
61#include "param_c.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 INTEGER NSN, NMN,NOINT,IDT,INACTI,IGAP0
66 LOGICAL, INTENT(in) :: FLAG_REMOVED_NODE !< flag to remove some S node from the list of candidates
67 INTEGER, INTENT(in) :: S_KREMNODE_E2S !< size of KREMNODE_E2S array
68 INTEGER, INTENT(in) :: S_REMNODE_E2S !< size of REMNODE_E2S array
69 INTEGER, INTENT(in) :: S_KREMNODE_EDG
70
71 INTEGER IRECT(4,*),ITASK,ILEV, IGAP, IEDGE, NEDGE, ESHIFT,NEDGE_T,SSHIFT,NRTM_T
72 INTEGER CANDM_E2E(*),CANDS_E2E(*),CAND_A(*),CANDM_E2S(*),CANDS_E2S(*),CAND_B(*)
73 INTEGER, INTENT(in) :: S_REMNODE_EDG
74 INTEGER MULNSNE,MULNSNS,NCONT,I_MEM(2),
75 . II_STOK, LL_STOK, ITAB(*),MBINFLG(*), EBINFLG(*), LEDGE(NLEDGE,*), ADMSR(*),
76 . MSEGTYP(*),
77 . FLAGREMNODE, KREMNOD(S_KREMNODE_EDG), REMNOD(*)
78 INTEGER, DIMENSION(S_KREMNODE_E2S), INTENT(in) :: KREMNODE_E2S !< adress of forbidden S edge
79 INTEGER, DIMENSION(S_REMNODE_E2S), INTENT(in) :: REMNODE_E2S !< list of forbidden S edge
80 my_real
81 . gap,vmaxdt,drad,
82 . bminma(6),bgapemx, marge
83 my_real , INTENT(IN) :: dgapload
84 my_real
85 . x(3,*), stfm(*), gap_m(*), gap_m_l(*), gape(*), gap_e_l(*), cand_p(*), cand_ps(*), stfn(*)
86 real*4 edg_bisector(3,4,*), vtx_bisector(3,2,*)
87C-----------------------------------------------
88C L o c a l V a r i a b l e s
89C-----------------------------------------------
90 INTEGER I, J, SOL_EDGE, SH_EDGE,
91 . N, L, E, IE, I1, I2, N1, N2
92 my_real
93 . xyzm(6), aaa, tzinf,
94 . xmin, ymin, zmin, xmax, ymax, zmax
95 INTEGER NBX,NBY,NBZ
96 INTEGER (KIND=8) :: NBX8,NBY8,NBZ8,RES8,LVOXEL8
97 INTEGER (KIND=8) :: IONE,IHUNDRED !< Integer constants in INTEGER 8 for comparisions
98C-----------------------------------------------
99C S o u r c e L i n e s
100C-----------------------------------------------
101 ione=1 !< Constant init
102 ihundred=100 !< Constant init
103C--------------------------------
104C CALCUL DES BORNES DU DOMAINE
105C--------------------------------
106 bminma(1)=-ep30
107 bminma(2)=-ep30
108 bminma(3)=-ep30
109 bminma(4)= ep30
110 bminma(5)= ep30
111 bminma(6)= ep30
112
113 xmin= ep30
114 xmax=-ep30
115 ymin= ep30
116 ymax=-ep30
117 zmin= ep30
118 zmax=-ep30
119C
120 DO i=eshift+1,eshift+nedge_t
121 l=ledge(1,i)
122 e=ledge(2,i)
123 IF(stfm(l) /= zero)THEN
124 j=irect(e,l)
125 xmin= min(xmin,x(1,j))
126 ymin= min(ymin,x(2,j))
127 zmin= min(zmin,x(3,j))
128 xmax= max(xmax,x(1,j))
129 ymax= max(ymax,x(2,j))
130 zmax= max(zmax,x(3,j))
131 j=irect(mod(e,4)+1,l)
132 xmin= min(xmin,x(1,j))
133 ymin= min(ymin,x(2,j))
134 zmin= min(zmin,x(3,j))
135 xmax= max(xmax,x(1,j))
136 ymax= max(ymax,x(2,j))
137 zmax= max(zmax,x(3,j))
138 END IF
139 END DO
140
141 tzinf = marge+two*bgapemx+vmaxdt+dgapload
142
143 xmin=xmin-tzinf
144 ymin=ymin-tzinf
145 zmin=zmin-tzinf
146 xmax=xmax+tzinf
147 ymax=ymax+tzinf
148 zmax=zmax+tzinf
149
150 bminma(1) = max(bminma(1),xmax)
151 bminma(2) = max(bminma(2),ymax)
152 bminma(3) = max(bminma(3),zmax)
153 bminma(4) = min(bminma(4),xmin)
154 bminma(5) = min(bminma(5),ymin)
155 bminma(6) = min(bminma(6),zmin)
156
157 xyzm(1) = bminma(4)
158 xyzm(2) = bminma(5)
159 xyzm(3) = bminma(6)
160 xyzm(4) = bminma(1)
161 xyzm(5) = bminma(2)
162 xyzm(6) = bminma(3)
163 i_mem(1:2) = 0
164C
165C=============================================================================
166c
167c Si MARGE - DELTA_PMAX_GAP - SOMME(Vrel*dt) < ZERO => RETRI
168c DELTA_PMAX_GAP = MAX((PENEmax(i)-GAP)-(PENEmax_Tri(i)-GAP)
169c
170C=============================================================================
171
172
173 aaa = sqrt(nmn /
174 . ((bminma(1)-bminma(4))*(bminma(2)-bminma(5))
175 . +(bminma(2)-bminma(5))*(bminma(3)-bminma(6))
176 . +(bminma(3)-bminma(6))*(bminma(1)-bminma(4))))
177
178 aaa = 0.75*aaa
179
180 nbx = nint(aaa*(bminma(1)-bminma(4)))
181 nby = nint(aaa*(bminma(2)-bminma(5)))
182 nbz = nint(aaa*(bminma(3)-bminma(6)))
183 nbx = max(nbx,1)
184 nby = max(nby,1)
185 nbz = max(nbz,1)
186
187 nbx8=nbx
188 nby8=nby
189 nbz8=nbz
190 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
191 lvoxel8 = lvoxel
192
193 IF(res8 > lvoxel8) THEN
194 aaa = lvoxel
195 aaa = aaa/((nbx8+2)*(nby8+2)*(nbz8+2))
196 aaa = aaa**(third)
197 nbx = int((nbx+2)*aaa)-2
198 nby = int((nby+2)*aaa)-2
199 nbz = int((nbz+2)*aaa)-2
200 nbx = max(nbx,1)
201 nby = max(nby,1)
202 nbz = max(nbz,1)
203 ENDIF
204
205 nbx8=nbx
206 nby8=nby
207 nbz8=nbz
208 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
209
210 IF(res8 > lvoxel8) THEN
211 nbx = min(ihundred,max(nbx8,ione))
212 nby = min(ihundred,max(nby8,ione))
213 nbz = min(ihundred,max(nbz8,ione))
214 END IF
215
216C initialisation complete de VOXEL
217 DO i=inivoxel,(nbx+2)*(nby+2)*(nbz+2)
218 voxel1(i)=0
219 ENDDO
220 inivoxel = max(inivoxel,(nbx+2)*(nby+2)*(nbz+2)+1)
221C
222 CALL i25trivox_edg(
223 1 i_mem ,vmaxdt ,inacti ,
224 2 irect ,x ,stfm ,xyzm ,
225 3 ii_stok ,cands_e2e ,eshift ,nedge_t ,candm_e2e ,
226 4 mulnsne ,noint ,bgapemx ,sshift ,nrtm_t ,
227 5 voxel1 ,nbx ,nby ,nbz ,
228 6 igap ,gap_m ,gap_m_l ,drad ,marge ,
229 7 itask ,itab ,ll_stok ,mulnsns ,
230 8 mbinflg ,ebinflg ,ilev ,cand_a ,cand_p ,
231 9 flagremnode,kremnod,remnod , s_remnode_edg,
232 a iedge ,nedge ,ledge ,msegtyp ,igap0 ,
233 b admsr,edg_bisector,vtx_bisector,
234 c candm_e2s,cands_e2s,cand_b,cand_ps ,gape ,
235 d gap_e_l ,dgapload,flag_removed_node,
236 e s_kremnode_e2s,s_remnode_e2s,kremnode_e2s,remnode_e2s,
237 f s_kremnode_edg)
238C
239C I_MEM /= 0 ==> PAS ASSEZ DE MEMOIRE CANDIDATS
240C
241 RETURN
242 END
my_real
#define my_real
Definition cppsort.cpp:32
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:272
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1249
tri7box::voxel1
integer, dimension(lvoxel) voxel1
Definition tri7box.F:53
tri7box::inivoxel
integer inivoxel
Definition tri7box.F:53
tri7box::lvoxel
integer lvoxel
Definition tri7box.F:51
i25buce_edg
subroutine i25buce_edg(x, irect, inacti, nsn, nmn, candm_e2e, cands_e2e, gap, noint, ii_stok, mulnsne, bminma, marge, vmaxdt, drad, eshift, nedge_t, sshift, nrtm_t, stfm, stfn, ncont, gap_m, itask, bgapemx, i_mem, itab, mbinflg, ebinflg, ll_stok, mulnsns, ilev, cand_a, cand_p, igap0, flagremnode, kremnod, remnod, s_remnode_edg, igap, gap_m_l, iedge, nedge, msegtyp, ledge, admsr, edg_bisector, vtx_bisector, candm_e2s, cands_e2s, cand_b, cand_ps, gape, gap_e_l, dgapload, flag_removed_node, s_kremnode_e2s, s_remnode_e2s, kremnode_e2s, remnode_e2s, s_kremnode_edg)
Definition i25buce_edg.F:49
i25trivox_edg
subroutine i25trivox_edg(i_mem, vmaxdt, inacti, irect, x, stf, xyzm, ii_stok, cands_e2e, eshift, nedge_t, candm_e2e, mulnsne, noint, bgapemx, sshift, nrtm_t, voxel, nbx, nby, nbz, igap, gap_m, gap_m_l, drad, marge, itask, itab, ll_stok, mulnsns, mbinflg, ebinflg, ilev, cand_a, cand_p, flagremnode, kremnode, remnode, s_remnode_edg, iedge, nedge, ledge, msegtyp, igap0, admsr, edg_bisector, vtx_bisector, candm_e2s, cands_e2s, cand_b, cand_ps, gape, gap_e_l, dgapload, flag_removed_node, s_kremnode_e2s, s_remnode_e2s, kremnode_e2s, remnode_e2s, s_kremnode_edg)
Definition i25trivox_edg.F:53