src/tool/Decision/decpte.F

   1       subroutine decpte ( pilraf, pilder,
   2      >                    decare, decfac,
   3      >                    hettri, hetqua,
   4      >                    tritet, hettet,
   5      >                    quahex, hethex,
   6      >                    facpyr, hetpyr,
   7      >                    facpen, hetpen,
   8      >                    ulsort, langue, codret )
   9 c
  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
  30 c traitement des DEcisions - ComPTagE
  31 c                --          -  --  -
  32 c ______________________________________________________________________
  33 c .        .     .        .                                            .
  34 c .  nom   . e/s . taille .           description                      .
  35 c .____________________________________________________________________.
  36 c . pilraf . e   .   1    . pilotage du raffinement                    .
  37 c .        .     .        . -1 : raffinement uniforme                  .
  38 c .        .     .        .  0 : pas de raffinement                    .
  39 c .        .     .        .  1 : raffinement libre                     .
  40 c .        .     .        .  2 : raff. libre homogene en type d'element.
  41 c . pilder . e   .   1    . pilotage du deraffinement                  .
  42 c .        .     .        . 0 : pas de deraffinement                   .
  43 c .        .     .        . 1 : deraffinement libre                    .
  44 c .        .     .        . -1 : deraffinement uniforme                .
  45 c . decare . e   .0:nbarto. decisions des aretes                       .
  46 c . decfac . e   . -nbquto. decision sur les faces (quad. + tri.)      .
  47 c .        .     . :nbtrto.                                            .
  48 c . hettri . e   . nbtrto . historique de l'etat des triangles         .
  49 c . hetqua . e   . nbquto . historique de l'etat des quadrangles       .
  50 c . tritet . e   .nbtecf*4. numeros des 4 triangles des tetraedres     .
  51 c . hettet . e   . nbteto . historique de l'etat des tetraedres        .
  52 c . quahex . e   .nbhecf*6. numeros des 6 quadrangles des hexaedres    .
  53 c . hethex . e   . nbheto . historique de l'etat des hexaedres         .
  54 c . facpyr . e   .nbpycf*5. numeros des 5 faces des pyramides          .
  55 c . hetpyr . e   . nbpyto . historique de l'etat des pyramides         .
  56 c . facpen . e   .nbpecf*5. numeros des faces des pentaedres           .
  57 c . hetpen . e   . nbpeto . historique de l'etat des pentaedres        .
  58 c . ulsort . e   .   1    . unite logique de la sortie generale        .
  59 c . langue . e   .    1   . langue des messages                        .
  60 c .        .     .        . 1 : francais, 2 : anglais                  .
  61 c . codret .  s  .    1   . code de retour des modules                 .
  62 c .        .     .        . 0 : pas de probleme                        .
  63 c .        .     .        . 1 : probleme                               .
  64 c ______________________________________________________________________
  65 c
  66 c====
  67 c 0. declarations et dimensionnement
  68 c====
  69 c
  70 c 0.1. ==> generalites
  71 c
  72       implicit none
  73       save
  74 c
  75       character*6 nompro
  76       parameter ( nompro = 'DECPTE' )
  77 c
  78 #include "nblang.h"
  79 c
  80 c 0.2. ==> communs
  81 c
  82 #include "envex1.h"
  83 c
  84 #include "envada.h"
  85 #include "nombar.h"
  86 #include "nombtr.h"
  87 #include "nombqu.h"
  88 #include "nombte.h"
  89 #include "nombhe.h"
  90 #include "nombpy.h"
  91 #include "nombpe.h"
  92 #include "impr02.h"
  93 c
  94 c 0.3. ==> arguments
  95 c
  96       integer pilraf, pilder
  97       integer decare(0:nbarto), decfac(-nbquto:nbtrto)
  98       integer hettri(nbtrto)
  99       integer hetqua(nbquto)
 100       integer hettet(nbteto), tritet(nbtecf,4)
 101       integer hethex(nbheto), quahex(nbhecf,6)
 102       integer hetpyr(nbpyto), facpyr(nbpycf,5)
 103       integer hetpen(nbpeto), facpen(nbpecf,5)
 104 c
 105       integer ulsort, langue, codret
 106 c
 107 c 0.4. ==> variables locales
 108 c
 109       integer iaux
 110 c
 111       integer narde2, narra2
 112       integer ntrde4, ntrra4
 113       integer nqude4, nqura4
 114       integer ntede8, ntera8
 115       integer nhede8, nhera8
 116       integer npyder, npyraf
 117       integer npeder, nperaf
 118 c
 119       integer nbmess
 120       parameter (nbmess = 10 )
 121       character*80 texte(nblang,nbmess)
 122 c ______________________________________________________________________
 123 c
 124 c====
 125 c 1. messages
 126 c====
 127 c
 128 #include "impr01.h"
 129 c
 130 #ifdef _DEBUG_HOMARD_
 131       write (ulsort,texte(langue,1)) 'Entree', nompro
 132       call dmflsh (iaux)
 133 #endif
 134 c
 135       texte(1,4) =
 136      > '(/,7x,''Nombre de '',a,'' a decouper en '',i1,''  : '',i10)'
 137       texte(1,5) =
 138      > '(/,7x,''Nombre de '',a,'' a reactiver      : '',i10)'
 139       texte(1,6) =
 140      > '(/,7x,''Nombre de '',a,'' a decouper       : '',i10)'
 141 c
 142       texte(2,4) =
 143      > '(/,7x,''Number of '',a,'' to divide into '',i1,'' : '',i10)'
 144       texte(2,5) =
 145      > '(/,7x,''Number of '',a,'' to reactivate    : '',i10)'
 146       texte(2,6) =
 147      > '(/,7x,''Number of '',a,'' to divide  : '',i10)'
 148 c
 149       codret = 0
 150 c
 151 #include "impr03.h"
 152 c
 153 c====
 154 c 2. decompte des entites a decouper et a supprimer et impressions
 155 c====
 156 c
 157 #ifdef _DEBUG_HOMARD_
 158       write (ulsort,texte(langue,3)) 'DECPT0', nompro
 159 #endif
 160       call decpt0 ( decare, decfac,
 161      >              hettri, hetqua,
 162      >              tritet, hettet,
 163      >              quahex, hethex,
 164      >              facpyr, hetpyr,
 165      >              facpen, hetpen,
 166      >              narde2, narra2,
 167      >          ntrde4, ntrra4,
 168      >          nqude4, nqura4,
 169      >          ntede8, ntera8,
 170      >          nhede8, nhera8,
 171      >          npyder, npyraf,
 172      >          npeder, nperaf,
 173      >          ulsort, langue, codret )
 174 c
 175 c====
 176 c 3. impressions
 177 c====
 178 #ifdef _DEBUG_HOMARD_
 179       write (ulsort,90002) '3. impressions ; codret', codret
 180 #endif
 181 c
 182 c 3.1. ==> raffinement
 183 c
 184 #ifdef _DEBUG_HOMARD_
 185       if ( pilraf.ne.-100 ) then
 186 #else
 187       if ( pilraf.ne.0 ) then
 188 #endif
 189 c
 190         if ( nbteto.ne.0 ) then
 191           write(ulsort,texte(langue,4)) mess14(langue,3,3), 8, ntera8
 192         endif
 193         if ( nbheto.ne.0 ) then
 194           write(ulsort,texte(langue,4)) mess14(langue,3,6), 8, nhera8
 195         endif
 196         if ( nbpyto.ne.0 ) then
 197           write(ulsort,texte(langue,6)) mess14(langue,3,5), npyraf
 198         endif
 199         if ( nbpeto.ne.0 ) then
 200           write(ulsort,texte(langue,4)) mess14(langue,3,7), 8, nperaf
 201         endif
 202         if ( nbquto.ne.0 ) then
 203           write(ulsort,texte(langue,4)) mess14(langue,3,4), 4, nqura4
 204         endif
 205         if ( nbtrto.ne.0 ) then
 206           write(ulsort,texte(langue,4)) mess14(langue,3,2), 4, ntrra4
 207         endif
 208         write(ulsort,texte(langue,4)) mess14(langue,3,1), 2, narra2
 209 c
 210       endif
 211 c
 212 c 3.2. ==> deraffinement
 213 c
 214       if ( nbiter.gt.0 ) then
 215 c
 216 #ifdef _DEBUG_HOMARD_
 217       if ( pilder.ne.-100 ) then
 218 #else
 219       if ( pilder.ne.0 ) then
 220 #endif
 221 c
 222         if ( nbteto.ne.0 ) then
 223           write(ulsort,texte(langue,5)) mess14(langue,3,3), ntede8
 224         endif
 225         if ( nbheto.ne.0 ) then
 226           write(ulsort,texte(langue,5)) mess14(langue,3,6), nhede8
 227         endif
 228         if ( nbpyto.ne.0 ) then
 229           write(ulsort,texte(langue,5)) mess14(langue,3,5), npyder
 230         endif
 231         if ( nbpeto.ne.0 ) then
 232           write(ulsort,texte(langue,5)) mess14(langue,3,7), npeder
 233         endif
 234         if ( nbquto.ne.0 ) then
 235           write(ulsort,texte(langue,5)) mess14(langue,3,4), nqude4
 236         endif
 237         if ( nbtrto.ne.0 ) then
 238           write(ulsort,texte(langue,5)) mess14(langue,3,2), ntrde4
 239         endif
 240         write(ulsort,texte(langue,5)) mess14(langue,3,1), narde2
 241 c
 242       endif
 243 c
 244       endif
 245 c
 246       write(ulsort,*) ' '
 247 c
 248 c====
 249 c 4. la fin
 250 c====
 251 c
 252       if ( codret.ne.0 ) then
 253 c
 254 #include "envex2.h"
 255 c
 256       write (ulsort,texte(langue,1)) 'Sortie', nompro
 257       write (ulsort,texte(langue,2)) codret
 258 c
 259       endif
 260 c
 261 #ifdef _DEBUG_HOMARD_
 262       write (ulsort,texte(langue,1)) 'Sortie', nompro
 263       call dmflsh (iaux)
 264 #endif
 265 c
 266       end