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"

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,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
75 my_real
76 . tzinf,maxbox,minbox,bminma(6),bgapsmx
77 my_real
78 . maxgap,gapmin,gap
79 my_real , INTENT(IN) :: dgapload,drad
80 my_real
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, I_ADD, MAXSIZ,
90 . ADD(2,I_ADD_MAX)
91 my_real
92 . xyzm(6,i_add_max-1), marge, aaa
93 INTEGER NBX,NBY,NBZ
94 INTEGER (KIND=8) :: NBX8,NBY8,NBZ8,RES8,LVOXEL8
95C-----------------------------------------------
96C definition from TRI7BOX module
97C-----------------------------------------------
98C
99C-----------------------------------------------
100C S o u r c e L i n e s
101C-----------------------------------------------
102C
103C----- sorting by boxes
104C
105C-----------------------------------------------
106C if we don't have enough memory for the stacks we restart the sorting
107C by incrementing nb_n_b (number of nodes per finished box)
108C
109C POINTEUR NOM TAILLE
110C P1........Elt Bas Pile NRTM
111C P2........Elt PILE 3*NRTM
112C P21.......Elt Bas Pile NRTS
113C P22.......Elt PILE 3*NRTS
114 maxsiz = 3*(max(nrtm,nrts+nrtsr)+100)
115C
116C-----initialization of addresses and x,y,z
117C
118C ADDE ADDN X Y Z
119C 1 1 XMIN YMIN ZMIN
120C 1 1 XMAX YMAX ZMAX
121C
122 add(1,1) = 0
123 add(2,1) = 0
124 add(1,2) = 0
125 add(2,2) = 0
126 i_add = 1
127 xyzm(1,i_add) = bminma(4)
128 xyzm(2,i_add) = bminma(5)
129 xyzm(3,i_add) = bminma(6)
130 xyzm(4,i_add) = bminma(1)
131 xyzm(5,i_add) = bminma(2)
132 xyzm(6,i_add) = bminma(3)
133 i_mem = 0
134C
135 IF (iform /= 2) THEN
136 isznsnr = 0
137 DO i=1,nrtm
138 addcm(i)=0
139 ENDDO
140 ELSE
141 isznsnr = nrtsr
142 ENDIF
143C
144C
145C-----start of sorting phase
146
147 marge = tzinf - max(maxgap+dgapload,drad)
148
149 IF( nmn /= 0 ) THEN
150 aaa = sqrt(nmn /
151 . ((bminma(1)-bminma(4))*(bminma(2)-bminma(5))
152 . +(bminma(2)-bminma(5))*(bminma(3)-bminma(6))
153 . +(bminma(3)-bminma(6))*(bminma(1)-bminma(4))))
154 ELSE
155 aaa = 0
156 ENDIF
157
158 aaa = 0.75*aaa
159
160 nbx = nint(aaa*(bminma(1)-bminma(4)))
161 nby = nint(aaa*(bminma(2)-bminma(5)))
162 nbz = nint(aaa*(bminma(3)-bminma(6)))
163 nbx = max(nbx,1)
164 nby = max(nby,1)
165 nbz = max(nbz,1)
166
167 nbx8=nbx
168 nby8=nby
169 nbz8=nbz
170 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
171 lvoxel8 = lvoxel
172
173 IF(res8 > lvoxel8)THEN
174 aaa = lvoxel
175 aaa = aaa/((nbx8+2)*(nby8+2)*(nbz8+2))
176 aaa = aaa**(third)
177 nbx = int((nbx+2)*aaa)-2
178 nby = int((nby+2)*aaa)-2
179 nbz = int((nbz+2)*aaa)-2
180 nbx = max(nbx,1)
181 nby = max(nby,1)
182 nbz = max(nbz,1)
183 nbx8 = nbx
184 nby8 = nby
185 nbz8 = nbz
186 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
187 END IF
188C If still too many voxels:
189C Reduction of the number of voxels
190 IF(res8 > lvoxel8) THEN
191 nbx = min(100,max(nbx8,1))
192 nby = min(100,max(nby8,1))
193 nbz = min(100,max(nbz8,1))
194 END IF
195
196 DO i=inivoxel,(nbx+2)*(nby+2)*(nbz+2)
197 voxel1(i)=0
198 ENDDO
199 inivoxel = max(inivoxel,(nbx+2)*(nby+2)*(nbz+2)+1)
200
201 !print *, "voxel search"
202
203 CALL i11trivox(
204 1 irects ,irectm ,x ,nrtm ,nrtsr ,
205 2 xyzm ,ii_stok ,cand_s ,cand_m ,ncontact,
206 3 noint ,tzinf ,i_mem ,eshift ,addcm ,
207 4 chaine ,nrts ,itab ,stifs ,stifm ,
208 5 iauto ,voxel1 ,nbx ,nby ,nbz ,
209 6 itask ,ifpen ,iform ,gapmin ,drad ,
210 7 marge ,gap_s ,gap_m ,gap_s_l, gap_m_l,
211 8 bgapsmx, igap ,gap ,flagremnode,kremnode,
212 9 remnode,dgapload )
213
214 CALL my_barrier
215
216C
217C I_MEM = 1 ==> N/A
218C I_MEM = 2 ==> PAS ASSEZ DE MEMOIRE CANDIDATES
219C I_MEM = 3 ==> N/A
220
221
222C === WRITE CANDIDATES IN fort.[900 + ISPMD] files
223c IF ( ) THEN
224c DO I = 1, II_STOK
225c IF(CAND_S(I) <= NRTS) THEN
226c WRITE(900+ISPMD,*) NOINT,ITAB(IRECTS(1,CAND_S(I))),
227c . ITAB(IRECTS(2,CAND_S(I))),ITAB(IRECTM(1,CAND_M(I))),ITAB(IRECTM(2,CAND_M(I)))
228c ELSE
229c WRITE(900+ISPMD,*) -NOINT,ITAB(IRECTS(1,CAND_S(I)))
230c . ,ITAB(IRECTS(2,CAND_S(I))),ITAB(IRECTM(1,CAND_M(I))),ITAB(IRECTM(2,CAND_M(I)))
231c ENDIF
232c ENDDO
233c CALL FLUSH(900+ISPMD)
234c STOP
235c ENDIF
236
237
238
239 IF (i_mem == 2) RETURN
240
241 IF(i_mem==1)THEN
242 nb_n_b = nb_n_b + 1
243 IF ( nb_n_b > max(nrtm,nrts)) THEN
244 CALL ancmsg(msgid=85,anmode=aninfo,
245 . i1=noint)
246 CALL arret(2)
247 ENDIF
248 ild = 1
249 ELSEIF(i_mem==2) THEN
250 IF(debug(1)>=1) THEN
251 iwarn = iwarn+1
252#include "lockon.inc"
253 WRITE(istdo,*)' **WARNING INTERFACE/MEMORY'
254 WRITE(iout,*)' **WARNING INTERFACE NB:',noint
255 WRITE(iout,*)' TOO MANY POSSIBLE IMPACTS'
256 WRITE(iout,*)' SIZE OF INFLUENCE ZONE IS'
257 WRITE(iout,*)' MULTIPLIED BY 0.75'
258#include "lockoff.inc"
259 ENDIF
260 tzinf = three_over_4*tzinf
261C do not decrease the box size
262C MINBOX= THREE_OVER_4*MINBOX
263C MAXBOX= THREE_OVER_4*MAXBOX
264 IF( tzinf<=max(maxgap+dgapload,drad) ) THEN
265 CALL ancmsg(msgid=98,anmode=aninfo,
266 . i1=noint,c1='(I11BUCE)')
267 CALL arret(2)
268 ENDIF
269 ild = 1
270 ELSEIF(i_mem==3)THEN
271 nb_n_b = nb_n_b + 1
272 IF ( nb_n_b > max(nrtm,nrts)) THEN
273 CALL ancmsg(msgid=99,anmode=aninfo,
274 . i1=noint,c1='(I11BUCE)')
275 CALL arret(2)
276 ENDIF
277 ild = 1
278 ENDIF
279C
280 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
i11trivox
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
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1257
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
ancmsg
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:895
arret
subroutine arret(nn)
Definition arret.F:86
my_barrier
subroutine my_barrier
Definition machine.F:31