src/tool/Utilitaire/utvois.F

   1       subroutine utvois ( nomail, nhvois,
   2      >                    voarno, vofaar, vovoar, vovofa,
   3      >                    ppovos, pvoiso,
   4      >                    nbfaar, pposif, pfacar,
   5      >                    ulsort, langue, codret)
   6 c ______________________________________________________________________
   7 c
   8 c                             H O M A R D
   9 c
  10 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  11 c
  12 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  13 c aupres des huissiers de justice Simart et Lavoir a Clamart
  14 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  15 c aupres des huissiers de justice
  16 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  17 c
  18 c    HOMARD est une marque deposee d'Electricite de France
  19 c
  20 c Copyright EDF 1996
  21 c Copyright EDF 1998
  22 c Copyright EDF 2002
  23 c Copyright EDF 2020
  24 c ______________________________________________________________________
  25 c
  26 c    UTilitaire - creation des tableaux des VOISins
  27 c    --                                     ----
  28 c ______________________________________________________________________
  29 c .        .     .        .                                            .
  30 c .  nom   . e/s . taille .           description                      .
  31 c .____________________________________________________________________.
  32 c . nomail . e   . char8  . nom de l'objet maillage homard             .
  33 c . nhvois . es  . char8  . nom de la branche Voisins                  .
  34 c . voarno . e   .   1    . pilotage des voisins des noeuds :          .
  35 c .        .     .        . -1 : on detruit la table.                  .
  36 c .        .     .        . 0 : on ne fait rien.                       .
  37 c .        .     .        . 1 : on construit la table.                 .
  38 c .        .     .        . 2 : on construit la table et on controle   .
  39 c . vofaar . e   .   1    . pilotage des voisins des aretes :          .
  40 c .        .     .        . -1 : on detruit la table.                  .
  41 c .        .     .        . 0 : on ne fait rien.                       .
  42 c .        .     .        . 1 : on construit la table.                 .
  43 c .        .     .        . 2 : on construit la table et on controle   .
  44 c . vovoar . e   .   1    . pilotage des volumes voisins des aretes :  .
  45 c .        .     .        . -1 : on detruit la table.                  .
  46 c .        .     .        . 0 : on ne fait rien.                       .
  47 c .        .     .        . 1 : on construit la table.                 .
  48 c .        .     .        . 2 : on construit la table et on controle   .
  49 c . vovofa . e   .   1    . pilotage des volumes voisins des faces :   .
  50 c .        .     .        . -1 : on detruit la table.                  .
  51 c .        .     .        . 0 : on ne fait rien.                       .
  52 c .        .     .        . 1 : on construit la table.                 .
  53 c .        .     .        . 2 : on construit la table et on controle   .
  54 c . ppovos .   s .   1    . adresse du pointeur des vois. des sommets  .
  55 c . pvoiso .   s .   1    . adresse des voisins des sommets            .
  56 c . nbfaar .  s  .   1    . nombre cumule de faces par arete           .
  57 c . pposif .   s .   1    . adresse du pointeur des vois. des aretes   .
  58 c . pfacar .   s .   1    . adresse des voisins des aretes             .
  59 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  60 c . langue . e   .    1   . langue des messages                        .
  61 c .        .     .        . 1 : francais, 2 : anglais                  .
  62 c . codret . es  .    1   . code de retour des modules                 .
  63 c .        .     .        . 0 : pas de probleme                        .
  64 c .        .     .        . 1 : probleme                               .
  65 c ______________________________________________________________________
  66 c
  67 c====
  68 c 0. declarations et dimensionnement
  69 c====
  70 c
  71 c 0.1. ==> generalites
  72 c
  73       implicit none
  74       save
  75 c
  76       character*6 nompro
  77       parameter ( nompro = 'UTVOIS' )
  78 c
  79 #include "nblang.h"
  80 #include "envca1.h"
  81 c
  82 c 0.2. ==> communs
  83 c
  84 #include "envex1.h"
  85 c
  86 #include "impr02.h"
  87 c
  88 c 0.3. ==> arguments
  89 c
  90       character*8 nomail, nhvois
  91 c
  92       integer voarno, vofaar, vovoar, vovofa
  93       integer ppovos, pvoiso
  94       integer nbfaar, pposif, pfacar
  95 c
  96       integer ulsort, langue, codret
  97 c
  98 c 0.4. ==> variables locales
  99 c
 100       integer iaux
 101 c
 102       character*8 norenu
 103       character*8 nhnoeu, nhmapo, nharet, nhtria, nhquad
 104       character*8 nhtetr, nhhexa, nhpyra, nhpent
 105       character*8 nhelig
 106       character*8 nhsupe, nhsups
 107 c
 108       integer nbmess
 109       parameter ( nbmess = 10 )
 110       character*80 texte(nblang,nbmess)
 111 c
 112 c 0.5. ==> initialisations
 113 c ______________________________________________________________________
 114 c
 115 c====
 116 c 1. messages
 117 c====
 118 c
 119 #include "impr01.h"
 120 c
 121 #ifdef _DEBUG_HOMARD_
 122       write (ulsort,texte(langue,1)) 'Entree', nompro
 123       call dmflsh (iaux)
 124 #endif
 125       texte(1,4) = '(5x,''Mise en place des voisins.'')'
 126       texte(1,5) = '(a,'' voisins des '',a,'' : '',i6)'
 127 c
 128       texte(2,4) = '(5x,''Neighbourhood.'')'
 129       texte(2,5) = '(a,'' closed to the '',a,'' : '',i6)'
 130 c
 131 #include "impr03.h"
 132 c
 133 #ifdef _DEBUG_HOMARD_
 134       write(ulsort,texte(langue,4))
 135 #endif
 136 c
 137 c====
 138 c 2. Allocation de la tete des voisins.
 139 c    Il faut le faire au depart, sinon, le programme utnomh plante.
 140 c====
 141 c
 142       if ( codret.eq.0 ) then
 143 c
 144       call gmobal ( nomail//'.Voisins', codret )
 145 c
 146       if ( codret.eq.0 ) then
 147         call gmaloj ( nomail//'.Voisins', ' ', 0, iaux, codret )
 148 c
 149       elseif ( codret.eq.1 ) then
 150         codret = 0
 151 c
 152       else
 153         codret = 2
 154 c
 155       endif
 156 c
 157       endif
 158 c
 159 c====
 160 c 3. recuperation des donnees du maillage d'entree
 161 c====
 162 #ifdef _DEBUG_HOMARD_
 163       write (ulsort,90002) '3. recuperation ; codret', codret
 164 #endif
 165 c
 166       if ( codret.eq.0 ) then
 167 c
 168 #ifdef _DEBUG_HOMARD_
 169       write (ulsort,texte(langue,3)) 'UTNOMH', nompro
 170 #endif
 171       call utnomh ( nomail,
 172      >                sdim,   mdim,
 173      >               degre, maconf, homolo, hierar,
 174      >              rafdef, nbmane, typcca, typsfr, maextr,
 175      >              mailet,
 176      >              norenu,
 177      >              nhnoeu, nhmapo, nharet,
 178      >              nhtria, nhquad,
 179      >              nhtetr, nhhexa, nhpyra, nhpent,
 180      >              nhelig,
 181      >              nhvois, nhsupe, nhsups,
 182      >              ulsort, langue, codret)
 183 c
 184       endif
 185 c
 186 c====
 187 c 4. Traitement
 188 c====
 189 #ifdef _DEBUG_HOMARD_
 190       write (ulsort,90002) '4. Traitement ; codret', codret
 191 #endif
 192 c 4.1. ==> determination des aretes voisines des noeuds
 193 c
 194 #ifdef _DEBUG_HOMARD_
 195       write(ulsort,texte(langue,5))
 196      >      mess14(langue,3,1), mess14(langue,3,-1), voarno
 197 #endif
 198 c
 199       if ( voarno.ne.0 ) then
 200 c
 201         if ( codret.eq.0 ) then
 202 c
 203 #ifdef _DEBUG_HOMARD_
 204         write (ulsort,texte(langue,3)) 'UTVGAN', nompro
 205 #endif
 206 c
 207         call utvgan ( nhvois, nhnoeu, nharet,
 208      >                voarno,
 209      >                ppovos, pvoiso,
 210      >                ulsort, langue, codret)
 211 c
 212         endif
 213 c
 214       endif
 215 c
 216 c 4.2. ==> determination des faces voisines des aretes
 217 c
 218 #ifdef _DEBUG_HOMARD_
 219       write (ulsort,90002) '4.2. faces/aretes ; codret', codret
 220 #endif
 221 #ifdef _DEBUG_HOMARD_
 222       write(ulsort,texte(langue,5))
 223      >      mess14(langue,3,8), mess14(langue,3,1), vofaar
 224 #endif
 225 c
 226       if ( vofaar.ne.0 ) then
 227 c
 228         if ( codret.eq.0 ) then
 229 c
 230 #ifdef _DEBUG_HOMARD_
 231         write (ulsort,texte(langue,3)) 'UTVGFA', nompro
 232 #endif
 233 c
 234         call utvgfa ( nhvois, nharet, nhtria, nhquad,
 235      >                vofaar,
 236      >                nbfaar, pposif, pfacar,
 237      >                ulsort, langue, codret )
 238 c
 239         endif
 240 c
 241       endif
 242 c
 243 c 4.3. ==> reperage des volumes s'appuyant sur chaque arete
 244 c
 245 #ifdef _DEBUG_HOMARD_
 246       write (ulsort,90002) '4.3. volumes/aretes ; codret', codret
 247 #endif
 248 #ifdef _DEBUG_HOMARD_
 249       write(ulsort,texte(langue,5))
 250      >      mess14(langue,3,9), mess14(langue,3,1), vovoar
 251 #endif
 252 c
 253       if ( vovoar.ne.0 ) then
 254 c
 255         if ( codret.eq.0 ) then
 256 c
 257 #ifdef _DEBUG_HOMARD_
 258         write (ulsort,texte(langue,3)) 'UTVGVA', nompro
 259 #endif
 260         call utvgva ( nhvois, nharet, nhtria, nhquad,
 261      >                nhtetr, nhhexa, nhpyra, nhpent,
 262      >                vovoar,
 263      >                ulsort, langue, codret)
 264 c
 265         endif
 266 c
 267       endif
 268 c
 269 c 4.4. ==> reperage des volumes s'appuyant sur chaque face
 270 c
 271 #ifdef _DEBUG_HOMARD_
 272       write (ulsort,90002) '4.4. volumes/faces ; codret', codret
 273 #endif
 274 #ifdef _DEBUG_HOMARD_
 275       write(ulsort,texte(langue,5))
 276      >      mess14(langue,3,9), mess14(langue,3,8), vovofa
 277 #endif
 278 c
 279       if ( vovofa.ne.0 ) then
 280 c
 281         if ( codret.eq.0 ) then
 282 c
 283 #ifdef _DEBUG_HOMARD_
 284         write (ulsort,texte(langue,3)) 'UTVGVF', nompro
 285 #endif
 286         call utvgvf ( nhvois, nhtria, nhquad,
 287      >                nhtetr, nhhexa, nhpyra, nhpent,
 288      >                vovofa,
 289      >                ulsort, langue, codret)
 290 c
 291         endif
 292 c
 293       endif
 294 c
 295 c====
 296 c 5. la fin
 297 c====
 298 c
 299       if ( codret.ne.0 ) then
 300 c
 301 #include "envex2.h"
 302 c
 303       write (ulsort,texte(langue,1)) 'Sortie', nompro
 304       write (ulsort,texte(langue,2)) codret
 305 c
 306       endif
 307 c
 308 #ifdef _DEBUG_HOMARD_
 309       write (ulsort,texte(langue,1)) 'Sortie', nompro
 310       call dmflsh (iaux)
 311 #endif
 312 c
 313       end