src/tool/Utilitaire/uthcnb.F

   1       subroutine uthcnb ( etdare,
   2      >                    nbreso, nbrear, nbrepy, nbrete, nbrehe,
   3      >                    ulsort, langue, codret )
   4 c ______________________________________________________________________
   5 c
   6 c                             H O M A R D
   7 c
   8 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   9 c
  10 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  11 c aupres des huissiers de justice Simart et Lavoir a Clamart
  12 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  13 c aupres des huissiers de justice
  14 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  15 c
  16 c    HOMARD est une marque deposee d'Electricite de France
  17 c
  18 c Copyright EDF 1996
  19 c Copyright EDF 1998
  20 c Copyright EDF 2002
  21 c Copyright EDF 2020
  22 c ______________________________________________________________________
  23 c
  24 c     UTilitaire : Hexaedre, Conformite - recuperation des NomBres
  25 c     --           -         -                             -  -
  26 c ______________________________________________________________________
  27 c .        .     .        .                                            .
  28 c .  nom   . e/s . taille .           description                      .
  29 c .____________________________________________________________________.
  30 c . etdare . e   .    12  . etat/decision des aretes                   .
  31 c . nbreso .  s  .   1    . nombre de sommets a creer                  .
  32 c . nbrear .  s  .   1    . nombre d'arete a creer                     .
  33 c . nbrepy .  s  .   1    . nombre de pyramides a creer                .
  34 c . nbrete .  s  .   1    . nombre de tetraedres a creer               .
  35 c . nbrehe .  s  .   1    . nombre d'hexaedres a creer                 .
  36 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  37 c . langue . e   .    1   . langue des messages                        .
  38 c .        .     .        . 1 : francais, 2 : anglais                  .
  39 c . codret .  s  .    1   . code de retour des modules                 .
  40 c ______________________________________________________________________
  41 c
  42 c====
  43 c 0. declarations et dimensionnement
  44 c====
  45 c
  46 c 0.1. ==> generalites
  47 c
  48       implicit none
  49       save
  50 c
  51       character*6 nompro
  52       parameter ( nompro = 'UTHCNB' )
  53 c
  54 #include "nblang.h"
  55 c
  56 c 0.2. ==> communs
  57 c
  58 #include "envex1.h"
  59 #include "hexcf0.h"
  60 c
  61 c 0.3. ==> arguments
  62 c
  63       integer etdare(12)
  64       integer nbreso, nbrear, nbrepy, nbrete, nbrehe
  65 c
  66       integer ulsort, langue, codret
  67 c
  68 c 0.4. ==> variables locales
  69 c
  70       integer iaux, jaux
  71 c
  72       integer nbmess
  73       parameter ( nbmess = 10 )
  74       character*80 texte(nblang,nbmess)
  75 c
  76 c 0.5. ==> initialisations
  77 c ______________________________________________________________________
  78 c
  79 c====
  80 c 1. messages
  81 c====
  82 c
  83       codret = 0
  84 c
  85 c 1.2. ==> les messages
  86 c
  87 #include "impr01.h"
  88 c
  89 #ifdef _DEBUG_HOMARD_
  90       write (ulsort,texte(langue,1)) 'Entree', nompro
  91       call dmflsh (iaux)
  92 #endif
  93 c
  94 #include "impr03.h"
  95 c
  96 c====
  97 c 2. les references
  98 c====
  99 c
 100       jaux = etdare(1)
 101       do 20 , iaux = 2, 12
 102 cgn      write(ulsort,90015) 'etdare(', iaux, ') :', etdare
 103         if ( etdare(iaux).gt.0 ) then
 104           jaux = jaux + 2**(iaux-1)
 105         endif
 106    20 continue
 107 cgn      write(ulsort,90002) '==> binaire', jaux
 108 c
 109       nbreso = chnp1(jaux)
 110       nbrear = chnar(jaux)
 111       nbrepy = chnpy(jaux)
 112       nbrete = chnte(jaux)
 113       nbrehe = chnhe(jaux)
 114       if ( nbreso.eq.-1 ) then
 115       write(ulsort,90002) '==> binaire', jaux
 116       write(ulsort,*) 'etdare', etdare
 117       endif
 118 c
 119 c====
 120 c 3. la fin
 121 c====
 122 c
 123       if ( codret.ne.0 ) then
 124 c
 125       call dmflsh(iaux)
 126 c
 127 #include "envex2.h"
 128 c
 129       write (ulsort,texte(langue,1)) 'Sortie', nompro
 130       write (ulsort,texte(langue,2)) codret
 131 c
 132       endif
 133 c
 134 #ifdef _DEBUG_HOMARD_
 135       write (ulsort,texte(langue,1)) 'Sortie', nompro
 136       call dmflsh (iaux)
 137 #endif
 138 c
 139       end