src/tool/AV_Conversion/vcmex2.F

   1       subroutine vcmex2 ( maconf,
   2      >                    nhnofa, famnoe, notfno, nofano, cofano,
   3      >                    posnoe, inxnoe, pcfano,
   4      >                    nharfa, famare, notfar, nofaar, cofaar,
   5      >                    posare, inxare, pcfaar,
   6      >                    nhtrfa, famtri, notftr, nofatr, cofatr,
   7      >                    postri, inxtri, pcfatr,
   8      >                    nhqufa, famqua, notfqu, nofaqu, cofaqu,
   9      >                    posqua, inxqua, pcfaqu,
  10      >                    pcfahe,
  11      >                    nhpefa, pcfape,
  12      >                    ulsort, langue, codret )
  13 c ______________________________________________________________________
  14 c
  15 c                             H O M A R D
  16 c
  17 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  18 c
  19 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  20 c aupres des huissiers de justice Simart et Lavoir a Clamart
  21 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  22 c aupres des huissiers de justice
  23 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  24 c
  25 c    HOMARD est une marque deposee d'Electricite de France
  26 c
  27 c Copyright EDF 1996
  28 c Copyright EDF 1998
  29 c Copyright EDF 2002
  30 c Copyright EDF 2020
  31 c ______________________________________________________________________
  32 c
  33 c    aVant adaptation - Conversion de Maillage EXtrude - phase 2
  34 c     -                 -             -        --              -
  35 c Determine les nouvelles familles pour les mailles du maillage 2D
  36 c ______________________________________________________________________
  37 c .        .     .        .                                            .
  38 c .  nom   . e/s . taille .           description                      .
  39 c .____________________________________________________________________.
  40 c . maconf . e   .    1   . conformite du maillage                     .
  41 c .        .     .        .  0 : oui                                   .
  42 c .        .     .        .  1 : non-conforme avec au minimum 2 aretes .
  43 c .        .     .        .      non decoupees en 2 par face           .
  44 c .        .     .        .  2 : non-conforme avec 1 seul noeud        .
  45 c .        .     .        .      pendant par arete                     .
  46 c .        .     .        .  3 : non-conforme fidele a l'indicateur    .
  47 c .        .     .        . 10 : non-conforme sans autre connaissance  .
  48 c .        .     .        . -1 : conforme, avec des boites pour les    .
  49 c .        .     .        .      quadrangles, hexaedres et pentaedres  .
  50 c .        .     .        . -2 : non-conforme avec au maximum 1 arete  .
  51 c .        .     .        .      decoupee en 2 (boite pour les         .
  52 c .        .     .        .      quadrangles, hexaedres et pentaedres) .
  53 c .        .     .        . 10 : non-conforme sans autre connaissance  .
  54 c . nhnofa . e   . char8  . objet decrivant les familles des noeuds    .
  55 c . famnoe . es  . nbnoto . famille des noeuds                         .
  56 c . notfno . e   .  1     . nombre d'origine des carac. des f. noeuds  .
  57 c . nofano . e   .  1     . nombre d'origine de familles de noeuds     .
  58 c . cofano . e   . notfno*. codes d'origine des familles des noeuds    .
  59 c .        .     . nofano .   1 : famille MED                          .
  60 c . posnoe . e   . nbnoto . position des noeuds                        .
  61 c .        .     .        . 0 : face avant                             .
  62 c .        .     .        . 1 : face arriere                           .
  63 c . inxnoe . e   .2*nbnoto. informations pour l'extrusion des noeuds   .
  64 c .        .     .        . 1 : famille du noeud extrude               .
  65 c .        .     .        . 2 : famille de l'arete perpendiculaire     .
  66 c . pcfano .  s  .  1     . familles pour l'extrusion des noeuds       .
  67 c . nharfa . e   . char8  . objet decrivant les familles des aretes    .
  68 c . famare . es  . nbarto . famille des aretes                         .
  69 c . notfar . e   .  1     . nombre d'origine des carac. des f. aretes  .
  70 c . nofaar . e   .  1     . nombre d'origine de familles d'aretes      .
  71 c . cofaar . e   . notfar*. codes d'origine des familles des aretes    .
  72 c .        .     . nofaar .   1 : famille MED                          .
  73 c .        .     .        .   2 : type de segment                      .
  74 c .        .     .        .   3 : orientation                          .
  75 c .        .     .        .   4 : famille d'orientation inverse        .
  76 c .        .     .        .   5 : numero de ligne de frontiere         .
  77 c .        .     .        .  > 0 si concernee par le suivi de frontiere.
  78 c .        .     .        . <= 0 si non concernee                      .
  79 c .        .     .        .   6 : famille frontiere active/inactive    .
  80 c .        .     .        .   7 : numero de surface de frontiere       .
  81 c . posare . e   . nbarto . position des aretes                        .
  82 c .        .     .        . 0 : arete avant                            .
  83 c .        .     .        . 1 : arete arriere                          .
  84 c .        .     .        . 2 : arete perpendiculaire                  .
  85 c . inxare . e   .4*nbarto. informations pour l'extrusion des aretes   .
  86 c .        .     .        . 1 : famille de l'arete extrudee            .
  87 c .        .     .        . 2 : famille du quadrangle perpendiculaire  .
  88 c .        .     .        . 3 : code du quadrangle dans le volume      .
  89 c .        .     .        . 4 : quadrangle perpendiculaire             .
  90 c . pcfaar .  s  .  1     . familles pour l'extrusion des aretes       .
  91 c . nhtrfa . e   . char8  . objet decrivant les familles des triangles .
  92 c . famtri . es  . nbtrto . famille des triangles                      .
  93 c . notftr . e   .  1     . nombre d'origine des carac. des f. tria.   .
  94 c . nofatr . e   .  1     . nombre d'origine de familles de triangles  .
  95 c . cofatr . e   . notftr*. codes d'origine des familles des triangles .
  96 c .        .     . nofatr .   1 : famille MED                          .
  97 c .        .     .        .   2 : type de triangle                     .
  98 c .        .     .        .   3 : numero de surface de frontiere       .
  99 c .        .     .        .   4 : famille des aretes internes apres raf.
 100 c . postri . e   . nbtrto . position des triangles                     .
 101 c .        .     .        . 0 : face avant                             .
 102 c .        .     .        . 1 : face arriere                           .
 103 c .        .     .        . 2 : face perpendiculaire                   .
 104 c . inxtri . e   .3*nbtrto. informations pour l'extrusion des triangles.
 105 c .        .     .        . 1 : famille du triangle extrude            .
 106 c .        .     .        . 2 : famille du pentaedre                   .
 107 c .        .     .        . 3 : code du triangle dans le pentaedre     .
 108 c . pcfatr .  s  .  1     . familles pour l'extrusion des triangles    .
 109 c . nhqufa . e   . char8  . objet decrivant les familles des quad.     .
 110 c . famqua . es  . nbquto . famille des quadrangles                    .
 111 c . notfqu . e   .  1     . nombre d'origine des carac. des f. quad.   .
 112 c . nofaqu . e   .  1     . nombre d'origine de familles de quad.      .
 113 c . cofaqu . e   . notfqu*. codes d'origine des familles des quad.     .
 114 c .        .     . nofaqu .   1 : famille MED                          .
 115 c .        .     .        .   2 : type de quadrangle                   .
 116 c .        .     .        .   3 : numero de surface de frontiere       .
 117 c .        .     .        .   4 : famille des aretes internes apres raf.
 118 c .        .     .        .   5 : famille des triangles de conformite  .
 119 c .        .     .        .   6 : famille de sf active/inactive        .
 120 c . posqua . e   . nbquto . position des quadrangles                   .
 121 c .        .     .        . 0 : face avant                             .
 122 c .        .     .        . 1 : face arriere                           .
 123 c .        .     .        . 2 : face perpendiculaire                   .
 124 c . inxqua . e   .3*nbquto. informations pour l'extrusion des quads    .
 125 c .        .     .        . Pour un quadrangle a l'avant :             .
 126 c .        .     .        .  1 : famille du quadrangle extrude         .
 127 c .        .     .        .  2 : famille de l'hexaedre                 .
 128 c .        .     .        .  3 : orientation du quadrangle dans le vol..
 129 c .        .     .        . Pour un quadrangle a l'arriere :           .
 130 c .        .     .        .  1 : inutile                               .
 131 c .        .     .        .  2 : inutile                               .
 132 c .        .     .        .  3 : orientation du quadrangle dans le vol..
 133 c .        .     .        . Pour un quadrangle perpendiculaire :       .
 134 c .        .     .        .  1 : sens de la 1ere compos. de la normale .
 135 c .        .     .        .  2 : sens de la 2eme compos. de la normale .
 136 c .        .     .        .  3 : orientation du quadrangle dans le vol..
 137 c . pcfaqu .  s  .  1     . familles pour l'extrusion des quadrangles  .
 138 c . pcfahe . es  .   1    . codes des familles des hexaedres           .
 139 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
 140 c . langue . e   .    1   . langue des messages                        .
 141 c .        .     .        . 1 : francais, 2 : anglais                  .
 142 c . codret . e   .    1   . code de retour des modules                 .
 143 c .        .     .        . 0 : pas de probleme                        .
 144 c .        .     .        . 1 : probleme                               .
 145 c ______________________________________________________________________
 146 c
 147 c====
 148 c 0. declarations et dimensionnement
 149 c====
 150 c
 151 c 0.1. ==> generalites
 152 c
 153       implicit none
 154       save
 155 c
 156       character*6 nompro
 157       parameter ( nompro = 'VCMEX2' )
 158 c
 159 #include "nblang.h"
 160 c
 161 c 0.2. ==> communs
 162 c
 163 #include "envex1.h"
 164 c
 165 #include "gmenti.h"
 166 c
 167 #include "nombno.h"
 168 #include "nombar.h"
 169 #include "nombtr.h"
 170 #include "nombqu.h"
 171 #include "nombhe.h"
 172 #include "nbfami.h"
 173 #include "dicfen.h"
 174 #include "cofexa.h"
 175 #include "cofexn.h"
 176 #include "cofext.h"
 177 #include "cofexq.h"
 178 c
 179 c 0.3. ==> arguments
 180 c
 181       integer maconf
 182 c
 183       integer pcfano
 184       integer pcfaar
 185       integer pcfatr
 186       integer pcfaqu
 187       integer pcfape
 188 c
 189       integer famnoe(nbnoto), notfno, nofano, cofano(notfno,nofano)
 190       integer posnoe(nbnoto), inxnoe(2,nbnoto)
 191       integer famare(nbarto), notfar, nofaar, cofaar(notfar,nofaar)
 192       integer posare(nbarto), inxare(4,nbarto)
 193       integer famtri(nbtrto), notftr, nofatr, cofatr(notftr,nofatr)
 194       integer postri(nbtrto), inxtri(3,nbtrto)
 195       integer famqua(nbquto), notfqu, nofaqu, cofaqu(notfqu,nofaqu)
 196       integer posqua(nbquto), inxqua(3,nbquto)
 197       integer pcfahe
 198 c
 199       character*8 nhnofa, nharfa, nhtrfa, nhqufa
 200       character*8 nhpefa
 201 c
 202       integer ulsort, langue, codret
 203 c
 204 c 0.4. ==> variables locales
 205 c
 206       integer iaux, jaux, kaux
 207 c
 208       integer nbmess
 209       parameter ( nbmess = 10 )
 210       character*80 texte(nblang,nbmess)
 211 c
 212 c 0.5. ==> initialisations
 213 c ______________________________________________________________________
 214 c
 215 c====
 216 c 1. messages
 217 c====
 218 c
 219 #include "impr01.h"
 220 c
 221 #ifdef _DEBUG_HOMARD_
 222       write (ulsort,texte(langue,1)) 'Entree', nompro
 223       call dmflsh (iaux)
 224 #endif
 225 c
 226 #include "impr03.h"
 227 c
 228       codret = 0
 229 c
 230 #ifdef _DEBUG_HOMARD_
 231 49900 format(/,24x,a)
 232       write(ulsort,49900) ' famille fa noe ex  fa arete'
 233       do 4991 , iaux = 1 , nbnoto
 234         if ( posnoe(iaux).eq.0 ) then
 235         write(ulsort,90012) 'noeud',iaux,famnoe(iaux),
 236      >                      inxnoe(1,iaux),inxnoe(2,iaux)
 237         endif
 238  4991 continue
 239 c
 240       write(ulsort,49900)
 241      > ' famille fa are ex   fa quad code q/vo face perp'
 242       do 4992 , iaux = 1 , nbarto
 243         if ( posare(iaux).eq.0 ) then
 244         write(ulsort,90012) 'arete',iaux,famare(iaux),
 245      >  inxare(1,iaux),inxare(2,iaux),inxare(3,iaux),inxare(4,iaux)
 246         endif
 247  4992 continue
 248 c
 249       if ( nbtrto.ne.0 ) then
 250       write(ulsort,49900) 'famille fa tri ex   fa pent code t/pe'
 251       do 4993 , iaux = 1 , nbtrto
 252         if ( postri(iaux).eq.0 ) then
 253         write(ulsort,90012) 'tria',iaux,famtri(iaux),
 254      >               inxtri(1,iaux),inxtri(2,iaux),inxtri(3,iaux)
 255         endif
 256  4993 continue
 257       endif
 258 c
 259       write(ulsort,49900)
 260      >'famille  position fa qua ex   fa hexa code q/vo'
 261       do 4994 , iaux = 1 , nbquto
 262         write(ulsort,90012) 'quad',iaux,famqua(iaux),posqua(iaux),
 263      >               inxqua(1,iaux),inxqua(2,iaux),inxqua(3,iaux)
 264  4994 continue
 265 #endif
 266 c
 267 c====
 268 c 2. Phase 1 : famille des entites sur la face avant
 269 c====
 270 c 2.1. ==> Traitement des noeuds
 271 c
 272 #ifdef _DEBUG_HOMARD_
 273       write (ulsort,90002) '2.1. noeuds ; codret', codret
 274 #endif
 275 c
 276       if ( codret.eq.0 ) then
 277 c
 278       iaux = -1
 279       jaux = -1
 280       kaux = 2
 281       nctfno = nctfno + ncxfno
 282 #ifdef _DEBUG_HOMARD_
 283       write (ulsort,texte(langue,3)) 'VCME21-noe', nompro
 284 #endif
 285       call vcme21 (   iaux, jaux,
 286      >                kaux, nctfno, nbnoto,
 287      >              notfno, nofano, cofano,
 288      >              nhnofa, famnoe, posnoe, inxnoe,
 289      >              nbfnoe, pcfano,
 290      >              ulsort, langue, codret )
 291 c
 292       endif
 293 c
 294 c 2.2. ==> Traitement des aretes
 295 c
 296 #ifdef _DEBUG_HOMARD_
 297       write (ulsort,90002) '2.2. aretes ; codret', codret
 298 #endif
 299 c
 300       if ( codret.eq.0 ) then
 301 c
 302       iaux = 1
 303       jaux = -1
 304       kaux = 4
 305       nctfar = nctfar + ncxfar
 306 #ifdef _DEBUG_HOMARD_
 307       write (ulsort,texte(langue,3)) 'VCME21-are', nompro
 308 #endif
 309       call vcme21 (   iaux, jaux,
 310      >                kaux, nctfar, nbarto,
 311      >              notfar, nofaar, cofaar,
 312      >              nharfa, famare, posare, inxare,
 313      >              nbfare, pcfaar,
 314      >              ulsort, langue, codret )
 315 c
 316       endif
 317 c
 318 c 2.3. ==> Traitement des triangles
 319 c
 320 #ifdef _DEBUG_HOMARD_
 321       write (ulsort,90002) '2.3. triangles ; codret', codret
 322 #endif
 323 c
 324       if ( nbtrto.ne.0 ) then
 325 c
 326         if ( codret.eq.0 ) then
 327 c
 328         iaux = 2
 329         jaux = cofxto
 330         kaux = 3
 331         nctftr = nctftr + ncxftr
 332 #ifdef _DEBUG_HOMARD_
 333         write (ulsort,texte(langue,3)) 'VCME21-tri', nompro
 334 #endif
 335         call vcme21 (   iaux, jaux,
 336      >                  kaux, nctftr, nbtrto,
 337      >                notftr, nofatr, cofatr,
 338      >                nhtrfa, famtri, postri, inxtri,
 339      >                nbftri, pcfatr,
 340      >                ulsort, langue, codret )
 341 c
 342         endif
 343 c
 344       endif
 345 c
 346 c 2.4. ==> Traitement des quadrangles
 347 c
 348 #ifdef _DEBUG_HOMARD_
 349       write (ulsort,90002) '2.4. quadrangles ; codret', codret
 350 #endif
 351 c
 352       if ( codret.eq.0 ) then
 353 c
 354       iaux = 4
 355       jaux = cofxqo
 356       kaux = 3
 357       nctfqu = nctfqu + ncxfqu
 358 #ifdef _DEBUG_HOMARD_
 359       write (ulsort,texte(langue,3)) 'VCME21-qua', nompro
 360 #endif
 361       call vcme21 (   iaux, jaux,
 362      >                kaux, nctfqu, nbquto,
 363      >              notfqu, nofaqu, cofaqu,
 364      >              nhqufa, famqua, posqua, inxqua,
 365      >              nbfqua, pcfaqu,
 366      >              ulsort, langue, codret )
 367 c
 368       endif
 369 c
 370 cgn      call gmprsx(nompro//' - apres Phase 1, noeuds', nhnofa//'.Codes' )
 371 cgn      call gmprsx(nompro//' - apres Phase 1, aretes', nharfa//'.Codes' )
 372 cgn      call gmprsx(nompro//' - apres Phase 1, trias', nhtrfa//'.Codes' )
 373 cgn      call gmprsx(nompro//' - apres Phase 1, quads', nhqufa//'.Codes' )
 374 c
 375 c====
 376 c 3. Phase 2 : Traitement des relations hexaedres/pentaedres
 377 c====
 378 c
 379 #ifdef _DEBUG_HOMARD_
 380       write (ulsort,90002) '3. hexa/pent ; codret', codret
 381 #endif
 382 c
 383       if ( ( ( maconf.eq.0 ) .or. ( maconf.eq.-1 ) ) .and.
 384      >      nbheto.gt.0 ) then
 385 c
 386         if ( codret.eq.0 ) then
 387 c
 388 #ifdef _DEBUG_HOMARD_
 389       write (ulsort,texte(langue,3)) 'VCME23', nompro
 390 #endif
 391         call vcme23 ( nhpefa,
 392      >                pcfaqu,
 393      >                pcfahe,
 394      >                pcfape,
 395      >                ulsort, langue, codret )
 396 c
 397         endif
 398 c
 399       endif
 400 c
 401 cgn      call gmprsx(nompro//' - apres Phase 2, quads', nhqufa//'.Codes' )
 402 cgn      call gmprsx(nompro//' - apres Phase 2, aretes', nhpefa//'.Codes' )
 403 c
 404 c====
 405 c 4. Phase 3 : relation face avant / face arriere
 406 c====
 407 c 4.1. ==> Traitement des noeuds
 408 c
 409 #ifdef _DEBUG_HOMARD_
 410       write (ulsort,90002) '4.1. noeuds ; codret', codret
 411 #endif
 412 c
 413       if ( codret.eq.0 ) then
 414 c
 415       iaux = -1
 416       jaux = cofxnt
 417       kaux = cofxnp
 418 #ifdef _DEBUG_HOMARD_
 419       write (ulsort,texte(langue,3)) 'VCME25-noe', nompro
 420 #endif
 421       call vcme25 (   iaux,
 422      >              nctfno, ncffno,   jaux,   kaux,
 423      >              notfno, nofano, cofano,
 424      >              nhnofa,
 425      >              nbfnoe, pcfano,
 426      >              ulsort, langue, codret )
 427 c
 428       endif
 429 c
 430 c 4.2. ==> Traitement des aretes
 431 c
 432 #ifdef _DEBUG_HOMARD_
 433       write (ulsort,90002) '4.2. aretes ; codret', codret
 434 #endif
 435 c
 436       if ( codret.eq.0 ) then
 437 c
 438       iaux = 1
 439       jaux = cofxat
 440       kaux = cofxap
 441 #ifdef _DEBUG_HOMARD_
 442       write (ulsort,texte(langue,3)) 'VCME25-are', nompro
 443 #endif
 444       call vcme25 (   iaux,
 445      >              nctfar, ncffar,   jaux,   kaux,
 446      >              notfar, nofaar, cofaar,
 447      >              nharfa,
 448      >              nbfare, pcfaar,
 449      >              ulsort, langue, codret )
 450 c
 451       endif
 452 c
 453 c 4.3. ==> Traitement des triangles
 454 c
 455 #ifdef _DEBUG_HOMARD_
 456       write (ulsort,90002) '4.3. triangles ; codret', codret
 457 #endif
 458 c
 459       if ( nbtrto.ne.0 ) then
 460 c
 461         if ( codret.eq.0 ) then
 462 c
 463         iaux = 2
 464         jaux = cofxtt
 465         kaux = cofxtp
 466 #ifdef _DEBUG_HOMARD_
 467         write (ulsort,texte(langue,3)) 'VCME25-tri', nompro
 468 #endif
 469         call vcme25 (   iaux,
 470      >                nctftr, ncfftr,   jaux,   kaux,
 471      >                notftr, nofatr, cofatr,
 472      >                nhtrfa,
 473      >                nbftri, pcfatr,
 474      >                ulsort, langue, codret )
 475 c
 476         endif
 477 c
 478       endif
 479 c
 480 c 4.4. ==> Traitement des quadrangles
 481 c
 482 #ifdef _DEBUG_HOMARD_
 483       write (ulsort,90002) '4.4. quadrangles ; codret', codret
 484 #endif
 485 c
 486       if ( nbquto.gt.0 ) then
 487 c
 488         if ( codret.eq.0 ) then
 489 c
 490         iaux = 4
 491         jaux = cofxqt
 492         kaux = cofxqp
 493 #ifdef _DEBUG_HOMARD_
 494         write (ulsort,texte(langue,3)) 'VCME25-qua', nompro
 495 #endif
 496         call vcme25 (   iaux,
 497      >                nctfqu, ncffqu,   jaux,   kaux,
 498      >                notfqu, nofaqu, cofaqu,
 499      >                nhqufa,
 500      >                nbfqua, pcfaqu,
 501      >                ulsort, langue, codret )
 502 c
 503         endif
 504 c
 505       endif
 506 c
 507 cgn      call gmprsx(nompro//' - apres Phase 3, noeuds', nhnofa//'.Codes' )
 508 cgn      call gmprsx(nompro//' - apres Phase 3, aretes', nharfa//'.Codes' )
 509 cgn      call gmprsx(nompro//' - apres Phase 3, trias', nhtrfa//'.Codes' )
 510 cgn      call gmprsx(nompro//' - apres Phase 3, quads', nhqufa//'.Codes' )
 511 c
 512 c====
 513 c 5. Phase 4 : Traitement des relations quadrangles/triangles
 514 c====
 515 c
 516 #ifdef _DEBUG_HOMARD_
 517       write (ulsort,90002) '5. quad/tria ; codret', codret
 518 #endif
 519 c
 520       if ( ( maconf.eq.0 ) .or. ( maconf.eq.-1 ) ) then
 521 c
 522         if ( codret.eq.0 ) then
 523 c
 524 #ifdef _DEBUG_HOMARD_
 525         write (ulsort,texte(langue,3)) 'VCME27', nompro
 526 #endif
 527         call vcme27 ( notftr, nofatr, cofatr,
 528      >                nhtrfa,
 529      >                pcfatr,
 530      >                pcfaqu,
 531      >                pcfahe,
 532      >                ulsort, langue, codret )
 533 c
 534         endif
 535 c
 536       endif
 537 c
 538 cgn      call gmprsx(nompro//' - apres Phase 4, trias', nhtrfa//'.Codes' )
 539 cgn      call gmprsx(nompro//' - apres Phase 4, quads', nhqufa//'.Codes' )
 540 c
 541 c====
 542 c 6. Phase 5 : relation face avant / face perpendiculaire
 543 c====
 544 c 6.1. ==> Traitement de l'extrusion des noeuds
 545 c
 546 #ifdef _DEBUG_HOMARD_
 547       write (ulsort,90002) '6.1. noeuds ; codret', codret
 548 #endif
 549 c
 550       if ( codret.eq.0 ) then
 551 c
 552 #ifdef _DEBUG_HOMARD_
 553       write (ulsort,texte(langue,3)) 'VCME29', nompro
 554 #endif
 555       call vcme29 ( nofaar, cofaar,
 556      >              imem(pcfano),
 557      >              nharfa,
 558      >              pcfaar,
 559      >              ulsort, langue, codret )
 560 c
 561       endif
 562 c
 563 c 6.2. ==> Traitement de l'extrusion des aretes
 564 c
 565 #ifdef _DEBUG_HOMARD_
 566       write (ulsort,90002) '6.2. aretes ; codret', codret
 567 #endif
 568 c
 569       if ( codret.eq.0 ) then
 570 c
 571 #ifdef _DEBUG_HOMARD_
 572       write (ulsort,texte(langue,3)) 'VCME31', nompro
 573 #endif
 574       call vcme31 ( nofaqu, cofaqu,
 575      >              nharfa, pcfaar, famare, posare, inxare,
 576      >              nhqufa, pcfaqu, inxqua,
 577      >              ulsort, langue, codret )
 578 c
 579       endif
 580 c
 581 c====
 582 c 7. la fin
 583 c====
 584 c
 585       if ( codret.ne.0 ) then
 586 c
 587 #include "envex2.h"
 588 c
 589       write (ulsort,texte(langue,1)) 'Sortie', nompro
 590       write (ulsort,texte(langue,2)) codret
 591 c
 592       endif
 593 c
 594 #ifdef _DEBUG_HOMARD_
 595       write (ulsort,texte(langue,1)) 'Sortie', nompro
 596       call dmflsh (iaux)
 597 #endif
 598 c
 599       end