src/tool/ES_HOMARD/eslefe.F

   1       subroutine eslefe ( idfmed, nomamd,
   2      >                    nhnoeu, nhmapo, nharet, nhtria, nhquad,
   3      >                    nhtetr, nhhexa, nhpyra, nhpent,
   4      >                    nhsups,
   5      >                    ltbsau, tbsaux,
   6      >                    ulsort, langue, codret)
   7 c
   8 c ______________________________________________________________________
   9 c
  10 c                             H O M A R D
  11 c
  12 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  13 c
  14 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  15 c aupres des huissiers de justice Simart et Lavoir a Clamart
  16 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  17 c aupres des huissiers de justice
  18 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  19 c
  20 c    HOMARD est une marque deposee d'Electricite de France
  21 c
  22 c Copyright EDF 1996
  23 c Copyright EDF 1998
  24 c Copyright EDF 2002
  25 c Copyright EDF 2020
  26 c ______________________________________________________________________
  27 c
  28 c  Entree-Sortie : LEcture des Familles des Entites
  29 c  -      -        --          -            -
  30 c ______________________________________________________________________
  31 c .  nom   . e/s . taille .           description                      .
  32 c .____________________________________________________________________.
  33 c . idfmed . e   .   1    . identificateur du fichier MED              .
  34 c . nomamd . e   . char64 . nom du maillage MED voulu                  .
  35 c . nhsups . e   . char*8 . informations supplementaires caracteres 8  .
  36 c . ltbsau . e   .    1   . longueur allouee a tbsaux                  .
  37 c . tbsaux .     .    *   . tableau tampon caracteres                  .
  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 .        .     .        . 0 : pas de probleme                        .
  43 c ______________________________________________________________________
  44 c
  45 c====
  46 c 0. declarations et dimensionnement
  47 c====
  48 c
  49 c 0.1. ==> generalites
  50 c
  51       implicit none
  52       save
  53 c
  54       character*6 nompro
  55       parameter ( nompro = 'ESLEFE' )
  56 c
  57 #include "nblang.h"
  58 #include "consts.h"
  59 c
  60 c 0.2. ==> communs
  61 c
  62 #include "envex1.h"
  63 c
  64 #include "gmenti.h"
  65 #include "gmstri.h"
  66 c
  67 #include "dicfen.h"
  68 #include "nbfami.h"
  69 #include "envca2.h"
  70 c
  71 #include "enti01.h"
  72 #include "impr02.h"
  73 c
  74 c 0.3. ==> arguments
  75 c
  76       integer*8 idfmed
  77       integer ltbsau
  78 c
  79       character*8 tbsaux(ltbsau)
  80       character*8 nhnoeu, nhmapo, nharet, nhtria, nhquad
  81       character*8 nhsups
  82       character*8 nhtetr, nhhexa, nhpyra, nhpent
  83       character*64 nomamd
  84 c
  85       integer ulsort, langue, codret
  86 c
  87 c 0.4. ==> variables locales
  88 c
  89 #include "meddc0.h"
  90 c
  91       integer nbgrox
  92       parameter (nbgrox = 10000 )
  93 c
  94       integer iaux, jaux, kaux
  95       integer cptr, kdeb, kfin, reste
  96       integer typenh
  97       integer nbfmed, nrofam, numfam, natt, ngro
  98       integer adress, nbval
  99       integer codre0
 100       integer codre1, codre2
 101       integer adcono, adcomp, adcoar, adcotr, adcoqu
 102       integer adcote, adcopy, adcohe, adcope
 103       integer adcoen
 104       integer adnogr, lgnogr
 105       integer numtab, numgro
 106 c
 107       character*8 nhenti
 108       character*8 ntnogr
 109       character*32 saux32
 110       character*80 nomgro
 111       character*64 nomfam
 112 c
 113       integer nbmess
 114       parameter ( nbmess = 150 )
 115       character*80 texte(nblang,nbmess)
 116 c ______________________________________________________________________
 117 c
 118 c====
 119 c 1. initialisations
 120 c====
 121 c 1.1. ==> messages
 122 c
 123 #include "impr01.h"
 124 c
 125 #ifdef _DEBUG_HOMARD_
 126       write (ulsort,texte(langue,1)) 'Entree', nompro
 127       call dmflsh (iaux)
 128 #endif
 129 c
 130 #include "esimpr.h"
 131 c
 132       texte(1,4) = '(''. Lecture des familles'')'
 133       texte(1,6) = '(''Allongement de nomgro.'')'
 134       texte(1,81) = '(''Longueur allouee pour tbsaux    : '',i10)'
 135       texte(1,82) = '(''Longueur necessaire pour tbsaux : '',i10)'
 136 c
 137       texte(2,4) = '(''. Readings of families'')'
 138       texte(2,6) = '(''Extension of nomgro.'')'
 139       texte(2,81) = '(''Allocated length for tbsaux    : '',i10)'
 140       texte(2,82) = '(''Used length for tbsaux : '',i10)'
 141 c
 142 #include "impr03.h"
 143 c
 144  1002 format(10(a8,'+'))
 145  1003 format(a80,'+')
 146 c
 147 #ifdef _DEBUG_HOMARD_
 148       write (ulsort,texte(langue,4))
 149 #endif
 150 c
 151       codret = 0
 152 c
 153 c====
 154 c 2. Preparatifs
 155 c====
 156 #ifdef _DEBUG_HOMARD_
 157       write (ulsort,90002) '2. Preparatifs ; codret', codret
 158 #endif
 159 c
 160       do 21 , typenh = -1 , 7
 161 c
 162         if ( codret.eq.0 ) then
 163 c
 164         if ( typenh.eq.-1 ) then
 165           nhenti = nhnoeu
 166           iaux = nbfnoe
 167         elseif ( typenh.eq.0 ) then
 168           nhenti = nhmapo
 169           iaux = nbfmpo
 170        elseif ( typenh.eq.1 ) then
 171           nhenti = nharet
 172           iaux = nbfare
 173         elseif ( typenh.eq.2 ) then
 174           nhenti = nhtria
 175           iaux = nbftri
 176         elseif ( typenh.eq.3 ) then
 177           nhenti = nhtetr
 178           iaux = nbftet
 179         elseif ( typenh.eq.4 ) then
 180           nhenti = nhquad
 181           iaux = nbfqua
 182         elseif ( typenh.eq.5 ) then
 183           nhenti = nhpyra
 184           iaux = nbfpyr
 185         elseif ( typenh.eq.6 ) then
 186           nhenti = nhhexa
 187           iaux = nbfhex
 188         else
 189           nhenti = nhpent
 190           iaux = nbfpen
 191         endif
 192 c
 193         if ( iaux.gt.0 ) then
 194 c
 195 #ifdef _DEBUG_HOMARD_
 196           write (ulsort,*) ' '
 197           write (ulsort,*) mess14(langue,4,typenh)
 198           write (ulsort,90002) 'nbfent', iaux
 199 #endif
 200 c
 201           call gmadoj ( nhenti//'.Famille.Codes', adcoen, iaux, codre1 )
 202 c
 203           codret = max ( codret,
 204      >                   codre1 )
 205 c
 206         endif
 207 c
 208         endif
 209 c
 210         if ( codret.eq.0 ) then
 211 c
 212         if ( typenh.eq.-1 ) then
 213           adcono = adcoen
 214         elseif ( typenh.eq.0 ) then
 215           adcomp = adcoen
 216         elseif ( typenh.eq.1 ) then
 217           adcoar = adcoen
 218         elseif ( typenh.eq.2 ) then
 219           adcotr = adcoen
 220         elseif ( typenh.eq.3 ) then
 221           adcote = adcoen
 222         elseif ( typenh.eq.4 ) then
 223           adcoqu = adcoen
 224         elseif ( typenh.eq.5 ) then
 225           adcopy = adcoen
 226         elseif ( typenh.eq.6 ) then
 227           adcohe = adcoen
 228         else
 229           adcope = adcoen
 230         endif
 231 c
 232         endif
 233 c
 234    21 continue
 235 c
 236 ccc      write (ulsort,90002) 'adcono', adcono
 237 ccc      write (ulsort,90002) 'adcomp', adcomp
 238 ccc      write (ulsort,90002) 'adcoar', adcoar
 239 ccc      write (ulsort,90002) 'adcotr', adcotr
 240 ccc      write (ulsort,90002) 'adcote', adcote
 241 ccc      write (ulsort,90002) 'adcoqu', adcoqu
 242 ccc      write (ulsort,90002) 'adcopy', adcopy
 243 ccc      write (ulsort,90002) 'adcohe', adcohe
 244 ccc      write (ulsort,90002) 'adcope', adcope
 245 c====
 246 c 3. Nombre de familles dans le fichier
 247 c====
 248 #ifdef _DEBUG_HOMARD_
 249       write (ulsort,90002) '3. Nombre de familles ; codret', codret
 250 #endif
 251 c
 252       if ( codret.eq.0 ) then
 253 c
 254 #ifdef _DEBUG_HOMARD_
 255       write (ulsort,texte(langue,3)) 'MFANFA', nompro
 256 #endif
 257       call mfanfa ( idfmed, nomamd, nbfmed, codret )
 258 c
 259 #ifdef _DEBUG_HOMARD_
 260       write (ulsort,texte(langue,29)) nbfmed
 261 #endif
 262 c
 263       endif
 264 c
 265 c====
 266 c 4. Lecture des familles MED decrivant les familles HOMARD
 267 c====
 268 #ifdef _DEBUG_HOMARD_
 269       write (ulsort,90002) '4. Lecture des familles ; codret', codret
 270 #endif
 271 c
 272 c 4.0. ==> Allocation d'un tableau tampon pour les noms des groupes
 273 c
 274       if ( codret.eq.0 ) then
 275 c
 276       lgnogr = nbgrox*10
 277       call gmalot ( ntnogr , 'chaine  ', lgnogr, adnogr, codret )
 278 #ifdef _DEBUG_HOMARD_
 279       write(ulsort,90002) 'lgnogr', lgnogr
 280 #endif
 281 c
 282       endif
 283 c
 284       do 40 , nrofam = 1 , nbfmed
 285 #ifdef _DEBUG_HOMARD_
 286       write (ulsort,90002) 'nrofam', nrofam
 287 #endif
 288 c
 289 c 4.1. ==> Caracterisations de la famille en cours de lecture
 290 c
 291         if ( codret.eq.0 ) then
 292 c
 293 #ifdef _DEBUG_HOMARD_
 294       write (ulsort,texte(langue,3)) 'MFANFG', nompro
 295 #endif
 296         iaux = nrofam
 297         call mfanfg ( idfmed, nomamd, iaux, ngro, codret )
 298 c
 299         endif
 300 #ifdef _DEBUG_HOMARD_
 301         write(ulsort,90002) 'ngro  ', ngro
 302 #endif
 303 c
 304 c 4.2. ==> Ici, on decode les familles HOMARD
 305 c          ATTENTION : le test est severe mais il faudrait
 306 c          avoir une fonction qui ne renvoie que le nom de la famille,
 307 c          sans retourner nomgro
 308 c
 309         if ( codret.eq.0 ) then
 310 c
 311         if ( ngro.gt.nbgrox ) then
 312 #ifdef _DEBUG_HOMARD_
 313           write(ulsort,90002) 'lgnogr', lgnogr
 314           write(ulsort,90002) 'ngro  ', ngro
 315           write (ulsort,texte(langue,6))
 316 #endif
 317           iaux = ngro*10 + 100
 318           call gmmod ( ntnogr, adnogr, lgnogr, iaux, 1, 1, codret )
 319           lgnogr = iaux
 320 #ifdef _DEBUG_HOMARD_
 321           write(ulsort,90002) 'lgnogr', lgnogr
 322 #endif
 323 c
 324         endif
 325 c
 326         endif
 327 c
 328 c 4.3. ==> Lecture du contenu de la famille
 329 c
 330         if ( codret.eq.0 ) then
 331 c
 332 #ifdef _DEBUG_HOMARD_
 333       write (ulsort,texte(langue,3)) 'MFAFAI', nompro
 334 #endif
 335         iaux = nrofam
 336         call mfafai ( idfmed, nomamd, iaux, nomfam, numfam,
 337      >                smem(adnogr), codret )
 338 c
 339         endif
 340 #ifdef _DEBUG_HOMARD_
 341       write (ulsort,*) '... Famille ', nomfam
 342       write (ulsort,90002) 'numfam', numfam
 343       write (ulsort,*) (smem(adnogr+iaux),iaux=0,ngro-1)
 344       call gmprot(nompro, ntnogr, 1, 41 )
 345 #endif
 346 c
 347 c 4.5. ==> Rangement
 348 c
 349         if ( codret.eq.0 ) then
 350 c
 351           do 45 , typenh = -1 , 7
 352 c
 353             if ( nomfam(1:2).eq.suffix(3,typenh)(1:2) ) then
 354 c
 355 #ifdef _DEBUG_HOMARD_
 356       write (ulsort,*) '... Famille ', nomfam
 357       write (ulsort,90002) 'numfam', numfam
 358 #endif
 359 c
 360 c 4.5.1. ==> le numero de la famille HOMARD
 361 c            Attention : le numero de la famille HOMARD associee est
 362 c            le 1er attribut (cf. esecf0). Il faut gerer le decalage
 363 c            des codes en consequence
 364 c
 365               if ( codret.eq.0 ) then
 366 c
 367 #ifdef _DEBUG_HOMARD_
 368       write (ulsort,texte(langue,3)) 'UTS8CH', nompro
 369 #endif
 370               iaux = 80
 371               call uts8ch ( smem(adnogr), iaux, nomgro,
 372      >                      ulsort, langue, codret )
 373 #ifdef _DEBUG_HOMARD_
 374         write (ulsort,*) '... nomgro : ', nomgro
 375 #endif
 376 c
 377               endif
 378 c
 379               if ( codret.eq.0 ) then
 380 c
 381 #ifdef _DEBUG_HOMARD_
 382       write (ulsort,texte(langue,3)) 'UTCHEN', nompro//"-4.5.1."
 383 #endif
 384               call utchen ( nomgro(9:16), kaux,
 385      >                      ulsort, langue, codret )
 386 #ifdef _DEBUG_HOMARD_
 387         write (ulsort,90002) 'Numero famille HOMARD', kaux
 388 #endif
 389               kaux = kaux - 1
 390 c
 391 c 4.5.2. ==> les codes
 392 c
 393               if ( typenh.eq.-1 ) then
 394                 natt = nctfno
 395                 adcoen = adcono + kaux*nctfno
 396               elseif ( typenh.eq.0 ) then
 397                 natt = nctfmp
 398                 adcoen = adcomp + kaux*nctfmp
 399               elseif ( typenh.eq.1 ) then
 400                 natt = nctfar
 401                 adcoen = adcoar + kaux*nctfar
 402               elseif ( typenh.eq.2 ) then
 403                 natt = nctftr
 404                 adcoen = adcotr + kaux*nctftr
 405               elseif ( typenh.eq.3 ) then
 406                 natt = nctfte
 407                 adcoen = adcote + kaux*nctfte
 408               elseif ( typenh.eq.4 ) then
 409                 natt = nctfqu
 410                 adcoen = adcoqu + kaux*nctfqu
 411               elseif ( typenh.eq.5 ) then
 412                 natt = nctfpy
 413                 adcoen = adcopy + kaux*nctfpy
 414               elseif ( typenh.eq.6 ) then
 415                 natt = nctfhe
 416                 adcoen = adcohe + kaux*nctfhe
 417               else
 418                 natt = nctfpe
 419                 adcoen = adcope + kaux*nctfpe
 420               endif
 421 #ifdef _DEBUG_HOMARD_
 422         write (ulsort,90002) 'natt', natt
 423 #endif
 424 c
 425               reste = mod(natt+1,9)
 426 #ifdef _DEBUG_HOMARD_
 427         write (ulsort,90002) 'reste', reste
 428 #endif
 429 c
 430               cptr = adcoen - 1
 431               kdeb = 2
 432               do 451 , jaux = 1, ngro
 433                 if ( jaux.lt.ngro .or. reste.eq.0 ) then
 434                   kfin = 9
 435                 else
 436                   kfin = reste
 437                 endif
 438                 iaux = 80
 439                 call uts8ch ( smem(adnogr+10*(jaux-1)), iaux, nomgro,
 440      >                        ulsort, langue, codret )
 441                 do 4511 , iaux = kdeb, kfin
 442 #ifdef _DEBUG_HOMARD_
 443       write (ulsort,texte(langue,3)) 'UTCHEN', nompro//"-do 4511"
 444 #endif
 445                   call utchen ( nomgro(8*iaux+1:8*(iaux+1)), kaux,
 446      >                          ulsort, langue, codret )
 447                   cptr = cptr + 1
 448                   imem(cptr) = kaux
 449  4511           continue
 450                 kdeb = 1
 451   451         continue
 452 c
 453               endif
 454 c
 455             endif
 456 c
 457    45     continue
 458 c
 459         endif
 460 c
 461    40 continue
 462 ccc          call gmprsx ( nompro, nhnoeu//'.Famille' )
 463 ccc          call gmprsx ( nompro, nhnoeu//'.Famille.Codes' )
 464 ccc          call gmprsx ( nompro, nhnoeu//'.Famille.Groupe' )
 465 ccc          call gmprsx ( nompro, nharet//'.Famille' )
 466 ccc          call gmprsx ( nompro, nharet//'.Famille.Codes' )
 467 c
 468 c====
 469 c 5. Lecture des familles de sauvegarde
 470 c====
 471 #ifdef _DEBUG_HOMARD_
 472       write (ulsort,90002) '5. Lecture familles sauv. ; codret', codret
 473 #endif
 474 c
 475       do 50 , nrofam = 1 , nbfmed
 476 #ifdef _DEBUG_HOMARD_
 477       write (ulsort,90002) 'nrofam', nrofam
 478 #endif
 479 c
 480 c 5.1. ==> Caracterisations de la famille en cours de lecture
 481 c
 482         if ( codret.eq.0 ) then
 483 c
 484 #ifdef _DEBUG_HOMARD_
 485       write (ulsort,texte(langue,3)) 'MFANFG', nompro
 486 #endif
 487         iaux = nrofam
 488         call mfanfg ( idfmed, nomamd, iaux, ngro, codret )
 489 c
 490         endif
 491 c
 492 c 5.2. ==> Controles
 493 c
 494         if ( codret.eq.0 ) then
 495 c
 496         if ( 10*ngro.gt.ltbsau ) then
 497           write (ulsort,texte(langue,81)) ltbsau
 498           write (ulsort,texte(langue,82)) 10*ngro
 499           codret = 52
 500         endif
 501 c
 502         endif
 503 c
 504 c 5.3. ==> Lecture du contenu de la famille
 505 c
 506         if ( codret.eq.0 ) then
 507 c
 508 #ifdef _DEBUG_HOMARD_
 509       write (ulsort,texte(langue,3)) 'MFAFAI', nompro
 510 #endif
 511         iaux = nrofam
 512         call mfafai ( idfmed, nomamd, iaux, nomfam, numfam,
 513      >                tbsaux, codret )
 514 c
 515         endif
 516 #ifdef _DEBUG_HOMARD_
 517       write (ulsort,*) '... Famille ', nomfam
 518       write (ulsort,90002) 'numfam', numfam
 519       do 5353 , jaux = 1 , ngro
 520       write (ulsort,1002) (tbsaux(kaux),kaux=10*(jaux-1)+1,10*jaux)
 521  5353 continue
 522 #endif
 523 c
 524 c 5.3. ==> Rangement
 525 c
 526         if ( codret.eq.0 ) then
 527 c
 528 c 5.3.1. ==> La date et le titre
 529 c
 530           if ( nomfam(1:13).eq.'date_et_titre' ) then
 531 c
 532             if ( codret.eq.0 ) then
 533 c
 534             iaux = len(ladate)
 535             call  uts8ch ( tbsaux, iaux, ladate,
 536      >                     ulsort, langue, codret )
 537 c
 538             endif
 539             if ( codret.eq.0 ) then
 540 c
 541             iaux = 80
 542             call  uts8ch ( tbsaux(11), iaux, titre,
 543      >                     ulsort, langue, codret )
 544 c
 545             endif
 546 cgn           print *,ladate
 547 cgn           print *,titre
 548 c
 549 c 5.3.2. ==> Les informations supplementaires (cf. esecfs)
 550 c
 551           elseif ( nomfam(1:12).eq.'InfoSupS_Tab' ) then
 552 #ifdef _DEBUG_HOMARD_
 553       write (ulsort,*) '... Famille ', nomfam
 554       write (ulsort,90002) 'numfam', numfam
 555       write (ulsort,90002) 'ngro', ngro
 556       do 53299 , jaux = 1 , ngro
 557         write (ulsort,1002) (tbsaux(kaux),kaux=10*(jaux-1)+1,10*jaux)
 558 53299 continue
 559 #endif
 560 c
 561 c           La categorie
 562 c
 563             if ( codret.eq.0 ) then
 564 c
 565 #ifdef _DEBUG_HOMARD_
 566       write (ulsort,texte(langue,3)) 'UTCHEN', nompro//"-5.3.2.a"
 567 #endif
 568             call utchen ( nomfam(13:64), numtab,
 569      >                    ulsort, langue, codret )
 570 c
 571             endif
 572 c
 573             if ( codret.eq.0 ) then
 574 c
 575 c           Le nombre de valeurs
 576 c
 577             do 5321 , jaux = 1 , ngro
 578 c
 579               kaux = 10*(jaux-1) + 1
 580 #ifdef _DEBUG_HOMARD_
 581       write (ulsort,90002) 'kaux', kaux
 582       write (ulsort,*) 'tbsaux(kaux)', tbsaux(kaux)
 583 #endif
 584               if ( tbsaux(kaux).eq.'Nombre d' ) then
 585 c
 586                 numgro = jaux
 587 c
 588                 saux32 =
 589      > tbsaux(kaux+3)//tbsaux(kaux+4)//tbsaux(kaux+5)//tbsaux(kaux+6)
 590 #ifdef _DEBUG_HOMARD_
 591       write (ulsort,texte(langue,3)) 'UTCHEN', nompro//"-5.3.2.b"
 592 #endif
 593                 call utchen ( saux32, nbval, ulsort, langue, codret )
 594 #ifdef _DEBUG_HOMARD_
 595       write (ulsort,90002) 'nbval  ', nbval
 596       write (ulsort,90002) 'numgro', numgro
 597 #endif
 598 c
 599                 goto 53210
 600 c
 601               endif
 602 c
 603  5321       continue
 604 53210       continue
 605 c
 606             endif
 607 c
 608 c           Gestion memoire
 609 c
 610             if ( codret.eq.0 ) then
 611 c
 612             call utlgut ( jaux, nomfam,
 613      >                    ulsort, langue, codret )
 614             call gmaloj ( nhsups//'.'//nomfam(10:jaux) , ' ',
 615      >                    nbval, adress, codre1 )
 616             call gmecat ( nhsups , numtab, nbval, codre2 )
 617 c
 618             codre0 = min ( codre1, codre2 )
 619             codret = max ( abs(codre0), codret,
 620      >                     codre1, codre2 )
 621 c
 622             endif
 623 c
 624 c           Les valeurs
 625 c           il faut supprimer le pseudo-groupe du nombre de valeurs
 626 c
 627             if ( codret.eq.0 ) then
 628 c
 629             do 5322 , jaux = 1 , ngro
 630               if ( jaux.ne.numgro ) then
 631                 kaux = 10*(jaux-1)
 632                 do 53221 , iaux = 1, 10
 633                   smem(adress) = tbsaux(kaux+iaux)
 634                   adress = adress + 1
 635 53221           continue
 636               endif
 637  5322       continue
 638 c            do 5322 , jaux = 0 , nbval-1
 639 c              smem(adress+jaux) = tbsaux(11+jaux)
 640 c 5322       continue
 641 c
 642             endif
 643 c
 644           endif
 645 c
 646         endif
 647 c
 648    50 continue
 649 c
 650 c====
 651 c 6. Menage
 652 c====
 653 #ifdef _DEBUG_HOMARD_
 654       write (ulsort,90002) '6. Menage ; codret', codret
 655 #endif
 656 c
 657       if ( codret.eq.0 ) then
 658 c
 659       call gmlboj ( ntnogr , codret  )
 660 c
 661       endif
 662 c
 663 c====
 664 c 7. la fin
 665 c====
 666 c
 667       if ( codret.ne.0 ) then
 668 c
 669 #include "envex2.h"
 670 c
 671       write (ulsort,texte(langue,1)) 'Sortie', nompro
 672       write (ulsort,texte(langue,2)) codret
 673 c
 674       endif
 675 c
 676 #ifdef _DEBUG_HOMARD_
 677       write (ulsort,texte(langue,1)) 'Sortie', nompro
 678       call dmflsh (iaux)
 679 #endif
 680 c
 681       end