--- /dev/null
+ subroutine vcmnc2 ( nbanci, nbgemx,
+ > arreca, arrecb, noerec,
+ > nohman, nhvois,
+ > coonoe, hetnoe, arenoe,
+ > coexno, nnosho, nnosca,
+ > noempo,
+ > somare, hetare, np2are,
+ > merare, filare, insoar,
+ > coexar, narsho, narsca,
+ > aretri, arequa,
+ > ppovos, pvoiso,
+ > pposif, pfacar,
+ > ngenar, ngenno, nouent, tabaux, tbdaux,
+ > 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 aVant adaptation - Conversion de Maillage - Non Conformite - 2
+c - - - - - -
+c Renumerotations des noeuds
+c ______________________________________________________________________
+c . . . . .
+c . nom . e/s . taille . description .
+c .____________________________________________________________________.
+c . nbanci . e . 1 . nombre d'aretes de non conformite initiale .
+c . . . . egal au nombre d'aretes recouvrant 2 autres.
+c . nbgemx . e . 1 . nombre maximal de generations sous une .
+c . . . . arete .
+c . arreca . s .2*nbanci. liste des aretes recouvrant une autre .
+c . arrecb . s .2*nbanci. liste des aretes recouvertes par une autre .
+c . noerec . s . nbanci . liste initiale des noeuds de recollement .
+c . nohman . e . char*8 . nom de l'objet maillage homard iteration n .
+c . nhvois . e . char8 . nom de la branche Voisins .
+c . coonoe . e . nbnoto . coordonnees des noeuds .
+c . hetnoe . es . nbnoto . historique de l'etat des noeuds .
+c . arenoe . es . nbnoto . 0 pour un sommet, le numero de l'arete pour.
+c . . . . un noeud milieu .
+c . coexno . es . nbnoto*. codes de conditions aux limites portants .
+c . . . nctfno . sur les noeuds .
+c . nnosho . es . rsnoac . numero des noeuds dans HOMARD .
+c . nnosca . es . rsnoto . numero des noeuds dans le calcul .
+c . noempo . es . nbmpto . numeros des noeuds associes aux mailles .
+c . somare . es .2*nbarto. numeros des extremites d'arete .
+c . hetare . es . nbarto . historique de l'etat des aretes .
+c . np2are . es . nbarto . noeud milieux des aretes .
+c . merare . es . nbarto . mere des aretes .
+c . filare . es . nbarto . premiere fille des aretes .
+c . insoar . es . nbarto . information sur les sommets des aretes .
+c . coexar . es . nbarto*. codes de conditions aux limites portants .
+c . . . nctfar . sur les aretes .
+c . narsho . es . rsarac . numero des aretes dans HOMARD .
+c . narsca . es . rsarto . numero des aretes du calcul .
+c . aretri . e .nbtrto*3. numeros des 3 aretes des triangles .
+c . arequa . e .nbquto*4. numeros des 4 aretes des quadrangles .
+c . ppovos . es . 1 . adresse du pointeur des vois. des sommets .
+c . pvoiso . es . 1 . adresse des voisins des sommets .
+c . pposif . es . 1 . adresse du pointeur des vois. des aretes .
+c . pfacar . es . 1 . adresse des voisins des aretes .
+c . ngenar . e . nbarto . nombre de generations au-dessus des aretes .
+c . ngenno . s . nbnoto . nombre de generations au-dessus des noeuds .
+c . nouent . s . nbnoto . nouveau numero des noeuds .
+c . tabaux . a . * . tableau auxiliaire .
+c . tbdaux . a . * . tableau auxiliaire reel .
+c . ulsort . e . 1 . numero d'unite logique de la liste standard.
+c . langue . e . 1 . langue des messages .
+c . . . . 1 : francais, 2 : anglais .
+c . codret . es . 1 . code de retour des modules .
+c . . . . 0 : pas de probleme .
+c . . . . 3 : 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 = 'VCMNC2' )
+c
+#include "nblang.h"
+c
+c 0.2. ==> communs
+c
+#include "impr02.h"
+#include "envex1.h"
+#include "nombno.h"
+#include "nombmp.h"
+#include "nombar.h"
+#include "nombtr.h"
+#include "nombqu.h"
+#include "envca1.h"
+#include "dicfen.h"
+#include "nombsr.h"
+c
+c 0.3. ==> arguments
+c
+ character*8 nohman, nhvois
+c
+ integer nbanci, nbgemx
+ integer arreca(2*nbanci), arrecb(2*nbanci)
+ integer noerec(nbanci)
+ integer noempo(nbmpto)
+ integer hetnoe(nbnoto), arenoe(nbnoto)
+ integer coexno(nbnoto,nctfno)
+ integer nnosho(rsnoac), nnosca(rsnoto)
+ integer somare(2,nbarto), hetare(nbarto), np2are(nbarto)
+ integer filare(nbarto), merare(nbarto), insoar(nbarto)
+ integer coexar(nbarto,nctfar)
+ integer narsho(rsarac), narsca(rsarto)
+ integer aretri(nbtrto,3)
+ integer arequa(nbquto,4)
+ integer ppovos, pvoiso
+ integer pposif, pfacar
+ integer ngenar(nbarto), ngenno(nbnoto), nouent(0:nbnoto)
+ integer tabaux(*)
+c
+ double precision tbdaux(*)
+ double precision coonoe(nbnoto,sdim)
+c
+ integer ulsort, langue, codret
+c
+c 0.4. ==> variables locales
+c
+ integer iaux, jaux
+ integer voarno, vofaar, vovoar, vovofa
+ integer numgen
+ integer numfin
+c
+ integer nbmess
+ parameter ( nbmess = 10 )
+ character*80 texte(nblang,nbmess)
+c
+c 0.5. ==> initialisations
+c ______________________________________________________________________
+c
+c====
+c 1. preliminaires
+c====
+c
+c 1.1. ==> messages
+c
+#include "impr01.h"
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,1)) 'Entree', nompro
+ call dmflsh (iaux)
+#endif
+c
+ texte(1,4) =
+ > '(''Nombre de paires de '',a,'' non-conformes :'',i10))'
+ texte(1,8) = '(''Regroupement des '',a,'' de generation'',i3)'
+c
+ texte(2,4) =
+ > '(''Number of pairs of non-conformal '',a,'' :'',i10))'
+ texte(2,8) = '(''Gathering of '',a,'' in generation'',i3)'
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,4)) mess14(langue,3,1), nbanci
+#endif
+c
+c====
+c 2. Elaboration des generations des noeuds
+c====
+c
+ if ( codret.eq.0 ) then
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,3)) 'UTNC05', nompro
+#endif
+c
+ jaux = -1
+ call utnc05 ( jaux, nbanci,numfin,
+ > arreca, arrecb,
+ > somare,
+ > ngenar, ngenno, nouent,
+ > ulsort, langue, codret )
+c
+ endif
+c
+c====
+c 2. Renumerotation des noeuds
+c Remarque : les generations doivent etre parcourues de la plus jeune
+c a la plus vieille, pour tasser vers la fin de la
+c numerotation
+c====
+c
+ numfin = nbnoto
+c
+ do 21 , numgen = nbgemx , 1 , -1
+c
+#ifdef _DEBUG_HOMARD_
+ if ( codret.eq.0 ) then
+ write (ulsort,texte(langue,8)) mess14(langue,3,-1), numgen
+ endif
+#endif
+c
+c 2.1. ==> Recherche des renumerotations
+c
+ if ( codret.eq.0 ) then
+c
+ jaux = numgen
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,3)) 'UTNC05', nompro
+#endif
+c
+ call utnc05 ( jaux, nbanci, numfin,
+ > arreca, arrecb,
+ > somare,
+ > ngenar, ngenno, nouent,
+ > ulsort, langue, codret )
+cgn write(ulsort,*) 'nouent'
+cgn do jaux=1,nbnoto
+cgn write(ulsort,3333) jaux,nouent(jaux)
+cgn 3333 format (i10,' :',i10)
+cgn enddo
+c
+ endif
+c
+c 2.2. ==> Prise en compte des renumerotations
+c
+ if ( codret.eq.0 ) then
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,3)) 'UTNC06', nompro
+#endif
+c
+ jaux = 0
+ call utnc06 ( jaux,
+ > nouent, tabaux, tbdaux,
+ > coonoe, hetnoe, arenoe,
+ > coexno, nnosho, nnosca,
+ > ngenno,
+ > noempo,
+ > somare,
+ > ulsort, langue, codret )
+c
+ endif
+c
+ 21 continue
+cgn write(ulsort,*) 'ngenno(', 1,') = ',ngenno(1)
+cgn do 2111,iaux=25300,25310
+cgn write(ulsort,*) 'ngenno(',iaux,') = ',ngenno(iaux)
+cgn 2111 continue
+cgn write(ulsort,*) 'ngenno(',36917,') = ',ngenno(36917)
+cgn write(ulsort,*) 'ngenno(',36918,') = ',ngenno(36918)
+cgn write(ulsort,*) 'ngenno(',nbnoto,') = ',ngenno(nbnoto)
+c
+c====
+c 3. Renumerotation des aretes soeurs : il faut que celle de plus petit
+c numero soit celle qui demarre sur le noeud de + petit numero
+c====
+c
+c 3.1. ==> Changement des renumerotations
+c
+ if ( codret.eq.0 ) then
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,3)) 'UTNC03', nompro
+#endif
+c
+ jaux = 0
+ call utnc03 ( jaux, nbanci, iaux,
+ > arreca, arrecb,
+ > somare, filare, merare,
+ > ngenar, nouent, tabaux,
+ > ulsort, langue, codret )
+c
+ endif
+c
+c 3.2. ==> Prise en compte des renumerotations
+c
+ if ( codret.eq.0 ) then
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,3)) 'UTNC04', nompro
+#endif
+c
+ call utnc04 ( nbanci, arreca, arrecb,
+ > nouent, tabaux,
+ > arenoe,
+ > somare, hetare, np2are,
+ > merare, filare, insoar,
+ > coexar, narsho, narsca,
+ > ngenar,
+ > aretri, arequa,
+ > ulsort, langue, codret )
+c
+ endif
+c
+c====
+c 4. Stockage du noeud commun aux aretes de recollement
+c====
+c
+ if ( codret.eq.0 ) then
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,3)) 'UTNC07', nompro
+#endif
+c
+ call utnc07 ( nbanci,
+ > noerec, arreca, arrecb,
+ > somare, arenoe,
+ > ulsort, langue, codret )
+c
+ endif
+c
+c====
+c 5. Mise a jour des aretes voisines des noeuds
+c====
+c
+ if ( codret.eq.0 ) then
+c
+ voarno = 2
+ vofaar = 0
+ vovoar = 0
+ vovofa = 0
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,3)) 'UTVOIS', nompro
+#endif
+ call utvois ( nohman, nhvois,
+ > voarno, vofaar, vovoar, vovofa,
+ > ppovos, pvoiso,
+ > nbfaar, pposif, pfacar,
+ > ulsort, langue, codret )
+c
+ endif
+c
+c====
+c 6. 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
