OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
nbadigemesh.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| nbadigemesh ../starter/source/elements/ige3d/nbadigemesh.F
25!||--- called by ------------------------------------------------------
26!|| contrl ../starter/source/starter/contrl.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| constit ../starter/source/elements/nodes/constit.F
30!|| fredec0 ../starter/source/starter/freform.F
31!|| fredec_2key_4id_t ../starter/source/starter/freform.F
32!|| fredec_key_3id_t ../starter/source/starter/freform.F
33!|| nintri ../starter/source/system/nintrr.F
34!|| prerafig3d ../starter/source/elements/ige3d/prerafig3d.F
35!|| usr2sys ../starter/source/system/sysfus.F
36!||--- uses -----------------------------------------------------
37!|| format_mod ../starter/share/modules1/format_mod.F90
38!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
39!|| meshsurfig3d_mod ../starter/source/elements/ige3d/meshsurfig3d_mod.F
40!|| message_mod ../starter/share/message_module/message_mod.F
41!|| reader_old_mod ../starter/share/modules1/reader_old_mod.F90
42!|| submodel_mod ../starter/share/modules1/submodel_mod.F
43!||====================================================================
44 SUBROUTINE nbadigemesh(LSUBMODEL,NUMNUSR)
45C----------------------------------------------------------------------
46C ROUTINE BASED ON NBADMESH BUT SPECIFIC TO ISOGEOMETRIC ELEMENTS
47C allows reading and construction of all the necessary arrays
48C FOR THE REFINEMENT OF IGEO ELEMENTS
49C NOTE: CAN BE REORGANIZED FOR BETTER READABILITY
50C----------------------------------------------------------------------
51C-----------------------------------------------
52C M o d u l e s
53C-----------------------------------------------
54 USE message_mod
55 USE meshsurfig3d_mod
56 USE submodel_mod
57 USE hm_option_read_mod
58 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
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
62C-----------------------------------------------
63C I m p l i c i t T y p e s
64C-----------------------------------------------
65#include "implicit_f.inc"
66C-----------------------------------------------
67C C o m m o n B l o c k s
68C-----------------------------------------------
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"
76C-----------------------------------------------
77C D u m m y A r g u m e n t s
78C-----------------------------------------------
79 INTEGER NUMNUSR
80 TYPE(submodel_data) LSUBMODEL(*)
81C-----------------------------------------------
82C L o c a l V a r i a b l e s
83C-----------------------------------------------
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),STAT,NCTRLMAX
91 INTEGER USR2SYS,NUMNUSR1,IDS,K,
92 . IAD,IDX1,IDY1,IDZ1,NCTRL,BID,NUM,
93 . NRAFX,NRAFY,NRAFZ,NBLINE,D1,D2,D3,N1,N2,N3
94 INTEGER IAD_KNOT,IG,UID,SUB_ID,INTRULE,RAFRULE,
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
101 my_real r5(5),rbid
102C-----------------------------------------------
103C E x t e r n a l F u n c t i o n s
104C-----------------------------------------------
105 INTEGER NINTRI
106C-----------------------------------------------
107 DATA mess /'OPTIONS FOR ISOGEOMETRIC MESH DEFINITION'/
108C-----------------------------------------------
109 ipart=0
110 nctrlmax=0
111 bid=0
112 nrafmax=8
113 maxnumgeo=0
114 deg_max=0
115 rbid=0
116C------
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
122C--------------------------------------
123C reading of ige properties
124C--------------------------------------
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
140 CALL fredec_2key_4id_t(key,ig,uid,bid,sub_id,idtitl)
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
175C--------------------------------------
176C reading of parts
177C--------------------------------------
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
183 CALL fredec_key_3id_t(id,bid,uid,titr)
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) ! HERE MAKES IPID STRANGE
188 ipart(2,i)=ipid
189 ipart(4,i)=id
190 ENDDO
191
192
193 iadmstat=1
194
195C------
196 IF(iadmstat /= 0) id_limit%admesh=id_limit%global
197C------
198C--------------------------------------
199C sizing of knot
200C--------------------------------------
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
211 CALL FREDEC_2KEY_4ID_T(KEY,IG,UID,BID,SUB_ID,IDTITL)
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
272C--------------------------------------
273C pre-reading of ige3d for sizing ixig3d and tabconpatch
274C--------------------------------------
275c
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
288c it is necessary to differentiate ige3d parts from the others
289
290 DO WHILE( LINE(1:1) /= '/.OR.' LINE(1:6) == '/ige3d')
291
292 IF (LINE(1:1) == '/')THEN ! ON A ONE CHANGEMENT DE PART
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 ! ON A ONE CHANGEMENT DE PART
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
319c
320 ALLOCATE(TABCONPATCH(NBPART_IG3D),STAT=stat)
321 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,MSGTYPE=MSGERROR,C1='tabcon_patch')
322C--------------------------------------
323C new pre-reading of ige3d for lists of tabconpatch elements
324C--------------------------------------
325c
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 ! ON A ONE CHANGEMENT DE PART
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')
367C
368C--------------------------------------------------
369C HM OFFSETS IDs
370C--------------------------------------------------
371 DO I=1,NSUBMOD
372 OFF_NOD(I) = LSUBMODEL(I)%OFF_NOD
373 OFF_DEF(I) = LSUBMODEL(I)%OFF_DEF
374 ENDDO
375C--------------------------------------------------
376C READING NODES IDs IN HM STRUCTURE
377C--------------------------------------------------
378 CALL CPP_NODE_COUNT(NUMNUSR1)
379 CALL CPP_NODE_ID_READ(ITAB,SUBID_NODES)
380C--------------------------------------------------
381C CHECKS NODES IDs
382C--------------------------------------------------
383 DO I=1,NUMNUSR1
384C--------------------------------------------------
385C SUBMODEL OFFSET
386C--------------------------------------------------
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..OR. . (ITAB(I) < id_limit%admesh_ft_node_auto 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)
396C--------------------------------------------------
397C reading of cnodes
398C--------------------------------------------------
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..OR. . (ITAB(N) < id_limit%admesh_ft_node_auto ITAB(N) >= id_limit%admesh_lt_node_auto))THEN
412 CALL ANCMSG(MSGID=1069,ANMODE=ANINFO,MSGTYPE=MSGERROR,I1=ITAB(N),C1=LINE,C2='/cnode')
413 ENDIF
414 ENDIF
415 ENDDO
416C------
417C construction of the inverse node array
418C------
419C NUMNUSR=NUMNUSR1+NUMCNOD !
420 CALL CONSTIT(ITAB,ITABM1,NUMNUSR)
421C--------------------------------------
422C reading of ige3d
423C--------------------------------------
424c
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
450 CALL FREDEC0(ID)
451 IDS=0
452 DO J=1,NPART
453 IF(IPART(4,J) == ID)IDS=J
454 ENDDO
455 PTABCONPATCH%PID=IDS
456 ELSE
457c HERE WE KNOW IN WHICH IGE PART WE ARE (IDS) NUMGEO BUT IG3D. WE CAN THEREFORE POINT TO THE RIGHT TABCONPATCH_IG3D
458
459 I = I + 1
460 KXIG3D(1,I) =IPART(1,IDS) ! ON SE FICHE DU 1 (PM)
461 KXIG3D(2,I) =IPART(2,IDS)
462 MAXNUMGEO=MAX(MAXNUMGEO,IPART(2,IDS))
463 KXIG3D(4,I) =IAD
464 IPARTIG3D(I)=IDS
465C
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 ! ID
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
475 KXIG3D(5,I)=ID
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
484C
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
501C------
502C inverse connectivity at level 0
503C------
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
521C
522 DO I=1,NUMNOD
523 KNOD2ELIG3D(I+1) = KNOD2ELIG3D(I+1) + KNOD2ELIG3D(I)
524 END DO
525C
526 DO N=NUMNOD,1,-1
527 KNOD2ELIG3D(N+1)=KNOD2ELIG3D(N)
528 END DO
529 KNOD2ELIG3D(1)=0
530c
531C------
532C the refinement work starts here, before this it is only reading
533C------
534c
535 SKNOTLOCPC = DEG_MAX*3*(NUMNODIGE0+2*ADDELIG3D*NCTRLMAX)*MAXNUMGEO ! CAN BE FURTHER IMPROVED
536 ALLOCATE (KNOTLOCPC(SKNOTLOCPC) ,STAT=stat)
537 IF (STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,MSGTYPE=MSGERROR,C1='knotlocpc')
538 KNOTLOCPC(:)=0
539C
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
544C
545 ADDSIXIG3D = 0
546 NBNEWX_FINAL = 0
547 IF(ADDELIG3D>0) THEN
548 CALL PRERAFIG3D(KNOT,KNOTLOCPC,KNOTLOCEL,
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
562C
563C-------------------------------------
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
571C-------------------------------------
572 999 CALL FREERR(1)
573 RETURN
574 END
575
576
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
hm_option_read_mod
Definition hm_option_read_mod.F:412
meshsurfig3d_mod
Definition meshsurfig3d_mod.F:33
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1005
submodel_mod
Definition submodel_mod.F:717
nbadigemesh
subroutine nbadigemesh(lsubmodel, numnusr)
Definition nbadigemesh.F:45
ancmsg
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)
Definition message.F:895
fredec_key_3id_t
subroutine fredec_key_3id_t(id, uid, vers, titr)
Definition freform.F:1214
fredec_2key_4id_t
subroutine fredec_2key_4id_t(key2, id, uid, vers, sub_id, titr)
Definition freform.F:1105
meshsurfig3d_mod::tabconpatch_ig3d_
Definition meshsurfig3d_mod.F:83
submodel_mod::submodel_data
Definition submodel_mod.F:728