59
60
61
62#include "implicit_f.inc"
63
64
65
66#include "mvsiz_p.inc"
67
68
69
70#include "com01_c.inc"
71#include "com04_c.inc"
72#include "param_c.inc"
73#include "vect07_c.inc"
74
75
76
77 INTEGER NB_NC,NB_EC,I_ADD,MAXSIZ,I_STOK,J_STOK,I_MEM
78 INTEGER I_BID, I_AMAX,NB_N_B, NOINT, NSN,MULTIMP, IGAP
79 INTEGER ADD(2,0:*),IRECT(4,*),BPE(*),PE(*),BPN(*),PN(*)
80 INTEGER NSV(*),CAND_N(*),CAND_E(*), ITAB(*), MSR(*)
81
83 . x(3,*),xyzm(6,*),tzinf,dbuc,
84 . maxbox,minbox, xmax,
ymax, zmax,
85 . gap, gap_s(*), gap_m(*),
86 . gapmin, gapmax, marge, gapsmx, bgapsmx
87 INTEGER ID
88 CHARACTER(LEN=NCHARTITLE) :: TITR
89 INTEGER, DIMENSION(MVSIZ), INTENT(INOUT) ::PROV_N,PROV_E
90 INTEGER, DIMENSION(MVSIZ), INTENT(INOUT) :: IX1,IX2,IX3,IX4,NSVG
91 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: x1,x2,x3,x4
92 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: y1,y2,y3,y4
93 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: z1,z2,z3,z4
94 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: xi,yi,zi
95 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: x0,y0,z0
96 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: n11,n21,n31,pene
97 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: nx1,ny1,nz1
98 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: nx2,ny2,nz2
99 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: nx3,ny3,nz3
100 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: nx4,ny4,nz4
101 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: p1,p2,p3,p4
102 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: lb1,lb2,lb3,lb4
103 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: lc1,lc2,lc3,lc4
104
105
106
107 INTEGER NB_NCN,,ADDNN,ADDNE,IPOS,I,IP,J
108 INTEGER INF,SUP,DIR,N1,N2,N3,N4,NN,NE
109
111 . bid,dx,dy,dz,dsup,seuil,xmx,xmn,gapsmax,
112 . gapv(mvsiz)
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180 IF(nb_ec==0.OR.nb_nc==0) THEN
181
182
183
184 CALL i7dstk(i_add,nb_nc,nb_ec,add,bpn,pn,bpe,pe)
185 RETURN
186 ENDIF
187
188
189
190 dx = xyzm(4,i_add) - xyzm(1,i_add)
191 dy = xyzm(5,i_add) - xyzm(2,i_add)
192 dz = xyzm(6,i_add) - xyzm(3,i_add)
194
195 IF(add(2,1)+nb_ec>=maxsiz) THEN
196
197 IF ( nb_n_b == numnod) THEN
198
199
200
201 IF (istamping == 1) THEN
203 . msgtype=msgerror,
204 . anmode=aninfo,
206 . c1=titr)
207 ELSE
209 . msgtype=msgerror,
210 . anmode=aninfo,
212 . c1=titr)
213 ENDIF
214 ENDIF
215 i_mem = 1
216 RETURN
217 ENDIF
218 IF(dsup<minbox.OR.
219 . nb_nc<=nb_n_b.AND.dsup<maxbox.OR.
220 . nb_nc<=nb_n_b.AND.nb_ec==1) THEN
221
222
223
224
225 DO 20 i=1,nb_ec
226 ne = bpe(i)
227 n1=irect(1,ne)
228 n2=irect(2,ne)
229 n3=irect(3,ne)
230 n4=irect(4,ne)
231 DO 20 j=1,nb_nc
232 nn=nsv(bpn(j))
233 IF(nn/=n1.AND.nn/=n2.AND.nn/=n3.AND.nn/=n4) THEN
234 j_stok = j_stok + 1
235 prov_n(j_stok) = bpn(j)
236 prov_e(j_stok) = ne
237 IF(j_stok==nvsiz) THEN
238 lft = 1
239 llt = nvsiz
240 nft = 0
241 j_stok = 0
242 CALL i23cor3t(x ,irect,nsv ,prov_e ,prov_n,
243 2 gapv ,igap ,gap ,gap_s,gapmin ,
244 3 gapmax,msr ,gap_m ,ix1 ,ix2 ,
245 4 ix3 ,ix4 ,nsvg ,x1 ,x2 ,
246 5 x3 ,x4 ,y1 ,y2 ,y3 ,
247 6 y4 ,z1 ,z2 ,z3 ,z4 ,
248 7 xi ,yi ,zi )
249 CALL i7dst3(ix3,ix4,x1 ,x2 ,x3 ,
250 1 x4 ,y1 ,y2 ,y3 ,y4 ,
251 2 z1 ,z2 ,z3 ,z4 ,xi ,
252 3 yi ,zi ,x0 ,y0 ,z0 ,
253 4 nx1,ny1,nz1,nx2,ny2,
254 5 nz2,nx3,ny3,nz3,nx4,
255 6 ny4,nz4,p1 ,p2 ,p3 ,
256 7 p4 ,lb1,lb2,lb3,lb4,
257 8 lc1,lc2,lc3,lc4,llt)
258 CALL i7pen3(marge,gapv,n11,n21,n31,
259 1 pene ,nx1 ,ny1,nz1,nx2,
260 2 ny2 ,nz2 ,nx3,ny3,nz3,
261 3 nx4 ,ny4 ,nz4,p1 ,p2 ,
262 4 p3 ,p4,llt)
263 IF(i_stok+nvsiz<multimp*nsn) THEN
264 CALL i7cmp3(i_stok,cand_e ,cand_n,1,pene,
265 1 prov_n,prov_e)
266 ELSE
267 i_bid = 0
268 CALL i7cmp3(i_bid,cand_e,cand_n,0,pene,
269 1 prov_n,prov_e)
270 IF(i_stok+i_bid<multimp*nsn) THEN
271 CALL i7cmp3(i_stok,cand_e,cand_n,1,pene,
272 1 prov_n,prov_e)
273 ELSE
274 i_mem = 2
275
276
277
278
280 . msgtype=msgwarning,
281 . anmode=aninfo_blind_2,
283 . c1=titr)
284 RETURN
285 ENDIF
286 ENDIF
287 ENDIF
288
289
290 ENDIF
291 20 CONTINUE
292
293
294 CALL i7dstk(i_add,nb_nc,nb_ec,add,bpn,pn,bpe,pe)
295 RETURN
296 ENDIF
297
298
299
300
301
302
303
304
305
306
307
308
309 dir = 1
310 IF(dy==dsup) THEN
311 dir = 2
312 ELSE IF(dz==dsup) THEN
313 dir = 3
314 ENDIF
315 seuil =(xyzm(dir+3,i_add)+xyzm(dir,i_add))/2
316
317
318
319 nb_ncn= 0
320 addnn= add(1,1)
321 inf = 0
322 sup = 0
323 IF(igap==0)THEN
324 DO i=1,nb_nc
325 IF(x(dir,nsv(bpn(i)))<seuil) THEN
326
327 addnn = addnn + 1
328 pn(addnn) = bpn(i)
329 inf = 1
330 ELSE
331 nb_ncn = nb_ncn + 1
332 bpn(nb_ncn) = bpn(i)
333
334 sup = 1
335 ENDIF
336 END DO
337 ELSE
338 gapsmx = zero
339 bgapsmx = zero
340 DO i=1,nb_nc
341 IF(x(dir,nsv(bpn(i)))<seuil) THEN
342
343 addnn = addnn + 1
344 pn(addnn) = bpn(i)
345 gapsmx =
max(gapsmx,gap_s(bpn(i)))
346 inf = 1
347 ELSE
348
349 nb_ncn = nb_ncn + 1
350 bpn(nb_ncn) = bpn(i)
351 bgapsmx =
max(bgapsmx,gap_s(bpn(i)))
352 sup = 1
353 ENDIF
354 END DO
355 END IF
356
357
358
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
388
389
390
391
392
393
394
395
396
397 nb_ecn= 0
398 addne= add(2,1)
399 IF(igap==0)THEN
400 DO i=1,nb_ec
401 xmx=
max(x(dir,irect(1,bpe(i))),x(dir,irect(2,bpe(i))),
402 . x(dir,irect(3,bpe(i))),x(dir,irect(4,bpe(i))))
403 . + tzinf
404 xmn=
min(x(dir,irect(1,bpe(i))),x(dir,irect(2,bpe(i))),
405 . x(dir,irect(3,bpe(i))),x(dir,irect(4,bpe(i))))
406 . - tzinf
407 IF(xmn<seuil.AND.inf==1) THEN
408
409 addne = addne + 1
410 pe(addne) = bpe(i)
411 ENDIF
412 IF(xmx>=seuil.AND.sup==1) THEN
413
414 nb_ecn = nb_ecn + 1
415 bpe(nb_ecn) = bpe(i)
416 ENDIF
417 ENDDO
418 ELSE
419 DO i=1,nb_ec
420 xmn=
min(x(dir,irect(1,bpe(i))),x(dir,irect(2,bpe(i))),
421 . x(dir,irect(3,bpe(i))),x(dir,irect(4,bpe(i))))
422 - -sqrt(three)*
min(
max(gapsmx+gap_m(bpe(i)),gapmin),gapmax)
423 - -marge
424 IF(xmn<seuil.AND.inf==1) THEN
425
426 addne = addne + 1
427 pe(addne) = bpe(i)
428 ENDIF
429 xmx=
max(x(dir,irect(1,bpe(i))),x(dir,irect(2,bpe(i))),
430 . x(dir,irect(3,bpe(i))),x(dir,irect(4,bpe(i))))
431 + +sqrt(three)*
min(
max(bgapsmx+gap_m(bpe(i)),gapmin),gapmax)
432 + +marge
433 IF(xmx>=seuil.AND.sup==1) THEN
434
435 nb_ecn = nb_ecn + 1
436 bpe(nb_ecn) = bpe(i)
437 ENDIF
438 ENDDO
439 END IF
440
441
442
443 add(1,2) = addnn
444 add(2,2) = addne
445
446
447
448
449
450
451 xyzm(1,i_add+1) = xyzm(1,i_add)
452 xyzm(2,i_add+1) = xyzm(2,i_add)
453 xyzm(3,i_add+1) = xyzm(3,i_add)
454 xyzm(4,i_add+1) = xyzm(4,i_add)
455 xyzm(5,i_add+1) = xyzm(5,i_add)
456 xyzm(6,i_add+1) = xyzm(6,i_add)
457 xyzm(dir,i_add+1) = seuil
458 xyzm(dir+3,i_add) = seuil
459
460 nb_nc = nb_ncn
461 nb_ec = nb_ecn
462
463 i_add = i_add + 1
464 IF(i_add>=1000) THEN
465
466 IF ( nb_n_b == numnod) THEN
467
468
469
470 IF (istamping == 1) THEN
472 . msgtype=msgerror,
473 . anmode=aninfo,
475 . c1=titr)
476 ELSE
478 . msgtype=msgerror,
479 . anmode=aninfo,
481 . c1=titr)
482 ENDIF
483 ENDIF
484 i_mem = 1
485 RETURN
486 ENDIF
487
488
489 RETURN
subroutine i7cmp3(i_stok, cand_e, cand_n, iflag, pene, prov_n, prov_e)
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
integer, parameter nchartitle
subroutine i23cor3t(x, irect, nsv, cand_e, cand_n, gapv, igap, gap, gap_s, gapmin, gapmax, msr, gap_m, ix1, ix2, ix3, ix4, nsvg, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi)
subroutine i7dst3(ix3, ix4, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, x0, y0, z0, nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4, p1, p2, p3, p4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, last)
subroutine i7dstk(i_add, nb_nc, nb_ec, add, bpn, pn, bpe, pe)
subroutine i7pen3(marge, gapv, n1, n2, n3, pene, nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4, p1, p2, p3, p4, last)
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)