56
57
58
59
60
61
62
63
70 use element_mod , only : nixs
71
72
73
74#include "implicit_f.inc"
75#include "comlock.inc"
76
77
78
79#include "units_c.inc"
80#include "warn_c.inc"
81#include "com01_c.inc"
82#include "param_c.inc"
83
84
85
86 INTEGER IPARI(NPARI), ISKIP
87 INTEGER NMN, NSN, NOINT,IDT,INACTI,IFQ, NIN, NSNR,NSNROLD
88 INTEGER N_CAND_B
89 INTEGER IRECT(4,*),NSV(*),MWAG(*), RENUM(*),NUM_IMP, ITASK
90 INTEGER CAND_E(*),CAND_B(*),IFPEN(*), IXS(NIXS,*), BUFBRIC(NBRIC)
91 INTEGER NCONTACT,ESHIFT,ILD,NB_N_B,IGAP,NCONT,INTTH,I_MEM,NBRIC
92 INTEGER ITAB(*),NSHEL_T,NSHEL_L, NSHELR_L, II_STOK
94 . gap,tzinf,maxbox,minbox,curv_max_max,
95 . gapmin, gapmax, bminma(6),curv_max(nshel_t),bgapsmx
97 . x(3,*), stfn(*),
98 . stf(*)
99 INTEGER :: CANDB, CANDE, NB_SHORT, IPOS_, IREF,ILEN,IVAL
100 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECTIVITY
101
102
103
104 TYPE(BRICK_ENTITY), DIMENSION(:),ALLOCATABLE :: BRICK_GRID
105 TYPE(EDGE_ENTITY), DIMENSION(:),ALLOCATABLE :: EDGE_GRID
106
107 INTEGER I_ADD_MAX,ICUR
108 parameter(i_add_max = 1001)
109
110 INTEGER I, J, I_ADD, IP0, IP1, MAXSIZ,
111 . ADD(2,I_ADD_MAX), LOC_PROC, N, ISZNSNR,
112 . NSNFIOLD(NSPMD)
113
115
116 CHARACTER*8 KEY
117
118 INTEGER :: NCAND, NBF, NBL, SOMB, SOME, IPA
119 INTEGER :: TMP1, TMP2, IPOS
120 INTEGER, ALLOCATABLE, DIMENSION(:) :: IFIRST, ILAST
121 CHARACTER*12 ::filename
122
123 INTEGER, ALLOCATABLE, DIMENSION(:) :: order, VALUE
124
125 INTEGER R2,MIN2
126
127
128
129
130 INTEGER NBX,NBY,NBZ
131 INTEGER (KIND=8) :: NBX8,NBY8,NBZ8,RES8,LVOXEL8
132
133
134
135 ip0 = 1
136 isznsnr = 0
137 i_mem = 0
138 marge = 1.1 * tzinf-gap
139
140 aaa = sqrt(nmn /
141 . ((bminma(1)-bminma(4))*(bminma(2)-bminma(5))
142 . +(bminma(2)-bminma(5))*(bminma(3)-bminma(6))
143 . +(bminma(3)-bminma(6))*(bminma(1)-bminma(4))))
144
145 aaa = 0.75*aaa
146
147 nbx = nint(aaa*(bminma(1)-bminma(4)))
148 nby = nint(aaa*(bminma(2)-bminma(5)))
149 nbz = nint(aaa*(bminma(3)-bminma(6)))
153
154 nbx8=nbx
155 nby8=nby
156 nbz8=nbz
157 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
159
160 IF(res8 > lvoxel8) THEN
161 if(itask==0.and.
ibug22_tri==1)print *,
"redim Voxel"
163 aaa = aaa/((nbx8+2)*(nby8+2)*(nbz8+2))
164 aaa = aaa**(third)
165 nbx = int((nbx+2)*aaa)-2
166 nby = int((nby+2)*aaa)-2
167 nbz = int((nbz+2)*aaa)-2
171 ENDIF
172
173 nbx8=nbx
174 nby8=nby
175 nbz8=nbz
176 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
177
178 IF(res8 > lvoxel8) THEN
179 nbx =
min(100,
max(nbx8,1))
180 nby =
min(100,
max(nby8,1))
181 nbz =
min(100,
max(nbz8,1))
182 print *, "stop 678"
183
184 end if
185
186
187
188 DO i=
inivoxel,(nbx+2)*(nby+2)*(nbz+2)
190 ENDDO
191
193
194 if(itask==0.and.
ibug22_tri==1)print *,
"call i22trivox"
195
197 1 nsn ,renum ,nshelr_l ,isznsnr ,i_mem ,
198 2 irect ,x ,stf ,stfn ,bminma ,
199 3 nsv ,ii_stok ,cand_b ,eshift ,cand_e ,
200 4 ncontact,noint ,tzinf ,
202 6 bid ,
203 7 nshel_t ,
204 8 marge ,
205 9 nin ,itask ,ixs ,bufbric ,
206 a nbric ,itab ,nshel_l )
207
208
209
210
211 IF(i_mem==1)THEN
212 nb_n_b = nb_n_b + 1
213 IF ( nb_n_b > ncont) THEN
214 CALL ancmsg(msgid=85,anmode=aninfo,
215 . i1=noint)
217 ENDIF
218 ild = 1
219 iskip=1
220 ELSEIF(i_mem==2) THEN
221 IF(debug(1)>=1) THEN
222 iwarn = iwarn+1
223#include "lockon.inc"
224 WRITE(istdo,*)' **WARNING INTERFACE/MEMORY'
225 WRITE(iout,*)' **WARNING INTERFACE NB:',noint
226 WRITE(iout,*)' TOO MANY POSSIBLE IMPACTS'
227 WRITE(iout,*)' SIZE OF INFLUENCE ZONE IS'
228 WRITE(iout,*)' EXAPNDED'
229#include "lockoff.inc"
230 ENDIF
231
232 ild = 1
233 iskip=1
234 ELSEIF(i_mem==3)THEN
235 nb_n_b = nb_n_b + 1
236 IF ( nb_n_b > ncont) THEN
237 CALL ancmsg(msgid=100,anmode=aninfo,
238 . i1=noint)
240 ENDIF
241 ild = 1
242 iskip=1
243 ENDIF
244
245
246
248 print *, " |------------i22buce.F----------|"
249 print *, " | LISTE DES CANDIDATS |"
250 print *, " |-------------------------------|"
251 allocate(order(ii_stok) ,value(ii_stok))
252 min2 = minval(abs(cand_e(1:ii_stok)))
253 r2 = maxval(abs(cand_e(1:ii_stok)))-min2
254 DO i=1,ii_stok
255 value(i) = cand_b(i)*(r2+1)+abs(cand_e(i))-min2
256 ENDDO
257 order=0
258
259 DO i=1,ii_stok
260 if(cand_e(order(i))>0)then
261 print *,i,ixs(11,bufbric(cand_b(order(i)))),
262 . "avec+",nint(irect_l(1:4,iabs(cand_e(order(i)))))
263 else
264 print *,i,ixs(11,bufbric(cand_b(order(i)))),
265 . "avec-",nint(irect_l(1:4,iabs(cand_e(order(i)))))
266 endif
267 END DO
268 deallocate(order,value)
269 end if
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
289
290 IF(iskip==1)THEN
292 RETURN
293 ENDIF
294
295
296
297
298
299
300
301
302 IF(itask==0)THEN
303 ALLOCATE(
itagb(1:nbric))
304 ALLOCATE(ifirst(1:nbric))
305 ALLOCATE(ilast(1:nbric))
307 ifirst(:) = 0
308 ilast(:) = 0
309
310 DO i=1,ii_stok
311
312 IF(
itagb(cand_b(i)) == 0)
THEN
313 ifirst(cand_b(i)) = i
314 ilast(cand_b(i)) = i
316
317 ELSE
318 ilast(cand_b(i)) = i
319 ENDIF
320 enddo
325 ipos = 0
326 DO i=1,nbric
327 IF(
itagb(i) == 0)cycle
328 ipos = ipos + 1
330 iadf(ipos) = ifirst(i)
331 iadl(ipos) = ilast(i)
332 ENDDO
333 endif
334
335
336
337
338
339
340
341
342 IF(itask==0)THEN
345
346 DO i=1,ii_stok
347 itage(iabs(cand_e(i))) = 1
348 ENDDO
351 ipos = 0
353 IF(
itage(i) == 0)cycle
354 ipos = ipos + 1
357 ENDDO
358 endif
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387 IF(itask==0)THEN
389 DO i=1,ii_stok
391 ENDDO
392 endif
393
395
396 ncand = ii_stok
397
399
401 order = 0
402
403
404 print *, ""
405 print *, " |------------i22buce.F----------|"
406 print *, " | SYNTHESE DES CANDIDATS |"
407 print *, " |-------------------------------|"
408 print *, ncand , "couples candidats avec :"
409 print *,
ncandb ,
"briques differentes, et"
410 print *,
ncande ,
"facettes differentes."
411 print *, ""
412 print *, " |------------i22buce.F----------|"
413 print *, " | BRIQUES RETENUES |"
414 print *, " | FOR CUT CELL BUFFER |"
415 print *, " |-------------------------------|"
417 print *, ""
418
419
420
421
422
423
424 deallocate(order,VALUE)
425
426 end if
427
428
429
430
431
432
433
434
435
436
437
438
439
441 1 x ,ii_stok ,cand_b ,cand_e ,itask ,
442 2 nbric ,itab ,bufbric ,ncand ,
443 3 ixs ,nin)
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
461
462
463
464
465
466
467
468
469
470
472 1 x ,ii_stok ,cand_b ,cand_e ,itask ,
473 2 nbric ,itab ,bufbric ,ncand ,
474 3 ixs ,nin)
475
477
478
479
480
482 1 ixs ,x ,itask, nin, bufbric)
483
486
487
488
489
490
491 IF(itask==0)THEN
494 DEALLOCATE(ifirst)
495 DEALLOCATE(ilast)
501 ENDIF
502
503
504
505 RETURN
subroutine i22get_prev_data(x, ii_stok, cand_b, cand_e, itask, nbric, itab, bufbric, ncand, ixs, nin)
subroutine i22ident(ixs, x, itask, nin, bufbric)
subroutine i22intersect(x, ii_stok, cand_b, cand_e, itask, nbric, itab, bufbric, ncand, ixs, nin)
subroutine i22trivox(nsn, renum, nshelr_l, isznsnr, i_mem, irect, x, stf, stfn, bminma, nsv, ii_stok, cand_b, eshift, cand_e, mulnsn, noint, tzinf, voxel, nbx, nby, nbz, cand_p, nshel_t, marge, nin, itask, ixs, bufbric, nbric, itab, nshel_l)
integer, dimension(:), allocatable list_e
integer, dimension(:), allocatable iadf
integer, dimension(:), allocatable get_list_e_pos_from_cand_e_pos
integer, dimension(:), allocatable itage
integer, dimension(:), allocatable iadl
integer, dimension(:), allocatable itagb
integer, dimension(:), allocatable list_b
integer, dimension(lvoxel) voxel1
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)