src/tool/Decision/deinbi.F

   1       subroutine deinbi ( nbvent, ncmpin,
   2      >                    nosupp, noindi,
   3      >                    arsupp, arindi,
   4      >                    trsupp, trindi,
   5      >                    qusupp, quindi,
   6      >                    tesupp, teindi,
   7      >                    hesupp, heindi,
   8      >                    pysupp, pyindi,
   9      >                    pesupp, peindi,
  10      >                    ulsort, langue, codret)
  11 c ______________________________________________________________________
  12 c
  13 c                             H O M A R D
  14 c
  15 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  16 c
  17 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  18 c aupres des huissiers de justice Simart et Lavoir a Clamart
  19 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  20 c aupres des huissiers de justice
  21 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  22 c
  23 c    HOMARD est une marque deposee d'Electricite de France
  24 c
  25 c Copyright EDF 1996
  26 c Copyright EDF 1998
  27 c Copyright EDF 2002
  28 c Copyright EDF 2020
  29 c ______________________________________________________________________
  30 c
  31 c traitement des DEcisions - INitialisations - BIlan
  32 c                --          --                --
  33 c    impression des histogrammes
  34 c ______________________________________________________________________
  35 c .        .     .        .                                            .
  36 c .  nom   . e/s . taille .           description                      .
  37 c .____________________________________________________________________.
  38 c . nbvent .  e .   -1:7  . nombre d'entites actives pour chaque type  .
  39 c .        .     .        . d'element au sens HOMARD avec indicateur   .
  40 c . ncmpin .  e  .   1    . nombre de composantes de l'indicateur      .
  41 c . nosupp . e   . nbnoto . support pour les noeuds                    .
  42 c . noindi . e   . nbnoto . valeurs pour les noeuds                    .
  43 c . arsupp . e   . nbarto . support pour les aretes                    .
  44 c . arindi . e   . nbarto . valeurs pour les aretes                    .
  45 c . trsupp . e   . nbtrto . support pour les triangles                 .
  46 c . trindi . e   . nbtrto . valeurs pour les triangles                 .
  47 c . qusupp . e   . nbquto . support pour les quadrangles               .
  48 c . quindi . e   . nbquto . valeurs pour les quadrangles               .
  49 c . tesupp . e   . nbteto . support pour les tetraedres                .
  50 c . teindi . e   . nbteto . valeurs pour les tetraedres                .
  51 c . hesupp . e   . nbheto . support pour les hexaedres                 .
  52 c . heindi . e   . nbheto . valeurs pour les hexaedres                 .
  53 c . pysupp . e   . nbpyto . support pour les pyramides                 .
  54 c . pyindi . e   . nbpyto . valeurs pour les pyramides                 .
  55 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  56 c . langue . e   .    1   . langue des messages                        .
  57 c .        .     .        . 1 : francais, 2 : anglais                  .
  58 c . codret . es  .    1   . code de retour des modules                 .
  59 c .        .     .        . 0 : pas de probleme                        .
  60 c .        .     .        . 3 : probleme dans les fichiers             .
  61 c ______________________________________________________________________
  62 c
  63 c====
  64 c 0. declarations et dimensionnement
  65 c====
  66 c
  67 c 0.1. ==> generalites
  68 c
  69       implicit none
  70       save
  71 c
  72       character*6 nompro
  73       parameter ( nompro = 'DEINBI' )
  74 c
  75 #include "nblang.h"
  76 c
  77 c 0.2. ==> communs
  78 c
  79 #include "envex1.h"
  80 c
  81 #include "nombno.h"
  82 #include "nombar.h"
  83 #include "nombtr.h"
  84 #include "nombqu.h"
  85 #include "nombte.h"
  86 #include "nombhe.h"
  87 #include "nombpy.h"
  88 #include "nombpe.h"
  89 c
  90 c 0.3. ==> arguments
  91 c
  92       integer nbvent(-1:7)
  93       integer ncmpin
  94       integer nosupp(nbnoto)
  95       integer arsupp(nbarto)
  96       integer trsupp(nbtrto)
  97       integer qusupp(nbquto)
  98       integer tesupp(nbteto)
  99       integer hesupp(nbheto)
 100       integer pysupp(nbpyto)
 101       integer pesupp(nbpeto)
 102 c
 103       integer ulsort, langue, codret
 104 c
 105       double precision noindi(nbnoto,ncmpin)
 106       double precision arindi(nbarto,ncmpin)
 107       double precision trindi(nbtrto,ncmpin)
 108       double precision quindi(nbquto,ncmpin)
 109       double precision teindi(nbteto,ncmpin)
 110       double precision heindi(nbheto,ncmpin)
 111       double precision pyindi(nbpyto,ncmpin)
 112       double precision peindi(nbpeto,ncmpin)
 113 c
 114 c 0.4. ==> variables locales
 115 c
 116       integer iaux
 117 c
 118       integer nbmess
 119       parameter ( nbmess = 10 )
 120       character*80 texte(nblang,nbmess)
 121 c
 122 c 0.5. ==> initialisations
 123 c ______________________________________________________________________
 124 c
 125 c====
 126 c 1. initialisations
 127 c====
 128 c
 129 #include "impr01.h"
 130 c
 131 #ifdef _DEBUG_HOMARD_
 132       write (ulsort,texte(langue,1)) 'Entree', nompro
 133       call dmflsh (iaux)
 134 #endif
 135 c
 136 c====
 137 c 2. impression selon le type d'entite
 138 c====
 139 c
 140 c 2.1. ==> au moins un indicateur est exprime sur les tetraedres
 141 c
 142       iaux = 3
 143       if ( nbvent(iaux).gt.0 ) then
 144 c
 145 #ifdef _DEBUG_HOMARD_
 146         write (ulsort,texte(langue,3)) 'DEINB1_te', nompro
 147 #endif
 148         call deinb1 ( iaux, nbteto, ncmpin,
 149      >                tesupp, teindi,
 150      >                ulsort, langue, codret)
 151 c
 152       endif
 153 c
 154 c 2.2. ==> au moins un indicateur est exprime sur les quadrangles
 155 c
 156       iaux = 4
 157       if ( nbvent(iaux).gt.0 ) then
 158 c
 159 #ifdef _DEBUG_HOMARD_
 160         write (ulsort,texte(langue,3)) 'DEINB1_qu', nompro
 161 #endif
 162         call deinb1 ( iaux, nbquto, ncmpin,
 163      >                qusupp, quindi,
 164      >                ulsort, langue, codret)
 165 c
 166       endif
 167 c
 168 c 2.3. ==> au moins un indicateur est exprime sur les triangles
 169 c
 170       iaux = 2
 171       if ( nbvent(iaux).gt.0 ) then
 172 c
 173 #ifdef _DEBUG_HOMARD_
 174         write (ulsort,texte(langue,3)) 'DEINB1_tr', nompro
 175 #endif
 176         call deinb1 ( iaux, nbtrto, ncmpin,
 177      >                trsupp, trindi,
 178      >                ulsort, langue, codret)
 179 c
 180       endif
 181 c
 182 c 2.4. ==> au moins un indicateur est exprime sur les aretes
 183 c
 184       iaux = 1
 185       if ( nbvent(iaux).gt.0 ) then
 186 c
 187 #ifdef _DEBUG_HOMARD_
 188         write (ulsort,texte(langue,3)) 'DEINB1_ar', nompro
 189 #endif
 190         call deinb1 ( iaux, nbarto, ncmpin,
 191      >                arsupp, arindi,
 192      >                ulsort, langue, codret)
 193 c
 194       endif
 195 c
 196 c 2.5. ==> au moins un indicateur est exprime sur les noeuds
 197 c
 198       iaux = -1
 199       if ( nbvent(iaux).gt.0 ) then
 200 c
 201 #ifdef _DEBUG_HOMARD_
 202         write (ulsort,texte(langue,3)) 'DEINB1_no', nompro
 203 #endif
 204         call deinb1 ( iaux, nbnoto, ncmpin,
 205      >                nosupp, noindi,
 206      >                ulsort, langue, codret)
 207 c
 208       endif
 209 c
 210 c 2.5. ==> au moins un indicateur est exprime sur les pyramides
 211 c
 212       iaux = 5
 213       if ( nbvent(iaux).gt.0 ) then
 214 c
 215 #ifdef _DEBUG_HOMARD_
 216         write (ulsort,texte(langue,3)) 'DEINB1_py', nompro
 217 #endif
 218         call deinb1 ( iaux, nbpyto, ncmpin,
 219      >                pysupp, pyindi,
 220      >                ulsort, langue, codret)
 221 c
 222       endif
 223 c
 224 c 2.5. ==> au moins un indicateur est exprime sur les hexaedres
 225 c
 226       iaux = 6
 227       if ( nbvent(iaux).gt.0 ) then
 228 c
 229 #ifdef _DEBUG_HOMARD_
 230         write (ulsort,texte(langue,3)) 'DEINB1_he', nompro
 231 #endif
 232         call deinb1 ( iaux, nbheto, ncmpin,
 233      >                hesupp, heindi,
 234      >                ulsort, langue, codret)
 235 c
 236       endif
 237 c
 238 c 2.6. ==> au moins un indicateur est exprime sur les pentaedres
 239 c
 240       iaux = 7
 241       if ( nbvent(iaux).gt.0 ) then
 242 c
 243 #ifdef _DEBUG_HOMARD_
 244         write (ulsort,texte(langue,3)) 'DEINB1_pe', nompro
 245 #endif
 246         call deinb1 ( iaux, nbpeto, ncmpin,
 247      >                pesupp, peindi,
 248      >                ulsort, langue, codret)
 249 c
 250       endif
 251 c
 252 c====
 253 c 3. la fin
 254 c====
 255 c
 256       if ( codret.ne.0 ) then
 257 c
 258 #include "envex2.h"
 259 c
 260       write (ulsort,texte(langue,1)) 'Sortie', nompro
 261       write (ulsort,texte(langue,2)) codret
 262 c
 263       endif
 264 c
 265 #ifdef _DEBUG_HOMARD_
 266       write (ulsort,texte(langue,1)) 'Sortie', nompro
 267       call dmflsh (iaux)
 268 #endif
 269 c
 270       end