OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25buce_edg.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ i25buce_edg()

subroutine i25buce_edg ( x,
v,
integer, dimension(4,*) irect,
integer inacti,
integer nsn,
integer nmn,
integer, dimension(*) candm_e2e,
integer, dimension(*) cands_e2e,
gap,
integer noint,
integer ii_stok,
integer mulnsne,
bminma,
marge,
vmaxdt,
intent(in) drad,
integer eshift,
integer nedge_t,
integer sshift,
integer nrtm_t,
stf,
stfe,
integer ncont,
gap_m,
integer itask,
bgapemx,
integer, dimension(2) i_mem,
integer, dimension(*) itab,
integer, dimension(*) mbinflg,
integer, dimension(*) ebinflg,
integer ll_stok,
integer mulnsns,
integer ilev,
integer, dimension(*) cand_a,
cand_p,
integer igap0,
integer, intent(in) flagremnode,
integer, dimension(kremnode_edg_siz), intent(in) kremnode_edg,
integer, dimension(remnode_edg_siz), intent(in) remnode_edg,
integer, dimension(kremnode_e2s_siz), intent(in) kremnode_e2s,
integer, dimension(remnode_e2s_siz), intent(in) remnode_e2s,
integer igap,
gap_m_l,
integer iedge,
integer nedge,
integer, dimension(*) msegtyp,
integer, dimension(nledge,*) ledge,
integer, dimension(*) admsr,
real*4, dimension(3,4,*) edg_bisector,
real*4, dimension(3,2,*) vtx_bisector,
integer, dimension(*) candm_e2s,
integer, dimension(*) cands_e2s,
integer, dimension(*) cand_b,
cand_ps,
gape,
gap_e_l,
integer nedge_local,
integer ifq,
cande2e_fx,
cande2e_fy,
cande2e_fz,
cande2s_fx,
cande2s_fy,
cande2s_fz,
integer, dimension(*) ifpen_e,
integer, dimension(*) ifpen_e2s,
integer, intent(in) kremnode_edg_siz,
integer, intent(in) remnode_edg_siz,
integer, intent(in) kremnode_e2s_siz,
integer, intent(in) remnode_e2s_siz,
intent(in) dgapload )

Definition at line 33 of file i25buce_edg.F.

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
82 . gap,pmax_gap,vmaxdt,
83 . bminma(6),bgapemx, marge
84 my_real , INTENT(IN) :: dgapload ,drad
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
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
#define my_real
Definition cppsort.cpp:32
#define max(a, b)
Definition macros.h:21
integer, dimension(lvoxel) voxel1
Definition tri7box.F:53
integer lvoxel
Definition tri7box.F:51
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)