OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i11buce.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "units_c.inc"
#include "warn_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i11buce_vox (x, irects, irectm, nrts, nmn, nrtm, nsn, cand_m, cand_s, maxgap, noint, ii_stok, tzinf, maxbox, minbox, nb_n_b, eshift, ild, bminma, ncontact, addcm, chaine, nin, itab, nrtsr, ncont, gap_s, stifs, penis, igap, stifm, iauto, i_mem, itask, iform, ifpen, drad, gap_m, gap_s_l, gap_m_l, gapmin, bgapsmx, gap, flagremnode, kremnode, remnode, dgapload)

Function/Subroutine Documentation

◆ i11buce_vox()

subroutine i11buce_vox ( x,
integer, dimension(2,*) irects,
integer, dimension(2,*) irectm,
integer nrts,
integer nmn,
integer nrtm,
integer nsn,
integer, dimension(*) cand_m,
integer, dimension(*) cand_s,
maxgap,
integer noint,
integer ii_stok,
tzinf,
maxbox,
minbox,
integer nb_n_b,
integer eshift,
integer ild,
bminma,
integer ncontact,
integer, dimension(*) addcm,
integer, dimension(2,*) chaine,
integer nin,
integer, dimension(*) itab,
integer nrtsr,
integer ncont,
gap_s,
stifs,
penis,
integer igap,
stifm,
integer iauto,
integer i_mem,
integer itask,
integer iform,
integer, dimension(*) ifpen,
intent(in) drad,
gap_m,
gap_s_l,
gap_m_l,
gapmin,
bgapsmx,
gap,
integer flagremnode,
integer, dimension(*) kremnode,
integer, dimension(*) remnode,
intent(in) dgapload )

Definition at line 37 of file i11buce.F.

