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