45
46
47
51
52
53
54#include "implicit_f.inc"
55
56
57
58#include "mvsiz_p.inc"
59
60
61
62#include "param_c.inc"
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110 INTEGER ::
111 . NRTM,NRTS,MULTIMP,IADFIN,IGAP,
112 . NSN,NOINT,ITAB(*),NBX,NBY,NBZ,IAUTO,
113 . IRECTS(2,NRTS),IRECTM(2,NRTM),FLAGREMNODE
114 INTEGER ITASK
115 INTEGER, INTENT(INOUT) ::
116 . CAND_S(*),CAND_M(*),ADDCM(*),CHAINE(2,*),
117 . VOXEL(1:NBX+2,1:NBY+2,1:NBZ+2), I_MEM,II_STOK,
118 . KREMNODE(*),REMNODE(*)
120 . ,INTENT(IN) ::
121 . x(3,*),xyzm(6,*),
122 . gapmin, drad, marge, tzinf, dgapload,
123 . gap_s(*), gap_m(*), gap_s_l(*), gap_m_l(*)
124
125
126
127 INTEGER
128 . I,J,SS1,SS2,IBUG,
129 . N1,N2,MM1,MM2, iN1, iN2, iM1, iM2, K,L,
130 . PROV_S(2*MVSIZ),PROV_M(2*MVSIZ),
131 . IX1,IY1,IZ1,IX2,IY2,IZ2,
132 . IX,IY,IZ, FIRST_ADD,
133 . I_STOK, I_STOK_BAK, IEDG,
134 . PREV_ADD, CHAIN_ADD, CURRENT_ADD,
135 . NEDG, DEJA , MAX_ADD ,II_STOK0, M
137 . xx1, xx2,
138 . xmin, xmax,ymin,
ymax,zmin, zmax,
139 . yy1,yy2,zz1,zz2,
140 . aaa, dd,
141 . xminb,yminb,zminb,xmaxb,ymaxb,zmaxb
142 my_real,
dimension(:),
ALLOCATABLE :: xmax_edgs, xmin_edgs, ymax_edgs, ymin_edgs, zmax_edgs, zmin_edgs
143 my_real,
dimension(:),
ALLOCATABLE :: xmax_edgm, xmin_edgm, ymax_edgm, ymin_edgm, zmax_edgm, zmin_edgm
144 INTEGER, DIMENSION(:), ALLOCATABLE :: TAGREMLINE
145
146 ALLOCATE(xmax_edgs(nrts), xmin_edgs(nrts), ymax_edgs(nrts))
147 ALLOCATE(ymin_edgs(nrts), zmax_edgs(nrts), zmin_edgs(nrts))
148 ALLOCATE(xmax_edgm(nrtm), xmin_edgm(nrtm), ymax_edgm(nrtm))
149 ALLOCATE(ymin_edgm(nrtm), zmax_edgm(nrtm), zmin_edgm(nrtm))
150
151 IF(flagremnode==2)THEN
152 ALLOCATE(tagremline(nrts))
153 tagremline(1:nrts) = 0
154 ENDIF
155
156 aaa = zero
157
164
165
166
167
168 max_add =
max(1,4*(nrts))
172
173
174 IF(nrtm==0.OR.nrts==0)THEN
175
179 END IF
180
181
182
183
184 xmin = xyzm(1,1)
185 ymin = xyzm(2,1)
186 zmin = xyzm(3,1)
187 xmax = xyzm(4,1)
189 zmax = xyzm(6,1)
190
191 xminb = xmin
192 yminb = ymin
193 zminb = zmin
194 xmaxb = xmax
196 zmaxb = zmax
197
198
199
200
201
202
203
204
205
206
207 current_add=1
208
209 DO i = 1,nrts
210
211
212
213
214
215
216 n1=irects(1,i)
217 n2=irects(2,i)
218
219
220
221
222
223 xx1=x(1,n1)
224 xx2=x(1,n2)
225 xmax_edgs(i)=
max(xx1,xx2);
IF(xmax_edgs(i) < xmin) cycle
226 xmin_edgs(i)=
min(xx1,xx2);
IF(xmin_edgs(i) > xmax) cycle
227 yy1=x(2,n1)
228 yy2=x(2,n2)
229 ymax_edgs(i)=
max(yy1,yy2);
IF(ymax_edgs(i) < ymin) cycle
230 ymin_edgs(i)=
min(yy1,yy2);
IF(ymin_edgs(i) >
ymax) cycle
231 zz1=x(3,n1)
232 zz2=x(3,n2)
233 zmax_edgs(i)=
max(zz1,zz2);
IF(zmax_edgs(i) < zmin) cycle
234 zmin_edgs(i)=
min(zz1,zz2);
IF(zmin_edgs(i) > zmax) cycle
235
236
237
238
239
240 ix1=int(nbx*(xmin_edgs(i)-xminb)/(xmaxb-xminb))
241 iy1=int(nby*(ymin_edgs(i)-yminb)/(ymaxb-yminb))
242 iz1=int(nbz*(zmin_edgs(i)-zminb)/(zmaxb-zminb))
246
247 ix2=int(nbx*(xmax_edgs(i)-xminb)/(xmaxb-xminb))
248 iy2=int(nby*(ymax_edgs(i)-yminb)/(ymaxb-yminb))
249 iz2=int(nbz*(zmax_edgs(i)-zminb)/(zmaxb-zminb))
253
254
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291 DO iz = iz1,iz2
292 DO iy = iy1,iy2
293 DO ix = ix1,ix2
294
295 first_add = voxel(ix,iy,iz)
296
297 IF(first_add == 0)THEN
298
299 voxel(ix,iy,iz) = current_add
303 ELSE
304
310 ENDIF
311
312 current_add = current_add+1
313
314 IF( current_add>=max_add)THEN
315
316
317 max_add = 2 * max_add
318
322 ENDIF
323
324 ENDDO
325 ENDDO
326 ENDDO
327
328 ENDDO
329
330
331
332
333
334
335
336
337 nedg = 0
338 i_stok = 0
339
340 DO iedg=1,nrtm
341
342 aaa = zero
343
344
345
346
347 n1 = irectm(1,iedg)
348 n2 = irectm(2,iedg)
349 mm1 = itab(n1)
350 mm2 = itab(n2)
351
352
353
354
355 xx1=x(1,n1)
356 xx2=x(1,n2)
357 xmax_edgm(iedg)=
max(xx1,xx2)+tzinf
358 xmin_edgm(iedg)=
min(xx1,xx2)-tzinf
359 yy1=x(2,n1)
360 yy2=x(2,n2)
361 ymax_edgm(iedg)=
max(yy1,yy2)+tzinf
362 ymin_edgm(iedg)=
min(yy1,yy2)-tzinf
363 zz1=x(3,n1)
364 zz2=x(3,n2)
365 zmax_edgm(iedg)=
max(zz1,zz2)+tzinf
366 zmin_edgm(iedg)=
min(zz1,zz2)-tzinf
367
368
369
370
371
372 ix1=int(nbx*(xmin_edgm(iedg)-aaa-xminb)/(xmaxb-xminb))
373 iy1=int(nby*(ymin_edgm(iedg)-aaa-yminb)/(ymaxb-yminb))
374 iz1=int(nbz*(zmin_edgm(iedg)-aaa-zminb)/(zmaxb-zminb))
378
379 ix2=int(nbx*(xmax_edgm(iedg)+aaa-xminb)/(xmaxb-xminb))
380 iy2=int(nby*(ymax_edgm(iedg)+aaa-yminb)/(ymaxb-yminb))
381 iz2=int(nbz*(zmax_edgm(iedg)+aaa-zminb)/(zmaxb-zminb))
385
386 deja = 0
387 i_stok_bak = i_stok
388
389
390 IF(flagremnode==2)THEN
391 k = kremnode(iedg)
392 l = kremnode(iedg+1)-1
393 DO m=k,l
394 tagremline(remnode(m)) = 1
395 ENDDO
396 ENDIF
397
398
399
400 DO iz = iz1,iz2
401 DO iy = iy1,iy2
402 DO ix = ix1,ix2
403
404 chain_add = voxel(ix,iy,iz)
405 DO WHILE(chain_add /= 0)
407
408
409 ss1=itab(irects(1,i))
410 ss2=itab(irects(2,i))
411
412 IF( (ss1==mm1).OR.(ss1==mm2).OR.
413 . (ss2==mm1).OR.(ss2==mm2) )THEN
415 cycle
416 END IF
417
418
419 IF(iauto==1 .AND. mm1<ss1 )THEN
421 cycle
422 END IF
423
424
425 IF(flagremnode==2)THEN
426 IF(tagremline(i)==1) THEN
428 cycle
429 ENDIF
430 ENDIF
431
432 i_stok = i_stok + 1
433 prov_s(i_stok) = i
434 prov_m(i_stok) = iedg
435
436 IF(deja==0) nedg = nedg + 1
437 deja=1
439
440 IF(i_stok>=nvsiz)THEN
442 1 nvsiz,irects,irectm,x ,ii_stok ,
443 2 cand_s,cand_m,nsn ,noint ,marge ,
444 3 i_mem ,prov_s,prov_m,multimp,addcm ,
445 4 chaine,iadfin,gapmin,drad ,igap ,
446 5 gap_s ,gap_m ,gap_s_l,gap_m_l,dgapload)
447
448 IF(i_mem==2) THEN
449 ii_stok=zero
450 GOTO 1000
452 i_stok = i_stok-nvsiz
453 DO j=1,i_stok
454 prov_s(j) = prov_s(j+nvsiz)
455 prov_m(j) = prov_m(j+nvsiz)
456 ENDDO
457 ENDIF
458
459
460 ENDDO
461 ENDDO
462 ENDDO
463 ENDDO
464
465
466 IF(flagremnode==2)THEN
467 k = kremnode(iedg)
468 l = kremnode(iedg+1)-1
469 DO m=k,l
470 tagremline(remnode(m)) = 0
471 ENDDO
472 ENDIF
473
474 ENDDO
475
476
477
478
479
480
482 1 i_stok,irects,irectm,x ,ii_stok,
483 2 cand_s,cand_m,nsn ,noint ,marge ,
484 3 i_mem ,prov_s,prov_m,multimp,addcm ,
485 4 chaine,iadfin,gapmin,drad ,igap ,
486 5 gap_s ,gap_m ,gap_s_l,gap_m_l,dgapload)
487
488
489
490
491
492
493
494 1000 CONTINUE
495
496
497
498
499
500
504 2 nbx, nby, nbz, voxel )
505
509 IF(flagremnode==2) DEALLOCATE(tagremline)
510
511 DEALLOCATE(xmax_edgs, xmin_edgs, ymax_edgs)
512 DEALLOCATE(ymin_edgs, zmax_edgs, zmin_edgs)
513 DEALLOCATE(xmax_edgm, xmin_edgm, ymax_edgm)
514 DEALLOCATE(ymin_edgm, zmax_edgm, zmin_edgm)
515
516 RETURN
if(complex_arithmetic) id
subroutine i11resetvoxel1(tmin, tmax, nbx, nby, nbz, voxel)
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
integer function, dimension(:), pointer ireallocate(ptr, new_size)
integer, dimension(:), pointer lchain_elem
integer, dimension(:), pointer lchain_last
integer, dimension(:), pointer lchain_next
subroutine i11sto_vox1(j_stok, irects, irectm, x, ii_stok, cand_n, cand_e, nsn, noint, marge, i_mem, prov_n, prov_e, multimp, addcm, chaine, iadfin, gapmin, drad, igap, gap_s, gap_m, gap_s_l, gap_m_l, dgapload)