src/tool/Suivi_Frontiere/sfcoin.F

   1       subroutine sfcoin ( nomail,
   2      >                    lgopti, taopti, lgopts, taopts,
   3      >                    lgetco, taetco,
   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   Suivi de Frontiere : COnversions INitiales
  26 c   --                   --          --
  27 c ______________________________________________________________________
  28 c .        .     .        .                                            .
  29 c .  nom   . e/s . taille .           description                      .
  30 c .____________________________________________________________________.
  31 c . nomail . e   . char8  . nom de l'objet maillage homard             .
  32 c . lgopti . e   .   1    . longueur du tableau des options            .
  33 c . taopti . e   . lgopti . tableau des options                        .
  34 c . lgopts . e   .   1    . longueur du tableau des options caracteres .
  35 c . taopts . e   . lgopts . tableau des options caracteres             .
  36 c . lgetco . e   .   1    . longueur du tableau de l'etat courant      .
  37 c . taetco . e   . lgetco . tableau de l'etat courant                  .
  38 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  39 c . langue . e   .    1   . langue des messages                        .
  40 c .        .     .        . 1 : francais, 2 : anglais                  .
  41 c . codret . es  .    1   . code de retour des modules                 .
  42 c .        .     .        . en entree = celui du module d'avant        .
  43 c .        .     .        . en sortie = celui du module en cours       .
  44 c .        .     .        . 0 : pas de probleme                        .
  45 c .        .     .        . 1 : manque de temps cpu                    .
  46 c .        .     .        . 2x : probleme dans les memoires            .
  47 c .        .     .        . 3x : probleme dans les fichiers            .
  48 c .        .     .        . 5 : mauvaises options                      .
  49 c .        .     .        . 6 : problemes dans les noms d'objet        .
  50 c ______________________________________________________________________
  51 c
  52 c====
  53 c 0. declarations et dimensionnement
  54 c====
  55 c
  56 c 0.1. ==> generalites
  57 c
  58       implicit none
  59       save
  60 c
  61       character*6 nompro
  62       parameter ( nompro = 'SFCOIN' )
  63 c
  64 #include "nblang.h"
  65 c
  66 c 0.2. ==> communs
  67 c
  68 #include "envex1.h"
  69 c
  70 #include "gmenti.h"
  71 #include "gmreel.h"
  72 #include "gmstri.h"
  73 c
  74 #include "envca1.h"
  75 #include "nombqu.h"
  76 #include "impr02.h"
  77 #include "precis.h"
  78 #include "front0.h"
  79 c
  80 c 0.3. ==> arguments
  81 c
  82       character*8 nomail
  83 c
  84       integer lgopti
  85       integer taopti(lgopti)
  86 c
  87       integer lgopts
  88       character*8 taopts(lgopts)
  89 c
  90       integer lgetco
  91       integer taetco(lgetco)
  92 c
  93       integer ulsort, langue, codret
  94 c
  95 c 0.4. ==> variables locales
  96 c
  97       integer iaux, jaux, kaux
  98       integer nretap, nrsset
  99 c
 100       integer nbarfr, nbqufr
 101       integer nbfrdi
 102       integer adnuno, adlino, adacno
 103       integer adabsc, psomse, psegli, pgeoco
 104       integer pcoono, adcocs
 105       integer pareno
 106       integer phetno
 107       integer psomar, phetar, pfilar, pnp2ar
 108       integer pcfaar, pfamar
 109       integer parequ, phetqu
 110       integer pcfaqu, pfamqu
 111       integer adcafr
 112       integer adfrgr, adnogr, nbfrgr, adulgr
 113       integer cpt1d, cpt2d
 114 c
 115       integer codre0
 116       integer codre1, codre2, codre3, codre4
 117 c
 118       double precision unst2x, epsid2
 119 c
 120       character*2 saux02
 121       character*6 saux
 122       character*7 saux07
 123       character*8 norenu
 124       character*8 nhnoeu, nhmapo, nharet, nhtria, nhquad
 125       character*8 nhtetr, nhhexa, nhpyra, nhpent
 126       character*8 nhelig
 127       character*8 nhvois, nhsupe, nhsups
 128       character*8 ntrav1, ntrav2, ntrav3
 129       character*8 ncafdg, nocdfr, ncafan, ncfgnf, ncfgng, ncafar
 130       character*80 saux80
 131 c
 132       integer nbmess
 133       parameter ( nbmess = 10 )
 134       character*80 texte(nblang,nbmess)
 135 c
 136 c 0.5. ==> initialisations
 137 c ______________________________________________________________________
 138 c
 139 c====
 140 c 1. les initialisations
 141 c====
 142 c 1.1. ==> les messages
 143 c
 144 #include "impr01.h"
 145 c
 146 #ifdef _DEBUG_HOMARD_
 147       write (ulsort,texte(langue,1)) 'Entree', nompro
 148       call dmflsh (iaux)
 149 #endif
 150 c
 151       texte(1,4) = '(/,a6,'' PRISE EN COMPTE DES FRONTIERES'')'
 152       texte(1,5) = '(37(''=''),/)'
 153       texte(1,6) = '(''Aucun '',a,''n''''est concerne.'')'
 154       texte(1,7) = '(''Nombre de '',a,''concernes :'',i10)'
 155       texte(1,8) = '(/,''. Conversion de la geometrie discrete'',/)'
 156 c
 157       texte(2,4) = '(/,a6,'' BOUNDARY EXAMINATION'')'
 158       texte(2,5) = '(27(''=''),/)'
 159       texte(2,6) = '(''No '',a,''is involved'')'
 160       texte(2,7) = '(''Number of involved '',a,'':'',i10)'
 161       texte(2,8) = '(/,''. Conversion of discrete geometry'',/)'
 162 c
 163 #include "impr03.h"
 164 c
 165 c 1.4. ==> le numero de sous-etape
 166 c
 167       nretap = taetco(1)
 168       nrsset = taetco(2) + 1
 169       taetco(2) = nrsset
 170 c
 171       call utcvne ( nretap, nrsset, saux, iaux, codret )
 172 c
 173 c 1.5 ==> le titre
 174 c
 175       if ( taopti(4).ne.2 ) then
 176       write (ulsort,texte(langue,4)) saux
 177       write (ulsort,texte(langue,5))
 178       endif
 179 c
 180 c====
 181 c 2. recuperation des pointeurs
 182 c====
 183 c 2.1. ==> structure generale
 184 c
 185       if ( codret.eq.0 ) then
 186 c
 187 #ifdef _DEBUG_HOMARD_
 188       write (ulsort,texte(langue,3)) 'UTNOMH', nompro
 189 #endif
 190       call utnomh ( nomail,
 191      >                sdim,   mdim,
 192      >               degre, maconf, homolo, hierar,
 193      >              rafdef, nbmane, typcca, typsfr, maextr,
 194      >              mailet,
 195      >              norenu,
 196      >              nhnoeu, nhmapo, nharet,
 197      >              nhtria, nhquad,
 198      >              nhtetr, nhhexa, nhpyra, nhpent,
 199      >              nhelig,
 200      >              nhvois, nhsupe, nhsups,
 201      >              ulsort, langue, codret)
 202 c
 203       endif
 204 c
 205 c 2.2.==> tableaux du maillage
 206 c
 207       if ( codret.eq.0 ) then
 208 c
 209 #ifdef _DEBUG_HOMARD_
 210       write (ulsort,texte(langue,3)) 'UTAD01', nompro
 211 #endif
 212       iaux = 30*19
 213       call utad01 ( iaux, nhnoeu,
 214      >              phetno,
 215      >                jaux,   jaux,   jaux,
 216      >              pcoono, pareno,   jaux, adcocs,
 217      >              ulsort, langue, codret )
 218 c
 219       endif
 220 c
 221 #ifdef _DEBUG_HOMARD_
 222       write (ulsort,texte(langue,3)) 'UTAD02_ar', nompro
 223 #endif
 224       iaux = 1554
 225       if ( degre.eq.2 ) then
 226         iaux = iaux*13
 227       endif
 228       call utad02 ( iaux, nharet,
 229      >              phetar, psomar, pfilar, jaux,
 230      >              pfamar, pcfaar,   jaux,
 231      >              jaux  , pnp2ar,   jaux,
 232      >                jaux,   jaux,   jaux,
 233      >              ulsort, langue, codret )
 234 c
 235       if ( nbquto.gt.0 ) then
 236 c
 237 #ifdef _DEBUG_HOMARD_
 238       write (ulsort,texte(langue,3)) 'UTAD02_qu', nompro
 239 #endif
 240         iaux = 518
 241         call utad02 ( iaux, nhquad,
 242      >                phetqu, parequ, jaux, jaux,
 243      >                pfamqu, pcfaqu,   jaux,
 244      >                  jaux,   jaux,   jaux,
 245      >                  jaux,   jaux,   jaux,
 246      >                ulsort, langue, codret )
 247 c
 248       endif
 249 c
 250       epsid2 = max(1.d-14,epsima)
 251 #ifdef _DEBUG_HOMARD_
 252       write (ulsort,90004) 'epsid2', epsid2
 253 #endif
 254 c
 255       nrofro = 0
 256 c
 257 c====
 258 c 3. Decompte des entites concernees par la frontiere
 259 c====
 260 #ifdef _DEBUG_HOMARD_
 261       write (ulsort,90002) '3. Decompte ; codret', codret
 262 #endif
 263 c
 264 c 3.1. ==> Decompte des aretes concernees par la frontiere
 265 c
 266       if ( codret.eq.0 ) then
 267 c
 268       nbarfr = 0
 269       iaux = 0
 270 c
 271 #ifdef _DEBUG_HOMARD_
 272       write (ulsort,texte(langue,3)) 'SFCONA', nompro
 273 #endif
 274       call sfcona ( iaux, nbarfr, imem(iaux),
 275      >              imem(phetar), imem(pcfaar), imem(pfamar),
 276      >              ulsort, langue, codret )
 277 c
 278       endif
 279 c
 280 #ifdef _DEBUG_HOMARD_
 281       if ( codret.eq.0 ) then
 282       if ( nbarfr.eq.0 ) then
 283         write (ulsort,texte(langue,6)) mess14(langue,1,1)
 284       else
 285         write (ulsort,texte(langue,7)) mess14(langue,3,1), nbarfr
 286       endif
 287       endif
 288 #endif
 289 c
 290 c 3.2. ==> Decompte des quadrangles concernes par la frontiere
 291 c          Ne sert a rien ?
 292 c
 293 cgn      if ( nbquto.lt.0 ) then
 294 cgnc
 295 cgn        if ( codret.eq.0 ) then
 296 cgnc
 297 cgn        nbqufr = 0
 298 cgn        iaux = 0
 299 cgnc
 300 cgn#ifdef _DEBUG_HOMARD_
 301 cgn      write (ulsort,texte(langue,3)) 'SFCONQ', nompro
 302 cgn#endif
 303 cgn        call sfconq ( iaux, nbqufr, imem(iaux),
 304 cgn     >                imem(phetqu), imem(pcfaqu), imem(pfamqu),
 305 cgn     >                ulsort, langue, codret )
 306 cgnc
 307 cgn        endif
 308 cgnc
 309 cgn#ifdef _DEBUG_HOMARD_
 310 cgn      if ( codret.eq.0 ) then
 311 cgn      if ( nbarfr.eq.0 ) then
 312 cgn        write (ulsort,texte(langue,6)) mess14(langue,1,4)
 313 cgn      else
 314 cgn        write (ulsort,texte(langue,7)) mess14(langue,3,4), nbqufr
 315 cgn      endif
 316 cgn      endif
 317 cgn#endif
 318 cgnc
 319 cgn      endif
 320 c
 321 c 3.3. ==> Nombre de frontieres discretes ou CAO
 322 #ifdef _DEBUG_HOMARD_
 323       write (ulsort,90002) '3.3 ; codret', codret
 324       write (ulsort,90002) 'nbarfr', nbarfr
 325       write (ulsort,90002) 'taopti(29) (suifro)', taopti(29)
 326       call gmprsx ( nompro, taopts(17) )
 327 #endif
 328 c
 329       if ( nbarfr.gt.0 .and.
 330      >   ( mod(taopti(29),2).eq.0 ) ) then
 331 c
 332 c 3.3.1. ==> Au premier passage
 333 c
 334         if ( taopti(10).eq.0 ) then
 335 c
 336           if ( codret.eq.0 ) then
 337 c
 338           ncafdg = taopts(17)
 339           call gmliat ( ncafdg, 1, nbfrdi, codret )
 340 c
 341           endif
 342 c
 343 c 3.3.2. ==> ensuite
 344 c
 345         else
 346 c
 347           if ( codret.eq.0 ) then
 348 c
 349           call gmliat ( nhsupe, 10, nbfrdi, codret )
 350 c
 351           endif
 352 c
 353         endif
 354 c
 355 #ifdef _DEBUG_HOMARD_
 356       write (ulsort,90002) 'nbfrdi', nbfrdi
 357 #endif
 358 c
 359       endif
 360 c
 361 c====
 362 c 4. Affichage
 363 c====
 364 #ifdef _DEBUG_HOMARD_
 365       write (ulsort,90002) '4. Affichage ; codret', codret
 366       write (ulsort,90002) 'nbarfr', nbarfr
 367 #endif
 368 c
 369       if ( nbarfr.gt.0 ) then
 370 c
 371         if ( codret.eq.0 ) then
 372 c
 373         ncfgnf = taopts(23)
 374         ncfgng = taopts(24)
 375         ncafan = taopts(25)
 376         ncafar = taopts(26)
 377 c
 378 #ifdef _DEBUG_HOMARD_
 379       write (ulsort,texte(langue,3)) 'SFFAFF', nompro
 380 #endif
 381         call sffaff ( taopti(29),
 382      >                ncafdg, ncafan, ncfgnf, ncfgng, ncafar,
 383      >                nhsupe, nhsups,
 384      >                ulsort, langue, codret )
 385 c
 386         endif
 387 c
 388       endif
 389 c
 390 c====
 391 c 5. frontiere CAO : initialisations des fichiers
 392 c====
 393 #ifdef _DEBUG_HOMARD_
 394       write (ulsort,90002) '5. frontiere CAO ; codret', codret
 395 #endif
 396 c
 397       if ( mod(taopti(29),5).eq.0 ) then
 398 c
 399         if ( codret.eq.0 ) then
 400 #ifdef _DEBUG_HOMARD_
 401         call gmprsx ( nompro, nhsupe//'.Tab10' )
 402         call gmprsx ( nompro, nhsups//'.Tab10' )
 403 #endif
 404 c
 405         call gmadoj ( nhsupe//'.Tab10', adfrgr, iaux, codre1 )
 406         call gmadoj ( nhsups//'.Tab10', adnogr, iaux, codre2 )
 407         call gmliat ( nhsupe, 10, nbfrgr, codre3 )
 408 c
 409         codre0 = min ( codre1, codre2, codre3 )
 410         codret = max ( abs(codre0), codret,
 411      >                 codre1, codre2, codre3 )
 412 c
 413         endif
 414 c
 415         if ( codret.eq.0 ) then
 416 c
 417         call gmalot ( taopts(27), 'entier', nbfrgr, adulgr, codret )
 418 c
 419         endif
 420 c
 421         if ( codret.eq.0 ) then
 422 c
 423         cpt1d = 0
 424         cpt2d = 0
 425         do 51 , iaux = 1, nbfrgr
 426 c
 427           if ( imem(adfrgr+iaux-1).gt.0 ) then
 428             jaux = cpt1d
 429             cpt1d = cpt1d + 1
 430             saux07 = 'fr1D.  '
 431           elseif ( imem(adfrgr+iaux-1).lt.0 ) then
 432             jaux = cpt2d
 433             cpt2d = cpt2d + 1
 434             saux07 = 'fr2D.  '
 435           else
 436             jaux = -1
 437           endif
 438 c
 439           if ( jaux.ge.0 ) then
 440 c
 441             if ( codret.eq.0 ) then
 442 c
 443             call utench ( jaux, '0', kaux, saux02,
 444      >                    ulsort, langue, codret )
 445 c
 446             saux07(6:7) = saux02
 447             jaux = 7
 448             call guoufs ( saux07, jaux, kaux, codret )
 449 c
 450             endif
 451 c
 452             if ( codret.eq.0 ) then
 453 c
 454             call uts8ch ( smem(adnogr+(iaux-1)*10), 80, saux80,
 455      >                    ulsort, langue, codret )
 456             write (kaux,*) saux80
 457 c
 458             endif
 459 c
 460           else
 461 c
 462             kaux = 0
 463 c
 464           endif
 465 c
 466           imem(adulgr+iaux-1) = kaux
 467 c
 468    51   continue
 469 c
 470         endif
 471 #ifdef _DEBUG_HOMARD_
 472         call gmprsx ( nompro, taopts(27) )
 473 #endif
 474 c
 475       endif
 476 c
 477 c====
 478 c 6. Conversion de la description de la geometrie analytique
 479 c    Il faut normaliser les axes ; on ne le fait pas avant pour
 480 c    avoir un affichage conforme a la donnee de l'utilisateur
 481 c====
 482 #ifdef _DEBUG_HOMARD_
 483       write (ulsort,90002) '6. Conversion geometrie ; codret', codret
 484 #endif
 485 c
 486       if ( nbarfr.gt.0 .and. mod(taopti(29),3).eq.0 ) then
 487 c
 488         if ( codret.eq.0 ) then
 489 c
 490         call gmadoj ( ncafar, adcafr, jaux, codret )
 491 c
 492         endif
 493 c
 494         if ( codret.eq.0 ) then
 495 c
 496         jaux = jaux/13
 497 #ifdef _DEBUG_HOMARD_
 498       write (ulsort,texte(langue,3)) 'SFCOI1', nompro
 499 #endif
 500         call sfcoi1 ( jaux, rmem(adcafr),
 501      >                ulsort, langue, codret)
 502 c
 503         endif
 504 c
 505       endif
 506 c
 507 c====
 508 c 7. Conversion de la description de la geometrie discrete
 509 c====
 510 #ifdef _DEBUG_HOMARD_
 511       write (ulsort,90002) '7. Conversion geometrie ; codret', codret
 512       write (ulsort,90002) 'taopti(29)', taopti(29)
 513       write (ulsort,90002) 'nbfrdi', nbfrdi
 514       write (ulsort,90002) 'nbarfr', nbarfr
 515 #endif
 516 c
 517       if ( taopti(29).lt.0 .and. mod(taopti(29),2).eq.0 .and.
 518      >     nbfrdi.gt.0 .and. nbarfr.gt.0 ) then
 519 c
 520         if ( codret.eq.0 ) then
 521 c
 522 #ifdef _DEBUG_HOMARD_
 523       write (ulsort,texte(langue,3)) 'SFCONV', nompro
 524 #endif
 525         call sfconv ( lgopti, taopti, lgopts, taopts,
 526      >                lgetco, taetco,
 527      >                ulsort, langue, codret)
 528 c
 529         endif
 530 c
 531         if ( codret.eq.0 ) then
 532 c
 533         nocdfr = taopts(16)
 534 c
 535         call gmadoj ( nocdfr//'.CoorNoeu', pgeoco, iaux, codre1 )
 536         call gmadoj ( nocdfr//'.PtrSomLi', psegli, iaux, codre2 )
 537         call gmadoj ( nocdfr//'.SommSegm', psomse, iaux, codre3 )
 538         call gmadoj ( nocdfr//'.AbsCurvi', adabsc, iaux, codre4 )
 539 c
 540         codre0 = min ( codre1, codre2, codre3, codre4 )
 541         codret = max ( abs(codre0), codret,
 542      >                 codre1, codre2, codre3, codre4 )
 543 c
 544         endif
 545 c
 546       endif
 547 c
 548 c====
 549 c 8. Quand on est parti d'un macro-maillage : inhibition du suivi
 550 c    de frontiere sur les lignes droites
 551 c====
 552 c
 553 #ifdef _DEBUG_HOMARD_
 554       write (ulsort,90002) '8. lignes droites ; codret', codret
 555 #endif
 556 c
 557       if ( nbfrdi.gt.0 .and. nbarfr.gt.0 ) then
 558 c
 559         if ( taopti(10).eq.0 ) then
 560 c
 561           if ( codret.eq.0 ) then
 562 c
 563 #ifdef _DEBUG_HOMARD_
 564           write (ulsort,texte(langue,3)) 'SFINDR', nompro
 565 #endif
 566           call sfindr ( imem(psegli), imem(pcfaar), imem(pfamar),
 567      >                  lgetco, taetco,
 568      >                  ulsort, langue, codret )
 569 c
 570           endif
 571 c
 572         endif
 573 c
 574       endif
 575 c
 576 c====
 577 c 9. Quand on est parti d'un macro-maillage : determination du
 578 c    comportement en degre 2
 579 c====
 580 #ifdef _DEBUG_HOMARD_
 581       write (ulsort,90002) '9. degre 2 ; codret', codret
 582 #endif
 583 c
 584       if ( taopti(10).eq.0 ) then
 585 c
 586         if ( codret.eq.0 ) then
 587 c
 588 c 9.1. ==> en degre 1, c'est simple
 589 c
 590         if ( degre.eq.1 ) then
 591 c
 592           typsfr = 1
 593 c
 594 c 9.2. ==> en degre 2, tout depent de la position initiale des noeuds P2
 595 c
 596         else
 597 c
 598 #ifdef _DEBUG_HOMARD_
 599         write (ulsort,texte(langue,3)) 'SFPOP2', nompro
 600 #endif
 601           call sfpop2 ( typsfr,
 602      >                  rmem(pcoono),
 603      >                  imem(psomar), imem(pnp2ar),
 604      >                  imem(pcfaar), imem(pfamar),
 605      >                  lgetco, taetco,
 606      >                  ulsort, langue, codret)
 607 c
 608         endif
 609 c
 610         if ( codret.eq.0 ) then
 611         call gmecat ( nomail, 10, typsfr, codret )
 612         endif
 613 c
 614         endif
 615 c
 616       endif
 617 c
 618 c====
 619 c 10. Noeuds initiaux et frontiere
 620 c     Attention : sfcaf1 et sfcoin doivent etre coherents
 621 c====
 622 #ifdef _DEBUG_HOMARD_
 623       write (ulsort,90002) '10. Noeuds ini / frontiere ; codret', codret
 624 #endif
 625 c
 626       if ( taopti(10).eq.0 ) then
 627 c
 628       if ( taopti(29).lt.0 .and. nbfrdi.gt.0 ) then
 629 c
 630 cgn      call gmprot(nompro,nhnoeu//'.Coor',115,115)
 631 c
 632         if ( codret.eq.0 ) then
 633 c
 634         unst2x = 1.d0 / rmem(adcocs+10)**2
 635 c
 636 #ifdef _DEBUG_HOMARD_
 637       write (ulsort,texte(langue,3)) 'SFNOFL', nompro
 638 #endif
 639         call sfnofl ( ntrav1, ntrav2, ntrav3,
 640      >                adnuno, adlino, adacno,
 641      >                unst2x, epsid2,
 642      >                rmem(pcoono),
 643      >                imem(psomar), imem(phetar), imem(pfilar),
 644      >                imem(pnp2ar),
 645      >                imem(pcfaar), imem(pfamar),
 646      >                rmem(pgeoco), rmem(adabsc),
 647      >                imem(psomse), imem(psegli),
 648      >                lgetco, taetco,
 649      >                ulsort, langue, codret )
 650 c
 651         endif
 652 c
 653       endif
 654 c
 655       endif
 656 c
 657 cgn      call gmprot(nompro,nhnoeu//'.Coor',115,115)
 658 c
 659 c====
 660 c 11. La fin
 661 c====
 662 c
 663       if ( codret.eq.0 ) then
 664 c
 665       taopti(29) = abs(taopti(29))
 666 c
 667       endif
 668 c
 669 c====
 670 c 12. La fin
 671 c====
 672 c
 673       if ( codret.ne.0 ) then
 674 c
 675 #include "envex2.h"
 676 c
 677       write (ulsort,texte(langue,1)) 'Sortie', nompro
 678       write (ulsort,texte(langue,2)) codret
 679 c
 680       endif
 681 c
 682 #ifdef _DEBUG_HOMARD_
 683       write (ulsort,texte(langue,1)) 'Sortie', nompro
 684       call dmflsh (iaux)
 685 #endif
 686 c
 687       end