src/tool/ES_MED/eslsm1.F

   1       subroutine eslsm1 ( idfmed, nomamd,
   2      >                    nbchfi, option,
   3      >                    nbseal, cactal, caetal, cartal,
   4      >                    nbcham, nocham, nbtosv,
   5      >                    nbprof, liprof,
   6      >                    nblopg, lilopg,
   7      >                    ulsort, langue, codret )
   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 d'une Solution au format MED - phase 1
  29 c  -      -        -             -                  -           -
  30 c  En sortie, on a des tableaux caracteristiques des champs contenus
  31 c  dans le fichier
  32 c ______________________________________________________________________
  33 c .        .     .        .                                            .
  34 c .  nom   . e/s . taille .           description                      .
  35 c .____________________________________________________________________.
  36 c . idfmed . e   .   1    . identifiant du fichier med en entree       .
  37 c . nomamd . e   . char64 . nom du maillage MED                        .
  38 c . nbchfi . e   .   1    . nombre de champs dans le fichier           .
  39 c . option . e   .   1    . 1 : on controle que l'on a les couples (aux.
  40 c .        .     .        . noeuds par element/aux points de Gauss)    .
  41 c .        .     .        . 0 : pas de controle                        .
  42 c . nbseal . e   .    1   . nombre de sequences a lire                 .
  43 c .        .     .        . si -1, on lit tous les champs du fichier   .
  44 c . cactal . e   .8*nbseal. caracteristiques caracteres de chaque      .
  45 c .        .     .        . tableau a lire                             .
  46 c .        .     .        . 1,..,8. nom du champ associe               .
  47 c . caetal . es  .  12 *  . caracteristiques entieres de chaque        .
  48 c .        .     . nbseal . tableau a lire                             .
  49 c .        .     .        . 1. type de support au sens MED             .
  50 c .        .     .        .  -1, si on prend tous les supports         .
  51 c .        .     .        . 2. 2, on prend le dernier pas de temps     .
  52 c .        .     .        .    1, le numero du pas de temps est fourni .
  53 c .        .     .        .    0, sinon                                .
  54 c .        .     .        . 3. numero du pas de temps                  .
  55 c .        .     .        . 4. 2, on prend le dernier numero d'ordre   .
  56 c .        .     .        .    1, le numero d'ordre est fourni         .
  57 c .        .     .        .    0, sinon                                .
  58 c .        .     .        . 5. numero d'ordre                          .
  59 c .        .     .        . 6. 2, on prend le dernier instant          .
  60 c .        .     .        .    1, l'instant est fourni                 .
  61 c .        .     .        .    0, sinon                                .
  62 c .        .     .        . 7. 1, si aux noeuds par elements, 0 sinon, .
  63 c .        .     .        .   -1, si non precise                       .
  64 c .        .     .        . 8. numero du champ noeuds/element associe  .
  65 c .        .     .        . 9. numero du champ associe dans HOMARD     .
  66 c .        .     .        . 10. type d'interpolation                   .
  67 c .        .     .        .  0, si automatique                         .
  68 c .        .     .        .  1 si degre 1, 2 si degre 2, 3 si iso-P2   .
  69 c .        .     .        . 11. 1, s'il fait partie du champ en cours  .
  70 c .        .     .        .    d'examen, 0, sinon                      .
  71 c .        .     .        . 12. type de champ edfl64/edin64            .
  72 c . cartal . e   . nbseal . caracteristiques reelles de chaque         .
  73 c .        .     .        . tableau a lire                             .
  74 c .        .     .        . 1. instant                                 .
  75 c . nbcham .  s  .   1    . nombre de champs a lire                    .
  76 c . nocham .  s  . nbchfi . nom des objets qui contiennent la          .
  77 c .        .     .        . description de chaque champ                .
  78 c . nbtosv .  s  .   1    . nombre total de tableaux de valeurs        .
  79 c . nbprof . es  .   1    . nombre cumule de profils a lire            .
  80 c . liprof .  s  .9*nbrpro. 1-8 : nom du -i-eme profil lu              .
  81 c .        .     .        . 9 : nom de l'objet de type 'Profil' associe.
  82 c . nblopg . es  .   1    . nombre cumule de localisations Gauss a lire.
  83 c . lilopg .  s  .9*nbrlpg. 1-8 : nom de la -i-eme localisation lue    .
  84 c .        .     .        . 9 : nom de l'objet de type 'LocaPG' associe.
  85 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  86 c . langue . e   .    1   . langue des messages                        .
  87 c .        .     .        . 1 : francais, 2 : anglais                  .
  88 c . codret . es  .    1   . code de retour des modules                 .
  89 c .        .     .        . 0 : pas de probleme                        .
  90 c .        .     .        . 1 : probleme                               .
  91 c ______________________________________________________________________
  92 c
  93 c====
  94 c 0. declarations et dimensionnement
  95 c====
  96 c
  97 c 0.1. ==> generalites
  98 c
  99       implicit none
 100       save
 101 c
 102       character*6 nompro
 103       parameter ( nompro = 'ESLSM1' )
 104 c
 105 #include "nblang.h"
 106 #include "consts.h"
 107 #include "meddc0.h"
 108 #include "litme0.h"
 109 c
 110 c 0.2. ==> communs
 111 c
 112 #include "envex1.h"
 113 c
 114 #include "esutil.h"
 115 #include "gmenti.h"
 116 #include "gmreel.h"
 117 #include "gmstri.h"
 118 c
 119 c 0.3. ==> arguments
 120 c
 121       integer*8 idfmed
 122       integer option
 123       integer nbchfi, nbseal
 124       integer nbtosv, nbcham
 125       integer nbprof, nblopg
 126       integer caetal(12,*)
 127 c
 128       double precision cartal(*)
 129 c
 130       character*8 nocham(nbchfi)
 131       character*8 cactal(*)
 132       character*8 liprof(*)
 133       character*8 lilopg(*)
 134       character*64 nomamd
 135 c
 136       integer ulsort, langue, codret
 137 c
 138 c 0.4. ==> variables locales
 139 c
 140       integer codre1, codre2, codre3, codre4, codre5
 141       integer codre0
 142 c
 143       integer lmesh, typcha
 144       integer iaux, jaux, kaux
 145       integer adnocp, adcaen, adcare, adcaca
 146       integer nrocha, nbcomp
 147       integer nbsqch, nbtvlu
 148       integer adtra1
 149       integer nbtvch, numdtx
 150 c
 151       character*8 ntrav1
 152       character*8 obcham
 153       character*64 saux64
 154       character*64 nomcha, nomach
 155 c
 156       logical alire
 157 c
 158       integer nbmess
 159       parameter ( nbmess = 150 )
 160       character*80 texte(nblang,nbmess)
 161 c
 162 c 0.5. ==> initialisations
 163 c ______________________________________________________________________
 164 c
 165 c====
 166 c 1. initialisations
 167 c====
 168 c
 169 #include "impr01.h"
 170 c
 171 #ifdef _DEBUG_HOMARD_
 172       write (ulsort,texte(langue,1)) 'Entree', nompro
 173       call dmflsh (iaux)
 174 #endif
 175 c
 176 #include "esimpr.h"
 177 c
 178 #include "impr03.h"
 179 c
 180 #include "litmed.h"
 181 c
 182       nbcham = 0
 183 c
 184 #ifdef _DEBUG_HOMARD_
 185       write (ulsort,90002) '. Debut de '//nompro//', nbseal', nbseal
 186       write (ulsort,90002) 'Nombre de champs dans le fichier', nbchfi
 187 cgn      write (ulsort,*) '. Premier champ a lire = ',
 188 cgn     >                   cactal(1),cactal(2),cactal(3),cactal(4),
 189 cgn     >                   cactal(5),cactal(6),cactal(7),cactal(8)
 190 #endif
 191 c
 192 c====
 193 c 2. caracterisation des champs
 194 c====
 195 #ifdef _DEBUG_HOMARD_
 196       write (ulsort,90002) '2. caracterisation champ ; codret', codret
 197 #endif
 198 c
 199       nbtosv = 0
 200 c
 201       if ( codret.eq.0 ) then
 202 c
 203       do 20 , nrocha = 1 , nbchfi
 204 c
 205 #ifdef _DEBUG_HOMARD_
 206         if ( codret.eq.0 ) then
 207         write (ulsort,*) ' '
 208         write (ulsort,*) '.......................................'//
 209      >                   '.......................................'
 210         write (ulsort,90002) 'Dans le fichier, champ numero', nrocha
 211         endif
 212 #endif
 213 c
 214 c 2.1. ==> allocation de la structure decrivant le champ numero nrocha.
 215 c          le nom de la structure est conserve dans obcham
 216 c
 217         if ( codret.eq.0 ) then
 218 c
 219         call gmalot ( obcham, 'InfoCham', 0, iaux, codret )
 220 c
 221         endif
 222 c
 223 c 2.2. ==> nombre de composantes du champ courant
 224 c
 225         if ( codret.eq.0 ) then
 226 c
 227 #ifdef _DEBUG_HOMARD_
 228       write (ulsort,texte(langue,3)) 'MFDNFC', nompro
 229 #endif
 230         iaux = nrocha
 231         call mfdnfc ( idfmed, iaux, nbcomp, codret )
 232 c
 233         endif
 234 c
 235 c 2.3. ==> allocation des tableaux decrivant le champ et ses composantes
 236 c          remarque : ce dimensionnement suppose que :
 237 c                    1. le nom des champs est code sur 64 caracteres
 238 c                    2. le nom des composantes l'est sur 16
 239 c                    3. le nom des unites des composantes l'est sur 16
 240 c                    4. le nom de l'unite du pas de temps l'est sur 16
 241 c
 242         if ( codret.eq.0 ) then
 243 #ifdef _DEBUG_HOMARD_
 244       write (ulsort,texte(langue,85)) nbcomp
 245 #endif
 246 c
 247         call gmecat ( obcham, 1, nbcomp, codre1 )
 248         iaux = 8 + 4*nbcomp + 2
 249         call gmaloj ( obcham//'.Nom_Comp', ' ', iaux, adnocp, codre2 )
 250 c
 251         codre0 = min ( codre1, codre2 )
 252         codret = max ( abs(codre0), codret,
 253      >                 codre1, codre2 )
 254 c
 255         endif
 256 c
 257 c 2.4. ==> lecture du nom du champ, du maillage associe, du type
 258 c          de champ, des noms et des unites de ses composantes,
 259 c          de l'unite du pas de temps, du nombre de sequences
 260 c
 261         if ( codret.eq.0 ) then
 262 c
 263 #ifdef _DEBUG_HOMARD_
 264       write (ulsort,texte(langue,3)) 'MFDFDI', nompro
 265 #endif
 266         nomcha = blan64
 267         iaux = nrocha
 268         call mfdfdi ( idfmed, iaux,
 269      >                nomcha, nomach, lmesh, typcha,
 270      >                smem(adnocp+8), smem(adnocp+8+2*nbcomp),
 271      >                smem(adnocp+8+4*nbcomp), nbsqch, codret)
 272 #ifdef _DEBUG_HOMARD_
 273         write(ulsort,texte(langue,32)) nomcha
 274         do 241 , jaux=1,nbcomp
 275           write(ulsort,texte(langue,54))smem(adnocp+8+2*(jaux-1))//
 276      >                                  smem(adnocp+8+2*jaux-1)
 277           write(ulsort,90003) ' unite',
 278      >            smem(adnocp+8+2*nbcomp+2*(jaux-1))//
 279      >            smem(adnocp+8+2*nbcomp+2*(jaux-1)+1)
 280   241   continue
 281         write(ulsort,90003) 'nomach', nomach
 282         write(ulsort,90002) 'lmesh ', lmesh
 283         write(ulsort,90002) 'typcha', typcha
 284         write(ulsort,90003) 'dtunit', smem(adnocp+8+4*nbcomp)//
 285      >                                smem(adnocp+8+4*nbcomp+1)
 286         write(ulsort,90002) 'nbsqch', nbsqch
 287 #endif
 288 c
 289         endif
 290 c
 291 c 2.5. ==> On ne lit le champ que si le nombre de sequences
 292 c          est non nul. Logique.
 293 c
 294         if ( codret.eq.0 ) then
 295 c
 296           if ( nbsqch.gt.0 ) then
 297             alire = .true.
 298           else
 299             alire = .false.
 300           endif
 301 c
 302         endif
 303 c
 304 c 2.6. ==> le champ est-il sur le bon maillage ?
 305 c
 306         if ( alire ) then
 307 c
 308         if ( codret.eq.0 ) then
 309 c
 310 #ifdef _DEBUG_HOMARD_
 311       write (ulsort,90003) 'Nom de ce champ (nomcha)', nomcha
 312       write (ulsort,90003) 'Maillage du champ', nomach
 313       write (ulsort,90003) 'Maillage courant ', nomamd
 314 #endif
 315 c
 316         call utdich ( nomach, nomamd,
 317      >                ulsort, langue, codret )
 318 c
 319         if ( codret.eq.1 .or. codret.eq.2 ) then
 320           alire = .false.
 321           codret = 0
 322         endif
 323 c
 324 #ifdef _DEBUG_HOMARD_
 325         write (ulsort,99001) 'Fin de 2.6. alire', alire
 326 #endif
 327 c
 328         endif
 329 c
 330         endif
 331 c
 332 c 2.7. ==> le champ est-il dans la liste des sequences enregistrees ?
 333 c
 334         if ( alire ) then
 335 c
 336         if ( codret.eq.0 ) then
 337 c
 338 #ifdef _DEBUG_HOMARD_
 339       write (ulsort,90003) 'Nom de ce champ (nomcha)', nomcha
 340 #endif
 341 c
 342         if ( nbseal.gt.0 ) then
 343 c
 344           alire = .false.
 345           do 27 , iaux = 1 , nbseal
 346 c
 347             if ( codret.eq.0 ) then
 348             call uts8ch ( cactal(8*(iaux-1)+1), 64, saux64,
 349      >                    ulsort, langue, codret )
 350             endif
 351 #ifdef _DEBUG_HOMARD_
 352       write (ulsort,90064) iaux,
 353      >                    '-me champ que l''on veut lire : ', saux64
 354 #endif
 355 c
 356             if ( codret.eq.0 ) then
 357 c
 358             if ( saux64.eq.nomcha ) then
 359 #ifdef _DEBUG_HOMARD_
 360               write (ulsort,*) '..... ce champ doit etre lu'
 361 #endif
 362               alire = .true.
 363               caetal(11,iaux) = 1
 364             else
 365               caetal(11,iaux) = 0
 366             endif
 367 c
 368             caetal(12,iaux) = typcha
 369 c
 370             endif
 371 c
 372 #ifdef _DEBUG_HOMARD_
 373            write (ulsort,90005) 'caetal',
 374      >     caetal(1,iaux),caetal(2,iaux),caetal(3,iaux),caetal(4,iaux),
 375      >     caetal(5,iaux),caetal(6,iaux),caetal(7,iaux),
 376      >     caetal(8,iaux),caetal(9,iaux),caetal(10,iaux),
 377      >     caetal(11,iaux),caetal(12,iaux)
 378            write (ulsort,90004) 'cartal', cartal(iaux)
 379 #endif
 380    27     continue
 381 c
 382         endif
 383 c
 384 #ifdef _DEBUG_HOMARD_
 385         write (ulsort,99001) 'Fin de 2.7. alire', alire
 386 #endif
 387 c
 388         endif
 389 c
 390         endif
 391 c
 392 c 2.8. ==> on lira le champ, donc on le garde
 393 c
 394         if ( alire ) then
 395 c
 396         if ( codret.eq.0 ) then
 397 c
 398         iaux = 64
 399         call utchs8 ( nomcha, iaux, smem(adnocp),
 400      >                ulsort, langue, codret )
 401 c
 402         endif
 403 c
 404         endif
 405 c
 406 c 2.9. ==> Nombre de tableaux de valeurs de ce champ ecrits dans le
 407 c          fichier pour toutes les sequences et tous les types
 408 c          geometriques
 409 c
 410         if ( alire ) then
 411 c
 412         if ( codret.eq.0 ) then
 413 c
 414         iaux = 0
 415 #ifdef _DEBUG_HOMARD_
 416       write (ulsort,texte(langue,3)) 'ESLCH1', nompro
 417 #endif
 418         call eslch1 ( idfmed, nomcha, nbsqch,
 419      >                nbtmed, litmed,
 420      >                iaux,
 421      >                nbtvch, numdtx,
 422      >                ulsort, langue, codret )
 423 c
 424 #ifdef _DEBUG_HOMARD_
 425         write (ulsort,90002) 'Nombre total de tableaux de valeurs '//
 426      >                       'presents (nbtvch)', nbtvch
 427         write (ulsort,90002) 'Dernier instant (numdtx)', numdtx
 428 #endif
 429 c
 430         endif
 431 c
 432         if ( codret.eq.0 ) then
 433 c
 434          if ( nbtvch.eq.0 ) then
 435            alire = .false.
 436          endif
 437 c
 438         endif
 439 c
 440         endif
 441 c
 442 c 2.10. ==> description des tableaux de valeurs
 443 c
 444 #ifdef _DEBUG_HOMARD_
 445         write (ulsort,99001) '2.10. alire', alire
 446 #endif
 447 c
 448         if ( alire ) then
 449 c
 450 c 2.10.1. ==> allocation des tableaux decrivant les tableaux de valeurs
 451 c            pour chaque tableau du champ
 452 c
 453         if ( codret.eq.0 ) then
 454 c
 455         iaux = nbinec * nbtvch
 456         call gmaloj ( obcham//'.Cham_Ent', ' ', iaux, adcaen, codre1 )
 457         call gmaloj ( obcham//'.Cham_Ree', ' ',
 458      >                nbtvch, adcare, codre2 )
 459         iaux = nbincc * nbtvch
 460         call gmaloj ( obcham//'.Cham_Car', ' ',
 461      >                iaux, adcaca, codre3 )
 462 c
 463         codre0 = min ( codre1, codre2, codre3 )
 464         codret = max ( abs(codre0), codret,
 465      >                 codre1, codre2, codre3 )
 466 c
 467         endif
 468 c
 469 c 2.10.2. ==> remplissage des caracteristiques
 470 c
 471         if ( codret.eq.0 ) then
 472 c
 473 #ifdef _DEBUG_HOMARD_
 474       write (ulsort,texte(langue,3)) 'ESLCH2', nompro
 475 #endif
 476         call eslch2 ( idfmed, nomcha, numdtx, typcha,
 477      >                nbtmed, litmed,
 478      >                nbsqch, nbtvch, nbtvlu,
 479      >                nbcham, nbseal, caetal, cartal,
 480      >                imem(adcaen), rmem(adcare), smem(adcaca),
 481      >                nbprof, liprof,
 482      >                nblopg, lilopg,
 483      >                ulsort, langue, codret )
 484 c
 485 #ifdef _DEBUG_HOMARD_
 486         write (ulsort,90002) '... nombre total de tableaux de '//
 487      >                       'valeurs a lire (nbtvlu)', nbtvlu
 488         call gmprsx (nompro, obcham )
 489         call gmprsx (nompro, obcham//'.Cham_Ent' )
 490         call gmprsx (nompro, obcham//'.Cham_Ree' )
 491         call gmprsx (nompro, obcham//'.Cham_Car' )
 492 #endif
 493 c
 494         endif
 495 c
 496         endif
 497 c
 498 c 2.11. ==> gestion de l'objet qui memorise le champ
 499 c 2.11.1. ==> quand on garde le champ, on memorise son nom et on
 500 c             ajuste la taille des tableaux
 501 c
 502 #ifdef _DEBUG_HOMARD_
 503         write (ulsort,99001) 'Debut de 2.11, alire',alire
 504         write (ulsort,90002) 'nbcham', nbcham
 505 #endif
 506 c
 507         if ( alire ) then
 508 c
 509         if ( codret.eq.0 ) then
 510 c
 511         nbcham = nbcham + 1
 512         nocham(nbcham) = obcham
 513 c
 514         nbtosv = nbtosv + nbtvlu
 515 c
 516         if ( codret.eq.0 ) then
 517 #ifdef _DEBUG_HOMARD_
 518         if ( codret.eq.0 ) then
 519         write (ulsort,21000) nbcham, nomcha
 520         call gmprsx (nompro, obcham )
 521         call gmprsx (nompro, obcham//'.Nom_Comp' )
 522         call gmprsx (nompro, obcham//'.Cham_Ent' )
 523         call gmprsx (nompro, obcham//'.Cham_Ree' )
 524         call gmprsx (nompro, obcham//'.Cham_Car' )
 525         endif
 526 #endif
 527 c
 528         call gmecat ( obcham, 2, nbtvlu, codre1 )
 529         call gmecat ( obcham, 3, typcha, codre2 )
 530         call gmmod ( obcham//'.Cham_Ent',
 531      >               adcaen, nbinec, nbinec, nbtvch, nbtvlu, codre3 )
 532         call gmmod ( obcham//'.Cham_Ree',
 533      >               adcare, 1, 1, nbtvch, nbtvlu, codre4 )
 534         call gmmod ( obcham//'.Cham_Car',
 535      >               adcaca, nbincc, nbincc, nbtvch, nbtvlu, codre5 )
 536 c
 537         codre0 = min ( codre1, codre2, codre3, codre4, codre5 )
 538         codret = max ( abs(codre0), codret,
 539      >                 codre1, codre2, codre3, codre4, codre5 )
 540 c
 541         endif
 542 c
 543 #ifdef _DEBUG_HOMARD_
 544         write (ulsort,90002) 'nombre cumule de tableaux de '//
 545      >                       ' valeurs (nbtosv) = ',nbtosv
 546 #endif
 547 #ifdef _DEBUG_HOMARD_
 548           if ( codret.eq.0 ) then
 549           write (ulsort,21000) nbcham, nomcha
 550 21000 format(/,'Champ numero ',i3,' : ',a64,/,18('='),/)
 551           call gmprsx (nompro, obcham )
 552           call gmprsx (nompro, obcham//'.Nom_Comp' )
 553           call gmprsx (nompro, obcham//'.Cham_Ent' )
 554           call gmprsx (nompro, obcham//'.Cham_Ree' )
 555           call gmprsx (nompro, obcham//'.Cham_Car' )
 556           endif
 557 #endif
 558 c
 559 c 2.11.2. ==> N'etant pas lu, le champ est detruit
 560 c
 561         else
 562 c
 563           if ( codret.eq.0 ) then
 564 c
 565           call gmsgoj ( obcham, codret )
 566 c
 567           endif
 568 c
 569         endif
 570 c
 571         endif
 572 c
 573 #ifdef _DEBUG_HOMARD_
 574       write (ulsort,90002)
 575      > nompro//', avant 20 continue, pour nrocha',nrocha
 576       call dmflsh (iaux)
 577 #endif
 578 c
 579    20 continue
 580 c
 581       endif
 582 c
 583 c====
 584 c 3. On parcourt tous les champs enregistres pour memoriser les
 585 c    relations entre les champs aux points de Gauss et leurs
 586 c    homologues aux noeuds par elements
 587 c    il faut traiter dans l'ordre :
 588 c    1. Les champs standards
 589 c    2. Les champs aux points de Gauss
 590 c    3. Les champs aux noeuds par element
 591 c====
 592 c
 593 #ifdef _DEBUG_HOMARD_
 594       write (ulsort,90002) '... Debut de 3., codret', codret
 595 #endif
 596 c
 597       if ( option.eq.1 ) then
 598 c
 599 #ifdef _DEBUG_HOMARD_
 600       do 33333 , iaux=1,nbtosv
 601           write (ulsort,*) '... Champ '//cactal(8*iaux-7)//
 602      >    cactal(8*iaux-6)//cactal(8*iaux-5)//cactal(8*iaux-4)//
 603      >    cactal(8*iaux-3)//
 604      >    cactal(8*iaux-2)//cactal(8*iaux-1)//cactal(8*iaux)
 605           write (ulsort,90005) '.. caetal',
 606      >    caetal(1,iaux),caetal(2,iaux),caetal(3,iaux),caetal(4,iaux),
 607      >    caetal(5,iaux),caetal(6,iaux),caetal(7,iaux),
 608      >    caetal(8,iaux),caetal(9,iaux),caetal(10,iaux),
 609      >    caetal(11,iaux)
 610           write (ulsort,90004) '.. cartal',cartal(iaux)
 611 33333 continue
 612 #endif
 613 c
 614 c 3.1. ==> allocation d'un tableau auxiliaire pour memoriser les
 615 c          correspondances
 616 c
 617       if ( codret.eq.0 ) then
 618       call gmalot ( ntrav1, 'entier  ', nbcham, adtra1, codret )
 619       endif
 620       do 30 , iaux = adtra1 , adtra1+nbcham-1
 621         imem(iaux) = -1
 622    30 continue
 623 c
 624       do 3 , jaux = 1 , 3
 625 c
 626 c 3.2. ==> choix du type de champ a traiter
 627 c
 628         if ( codret.eq.0 ) then
 629 c
 630 #ifdef _DEBUG_HOMARD_
 631       write (ulsort,*) ' '
 632       write (ulsort,*) '+++++++++++++++++++++++++++++++++++++++++'
 633       write (ulsort,texte(langue,64+jaux))
 634 #endif
 635         if ( jaux.eq.1 ) then
 636           kaux = 0
 637         elseif ( jaux.eq.2 ) then
 638           kaux = 2
 639         else
 640           kaux = 1
 641         endif
 642 c
 643         endif
 644 c
 645 c 3.3. ==> parcours des champs enregistres
 646 c
 647         do 33 , nrocha = 1 , nbcham
 648 c
 649 c 3.3.1. ==> caracteristiques du champ numero nrocha
 650 c
 651           if ( codret.eq.0 ) then
 652 c
 653           obcham = nocham(nrocha)
 654 c
 655           call gmliat ( obcham, 2, nbtvlu, codre1 )
 656           call gmadoj ( obcham//'.Cham_Ent', adcaen, iaux, codre2 )
 657           call gmadoj ( obcham//'.Nom_Comp', adnocp, iaux, codre3 )
 658 c
 659           codre0 = min ( codre1, codre2, codre3 )
 660           codret = max ( abs(codre0), codret,
 661      >                   codre1, codre2, codre3 )
 662 c
 663           endif
 664 c
 665           if ( codret.eq.0 ) then
 666             iaux = 64
 667             call uts8ch ( smem(adnocp), iaux, nomcha,
 668      >                    ulsort, langue, codret )
 669           endif
 670 c
 671 c 3.3.2. ==> appel ad-hoc
 672 c
 673           if ( codret.eq.0 ) then
 674 c
 675 #ifdef _DEBUG_HOMARD_
 676       write (ulsort,texte(langue,3)) 'ESLCH6', nompro
 677 cgn          call gmprsx (nompro, obcham//'.Cham_Ent' )
 678 #endif
 679           iaux = nrocha
 680           call eslch6 ( iaux, kaux, nbtvlu, imem(adcaen), nomcha,
 681      >                  nbtosv, caetal,
 682      >                  nbcham, imem(adtra1),
 683      >                  ulsort, langue, codret )
 684 c
 685           endif
 686 c
 687 #ifdef _DEBUG_HOMARD_
 688           if ( codret.eq.0 ) then
 689           write (ulsort,31000) nomcha, nrocha
 690 31000 format(/,60('='),/,'Champ ',a,', de numero ',i3,/)
 691           call gmprsx (nompro, obcham )
 692           call gmprsx (nompro, obcham//'.Cham_Ent' )
 693           endif
 694 #endif
 695 c
 696    33   continue
 697 c
 698     3 continue
 699 c
 700       if ( codret.eq.0 ) then
 701 c
 702       call gmlboj ( ntrav1, codret )
 703 c
 704       endif
 705 c
 706       endif
 707 c
 708 c====
 709 c 4. controle de la presence des champs demandes
 710 c    on memorise le codret dans la variable jaux
 711 c====
 712 c
 713 #ifdef _DEBUG_HOMARD_
 714       write (ulsort,90002) '... Debut de 4., codret', codret
 715 #endif
 716 c
 717       jaux = 0
 718 c
 719       do 4 , iaux = 1 , nbseal
 720 c
 721         if ( codret.eq.0 ) then
 722 c
 723 #ifdef _DEBUG_HOMARD_
 724         write (ulsort,90005) 'caetal',
 725      >  caetal(1,iaux),caetal(2,iaux),caetal(3,iaux),caetal(4,iaux),
 726      >  caetal(5,iaux),caetal(6,iaux),caetal(7,iaux),
 727      >  caetal(8,iaux),caetal(9,iaux),caetal(10,iaux),
 728      >  caetal(11,iaux),caetal(12,iaux)
 729         write (ulsort,90004) 'cartal', cartal(iaux)
 730         write (ulsort,90122) 'caetal', 9, iaux, caetal(9,iaux)
 731 #endif
 732 c
 733         if ( caetal(9,iaux).eq.0 ) then
 734 c
 735           jaux = 1
 736 c
 737           if ( codret.eq.0 ) then
 738           call uts8ch ( cactal(8*iaux-7), 64, saux64,
 739      >                  ulsort, langue, codret )
 740           endif
 741           if ( codret.eq.0 ) then
 742           write (ulsort,texte(langue,32)) saux64
 743           if ( caetal(2,iaux).gt.0 ) then
 744             write (ulsort,texte(langue,113)) caetal(3,iaux)
 745           endif
 746           if ( caetal(4,iaux).gt.0 ) then
 747             write (ulsort,texte(langue,114)) caetal(5,iaux)
 748           endif
 749           if ( caetal(6,iaux).gt.0 ) then
 750             write (ulsort,texte(langue,115)) cartal(iaux)
 751           endif
 752           write (ulsort,texte(langue,92))
 753           endif
 754 c
 755         endif
 756 c
 757         endif
 758 c
 759     4 continue
 760 c
 761       if ( jaux.ne.0 ) then
 762         codret = 1
 763       endif
 764 c
 765 c====
 766 c 5. la fin
 767 c====
 768 c
 769       if ( codret.ne.0 ) then
 770 c
 771 #include "envex2.h"
 772 c
 773       write (ulsort,texte(langue,1)) 'Sortie', nompro
 774       write (ulsort,texte(langue,2)) codret
 775 c
 776       endif
 777 c
 778 #ifdef _DEBUG_HOMARD_
 779       write (ulsort,texte(langue,1)) 'Sortie', nompro
 780       call dmflsh (iaux)
 781 #endif
 782 c
 783       end
 784