48C-----------------------------------------------
49C M o d u l e s
50C-----------------------------------------------
51 USE message_mod
52 USE tri7box
53 USE tri11
54
55C============================================================================
56C I m p l i c i t T y p e s
57C-----------------------------------------------
58#include "implicit_f.inc"
59#include "comlock.inc"
60C-----------------------------------------------
61C C o m m o n B l o c k s
62C-----------------------------------------------
63#include "units_c.inc"
64#include "warn_c.inc"
65C-----------------------------------------------
66C D u m m y A r g u m e n t s
67C-----------------------------------------------
68 INTEGER NMN, NRTM, NSN, NOINT,IDT,NRTS, NIN, NRTSR,
69 . IGAP,IAUTO, I_MEM, ITASK
70 INTEGER IRECTS(2,*),IRECTM(2,*),ADDCM(*),CHAINE(2,*)
71 INTEGER CAND_M(*),CAND_S(*),IFPEN(*),FLAGREMNODE,KREMNODE(*),REMNODE(*)
72 INTEGER ESHIFT,ILD,NB_N_B, NCONTACT, NCONT, ITAB(*),
73 . IFORM,II_STOK
74C REAL
76 . tzinf,maxbox,minbox,bminma(6),bgapsmx
78 . maxgap,gapmin,gap
79 my_real , INTENT(IN) :: dgapload,drad
81 . x(3,*),stifs(*),penis(2,*),stifm(*),
82 . gap_s(*),gap_m(*),gap_s_l(*),gap_m_l(*)
83C-----------------------------------------------
84C L o c a l V a r i a b l e s
85C-----------------------------------------------
86 INTEGER I_ADD_MAX,ISZNSNR
87 parameter(i_add_max = 1001)
88C
89 INTEGER I, J, N1, N2, I_ADD, MAXSIZ,JJ,
90 . ADD(2,I_ADD_MAX), N
92 . xyzm(6,i_add_max-1), marge, aaa
93 my_real
94 . dd,dd1,marge_st,dx1,dy1,dz1
95 INTEGER :: L
96 INTEGER NB_OLD(2,I_ADD_MAX+1)
97 INTEGER NBX,NBY,NBZ
98 INTEGER (KIND=8) :: NBX8,NBY8,NBZ8,RES8,LVOXEL8
99C-----------------------------------------------
100C definition from TRI7BOX module
101C-----------------------------------------------
102C
103C-----------------------------------------------
104C S o u r c e L i n e s
105C-----------------------------------------------
106C
107C----- TRI PAR BOITES
108C
109C-----------------------------------------------
110C SI ON A PAS ASSEZ DE MEMOIRE POUR LES PILES ON RECOMMENCE LE TRI
111C EN INCREMENTANT LE NB_N_B (NOMBRE DE NOEUDS PAR BOITE FINIE)
112C
113C POINTEUR NOM TAILLE
114C P1........Elt Bas Pile NRTM
115C P2........Elt PILE 3*NRTM
116C P21.......Elt Bas Pile NRTS
117C P22.......Elt PILE 3*NRTS
118 maxsiz = 3*(max(nrtm,nrts+nrtsr)+100)
119C
120C-----INITIALISATION DES ADRESSES ET X,Y,Z
121C
122C ADDE ADDN X Y Z
123C 1 1 XMIN YMIN ZMIN
124C 1 1 XMAX YMAX ZMAX
125C
126 add(1,1) = 0
127 add(2,1) = 0
128 add(1,2) = 0
129 add(2,2) = 0
130 i_add = 1
131 xyzm(1,i_add) = bminma(4)
132 xyzm(2,i_add) = bminma(5)
133 xyzm(3,i_add) = bminma(6)
134 xyzm(4,i_add) = bminma(1)
135 xyzm(5,i_add) = bminma(2)
136 xyzm(6,i_add) = bminma(3)
137 i_mem = 0
138C
139 IF (iform /= 2) THEN
140 isznsnr = 0
141 DO i=1,nrtm
142 addcm(i)=0
143 ENDDO
144 ELSE
145 isznsnr = nrtsr
146 ENDIF
147C
148C
149C-----DEBUT DE LA PHASE DE TRI
150
151 marge = tzinf - max(maxgap+dgapload,drad)
152
153 IF( nmn /= 0 ) THEN
154 aaa = sqrt(nmn /
155 . ((bminma(1)-bminma(4))*(bminma(2)-bminma(5))
156 . +(bminma(2)-bminma(5))*(bminma(3)-bminma(6))
157 . +(bminma(3)-bminma(6))*(bminma(1)-bminma(4))))
158 ELSE
159 aaa = 0
160 ENDIF
161
162 aaa = 0.75*aaa
163
164 nbx = nint(aaa*(bminma(1)-bminma(4)))
165 nby = nint(aaa*(bminma(2)-bminma(5)))
166 nbz = nint(aaa*(bminma(3)-bminma(6)))
167 nbx = max(nbx,1)
168 nby = max(nby,1)
169 nbz = max(nbz,1)
170
171 nbx8=nbx
172 nby8=nby
173 nbz8=nbz
174 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
175 lvoxel8 = lvoxel
176
177 IF(res8 > lvoxel8)THEN
178 aaa = lvoxel
179 aaa = aaa/((nbx8+2)*(nby8+2)*(nbz8+2))
180 aaa = aaa**(third)
181 nbx = int((nbx+2)*aaa)-2
182 nby = int((nby+2)*aaa)-2
183 nbz = int((nbz+2)*aaa)-2
184 nbx = max(nbx,1)
185 nby = max(nby,1)
186 nbz = max(nbz,1)
187 nbx8 = nbx
188 nby8 = nby
189 nbz8 = nbz
190 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
191 END IF
192C If still too many voxels:
193C Reduction of the number of voxels
194 IF(res8 > lvoxel8) THEN
195 nbx = min(100,max(nbx8,1))
196 nby = min(100,max(nby8,1))
197 nbz = min(100,max(nbz8,1))
198 END IF
199
200 DO i=inivoxel,(nbx+2)*(nby+2)*(nbz+2)
201 voxel1(i)=0
202 ENDDO
203 inivoxel = max(inivoxel,(nbx+2)*(nby+2)*(nbz+2)+1)
204
205 !print *, "voxel search"
206
207 CALL i11trivox(
208 1 irects ,irectm ,x ,nrtm ,nrtsr ,
209 2 xyzm ,ii_stok ,cand_s ,cand_m ,ncontact,
210 3 noint ,tzinf ,i_mem ,eshift ,addcm ,
211 4 chaine ,nrts ,itab ,stifs ,stifm ,
212 5 iauto ,voxel1 ,nbx ,nby ,nbz ,
213 6 itask ,ifpen ,iform ,gapmin ,drad ,
214 7 marge ,gap_s ,gap_m ,gap_s_l, gap_m_l,
215 8 bgapsmx, igap ,gap ,flagremnode,kremnode,
216 9 remnode,dgapload )
217
218 CALL my_barrier
219
220 100 CONTINUE
221
222C
223C I_MEM = 1 ==> N/A
224C I_MEM = 2 ==> PAS ASSEZ DE MEMOIRE CANDIDATS
225C I_MEM = 3 ==> N/A
226
227
228C === WRITE CANDIDATES IN fort.[900 + ISPMD] files
229c IF ( ) THEN
230c DO I = 1, II_STOK
231c IF(CAND_S(I) <= NRTS) THEN
232c WRITE(900+ISPMD,*) NOINT,ITAB(IRECTS(1,CAND_S(I))),
233c . ITAB(IRECTS(2,CAND_S(I))),ITAB(IRECTM(1,CAND_M(I))),ITAB(IRECTM(2,CAND_M(I)))
234c ELSE
235c WRITE(900+ISPMD,*) -NOINT,ITAB(IRECTS(1,CAND_S(I)))
236c . ,ITAB(IRECTS(2,CAND_S(I))),ITAB(IRECTM(1,CAND_M(I))),ITAB(IRECTM(2,CAND_M(I)))
237c ENDIF
238c ENDDO
239c CALL FLUSH(900+ISPMD)
240c STOP
241c ENDIF
242
243
244
245 IF (i_mem == 2) RETURN
246
247 IF(i_mem==1)THEN
248 nb_n_b = nb_n_b + 1
249 IF ( nb_n_b > max(nrtm,nrts)) THEN
250 CALL ancmsg(msgid=85,anmode=aninfo,
251 . i1=noint)
252 CALL arret(2)
253 ENDIF
254 ild = 1
255 ELSEIF(i_mem==2) THEN
256 IF(debug(1)>=1) THEN
257 iwarn = iwarn+1
258#include "lockon.inc"
259 WRITE(istdo,*)' **WARNING INTERFACE/MEMORY'
260 WRITE(iout,*)' **WARNING INTERFACE NB:',noint
261 WRITE(iout,*)' TOO MANY POSSIBLE IMPACTS'
262 WRITE(iout,*)' SIZE OF INFLUENCE ZONE IS'
263 WRITE(iout,*)' MULTIPLIED BY 0.75'
264#include "lockoff.inc"
265 ENDIF
266 tzinf = three_over_4*tzinf
267C ne pas dimunuer la taille des boite
268C MINBOX= THREE_OVER_4*MINBOX
269C MAXBOX= THREE_OVER_4*MAXBOX
270 IF( tzinf<=max(maxgap+dgapload,drad) ) THEN
271 CALL ancmsg(msgid=98,anmode=aninfo,
272 . i1=noint,c1='(I11BUCE)')
273 CALL arret(2)
274 ENDIF
275 ild = 1
276 ELSEIF(i_mem==3)THEN
277 nb_n_b = nb_n_b + 1
278 IF ( nb_n_b > max(nrtm,nrts)) THEN
279 CALL ancmsg(msgid=99,anmode=aninfo,
280 . i1=noint,c1='(I11BUCE)')
281 CALL arret(2)
282 ENDIF
283 ild = 1
284 ENDIF
285C
286 RETURN
#define my_real
Definition cppsort.cpp:32
subroutine i11trivox(irects, irectm, x, nrtm, nrtsr, xyzm, ii_stok, cand_s, cand_m, nsn4, noint, tzinf, i_mem, eshift, addcm, chaine, nrts, itab, stfs, stfm, iauto, voxel, nbx, nby, nbz, itask, ifpen, iform, gapmin, drad, marge, gap_s, gap_m, gap_s_l, gap_m_l, bgapsmx, igap, gap, flagremnode, kremnode, remnode, dgapload)
Definition i11trivox.F:46
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21
integer, dimension(lvoxel) voxel1
Definition tri7box.F:53
integer inivoxel
Definition tri7box.F:53
integer lvoxel
Definition tri7box.F:51
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
subroutine arret(nn)
Definition arret.F:87
subroutine my_barrier
Definition machine.F:31