src/tool/ES_MED/eslsm0.F

   1       subroutine eslsm0 ( nocson, nomfic, lnomfi,
   2      >                    nomamd, lnomam,
   3      >                    nbseal, nbtosv,
   4      >                    cactal, caetal, cartal,
   5      >                    messin, option,
   6      >                    ulsort, langue, codret )
   7 c ______________________________________________________________________
   8 c
   9 c                             H O M A R D
  10 c
  11 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  12 c
  13 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  14 c aupres des huissiers de justice Simart et Lavoir a Clamart
  15 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  16 c aupres des huissiers de justice
  17 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  18 c
  19 c    HOMARD est une marque deposee d'Electricite de France
  20 c
  21 c Copyright EDF 1996
  22 c Copyright EDF 1998
  23 c Copyright EDF 2002
  24 c Copyright EDF 2020
  25 c ______________________________________________________________________
  26 c
  27 c  Entree-Sortie - Lecture d'une Solution au format Med - phase 0
  28 c  -      -        -             -                  -           -
  29 c ______________________________________________________________________
  30 c .        .     .        .                                            .
  31 c .  nom   . e/s . taille .           description                      .
  32 c .____________________________________________________________________.
  33 c . nocson .   s . char*8 . nom de l'objet solution calcul iteration n .
  34 c . nomfic . e   . char*  . nom du fichier                             .
  35 c . lnomfi . e   .    1   . longueur du nom du fichier                 .
  36 c . nomamd . e   . char64 . nom du maillage MED                        .
  37 c . lnomam . e   .    1   . longueur du nom du maillage                .
  38 c . nbseal . e   .    1   . nombre de sequences a lire                 .
  39 c .        .     .        . si -1, on lit tous les champs du fichier   .
  40 c . nbtosv .  s  .    1   . nombre total de sequences lues             .
  41 c . cactal . e   .8*nbseal. caracteristiques caracteres de chaque      .
  42 c .        .     .        . tableau a lire                             .
  43 c .        .     .        . 1,...,8. nom du champ associe              .
  44 c . caetal . es  .  12 *  . caracteristiques entieres de chaque        .
  45 c .        .     . nbseal . tableau a lire                             .
  46 c .        .     .        . 1. type de support au sens MED             .
  47 c .        .     .        .  -1, si on prend tous les supports         .
  48 c .        .     .        . 2. 2, on prend le dernier pas de temps     .
  49 c .        .     .        .    1, le numero du pas de temps est fourni .
  50 c .        .     .        .    0, sinon                                .
  51 c .        .     .        . 3. numero du pas de temps                  .
  52 c .        .     .        . 4. 2, on prend le dernier numero d'ordre   .
  53 c .        .     .        .    1, le numero d'ordre est fourni         .
  54 c .        .     .        .    0, sinon                                .
  55 c .        .     .        . 5. numero d'ordre                          .
  56 c .        .     .        . 6. 2, on prend le dernier instant          .
  57 c .        .     .        .    1, l'instant est fourni                 .
  58 c .        .     .        .    0, sinon                                .
  59 c .        .     .        . 7. 1, si aux noeuds par elements, 0 sinon, .
  60 c .        .     .        .   -1, si non precise                       .
  61 c .        .     .        . 8. numero du champ noeuds/element associe  .
  62 c .        .     .        . 9. numero du champ associe dans HOMARD     .
  63 c .        .     .        . 10. type d'interpolation                   .
  64 c .        .     .        .  0, si automatique                         .
  65 c .        .     .        .  1 si degre 1, 2 si degre 2, 3 si iso-P2   .
  66 c .        .     .        . 11. 1, s'il fait partie du champ en cours  .
  67 c .        .     .        .    d'examen, 0, sinon                      .
  68 c .        .     .        . 12. type de champ edfl64/edin64            .
  69 c . cartal . e   . nbseal . caracteristiques reelles de chaque         .
  70 c .        .     .        . tableau a lire                             .
  71 c .        .     .        . 1. instant                                 .
  72 c . messin . e   .   1    . message d'informations                     .
  73 c .        .     .        . impressions MED si multiple de 3           .
  74 c . option . e   .   1    . 1 : on controle que l'on a les couples (aux.
  75 c .        .     .        . noeuds par element/aux points de Gauss)    .
  76 c .        .     .        . 0 : pas de controle                        .
  77 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  78 c . langue . e   .    1   . langue des messages                        .
  79 c .        .     .        . 1 : francais, 2 : anglais                  .
  80 c . codret . es  .    1   . code de retour des modules                 .
  81 c .        .     .        . 0 : pas de probleme                        .
  82 c .        .     .        . 1 : probleme                               .
  83 c ______________________________________________________________________
  84 c
  85 c  ESLSMD -> ESLSM0 -> ESOUVL -> ESVERI -> MFICOM
  86 c /ESLIMD                               -> MLBSTV
  87 c                                       -> MFIOPE
  88 c                                       -> MFISVR
  89 c                                       -> MFICLO
  90 c                             -> MFIOPE
  91 c                             -> ESLENT -> MFICOR
  92 c                   -> ESLNOM -> MMHNMH
  93 c                             -> MMHMII
  94 c                   -> MFDNFD
  95 c                   -> MLCNLC
  96 c                   -> ESLSM1 -> MFDNFC
  97 c                             -> MFDFDI
  98 c                             -> ESLCH1
  99 c                             -> ESLCH2 -> MFDCSI
 100 c                                       -> MFDNPF
 101 c                                       -> ESLPR1 -> MPFPSN
 102 c                                                 -> MPFPRR
 103 c                                       -> ESLPG1 -> ESLPG2 -> MLCNLC
 104 c                                                           -> MLCLCI
 105 c                                                 -> MLCLOR
 106 c                                       -> MFDNPN
 107 c                             -> ESLCH6
 108 c                   -> ESLSM2 -> ESLCH3
 109 c                             -> ESLCH7
 110 c                   -> ESLSM3
 111 c                   -> ESLSM4 -> ESLCH4 -> MFDRPR
 112 c                                       -> ESLCH5
 113 c                   -> ESLSM5
 114 c         -> MFICLO
 115 c
 116 c====
 117 c 0. declarations et dimensionnement
 118 c====
 119 c
 120 c 0.1. ==> generalites
 121 c
 122       implicit none
 123       save
 124 c
 125       character*6 nompro
 126       parameter ( nompro = 'ESLSM0' )
 127 c
 128 #include "nblang.h"
 129 c
 130 c 0.2. ==> communs
 131 c
 132 #include "envex1.h"
 133 c
 134 #include "esutil.h"
 135 #include "gmenti.h"
 136 #include "gmstri.h"
 137 c
 138 c 0.3. ==> arguments
 139 c
 140       integer lnomfi, lnomam
 141       integer nbseal, nbtosv
 142       integer caetal(12,*)
 143 c
 144       double precision cartal(*)
 145 c
 146       character*8 nocson
 147       character*8 cactal(*)
 148       character*64 nomamd
 149       character*200 nomfic
 150 c
 151       integer messin, option
 152 c
 153       integer ulsort, langue, codret
 154 c
 155 c 0.4. ==> variables locales
 156 c
 157       integer iaux, jaux
 158       integer codre1, codre2
 159       integer codre0
 160 c
 161       integer nbchfi, nbcham, nbfonc, nbprof, nblopg
 162       integer nbrpro, nbrlpg
 163       integer nbpafo
 164       integer adinch, adinpf, adinpr, adinlg
 165       integer adtra1, adtra2
 166       integer typrep
 167 c
 168       integer*8 idfmed
 169 c
 170       character*8 ntrav1, ntrav2
 171       character*16 nomaxe(3), uniaxe(3)
 172 #ifdef _DEBUG_HOMARD_
 173       character*8 saux08
 174 #endif
 175 c
 176       integer nbmess
 177       parameter ( nbmess = 150 )
 178       character*80 texte(nblang,nbmess)
 179 c
 180 c 0.5. ==> initialisations
 181 c ______________________________________________________________________
 182 c
 183 c====
 184 c 1. initialisations
 185 c====
 186 c
 187 #include "impr01.h"
 188 c
 189 #ifdef _DEBUG_HOMARD_
 190       write (ulsort,texte(langue,1)) 'Entree', nompro
 191       call dmflsh (iaux)
 192 #endif
 193 c
 194 #include "impr03.h"
 195 c
 196 #include "esimpr.h"
 197 c
 198 c====
 199 c 2. prealables
 200 c====
 201 #ifdef _DEBUG_HOMARD_
 202       write (ulsort,90002) '2. prealables ; codret', codret
 203 #endif
 204 c
 205 c 2.1. ==> ouverture du fichier MED
 206 c
 207       if ( codret.eq.0 ) then
 208 c
 209 #ifdef _DEBUG_HOMARD_
 210       iaux = max(3,messin)
 211 #else
 212       iaux = messin
 213 #endif
 214 c
 215 #ifdef _DEBUG_HOMARD_
 216       write (ulsort,texte(langue,3)) 'ESOUVL', nompro
 217 #endif
 218       call esouvl ( idfmed, nomfic(1:lnomfi), iaux,
 219      >              ulsort, langue, codret )
 220 c
 221       endif
 222 c
 223 c 2.2. ==> le maillage est-il present dans le fichier ?
 224 c
 225       if ( codret.eq.0 ) then
 226 c
 227 #ifdef _DEBUG_HOMARD_
 228       write (ulsort,texte(langue,3)) 'ESLNOM', nompro
 229 #endif
 230       call eslnom ( idfmed, nomamd, lnomam,
 231      >                iaux,   jaux,
 232      >              typrep, nomaxe, uniaxe,
 233      >              ulsort, langue, codret )
 234 c
 235       endif
 236 c
 237 c====
 238 c 3. nombre de champs dans le fichier : s'il n'y en n'a pas, on met
 239 c    tout a zero et on passera par-dessus la suite
 240 c====
 241 #ifdef _DEBUG_HOMARD_
 242       write (ulsort,90002) '3. nb champs dans fichier ; codret', codret
 243 #endif
 244 c
 245 c 3.1. ==> nombre de champs dans le fichier
 246 c
 247       if ( codret.eq.0 ) then
 248 c
 249 #ifdef _DEBUG_HOMARD_
 250       write (ulsort,texte(langue,3)) 'MFDNFD', nompro
 251 #endif
 252       call mfdnfd ( idfmed, nbchfi, codret )
 253 c
 254 #ifdef _DEBUG_HOMARD_
 255       if ( codret.eq.0 ) then
 256       write (ulsort,90002) 'Nombre de champs dans le fichier', nbchfi
 257       endif
 258 #endif
 259 c
 260       endif
 261 c
 262 c 3.2. ==> nombre de localisations de points de Gauss dans le fichier
 263 c
 264       if ( codret.eq.0 ) then
 265 c
 266 #ifdef _DEBUG_HOMARD_
 267       write (ulsort,texte(langue,3)) 'MLCNLC', nompro
 268 #endif
 269       call mlcnlc ( idfmed, nbrlpg, codret )
 270       if ( codret.ne.0 ) then
 271       write (ulsort,texte(langue,4))
 272       write (ulsort,texte(langue,79))
 273       endif
 274 c
 275 #ifdef _DEBUG_HOMARD_
 276       write (ulsort,texte(langue,82)) nbrlpg
 277 #endif
 278 c
 279       endif
 280 c
 281 c 3.3. ==> nombre de profils dans le fichier
 282 c
 283       if ( codret.eq.0 ) then
 284 c
 285 #ifdef _DEBUG_HOMARD_
 286       write (ulsort,texte(langue,3)) 'MPFNPF', nompro
 287 #endif
 288       call mpfnpf ( idfmed, nbrpro, codret )
 289 c
 290 #ifdef _DEBUG_HOMARD_
 291       write (ulsort,texte(langue,86)) nbrpro
 292 #endif
 293 c
 294       endif
 295 c
 296 c 3.4. ==> allocation de l'objet solution : la tete et la
 297 c          branche des champs
 298 c          On suppose qu'il n'y a ni fonction, ni profil, ni
 299 c          localisation de points de Gauss
 300 c
 301       if ( codret.eq.0 ) then
 302 c
 303       iaux = 0
 304 #ifdef _DEBUG_HOMARD_
 305       write (ulsort,texte(langue,3)) 'UTALSO', nompro
 306 #endif
 307       call utalso ( nocson,
 308      >              nbchfi, iaux, iaux, iaux,
 309      >              adinch, adinpf, adinpr, adinlg,
 310      >              ulsort, langue, codret )
 311 c
 312       endif
 313 c
 314 c====
 315 c 4. caracterisations des champs
 316 c====
 317 #ifdef _DEBUG_HOMARD_
 318       write (ulsort,90002) '4. caracterisations champs ; codret', codret
 319 #endif
 320 c
 321       nbtosv = 0
 322       nbprof = 0
 323       nblopg = 0
 324 c
 325       if ( nbchfi.ne.0 ) then
 326 c
 327 c 4.1. ==> tableaux temporaires pour stocker les noms des eventuels
 328 c          profils et localisations de points de Gauss a lire
 329 c
 330         if ( codret.eq.0 ) then
 331 c
 332         iaux = 9*nbchfi*nbrpro
 333         call gmalot ( ntrav1, 'chaine', iaux, adtra1, codre1 )
 334         iaux = 9*nbchfi*nbrlpg
 335         call gmalot ( ntrav2, 'chaine', iaux, adtra2, codre2 )
 336 c
 337         codre0 = min ( codre1, codre2 )
 338         codret = max ( abs(codre0), codret,
 339      >                 codre1, codre2 )
 340 c
 341         endif
 342 c
 343 c 4.2. ==> A partir des nbchfi champs contenus dans le fichier, on
 344 c          cree les caracteristiques de ce qu'il faut lire. On
 345 c          recupere leur nombre, nbcham, et le nombre total de
 346 c          tableaux de valeurs auxquels cela correspond, nbtosv
 347 c          On ne s'interesse ici qu'aux caracteristiques des tableaux
 348 c          de valeurs.
 349 c
 350         if ( codret.eq.0 ) then
 351 c
 352 #ifdef _DEBUG_HOMARD_
 353       write (ulsort,texte(langue,3)) 'ESLSM1', nompro
 354 #endif
 355         call eslsm1 ( idfmed, nomamd,
 356      >                nbchfi, option,
 357      >                nbseal, cactal, caetal, cartal,
 358      >                nbcham, smem(adinch), nbtosv,
 359      >                nbprof, smem(adtra1),
 360      >                nblopg, smem(adtra2),
 361      >                ulsort, langue, codret )
 362 c
 363         endif
 364 c
 365 #ifdef _DEBUG_HOMARD_
 366       write (ulsort,90002) 'nbseal',nbseal
 367       if ( nbseal.gt.0 ) then
 368       write (ulsort,90005) 'caetal',(caetal(iaux,1),iaux=1,12)
 369       write (ulsort,90004) 'cartal',cartal(1)
 370       endif
 371       if ( codret.eq.0 ) then
 372         write (ulsort,90002) 'Nbre de champs a lire (nbcham)   ', nbcham
 373         write (ulsort,90002) 'Nbre cumule de sequences (nbtosv)', nbtosv
 374         write (ulsort,90002) 'Nbre cumule de profils (nbprof)  ', nbprof
 375 cgn        call gmprsx (nompro, ntrav1 )
 376       endif
 377 #endif
 378 c
 379 c 4.3. ==> stockage de l'information sur les champs dans la
 380 c          structure solution
 381 #ifdef _DEBUG_HOMARD_
 382       write (ulsort,90002)'Avant 4.3., codret', codret
 383 #endif
 384 c
 385         if ( codret.eq.0 ) then
 386 c
 387         call gmecat ( nocson, 1, nbcham, codre1 )
 388         call gmmod ( nocson//'.InfoCham',
 389      >               adinch, nbchfi, nbcham, 1, 1, codre2 )
 390 c
 391         codre0 = min ( codre1, codre2 )
 392         codret = max ( abs(codre0), codret,
 393      >                 codre1, codre2 )
 394 c
 395         endif
 396 c
 397 #ifdef _DEBUG_HOMARD_
 398         if ( codret.eq.0 ) then
 399 40000 format(/,'Apres 4.3., solution ',a8,/,29('='),/)
 400         write (ulsort,40000) nocson
 401         call gmprsx (nompro, nocson )
 402         call gmprsx (nompro, nocson//'.InfoCham' )
 403 cgn        call gmprsx (nompro, '%%%%%%14' )
 404 cgn        call gmprsx (nompro, '%%%%%%14.Nom_Comp' )
 405 cgn        call gmprsx (nompro, '%%%%%%17.Cham_Ent' )
 406 cgn        call gmprsx (nompro, '%%%%%%18.Cham_Ent' )
 407 cgn        call gmprsx (nompro, '%%%%%%14.Cham_Ree' )
 408 cgn        call gmprsx (nompro, '%%%%%%14.Cham_Car' )
 409         endif
 410 #endif
 411 c
 412 c 4.4.==> creations des structures representant les profils
 413 c         necessaires aux champs a lire
 414 #ifdef _DEBUG_HOMARD_
 415       write (ulsort,90002)'Avant 4.4., codret', codret
 416 #endif
 417 c
 418         if ( nbprof.ne.0 ) then
 419 c
 420           if ( codret.eq.0 ) then
 421 c
 422           call gmaloj ( nocson//'.InfoProf', ' ',
 423      >                  nbprof, adinpr, codre1 )
 424           call gmecat ( nocson, 3, nbprof, codre2 )
 425 c
 426           codre0 = min ( codre1, codre2 )
 427           codret = max ( abs(codre0), codret,
 428      >                 codre1, codre2 )
 429 c
 430           endif
 431 c
 432           if ( codret.eq.0 ) then
 433 c
 434           do 44 , iaux = 1 , nbprof
 435             smem(adinpr+iaux-1) = smem(adtra1+5*iaux-1)
 436    44     continue
 437 c
 438           endif
 439 c
 440 #ifdef _DEBUG_HOMARD_
 441 40004 format(/,'Apres 4.4., solution ',a8,/,29('='),/)
 442           if ( codret.eq.0 ) then
 443           write (ulsort,40004) nocson
 444           call gmprsx (nompro, nocson )
 445           call gmprsx (nompro, nocson//'.InfoProf' )
 446 cgn          call gmprsx (nompro, '%%%%%%%6' )
 447 cgn          call gmprsx (nompro, '%%%%%%%6.NomProfi' )
 448 cgn          call gmprsx (nompro, '%%%%%%%6.ListEnti' )
 449           endif
 450 #endif
 451 c
 452         endif
 453 c
 454 c 4.5. ==> creations des structures representant les localisations de
 455 c          points de Gauss necessaires aux champs a lire
 456 #ifdef _DEBUG_HOMARD_
 457       write (ulsort,90002) 'Avant 4.5., codret', codret
 458 #endif
 459 c
 460         if ( nblopg.ne.0 ) then
 461 c
 462           if ( codret.eq.0 ) then
 463 c
 464           call gmaloj ( nocson//'.InfoLoPG', ' ',
 465      >                  nblopg, adinlg, codre1 )
 466           call gmecat ( nocson, 4, nblopg, codre2 )
 467 c
 468           codre0 = min ( codre1, codre2 )
 469           codret = max ( abs(codre0), codret,
 470      >                 codre1, codre2 )
 471 c
 472           endif
 473 c
 474           if ( codret.eq.0 ) then
 475 c
 476           do 45 , iaux = 1 , nblopg
 477             smem(adinlg+iaux-1) = smem(adtra2+9*iaux-1)
 478    45     continue
 479 c
 480           endif
 481 c
 482 #ifdef _DEBUG_HOMARD_
 483 40005 format(/,'Apres 4.5., solution ',a8,/,29('='),/)
 484           if ( codret.eq.0 ) then
 485           write (ulsort,40005) nocson
 486           call gmprsx (nompro, nocson )
 487           call gmprsx (nompro, nocson//'.InfoLoPG' )
 488           endif
 489 #endif
 490 c
 491         endif
 492 c
 493 c 4.6. ==> menage
 494 c
 495         if ( codret.eq.0 ) then
 496 c
 497         call gmlboj ( ntrav1, codre1 )
 498         call gmlboj ( ntrav2, codre2 )
 499 c
 500         codre0 = min ( codre1, codre2 )
 501         codret = max ( abs(codre0), codret,
 502      >                 codre1, codre2 )
 503 c
 504         endif
 505 c
 506       endif
 507 c
 508 c====
 509 c 5. les fonctions
 510 c====
 511 #ifdef _DEBUG_HOMARD_
 512       write (ulsort,90002) '5. les fonctions ; codret', codret
 513 #endif
 514 c
 515       if ( codret.eq.0 ) then
 516 c
 517       if ( nbtosv.ne.0 ) then
 518 c
 519 c 5.1.==> classement des champs en fonctions
 520 c         a priori, on suppose qu'il y a autant de fonctions differents
 521 c         que de tableaux ; on pourrait corriger ensuite en fonction
 522 c         des regroupements qui auront ete faits dans eslsm2, mais
 523 c         c'est inutile de passer du temps a cela car les tableaux
 524 c         sont detruits a la fin de cette sequence.
 525 c
 526         if ( codret.eq.0 ) then
 527 c
 528 #ifdef _DEBUG_HOMARD_
 529         write (ulsort,90002) 'Nombre de fonctions suppose', nbtosv
 530         write (ulsort,90002) 'nbinec', nbinec
 531 #endif
 532         iaux = nbinec*nbtosv
 533         call gmalot ( ntrav1, 'entier', iaux, adtra1, codre1 )
 534         iaux = 3*nbtosv
 535         call gmalot ( ntrav2, 'chaine', iaux, adtra2, codre2 )
 536 c
 537         codre0 = min ( codre1, codre2 )
 538         codret = max ( abs(codre0), codret,
 539      >                 codre1, codre2 )
 540 c
 541         endif
 542 c
 543         if ( codret.eq.0 ) then
 544 c
 545 #ifdef _DEBUG_HOMARD_
 546       write (ulsort,texte(langue,3)) 'ESLSM2', nompro
 547 #endif
 548         call eslsm2 ( nbcham, smem(adinch), nbseal,
 549      >                nbfonc, imem(adtra1), smem(adtra2), option,
 550      >                ulsort, langue, codret )
 551 c
 552         endif
 553 c
 554 #ifdef _DEBUG_HOMARD_
 555         if ( codret.eq.0 ) then
 556         write (ulsort,90002) 'Nombre de fonctions (nbfonc)',nbfonc
 557         call gmprsx (nompro, ntrav1 )
 558         call gmprsx (nompro, ntrav2 )
 559        endif
 560 #endif
 561 c
 562 c 5.2. ==> creations des structures pour les fonctions
 563 c
 564 #ifdef _DEBUG_HOMARD_
 565       write (ulsort,90002)'Avant 5.2, codret',codret
 566 #endif
 567 c
 568         if ( codret.eq.0 ) then
 569 c
 570 #ifdef _DEBUG_HOMARD_
 571       write (ulsort,texte(langue,3)) 'ESLSM3', nompro
 572 #endif
 573 c
 574         call eslsm3 ( nbfonc, imem(adtra1),
 575      >                smem(adtra2),
 576      >                ulsort, langue, codret )
 577 c
 578 #ifdef _DEBUG_HOMARD_
 579         if ( codret.eq.0 ) then
 580         call gmprsx (nompro, ntrav2 )
 581         endif
 582 #endif
 583 c
 584         endif
 585 c
 586 c 5.3. ==> lecture des valeurs numeriques et des eventuels profils
 587 c
 588 #ifdef _DEBUG_HOMARD_
 589       write (ulsort,90002)'Avant 5.3, codret',codret
 590 #endif
 591 c
 592         if ( codret.eq.0 ) then
 593 c
 594 #ifdef _DEBUG_HOMARD_
 595       write (ulsort,texte(langue,3)) 'ESLSM4', nompro
 596 #endif
 597 c
 598         call eslsm4 ( idfmed,
 599      >                nbcham, smem(adinch),
 600      >                nbfonc, imem(adtra1), smem(adtra2),
 601      >                ulsort, langue, codret )
 602 c
 603         endif
 604 c
 605 c 5.4. ==> regroupement des fonctions en paquets
 606 c
 607 #ifdef _DEBUG_HOMARD_
 608       write (ulsort,90002) 'Avant 5.4, codret', codret
 609 #endif
 610 c
 611         if ( codret.eq.0 ) then
 612 c
 613         call gmaloj ( nocson//'.InfoPaFo', ' ', nbfonc, adinpf, codret )
 614 c
 615         endif
 616 c
 617         if ( codret.eq.0 ) then
 618 c
 619 #ifdef _DEBUG_HOMARD_
 620       write (ulsort,texte(langue,3)) 'ESLSM5', nompro
 621 #endif
 622 c
 623         call eslsm5 ( nbfonc, imem(adtra1), smem(adtra2), nbseal,
 624      >                nbpafo, smem(adinpf), option,
 625      >                ulsort, langue, codret )
 626 c
 627         endif
 628 c
 629         if ( codret.eq.0 ) then
 630 c
 631         call gmecat ( nocson, 2, nbpafo, codre1 )
 632         call gmmod ( nocson//'.InfoPaFo',
 633      >               adinpf, nbfonc, nbpafo, 1, 1, codre2 )
 634 c
 635         codre0 = min ( codre1, codre2 )
 636         codret = max ( abs(codre0), codret,
 637      >                 codre1, codre2 )
 638 c
 639 #ifdef _DEBUG_HOMARD_
 640         if ( codret.eq.0 ) then
 641         write (ulsort,40054) nocson
 642         endif
 643 40054 format(/,'Apres 5.4., solution ',a8,/,29('='),/)
 644         call gmprsx (nompro, nocson )
 645         call gmprsx (nompro, nocson//'.InfoPaFo' )
 646         do 54555 , iaux = adinpf , adinpf+nbpafo-1
 647         call gmprsx (nompro, smem(iaux) )
 648 54555   continue
 649         call gmprsx (nompro, '%%Fo002I' )
 650         call gmprsx (nompro, '%%%%%%12' )
 651         call gmprsx (nompro,'%%%%%%12.ValeursR')
 652         call gmprsx (nompro,'%%%%%%12.InfoPrPG')
 653         call gmprsx (nompro, '%%%%%%10' )
 654         write (ulsort,*) '+++++++++++++++++++++++++++++++++++++++++'
 655 #endif
 656 c
 657         endif
 658 c
 659 c 5.5. ==> menage
 660 c
 661 #ifdef _DEBUG_HOMARD_
 662       write (ulsort,90002)'Avant 5.5, codret',codret
 663 #endif
 664 c
 665         if ( codret.eq.0 ) then
 666 c
 667 ccc        call gmprsx (nompro, ntrav1 )
 668         call gmlboj ( ntrav1, codre1 )
 669 ccc        call gmprsx (nompro, ntrav2 )
 670         call gmlboj ( ntrav2, codre2 )
 671 c
 672         codre0 = min ( codre1, codre2 )
 673         codret = max ( abs(codre0), codret,
 674      >                 codre1, codre2 )
 675 c
 676         endif
 677 c
 678       endif
 679 c
 680       endif
 681 c
 682 c====
 683 c 6. fermeture du fichier
 684 c====
 685 #ifdef _DEBUG_HOMARD_
 686       write (ulsort,90002) '6. fermeture du fichier ; codret', codret
 687 #endif
 688 c
 689       if ( codret.eq.0 ) then
 690 c
 691 #ifdef _DEBUG_HOMARD_
 692       write (ulsort,texte(langue,3)) 'MFICLO', nompro
 693 #endif
 694       call mficlo( idfmed, codret )
 695       if ( codret.ne.0 ) then
 696         write (ulsort,texte(langue,10))
 697       endif
 698 c
 699       endif
 700 c
 701 #ifdef _DEBUG_HOMARD_
 702 33333 format(80('*'))
 703 44444 format(80('='))
 704       if ( codret.eq.0 ) then
 705       call gmprsx (nompro, nocson )
 706       call gmprsx (nompro, nocson//'.InfoCham' )
 707       call gmprsx (nompro, nocson//'.InfoPaFo' )
 708       call gmprsx (nompro, nocson//'.InfoProf' )
 709       write (ulsort,44444)
 710       do 61 , iaux = 6,20,2
 711       call utench ( iaux, 'd', codre0, saux08,
 712      >              ulsort, langue, codret )
 713       if (iaux.le.9 ) then
 714         saux08(1:7) = '%%%%%%%'
 715       else
 716         saux08(1:6) = '%%%%%%'
 717       endif
 718       call gmprsx (nompro,saux08)
 719       call gmprsx (nompro,saux08//'.NomProfi')
 720       call gmprsx (nompro,saux08//'.ListEnti')
 721       write (ulsort,33333)
 722 61    continue
 723       write (ulsort,44444)
 724       do 62 , iaux = 42,46
 725       call utench ( iaux, 'd', codre0, saux08,
 726      >              ulsort, langue, codret )
 727       if (iaux.le.9 ) then
 728         saux08(1:7) = '%%%%%%%'
 729       else
 730         saux08(1:6) = '%%%%%%'
 731       endif
 732       call gmprsx (nompro,saux08)
 733       call gmprsx (nompro,saux08//'.Fonction')
 734       if ( iaux.eq.42 ) then
 735       call gmprsx (nompro,'%%%%%%36')
 736       call gmprsx (nompro,'%%%%%%36.ValeursR')
 737       call gmprsx (nompro,'%%%%%%36.InfoPrPG')
 738       write (ulsort,33333)
 739       endif
 740       call utench ( iaux-5, 'd', codre0, saux08,
 741      >              ulsort, langue, codret )
 742       saux08(1:6) = '%%%%%%'
 743       call gmprsx (nompro,saux08)
 744       call gmprsx (nompro,saux08//'.ValeursR')
 745       call gmprsx (nompro,saux08//'.InfoPrPG')
 746       write (ulsort,33333)
 747 62    continue
 748       write (ulsort,44444)
 749       do 63 , iaux = 5,34
 750       if ( mod(iaux,2).eq.1 .or. iaux.ge.21 ) then
 751       call utench ( iaux, 'd', codre0, saux08,
 752      >              ulsort, langue, codret )
 753       if (iaux.le.9 ) then
 754         saux08(1:7) = '%%%%%%%'
 755       else
 756         saux08(1:6) = '%%%%%%'
 757       endif
 758       call gmprsx (nompro,saux08)
 759       endif
 760 63    continue
 761 cgn      call gmprsx (nompro, '%%%%%%14' )
 762 cgn      call gmprsx (nompro, '%%%%%%14.Nom_Comp' )
 763 cgn      call gmprsx (nompro, '%%%%%%14.Cham_Ent' )
 764 cgn      call gmprsx (nompro, '%%%%%%14.Cham_Ree' )
 765 cgn      call gmprsx (nompro, '%%%%%%14.Cham_Car' )
 766 cgn      call gmprsx (nompro, '%%%%%%23' )
 767 cgn      call gmprsx (nompro, '%%Fo004J')
 768 cgn      call gmprsx (nompro, '%%%%%%21' )
 769 cgn      call gmprsx (nompro, '%%%%%%21.InfoPrPG' )
 770       endif
 771 #endif
 772 c
 773 c====
 774 c 7. la fin
 775 c====
 776 c
 777       if ( codret.ne.0 ) then
 778 c
 779 #include "envex2.h"
 780 c
 781       write (ulsort,texte(langue,1)) 'Sortie', nompro
 782       write (ulsort,texte(langue,2)) codret
 783       write (ulsort,texte(langue,8)) nomfic
 784 c
 785       endif
 786 c
 787 #ifdef _DEBUG_HOMARD_
 788       write (ulsort,texte(langue,1)) 'Sortie', nompro
 789       call dmflsh (iaux)
 790 #endif
 791 c
 792       end