--- /dev/null
+ subroutine decpte ( pilraf, pilder,
+ > decare, decfac,
+ > hettri, hetqua,
+ > tritet, hettet,
+ > quahex, hethex,
+ > facpyr, hetpyr,
+ > facpen, hetpen,
+ > ulsort, langue, codret )
+c
+c ______________________________________________________________________
+c
+c H O M A R D
+c
+c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
+c
+c Version originale enregistree le 18 juin 1996 sous le numero 96036
+c aupres des huissiers de justice Simart et Lavoir a Clamart
+c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
+c aupres des huissiers de justice
+c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
+c
+c HOMARD est une marque deposee d'Electricite de France
+c
+c Copyright EDF 1996
+c Copyright EDF 1998
+c Copyright EDF 2002
+c Copyright EDF 2020
+c ______________________________________________________________________
+c
+c traitement des DEcisions - ComPTagE
+c -- - -- -
+c ______________________________________________________________________
+c . . . . .
+c . nom . e/s . taille . description .
+c .____________________________________________________________________.
+c . pilraf . e . 1 . pilotage du raffinement .
+c . . . . -1 : raffinement uniforme .
+c . . . . 0 : pas de raffinement .
+c . . . . 1 : raffinement libre .
+c . . . . 2 : raff. libre homogene en type d'element.
+c . pilder . e . 1 . pilotage du deraffinement .
+c . . . . 0 : pas de deraffinement .
+c . . . . 1 : deraffinement libre .
+c . . . . -1 : deraffinement uniforme .
+c . decare . e .0:nbarto. decisions des aretes .
+c . decfac . e . -nbquto. decision sur les faces (quad. + tri.) .
+c . . . :nbtrto. .
+c . hettri . e . nbtrto . historique de l'etat des triangles .
+c . hetqua . e . nbquto . historique de l'etat des quadrangles .
+c . tritet . e .nbtecf*4. numeros des 4 triangles des tetraedres .
+c . hettet . e . nbteto . historique de l'etat des tetraedres .
+c . quahex . e .nbhecf*6. numeros des 6 quadrangles des hexaedres .
+c . hethex . e . nbheto . historique de l'etat des hexaedres .
+c . facpyr . e .nbpycf*5. numeros des 5 faces des pyramides .
+c . hetpyr . e . nbpyto . historique de l'etat des pyramides .
+c . facpen . e .nbpecf*5. numeros des faces des pentaedres .
+c . hetpen . e . nbpeto . historique de l'etat des pentaedres .
+c . ulsort . e . 1 . unite logique de la sortie generale .
+c . langue . e . 1 . langue des messages .
+c . . . . 1 : francais, 2 : anglais .
+c . codret . s . 1 . code de retour des modules .
+c . . . . 0 : pas de probleme .
+c . . . . 1 : probleme .
+c ______________________________________________________________________
+c
+c====
+c 0. declarations et dimensionnement
+c====
+c
+c 0.1. ==> generalites
+c
+ implicit none
+ save
+c
+ character*6 nompro
+ parameter ( nompro = 'DECPTE' )
+c
+#include "nblang.h"
+c
+c 0.2. ==> communs
+c
+#include "envex1.h"
+c
+#include "envada.h"
+#include "nombar.h"
+#include "nombtr.h"
+#include "nombqu.h"
+#include "nombte.h"
+#include "nombhe.h"
+#include "nombpy.h"
+#include "nombpe.h"
+#include "impr02.h"
+c
+c 0.3. ==> arguments
+c
+ integer pilraf, pilder
+ integer decare(0:nbarto), decfac(-nbquto:nbtrto)
+ integer hettri(nbtrto)
+ integer hetqua(nbquto)
+ integer hettet(nbteto), tritet(nbtecf,4)
+ integer hethex(nbheto), quahex(nbhecf,6)
+ integer hetpyr(nbpyto), facpyr(nbpycf,5)
+ integer hetpen(nbpeto), facpen(nbpecf,5)
+c
+ integer ulsort, langue, codret
+c
+c 0.4. ==> variables locales
+c
+ integer iaux
+c
+ integer narde2, narra2
+ integer ntrde4, ntrra4
+ integer nqude4, nqura4
+ integer ntede8, ntera8
+ integer nhede8, nhera8
+ integer npyder, npyraf
+ integer npeder, nperaf
+c
+ integer nbmess
+ parameter (nbmess = 10 )
+ character*80 texte(nblang,nbmess)
+c ______________________________________________________________________
+c
+c====
+c 1. messages
+c====
+c
+#include "impr01.h"
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,1)) 'Entree', nompro
+ call dmflsh (iaux)
+#endif
+c
+ texte(1,4) =
+ > '(/,7x,''Nombre de '',a,'' a decouper en '',i1,'' : '',i10)'
+ texte(1,5) =
+ > '(/,7x,''Nombre de '',a,'' a reactiver : '',i10)'
+ texte(1,6) =
+ > '(/,7x,''Nombre de '',a,'' a decouper : '',i10)'
+c
+ texte(2,4) =
+ > '(/,7x,''Number of '',a,'' to divide into '',i1,'' : '',i10)'
+ texte(2,5) =
+ > '(/,7x,''Number of '',a,'' to reactivate : '',i10)'
+ texte(2,6) =
+ > '(/,7x,''Number of '',a,'' to divide : '',i10)'
+c
+ codret = 0
+c
+#include "impr03.h"
+c
+c====
+c 2. decompte des entites a decouper et a supprimer et impressions
+c====
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,3)) 'DECPT0', nompro
+#endif
+ call decpt0 ( decare, decfac,
+ > hettri, hetqua,
+ > tritet, hettet,
+ > quahex, hethex,
+ > facpyr, hetpyr,
+ > facpen, hetpen,
+ > narde2, narra2,
+ > ntrde4, ntrra4,
+ > nqude4, nqura4,
+ > ntede8, ntera8,
+ > nhede8, nhera8,
+ > npyder, npyraf,
+ > npeder, nperaf,
+ > ulsort, langue, codret )
+c
+c====
+c 3. impressions
+c====
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,90002) '3. impressions ; codret', codret
+#endif
+c
+c 3.1. ==> raffinement
+c
+#ifdef _DEBUG_HOMARD_
+ if ( pilraf.ne.-100 ) then
+#else
+ if ( pilraf.ne.0 ) then
+#endif
+c
+ if ( nbteto.ne.0 ) then
+ write(ulsort,texte(langue,4)) mess14(langue,3,3), 8, ntera8
+ endif
+ if ( nbheto.ne.0 ) then
+ write(ulsort,texte(langue,4)) mess14(langue,3,6), 8, nhera8
+ endif
+ if ( nbpyto.ne.0 ) then
+ write(ulsort,texte(langue,6)) mess14(langue,3,5), npyraf
+ endif
+ if ( nbpeto.ne.0 ) then
+ write(ulsort,texte(langue,4)) mess14(langue,3,7), 8, nperaf
+ endif
+ if ( nbquto.ne.0 ) then
+ write(ulsort,texte(langue,4)) mess14(langue,3,4), 4, nqura4
+ endif
+ if ( nbtrto.ne.0 ) then
+ write(ulsort,texte(langue,4)) mess14(langue,3,2), 4, ntrra4
+ endif
+ write(ulsort,texte(langue,4)) mess14(langue,3,1), 2, narra2
+c
+ endif
+c
+c 3.2. ==> deraffinement
+c
+ if ( nbiter.gt.0 ) then
+c
+#ifdef _DEBUG_HOMARD_
+ if ( pilder.ne.-100 ) then
+#else
+ if ( pilder.ne.0 ) then
+#endif
+c
+ if ( nbteto.ne.0 ) then
+ write(ulsort,texte(langue,5)) mess14(langue,3,3), ntede8
+ endif
+ if ( nbheto.ne.0 ) then
+ write(ulsort,texte(langue,5)) mess14(langue,3,6), nhede8
+ endif
+ if ( nbpyto.ne.0 ) then
+ write(ulsort,texte(langue,5)) mess14(langue,3,5), npyder
+ endif
+ if ( nbpeto.ne.0 ) then
+ write(ulsort,texte(langue,5)) mess14(langue,3,7), npeder
+ endif
+ if ( nbquto.ne.0 ) then
+ write(ulsort,texte(langue,5)) mess14(langue,3,4), nqude4
+ endif
+ if ( nbtrto.ne.0 ) then
+ write(ulsort,texte(langue,5)) mess14(langue,3,2), ntrde4
+ endif
+ write(ulsort,texte(langue,5)) mess14(langue,3,1), narde2
+c
+ endif
+c
+ endif
+c
+ write(ulsort,*) ' '
+c
+c====
+c 4. la fin
+c====
+c
+ if ( codret.ne.0 ) then
+c
+#include "envex2.h"
+c
+ write (ulsort,texte(langue,1)) 'Sortie', nompro
+ write (ulsort,texte(langue,2)) codret
+c
+ endif
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,1)) 'Sortie', nompro
+ call dmflsh (iaux)
+#endif
+c
+ end
