39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
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
93 use element_mod , only : nixs
94
95
96
97#include "implicit_f.inc"
98#include "comlock.inc"
99
100
101
102#include "task_c.inc"
103#include "subvolumes.inc"
104
105 INTERFACE
106 FUNCTION i22chk(
107 1 SECtype, Nbits, Npqts)
108 INTEGER :: Nbits, Npqts
109 CHARACTER*(*) :: SECtype
110 LOGICAL :: I22CHK
111 END FUNCTION i22chk
112 END INTERFACE
113
114
115
116 INTEGER :: IXS(NIXS,*), ITASK, NIN, BUFBRIC(*)
118 . x(3,*)
119
120
121
122 INTEGER I, J, , K, L,S, NE, POS, IAD,NBCUT, Icode, Idble, IB
123 INTEGER I_12BITS, PQTS(4), NPQTS, NBITS, SOM, I_bits(12)
124 INTEGER NBF, NBL, ID, N, , id2
125 INTEGER NFACE, NEDGE
126 INTEGER :: MAXSOM
127 INTEGER D, M
128 INTEGER,POINTER,DIMENSION(:) :: pCODE, pTAG, pGnod
129 CHARACTER*14,DIMENSION(:),POINTER ::pSEC
130 LOGICAL LTag(18)
131 CHARACTER*14 :: dbKEY1, dbKEY2
132 integer (0:ncandb), idb2(0:ncandb)
133 INTEGER :: tagTETRA(S_TETRA),tagPENTA(S_PENTA),tagPOLY3(S_POLY3),
134 . taghexae(s_hexae),tagpoly4(s_poly4)
135 INTEGER :: MultICODE(S22_MAX), MultIDBLE(S22_MAX)
136 CHARACTER*14 :: MultiSECtype(S22_MAX)
137 INTEGER :: MultiSECid(S22_MAX)
138 LOGICAL :: bool1, bool2
139 INTEGER :: BasedOnUsedNodes
140 INTEGER :: UsedNodes, Gnod
141 INTEGER :: SecTypeList(0:106)
142 INTEGER :: LIST(106), LIST_FIX(8),LIST_VAR(106)
143 INTEGER :: SizeL , SizeLFIX ,SizeLVAR
144 INTEGER :: NINTP , TAB(12)
145 INTEGER :: RESULT(8)
146 LOGICAL :: bFOUND, debug_outp
147 INTEGER :: CODE, brickID, bAND, IE, Iremoved
149 LOGICAL :: db_WRITE
150
151
152
153 list_fix(1:8) = 0
154 tagtetra=0
155 tagpenta=0
156 tagpoly3=0
157 taghexae=0
158 tagpoly4=0
159
160
161
162
163 nbf = 1+itask*
nb/nthread
164 nbl = (itask+1)*
nb/nthread
165
166 DO i=nbf,nbl
167
168
169
170
172 1 i , icode , idble, nbits, npqts,
173 2 idb1(i), idb2(i), nin )
179 END DO
180
181
182
183
184
185
186
187
188 debug_outp = .false.
191 do ib=nbf,nbl
194 debug_outp=.true.
195 exit
196 endif
197 enddo
199 debug_outp = .true.
200 endif
201 endif
202 if(itask==0.AND.debug_outp)then
203 print *, ""
204 print *, " |----------i22ident.F-----------|"
205 print *, " | IDENTIFICATION INTERSECTION |"
206 print *, " |-------------------------------|"
207 end if
208
209
210 DO i=nbf,nbl
211
212
213
214 iremoved = 0
215 ib = i
216 sectypelist(:) = 0
217 usednodes = 0
218 k = 1
223 brick_list(nin,i)%Sectype(1:8) =
'--------------'
224
225
226
227
228
229
230 IF(nbits<3)GOTO 50
231
232
233
234 d = d_tetra
235 m = m_tetra
236 s = s_tetra
237 n = n_tetra
238 pcode => bcode(d:d+s-1)
239 psec => strcode(d:d+s-1)
240 DO j=1,s
241 IF( iand(icode,pcode(j))==pcode(j) )THEN
242 sectypelist(k) = d+j-1
243 k = k+1
244 END IF
245 END DO
246 IF(nbits==3.AND.(npqts==1.OR.npqts==3))GOTO 50
247
248
249
250 IF(nbits>=4.AND.npqts>=3)THEN
251 d = d_penta
252 m = m_penta
253 s = s_penta
254 n = n_penta
255 pcode => bcode(d:d+s-1)
256 psec => strcode(d:d+s-1)
257 DO j=1,s
258 IF( iand(icode,pcode(j))==pcode(j) )THEN
259 sectypelist(k) = d+j-1
260 k = k+1
261 END IF
262 END DO
263
264
265
266 IF(nbits>=5)THEN
267 d = d_poly3
268 s = s_poly3
269 m = m_poly3
270 n = n_poly3
271 pcode => bcode(d:d+s-1)
272 psec => strcode(d:d+s-1)
273 DO j=1,s
274 IF( iand(icode,pcode(j))==pcode(j) )THEN
275 sectypelist(k) = d+j-1
276 k = k+1
277 END IF
278 END DO
279 END IF
280
281
282
283 IF(npqts==4)THEN
284 d = d_hexae
285 m = m_hexae
286 s = s_hexae * m
287 n = n_hexae
288 pcode => bcode(d:d+s-1)
289 psec => strcode(d:d+s-1)
290 DO j=1,s
291 IF( iand(icode,pcode(j))==pcode(j) )THEN
292 sectypelist(k) = d+j-1
293 k = k+1
294 END IF
295 END DO
296 END IF
297
298
299
300 IF(nbits>=6)THEN
301 d = d_poly4
302 m = m_poly4
303 s = s_poly4 * m
304 n = n_poly4
305 pcode => bcode(d:d+s-1)
306 psec => strcode(d:d+s-1)
307 DO j=1,s
308 IF( iand(icode,pcode(j))==pcode(j) )THEN
309 sectypelist(k) = d+j-1
310 k = k+1
311 END IF
312 END DO
313 END IF
314
315
316
317 IF(nbits>=6)THEN
318 d = d_poly4a
319 m = m_poly4a
320 s = s_poly4a * m
321 n = n_poly4a
322 pcode => bcode(d:d+s-1)
323 psec => strcode(d:d+s-1)
324 DO j=1,s
325 IF( iand(icode,pcode(j))==pcode(j) )THEN
326 sectypelist(k) = d+j-1
327 k = k+1
328 END IF
329 END DO
330 END IF
331
332
333
334 IF(nbits>=6)THEN
335 d = d_poly4b
336 m = m_poly4b
337 s = s_poly4b * m
338 n = n_poly4b
339 pcode => bcode(d:d+s-1)
340 psec => strcode(d:d+s-1)
341 DO j=1,s
342 IF( iand(icode,pcode(j))==pcode(j) )THEN
343 sectypelist(k) = d+j-1
344 k = k+1
345 END IF
346 END DO
347 END IF
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369 END IF
370
371 50 CONTINUE
372 sectypelist(0) = k - 1
373 sizel = sectypelist(0)
374
375
376
377
378
379
380 DO k=1,sectypelist(0)
381 j = sectypelist(k)
382 list(k) = j
383 ENDDO
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399 IF(sectypelist(0)==0)cycle
400 IF(icode==0)cycle
401
402
403
404
405
406
407
408
409 nintp = nbits + popcnt(idble)
410
411 list_var(1:sizel) = list(1:sizel)
412 sizelvar = sizel
413 sizelfix = 0
414
415 result(:) = 0
416 bfound = .false.
417
418
420 db_write = .false.
421
422 IF(sizel==1)THEN
423 IF(icode/=idble)THEN
424 IF(idble == 0)THEN
425 result(1) = list(1)
426 result(2) = 0
427 bfound = .true.
428 ELSE
429 print *, "**WARNING INTER22 : UNUSED INTERSECTION POINTS FOR THIS ELEMENT ",brickid
430 db_write = .true.
431 result(1) = list(1)
432 result(2) = 0
433 bfound = .true.
434 ENDIF
435 ELSE
436
437 result(1) = list(1)
438 result(2) = list(1)
439 bfound = .true.
440 ENDIF
441 ELSEIF(sizel==2 .AND. ((list(1)>=45.AND.list(1)<=49) .OR. (list(1)>=51.AND.list(1)<=57)))THEN
442 IF(list(2) == list(1)+1)THEN
443 IF( icode==idble )THEN
444 bfound = .true.
445 result(1:2) = list(1:2)
446 result(3) = 0
447 ELSEIF(idble==0)THEN
448 bfound = .true.
449 result(1) = list(1)
450 result(2) = 0
451 ELSE
452 print *, "**WARNING INTER22 : UNUSED INTERSECTION POINTS FOR THIS ELEMENT ",brickid
453 db_write = .true.
454 ENDIF
455 ENDIF
456 else
457 CALL int22listcombi(itask,list_fix,sizelfix,list_var,sizelvar,nintp,icode,idble,0,result,bfound)
458 if((.NOT.bfound).AND.sizel==1)then
459 bfound = .true.
460 result(1) = list(1)
461 result(2) = 0
462 elseif((.NOT.bfound).AND.sizel>1)then
463
464
465 bfound = .true.
466 result(1) = list( maxloc(list(1:sizel),1) )
467 result(2) = 0
468
469
470
471
472
473
474
475
476
477 endif
478 ENDIF
479
480 IF(db_write .EQV. .true.)THEN
481
482
483 DO j=1,12
484 iad = (i-1)*12+j
486 DO k=1,nbcut
487
489 point(1:3) = x(1:3,
edge_list(nin,iad)%NODE(1) ) + cutcoor * (
edge_list(nin,iad)%VECTOR(1:3))
490 END DO
491 ENDDO
492
493 ENDIF
494
495 IF(bfound)THEN
496
497
498
499
500
501 j = 1
502 code = result(j)
503 DO WHILE(code/=0)
505 brick_list(nin,i)%SECTYPE(j) = strcode(iabs(code))
506 j = j + 1
507 IF(j==9)EXIT
508 code = result(j)
509 ENDDO
511 ELSE
512
513
514
515
516 ENDIF
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532 END DO
533
534
535
536
538
539 if(debug_outp)then
541
542
543
545 if(itask==0)then
546 do i=nbf,nbl
550 print *,
" CELL ID -:",ixs(11,
brick_list(nin,i)%ID)
551 WRITE(*,fmt='(A20,I10,A4,I10)') " edges add from ",idb1(i)," to ",idb2(i)
552 WRITE(*,fmt='(A11,I4,A20,I2,A1,I1,A1)') " icode=", icode, " (nbits,npqts) = (", nbits,",",npqts,")"
553 WRITE(*,fmt='(A11,I4,A20,I2,A1,I1,A1)') " idble=", idble
554 WRITE(*,fmt=
'(A,I1)')
" num planes=" ,
brick_list(nin,i)%NBCUT
557 if(dbkey1(1:1)=='-') then
558 WRITE(*,fmt='(A)') " --> NONE"
559 else
560 WRITE(*,fmt='(A,A)') " -->",dbkey1(1:14)
561 end if
562 enddo
563 end do
564 endif
566 if(itask==1)then
567 do i=nbf,nbl
571 print *,
" BRIQUE ID -:",ixs(11,
brick_list(nin,i)%ID)
572 WRITE(*,fmt='(A20,I10,A4,I10)') " edges add from ",idb1(i)," to ",idb2(i)
573 WRITE(*,fmt='(A11,I4,A20,I2,A1,I1,A1)') " icode=", icode, " (nbits,npqts) = (", nbits,",",npqts,")"
574 WRITE(*,fmt=
'(A,I1)')
" num planes=" ,
brick_list(nin,i)%NBCUT
577 if(dbkey1(1:1)=='-') then
578 WRITE(*,fmt='(A)') " --> NONE"
579 else
580 WRITE(*,fmt='(A,A)') " -->",dbkey1(1:14)
581 end if
582 enddo
583 end do
584 endif
585
586
587
588
589 end if
590 endif
591
592
593
594
595
596
597
598
599 RETURN
600
subroutine i22gbit(iad, icode, idble, nbits, npqts, idb1, idb2, nin)
recursive subroutine int22listcombi(itask, arg_listfix, arg_sizefix, arg_listvar, arg_sizevar, nintp, icode, idble, lvl, result, bfound)
type(brick_entity), dimension(:,:), allocatable, target brick_list