--- /dev/null
+ subroutine utb11a ( hetare, somare,
+ > hettri, aretri,
+ > voltri, pypetr,
+ > hetqua, arequa,
+ > volqua, pypequ,
+ > hettet, tritet,
+ > hethex, quahex,
+ > hetpyr, facpyr,
+ > hetpen, facpen,
+ > povoso, voisom,
+ > posifa, facare,
+ > famare, cfaare,
+ > famtri, cfatri,
+ > famqua, cfaqua,
+ > famtet, cfatet,
+ > famhex, cfahex,
+ > fampyr, cfapyr,
+ > fampen, cfapen,
+ > tabau1, tabau2, tabau3, tabau4,
+ > taba11, taba12, taba13, taba14,
+ > taba15, taba16,
+ > nublen,
+ > ulbila,
+ > ulsort, langue, codret )
+c ______________________________________________________________________
+c
+c H O M A R D
+c
+c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
+c
+c Version originale enregistree le 18 juin 1996 sous le numero 96036
+c aupres des huissiers de justice Simart et Lavoir a Clamart
+c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
+c aupres des huissiers de justice
+c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
+c
+c HOMARD est une marque deposee d'Electricite de France
+c
+c Copyright EDF 1996
+c Copyright EDF 1998
+c Copyright EDF 2002
+c Copyright EDF 2020
+c ______________________________________________________________________
+c
+c UTilitaire - Bilan sur le maillage - option 11
+c -- - --
+c ______________________________________________________________________
+c
+c analyse de la connexite du maillage de calcul
+c remarque : pour du raffinement non-conforme, chaque niveau est
+c un bloc
+c ______________________________________________________________________
+c . . . . .
+c . nom . e/s . taille . description .
+c .____________________________________________________________________.
+c . hetare . e . nbarto . historique de l'etat des aretes .
+c . somare . e .2*nbarto. numeros des extremites d'arete .
+c . hettri . e . nbtrto . historique de l'etat des triangles .
+c . aretri . e .nbtrto*3. numeros des 3 aretes des triangles .
+c . voltri . e .2*nbtrto. numeros des 2 volumes par triangle .
+c . . . . voltri(i,k) definit le i-eme voisin de k .
+c . . . . 0 : pas de voisin .
+c . . . . j>0 : tetraedre j .
+c . . . . j<0 : pyramide/pentaedre dans pypetr(1/2,j).
+c . pypetr . e .2*lgpype. pypetr(1,j) = numero de la pyramide voisine.
+c . . . . du triangle k tel que voltri(1/2,k) = -j .
+c . . . . pypetr(2,j) = numero du pentaedre voisin .
+c . . . . du triangle k tel que voltri(1/2,k) = -j .
+c . hetqua . e . nbquto . historique de l'etat des quadrangles .
+c . arequa . e .nbquto*4. numeros des 4 aretes des quadrangles .
+c . volqua . e .2*nbquto. numeros des 2 volumes par quadrangle .
+c . . . . volqua(i,k) definit le i-eme voisin de k .
+c . . . . 0 : pas de voisin .
+c . . . . j>0 : hexaedre j .
+c . . . . j<0 : pyramide/pentaedre dans pypequ(1/2,j).
+c . pypequ . e .2*lgpype. pypequ(1,j) = numero de la pyramide voisine.
+c . . . . du quadrangle k tel que volqua(1/2,k) = -j .
+c . . . . pypequ(2,j) = numero du pentaedre voisin .
+c . . . . du quadrangle k tel que volqua(1/2,k) = -j .
+c . hettet . e . nbteto . historique de l'etat des tetraedres .
+c . tritet . e .nbtecf*4. numeros des 4 triangles des tetraedres .
+c . hethex . e . nbheto . historique de l'etat des hexaedres .
+c . quahex . e .nbhecf*6. numeros des 6 quadrangles des hexaedres .
+c . hetpyr . e . nbpyto . historique de l'etat des pyramides .
+c . facpyr . e .nbpycf*5. numeros des 5 faces des pyramides .
+c . hetpen . e . nbpeto . historique de l'etat des pentaedres .
+c . facpen . e .nbpecf*5. numeros des 5 faces des pentaedres .
+c . povoso . e .0:nbnoto. pointeur des voisins par noeud .
+c . voisom . e . nvosom . aretes voisines de chaque noeud .
+c . posifa . e .0:nbarto. pointeur sur tableau facare .
+c . facare . e . nbfaar . liste des faces contenant une arete .
+c . famare . e . nbarto . famille des aretes .
+c . cfaare . e . nctfar*. codes des familles des aretes .
+c . . . nbfare . 1 : famille MED .
+c . . . . 2 : type de segment .
+c . . . . 3 : orientation .
+c . . . . 4 : famille d'orientation inverse .
+c . . . . 5 : numero de ligne de frontiere .
+c . . . . > 0 si concernee par le suivi de frontiere.
+c . . . . <= 0 si non concernee .
+c . . . . 6 : famille frontiere active/inactive .
+c . . . . 7 : numero de surface de frontiere .
+c . . . . + l : appartenance a l'equivalence l .
+c . famtri . e . nbtrto . famille des triangles .
+c . cfatri . e . nctftr*. codes des familles des triangles .
+c . . . nbftri . 1 : famille MED .
+c . . . . 2 : type de triangle .
+c . . . . 3 : numero de surface de frontiere .
+c . . . . 4 : famille des aretes internes apres raf.
+c . . . . + l : appartenance a l'equivalence l .
+c . famqua . e . nbquto . famille des quadrangles .
+c . cfaqua . e . nctfqu*. codes des familles des quadrangles .
+c . . . nbfqua . 1 : famille MED .
+c . . . . 2 : type de quadrangle .
+c . . . . 3 : numero de surface de frontiere .
+c . . . . 4 : famille des aretes internes apres raf.
+c . . . . 5 : famille des triangles de conformite .
+c . . . . 6 : famille de sf active/inactive .
+c . . . . + l : appartenance a l'equivalence l .
+c . famtet . e . nbteto . famille des tetraedres .
+c . cfatet . . nctfte*. codes des familles des tetraedres .
+c . . . nbftet . 1 : famille MED .
+c . . . . 2 : type de tetraedres .
+c . famhex . e . nbheto . famille des hexaedres .
+c . cfahex . . nctfhe*. codes des familles des hexaedres .
+c . . . nbfhex . 1 : famille MED .
+c . . . . 2 : type d'hexaedres .
+c . . . . 3 : famille des tetraedres de conformite .
+c . . . . 4 : famille des pyramides de conformite .
+c . fampyr . e . nbpyto . famille des pyramides .
+c . cfapyr . . nctfpy*. codes des familles des pyramides .
+c . . . nbfpyr . 1 : famille MED .
+c . . . . 2 : type de pyramides .
+c . fampen . e . nbpeto . famille des pentaedres .
+c . cfapen . . nctfpe*. codes des familles des pentaedres .
+c . . . nbfpen . 1 : famille MED .
+c . . . . 2 : type de pentaedres .
+c . . . . 3 : famille des tetraedres de conformite .
+c . . . . 4 : famille des pyramides de conformite .
+c . tabau1 . a . * . tableau de travail .
+c . tabau2 . a . * . tableau de travail .
+c . tabau3 . a . * . tableau de travail .
+c . tabau4 . a .-nbquto . tableau de travail .
+c . . . :nbtrto. .
+c . taba11 . a . * . tableau de travail .
+c . taba12 . a . nbnoto . tableau de travail .
+c . taba13 . a . nbarto . tableau de travail .
+c . taba14 . a . * . tableau de travail .
+c . taba15 . a . nbarto . tableau de travail .
+c . taba16 . a . * . tableau de travail .
+c . nublen . s . * . numero de blocs par entite .
+c . ulbila . e . 1 . unite logique d'ecriture du bilan .
+c . ulsort . e . 1 . unite logique de la sortie generale .
+c . langue . e . 1 . langue des messages .
+c . . . . 1 : francais, 2 : anglais .
+c . codret . s . 1 . code de retour des modules .
+c . . . . 0 : pas de probleme .
+c . . . . 1 : probleme .
+c .____________________________________________________________________.
+c
+c====
+c 0. declarations et dimensionnement
+c====
+c
+c 0.1. ==> generalites
+c
+ implicit none
+ save
+c
+ character*6 nompro
+ parameter ( nompro = 'UTB11A' )
+c
+#include "nblang.h"
+c
+c 0.2. ==> communs
+c
+#include "envex1.h"
+c
+#include "nbfami.h"
+#include "nombno.h"
+#include "nombar.h"
+#include "nombtr.h"
+#include "nombqu.h"
+#include "nombte.h"
+#include "nombhe.h"
+#include "nombpy.h"
+#include "nombpe.h"
+c
+#include "dicfen.h"
+#include "impr02.h"
+c
+c 0.3. ==> arguments
+c
+ integer hetare(nbarto), somare(2,nbarto)
+ integer hettri(nbtrto), aretri(nbtrto,3)
+ integer voltri(2,nbtrto), pypetr(2,*)
+ integer hetqua(nbquto), arequa(nbquto,4)
+ integer volqua(2,nbquto), pypequ(2,*)
+ integer hettet(nbteto), tritet(nbtecf,4)
+ integer hethex(nbheto), quahex(nbhecf,6)
+ integer hetpyr(nbpyto), facpyr(nbpycf,5)
+ integer hetpen(nbpeto), facpen(nbpecf,5)
+ integer povoso(0:nbnoto), voisom(*)
+ integer posifa(0:nbarto), facare(nbfaar)
+c
+ integer famare(nbarto), cfaare(nctfar,nbfare)
+ integer famtri(nbtrto), cfatri(nctftr,nbftri)
+ integer famqua(nbquto), cfaqua(nctfqu,nbfqua)
+ integer famtet(nbteto), cfatet(nctfte,nbftet)
+ integer famhex(nbheto), cfahex(nctfhe,nbfhex)
+ integer fampyr(nbpyto), cfapyr(nctfpy,nbfpyr)
+ integer fampen(nbpeto), cfapen(nctfpe,nbfpen)
+c
+ integer tabau1(*)
+ integer tabau2(nbnoto)
+ integer tabau3(nbarto)
+ integer tabau4(-nbquto:*)
+ integer taba11(*)
+ integer taba12(nbnoto)
+ integer taba13(nbarto)
+ integer taba14(*)
+ integer taba15(nbarto)
+ integer taba16(*)
+ integer nublen(-nbquto:*)
+c
+ integer ulbila
+ integer ulsort, langue, codret
+c
+c 0.4. ==> variables locales
+c
+ integer iaux
+ integer nbblar, nbblfa, nbblvo
+c
+ integer nbmess
+ parameter (nbmess = 10 )
+ character*80 texte(nblang,nbmess)
+c
+c 0.5. ==> initialisations
+c ______________________________________________________________________
+c
+c====
+c 1. messages
+c====
+c
+#include "impr01.h"
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,1)) 'Entree', nompro
+ call dmflsh (iaux)
+#endif
+c
+ texte(1,4) =
+ > '(//,3x,''CONNEXITE DES ENTITES DU CALCUL'',/,3x,31(''=''),/)'
+ texte(1,5) =
+ >'(5x,''*'',19x,''Blocs de '',a,14x,''*'')'
+c
+ texte(2,4) =
+ > '(//,3x,''CONNEXITY OF CALCULATION ENTITIES'',/,3x,33(''=''),/)'
+ texte(2,5) =
+ >'(5x,''*'',19x,''Blocks of '',a,13x,''*'')'
+c
+ write (ulbila,texte(langue,4))
+c
+#ifdef _DEBUG_HOMARD_
+10001 format(4x,60('-'))
+#endif
+c
+#include "impr03.h"
+c
+ codret = 0
+c
+c====
+c 2. blocs de volumes
+c Remarque : impossible si des volumes sont decrits par leurs aretes
+c====
+c
+ if ( codret.eq.0 ) then
+c
+ if ( nbteca.eq.0 .and. nbheca.eq.0 .and.
+ > nbpyca.eq.0 .and. nbpeca.eq.0 ) then
+c
+c
+ if ( nbteac.gt.0 .or. nbheac.gt.0 .or.
+ > nbpyac.gt.0 .or. nbpeac.gt.0 ) then
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,3)) 'UTB11B', nompro
+#endif
+ call utb11b ( nbblvo,
+ > hetare, somare,
+ > hettri, aretri,
+ > hetqua, arequa,
+ > hettet, tritet,
+ > hethex, quahex,
+ > hetpyr, facpyr,
+ > hetpen, facpen,
+ > povoso, voisom,
+ > posifa, facare,
+ > voltri, pypetr,
+ > volqua, pypequ,
+ > famare, cfaare,
+ > famtri, cfatri,
+ > famqua, cfaqua,
+ > famtet, cfatet,
+ > famhex, cfahex,
+ > fampyr, cfapyr,
+ > fampen, cfapen,
+ > tabau1, tabau2, tabau3, tabau4,
+ > taba11, taba12, taba13, taba14,
+ > taba15, taba16,
+ > nublen,
+ > ulbila,
+ > ulsort, langue, codret )
+c
+#ifdef _DEBUG_HOMARD_
+ write(ulsort,90002) 'Fin etape 2 avec codret', codret
+ write(ulsort,texte(langue,5)) mess14(langue,3,3)
+ write(ulsort,91040) (iaux,
+ > iaux=1,min(20,nbteto+nbheto+nbpyto-nbquto))
+ write(ulsort,10001)
+ write(ulsort,91040) (nublen(iaux),
+ > iaux=-nbquto,nbteto+nbheto+nbpyto-nbquto-1)
+#endif
+c
+ endif
+c
+ endif
+c
+ endif
+c
+c====
+c 3. blocs de faces
+c====
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,90002) '3. bloc de faces ; codret', codret
+#endif
+c
+ if ( codret.eq.0 ) then
+c
+ if ( nbtrac.gt.0 .or. nbquac.gt.0 ) then
+c
+c on examine toutes les faces actives du calcul
+c
+ do 31 , iaux = -nbquto, nbtrto
+ tabau4(iaux) = 1
+ 31 continue
+ tabau4(0) = 0
+ iaux = 2
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,3)) 'UTB11C', nompro
+#endif
+ call utb11c ( nbblfa, iaux, tabau4,
+ > hetare, somare,
+ > hettri, aretri,
+ > hetqua, arequa,
+ > povoso, voisom,
+ > posifa, facare,
+ > famare, cfaare,
+ > famtri, cfatri,
+ > famqua, cfaqua,
+ > tabau1, tabau2, tabau3,
+ > taba15, taba16,
+ > nublen,
+ > ulbila,
+ > ulsort, langue, codret )
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,90002) 'Fin etape 3 avec codret', codret
+ if ( nbtrac.gt.0 ) then
+ write(ulsort,texte(langue,5)) mess14(langue,3,2)
+ write(ulsort,91040) (iaux,iaux=1,min(20,nbtrto))
+ write(ulsort,10001)
+ write(ulsort,91040)
+ >(nublen(iaux),iaux=-nbquto+1,-nbquto+min(100,nbtrto))
+ endif
+ if ( nbquac.gt.0 ) then
+ write(ulsort,texte(langue,5)) mess14(langue,3,4)
+ write(ulsort,91040) (iaux,iaux=1,min(20,nbquto))
+ write(ulsort,10001)
+ write(ulsort,91040)
+ >(nublen(iaux),iaux=-nbquto,-nbquto+min(100,nbquto)-1)
+ endif
+#endif
+c
+ endif
+c
+ endif
+c
+c====
+c 4. blocs d'aretes
+c====
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,90002) '4. bloc d aretes ; codret', codret
+#endif
+c
+ if ( codret.eq.0 ) then
+c
+c on examine toutes les aretes actives du calcul
+c
+ do 41 , iaux = 1, nbarto
+ tabau3(iaux) = 1
+ 41 continue
+ iaux = 2
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,3)) 'UTB11D', nompro
+#endif
+ call utb11d ( nbblar, iaux, tabau3,
+ > hetare, somare,
+ > povoso, voisom,
+ > famare, cfaare,
+ > tabau1, tabau2,
+ > nublen,
+ > ulbila,
+ > ulsort, langue, codret )
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,90002) 'Fin etape 4 avec codret', codret
+ write(ulsort,texte(langue,5)) mess14(langue,3,1)
+ write(ulsort,91040) (iaux,iaux=1,min(20,nbarto))
+ write(ulsort,10001)
+ write(ulsort,91040)
+ >(nublen(iaux),iaux=-nbquto,-nbquto+min(100,nbarto)-1)
+#endif
+c
+ endif
+c
+c====
+c 5. la fin
+c====
+c
+ if ( codret.ne.0 ) then
+c
+#include "envex2.h"
+c
+ write (ulsort,texte(langue,1)) 'Sortie', nompro
+ write (ulsort,texte(langue,2)) codret
+c
+ endif
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,1)) 'Sortie', nompro
+ call dmflsh (iaux)
+#endif
+c
+ end
