src/tool/AP_Conversion/pcceq2.F

   1       subroutine pcceq2 ( option,
   2      >                    nbento, nctfen, nbfent,
   3      >                    ncefen, nbeqen, tyhen1, tyhen2, nbenca,
   4      >                    cfaent, fament, nensho,
   5      >                    typele,
   6      >                    ulsort, langue, codret )
   7 c ______________________________________________________________________
   8 c
   9 c                             H O M A R D
  10 c
  11 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  12 c
  13 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  14 c aupres des huissiers de justice Simart et Lavoir a Clamart
  15 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  16 c aupres des huissiers de justice
  17 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  18 c
  19 c    HOMARD est une marque deposee d'Electricite de France
  20 c
  21 c Copyright EDF 1996
  22 c Copyright EDF 1998
  23 c Copyright EDF 2002
  24 c Copyright EDF 2020
  25 c ______________________________________________________________________
  26 c
  27 c    aPres adaptation - Conversion - Creation des EQuivalences - phase 2
  28 c     -                 -            -            --                   -
  29 c ______________________________________________________________________
  30 c .        .     .        .                                            .
  31 c .  nom   . e/s . taille .           description                      .
  32 c .____________________________________________________________________.
  33 c . option . e   .    1   . variantes                                  .
  34 c .        .     .        .  -1 : noeuds                               .
  35 c .        .     .        .   0 : mailles-points                       .
  36 c .        .     .        .   1 : aretes                               .
  37 c .        .     .        .   2 : triangles                            .
  38 c .        .     .        .   4 : quadrangles                          .
  39 c . nbento . e   .    1   . nombre d'entites total                     .
  40 c . nctfen . e   .    1   . nombre total de caracteristiques           .
  41 c . nbfent . e   .    1   . nombre de familles de l'entite             .
  42 c . ncefen . e   .    1   . nombre de caracteristiques d'equivalence   .
  43 c .        .     .        . dans les familles de l'entite              .
  44 c . nbeqen .   s .    1   . estimation du nombre de paires d'entites   .
  45 c . tyhen1 . e   .    1   . 1er type homard representant cette entite  .
  46 c . tyhen2 . e   .    1   . 2nd type homard representant cette entite  .
  47 c . nbenca . e   .    1   . nombre d'entites du calcul                 .
  48 c . cfaent . e   . nctfen*. codes des familles des entites             .
  49 c .        .     . nbfent .                                            .
  50 c . fament . e   . nbento . famille des entites                        .
  51 c . nensho . e   . rsenac . numero des entites dans HOMARD             .
  52 c . typele . e   . nbelem . type des elements                          .
  53 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  54 c . langue . e   .    1   . langue des messages                        .
  55 c .        .     .        . 1 : francais, 2 : anglais                  .
  56 c . codret . es  .    1   . code de retour des modules                 .
  57 c .        .     .        . 0 : pas de probleme                        .
  58 c .        .     .        . 1 : probleme                               .
  59 c ______________________________________________________________________
  60 c
  61 c====
  62 c 0. declarations et dimensionnement
  63 c====
  64 c
  65 c 0.1. ==> generalites
  66 c
  67       implicit none
  68       save
  69 c
  70       character*6 nompro
  71       parameter ( nompro = 'PCCEQ2' )
  72 c
  73 #include "nblang.h"
  74 c
  75 c 0.2. ==> communs
  76 c
  77 #include "envex1.h"
  78 #include "rftmed.h"
  79 c
  80 #include "impr02.h"
  81 c
  82 c 0.3. ==> arguments
  83 c
  84       integer option
  85       integer nbento, nctfen, nbfent
  86       integer ncefen, nbeqen, tyhen1, tyhen2, nbenca
  87       integer nensho(*)
  88       integer typele(*)
  89 c
  90       integer cfaent(nctfen,nbfent), fament(nbento)
  91 c
  92       integer ulsort, langue, codret
  93 c
  94 c 0.4. ==> variables locales
  95 c
  96       integer nucode
  97       integer iaux, jaux, ideb, ifin
  98 c
  99       integer nbmess
 100       parameter ( nbmess = 10 )
 101       character*80 texte(nblang,nbmess)
 102 c
 103 c 0.5. ==> initialisations
 104 c ______________________________________________________________________
 105 c
 106 c====
 107 c 1. les messages
 108 c====
 109 c
 110 #include "impr01.h"
 111 c
 112 #ifdef _DEBUG_HOMARD_
 113       write (ulsort,texte(langue,1)) 'Entree', nompro
 114       call dmflsh (iaux)
 115 #endif
 116 c
 117       texte(1,4) = '(/,''Decompte des equivalences sur les '',a)'
 118       texte(1,5) = '(''--> Ce nombre doit etre pair !'')'
 119       texte(1,8) =
 120      > '(8x,''. Nombre a apparier                           :'',i10)'
 121 c
 122       texte(2,4) = '(/,''Description of equivalences over '',a)'
 123       texte(2,5) = '(''--> This number should be even !'')'
 124       texte(2,8) =
 125      > '(8x,''. Number of entities                          :'',i10)'
 126 c
 127 #include "impr03.h"
 128 c
 129 #ifdef _DEBUG_HOMARD_
 130       write (ulsort,texte(langue,4)) mess14(langue,3,option)
 131 #endif
 132 c
 133       codret = 0
 134 c
 135 c====
 136 c 2. on compte combien d'elements appartiennent a des equivalences.
 137 c    on trie les entites qui sont vraiment des elements : cela se
 138 c    reconnait en utilisant les codes lies au type des elements.
 139 c
 140 c    remarque : il vaut mieux que la boucle sur les entites soit a
 141 c               l'interieur car elle sera toujours plus longue que
 142 c               celle sur les equivalences, d'ou une meilleure
 143 c               vectorisation
 144 c====
 145 c
 146       nbeqen = 0
 147 c
 148 #ifdef _DEBUG_HOMARD_
 149       write (ulsort,90002) 'nbento', nbento
 150 #endif
 151 c
 152       if ( nbento.ne.0 ) then
 153 c
 154 #ifdef _DEBUG_HOMARD_
 155       write (ulsort,90002) 'nbenca', nbenca
 156       if ( option.ge.0 ) then
 157         write (ulsort,90002) 'tyhen1', tyhen1
 158         write (ulsort,90002) 'tyhen2', tyhen2
 159       endif
 160       write (ulsort,90002) 'ncefen', ncefen
 161 #endif
 162 c
 163       iaux = 0
 164       ideb = nctfen - ncefen + 1
 165       ifin = nctfen
 166 c
 167       do 21 , nucode = ideb , ifin
 168 c
 169 c 2.1. ==> cas particulier des noeuds
 170 c
 171         if ( option.lt.0 ) then
 172 c
 173           do 211 , jaux = 1, nbenca
 174             if ( cfaent(nucode,fament(nensho(jaux))).ne.0 ) then
 175               nbeqen = nbeqen + 1
 176             endif
 177   211     continue
 178 c
 179 c 2.2. ==> les elements
 180 c
 181         else
 182 c
 183           do 212 , jaux = 1, nbenca
 184             if ( medtrf(typele(jaux)).eq.tyhen1 .or.
 185      >           medtrf(typele(jaux)).eq.tyhen2 ) then
 186               if ( cfaent(nucode,fament(nensho(jaux))).ne.0 ) then
 187                  nbeqen = nbeqen + 1
 188               endif
 189             endif
 190   212     continue
 191 c
 192         endif
 193 c
 194         if ( iaux.ne.nbeqen ) then
 195           iaux = nbeqen
 196         endif
 197 c
 198    21 continue
 199 c
 200 #ifdef _DEBUG_HOMARD_
 201       write (ulsort,90002) 'ncefen', ncefen
 202 #endif
 203 c
 204       endif
 205 c
 206 c====
 207 c 3. la fin
 208 c====
 209 c
 210       if ( codret.ne.0 ) then
 211 c
 212 #include "envex2.h"
 213 c
 214       write (ulsort,texte(langue,1)) 'Sortie', nompro
 215       write (ulsort,texte(langue,2)) codret
 216 c
 217       endif
 218 c
 219 #ifdef _DEBUG_HOMARD_
 220       write (ulsort,texte(langue,1)) 'Sortie', nompro
 221       call dmflsh (iaux)
 222 #endif
 223 c
 224       end