OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
build_admesh.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!|| father ../starter/source/model/remesh/build_admesh.F
25!||--- called by ------------------------------------------------------
26!|| origin ../starter/source/model/remesh/build_admesh.F
27!||--- uses -----------------------------------------------------
28!||====================================================================
29 INTEGER FUNCTION father(NN,IXC,IPARTC,IPART,SONTYPE)
30 use element_mod , only : nixc
31C-----------------------------------------------
32C I m p l i c i t T y p e s
33C-----------------------------------------------
34#include "implicit_f.inc"
35C-----------------------------------------------
36C G l o b a l P a r a m e t e r s
37C-----------------------------------------------
38#include "com04_c.inc"
39#include "scr17_c.inc"
40C-----------------------------------------------
41C D u m m y A r g u m e n t s
42C-----------------------------------------------
43 INTEGER nn,ixc(nixc,*),ipartc(*),ipart(lipart1,*)
44 INTEGER sontype
45C-----------------------------------------------
46C L o c a l V a r i a b l e s
47C-----------------------------------------------
48
49 IF(nn<=numelc0)THEN
50 father=nn
51 sontype=0
52 ELSE
53 father =numelc0+1+5*int(((nn-numelc0)-1)/5)
54 sontype=nn-father
55 END IF
56 RETURN
57 END
58!||====================================================================
59!|| origin ../starter/source/model/remesh/build_admesh.F
60!||--- called by ------------------------------------------------------
61!|| hm_read_frm ../starter/source/tools/skew/hm_read_frm.F
62!|| hm_read_monvol_type6 ../starter/source/airbag/hm_read_monvol_type6.f
63!|| hm_read_monvol_type8 ../starter/source/airbag/hm_read_monvol_type8.F
64!|| hm_read_skw ../starter/source/tools/skew/hm_read_skw.F
65!|| i11remline ../starter/source/interfaces/inter3d1/i11remlin.F
66!|| i25remline ../starter/source/interfaces/int25/i25remlin.F
67!|| th_titles ../starter/source/output/th/th_titles.F90
68!||--- calls -----------------------------------------------------
69!|| father ../starter/source/model/remesh/build_admesh.F
70!||--- uses -----------------------------------------------------
71!||====================================================================
72 INTEGER FUNCTION origin(NN,IXC,IPARTC,IPART)
73 use element_mod , only : nixc
74C-----------------------------------------------
75C I m p l i c i t T y p e s
76C-----------------------------------------------
77#include "implicit_f.inc"
78C-----------------------------------------------
79C G l o b a l P a r a m e t e r s
80C-----------------------------------------------
81#include "com04_c.inc"
82#include "scr17_c.inc"
83C-----------------------------------------------
84C D u m m y A r g u m e n t s
85C-----------------------------------------------
86 INTEGER nn,ixc(nixc,*),ipartc(*),ipart(lipart1,*)
87C-----------------------------------------------
88C L o c a l V a r i a b l e s
89C-----------------------------------------------
90 INTEGER sontype, level
91C-----------------------------------------------
92C E x t e r n a l
93C-----------------------------------------------
94 INTEGER father
95 EXTERNAL father
96C-----------------------------------------------
97 level=0
98 DO WHILE(nn>numelc0)
99 nn=father(nn,ixc,ipartc,ipart,sontype)
100 level=level+1
101 END DO
102
103 origin=nn
104 RETURN
105 END
106!||====================================================================
107!|| identson4 ../starter/source/model/remesh/build_admesh.F
108!||--- called by ------------------------------------------------------
109!|| build_admesh ../starter/source/model/remesh/build_admesh.F
110!||--- calls -----------------------------------------------------
111!||--- uses -----------------------------------------------------
112!||====================================================================
113 RECURSIVE SUBROUTINE identson4(LEVEL,NN,IXC,SH4TREE)
114C-----------------------------------------------
115C M o d u l e s
116C-----------------------------------------------
117 USE user_id_mod , ONLY : id_limit
118 use element_mod , only : nixc
119C-----------------------------------------------
120C I m p l i c i t T y p e s
121C-----------------------------------------------
122#include "implicit_f.inc"
123C-----------------------------------------------
124C G l o b a l P a r a m e t e r s
125C-----------------------------------------------
126#include "scr17_c.inc"
127#include "param_c.inc"
128#include "remesh_c.inc"
129C-----------------------------------------------
130C D u m m y A r g u m e n t s
131C-----------------------------------------------
132 INTEGER level,nn,ixc(nixc,*),sh4tree(ksh4tree,*)
133 INTEGER, SAVE :: id
134C-----------------------------------------------
135C L o c a l V a r i a b l e s
136C-----------------------------------------------
137 INTEGER pp
138 IF(level==0)THEN
139 id=id_limit%ADMESH+(nn-1)*((4**(levelmax+1)-1)/3-1)
140 END IF
141 pp=sh4tree(2,nn)
142 IF(pp/=0) THEN
143
144 id=id+1
145 ixc(nixc,pp)=id
146 id=id+1
147 ixc(nixc,pp+1)=id
148 id=id+1
149 ixc(nixc,pp+2)=id
150 id=id+1
151 ixc(nixc,pp+3)=id
152
153 CALL identson4(level+1,pp,ixc,sh4tree)
154 pp=pp+1
155 CALL identson4(level+1,pp,ixc,sh4tree)
156 pp=pp+1
157 CALL identson4(level+1,pp,ixc,sh4tree)
158 pp=pp+1
159 CALL identson4(level+1,pp,ixc,sh4tree)
160 END IF
161 RETURN
162 END
163!||====================================================================
164!|| identson3 ../starter/source/model/remesh/build_admesh.F
165!||--- called by ------------------------------------------------------
166!|| build_admesh ../starter/source/model/remesh/build_admesh.F
167!||--- calls -----------------------------------------------------
168!||--- uses -----------------------------------------------------
169!||====================================================================
170 RECURSIVE SUBROUTINE identson3(LEVEL,NN,IXTG,SH3TREE)
171C-----------------------------------------------
172C M o d u l e s
173C-----------------------------------------------
174 USE user_id_mod , ONLY : id_limit
175 use element_mod , only : nixtg
176C-----------------------------------------------
177C I m p l i c i t T y p e s
178C-----------------------------------------------
179#include "implicit_f.inc"
180C-----------------------------------------------
181C G l o b a l P a r a m e t e r s
182C-----------------------------------------------
183#include "scr17_c.inc"
184#include "param_c.inc"
185#include "remesh_c.inc"
186C-----------------------------------------------
187C D u m m y A r g u m e n t s
188C-----------------------------------------------
189 INTEGER level,nn,ixtg(nixtg,*),sh3tree(ksh3tree,*)
190 INTEGER, SAVE :: id
191C-----------------------------------------------
192C L o c a l V a r i a b l e s
193C-----------------------------------------------
194 INTEGER pp
195 IF(level==0)THEN
196 id=id_limit%ADMESH+(nn-1)*((4**(levelmax+1)-1)/3-1)
197 END IF
198 pp=sh3tree(2,nn)
199 IF(pp/=0) THEN
200
201 id=id+1
202 ixtg(nixtg,pp)=id
203 id=id+1
204 ixtg(nixtg,pp+1)=id
205 id=id+1
206 ixtg(nixtg,pp+2)=id
207 id=id+1
208 ixtg(nixtg,pp+3)=id
209
210 CALL identson3(level+1,pp,ixtg,sh3tree)
211 pp=pp+1
212 CALL identson3(level+1,pp,ixtg,sh3tree)
213 pp=pp+1
214 CALL identson3(level+1,pp,ixtg,sh3tree)
215 pp=pp+1
216 CALL identson3(level+1,pp,ixtg,sh3tree)
217 END IF
218
219 RETURN
220 END
221!||====================================================================
222!|| build_admesh ../starter/source/model/remesh/build_admesh.F
223!||--- called by ------------------------------------------------------
224!|| lectur ../starter/source/starter/lectur.F
225!||--- calls -----------------------------------------------------
226!|| ancmsg ../starter/source/output/message/message.F
227!|| constit ../starter/source/elements/nodes/constit.f
228!|| identson3 ../starter/source/model/remesh/build_admesh.F
229!|| identson4 ../starter/source/model/remesh/build_admesh.F
230!||--- uses -----------------------------------------------------
231!|| message_mod ../starter/share/message_module/message_mod.F
232!||====================================================================
233 SUBROUTINE build_admesh(
234 . IPART ,IPARTC,IPARTTG,IXC ,IXTG ,
235 . X ,ITAB ,ITABM1 ,SH4TREE,SH3TREE,
236 . IPADMESH,PADMESH)
237C-----------------------------------------------
238C M o d u l e s
239C-----------------------------------------------
240 USE message_mod
241 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
242 use element_mod , only : nixc,nixtg
243C-----------------------------------------------
244C I m p l i c i t T y p e s
245C-----------------------------------------------
246#include "implicit_f.inc"
247C-----------------------------------------------
248C C o m m o n B l o c k s
249C-----------------------------------------------
250#include "param_c.inc"
251#include "com04_c.inc"
252#include "scr17_c.inc"
253#include "remesh_c.inc"
254C-----------------------------------------------
255C D u m m y A r g u m e n t s
256C-----------------------------------------------
257 INTEGER IPART(LIPART1,*), IPARTC(*), IPARTTG(*),
258 . IXC(NIXC,*), IXTG(NIXTG,*),ITAB(*),ITABM1(*),
259 . SH4TREE(KSH4TREE,*), SH3TREE(KSH3TREE,*),
260 . ipadmesh(kipadmesh,*)
261 my_real x(3,*), padmesh(kpadmesh,*)
262C-----------------------------------------------
263C L o c a l V a r i a b l e s
264C-----------------------------------------------
265 INTEGER ID,NP,J10(10),
266 . N,IP,I,J,NLEV,NI,NJ,NK,NL,NN,
267 . K,L,P,Q,QQ,STAT,
268 . level,numelc_lev,numeltg_lev,
269 . numelc_old,numeltg_old,
270 . numelc_old_old,numeltg_old_old,
271 . numelc_new,numeltg_new,numnod_new,
272 . inilev
273 INTEGER, DIMENSION(:),ALLOCATABLE ::
274 . KNOD2SH, NOD2SH
275 INTEGER, DIMENSION(:,:),ALLOCATABLE :: TAG
276 my_real
277 . angl,xa,xb
278 CHARACTER MESS*40
279 CHARACTER(LEN=NCHARTITLE) :: TITR
280 CHARACTER(LEN=NCHARKEY) :: KEY
281C-----------------------------------------------
282 DATA mess /'OPTIONS FOR ADAPTIVE MESHING DEFINITION '/
283C-----------------------------------------------
284 IF(iadmstat /= 0)RETURN
285C------
286
287 numnod_new =numnod0
288 numelc_old =0
289 numelc_new =numelc0
290 numeltg_old=0
291 numeltg_new=numeltg0
292
293 DO 100 level=1,levelmax
294 numelc_old_old=numelc_old
295 numelc_old =numelc_new
296 numeltg_old_old=numeltg_old
297 numeltg_old =numeltg_new
298
299 numelc_lev =numelc_old-numelc_old_old
300 numeltg_lev=numeltg_old-numeltg_old_old
301C
302C Reverse connectivity at the previous level
303C
304 ALLOCATE(knod2sh(0:numnod_new),stat=stat)
305 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
306 . msgtype=msgerror,
307 . c1='KNOD2SH')
308C
309 knod2sh=0
310 DO n=numelc_old_old+1,numelc_old
311 DO i=1,4
312 ni=ixc(i+1,n)
313 knod2sh(ni)=knod2sh(ni)+1
314 END DO
315 END DO
316C
317 DO n=numeltg_old_old+1,numeltg_old
318 DO i=1,3
319 ni=ixtg(i+1,n)
320 knod2sh(ni)=knod2sh(ni)+1
321 END DO
322 END DO
323C
324 DO n=2,numnod_new
325 knod2sh(n)=knod2sh(n)+knod2sh(n-1)
326 END DO
327C
328 ALLOCATE(nod2sh(4*numelc_lev+3*numeltg_lev),stat=stat)
329 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
330 . msgtype=msgerror,
331 . c1='NOD2SH')
332C
333 DO n=1,numelc_lev
334 nn=numelc_old_old+n
335 DO i=1,4
336 ni=ixc(i+1,nn)-1
337 knod2sh(ni)=knod2sh(ni)+1
338 nod2sh(knod2sh(ni))=n
339 END DO
340 END DO
341C
342 DO n=1,numeltg_lev
343 nn=numeltg_old_old+n
344 DO i=1,3
345 ni=ixtg(i+1,nn)-1
346 knod2sh(ni)=knod2sh(ni)+1
347 nod2sh(knod2sh(ni))=numelc_lev+n
348 END DO
349 END DO
350C
351 DO n=numnod_new,1,-1
352 knod2sh(n)=knod2sh(n-1)
353 END DO
354 knod2sh(0)=0
355C
356C allocation tag
357 ALLOCATE(tag(5,numelc_lev+numeltg_lev),stat=stat)
358 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
359 . msgtype=msgerror,
360 . c1='TAG')
361 tag=0
362C
363 DO n=1,numelc_lev
364 nn=numelc_old_old+n
365 ip =ipartc(nn)
366 nlev=ipart(10,ip)
367 IF(nlev<level) cycle
368 DO i=1,4
369 IF(tag(i,n)==0)THEN
370 ni=ixc(i+1,nn)
371 nj=ixc(mod(i,4)+2,nn)
372
373 numnod_new=numnod_new+1
374 tag(i,n)=numnod_new
375 DO j=1,3
376 x(j,numnod_new)=half*(x(j,ni)+x(j,nj))
377 END DO
378 DO k=knod2sh(ni-1)+1,knod2sh(ni)
379 p=nod2sh(k)
380 IF(p/=n)THEN
381 DO l=knod2sh(nj-1)+1,knod2sh(nj)
382 q=nod2sh(l)
383 IF(q==p)THEN
384 IF(q<=numelc_lev)THEN
385 qq=numelc_old_old+q
386 DO j=1,4
387 nk=ixc(j+1,qq)
388 nl=ixc(mod(j,4)+2,qq)
389
390 IF((nk==ni.AND.nl==nj).OR.
391 . (nl==ni.AND.nk==nj))THEN
392 tag(j,q)=numnod_new
393 END IF
394 END DO
395 ELSE
396 qq=numeltg_old_old+q-numelc_lev
397 DO j=1,3
398 nk=ixtg(j+1,qq)
399 nl=ixtg(mod(j,3)+2,qq)
400
401 IF((nk==ni.AND.nl==nj).OR.
402 . (nl==ni.AND.nk==nj))THEN
403 tag(j,q)=numnod_new
404 END IF
405 END DO
406 END IF
407 END IF
408 END DO
409 END IF
410 END DO
411 END IF
412 END DO
413 END DO
414C
415 DO n=1,numelc_lev
416 nn=numelc_old_old+n
417 ip =ipartc(nn)
418 nlev=ipart(10,ip)
419 IF(nlev<level) cycle
420 numnod_new=numnod_new+1
421 tag(5,n)=numnod_new
422 ni=tag(1,n)
423 nj=tag(3,n)
424 nk=tag(2,n)
425 nl=tag(4,n)
426 DO j=1,3
427 xa=half*(x(j,ni)+x(j,nj))
428 xb=half*(x(j,nk)+x(j,nl))
429 x(j,numnod_new)=half*(xa+xb)
430 END DO
431 END DO
432C
433 DO n=1,numeltg_lev
434 nn=numeltg_old_old+n
435 ip =iparttg(nn)
436 nlev=ipart(10,ip)
437 IF(nlev<level) cycle
438 DO i=1,3
439 IF(tag(i,n+numelc_lev)==0)THEN
440 ni=ixtg(i+1,nn)
441 nj=ixtg(mod(i,3)+2,nn)
442
443 numnod_new=numnod_new+1
444 tag(i,n+numelc_lev)=numnod_new
445 DO j=1,3
446 x(j,numnod_new)=half*(x(j,ni)+x(j,nj))
447 END DO
448 DO k=knod2sh(ni-1)+1,knod2sh(ni)
449 p=nod2sh(k)
450 IF(p/=n+numelc)THEN
451 DO l=knod2sh(nj-1)+1,knod2sh(nj)
452 q=nod2sh(l)
453 IF(q==p)THEN
454 IF(q<=numelc_lev)THEN
455 qq=numelc_old_old+q
456 DO j=1,4
457 nk=ixc(j+1,qq)
458 nl=ixc(mod(j,4)+2,qq)
459
460 IF((nk==ni.AND.nl==nj).OR.
461 . (nl==ni.AND.nk==nj))THEN
462 tag(j,q)=numnod_new
463 END IF
464 END DO
465 ELSE
466 qq=numeltg_old_old+q-numelc_lev
467 DO j=1,3
468 nk=ixtg(j+1,qq)
469 nl=ixtg(mod(j,3)+2,qq)
470
471 IF((nk==ni.AND.nl==nj).OR.
472 . (nl==ni.AND.nk==nj))THEN
473 tag(j,q)=numnod_new
474 END IF
475 END DO
476 END IF
477 END IF
478 END DO
479 END IF
480 END DO
481 END IF
482 END DO
483 END DO
484C
485 numelc_new=numelc_old
486 DO n=1,numelc_lev
487 nn=numelc_old_old+n
488 ip =ipartc(nn)
489 nlev=ipart(10,ip)
490 IF(nlev<level) cycle
491
492 DO j=1,nixc
493 DO i=1,4
494 ixc(j,numelc_new+i)=ixc(j,nn)
495 END DO
496 END DO
497
498 numelc_new=numelc_new+1
499 ixc(2,numelc_new)=ixc(2,nn)
500 ixc(3,numelc_new)=tag(1,n)
501 ixc(4,numelc_new)=tag(5,n)
502 ixc(5,numelc_new)=tag(4,n)
503 ipartc(numelc_new)=ip
504
505 sh4tree(1,numelc_new)=nn
506 sh4tree(2,nn)=numelc_new
507C
508C SH4TREE(3,NN) = LEVEL SI ACTIVE
509C = -(LEVEL+1) SINON
510 sh4tree(3,numelc_new)=-(level+1)
511
512 numelc_new=numelc_new+1
513 ixc(2,numelc_new)=tag(1,n)
514 ixc(3,numelc_new)=ixc(3,nn)
515 ixc(4,numelc_new)=tag(2,n)
516 ixc(5,numelc_new)=tag(5,n)
517 ipartc(numelc_new)=ip
518
519 sh4tree(1,numelc_new)=nn
520 sh4tree(3,numelc_new)=-(level+1)
521
522 numelc_new=numelc_new+1
523 ixc(2,numelc_new)=tag(5,n)
524 ixc(3,numelc_new)=tag(2,n)
525 ixc(4,numelc_new)=ixc(4,nn)
526 ixc(5,numelc_new)=tag(3,n)
527 ipartc(numelc_new)=ip
528
529 sh4tree(1,numelc_new)=nn
530 sh4tree(3,numelc_new)=-(level+1)
531
532 numelc_new=numelc_new+1
533 ixc(2,numelc_new)=tag(4,n)
534 ixc(3,numelc_new)=tag(5,n)
535 ixc(4,numelc_new)=tag(3,n)
536 ixc(5,numelc_new)=ixc(5,nn)
537 ipartc(numelc_new)=ip
538
539 sh4tree(1,numelc_new)=nn
540 sh4tree(3,numelc_new)=-(level+1)
541 END DO
542C
543 numeltg_new=numeltg_old
544 DO n=1,numeltg_lev
545 nn=numeltg_old_old+n
546 ip =iparttg(nn)
547 nlev=ipart(10,ip)
548 IF(nlev<level) cycle
549
550 DO j=1,nixtg
551 DO i=1,4
552 ixtg(j,numeltg_new+i)=ixtg(j,nn)
553 END DO
554 END DO
555
556 numeltg_new=numeltg_new+1
557 ixtg(2,numeltg_new)= ixtg(2,nn)
558 ixtg(3,numeltg_new)= tag(1,n+numelc_lev)
559 ixtg(4,numeltg_new)= tag(3,n+numelc_lev)
560 iparttg(numeltg_new)=ip
561
562 sh3tree(1,numeltg_new)=nn
563 sh3tree(2,nn)=numeltg_new
564 sh3tree(3,numeltg_new)=-(level+1)
565
566 numeltg_new=numeltg_new+1
567 ixtg(2,numeltg_new)= tag(1,n+numelc_lev)
568 ixtg(3,numeltg_new)= ixtg(3,nn)
569 ixtg(4,numeltg_new)= tag(2,n+numelc_lev)
570 iparttg(numeltg_new)=ip
571
572 sh3tree(1,numeltg_new)=nn
573 sh3tree(3,numeltg_new)=-(level+1)
574
575 numeltg_new=numeltg_new+1
576 ixtg(2,numeltg_new)= tag(3,n+numelc_lev)
577 ixtg(3,numeltg_new)= tag(2,n+numelc_lev)
578 ixtg(4,numeltg_new)= ixtg(4,nn)
579 iparttg(numeltg_new)=ip
580
581 sh3tree(1,numeltg_new)=nn
582 sh3tree(3,numeltg_new)=-(level+1)
583
584 numeltg_new=numeltg_new+1
585 ixtg(2,numeltg_new)= tag(2,n+numelc_lev)
586 ixtg(3,numeltg_new)= tag(3,n+numelc_lev)
587 ixtg(4,numeltg_new)= tag(1,n+numelc_lev)
588 iparttg(numeltg_new)=ip
589
590 sh3tree(1,numeltg_new)=nn
591 sh3tree(3,numeltg_new)=-(level+1)
592 END DO
593
594C next level
595 DEALLOCATE(tag)
596 DEALLOCATE(nod2sh)
597 DEALLOCATE(knod2sh)
598 100 CONTINUE
599
600C
601C identifiers of created shells and 3-node shells
602 DO n=1,numelc0
603 CALL identson4(0,n,ixc,sh4tree)
604 END DO
605
606 DO n=1,numeltg0
607 CALL identson3(0,n,ixtg,sh3tree)
608 END DO
609C inverse connectivity at level 0
610C
611C ALLOCATE(KNOD2SH(0:NUMNOD0+1),STAT=stat)
612C IF (STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,MSGTYPE=MSGERROR)
613C
614C KNOD2SH=0
615C DO N=1,NUMELC0
616C DO I=1,4
617C NI=IXC(I+1,N)
618C KNOD2SH(NI)=KNOD2SH(NI)+1
619C END DO
620C END DO
621C
622C DO N=1,NUMELTG0
623C DO I=1,3
624C NI=IXTG(I+1,N)
625C KNOD2SH(NI)=KNOD2SH(NI)+1
626C END DO
627C END DO
628C
629C DO N=2,NUMNOD0
630C KNOD2SH(N)=KNOD2SH(N)+KNOD2SH(N-1)
631C END DO
632C
633C ALLOCATE(NOD2SH(4*NUMELC0+3*NUMELTG0),STAT=stat)
634C IF (STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,MSGTYPE=MSGERROR)
635C
636C DO N=1,NUMELC0
637C DO I=1,4
638C NI=IXC(I+1,N)-1
639C KNOD2SH(NI)=KNOD2SH(NI)+1
640C NOD2SH(KNOD2SH(NI))=N
641C END DO
642C END DO
643C
644C DO N=1,NUMELTG0
645C DO I=1,3
646C NI=IXTG(I+1,N)-1
647C KNOD2SH(NI)=KNOD2SH(NI)+1
648C NOD2SH(KNOD2SH(NI))=NUMELC0+N
649C END DO
650C END DO
651C
652C DO N=NUMNOD0,1,-1
653C KNOD2SH(N)=KNOD2SH(N-1)
654C END DO
655C KNOD2SH(0)=0
656C
657C DO N=1,NUMELC0
658C IP =IPARTC(N)
659C NLEV=IPART(10,IP)
660C IF(NLEV==0) CYCLE
661C DO I=1,4
662C NI=IXC(I+1,N)
663C NJ=IXC(MOD(I,4)+2,N)
664C
665C DO K=KNOD2SH(NI-1)+1,KNOD2SH(NI)
666C P=NOD2SH(K)
667C IF(P/=N)THEN
668C DO L=KNOD2SH(NJ-1)+1,KNOD2SH(NJ)
669C Q=NOD2SH(L)
670C IF(Q==P)THEN
671C IF(SH4NEIGHB(I,N)/=0)THEN
672C CALL ANSTCKI(IXC(NIXC,N))
673C CALL ANSTCKI(IPART(1,IP))
674C CALL ANCERR(640,ANINFO_BLIND_1)
675C ELSE
676C SH4NEIGHB(I,N)=Q
677C END IF
678C END IF
679C END DO
680C END IF
681C END DO
682C END DO
683C END DO
684C
685C DO N=1,NUMELTG0
686C IP =IPARTTG(N)
687C NLEV=IPART(10,IP)
688C IF(NLEV==0) CYCLE
689C DO I=1,3
690C NI=IXTG(I+1,N)
691C NJ=IXTG(MOD(I,3)+2,N)
692C
693C DO K=KNOD2SH(NI-1)+1,KNOD2SH(NI)
694C P=NOD2SH(K)
695C IF(P/=N)THEN
696C DO L=KNOD2SH(NJ-1)+1,KNOD2SH(NJ)
697C Q=NOD2SH(L)
698C IF(Q==P)THEN
699C IF(SH3NEIGHB(I,N)/=0)THEN
700C CALL ANSTCKI(IXTG(NIXTG,N))
701C CALL ANSTCKI(IPART(1,IP))
702C CALL ANCERR(641,ANINFO_BLIND_1)
703C ELSE
704C SH3NEIGHB(I,N)=Q
705C END IF
706C END IF
707C END DO
708C END IF
709C END DO
710C END DO
711C END DO
712C-------------------------------------
713 numnod=numnod_new
714C--------------------------------------------------
715C rebuilding the inverse node table
716 CALL constit(itab,itabm1,numnod)
717 RETURN
718C-------------------------------------
719 END
build_admesh
subroutine build_admesh(ipart, ipartc, iparttg, ixc, ixtg, x, itab, itabm1, sh4tree, sh3tree, ipadmesh, padmesh)
Definition build_admesh.F:237
father
integer function father(nn, ixc, ipartc, ipart, sontype)
Definition build_admesh.F:30
identson4
recursive subroutine identson4(level, nn, ixc, sh4tree)
Definition build_admesh.F:114
origin
integer function origin(nn, ixc, ipartc, ipart)
Definition build_admesh.F:73
identson3
recursive subroutine identson3(level, nn, ixtg, sh3tree)
Definition build_admesh.F:171
constit
subroutine constit(itab, itabm1, numnod)
Definition constit.F:35
my_real
#define my_real
Definition cppsort.cpp:32
id
initmumps id
Definition multiplerhs_example.m:4
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
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
starter
program starter
Definition starter.F:39