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 BASEE SUR NBADMESH MAIS SPECIFIQUE AUX ELEMENTS ISOGEOMETRIQUES
47C PERMET LA LECTURE ET LA CONSTRUCTION DE TOUT LES TABLEAUX NECESSAIRES
48C AU RAFFINEMENT DES ELEMENTS IGEO
49C NB : PEUT ETRE ONE PEU REORGANISEE POUR UNE MEILLEURE LECTURE
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),TABIDS(NUMELIG3D0),
91 . N,ID,I,J,NLEV,NMUL,J10(10),STAT,NCTRLMAX
92 INTEGER USR2SYS,NUMNUSR1,IDS,NI,NJ,NK,NL,K,L,P,Q,QQ,
93 . NN,IAD,IDX1,IDY1,IDZ1,NCTRL,BID,NUM,
94 . NRAFX,NRAFY,NRAFZ,NBLINE,D1,D2,D3,N1,N2,N3
95 INTEGER IAD_KNOT,IG,UID,SUB_ID,INTRULE,RAFRULE,
96 . NKNOT1,NKNOT2,NKNOT3,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
102 my_real r5(5),rbid
103C-----------------------------------------------
104C E x t e r n a l F u n c t i o n s
105C-----------------------------------------------
106 INTEGER NINTRI
107C-----------------------------------------------
108 DATA mess /'OPTIONS FOR ISOGEOMETRIC MESH DEFINITION'/
109C-----------------------------------------------
110 ipart=0
111 nctrlmax=0
112 bid=0
113 nrafmax=8
114 maxnumgeo=0
115 deg_max=0
116 rbid=0
117C------
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
123C--------------------------------------
124C LECTURE DES PROP IGE
125C--------------------------------------
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
141 CALL fredec_2key_4id_t(key,ig,uid,bid,sub_id,idtitl)
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
176C--------------------------------------
177C LECUTRE DES PART
178C--------------------------------------
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
184 CALL fredec_key_3id_t(id,bid,uid,titr)
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) ! ICI REND IPID BIZARRE
189 ipart(2,i)=ipid
190 ipart(4,i)=id
191 ENDDO
192
193
194 iadmstat=1
195
196C------
197 IF(iadmstat /= 0) id_limit%admesh=id_limit%global
198C------
199C--------------------------------------
200C DIMENSIONNEMENT DE KNOT
201C--------------------------------------
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
212 CALL fredec_2key_4id_t(key,ig,uid,bid,sub_id,idtitl)
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
273C--------------------------------------
274C PRELECTURE DES IGE3D POUR DIMMENSIONNEMENT IXIG3D ET TABCONPATCH
275C--------------------------------------
276c
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
289c IL FAUT DIFFERENCIER LES PART IGE3D DES AUTRES
290
291 DO WHILE( LINE(1:1) /= '/.OR.' LINE(1:6) == '/ige3d')
292
293 IF (LINE(1:1) == '/')THEN ! ON A ONE CHANGEMENT DE PART
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 ! ON A ONE CHANGEMENT DE PART
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
320c
321 ALLOCATE(TABCONPATCH(NBPART_IG3D),STAT=stat)
322 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,MSGTYPE=MSGERROR,C1='tabcon_patch')
323C--------------------------------------
324C NOUVELLE PRELECTURE DES IGE3D POUR DES LISTES D'ELEMENTS DE TABCONPATCH
325C--------------------------------------
326c
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 ! ON A ONE CHANGEMENT DE PART
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')
368C
369C--------------------------------------------------
370C HM OFFSETS IDs
371C--------------------------------------------------
372 DO I=1,NSUBMOD
373 OFF_NOD(I) = LSUBMODEL(I)%OFF_NOD
374 OFF_DEF(I) = LSUBMODEL(I)%OFF_DEF
375 ENDDO
376C--------------------------------------------------
377C READING NODES IDs IN HM STRUCTURE
378C--------------------------------------------------
379 CALL CPP_NODE_COUNT(NUMNUSR1)
380 CALL CPP_NODE_ID_READ(ITAB,SUBID_NODES)
381C--------------------------------------------------
382C CHECKS NODES IDs
383C--------------------------------------------------
384 DO I=1,NUMNUSR1
385C--------------------------------------------------
386C SUBMODEL OFFSET
387C--------------------------------------------------
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..OR. . (ITAB(I) < id_limit%admesh_ft_node_auto 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)
397C--------------------------------------------------
398C LECTURE DES CNODES
399C--------------------------------------------------
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..OR. . (ITAB(N) < id_limit%admesh_ft_node_auto 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
417C------
418C CONSTITUTION DU TABLEAU INVERSE DES NOEUDS
419C------
420C NUMNUSR=NUMNUSR1+NUMCNOD !
421 CALL CONSTIT(ITAB,ITABM1,NUMNUSR)
422C--------------------------------------
423C LECTURE DES IGE3D
424C--------------------------------------
425c
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
451 CALL fredec0(id)
452 ids=0
453 DO j=1,npart
454 IF(ipart(4,j) == id)ids=j
455 ENDDO
456 ptabconpatch%PID=ids
457 ELSE
458c ICI ON SAIT DANS QUEL PART IGE ON EST (IDS) NUMGEO MAIS IG3D. ON PEUT DONC POINTER VERS LA BONNE TABCONPATCH_IG3D
459
460 i = i + 1
461 kxig3d(1,i) =ipart(1,ids) ! ON SE FICHE DU 1 (PM)
462 kxig3d(2,i) =ipart(2,ids)
463 maxnumgeo=max(maxnumgeo,ipart(2,ids))
464 kxig3d(4,i) =iad
465 ipartig3d(i)=ids
466C
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 ! ID
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
476 kxig3d(5,i)=id
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
485C
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
502C------
503C inverse connectivity at level 0
504C------
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
522C
523 DO i=1,numnod
524 knod2elig3d(i+1) = knod2elig3d(i+1) + knod2elig3d(i)
525 END DO
526C
527 DO n=numnod,1,-1
528 knod2elig3d(n+1)=knod2elig3d(n)
529 END DO
530 knod2elig3d(1)=0
531c
532C------
533C LE TRAVAIL DE RAFFINEMENT COMMENCE ICI, AVANT C'EST SEULEMENT DE LA LECTURE
534C------
535
536CC ATTENTION AU DIMENSIONNEMENT DES TABLEAUX BASES SUR LES POINTS CAR IL FAUT PRENDRE EN COMPTE LEE NOMBRE DE POINTS EN PLUS
537CC QUI NE RESTERA PAS, PAS SEULEMENT LES POINTS FINAUX
538c
539 sknotlocpc = deg_max*3*(numnodige0+2*addelig3d*nctrlmax)*maxnumgeo ! ON PEUT ENCORE AMELIORER
540 ALLOCATE (knotlocpc(sknotlocpc) ,stat=stat)
541 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='KNOTLOCPC')
542 knotlocpc(:)=0
543C
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
548C
549 addsixig3d = 0
550 nbnewx_final = 0
551 IF(addelig3d>0) THEN
552 CALL prerafig3d(knot,knotlocpc,knotlocel,
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
566C
567C-------------------------------------
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
575C-------------------------------------
576 999 CALL freerr(1)
577 RETURN
578 END
579
580
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:408
meshsurfig3d_mod
Definition meshsurfig3d_mod.F:33
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
submodel_mod
Definition submodel_mod.F:712
nbadigemesh
subroutine nbadigemesh(lsubmodel, numnusr)
Definition nbadigemesh.F:45
prerafig3d
subroutine prerafig3d(knot, knotlocpc, knotlocel, kxig3d, ixig3d, igeo, ipartig3d, x, v, d, ms, wige, tabconpatch, flag_pre)
Definition prerafig3d.F:43
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:889
fredec_key_3id_t
subroutine fredec_key_3id_t(id, uid, vers, titr)
Definition freform.F:1219
fredec_2key_4id_t
subroutine fredec_2key_4id_t(key2, id, uid, vers, sub_id, titr)
Definition freform.F:1110
freerr
subroutine freerr(it)
Definition freform.F:506
fredec0
subroutine fredec0(id)
Definition freform.F:39
starter
program starter
Definition starter.F:39
meshsurfig3d_mod::tabconpatch_ig3d_
Definition meshsurfig3d_mod.F:83
submodel_mod::submodel_data
Definition submodel_mod.F:723