src/tool/AV_Conversion/vcme21.F

   1       subroutine vcme21 ( typenh, cofxeo,
   2      >                    nbinfx, nctfen, nbenti,
   3      >                    notfen, nofaen, cofaen,
   4      >                    nhenfa, fament, posent, inxent,
   5      >                    nbfaen, pcfaen,
   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    aVant adaptation - Conversion de Maillage Extrude - phase 21
  28 c     -                 -             -        -               --
  29 c Determine les familles pour un type de mailles de la face avant
  30 c ______________________________________________________________________
  31 c .        .     .        .                                            .
  32 c .  nom   . e/s . taille .           description                      .
  33 c .____________________________________________________________________.
  34 c . typenh . e   .    1   . type d'entites                             .
  35 c .        .     .        .  -1 : noeuds                               .
  36 c .        .     .        .   0 : mailles-points                       .
  37 c .        .     .        .   1 : segments                             .
  38 c .        .     .        .   2 : triangles                            .
  39 c .        .     .        .   3 : tetraedres                           .
  40 c .        .     .        .   4 : quadrangles                          .
  41 c .        .     .        .   5 : pyramides                            .
  42 c .        .     .        .   6 : hexaedres                            .
  43 c .        .     .        .   7 : pentaedres                           .
  44 c . cofxeo . e   .    1   . orientation de l'entite comme face/volume  .
  45 c . nbinfx . e   .    1   . nombre d'informations pour inxent          .
  46 c . nctfen . e   .    1   . nombre de caracteristique des f. entite    .
  47 c . nbenti . e   .    1   . nombre d'entites                           .
  48 c . notfen . e   .  1     . nombre d'origine des carac. des f. entite  .
  49 c . nofaen . e   .  1     . nombre d'origine de familles de l'entite   .
  50 c . cofaen . e   . notfen*. codes d'origine des familles de l'entite   .
  51 c .        .     . nofaen .                                            .
  52 c . nhenfa . e   . char8  . objet decrivant les familles de l'entite   .
  53 c . fament . es  . nbenti . famille des entites                        .
  54 c . posent . e   . nbenti . position des entites                       .
  55 c .        .     .        . 0 : face avant                             .
  56 c .        .     .        . 1 : face arriere                           .
  57 c .        .     .        . 2 : perpendiculaire                        .
  58 c . inxent . e   . nbinfx*. informations pour l'extrusion des entites  .
  59 c .        .     . nbenti . 1 : famille de l'entite extrudee           .
  60 c .        .     .        . 2 : famille de l'entite perpendiculaire    .
  61 c .        .     .        . Si arete :                                 .
  62 c .        .     .        . 3 : code du quadrangle dans le volume      .
  63 c .        .     .        . 4 : quadrangle perpendiculaire             .
  64 c .        .     .        . Si triangle ou quadrangle :                .
  65 c .        .     .        . 3 : code de la face dans le volume         .
  66 c . nbfaen .  s  .  1     . nombre de familles de l'entite             .
  67 c . pcfaen .  s  .  1     . codes des familles de l'entite             .
  68 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  69 c . langue . e   .    1   . langue des messages                        .
  70 c .        .     .        . 1 : francais, 2 : anglais                  .
  71 c . codret . e   .    1   . code de retour des modules                 .
  72 c .        .     .        . 0 : pas de probleme                        .
  73 c .        .     .        . 1 : probleme                               .
  74 c ______________________________________________________________________
  75 c
  76 c====
  77 c 0. declarations et dimensionnement
  78 c====
  79 c
  80 c 0.1. ==> generalites
  81 c
  82       implicit none
  83       save
  84 c
  85       character*6 nompro
  86       parameter ( nompro = 'VCME21' )
  87 c
  88 #include "nblang.h"
  89 c
  90 c 0.2. ==> communs
  91 c
  92 #include "envex1.h"
  93 #include "gmenti.h"
  94 c
  95 #include "impr02.h"
  96 c
  97 c 0.3. ==> arguments
  98 c
  99       integer typenh
 100       integer cofxeo
 101       integer nbinfx, nctfen, nbenti
 102       integer notfen, nofaen, cofaen(notfen,nofaen)
 103       integer nbfaen, pcfaen
 104 c
 105       integer fament(nbenti), posent(nbenti), inxent(nbinfx,nbenti)
 106 c
 107       character*8 nhenfa
 108 c
 109       integer ulsort, langue, codret
 110 c
 111 c 0.4. ==> variables locales
 112 c
 113       integer iaux
 114       integer codre0
 115       integer nbfae0
 116       integer nument
 117 c
 118       integer nbmess
 119       parameter ( nbmess = 10 )
 120       character*80 texte(nblang,nbmess)
 121 c
 122 c 0.5. ==> initialisations
 123 c ______________________________________________________________________
 124 c
 125 c====
 126 c 1. messages
 127 c====
 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 #include "impr03.h"
 137 c
 138       texte(1,4) = '(''Familles d''''extrusion des '',a)'
 139 c
 140       texte(2,4) = '(''Description of families of extruded '',a)'
 141 c
 142 #ifdef _DEBUG_HOMARD_
 143       write (ulsort,texte(langue,4)) mess14(langue,3,typenh)
 144       write (ulsort,90002) 'nbenti', nbenti
 145       write (ulsort,90002) 'cofxeo', cofxeo
 146       write (ulsort,90002) 'nbinfx', nbinfx
 147       write (ulsort,90002) 'nctfen', nctfen
 148 #endif
 149 c
 150 #ifdef _DEBUG_HOMARD_
 151       do 4991 , nument = 1 , nbenti
 152         if ( posent(nument).eq.0 .or. typenh.eq.4 ) then
 153         write(ulsort,90012) mess14(langue,3,typenh),nument,
 154      >               fament(nument),(inxent(iaux,nument),iaux=1,nbinfx)
 155         endif
 156  4991 continue
 157 #endif
 158 c
 159       codret = 0
 160 c
 161 c====
 162 c 2. Menage initial
 163 c====
 164 c
 165       call gmlboj ( nhenfa//'.Codes' , codre0  )
 166       codret = max ( abs(codre0), codret )
 167 c
 168 c====
 169 c 3. Parcours des entites
 170 c====
 171 #ifdef _DEBUG_HOMARD_
 172       write (ulsort,90002) '3. parcours ; codret', codret
 173 #endif
 174 c
 175 c 3.1. ==> Taille initiale du tableau
 176 c
 177       nbfae0 = 0
 178       nbfaen = 0
 179       nument = 0
 180 c
 181 c 3.2. ==> Creation/Allongement du tableau des familles
 182 c          Au moins 6 pour passer la phase initiale
 183 c
 184    32 continue
 185 c
 186       if ( codret.eq.0 ) then
 187 c
 188       nbfae0 = nbfae0 + 21
 189 #ifdef _DEBUG_HOMARD_
 190       write (ulsort,90002) 'nbfaen', nbfaen
 191       write (ulsort,90002) 'nbfae0', nbfae0
 192 #endif
 193 c
 194 #ifdef _DEBUG_HOMARD_
 195       write (ulsort,texte(langue,3)) 'UTFAM2', nompro
 196 #endif
 197       call utfam2 ( typenh, nhenfa, nctfen, nbfae0,
 198      >              pcfaen,
 199      >              ulsort, langue, codret)
 200 #ifdef _DEBUG_HOMARD_
 201       if ( typenh.eq.1 ) then
 202       call gmprsx ( mess14(langue,3,typenh), nhenfa//'.Codes')
 203       endif
 204 #endif
 205 c
 206       endif
 207 c
 208 c 3.3. ==> Programme utilitaire
 209 c
 210       if ( codret.eq.0 ) then
 211 c
 212 #ifdef _DEBUG_HOMARD_
 213       write (ulsort,texte(langue,3)) 'VCME22', nompro
 214 #endif
 215       call vcme22 ( typenh, nument, cofxeo,
 216      >              nbinfx, nctfen, nbenti,
 217      >              notfen, nofaen, cofaen,
 218      >              nbfae0, nbfaen, imem(pcfaen),
 219      >              fament, posent, inxent,
 220      >              ulsort, langue, codret )
 221 c
 222       endif
 223 c
 224 c 3.4. ==> A rallonger ?
 225 c
 226       if ( codret.eq.0 ) then
 227 c
 228       if ( nbfaen.lt.0 ) then
 229 c
 230         nbfaen = -nbfaen
 231         goto 32
 232 c
 233       endif
 234 c
 235       endif
 236 c
 237 c====
 238 c 4. Redimensionnement final
 239 c====
 240 #ifdef _DEBUG_HOMARD_
 241       write (ulsort,90002) '4. Redimensionnement ; codret', codret
 242       write (ulsort,90002) 'nbfaen', nbfaen
 243       write (ulsort,90002) 'nbfae0', nbfae0
 244 #endif
 245 #ifdef _DEBUG_HOMARD_
 246       if ( typenh.eq.1 ) then
 247       call gmprsx ( mess14(langue,3,typenh), nhenfa//'.Codes')
 248       endif
 249 #endif
 250 c
 251       if ( nbfaen.ne.nbfae0 ) then
 252 c
 253         if ( codret.eq.0 ) then
 254 c
 255 #ifdef _DEBUG_HOMARD_
 256         write (ulsort,texte(langue,3)) 'UTFAM2', nompro
 257 #endif
 258         call utfam2 ( typenh, nhenfa, nctfen, nbfaen,
 259      >                pcfaen,
 260      >                ulsort, langue, codret)
 261 c
 262         endif
 263 c
 264       endif
 265 c
 266 #ifdef _DEBUG_HOMARD_
 267       if ( typenh.eq.1 ) then
 268       call gmprsx ( mess14(langue,3,typenh), nhenfa//'.Codes')
 269       endif
 270 #endif
 271 c
 272 c====
 273 c 5. la fin
 274 c====
 275 c
 276       if ( codret.ne.0 ) then
 277 c
 278 #include "envex2.h"
 279 c
 280       write (ulsort,texte(langue,1)) 'Sortie', nompro
 281       write (ulsort,texte(langue,2)) codret
 282 c
 283       endif
 284 c
 285 #ifdef _DEBUG_HOMARD_
 286       write (ulsort,texte(langue,1)) 'Sortie', nompro
 287       call dmflsh (iaux)
 288 #endif
 289 c
 290       end