src/tool/Decision/deisv2.F

   1       subroutine deisv2 ( ncmpin, usacmp,
   2      >                    tesupp, teindi, teinin,
   3      >                    hesupp, heindi, heinin,
   4      >                    pysupp, pyindi, pyinin,
   5      >                    pesupp, peindi, peinin,
   6      >                    hettri, pertri,
   7      >                    hetqua, filqua, perqua,
   8      >                    tritet, pertet, pthepe,
   9      >                    quahex, hethex, filhex, perhex, fhpyte,
  10      >                    facpyr,
  11      >                    facpen,
  12      >                    voltri, pypetr,
  13      >                    volqua, pypequ,
  14      >                    ulsort, langue, codret)
  15 c ______________________________________________________________________
  16 c
  17 c                             H O M A R D
  18 c
  19 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  20 c
  21 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  22 c aupres des huissiers de justice Simart et Lavoir a Clamart
  23 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  24 c aupres des huissiers de justice
  25 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  26 c
  27 c    HOMARD est une marque deposee d'Electricite de France
  28 c
  29 c Copyright EDF 1996
  30 c Copyright EDF 1998
  31 c Copyright EDF 2002
  32 c Copyright EDF 2020
  33 c ______________________________________________________________________
  34 c
  35 c    traitement des DEcisions - Initialisations - par Saut - Volumes - 2
  36 c                   --          -                     -      -         -
  37 c   attention : on ne traite pas les cas non-conformes
  38 c ______________________________________________________________________
  39 c .        .     .        .                                            .
  40 c .  nom   . e/s . taille .           description                      .
  41 c .____________________________________________________________________.
  42 c . ncmpin .  e  .   1    . nombre de composantes de l'indicateur      .
  43 c . usacmp . e   .   1    . usage des composantes de l'indicateur      .
  44 c .        .     .        . 0 : norme L2                               .
  45 c .        .     .        . 1 : norme infinie -max des valeurs absolues.
  46 c .        .     .        . 2 : valeur relative si une seule composante.
  47 c . tesupp . e   . nbteto . support pour les tetraedres                .
  48 c . teindi . es  . nbteto . valeurs pour les tetraedres                .
  49 c . teinin . e   . nbteto . valeurs initiales pour les tetraedres      .
  50 c . hesupp . e   . nbheto . support pour les hexaedres                 .
  51 c . heindi . es  . nbheto . valeurs pour les hexaedres                 .
  52 c . heinin . e   . nbheto . valeurs initiales pour les hexaedres       .
  53 c . pysupp . e   . nbpyto . support pour les pyramides                 .
  54 c . pyindi . es  . nbpyto . valeurs pour les pyramides                 .
  55 c . pyinin . e   . nbpyto . valeurs initiales pour les pyramides       .
  56 c . pesupp . e   . nbpeto . support pour les pentaedres                .
  57 c . peindi . es  . nbpeto . valeurs pour les pentaedres                .
  58 c . peinin . e   . nbpeto . valeurs initiales pour les pentaedres      .
  59 c . hettri . e   . nbtrto . historique de l'etat des triangles         .
  60 c . pertri . e   . nbtrto . pere des triangles                         .
  61 c . hetqua . e   . nbquto . historique de l'etat des quadrangles       .
  62 c . filqua . e   . nbquto . fils des quadrangles                       .
  63 c . perqua . e   . nbquto . pere des quadrangles                       .
  64 c . tritet . e   .nbtecf*4. numeros des triangles des tetraedres       .
  65 c . pertet . e   . nbteto . pere des tetraedres                        .
  66 c .        .     .        . si pertet(i) > 0 : numero du tetraedre     .
  67 c .        .     .        . si pertet(i) < 0 : -numero dans pthepe     .
  68 c . pthepe . e   .    *   . si i <= nbheco : numero de l'hexaedre      .
  69 c .        .     .        . si non : numero du pentaedre               .
  70 c . hethex . e   . nbheto . historique de l'etat des hexaedres         .
  71 c . quahex . e   .nbhecf*6. numeros des 6 quadrangles des hexaedres    .
  72 c . filhex . e   . nbheto . premier fils des hexaedres                 .
  73 c . perhex . e   . nbheto . pere des hexaedres                         .
  74 c . fhpyte . e   .2*nbheco. fhpyte(1,j) = numero de la 1ere pyramide   .
  75 c .        .     .        . fille de l'hexaedre k tel que filhex(k) =-j.
  76 c .        .     .        . fhpyte(2,j) = numero du 1er tetraedre      .
  77 c .        .     .        . fils de l'hexaedre k tel que filhex(k) = -j.
  78 c . facpyr . e   .nbpycf*5. numeros des 5 faces des pyramides          .
  79 c . facpen . e   .nbpecf*5. numeros des 5 faces des pyramides          .
  80 c . voltri . es  .2*nbtrto. numeros des 2 volumes par triangle         .
  81 c .        .     .        . voltri(i,k) definit le i-eme voisin de k   .
  82 c .        .     .        .   0 : pas de voisin                        .
  83 c .        .     .        . j>0 : tetraedre j                          .
  84 c .        .     .        . j<0 : pyramide/pentaedre dans pypetr(1/2,j).
  85 c . pypetr . e   .2*lgpype. pypetr(1,j) = numero de la pyramide voisine.
  86 c .        .     .        . du triangle k tel que voltri(1/2,k) = -j   .
  87 c .        .     .        . pypetr(2,j) = numero du pentaedre voisin   .
  88 c .        .     .        . du triangle k tel que voltri(1/2,k) = -j   .
  89 c . volqua . e   .2*nbquto. numeros des 2 volumes par quadrangle       .
  90 c .        .     .        . volqua(i,k) definit le i-eme voisin de k   .
  91 c .        .     .        .   0 : pas de voisin                        .
  92 c .        .     .        . j>0 : hexaedre j                           .
  93 c .        .     .        . j<0 : pyramide/pentaedre dans pypequ(1/2,j).
  94 c . pypequ . e   .2*lgpype. pypequ(1,j) = numero de la pyramide voisine.
  95 c .        .     .        . du quadrangle k tel que volqua(1/2,k) = -j .
  96 c .        .     .        . pypequ(2,j) = numero du pentaedre voisin   .
  97 c .        .     .        . du quadrangle k tel que volqua(1/2,k) = -j .
  98 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  99 c . langue . e   .    1   . langue des messages                        .
 100 c .        .     .        . 1 : francais, 2 : anglais                  .
 101 c . codret . es  .    1   . code de retour des modules                 .
 102 c .        .     .        . 0 : pas de probleme                        .
 103 c .        .     .        . 2 : probleme dans le traitement            .
 104 c ______________________________________________________________________
 105 c
 106 c====
 107 c 0. declarations et dimensionnement
 108 c====
 109 c
 110 c 0.1. ==> generalites
 111 c
 112       implicit none
 113       save
 114 c
 115       character*6 nompro
 116       parameter ( nompro = 'DEISV2' )
 117 c
 118 #include "nblang.h"
 119 c
 120       integer lgdaux
 121       parameter( lgdaux = 500 )
 122 c
 123 c 0.2. ==> communs
 124 c
 125 #include "envex1.h"
 126 c
 127 #include "impr02.h"
 128 #include "nombtr.h"
 129 #include "nombqu.h"
 130 #include "nombte.h"
 131 #include "nombhe.h"
 132 #include "nombpy.h"
 133 #include "nombpe.h"
 134 c
 135 c 0.3. ==> arguments
 136 c
 137       integer ncmpin
 138       integer usacmp
 139       integer tesupp(nbteto)
 140       integer hesupp(nbheto)
 141       integer pysupp(nbpyto)
 142       integer pesupp(nbpeto)
 143       integer hettri(nbtrto), pertri(nbtrto)
 144       integer hetqua(nbquto), filqua(nbquto), perqua(nbquto)
 145       integer tritet(nbtecf,4)
 146       integer pertet(nbteto), pthepe(*)
 147       integer quahex(nbhecf,6)
 148       integer hethex(nbheto), filhex(nbheto), perhex(nbheto)
 149       integer fhpyte(2,nbheco)
 150       integer facpyr(nbpycf,5)
 151       integer facpen(nbpecf,5)
 152       integer voltri(2,nbtrto), pypetr(2,*)
 153       integer volqua(2,nbquto), pypequ(2,*)
 154 c
 155       integer ulsort, langue, codret
 156 c
 157       double precision teindi(nbteto,ncmpin), teinin(nbteto,ncmpin)
 158       double precision heindi(nbheto,ncmpin), heinin(nbheto,ncmpin)
 159       double precision pyindi(nbpyto,ncmpin), pyinin(nbpyto,ncmpin)
 160       double precision peindi(nbpeto,ncmpin), peinin(nbpeto,ncmpin)
 161 c
 162 c 0.4. ==> variables locales
 163 c
 164       integer iaux, jaux, kaux
 165       integer laface, typfac
 166       integer lamail, typenh
 167 c
 168       double precision valaux(lgdaux)
 169 c
 170       integer nbfite, nbvote, voiste(lgdaux)
 171       integer nbfihe, nbvohe, voishe(lgdaux)
 172       integer nbfipy, nbvopy, voispy(lgdaux)
 173       integer nbfipe, nbvope, voispe(lgdaux)
 174 c
 175       integer nbmess
 176       parameter (nbmess = 10 )
 177       character*80 texte(nblang,nbmess)
 178 c ______________________________________________________________________
 179 c
 180 c====
 181 c 1. initialisation
 182 c====
 183 c
 184 c 1.1. ==> Les messages
 185 c
 186 #include "impr01.h"
 187 c
 188 #ifdef _DEBUG_HOMARD_
 189       write (ulsort,texte(langue,1)) 'Entree', nompro
 190       call dmflsh (iaux)
 191 #endif
 192 c
 193       texte(1,4) = '(''. Saut a la traversee des faces'')'
 194       texte(1,5) =
 195      > '(''On veut'',i6,'' composantes, mais taille de daux ='',i6)'
 196       texte(1,6) = '(''. Examen du '',a,i10)'
 197 c
 198       texte(2,4) = '(''. Jump through the faces'')'
 199       texte(2,5) =
 200      > '(i6,''components are requested, but size of daux equals'',i6)'
 201       texte(2,6) = '(''. Examen du '',a,i10)'
 202 c
 203 #include "impr03.h"
 204 20000 format(a,i10,a,20g16.8)
 205 20001 format(2(a,i10))
 206 c
 207       codret = 0
 208 c
 209 c 1.2. ==> controle
 210 c
 211       if ( ncmpin.gt.lgdaux ) then
 212         write (ulsort,texte(langue,5)) ncmpin, lgdaux
 213         codret = 1
 214       endif
 215 c
 216 #ifdef _DEBUG_HOMARD_
 217       write (ulsort,texte(langue,4))
 218 #endif
 219 c
 220 c====
 221 c 2. Calcul du saut entre chaque tetraedre et ses voisins
 222 c====
 223 #ifdef _DEBUG_HOMARD_
 224       write (ulsort,*) '2. parcours tetraedre ; codret = ', codret
 225       write (ulsort,90002) 'nbtecf', nbtecf
 226 #endif
 227 c
 228       typfac = 2
 229       typenh = 3
 230       do 21 , iaux = 1 , nbtecf
 231 c
 232         if ( tesupp(iaux).gt.0 ) then
 233 c
 234         lamail = iaux
 235 cgn      write (ulsort,*) 'lamail = ', lamail
 236 c
 237 c 2.1.1. ==> Recherche des voisins par chacune des faces
 238 c
 239         nbvote = 0
 240         nbvohe = 0
 241         nbvopy = 0
 242         nbvope = 0
 243 c
 244         do 211 , kaux = 1 , 4
 245 c
 246           if ( codret.eq.0 ) then
 247 c
 248           laface = tritet(iaux,kaux)
 249 #ifdef _DEBUG_HOMARD_
 250       write (ulsort,texte(langue,3)) 'DEISV6 / tetr', nompro
 251 #endif
 252           call deisv6 ( laface, typfac, lamail, typenh,
 253      >                  hettri, pertri,
 254      >                  hetqua, perqua,
 255      >                  pertet,
 256      >                  hethex, filhex, perhex, fhpyte,
 257      >                  voltri, pypetr,
 258      >                  volqua, pypequ,
 259      >                  nbvote, voiste,
 260      >                  nbvohe, voishe,
 261      >                  nbvopy, voispy,
 262      >                  nbvope, voispe,
 263      >                  ulsort, langue, codret )
 264 c
 265           endif
 266 c
 267   211   continue
 268 c
 269 c 2.1.2. ==> Retrait de la maille courante de la liste des voisins
 270 c
 271         if ( codret.eq.0 ) then
 272 c
 273 #ifdef _DEBUG_HOMARD_
 274       write (ulsort,texte(langue,3)) 'DEISV7 / tetr', nompro
 275 #endif
 276 cc        call deisv7 ( lamail, nbvote, voiste,
 277 cc     >                ulsort, langue, codret )
 278 c
 279         endif
 280 c
 281 c 2.1.3. ==> Calcul des sauts
 282 c
 283         if ( codret.eq.0 ) then
 284 c
 285 #ifdef _DEBUG_HOMARD_
 286       write (ulsort,texte(langue,3)) 'DEISV5 / tetr', nompro
 287 #endif
 288         call deisv5 ( lamail, ncmpin, usacmp,
 289      >                nbteto, teindi, teinin,
 290      >                tesupp, teinin,
 291      >                hesupp, heinin,
 292      >                pysupp, pyinin,
 293      >                pesupp, peinin,
 294      >                nbvote, voiste,
 295      >                nbvohe, voishe,
 296      >                nbvopy, voispy,
 297      >                nbvope, voispe,
 298      >                valaux,
 299      >                ulsort, langue, codret)
 300 c
 301         endif
 302 c
 303         endif
 304 c
 305    21 continue
 306 c
 307 c====
 308 c 3. Calcul du saut entre chaque hexaedre et ses voisins
 309 c====
 310 #ifdef _DEBUG_HOMARD_
 311       write (ulsort,*) '3. parcours hexaedre ; codret = ', codret
 312       write (ulsort,90002) 'nbhecf', nbhecf
 313 #endif
 314 c
 315       typfac = 4
 316       typenh = 6
 317       do 31 , iaux = 1 , nbhecf
 318 c
 319         if ( hesupp(iaux).gt.0 ) then
 320 c
 321         lamail = iaux
 322 cgn      write (ulsort,*) 'lamail = ', lamail
 323 c
 324 c 3.1.1. ==> Recherche des voisins par chacune des faces
 325 c
 326         nbvote = 0
 327         nbvohe = 0
 328         nbvopy = 0
 329         nbvope = 0
 330 c
 331         do 311 , kaux = 1 , 6
 332 c
 333           if ( codret.eq.0 ) then
 334 c
 335           laface = quahex(iaux,kaux)
 336 #ifdef _DEBUG_HOMARD_
 337       write (ulsort,texte(langue,3)) 'DEISV6 / hexa', nompro
 338 #endif
 339           call deisv6 ( laface, typfac, lamail, typenh,
 340      >                  hettri, pertri,
 341      >                  hetqua, perqua,
 342      >                  pertet,
 343      >                  hethex, filhex, perhex, fhpyte,
 344      >                  voltri, pypetr,
 345      >                  volqua, pypequ,
 346      >                  nbvote, voiste,
 347      >                  nbvohe, voishe,
 348      >                  nbvopy, voispy,
 349      >                  nbvope, voispe,
 350      >                  ulsort, langue, codret )
 351 c
 352 #ifdef _DEBUG_HOMARD_
 353       write (ulsort,90002) 'apres la face', kaux
 354       write (ulsort,90002) 'nbvote', nbvote
 355       write (ulsort,90002) 'nbvohe', nbvohe
 356       write (ulsort,90002) 'nbvopy', nbvopy
 357       write (ulsort,90002) 'nbvope', nbvope
 358 #endif
 359 c
 360           endif
 361 c
 362   311   continue
 363 c
 364 c 3.1.2. ==> Retrait de la maille courante de la liste des voisins
 365 c
 366         if ( codret.eq.0 ) then
 367 c
 368 #ifdef _DEBUG_HOMARD_
 369       write (ulsort,texte(langue,3)) 'DEISV7 / hexa', nompro
 370 #endif
 371 cc        call deisv7 ( lamail, nbvohe, voishe,
 372 cc     >                ulsort, langue, codret )
 373 c
 374         endif
 375 c
 376 c 3.1.3. ==> Calcul des sauts
 377 c
 378         if ( codret.eq.0 ) then
 379 c
 380 #ifdef _DEBUG_HOMARD_
 381       write (ulsort,texte(langue,3)) 'DEISV5 / hexa', nompro
 382 #endif
 383         call deisv5 ( lamail, ncmpin, usacmp,
 384      >                nbheto, heindi, heinin,
 385      >                tesupp, teinin,
 386      >                hesupp, heinin,
 387      >                pysupp, pyinin,
 388      >                pesupp, peinin,
 389      >                nbvote, voiste,
 390      >                nbvohe, voishe,
 391      >                nbvopy, voispy,
 392      >                nbvope, voispe,
 393      >                valaux,
 394      >                ulsort, langue, codret)
 395 c
 396         endif
 397 c
 398         endif
 399 c
 400    31 continue
 401 c
 402 c====
 403 c 4. Calcul du saut entre chaque pyramide et ses voisins
 404 c====
 405 #ifdef _DEBUG_HOMARD_
 406       write (ulsort,*) '4. parcours pyramide ; codret = ', codret
 407       write (ulsort,90002) 'nbpycf', nbpycf
 408 #endif
 409 c
 410       typenh = 5
 411       do 41 , iaux = 1 , nbpycf
 412 c
 413         if ( pysupp(iaux).gt.0 ) then
 414 c
 415         lamail = iaux
 416 cgn      write (ulsort,*) 'lamail = ', lamail
 417 c
 418 c 4.1.1. ==> Recherche des voisins par chacune des faces
 419 c
 420         nbvote = 0
 421         nbvohe = 0
 422         nbvopy = 0
 423         nbvope = 0
 424 c
 425         do 411 , kaux = 1 , 5
 426 c
 427           if ( codret.eq.0 ) then
 428 c
 429           laface = facpyr(iaux,kaux)
 430           if ( kaux.le.4 ) then
 431             typfac = 2
 432           else
 433             typfac = 4
 434           endif
 435 #ifdef _DEBUG_HOMARD_
 436       write (ulsort,texte(langue,3)) 'DEISV6 / pyra', nompro
 437 #endif
 438           call deisv6 ( laface, typfac, lamail, typenh,
 439      >                  hettri, pertri,
 440      >                  hetqua, perqua,
 441      >                  pertet,
 442      >                  hethex, filhex, perhex, fhpyte,
 443      >                  voltri, pypetr,
 444      >                  volqua, pypequ,
 445      >                  nbvote, voiste,
 446      >                  nbvohe, voishe,
 447      >                  nbvopy, voispy,
 448      >                  nbvope, voispe,
 449      >                  ulsort, langue, codret )
 450 c
 451           endif
 452 c
 453   411   continue
 454 c
 455 c 4.1.2. ==> Retrait de la maille courante de la liste des voisins
 456 c
 457         if ( codret.eq.0 ) then
 458 c
 459 #ifdef _DEBUG_HOMARD_
 460       write (ulsort,texte(langue,3)) 'DEISV7 / pyra', nompro
 461 #endif
 462 cc        call deisv7 ( lamail, nbvopy, voispy,
 463 cc     >                ulsort, langue, codret )
 464 c
 465         endif
 466 c
 467 c 4.1.3. ==> Calcul des sauts
 468 c
 469         if ( codret.eq.0 ) then
 470 c
 471 #ifdef _DEBUG_HOMARD_
 472       write (ulsort,texte(langue,3)) 'DEISV5 / pyra', nompro
 473 #endif
 474         call deisv5 ( lamail, ncmpin, usacmp,
 475      >                nbpyto, pyindi, pyinin,
 476      >                tesupp, teinin,
 477      >                hesupp, heinin,
 478      >                pysupp, pyinin,
 479      >                pesupp, peinin,
 480      >                nbvote, voiste,
 481      >                nbvohe, voishe,
 482      >                nbvopy, voispy,
 483      >                nbvope, voispe,
 484      >                valaux,
 485      >                ulsort, langue, codret)
 486 c
 487         endif
 488 c
 489         endif
 490 c
 491    41 continue
 492 c
 493 c====
 494 c 5. Calcul du saut entre chaque pentaedre et ses voisins
 495 c====
 496 #ifdef _DEBUG_HOMARD_
 497       write (ulsort,*) '5. parcours pentaedre ; codret = ', codret
 498       write (ulsort,90002) 'nbpecf', nbpecf
 499 #endif
 500 c
 501       typenh = 7
 502       do 51 , iaux = 1 , nbpecf
 503 c
 504         if ( pesupp(iaux).gt.0 ) then
 505 c
 506         lamail = iaux
 507 c
 508 c 5.1.1. ==> Recherche des voisins par chacune des faces
 509 c
 510         nbvote = 0
 511         nbvohe = 0
 512         nbvopy = 0
 513         nbvope = 0
 514 c
 515         do 511 , kaux = 1 , 5
 516 c
 517           if ( codret.eq.0 ) then
 518 c
 519           laface = facpen(iaux,kaux)
 520           if ( kaux.le.2 ) then
 521             typfac = 2
 522           else
 523             typfac = 4
 524           endif
 525 #ifdef _DEBUG_HOMARD_
 526       write (ulsort,texte(langue,3)) 'DEISV6 / pent', nompro
 527 #endif
 528           call deisv6 ( laface, typfac, lamail, typenh,
 529      >                  hettri, pertri,
 530      >                  hetqua, perqua,
 531      >                  pertet,
 532      >                  hethex, filhex, perhex, fhpyte,
 533      >                  voltri, pypetr,
 534      >                  volqua, pypequ,
 535      >                  nbvote, voiste,
 536      >                  nbvohe, voishe,
 537      >                  nbvopy, voispy,
 538      >                  nbvope, voispe,
 539      >                  ulsort, langue, codret )
 540 c
 541           endif
 542 c
 543   511   continue
 544 c
 545 c 5.1.2. ==> Retrait de la maille courante de la liste des voisins
 546 c
 547         if ( codret.eq.0 ) then
 548 c
 549 #ifdef _DEBUG_HOMARD_
 550       write (ulsort,texte(langue,3)) 'DEISV7 / pent', nompro
 551 #endif
 552         call deisv7 ( lamail, nbvope, voispe,
 553      >                ulsort, langue, codret )
 554 c
 555         endif
 556 c
 557 c 5.1.3. ==> Calcul des sauts
 558 c
 559         if ( codret.eq.0 ) then
 560 c
 561 #ifdef _DEBUG_HOMARD_
 562       write (ulsort,texte(langue,3)) 'DEISV5 / pent', nompro
 563 #endif
 564         call deisv5 ( lamail, ncmpin, usacmp,
 565      >                nbpeto, peindi, peinin,
 566      >                tesupp, teinin,
 567      >                hesupp, heinin,
 568      >                pysupp, pyinin,
 569      >                pesupp, peinin,
 570      >                nbvote, voiste,
 571      >                nbvohe, voishe,
 572      >                nbvopy, voispy,
 573      >                nbvope, voispe,
 574      >                valaux,
 575      >                ulsort, langue, codret)
 576 c
 577         endif
 578 c
 579         endif
 580 c
 581    51 continue
 582 c
 583 c====
 584 c 6. Calcul des sauts pour les fils des hexaedres coupes par conformite
 585 c    s'ils sont decrits par aretes
 586 c====
 587 #ifdef _DEBUG_HOMARD_
 588       write (ulsort,*) '6. fils des hexaedres ; codret = ', codret
 589 #endif
 590 c
 591       if ( nbteca.gt.0 .or. nbheca.gt.0 .or. nbpyca.gt.0 ) then
 592 c
 593         do 61 , jaux = 1 , nbhecf
 594 c
 595           iaux = jaux
 596 c
 597           if ( mod(hethex(iaux),1000).ge.11 ) then
 598 #ifdef _DEBUG_HOMARD_
 599         write (ulsort,texte(langue,6)) mess14(langue,1,6), iaux
 600 #endif
 601 c
 602 c 6.1. ==> Recherche des mailles a considerer
 603 c
 604             if ( codret.eq.0 ) then
 605 c
 606 #ifdef _DEBUG_HOMARD_
 607       write (ulsort,texte(langue,3)) 'DEISV8', nompro
 608 #endif
 609             call deisv8 ( iaux,
 610      >                    filqua,
 611      >                    hethex, quahex,
 612      >                    filhex, fhpyte,
 613      >                    volqua,
 614      >                    nbfite, nbvote, voiste,
 615      >                    nbfihe, nbvohe, voishe,
 616      >                    nbfipy, nbvopy, voispy,
 617      >                    ulsort, langue, codret )
 618 c
 619             endif
 620 c
 621 c 6.2. ==> Calcul des sauts entre chaque fils de l'hexaedre et les
 622 c          voisins contenus dans la liste
 623 c
 624             if ( codret.eq.0 ) then
 625 c
 626             do 621 , kaux = 1 , nbfite
 627 #ifdef _DEBUG_HOMARD_
 628       write (ulsort,texte(langue,3)) '. DEISV5 / tetr', nompro
 629 #endif
 630               call deisv5 ( voiste(kaux), ncmpin, usacmp,
 631      >                      nbteto, teindi, teinin,
 632      >                      tesupp, teinin,
 633      >                      hesupp, heinin,
 634      >                      pysupp, pyinin,
 635      >                      pesupp, peinin,
 636      >                      nbvote, voiste,
 637      >                      nbvohe, voishe,
 638      >                      nbvopy, voispy,
 639      >                      nbvope, voispe,
 640      >                      valaux,
 641      >                      ulsort, langue, codret)
 642   621       continue
 643 c
 644             do 622 , kaux = 1 , nbfihe
 645 #ifdef _DEBUG_HOMARD_
 646       write (ulsort,texte(langue,3)) '. DEISV5 / hexa', nompro
 647 #endif
 648               call deisv5 ( voishe(kaux), ncmpin, usacmp,
 649      >                      nbheto, heindi, heinin,
 650      >                      tesupp, teinin,
 651      >                      hesupp, heinin,
 652      >                      pysupp, pyinin,
 653      >                      pesupp, peinin,
 654      >                      nbvote, voiste,
 655      >                      nbvohe, voishe,
 656      >                      nbvopy, voispy,
 657      >                      nbvope, voispe,
 658      >                      valaux,
 659      >                      ulsort, langue, codret)
 660   622       continue
 661 c
 662             do 623 , kaux = 1 , nbfipy
 663 #ifdef _DEBUG_HOMARD_
 664       write (ulsort,texte(langue,3)) '. DEISV5 / pyra', nompro
 665 #endif
 666               call deisv5 ( voispy(kaux), ncmpin, usacmp,
 667      >                      nbpyto, pyindi, pyinin,
 668      >                      tesupp, teinin,
 669      >                      hesupp, heinin,
 670      >                      pysupp, pyinin,
 671      >                      pesupp, peinin,
 672      >                      nbvote, voiste,
 673      >                      nbvohe, voishe,
 674      >                      nbvopy, voispy,
 675      >                      nbvope, voispe,
 676      >                      valaux,
 677      >                      ulsort, langue, codret)
 678   623       continue
 679 c
 680             endif
 681 c
 682           endif
 683 c
 684    61   continue
 685 c
 686       endif
 687 c
 688 c====
 689 c 7. la fin
 690 c====
 691 c
 692       if ( codret.ne.0 ) then
 693 c
 694 #include "envex2.h"
 695 c
 696       write (ulsort,texte(langue,1)) 'Sortie', nompro
 697       write (ulsort,texte(langue,2)) codret
 698 c
 699       endif
 700 c
 701 #ifdef _DEBUG_HOMARD_
 702       write (ulsort,texte(langue,1)) 'Sortie', nompro
 703       call dmflsh (iaux)
 704 #endif
 705 c
 706       end