src/tool/Modification/mmagf0.F

   1       subroutine mmagf0 ( nbjoto, nbjois, nbjoit, nbjoiq,
   2      >                    nbjp06, nbjp09, nbjp12,
   3      >                    nhnoeu, nhmapo, nharet, nhtria, nhquad,
   4      >                    nhtetr, nhhexa, nhpyra, nhpent,
   5      >                    nhsupe, nhsups,
   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    Modification de Maillage - AGregat - Famille - phase 0
  28 c    -               -          --        -               -
  29 c    Creation des nouvelles familles MED
  30 c ______________________________________________________________________
  31 c .        .     .        .                                            .
  32 c .  nom   . e/s . taille .           description                      .
  33 c .____________________________________________________________________.
  34 c . nbjoto . e   .   1    . nombre total de joints                     .
  35 c . nbjois . e   .   1    . nombre de joints simples                   .
  36 c . nbjoit . e   .   1    . nombre de joints triples                   .
  37 c . nbjoiq . e   .   1    . nombre de joints quadruples                .
  38 c . nbjp06 . e   .   1    . nombre de joints ponctuels ordre 6         .
  39 c . nbjp09 . e   .   1    . nombre de joints ponctuels ordre 9         .
  40 c . nbjp12 . e   .   1    . nombre de joints ponctuels ordre 12        .
  41 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  42 c . langue . e   .    1   . langue des messages                        .
  43 c .        .     .        . 1 : francais, 2 : anglais                  .
  44 c . codret . es  .    1   . code de retour des modules                 .
  45 c .        .     .        . 0 : pas de probleme                        .
  46 c ______________________________________________________________________
  47 c
  48 c====
  49 c 0. declarations et dimensionnement
  50 c====
  51 c
  52 c 0.1. ==> generalites
  53 c
  54       implicit none
  55       save
  56 c
  57       character*6 nompro
  58       parameter ( nompro = 'MMAGF0' )
  59 c
  60 #include "nblang.h"
  61 #include "consts.h"
  62 c
  63 c 0.2. ==> communs
  64 c
  65 #include "meddc0.h"
  66 #include "envex1.h"
  67 c
  68 #include "gmenti.h"
  69 #include "gmstri.h"
  70 c
  71 #include "coftex.h"
  72 #include "nbfami.h"
  73 #include "dicfen.h"
  74 c
  75 #ifdef _DEBUG_HOMARD_
  76 #include "nombmp.h"
  77 #include "nombhe.h"
  78 #include "nombpe.h"
  79 #include "nombpy.h"
  80 #endif
  81 c
  82 #include "impr02.h"
  83 c
  84 c 0.3. ==> arguments
  85 c
  86       integer nbjoto, nbjois, nbjoit, nbjoiq
  87       integer nbjp06, nbjp09, nbjp12
  88 c
  89       character*8 nhnoeu, nhmapo, nharet, nhtria, nhquad
  90       character*8 nhtetr, nhhexa, nhpyra, nhpent
  91       character*8 nhsupe, nhsups
  92 c
  93       integer ulsort, langue, codret
  94 c
  95 c 0.4. ==> variables locales
  96 c
  97       integer iaux, jaux
  98       integer codre1, codre2, codre3, codre4, codre5
  99       integer codre0
 100 c
 101       integer nbfmed, nbfme0, nbfmaj
 102       integer lgte6n, lgte60
 103       integer lgts2n, lgts20
 104       integer adtae5, adtae6, adtae9, adtas2, adtas4
 105       integer typenh
 106       integer nctfen, nbfaen, pcfaen
 107       integer nbfte0
 108       integer pcfaqu
 109       integer pcfate
 110       integer pcfahe
 111       integer pcfape
 112 #ifdef _DEBUG_HOMARD_
 113       integer pfamno, pcfano
 114       integer pfammp, pcfamp
 115       integer pfamar, pcfaar
 116       integer pfamtr, pcfatr
 117       integer pfamqu
 118       integer pfamte
 119       integer pfamhe
 120       integer pfampy, pcfapy
 121       integer pfampe
 122 #endif
 123 c
 124       integer decafa
 125 c
 126       character*8 nhqufa, nhtefa, nhpefa, nhhefa
 127       character*8 nhenti
 128 c
 129       integer nbmess
 130       parameter ( nbmess = 10 )
 131       character*80 texte(nblang,nbmess)
 132 c
 133 c 0.5. ==> initialisations
 134 c ______________________________________________________________________
 135 c
 136 c====
 137 c 1. prealables
 138 c====
 139 c 1.1. ==> messages
 140 c
 141 #include "impr01.h"
 142 c
 143 #ifdef _DEBUG_HOMARD_
 144       write (ulsort,texte(langue,1)) 'Entree', nompro
 145       call dmflsh (iaux)
 146 #endif
 147 c
 148       texte(1,4) = '(''Decalage dans les numeros des familles :'',i5)'
 149       texte(1,5) =
 150      >'(''Ancien nombre de familles HOMARD de  '',a,'' :'',i5)'
 151       texte(1,6) =
 152      >'(''Nouveau nombre de familles HOMARD de '',a,'' :'',i5)'
 153       texte(1,7) = '(''Nombre de familles MED '',a,'' :'',i5)'
 154 c
 155       texte(2,4) = '(''Shift with numbers of the families :'',i5)'
 156       texte(2,5) =
 157      >'(''Old number of HOMARD families of '',a,'' :'',i5)'
 158       texte(2,6) =
 159      >'(''New number of HOMARD families of '',a,'' :'',i5)'
 160       texte(2,7) = '(''Number of MED families '',a,'' :'',i5)'
 161 c
 162       codret = 0
 163 c
 164 c====
 165 c 2. Gestion des tableaux
 166 c====
 167 c 2.1. ==> Familles des quadrangles : uniquement la famille libre
 168 c
 169       nbfqua = 1
 170 #ifdef _DEBUG_HOMARD_
 171       write (ulsort,texte(langue,6)) mess14(langue,3,4), nbfqua
 172 #endif
 173 c
 174       if ( codret.eq.0 ) then
 175 c
 176       call gmnomc ( nhquad//'.Famille', nhqufa, codret )
 177 c
 178       endif
 179 c
 180       if ( codret.eq.0 ) then
 181 c
 182       nctfqu = ncffqu
 183 c
 184 #ifdef _DEBUG_HOMARD_
 185       write (ulsort,texte(langue,3)) 'UTFAM1_qu', nompro
 186 #endif
 187       iaux = 4
 188       call utfam1 ( iaux, nhqufa, pcfaqu,
 189      >              nctfqu, jaux, nbfqua,
 190      >              ulsort, langue, codret )
 191 c
 192       endif
 193 c
 194 c 2.2. ==> Familles des tetraedres
 195 c
 196       nbfte0 = nbftet
 197 c
 198       if ( nbjp06.ne.0 ) then
 199 c
 200         nbftet = nbfte0 + nbjp06
 201 #ifdef _DEBUG_HOMARD_
 202       write (ulsort,texte(langue,5)) mess14(langue,3,3), nbfte0
 203       write (ulsort,texte(langue,6)) mess14(langue,3,3), nbftet
 204 #endif
 205 c
 206         if ( codret.eq.0 ) then
 207 c
 208         call gmnomc ( nhtetr//'.Famille', nhtefa, codret )
 209 c
 210         endif
 211 c
 212         if ( codret.eq.0 ) then
 213 c
 214         nctfhe = ncffhe
 215 c
 216 #ifdef _DEBUG_HOMARD_
 217         write (ulsort,texte(langue,3)) 'UTFAM1_te', nompro
 218 #endif
 219         iaux = 3
 220         call utfam1 ( iaux, nhtefa, pcfate,
 221      >                nctfte, nbfte0, nbftet,
 222      >                ulsort, langue, codret )
 223 c
 224         endif
 225 c
 226       endif
 227 c
 228 c 2.3. ==> Familles des pentaedres
 229 c
 230       nbfpen = 1 + nbjois + nbjoit + nbjp09
 231 #ifdef _DEBUG_HOMARD_
 232       write (ulsort,texte(langue,6)) mess14(langue,3,7), nbfpen
 233 #endif
 234 c
 235       if ( codret.eq.0 ) then
 236 c
 237       call gmnomc ( nhpent//'.Famille', nhpefa, codret )
 238 c
 239       endif
 240 c
 241       if ( codret.eq.0 ) then
 242 c
 243       nctfpe = ncffpe
 244 c
 245 #ifdef _DEBUG_HOMARD_
 246       write (ulsort,texte(langue,3)) 'UTFAM1_pe', nompro
 247 #endif
 248       iaux = 7
 249       call utfam1 ( iaux, nhpefa, pcfape,
 250      >              nctfpe, jaux, nbfpen,
 251      >              ulsort, langue, codret )
 252 c
 253       endif
 254 c
 255 c 2.4. ==> Familles des hexaedres
 256 c
 257       if ( nbjoiq.ne.0 ) then
 258 c
 259         nbfhex = 1 + nbjoiq + nbjp12
 260 #ifdef _DEBUG_HOMARD_
 261       write (ulsort,texte(langue,6)) mess14(langue,3,7), nbfhex
 262 #endif
 263 c
 264         if ( codret.eq.0 ) then
 265 c
 266         call gmnomc ( nhhexa//'.Famille', nhhefa, codret )
 267 c
 268         endif
 269 c
 270         if ( codret.eq.0 ) then
 271 c
 272         nctfhe = ncffhe
 273 c
 274 #ifdef _DEBUG_HOMARD_
 275         write (ulsort,texte(langue,3)) 'UTFAM1_he', nompro
 276 #endif
 277         iaux = 6
 278         call utfam1 ( iaux, nhhefa, pcfahe,
 279      >                nctfhe, jaux, nbfhex,
 280      >                ulsort, langue, codret )
 281 c
 282         endif
 283 c
 284       endif
 285 c
 286 c====
 287 c 3. Memorisation des familles MED
 288 c====
 289 c
 290 #ifdef _DEBUG_HOMARD_
 291       write (ulsort,*) '5.2. ; codret = ', codret
 292 #endif
 293 cgn      call gmprsx(nompro,nhpefa//'.Codes')
 294 cgn      call gmprsx(nompro,nhsupe)
 295 cgn      call gmprsx(nompro,nhsupe//'.Tab5')
 296 cgn      call gmprsx(nompro,nhsupe//'.Tab6')
 297 cgn      call gmprsx(nompro,nhsupe//'.Tab9')
 298 cgn      call gmprsx(nompro,nhsups)
 299 cgn      call gmprsx(nompro,nhsups//'.Tab2')
 300 cgn      call gmprsx(nompro,nhsups//'.Tab4')
 301 c
 302 c 3.1. ==> Nombre de familles MED
 303 c
 304 #ifdef _DEBUG_HOMARD_
 305       write (ulsort,*) '3.1. Nombre familles MED ; codret = ', codret
 306 #endif
 307 c
 308 c     Ancien nombre
 309 c
 310       if ( codret.eq.0 ) then
 311 c
 312       call gmliat ( nhsupe, 9, nbfme0, codret )
 313 c
 314       endif
 315 c
 316 c     Nombre de familles MED ajoute :
 317 c     Pour un type de mailles, il y a 1 famille MED de moins que
 318 c     de familles HOMARD
 319 c
 320       nbfmaj = nbfpen - 1
 321       if ( nbfhex.gt.0 ) then
 322         nbfmaj = nbfmaj + nbfhex - 1
 323       endif
 324       nbfmaj = nbfmaj + nbjp06
 325 c
 326       nbfmed = nbfme0 + nbfmaj
 327 c
 328 #ifdef _DEBUG_HOMARD_
 329       write (ulsort,texte(langue,7)) 'avant', nbfme0
 330       write (ulsort,texte(langue,5)) mess14(langue,3,3), nbfte0
 331       write (ulsort,texte(langue,6)) mess14(langue,3,3), nbftet
 332       write (ulsort,texte(langue,6)) mess14(langue,3,6), nbfhex
 333       write (ulsort,texte(langue,6)) mess14(langue,3,7), nbfpen
 334       write (ulsort,texte(langue,7)) 'apres', nbfmed
 335 #endif
 336 c
 337 c 3.1. ==> Gestions des groupes
 338 #ifdef _DEBUG_HOMARD_
 339       write (ulsort,*) '3.1. Groupes ; codret = ', codret
 340 #endif
 341 c
 342       if ( codret.eq.0 ) then
 343 c
 344       call gmliat ( nhsupe, 6, lgte60, codre1 )
 345       call gmliat ( nhsups, 2, lgts20, codre2 )
 346 c
 347       codre0 = min ( codre1, codre2 )
 348       codret = max ( abs(codre0), codret,
 349      >               codre1, codre2 )
 350 c
 351       endif
 352 c
 353       if ( codret.eq.0 ) then
 354 c
 355       call gmecat ( nhsupe, 5, nbfmed, codre1 )
 356       lgte6n = lgte60 + 10*2*nbfmaj
 357       call gmecat ( nhsupe, 6, lgte6n, codre2 )
 358       call gmecat ( nhsupe, 9, nbfmed, codre3 )
 359       lgts2n = lgts20 + 10*2*nbfmaj
 360       call gmecat ( nhsups, 2, lgts2n, codre4 )
 361       iaux = 10*nbfmed
 362       call gmecat ( nhsups, 4, iaux, codre5 )
 363 c
 364       codre0 = min ( codre1, codre2, codre3, codre4, codre5 )
 365       codret = max ( abs(codre0), codret,
 366      >               codre1, codre2, codre3, codre4, codre5 )
 367 c
 368       endif
 369 c
 370       if ( codret.eq.0 ) then
 371 c
 372       call gmmod ( nhsupe//'.Tab5', adtae5,
 373      >             1, 1, nbfme0+1, nbfmed+1, codre1 )
 374       call gmmod ( nhsupe//'.Tab6', adtae6,
 375      >             1, 1, lgte60, lgte6n, codre2 )
 376       call gmmod ( nhsupe//'.Tab9', adtae9,
 377      >             1, 1, nbfme0, nbfmed, codre3 )
 378       call gmmod ( nhsups//'.Tab2', adtas2,
 379      >             1, 1, lgts20, lgts2n, codre4 )
 380       call gmmod ( nhsups//'.Tab4', adtas4,
 381      >             1, 1, 10*nbfme0, 10*nbfmed, codre5 )
 382 c
 383       codre0 = min ( codre1, codre2, codre3, codre4, codre5 )
 384       codret = max ( abs(codre0), codret,
 385      >               codre1, codre2, codre3, codre4, codre5 )
 386 c
 387       endif
 388 c
 389 c====
 390 c 4. Recherche du decalage dans les numeros de familles MED de mailles
 391 c====
 392 #ifdef _DEBUG_HOMARD_
 393       write (ulsort,*) '4. decalage ; codret = ', codret
 394 #endif
 395 c
 396       if ( codret.eq.0 ) then
 397 c
 398       decafa = 0
 399 c
 400       do 40 , typenh = 0 , 4
 401 c
 402         if ( codret.eq.0 ) then
 403 c
 404         if ( typenh.eq.0 ) then
 405           nhenti = nhmapo
 406           nctfen = nctfmp
 407           nbfaen = nbfmpo
 408         elseif ( typenh.eq.1 ) then
 409           nhenti = nharet
 410           nctfen = nctfar
 411           nbfaen = nbfare
 412         elseif ( typenh.eq.2 ) then
 413           nhenti = nhtria
 414           nctfen = nctftr
 415           nbfaen = nbftri
 416         elseif ( typenh.eq.3 ) then
 417           nhenti = nhtetr
 418           nctfen = nctfte
 419           nbfaen = nbfte0
 420         elseif ( typenh.eq.4 ) then
 421           nhenti = nhquad
 422           nctfen = nctfqu
 423           nbfaen = nbfqua
 424         endif
 425 c
 426         endif
 427 c
 428         if ( nbfaen.gt.0 ) then
 429 c
 430 #ifdef _DEBUG_HOMARD_
 431           write (ulsort,*) ' '
 432           write (ulsort,*) mess14(langue,4,typenh)
 433           write (ulsort,*) 'nbfaen', nbfaen
 434           write (ulsort,*) 'nctfen', nctfen
 435 #endif
 436 c
 437           if ( codret.eq.0 ) then
 438 c
 439           call gmadoj ( nhenti//'.Famille.Codes',
 440      >                  pcfaen, iaux, codret )
 441 c
 442           endif
 443 c
 444           if ( codret.eq.0 ) then
 445 c
 446           do 401 , iaux = 1 , nbfaen
 447 c
 448 cgn          write (ulsort,*)imem(pcfaen+(iaux-1)*nctfen+cofamd-1)
 449             decafa = min(decafa,imem(pcfaen+(iaux-1)*nctfen+cofamd-1))
 450 c
 451   401     continue
 452 c
 453           endif
 454 c
 455         endif
 456 c
 457    40 continue
 458 c
 459 #ifdef _DEBUG_HOMARD_
 460       write (ulsort,texte(langue,4)) decafa
 461 #endif
 462 c
 463       endif
 464 c
 465 c====
 466 c 5. Creation des tableaux
 467 c====
 468 #ifdef _DEBUG_HOMARD_
 469       write (ulsort,*) '5. Creation des tableaux ; codret = ', codret
 470 #endif
 471 c
 472       if ( codret.eq.0 ) then
 473 c
 474 cgn      call gmprsx(nompro,nhpefa//'.Codes')
 475 cgn      call gmprsx(nompro,nhsupe)
 476 cgn      call gmprsx(nompro,nhsupe//'.Tab5')
 477 cgn      call gmprsx(nompro,nhsupe//'.Tab6')
 478 cgn      call gmprsx(nompro,nhsupe//'.Tab9')
 479 cgn      call gmprsx(nompro,nhsups)
 480 cgn      call gmprsx(nompro,nhsups//'.Tab2')
 481 cgn      call gmprsx(nompro,nhsups//'.Tab4')
 482 c
 483 #ifdef _DEBUG_HOMARD_
 484       write (ulsort,texte(langue,3)) 'MMAGF1', nompro
 485 #endif
 486       call mmagf1 ( decafa,
 487      >              imem(pcfaqu),
 488      >              imem(pcfate), nbfte0, imem(pcfape), imem(pcfahe),
 489      >              nbfme0, nbfmed,
 490      >              nbjois, nbjoit, nbjoiq,
 491      >              nbjp06, nbjp09, nbjp12,
 492      >              imem(adtae5), imem(adtae6), smem(adtas2),
 493      >              imem(adtae9), smem(adtas4),
 494      >              nbjoto,
 495      >              ulsort, langue, codret )
 496 cgn      call gmprsx(nompro,nhtefa//'.Codes')
 497 cgn      call gmprsx(nompro,nhpefa//'.Codes')
 498 cgn      call gmprsx(nompro,nhsupe)
 499 cgn      call gmprsx(nompro,nhsupe//'.Tab5')
 500 cgn      call gmprsx(nompro,nhsupe//'.Tab6')
 501 cgn      call gmprsx(nompro,nhsupe//'.Tab9')
 502 cgn      call gmprsx(nompro,nhsups)
 503 cgn      call gmprsx(nompro,nhsups//'.Tab2')
 504 cgn      call gmprsx(nompro,nhsups//'.Tab4')
 505 c
 506       endif
 507 c
 508 #ifdef _DEBUG_HOMARD_
 509 c====
 510 c 6. Impression eventuelle
 511 c====
 512 #ifdef _DEBUG_HOMARD_
 513       write (ulsort,*) '6. Impression eventuelle ; codret = ', codret
 514 #endif
 515 c
 516 c 6.1.==> Pointeurs
 517 c
 518       if ( codret.eq.0 ) then
 519 c
 520 #ifdef _DEBUG_HOMARD_
 521       write (ulsort,texte(langue,3)) 'UTAD01', nompro
 522 #endif
 523       iaux = 7
 524       call utad01 ( iaux, nhnoeu,
 525      >                jaux,
 526      >              pfamno, pcfano,   jaux,
 527      >                jaux,   jaux,   jaux,  jaux,
 528      >              ulsort, langue, codret )
 529 c
 530       if ( nbmpto.ne.0 ) then
 531 c
 532 #ifdef _DEBUG_HOMARD_
 533       write (ulsort,texte(langue,3)) 'UTAD02_mp', nompro
 534 #endif
 535         iaux = 259
 536         call utad02 ( iaux, nhmapo,
 537      >                  jaux,   jaux, jaux  , jaux,
 538      >                pfammp, pcfamp,   jaux,
 539      >                  jaux,   jaux,   jaux,
 540      >                  jaux,   jaux,   jaux,
 541      >                ulsort, langue, codret )
 542 c
 543       endif
 544 c
 545 #ifdef _DEBUG_HOMARD_
 546       write (ulsort,texte(langue,3)) 'UTAD02_ar', nompro
 547 #endif
 548       iaux = 259
 549       call utad02 ( iaux, nharet,
 550      >                jaux,   jaux,   jaux,   jaux,
 551      >              pfamar, pcfaar,   jaux,
 552      >                jaux,   jaux,   jaux,
 553      >                jaux,   jaux,   jaux,
 554      >              ulsort, langue, codret )
 555 c
 556 #ifdef _DEBUG_HOMARD_
 557       write (ulsort,texte(langue,3)) 'UTAD02_tr', nompro
 558 #endif
 559       iaux = 259
 560       call utad02 ( iaux, nhtria,
 561      >                jaux,   jaux,   jaux,   jaux,
 562      >              pfamtr, pcfatr,   jaux,
 563      >                jaux,   jaux,   jaux,
 564      >                jaux,   jaux,   jaux,
 565      >              ulsort, langue, codret )
 566 c
 567 #ifdef _DEBUG_HOMARD_
 568       write (ulsort,texte(langue,3)) 'UTAD02_qu', nompro
 569 #endif
 570       iaux = 259
 571       call utad02 ( iaux, nhquad,
 572      >                jaux,   jaux,   jaux,   jaux,
 573      >              pfamqu, pcfaqu,   jaux,
 574      >                jaux,   jaux,   jaux,
 575      >                jaux,   jaux,   jaux,
 576      >              ulsort, langue, codret )
 577 c
 578 #ifdef _DEBUG_HOMARD_
 579       write (ulsort,texte(langue,3)) 'UTAD02_te', nompro
 580 #endif
 581       iaux = 259
 582       call utad02 ( iaux, nhtetr,
 583      >                jaux,   jaux,   jaux,   jaux,
 584      >              pfamte, pcfate,   jaux,
 585      >                jaux,   jaux,   jaux,
 586      >                jaux,   jaux,   jaux,
 587      >              ulsort, langue, codret )
 588 c
 589       if ( nbheto.ne.0 ) then
 590 c
 591 #ifdef _DEBUG_HOMARD_
 592       write (ulsort,texte(langue,3)) 'UTAD02_he', nompro
 593 #endif
 594         iaux = 259
 595         call utad02 ( iaux, nhhexa,
 596      >                  jaux,   jaux,   jaux,   jaux,
 597      >                pfamhe, pcfahe,   jaux,
 598      >                  jaux,   jaux,   jaux,
 599      >                  jaux,   jaux,   jaux,
 600      >                ulsort, langue, codret )
 601 c
 602       endif
 603 c
 604       if ( nbpyto.ne.0 ) then
 605 c
 606 #ifdef _DEBUG_HOMARD_
 607       write (ulsort,texte(langue,3)) 'UTAD02_py', nompro
 608 #endif
 609         iaux = 259
 610         call utad02 ( iaux, nhpyra,
 611      >                  jaux,   jaux,   jaux,   jaux,
 612      >                pfampy, pcfapy,   jaux,
 613      >                  jaux,   jaux,   jaux,
 614      >                  jaux,   jaux,   jaux,
 615      >                ulsort, langue, codret )
 616 c
 617       endif
 618 c
 619       if ( nbpeto.ne.0 ) then
 620 c
 621 #ifdef _DEBUG_HOMARD_
 622       write (ulsort,texte(langue,3)) 'UTAD02_pe', nompro
 623 #endif
 624         iaux = 259
 625         call utad02 ( iaux, nhpent,
 626      >                  jaux,   jaux,   jaux,   jaux,
 627      >                pfampe, pcfape,  jaux,
 628      >                  jaux,   jaux,  jaux,
 629      >                  jaux,   jaux,   jaux,
 630      >                ulsort, langue, codret )
 631 c
 632       endif
 633 c
 634       endif
 635 c
 636 c 6.2 ==> Impressions
 637 c
 638       if ( codret.eq.0 ) then
 639 c
 640       iaux = 0
 641 #ifdef _DEBUG_HOMARD_
 642       write (ulsort,texte(langue,3)) 'UTECFE', nompro
 643 #endif
 644       call utecfe ( iaux,
 645      >              imem(pfamno), imem(pcfano),
 646      >              imem(pfammp), imem(pcfamp),
 647      >              imem(pfamar), imem(pcfaar),
 648      >              imem(pfamtr), imem(pcfatr),
 649      >              imem(pfamqu), imem(pcfaqu),
 650      >              imem(pfamte), imem(pcfate),
 651      >              imem(pfamhe), imem(pcfahe),
 652      >              imem(pfampy), imem(pcfapy),
 653      >              imem(pfampe), imem(pcfape),
 654      >              ulsort, langue, codret )
 655 c
 656       endif
 657 c
 658 #endif
 659 c====
 660 c 7. la fin
 661 c====
 662 c
 663       if ( codret.ne.0 ) then
 664 c
 665 #include "envex2.h"
 666 c
 667       write (ulsort,texte(langue,1)) 'Sortie', nompro
 668       write (ulsort,texte(langue,2)) codret
 669 c
 670       endif
 671 c
 672 #ifdef _DEBUG_HOMARD_
 673       write (ulsort,texte(langue,1)) 'Sortie', nompro
 674       call dmflsh (iaux)
 675 #endif
 676 c
 677       end