src/tool/Suivi_Frontiere/sfcot1.F

   1       subroutine sfcot1 ( nbcoqu, nbcoar,
   2      >                    coonoe,
   3      >                    somare, filare, np2are,
   4      >                    cfaare, famare,
   5      >                    facare, posifa,
   6      >                    hettri, aretri, filtri,
   7      >                    hetqua, arequa, filqua,
   8      >                    cfaqua, famqua,
   9      >                    tritet, cotrte, aretet,
  10      >                    hettet, filtet,
  11      >                    quahex, coquhe, arehex,
  12      >                    hethex, filhex,
  13      >                    voltri, pypetr,
  14      >                    volqua, pypequ,
  15      >                    nbarfr, arefro,
  16      >                    nbqufr, quafro,
  17      >                    ulsort, langue, codret)
  18 c ______________________________________________________________________
  19 c                             H O M A R D
  20 c
  21 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  22 c
  23 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  24 c aupres des huissiers de justice Simart et Lavoir a Clamart
  25 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  26 c aupres des huissiers de justice
  27 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  28 c
  29 c    HOMARD est une marque deposee d'Electricite de France
  30 c
  31 c Copyright EDF 1996
  32 c Copyright EDF 1998
  33 c Copyright EDF 2002
  34 c Copyright EDF 2020
  35 c ______________________________________________________________________
  36 c
  37 c   Suivi de Frontiere - COnTroles - phase 1
  38 c   -        -           -- -              -
  39 c ______________________________________________________________________
  40 c .        .     .        .                                            .
  41 c .  nom   . e/s . taille .           description                      .
  42 c .____________________________________________________________________.
  43 c . nbcoqu .   s .   1    . nombre de corrections pour les quadrangles .
  44 c . nbcoar .   s .   1    . nombre de corrections pour les aretes      .
  45 c . coonoe . es  . nbnoto . coordonnees des noeuds                     .
  46 c .        .     . *sdim  .                                            .
  47 c . somare . e   .2*nbarto. numeros des extremites d'arete             .
  48 c . filare . e   . nbarto . premiere fille des aretes                  .
  49 c . np2are . e   . nbarto . noeud milieux des aretes                   .
  50 c . cfaare . e   . nctfar*. codes des familles des aretes              .
  51 c .        .     . nbfare .   1 : famille MED                          .
  52 c .        .     .        .   2 : type de segment                      .
  53 c .        .     .        .   3 : orientation                          .
  54 c .        .     .        .   4 : famille d'orientation inverse        .
  55 c .        .     .        .   5 : numero de ligne de frontiere         .
  56 c .        .     .        .  > 0 si concernee par le suivi de frontiere.
  57 c .        .     .        . <= 0 si non concernee                      .
  58 c .        .     .        .   6 : famille frontiere active/inactive    .
  59 c .        .     .        .   7 : numero de surface de frontiere       .
  60 c .        .     .        . + l : appartenance a l'equivalence l       .
  61 c . famare . e   . nbarto . famille des aretes                         .
  62 c . facare . e   . nbfaar . liste des faces contenant une arete        .
  63 c . posifa . e   . nbarto . pointeur sur tableau facare                .
  64 c . hettri . e   . nbtrto . historique de l'etat des triangles         .
  65 c . aretri . e   .nbtrto*3. numeros des 3 aretes des triangles         .
  66 c . filtri . e   . nbtrto . premier fils des triangles                 .
  67 c . hetqua . e   . nbquto . historique de l'etat des quadrangles       .
  68 c . arequa . e   .nbquto*4. numeros des 4 aretes des quadrangles       .
  69 c . filqua . e   . nbquto . premier fils des quadrangles               .
  70 c . cfaqua . e   . nctfqu*. codes des familles des quadrangles         .
  71 c .        .     . nbfqua .   1 : famille MED                          .
  72 c .        .     .        .   2 : type de quadrangle                   .
  73 c .        .     .        .   3 : numero de surface de frontiere       .
  74 c .        .     .        .   4 : famille des aretes internes apres raf.
  75 c .        .     .        .   5 : famille des triangles de conformite  .
  76 c .        .     .        .   6 : famille de sf active/inactive        .
  77 c .        .     .        . + l : appartenance a l'equivalence l       .
  78 c . famqua . e   . nbquto . famille des quadrangles                    .
  79 c . tritet . e   .nbtecf*4. numeros des triangles des tetraedres       .
  80 c . cotrte . e   .nbtecf*4. codes des triangles des tetraedres         .
  81 c . aretet . e   .nbteca*6. numeros des 6 aretes des tetraedres        .
  82 c . hettet . e   . nbteto . historique de l'etat des tetraedres        .
  83 c . filtet . e   . nbteto . premier fils des tetraedres                .
  84 c . quahex . e   .nbhecf*6. numeros des 6 quadrangles des hexaedres    .
  85 c . coquhe . e   .nbhecf*6. codes des 6 quadrangles des hexaedres      .
  86 c . arehex . e   .nbheca12. numeros des 12 aretes des hexaedres        .
  87 c . hethex . e   . nbheto . historique de l'etat des hexaedres         .
  88 c . filhex . e   . nbheto . premier fils des hexaedres                 .
  89 c . voltri . e   .2*nbtrto. numeros des 2 volumes par triangle         .
  90 c .        .     .        . voltri(i,k) definit le i-eme voisin de k   .
  91 c .        .     .        .   0 : pas de voisin                        .
  92 c .        .     .        . j>0 : tetraedre j                          .
  93 c .        .     .        . j<0 : pyramide/pentaedre dans pypetr(1/2,j).
  94 c . pypetr . e   .2*lgpype. pypetr(1,j) = numero de la pyramide voisine.
  95 c .        .     .        . du triangle k tel que voltri(1/2,k) = -j   .
  96 c .        .     .        . pypetr(2,j) = numero du pentaedre voisin   .
  97 c .        .     .        . du triangle k tel que voltri(1/2,k) = -j   .
  98 c . volqua . e   .2*nbquto. numeros des 2 volumes par quadrangle       .
  99 c .        .     .        . volqua(i,k) definit le i-eme voisin de k   .
 100 c .        .     .        .   0 : pas de voisin                        .
 101 c .        .     .        . j>0 : hexaedre j                           .
 102 c .        .     .        . j<0 : pyramide/pentaedre dans pypequ(1/2,j).
 103 c . pypequ . e   .2*lgpype. pypequ(1,j) = numero de la pyramide voisine.
 104 c .        .     .        . du quadrangle k tel que volqua(1/2,k) = -j .
 105 c .        .     .        . pypequ(2,j) = numero du pentaedre voisin   .
 106 c .        .     .        . du quadrangle k tel que volqua(1/2,k) = -j .
 107 c . nbarfr . e   .   1    . nombre d'aretes concernees                 .
 108 c . arefro . es  . nbarfr . liste des aretes concernees                .
 109 c . nbqufr . e   .   1    . nombre de quadrangles concernes            .
 110 c . quafro . es  . nbqufr . liste des quadrangles concernes            .
 111 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
 112 c . langue . e   .    1   . langue des messages                        .
 113 c .        .     .        . 1 : francais, 2 : anglais                  .
 114 c . codret . es  .    1   . code de retour des modules                 .
 115 c .        .     .        . 0 : pas de probleme                        .
 116 c .        .     .        . x : probleme                               .
 117 c ______________________________________________________________________
 118 c
 119 c====
 120 c 0. declarations et dimensionnement
 121 c====
 122 c
 123 c 0.1. ==> generalites
 124 c
 125       implicit none
 126       save
 127 c
 128       character*6 nompro
 129       parameter ( nompro = 'SFCOT1' )
 130 c
 131 #include "nblang.h"
 132 #include "tbdim0.h"
 133 c
 134 c 0.2. ==> communs
 135 c
 136 #include "envex1.h"
 137 c
 138 #include "envca1.h"
 139 #include "dicfen.h"
 140 #include "nbfami.h"
 141 #include "nombno.h"
 142 #include "nombar.h"
 143 #include "nombqu.h"
 144 #include "nombtr.h"
 145 #include "nombte.h"
 146 #include "nombhe.h"
 147 #include "nombpy.h"
 148 #include "nombpe.h"
 149 #include "impr02.h"
 150 c
 151 c 0.3. ==> arguments
 152 c
 153       integer nbcoar, nbcoqu
 154       integer somare(2,nbarto), filare(nbarto), np2are(nbarto)
 155       integer posifa(0:nbarto), facare(nbfaar)
 156       integer cfaare(nctfar,nbfare), famare(nbarto)
 157       integer hettri(nbtrto), aretri(nbtrto,3), filtri(nbtrto)
 158       integer hetqua(nbquto), arequa(nbquto,4), filqua(nbquto)
 159       integer cfaqua(nctfqu,nbfqua), famqua(nbquto)
 160       integer tritet(nbtecf,4), cotrte(nbtecf,4), aretet(nbteca,6)
 161       integer hettet(nbteto)
 162       integer filtet(nbteto)
 163       integer quahex(nbhecf,6), coquhe(nbhecf,6), arehex(nbheca,12)
 164       integer hethex(nbheto)
 165       integer filhex(nbheto)
 166       integer voltri(2,nbtrto), pypetr(2,*)
 167       integer volqua(2,nbquto), pypequ(2,*)
 168       integer nbarfr, arefro(nbarfr)
 169       integer nbqufr, quafro(nbqufr)
 170 c
 171       double precision coonoe(nbnoto,sdim)
 172 c
 173       integer ulsort, langue, codret
 174 c
 175 c 0.4. ==> variables locales
 176 c
 177       integer iaux, jaux
 178 c
 179       integer larete, lequad, laface
 180       integer nuarfr, nuqufr
 181       integer nbexam, examno(2), examar(2)
 182       integer nufade, nufafi, decafv
 183       integer nbvoto
 184       integer nbtetr, nbhexa, nbpyra, nbpent
 185       integer lisvoi(tbdim)
 186       integer bilan, nbbato
 187       integer libasc(tbdim), nbbasc
 188 c
 189       integer nbmess
 190       parameter ( nbmess = 20 )
 191       character*80 texte(nblang,nbmess)
 192 c
 193 c 0.5. ==> initialisations
 194 c ______________________________________________________________________
 195 c
 196 c====
 197 c 1. initialisations
 198 c====
 199 c
 200 c 1.1. ==> les messages
 201 c
 202 #include "impr01.h"
 203 c
 204 #ifdef _DEBUG_HOMARD_
 205       write (ulsort,texte(langue,1)) 'Entree', nompro
 206       call dmflsh (iaux)
 207 #endif
 208 c
 209       texte(1,7) = '(/,''. Examen du '',a,i10)'
 210       texte(1,8) =
 211      >'(''==> Nombre de corrections de noeuds lies a des '',a,'':'',
 212      >i10)'
 213       texte(1,9) = '(''==> Tout va bien.'')'
 214       texte(1,10) = '(''Nombre de '',a,''concernes :'',i10)'
 215       texte(1,11) = '(''Nombre de '',a,'' a basculer :'',i10)'
 216       texte(1,12) = '(''... Reprise du '',a,i10)'
 217 c
 218       texte(2,7) = '(/,''. Examination of '',a,'' # '',i10)'
 219       texte(2,8) =
 220      >'(''==> Number of corrections of nodes connected to '',a,'':'',
 221      >i10)'
 222       texte(2,9) = '(''==> Everything is OK.'')'
 223       texte(2,10) = '(''Number of involved '',a,'':'',i10)'
 224       texte(2,11) = '(''Number of '',a,'' to swap :'',i10)'
 225       texte(2,12) = '(''... Correction of '',a,i10)'
 226 c
 227 #include "impr03.h"
 228 c
 229       codret = 0
 230 c
 231       nbcoar = 0
 232       nbcoqu = 0
 233       nbbato = 0
 234 c
 235       nbvoto = nbteto + nbheto + nbpyto + nbpeto
 236 c
 237 #ifdef _DEBUG_HOMARD_
 238       write (ulsort,90002) 'typsfr', typsfr
 239 #endif
 240 c
 241 c====
 242 c 2. Boucle sur les quadrangles qui viennent d'etre decoupes et
 243 c    qui font partie d'une frontiere reconnue
 244 c====
 245 #ifdef _DEBUG_HOMARD_
 246       write (ulsort,90002) '2. boucle quadrangles ; codret', codret
 247 #endif
 248 c
 249 #ifdef _DEBUG_HOMARD_
 250       write (ulsort,texte(langue,10)) mess14(langue,3,4), nbqufr
 251 #endif
 252 c
 253       nbtetr = 0
 254 c
 255       do 21 , nuqufr = 1 , nbqufr
 256 c
 257 c 2.1. ==> Elimination des situations ou il est inutile
 258 c          de controler car le quadrangle a deja ete ramene
 259 c
 260         lequad = quafro(nuqufr)
 261 c
 262         if ( lequad.le.0 ) then
 263           goto 21
 264         endif
 265 c
 266 c 2.2. ==> Reperage des situations a examiner :
 267 c          . le noeud central du quadrangle decoupe
 268 c          . les noeuds P2 courbes : a faire
 269 c          ce noeud central est la seconde extremite de la 2eme ou 3eme
 270 c          arete de l'un quelconque des quadrangles fils (cf. cmrdqu)
 271 c
 272         if ( codret.eq.0 ) then
 273 c
 274         if ( typsfr.le.2 ) then
 275           nbexam = 1
 276           larete = arequa(filqua(lequad),2)
 277           examno(1) = somare(2,larete)
 278         else
 279           codret = 22
 280         endif
 281 c
 282         endif
 283 c
 284 c 2.3. ==> Examen
 285 c
 286         if ( codret.eq.0 ) then
 287 c
 288 #ifdef _DEBUG_HOMARD_
 289       write (ulsort,texte(langue,7)) mess14(langue,1,4), lequad
 290 #endif
 291 c
 292         do 23 , iaux = 1 , nbexam
 293 c
 294           bilan = 0
 295 c
 296 c 2.3.1. ==> Controle des volumes s'appuyant sur ce quadrangle
 297 c
 298           if ( nbvoto.ne.0 ) then
 299 c
 300             if ( codret.eq.0 ) then
 301 c
 302 #ifdef _DEBUG_HOMARD_
 303       write (ulsort,texte(langue,3)) 'UTVGVQ', nompro
 304 #endif
 305             call utvgvq ( lequad,
 306      >                    volqua, pypequ,
 307      >                    nbhexa, nbpyra, nbpent,
 308      >                    lisvoi,
 309      >                    ulsort, langue, codret )
 310 c
 311             endif
 312 c
 313             if ( codret.eq.0 ) then
 314 c
 315             decafv = 2
 316 c
 317 #ifdef _DEBUG_HOMARD_
 318       write (ulsort,texte(langue,3)) 'SFCOVO', nompro
 319 #endif
 320             call sfcovo ( bilan,
 321      >                    nbtetr, nbhexa, nbpyra, nbpent,
 322      >                    decafv, lisvoi,
 323      >                    coonoe,
 324      >                    somare,
 325      >                    aretri,
 326      >                    arequa,
 327      >                    tritet, cotrte, aretet,
 328      >                    hettet, filtet,
 329      >                    quahex, coquhe, arehex,
 330      >                    hethex, filhex,
 331      >                    ulsort, langue, codret)
 332 c
 333             endif
 334 c
 335             if ( codret.eq.0 ) then
 336 c
 337             if ( bilan.ne.0 ) then
 338               goto 232
 339             endif
 340 c
 341             endif
 342 c
 343           endif
 344 c
 345 c 2.3.2. ==> Corrections eventuelles
 346 c
 347   232     continue
 348 c
 349           if ( codret.eq.0 ) then
 350 c
 351           if ( bilan.ne.0 ) then
 352 c
 353 #ifdef _DEBUG_HOMARD_
 354       write (ulsort,texte(langue,12)) mess14(langue,1,-1), examno(iaux)
 355 #endif
 356 c
 357             nbcoqu = nbcoqu + 1
 358             quafro(nuqufr) = -lequad
 359             jaux = 0
 360 #ifdef _DEBUG_HOMARD_
 361       write (ulsort,texte(langue,3)) 'UTCORN_quadrangle', nompro
 362 #endif
 363             call utcorn ( examno(iaux), lequad, jaux,
 364      >                    coonoe,
 365      >                    somare, filare,
 366      >                    cfaare, famare,
 367      >                    arequa, filqua,
 368      >                    cfaqua, famqua,
 369      >                    ulsort, langue, codret)
 370 c
 371           endif
 372 c
 373           endif
 374 c
 375    23   continue
 376 c
 377         endif
 378 c
 379    21 continue
 380 c
 381 c====
 382 c 3. Boucle sur les aretes qui viennent d'etre decoupees et
 383 c    qui font partie d'une frontiere reconnue
 384 c====
 385 #ifdef _DEBUG_HOMARD_
 386       write (ulsort,90002) '3. boucle aretes ; codret', codret
 387 #endif
 388 c
 389 #ifdef _DEBUG_HOMARD_
 390       write (ulsort,texte(langue,10)) mess14(langue,3,1), nbarfr
 391 #endif
 392 c
 393       do 31 , nuarfr = 1 , nbarfr
 394 c
 395 c 3.1. ==> Elimination des situations ou il est inutile
 396 c          de controler car l'arete a deja ete ramenee
 397 c
 398         if ( codret.eq.0 ) then
 399 c
 400         larete = arefro(nuarfr)
 401 c
 402         if ( larete.le.0 ) then
 403           goto 31
 404         endif
 405 c
 406         endif
 407 c
 408 c 3.2. ==> Reperage des situations a examiner :
 409 c          . le noeud milieu de l'arete decoupee ou
 410 cgnc          . les noeuds P2 courbes
 411 c
 412         if ( codret.eq.0 ) then
 413 c
 414 cgn        if ( typsfr.le.2 ) then
 415           nbexam = 1
 416           examar(1) = larete
 417           examno(1) = somare(2,filare(examar(1)))
 418 cgn        else
 419 cgn          nbexam = 2
 420 cgn          examar(1) = filare(larete)
 421 cgn          examno(1) = np2are(examar(1))
 422 cgn          examar(2) = examar(1) + 1
 423 cgn          examno(2) = np2are(examar(2))
 424 cgn        endif
 425 c
 426         endif
 427 c
 428 c 3.3. ==> Examen
 429 c
 430         if ( codret.eq.0 ) then
 431 c
 432         do 33 , iaux = 1 , nbexam
 433 c
 434 c 3.3.1. ==> Faces s'appuyant sur l'arete : s'il n'y en a pas, on
 435 c            passe a la suite
 436 c
 437           nufade = posifa(examar(iaux)-1) + 1
 438           nufafi = posifa(examar(iaux))
 439 c
 440           if ( nufafi.lt.nufade ) then
 441             goto 33
 442           endif
 443 c
 444           bilan = 0
 445 c
 446 #ifdef _DEBUG_HOMARD_
 447       write (ulsort,texte(langue,7)) mess14(langue,1,1), examar(iaux)
 448 #endif
 449 c
 450 c 3.3.2. ==> Controle des volumes s'appuyant sur cette arete
 451 c
 452           if ( nbvoto.ne.0 ) then
 453 c
 454             if ( codret.eq.0 ) then
 455 c
 456 #ifdef _DEBUG_HOMARD_
 457       write (ulsort,texte(langue,3)) 'UTVGVA', nompro
 458 #endif
 459             call utvgv1 ( nufade, nufafi,
 460      >                    voltri, pypetr,
 461      >                    volqua, pypequ,
 462      >                    nbtetr, nbhexa, nbpyra, nbpent,
 463      >                    lisvoi, facare,
 464      >                    ulsort, langue, codret )
 465 c
 466             endif
 467 c
 468             if ( codret.eq.0 ) then
 469 c
 470             decafv = 2 * ( nufafi - nufade + 1 )
 471 c
 472 #ifdef _DEBUG_HOMARD_
 473       write (ulsort,texte(langue,3)) 'SFCOVO', nompro
 474 #endif
 475             call sfcovo ( bilan,
 476      >                    nbtetr, nbhexa, nbpyra, nbpent,
 477      >                    decafv, lisvoi,
 478      >                    coonoe,
 479      >                    somare,
 480      >                    aretri,
 481      >                    arequa,
 482      >                    tritet, cotrte, aretet,
 483      >                    hettet, filtet,
 484      >                    quahex, coquhe, arehex,
 485      >                    hethex, filhex,
 486      >                    ulsort, langue, codret)
 487 c
 488             endif
 489 c
 490             if ( codret.eq.0 ) then
 491 c
 492             if ( bilan.ne.0 ) then
 493               goto 334
 494             endif
 495 c
 496             endif
 497 c
 498           endif
 499 c
 500 c 3.3.3. ==> Controle des surfaces vraiment 2D s'appuyant sur l'arete
 501 c
 502           if ( codret.eq.0 ) then
 503 c
 504 #ifdef _DEBUG_HOMARD_
 505       write (ulsort,texte(langue,3)) 'SFCOFA', nompro
 506 #endif
 507 c
 508           call sfcofa ( bilan, nbbasc, libasc,
 509      >                  examno(iaux), examar(iaux),
 510      >                  nufade, nufafi, nbvoto,
 511      >                  coonoe,
 512      >                  somare, filare, np2are,
 513      >                  facare,
 514      >                  hettri, aretri,
 515      >                  voltri,
 516      >                  hetqua, arequa, filqua,
 517      >                  volqua,
 518      >                  ulsort, langue, codret)
 519 c
 520           endif
 521 c
 522 #ifdef _DEBUG_HOMARD_
 523           if ( codret.eq.0 ) then
 524           write (ulsort,texte(langue,11)) mess14(langue,3,1), nbbasc
 525           endif
 526 #endif
 527 c
 528 c 3.3.4. ==> Corrections eventuelles
 529 c
 530   334     continue
 531 c
 532 c 3.3.4.1. ==> Retour au milieu
 533 c
 534           if ( codret.eq.0 ) then
 535 c
 536           if ( bilan.ne.0 ) then
 537 c
 538 #ifdef _DEBUG_HOMARD_
 539       write (ulsort,texte(langue,12)) mess14(langue,1,-1), examno(iaux)
 540 #endif
 541 c
 542             nbcoar = nbcoar + 1
 543             arefro(nuarfr) = -larete
 544             jaux = 0
 545 #ifdef _DEBUG_HOMARD_
 546       write (ulsort,texte(langue,3)) 'UTCORN_arete', nompro
 547 #endif
 548             call utcorn ( examno(iaux), jaux, larete,
 549      >                    coonoe,
 550      >                    somare, filare,
 551      >                    cfaare, famare,
 552      >                    arequa, filqua,
 553      >                    cfaqua, famqua,
 554      >                    ulsort, langue, codret)
 555 c
 556           endif
 557 c
 558           endif
 559 c
 560 c 3.3.4.2. ==> On fait les basculements d'aretes necessaires
 561 c
 562           if ( codret.eq.0 ) then
 563 c
 564           nbbato = nbbato + nbbasc
 565 c
 566           do 3342 , jaux = 1 , nbbasc
 567 c
 568             laface = libasc(jaux)
 569 c
 570 #ifdef _DEBUG_HOMARD_
 571       write (ulsort,texte(langue,3)) 'SFBATR', nompro
 572 #endif
 573             call sfbatr ( examno(iaux), examar(iaux), laface,
 574      >                    somare,
 575      >                    facare, posifa,
 576      >                    hettri, aretri, filtri,
 577      >                    ulsort, langue, codret)
 578 c
 579  3342     continue
 580 c
 581           endif
 582 c
 583    33   continue
 584 c
 585         endif
 586 c
 587    31 continue
 588 c
 589 c====
 590 c 4. La fin
 591 c====
 592 c
 593 #ifdef _DEBUG_HOMARD_
 594       if ( (nbcoqu+nbcoar).eq.0 ) then
 595         write (ulsort,texte(langue,9))
 596       else
 597         if ( nbcoqu.gt.0 ) then
 598           write (ulsort,texte(langue,8)) mess14(langue,3,4), nbcoqu
 599         endif
 600         if ( nbcoar.gt.0 ) then
 601           write (ulsort,texte(langue,8)) mess14(langue,3,1), nbcoar
 602         endif
 603       endif
 604 #endif
 605 c
 606       if ( nbbato.gt.0 ) then
 607         write (ulsort,texte(langue,11)) mess14(langue,3,1), nbbato
 608       endif
 609 c
 610       if ( codret.ne.0 ) then
 611 c
 612 #include "envex2.h"
 613 c
 614       write (ulsort,texte(langue,1)) 'Sortie', nompro
 615       write (ulsort,texte(langue,2)) codret
 616 c
 617       endif
 618 c
 619 #ifdef _DEBUG_HOMARD_
 620       write (ulsort,texte(langue,1)) 'Sortie', nompro
 621       call dmflsh (iaux)
 622 #endif
 623 c
 624       end