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