src/tool/Utilitaire/utnomc.F

   1       subroutine utnomc ( nocmai,
   2      >                      sdim,   mdim,
   3      >                     degre, mailet, maconf, homolo, hierar,
   4      >                    nbnomb,
   5      >                    ncinfo, ncnoeu, nccono, nccode,
   6      >                    nccoex, ncfami,
   7      >                    ncequi, ncfron, ncnomb,
   8      >                    ulsort, langue, codret)
   9 c ______________________________________________________________________
  10 c
  11 c                             H O M A R D
  12 c
  13 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  14 c
  15 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  16 c aupres des huissiers de justice Simart et Lavoir a Clamart
  17 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  18 c aupres des huissiers de justice
  19 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  20 c
  21 c    HOMARD est une marque deposee d'Electricite de France
  22 c
  23 c Copyright EDF 1996
  24 c Copyright EDF 1998
  25 c Copyright EDF 2002
  26 c Copyright EDF 2020
  27 c ______________________________________________________________________
  28 c
  29 c    UTilitaire - Nom des Objets du Maillage de Calcul
  30 c    --           -       -         -           -
  31 c ______________________________________________________________________
  32 c .        .     .        .                                            .
  33 c .  nom   . e/s . taille .           description                      .
  34 c .____________________________________________________________________.
  35 c . nocmai . e   . char8  . nom de l'objet maillage de calcul          .
  36 c . sdim   .   s .    1   . dimension de l'espace                      .
  37 c . mdim   .   s .    1   . dimension du maillage                      .
  38 c . degre  .   s .    1   . degre du maillage                          .
  39 c . mailet .   s .    1   . presence de mailles etendues               .
  40 c .        .     .        .  1 : aucune                                .
  41 c .        .     .        . 2x : TRIA7                                 .
  42 c .        .     .        . 3x : QUAD9                                 .
  43 c .        .     .        . 5x : HEXA27                                .
  44 c . maconf .   s .    1   . conformite du maillage                     .
  45 c .        .     .        .  0 : oui                                   .
  46 c .        .     .        .  1 : non-conforme avec au minimum 2 aretes .
  47 c .        .     .        .      non decoupees en 2 par face           .
  48 c .        .     .        .  2 : non-conforme avec 1 seul noeud pendant.
  49 c .        .     .        .      par arete                             .
  50 c .        .     .        .  3 : non-conforme sans contrainte          .
  51 c .        .     .        . -1 : conforme, avec des boites pour les    .
  52 c .        .     .        .      quadrangles, hexaedres et pentaedres  .
  53 c .        .     .        . -2 : non-conforme avec au maximum 1 arete  .
  54 c .        .     .        .      decoupee en 2 et des boites pour les  .
  55 c .        .     .        .       quadrangles, hexaedres et pentaedres .
  56 c .        .     .        . 10 : non-conforme sans autre connaissance  .
  57 c . homolo .  s  .    1   . type de relations par homologues           .
  58 c .        .     .        . 0 : pas d'homologues                       .
  59 c .        .     .        . 1 : relations sur les noeuds               .
  60 c .        .     .        . 2 : relations sur les noeuds et les aretes .
  61 c .        .     .        . 3 : relations sur les noeuds, les aretes   .
  62 c .        .     .        .     et les triangles                       .
  63 c . hierar .  s  .    1   . maillage hierarchique                      .
  64 c .        .     .        . 0 : non                                    .
  65 c .        .     .        . 1 : oui                                    .
  66 c . nbnomb .   s .    1   . longueur du tableau de la branche Nombres  .
  67 c . ncinfo .   s . char8  . nom de la branche InfoGene                 .
  68 c . ncnoeu .   s . char8  . nom de la branche Noeud                    .
  69 c . nccono .   s . char8  . nom de la branche ConnNoeu                 .
  70 c . nccode .   s . char8  . nom de la branche ConnDesc                 .
  71 c . nccoex .   s . char8  . nom de la branche CodeExte                 .
  72 c . ncfami .   s . char8  . nom de la branche Famille                  .
  73 c . ncequi .   s . char8  . nom de la branche Equivalt                 .
  74 c . ncfron .   s . char8  . nom de la branche Frontier                 .
  75 c . ncnomb .   s . char8  . nom de la branche Nombres                  .
  76 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  77 c . langue . e   .    1   . langue des messages                        .
  78 c .        .     .        . 1 : francais, 2 : anglais                  .
  79 c . codret . es  .    1   . code de retour des modules                 .
  80 c .        .     .        . 0 : pas de probleme                        .
  81 c .        .     .        . 1 : probleme                               .
  82 c ______________________________________________________________________
  83 c
  84 c====
  85 c 0. declarations et dimensionnement
  86 c====
  87 c
  88 c 0.1. ==> generalites
  89 c
  90       implicit none
  91       save
  92 c
  93       character*6 nompro
  94       parameter ( nompro = 'UTNOMC' )
  95 c
  96 #include "nblang.h"
  97 c
  98 c 0.2. ==> communs
  99 c
 100 #include "envex1.h"
 101 c
 102 c 0.3. ==> arguments
 103 c
 104       character*8 nocmai
 105       character*8 ncinfo, ncnoeu, nccono, nccode
 106       character*8 nccoex, ncfami
 107       character*8 ncequi, ncfron, ncnomb
 108 c
 109       integer sdim, mdim
 110       integer degre, mailet, maconf, homolo, hierar
 111       integer nbnomb
 112 c
 113       integer ulsort, langue, codret
 114 c
 115 c 0.4. ==> variables locales
 116 c
 117       integer iaux
 118       integer codre1, codre2, codre3, codre4, codre5
 119       integer codre6, codre7, codre8
 120       integer codre0
 121 c
 122       integer nbmess
 123       parameter ( nbmess = 10 )
 124       character*80 texte(nblang,nbmess)
 125 c
 126 c 0.5. ==> initialisations
 127 c ______________________________________________________________________
 128 c
 129 c====
 130 c 1. messages
 131 c====
 132 c
 133 #include "impr01.h"
 134 c
 135 #ifdef _DEBUG_HOMARD_
 136       write (ulsort,texte(langue,1)) 'Entree', nompro
 137       call dmflsh (iaux)
 138 #endif
 139 c
 140       texte(1,10) = '(''Noms des objets du maillage de calcul.'')'
 141       texte(1,4) = '(''Au moins une branche est indefinie.'')'
 142 c
 143       texte(2,10) = '(''Names of calculation mesh objects.'')'
 144       texte(2,4) = '(''At least one branch is undefined.'')'
 145 c
 146 #ifdef _DEBUG_HOMARD_
 147       write(ulsort,texte(langue,10))
 148 #endif
 149 c
 150       codret = 0
 151 c
 152 c====
 153 c 2. recuperation des donnees du maillage d'entree
 154 c====
 155 c
 156 c 2.1. ==> caracteristiques de base
 157 c
 158       if ( codret.eq.0 ) then
 159 c
 160       call gmliat ( nocmai, 1, sdim, codre1 )
 161       call gmliat ( nocmai, 2, mdim, codre2 )
 162       call gmliat ( nocmai, 3, degre, codre3 )
 163       call gmliat ( nocmai, 4, maconf, codre4 )
 164       call gmliat ( nocmai, 5, homolo, codre5 )
 165       call gmliat ( nocmai, 6, hierar, codre6 )
 166       call gmliat ( nocmai, 7, nbnomb, codre7 )
 167       call gmliat ( nocmai, 8, mailet, codre8 )
 168 c
 169       codre0 = min ( codre1, codre2, codre3, codre4, codre5,
 170      >               codre6, codre7, codre8 )
 171       codret = max ( abs(codre0), codret,
 172      >               codre1, codre2, codre3, codre4, codre5,
 173      >               codre6, codre7, codre8 )
 174 c
 175       endif
 176 c
 177 c 2.2. ==> noms des branches
 178 c
 179 c    le code de retour de gmnomc est :
 180 c      0 : tout va bien
 181 c     -1 : l'objet n'est pas defini ; dans ce cas, le nom est "Indefini"
 182 c     -3 : le nom etendu est invalide
 183 c
 184 c    Ici, on tolere le retour -1, car selon les endroits, les branches
 185 c    ne sont pas toutes definies.
 186 c    En revanche, le -3 est une vraie erreur car c'est que le nom
 187 c    de l'objet maillage est mauvais.
 188 c
 189       if ( codret.eq.0 ) then
 190 c
 191       call gmnomc ( nocmai//'.InfoGene', ncinfo, codre1 )
 192       call gmnomc ( nocmai//'.Noeud'   , ncnoeu, codre2 )
 193       call gmnomc ( nocmai//'.ConnNoeu', nccono, codre3 )
 194       call gmnomc ( nocmai//'.ConnDesc', nccode, codre4 )
 195 c
 196       codre0 = min ( codre1, codre2, codre3, codre4 )
 197       codret = max ( abs(codre0), codret,
 198      >               codre1, codre2, codre3, codre4 )
 199 c
 200       endif
 201 c
 202       if ( codret.eq.0 ) then
 203 c
 204       call gmnomc ( nocmai//'.CodeExte', nccoex, codre1 )
 205       call gmnomc ( nocmai//'.Famille' , ncfami, codre2 )
 206       call gmnomc ( nocmai//'.Equivalt', ncequi, codre3 )
 207       call gmnomc ( nocmai//'.Frontier', ncfron, codre4 )
 208       call gmnomc ( nocmai//'.Nombres' , ncnomb, codre5 )
 209 c
 210       codre0 = min ( codre1, codre2, codre3, codre4, codre5 )
 211       codret = max ( abs(codre0), codret,
 212      >               codre1, codre2, codre3, codre4, codre5 )
 213 c
 214       if ( codret.eq.1 ) then
 215 c
 216 #ifdef _DEBUG_HOMARD_
 217         write (ulsort,texte(langue,1)) 'Sortie', nompro
 218         write (ulsort,texte(langue,4))
 219 #endif
 220         codret = 0
 221       endif
 222 c
 223       endif
 224 c
 225 c====
 226 c 3. la fin
 227 c====
 228 c
 229       if ( codret.ne.0 ) then
 230 c
 231 #include "envex2.h"
 232 c
 233       write (ulsort,texte(langue,1)) 'Sortie', nompro
 234       write (ulsort,texte(langue,2)) codret
 235 c
 236       endif
 237 c
 238 #ifdef _DEBUG_HOMARD_
 239       write (ulsort,texte(langue,1)) 'Sortie', nompro
 240       call dmflsh (iaux)
 241 #endif
 242 c
 243       end