src/tool/AV_Conversion/vcmafa.F

   1       subroutine vcmafa ( modhom, pilraf, tyconf, suifro,
   2      >                    nocman, nohman,
   3      >                    ncafdg, ncafan, ncfgnf, ncfgng,
   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 - FAmilles
  26 c     -                 -             --         --
  27 c ______________________________________________________________________
  28 c .        .     .        .                                            .
  29 c .  nom   . e/s . taille .           description                      .
  30 c .____________________________________________________________________.
  31 c . modhom . e   .    1   . mode de fonctionnement de homard           .
  32 c .        .     .        .  1 : homard pur                            .
  33 c .        .     .        .  2 : information                           .
  34 c .        .     .        .  3 : modification de maillage sans adaptati.
  35 c .        .     .        .  4 : interpolation de la solution          .
  36 c . pilraf . e   .   1    . pilotage du raffinement                    .
  37 c .        .     .        . -1 : raffinement uniforme                  .
  38 c .        .     .        .  0 : pas de raffinement                    .
  39 c .        .     .        .  1 : raffinement libre                     .
  40 c .        .     .        .  2 : raff. libre homogene en type d'element.
  41 c . tyconf . e   .   1    .  0 : conforme (defaut)                     .
  42 c .        .     .        .  1 : non-conforme avec au minimum 2 aretes .
  43 c .        .     .        .      non decoupees en 2                    .
  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 .        .     .        . -1 : conforme, avec des boites pour les    .
  48 c .        .     .        .      quadrangles, hexaedres et pentaedres  .
  49 c .        .     .        . -2 : non-conforme avec au maximum 1 arete  .
  50 c .        .     .        .      decoupee en 2 (boite pour les         .
  51 c .        .     .        .      quadrangles, hexaedres et pentaedres) .
  52 c . suifro . e   .   1    . 1 : pas de suivi de frontiere              .
  53 c .        .     .        . 2x : frontiere discrete                    .
  54 c .        .     .        . 3x : frontiere analytique                  .
  55 c .        .     .        . 5x : frontiere cao                         .
  56 c . nocman .  s  . char*8 . nom de l'objet maillage calcul iteration n .
  57 c . nohman . e   . char8  . nom de l'objet maillage homard iteration n .
  58 c . ncafdg . e   . char*8 . nom de l'objet des frontieres discretes/CAO.
  59 c .        .     .        . nom des groupes frontiere                  .
  60 c . ncafan . e   . char*8 . nom de l'objet des frontieres analytiques :.
  61 c .        .     .        . description des frontieres                 .
  62 c . ncfgnf . es  . char*8 . lien frontiere/groupe : nom des frontieres .
  63 c . ncfgng . e   . char*8 . lien frontiere/groupe : nom des groupes    .
  64 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  65 c . langue . e   .    1   . langue des messages                        .
  66 c .        .     .        . 1 : francais, 2 : anglais                  .
  67 c . codret . es  .    1   . code de retour des modules                 .
  68 c .        .     .        . 0 : pas de probleme                        .
  69 c .        .     .        . 1 : probleme                               .
  70 c ______________________________________________________________________
  71 c
  72 c====
  73 c 0. declarations et dimensionnement
  74 c====
  75 c
  76 c 0.1. ==> generalites
  77 c
  78       implicit none
  79       save
  80 c
  81       character*6 nompro
  82       parameter ( nompro = 'VCMAFA' )
  83 c
  84 #include "nblang.h"
  85 #include "consts.h"
  86 #include "meddc0.h"
  87 #include "coftfq.h"
  88 #include "coftfh.h"
  89 #include "cofpfh.h"
  90 #include "coftfp.h"
  91 #include "cofpfp.h"
  92 c
  93 c 0.2. ==> communs
  94 c
  95 #include "envex1.h"
  96 c
  97 #include "gmenti.h"
  98 #include "gmstri.h"
  99 c
 100 #include "nbutil.h"
 101 #include "dicfen.h"
 102 #include "envca1.h"
 103 #include "nbfami.h"
 104 #include "nbfamm.h"
 105 #include "nombmp.h"
 106 #include "nombar.h"
 107 #include "nombtr.h"
 108 #include "nombqu.h"
 109 #include "nombno.h"
 110 #include "nombte.h"
 111 #include "nombhe.h"
 112 #include "nombpy.h"
 113 #include "nombpe.h"
 114 #include "impr02.h"
 115 c
 116 c 0.3. ==> arguments
 117 c
 118       integer modhom, pilraf, tyconf, suifro
 119 c
 120       character*8 nocman, nohman
 121       character*8 ncafdg, ncafan, ncfgnf, ncfgng
 122 c
 123       integer ulsort, langue, codret
 124 c
 125 c 0.4. ==> variables locales
 126 c
 127       integer pfamno, pcfano, pcexno
 128       integer pfammp, pcfamp, pcexmp
 129       integer pfamar, pcfaar, pcexar
 130       integer pfamtr, pcfatr, pcextr
 131       integer pfamqu, pcfaqu, pcexqu
 132       integer pfamte, pcfate, pcexte
 133       integer pfamhe, pcfahe, pcexhe
 134       integer pfampy, pcfapy, pcexpy
 135       integer pfampe, pcfape, pcexpe
 136       integer pnunoe, pnuele
 137       integer pnoemp
 138       integer psomar, pposif, pfacar, pnp2ar
 139       integer paretr, parequ, pareno
 140       integer pfamee, ptypel
 141       integer pgrpo, pgrtai, pgrtab
 142       integer nbfme0, ngrou0
 143 c
 144       integer adhono, admpho, adhoar, adhotr, adhoqu
 145       integer ppovos, pvoiso, adfrfa, pnumfa, pnomfa
 146       integer adeqpo
 147       integer adeqno, adeqar, adeqtr, adeqqu
 148       integer adnomb
 149 c
 150       integer typenh, pfamen, pcfaen
 151       integer nbento, nctfen, nbfenm, nbfaen
 152 c
 153       integer rvnoac, adnohn
 154       integer rvmpac, admphn
 155       integer rvarac, adarhn
 156       integer rvtrac, adtrhn
 157       integer rvquac, adquhn
 158       integer rvteac, adtehn
 159       integer rvheac, adhehn
 160       integer rvpyac, adpyhn
 161       integer rvpeac, adpehn
 162       integer ptngrf
 163 c
 164       integer iaux, jaux, kaux, paux
 165       integer iaux1, iaux2, iaux3, iaux4, iaux5, iaux6, iaux7, iaux8
 166       integer codre1, codre2, codre3, codre4, codre5
 167       integer codre6, codre0
 168       integer pttgrd, ptngrd, pointd
 169       integer adcpoi, adctai, adctab
 170       integer adfpoi, adftai, adftab
 171       integer adgpoi, adgtai, adgtab
 172       integer pointe
 173       integer nbgrof, nbfrgr, nbfran
 174       integer ptrav1
 175       integer adfrgr, adnogr
 176       integer un
 177       integer nbfmem, nbtype, nborie, nbrequ
 178 c
 179       character*8 norenu
 180       character*8 nhnoeu, nhmapo, nharet, nhtria, nhquad
 181       character*8 nhtetr, nhhexa, nhpyra, nhpent
 182       character*8 nhelig
 183       character*8 nhvois, nhsupe, nhsups
 184       character*8 nhnofa, nhmpfa, nharfa
 185       character*8 nhtrfa, nhqufa
 186       character*8 nhtefa, nhhefa, nhpyfa, nhpefa
 187       character*8 ncinfo, ncnoeu, nccono, nccode
 188       character*8 nccoex, ncfami
 189       character*8 ncequi, ncfron, ncnomb
 190       character*8 ntrav1
 191       character*8 nhenti, nhenfa
 192 c
 193       integer nbmess
 194       parameter ( nbmess = 10 )
 195       character*80 texte(nblang,nbmess)
 196 c
 197 c 0.5. ==> initialisations
 198 c ______________________________________________________________________
 199 c
 200 c====
 201 c 1. messages
 202 c====
 203 c
 204 #include "impr01.h"
 205 c
 206 #ifdef _DEBUG_HOMARD_
 207       write (ulsort,texte(langue,1)) 'Entree', nompro
 208       call dmflsh (iaux)
 209 #endif
 210 c
 211       texte(1,4) = '(''Erreur dans le decodage de l''''objet '',a)'
 212       texte(1,5) = '(''. Nombre de '',a,'' :'',i10)'
 213       texte(1,7) = '(5x,''Conversion '',a18,'' ---> HOMARD'',/)'
 214       texte(1,8) =
 215      > '(''Aucune frontiere analytique n''''a ete definie.'')'
 216 c
 217       texte(2,4) = '(''Error while uncoding object '',a)'
 218       texte(2,5) = '(''. Number of '',a,'' :'',i10)'
 219       texte(2,7) = '(5x,''Conversion '',a18,'' ---> HOMARD'',/)'
 220       texte(2,8) = '(''No analytical boundary was defined.'')'
 221 c
 222 #include "impr03.h"
 223 c
 224 c====
 225 c 2. recuperation des donnees du maillage d'entree
 226 c====
 227 c
 228 #ifdef _DEBUG_HOMARD_
 229       write (ulsort,texte(langue,5)) mess14(langue,3,-1), nbnoto
 230       write (ulsort,texte(langue,5)) mess14(langue,3,0), nbmpto
 231       write (ulsort,texte(langue,5)) mess14(langue,3,1), nbarto
 232       write (ulsort,texte(langue,5)) mess14(langue,3,2), nbtrto
 233       write (ulsort,texte(langue,5)) mess14(langue,3,3), nbteto
 234       write (ulsort,texte(langue,5)) mess14(langue,3,4), nbquto
 235       write (ulsort,texte(langue,5)) mess14(langue,3,6), nbheto
 236 #endif
 237 c
 238 c 2.1. ==> structure generale
 239 c
 240       if ( codret.eq.0 ) then
 241 c
 242 #ifdef _DEBUG_HOMARD_
 243       write (ulsort,texte(langue,3)) 'UTNOMC', nompro
 244 #endif
 245       call utnomc ( nocman,
 246      >              iaux1, iaux2,
 247      >              iaux3, iaux4, iaux5, iaux6, iaux7,
 248      >              iaux8,
 249      >              ncinfo, ncnoeu, nccono, nccode,
 250      >              nccoex, ncfami,
 251      >              ncequi, ncfron, ncnomb,
 252      >              ulsort, langue, codret )
 253 c
 254       endif
 255 c
 256       if ( codret.eq.0 ) then
 257 c
 258 #ifdef _DEBUG_HOMARD_
 259       write (ulsort,texte(langue,3)) 'UTNOMH', nompro
 260 #endif
 261       call utnomh ( nohman,
 262      >                sdim,   mdim,
 263      >               degre, maconf, homolo, hierar,
 264      >              rafdef, nbmane, typcca, typsfr, maextr,
 265      >              mailet,
 266      >              norenu,
 267      >              nhnoeu, nhmapo, nharet,
 268      >              nhtria, nhquad,
 269      >              nhtetr, nhhexa, nhpyra, nhpent,
 270      >              nhelig,
 271      >              nhvois, nhsupe, nhsups,
 272      >              ulsort, langue, codret )
 273 c
 274       endif
 275 c
 276 #ifdef _DEBUG_HOMARD_
 277 #include "mslve4.h"
 278 #endif
 279 c
 280 c 2.2. ==> tableaux
 281 c
 282 #ifdef _DEBUG_HOMARD_
 283       write (ulsort,90002) '2.2.==> tableaux ; codret', codret
 284 #endif
 285 c
 286 c 2.2.1. ==> Numerotations externes du code de calcul
 287 c
 288       if ( codret.eq.0 ) then
 289 c
 290       if ( ( homolo.ge.1 ) .or.
 291      >     ( mod(suifro,2).eq.0 ) .or.
 292      >     ( mod(suifro,3).eq.0 ) .or.
 293      >     ( mod(suifro,5).eq.0 ) ) then
 294 c
 295 #ifdef _DEBUG_HOMARD_
 296       write (ulsort,texte(langue,3)) 'UTAD11', nompro
 297 #endif
 298       if ( suifro.eq.1 ) then
 299         iaux = 85
 300       else
 301         iaux = 6545
 302       endif
 303       call utad11 ( iaux, ncnoeu, nccono,
 304      >                jaux,   jaux, pnunoe,  jaux,
 305      >              ptypel, pfamee,   jaux, pnuele,
 306      >              ulsort, langue, codret )
 307 c
 308       endif
 309 c
 310       endif
 311 c
 312 c 2.2.2. ==> Groupes et codes externes
 313 c
 314       if ( codret.eq.0 ) then
 315 c
 316 #ifdef _DEBUG_HOMARD_
 317       write (ulsort,texte(langue,3)) 'UTAD12_no', nompro
 318 #endif
 319       iaux = 210
 320       jaux = -1
 321       call utad12 ( iaux, jaux,
 322      >              nccoex, pcexno,
 323      >              ulsort, langue, codret )
 324 c
 325       if ( nbmpto.ne.0 ) then
 326 c
 327 #ifdef _DEBUG_HOMARD_
 328       write (ulsort,texte(langue,3)) 'UTAD12_mp', nompro
 329 #endif
 330         iaux = 210
 331         jaux = 0
 332         call utad12 ( iaux, jaux,
 333      >                nccoex, pcexmp,
 334      >                ulsort, langue, codret )
 335 c
 336       endif
 337 c
 338 #ifdef _DEBUG_HOMARD_
 339       write (ulsort,texte(langue,3)) 'UTAD12_ar', nompro
 340 #endif
 341       iaux = 210
 342       jaux = 1
 343       call utad12 ( iaux, jaux,
 344      >              nccoex, pcexar,
 345      >              ulsort, langue, codret )
 346 c
 347       if ( nbtrto.ne.0 ) then
 348 c
 349 #ifdef _DEBUG_HOMARD_
 350         write (ulsort,texte(langue,3)) 'UTAD12_tr', nompro
 351 #endif
 352         iaux = 210
 353         jaux = 2
 354         call utad12 ( iaux, jaux,
 355      >                nccoex, pcextr,
 356      >                ulsort, langue, codret )
 357 c
 358       endif
 359 c
 360       if ( nbquto.ne.0 ) then
 361 c
 362 #ifdef _DEBUG_HOMARD_
 363         write (ulsort,texte(langue,3)) 'UTAD12_qu', nompro
 364 #endif
 365         iaux = 210
 366         jaux = 4
 367         call utad12 ( iaux, jaux,
 368      >                nccoex, pcexqu,
 369      >                ulsort, langue, codret )
 370 c
 371       endif
 372 c
 373       if ( nbteto.ne.0 ) then
 374 c
 375 #ifdef _DEBUG_HOMARD_
 376         write (ulsort,texte(langue,3)) 'UTAD12_te', nompro
 377 #endif
 378         iaux = 210
 379         jaux = 3
 380         call utad12 ( iaux, jaux,
 381      >                nccoex, pcexte,
 382      >                ulsort, langue, codret )
 383 c
 384       endif
 385 c
 386       if ( nbheto.ne.0 ) then
 387 c
 388 #ifdef _DEBUG_HOMARD_
 389         write (ulsort,texte(langue,3)) 'UTAD12_he', nompro
 390 #endif
 391         iaux = 210
 392         jaux = 6
 393         call utad12 ( iaux, jaux,
 394      >                nccoex, pcexhe,
 395      >                ulsort, langue, codret )
 396 c
 397       endif
 398 c
 399       if ( nbpyto.ne.0 ) then
 400 c
 401 #ifdef _DEBUG_HOMARD_
 402         write (ulsort,texte(langue,3)) 'UTAD12_py', nompro
 403 #endif
 404         iaux = 210
 405         jaux = 5
 406         call utad12 ( iaux, jaux,
 407      >                nccoex, pcexpy,
 408      >                ulsort, langue, codret )
 409 c
 410       endif
 411 c
 412       if ( nbpeto.ne.0 ) then
 413 c
 414 #ifdef _DEBUG_HOMARD_
 415         write (ulsort,texte(langue,3)) 'UTAD12_pe', nompro
 416 #endif
 417         iaux = 210
 418         jaux = 7
 419         call utad12 ( iaux, jaux,
 420      >                nccoex, pcexpe,
 421      >                ulsort, langue, codret )
 422 c
 423       endif
 424 c
 425 c 2.2.3. ==> Connectivites des entites HOMARD
 426 c
 427       call gmadoj ( nhnoeu//'.AretSupp', pareno, iaux, codre1 )
 428       call gmadoj ( nhmapo//'.ConnDesc', pnoemp, iaux, codre2 )
 429       call gmadoj ( nharet//'.ConnDesc', psomar, iaux, codre3 )
 430       if ( degre.eq.2 ) then
 431         call gmadoj ( nharet//'.InfoSupp', pnp2ar, iaux, codre4 )
 432       else
 433         codre4 = 0
 434       endif
 435       if ( nbtrto.ne.0 ) then
 436         call gmadoj ( nhtria//'.ConnDesc', paretr, iaux, codre5 )
 437       else
 438         codre5 = 0
 439       endif
 440       if ( nbquto.ne.0 ) then
 441         call gmadoj ( nhquad//'.ConnDesc', parequ, iaux, codre6 )
 442       else
 443         codre6 = 0
 444       endif
 445 c
 446       codre0 = min ( codre1, codre2, codre3, codre4, codre5,
 447      >               codre6 )
 448       codret = max ( abs(codre0), codret,
 449      >               codre1, codre2, codre3, codre4, codre5,
 450      >               codre6 )
 451 c
 452 c 2.2.4. ==> Homologues
 453 c
 454       if ( homolo.ne.0 ) then
 455 c
 456         call gmadoj ( ncequi//'.Pointeur', adeqpo, iaux, codre1 )
 457         call gmadoj ( ncequi//'.Noeud' , adeqno, iaux, codre2 )
 458         call gmadoj ( ncequi//'.Arete' , adeqar, iaux, codre3 )
 459         call gmadoj ( ncequi//'.Trian' , adeqtr, iaux, codre4 )
 460         call gmadoj ( ncequi//'.Quadr' , adeqqu, iaux, codre5 )
 461 c
 462         codre0 = min ( codre1, codre2, codre3, codre4, codre5 )
 463         codret = max ( abs(codre0), codret,
 464      >                 codre1, codre2, codre3, codre4, codre5 )
 465 c
 466       endif
 467 c
 468 c 2.2.5. ==> Voisinages
 469 c
 470 #ifdef _DEBUG_HOMARD_
 471       write (ulsort,texte(langue,3)) 'UTAD04', nompro
 472 #endif
 473       iaux = 3
 474       if ( homolo.ne.0 ) then
 475         iaux = iaux*2
 476       endif
 477       call utad04 ( iaux, nhvois,
 478      >              ppovos, pvoiso, pposif, pfacar,
 479      >                jaux,   jaux,
 480      >                jaux,   jaux,   jaux,   jaux,
 481      >                jaux,   jaux,   jaux,
 482      >                jaux,   jaux,   jaux,
 483      >                jaux,   jaux,   jaux,
 484      >                jaux,   jaux,   jaux,
 485      >              ulsort, langue, codret )
 486 c
 487       endif
 488 c
 489       if ( codret.ne.0 ) then
 490       write (ulsort,texte(langue,4)) nocman
 491       endif
 492 c
 493 c 2.3. ==> modification de la taille du tableau des codes par la prise
 494 c          en compte des groupes et des homologues
 495 c
 496 #ifdef _DEBUG_HOMARD_
 497       write (ulsort,90002) '2.3. ==> modif taille ; codret', codret
 498       write (ulsort,90002) 'homolo', homolo
 499 #endif
 500 c
 501       if ( codret.eq.0 ) then
 502 c
 503       ncefno = 0
 504       ncefmp = 0
 505       ncefar = 0
 506       nceftr = 0
 507       ncefqu = 0
 508 c
 509 c 2.3.1. ==> homologues
 510 c
 511       if ( homolo.ne.0 ) then
 512 c
 513 c  pour chaque type d'entite, on repere si au moins une equivalence
 514 c  est concernee
 515 c
 516         do 23 , iaux = 1 , nbequi
 517           jaux = adeqpo + 5*iaux - 5
 518           if ( imem(jaux).ne.0 ) then
 519             ncefno = ncefno + 1
 520           endif
 521           jaux = adeqpo + 5*iaux - 4
 522           if ( imem(jaux).ne.0 ) then
 523             ncefmp = ncefmp + 1
 524           endif
 525           jaux = adeqpo + 5*iaux - 3
 526           if ( imem(jaux).ne.0 ) then
 527             ncefar = ncefar + 1
 528           endif
 529           jaux = adeqpo + 5*iaux - 2
 530           if ( imem(jaux).ne.0 ) then
 531             nceftr = nceftr + 1
 532           endif
 533           jaux = adeqpo + 5*iaux - 1
 534           if ( imem(jaux).ne.0 ) then
 535             ncefqu = ncefqu + 1
 536             nceftr = nceftr + 1
 537           endif
 538    23   continue
 539 c
 540 c  pour chaque type d'entite, si au moins une equivalence est concernee,
 541 c  on dit que toutes les equivalences sont concernees.
 542 c  verrue car on n'a pas separe les equivalences par type comme cela
 543 c  est fait pour les groupes.
 544 c  on gaspille un peu de memoire, mais ce n'est pas tres grave.
 545 c
 546         if ( ncefno.ne.0 ) then
 547           ncefno = nbequi
 548         endif
 549         if ( ncefmp.ne.0 ) then
 550           ncefmp = nbequi
 551         endif
 552         if ( ncefar.ne.0 ) then
 553           ncefar = nbequi
 554         endif
 555         if ( nceftr.ne.0 ) then
 556           nceftr = nbequi
 557         endif
 558         if ( ncefqu.ne.0 ) then
 559           ncefqu = nbequi
 560         endif
 561 c
 562       endif
 563 c
 564 c 2.3.2. ==> Changement de tailles
 565 c
 566 #ifdef _DEBUG_HOMARD_
 567       write (ulsort,90002) '2.3.2. ==> modif taille ; codret', codret
 568 #endif
 569 c
 570       iaux1 = nctfno
 571       nctfno = nctfno + ncefno
 572       call gmmod ( nccoex//'.Noeud', pcexno,
 573      >             nbnoto, nbnoto, iaux1, nctfno, codre1 )
 574 c
 575       if ( nbmpto.ne.0 ) then
 576         iaux1 = nctfmp
 577         nctfmp = nctfmp + ncefmp
 578         call gmmod ( nccoex//'.Point', pcexmp,
 579      >               nbmpto, nbmpto, iaux1, nctfmp, codre2 )
 580       endif
 581 c
 582       iaux1 = nctfar
 583       nctfar = nctfar + ncefar
 584       call gmmod ( nccoex//'.Arete', pcexar,
 585      >             nbarto, nbarto, iaux1, nctfar, codre3 )
 586 c
 587       codre0 = min ( codre1, codre2, codre3 )
 588       codret = max ( abs(codre0), codret,
 589      >               codre1, codre2, codre3 )
 590 c
 591       if ( nbtria.ne.0 .or. nbquad.ne.0 ) then
 592         iaux1 = nctftr
 593         if ( nbtria.ne.0 ) then
 594           nctftr = nctftr + nceftr
 595         endif
 596         if ( nbquad.ne.0 .and. modhom.eq.1 .and. pilraf.eq.1 ) then
 597           nctftr = nctftr
 598         endif
 599         call gmmod ( nccoex//'.Trian', pcextr,
 600      >               nbtrto, nbtrto, iaux1, nctftr, codre0 )
 601         codret = max ( abs(codre0), codret )
 602       endif
 603 c
 604       if ( nbquto.ne.0 ) then
 605         iaux1 = nctfqu
 606         nctfqu = nctfqu + ncefqu
 607         call gmmod ( nccoex//'.Quadr', pcexqu,
 608      >               nbquto, nbquto, iaux1, nctfqu, codre0 )
 609         codret = max ( abs(codre0), codret )
 610       endif
 611 c
 612       if ( nbteto.ne.0 ) then
 613         iaux1 = nctfte
 614         nctfte = nctfte
 615         call gmmod ( nccoex//'.Tetra', pcexte,
 616      >               nbteto, nbteto, iaux1, nctfte, codre0 )
 617         codret = max ( abs(codre0), codret )
 618       endif
 619 c
 620       if ( nbheto.ne.0 ) then
 621         iaux1 = nctfhe
 622         nctfhe = nctfhe
 623         call gmmod ( nccoex//'.Hexae', pcexhe,
 624      >               nbheto, nbheto, iaux1, nctfhe, codre0 )
 625         codret = max ( abs(codre0), codret )
 626       endif
 627 c
 628       if ( nbpyto.ne.0 ) then
 629         iaux1 = nctfpy
 630         nctfpy = nctfpy
 631         call gmmod ( nccoex//'.Pyram', pcexpy,
 632      >               nbpyto, nbpyto, iaux1, nctfpy, codre0 )
 633         codret = max ( abs(codre0), codret )
 634       endif
 635 c
 636       if ( nbpeto.ne.0 ) then
 637         iaux1 = nctfpe
 638         nctfpe = nctfpe
 639         call gmmod ( nccoex//'.Penta', pcexpe,
 640      >               nbpeto, nbpeto, iaux1, nctfpe, codre0 )
 641         codret = max ( abs(codre0), codret )
 642       endif
 643 c
 644       endif
 645 c
 646 c 2.4. ==> tableaux de renumerotation
 647 #ifdef _DEBUG_HOMARD_
 648       write (ulsort,90002) '2.4. ==> renumerotation ; codret', codret
 649       call gmprsx (nompro,norenu)
 650 #endif
 651 c
 652       if ( codret.eq.0 ) then
 653 c
 654 #ifdef _DEBUG_HOMARD_
 655       write (ulsort,texte(langue,3)) 'UTRE03_no', nompro
 656 #endif
 657       iaux = -1
 658       jaux = 10
 659       call utre03 ( iaux, jaux, norenu,
 660      >              rvnoac,   kaux, adnohn,   kaux,
 661      >              ulsort, langue, codret )
 662 c
 663       endif
 664 c
 665       if ( codret.eq.0 ) then
 666 c
 667 #ifdef _DEBUG_HOMARD_
 668       write (ulsort,texte(langue,3)) 'UTRE03_mp', nompro
 669 #endif
 670       iaux = 0
 671       jaux = -10
 672       call utre03 ( iaux, jaux, norenu,
 673      >              rvmpac,   kaux, admphn,   kaux,
 674      >              ulsort, langue, codret )
 675 c
 676       endif
 677 c
 678       if ( codret.eq.0 ) then
 679 c
 680 #ifdef _DEBUG_HOMARD_
 681       write (ulsort,texte(langue,3)) 'UTRE03_ar', nompro
 682 #endif
 683       iaux = 1
 684       jaux = -10
 685       call utre03 ( iaux, jaux, norenu,
 686      >              rvarac,   kaux, adarhn,   kaux,
 687      >              ulsort, langue, codret )
 688 c
 689       endif
 690 c
 691       if ( codret.eq.0 ) then
 692 c
 693 #ifdef _DEBUG_HOMARD_
 694       write (ulsort,texte(langue,3)) 'UTRE03_tr', nompro
 695 #endif
 696       iaux = 2
 697       jaux = -10
 698       call utre03 ( iaux, jaux, norenu,
 699      >              rvtrac,   kaux, adtrhn,   kaux,
 700      >              ulsort, langue, codret )
 701 c
 702       endif
 703 c
 704       if ( codret.eq.0 ) then
 705 c
 706 #ifdef _DEBUG_HOMARD_
 707       write (ulsort,texte(langue,3)) 'UTRE03_te', nompro
 708 #endif
 709       iaux = 3
 710       jaux = -10
 711       call utre03 ( iaux, jaux, norenu,
 712      >              rvteac,   kaux, adtehn,   kaux,
 713      >              ulsort, langue, codret )
 714 c
 715       endif
 716 c
 717       if ( codret.eq.0 ) then
 718 c
 719 #ifdef _DEBUG_HOMARD_
 720       write (ulsort,texte(langue,3)) 'UTRE03_qu', nompro
 721 #endif
 722       iaux = 4
 723       jaux = -10
 724       call utre03 ( iaux, jaux, norenu,
 725      >              rvquac,   kaux, adquhn,   kaux,
 726      >              ulsort, langue, codret )
 727 c
 728       endif
 729 c
 730       if ( codret.eq.0 ) then
 731 c
 732 #ifdef _DEBUG_HOMARD_
 733       write (ulsort,texte(langue,3)) 'UTRE03_py', nompro
 734 #endif
 735       iaux = 5
 736       jaux = -10
 737       call utre03 ( iaux, jaux, norenu,
 738      >              rvpyac,   kaux, adpyhn,   kaux,
 739      >              ulsort, langue, codret )
 740 c
 741       endif
 742 c
 743       if ( codret.eq.0 ) then
 744 c
 745 #ifdef _DEBUG_HOMARD_
 746       write (ulsort,texte(langue,3)) 'UTRE03_he', nompro
 747 #endif
 748       iaux = 6
 749       jaux = -10
 750       call utre03 ( iaux, jaux, norenu,
 751      >              rvheac,   kaux, adhehn,   kaux,
 752      >              ulsort, langue, codret )
 753 c
 754       endif
 755 c
 756       if ( codret.eq.0 ) then
 757 c
 758 #ifdef _DEBUG_HOMARD_
 759       write (ulsort,texte(langue,3)) 'UTRE03_pe', nompro
 760 #endif
 761       iaux = 7
 762       jaux = -10
 763       call utre03 ( iaux, jaux, norenu,
 764      >              rvpeac,   kaux, adpehn,   kaux,
 765      >              ulsort, langue, codret )
 766 c
 767       endif
 768 c
 769 c 2.5. ==> borne maximale des dimensionnements en fonction
 770 c          de la configuration
 771 c
 772 c  noeuds          1 : famille MED
 773 c                + l : appartenance a l'equivalence l
 774 c
 775 c  mailles-points  1 : famille MED
 776 c                  2 : type de maille-point
 777 c                  3 : famille du sommet support
 778 c                + l : appartenance a l'equivalence l
 779 c
 780 c  aretes          1 : famille MED
 781 c                  2 : type de segment
 782 c                  3 : orientation
 783 c                  4 : famille d'orientation inverse
 784 c                  5 : numero de ligne de frontiere
 785 c                       > 0 si arete concernee par le suivi de frontiere
 786 c                      <= 0 si non concernee
 787 c                  6 : famille de suivi de frontiere active/inactive
 788 c                  7 : numero de surface de frontiere
 789 c                + l : appartenance a l'equivalence l
 790 c
 791 c  triangles       1 : famille MED
 792 c                  2 : type de triangle
 793 c                  3 : numero de surface de frontiere
 794 c                  4 : famille des aretes internes apres raf
 795 c                + l : appartenance a l'equivalence l
 796 c
 797 c  quadrangles     1 : famille MED
 798 c                  2 : type de quadrangle
 799 c                  3 : numero de surface de frontiere
 800 c                  4 : famille des aretes internes apres raf
 801 c                  5 : famille des triangles de conformite
 802 c                  6 : famille de suivi de frontiere active/inactive
 803 c                + l : appartenance a l'equivalence l
 804 c
 805 c  tetraedres      1 : famille MED
 806 c                  2 : type de tetraedres
 807 c
 808 c  hexaedres       1 : famille MED
 809 c                  2 : type de hexaedres
 810 c                  3 : famille des tetraedres de conformite
 811 c                  4 : famille des pyramides de conformite
 812 c
 813 c  pyramides       1 : famille MED
 814 c                  2 : type de pyramides
 815 c
 816 c  pentaedres      1 : famille MED
 817 c                  2 : type de pentaedres
 818 c                  3 : famille des tetraedres de conformite
 819 c                  4 : famille des pyramides de conformite
 820 c
 821 #ifdef _DEBUG_HOMARD_
 822       write (ulsort,90002) '2.5. ==> borne maximale ; codret', codret
 823 #endif
 824 #ifdef _DEBUG_HOMARD_
 825       write (ulsort,90002)
 826      > 'nbequi, nbeqno, nbeqmp, nbeqar, nbeqtr, nbeqqu',
 827      >  nbequi, nbeqno, nbeqmp, nbeqar, nbeqtr, nbeqqu
 828       write (ulsort,90002) 'nbfmen', nbfmen
 829 #endif
 830 c
 831       if ( codret.eq.0 ) then
 832 c
 833 c 2.5.1. ==> Les noeuds
 834 c
 835       nbfnom = nbfmen + 2
 836 c     prise en compte des equivalences possibles
 837       if ( ncefno.ne.0 ) then
 838         nbfnom = 2*nbfnom
 839       endif
 840 #ifdef _DEBUG_HOMARD_
 841       write (ulsort,90002) 'nbfnom', nbfnom
 842 #endif
 843 c
 844 c 2.5.2. ==> Les mailles
 845 c
 846 c     nombre de familles med
 847       nbfmem = nbfmed - nbfmen
 848 c
 849       do 252 , typenh = 0 , 7
 850 c
 851 #ifdef _DEBUG_HOMARD_
 852         write (ulsort,*) ' '
 853         write (ulsort,*) mess14(langue,4,typenh)
 854 #endif
 855 c
 856 c 2.5.2.1. ==> nombre de types possibles
 857 c
 858         if ( typenh.eq.0 ) then
 859           nbtype = 1
 860         else
 861           nbtype = 2
 862         endif
 863 c
 864 c 2.5.2.2. ==> nombre d'orientations possibles
 865 c
 866         if ( typenh.eq.1 ) then
 867           nborie = 2
 868         else
 869           nborie = 1
 870         endif
 871 c
 872 c 2.5.2.3. ==> equivalences possibles
 873 c
 874         if ( typenh.eq.0 ) then
 875           nbrequ = ncefmp
 876         elseif ( typenh.eq.1 ) then
 877           nbrequ = ncefar
 878         elseif ( typenh.eq.2 ) then
 879           nbrequ = nceftr
 880         elseif ( typenh.eq.4 ) then
 881           nbrequ = ncefqu
 882         else
 883           nbrequ = 0
 884         endif
 885         nbrequ = nbrequ + 1
 886 c
 887 c 2.5.2.4. ==> evaluation du nombre maximum de familles
 888 c
 889 #ifdef _DEBUG_HOMARD_
 890         write (ulsort,90002) 'nbfmem', nbfmem
 891         write (ulsort,90002) 'nbtype', nbtype
 892         write (ulsort,90002) 'nborie', nborie
 893         write (ulsort,90002) 'nbrequ', nbrequ
 894 #endif
 895         iaux = nbfmem*nbtype*nborie*nbrequ
 896 #ifdef _DEBUG_HOMARD_
 897         write (ulsort,90002) '==> iaux', iaux
 898 #endif
 899 c
 900         if ( typenh.eq.0 ) then
 901           nbfmpm = iaux*nbfnom
 902         elseif ( typenh.eq.3 ) then
 903           nbftem = iaux
 904         elseif ( typenh.eq.5 ) then
 905           nbfhem = iaux
 906         elseif ( typenh.eq.6 ) then
 907           nbfpym = iaux
 908         elseif ( typenh.eq.7 ) then
 909           nbfpem = iaux
 910         endif
 911 c
 912   252 continue
 913 c
 914 #ifdef _DEBUG_HOMARD_
 915       write (ulsort,90002) 'nbfmpm', nbfmpm
 916       write (ulsort,90002) 'nbfarm', nbfarm
 917       write (ulsort,90002) 'nbftrm', nbftrm
 918       write (ulsort,90002) 'nbfqum', nbfqum
 919       write (ulsort,90002) 'nbftem', nbftem
 920       write (ulsort,90002) 'nbfhem', nbfhem
 921       write (ulsort,90002) 'nbfpym', nbfpym
 922       write (ulsort,90002) 'nbfpem', nbfpem
 923 #endif
 924 c
 925       endif
 926 c
 927 c====
 928 c 3. allocation des nouveaux tableaux
 929 c    remarque : on alloue pour toutes les entites, meme s'il se
 930 c               peut qu'il n'y en ait pas.
 931 c====
 932 c
 933 #ifdef _DEBUG_HOMARD_
 934       write (ulsort,90002) '3. allocation nou tab ; codret', codret
 935       call gmstat(1)
 936 #endif
 937 c
 938       do 30 , typenh = -1 , 7
 939 c
 940 c 3.1. ==> Caracteristiques des entites concernees
 941 c
 942         if ( codret.eq.0 ) then
 943 c
 944         if ( typenh.eq.-1 ) then
 945           nhenti = nhnoeu
 946           nbento = nbnoto
 947           nctfen = nctfno
 948           nbfenm = nbfnom
 949         elseif ( typenh.eq.0 ) then
 950           nhenti = nhmapo
 951           nbento = nbmpto
 952           nctfen = nctfmp
 953           nbfenm = nbfmpm
 954         elseif ( typenh.eq.1 ) then
 955           nhenti = nharet
 956           nbento = nbarto
 957           nctfen = nctfar
 958           nbfenm = nbfarm
 959         elseif ( typenh.eq.2 ) then
 960           nhenti = nhtria
 961           nbento = nbtrto
 962           nctfen = nctftr
 963           nbfenm = nbftrm
 964         elseif ( typenh.eq.3 ) then
 965           nhenti = nhtetr
 966           nbento = nbteto
 967           nctfen = nctfte
 968           nbfenm = nbftem
 969         elseif ( typenh.eq.4 ) then
 970           nhenti = nhquad
 971           nbento = nbquto
 972           nctfen = nctfqu
 973           nbfenm = nbfqum
 974         elseif ( typenh.eq.5 ) then
 975           nhenti = nhpyra
 976           nbento = nbpyto
 977           nctfen = nctfpy
 978           nbfenm = nbfpym
 979         elseif ( typenh.eq.6 ) then
 980           nhenti = nhhexa
 981           nbento = nbheto
 982           nctfen = nctfhe
 983           nbfenm = nbfhem
 984         elseif ( typenh.eq.7 ) then
 985           nhenti = nhpent
 986           nbento = nbpeto
 987           nctfen = nctfpe
 988           nbfenm = nbfpem
 989         endif
 990 c
 991         endif
 992 c
 993 c 3.2. ==> appel du programme generique
 994 c
 995         if ( codret.eq.0 ) then
 996 c
 997 #ifdef _DEBUG_HOMARD_
 998           write (ulsort,*) ' '
 999           write (ulsort,*) mess14(langue,4,typenh)
1000           write (ulsort,90002) 'nbento', nbento
1001           write (ulsort,90002) 'nctfen', nctfen
1002           write (ulsort,90002) 'nbfenm', nbfenm
1003 #endif
1004 c
1005 #ifdef _DEBUG_HOMARD_
1006         write (ulsort,texte(langue,3)) 'UTALFE', nompro
1007 #endif
1008         iaux = typenh
1009         call utalfe ( iaux, nhenti,
1010      >                nbento, nctfen, nbfenm,
1011      >                nhenfa, pfamen, pcfaen,
1012      >                ulsort, langue, codret )
1013 c
1014         endif
1015 c
1016 c 3.3. ==> Recuperation de l'adresse des codes
1017 c
1018         if ( codret.eq.0 ) then
1019 c
1020         if ( typenh.eq.-1 ) then
1021           nhnofa = nhenfa
1022           pfamno = pfamen
1023           pcfano = pcfaen
1024         elseif ( typenh.eq.0 ) then
1025           nhmpfa = nhenfa
1026           pfammp = pfamen
1027           pcfamp = pcfaen
1028         elseif ( typenh.eq.1 ) then
1029           nharfa = nhenfa
1030           pfamar = pfamen
1031           pcfaar = pcfaen
1032         elseif ( typenh.eq.2 ) then
1033           nhtrfa = nhenfa
1034           pfamtr = pfamen
1035           pcfatr = pcfaen
1036         elseif ( typenh.eq.3 ) then
1037           nhtefa = nhenfa
1038           pfamte = pfamen
1039           pcfate = pcfaen
1040         elseif ( typenh.eq.4 ) then
1041           nhqufa = nhenfa
1042           pfamqu = pfamen
1043           pcfaqu = pcfaen
1044         elseif ( typenh.eq.5 ) then
1045           nhpyfa = nhenfa
1046           pfampy = pfamen
1047           pcfapy = pcfaen
1048         elseif ( typenh.eq.6 ) then
1049           nhhefa = nhenfa
1050           pfamhe = pfamen
1051           pcfahe = pcfaen
1052         elseif ( typenh.eq.7 ) then
1053           nhpefa = nhenfa
1054           pfampe = pfamen
1055           pcfape = pcfaen
1056         endif
1057 c
1058         endif
1059 c
1060    30 continue
1061 c
1062 c====
1063 c 4. initialisations
1064 c====
1065 c
1066 #ifdef _DEBUG_HOMARD_
1067       write (ulsort,90002) '4. initialisations ; codret', codret
1068       call gmstat(1)
1069 #endif
1070 c
1071 c 4.1. ==> prise en compte de l'eventuel suivi de frontiere
1072 c
1073 #ifdef _DEBUG_HOMARD_
1074       write (ulsort,90002) 'suifro', suifro
1075 #endif
1076 c
1077       if ( ( mod(suifro,2).eq.0 ) .or.
1078      >     ( mod(suifro,3).eq.0 ) .or.
1079      >     ( mod(suifro,5).eq.0 ) ) then
1080 c
1081         nbgrof = 0
1082         nbfrgr = 0
1083 c
1084         if ( codret.eq.0 ) then
1085 c
1086         if ( ( mod(suifro,2).eq.0 ) .or.
1087      >       ( mod(suifro,3).eq.0 ) ) then
1088           call gmmod ( nocman//'.Frontier',
1089      >                 adfrfa, 0, nbfmed, 1, 1, codre1 )
1090         else
1091           codre1 = 0
1092         endif
1093 c
1094         call gmaloj ( nhsupe//'.Tab10', ' ', nbfmed, adfrgr, codre2 )
1095         call gmecat ( nhsupe, 10, nbfmed, codre3 )
1096         iaux = 10*nbfmed
1097         call gmaloj ( nhsups//'.Tab10', ' ', iaux, adnogr, codre4 )
1098         call gmecat ( nhsups, 10, iaux, codre5 )
1099 c
1100         codre0 = min ( codre1, codre2, codre3, codre4, codre5 )
1101         codret = max ( abs(codre0), codret,
1102      >                 codre1, codre2, codre3, codre4, codre5 )
1103 c
1104         endif
1105 c
1106 cgn        call gmprsx (nompro,ncfami//'.Groupe.Table' )
1107 cgn        call gmprsx (nompro,ncfami//'.Groupe.Pointeur' )
1108 c
1109 c 4.1.1. ==> Groupes pour les frontieres discretes ou CAO
1110 c
1111         if ( ( mod(suifro,2).eq.0 ) .or. ( mod(suifro,5).eq.0 ) ) then
1112 c
1113 #ifdef _DEBUG_HOMARD_
1114       write (ulsort,90002) '4.1.1. F. discretes/CAO ; codret', codret
1115 #endif
1116 c
1117 cgn        call gmprsx (nompro,ncafdg )
1118 cgn        call gmprsx (nompro,ncafdg//'.Pointeur' )
1119 cgn        call gmprsx (nompro,ncafdg//'.Table' )
1120 cgn        call gmprsx (nompro,ncafdg//'.Taille' )
1121 c
1122           if ( codret.eq.0 ) then
1123 c
1124           call gmliat ( ncafdg, 1, nbgrof, codret )
1125 c
1126           endif
1127 c
1128           if ( codret.eq.0 ) then
1129 #ifdef _DEBUG_HOMARD_
1130       write (ulsort,90002) 'nbgrof', nbgrof
1131 #endif
1132 c
1133           if ( nbgrof.gt.0 ) then
1134 c
1135           iaux = 3
1136 #ifdef _DEBUG_HOMARD_
1137         write (ulsort,texte(langue,3)) 'UTADPT', nompro
1138 #endif
1139           call utadpt ( ncafdg, iaux,
1140      >                    jaux, kaux,
1141      >                  pointd, pttgrd, ptngrd,
1142      >                  ulsort, langue, codret )
1143 c
1144           endif
1145 c
1146           endif
1147 c
1148         endif
1149 c
1150 c 4.1.2. ==> Frontieres analytiques
1151 c
1152         if ( mod(suifro,3).eq.0 ) then
1153 c
1154 #ifdef _DEBUG_HOMARD_
1155       write (ulsort,90002) '4.1.2 Front analytiques ; codret', codret
1156 #endif
1157 c
1158 c 4.1.2.1 ==> Combien de frontieres analytiques ?
1159 c
1160           if ( codret.eq.0 ) then
1161 c
1162 cgn        call gmprsx (nompro,ncafan )
1163           call gmliat ( ncafan, 1, nbfran ,codret )
1164 c
1165           endif
1166 c
1167           if ( codret.eq.0 ) then
1168 c
1169           if ( nbfran.eq.0 ) then
1170             write (ulsort,texte(langue,8))
1171             codret = 4121
1172           endif
1173 c
1174           endif
1175 c
1176 c 4.1.2.2 ==> Description des noms des frontieres dans les liens
1177 c
1178           if ( nbfran.gt.0 ) then
1179 c
1180             if ( codret.eq.0 ) then
1181 c
1182 cgn        call gmprsx (nompro,ncfgnf//'.Pointeur' )
1183 cgn        call gmprsx (nompro,ncfgnf//'.Table' )
1184 cgn        call gmprsx (nompro,ncfgnf//'.Taille' )
1185             iaux = 6
1186 #ifdef _DEBUG_HOMARD_
1187         write (ulsort,texte(langue,3)) 'UTADPT', nompro
1188 #endif
1189             call utadpt ( ncfgnf, iaux,
1190      >                    nbfrgr, kaux,
1191      >                    adfpoi, adftai, adftab,
1192      >                    ulsort, langue, codret )
1193 c
1194             endif
1195 c
1196           endif
1197 c
1198 c 4.1.2.3 ==> Description des noms des groupes dans les liens
1199 c
1200           if ( nbfran.gt.0 ) then
1201 c
1202             if ( codret.eq.0 ) then
1203 cgn        call gmprsx (nompro//' - ncfgng',ncfgng )
1204 cgn        call gmprsx (nompro//' - ncfgng',ncfgng//'.Pointeur' )
1205 cgn        call gmprsx (nompro//' - ncfgng',ncfgng//'.Table' )
1206 cgn        call gmprsx (nompro//' - ncfgng',ncfgng//'.Taille' )
1207             iaux = 3
1208 #ifdef _DEBUG_HOMARD_
1209         write (ulsort,texte(langue,3)) 'UTADPT', nompro
1210 #endif
1211             call utadpt ( ncfgng, iaux,
1212      >                    jaux, kaux,
1213      >                    adgpoi, adgtai, adgtab,
1214      >                    ulsort, langue, codret )
1215 c
1216             endif
1217 c
1218           endif
1219 c
1220 c 4.1.2.3 ==> Description des frontieres
1221 c
1222           if ( nbfran.gt.0 ) then
1223 c
1224             if ( codret.eq.0 ) then
1225 cgn        call gmprsx (nompro,ncafan//'.Pointeur' )
1226 cgn        call gmprsx (nompro,ncafan//'.Table' )
1227 cgn        call gmprsx (nompro,ncafan//'.Taille' )
1228 c
1229             iaux = 3
1230 #ifdef _DEBUG_HOMARD_
1231         write (ulsort,texte(langue,3)) 'UTADPT', nompro
1232 #endif
1233             call utadpt ( ncafan, iaux,
1234      >                    jaux, kaux,
1235      >                    adcpoi, adctai, adctab,
1236      >                    ulsort, langue, codret )
1237 c
1238             endif
1239 c
1240           endif
1241 c
1242         endif
1243 c
1244 c 4.1.3. ==> Caracteristiques des familles
1245 #ifdef _DEBUG_HOMARD_
1246       write (ulsort,90002) '4.1.3. Carac familles ; codret', codret
1247 #endif
1248 c
1249         if ( codret.eq.0 ) then
1250 c
1251         iaux = 30
1252 c
1253 #ifdef _DEBUG_HOMARD_
1254         write (ulsort,texte(langue,3)) 'UTAD13', nompro
1255 #endif
1256         call utad13 ( iaux, ncfami,
1257      >                pnumfa, pnomfa,
1258      >                pointe,  jaux, ptngrf,
1259      >                ulsort, langue, codret )
1260 c
1261         endif
1262 c
1263 c 4.1.4. ==> Initialisations ad-hoc
1264 #ifdef _DEBUG_HOMARD_
1265       write (ulsort,90002) '4.1.4. Init ad hoc ; codret', codret
1266 #endif
1267 c
1268         if ( codret.eq.0 ) then
1269 c
1270 #ifdef _DEBUG_HOMARD_
1271       write (ulsort,texte(langue,3)) 'VCSFIN', nompro
1272 #endif
1273         call vcsfin ( suifro,
1274      >                imem(pcexar), imem(pcextr), imem(pcexqu),
1275      >                nbgrof, nbfrgr, nbfran, nbfmed, nbelem,
1276      >                imem(pointd), imem(pttgrd), smem(ptngrd),
1277      >                imem(adcpoi), imem(adctai), smem(adctab),
1278      >                imem(adfpoi), imem(adftai), smem(adftab),
1279      >                imem(adgpoi), imem(adgtai), smem(adgtab),
1280      >                imem(pointe), smem(ptngrf),
1281      >                imem(adfrfa), imem(adfrgr), smem(adnogr),
1282      >                imem(pnuele), imem(adarhn),
1283      >                imem(pfamee), imem(ptypel),
1284      >                imem(pnumfa), smem(pnomfa),
1285      >                imem(paretr), imem(adtrhn),
1286      >                imem(parequ), imem(adquhn),
1287      >                ulsort, langue, codret )
1288 c
1289         endif
1290 c
1291       endif
1292 c
1293 c====
1294 c 5. homologues
1295 c====
1296 c
1297 #ifdef _DEBUG_HOMARD_
1298       write (ulsort,90002) '5. homologues ; codret', codret
1299 #endif
1300 c
1301       nbpnho = 0
1302       nbppho = 0
1303       nbpaho = 0
1304       nbptho = 0
1305 c
1306 c 5.1. ==> allocation des tableaux etendus de description des
1307 c          homologues
1308 c
1309       if ( codret.eq.0 ) then
1310 c
1311       if ( homolo.ge.1 ) then
1312         call gmaloj ( nhnoeu//'.Homologu', ' ', nbnoto, adhono, codret )
1313       endif
1314 c
1315       if ( homolo.ge.1 .and. nbmpto.gt.0 ) then
1316         typenh = 0
1317         iaux = 29
1318         kaux = 0
1319 #ifdef _DEBUG_HOMARD_
1320       write (ulsort,texte(langue,3)) 'UTAL02_mp', nompro
1321 #endif
1322         call utal02 ( typenh, iaux,
1323      >                nhmapo, nbmpto,   kaux,
1324      >                  paux,   paux,   paux,   paux,
1325      >                  paux,   paux,
1326      >                  paux,   paux,   paux,
1327      >                  paux, admpho,   paux,
1328      >                ulsort, langue, codret )
1329       endif
1330 c
1331       if ( homolo.ge.2 ) then
1332         typenh = 1
1333         iaux = 29
1334         kaux = 0
1335 #ifdef _DEBUG_HOMARD_
1336       write (ulsort,texte(langue,3)) 'UTAL02_ar', nompro
1337 #endif
1338         call utal02 ( typenh, iaux,
1339      >                nharet, nbarto,   kaux,
1340      >                  paux,   paux,   paux,   paux,
1341      >                  paux,   paux,
1342      >                  paux,   paux,   paux,
1343      >                  paux, adhoar,   paux,
1344      >                ulsort, langue, codret )
1345       endif
1346 c
1347       if ( homolo.ge.3 .and. nbtrto.gt.0 ) then
1348         typenh = 2
1349         iaux = 29
1350         kaux = 0
1351 #ifdef _DEBUG_HOMARD_
1352       write (ulsort,texte(langue,3)) 'UTAL02_tr', nompro
1353 #endif
1354         call utal02 ( typenh, iaux,
1355      >                nhtria, nbtrto,   kaux,
1356      >                  paux,   paux,   paux,   paux,
1357      >                  paux,   paux,
1358      >                  paux,   paux,   paux,
1359      >                  paux, adhotr,   paux,
1360      >                ulsort, langue, codret )
1361       endif
1362 c
1363       if ( homolo.ge.3 .and. nbquto.gt.0 ) then
1364         typenh = 4
1365         iaux = 29
1366         kaux = 0
1367 #ifdef _DEBUG_HOMARD_
1368       write (ulsort,texte(langue,3)) 'UTAL02_qu', nompro
1369 #endif
1370         call utal02 ( typenh, iaux,
1371      >                nhquad, nbquto,   kaux,
1372      >                  paux,   paux,   paux,   paux,
1373      >                  paux,   paux,
1374      >                  paux,   paux,   paux,
1375      >                  paux, adhoqu,   paux,
1376      >                ulsort, langue, codret )
1377       endif
1378 c
1379       endif
1380 c
1381 c 5.2. ==> construction des tableaux etendus d'equivalence - phase 1
1382 c          on ne fait ici que la traduction directe des donnees dans le
1383 c          but de pouvoir etablir les familles
1384 c
1385       if ( codret.eq.0 ) then
1386 c
1387       if ( homolo.ge.1 ) then
1388 c
1389 #ifdef _DEBUG_HOMARD_
1390       write (ulsort,texte(langue,3)) 'VCEQU1', nompro
1391 #endif
1392         call vcequ1 ( imem(pnunoe), imem(pnuele),
1393      >                imem(adhono), imem(adnohn), imem(adeqno),
1394      >                imem(adhoar), imem(adarhn), imem(adeqar),
1395      >                imem(adhotr), imem(adtrhn), imem(adeqtr),
1396      >                imem(adhoqu), imem(adquhn), imem(adeqqu),
1397      >                ulsort, langue, codret )
1398 c
1399         endif
1400 c
1401       endif
1402 c
1403 c 5.3. ==> prise en compte des equivalences dans les caracteristiques
1404 c          des entites
1405 c
1406       if ( codret.eq.0 ) then
1407 c
1408       if ( homolo.ge.1 ) then
1409 c
1410 #ifdef _DEBUG_HOMARD_
1411       write (ulsort,texte(langue,3)) 'VCEQUI', nompro
1412 #endif
1413         call vcequi ( imem(pnunoe), imem(pnuele),
1414      >                imem(pcexno), imem(adnohn), imem(adeqno),
1415      >                imem(pcexar), imem(adarhn), imem(adeqar),
1416      >                imem(pcextr), imem(adtrhn), imem(adeqtr),
1417      >                imem(pcexqu), imem(adquhn), imem(adeqqu),
1418      >                imem(adeqpo),
1419      >                ulsort, langue, codret )
1420 c
1421         endif
1422 c
1423       endif
1424 c
1425 c====
1426 c 6. construction des familles de noeuds
1427 c====
1428 c
1429 #ifdef _DEBUG_HOMARD_
1430       write (ulsort,90002) '6. familles de noeuds ; codret', codret
1431 #endif
1432 c
1433       if ( codret.eq.0 ) then
1434 c
1435 #ifdef _DEBUG_HOMARD_
1436       write (ulsort,90002) 'nbnoto, nctfno, nbfnom',
1437      >                      nbnoto, nctfno, nbfnom
1438       write (ulsort,texte(langue,3)) 'VCCFAM_no', nompro
1439 #endif
1440 c
1441       iaux = -1
1442       call vccfam
1443      >        ( iaux,
1444      >          nbnoto, nctfno, nbfnom,
1445      >          imem(pcexno), imem(pcfano), imem(iaux), imem(iaux),
1446      >          imem(pfamno), nbfnoe,
1447      >          jaux, jaux, imem(jaux),
1448      >          ulsort, langue, codret )
1449 c
1450       endif
1451 c
1452 c====
1453 c 7. construction des familles de mailles-points
1454 c====
1455 c
1456 #ifdef _DEBUG_HOMARD_
1457       write (ulsort,90002) '7. familles de m-pt ; codret', codret
1458 #endif
1459 c
1460       if ( codret.eq.0 ) then
1461 c
1462       if ( nbmpto.ne.0 ) then
1463 c
1464 #ifdef _DEBUG_HOMARD_
1465       write (ulsort,90002) 'nbmpto, nctfmp, nbfmpm',
1466      >                      nbmpto, nctfmp, nbfmpm
1467       write (ulsort,texte(langue,3)) 'VCCFAM_mp', nompro
1468 #endif
1469 c
1470         iaux = 0
1471         call vccfam
1472      >        ( iaux,
1473      >          nbmpto, nctfmp, nbfmpm,
1474      >          imem(pcexmp), imem(pcfamp), imem(pnoemp), imem(pfamno),
1475      >          imem(pfammp), nbfmpo,
1476      >          jaux, jaux, imem(jaux),
1477      >          ulsort, langue, codret )
1478 c
1479       endif
1480 c
1481       endif
1482 c
1483 c====
1484 c 8. construction des familles d'aretes
1485 c====
1486 c
1487 #ifdef _DEBUG_HOMARD_
1488       write (ulsort,90002) '8. familles d aretes ; codret', codret
1489 #endif
1490 c
1491       if ( codret.eq.0 ) then
1492 c
1493 #ifdef _DEBUG_HOMARD_
1494       write (ulsort,90002) 'nbarto, nctfar, nbfarm',
1495      >                      nbarto, nctfar, nbfarm
1496       write (ulsort,texte(langue,3)) 'VCCFAM_ar', nompro
1497 #endif
1498 c
1499       iaux = 1
1500       call vccfam
1501      >        ( iaux,
1502      >          nbarto, nctfar, nbfarm,
1503      >          imem(pcexar), imem(pcfaar), imem(iaux), imem(iaux),
1504      >          imem(pfamar), nbfare,
1505      >          jaux, jaux, imem(jaux),
1506      >          ulsort, langue, codret )
1507 c
1508       endif
1509 c
1510 c====
1511 c 9. construction des familles de triangles
1512 c====
1513 c
1514 #ifdef _DEBUG_HOMARD_
1515       write (ulsort,90002) '9. familles de triangles ; codret', codret
1516 #endif
1517 c
1518       if ( codret.eq.0 ) then
1519 c
1520       if ( nbtrto.ne.0 .or.
1521      >   ( nbquto.ne.0 .and. ( tyconf.eq.-1 .or. tyconf.eq.0 ) ) ) then
1522 c
1523 #ifdef _DEBUG_HOMARD_
1524       write (ulsort,90002) 'nbtrto, nctftr, nbftrm',
1525      >                      nbtrto, nctftr, nbftrm
1526       write (ulsort,texte(langue,3)) 'VCCFAM_tr', nompro
1527 #endif
1528 c
1529         iaux = 2
1530         call vccfam
1531      >        ( iaux,
1532      >          nbtrto, nctftr, nbftrm,
1533      >          imem(pcextr), imem(pcfatr), imem(iaux), imem(iaux),
1534      >          imem(pfamtr), nbftri,
1535      >          nctfar, nbfarm, imem(pcfaar),
1536      >          ulsort, langue, codret )
1537 c
1538       endif
1539 c
1540       endif
1541 c
1542 c====
1543 c 10. construction des familles de quadrangles
1544 c====
1545 c
1546 #ifdef _DEBUG_HOMARD_
1547       write (ulsort,90002) '10. familles de quad. ; codret', codret
1548 #endif
1549 c
1550       if ( codret.eq.0 ) then
1551 c
1552       if ( nbquto.ne.0 ) then
1553 c
1554 #ifdef _DEBUG_HOMARD_
1555       write (ulsort,90002) 'nbquto, nctfqu, nbfqum',
1556      >                      nbquto, nctfqu, nbfqum
1557       write (ulsort,texte(langue,3)) 'VCCFAM_qu', nompro
1558 #endif
1559 c
1560         iaux = 4
1561         call vccfam
1562      >        ( iaux,
1563      >          nbquto, nctfqu, nbfqum,
1564      >          imem(pcexqu), imem(pcfaqu), imem(iaux), imem(iaux),
1565      >          imem(pfamqu), nbfqua,
1566      >          nctfar, nbfarm, imem(pcfaar),
1567      >          ulsort, langue, codret )
1568 c
1569       endif
1570 c
1571       endif
1572 c
1573 c====
1574 c 11. construction des familles de triangles pour la mise en conformite
1575 c     des quadrangles
1576 c     Remarque : seulement s'il y a du raffinement conforme
1577 c====
1578 c
1579 #ifdef _DEBUG_HOMARD_
1580       write (ulsort,90002) '11. triangles conformite ; codret', codret
1581       write (ulsort,90002) 'nbquto, modhom, pilraf',
1582      >                      nbquto, modhom, pilraf
1583 #endif
1584 c
1585       if ( codret.eq.0 ) then
1586 c
1587       if ( nbquto.ne.0 .and. ( tyconf.eq.-1 .or. tyconf.eq.0 ) ) then
1588 c
1589 #ifdef _DEBUG_HOMARD_
1590       write (ulsort,90002) 'nbfqua, nbftri', nbfqua, nbftri
1591 #endif
1592 c
1593         if ( codret.eq.0 ) then
1594         call gmalot ( ntrav1, 'entier  ', nctftr, ptrav1, codret )
1595         endif
1596 c
1597         if ( codret.eq.0 ) then
1598 c
1599         iaux = 4
1600         jaux = 2
1601 #ifdef _DEBUG_HOMARD_
1602       write (ulsort,texte(langue,3)) 'VCCFCF_qu_tr', nompro
1603 #endif
1604         call vccfcf ( iaux, nctfqu, nbfqum, nbfqua,
1605      >                jaux, nctftr, nbftrm, nbftri, ncfftr,
1606      >                coftfq,
1607      >                imem(pcfaqu), imem(pcfatr),
1608      >                edqua4, edtri3,
1609      >                edqua8, edtri6,
1610      >                edqua9, edtri7,
1611      >                imem(ptrav1),
1612      >                ulsort, langue, codret )
1613 c
1614 #ifdef _DEBUG_HOMARD_
1615       write (ulsort,90002) 'nbfqua, nbftri', nbfqua, nbftri
1616 #endif
1617 c
1618         endif
1619 c
1620         if ( codret.eq.0 ) then
1621         call gmlboj ( ntrav1, codret )
1622         endif
1623 c
1624       endif
1625 c
1626       endif
1627 c
1628 c====
1629 c 12. construction des familles de tetraedres
1630 c====
1631 c
1632 #ifdef _DEBUG_HOMARD_
1633       write (ulsort,90002) '12. familles de tetraedres ; codret', codret
1634 #endif
1635 c
1636       if ( codret.eq.0 ) then
1637 c
1638       if ( nbteto.ne.0 .or.
1639      >   ( nbheto.ne.0 .and. ( tyconf.eq.-1 .or. tyconf.eq.0 ) ) ) then
1640 c
1641 #ifdef _DEBUG_HOMARD_
1642       write (ulsort,texte(langue,3)) 'VCCFAM_te', nompro
1643 #endif
1644         iaux = 3
1645         call vccfam
1646      >        ( iaux,
1647      >          nbteto, nctfte, nbftem,
1648      >          imem(pcexte), imem(pcfate), imem(iaux), imem(iaux),
1649      >          imem(pfamte), nbftet,
1650      >          jaux, jaux, imem(jaux),
1651      >          ulsort, langue, codret )
1652 c
1653       endif
1654 c
1655       endif
1656 c
1657 c====
1658 c 13. construction des familles d'hexaedres
1659 c====
1660 c
1661 #ifdef _DEBUG_HOMARD_
1662       write (ulsort,90002) '13. familles d''hexaedres ; codret', codret
1663 #endif
1664 c
1665       if ( codret.eq.0 ) then
1666 c
1667       if ( nbheto.ne.0 ) then
1668 c
1669 #ifdef _DEBUG_HOMARD_
1670       write (ulsort,texte(langue,3)) 'VCCFAM_he', nompro
1671 #endif
1672         iaux = 6
1673         call vccfam
1674      >        ( iaux,
1675      >          nbheto, nctfhe, nbfhem,
1676      >          imem(pcexhe), imem(pcfahe), imem(iaux), imem(iaux),
1677      >          imem(pfamhe), nbfhex,
1678      >          jaux, jaux, imem(jaux),
1679      >          ulsort, langue, codret )
1680 c
1681       endif
1682 c
1683       endif
1684 c
1685 c====
1686 c 14. construction des familles de pyramides
1687 c====
1688 c
1689 #ifdef _DEBUG_HOMARD_
1690       write (ulsort,90002) '14. familles de pyramidess ; codret', codret
1691 #endif
1692 c
1693       if ( codret.eq.0 ) then
1694 c
1695       if ( nbpyto.ne.0 .or.
1696      >   ( nbheto.ne.0 .and. ( tyconf.eq.-1 .or. tyconf.eq.0 ) ) ) then
1697 c
1698 #ifdef _DEBUG_HOMARD_
1699       write (ulsort,texte(langue,3)) 'VCCFAM_py', nompro
1700 #endif
1701         iaux = 5
1702         call vccfam
1703      >        ( iaux,
1704      >          nbpyto, nctfpy, nbfpym,
1705      >          imem(pcexpy), imem(pcfapy), imem(iaux), imem(iaux),
1706      >          imem(pfampy), nbfpyr,
1707      >          jaux, jaux, imem(jaux),
1708      >          ulsort, langue, codret )
1709 c
1710       endif
1711 c
1712       endif
1713 c
1714 c====
1715 c 15. construction des familles de tetraedres et pyramides pour la mise
1716 c     en conformite des hexaedres
1717 c     Remarque : seulement s'il y a du raffinement conforme
1718 c====
1719 c
1720 #ifdef _DEBUG_HOMARD_
1721       write (ulsort,90002) '15. tetr/pyra conformite ; codret', codret
1722       write (ulsort,90002) 'nbheto, modhom, pilraf',
1723      >                      nbheto, modhom, pilraf
1724 #endif
1725 c
1726       if ( codret.eq.0 ) then
1727 c
1728       if ( nbheto.ne.0 .and. ( tyconf.eq.-1 .or. tyconf.eq.0 ) ) then
1729 c
1730 #ifdef _DEBUG_HOMARD_
1731       write (ulsort,90002) 'nbfhex, nbftet, nbfpyr',
1732      >                      nbfhex, nbftet, nbfpyr
1733 #endif
1734 c
1735         if ( codret.eq.0 ) then
1736         call gmalot ( ntrav1, 'entier  ', nctftr, ptrav1, codret )
1737         endif
1738 c
1739         if ( codret.eq.0 ) then
1740 c
1741         iaux = 6
1742         jaux = 3
1743         kaux = 0
1744 #ifdef _DEBUG_HOMARD_
1745       write (ulsort,texte(langue,3)) 'VCCFCF_he_te', nompro
1746 #endif
1747         call vccfcf ( iaux, nctfhe, nbfhem, nbfhex,
1748      >                jaux, nctfte, nbftem, nbftet, ncffte,
1749      >                coftfh,
1750      >                imem(pcfahe), imem(pcfate),
1751      >                edhex8, edtet4,
1752      >                edhe20, edte10,
1753      >                edhe20, edte10,
1754      >                imem(ptrav1),
1755      >                ulsort, langue, codret )
1756 c
1757 #ifdef _DEBUG_HOMARD_
1758       write (ulsort,90002) 'nbfhex, nbftet', nbfhex, nbftet
1759 #endif
1760 c
1761         endif
1762 c
1763         if ( codret.eq.0 ) then
1764 c
1765         iaux = 6
1766         jaux = 5
1767         kaux = 0
1768 #ifdef _DEBUG_HOMARD_
1769       write (ulsort,texte(langue,3)) 'VCCFCF_he_py', nompro
1770 #endif
1771         call vccfcf ( iaux, nctfhe, nbfhem, nbfhex,
1772      >                jaux, nctfpy, nbfpym, nbfpyr, ncffpy,
1773      >                cofpfh,
1774      >                imem(pcfahe), imem(pcfapy),
1775      >                edhex8, edpyr5,
1776      >                edhe20, edpy13,
1777      >                edhe20, edpy13,
1778      >                imem(ptrav1),
1779      >                ulsort, langue, codret )
1780 c
1781 #ifdef _DEBUG_HOMARD_
1782       write (ulsort,90002) 'nbfhex, nbfpyr', nbfhex, nbfpyr
1783 #endif
1784 c
1785         endif
1786 c
1787         if ( codret.eq.0 ) then
1788         call gmlboj ( ntrav1, codret )
1789         endif
1790 c
1791       endif
1792 c
1793       endif
1794 c
1795 c====
1796 c 16. construction des familles de pentaedres
1797 c====
1798 c
1799 #ifdef _DEBUG_HOMARD_
1800       write (ulsort,90002) '16. familles de pentaedres ; codret', codret
1801 #endif
1802 c
1803       if ( codret.eq.0 ) then
1804 c
1805       if ( nbpeto.ne.0 ) then
1806 c
1807 #ifdef _DEBUG_HOMARD_
1808       write (ulsort,texte(langue,3)) 'VCCFAM_pe', nompro
1809 #endif
1810         iaux = 7
1811         call vccfam
1812      >        ( iaux,
1813      >          nbpeto, nctfpe, nbfpem,
1814      >          imem(pcexpe), imem(pcfape), imem(iaux), imem(iaux),
1815      >          imem(pfampe), nbfpen,
1816      >          jaux, jaux, imem(jaux),
1817      >          ulsort, langue, codret )
1818 c
1819       endif
1820 c
1821       endif
1822 c
1823 c====
1824 c 17. construction des familles de tetraedres et pyramides pour la mise
1825 c     en conformite des pentaedres
1826 c     Remarque : seulement s'il y a du raffinement conforme
1827 c====
1828 c
1829 #ifdef _DEBUG_HOMARD_
1830       write (ulsort,90002) '17. tetr/pyra conformite ; codret', codret
1831       write (ulsort,90002) 'nbpeto, modhom, pilraf',
1832      >                      nbpeto, modhom, pilraf
1833 #endif
1834 c
1835       if ( codret.eq.0 ) then
1836 c
1837       if ( nbpeto.ne.0 .and. ( tyconf.eq.-1 .or. tyconf.eq.0 ) ) then
1838 c
1839 #ifdef _DEBUG_HOMARD_
1840       write (ulsort,90002) 'nbfpen, nbftet, nbfpyr',
1841      >                      nbfpen, nbftet, nbfpyr
1842 #endif
1843 c
1844         if ( codret.eq.0 ) then
1845         call gmalot ( ntrav1, 'entier  ', nctftr, ptrav1, codret )
1846         endif
1847 c
1848         if ( codret.eq.0 ) then
1849 c
1850         iaux = 7
1851         jaux = 3
1852         kaux = 0
1853 #ifdef _DEBUG_HOMARD_
1854       write (ulsort,texte(langue,3)) 'VCCFCF_pe_te', nompro
1855 #endif
1856         call vccfcf ( iaux, nctfpe, nbfpem, nbfpen,
1857      >                jaux, nctfte, nbftem, nbftet, ncffte,
1858      >                coftfp,
1859      >                imem(pcfape), imem(pcfate),
1860      >                edpen6, edtet4,
1861      >                edpe15, edte10,
1862      >                edpe15, edte10,
1863      >                imem(ptrav1),
1864      >                ulsort, langue, codret )
1865 c
1866 #ifdef _DEBUG_HOMARD_
1867       write (ulsort,90002) 'nbfpen, nbftet', nbfpen, nbftet
1868 #endif
1869 c
1870         endif
1871 c
1872         if ( codret.eq.0 ) then
1873 c
1874         iaux = 7
1875         jaux = 5
1876         kaux = 0
1877 #ifdef _DEBUG_HOMARD_
1878       write (ulsort,texte(langue,3)) 'VCCFCF_pe_py', nompro
1879 #endif
1880         call vccfcf ( iaux, nctfpe, nbfpem, nbfpen,
1881      >                jaux, nctfpy, nbfpym, nbfpyr, ncffpy,
1882      >                cofpfp,
1883      >                imem(pcfape), imem(pcfapy),
1884      >                edpen6, edpyr5,
1885      >                edpe15, edpy13,
1886      >                edpe15, edpy13,
1887      >                imem(ptrav1),
1888      >                ulsort, langue, codret )
1889 c
1890 #ifdef _DEBUG_HOMARD_
1891       write (ulsort,90002) 'nbfpen, nbfpyr', nbfpen, nbfpyr
1892 #endif
1893 c
1894         endif
1895 c
1896         if ( codret.eq.0 ) then
1897         call gmlboj ( ntrav1, codret )
1898         endif
1899 c
1900       endif
1901 c
1902       endif
1903 c
1904 c====
1905 c 18. complement des familles pour non conforme ou Carmel
1906 c====
1907 #ifdef _DEBUG_HOMARD_
1908       write (ulsort,90002) '18. complement familles ; codret', codret
1909 #endif
1910 c
1911 c 18.1. ==> Adaptation non conforme
1912 c
1913       if ( tyconf.eq.-2 .or.
1914      >     tyconf.eq.1 .or.
1915      >     tyconf.eq.2 .or.
1916      >     tyconf.eq.3 ) then
1917 c
1918 #ifdef _DEBUG_HOMARD_
1919       write (ulsort,90002) '18.1. non-conforme ; codret', codret
1920 cgn      call gmprsx (nompro,ncfami)
1921 cgn      call gmprsx (nompro,ncfami//'.Numero')
1922 cgn      call gmprsx (nompro,ncfami//'.Nom')
1923 #endif
1924 c
1925 c 18.1.1. ==> modifications des structures
1926 c
1927         if ( codret.eq.0 ) then
1928 c
1929         nbfme0 = nbfmed
1930         nbfmed = nbfmed + 3
1931         ngrou0 = ngrouc
1932         ngrouc = ngrouc + 3
1933         un = 1
1934 c
1935         call gmecat ( ncfami, 1, nbfmed, codre1 )
1936         call gmecat ( ncfami, 2, ngrouc, codre2 )
1937         call gmecat ( ncfami//'.Groupe', 1, nbfmed, codre3 )
1938         iaux = 10*ngrouc
1939         call gmecat ( ncfami//'.Groupe', 2, iaux, codre4 )
1940 c
1941         codre0 = min ( codre1, codre2, codre3, codre4 )
1942         codret = max ( abs(codre0), codret,
1943      >                 codre1, codre2, codre3, codre4 )
1944 c
1945         call gmmod ( ncfami//'.Numero',
1946      >               pnumfa, nbfme0, nbfmed, un, un, codre1 )
1947         iaux1 = 10*nbfme0
1948         iaux2 = 10*nbfmed
1949         call gmmod ( ncfami//'.Nom',
1950      >               pnomfa, iaux1, iaux2, un, un, codre2 )
1951         call gmmod ( ncfami//'.Groupe.Pointeur',
1952      >               pgrpo, nbfme0+1, nbfmed+1, un, un, codre3 )
1953         iaux1 = 10*ngrou0
1954         iaux2 = 10*ngrouc
1955         call gmmod ( ncfami//'.Groupe.Taille',
1956      >               pgrtai, iaux1, iaux2, un, un, codre4 )
1957         call gmmod ( ncfami//'.Groupe.Table',
1958      >               pgrtab, iaux1, iaux2, un, un, codre5 )
1959 c
1960         codre0 = min ( codre1, codre2, codre3, codre4, codre5 )
1961         codret = max ( abs(codre0), codret,
1962      >                 codre1, codre2, codre3, codre4, codre5 )
1963 c
1964         endif
1965 c
1966         if ( codret.eq.0 ) then
1967 c
1968         call gmadoj ( ncnomb, adnomb, iaux, codret )
1969 c
1970         endif
1971 c
1972 c 18.1.2. ==> Modifications
1973 c
1974         if ( codret.eq.0 ) then
1975 c
1976 #ifdef _DEBUG_HOMARD_
1977       write (ulsort,texte(langue,3)) 'VCCFNC', nompro
1978 #endif
1979         call vccfnc ( nbfare, imem(pcfaar),
1980      >                nbfqua, imem(pcfaqu),
1981      >                nbftri, imem(pcfatr),
1982      >                imem(adnomb+47), imem(adnomb+48),
1983      >                nbfme0, imem(pnumfa), smem(pnomfa),
1984      >                imem(pgrpo),
1985      >                imem(pgrtai), smem(pgrtab),
1986      >                ulsort, langue, codret )
1987 c
1988         endif
1989 c
1990       endif
1991 c
1992 c 18.2. ==> Carmel
1993 c
1994       if ( typcca.eq.66 .or. typcca.eq.76 ) then
1995 c
1996 #ifdef _DEBUG_HOMARD_
1997       write (ulsort,90002) '18.2. Carmel ; codret', codret
1998 cgn      call gmprsx (nompro,ncfami)
1999 cgn      call gmprsx (nompro,ncfami//'.Numero')
2000 cgn      call gmprsx (nompro,ncfami//'.Nom')
2001 #endif
2002 c
2003         if ( codret.eq.0 ) then
2004 c
2005 #ifdef _DEBUG_HOMARD_
2006       write (ulsort,texte(langue,3)) 'VCCFCA', nompro
2007 #endif
2008         call vccfca ( nbfare, imem(pcfaar),
2009      >                nbfqua, imem(pcfaqu),
2010      >                nbftri, imem(pcfatr),
2011      >                imem(adnomb+47), imem(adnomb+48),
2012      >                nbfme0, imem(pnumfa), smem(pnomfa),
2013      >                imem(pgrpo),
2014      >                imem(pgrtai), smem(pgrtab),
2015      >                ulsort, langue, codret )
2016 c
2017         endif
2018 c
2019       endif
2020 c
2021 c====
2022 c 19. construction des tableaux etendus d'equivalence - phase 2
2023 c     les familles etant construites, on enrichit les structures pour
2024 c     pouvoir passer l'algorithme de maillage
2025 c====
2026 c
2027 #ifdef _DEBUG_HOMARD_
2028       write (ulsort,90002) '19. equivalence ; codret', codret
2029 #endif
2030 c
2031       if ( codret.eq.0 ) then
2032 c
2033       if ( homolo.ge.1 ) then
2034 c
2035 #ifdef _DEBUG_HOMARD_
2036       write (ulsort,texte(langue,3)) 'VCEQU2', nompro
2037 #endif
2038         call vcequ2 ( imem(adhono), imem(adhoar),
2039      >                imem(adhotr), imem(adhoqu),
2040      >                imem(psomar), imem(pnp2ar),
2041      >                imem(paretr), imem(parequ),
2042      >                imem(pposif), imem(pfacar),
2043      >                imem(ppovos), imem(pvoiso),
2044      >                ulsort, langue, codret )
2045 c
2046 #ifdef _DEBUG_HOMARD_
2047         call gmprsx (nompro, nhnoeu//'.Homologu' )
2048         call gmprsx (nompro, nharet//'.Homologu' )
2049 cgn        call gmprsx (nompro, nhtria//'.Homologu' )
2050 #endif
2051 c
2052         endif
2053 c
2054       endif
2055 c
2056 c====
2057 c 20. menage
2058 c====
2059 c
2060 #ifdef _DEBUG_HOMARD_
2061       write (ulsort,90002) '20. menage ; codret', codret
2062 #endif
2063 c
2064 c 20.1. ==> mise a la bonne taille des tableaux lies aux familles HOMARD
2065 c           Attention : meme dans le cas ou un type d'entite est absent,
2066 c                       (maille-point, tetraedre, etc.), il faut passer
2067 c                       par chacune des mises a jour. En effet par la
2068 c                       suite, certains traitements font des appels
2069 c                       systematiques aux attributs et aux adresses des
2070 c                       tableaux. Il est est donc indispensable d'avoir
2071 c                       correctement rempli les structures.
2072 c
2073       do 201 , typenh = -1 , 7
2074 c
2075 c 20.1.1. ==> Caracteristiques des entites concernees
2076 c
2077         if ( codret.eq.0 ) then
2078 c
2079         if ( typenh.eq.-1 ) then
2080           nhenfa = nhnofa
2081           nctfen = nctfno
2082           nbfenm = nbfnom
2083           nbfaen = nbfnoe
2084         elseif ( typenh.eq.0 ) then
2085           nhenfa = nhmpfa
2086           nctfen = nctfmp
2087           nbfenm = nbfmpm
2088           nbfaen = nbfmpo
2089         elseif ( typenh.eq.1 ) then
2090           nhenfa = nharfa
2091           nctfen = nctfar
2092           nbfenm = nbfarm
2093           nbfaen = nbfare
2094         elseif ( typenh.eq.2 ) then
2095           nhenfa = nhtrfa
2096           nctfen = nctftr
2097           nbfenm = nbftrm
2098           nbfaen = nbftri
2099         elseif ( typenh.eq.3 ) then
2100           nhenfa = nhtefa
2101           nctfen = nctfte
2102           nbfenm = nbftem
2103           nbfaen = nbftet
2104         elseif ( typenh.eq.4 ) then
2105           nhenfa = nhqufa
2106           nctfen = nctfqu
2107           nbfenm = nbfqum
2108           nbfaen = nbfqua
2109         elseif ( typenh.eq.5 ) then
2110           nhenfa = nhpyfa
2111           nctfen = nctfpy
2112           nbfenm = nbfpym
2113           nbfaen = nbfpyr
2114         elseif ( typenh.eq.6 ) then
2115           nhenfa = nhhefa
2116           nctfen = nctfhe
2117           nbfenm = nbfhem
2118           nbfaen = nbfhex
2119         elseif ( typenh.eq.7 ) then
2120           nhenfa = nhpefa
2121           nctfen = nctfpe
2122           nbfenm = nbfpem
2123           nbfaen = nbfpen
2124         endif
2125 c
2126         endif
2127 c
2128 c 20.1.2. ==> appel du programme generique
2129 c
2130         if ( codret.eq.0 ) then
2131 c
2132 #ifdef _DEBUG_HOMARD_
2133           write (ulsort,*) ' '
2134           write (ulsort,*) mess14(langue,4,typenh)
2135           write (ulsort,90002) 'nctfen', nctfen
2136           write (ulsort,90002) 'nbfenm', nbfenm
2137           write (ulsort,90002) 'nbfaen', nbfaen
2138 #endif
2139 c
2140 #ifdef _DEBUG_HOMARD_
2141         write (ulsort,texte(langue,3))
2142      >        'UTFAM1 - '//mess14(langue,3,typenh), nompro
2143 #endif
2144         iaux = typenh
2145         call utfam1 ( iaux, nhenfa, pcfaen,
2146      >                nctfen, nbfenm, nbfaen,
2147      >                ulsort, langue, codret )
2148 c
2149         endif
2150 c
2151 c 20.1.3. ==> Recuperation de l'adresse des codes
2152 c
2153         if ( codret.eq.0 ) then
2154 c
2155         if ( typenh.eq.-1 ) then
2156           pcfano = pcfaen
2157         elseif ( typenh.eq.0 ) then
2158           pcfamp = pcfaen
2159         elseif ( typenh.eq.1 ) then
2160           pcfaar = pcfaen
2161         elseif ( typenh.eq.2 ) then
2162           pcfatr = pcfaen
2163         elseif ( typenh.eq.3 ) then
2164           pcfate = pcfaen
2165         elseif ( typenh.eq.4 ) then
2166           pcfaqu = pcfaen
2167         elseif ( typenh.eq.5 ) then
2168           pcfapy = pcfaen
2169         elseif ( typenh.eq.6 ) then
2170           pcfahe = pcfaen
2171         elseif ( typenh.eq.7 ) then
2172           pcfape = pcfaen
2173         endif
2174 c
2175         endif
2176 c
2177   201 continue
2178 c
2179 c 20.2. ==> Liberation de structures inutiles
2180 c
2181       if ( codret.eq.0 ) then
2182 c
2183       call gmsgoj ( nhvois//'.0D/1D' , codret )
2184 c
2185       endif
2186 c
2187 c====
2188 c 21. sauvegarde des informations sur les familles, au sens
2189 c     du module de calcul associe
2190 c     attention : il faut faire des copies et non pas des attachements
2191 c                 car la structure generale de l'objet "maillage de
2192 c                 calcul" est detruite apres la phase de conversion.
2193 c====
2194 #ifdef _DEBUG_HOMARD_
2195       write (ulsort,*) '21. sauvegarde ; codret', codret
2196 #endif
2197 c
2198 cgn      print *,nompro,' : nbfmed,ngrouc',nbfmed,ngrouc
2199 c
2200       if ( codret.eq.0 ) then
2201 c
2202       if ( codret.eq.0 ) then
2203 c
2204       if ( ngrouc.gt.0 ) then
2205 c
2206         call gmecat ( nhsupe, 5, nbfmed, codre1 )
2207         iaux = 10*ngrouc
2208         call gmecat ( nhsupe, 6, iaux, codre2 )
2209         iaux = 10*ngrouc
2210         call gmecat ( nhsups, 2, iaux, codre3 )
2211 c
2212         codre0 = min ( codre1, codre2, codre3 )
2213         codret = max ( abs(codre0), codret,
2214      >                 codre1, codre2, codre3 )
2215 c
2216       endif
2217 c
2218       call gmecat ( nhsupe, 9, nbfmed, codre1 )
2219       call gmecat ( nhsups, 4, 10*nbfmed, codre2 )
2220       codre0 = min ( codre1, codre2 )
2221       codret = max ( abs(codre0), codret,
2222      >               codre1, codre2 )
2223 c
2224       endif
2225 c
2226       if ( codret.eq.0 ) then
2227 c
2228       if ( nbfmed.ne.0 ) then
2229 c
2230         if ( ngrouc.gt.0 ) then
2231 c
2232           call gmcpoj ( ncfami//'.Groupe.Pointeur',
2233      >                  nhsupe//'.Tab5', codre1 )
2234           call gmcpoj ( ncfami//'.Groupe.Taille',
2235      >                  nhsupe//'.Tab6', codre2 )
2236           call gmcpoj ( ncfami//'.Groupe.Table',
2237      >                  nhsups//'.Tab2', codre3 )
2238 c
2239           codre0 = min ( codre1, codre2, codre3 )
2240           codret = max ( abs(codre0), codret,
2241      >                   codre1, codre2, codre3 )
2242 c
2243         endif
2244 c
2245         call gmcpoj ( ncfami//'.Numero',
2246      >                nhsupe//'.Tab9', codre1 )
2247         call gmcpoj ( ncfami//'.Nom',
2248      >                nhsups//'.Tab4', codre2 )
2249 c
2250         codre0 = min ( codre1, codre2 )
2251         codret = max ( abs(codre0), codret,
2252      >                 codre1, codre2 )
2253 c
2254       endif
2255 c
2256       endif
2257 c
2258 #ifdef _DEBUG_HOMARD_
2259       call gmprsx (nompro, nhsupe )
2260       call gmprsx (nompro, nhsupe//'.Tab3' )
2261       call gmprsx (nompro, nhsupe//'.Tab4' )
2262       call gmprsx (nompro, nhsupe//'.Tab5' )
2263       call gmprsx (nompro, nhsupe//'.Tab6' )
2264       call gmprsx (nompro, nhsupe//'.Tab9' )
2265       call gmprsx (nompro, nhsups )
2266       call gmprsx (nompro, nhsups//'.Tab2' )
2267       call gmprsx (nompro, nhsups//'.Tab3' )
2268       call gmprsx (nompro, nhsups//'.Tab4' )
2269       call gmprsx (nompro, nhsups//'.Tab9' )
2270 #endif
2271 c
2272       endif
2273 c
2274 c====
2275 c 22. sauvegarde des informations sur les equivalences, au sens
2276 c     du module de calcul associe
2277 c     attention : il faut faire des copies et non pas des attachements
2278 c                 car la structure generale de l'objet "maillage de
2279 c                 calcul" est detruite apres la phase de conversion.
2280 c====
2281 c
2282 #ifdef _DEBUG_HOMARD_
2283       write (ulsort,*) '22. sauvegarde equivalences ; codret', codret
2284 #endif
2285 c
2286       if ( codret.eq.0 ) then
2287 c
2288       if ( homolo.ne.0 ) then
2289 c
2290         call gmecat ( nhsups, 5, 33*nbequi, codre1 )
2291         call gmcpoj ( ncequi//'.InfoGene',
2292      >                nhsups//'.Tab5', codre2 )
2293 c
2294         codre0 = min ( codre1, codre2 )
2295         codret = max ( abs(codre0), codret,
2296      >                 codre1, codre2 )
2297 c
2298 #ifdef _DEBUG_HOMARD_
2299         call gmprsx (nompro, nhsups )
2300         call gmprsx (nompro, nhsups//'.Tab5' )
2301 #endif
2302 c
2303       endif
2304 c
2305       endif
2306 c
2307 #ifdef _DEBUG_HOMARD_
2308 c
2309 c====
2310 c 23. impressions
2311 c====
2312 cgn      call gmprsx (nompro, nhnofa//'.EntiFamm')
2313 cgn      call gmprsx (nompro, nhmpfa//'.EntiFamm')
2314 cgn      call gmprsx (nompro, nharfa//'.EntiFamm')
2315 cgn      call gmprsx (nompro, nhtrfa//'.EntiFamm')
2316 cgn      call gmprsx (nompro, nhqufa//'.EntiFamm')
2317 cgn      call gmprsx (nompro, nhtefa//'.EntiFamm')
2318 cgn      call gmprsx (nompro, nhtrfa//'.Codes')
2319 cgn      call gmprsx (nompro, nhqufa//'.Codes')
2320 cgn      call gmprsx (nompro, nhtetr/1/'.Famille')
2321 cgn      call gmprsx (nompro, nhtetr//'.Famille.Codes')
2322 c
2323       if ( codret.eq.0 ) then
2324 c
2325       iaux = 0
2326 #ifdef _DEBUG_HOMARD_
2327       write (ulsort,texte(langue,3)) 'UTECFE', nompro
2328 #endif
2329       call utecfe ( iaux,
2330      >              imem(pfamno), imem(pcfano),
2331      >              imem(pfammp), imem(pcfamp),
2332      >              imem(pfamar), imem(pcfaar),
2333      >              imem(pfamtr), imem(pcfatr),
2334      >              imem(pfamqu), imem(pcfaqu),
2335      >              imem(pfamte), imem(pcfate),
2336      >              imem(pfamhe), imem(pcfahe),
2337      >              imem(pfampy), imem(pcfapy),
2338      >              imem(pfampe), imem(pcfape),
2339      >              ulsort, langue, codret )
2340 c
2341       endif
2342 c
2343 #endif
2344 c
2345 c====
2346 c 24. la fin
2347 c====
2348 c
2349       if ( codret.ne.0 ) then
2350 c
2351 #include "envex2.h"
2352 c
2353       write (ulsort,texte(langue,1)) 'Sortie', nompro
2354       write (ulsort,texte(langue,2)) codret
2355 c
2356       endif
2357 c
2358 #ifdef _DEBUG_HOMARD_
2359       write (ulsort,texte(langue,1)) 'Sortie', nompro
2360       call dmflsh (iaux)
2361 #endif
2362 c
2363       end