src/tool/Creation_Maillage/cmmisa.F

   1       subroutine cmmisa ( nomail,
   2      >                    lgetco, taetco,
   3      >                    ulsort, langue, codret )
   4 c ______________________________________________________________________
   5 c
   6 c                             H O M A R D
   7 c
   8 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   9 c
  10 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  11 c aupres des huissiers de justice Simart et Lavoir a Clamart
  12 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  13 c aupres des huissiers de justice
  14 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  15 c
  16 c    HOMARD est une marque deposee d'Electricite de France
  17 c
  18 c Copyright EDF 1996
  19 c Copyright EDF 1998
  20 c Copyright EDF 2002
  21 c Copyright EDF 2020
  22 c ______________________________________________________________________
  23 c
  24 c    Creation du Maillage - MISe A jour de la structure de donnees
  25 c    -           -          ---  -
  26 c ______________________________________________________________________
  27 c
  28 c but : mise a jour de la structure de donnees pour le maillage adapte
  29 c       dont :
  30 c              - reconstruction des voisinages
  31 c              - traitement des homologues
  32 c ______________________________________________________________________
  33 c .        .     .        .                                            .
  34 c .  nom   . e/s . taille .           description                      .
  35 c .____________________________________________________________________.
  36 c . nomail . e   .  ch8   . nom de l'objet contenant le maillage       .
  37 c . lgetco . e   .   1    . longueur du tableau de l'etat courant      .
  38 c . taetco . e   . lgetco . tableau de l'etat courant                  .
  39 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  40 c . langue . e   .    1   . langue des messages                        .
  41 c .        .     .        . 1 : francais, 2 : anglais                  .
  42 c . codret . es  .    1   . code de retour des modules                 .
  43 c .        .     .        . 0 : pas de probleme                        .
  44 c ______________________________________________________________________
  45 c
  46 c
  47 c====
  48 c 0. declarations et dimensionnement
  49 c====
  50 c
  51 c 0.1. ==> generalites
  52 c
  53       implicit none
  54       save
  55 c
  56       character*6 nompro
  57       parameter ( nompro = 'CMMISA' )
  58 c
  59 #include "nblang.h"
  60 c
  61 c 0.2. ==> communs
  62 c
  63 #include "envex1.h"
  64 c
  65 #include "gmenti.h"
  66 c
  67 #include "envca1.h"
  68 #include "envada.h"
  69 #include "nombno.h"
  70 #include "nombar.h"
  71 #include "nombtr.h"
  72 #include "nombqu.h"
  73 #include "nombte.h"
  74 #include "nombhe.h"
  75 #include "nombpy.h"
  76 #include "nombpe.h"
  77 #include "nouvnb.h"
  78 #include "impr02.h"
  79 c
  80 c 0.3. ==> arguments
  81 c
  82       character*8 nomail
  83 c
  84       integer lgetco
  85       integer taetco(lgetco)
  86 c
  87       integer ulsort, langue, codret
  88 c
  89 c 0.4. ==> variables locales
  90 c
  91       integer codava
  92       integer nrosec
  93       integer nretap, nrsset
  94       integer iaux, jaux
  95 c
  96       integer codre0, codre1, codre2, codre3, codre4
  97       integer codre5, codre6, codre7, codre8
  98       integer phetno, pcoono
  99       integer psomar, phetar, pfilar, pnp2ar
 100       integer pposif, pfacar
 101       integer phettr, paretr, pfiltr, ppertr, pnivtr
 102       integer phetqu, parequ, pfilqu, pperqu, pnivqu
 103       integer ptrite, phette, pfilte
 104       integer pquahe, phethe, pfilhe
 105       integer pfacpy, phetpy, pfilpy
 106       integer pfacpe, phetpe, pfilpe
 107       integer adhono, adhoar, adhotr, adhoqu
 108       integer numead
 109 c
 110       integer nvacar, nvactr, nvacqu, nvacte, nvache, nvacpy, nvacpe
 111       integer vofaar, vovofa
 112 c
 113       character*6 saux
 114       character*8 norenu
 115       character*8 nhnoeu, nhmapo, nharet, nhtria, nhquad
 116       character*8 nhtetr, nhhexa, nhpyra, nhpent
 117       character*8 nhelig
 118       character*8 nhvois, nhsupe, nhsups
 119       character*14 saux14
 120 c
 121       integer nbmess
 122       parameter ( nbmess = 11 )
 123       character*80 texte(nblang,nbmess)
 124 c
 125 c 0.5. ==> initialisations
 126 c ______________________________________________________________________
 127 c
 128 c====
 129 c 1. messages
 130 c====
 131 c
 132       codava = codret
 133 c
 134 c=======================================================================
 135       if ( codava.eq.0 ) then
 136 c=======================================================================
 137 c
 138 c 1.1. ==> le debut des mesures de temps
 139 c
 140       nrosec = taetco(4)
 141       call gtdems (nrosec)
 142 c
 143 c 1.3. ==> les messages
 144 c
 145 #include "impr01.h"
 146 c
 147 #ifdef _DEBUG_HOMARD_
 148       write (ulsort,texte(langue,1)) 'Entree', nompro
 149       call dmflsh (iaux)
 150 #endif
 151 c
 152       texte(1,4) =
 153      > '(/,a6,'' MISE A JOUR DES DONNEES DU MAILLAGE ADAPTE'')'
 154       texte(1,5) = '(49(''=''),/)'
 155 c
 156       texte(1,6) = '(5x,''Nombre de noeuds                 :'',i10)'
 157       texte(1,7) = '(5x,''Nombre de '',a,'' actifs  :'',i10)'
 158       texte(1,8) = '(5x,''Niveau minimum des '',a,'':'',i10)'
 159       texte(1,9) = '(5x,''Niveau minimum des '',a,'':'',i10,''.5'')'
 160       texte(1,10) = '(5x,''Niveau maximum des '',a,'':'',i10)'
 161       texte(1,11) = '(5x,''Niveau maximum des '',a,'':'',i10,''.5'')'
 162 c
 163       texte(2,4) = '(/,a6,'' UPDATING OF DATA ON ADAPTED MESH'')'
 164       texte(2,5) = '(39(''=''),/)'
 165       texte(2,6) = '(5x,''Number of nodes                :'',i10)'
 166       texte(2,7) = '(5x,''Number of active '',a,'':'',i10)'
 167       texte(2,8) = '(5x,''Minimum level of '',a,'':'',i10)'
 168       texte(2,9) = '(5x,''Minimum level of '',a,'':'',i10,''.5'')'
 169       texte(2,10) = '(5x,''Maximum level of '',a,'':'',i10)'
 170       texte(2,11) = '(5x,''Maximum level of '',a,'':'',i10,''.5'')'
 171 c
 172 #include "impr03.h"
 173 c
 174 c 1.4. ==> le numero de sous-etape
 175 c
 176       nretap = taetco(1)
 177       nrsset = taetco(2) + 1
 178       taetco(2) = nrsset
 179 c
 180       call utcvne ( nretap, nrsset, saux, iaux, codret )
 181 c
 182 c 1.5. ==> le titre
 183 c
 184       write ( ulsort,texte(langue,4)) saux
 185       write ( ulsort,texte(langue,5))
 186 c
 187 c====
 188 c 2. recuperation des pointeurs
 189 c====
 190 c
 191 c 2.1. ==> structure generale
 192 c
 193       if ( codret.eq.0 ) then
 194 c
 195 #ifdef _DEBUG_HOMARD_
 196       write (ulsort,texte(langue,3)) 'UTNOMH', nompro
 197 #endif
 198       call utnomh ( nomail,
 199      >                sdim,   mdim,
 200      >               degre, maconf, homolo, hierar,
 201      >              rafdef, nbmane, typcca, typsfr, maextr,
 202      >              mailet,
 203      >              norenu,
 204      >              nhnoeu, nhmapo, nharet,
 205      >              nhtria, nhquad,
 206      >              nhtetr, nhhexa, nhpyra, nhpent,
 207      >              nhelig,
 208      >              nhvois, nhsupe, nhsups,
 209      >              ulsort, langue, codret)
 210 c
 211       endif
 212 c
 213 c 2.2. ==> tableaux
 214 #ifdef _DEBUG_HOMARD_
 215       write (ulsort,90002) '2.2. tableaux ; codret', codret
 216 #endif
 217 c
 218       if ( codret.eq.0 ) then
 219 c
 220       iaux = 6
 221       if ( homolo.ge.1 ) then
 222         iaux = iaux*11
 223       endif
 224 #ifdef _DEBUG_HOMARD_
 225       write (ulsort,texte(langue,3)) 'UTAD01', nompro
 226 #endif
 227       call utad01 ( iaux, nhnoeu,
 228      >              phetno,
 229      >                jaux,   jaux,   jaux,
 230      >              pcoono,   jaux, adhono,  jaux,
 231      >              ulsort, langue, codret )
 232 c
 233       iaux = 6
 234       if ( degre.eq.2 ) then
 235         iaux = iaux*13
 236       endif
 237       if ( homolo.ge.2 ) then
 238         iaux = iaux*29
 239       endif
 240 #ifdef _DEBUG_HOMARD_
 241       write (ulsort,texte(langue,3)) 'UTAD02_ar', nompro
 242 #endif
 243       call utad02 ( iaux, nharet,
 244      >              phetar, psomar, pfilar, jaux,
 245      >                jaux,   jaux,   jaux,
 246      >                jaux, pnp2ar,   jaux,
 247      >                jaux, adhoar,   jaux,
 248      >              ulsort, langue, codret )
 249 c
 250       if ( nouvtr.ne.0 ) then
 251 c
 252         iaux = 330
 253         if ( homolo.ge.3 ) then
 254           iaux = iaux*29
 255         endif
 256 #ifdef _DEBUG_HOMARD_
 257       write (ulsort,texte(langue,3)) 'UTAD02_tr', nompro
 258 #endif
 259         call utad02 ( iaux, nhtria,
 260      >                phettr, paretr, pfiltr, ppertr,
 261      >                  jaux,   jaux,   jaux,
 262      >                pnivtr, jaux,  jaux,
 263      >                  jaux, adhotr, jaux,
 264      >                ulsort, langue, codret )
 265 c
 266       endif
 267 c
 268       if ( nouvqu.ne.0 ) then
 269 c
 270         iaux = 330
 271         if ( homolo.ge.3 ) then
 272           iaux = iaux*29
 273         endif
 274 #ifdef _DEBUG_HOMARD_
 275       write (ulsort,texte(langue,3)) 'UTAD02_qu', nompro
 276 #endif
 277         call utad02 ( iaux, nhquad,
 278      >                phetqu, parequ, pfilqu, pperqu,
 279      >                  jaux,   jaux,   jaux,
 280      >                pnivqu, jaux,  jaux,
 281      >                  jaux, adhoqu, jaux,
 282      >                ulsort, langue, codret )
 283 c
 284       endif
 285 c
 286       if ( nouvte.ne.0 ) then
 287 c
 288         iaux = 6
 289 #ifdef _DEBUG_HOMARD_
 290       write (ulsort,texte(langue,3)) 'UTAD02_te', nompro
 291 #endif
 292         call utad02 ( iaux, nhtetr,
 293      >                phette, ptrite, pfilte, jaux,
 294      >                  jaux,   jaux,   jaux,
 295      >                  jaux,   jaux,   jaux,
 296      >                  jaux,   jaux,   jaux,
 297      >                ulsort, langue, codret )
 298 c
 299       endif
 300 c
 301       if ( nouvhe.ne.0 ) then
 302 c
 303         iaux = 6
 304 #ifdef _DEBUG_HOMARD_
 305       write (ulsort,texte(langue,3)) 'UTAD02_he', nompro
 306 #endif
 307         call utad02 ( iaux, nhhexa,
 308      >                phethe, pquahe, pfilhe, jaux,
 309      >                  jaux,   jaux,   jaux,
 310      >                  jaux,   jaux,   jaux,
 311      >                  jaux,   jaux,   jaux,
 312      >                ulsort, langue, codret )
 313 c
 314       endif
 315 c
 316       if ( nouvpy.ne.0 ) then
 317 c
 318         iaux = 6
 319 #ifdef _DEBUG_HOMARD_
 320       write (ulsort,texte(langue,3)) 'UTAD02_py', nompro
 321 #endif
 322         call utad02 ( iaux, nhpyra,
 323      >                phetpy, pfacpy, pfilpy, jaux,
 324      >                  jaux,   jaux,   jaux,
 325      >                  jaux,   jaux,   jaux,
 326      >                  jaux,   jaux,   jaux,
 327      >                ulsort, langue, codret )
 328 c
 329       endif
 330 c
 331       if ( nouvpe.ne.0 ) then
 332 c
 333         iaux = 6
 334 #ifdef _DEBUG_HOMARD_
 335       write (ulsort,texte(langue,3)) 'UTAD02_pe', nompro
 336 #endif
 337         call utad02 ( iaux, nhpent,
 338      >                phetpe, pfacpe, pfilpe, jaux,
 339      >                  jaux,   jaux,   jaux,
 340      >                  jaux,   jaux,   jaux,
 341      >                  jaux,   jaux,   jaux,
 342      >                ulsort, langue, codret )
 343 c
 344       endif
 345 c
 346       endif
 347 c
 348 c====
 349 c 3. comptage des entites actives du maillage
 350 c====
 351 #ifdef _DEBUG_HOMARD_
 352       write (ulsort,90002) '3. comptage entites active ; codret', codret
 353 #endif
 354 c
 355       if ( codret.eq.0 ) then
 356 c
 357 #ifdef _DEBUG_HOMARD_
 358       write (ulsort,texte(langue,3)) 'CMCACT', nompro
 359 #endif
 360       call cmcact ( imem(phetno),
 361      >              imem(pfilar),
 362      >              imem(pfiltr), imem(pnivtr),
 363      >              imem(pfilqu), imem(pnivqu),
 364      >              imem(pfilte), imem(pfilhe),
 365      >              imem(pfilpy), imem(pfilpe),
 366      >              nvacar, nvactr, nvacqu,
 367      >              nvacte, nvache, nvacpy, nvacpe,
 368      >              ulsort, langue, codret )
 369 c
 370       endif
 371 c
 372 c====
 373 c 4. mise a jour des nombres d'entites du maillage adapte
 374 c====
 375 #ifdef _DEBUG_HOMARD_
 376       write (ulsort,90002) '4. mise a jour des nombres ; codret', codret
 377       call dmflsh (iaux)
 378 #endif
 379 c
 380       if ( codret.eq.0 ) then
 381 c
 382 c 4.1. commun "nombno" --> noeuds
 383 c
 384 c     nbpnho = mis a jour en 5.1
 385 c     nbnois = non modifie
 386 c     nbnoei = non modifie
 387 c     nbnoma = non modifie
 388 c     nbnomp = non modifie
 389 cgn      write (ulsort,90002) 'nouvno,provp1',nouvno,provp1
 390 cgn      write (ulsort,90002) 'nouvp2,nouvim',nouvp2,nouvim
 391 cgn      write (ulsort,90002) 'nbnoei,nbnois',nbnoei,nbnois
 392       nbnop1 = nouvno - nouvp2 - nouvim - nbnomp - nbnoei - nbnois
 393       nbnop2 = nouvp2
 394       nbnoim = nouvim
 395       nbnoto = nouvno
 396       nbnoin = provp1 - nbquq5/3
 397 cgn      write (ulsort,90002) 'p1,p2,im,to',nbnop1,nbnop2,nbnoim,nbnoto
 398 c
 399 c 4.2. commun "nombar" --> aretes
 400 c
 401       nbarac = nvacar
 402       nbarde = permar - nbarma
 403 c     nbart2 = calcule dans utplco
 404 c     nbarq2 = calcule dans utplco
 405 c     nbarq3 = calcule dans utplco
 406 c     nbarq5 = calcule dans utplco
 407 c     nbpaho = mis a jour en 5.1
 408 c     nbarin = calcule dans utplco
 409 c     nbarma = non modifie
 410       nbarpe = permar
 411       nbarto = nouvar
 412 cgn      write (ulsort,*) nbarac,nbarde,nbarpe,nbarto
 413 c
 414 c 4.3. commun "nombtr" --> triangles
 415 c
 416       nbtrac = nvactr
 417       nbtrde = permtr - nbtrma
 418 c     nbtrt2 = calcule dans utplco
 419 c     nbtrq3 = calcule dans utplco
 420 c     nbptho = mis a jour en 5.1
 421 c     nbtrhc = calcule dans utplco
 422 c     nbtrpc = calcule dans utplco
 423 c     nbtrtc = calcule dans utplco
 424 c     nbtrma = non modifie
 425       nbtrpe = permtr
 426       nbtrto = nouvtr
 427 cgn      write (ulsort,*) nbtrac,nbtrde,nbtrpe,nbtrto
 428 c
 429 c 4.4. commun "nombqu" --> quadrangles
 430 c
 431       nbquac = nvacqu
 432       nbqude = permqu - nbquma
 433 c     nbquq2 = calcule dans utplco
 434 c     nbquq5 = calcule dans utplco
 435       nbqupe = permqu
 436       nbquto = nouvqu
 437 cgn      write (ulsort,*) nbquac,nbqude,nbqupe,nbquto
 438 c
 439 c 4.5. commun "nombte" --> tetraedres
 440 c
 441       nbteac = nvacte
 442 c     nbtea2 = calcule dans utplco
 443 c     nbtea4 = calcule dans utplco
 444       nbtede = permte - nbtema
 445 c     nbtef4 = calcule dans utplco
 446 c     nbtema = non modifie
 447       nbtepe = permte
 448       nbteto = nouvte
 449       nbteca = provta
 450       nbtecf = nbteto - nbteca
 451 cgn      write (ulsort,90002) 'nbteac,nbtepe,nbteto,nbtecf,nbteca',
 452 cgn     >                      nbteac,nbtepe,nbteto,nbtecf,nbteca
 453 c
 454 c 4.6. commun "nombhe" --> hexaedres
 455 c
 456       nbheac = nvache
 457       nbhede = permhe - nbhema
 458 c     nbhema = non modifie
 459       nbhepe = permhe
 460       nbheto = nouvhe
 461       nbheca = provha
 462       nbhecf = nbheto - nbheca
 463 cgn      write (ulsort,90002) 'nbheac,nbhepe,nbheto,nbhecf,nbheca',
 464 cgn     >                      nbheac,nbhepe,nbheto,nbhecf,nbheca
 465 c
 466 c 4.7. commun "nombpy" --> pyramides
 467 c
 468       nbpyac = nvacpy
 469 c     nbpyma = non modifie
 470       nbpype = permpy
 471       nbpyto = nouvpy
 472       nbpyca = provya
 473       nbpycf = nbpyto - nbpyca
 474 cgn      write (ulsort,90002) 'nbpyac,nbpype,nbpyto,nbpycf,nbpyca',
 475 cgn     >                      nbpyac,nbpype,nbpyto,nbpycf,nbpyca
 476 c
 477 c 4.8. commun "nombpe" --> pentaedres
 478 c
 479       nbpeac = nvacpe
 480       nbpede = permpe - nbpema
 481 c     nbpema = non modifie
 482       nbpepe = permpe
 483       nbpeto = nouvpe
 484       nbpeto = nouvpe
 485       nbpeca = provpa
 486       nbpecf = nbpeto - nbpeca
 487 cgn      write (ulsort,90002) 'nbpeac,nbpepe,nbpeto,nbpecf,nbpeca',
 488 cgn     >                      nbpeac,nbpepe,nbpeto,nbpecf,nbpeca
 489 c
 490 c 4.9. ==> stockage
 491 c
 492       call gmecat ( nhnoeu, 1 , nbnoto, codre1 )
 493       call gmecat ( nharet, 1 , nbarto, codre2 )
 494       call gmecat ( nhtria, 1 , nbtrto, codre3 )
 495       call gmecat ( nhquad, 1 , nbquto, codre4 )
 496       call gmecat ( nhtetr, 1 , nbteto, codre5 )
 497       call gmecat ( nhhexa, 1 , nbheto, codre6 )
 498       call gmecat ( nhpyra, 1 , nbpyto, codre7 )
 499       call gmecat ( nhpent, 1 , nbpeto, codre8 )
 500 c
 501       codre0 = min ( codre1, codre2, codre3, codre4, codre5,
 502      >               codre6, codre7, codre8 )
 503       codret = max ( abs(codre0), codret,
 504      >               codre1, codre2, codre3, codre4, codre5,
 505      >               codre6, codre7, codre8 )
 506 c
 507       call gmecat ( nhtetr, 2, nbteca, codre1 )
 508       call gmecat ( nhhexa, 2, nbheca, codre2 )
 509       call gmecat ( nhpyra, 2, nbpyca, codre3 )
 510       call gmecat ( nhpent, 2, nbpeca, codre4 )
 511 c
 512       codre0 = min ( codre1, codre2, codre3, codre4 )
 513       codret = max ( abs(codre0), codret,
 514      >               codre1, codre2, codre3, codre4 )
 515 c
 516       endif
 517 c
 518 c====
 519 c 5. determination des voisinages
 520 c====
 521 #ifdef _DEBUG_HOMARD_
 522       write (ulsort,90002) '5. voisinages ; codret', codret
 523 #endif
 524 c
 525 c 5.1. ==> determination des faces voisines des aretes
 526 c
 527       if ( codret.eq.0 ) then
 528 c
 529       vofaar = 1
 530 c
 531 #ifdef _DEBUG_HOMARD_
 532       write (ulsort,texte(langue,3)) 'UTVGFA', nompro
 533 #endif
 534 c
 535       call utvgfa ( nhvois, nharet, nhtria, nhquad,
 536      >              vofaar,
 537      >              nbfaar, pposif, pfacar,
 538      >              ulsort, langue, codret )
 539 c
 540       endif
 541 c
 542 #ifdef _DEBUG_HOMARD_
 543       if ( codret.eq.0 ) then
 544       iaux = 2
 545       write (ulsort,texte(langue,3)) 'UTVERI_UTVGFA_apres', nompro
 546       call utveri ( 'adap    ', nomail, 'UTVGFA', iaux,
 547      >              ulsort, langue, codret )
 548       endif
 549 #endif
 550 c
 551 c 5.2. ==> determination des volumes voisins des faces
 552 c
 553       if ( codret.eq.0 ) then
 554 c
 555       vovofa = 1
 556 c
 557 #ifdef _DEBUG_HOMARD_
 558       write (ulsort,texte(langue,3)) 'UTVGVF', nompro
 559 #endif
 560 c
 561       call utvgvf ( nhvois, nhtria, nhquad,
 562      >              nhtetr, nhhexa, nhpyra, nhpent,
 563      >              vovofa,
 564      >              ulsort, langue, codret)
 565 c
 566       endif
 567 c
 568 #ifdef _DEBUG_HOMARD_
 569       if ( codret.eq.0 ) then
 570       iaux = 2
 571       write (ulsort,texte(langue,3)) 'UTVERI_UTVGVF_apres', nompro
 572       call utveri ( 'adap    ', nomail, 'UTVGVF', iaux,
 573      >              ulsort, langue, codret )
 574       endif
 575 #endif
 576 c
 577 c====
 578 c 6. mise a jour eventuelle pour les homologues
 579 c====
 580 #ifdef _DEBUG_HOMARD_
 581       write (ulsort,90002) '6. homologues ; codret', codret
 582 #endif
 583 c
 584       if ( homolo.ne.0 ) then
 585 c
 586         if ( codret.eq.0 ) then
 587 c
 588 c 6.1. ==> comptage des entites du maillage concernees par une
 589 c          condition homologue et mise a jour des tables
 590 c          provisoires de correspondance
 591 c
 592 #ifdef _DEBUG_HOMARD_
 593       write (ulsort,texte(langue,3)) 'CMHOMO', nompro
 594 #endif
 595         call cmhomo (
 596      >           imem(adhono), imem(adhoar), imem(adhotr), imem(adhoqu),
 597      >           imem(psomar), imem(pfilar), imem(phetar), imem(pnp2ar),
 598      >           imem(paretr), imem(pfiltr), imem(phettr),
 599      >           imem(parequ), imem(pfilqu), imem(phetqu),
 600      >           ulsort, langue, codret )
 601 c
 602         endif
 603 c
 604       endif
 605 c
 606 c====
 607 c 7. mise a jour eventuelle pour les non conformites
 608 c====
 609 #ifdef _DEBUG_HOMARD_
 610       write (ulsort,90002) '7. maj non-conformite ; codret', codret
 611 #endif
 612 c
 613       if ( ( maconf.eq.-2 ) .or. ( maconf.ge.1 ) ) then
 614 c
 615         if ( codret.eq.0 ) then
 616 c
 617 #ifdef _DEBUG_HOMARD_
 618         write (ulsort,texte(langue,3)) 'UTNC08', nompro
 619 #endif
 620         call utnc08 ( nharet, nhtria, nhquad, nhvois,
 621      >                numead,
 622      >                ulsort, langue, codret )
 623 c
 624         endif
 625 c
 626 #ifdef _DEBUG_HOMARD_
 627       if ( codret.eq.0 ) then
 628       write (ulsort,texte(langue,3)) 'UTVERI_UTNC08_apres', nompro
 629       iaux = 2
 630       call utveri ( 'adap    ', nomail, 'UTNC08', iaux,
 631      >              ulsort, langue, codret )
 632       endif
 633 #endif
 634 c
 635       endif
 636 c
 637 c====
 638 c 8. impressions
 639 c====
 640 #ifdef _DEBUG_HOMARD_
 641       write (ulsort,90002) '8. Impressions ; codret', codret
 642 #endif
 643 c
 644       if ( codret.eq.0 ) then
 645 c
 646       write(ulsort,texte(langue,6)) nbnoto
 647       write(ulsort,texte(langue,7)) mess14(langue,3,1), nbarac
 648       if ( nbtrto.ne.0 ) then
 649         write(ulsort,texte(langue,7)) mess14(langue,3,2), nbtrac
 650       endif
 651       if ( nbquto.ne.0 ) then
 652         write(ulsort,texte(langue,7)) mess14(langue,3,4), nbquac
 653       endif
 654       if ( nbteto.ne.0 ) then
 655         write(ulsort,texte(langue,7)) mess14(langue,3,3), nbteac
 656       endif
 657       if ( nbheto.ne.0 ) then
 658         write(ulsort,texte(langue,7)) mess14(langue,3,6), nbheac
 659       endif
 660       if ( nbpyto.ne.0 ) then
 661         write(ulsort,texte(langue,7)) mess14(langue,3,5), nbpyac
 662       endif
 663       if ( nbpeto.ne.0 ) then
 664         write(ulsort,texte(langue,7)) mess14(langue,3,7), nbpeac
 665       endif
 666       if ( nbtrto.ne.0 .or. nbquto.ne.0 ) then
 667         if ( nbquto.eq.0 ) then
 668           saux14 = mess14(langue,3,2)
 669         elseif ( nbtrto.eq.0 ) then
 670           saux14 = mess14(langue,3,4)
 671         else
 672           saux14 = mess14(langue,3,8)
 673         endif
 674         iaux = mod(niincf,10)
 675         if ( iaux.ne.0 ) then
 676           if ( nivinf.le.((niincf-5)/10) ) then
 677             iaux = 0
 678           endif
 679         endif
 680         if ( iaux.eq.0 ) then
 681           write (ulsort,texte(langue,8)) saux14, nivinf
 682         else
 683           write (ulsort,texte(langue,9)) saux14, (niincf-5)/10
 684         endif
 685         iaux = mod(nisucf,10)
 686         if ( iaux.eq.0 ) then
 687           write (ulsort,texte(langue,10)) saux14, nivsup
 688         else
 689           write (ulsort,texte(langue,11)) saux14, (nisucf-5)/10
 690         endif
 691       endif
 692 c
 693       endif
 694 c
 695 c====
 696 c 9. la fin
 697 c====
 698 c
 699 c 9.1. ==> message si erreur
 700 c
 701       if ( codret.ne.0 ) then
 702 c
 703 #include "envex2.h"
 704 c
 705       write (ulsort,texte(langue,1)) 'Sortie', nompro
 706       write (ulsort,texte(langue,2)) codret
 707 c
 708       endif
 709 c
 710 c 9.2. ==> fin des mesures de temps de la section
 711 c
 712       call gtfims (nrosec)
 713 c
 714 c=======================================================================
 715       endif
 716 c=======================================================================
 717 c
 718 #ifdef _DEBUG_HOMARD_
 719       write (ulsort,texte(langue,1)) 'Sortie', nompro
 720       call dmflsh (iaux)
 721 #endif
 722 c
 723       end