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 ../engine/source/interfaces/intsort/i25buce_edg.F
25!||--- called by ------------------------------------------------------
26!|| i25main_tri ../engine/source/interfaces/intsort/i25main_tri.F
27!||--- calls -----------------------------------------------------
28!|| i25trivox_edg ../engine/source/interfaces/intsort/i25trivox_edg.f
29!||--- uses -----------------------------------------------------
30!|| message_mod ../engine/share/message_module/message_mod.F
31!|| tri7box ../engine/share/modules/tri7box.F
32!||====================================================================
33 SUBROUTINE i25buce_edg(
34 1 X ,V ,IRECT ,INACTI ,
35 2 NSN ,NMN ,CANDM_E2E ,CANDS_E2E ,
36 3 GAP ,NOINT ,II_STOK ,MULNSNE ,BMINMA ,
37 4 MARGE ,VMAXDT ,DRAD ,
38 5 ESHIFT ,NEDGE_T ,SSHIFT ,NRTM_T ,STF ,
39 6 STFE ,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,KREMNODE_EDG,REMNODE_EDG,KREMNODE_E2S ,
43 . REMNODE_E2S,
44 A IGAP ,GAP_M_L ,IEDGE ,NEDGE ,MSEGTYP,
45 B LEDGE ,ADMSR,EDG_BISECTOR,VTX_BISECTOR,
46 C CANDM_E2S,CANDS_E2S ,CAND_B ,CAND_PS ,GAPE ,
47 D GAP_E_L, NEDGE_LOCAL ,IFQ ,CANDE2E_FX ,CANDE2E_FY,
48 E CANDE2E_FZ,CANDE2S_FX ,CANDE2S_FY,CANDE2S_FZ,
49 F IFPEN_E ,IFPEN_E2S ,KREMNODE_EDG_SIZ,REMNODE_EDG_SIZ,
50 G KREMNODE_E2S_SIZ,REMNODE_E2S_SIZ,DGAPLOAD)
51C============================================================================
52C M o d u l e s
53C-----------------------------------------------
54 USE tri7box
55 USE message_mod
56C-----------------------------------------------
57C I m p l i c i t T y p e s
58C-----------------------------------------------
59#include "implicit_f.inc"
60#include "comlock.inc"
61C-----------------------------------------------
62C C o m m o n B l o c k s
63C-----------------------------------------------
64#include "param_c.inc"
65C-----------------------------------------------
66C D u m m y A r g u m e n t s
67C-----------------------------------------------
68 INTEGER NSN, NMN,NOINT,IDT,INACTI,IGAP0,IFQ
69 INTEGER IRECT(4,*),ITASK,ILEV, IGAP, IEDGE, NEDGE, ESHIFT,NEDGE_T,SSHIFT,NRTM_T
70 INTEGER CANDM_E2E(*),CANDS_E2E(*),CAND_A(*),CANDM_E2S(*),CANDS_E2S(*),CAND_B(*),
71 . ifpen_e(*), ifpen_e2s(*)
72 INTEGER MULNSNE,MULNSNS,NCONT,I_MEM(2),
73 . II_STOK, LL_STOK, ITAB(*),MBINFLG(*), LEDGE(NLEDGE,*), ADMSR(*), MSEGTYP(*)
74 INTEGER EBINFLG(*)
75 INTEGER :: NEDGE_LOCAL
76 INTEGER , INTENT(IN) :: KREMNODE_EDG_SIZ,REMNODE_EDG_SIZ,KREMNODE_E2S_SIZ,REMNODE_E2S_SIZ
77 INTEGER , INTENT(IN) ::
78 . FLAGREMNODE, KREMNODE_EDG(KREMNODE_EDG_SIZ), REMNODE_EDG(REMNODE_EDG_SIZ),
79 . KREMNODE_E2S(KREMNODE_E2S_SIZ), REMNODE_E2S(REMNODE_E2S_SIZ)
80C REAL
81 my_real
82 . GAP,PMAX_GAP,VMAXDT,
83 . BMINMA(6),BGAPEMX, MARGE
84 my_real , INTENT(IN) :: DGAPLOAD ,DRAD
85 my_real
86 . x(3,*), v(3,*), stf(*), stfe(*), gap_m(*), gap_m_l(*), gape(*), gap_e_l(*),
87 . cand_p(*), cand_ps(*), cande2e_fx(*), cande2e_fy(*), cande2e_fz(*),
88 . cande2s_fx(4,*) ,cande2s_fy(4,*),cande2s_fz(4,*)
89 real*4 edg_bisector(3,4,*), vtx_bisector(3,2,*)
90C-----------------------------------------------
91C L o c a l V a r i a b l e s
92C-----------------------------------------------
93 INTEGER I, J, IP0, IP1, MAXSIZ, NSNF, NSNL,
94 . loc_proc, n, iedg, i1, i2
95C REAL
96 my_real
97 . xyzm(6), aaa, lx, ly, lz, my_lx, my_ly, my_lz,drad2
98 INTEGER NBX,NBY,NBZ
99 INTEGER (KIND=8) :: NBX8,NBY8,NBZ8,RES8,LVOXEL8
100 SAVE LX, LY, LZ
101C-----------------------------------------------
102C S o u r c e L i n e s
103C-----------------------------------------------
104 drad2 = zero
105C-----------------------------------------------
106C
107C----- TRI DES ELEMENTS ET DES NOEUDS
108C
109C-----------------------------------------------
110C
111C----- BORNES DU DOMAINE DEJA CALCULEES
112C
113 xyzm(1) = bminma(4)
114 xyzm(2) = bminma(5)
115 xyzm(3) = bminma(6)
116 xyzm(4) = bminma(1)
117 xyzm(5) = bminma(2)
118 xyzm(6) = bminma(3)
119 i_mem(1:2) = 0
120C
121C=============================================================================
122c
123c Si MARGE - DELTA_PMAX_GAP - SOMME(Vrel*dt) < ZERO => RETRI
124c DELTA_PMAX_GAP = MAX((PENEmax(i)-GAP)-(PENEmax_Tri(i)-GAP)
125c
126C=============================================================================
127
128
129c AAA = SQRT(NMN /
130c . ((BMINMA(1)-BMINMA(4))*(BMINMA(2)-BMINMA(5))
131c . +(BMINMA(2)-BMINMA(5))*(BMINMA(3)-BMINMA(6))
132c . +(BMINMA(3)-BMINMA(6))*(BMINMA(1)-BMINMA(4))))
133
134c AAA = 0.75*AAA
135
136 aaa = (nmn /
137 . ((bminma(1)-bminma(4))*(bminma(2)-bminma(5))*(bminma(3)-bminma(6))))**third
138
139 aaa = two*aaa
140
141 nbx = nint(aaa*(bminma(1)-bminma(4)))
142 nby = nint(aaa*(bminma(2)-bminma(5)))
143 nbz = nint(aaa*(bminma(3)-bminma(6)))
144
145c LX=ZERO
146c LY=ZERO
147c LZ=ZERO
148c
149c CALL MY_BARRIER
150c
151c MY_LX=ZERO
152c MY_LY=ZERO
153c MY_LZ=ZERO
154c DO I=1,NEDGE_T ! no parith on
155c IEDG=SSHIFT+I
156c I1=LEDGE(5,IEDG)
157c I2=LEDGE(6,IEDG)
158c MY_LX=MY_LX+ABS(X(1,I2)-X(1,I1))
159c MY_LY=MY_LY+ABS(X(2,I2)-X(2,I1))
160c MY_LZ=MY_LZ+ABS(X(3,I2)-X(3,I1))
161c END DO
162c#include "lockon.inc"
163c LX=LX+MY_LX
164c LY=LY+MY_LY
165c LZ=LZ+MY_LZ
166c#include "lockoff.inc"
167c
168c CALL MY_BARRIER
169c
170c!$OMP SINGLE
171c LX=TWO*LX/NEDGE
172c LY=TWO*LY/NEDGE
173c LZ=TWO*LZ/NEDGE
174c!$OMP END SINGLE
175c
176c NBX = NINT((BMINMA(1)-BMINMA(4))/LX)
177c NBY = NINT((BMINMA(2)-BMINMA(5))/LY)
178c NBZ = NINT((BMINMA(3)-BMINMA(6))/LZ)
179
180 nbx = max(nbx,1)
181 nby = max(nby,1)
182 nbz = max(nbz,1)
183
184 nbx8=nbx
185 nby8=nby
186 nbz8=nbz
187 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
188 lvoxel8 = lvoxel
189
190 IF(res8 > lvoxel8) THEN
191 aaa = lvoxel
192 aaa = aaa/((nbx8+2)*(nby8+2)*(nbz8+2))
193 aaa = aaa**(third)
194 nbx = int((nbx+2)*aaa)-2
195 nby = int((nby+2)*aaa)-2
196 nbz = int((nbz+2)*aaa)-2
197 nbx = max(nbx,1)
198 nby = max(nby,1)
199 nbz = max(nbz,1)
200 ENDIF
201
202 nbx8=nbx
203 nby8=nby
204 nbz8=nbz
205 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
206
207 IF(res8 > lvoxel8) stop 678
208c IF(MAX(NBX,NBY,NBZ) > 100) stop 678
209
210C pas d'initialisation de VOXEL <=> remise a 0 dans i25trivox.
211C
212 CALL i25trivox_edg(
213 1 i_mem ,vmaxdt ,inacti ,irect ,
214 2 x ,v ,stf ,stfe ,xyzm ,
215 3 ii_stok ,cands_e2e ,eshift ,nedge_t ,candm_e2e ,
216 4 mulnsne ,noint ,bgapemx ,sshift ,nrtm_t ,
217 5 voxel1 ,nbx ,nby ,nbz ,
218 6 igap ,gap_m ,gap_m_l ,drad2 ,marge ,
219 7 itask ,itab ,ll_stok ,mulnsns ,
220 8 mbinflg , ebinflg ,ilev ,cand_a ,cand_p ,
221 9 flagremnode,kremnode_edg,remnode_edg,kremnode_e2s ,
222 . remnode_e2s ,
223 a iedge ,nedge ,ledge ,msegtyp ,igap0 ,
224 b admsr,edg_bisector,vtx_bisector,
225 c candm_e2s,cands_e2s,cand_b,cand_ps,gape ,
226 d gap_e_l,nedge_local,ifq,cande2e_fx ,cande2e_fy,
227 e cande2e_fz,cande2s_fx ,cande2s_fy,cande2s_fz,ifpen_e,ifpen_e2s,
228 f kremnode_edg_siz,remnode_edg_siz,kremnode_e2s_siz,remnode_e2s_siz,
229 g dgapload )
230C
231C I_MEM /= 0 ==> PAS ASSEZ DE MEMOIRE CANDIDATS
232C
233 RETURN
234 END
i25buce_edg
subroutine i25buce_edg(x, v, irect, inacti, nsn, nmn, candm_e2e, cands_e2e, gap, noint, ii_stok, mulnsne, bminma, marge, vmaxdt, drad, eshift, nedge_t, sshift, nrtm_t, stf, stfe, ncont, gap_m, itask, bgapemx, i_mem, itab, mbinflg, ebinflg, ll_stok, mulnsns, ilev, cand_a, cand_p, igap0, flagremnode, kremnode_edg, remnode_edg, kremnode_e2s, remnode_e2s, 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, nedge_local, ifq, cande2e_fx, cande2e_fy, cande2e_fz, cande2s_fx, cande2s_fy, cande2s_fz, ifpen_e, ifpen_e2s, kremnode_edg_siz, remnode_edg_siz, kremnode_e2s_siz, remnode_e2s_siz, dgapload)
Definition i25buce_edg.F:51
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::lvoxel
integer lvoxel
Definition tri7box.F:51
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