src/tool/Information/infovi.F

   1       subroutine infovi ( typmes,
   2      >                    nbtevr, tatevr,
   3      >                    nbhevr, tahevr,
   4      >                    nbpyvr, tapyvr,
   5      >                    nbpevr, tapevr,
   6      >                    hettet, hetpyr, hethex, hetpen,
   7      >                    ulecr,
   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   INFOrmation : Volumes voisins - Impression
  30 c   ----          -                 -
  31 c ______________________________________________________________________
  32 c .        .     .        .                                            .
  33 c .  nom   . e/s . taille .           description                      .
  34 c .____________________________________________________________________.
  35 c . typmes . e   .   1    . 10 : message pour les aretes               .
  36 c .        .     .        . 20 : message pour les noeuds sommets       .
  37 c .        .     .        . 30 : message pour les noeuds milieux       .
  38 c . nbtevr . e   .    1   . nombre de tetraedres voisins d'aretes      .
  39 c . tatevr . e   . nbtevr . tetraedres voisins par aretes              .
  40 c . nbhevr . e   .    1   . nombre d'hexaedres voisins d'aretes        .
  41 c . tahevr . e   . nbhevr . hexaedres voisins par aretes               .
  42 c . nbpyvr . e   .    1   . nombre de pyramides voisines d'aretes      .
  43 c . tapyvr . e   . nbpyvr . pyramides voisines par aretes              .
  44 c . nbpevr . e   .    1   . nombre de pentaedres voisins d'aretes      .
  45 c . tapevr . e   . nbpevr . pentaedres voisins par aretes              .
  46 c . hettet . e   . nbteto . historique de l'etat des tetraedres        .
  47 c . hetpyr . e   . nbpyto . historique de l'etat des pyramides         .
  48 c . hethex . e   . nbheto . historique de l'etat des hexaedres         .
  49 c . hetpen . e   . nbpeto . historique de l'etat des pentaedres        .
  50 c . ulecr  . e   .   1    . unite logique pour l'ecriture              .
  51 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  52 c . langue . e   .    1   . langue des messages                        .
  53 c .        .     .        . 1 : francais, 2 : anglais                  .
  54 c . codret . es  .    1   . code de retour des modules                 .
  55 c .        .     .        . 0 : pas de probleme                        .
  56 c .        .     .        . non nul : probleme                         .
  57 c ______________________________________________________________________
  58 c
  59 c====
  60 c 0. declarations et dimensionnement
  61 c====
  62 c
  63 c 0.1. ==> generalites
  64 c
  65       implicit none
  66       save
  67 c
  68       character*6 nompro
  69       parameter ( nompro = 'INFOVI' )
  70 c
  71 #include "nblang.h"
  72 c
  73 c 0.2. ==> communs
  74 c
  75 #include "envex1.h"
  76 #include "inmess.h"
  77 #include "impr02.h"
  78 c
  79 #include "nombte.h"
  80 #include "nombpy.h"
  81 #include "nombhe.h"
  82 #include "nombpe.h"
  83 #include "hexcf0.h"
  84 #include "hexcf1.h"
  85 c
  86 c 0.3. ==> arguments
  87 c
  88       integer typmes
  89       integer nbtevr, tatevr(nbtevr)
  90       integer nbhevr, tahevr(nbhevr)
  91       integer nbpyvr, tapyvr(nbpyvr)
  92       integer nbpevr, tapevr(nbpevr)
  93       integer hettet(nbteto)
  94       integer hetpyr(nbpyto)
  95       integer hethex(nbheto)
  96       integer hetpen(nbpeto)
  97 c
  98       integer ulecr
  99       integer ulsort, langue, codret
 100 c
 101 c 0.4. ==> variables locales
 102 c
 103       integer iaux
 104       integer etat, bindec
 105       integer letetr, lehexa, lapyra, lepent
 106       integer inditv (0:2,0:2,0:2,0:2)
 107 c
 108       character*40 taux40
 109 c
 110       integer nbmess
 111       parameter ( nbmess = 10 )
 112       character*80 texte(nblang,nbmess)
 113 c ______________________________________________________________________
 114 c
 115 c====
 116 c 1. initialisation
 117 c====
 118 c 1.1. ==> messages
 119 c
 120 #include "impr01.h"
 121 #include "infoen.h"
 122 c
 123 #ifdef _DEBUG_HOMARD_
 124       write (ulsort,texte(langue,1)) 'Entree', nompro
 125       call dmflsh (iaux)
 126 #endif
 127 c
 128 #include "impr03.h"
 129 c
 130 c 1.2. ==> indirections dans les messages
 131 c
 132       inditv(1,0,0,0) = 1 + typmes
 133       inditv(2,0,0,0) = 2 + typmes
 134       inditv(0,1,0,0) = 3 + typmes
 135       inditv(0,2,0,0) = 4 + typmes
 136       inditv(0,0,1,0) = 5 + typmes
 137       inditv(0,0,2,0) = 6 + typmes
 138       inditv(0,0,0,1) = 7 + typmes
 139       inditv(0,0,0,2) = 8 + typmes
 140 c
 141 c====
 142 c 2. tetraedres
 143 c====
 144 c
 145 #ifdef _DEBUG_HOMARD_
 146         write (ulecr,90002) 'nbtevr', nbtevr
 147 #endif
 148 c
 149       if ( nbtevr.gt.0 ) then
 150 c
 151         iaux = min(2,nbtevr)
 152         write (ulecr,40002) textvo(inditv(iaux,0,0,0))
 153 c
 154         do 21 , iaux = 1 , nbtevr
 155           letetr = tatevr(iaux)
 156           etat = mod(hettet(letetr),100)
 157           taux40 = textte(etat)
 158           write (ulecr,46000) letetr, taux40
 159    21   continue
 160 c
 161       endif
 162 c
 163 c====
 164 c 3. hexaedres
 165 c====
 166 c
 167 #ifdef _DEBUG_HOMARD_
 168         write (ulecr,90002) 'nbhevr', nbhevr
 169 #endif
 170 c
 171       if ( nbhevr.gt.0 ) then
 172 c
 173         iaux = min(2,nbhevr)
 174         write (ulecr,40002) textvo(inditv(0,iaux,0,0))
 175 c
 176         do 31 , iaux = 1 , nbhevr
 177           lehexa = tahevr(iaux)
 178           etat = mod(hethex(lehexa),1000)
 179           if ( etat.le.10 ) then
 180             taux40 = texthe(etat)
 181             write (ulecr,46000) lehexa, taux40
 182           else
 183             bindec = chbiet(etat)
 184             if ( etat.le.22 ) then
 185               write (ulecr,46031) lehexa, charde(bindec)(1:3)
 186             elseif ( ( etat.ge.285 ) .and. ( etat.le.290 ) ) then
 187               taux40 = texthe(etat-244)
 188               write (ulecr,46000) lehexa, taux40
 189             else
 190               write (ulecr,46030) lehexa, charde(bindec)(1:27)
 191             endif
 192           endif
 193    31   continue
 194 c
 195       endif
 196 c
 197 c====
 198 c 4. pyramides
 199 c====
 200 c
 201 #ifdef _DEBUG_HOMARD_
 202         write (ulecr,90002) 'nbpyvr', nbpyvr
 203 #endif
 204 c
 205       if ( nbpyvr.gt.0 ) then
 206 c
 207         iaux = min(2,nbpyvr)
 208         write (ulecr,40002) textvo(inditv(0,0,iaux,0))
 209 c
 210         do 41 , iaux = 1 , nbpyvr
 211           lapyra = tapyvr(iaux)
 212           etat = mod(hetpyr(lapyra),100)
 213           taux40 = textpy(etat)
 214           write (ulecr,46000) lapyra, taux40
 215    41   continue
 216 c
 217       endif
 218 c
 219 c====
 220 c 5. pentaedres
 221 c====
 222 c
 223 #ifdef _DEBUG_HOMARD_
 224         write (ulecr,90002) 'nbpevr', nbpevr
 225 #endif
 226 c
 227       if ( nbpevr.gt.0 ) then
 228 c
 229         iaux = min(2,nbpevr)
 230         write (ulecr,40002) textvo(inditv(0,0,0,iaux))
 231 c
 232         do 51 , iaux = 1 , nbpevr
 233           lepent = tapevr(iaux)
 234           etat = mod(hetpen(lepent),100)
 235           taux40 = textpe(etat)
 236           write (ulecr,46000) lepent, taux40
 237    51   continue
 238 c
 239       endif
 240 c
 241 c====
 242 c 6. La fin
 243 c====
 244 c
 245       if ( codret.ne.0 ) then
 246 c
 247 #include "envex2.h"
 248 c
 249       write (ulsort,texte(langue,1)) 'Sortie', nompro
 250       write (ulsort,texte(langue,2)) codret
 251 c
 252       endif
 253 c
 254 #ifdef _DEBUG_HOMARD_
 255       write (ulsort,texte(langue,1)) 'Sortie', nompro
 256       call dmflsh (iaux)
 257 #endif
 258 c
 259       end