45
46
47
48
49
50
51
52
53
59 USE format_mod , ONLY : fmt_10i, fmt_8i, fmt_i, fmt_6i, fmt_5f, fmt_2i
60 USE reader_old_mod , ONLY : kpart,kprop,kcnode,kige3d,kcur,irec,nslash,koptad,nline,line,kline
61 USE user_id_mod , ONLY : id_limit
62
63
64
65#include "implicit_f.inc"
66
67
68
69#include "com04_c.inc"
70#include "param_c.inc"
71#include "remesh_c.inc"
72#include "scr17_c.inc"
73#include "units_c.inc"
74#include "tabsiz_c.inc"
75#include "ige3d_c.inc"
76
77
78
79 INTEGER NUMNUSR
80 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
81
82
83
84 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAB,ITABM1,SUBID_NODES
85 INTEGER, DIMENSION(:,:), ALLOCATABLE :: KXIG3D,IGEO
86 INTEGER, DIMENSION(:), ALLOCATABLE :: IPARTIG3D,IXIG3D,KNOD2ELIG3D,NOD2ELIG3D
87 my_real,
DIMENSION(:),
ALLOCATABLE :: knotlocpc,knotlocel,knot
88 TYPE(TABCONPATCH_IG3D_), DIMENSION(:), ALLOCATABLE, TARGET :: TABCONPATCH
89 TYPE(TABCONPATCH_IG3D_), POINTER :: PTABCONPATCH
90 INTEGER :: IPART(4,NPART), N,ID,I,J,J10(10),,NCTRLMAX
91 INTEGER USR2SYS,NUMNUSR1,IDS,K,
92 . IAD,IDX1,,IDZ1,NCTRL,BID,NUM,
93 . NRAFX,NRAFY,NRAFZ,NBLINE,D1,D2,D3,N1,N2,N3
94 INTEGER IAD_KNOT,,UID,SUB_ID,INTRULE,,
95 . NKNOT1,NKNOT2,NKNOT3,ITGEO,PX,PY,PZ,PID,IPID,MAXNUMGEO,
96 . NBRAFX,NBRAFY,NBRAFZ,NBIG3D_PATCH
97 INTEGER OFF_NOD(NSUBMOD), OFF_DEF(NSUBMOD)
98 CHARACTER MESS*40
99 CHARACTER(LEN=nchartitle) :: TITR,IDTITL
100 CHARACTER(LEN=ncharkey) :: KEY
102
103
104
105 INTEGER NINTRI
106
107 DATA mess /'OPTIONS FOR ISOGEOMETRIC MESH DEFINITION'/
108
109 ipart=0
110 nctrlmax=0
111 bid=0
112 nrafmax=8
113 maxnumgeo=0
114 deg_max=0
115 rbid=0
116
117 ALLOCATE(itab(numnusr),itabm1(2*numnusr),stat=stat)
118 IF(stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'ITAB')
119 ALLOCATE (subid_nodes(numnusr),stat=stat)
120 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'SUBID_NODES')
121 subid_nodes(1:numnusr) = 0
122
123
124
125 numgeo=nslash(kprop)
126 ALLOCATE (igeo(npropgi,numgeo),stat=stat)
127 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'IGEO')
128 igeo = 0
129 kcur = kprop
130 irec=koptad(kcur)-1
131 sknot = 0
132 iad_knot = 0
133 DO itgeo=1,numgeo
134 kline(1:1)=' '
135 DO WHILE(kline(1:1)/='/')
136 irec=irec+1
137 READ(iin,rec=irec,err=999,fmt='(A)')line
138 kline=line
139 ENDDO
141 IF(key(1:6)=='TYPE47'.OR. key(1:5)=='IGE3D')THEN
142 igeo(1,itgeo)=ig
143 irec=irec+1
144 READ(iin,rec=irec,err=999,fmt='(A)')line
145 kline=line
146 READ(line,err=999,fmt=fmt_2i) intrule,rafrule
147 irec=irec+1
148 READ(iin,rec=irec,err=999,fmt='(A)')line
149 kline=line
150 READ(line,err=999,fmt=fmt_6i)
151 . d1,d2,d3,n1,n2,n3
152 igeo(40,itgeo) = iad_knot
153 igeo(41,itgeo) = d1+1
154 igeo(42,itgeo) = d2+1
155 igeo(43,itgeo) = d3+1
156 igeo(44,itgeo) = n1
157 igeo(45,itgeo) = n2
158 igeo(46,itgeo) = n3
159 deg_max=
max(deg_max,d1+2,d2+2,d3+2)
160 irec=irec+1
161 READ(iin,rec=irec,err=999,fmt='(A)')line
162 kline=line
163 DO WHILE(kline(1:1)/='/')
164 irec=irec+1
165 sknot = sknot + 5
166 READ(iin,rec=irec,err=999,fmt='(A)')line
167 kline=line
168 ENDDO
169 irec=irec-1
170 ENDIF
171 ENDDO
172 ALLOCATE(knot(sknot),stat=stat)
173 IF(stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'KNOT')
174 knot=0
175
176
177
178 kcur = kpart
179 irec=koptad(kcur)-1
180 DO i=1,npart
181 irec=irec+1
182 READ(iin,rec=irec,err=999,fmt='(A)')kline
184 irec=irec+1
185 READ(iin,rec=irec,err=999,fmt='(A)')line
186 READ(line,err=999,fmt=fmt_i)pid
187 ipid =
nintri(pid,igeo,npropgi,numgeo,1)
188 ipart(2,i)=ipid
190 ENDDO
191
192
193 iadmstat=1
194
195
196 IF(iadmstat /= 0) id_limit%admesh=id_limit%global
197
198
199
200
201 kcur = kprop
202 irec=koptad(kcur)-1
203 iad_knot = 0
204 DO itgeo=1,numgeo
205 kline(1:1)=' '
206 DO WHILE(kline(1:1)/='/')
207 irec=irec+1
208 READ(iin,rec=irec,err=999,fmt='(A)')line
209 kline=line
210 ENDDO
212 IF(key(1:6)=='TYPE47'.OR. key(1:5)=='IGE3D')THEN
213 irec=irec+1
214 READ(iin,rec=irec,err=999,fmt='(A)')line
215 kline=line
216 READ(line,err=999,fmt=fmt_2i) intrule,rafrule
217 irec=irec+1
218 READ(iin,rec=irec,err=999,fmt='(A)')line
219 kline=line
220 READ(line,err=999,fmt=fmt_6i)d1,d2,d3,n1,n2,n3
221 igeo(40,itgeo) = iad_knot
222 igeo(41,itgeo) = d1+1
223 igeo(42,itgeo) = d2+1
224 igeo(43,itgeo) = d3+1
225 igeo(44,itgeo) = n1
226 igeo(45,itgeo) = n2
227 igeo(46,itgeo) = n3
228 nknot1 = n1+d1+1
229 nknot2 = n2+d2+1
230 nknot3 = n3+d3+1
231 DO i=1,((n1+d1)/5)+1
232 irec=irec+1
233 READ(iin,rec=irec,err=999,fmt='(A)')line
234 kline=line
235 READ(line,err=999,fmt=fmt_5f) r5
236 DO j=1,5
237 IF(iad_knot < nknot1+igeo(40,itgeo))THEN
238 iad_knot = iad_knot + 1
239 knot(iad_knot) = r5(j)
240 ENDIF
241 ENDDO
242 ENDDO
243
244 DO i=1,((n2+d2)/5)+1
245 irec=irec+1
246 READ(iin,rec=irec,err=999,fmt='(A)')line
247 kline=line
248 READ(line,err=999,fmt=fmt_5f) r5
249 DO j=1,5
250 IF(iad_knot < nknot1+nknot2+igeo(40,itgeo))THEN
251 iad_knot = iad_knot + 1
252 knot(iad_knot) = r5(j)
253 ENDIF
254 ENDDO
255 ENDDO
256
257 DO i=1,((n3+d3)/5)+1
258 irec=irec+1
259 READ(iin,rec=irec,err=999,fmt='(A)')line
260 kline=line
261 READ(line,err=999,fmt=fmt_5f) r5
262 DO j=1,5
263 IF(iad_knot < nknot1+nknot2+nknot3+igeo(40,itgeo))THEN
264 iad_knot = iad_knot + 1
265 knot(iad_knot) = r5(j)
266 ENDIF
267 ENDDO
268 ENDDO
269 sknot=iad_knot
270 ENDIF
271 ENDDO
272
273
274
275
276 nbig3d_patch = 0
277 nbpart_ig3d = 0
278 num = 0
279 nbfilsmax = 1
280 nbmeshsurf = 0
281 addelig3d = 0
282 kcur = kige3d
283 nbpart_ig3d = nbpart_ig3d+1
284 irec = koptad(kcur)
285 irec=irec+1
286 READ(iin,rec=irec,err=999,fmt='(A)')line
287
288
289
290 DO WHILE( line(1:1) /= '/' .OR. line(1:6) == '/IGE3D')
291
292 IF (line(1:1) == '/')THEN
293 irec=irec+1
294 READ(iin,rec=irec,err=999,fmt='(A)')line
295 ENDIF
296
297 READ(line,err=999,fmt=fmt_8i)
id,idx1,idy1,idz1,nctrl,nbrafx,nbrafy,nbrafz
298 nbig3d_patch=nbig3d_patch+1
299 nctrlmax =
max(nctrlmax,nctrl)
300 num = num + nctrl
301 nbfilsmax =
max(nbfilsmax,nbrafx*nbrafy*nbrafz + 1)
302 nbmeshsurf = nbmeshsurf +
max(nbrafx-1,0) +
max(nbrafy-1,0) +
max(nbrafz-1,0)
303 addelig3d = addelig3d + nbrafx*nbrafy*nbrafz
304 irec = irec + ((nctrl-1)/10)+2
305 READ(iin,rec=irec,err=999,fmt='(A)')line
306
307 IF (line(1:6) == '/IGE3D')THEN
308 nbpart_ig3d = nbpart_ig3d+1
309 nbig3d_patch=0
310 irec=irec+1
311 READ(iin,rec=irec,err=999,fmt='(A)')line
312 ENDIF
313
314 ENDDO
315
316 ALLOCATE(ixig3d(num+addelig3d*nctrlmax),stat=stat)
317 IF(stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'IXIG3D')
318 sixig3d=num
319
320 ALLOCATE(tabconpatch(nbpart_ig3d),stat=stat)
321 IF(stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'TABCON_PATCH')
322
323
324
325
326 nbig3d_patch = 0
327 nbpart_ig3d = 0
328 kcur = kige3d
329 nbpart_ig3d = nbpart_ig3d+1
330 ptabconpatch => tabconpatch(nbpart_ig3d)
331 ptabconpatch%ID_TABCON=nbpart_ig3d
332 irec = koptad(kcur)
333 irec=irec+1
334 READ(iin,rec=irec,err=999,fmt='(A)')line
335 DO WHILE( line(1:1) /= '/' .OR. line(1:6) == '/IGE3D')
336
337 IF (line(1:1) == '/')THEN
338 irec=irec+1
339 READ(iin,rec=irec,err=999,fmt='(A)')line
340 ENDIF
341
342 READ(line,err=999,fmt=fmt_8i)
id,idx1,idy1,idz1,nctrl,nbrafx,nbrafy,nbrafz
343 nbig3d_patch=nbig3d_patch+1
344 irec = irec + ((nctrl-1)/10)+2
345 READ(iin,rec=irec,err=999,fmt='(A)')line
346
347 IF (line(1:6) == '/IGE3D')THEN
348 ptabconpatch%L_TAB_IG3D=nbig3d_patch
349 ALLOCATE(ptabconpatch%TAB_IG3D(nbig3d_patch),stat=stat)
350 IF(stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'TABCON_PATCH')
351 ALLOCATE(ptabconpatch%INITIAL_CUT(3,nbig3d_patch),stat=stat)
352 IF(stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'TABCON_PATCH')
353 nbpart_ig3d = nbpart_ig3d+1
354 ptabconpatch => tabconpatch(nbpart_ig3d)
355 nbig3d_patch=0
356 irec=irec+1
357 READ(iin,rec=irec,err=999,fmt='(A)')line
358 ENDIF
359
360 ENDDO
361
362 ptabconpatch%L_TAB_IG3D=nbig3d_patch
363 ALLOCATE(ptabconpatch%TAB_IG3D(nbig3d_patch),stat=stat)
364 IF(stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'TABCON_PATCH')
365 ALLOCATE(ptabconpatch%INITIAL_CUT(3,nbig3d_patch),stat=stat)
366 IF(stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'TABCON_PATCH')
367
368
369
370
372 off_nod(i) = lsubmodel(i)%OFF_NOD
373 off_def(i) = lsubmodel(i)%OFF_DEF
374 ENDDO
375
376
377
378 CALL cpp_node_count(numnusr1)
379 CALL cpp_node_id_read(itab,subid_nodes)
380
381
382
383 DO i=1,numnusr1
384
385
386
387 IF(subid_nodes(i) /= 0)THEN
388 IF(itab(i) /= 0) itab(i) = itab(i) + off_nod(subid_nodes(i))
389 ENDIF
390 IF (itab(i) > id_limit%admesh
391 . .AND. (itab(i) < id_limit%admesh_ft_node_auto .OR. itab(i) >= id_limit%admesh_lt_node_auto))THEN
392 CALL ancmsg(msgid=1069,anmode=aninfo,msgtype=msgerror,i1=itab(i),c1=line,c2=
'/NODE')
393 ENDIF
394 ENDDO
395 IF(ALLOCATED(subid_nodes)) DEALLOCATE(subid_nodes)
396
397
398
399 n = numnusr1
400 kcur = kcnode
401 irec = koptad(kcur)-1
402 DO i=1,nline(kcur)+nslash(kcur)
403 irec=irec+1
404 READ(iin,rec=irec,err=999,fmt='(A)')line
405 IF(line(1:1)=='/')THEN
406 kline=line
407 ELSE
408 n=n+1
409 READ(line,err=999,fmt=fmt_i) itab(n)
410 IF (itab(n)>id_limit%admesh
411 . .AND. (itab(n) < id_limit%admesh_ft_node_auto .OR. itab(nTHEN
412 CALL ancmsg(msgid=1069,anmode=aninfo,msgtype=msgerror
'/CNODE')
413 ENDIF
414 ENDIF
415 ENDDO
416
417
418
419
420 CALL constit(itab,itabm1,numnusr)
421
422
423
424
425 ALLOCATE(kxig3d(nixig3d,numelig3d0+addelig3d),stat=stat)
426 IF(stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'KXIG3D')
427 kxig3d=0
428
429 ALLOCATE(ipartig3d(numelig3d0+addelig3d),stat=stat)
430 IF(stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'IPARTIG3D')
431 ipartig3d=0
432
433 nbpart_ig3d = 0
434 nbig3d_patch = 0
435
436 iad =1
437 kcur=kige3d
438 irec=koptad(kcur)-1
439 i = 0
440 inod_ige = firstnod_isogeo
441 ids=0
442 DO WHILE( i < numelig3d0 )
443 irec=irec+1
444 READ(iin,rec=irec,err=999,fmt='(A)')line
445 IF (line(1:1) == '/')THEN
446 nbpart_ig3d = nbpart_ig3d+1
447 nbig3d_patch = 0
448 ptabconpatch => tabconpatch(nbpart_ig3d)
449 kline=line
451 ids=0
452 DO j=1,npart
453 IF(ipart(4,j) ==
id)ids=j
454 ENDDO
455 ptabconpatch%PID=ids
456 ELSE
457
458
459 i = i + 1
460 kxig3d(1,i) =ipart(1,ids)
461 kxig3d(2,i) =ipart(2,ids)
462 maxnumgeo=
max(maxnumgeo,ipart(2,ids))
463 kxig3d(4,i) =iad
464 ipartig3d(i)=ids
465
466 READ(iin,rec=irec,err=999,fmt='(A)')line
467 READ(line,err=999,fmt=fmt_8i)
id,idx1,idy1,idz1,nctrl,nrafx,nrafy,nrafz
468 nbig3d_patch = nbig3d_patch + 1
469 ptabconpatch%TAB_IG3D(nbig3d_patch)=i
470 ptabconpatch%INITIAL_CUT(1,nbig3d_patch)=nrafx
471 ptabconpatch%INITIAL_CUT(2,nbig3d_patch)=nrafy
472 ptabconpatch%INITIAL_CUT(3,nbig3d_patch)=nrafz
473 nctrlmax =
max(nctrlmax,nctrl)
474 kxig3d(3,i)=nctrl
476 kxig3d(6,i)=idx1
477 kxig3d(7,i)=idy1
478 kxig3d(8,i)=idz1
479 kxig3d(12,i)=
max(nrafx,1)
480 kxig3d(13,i)=
max(nrafy,1)
481 kxig3d(14,i)=
max(nrafz,1)
482 kxig3d(15,i)=inod_ige
483 inod_ige = inod_ige + 64
484
485 nbline= ((nctrl-1)/10)+1
486
487 DO n=1,nbline
488 irec=irec+1
489 READ(iin,rec=irec,err=999,fmt='(A)')line
490 READ(line,err=999,fmt=fmt_10i) j10
491 DO j=1,10
492 IF(j10(j) /= 0)THEN
493 ixig3d(iad)=
usr2sys(j10(j),itabm1,mess,
id)
494 iad=iad+1
495 ENDIF
496 ENDDO
497 ENDDO
498 ENDIF
499 ENDDO
500
501
502
503
504 ALLOCATE(knod2elig3d(numnod+1),stat=stat)
505 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'KNOD2ELIG3D')
506 knod2elig3d=0
507 ALLOCATE(nod2elig3d(nctrlmax*numelig3d),
508 . stat=stat)
509 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'NOD2ELIG3D')
510 nod2elig3d=0
511
512 DO i=1,numelig3d0
513 px = igeo(41,kxig3d(2,i))
514 py = igeo(42,kxig3d(2,i))
515 pz = igeo(43,kxig3d(2,i))
516 DO k=1,px*py*pz
517 n = ixig3d(kxig3d(4,i)+k-1)
518 knod2elig3d(n) = knod2elig3d(n) + 1
519 END DO
520 END DO
521
522 DO i=1,numnod
523 knod2elig3d(i+1) = knod2elig3d(i+1) + knod2elig3d(i)
524 END DO
525
526 DO n=numnod,1,-1
527 knod2elig3d(n+1)=knod2elig3d(n)
528 END DO
529 knod2elig3d(1)=0
530
531
532
533
534
535 sknotlocpc = deg_max*3*(numnodige0+2*addelig3d*nctrlmax)*maxnumgeo
536 ALLOCATE (knotlocpc(sknotlocpc) ,stat=stat)
537 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'KNOTLOCPC')
538 knotlocpc(:)=0
539
540 sknotlocel = 2*3*(numelig3d0+addelig3d)
541 ALLOCATE (knotlocel(sknotlocel) ,stat=stat)
542 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo, msgtype=msgerror,c1=
'KNOTLOCEL')
543 knotlocel(:)=0
544
545 addsixig3d = 0
546 nbnewx_final = 0
547 IF(addelig3d>0) THEN
549 . kxig3d,ixig3d,igeo,
550 . ipartig3d,
551 . rbid,rbid,rbid,rbid,rbid,tabconpatch,0)
552 ENDIF
553
554 numnod=numnod + nbnewx_final
555 print*,'NBNEWX_FINAL',nbnewx_final
556 print*,'ADDELIG3D',addelig3d
557 numelig3d = numelig3d + addelig3d
558 IF(nbnewx_final/=0) THEN
559 nadigemesh=1
560 ENDIF
561 firstnod_isogeo=numnod+1
562
563
564 DO i=1,nbpart_ig3d
565 IF(tabconpatch(i)%L_TAB_IG3D/=0) DEALLOCATE(tabconpatch(i)%TAB_IG3D,tabconpatch(i)%INITIAL_CUT)
566 ENDDO
567
568 DEALLOCATE(itab,itabm1,igeo,kxig3d,ixig3d,ipartig3d,knot,knotlocpc,knotlocel,knod2elig3d,nod2elig3d,tabconpatch)
569
570 RETURN
571
573 RETURN
subroutine constit(itab, itabm1, numnod)
integer, parameter nchartitle
integer, parameter ncharkey
integer function nintri(iext, antn, m, n, m1)
subroutine prerafig3d(knot, knotlocpc, knotlocel, kxig3d, ixig3d, igeo, ipartig3d, x, v, d, ms, wige, tabconpatch, flag_pre)
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)
integer function usr2sys(iu, itabm1, mess, id)