src/tool/ES_Xfig/pppma4.F

   1       subroutine pppma4 ( rangfa, nbfast,
   2      >                    nbtrvi, nbquvi,
   3      >                    nntrvi, nnquvi,
   4      >                    coopro,
   5      >                    posini, xyzfac, tabaux,
   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     Post-Processeur - Preparation du MAillage - phase 4
  28 c     -    -            -              --               -
  29 c ______________________________________________________________________
  30 c
  31 c On place la rangfa-ieme face par rapport aux autres
  32 c ______________________________________________________________________
  33 c .        .     .        .                                            .
  34 c .  nom   . e/s . taille .           description                      .
  35 c .____________________________________________________________________.
  36 c . rangfa . e   .   1    . rang dans la liste initiale de la face a   .
  37 c .        .     .        . classer                                    .
  38 c . nbfast . es  .   1    . nombre de faces deja classees              .
  39 c . nbtrvi . e   .   1    . nombre triangles visualisables             .
  40 c . nbquvi . e   .   1    . nombre de quadrangles visualisables        .
  41 c . nntrvi . e   .10nbtrvi. 1 : niveau du triangle a afficher          .
  42 c .        .     .        . 2 : numero HOMARD du triangle              .
  43 c .        .     .        . 3, 4, 5 : numeros des noeuds p1            .
  44 c .        .     .        . 6 : famille du triangle                    .
  45 c .        .     .        . 7, 8, 9 : numeros des noeuds p2            .
  46 c .        .     .        . 10 : numero du noeud interne               .
  47 c . nnquvi . e   .12nbquvi. 1 : niveau du quadrangle a afficher        .
  48 c .        .     .        . 2 : numero HOMARD du quadrangle            .
  49 c .        .     .        . 3, 4, 5, 6 : numeros des noeuds p1         .
  50 c .        .     .        . 7 : famille du quadrangle                  .
  51 c .        .     .        . 8, 9, 10, 11 : numeros des noeuds p2       .
  52 c .        .     .        . 12 : numero du noeud interne               .
  53 c . coopro . e   .  sdim* . coordonnees projetees de :                 .
  54 c .        .     .nbnot+12. le triedre : -8:O ; -9:I ; -10:J ; -11:K   .
  55 c .        .     .        . la fenetre de zoom : de -7 a 0 en 3D ou    .
  56 c .        .     .        .                      de -3 a 0 en 2D       .
  57 c .        .     .        . les noeuds de 1 a nbnoto                   .
  58 c . posini . aux . nbquvi . tableau auxiliaire de renumerotation des   .
  59 c .        .     .+nbtrvi . faces en fonction de l'affichage           .
  60 c . xyzfac .  e  .nbtrvi+ . coordonnees des noeuds des faces           .
  61 c .        .     .nbtrvi,9.                                            .
  62 c . tabaux . e/s . nbquvi . tabaux(i) = 1 : la face i est stockee      .
  63 c .        .     .+nbtrvi . tabaux(i) = 0 : la face i n'est pas stockee.
  64 c . ulsort . e   .   1    . unite logique de la sortie generale        .
  65 c . langue . e   .    1   . langue des messages                        .
  66 c .        .     .        . 1 : francais, 2 : anglais                  .
  67 c . codret .  s  .    1   . code de retour des modules                 .
  68 c .        .     .        . 0 : pas de probleme                        .
  69 c ._____________________________________________________________________
  70 c
  71 c====
  72 c 0. declarations et dimensionnement
  73 c====
  74 c
  75 c 0.1. ==> generalites
  76 c
  77       implicit none
  78       save
  79 c
  80       character*6 nompro
  81       parameter ( nompro = 'PPPMA4' )
  82 c
  83 #include "nblang.h"
  84 c
  85 c 0.2. ==> communs
  86 c
  87 #include "envex1.h"
  88 #include "envca1.h"
  89 #include "nombno.h"
  90 c
  91 c 0.3. ==> arguments
  92 c
  93       integer rangfa, nbfast
  94       integer nbtrvi, nbquvi
  95       integer nntrvi(10,nbtrvi)
  96       integer nnquvi(12,nbquvi)
  97       integer posini(nbtrvi+nbquvi)
  98       integer tabaux(nbtrvi+nbquvi)
  99 c
 100       double precision coopro(sdim,-11:nbnoto)
 101       double precision xyzfac(nbtrvi+nbquvi,9)
 102 c
 103       integer ulsort, langue, codret
 104 c
 105 c 0.4. ==> variables locales
 106 c
 107       integer indpos, lerang
 108       integer numfac, rangqu
 109       integer nufast, rgfast, rgqust
 110       integer nbnfac, nbnfst
 111       integer iaux, jaux
 112       integer glop, glop1
 113 c
 114       double precision daux
 115       double precision dzmini
 116       double precision xminfa, xmaxfa
 117       double precision yminfa, ymaxfa
 118       double precision zvuefa, zvuefs
 119       double precision v1(3), v2(3), v3(3), v4(3)
 120       double precision w1(3), w2(3), w3(3), w4(3), wn(2)
 121 c
 122       logical prem
 123       logical dedans
 124 c
 125       integer nbmess
 126       parameter ( nbmess = 10 )
 127       character*80 texte(nblang,nbmess)
 128 c
 129 c 0.5. ==> initialisations
 130 c_______________________________________________________________________
 131 c
 132 c====
 133 c 1. prealables
 134 c====
 135 c
 136 #include "impr01.h"
 137 c
 138 #ifdef _DEBUG_HOMARD_
 139       write (ulsort,texte(langue,1)) 'Entree', nompro
 140       call dmflsh (iaux)
 141 #endif
 142 c
 143 #ifdef _DEBUG_HOMARD_
 144 cgn      write (ulsort,1795) '. nbtrvi', nbtrvi, 'nbquvi', nbquvi
 145       write (ulsort,1795) '. rangfa', rangfa, 'nbfast', nbfast
 146 #endif
 147 c
 148       dzmini = 1.0d-4
 149 c
 150       codret = 0
 151 c
 152  1794 format(3(a,' =',f12.5,' , '))
 153  1795 format(3(a,' =',i5,' , '))
 154  1796 format(a,6f12.5)
 155  1797 format(i5,' *',6f12.5)
 156 c
 157 c 1.2. ==> Caracteristiques
 158 c
 159       if ( rangfa.gt.nbtrvi ) then
 160         rangqu = rangfa - nbtrvi
 161       endif
 162       if ( rangfa.le.nbtrvi ) then
 163         numfac = nntrvi(2,rangfa)
 164       else
 165         numfac = -nnquvi(2,rangqu)
 166       endif
 167 c
 168 c 1.3. ==> A priori, on va mettre la face devant toutes les autres
 169 c
 170       lerang = nbfast + 1
 171 c
 172 c====
 173 c 2. On commence par s'assurer que la face a classer n'est pas
 174 c    parallele a l'axe de vision. Si c'est le cas, on la range dans la
 175 c    place la plus eloignee car l'ordre d'affichage n'a pas
 176 c    d'importance : on ne verra qu'une tranche !
 177 c====
 178 c
 179       daux = sqrt( abs(xyzfac(rangfa,7))**2
 180      >     +       abs(xyzfac(rangfa,8))**2
 181      >     +       abs(xyzfac(rangfa,9))**2 )
 182       if ( abs(xyzfac(rangfa,9))/daux.le.dzmini ) then
 183 cgn        write(*,*)'rang',rangfa,', face',numfac
 184 cgn        write(*,1794)'Nx',xyzfac(rangfa,7),'Ny',xyzfac(rangfa,8),
 185 cgn     >               'Nz',xyzfac(rangfa,9)
 186 cgn        write(*,1794)'norme',daux,
 187 cgn     >               'Nz/norme',abs(xyzfac(rangfa,9))/daux
 188 cgn        write(*,*)'La face a classer est parallele a la vision'
 189         tabaux(rangfa) = 1
 190         lerang = 1
 191         goto 50
 192       endif
 193 c
 194 c====
 195 c 3. Suite des caracteristiques
 196 c====
 197 c
 198       prem = .true.
 199 c
 200       xminfa = xyzfac(rangfa,1)
 201       xmaxfa = xyzfac(rangfa,2)
 202       yminfa = xyzfac(rangfa,3)
 203       ymaxfa = xyzfac(rangfa,4)
 204 c
 205       glop = 0
 206 cgn      if ( numfac.eq.-25 .or. numfac.eq.-21 ) then
 207 cgn        glop = 1
 208 cgn      endif
 209       if ( glop.ne.0) then
 210       write(*,*)'*************************************************'
 211       write(*,*)'Examen de la face',numfac,' (rangfa =', rangfa,')'
 212       endif
 213       if ( glop.ne.0 ) then
 214         write(*,*)'....... Face a classer',numfac,' ==> noeuds :'
 215         if ( rangfa.le.nbtrvi ) then
 216           jaux = nntrvi(3,rangfa)
 217           write(*,1797) jaux, (coopro(iaux,jaux),iaux=1,3)
 218           jaux = nntrvi(4,rangfa)
 219           write(*,1797) jaux, (coopro(iaux,jaux),iaux=1,3)
 220           jaux = nntrvi(5,rangfa)
 221           write(*,1797) jaux, (coopro(iaux,jaux),iaux=1,3)
 222         else
 223           jaux = nnquvi(3,rangqu)
 224           write(*,1797) jaux, (coopro(iaux,jaux),iaux=1,3)
 225           jaux = nnquvi(4,rangqu)
 226           write(*,1797) jaux, (coopro(iaux,jaux),iaux=1,3)
 227           jaux = nnquvi(5,rangqu)
 228           write(*,1797) jaux, (coopro(iaux,jaux),iaux=1,3)
 229           jaux = nnquvi(6,rangqu)
 230           write(*,1797) jaux, (coopro(iaux,jaux),iaux=1,3)
 231         endif
 232         write(*,1796)'normale',(xyzfac(rangfa,iaux),iaux=7,9)
 233       endif
 234 c
 235 c====
 236 c 4. On parcourt toutes les faces deja stockees
 237 c    posini(indpos) est la position de la indpos-eme face stockee,
 238 c    dans la suite generale des faces a visualiser.
 239 c    . Si posini(indpos) est inferieur a nbtrvi, c'est que la face
 240 c    stockee est un triangle. Son indice dans les triangles a tracer
 241 c    est posini(indpos).
 242 c    . Si posini(indpos) est superieur a nbtrvi, c'est un quadrangle
 243 c    dont l'indice dans les quadrangles est posini(indpos)-nbtrvi
 244 c    Attention a ne pas comparer une face a elle-meme ! Cela peut
 245 c    arriver quand on fait une seconde passe pour replacer une face
 246 c    qui n'avait aucun point commun avec les autres.
 247 c====
 248 c
 249       do 40 , indpos = 1 , nbfast
 250 c
 251 c 4.1. ==> caracteristique de la face stockee
 252 c
 253         rgfast = posini(indpos)
 254 c
 255         if ( rgfast.eq.rangfa ) then
 256           if ( glop.ne.0 ) then
 257             write(*,*)'Ne pas tester une face par rapport a elle-meme'
 258           endif
 259           goto 40
 260         endif
 261         if ( rgfast.le.nbtrvi ) then
 262           nufast = nntrvi(2,rgfast)
 263         else
 264           rgqust = rgfast - nbtrvi
 265           nufast = -nnquvi(2,rgqust)
 266         endif
 267         glop1 = 0
 268 cgn          if ( nufast.eq.2098 ) then
 269 cgn            glop1 = 1
 270 cgn          endif
 271         if ( glop.ne.0 .or. glop1.ne.0 ) then
 272           write(*,*)'.... Face stockee', nufast,', (rang',rgfast,')'
 273         endif
 274 c
 275 c 4.2. ==> On commence par s'assurer que la face stockee n'est pas
 276 c          parallele a l'axe de vision. Si c'est le cas, leur ordre
 277 c          de trace relatif n'a aucune importance. On passe donc a la
 278 c          face stockee suivante.
 279 c
 280         daux = sqrt( abs(xyzfac(rgfast,7))**2
 281      >       +       abs(xyzfac(rgfast,8))**2
 282      >       +       abs(xyzfac(rgfast,9))**2 )
 283         if ( abs(xyzfac(rgfast,9))/daux.le.dzmini ) then
 284           if ( glop.ne.0 .or. glop1.ne.0 ) then
 285             write(*,1794)'Nx',xyzfac(rgfast,7),'Ny',xyzfac(rgfast,8),
 286      >                   'Nz',xyzfac(rgfast,9)
 287             write(*,1794)'norme',daux,
 288      >                   'Nz/norme',abs(xyzfac(rgfast,9))/daux
 289             write(*,*)'La face stockee est parallele a la vision'
 290           endif
 291           goto 40
 292         endif
 293 c
 294 c 4.3. ==> Si le quadrangle enveloppe de la face stockee n'a pas de
 295 c          recouvrement avec la face a classer, leur ordre de trace
 296 c          relatif n'a aucune importance. On passe donc a la face
 297 c          stockee suivante.
 298 c
 299         if ( xyzfac(rgfast,1).ge.xmaxfa ) then
 300 cgn          write(*,*) '==> xyzfac > xmaxfa'
 301           goto 40
 302         endif
 303         if ( xyzfac(rgfast,2).le.xminfa ) then
 304 cgn          write(*,*) '==> xyzfac < xminfa'
 305           goto 40
 306         endif
 307         if ( xyzfac(rgfast,3).ge.ymaxfa ) then
 308 cgn          write(*,*) '==> xyzfac > ymaxfa'
 309           goto 40
 310         endif
 311         if ( xyzfac(rgfast,4).le.yminfa ) then
 312 cgn          write(*,*) '==> xyzfac < yminfa'
 313           goto 40
 314         endif
 315 c
 316 c 4.4. ==> Les deux quadrangles enveloppes des faces se recouvrent,
 317 c          mais pas forcement les faces.
 318 c          On cherche a savoir si les deux faces partagent une
 319 c          surface non vide. C'est de la methode arlequin ;=)
 320 c          On va chercher si un point interne a la face stockee est
 321 c          strictement interne a la face a classer.
 322 c          Si on en trouve un, on calculera ses distances.
 323 c
 324         if ( glop.ne.0 .or. glop1.ne.0 ) then
 325           write(*,*)'....... Point commun aux deux faces ?'
 326         endif
 327 c
 328 c 4.4.1. ==> Transfert des coordonnees des noeuds de la face a classer
 329 c            Remarque : on ne le fait qu'une fois
 330 c
 331         if ( prem ) then
 332           if ( rangfa.le.nbtrvi ) then
 333             v1(1) = coopro(1,nntrvi(3,rangfa))
 334             v1(2) = coopro(2,nntrvi(3,rangfa))
 335             v2(1) = coopro(1,nntrvi(4,rangfa))
 336             v2(2) = coopro(2,nntrvi(4,rangfa))
 337             v3(1) = coopro(1,nntrvi(5,rangfa))
 338             v3(2) = coopro(2,nntrvi(5,rangfa))
 339             nbnfac = 3
 340           else
 341             v1(1) = coopro(1,nnquvi(3,rangqu))
 342             v1(2) = coopro(2,nnquvi(3,rangqu))
 343             v2(1) = coopro(1,nnquvi(4,rangqu))
 344             v2(2) = coopro(2,nnquvi(4,rangqu))
 345             v3(1) = coopro(1,nnquvi(5,rangqu))
 346             v3(2) = coopro(2,nnquvi(5,rangqu))
 347             v4(1) = coopro(1,nnquvi(6,rangqu))
 348             v4(2) = coopro(2,nnquvi(6,rangqu))
 349             nbnfac = 4
 350           endif
 351           prem = .false.
 352         endif
 353 c
 354 c 4.4.2. ==> Transfert des coordonnees des noeuds de la face stockee
 355 c
 356         if ( rgfast.le.nbtrvi ) then
 357           w1(1) = coopro(1,nntrvi(3,rgfast))
 358           w1(2) = coopro(2,nntrvi(3,rgfast))
 359           w2(1) = coopro(1,nntrvi(4,rgfast))
 360           w2(2) = coopro(2,nntrvi(4,rgfast))
 361           w3(1) = coopro(1,nntrvi(5,rgfast))
 362           w3(2) = coopro(2,nntrvi(5,rgfast))
 363           nbnfst = 3
 364         else
 365           w1(1) = coopro(1,nnquvi(3,rgqust))
 366           w1(2) = coopro(2,nnquvi(3,rgqust))
 367           w2(1) = coopro(1,nnquvi(4,rgqust))
 368           w2(2) = coopro(2,nnquvi(4,rgqust))
 369           w3(1) = coopro(1,nnquvi(5,rgqust))
 370           w3(2) = coopro(2,nnquvi(5,rgqust))
 371           w4(1) = coopro(1,nnquvi(6,rgqust))
 372           w4(2) = coopro(2,nnquvi(6,rgqust))
 373           nbnfst = 4
 374         endif
 375         if ( glop1.ne.0 ) then
 376           write(*,*)'....... Noeuds de la face stockee'
 377           if ( rgfast.le.nbtrvi ) then
 378             write(*,1797) nntrvi(3,rgfast), (w1(iaux),iaux=1,2)
 379             write(*,1797) nntrvi(4,rgfast), (w2(iaux),iaux=1,2)
 380             write(*,1797) nntrvi(5,rgfast), (w3(iaux),iaux=1,2)
 381           else
 382             write(*,1797) nnquvi(3,rgqust), (w1(iaux),iaux=1,2)
 383             write(*,1797) nnquvi(4,rgqust), (w2(iaux),iaux=1,2)
 384             write(*,1797) nnquvi(5,rgqust), (w3(iaux),iaux=1,2)
 385             write(*,1797) nnquvi(6,rgqust), (w4(iaux),iaux=1,2)
 386           endif
 387           write(*,1796)'normale',(xyzfac(rgfast,iaux),iaux=7,9)
 388         endif
 389 c
 390 c 4.4.3. ==> Un point de la face a classer est-il dans la face stockee ?
 391 c
 392 #ifdef _DEBUG_HOMARD_
 393       write (ulsort,texte(langue,3)) 'PPPMA5', nompro
 394 #endif
 395         call pppma5 ( dedans, wn,
 396      >                nbnfst, w1, w2, w3, w4,
 397      >                nbnfac, v1, v2, v3, v4,
 398      >                ulsort, langue, codret )
 399 c
 400         if ( dedans ) then
 401           if ( glop.ne.0 .or. glop1.ne.0 ) then
 402             write(*,*)'..... Un point de',numfac,' est dans', nufast
 403             write(*,*)'..... modif pour',numfac,', rang', rangfa
 404           endif
 405           tabaux(rangfa) = 1
 406           goto 457
 407         endif
 408 c
 409 c 4.4.4. ==> Un point de la face stockee est-il dans la face a classer ?
 410 c
 411         if ( codret.eq.0 ) then
 412 c
 413 #ifdef _DEBUG_HOMARD_
 414       write (ulsort,texte(langue,3)) 'PPPMA5', nompro
 415 #endif
 416         call pppma5 ( dedans, wn,
 417      >                nbnfac, v1, v2, v3, v4,
 418      >                nbnfst, w1, w2, w3, w4,
 419      >                ulsort, langue, codret )
 420 c
 421         if ( dedans ) then
 422           if ( glop.ne.0 .or. glop1.ne.0 ) then
 423             write(*,*)'..... Un point de', nufast,' est dans',numfac
 424             write(*,*)'..... modif pour',numfac,'(rangfa =', rangfa,')'
 425           endif
 426           tabaux(rangfa) = 1
 427           goto 457
 428         endif
 429 c
 430         endif
 431 c
 432 c 4.4.5. ==> Sortie prematuree
 433 c
 434         if ( codret.ne.0 ) then
 435           goto 59
 436         endif
 437 c
 438 c 4.4.5. ==> Si on arrive ici c'est qu'on a n'a pas reussi a mettre
 439 c            un point dans la zone commune aux 2 faces.
 440 c            On passe a la suite
 441 c
 442         if ( glop.ne.0 .or. glop1.ne.0 ) then
 443           write(*,*) 'Impossible de trier les faces',numfac,' et',nufast
 444         endif
 445 c              if ( glop1.ne.0 ) then
 446 c                stop
 447 c              endif
 448         goto 40
 449 c
 450 c 4.4.7. ==> Test des profondeurs du point vis-a-vis des 2 faces
 451 c
 452   457   continue
 453 c
 454 c 4.4.7.1. ==> Face a classer
 455 c
 456         if ( rangfa.le.nbtrvi ) then
 457           zvuefa = coopro(3,nntrvi(3,rangfa))
 458         else
 459           zvuefa = coopro(3,nnquvi(3,rangqu))
 460         endif
 461         zvuefa = zvuefa
 462      > - ( (wn(1)-v1(1))*xyzfac(rangfa,7)
 463      >   + (wn(2)-v1(2))*xyzfac(rangfa,8) ) / xyzfac(rangfa,9)
 464 c
 465 c 4.4.7.2. ==> Face stokee
 466 c
 467         if ( rgfast.le.nbtrvi ) then
 468           zvuefs = coopro(3,nntrvi(3,rgfast))
 469         else
 470           zvuefs = coopro(3,nnquvi(3,rgqust))
 471         endif
 472         zvuefs = zvuefs
 473      > - ( (wn(1)-w1(1))*xyzfac(rgfast,7)
 474      >   + (wn(2)-w1(2))*xyzfac(rgfast,8) ) / xyzfac(rgfast,9)
 475 c
 476 cgn          if ( glop.ne.0 ) then
 477 cgn            write(*,1796)'... point commun', wn
 478 cgn            write(*,*)'....... zvuefs = ',zvuefs
 479 cgn            write(*,*)'....... zvuefa = ',zvuefa
 480 cgn          endif
 481 c
 482 c 4.4.7.3. ==> Comparaison :
 483 c              Si la face a classer est derriere la face a stocker,
 484 c              il faut l'inserer a cet endroit, sinon, on ne fait rien
 485 c
 486         if ( zvuefa.le.zvuefs ) then
 487 c
 488           lerang = indpos
 489           if ( glop.ne.0 ) then
 490           write(*,*)'La face',numfac,'est derriere la face', nufast
 491           endif
 492 c
 493           goto 50
 494 #ifdef _DEBUG_HOMARD_
 495         else
 496           if ( glop.ne.0 ) then
 497           write(*,*)'La face',nufast,'est derriere la face', numfac
 498           endif
 499 #endif
 500 c
 501         endif
 502 c
 503    40 continue
 504 c
 505       if ( tabaux(rangfa).eq.0 ) then
 506         if ( glop.ne.0 ) then
 507           write(*,*) 'Impossible de placer la face',numfac
 508         endif
 509         goto 59
 510       endif
 511 c
 512 c====
 513 c 5. On insere la face a la position lerang
 514 c====
 515 c
 516    50 continue
 517 c
 518       if ( glop.ne.0 ) then
 519         write(*,*) '==> On insere la face',numfac,' en', lerang
 520       endif
 521 c
 522       nbfast = nbfast + 1
 523       do 51 , indpos = nbfast , lerang+1, -1
 524 cgn        write(ulsort,*)'indpos =',indpos
 525         posini(indpos) = posini(indpos-1)
 526    51 continue
 527       posini(lerang) = rangfa
 528 c
 529       if ( glop.ne.0 ) then
 530         do 501 , iaux = 1 , nbfast
 531           if ( posini(iaux).le.nbtrvi ) then
 532             jaux = nntrvi(2,posini(iaux))
 533           else
 534             jaux = -nnquvi(2,posini(iaux)-nbtrvi)
 535           endif
 536           write (*,*) iaux,posini(iaux),'-eme face :',jaux
 537   501   continue
 538       endif
 539 c
 540    59 continue
 541 c
 542       if ( glop.ne.0 ) then
 543         if ( posini(1).le.nbtrvi ) then
 544           iaux = nntrvi(2,posini(1))
 545         else
 546           iaux = -nnquvi(2,posini(1)-nbtrvi)
 547         endif
 548         write(*,*)'Face la plus eloignee :', iaux
 549         if ( posini(nbfast).le.nbtrvi ) then
 550           iaux = nntrvi(2,posini(nbfast))
 551         else
 552           iaux = -nnquvi(2,posini(nbfast)-nbtrvi)
 553         endif
 554         write(*,*)'Face la plus proche   :', iaux
 555       endif
 556 cgn          stop
 557 c
 558 c====
 559 c 6. la fin
 560 c====
 561 c
 562       if ( codret.ne.0 ) then
 563 c
 564 #include "envex2.h"
 565 c
 566       write (ulsort,texte(langue,1)) 'Sortie', nompro
 567       write (ulsort,texte(langue,2)) codret
 568 c
 569       endif
 570 c
 571 #ifdef _DEBUG_HOMARD_
 572       write (ulsort,texte(langue,1)) 'Sortie', nompro
 573       call dmflsh (iaux)
 574 #endif
 575 c
 576       end