src/tool/Suivi_Frontiere/sfcaf1.F

   1       subroutine sfcaf1 ( nomail, nbarfr, nbqufr,
   2      >                    ncafdg, nocdfr, ncafan, ncafar,
   3      >                    suifro, ulgrfr,
   4      >                    lgetco, taetco,
   5      >                    ulsort, langue, codret )
   6 c ______________________________________________________________________
   7 c
   8 c                             H O M A R D
   9 c
  10 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  11 c
  12 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  13 c aupres des huissiers de justice Simart et Lavoir a Clamart
  14 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  15 c aupres des huissiers de justice
  16 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  17 c
  18 c    HOMARD est une marque deposee d'Electricite de France
  19 c
  20 c Copyright EDF 1996
  21 c Copyright EDF 1998
  22 c Copyright EDF 2002
  23 c Copyright EDF 2020
  24 c ______________________________________________________________________
  25 c
  26 c   Suivi de Frontiere : CAlcul des nouvelles Frontieres - 1
  27 c   --                   --                   -            -
  28 c ______________________________________________________________________
  29 c .        .     .        .                                            .
  30 c .  nom   . e/s . taille .           description                      .
  31 c .____________________________________________________________________.
  32 c . nomail . e   . char8  . nom de l'objet maillage homard iter. n+1   .
  33 c . nbarfr . e   .   1    . nombre d'aretes concernees                 .
  34 c . nbqufr . e   .   1    . nombre de quadrangles concernes            .
  35 c . ncafdg . e   . char*8 . nom de l'objet des frontieres discretes   :.
  36 c .        .     .        . nom des groupes                            .
  37 c . nocdfr . e   . char8  . nom de l'objet description de la frontiere .
  38 c . ncafan . e   . char*8 . nom de l'objet des frontieres analytiques :.
  39 c .        .     .        . description des frontieres                 .
  40 c . ncafar . e   . char*8 . nom de l'objet des frontieres analytiques :.
  41 c .        .     .        . valeurs reelles                            .
  42 c . suifro . e   .   1    . 1 : pas de suivi de frontiere              .
  43 c .        .     .        . 2x : frontiere discrete                    .
  44 c .        .     .        . 3x : frontiere analytique                  .
  45 c .        .     .        . 5x : frontiere cao                         .
  46 c . ulgrfr . e   .   *    . unite logique des groupes frontieres CAO   .
  47 c . lgetco . e   .   1    . longueur du tableau de l'etat courant      .
  48 c . taetco . e   . lgetco . tableau de l'etat courant                  .
  49 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  50 c . langue . e   .    1   . langue des messages                        .
  51 c .        .     .        . 1 : francais, 2 : anglais                  .
  52 c . codret . es  .    1   . code de retour des modules                 .
  53 c .        .     .        . en entree = celui du module d'avant        .
  54 c .        .     .        . en sortie = celui du module en cours       .
  55 c .        .     .        . 0 : pas de probleme                        .
  56 c .        .     .        . 1 : manque de temps cpu                    .
  57 c .        .     .        . 2x : probleme dans les memoires            .
  58 c .        .     .        . 3x : probleme dans les fichiers            .
  59 c .        .     .        . 5 : mauvaises options                      .
  60 c .        .     .        . 6 : problemes dans les noms d'objet        .
  61 c ______________________________________________________________________
  62 c
  63 c Nombre d'aretes et de quadrangles concernes :
  64 c            ---> SFCONA
  65 c            ---> SFCONQ
  66 c
  67 c Reperage des noeuds P2 sur les lignes frontiere :
  68 c            ---> SFNOFL ---> SFNNFL
  69 c                        ---> SFLISO ---> SFSENO
  70 c                                    ---> SFLISE
  71 c Suivi des frontieres
  72 c            ---> SFCAF2 ---> SFFA01
  73 c                        ---> SFFA02
  74 c                        ---> SFFA03
  75 c                        ---> SFFA05
  76 c                        ---> SFSLIN
  77 c            ---> SFNULI
  78 c Correction des noeuds P2 :
  79 c            ---> SFMOP2
  80 c Controles :
  81 c            ---> SFCOTL ---> SFCOT1 ---> SFCOVO ---> UTCOTE
  82 c                                                ---> UTCOHE
  83 c                                    ---> UTCORN ---> UTSOQU
  84 c                                    ---> SFCOVO ---> UTCOTE
  85 c                                                ---> UTCOHE
  86 c                                    ---> SFCOFA ---> SFTQTR
  87 c                                                ---> SFTQQU
  88 c                                    ---> UTCORN ---> UTSOQU
  89 c                                    ---> SFBATR ---> SFBATT
  90 c                        ---> SFCOT2 ---> UTB3F1
  91 c                                    ---> UTB3G1
  92 c                                    ---> UTB3D1
  93 c                                    ---> UTB3E1
  94 c Correction des noeuds P2 :
  95 c            ---> SFMOP2
  96 c====
  97 c 0. declarations et dimensionnement
  98 c====
  99 c
 100 c 0.1. ==> generalites
 101 c
 102       implicit none
 103       save
 104 c
 105       character*6 nompro
 106       parameter ( nompro = 'SFCAF1' )
 107 c
 108 #include "nblang.h"
 109 c
 110 c 0.2. ==> communs
 111 c
 112 #include "envex1.h"
 113 c
 114 #include "gmenti.h"
 115 #include "gmreel.h"
 116 c
 117 #include "envca1.h"
 118 #include "nombno.h"
 119 #include "nombqu.h"
 120 #include "nombtr.h"
 121 #include "nombte.h"
 122 #include "nombhe.h"
 123 #include "nombpe.h"
 124 #include "nombpy.h"
 125 #include "precis.h"
 126 c
 127 c 0.3. ==> arguments
 128 c
 129       character*8 nomail
 130       character*8 ncafdg, nocdfr, ncafan, ncafar
 131 c
 132       integer suifro
 133       integer ulgrfr(*)
 134       integer nbarfr, nbqufr
 135 c
 136       integer lgetco
 137       integer taetco(lgetco)
 138 c
 139       integer ulsort, langue, codret
 140 c
 141 c 0.4. ==> variables locales
 142 c
 143       integer iaux, jaux
 144 c
 145       integer pcoono, adcocs
 146       integer adhono, pareno
 147       integer adnuno, adlino, adacno
 148       integer phetno
 149       integer psomar, phetar, pfilar, pnp2ar, pfacar, pposif
 150       integer pcfaar, pfamar
 151       integer phettr, paretr, pfiltr
 152       integer phetqu, parequ, pfilqu
 153       integer pcfaqu, pfamqu
 154       integer ptrite, pcotrt, parete, phette, pfilte
 155       integer pquahe, pcoquh, parehe, phethe, pfilhe
 156       integer pfacpy, pcofay, parepy, phetpy
 157       integer pfacpe, pcofap, parepe, phetpe
 158       integer advotr, advoqu
 159       integer adpptr, adppqu
 160       integer adabsc, psomse, psegli, pnumli, ptypli, pgeoco
 161       integer adcafr
 162       integer pttgrd
 163       integer nbfrdi, nbfran
 164       integer adtra4, adtra5
 165 c
 166       integer codre0
 167       integer codre1, codre2, codre3, codre4, codre5
 168       integer codre6
 169 c
 170       double precision unst2x, epsid2
 171 c
 172 #ifdef _DEBUG_HOMARD_
 173       character*8 action
 174       parameter ( action = 'sufr    ' )
 175 #endif
 176       character*8 norenu
 177       character*8 nhnoeu, nhmapo, nharet, nhtria, nhquad
 178       character*8 nhtetr, nhhexa, nhpyra, nhpent
 179       character*8 nhelig
 180       character*8 nhvois, nhsupe, nhsups
 181       character*8 ntrav1, ntrav2, ntrav3, ntrav4, ntrav5
 182 c
 183 #ifdef _DEBUG_HOMARD_
 184       character*6 nompra
 185 #endif
 186 c
 187       integer nbmess
 188       parameter ( nbmess = 10 )
 189       character*80 texte(nblang,nbmess)
 190 c
 191 c 0.5. ==> initialisations
 192 c ______________________________________________________________________
 193 c
 194 c====
 195 c 1. messages
 196 c====
 197 c
 198 #include "impr01.h"
 199 c
 200 #ifdef _DEBUG_HOMARD_
 201       write (ulsort,texte(langue,1)) 'Entree', nompro
 202       call dmflsh (iaux)
 203 #endif
 204 c
 205 #include "impr03.h"
 206 c
 207 #ifdef _DEBUG_HOMARD_
 208       if ( codret.eq.0 ) then
 209 c
 210       iaux = 0
 211       call utveri ( action, nomail, nompro, iaux,
 212      >              ulsort, langue, codret )
 213 c
 214       endif
 215 #endif
 216 c
 217 c====
 218 c 2. recuperation des pointeurs
 219 c====
 220 c 2.1. ==> structure generale
 221 c
 222       if ( codret.eq.0 ) then
 223 c
 224 #ifdef _DEBUG_HOMARD_
 225       write (ulsort,texte(langue,3)) 'UTNOMH', nompro
 226 #endif
 227       call utnomh ( nomail,
 228      >                sdim,   mdim,
 229      >               degre, maconf, homolo, hierar,
 230      >              rafdef, nbmane, typcca, typsfr, maextr,
 231      >              mailet,
 232      >              norenu,
 233      >              nhnoeu, nhmapo, nharet,
 234      >              nhtria, nhquad,
 235      >              nhtetr, nhhexa, nhpyra, nhpent,
 236      >              nhelig,
 237      >              nhvois, nhsupe, nhsups,
 238      >              ulsort, langue, codret)
 239 c
 240       endif
 241 c
 242 c 2.2.==> tableaux du maillage
 243 c
 244       if ( codret.eq.0 ) then
 245 c
 246 #ifdef _DEBUG_HOMARD_
 247       write (ulsort,texte(langue,3)) 'UTAD01', nompro
 248 #endif
 249       iaux = 30*19
 250       if ( homolo.ge.1 ) then
 251         iaux = iaux*11
 252       endif
 253       call utad01 ( iaux, nhnoeu,
 254      >              phetno,
 255      >                jaux,   jaux,   jaux,
 256      >              pcoono, pareno, adhono, adcocs,
 257      >              ulsort, langue, codret )
 258 c
 259 #ifdef _DEBUG_HOMARD_
 260       write (ulsort,texte(langue,3)) 'UTAD02_ar', nompro
 261 #endif
 262       iaux = 1554
 263       if ( degre.eq.2 ) then
 264         iaux = iaux*13
 265       endif
 266       call utad02 ( iaux, nharet,
 267      >              phetar, psomar, pfilar, jaux,
 268      >              pfamar, pcfaar,   jaux,
 269      >                jaux, pnp2ar,   jaux,
 270      >                jaux,   jaux,   jaux,
 271      >              ulsort, langue, codret )
 272 c
 273       if ( nbtrto.gt.0 ) then
 274 c
 275 #ifdef _DEBUG_HOMARD_
 276       write (ulsort,texte(langue,3)) 'UTAD02_tr', nompro
 277 #endif
 278         iaux = 6
 279         call utad02 ( iaux, nhtria,
 280      >                phettr, paretr, pfiltr, jaux,
 281      >                  jaux,   jaux,   jaux,
 282      >                  jaux,   jaux,   jaux,
 283      >                  jaux,   jaux,   jaux,
 284      >                ulsort, langue, codret )
 285 c
 286       endif
 287 c
 288       if ( nbquto.gt.0 ) then
 289 c
 290 #ifdef _DEBUG_HOMARD_
 291       write (ulsort,texte(langue,3)) 'UTAD02_qu', nompro
 292 #endif
 293         iaux = 1554
 294         call utad02 ( iaux, nhquad,
 295      >                phetqu, parequ, pfilqu, jaux,
 296      >                pfamqu, pcfaqu,   jaux,
 297      >                  jaux,   jaux,   jaux,
 298      >                  jaux,   jaux,   jaux,
 299      >                ulsort, langue, codret )
 300 c
 301       endif
 302 c
 303       if ( nbteto.ne.0 ) then
 304 c
 305         iaux = 78
 306         if ( nbteca.gt.0 ) then
 307           iaux = iaux*31
 308         endif
 309 #ifdef _DEBUG_HOMARD_
 310       write (ulsort,texte(langue,3)) 'UTAD02_te', nompro
 311 #endif
 312         call utad02 ( iaux, nhtetr,
 313      >                phette, ptrite, pfilte,   jaux,
 314      >                  jaux,   jaux,   jaux,
 315      >                  jaux, pcotrt,   jaux,
 316      >                  jaux,   jaux, parete,
 317      >                ulsort, langue, codret )
 318 c
 319       endif
 320 c
 321       if ( nbheto.ne.0 ) then
 322 c
 323         iaux = 78
 324         if ( nbheca.gt.0 ) then
 325           iaux = iaux*31
 326         endif
 327 #ifdef _DEBUG_HOMARD_
 328       write (ulsort,texte(langue,3)) 'UTAD02_he', nompro
 329 #endif
 330         call utad02 ( iaux, nhhexa,
 331      >                phethe, pquahe, pfilhe,   jaux,
 332      >                  jaux,   jaux,   jaux,
 333      >                  jaux, pcoquh,   jaux,
 334      >                  jaux,   jaux, parehe,
 335      >                ulsort, langue, codret )
 336 c
 337       endif
 338 c
 339       if ( nbpyto.ne.0 ) then
 340 c
 341         iaux = 26
 342         if ( nbpyca.gt.0 ) then
 343           iaux = iaux*31
 344         endif
 345 #ifdef _DEBUG_HOMARD_
 346       write (ulsort,texte(langue,3)) 'UTAD02_py', nompro
 347 #endif
 348         call utad02 ( iaux, nhpyra,
 349      >                phetpy, pfacpy, jaux  , jaux,
 350      >                  jaux,   jaux,   jaux,
 351      >                  jaux, pcofay,   jaux,
 352      >                  jaux,   jaux, parepy,
 353      >                ulsort, langue, codret )
 354 c
 355       endif
 356 c
 357       if ( nbpeto.ne.0 ) then
 358 c
 359         iaux = 26
 360         if ( nbpeca.gt.0 ) then
 361           iaux = iaux*31
 362         endif
 363 #ifdef _DEBUG_HOMARD_
 364       write (ulsort,texte(langue,3)) 'UTAD02_pe', nompro
 365 #endif
 366         call utad02 ( iaux, nhpent,
 367      >                phetpe, pfacpe, jaux  , jaux,
 368      >                  jaux,   jaux,   jaux,
 369      >                  jaux, pcofap,   jaux,
 370      >                  jaux,   jaux, parepe,
 371      >                ulsort, langue, codret )
 372 c
 373       endif
 374 c
 375       endif
 376 c
 377       if ( codret.eq.0 ) then
 378 c
 379 #ifdef _DEBUG_HOMARD_
 380       write (ulsort,texte(langue,3)) 'UTAD04', nompro
 381 #endif
 382       iaux = 3
 383       if ( nbteto.ne.0 .or. nbpyto.ne.0 .or. nbpeto.ne.0 ) then
 384         iaux = iaux*5
 385       endif
 386       if ( nbheto.ne.0 .or. nbpyto.ne.0 .or. nbpeto.ne.0 ) then
 387         iaux = iaux*7
 388       endif
 389       if ( nbpyto.ne.0 .or. nbpeto.ne.0 ) then
 390         iaux = iaux*221
 391       endif
 392       call utad04 ( iaux, nhvois,
 393      >                jaux,   jaux, pposif, pfacar,
 394      >              advotr, advoqu,
 395      >                jaux,   jaux, adpptr, adppqu,
 396      >                jaux,   jaux,   jaux,
 397      >                jaux,   jaux,   jaux,
 398      >                jaux,   jaux,   jaux,
 399      >                jaux,   jaux,   jaux,
 400      >              ulsort, langue, codret )
 401 c
 402       endif
 403 cgn      call gmprsx(nompro,nhvois)
 404 cgn      call gmprsx(nompro,nhvois//'.Vol/Tri')
 405 c
 406 c 2.3. ==> Stockage des entites concernees par la frontiere
 407 c
 408       if ( codret.eq.0 ) then
 409 c
 410       call gmalot ( ntrav4, 'entier', nbarfr, adtra4, codre1 )
 411       if ( nbquto.gt.0 ) then
 412         call gmalot ( ntrav5, 'entier', nbqufr, adtra5, codre2 )
 413       else
 414         codre2 = 0
 415       endif
 416 c
 417       codre0 = min ( codre1, codre2 )
 418       codret = max ( abs(codre0), codret,
 419      >               codre1, codre2 )
 420 c
 421       endif
 422 c
 423       if ( codret.eq.0 ) then
 424 c
 425       iaux = 1
 426 c
 427 #ifdef _DEBUG_HOMARD_
 428       write (ulsort,texte(langue,3)) 'SFCONA', nompro
 429 #endif
 430       call sfcona ( iaux, nbarfr, imem(adtra4),
 431      >              imem(phetar), imem(pcfaar), imem(pfamar),
 432      >              ulsort, langue, codret )
 433 c
 434 #ifdef _DEBUG_HOMARD_
 435       call gmprsx(nompro,ntrav4)
 436 #endif
 437 c
 438       endif
 439 c
 440       if ( codret.eq.0 ) then
 441 c
 442       if ( nbqufr.gt.0 ) then
 443 c
 444         iaux = 1
 445 c
 446 #ifdef _DEBUG_HOMARD_
 447       write (ulsort,texte(langue,3)) 'SFCONQ', nompro
 448 #endif
 449         call sfconq ( iaux, nbqufr, imem(adtra5),
 450      >                imem(phetqu), imem(pcfaqu), imem(pfamqu),
 451      >                ulsort, langue, codret )
 452 c
 453 #ifdef _DEBUG_HOMARD_
 454       call gmprsx(nompro,ntrav5)
 455 #endif
 456 c
 457        endif
 458 c
 459       endif
 460 c
 461 c 2.4. ==> Tolerance pour les tests de coincidence
 462 c          Attention : sfcaf1 et sfcoin doivent etre coherents
 463 c
 464       if ( codret.eq.0 ) then
 465 c
 466       unst2x = 1.d0 / rmem(adcocs+10)**2
 467       epsid2 = max(1.d-14,epsima)
 468 c
 469       endif
 470 c
 471 c====
 472 c 3. Les structures des frontieres
 473 c====
 474 #ifdef _DEBUG_HOMARD_
 475       write (ulsort,90002) '3. Les frontieres ; codret', codret
 476 #endif
 477 c
 478 c 3.1. ==> Discretes
 479 c
 480       nbfrdi = 0
 481 c
 482       if ( mod(suifro,2).eq.0 ) then
 483 c
 484 c 3.1.1. ==> Combien de frontieres discretes
 485 c
 486 #ifdef _DEBUG_HOMARD_
 487         call gmprsx (nompro, ncafdg )
 488 #endif
 489 c
 490         if ( codret.eq.0 ) then
 491 c
 492         if ( suifro.gt.0 ) then
 493 c
 494           call gmliat ( ncafdg, 1, nbfrdi, codret )
 495 c
 496         else
 497 c
 498           call gmadoj ( ncafdg, pttgrd, nbfrdi, codret )
 499 c
 500         endif
 501 c
 502         endif
 503 c
 504 c 3.1.2. ==> Description des frontieres discretes
 505 c
 506         if ( nbfrdi.gt.0 ) then
 507 c
 508           if ( codret.eq.0 ) then
 509 c
 510 #ifdef _DEBUG_HOMARD_
 511       call gmliat (nocdfr, 2, iaux, codret )
 512       call gmprot (nompro, nocdfr//'.CoorNoeu', 1 , 20 )
 513       call gmprot (nompro, nocdfr//'.CoorNoeu', 3*iaux-19 , 3*iaux )
 514       call gmprsx (nompro, nocdfr//'.NumeLign' )
 515       call gmprsx (nompro, nocdfr//'.PtrSomLi' )
 516       call gmprot (nompro, nocdfr//'.SommSegm', 1 , 20 )
 517       call gmprot (nompro, nocdfr//'.SommSegm', 999 , 1002 )
 518       call gmprot (nompro, nocdfr//'.SommSegm', 1003 , 1008 )
 519       call gmprot (nompro, nocdfr//'.SommSegm', 1999 , 2004 )
 520       call gmprot (nompro, nocdfr//'.AbsCurvi', 1 , 20 )
 521       call gmprot (nompro, nocdfr//'.AbsCurvi', 999 , 1002 )
 522       call gmprot (nompro, nocdfr//'.AbsCurvi', 1003 , 1008 )
 523       call gmprot (nompro, nocdfr//'.AbsCurvi', 1999 , 2004 )
 524 #endif
 525 c
 526           call gmadoj ( nocdfr//'.CoorNoeu', pgeoco, iaux, codre1 )
 527           call gmadoj ( nocdfr//'.NumeLign', pnumli, iaux, codre2 )
 528           call gmadoj ( nocdfr//'.TypeLign', ptypli, iaux, codre3 )
 529           call gmadoj ( nocdfr//'.PtrSomLi', psegli, iaux, codre4 )
 530           call gmadoj ( nocdfr//'.SommSegm', psomse, iaux, codre5 )
 531           call gmadoj ( nocdfr//'.AbsCurvi', adabsc, iaux, codre6 )
 532 c
 533           codre0 = min ( codre1, codre2, codre3, codre4, codre5,
 534      >                   codre6 )
 535           codret = max ( abs(codre0), codret,
 536      >                   codre1, codre2, codre3, codre4, codre5,
 537      >                   codre6 )
 538 c
 539           endif
 540 c
 541         endif
 542 c
 543       endif
 544 c
 545 c 3.2. ==> Analytiques
 546 c
 547       nbfran = 0
 548 c
 549       if ( mod(suifro,3).eq.0 ) then
 550 c
 551 c 3.2.1. ==> Combien de frontieres analytiques
 552 c
 553         if ( codret.eq.0 ) then
 554 c
 555         call gmliat ( ncafan, 1, nbfran, codret )
 556 c
 557         endif
 558 c
 559 c 3.2.2. ==> Description des frontieres analytiques
 560 c
 561         if ( nbfran.gt.0 ) then
 562 c
 563 #ifdef _DEBUG_HOMARD_
 564         call gmprsx (nompro, ncafar )
 565 #endif
 566 c
 567         if ( codret.eq.0 ) then
 568 c
 569           call gmadoj ( ncafar, adcafr, iaux, codret )
 570 c
 571         endif
 572 c
 573         endif
 574 c
 575       endif
 576 c
 577 #ifdef _DEBUG_HOMARD_
 578       write (ulsort,90002) 'nbfrdi', nbfrdi
 579       write (ulsort,90002) 'nbfran', nbfran
 580 #endif
 581 c
 582 c====
 583 c 4. Noeuds initiaux et frontiere
 584 c====
 585 #ifdef _DEBUG_HOMARD_
 586       write (ulsort,90002) '4. Noeuds ini / frontiere ; codret', codret
 587 #endif
 588 c
 589       if ( nbfrdi.gt.0 ) then
 590 c
 591         if ( codret.eq.0 ) then
 592 c
 593 #ifdef _DEBUG_HOMARD_
 594       write (ulsort,texte(langue,3)) 'SFNOFL', nompro
 595 #endif
 596         call sfnofl ( ntrav1, ntrav2, ntrav3,
 597      >                adnuno, adlino, adacno,
 598      >                unst2x, epsid2,
 599      >                rmem(pcoono),
 600      >                imem(psomar), imem(phetar), imem(pfilar),
 601      >                imem(pnp2ar),
 602      >                imem(pcfaar), imem(pfamar),
 603      >                rmem(pgeoco), rmem(adabsc),
 604      >                imem(psomse), imem(psegli),
 605      >                lgetco, taetco,
 606      >                ulsort, langue, codret )
 607 c
 608         endif
 609 c
 610 #ifdef _DEBUG_HOMARD_
 611       if ( codret.eq.0 ) then
 612 c
 613       nompra = 'sfnofl'
 614       iaux = 2
 615       call utveri ( action, nomail, nompra, iaux,
 616      >              ulsort, langue, codret )
 617 c
 618       endif
 619 #endif
 620 c
 621       endif
 622 c
 623 c====
 624 c 5. Suivi sur les frontieres
 625 c====
 626 #ifdef _DEBUG_HOMARD_
 627       write (ulsort,90002) '5. Suivi ; codret', codret
 628 #endif
 629 c
 630       if ( codret.eq.0 ) then
 631 c
 632 #ifdef _DEBUG_HOMARD_
 633       write (ulsort,texte(langue,3)) 'SFCAF2', nompro
 634 #endif
 635       call sfcaf2 ( suifro, ulgrfr,
 636      >              nbfrdi, rmem(pgeoco), rmem(adabsc),
 637      >              imem(adnuno), imem(adlino), rmem(adacno),
 638      >              imem(ptypli), imem(psomse), imem(psegli),
 639      >              nbfran, rmem(adcafr),
 640      >              unst2x, epsid2,
 641      >              rmem(pcoono),
 642      >              imem(adhono),
 643      >              imem(phetar), imem(psomar), imem(pfilar),
 644      >              imem(pnp2ar), imem(pcfaar), imem(pfamar),
 645      >              imem(pfacar), imem(pposif),
 646      >              imem(phettr), imem(paretr), imem(pfiltr),
 647      >              imem(advotr),
 648      >              imem(phetqu), imem(parequ), imem(pfilqu),
 649      >              imem(pcfaqu), imem(pfamqu),
 650      >              imem(advoqu),
 651      >              lgetco, taetco,
 652      >              ulsort, langue, codret )
 653 c
 654       endif
 655 c
 656 #ifdef _DEBUG_HOMARD_
 657       if ( codret.eq.0 ) then
 658 c
 659       nompra = 'sfcaf2'
 660       iaux = 2
 661       call utveri ( action, nomail, nompra, iaux,
 662      >              ulsort, langue, codret )
 663 c
 664       endif
 665 #endif
 666 c
 667 c====
 668 c 6. Retablissement des numeros de ligne
 669 c====
 670 c
 671 #ifdef _DEBUG_HOMARD_
 672       write (ulsort,90002) '6. retablissement nros ; codret', codret
 673 #endif
 674 c
 675       if ( nbfrdi.gt.0 ) then
 676 c
 677         if ( codret.eq.0 ) then
 678 c
 679         iaux = 1
 680 #ifdef _DEBUG_HOMARD_
 681       write (ulsort,texte(langue,3)) 'SFNULI', nompro
 682 #endif
 683         call sfnuli ( imem(pcfaar), imem(pnumli), iaux,
 684      >                lgetco, taetco,
 685      >                ulsort, langue, codret )
 686 c
 687         endif
 688 c
 689       endif
 690 c
 691 c====
 692 c 7. Mouvements de noeud induits
 693 c====
 694 #ifdef _DEBUG_HOMARD_
 695       write (ulsort,90002) '7. Mouvements 1 ; codret', codret
 696 #endif
 697 c
 698       if ( codret.eq.0 ) then
 699 c
 700       if ( typsfr.eq.2 ) then
 701 c
 702 #ifdef _DEBUG_HOMARD_
 703       write (ulsort,texte(langue,3)) 'SFMOP2', nompro
 704 #endif
 705       call sfmop2 ( rmem(pcoono), imem(phetno), imem(pareno),
 706      >              imem(psomar),
 707      >              ulsort, langue, codret)
 708       endif
 709 c
 710       endif
 711 c
 712 c====
 713 c 8. Controles
 714 c====
 715 #ifdef _DEBUG_HOMARD_
 716       write (ulsort,90002) '8. Controles ; codret', codret
 717 #endif
 718 c
 719       if ( mod(suifro,5).ne.0 ) then
 720 c
 721       if ( codret.eq.0 ) then
 722 c
 723 #ifdef _DEBUG_HOMARD_
 724       write (ulsort,texte(langue,3)) 'SFCOTL', nompro
 725 #endif
 726       call sfcotl ( rmem(pcoono),
 727      >              imem(psomar), imem(pfilar), imem(pnp2ar),
 728      >              imem(pcfaar), imem(pfamar),
 729      >              imem(pfacar), imem(pposif),
 730      >              imem(phettr), imem(paretr), imem(pfiltr),
 731      >              imem(phetqu), imem(parequ), imem(pfilqu),
 732      >              imem(pcfaqu), imem(pfamqu),
 733      >              imem(ptrite), imem(pcotrt), imem(parete),
 734      >              imem(phette),
 735      >              imem(pfilte),
 736      >              imem(pquahe), imem(pcoquh), imem(parehe),
 737      >              imem(phethe),
 738      >              imem(pfilhe),
 739      >              imem(pfacpy), imem(pcofay), imem(parepy),
 740      >              imem(phetpy),
 741      >              imem(pfacpe), imem(pcofap), imem(parepe),
 742      >              imem(phetpe),
 743      >              imem(advotr), imem(adpptr),
 744      >              imem(advoqu), imem(adppqu),
 745      >              nbarfr, imem(adtra4),
 746      >              nbqufr, imem(adtra5),
 747      >              lgetco, taetco,
 748      >              ulsort, langue, codret )
 749 c
 750       endif
 751 c
 752       endif
 753 c
 754 c====
 755 c 10. Corrections P2
 756 c====
 757 #ifdef _DEBUG_HOMARD_
 758       write (ulsort,90002) '10. Mouvements 2 ; codret', codret
 759 #endif
 760 c
 761       if ( codret.eq.0 ) then
 762 c
 763       if ( typsfr.eq.2 ) then
 764 c
 765 #ifdef _DEBUG_HOMARD_
 766       write (ulsort,texte(langue,3)) 'SFMOP2', nompro
 767 #endif
 768       call sfmop2 ( rmem(pcoono), imem(phetno), imem(pareno),
 769      >              imem(psomar),
 770      >              ulsort, langue, codret)
 771       endif
 772 c
 773       endif
 774 c
 775 c====
 776 c 11. Mise a jour des coordonnes extremes
 777 c====
 778 c
 779       if ( mod(suifro,5).ne.0 ) then
 780 c
 781       if ( codret.eq.0 ) then
 782 c
 783 #ifdef _DEBUG_HOMARD_
 784       write (ulsort,texte(langue,3)) 'UTMMCO', nompro
 785 #endif
 786       call utmmco ( rmem(adcocs+1), rmem(adcocs+4), rmem(adcocs+7),
 787      >              nbnoto, sdim, rmem(pcoono),
 788      >              ulsort, langue, codret )
 789 c
 790       endif
 791 c
 792       endif
 793 c
 794 c====
 795 c 12. Menage
 796 c====
 797 #ifdef _DEBUG_HOMARD_
 798       write (ulsort,90002) '12. menage ; codret', codret
 799 #endif
 800 c
 801       if ( codret.eq.0 ) then
 802 c
 803       if ( nbfrdi.gt.0 ) then
 804 c
 805         call gmlboj ( ntrav1, codre1 )
 806         call gmlboj ( ntrav2, codre2 )
 807         call gmlboj ( ntrav3, codre3 )
 808 c
 809         codre0 = min ( codre1, codre2, codre3 )
 810         codret = max ( abs(codre0), codret,
 811      >                 codre1, codre2, codre3 )
 812 c
 813       endif
 814 c
 815       endif
 816 c
 817       if ( codret.eq.0 ) then
 818 c
 819       call gmlboj ( ntrav4, codre1 )
 820       if ( nbquto.gt.0 ) then
 821         call gmlboj ( ntrav5, codre2 )
 822       else
 823         codre2 = 0
 824       endif
 825 c
 826       codre0 = min ( codre1, codre2 )
 827       codret = max ( abs(codre0), codret,
 828      >               codre1, codre2 )
 829 c
 830       endif
 831 c
 832 #ifdef _DEBUG_HOMARD_
 833       if ( codret.eq.0 ) then
 834 c
 835       iaux = 2
 836       call utveri ( action, nomail, nompro, iaux,
 837      >              ulsort, langue, codret )
 838 c
 839       endif
 840 #endif
 841 c
 842 c====
 843 c 13. la fin
 844 c====
 845 c
 846       if ( codret.ne.0 ) then
 847 c
 848 #include "envex2.h"
 849 c
 850       write (ulsort,texte(langue,1)) 'Sortie', nompro
 851       write (ulsort,texte(langue,2)) codret
 852 c
 853       endif
 854 c
 855 #ifdef _DEBUG_HOMARD_
 856       write (ulsort,texte(langue,1)) 'Sortie', nompro
 857       call dmflsh (iaux)
 858 #endif
 859 c
 860       end