src/tool/AV_Conversion/vcequ3.F

   1       subroutine vcequ3 ( option,
   2      >                    nbento, nbeqen, ibenti,
   3      >                    nuenex, enthom, nensho, eqenti,
   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    aVant adaptation Conversion - EQUivalence - phase 3
  26 c     -               -            ---                 -
  27 c
  28 c    remarque : ce traitement suppose qu'une entite ne possede pas plus
  29 c               d'un homologue. Si des cas plus compliques apparaissent,
  30 c               il faudra modifier la structure des equivalences
  31 c
  32 c    on fait une traduction bete des donnees en entree.
  33 c    pour chaque couple d'entite (e1,e2) donnees comme homologue, on
  34 c    note entequ(e1)=+-e2 et entequ(e2)=+-e1
  35 c    on fait evidemment les changements de numerotation appropries.
  36 c
  37 c   remarque importante : reperage des elements homologues
  38 c     on prend la convention de reperage suivante : lorsque
  39 c     l'on a deux faces periodiques 1 et 2, on attribue un signe a
  40 c     chacune des faces. pour un noeud "i", noehom(i) est alors egal
  41 c     a la valeur suivante :
  42 c     - "le numero du noeud correspondant par periodicite
  43 c        si i est sur la face 2"
  44 c     - "l'oppose du numero du noeud correspondant par periodicite
  45 c        si i est sur la face 1"
  46 c
  47 c     Donc, on etend cette convention a toutes les entites noeuds,
  48 c     aretes, triangles et quadrangles :
  49 c     enthom(i) = abs(homologue(i)) ssi i est sur la face 2
  50 c     enthom(i) = -abs(homologue(i)) ssi i est sur la face 1
  51 c
  52 c     pour une entite situee sur l'axe, on prend la convention positive
  53 c
  54 c ______________________________________________________________________
  55 c .        .     .        .                                            .
  56 c .  nom   . e/s . taille .           description                      .
  57 c .____________________________________________________________________.
  58 c . option . e   .    1   . variantes                                  .
  59 c .        .     .        .  -1 : noeuds                               .
  60 c .        .     .        .   1 : aretes                               .
  61 c .        .     .        .   2 : triangles                            .
  62 c .        .     .        .   4 : quadrangles                          .
  63 c . nbento . e   .    1   . nombre d'entites total                     .
  64 c . nbeqen . e   .    1   . nombre d'equivalence pour cette entite     .
  65 c . ibenti . e   .    1   . reperage dans la numerotation contigue     .
  66 c .        .     .        . des entites                                .
  67 c . nuenex . e   .    *   . numerotation des entites en exterieur      .
  68 c . enthom .   s . nbento . liste etendue des entites homologues       .
  69 c .        .     .        . enthom(i) = abs(hom(i)) ssi i sur face 2   .
  70 c .        .     .        . enthom(i) = -abs(hom(i)) ssi i sur face 1  .
  71 c . nensho . e   . rstrac . numero des entites dans HOMARD             .
  72 c . eqenti . e   .2*nbeqen. ensemble des entites homologues ; leurs    .
  73 c .        .     .        . numeros sont dans la numerotation du code  .
  74 c .        .     .        . de calcul                                  .
  75 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  76 c . langue . e   .    1   . langue des messages                        .
  77 c .        .     .        . 1 : francais, 2 : anglais                  .
  78 c . codret . es  .    1   . code de retour des modules                 .
  79 c .        .     .        . 0 : pas de probleme                        .
  80 c .        .     .        . 1 : probleme                               .
  81 c ______________________________________________________________________
  82 c
  83 c====
  84 c 0. declarations et dimensionnement
  85 c====
  86 c
  87 c 0.1. ==> generalites
  88 c
  89       implicit none
  90       save
  91 c
  92       character*6 nompro
  93       parameter ( nompro = 'VCEQU3' )
  94 c
  95 #include "nblang.h"
  96 c
  97 c 0.2. ==> communs
  98 c
  99 #include "envex1.h"
 100 c
 101 #include "impr02.h"
 102 c
 103 c 0.3. ==> arguments
 104 c
 105       integer option
 106       integer nbento, nbeqen, ibenti
 107       integer nuenex(*)
 108       integer enthom(nbento), nensho(*), eqenti(2*nbeqen)
 109       integer ulsort, langue, codret
 110 c
 111 c 0.4. ==> variables locales
 112 c
 113       integer entlo1, entlo2
 114       integer iaux
 115 c
 116       integer nbmess
 117       parameter ( nbmess = 10 )
 118       character*80 texte(nblang,nbmess)
 119 c
 120 c 0.5. ==> initialisations
 121 c ______________________________________________________________________
 122 c
 123 c====
 124 c 1. initialisations
 125 c====
 126 c
 127 c 1.1. ==> messages
 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       texte(1,4) = '(''Il/Elle devrait l''''etre aussi de'',i10,'' ?'')'
 137       texte(1,5) = '(''Infos donnees en numerotation calcul'',/)'
 138       texte(1,6) = '(''Infos donnees en numerotation HOMARD :'')'
 139       texte(1,7) = '(a,i10,'' : est homologue de'',i10)'
 140       texte(1,8) = '(''Equivalence sur les '',a)'
 141       texte(1,9) =
 142      >'(''Raffinement impossible pour des equivalences multiples.'')'
 143 c
 144       texte(2,4) = '(''It also should be with #'',i10)'
 145       texte(2,5) = '(''Infos given with calculation #'',/)'
 146       texte(2,6) = '(''Infos given with HOMARD # :'')'
 147       texte(2,7) = '(a,i10,'' : is homologous with'',i10)'
 148       texte(2,8) = '(''Equivalence for '',a)'
 149       texte(2,9) = '(''Refinement cannot be done.'')'
 150 c
 151       codret = 0
 152 c
 153 #ifdef _DEBUG_HOMARD_
 154       write(ulsort,texte(langue,8)) mess14(langue,3,option)
 155 #endif
 156 c
 157 c====
 158 c 2. prise en compte des donnees sur les entites homologues
 159 c    on complete la liste, en verifiant que si il y a deja un
 160 c    homologue, c'est le bon !
 161 c====
 162 c
 163 c 2.1. ==> tableaux etendus des entites homologues
 164 c          a priori aucun pour le moment
 165 c          remarque : on n'initialise les tableaux a 0 que si ils seront
 166 c                     utilises. comme cela, s'ils le sont sans etre
 167 c                     passes par ici, il y aura carton. Youpi.
 168 c
 169       if ( nbeqen.ne.0 ) then
 170         do 21 , iaux = 1 , nbento
 171           enthom(iaux) = 0
 172    21   continue
 173       endif
 174 c
 175 c 2.2. ==> prise en compte des donnees sur les entites homologues
 176 c          on complete la liste, en verifiant que si il y a deja un
 177 c          homologue, c'est le bon !
 178 c          pour une entite situee sur l'axe, c'est-a-dire homologues
 179 c          d'elle-meme, on prend la convention positive
 180 c
 181       do 22 , iaux = 1 , 2*nbeqen , 2
 182 c
 183         entlo1 = nensho(nuenex(ibenti+eqenti(iaux)))
 184         entlo2 = nensho(nuenex(ibenti+eqenti(iaux+1)))
 185 c
 186         if ( enthom(entlo1).eq.0 ) then
 187           if ( entlo1.eq.entlo2 ) then
 188             enthom(entlo1) = entlo2
 189           else
 190             enthom(entlo1) = - entlo2
 191           endif
 192         else
 193           if ( abs(enthom(entlo1)).ne.entlo2 ) then
 194             write(ulsort,texte(langue,7)) mess14(langue,1,option),
 195      >                                    entlo1, abs(enthom(entlo1))
 196             write(ulsort,texte(langue,4)) entlo2
 197             write(ulsort,texte(langue,5))
 198             codret = 5
 199           endif
 200         endif
 201 c
 202         if ( enthom(entlo2).eq.0 ) then
 203           enthom(entlo2) = entlo1
 204         else
 205           if ( abs(enthom(entlo2)).ne.entlo1 ) then
 206             write(ulsort,texte(langue,7)) mess14(langue,1,option),
 207      >                                    entlo2, enthom(entlo2)
 208             write(ulsort,texte(langue,4)) entlo1
 209             write(ulsort,texte(langue,5))
 210             codret = 5
 211           endif
 212         endif
 213 c
 214    22 continue
 215 c
 216 c====
 217 c 3. la fin
 218 c====
 219 c
 220 #ifdef _DEBUG_HOMARD_
 221       if ( nbeqen.ne.0 ) then
 222         write(ulsort,texte(langue,6))
 223         do 31 , iaux = 1 , nbento
 224           if ( enthom(iaux).ne.0 ) then
 225             write(ulsort,texte(langue,7)) mess14(langue,1,option),
 226      >                                    iaux, enthom(iaux)
 227           endif
 228    31   continue
 229       endif
 230 #endif
 231 c
 232       if ( codret.ne.0 ) then
 233 c
 234 #include "envex2.h"
 235 c
 236       write (ulsort,texte(langue,1)) 'Sortie', nompro
 237       write (ulsort,texte(langue,2)) codret
 238       write (ulsort,texte(langue,9))
 239 c
 240       endif
 241 c
 242 #ifdef _DEBUG_HOMARD_
 243       write (ulsort,texte(langue,1)) 'Sortie', nompro
 244       call dmflsh (iaux)
 245 #endif
 246 c
 247       end