src/tool/Decision/deini3.F

   1       subroutine deini3 ( nohind,
   2      >                    nbvtri, nbvqua,
   3      >                    nbvtet, nbvhex, nbvpyr, nbvpen,
   4      >                    ulsort, langue, codret )
   5 c ______________________________________________________________________
   6 c
   7 c                             H O M A R D
   8 c
   9 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  10 c
  11 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  12 c aupres des huissiers de justice Simart et Lavoir a Clamart
  13 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  14 c aupres des huissiers de justice
  15 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  16 c
  17 c    HOMARD est une marque deposee d'Electricite de France
  18 c
  19 c Copyright EDF 1996
  20 c Copyright EDF 1998
  21 c Copyright EDF 2002
  22 c Copyright EDF 2020
  23 c ______________________________________________________________________
  24 c
  25 c traitement des DEcisions - INITialisations - phase 3
  26 c                --          ---                     -
  27 c ______________________________________________________________________
  28 c  Suppressions de structures apres suppression de la conformite :
  29 c  on supprime la branche d'une entite s'il n'y en a plus (nbento=0) et
  30 c  s'il y avait un indicateur auparavant (nbvent>0)
  31 c ______________________________________________________________________
  32 c .        .     .        .                                            .
  33 c .  nom   . e/s . taille .           description                      .
  34 c .____________________________________________________________________.
  35 c . nohind . e   .  ch8   . nom de l'objet contenant l'indicateur      .
  36 c . nbvent . es  .   1    . nombre de valeurs pour l'entite            .
  37 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  38 c . langue . e   .    1   . langue des messages                        .
  39 c .        .     .        . 1 : francais, 2 : anglais                  .
  40 c . codret . es  .    1   . code de retour des modules                 .
  41 c .        .     .        . 0 : pas de probleme                        .
  42 c ______________________________________________________________________
  43 c
  44 c====
  45 c 0. declarations et dimensionnement
  46 c====
  47 c
  48 c 0.1. ==> generalites
  49 c
  50       implicit none
  51       save
  52 c
  53       character*6 nompro
  54       parameter ( nompro = 'DEINI3' )
  55 c
  56 #include "nblang.h"
  57 #include "impr02.h"
  58 c
  59 c 0.2. ==> communs
  60 c
  61 #include "enti01.h"
  62 #include "envex1.h"
  63 #include "nombtr.h"
  64 #include "nombqu.h"
  65 #include "nombte.h"
  66 #include "nombhe.h"
  67 #include "nombpy.h"
  68 #include "nombpe.h"
  69 c
  70 c 0.3. ==> arguments
  71 c
  72       character*8 nohind
  73 c
  74       integer nbvtri, nbvqua
  75       integer nbvtet, nbvhex, nbvpyr, nbvpen
  76 c
  77       integer ulsort, langue, codret
  78 c
  79 c 0.4. ==> variables locales
  80 c
  81       integer iaux, jaux, kaux
  82 c
  83       integer nbmess
  84       parameter ( nbmess = 10 )
  85       character*80 texte(nblang,nbmess)
  86 c
  87 c 0.5. ==> initialisations
  88 c ______________________________________________________________________
  89 c
  90 c====
  91 c 1. messages
  92 c====
  93 c
  94 #include "impr01.h"
  95 c
  96 #ifdef _DEBUG_HOMARD_
  97       write (ulsort,texte(langue,1)) 'Entree', nompro
  98       call dmflsh (iaux)
  99 #endif
 100 c
 101       texte(1,4) = '(''. Suppression de la branche sur les '',a)'
 102 c
 103       texte(2,4) = '(''. Suppression of branch for '',a)'
 104 c
 105 c====
 106 c 2. Par type de mailles
 107 c====
 108 c
 109       do 21 , iaux = 2, 7
 110 c
 111         if ( codret.eq.0 ) then
 112 c
 113         if ( iaux.eq.2 ) then
 114           jaux = nbvtri
 115           kaux = nbtrto
 116         elseif ( iaux.eq.3 ) then
 117           jaux = nbvtet
 118           kaux = nbteto
 119         elseif ( iaux.eq.4 ) then
 120           jaux = nbvqua
 121           kaux = nbquto
 122         elseif ( iaux.eq.5 ) then
 123           jaux = nbvpyr
 124           kaux = nbpyto
 125         elseif ( iaux.eq.6 ) then
 126           jaux = nbvhex
 127           kaux = nbheto
 128         else
 129           jaux = nbvpen
 130           kaux = nbpeto
 131         endif
 132 c
 133         if ( jaux.ne.0 .and. kaux.eq.0 ) then
 134 c
 135 #ifdef _DEBUG_HOMARD_
 136           write (ulsort,texte(langue,4)) mess14(langue,3,iaux)
 137 #endif
 138           call gmsgoj ( nohind//'.'//suffix(1,iaux)(1:5) , codret )
 139 c
 140           if ( codret.eq.0 ) then
 141 c
 142             if ( iaux.eq.2 ) then
 143               nbvtri = 0
 144             elseif ( iaux.eq.3 ) then
 145               nbvtet = 0
 146             elseif ( iaux.eq.4 ) then
 147               nbvqua = 0
 148             elseif ( iaux.eq.5 ) then
 149               nbvpyr = 0
 150             elseif ( iaux.eq.6 ) then
 151               nbvhex = 0
 152             else
 153               nbvpen = 0
 154             endif
 155 c
 156           else
 157 c
 158             jaux = iaux
 159 c
 160           endif
 161 c
 162         endif
 163 c
 164         endif
 165 c
 166    21 continue
 167 c
 168 c====
 169 c 3. la fin
 170 c====
 171 c
 172       if ( codret.ne.0 ) then
 173 c
 174 #include "envex2.h"
 175 c
 176       write (ulsort,texte(langue,1)) 'Sortie', nompro
 177       write (ulsort,texte(langue,2)) codret
 178       write (ulsort,texte(langue,4)) mess14(langue,3,jaux)
 179 c
 180       endif
 181 c
 182 #ifdef _DEBUG_HOMARD_
 183       write (ulsort,texte(langue,1)) 'Sortie', nompro
 184       call dmflsh (iaux)
 185 #endif
 186 c
 187       end