src/tool/AV_Conversion/vcmnc2.F

   1       subroutine vcmnc2 ( nbanci, nbgemx,
   2      >                    arreca, arrecb, noerec,
   3      >                    nohman, nhvois,
   4      >                    coonoe, hetnoe, arenoe,
   5      >                    coexno, nnosho, nnosca,
   6      >                    noempo,
   7      >                    somare, hetare, np2are,
   8      >                    merare, filare, insoar,
   9      >                    coexar, narsho, narsca,
  10      >                    aretri, arequa,
  11      >                    ppovos, pvoiso,
  12      >                    pposif, pfacar,
  13      >                    ngenar, ngenno, nouent, tabaux, tbdaux,
  14      >                    ulsort, langue, codret )
  15 c ______________________________________________________________________
  16 c
  17 c                             H O M A R D
  18 c
  19 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  20 c
  21 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  22 c aupres des huissiers de justice Simart et Lavoir a Clamart
  23 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  24 c aupres des huissiers de justice
  25 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  26 c
  27 c    HOMARD est une marque deposee d'Electricite de France
  28 c
  29 c Copyright EDF 1996
  30 c Copyright EDF 1998
  31 c Copyright EDF 2002
  32 c Copyright EDF 2020
  33 c ______________________________________________________________________
  34 c
  35 c    aVant adaptation - Conversion de Maillage - Non Conformite - 2
  36 c     -                 -             -          -   -            -
  37 c    Renumerotations des noeuds
  38 c ______________________________________________________________________
  39 c .        .     .        .                                            .
  40 c .  nom   . e/s . taille .           description                      .
  41 c .____________________________________________________________________.
  42 c . nbanci . e   .    1   . nombre d'aretes de non conformite initiale .
  43 c .        .     .        . egal au nombre d'aretes recouvrant 2 autres.
  44 c . nbgemx . e   .    1   . nombre maximal de generations sous une     .
  45 c .        .     .        . arete                                      .
  46 c . arreca .  s  .2*nbanci. liste des aretes recouvrant une autre      .
  47 c . arrecb .  s  .2*nbanci. liste des aretes recouvertes par une autre .
  48 c . noerec .  s  . nbanci . liste initiale des noeuds de recollement   .
  49 c . nohman . e   . char*8 . nom de l'objet maillage homard iteration n .
  50 c . nhvois . e   . char8  . nom de la branche Voisins                  .
  51 c . coonoe . e   . nbnoto . coordonnees des noeuds                     .
  52 c . hetnoe . es  . nbnoto . historique de l'etat des noeuds            .
  53 c . arenoe . es  . nbnoto . 0 pour un sommet, le numero de l'arete pour.
  54 c .        .     .        . un noeud milieu                            .
  55 c . coexno . es  . nbnoto*. codes de conditions aux limites portants   .
  56 c .        .     . nctfno . sur les noeuds                             .
  57 c . nnosho . es  . rsnoac . numero des noeuds dans HOMARD              .
  58 c . nnosca . es  . rsnoto . numero des noeuds dans le calcul           .
  59 c . noempo . es  . nbmpto . numeros des noeuds associes aux mailles    .
  60 c . somare . es  .2*nbarto. numeros des extremites d'arete             .
  61 c . hetare . es  . nbarto . historique de l'etat des aretes            .
  62 c . np2are . es  . nbarto . noeud milieux des aretes                   .
  63 c . merare . es  . nbarto . mere des aretes                            .
  64 c . filare . es  . nbarto . premiere fille des aretes                  .
  65 c . insoar . es  . nbarto . information sur les sommets des aretes     .
  66 c . coexar . es  . nbarto*. codes de conditions aux limites portants   .
  67 c .        .     . nctfar . sur les aretes                             .
  68 c . narsho . es  . rsarac . numero des aretes dans HOMARD              .
  69 c . narsca . es  . rsarto . numero des aretes du calcul                .
  70 c . aretri . e   .nbtrto*3. numeros des 3 aretes des triangles         .
  71 c . arequa . e   .nbquto*4. numeros des 4 aretes des quadrangles       .
  72 c . ppovos . es  .   1    . adresse du pointeur des vois. des sommets  .
  73 c . pvoiso . es  .   1    . adresse des voisins des sommets            .
  74 c . pposif . es  .   1    . adresse du pointeur des vois. des aretes   .
  75 c . pfacar . es  .   1    . adresse des voisins des aretes             .
  76 c . ngenar . e   . nbarto . nombre de generations au-dessus des aretes .
  77 c . ngenno .  s  . nbnoto . nombre de generations au-dessus des noeuds .
  78 c . nouent .  s  . nbnoto . nouveau numero des noeuds                  .
  79 c . tabaux . a   .   *    . tableau auxiliaire                         .
  80 c . tbdaux . a   .   *    . tableau auxiliaire reel                    .
  81 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  82 c . langue . e   .    1   . langue des messages                        .
  83 c .        .     .        . 1 : francais, 2 : anglais                  .
  84 c . codret . es  .    1   . code de retour des modules                 .
  85 c .        .     .        . 0 : pas de probleme                        .
  86 c .        .     .        . 3 : probleme                               .
  87 c ______________________________________________________________________
  88 c
  89 c====
  90 c 0. declarations et dimensionnement
  91 c====
  92 c
  93 c 0.1. ==> generalites
  94 c
  95       implicit none
  96       save
  97 c
  98       character*6 nompro
  99       parameter ( nompro = 'VCMNC2' )
 100 c
 101 #include "nblang.h"
 102 c
 103 c 0.2. ==> communs
 104 c
 105 #include "impr02.h"
 106 #include "envex1.h"
 107 #include "nombno.h"
 108 #include "nombmp.h"
 109 #include "nombar.h"
 110 #include "nombtr.h"
 111 #include "nombqu.h"
 112 #include "envca1.h"
 113 #include "dicfen.h"
 114 #include "nombsr.h"
 115 c
 116 c 0.3. ==> arguments
 117 c
 118       character*8 nohman, nhvois
 119 c
 120       integer nbanci, nbgemx
 121       integer arreca(2*nbanci), arrecb(2*nbanci)
 122       integer noerec(nbanci)
 123       integer noempo(nbmpto)
 124       integer hetnoe(nbnoto), arenoe(nbnoto)
 125       integer coexno(nbnoto,nctfno)
 126       integer nnosho(rsnoac), nnosca(rsnoto)
 127       integer somare(2,nbarto), hetare(nbarto), np2are(nbarto)
 128       integer filare(nbarto), merare(nbarto), insoar(nbarto)
 129       integer coexar(nbarto,nctfar)
 130       integer narsho(rsarac), narsca(rsarto)
 131       integer aretri(nbtrto,3)
 132       integer arequa(nbquto,4)
 133       integer ppovos, pvoiso
 134       integer pposif, pfacar
 135       integer ngenar(nbarto), ngenno(nbnoto), nouent(0:nbnoto)
 136       integer tabaux(*)
 137 c
 138       double precision tbdaux(*)
 139       double precision coonoe(nbnoto,sdim)
 140 c
 141       integer ulsort, langue, codret
 142 c
 143 c 0.4. ==> variables locales
 144 c
 145       integer iaux, jaux
 146       integer voarno, vofaar, vovoar, vovofa
 147       integer numgen
 148       integer numfin
 149 c
 150       integer nbmess
 151       parameter ( nbmess = 10 )
 152       character*80 texte(nblang,nbmess)
 153 c
 154 c 0.5. ==> initialisations
 155 c ______________________________________________________________________
 156 c
 157 c====
 158 c 1. preliminaires
 159 c====
 160 c
 161 c 1.1. ==> messages
 162 c
 163 #include "impr01.h"
 164 c
 165 #ifdef _DEBUG_HOMARD_
 166       write (ulsort,texte(langue,1)) 'Entree', nompro
 167       call dmflsh (iaux)
 168 #endif
 169 c
 170       texte(1,4) =
 171      > '(''Nombre de paires de '',a,'' non-conformes :'',i10))'
 172       texte(1,8) = '(''Regroupement des '',a,'' de generation'',i3)'
 173 c
 174       texte(2,4) =
 175      > '(''Number of pairs of non-conformal '',a,'' :'',i10))'
 176       texte(2,8) = '(''Gathering of '',a,'' in generation'',i3)'
 177 c
 178 #ifdef _DEBUG_HOMARD_
 179       write (ulsort,texte(langue,4)) mess14(langue,3,1), nbanci
 180 #endif
 181 c
 182 c====
 183 c 2. Elaboration des generations des noeuds
 184 c====
 185 c
 186       if ( codret.eq.0 ) then
 187 c
 188 #ifdef _DEBUG_HOMARD_
 189       write (ulsort,texte(langue,3)) 'UTNC05', nompro
 190 #endif
 191 c
 192       jaux = -1
 193       call utnc05 ( jaux, nbanci,numfin,
 194      >              arreca, arrecb,
 195      >              somare,
 196      >              ngenar, ngenno, nouent,
 197      >              ulsort, langue, codret )
 198 c
 199       endif
 200 c
 201 c====
 202 c 2. Renumerotation des noeuds
 203 c    Remarque : les generations doivent etre parcourues de la plus jeune
 204 c               a la plus vieille, pour tasser vers la fin de la
 205 c               numerotation
 206 c====
 207 c
 208       numfin = nbnoto
 209 c
 210       do 21 , numgen = nbgemx , 1 , -1
 211 c
 212 #ifdef _DEBUG_HOMARD_
 213         if ( codret.eq.0 ) then
 214           write (ulsort,texte(langue,8)) mess14(langue,3,-1), numgen
 215         endif
 216 #endif
 217 c
 218 c 2.1. ==> Recherche des renumerotations
 219 c
 220         if ( codret.eq.0 ) then
 221 c
 222         jaux = numgen
 223 c
 224 #ifdef _DEBUG_HOMARD_
 225       write (ulsort,texte(langue,3)) 'UTNC05', nompro
 226 #endif
 227 c
 228         call utnc05 ( jaux, nbanci, numfin,
 229      >                arreca, arrecb,
 230      >                somare,
 231      >                ngenar, ngenno, nouent,
 232      >                ulsort, langue, codret )
 233 cgn      write(ulsort,*) 'nouent'
 234 cgn      do jaux=1,nbnoto
 235 cgn      write(ulsort,3333) jaux,nouent(jaux)
 236 cgn 3333 format (i10,' :',i10)
 237 cgn      enddo
 238 c
 239         endif
 240 c
 241 c 2.2. ==> Prise en compte des renumerotations
 242 c
 243         if ( codret.eq.0 ) then
 244 c
 245 #ifdef _DEBUG_HOMARD_
 246       write (ulsort,texte(langue,3)) 'UTNC06', nompro
 247 #endif
 248 c
 249         jaux = 0
 250         call utnc06 ( jaux,
 251      >                nouent, tabaux, tbdaux,
 252      >                coonoe, hetnoe, arenoe,
 253      >                coexno, nnosho, nnosca,
 254      >                ngenno,
 255      >                noempo,
 256      >                somare,
 257      >                ulsort, langue, codret )
 258 c
 259         endif
 260 c
 261    21 continue
 262 cgn      write(ulsort,*) 'ngenno(',     1,') = ',ngenno(1)
 263 cgn      do 2111,iaux=25300,25310
 264 cgn      write(ulsort,*) 'ngenno(',iaux,') = ',ngenno(iaux)
 265 cgn 2111 continue
 266 cgn      write(ulsort,*) 'ngenno(',36917,') = ',ngenno(36917)
 267 cgn      write(ulsort,*) 'ngenno(',36918,') = ',ngenno(36918)
 268 cgn      write(ulsort,*) 'ngenno(',nbnoto,') = ',ngenno(nbnoto)
 269 c
 270 c====
 271 c 3. Renumerotation des aretes soeurs : il faut que celle de plus petit
 272 c    numero soit celle qui demarre sur le noeud de + petit numero
 273 c====
 274 c
 275 c 3.1. ==> Changement des renumerotations
 276 c
 277       if ( codret.eq.0 ) then
 278 c
 279 #ifdef _DEBUG_HOMARD_
 280       write (ulsort,texte(langue,3)) 'UTNC03', nompro
 281 #endif
 282 c
 283       jaux = 0
 284       call utnc03 ( jaux, nbanci, iaux,
 285      >              arreca, arrecb,
 286      >              somare, filare, merare,
 287      >              ngenar, nouent, tabaux,
 288      >              ulsort, langue, codret )
 289 c
 290       endif
 291 c
 292 c 3.2. ==> Prise en compte des renumerotations
 293 c
 294       if ( codret.eq.0 ) then
 295 c
 296 #ifdef _DEBUG_HOMARD_
 297       write (ulsort,texte(langue,3)) 'UTNC04', nompro
 298 #endif
 299 c
 300       call utnc04 ( nbanci, arreca, arrecb,
 301      >              nouent, tabaux,
 302      >              arenoe,
 303      >              somare, hetare, np2are,
 304      >              merare, filare, insoar,
 305      >              coexar, narsho, narsca,
 306      >              ngenar,
 307      >              aretri, arequa,
 308      >              ulsort, langue, codret )
 309 c
 310       endif
 311 c
 312 c====
 313 c 4. Stockage du noeud commun aux aretes de recollement
 314 c====
 315 c
 316       if ( codret.eq.0 ) then
 317 c
 318 #ifdef _DEBUG_HOMARD_
 319       write (ulsort,texte(langue,3)) 'UTNC07', nompro
 320 #endif
 321 c
 322       call utnc07 ( nbanci,
 323      >              noerec, arreca, arrecb,
 324      >              somare, arenoe,
 325      >              ulsort, langue, codret )
 326 c
 327       endif
 328 c
 329 c====
 330 c 5. Mise a jour des aretes voisines des noeuds
 331 c====
 332 c
 333       if ( codret.eq.0 ) then
 334 c
 335       voarno = 2
 336       vofaar = 0
 337       vovoar = 0
 338       vovofa = 0
 339 c
 340 #ifdef _DEBUG_HOMARD_
 341       write (ulsort,texte(langue,3)) 'UTVOIS', nompro
 342 #endif
 343       call utvois ( nohman, nhvois,
 344      >              voarno, vofaar, vovoar, vovofa,
 345      >              ppovos, pvoiso,
 346      >              nbfaar, pposif, pfacar,
 347      >              ulsort, langue, codret )
 348 c
 349       endif
 350 c
 351 c====
 352 c 6. la fin
 353 c====
 354 c
 355       if ( codret.ne.0 ) then
 356 c
 357 #include "envex2.h"
 358 c
 359       write (ulsort,texte(langue,1)) 'Sortie', nompro
 360       write (ulsort,texte(langue,2)) codret
 361 c
 362       endif
 363 c
 364 #ifdef _DEBUG_HOMARD_
 365       write (ulsort,texte(langue,1)) 'Sortie', nompro
 366       call dmflsh (iaux)
 367 #endif
 368 c
 369       end