src/tool/AV_Conversion/vcmaco.F

   1       subroutine vcmaco ( modhom, typcce, eleinc,
   2      >                    tyconf, maext0,
   3      >                    nocman, nohman, typnom,
   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 de MAillage - COnnectivite
  26 c     -                 -             --         --
  27 c ______________________________________________________________________
  28 c
  29 c    cette conversion suppose que l'on ne garde du maillage
  30 c    que les elements suivants :
  31 c    . 0D : mailles-points
  32 c    . 1D : poutres
  33 c    . 2D : triangles, quadrangles
  34 c    . 3D : tetraedres, hexaedres, pentaedres, pyramides.
  35 c    le degre est 1 ou 2, mais il est le meme pour toutes les mailles.
  36 c ______________________________________________________________________
  37 c .        .     .        .                                            .
  38 c .  nom   . e/s . taille .           description                      .
  39 c .____________________________________________________________________.
  40 c . modhom . e   .    1   . mode de fonctionnement de homard           .
  41 c .        .     .        . -5 : executable du suivi de frontiere      .
  42 c .        .     .        . -4 : exec. de l'interface apres adaptation .
  43 c .        .     .        . -3 : exec. de l'interface avant adaptation .
  44 c .        .     .        . -2 : executable de l'information           .
  45 c .        .     .        . -1 : executable de l'adaptation            .
  46 c .        .     .        .  0 : executable autre                      .
  47 c .        .     .        .  1 : homard pur                            .
  48 c .        .     .        .  2 : information                           .
  49 c .        .     .        .  3 : modification de maillage sans adaptati.
  50 c .        .     .        .  4 : interpolation de la solution          .
  51 c . typcce . e   .   1    . type du code de calcul en entree           .
  52 c . eleinc . e   .   1    . elements incompatibles                     .
  53 c .        .     .        . 0 : on bloque s'il y en a                  .
  54 c .        .     .        . 1 : on les ignore s'il y en a              .
  55 c . tyconf . e   .   1    .  0 : conforme (defaut)                     .
  56 c .        .     .        .  1 : non-conforme avec au minimum 2 aretes .
  57 c .        .     .        .      non decoupees en 2                    .
  58 c .        .     .        .  2 : non-conforme avec 1 seul noeud        .
  59 c .        .     .        .      pendant par arete                     .
  60 c .        .     .        .  3 : non-conforme fidele a l'indicateur    .
  61 c .        .     .        . -1 : conforme, avec des boites pour les    .
  62 c .        .     .        .      quadrangles, hexaedres et pentaedres  .
  63 c .        .     .        . -2 : non-conforme avec au maximum 1 arete  .
  64 c .        .     .        .      decoupee en 2 (boite pour les         .
  65 c .        .     .        .      quadrangles, hexaedres et pentaedres) .
  66 c . maext0 . e   .   1    . maillage extrude                           .
  67 c .        .     .        . 0 : non                                    .
  68 c .        .     .        . 1 : selon X                                .
  69 c .        .     .        . 2 : selon Y                                .
  70 c .        .     .        . 3 : selon Z (cas de Saturne ou Neptune)    .
  71 c . nocman . e   . char*8 . nom de l'objet maillage calcul iteration n .
  72 c . nohman . es  . char*8 . nom de l'objet maillage homard iteration n .
  73 c . typnom . e   .    1   . type du nom de l'objet maillage            .
  74 c .        .     .        . 0 : le nom est a creer automatiquement     .
  75 c .        .     .        . 1 : le nom est impose par l'appel          .
  76 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  77 c . langue . e   .    1   . langue des messages                        .
  78 c .        .     .        . 1 : francais, 2 : anglais                  .
  79 c . codret . es  .    1   . code de retour des modules                 .
  80 c .        .     .        . 0 : pas de probleme                        .
  81 c .        .     .        . autre : probleme                           .
  82 c ______________________________________________________________________
  83 c
  84 c====
  85 c 0. declarations et dimensionnement
  86 c====
  87 c
  88 c 0.1. ==> generalites
  89 c
  90       implicit none
  91       save
  92 c
  93       character*6 nompro
  94       parameter ( nompro = 'VCMACO' )
  95 c
  96 #include "nblang.h"
  97 #include "referx.h"
  98 c
  99 c 0.2. ==> communs
 100 c
 101 #include "envex1.h"
 102 c
 103 #include "gmenti.h"
 104 #include "gmreel.h"
 105 #include "gmstri.h"
 106 c
 107 #include "dicfen.h"
 108 #include "envca1.h"
 109 #include "envca2.h"
 110 c
 111 #include "nombno.h"
 112 #include "nombmp.h"
 113 #include "nombar.h"
 114 #include "nombqu.h"
 115 #include "nombtr.h"
 116 #include "nombte.h"
 117 #include "nombhe.h"
 118 #include "nombpe.h"
 119 #include "nombpy.h"
 120 #include "nombsr.h"
 121 #include "nomest.h"
 122 #include "nbfami.h"
 123 c
 124 #include "rfamed.h"
 125 c
 126 #include "nbutil.h"
 127 c
 128 c 0.3. ==> arguments
 129 c
 130       integer modhom, typcce, eleinc, tyconf, maext0
 131       integer typnom
 132 c
 133       character*8 nocman, nohman
 134 c
 135       integer ulsort, langue, codret
 136 c
 137 c 0.4. ==> variables locales
 138 c
 139       integer lgnoig
 140       integer adnoig
 141       integer pnoemp, phetmp
 142       integer pcoono, phetno, pareno
 143       integer psomar
 144       integer ppovos, pvoiso
 145       integer pposif, pfacar
 146       integer phetar, pfilar, pmerar, adars2
 147       integer phettr, pfiltr, ppertr, pnivtr, paretr, adnmtr
 148       integer phetqu, pfilqu, pperqu, pnivqu, parequ, adnmqu
 149       integer ptrite, pcotrt, phette, pfilte, pperte
 150       integer pquahe, pcoquh, phethe, pfilhe, pperhe, adnmhe
 151       integer pfacpy, pcofay, phetpy, pfilpy, pperpy
 152       integer pfacpe, pcofap, phetpe, pfilpe, pperpe
 153       integer pnp2ar
 154       integer hfmdel, hnoeel
 155       integer dimcst
 156       integer nbpqt, pinftb
 157 c
 158       integer pcexno, pcexmp, pcexar
 159       integer pcextr, pcexqu
 160       integer pcexte, pcexhe, pcexpy, pcexpe
 161 c
 162       integer adnbrn
 163       integer adnohn, adnocn, adnoic
 164       integer admphn, admpcn, admpic
 165       integer adarhn, adarcn, adaric
 166       integer adtrhn, adtrcn, adtric
 167       integer adquhn, adqucn, adquic
 168       integer adtehn, adtecn, adteic
 169       integer adhehn, adhecn, adheic
 170       integer adpyhn, adpycn, adpyic
 171       integer adpehn, adpecn, adpeic
 172 c
 173       integer pfamen, pfamee, pnoeel, ptypel, pcoonc
 174       integer pnuele, pnunoe
 175 c
 176       integer ptrav1, ptrav2, ptrav3, ptrav4, ptrav5
 177 c
 178       integer iaux, jaux, kaux, paux
 179       integer codre1, codre2, codre3, codre4, codre5
 180       integer codre6, codre7, codre8, codre0
 181       integer nbnomb, adnomb
 182       integer voarno, vofaar, vovoar, vovofa
 183       integer decanu(-1:7)
 184       integer nbardb, cpt, nbarne, rbarne
 185 c
 186       character*8 norenu
 187       character*8 nhnoeu, nhmapo, nharet, nhtria, nhquad
 188       character*8 nhtetr, nhhexa, nhpyra, nhpent
 189       character*8 nhelig
 190       character*8 nhvois, nhsupe, nhsups
 191       character*8 ncinfo, ncnoeu, nccono, nccode
 192       character*8 nccoex, ncfami
 193       character*8 ncequi, ncfron, ncnomb
 194       character*8 ntrav1, ntrav2, ntrav3, ntrav4, ntrav5
 195       character*9 saux09
 196 c
 197       logical existe
 198 c
 199       integer nbmess
 200       parameter ( nbmess = 10 )
 201       character*80 texte(nblang,nbmess)
 202 cmdc ---------------- MAILLES DOUBLES DEBUT --------------
 203 cmd      integer nbelnw, nbtenw
 204 cmd      character*80 nomfic
 205 cmd      logical maildb
 206 cmd      integer adpoin, adtail, adtabl
 207 cmd      integer adnumf
 208 cmdc ---------------- MAILLES DOUBLES FIN ----------------
 209 c
 210 c 0.5. ==> initialisations
 211 c ______________________________________________________________________
 212 c
 213 c====
 214 c 1. messages
 215 c====
 216 c
 217 #include "impr01.h"
 218 c
 219 #ifdef _DEBUG_HOMARD_
 220       write (ulsort,texte(langue,1)) 'Entree', nompro
 221       call dmflsh (iaux)
 222 #endif
 223 c
 224       texte(1,4) = '(5x,''Estimation du nombre d''''aretes :'')'
 225       texte(1,5) = '(7x,''Passage numero'',i5)'
 226       texte(1,6) = '(5x,''Type de logiciel inconnu :'',i10,/)'
 227       texte(1,7) = '(5x,''Conversion '',a18,'' ---> HOMARD'',/)'
 228       texte(1,8) =
 229      > '(/,5x,i10,'' autres elements.'',/,5x,''Cela est interdit ...'')'
 230       texte(1,10) ='(/,''On '',a,'' les elements incompatibles.'')'
 231 c
 232       texte(2,4) = '(5x,''Estimation of the number of edges:'')'
 233       texte(2,5) = '(7x,''Pass #'',i5)'
 234       texte(2,6) = '(5x,''This kind of software is unknown:'',i10,/)'
 235       texte(2,7) = '(5x,''Conversion '',a18,'' ---> HOMARD'',/)'
 236       texte(2,8) =
 237      > '(/,5x,i10,'' other elements.'',/,5x,''This is forbidden ...'')'
 238       texte(2,10) ='(/,''Incompatible elements are '',a)'
 239 c
 240 #include "impr03.h"
 241 c
 242       typcca = typcce
 243 c
 244 #include "mslve4.h"
 245 c
 246 #ifdef _DEBUG_HOMARD_
 247       if ( eleinc.eq.0 ) then
 248         write (ulsort,texte(langue,10)) 'bloque'
 249       else
 250         write (ulsort,texte(langue,10)) 'ignore'
 251       endif
 252 #endif
 253 c
 254 #ifdef _DEBUG_HOMARD_
 255       write (ulsort,90002) 'typcce', typcce
 256       write (ulsort,90002) 'tyconf', tyconf
 257       write (ulsort,90002) 'maext0', maext0
 258 #endif
 259 c
 260 c====
 261 c 2. controle des elements a faces quadrangulaires
 262 c====
 263 #ifdef _DEBUG_HOMARD_
 264       write (ulsort,90002) '2. faces quadrangulaires ; codret', codret
 265 #endif
 266 c
 267       if ( codret.eq.0 ) then
 268 c
 269 #ifdef _DEBUG_HOMARD_
 270       write (ulsort,texte(langue,3)) 'UTAURQ', nompro
 271 #endif
 272 c
 273       call utaurq ( modhom, eleinc,
 274      >              nocman,
 275      >              nbelig,
 276      >              ulsort, langue, codret )
 277 #ifdef _DEBUG_HOMARD_
 278       write(ulsort,90002) 'nbelig', nbelig
 279 #endif
 280 c
 281       endif
 282 c
 283 c====
 284 c 3. recuperation des donnees du maillage d'entree
 285 c====
 286 #ifdef _DEBUG_HOMARD_
 287       write (ulsort,90002) '3. recuperation donnees ; codret', codret
 288 #endif
 289 c
 290 c 3.1. ==> les noms des structures
 291 #ifdef _DEBUG_HOMARD_
 292       call gmprsx( nompro, nocman)
 293 cgn      call gmprsx( nompro, nocman//'.ConnNoeu')
 294 cgn      call gmprsx( nompro, nocman//'.ConnNoeu.Noeuds')
 295 #endif
 296 c
 297       if ( codret.eq.0 ) then
 298 c
 299 #ifdef _DEBUG_HOMARD_
 300       write (ulsort,texte(langue,3)) 'UTNOMC', nompro
 301 #endif
 302       call utnomc ( nocman,
 303      >              sdimca, mdimca,
 304      >               degre, mailet, maconf, homolo, hierar,
 305      >              nbnomb,
 306      >              ncinfo, ncnoeu, nccono, nccode,
 307      >              nccoex, ncfami,
 308      >              ncequi, ncfron, ncnomb,
 309      >              ulsort, langue, codret)
 310 c
 311       endif
 312 c
 313 c 3.2. ==> les principales constantes
 314 c
 315       if ( codret.eq.0 ) then
 316 c
 317       call gmliat ( ncnoeu, 1, nbnoto, codre1 )
 318       call gmliat ( ncnoeu, 2, nctfno, codre2 )
 319       call gmliat ( ncnoeu, 3, dimcst, codre3 )
 320       call gmliat ( nccono, 1, nbelem, codre4 )
 321       call gmliat ( nccono, 2, nbmane, codre5 )
 322       call gmadoj ( ncnomb, adnomb, iaux, codre6 )
 323 c
 324       codre0 = min ( codre1, codre2, codre3, codre4, codre5,
 325      >               codre6 )
 326       codret = max ( abs(codre0), codret,
 327      >               codre1, codre2, codre3, codre4, codre5,
 328      >               codre6 )
 329 c
 330       endif
 331 c
 332       if ( codret.eq.0 ) then
 333 c
 334 #ifdef _DEBUG_HOMARD_
 335       write (ulsort,texte(langue,3)) 'UTNBMC', nompro
 336 #endif
 337       call utnbmc ( imem(adnomb),
 338      >              nbmaae, nbmafe, nbmnei,
 339      >              numano, numael,
 340      >              nbma2d, nbma3d,
 341      >              nbmapo, nbsegm, nbtria, nbtetr,
 342      >              nbquad, nbhexa, nbpent, nbpyra,
 343      >              nbfmed, nbfmen, ngrouc,
 344      >              nbequi,
 345      >              nbeqno, nbeqmp, nbeqar, nbeqtr, nbeqqu,
 346      >              ulsort, langue, codret )
 347 c
 348       endif
 349 c
 350 c 3.3. ==> les adresses
 351 c
 352       if ( codret.eq.0 ) then
 353 c
 354 #ifdef _DEBUG_HOMARD_
 355       write (ulsort,texte(langue,3)) 'UTAD11', nompro
 356 #endif
 357       iaux = 510510
 358       call utad11 ( iaux, ncnoeu, nccono,
 359      >              pcoonc, pfamen, pnunoe,   jaux,
 360      >              ptypel, pfamee, pnoeel, pnuele,
 361      >              ulsort, langue, codret )
 362 c
 363       endif
 364 c
 365       if ( codret.eq.0 ) then
 366 #ifdef _DEBUG_HOMARD_
 367       write (ulsort,texte(langue,3)) 'UTAD12', nompro
 368 #endif
 369       iaux = 7
 370       jaux = -1
 371       call utad12 ( iaux, jaux,
 372      >              nccoex, pcexno,
 373      >              ulsort, langue, codret )
 374 c
 375       endif
 376 c
 377 cmdc ---------------- MAILLES DOUBLES DEBUT --------------
 378 cmdc 3.4. ==> menage des mailles dupliquees
 379 cmdc
 380 cmdc 3.4.1. ==> Lecture du numero de la couche en cours
 381 cmdc
 382 cmd      if ( codret.eq.0 ) then
 383 cmdc
 384 cmd      nomfic = 'nrc.dat'
 385 cmd      inquire ( file = nomfic, exist = maildb )
 386 cmdc
 387 cmd      endif
 388 cmdc
 389 cmd      if ( maildb ) then
 390 cmdc
 391 cmdcgn#ifdef _DEBUG_HOMARD_
 392 cmd      write (ulsort,*) 'MENAGE'
 393 cmd#endif
 394 cmdc
 395 cmd      if ( codret.eq.0 ) then
 396 cmdc
 397 cmd      call gmadoj ( ncfami//'.Numero', adnumf, iaux, codret )
 398 cmdc
 399 cmd      endif
 400 cmdc
 401 cmd      if ( codret.eq.0 ) then
 402 cmdcgn      call gmprsx(nompro,ncfami)
 403 cmdcgn      call gmprsx(nompro,ncfami//'.Numero')
 404 cmdcgn      call gmprsx(nompro,ncfami//'.Groupe')
 405 cmdcgn      call gmprsx(nompro,ncfami//'.Groupe.Pointeur')
 406 cmdcgn      call gmprsx(nompro,ncfami//'.Groupe.Taille')
 407 cmdcgn      call gmprsx(nompro,ncfami//'.Groupe.Table')
 408 cmdc
 409 cmdcgn#ifdef _DEBUG_HOMARD_
 410 cmd      write (ulsort,texte(langue,3)) 'UTRPTC', nompro
 411 cmd#endif
 412 cmd      call utrptc ( ncfami//'.Groupe',
 413 cmd     >              iaux, jaux,
 414 cmd     >              adpoin, adtail, adtabl,
 415 cmd     >              ulsort, langue, codret )
 416 cmdc
 417 cmd      endif
 418 cmdc
 419 cmd      if ( codret.eq.0 ) then
 420 cmdc
 421 cmd      call gmalot ( ntrav1, 'entier  ', nbelem, ptrav1, codre1 )
 422 cmd      iaux = 2*nbfmed
 423 cmd      call gmalot ( ntrav2, 'entier  ',   iaux, ptrav2, codre2 )
 424 cmdc
 425 cmd      codre0 = min ( codre1, codre2 )
 426 cmd      codret = max ( abs(codre0), codret,
 427 cmd     >               codre1, codre2 )
 428 cmdc
 429 cmd      endif
 430 cmdc
 431 cmd      if ( codret.eq.0 ) then
 432 cmdc
 433 cmdcgn      call gmprsx ( nompro, nccono//'.Noeuds')
 434 cmdcgn      write(ulsort,90003) 'norete', norete
 435 cmdcgn      write(ulsort,90002) 'nbeled', nbelem
 436 cmdcgn      write(ulsort,90002) 'nbtetd', nbtetr
 437 cmdcgn#ifdef _DEBUG_HOMARD_
 438 cmd      write (ulsort,texte(langue,3)) 'VCMMEN', nompro
 439 cmd#endif
 440 cmd      call vcmmen
 441 cmd     >        ( nbelem, nbelnw,
 442 cmd     >          nbtetr, nbtenw,
 443 cmd     >          imem(pnoeel), imem(pfamee), imem(ptypel), imem(pnuele),
 444 cmd     >          imem(adnumf),
 445 cmd     >          imem(adpoin), imem(adtail), smem(adtabl),
 446 cmd     >          imem(ptrav1), imem(ptrav2), imem(ptrav2+nbfmed),
 447 cmd     >          ulsort, langue, codret )
 448 cmdc
 449 cmd      endif
 450 cmdc
 451 cmd      if ( codret.eq.0 ) then
 452 cmdc
 453 cmd      call gmmod ( nccono//'.Noeuds',
 454 cmd     >             pnoeel, nbelem, nbelnw, nbmane, nbmane, codre1 )
 455 cmd      call gmmod ( nccono//'.Type',
 456 cmd     >             ptypel, nbelem, nbelnw, 1, 1, codre2 )
 457 cmd      call gmmod ( nccono//'.FamilMED',
 458 cmd     >             pfamee, nbelem, nbelnw, 1, 1, codre3 )
 459 cmd      call gmmod ( nccono//'.NumeExte',
 460 cmd     >             pnuele, nbelem, nbelnw, 1, 1, codre4 )
 461 cmd      call gmecat ( nccono, 1, nbelnw, codre5 )
 462 cmdc
 463 cmd      codre0 = min ( codre1, codre2, codre3, codre4, codre5 )
 464 cmd      codret = max ( abs(codre0), codret,
 465 cmd     >               codre1, codre2, codre3, codre4, codre5 )
 466 cmdc
 467 cmd      endif
 468 cmdc
 469 cmd      if ( codret.eq.0 ) then
 470 cmdc
 471 cmd      nbelem = nbelnw
 472 cmd      numael = numael - nbtetr + nbtenw
 473 cmd      imem(adnomb+4) = numael
 474 cmd      nbtetr = nbtenw
 475 cmd      imem(adnomb+14) = nbtetr
 476 cmdc
 477 cmd      endif
 478 cmd      if ( codret.eq.0 ) then
 479 cmdc
 480 cmd      call gmlboj ( ntrav1 , codre1  )
 481 cmd      call gmlboj ( ntrav2 , codre2  )
 482 cmdc
 483 cmd      codre0 = min ( codre1, codre2 )
 484 cmd      codret = max ( abs(codre0), codret,
 485 cmd     >               codre1, codre2 )
 486 cmdc
 487 cmd      endif
 488 cmdc
 489 cmd      endif
 490 cmdc
 491 cmdc ---------------- MAILLES DOUBLES FIN ----------------
 492 c
 493 c====
 494 c 4. preliminaires
 495 c====
 496 c
 497 #ifdef _DEBUG_HOMARD_
 498       write (ulsort,90002) '4. preliminaires ; codret', codret
 499 #endif
 500 c
 501 c 4.1.==> initialisations
 502 c
 503       if ( codret.eq.0 ) then
 504 c
 505 #ifdef _DEBUG_HOMARD_
 506       write (ulsort,texte(langue,3)) 'UTINEI', nompro
 507 #endif
 508       call utinei ( modhom,
 509      >              ulsort, langue, codret )
 510 c
 511       endif
 512 c
 513 c 4.2. ==> allocation de la tete du maillage HOMARD
 514 c
 515       if ( codret.eq.0 ) then
 516 c
 517 #ifdef _DEBUG_HOMARD_
 518       write (ulsort,texte(langue,3)) 'UTAHMA', nompro
 519 #endif
 520       iaux = 1
 521       rafdef = 0
 522       if ( dimcst.eq.0 ) then
 523         sdim = sdimca
 524       else
 525         sdim = sdimca - 1
 526       endif
 527       if ( (nbtetr+nbhexa+nbpent+nbpyra).gt.0 ) then
 528         mdim = 3
 529       elseif ( (nbtria+nbquad).gt.0 ) then
 530         mdim = 2
 531       else
 532         mdim = 1
 533       endif
 534       typsfr = 0
 535       maextr = maext0
 536       call utahma ( nohman, typnom, iaux,
 537      >                sdim,   mdim,  degre, mailet, maconf,
 538      >              homolo, hierar, rafdef,
 539      >              nbmane, typcca, typsfr, maextr,
 540      >              norenu,
 541      >              nhnoeu, nhmapo, nharet,
 542      >              nhtria, nhquad,
 543      >              nhtetr, nhhexa, nhpyra, nhpent,
 544      >              nhelig,
 545      >              nhvois, nhsupe, nhsups,
 546      >              ulsort, langue, codret )
 547 c
 548       endif
 549 c
 550 c 4.3. ==> renumerotation
 551 c
 552       if ( codret.eq.0 ) then
 553 c
 554       iaux = 25
 555       call gmecat ( norenu, 19, iaux, codre1 )
 556       call gmaloj ( norenu//'.Nombres', ' ', iaux, adnbrn, codre2 )
 557 c
 558       codre0 = min ( codre1, codre2 )
 559       codret = max ( abs(codre0), codret,
 560      >               codre1, codre2 )
 561 c
 562       endif
 563 c
 564 c 4.4. ==> les caracteristiques du maillage de calcul
 565 c
 566       if ( codret.eq.0 ) then
 567 c
 568       imem(adnbrn+9) = nbelem
 569       imem(adnbrn+10) = nbmaae
 570       imem(adnbrn+11) = nbmafe
 571       imem(adnbrn+12) = nbmane
 572       imem(adnbrn+13) = nbmapo
 573       imem(adnbrn+14) = nbsegm
 574       imem(adnbrn+15) = nbtetr
 575       imem(adnbrn+16) = nbtria
 576       imem(adnbrn+17) = nbquad
 577       imem(adnbrn+18) = numael
 578       imem(adnbrn+19) = numano
 579       imem(adnbrn+22) = nbhexa
 580       imem(adnbrn+23) = nbpyra
 581       imem(adnbrn+24) = nbpent
 582 c
 583 c 4.5. ==> nombre total de mailles-points, de tetraedres, d'hexaedres,
 584 c          de pentaedres, de pyramides
 585 c
 586       nbmpto = nbmapo
 587       nbteto = nbtetr
 588       nbtecf = nbteto
 589       nbteca = 0
 590       nbheto = nbhexa
 591       nbhecf = nbheto
 592       nbheca = 0
 593       nbpeto = nbpent
 594       nbpecf = nbpeto
 595       nbpeca = 0
 596       nbpyto = nbpyra - nbelig
 597       nbpycf = nbpyto
 598       nbpyca = 0
 599 c
 600 c 4.6. ==> initialisation des nombres reels de familles
 601 c
 602       nbfnoe = 0
 603       nbfmpo = 0
 604       nbfare = 0
 605       nbftri = 0
 606       nbfqua = 0
 607       nbftet = 0
 608       nbfhex = 0
 609       nbfpyr = 0
 610       nbfpen = 0
 611 c
 612       endif
 613 c
 614 c====
 615 c 5. traitement des noeuds
 616 c====
 617 #ifdef _DEBUG_HOMARD_
 618       write (ulsort,90002) '5. traitement des noeuds ; codret', codret
 619 #endif
 620 c
 621 c 5.1. ==> nombres
 622 c
 623       if ( codret.eq.0 ) then
 624 c
 625       rsnoac = numano
 626       rsnoto = nbnoto
 627 c
 628       endif
 629 c
 630 c 5.2. ==> allocation des tableaux
 631 c
 632       if ( codret.eq.0 ) then
 633 c
 634       call gmecat ( nhnoeu, 1, nbnoto, codre1 )
 635       call gmecat ( nhnoeu, 2, 0, codre2 )
 636       lgnoig = 4
 637       call gmecat ( nhnoeu, 3, lgnoig, codre3 )
 638       call gmecat ( nhnoeu, 4, 0, codre4 )
 639       call gmaloj ( nhnoeu//'.InfoGene', ' ', lgnoig, adnoig, codre5 )
 640       call gmaloj ( nhnoeu//'.HistEtat', ' ', nbnoto, phetno, codre6 )
 641       iaux = sdim * nbnoto
 642       call gmaloj ( nhnoeu//'.Coor', ' ', iaux, pcoono, codre7 )
 643       call gmaloj ( nhnoeu//'.AretSupp', ' ', nbnoto, pareno, codre8 )
 644 c
 645       codre0 = min ( codre1, codre2, codre3, codre4, codre5,
 646      >               codre6, codre7, codre8 )
 647       codret = max ( abs(codre0), codret,
 648      >               codre1, codre2, codre3, codre4, codre5,
 649      >               codre6, codre7, codre8 )
 650 c
 651       call gmalot ( ntrav1, 'entier  ', nbnoto, ptrav1, codre1 )
 652       call gmalot ( ntrav2, 'entier  ', nbnoto, ptrav2, codre2 )
 653 c
 654       codre0 = min ( codre1, codre2 )
 655       codret = max ( abs(codre0), codret,
 656      >               codre1, codre2  )
 657 c
 658       endif
 659 c
 660       if ( codret.eq.0 ) then
 661 c
 662 #ifdef _DEBUG_HOMARD_
 663       write (ulsort,texte(langue,3)) 'UTRE01_no', nompro
 664 #endif
 665       iaux = -1
 666       kaux = 2310
 667       call utre01 ( iaux, kaux, norenu, rsnoac, rsnoto,
 668      >              adnohn, adnocn, adnoic,
 669      >              ulsort, langue, codret)
 670 c
 671       endif
 672 c
 673 c 5.3. ==> les informations generales
 674 c
 675       if ( codret.eq.0 ) then
 676         smem(adnoig) = 'm       '
 677         smem(adnoig+1) = 'x       '
 678         smem(adnoig+2) = 'y       '
 679         smem(adnoig+3) = 'z       '
 680       endif
 681 c
 682 c 5.5. ==> traitement des noeuds
 683 #ifdef _DEBUG_HOMARD_
 684       write (ulsort,90002) '5.5. traitement noeuds ; codret', codret
 685 #endif
 686 c
 687       if ( codret.eq.0 ) then
 688 c
 689 #ifdef _DEBUG_HOMARD_
 690       write (ulsort,texte(langue,3)) 'VCMNOE', nompro
 691 #endif
 692       call vcmnoe ( eleinc, imem(pfamen), imem(pnoeel), imem(ptypel),
 693      >              dimcst, rmem(pcoonc),
 694      >              imem(adnohn), imem(adnocn),
 695      >              rmem(pcoono), imem(phetno), imem(pcexno),
 696      >              imem(ptrav1), imem(ptrav2),
 697      >              ulsort, langue, codret )
 698 c
 699       endif
 700 cgn      call gmprsx ( nompro , norenu//'.NoHOMARD' )
 701 cgn      call gmprsx ( nompro , norenu//'.NoCalcul' )
 702 c
 703       if ( codret.eq.0 ) then
 704 c
 705       call gmlboj ( ntrav1 , codret )
 706 c
 707       imem(adnbrn) = nbnois
 708       imem(adnbrn+1) = nbnoei
 709       imem(adnbrn+2) = nbnomp
 710       imem(adnbrn+3) = nbnop1
 711       imem(adnbrn+4) = nbnop2
 712       imem(adnbrn+5) = nbnoim
 713 c
 714       endif
 715 c
 716       if ( codret.eq.0 ) then
 717 c
 718       call gmecat ( nhnoeu, 2, dimcst, codre1 )
 719       call gmcpoj ( ncnoeu//'.CoorCons', nhnoeu//'.CoorCons', codre2 )
 720 c
 721       codre0 = min ( codre1, codre2 )
 722       codret = max ( abs(codre0), codret,
 723      >               codre1, codre2 )
 724 c
 725       endif
 726 c
 727 c====
 728 c 6. determination des elements 0d, 1d, 2d ou 3d voisins des sommets
 729 c====
 730 #ifdef _DEBUG_HOMARD_
 731       write (ulsort,90002) '6. traitement mailles ; codret', codret
 732 #endif
 733 c
 734 c 6.1. ==> comptage du nombre d'elements pour chaque sommet
 735 c          et determination des pointeurs par sommets sur "voisom",
 736 c          ranges dans la structure "povoso"
 737 c
 738       if ( codret.eq.0 ) then
 739 c
 740       call gmalot ( ntrav1, 'PtTabEnt', 0, iaux, codret )
 741 c
 742       endif
 743 c
 744       if ( codret.eq.0 ) then
 745 c
 746       iaux = nbnoto + 1
 747       call gmaloj ( ntrav1//'.Pointeur', ' ', iaux, ppovos, codret )
 748 c
 749       endif
 750 c
 751       if ( codret.eq.0 ) then
 752 c
 753 #ifdef _DEBUG_HOMARD_
 754       write (ulsort,texte(langue,3)) 'VCVOS1', nompro
 755 #endif
 756       call vcvos1 ( imem(pnoeel), imem(ptypel), imem(ppovos),
 757      >              nvosom, nbelem, nbmane, nbnoto )
 758       imem(adnbrn+21) = nvosom
 759 c
 760       endif
 761 c
 762 c 6.2. ==> reperage des voisins : la structure voisom contient la
 763 c          liste des elements 1d, 2d ou 3d voisins de chaque sommet
 764 c          (allocation du tableau des voisins a une taille egale
 765 c           au nombre cumule de voisins des sommets)
 766 c
 767       if ( codret.eq.0 ) then
 768 c
 769       call gmaloj ( ntrav1//'.Table', ' ', nvosom, pvoiso, codret )
 770 c
 771       endif
 772 c
 773       if ( codret.eq.0 ) then
 774 c
 775 #ifdef _DEBUG_HOMARD_
 776       write (ulsort,texte(langue,3)) 'VCVOS2', nompro
 777 #endif
 778       call vcvos2 ( imem(pnoeel), imem(ptypel), imem(ppovos),
 779      >              imem(pvoiso), nvosom, nbelem, nbmane, nbnoto )
 780 c
 781       endif
 782 cgn      call gmprsx ( nompro, ntrav1 )
 783 cgn      call gmprsx ( nompro, ntrav1//'.Pointeur' )
 784 cgn      call gmprsx ( nompro, ntrav1//'.Table' )
 785 c
 786 c====
 787 c 7. prise en compte des mailles-points
 788 c====
 789 c
 790 #ifdef _DEBUG_HOMARD_
 791       write (ulsort,90002) '7. traitement mailles-points ; codret',
 792      >                  codret
 793 #endif
 794 c
 795 c 7.1. ==> memorisation du nombre de mailles-points
 796 c
 797       if ( codret.eq.0 ) then
 798 c
 799       call gmecat ( nhmapo, 1, nbmpto, codret )
 800 c
 801       endif
 802 c
 803 c 7.2. ==> allocation des tableaux
 804 c
 805       rsmpto = nbmpto
 806       if ( nbmpto.ne.0 ) then
 807         rsmpac = numael
 808       else
 809         rsmpac = 0
 810       endif
 811 c
 812       if ( codret.eq.0 ) then
 813 c
 814       iaux = 0
 815       jaux = 2
 816       kaux = 0
 817 #ifdef _DEBUG_HOMARD_
 818       write (ulsort,texte(langue,3)) 'UTAL02_mp', nompro
 819 #endif
 820       call utal02 ( iaux, jaux,
 821      >              nhmapo, nbmpto, kaux,
 822      >              phetmp, pnoemp,   paux,   paux,
 823      >                paux,   paux,
 824      >                paux,   paux,   paux,
 825      >                paux,   paux,   paux,
 826      >              ulsort, langue, codret )
 827 c
 828       iaux = nbmpto * nctfmp
 829       call gmaloj ( nccoex//'.Point', ' ', iaux  , pcexmp, codre0 )
 830 c
 831       codret = max ( abs(codre0), codret )
 832 c
 833       endif
 834 c
 835       if ( codret.eq.0 ) then
 836 c
 837 #ifdef _DEBUG_HOMARD_
 838       write (ulsort,texte(langue,3)) 'UTRE01_mp', nompro
 839 #endif
 840       iaux = 0
 841       kaux = 2310
 842       call utre01 ( iaux, kaux, norenu, rsmpac, rsmpto,
 843      >              admphn, admpcn, admpic,
 844      >              ulsort, langue, codret)
 845 c
 846       endif
 847 c
 848 c 7.3. ==> remplissage des tableaux
 849 c     e : ntrav1 : voisom, voisinage des sommets
 850 c     e : ntrav2 : povoso, pointeur sur ntrav1=voisom
 851 c
 852       if ( nbmpto.ne.0 ) then
 853 c
 854         if ( codret.eq.0 ) then
 855 c
 856 #ifdef _DEBUG_HOMARD_
 857       write (ulsort,texte(langue,3)) 'VCMMPO', nompro
 858 #endif
 859         call vcmmpo
 860      >          ( imem(pnoemp), imem(phetmp), imem(pcexmp),
 861      >            imem(adnocn), imem(admphn), imem(admpcn),
 862      >            imem(pfamee), imem(ptypel),
 863      >            imem(ppovos), imem(pvoiso),
 864      >            ulsort, langue, codret )
 865 c
 866         endif
 867 c
 868       endif
 869 c
 870 c====
 871 c 8. etablissement d'une table de connectivite par arete
 872 c====
 873 c
 874 #ifdef _DEBUG_HOMARD_
 875       write (ulsort,90002) '8. connectivite par arete ; codret',codret
 876 #endif
 877 c
 878 c 8.1. ==> allocation des tableaux
 879 c      la structure ntrav3 contiendra la table de connectivite par
 880 c      arete pour les elements 2d ou 3d. on la dimensionne au plus
 881 c      large en tenant compte du nombre maximum d'arete par element
 882 c      2d ou 3d du maillage
 883 c      ici, seuls sont concernes les triangles, les quadrangles,
 884 c      les tetraedres, les pentaedres et les hexaedres
 885 c      c'est le tableau areele
 886 c      la structure ntrav4 contiendra le numero de la premiere arete
 887 c      partant d'un sommet donne ; c'est le tableau preare.
 888 c      pour dimensionner les tableaux lies aux aretes, on donne
 889 c      une estimation du nombre total par le maximum possible
 890 c
 891       if ( codret.eq.0 ) then
 892 c
 893       iaux = nbelem*nbmaae
 894       call gmalot ( ntrav3, 'entier  ', iaux  , ptrav3, codre1 )
 895       call gmalot ( ntrav4, 'entier  ', nbnoto, ptrav4, codre2 )
 896 c
 897       codre0 = min ( codre1, codre2 )
 898       codret = max ( abs(codre0), codret,
 899      >               codre1, codre2 )
 900 c
 901       endif
 902 c
 903 c 8.2. ==> estimation du nombre d'aretes
 904 c
 905       if ( codret.eq.0 ) then
 906 c
 907       nbar00 = nbsegm + 3*nbtria + 4*nbquad
 908      >       + 6*nbtetr + 8*nbpyra + 12*nbhexa + 9*nbpent
 909 c
 910 #ifdef _DEBUG_HOMARD_
 911       write (ulsort,90002) 'nbar00 initial', nbar00
 912 #endif
 913 c
 914 #ifdef _DEBUG_HOMARD_
 915       write (ulsort,texte(langue,3)) 'VCMAR0', nompro
 916 #endif
 917       call vcmar0 ( imem(adnohn), imem(adnocn),
 918      >              imem(pnoeel), imem(ptypel),
 919      >              imem(ppovos), imem(pvoiso),
 920      >              nbardb,
 921      >              ulsort, langue, codret )
 922 c
 923       nbar00 = nbar00 - nbardb/2
 924 c
 925       if ( nbsegm.ne.0 ) then
 926         rbar00 = nbar00
 927         rsarac = numael
 928       else
 929         rbar00 = 0
 930         rsarac = 0
 931       endif
 932 c
 933 #ifdef _DEBUG_HOMARD_
 934       write (ulsort,90002) 'nbar00, rbar00, rsarac',
 935      >                      nbar00, rbar00, rsarac
 936 #endif
 937 c
 938       cpt = 1
 939 c
 940       endif
 941 c
 942 c 8.3. ==> allocations
 943 c
 944       if ( codret.eq.0 ) then
 945 c
 946       iaux = 1
 947       jaux = 30
 948       if ( degre.eq.2 ) then
 949         jaux = jaux*13
 950       endif
 951       if ( nbelig.ne.0 ) then
 952         jaux = jaux*17
 953       endif
 954       kaux = 0
 955 #ifdef _DEBUG_HOMARD_
 956       write (ulsort,texte(langue,3)) 'UTAL02_ar', nompro
 957 #endif
 958       call utal02 ( iaux, jaux,
 959      >              nharet, nbar00, kaux,
 960      >              phetar, psomar, pfilar, pmerar,
 961      >                paux,   paux,
 962      >                paux, pnp2ar, adars2,
 963      >                paux,   paux,   paux,
 964      >              ulsort, langue, codret )
 965 c
 966       endif
 967 c
 968       if ( codret.eq.0 ) then
 969 c
 970       iaux = nbar00 * nctfar
 971       call gmaloj ( nccoex//'.Arete', ' ', iaux  , pcexar, codre1 )
 972       call gmalot ( ntrav5, 'entier  ', rbar00, ptrav5, codre2 )
 973 c
 974       codre0 = min ( codre1, codre2 )
 975       codret = max ( abs(codre0), codret,
 976      >               codre1, codre2 )
 977 c
 978       endif
 979 c
 980       if ( codret.eq.0 ) then
 981 c
 982 #ifdef _DEBUG_HOMARD_
 983       write (ulsort,texte(langue,3)) 'UTRE01_ar', nompro
 984 #endif
 985       iaux = 1
 986       kaux = 2310
 987       call utre01 ( iaux, kaux, norenu, rsarac, rbar00,
 988      >              adarhn, adarcn, adaric,
 989      >              ulsort, langue, codret)
 990 c
 991       endif
 992 c
 993 c 8.4. ==> etablissement de la table et initialisation des tableaux
 994 c            lies aux aretes
 995 c
 996    84 continue
 997 c
 998       if ( codret.eq.0 ) then
 999 c
1000 #ifdef _DEBUG_HOMARD_
1001       write (ulsort,90002) 'nbar00, rbar00', nbar00, rbar00
1002 #endif
1003 c
1004 #ifdef _DEBUG_HOMARD_
1005       write (ulsort,texte(langue,3)) 'VCMARE', nompro
1006 #endif
1007       call vcmare
1008      >        ( imem(ptrav3), imem(psomar), imem(pnp2ar),
1009      >          imem(phetar), imem(pfilar), imem(pmerar),
1010      >          imem(pcexar), imem(pareno), imem(adars2),
1011      >          imem(adnohn), imem(adnocn), imem(adarhn),
1012      >          imem(adarcn), imem(pfamee), imem(pnoeel),
1013      >          imem(ptypel), imem(ppovos), imem(pvoiso),
1014      >          imem(ptrav4),
1015      >          arsmed, deamed, imem(ptrav5),
1016      >          imem(ptrav2),
1017      >          ulsort, langue, codret )
1018 c
1019 #ifdef _DEBUG_HOMARD_
1020       write (ulsort,90002) '--> nbarto', nbarto
1021 #endif
1022 c
1023       endif
1024 c
1025 c 8.5. ==> si l'estimation est trop courte, on augmente
1026 c
1027       if ( codret.eq.0 ) then
1028 c
1029       if ( nbarto.lt.0 ) then
1030 c
1031         nbarne = int(1.3d0*dble(nbar00))
1032         rbarne = int(1.3d0*dble(rbar00))
1033         cpt = cpt + 1
1034 c
1035       else
1036 c
1037         nbarne = nbarto
1038         rbarne = rsarto
1039         cpt = 0
1040 c
1041       endif
1042 #ifdef _DEBUG_HOMARD_
1043       write (ulsort,90002) 'nbarne, rbarne', nbarne, rbarne
1044 #endif
1045 c
1046       endif
1047 c
1048 c 8.6. ==> connaissant le vrai nombre d'aretes, on ajuste les tableaux
1049 c          somare, nareho, nareca, hetare, filare, merare
1050 c          a leurs vraies tailles
1051 c          de plus, on desalloue les tableaux ne servant plus a rien
1052 c
1053 #ifdef _DEBUG_HOMARD_
1054       write (ulsort,90002) '8.6 apres vcmare ; codret', codret
1055 #endif
1056 c
1057       if ( rsarto.ne.0 ) then
1058 c
1059       if ( codret.eq.0 ) then
1060 c
1061 #ifdef _DEBUG_HOMARD_
1062       write (ulsort,texte(langue,3)) 'UTRE02_ar', nompro
1063 #endif
1064       iaux = 1
1065       jaux = 3
1066       call utre02 ( iaux, jaux, norenu,
1067      >                kaux, rbar00,   kaux, rbarne,
1068      >              adarhn, adarcn,
1069      >              ulsort, langue, codret)
1070 c
1071       endif
1072 c
1073       endif
1074 c
1075       if ( codret.eq.0 ) then
1076 c
1077       iaux = 1
1078       jaux = 30
1079       if ( degre.eq.2 ) then
1080         jaux = jaux*13
1081       endif
1082       if ( nbelig.ne.0 ) then
1083         jaux = jaux*17
1084       endif
1085       kaux = 0
1086 #ifdef _DEBUG_HOMARD_
1087       write (ulsort,texte(langue,3)) 'UTAD06_ar', nompro
1088 #endif
1089       call utad06 ( iaux, jaux, kaux, nharet,
1090      >              nbar00, nbarne,      0,      0,
1091      >              phetar, psomar, pfilar, pmerar,
1092      >                paux,
1093      >                paux, pnp2ar, adars2,
1094      >                paux,   paux,   paux,   paux,
1095      >              ulsort, langue, codret )
1096 c
1097       endif
1098 c
1099       if ( codret.eq.0 ) then
1100 c
1101       call gmmod ( nccoex//'.Arete',
1102      >             pcexar, nbar00, nbarne, nctfar, nctfar, codre1 )
1103       call gmmod ( ntrav5,
1104      >             ptrav5, rbar00, rbarne, 1, 1, codre2 )
1105 c
1106       codre0 = min ( codre1, codre2 )
1107       codret = max ( abs(codre0), codret,
1108      >               codre1, codre2 )
1109 c
1110       endif
1111 c
1112 c 8.7. ==> si l'estimation est trop courte, on recommence
1113 c
1114       if ( codret.eq.0 ) then
1115 c
1116       if ( cpt.gt.0 ) then
1117 c
1118         write (ulsort,texte(langue,4))
1119         write (ulsort,texte(langue,5)) cpt
1120         nbar00 = nbarne
1121         rbar00 = rbarne
1122         goto 84
1123 c
1124       endif
1125 c
1126       endif
1127 c
1128 c 8.8. ==> menage
1129 c
1130       if ( codret.eq.0 ) then
1131 c
1132       call gmsgoj ( ntrav1 , codre1 )
1133       call gmlboj ( ntrav2 , codre2 )
1134       call gmlboj ( ntrav4 , codre3 )
1135       call gmlboj ( ntrav5 , codre4 )
1136 c
1137       codre0 = min ( codre1, codre2, codre3, codre4 )
1138       codret = max ( abs(codre0), codret,
1139      >               codre1, codre2, codre3, codre4 )
1140 c
1141       endif
1142 c
1143 c====
1144 c 9. etablissement d'une table de connectivite par face
1145 c====
1146 c
1147 #ifdef _DEBUG_HOMARD_
1148       write (ulsort,90002) '9. connectivite par face ; codret', codret
1149 #endif
1150 c
1151 c 9.1. ==> determination des elements 2d ou 3d voisins des aretes
1152 c
1153 c 9.1.1. ==> comptage du nombre d'elements pour chaque arete
1154 c
1155       if ( codret.eq.0 ) then
1156 c
1157       iaux = nbarto + 1
1158       call gmalot ( ntrav2, 'entier  ', iaux  , ptrav2, codret )
1159 c
1160       endif
1161 c
1162       if ( codret.eq.0 ) then
1163 c
1164 #ifdef _DEBUG_HOMARD_
1165       write (ulsort,texte(langue,3)) 'VCVAR1', nompro
1166 #endif
1167       call vcvar1 ( imem(ptrav3), imem(ptypel), imem(ptrav2) )
1168       imem(adnbrn+20) = nvoare
1169 c
1170       endif
1171 c
1172 c 9.1.2. ==> reperage des voisins
1173 c      allocation du tableau des voisins a une taille
1174 c          egale au nombre cumule de voisins des aretes
1175 c      en sortie :
1176 c      la structure ntrav1 contient la liste des elements 2d ou 3d
1177 c      voisins de chaque arete ; c'est le tableau vofaar
1178 c      la structure ntrav2 contient les pointeurs sur vofaar ; c'est
1179 c      le tableau povoar
1180 c
1181       if ( codret.eq.0 ) then
1182       call gmalot ( ntrav1, 'entier  ', nvoare, ptrav1, codret )
1183       endif
1184 c
1185       if ( codret.eq.0 ) then
1186 c
1187 #ifdef _DEBUG_HOMARD_
1188       write (ulsort,texte(langue,3)) 'VCVAR2', nompro
1189 #endif
1190       call vcvar2 ( imem(ptrav3), imem(ptypel), imem(ptrav1),
1191      >              imem(ptrav2) )
1192 c
1193       endif
1194 c
1195 c 9.2. ==> allocation des tableaux
1196 c      la structure ntrite contiendra la table de connectivite par
1197 c      face. on la dimmensionne au plus large en tenant compte du
1198 c      nombre maximum de face par element 3d du maillage ; c'est le
1199 c      tableau areele.
1200 c      la structure ntrav4 contiendra le numero de la premiere face
1201 c      partant d'une arete donnee ; c'est le tableau prefac.
1202 c      pour dimensionner les tableaux lies aux faces, on donne
1203 c      une estimation du nombre total par le maximum possible.
1204 c
1205 c 9.2.1. ==> on verifie qu'il y a assez de place avant de se lancer
1206 c
1207       if ( codret.eq.0 ) then
1208 c
1209       nbtr00 = nbtria + 4*nbtetr + 4*nbpyra + 2*nbpent
1210       if ( nbtria.ne.0 ) then
1211         rbtr00 = nbtr00
1212         rstrac = numael
1213       else
1214         rbtr00 = 0
1215         rstrac = 0
1216       endif
1217 c
1218       nbqu00 = nbquad + 6*nbhexa + nbpyra + 3*nbpent
1219       if ( nbquad.ne.0 ) then
1220         rbqu00 = nbqu00
1221         rsquac = numael
1222       else
1223         rbqu00 = 0
1224         rsquac = 0
1225       endif
1226 c
1227       rsteto = nbteto
1228       if ( nbteto.ne.0 ) then
1229         rsteac = numael
1230       else
1231         rsteac = 0
1232       endif
1233 c
1234       rsheto = nbheto
1235       if ( nbheto.ne.0 ) then
1236         rsheac = numael
1237       else
1238         rsheac = 0
1239       endif
1240 c
1241       rspyto = nbpyto
1242       if ( nbpyto.ne.0 ) then
1243         rspyac = numael
1244       else
1245         rspyac = 0
1246       endif
1247 c
1248       rspeto = nbpeto
1249       if ( nbpeto.ne.0 ) then
1250         rspeac = numael
1251       else
1252         rspeac = 0
1253       endif
1254 c
1255       endif
1256 c
1257 c 9.2.2. ==> allocation
1258 c
1259       if ( codret.eq.0 ) then
1260 c
1261 c 9.2.2.1. ==> pour les triangles, dans deux cas :
1262 c            . il y en a (quelle bonne idee)
1263 c            . il n'y en a pas, mais les quadrangles decoupes par
1264 c              conformite pourraient en produire ; on cree le tableau
1265 c              de sauvegarde des codes externes
1266 #ifdef _DEBUG_HOMARD_
1267       write (ulsort,90002) '9.2.2.1. triangles ; codret', codret
1268       write (ulsort,90002) 'nbtr00, nbqu00', nbtr00, nbqu00
1269 #endif
1270 c
1271       if ( nbtr00.ne.0 ) then
1272 c
1273         if ( mod(mailet,3).eq.0 ) then
1274           if ( mod(mailet,2).ne.0 ) then
1275             mailet = mailet * 2
1276           endif
1277         endif
1278 c
1279         iaux = 2
1280         jaux = 330
1281         if ( mod(mailet,2).eq.0 ) then
1282           jaux = jaux * 19
1283         endif
1284         kaux = 0
1285 #ifdef _DEBUG_HOMARD_
1286       write (ulsort,texte(langue,3)) 'UTAL02_tr', nompro
1287 #endif
1288         call utal02 ( iaux, jaux,
1289      >                nhtria, nbtr00, kaux,
1290      >                phettr, paretr, pfiltr, ppertr,
1291      >                paux  ,   paux,
1292      >                pnivtr,   paux,   paux,
1293      >                adnmtr,   paux, paux,
1294      >                ulsort, langue, codret )
1295 c
1296       endif
1297 c
1298       if ( nbtr00.ne.0 .or. nbqu00.ne.0 ) then
1299 c
1300         iaux = nbtr00 * nctftr
1301         call gmaloj ( nccoex//'.Trian', ' ', iaux  , pcextr, codre0 )
1302 c
1303         codret = max ( abs(codre0), codret )
1304 c
1305       endif
1306 c
1307 c 9.2.2.2. ==> pour les quadrangles, dans un cas :
1308 c            . il y en a (quelle bonne idee)
1309 c
1310 #ifdef _DEBUG_HOMARD_
1311       write (ulsort,90002) '9.2.2.2. quadrangles ; codret', codret
1312       write (ulsort,90002) 'nbqu00', nbqu00
1313 #endif
1314 c
1315       if ( nbqu00.ne.0 ) then
1316 c
1317         iaux = 4
1318         jaux = 330
1319         if ( mod(mailet,3).eq.0 ) then
1320           jaux = jaux * 19
1321         endif
1322         kaux = 0
1323 #ifdef _DEBUG_HOMARD_
1324       write (ulsort,texte(langue,3)) 'UTAL02_qu', nompro
1325 #endif
1326         call utal02 ( iaux, jaux,
1327      >                nhquad, nbqu00, kaux,
1328      >                phetqu, parequ, pfilqu, pperqu,
1329      >                paux  ,   paux,
1330      >                pnivqu,   paux,   paux,
1331      >                adnmqu,   paux, paux,
1332      >                ulsort, langue, codret )
1333 c
1334         iaux = nbqu00 * nctfqu
1335         call gmaloj ( nccoex//'.Quadr', ' ', iaux  , pcexqu, codre0 )
1336 c
1337         codret = max ( abs(codre0), codret )
1338 c
1339       endif
1340 c
1341 c 9.2.2.3. ==> pour les tetraedres, dans un cas :
1342 c            . il y en a (quelle bonne idee)
1343 c            . il n'y en a pas, mais les hexaedres decoupes par
1344 c              conformite pourraient en produire ; on cree le tableau
1345 c              de sauvegarde des codes externes
1346 c
1347 #ifdef _DEBUG_HOMARD_
1348       write (ulsort,90002) '9.2.2.3. tetraedres ; codret', codret
1349       write (ulsort,90002) 'nbteto', nbteto
1350 #endif
1351 c
1352       if ( nbteto.ne.0 ) then
1353 c
1354         iaux = 3
1355         jaux = 390
1356         kaux = 0
1357 #ifdef _DEBUG_HOMARD_
1358       write (ulsort,texte(langue,3)) 'UTAL02_te', nompro
1359 #endif
1360         call utal02 ( iaux, jaux,
1361      >                nhtetr, nbteto, kaux,
1362      >                phette, ptrite, pfilte, pperte,
1363      >                paux  ,   paux,
1364      >                paux  , pcotrt,   paux,
1365      >                  paux,   paux, paux,
1366      >                ulsort, langue, codret )
1367 c
1368       endif
1369 c
1370       if ( nbteto.ne.0 .or. ( nbheto.ne.0 .and. tyconf.eq.-1 ) ) then
1371 c
1372         iaux = nbteto * nctfte
1373         call gmaloj ( nccoex//'.Tetra', ' ', iaux  , pcexte, codre0 )
1374 c
1375         codret = max ( abs(codre0), codret )
1376 c
1377       endif
1378 c
1379 c 9.2.2.4. ==> pour les hexaedres, dans un cas :
1380 c            . il y en a (quelle bonne idee)
1381 c
1382 #ifdef _DEBUG_HOMARD_
1383       write (ulsort,90002) '9.2.2.4. hexaedres ; codret', codret
1384       write (ulsort,90002) 'nbheto', nbheto
1385 #endif
1386       if ( nbheto.ne.0 ) then
1387 c
1388         iaux = 6
1389         jaux = 390
1390         if (  mod(mailet,5).eq.0 ) then
1391           jaux = jaux*19
1392         endif
1393         kaux = 0
1394 #ifdef _DEBUG_HOMARD_
1395       write (ulsort,texte(langue,3)) 'UTAL02_he', nompro
1396 #endif
1397         call utal02 ( iaux, jaux,
1398      >                nhhexa, nbheto, kaux,
1399      >                phethe, pquahe, pfilhe, pperhe,
1400      >                paux  ,   paux,
1401      >                paux  , pcoquh,   paux,
1402      >                adnmhe,   paux, paux,
1403      >                ulsort, langue, codret )
1404 c
1405         iaux = nbheto * nctfhe
1406         call gmaloj ( nccoex//'.Hexae', ' ', iaux  , pcexhe, codre0 )
1407 c
1408         codret = max ( abs(codre0), codret )
1409 c
1410       endif
1411 c
1412 c 9.2.2.5. ==> pour les pyramides, dans un cas :
1413 c            . il y en a (quelle bonne idee)
1414 c            . il n'y en a pas, mais les hexaedres decoupes par
1415 c              conformite pourraient en produire ; on cree le tableau
1416 c              de sauvegarde des codes externes
1417 c
1418 #ifdef _DEBUG_HOMARD_
1419       write (ulsort,90002) '9.2.2.5. pyramides ; codret', codret
1420       write (ulsort,90002) 'nbpyto', nbpyto
1421       write (ulsort,90002) 'nbheto', nbheto
1422       write (ulsort,90002) 'tyconf', tyconf
1423 #endif
1424       if ( nbpyto.ne.0 ) then
1425 c
1426         iaux = 5
1427         jaux = 390
1428         kaux = 0
1429 #ifdef _DEBUG_HOMARD_
1430       write (ulsort,texte(langue,3)) 'UTAL02_py', nompro
1431 #endif
1432         call utal02 ( iaux, jaux,
1433      >                nhpyra, nbpyto, kaux,
1434      >                phetpy, pfacpy, pfilpy, pperpy,
1435      >                paux  ,   paux,
1436      >                paux  , pcofay,   paux,
1437      >                  paux,   paux, paux,
1438      >                ulsort, langue, codret )
1439 c
1440       endif
1441 c
1442       if ( nbpyto.ne.0 .or. ( nbheto.ne.0 .and. tyconf.eq.-1 ) ) then
1443 c
1444         iaux = nbpyto * nctfpy
1445         call gmaloj ( nccoex//'.Pyram', ' ', iaux  , pcexpy, codre0 )
1446 c
1447         codret = max ( abs(codre0), codret )
1448 c
1449       endif
1450 c
1451 c 9.2.2.6. ==> pour les pentaedres, 1 seul cas : il y en a
1452 c
1453 #ifdef _DEBUG_HOMARD_
1454       write (ulsort,90002) '9.2.2.6. pentaedres ; codret', codret
1455       write (ulsort,90002) 'nbpeto', nbpeto
1456 #endif
1457       if ( nbpeto.ne.0 ) then
1458 c
1459         iaux = 7
1460         jaux = 390
1461         kaux = 0
1462 #ifdef _DEBUG_HOMARD_
1463       write (ulsort,texte(langue,3)) 'UTAL02_pe', nompro
1464 #endif
1465         call utal02 ( iaux, jaux,
1466      >                nhpent, nbpeto, kaux,
1467      >                phetpe, pfacpe, pfilpe, pperpe,
1468      >                paux  ,   paux,
1469      >                paux  , pcofap,   paux,
1470      >                  paux,   paux, paux,
1471      >                ulsort, langue, codret )
1472 c
1473         iaux = nbpeto * nctfpe
1474         call gmaloj ( nccoex//'.Penta', ' ', iaux  , pcexpe, codre0 )
1475 c
1476         codret = max ( abs(codre0), codret )
1477 c
1478       endif
1479 c
1480 c 9.2.2.7. ==> la renumerotation des faces 2D
1481 c
1482 #ifdef _DEBUG_HOMARD_
1483       write (ulsort,90002) '9.2.2.7. ren. faces 2D ; codret', codret
1484 #endif
1485 c
1486       if ( codret.eq.0 ) then
1487 c
1488 #ifdef _DEBUG_HOMARD_
1489       write (ulsort,texte(langue,3)) 'UTRE01_tr', nompro
1490 #endif
1491       iaux = 2
1492       jaux = 2310
1493       call utre01 ( iaux, jaux, norenu, rstrac, rbtr00,
1494      >              adtrhn, adtrcn, adtric,
1495      >              ulsort, langue, codret)
1496
1497       endif
1498 c
1499       if ( codret.eq.0 ) then
1500 c
1501 #ifdef _DEBUG_HOMARD_
1502       write (ulsort,texte(langue,3)) 'UTRE01_qu', nompro
1503 #endif
1504       iaux = 4
1505       if ( nbqu00.eq.0 ) then
1506       jaux = 2310
1507         kaux = 0
1508       else
1509         kaux = rsquac
1510       endif
1511       call utre01 ( iaux, jaux, norenu,   kaux, rbqu00,
1512      >              adquhn, adqucn, adquic,
1513      >              ulsort, langue, codret)
1514
1515       endif
1516 c
1517 c 9.2.2.8. ==> la renumerotation des tetraedres
1518 c              remarque : on alloue meme en l'absence de tetraedres
1519 c                         car on utilise les attributs par la suite !
1520 c
1521 #ifdef _DEBUG_HOMARD_
1522       write (ulsort,90002) '9.2.2.8. ren. tetraedres ; codret', codret
1523 #endif
1524 c
1525       if ( codret.eq.0 ) then
1526 c
1527 #ifdef _DEBUG_HOMARD_
1528       write (ulsort,texte(langue,3)) 'UTRE01_te', nompro
1529 #endif
1530       iaux = 3
1531       jaux = 2310
1532       call utre01 ( iaux, jaux, norenu, rsteac, rsteto,
1533      >              adtehn, adtecn, adteic,
1534      >              ulsort, langue, codret)
1535
1536       endif
1537 c
1538 c 9.2.2.9. ==> la renumerotation des pyramides
1539 c              remarque : on alloue meme en l'absence de pyramides
1540 c                         car on utilise les attributs par la suite !
1541 c
1542 #ifdef _DEBUG_HOMARD_
1543       write (ulsort,90002) '9.2.2.9. ren. pyramides ; codret', codret
1544 #endif
1545 c
1546       if ( codret.eq.0 ) then
1547 c
1548 #ifdef _DEBUG_HOMARD_
1549       write (ulsort,texte(langue,3)) 'UTRE01_py', nompro
1550 #endif
1551       iaux = 5
1552       jaux = 2310
1553       call utre01 ( iaux, jaux, norenu, rspyac, rspyto,
1554      >              adpyhn, adpycn, adpyic,
1555      >              ulsort, langue, codret)
1556 c
1557       endif
1558 c
1559 c 9.2.2.10. ==> la renumerotation des hexaedres
1560 c               remarque : on alloue meme en l'absence de hexaedres
1561 c                          car on utilise les attributs par la suite !
1562 c
1563 #ifdef _DEBUG_HOMARD_
1564       write (ulsort,90002) '9.2.2.10. ren. hexaedres ; codret', codret
1565 #endif
1566 c
1567       if ( codret.eq.0 ) then
1568 c
1569 #ifdef _DEBUG_HOMARD_
1570       write (ulsort,texte(langue,3)) 'UTRE01_he', nompro
1571 #endif
1572       iaux = 6
1573       jaux = 2310
1574       call utre01 ( iaux, jaux, norenu, rsheac, rsheto,
1575      >              adhehn, adhecn, adheic,
1576      >              ulsort, langue, codret)
1577
1578       endif
1579 c
1580 c 9.2.2.11. ==> la renumerotation des pentaedres
1581 c               remarque : on alloue meme en l'absence de pentaedres
1582 c                          car on utilise les attributs par la suite !
1583 c
1584 #ifdef _DEBUG_HOMARD_
1585       write (ulsort,90002) '9.2.2.11. ren. pentaedres ; codret', codret
1586 #endif
1587 c
1588       if ( codret.eq.0 ) then
1589 c
1590 #ifdef _DEBUG_HOMARD_
1591       write (ulsort,texte(langue,3)) 'UTRE01_pe', nompro
1592 #endif
1593       iaux = 7
1594       jaux = 2310
1595       call utre01 ( iaux, jaux, norenu, rspeac, rspeto,
1596      >              adpehn, adpecn, adpeic,
1597      >              ulsort, langue, codret)
1598 c
1599       endif
1600 c
1601 c 9.2.2.12. ==> des tableaux de travail
1602 c
1603       iaux = 2*nbarto
1604       call gmalot ( ntrav4, 'entier  ', iaux, ptrav4, codre1 )
1605       iaux = 2*max(rbtr00,rbqu00)
1606       call gmalot ( ntrav5, 'entier  ', iaux, ptrav5, codre2 )
1607 c
1608       codre0 = min ( codre1, codre2 )
1609       codret = max ( abs(codre0), codret,
1610      >               codre1, codre2 )
1611 c
1612       endif
1613 c
1614 c 9.3. ==> etablissement de la table et initialisation des faces
1615 c
1616 c     rappel pour vcmfac :
1617 c     e : ntrav1 : vofaar, voisinage des aretes
1618 c     e : ntrav2 : povoar, pointeur sur ntrav1=vofaar
1619 c     e : ntrav3 : areele, table de connectivite par arete
1620 c     a : ntrav4 : prefac, premiere face s'appuyant sur une arete
1621 c     a : ntrav5 : dejavu, controle des doublons
1622 c
1623       if ( codret.eq.0 ) then
1624 c
1625 #ifdef _DEBUG_HOMARD_
1626       write (ulsort,texte(langue,3)) 'VCMFAC', nompro
1627 #endif
1628       call vcmfac
1629      >        ( imem(paretr), imem(phettr),
1630      >          imem(pfiltr), imem(ppertr), imem(pnivtr),
1631      >          imem(adnmtr),
1632      >          imem(pcextr), imem(adtrhn), imem(adtrcn),
1633      >          imem(parequ), imem(phetqu),
1634      >          imem(pfilqu), imem(pperqu), imem(pnivqu),
1635      >          imem(adnmqu),
1636      >          imem(pcexqu), imem(adquhn), imem(adqucn),
1637      >          imem(ptrite), imem(phette),
1638      >          imem(pfilte), imem(pperte),
1639      >          imem(pcexte), imem(adtehn), imem(adtecn),
1640      >          imem(pquahe), imem(phethe),
1641      >          imem(pfilhe), imem(pperhe), imem(adnmhe),
1642      >          imem(pcexhe), imem(adhehn), imem(adhecn),
1643      >          imem(pfacpe), imem(phetpe),
1644      >          imem(pfilpe), imem(pperpe),
1645      >          imem(pcexpe), imem(adpehn), imem(adpecn),
1646      >          imem(pfacpy), imem(phetpy),
1647      >          imem(pfilpy), imem(pperpy),
1648      >          imem(pcexpy), imem(adpyhn), imem(adpycn),
1649      >          imem(ptrav3), imem(pnoeel), imem(ptypel), imem(pfamee),
1650      >          imem(ptrav1), imem(ptrav2), imem(ptrav4), imem(ptrav5),
1651      >          imem(psomar), imem(adnohn), imem(adnocn),
1652      >          ulsort, langue, codret )
1653 c
1654       endif
1655 c
1656 c 9.4. ==> connaissant le vrai nombre de faces, on ajuste les tableaux
1657 c          a leurs vraies tailles
1658 c          de plus, on desalloue les tableaux ne servant plus a rien
1659 c
1660 #ifdef _DEBUG_HOMARD_
1661       write (ulsort,90002) '9.4. apres vcmfac ; codret', codret
1662 #endif
1663 c
1664 c 9.4.1. ==> triangles
1665 c
1666 #ifdef _DEBUG_HOMARD_
1667       write (ulsort,90002) '9.4.1. triangles ; codret', codret
1668       write (ulsort,90002) 'nbtr00, nbtrto', nbtr00, nbtrto
1669       write (ulsort,90002) 'rbtr00, rstrto', rbtr00, rstrto
1670 #endif
1671 c
1672       if ( nbtr00.ne.0 ) then
1673 c
1674         if ( codret.eq.0 ) then
1675 c
1676         iaux = 2
1677         jaux = 330
1678         if ( mod(mailet,2).eq.0 ) then
1679           jaux = jaux*19
1680         endif
1681         kaux = 0
1682 #ifdef _DEBUG_HOMARD_
1683       write (ulsort,texte(langue,3)) 'UTAD06_tr', nompro
1684 #endif
1685         call utad06 ( iaux, jaux, kaux, nhtria,
1686      >                nbtr00, nbtrto,      0,      0,
1687      >                phettr, paretr, pfiltr, ppertr,
1688      >                  paux,
1689      >                pnivtr,   paux,   paux,
1690      >                adnmtr,   paux,   paux,   paux,
1691      >                ulsort, langue, codret )
1692 c
1693         endif
1694 c
1695         if ( codret.eq.0 ) then
1696 c
1697         call gmmod ( nccoex//'.Trian',
1698      >               pcextr, nbtr00, nbtrto, nctftr, nctftr, codre0 )
1699 c
1700         codret = max ( abs(codre0), codret )
1701 c
1702         endif
1703 c
1704       endif
1705 c
1706       if ( rbtr00.ne.0 ) then
1707 c
1708       if ( codret.eq.0 ) then
1709 c
1710 #ifdef _DEBUG_HOMARD_
1711       write (ulsort,texte(langue,3)) 'UTRE02_tr', nompro
1712 #endif
1713       iaux = 2
1714       jaux = 3
1715       call utre02 ( iaux, jaux, norenu,
1716      >                kaux, rbtr00,   kaux, rstrto,
1717      >              adtrhn, adtrcn,
1718      >              ulsort, langue, codret)
1719 c
1720       endif
1721 c
1722       endif
1723 c
1724 c 9.4.2. ==> quadrangles
1725 c
1726 #ifdef _DEBUG_HOMARD_
1727       write (ulsort,90002) '9.4.2. quadrangles ; codret', codret
1728       write (ulsort,90002) 'nbqu00, nbquto', nbqu00, nbquto
1729       write (ulsort,90002) 'rbqu00, rsquto', rbqu00, rsquto
1730 #endif
1731 c
1732       if ( nbqu00.ne.0 ) then
1733 c
1734         if ( codret.eq.0 ) then
1735 c
1736         iaux = 4
1737         jaux = 330
1738         if ( mod(mailet,3).eq.0 ) then
1739           jaux = jaux*19
1740         endif
1741         kaux = 0
1742 #ifdef _DEBUG_HOMARD_
1743       write (ulsort,texte(langue,3)) 'UTAD06_qu', nompro
1744 #endif
1745         call utad06 ( iaux, jaux, kaux, nhquad,
1746      >                nbqu00, nbquto,      0,      0,
1747      >                phetqu, parequ, pfilqu, pperqu,
1748      >                  paux,
1749      >                pnivqu,   paux,   paux,
1750      >                adnmqu,   paux,   paux,   paux,
1751      >                ulsort, langue, codret )
1752 c
1753         endif
1754 c
1755         if ( codret.eq.0 ) then
1756 c
1757         call gmmod ( nccoex//'.Quadr',
1758      >               pcexqu, nbqu00, nbquto, nctfqu, nctfqu, codre0 )
1759 c
1760         codret = max ( abs(codre0), codret )
1761 c
1762         endif
1763 c
1764       endif
1765 c
1766       if ( rbqu00.ne.0 ) then
1767 c
1768       if ( codret.eq.0 ) then
1769 c
1770 #ifdef _DEBUG_HOMARD_
1771       write (ulsort,texte(langue,3)) 'UTRE02_qu', nompro
1772 #endif
1773       iaux = 4
1774       jaux = 3
1775       call utre02 ( iaux, jaux, norenu,
1776      >                kaux, rbqu00,   kaux, rsquto,
1777      >              adquhn, adqucn,
1778      >              ulsort, langue, codret)
1779 c
1780       endif
1781 c
1782       endif
1783 c
1784 #ifdef _DEBUG_HOMARD_
1785       call gmprsx (nompro, norenu//'.QuCalcul')
1786       call gmprsx (nompro, norenu//'.QuHOMARD')
1787       call gmprsx (nompro, nhquad//'.ConnDesc' )
1788       call gmprsx (nompro, nhquad//'.HistEtat')
1789       call gmprsx (nompro, nhquad//'.Fille' )
1790       call gmprsx (nompro, nhquad//'.Mere')
1791       call gmprsx (nompro, nhquad//'.Niveau' )
1792       call gmprsx (nompro, nccoex//'.Quadr')
1793 #endif
1794 c
1795 c====
1796 c 10. orientation des aretes et des faces du calcul et code des faces
1797 c     dans les volumes
1798 c====
1799 #ifdef _DEBUG_HOMARD_
1800       write (ulsort,90002) '10. orientation ; codret', codret
1801 #endif
1802 c
1803       if ( codret.eq.0 ) then
1804 c
1805 #ifdef _DEBUG_HOMARD_
1806       write (ulsort,texte(langue,3)) 'VCORIE', nompro
1807 #endif
1808       call vcorie
1809      >        ( eleinc, imem(pnoeel), imem(ptrav3), imem(ptypel),
1810      >          imem(psomar), imem(paretr), imem(parequ),
1811      >          imem(adnohn), imem(adarhn), imem(adtrhn), imem(adquhn),
1812      >          imem(pcexar),
1813      >          imem(ptrite), imem(pcotrt), imem(adtehn),
1814      >          imem(pquahe), imem(pcoquh), imem(adhehn),
1815      >          imem(pfacpe), imem(pcofap), imem(adpehn),
1816      >          imem(pfacpy), imem(pcofay), imem(adpyhn),
1817      >          ulsort, langue, codret )
1818 c
1819       endif
1820 c
1821 c 10.2. ==> menage
1822 c
1823 #ifdef _DEBUG_HOMARD_
1824       write (ulsort,90002) '10.2. menage ; codret', codret
1825 #endif
1826 c
1827       if ( codret.eq.0 ) then
1828 c
1829       call gmlboj ( ntrav1 , codre1 )
1830       call gmlboj ( ntrav2 , codre2 )
1831       call gmlboj ( ntrav3 , codre3 )
1832       call gmlboj ( ntrav4 , codre4 )
1833       call gmlboj ( ntrav5 , codre5 )
1834 c
1835       codre0 = min ( codre1, codre2, codre3, codre4, codre5 )
1836       codret = max ( abs(codre0), codret,
1837      >               codre1, codre2, codre3, codre4, codre5 )
1838 c
1839       endif
1840 c
1841 c====
1842 c 11. reperage des eventuelles non conformites
1843 c====
1844 c
1845 #ifdef _DEBUG_HOMARD_
1846       write (ulsort,90002) '11. non conformites ; codret', codret
1847       write (ulsort,90002) 'tyconf', tyconf
1848 #endif
1849 c
1850       nbtrri = 0
1851       nbquri = 0
1852 c
1853       if ( tyconf.gt.0 .or. tyconf.eq.-2 ) then
1854 c
1855         if ( codret.eq.0 ) then
1856 c
1857 #ifdef _DEBUG_HOMARD_
1858 cgn        call gmprsx (nompro, nccoex//'.Arete' )
1859       call gmprsx (nompro, nharet//'.ConnDesc' )
1860       call gmprsx (nompro, nhtria//'.ConnDesc' )
1861       call gmprsx (nompro, nhquad//'.ConnDesc' )
1862 #endif
1863 c
1864 #ifdef _DEBUG_HOMARD_
1865       write (ulsort,texte(langue,3)) 'VCMNCO', nompro
1866 #endif
1867 c
1868         call vcmnco ( nohman,
1869      >                nhnoeu, nharet, nhtria, nhquad, nhvois,
1870      >                imem(pnoemp),
1871      >                rmem(pcoono), imem(phetno), imem(pareno),
1872      >                imem(pcexno), imem(adnohn), imem(adnocn),
1873      >                imem(psomar), imem(phetar), imem(pnp2ar),
1874      >                imem(pmerar), imem(pfilar), imem(adars2),
1875      >                imem(pcexar), imem(adarhn), imem(adarcn),
1876      >                imem(phettr), imem(paretr),
1877      >                imem(pfiltr), imem(ppertr),
1878      >                imem(phetqu), imem(parequ),
1879      >                imem(pfilqu), imem(pperqu),
1880      >                imem(pcexqu), imem(adquhn), imem(adqucn),
1881      >                imem(pquahe), imem(pcoquh),
1882      >                ulsort, langue, codret )
1883 c
1884 #ifdef _DEBUG_HOMARD_
1885 cgn        call gmprsx (nompro, nccoex//'.Arete' )
1886 cgn      call gmprsx (nompro, nhnoeu//'.AretSupp')
1887 cgn        call gmprsx (nompro, nharet//'.ConnDesc' )
1888 cgn        call gmprsx (nompro, nharet//'.HistEtat' )
1889 cgn        call gmprsx (nompro, nharet//'.Fille' )
1890 cgn        call gmprsx (nompro, nharet//'.Mere' )
1891 cgn      call gmprsx (nompro, nhtria//'.ConnDesc' )
1892 cgn      call gmprsx (nompro, nhquad//'.ConnDesc' )
1893 #endif
1894 c
1895         endif
1896 c
1897       endif
1898 c
1899 c====
1900 c 12. determination des voisinages
1901 c====
1902 c
1903 #ifdef _DEBUG_HOMARD_
1904       write (ulsort,90002) '12. voisinages ; codret', codret
1905 #endif
1906 c
1907       if ( codret.eq.0 ) then
1908 c
1909       if ( homolo.ne.0 ) then
1910         voarno = 2
1911       else
1912         voarno = 0
1913       endif
1914       vofaar = 2
1915       vovoar = 0
1916       vovofa = 2
1917 c
1918 #ifdef _DEBUG_HOMARD_
1919 cgn      call gmprsx ('Volumes dans '//nompro,nohman//'.Volume')
1920       if ( nbtrto.gt.0 ) then
1921       call gmprsx ('nhtria dans '//nompro, nhtria)
1922       call gmprot ('Triangle ConnDesc', nhtria//'.ConnDesc',
1923      >              1, min(10,nbtrto) )
1924       call gmprsx ('InfoSupp', nhtria//'.InfoSupp')
1925       endif
1926       if ( nbquto.gt.0 ) then
1927       call gmprsx ('nhquad dans '//nompro, nhquad)
1928       call gmprot ('Quadrangle ConnDesc', nhquad//'.ConnDesc',
1929      >              1, min(10,nbquto) )
1930       call gmprsx ('InfoSupp', nhquad//'.InfoSupp')
1931       endif
1932       if ( nbteto.gt.0 ) then
1933       call gmprsx ('nhtetr dans '//nompro, nhtetr)
1934       endif
1935       if ( nbheto.gt.0 ) then
1936       call gmprsx ('nhhexa dans '//nompro, nhhexa)
1937       endif
1938       if ( nbpeto.gt.0 ) then
1939       call gmprsx ('nhpent dans '//nompro, nhpent)
1940       endif
1941       if ( nbpyto.gt.0 ) then
1942       call gmprsx ('nhpyra dans '//nompro, nhpyra)
1943       call gmprsx ('ConnDesc', nhpyra//'.ConnDesc')
1944       call gmprsx ('InfoSupp', nhpyra//'.InfoSupp')
1945       endif
1946 cgn      call gmprsx ('nhpyra dans '//nompro,nhpyra)
1947 #endif
1948 #ifdef _DEBUG_HOMARD_
1949       write (ulsort,texte(langue,3)) 'UTVOIS', nompro
1950 #endif
1951       call utvois ( nohman, nhvois,
1952      >              voarno, vofaar, vovoar, vovofa,
1953      >              ppovos, pvoiso,
1954      >              nbfaar, pposif, pfacar,
1955      >              ulsort, langue, codret )
1956 c
1957       endif
1958 c
1959 c====
1960 c 13. mise a jour des numerotations
1961 c====
1962 c
1963 #ifdef _DEBUG_HOMARD_
1964       write (ulsort,90002) '13. numerotations ; codret', codret
1965 #endif
1966 c
1967       if ( codret.eq.0 ) then
1968 c
1969 c 13.1. ==> Decalage des numerotations (cf. eslmm2)
1970 c
1971 #ifdef _DEBUG_HOMARD_
1972       write(ulsort,90002) 'nbmapo', nbmapo
1973       write(ulsort,90002) 'nbsegm', nbsegm
1974       write(ulsort,90002) 'nbtria', nbtria
1975       write(ulsort,90002) 'nbtetr', nbtetr
1976       write(ulsort,90002) 'nbquad', nbquad
1977       write(ulsort,90002) 'nbhexa', nbhexa
1978       write(ulsort,90002) 'nbpent', nbpent
1979       write(ulsort,90002) 'nbpyra', nbpyra
1980 #endif
1981       decanu(-1) = 0
1982       decanu(3) = 0
1983       decanu(2) = nbtetr
1984       decanu(1) = nbtetr + nbtria
1985       decanu(0) = nbtetr + nbtria + nbsegm
1986       decanu(4) = nbtetr + nbtria + nbsegm + nbmapo
1987       decanu(6) = nbtetr + nbtria + nbsegm + nbmapo + nbquad
1988       decanu(5) = nbtetr + nbtria + nbsegm + nbmapo + nbquad + nbhexa
1989       decanu(7) = nbtetr + nbtria + nbsegm + nbmapo + nbquad + nbhexa
1990      >          + nbpyra
1991 c
1992 #ifdef _DEBUG_HOMARD_
1993       write(ulsort,90002) 'decanu', decanu
1994 #endif
1995 #ifdef _DEBUG_HOMARD_
1996 cgn      call gmprot (nompro, ncnoeu//'.NumeExte' , 1, 20 )
1997 cgn      call gmprot (nompro, ncnoeu//'.NumeExte' , nbnoto-20, nbnoto )
1998 cgn      call gmprot (nompro, nccono//'.NumeExte' , 1, 20 )
1999 cgn      call gmprot (nompro, nccono//'.NumeExte' , nbelem-20, nbelem )
2000 cgn      call gmprsx (nompro, nccono//'.NumeExte' )
2001 #endif
2002 c
2003 c 13.2. ==> Traitement
2004 c
2005 #ifdef _DEBUG_HOMARD_
2006       write (ulsort,texte(langue,3)) 'VCMREN', nompro
2007 #endif
2008       call vcmren  ( imem(adnohn), imem(adnocn), imem(adnoic),
2009      >               imem(admphn), imem(admpcn), imem(admpic),
2010      >               imem(adarhn), imem(adarcn), imem(adaric),
2011      >               imem(adtrhn), imem(adtrcn), imem(adtric),
2012      >               imem(adquhn), imem(adqucn), imem(adquic),
2013      >               imem(adtehn), imem(adtecn), imem(adteic),
2014      >               imem(adpyhn), imem(adpycn), imem(adpyic),
2015      >               imem(adhehn), imem(adhecn), imem(adheic),
2016      >               imem(adpehn), imem(adpecn), imem(adpeic),
2017      >               imem(pnunoe), imem(pnuele), decanu,
2018      >               ulsort, langue, codret )
2019 cgn      call gmprsx (nompro//'-apres vcmren', norenu//'.InfoSupE.Tab4')
2020 cgn      call gmprsx (nompro//'-apres vcmren', norenu//'.TrHOMARD')
2021 cgn      call gmprsx (nompro//'-apres vcmren', norenu//'.TrCalcul')
2022 cgn      call gmprsx (nompro//'-apres vcmren', norenu//'.InfoSupE.Tab5')
2023 cgn      call gmprsx (nompro//'-apres vcmren', norenu//'.QuHOMARD')
2024 cgn      call gmprsx (nompro//'-apres vcmren', norenu//'.QuCalcul')
2025 c
2026 #ifdef _DEBUG_HOMARD_
2027       call gmprot (nompro, norenu//'.NoHOMARD' , 1, 20 )
2028       call gmprot (nompro, norenu//'.NoHOMARD' , rsnoac-20, rsnoac )
2029       call gmprot (nompro, norenu//'.MPHOMARD' , 1, 20 )
2030       call gmprot (nompro, norenu//'.MPHOMARD' , rsmpac-20, rsmpac )
2031       call gmprot (nompro, norenu//'.ArHOMARD' , 1 , 20 )
2032       call gmprot (nompro, norenu//'.ArHOMARD' , rsarac-20, rsarac )
2033       call gmprot (nompro, norenu//'.TrHOMARD' , 1, 20 )
2034       call gmprot (nompro, norenu//'.TrHOMARD' , rstrac-20, rstrac )
2035       call gmprot (nompro, norenu//'.QuHOMARD' , 1, 20 )
2036       call gmprot (nompro, norenu//'.QuHOMARD' , rsquac-20, rsquac )
2037       call gmprot (nompro, norenu//'.TeHOMARD' , 1, 20 )
2038       call gmprot (nompro, norenu//'.TeHOMARD' , rsteac-20, rsteac )
2039       call gmprot (nompro, norenu//'.HeHOMARD' , 1, 20 )
2040       call gmprot (nompro, norenu//'.HeHOMARD' , rsheac-20, rsheac )
2041       call gmprot (nompro, nccono//'.NumeExte' , 1, 20 )
2042       call gmprot (nompro, nccono//'.NumeExte' , nbelem-20, nbelem )
2043 #endif
2044 c
2045       endif
2046 c
2047       if ( codret.eq.0 ) then
2048 c
2049       if ( rsteac.eq.0 .and. rsheac.eq.0 .and. rspyac.eq.0 ) then
2050         rseutc = rstrac + rsquac
2051         rsevca = nbtria + nbquad
2052         rsevto = rstrto + rsquto
2053       else
2054         rseutc = rsteac + rsheac + rspyac
2055         rsevca = nbtetr + nbhexa + nbpyra
2056         rsevto = rsteto + rsheto + rspyto
2057       endif
2058 c
2059       imem(adnbrn+6) = rseutc
2060       imem(adnbrn+7) = rsevca
2061       imem(adnbrn+8) = rsevto
2062 c
2063       endif
2064 c
2065 c====
2066 c 14. sauvegarde des informations generales, au sens
2067 c     du module de calcul associe
2068 c     attention : il faut faire des copies et non pas des attachements
2069 c                 car la structure generale de l'objet "maillage de
2070 c                 calcul" est detruite apres la phase de conversion.
2071 c====
2072 c
2073 #ifdef _DEBUG_HOMARD_
2074       write (ulsort,90002) '14. sauvegarde ; codret', codret
2075       if ( codret.eq.0 ) then
2076       write (ulsort,*) 'Avant copie de ncinfo'
2077       call gmprsx (nompro,ncinfo)
2078       call gmprsx (nompro,ncinfo//'.Pointeur')
2079       call gmprsx (nompro,ncinfo//'.Taille')
2080       call gmprsx (nompro,ncinfo//'.Table')
2081       endif
2082       call dmflsh (iaux)
2083 #endif
2084 c
2085 c 14.1. ==> a-t-on defini des informations generales en externe ?
2086 c 14.1.1. ==> branche principale
2087 c
2088       if ( codret.eq.0 ) then
2089 c
2090       call gmobal ( ncinfo, codret )
2091 c
2092       if ( codret.eq.0 ) then
2093         existe = .false.
2094       elseif ( codret.eq.1 ) then
2095         codret = 0
2096         existe = .true.
2097       else
2098         codret = 2
2099       endif
2100 c
2101       endif
2102 c
2103 c 14.1.2. ==> verification de l'existence des differentes branches
2104 c
2105       do 141 , iaux = 1 , 3
2106 c
2107         if ( codret.eq.0 ) then
2108 c
2109         if ( existe ) then
2110 c
2111 c                     123456789
2112           if ( iaux.eq.1 ) then
2113             saux09 = '.Pointeur'
2114           elseif ( iaux.eq.1 ) then
2115             saux09 = '.Taille  '
2116           else
2117             saux09 = '.Table   '
2118           endif
2119           call gmobal ( ncinfo//saux09, codret )
2120           if ( codret.eq.0 ) then
2121             existe = .false.
2122           elseif ( codret.eq.2 ) then
2123             codret = 0
2124           else
2125             codret = 2
2126           endif
2127 c
2128         endif
2129 c
2130         endif
2131 c
2132   141 continue
2133 c
2134 c 14.2. ==> copie des differentes branches et des attributs
2135 #ifdef _DEBUG_HOMARD_
2136       write (ulsort,90002) '14.2. Copie ; codret', codret
2137 #endif
2138 c
2139       if ( codret.eq.0 ) then
2140 c
2141       if ( existe ) then
2142 c
2143       call gmliat ( ncinfo, 1, iaux , codre1 )
2144       call gmliat ( ncinfo, 2, jaux, codre2 )
2145 c
2146       codre0 = min ( codre1, codre2 )
2147       codret = max ( abs(codre0), codret,
2148      >               codre1, codre2 )
2149 c
2150       if ( codret.eq.0 ) then
2151 c
2152       call gmecat ( nhsupe, 7, iaux, codre1 )
2153       call gmecat ( nhsupe, 8, iaux, codre2 )
2154       call gmecat ( nhsups, 3, jaux, codre3 )
2155 c
2156       codre0 = min ( codre1, codre2, codre3 )
2157       codret = max ( abs(codre0), codret,
2158      >               codre1, codre2, codre3 )
2159 c
2160       endif
2161 c
2162       if ( codret.eq.0 ) then
2163 c
2164       call gmcpoj ( ncinfo//'.Pointeur', nhsupe//'.Tab7', codre1 )
2165       call gmcpoj ( ncinfo//'.Taille',   nhsupe//'.Tab8', codre2 )
2166       call gmcpoj ( ncinfo//'.Table',    nhsups//'.Tab3', codre3 )
2167 c
2168       codre0 = min ( codre1, codre2, codre3 )
2169       codret = max ( abs(codre0), codret,
2170      >               codre1, codre2, codre3 )
2171 c
2172       endif
2173 c
2174       if ( codret.eq.0 ) then
2175 c
2176       call gmadoj ( ncinfo//'.Table', pinftb, jaux, codre1 )
2177       call gmliat ( ncinfo, 1, iaux, codre2 )
2178       nbpqt = iaux - 1
2179 c
2180       codre0 = min ( codre1, codre2 )
2181       codret = max ( abs(codre0), codret,
2182      >               codre1, codre2 )
2183 c
2184       endif
2185 c
2186       if ( codret.eq.0 ) then
2187 c
2188       do 142 , iaux = 1, nbpqt
2189 c
2190         jaux = pinftb + 10*(iaux-1)
2191 cgn        write (ulsort,90064) jaux, '%'//smem(jaux)//'%'
2192 c
2193         if ( ( smem(jaux).ne.'NomCo   ' ) .and.
2194      >       ( smem(jaux).ne.'UniteCo ' ) .and.
2195      >       ( smem(jaux).ne.'NOMAMD  ' ) .and.
2196      >       ( smem(jaux).ne.'SATURNE ' ) ) then
2197 c
2198           kaux = min(80,len(titre))
2199 cgn        write (ulsort,90002) 'longueur', kaux
2200           call uts8ch ( smem(jaux), kaux, titre,
2201      >                  ulsort, langue, codret )
2202 cgn        write (ulsort,*) 'recuperation de titre =', titre
2203 c
2204         endif
2205 c
2206   142 continue
2207 c
2208       endif
2209 c
2210       endif
2211 c
2212       endif
2213 c
2214 c====
2215 c 15. transfert des elements ignores
2216 c====
2217 c
2218 #ifdef _DEBUG_HOMARD_
2219       write (ulsort,90002) '15. elements ignores ; codret', codret
2220       write (ulsort,90002) 'nbelig', nbelig
2221       call dmflsh(iaux)
2222 #endif
2223 c
2224       if ( nbelig.ne.0 ) then
2225 c
2226         if ( codret.eq.0 ) then
2227 c
2228         call gmecat ( nhelig, 1, nbelig, codre0 )
2229 c
2230         codret = max ( abs(codre0), codret )
2231 c
2232         endif
2233 c
2234         if ( codret.eq.0 ) then
2235 c
2236         if ( degre.eq.1 ) then
2237           iaux = nbelig * 5
2238         else
2239           iaux = nbelig * 13
2240         endif
2241         call gmaloj ( nhelig//'.ConnNoeu', ' ', iaux ,  hnoeel, codre1 )
2242         call gmaloj ( nhelig//'.FamilMED', ' ', nbelig, hfmdel, codre2 )
2243 c
2244         codre0 = min ( codre1, codre2 )
2245         codret = max ( abs(codre0), codret,
2246      >                 codre1, codre2 )
2247 c
2248         endif
2249 c
2250         if ( codret.eq.0 ) then
2251 c
2252 #ifdef _DEBUG_HOMARD_
2253       write (ulsort,texte(langue,3)) 'VCMAIG', nompro
2254 #endif
2255         call vcmaig
2256      >         ( imem(hfmdel), imem(hnoeel),
2257      >           imem(ptypel), imem(pfamee), imem(pnoeel),
2258      >           imem(adnohn),
2259      >           ulsort, langue, codret )
2260 c
2261         endif
2262 cgn        call gmprsx (nompro, nhelig )
2263 cgn        call gmprsx (nompro, nhelig//'.ConnNoeu' )
2264 cgn        call gmprsx (nompro, nhelig//'.FamilMED' )
2265 c
2266       endif
2267 c
2268 c====
2269 c 16. la fin
2270 c====
2271 c
2272 #ifdef _DEBUG_HOMARD_
2273       write (ulsort,90002) '16. fin ; codret', codret
2274 #endif
2275 c
2276       if ( codret.ne.0 ) then
2277 c
2278 #include "envex2.h"
2279 c
2280       write (ulsort,texte(langue,1)) 'Sortie', nompro
2281       write (ulsort,texte(langue,2)) codret
2282 c
2283       endif
2284 c
2285 #ifdef _DEBUG_HOMARD_
2286       write (ulsort,texte(langue,1)) 'Sortie', nompro
2287       call dmflsh (iaux)
2288 #endif
2289 c
2290       end