src/tool/Information/infc35.F

   1       subroutine infc35 ( numcas, nbcomp, nbentc,
   2      >                    profil, vafoti, vafotr,
   3      >                    facpyr, cofapy, arepyr,
   4      >                    perpyr, pphepe, npyrca,
   5      >                    coonoe, somare,
   6      >                    aretri, nivtri,
   7      >                    nivqua,
   8      >                    quahex, facpen,
   9      >                    ulsort, langue, codret )
  10 c ______________________________________________________________________
  11 c
  12 c                             H O M A R D
  13 c
  14 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  15 c
  16 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  17 c aupres des huissiers de justice Simart et Lavoir a Clamart
  18 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  19 c aupres des huissiers de justice
  20 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  21 c
  22 c    HOMARD est une marque deposee d'Electricite de France
  23 c
  24 c Copyright EDF 1996
  25 c Copyright EDF 1998
  26 c Copyright EDF 2002
  27 c Copyright EDF 2020
  28 c ______________________________________________________________________
  29 c  INformation - inFormations Complementaires - phase 35
  30 c  --              -          -                       --
  31 c  Valeurs sur les pyramides
  32 c ______________________________________________________________________
  33 c .        .     .        .                                            .
  34 c .  nom   . e/s . taille .           description                      .
  35 c .____________________________________________________________________.
  36 c . numcas . e   .   1    . numero du cas en cours de traitement       .
  37 c .        .     .        . 1 : niveau                                 .
  38 c .        .     .        . 2 : qualite                                .
  39 c .        .     .        . 3 : diametre                               .
  40 c .        .     .        . 4 : parente                                .
  41 c .        .     .        . 5 : voisins des recollements               .
  42 c . nbcomp . e   .   1    . nombre de composantes                      .
  43 c . nbentc . e   .   1    . nombre total d'entites du calcul           .
  44 c . profil .  s  . nbentc . pour chaque entite du calcul :             .
  45 c .        .     .        . 0 : l'entite est absente du profil         .
  46 c .        .     .        . 1 : l'entite est presente dans le profil   .
  47 c . vafoti .  s  . nbentc . tableau temporaire de la fonction          .
  48 c . vafotr .  s  . nbentc . tableau temporaire de la fonction          .
  49 c . facpyr . e   .nbpycf*5. numeros des 5 faces des pyramides          .
  50 c . cofapy . e   .nbpycf*5. codes des faces des pyramides              .
  51 c . arepyr . e   .nbpyca*8. numeros des 8 aretes des pyramides         .
  52 c . perpyr . e   . nbpyto . pere des pyramides                         .
  53 c .        .     .        . si perpyr(i) > 0 : numero de la pyramide   .
  54 c .        .     .        . si perpyr(i) < 0 : -numero dans pphepe     .
  55 c . pphepe . e   .    *   . si i <= nbheco : numero de l'hexaedre      .
  56 c .        .     .        . si non : numero du pentaedre               .
  57 c . npyrca . e   .   *    . nro des pyramides dans le calcul           .
  58 c . coonoe . e   . nbnoto . coordonnees des noeuds                     .
  59 c .        .     . * sdim .                                            .
  60 c . somare . e   .2*nbarto. numeros des extremites d'arete             .
  61 c . aretri . e   .nbtrto*3. numeros des 3 aretes des triangles         .
  62 c . nivtri . e   . nbtrto . niveau dans le raffinement/deraffinement   .
  63 c . nivqua . e   . nbquto . niveau dans le raffinement/deraffinement   .
  64 c . quahex . e   .nbhecf*6. numeros des 6 quadrangles des hexaedres    .
  65 c . facpen . e   .nbpecf*5. numeros des 5 faces des pentaedres         .
  66 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  67 c . langue . e   .    1   . langue des messages                        .
  68 c .        .     .        . 1 : francais, 2 : anglais                  .
  69 c . codret . es  .    1   . code de retour des modules                 .
  70 c .        .     .        . 0 : pas de probleme                        .
  71 c .        .     .        . 5 : mauvais type de code de calcul associe .
  72 c ______________________________________________________________________
  73 c
  74 c====
  75 c 0. declarations et dimensionnement
  76 c====
  77 c
  78 c 0.1. ==> generalites
  79 c
  80       implicit none
  81       save
  82 c
  83       character*6 nompro
  84       parameter ( nompro = 'INFC35' )
  85 c
  86 #include "nblang.h"
  87 c
  88 c 0.2. ==> communs
  89 c
  90 #include "envex1.h"
  91 #include "envca1.h"
  92 #include "impr02.h"
  93 #include "nombno.h"
  94 #include "nombar.h"
  95 #include "nombtr.h"
  96 #include "nombqu.h"
  97 #include "nombpy.h"
  98 #include "nombhe.h"
  99 #include "nombpe.h"
 100 c
 101 c 0.3. ==> arguments
 102 c
 103       integer numcas
 104       integer nbcomp, nbentc
 105       integer profil(nbentc)
 106       integer vafoti(nbentc)
 107       integer facpyr(nbpycf,5), cofapy(nbpycf,5), arepyr(nbpyca,8)
 108       integer perpyr(nbpyto), pphepe(*), npyrca(*)
 109       integer somare(2,nbarto)
 110       integer aretri(nbtrto,3), nivtri(nbtrto)
 111       integer nivqua(nbquto)
 112       integer quahex(nbhecf,6)
 113       integer facpen(nbpecf,5)
 114 c
 115       double precision coonoe(nbnoto,sdim)
 116       double precision vafotr(nbentc)
 117 c
 118       integer ulsort, langue, codret
 119 c
 120 c 0.4. ==> variables locales
 121 c
 122       integer iaux, jaux, kaux
 123 c
 124       double precision niveau, qualit, qualij, volume, diamet
 125 c
 126       integer nbmess
 127       parameter ( nbmess = 10 )
 128       character*80 texte(nblang,nbmess)
 129 c
 130 c 0.5. ==> initialisations
 131 c ______________________________________________________________________
 132 c
 133 c====
 134 c 1. messages
 135 c====
 136 c
 137 #include "impr01.h"
 138 #include "impr03.h"
 139 c
 140 #ifdef _DEBUG_HOMARD_
 141       write (ulsort,texte(langue,1)) 'Entree', nompro
 142       call dmflsh (iaux)
 143 #endif
 144       texte(1,4) = '(''.. Valeurs sur les '',a)'
 145 c
 146       texte(2,4) = '(''.. Values over the '',a)'
 147 c
 148 #ifdef _DEBUG_HOMARD_
 149       write (ulsort,texte(langue,4)) mess14(langue,3,5)
 150       write (ulsort,90002) 'numcas', numcas
 151       write (ulsort,90002) 'nbpyto', nbpyto
 152       write (ulsort,90002) 'nbpype', nbpype
 153       write (ulsort,90002) 'nbpycf', nbpycf
 154       write (ulsort,90002) 'nbentc', nbentc
 155 #endif
 156 c
 157       codret = 0
 158 c
 159 c====
 160 c 2. Rien par defaut
 161 c====
 162 c
 163       do 21 , iaux = 1 , nbentc
 164         profil(iaux) = 0
 165    21 continue
 166 c
 167 c====
 168 c 3. Niveau
 169 c====
 170 c
 171       if ( numcas.eq.1 ) then
 172 c
 173 c 3.1. ==> Les pyramides de depart ou issus d'un decoupage en 8
 174 c          Les faces sont toutes du meme niveau
 175 c          Remarque : elles sont toujours decrites par faces
 176 c
 177         do 31 , iaux = 1 , nbpype
 178 c
 179 cgn      write (ulsort,90015) 'npyrca(',iaux,') =', npyrca(iaux)
 180 cgn      write (ulsort,90015) 'nivtri(',iaux,') =', nivtri(iaux)
 181 c
 182           jaux = npyrca(iaux)
 183           if ( jaux.ne.0 ) then
 184             vafotr(jaux) = dble(nivtri(facpyr(iaux,1)))
 185             profil(jaux) = 1
 186           endif
 187 c
 188    31   continue
 189 c
 190 c 3.2. ==> Les pyramides issues d'un decoupage de conformite
 191 c          Remarque : elles sont toujours actives
 192 c
 193         do 32 , iaux = nbpype+1 , nbpyto
 194 c
 195           call utnpyr ( iaux, niveau,
 196      >                  facpyr, perpyr, pphepe,
 197      >                  nivtri, nivqua,
 198      >                  quahex, facpen )
 199 c
 200           jaux = npyrca(iaux)
 201           vafotr(jaux) = niveau
 202           profil(jaux) = 1
 203 c
 204    32   continue
 205 c
 206 c====
 207 c 4. Qualite
 208 c====
 209 c
 210       elseif ( numcas.eq.2 ) then
 211 c
 212         do 41 , iaux = 1 , nbpyto
 213 c
 214           jaux = npyrca(iaux)
 215           if ( jaux.ne.0 ) then
 216             kaux = iaux
 217             call utqpyr ( kaux, qualit, qualij, volume,
 218      >                    coonoe, somare, aretri,
 219      >                    facpyr, cofapy, arepyr )
 220             vafotr(jaux) = qualit
 221             profil(jaux) = 1
 222 c
 223           endif
 224 c
 225    41   continue
 226 c
 227 c====
 228 c 5. Diametre
 229 c====
 230 c
 231       elseif ( numcas.eq.3 ) then
 232 c
 233         do 51 , iaux = 1 , nbpyto
 234 c
 235           jaux = npyrca(iaux)
 236           if ( jaux.ne.0 ) then
 237             kaux = iaux
 238             call utdpyr ( kaux, diamet,
 239      >                    coonoe, somare, aretri,
 240      >                    facpyr, cofapy, arepyr )
 241             vafotr(jaux) = diamet
 242             profil(jaux) = 1
 243 c
 244           endif
 245 c
 246    51   continue
 247 c
 248 c====
 249 c 6. Parente
 250 c====
 251 c
 252       elseif ( numcas.eq.4 ) then
 253 c
 254         do 61 , iaux = 1 , nbpyto
 255 c
 256           jaux = npyrca(iaux)
 257           if ( jaux.ne.0 ) then
 258             vafoti(jaux) = perpyr(iaux)
 259             profil(jaux) = 1
 260           endif
 261 c
 262    61   continue
 263 c
 264       endif
 265 c
 266 c====
 267 c 7. la fin
 268 c====
 269 c
 270       if ( codret.ne.0 ) then
 271 c
 272 #include "envex2.h"
 273 c
 274       write (ulsort,texte(langue,1)) 'Sortie', nompro
 275       write (ulsort,texte(langue,2)) codret
 276 c
 277       endif
 278 c
 279 #ifdef _DEBUG_HOMARD_
 280       write (ulsort,texte(langue,1)) 'Sortie', nompro
 281       call dmflsh (iaux)
 282 #endif
 283 c
 284       end