src/tool/Suivi_Frontiere/sfcvgf.F

   1       subroutine sfcvgf ( nohman, mafrmd, nocdfr, ncafdg,
   2      >                    ulsort, langue, codret)
   3 c ______________________________________________________________________
   4 c
   5 c                             H O M A R D
   6 c
   7 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   8 c
   9 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  10 c aupres des huissiers de justice Simart et Lavoir a Clamart
  11 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  12 c aupres des huissiers de justice
  13 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  14 c
  15 c    HOMARD est une marque deposee d'Electricite de France
  16 c
  17 c Copyright EDF 1996
  18 c Copyright EDF 1998
  19 c Copyright EDF 2002
  20 c Copyright EDF 2020
  21 c ______________________________________________________________________
  22 c
  23 c   Suivi de Frontiere - ConVersion de la Geometrie de la Frontiere
  24 c   -        -           -  -             -               -
  25 c ______________________________________________________________________
  26 c .  nom   . e/s . taille .           description                      .
  27 c .____________________________________________________________________.
  28 c . nohman . e   . char*8 . nom de l'objet maillage homard iteration n .
  29 c . mafrmd . e   . char*8 . maillage de la frontiere au format med     .
  30 c . nocdfr .   s . char*8 . maillage de la frontiere a format C        .
  31 c . ncafdg . es  . char*8 . nom de l'objet groupes frontiere           .
  32 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  33 c . langue . e   .    1   . langue des messages                        .
  34 c .        .     .        . 1 : francais, 2 : anglais                  .
  35 c . codret . es  .    1   . code de retour des modules                 .
  36 c .        .     .        . 0 : pas de probleme                        .
  37 c .        .     .        . 2 : probleme avec la memoire               .
  38 c .        .     .        . 3 : probleme avec le fichier               .
  39 c .        .     .        . 5 : contenu incorrect                      .
  40 c ______________________________________________________________________
  41 c
  42 c====
  43 c 0. declarations et dimensionnement
  44 c====
  45 c
  46 c 0.1. ==> generalites
  47 c
  48       implicit none
  49       save
  50 c
  51       character*6 nompro
  52       parameter ( nompro = 'SFCVGF' )
  53 c
  54 #include "nblang.h"
  55 c
  56 c 0.2. ==> communs
  57 c
  58 #include "envex1.h"
  59 c
  60 #include "gmenti.h"
  61 #include "gmreel.h"
  62 #include "gmstri.h"
  63 #include "front1.h"
  64 c
  65 c 0.3. ==> arguments
  66 c
  67       character*8 nohman
  68       character*8 mafrmd, nocdfr, ncafdg
  69 c
  70       integer ulsort, langue, codret
  71 c
  72 c 0.4. ==> variables locales
  73 c
  74       integer   sdim,   mdim
  75       integer  degre, maconf, homolo, hierar
  76       integer rafdef, nbmane, typcca, typsfr, maextr
  77       integer mailet
  78       integer ptypel, pnoeel, nbnoto,nbelem, nvosom, pcoonc
  79       integer sdimca, mdimca, dimcst
  80       integer pgeoco, psomse, pnumli, ptypli, psegli, adabsc
  81       integer pnumfa, pnomfa, pfamee
  82       integer nbnomb
  83       integer ptngrf, pointe, pligfa
  84       integer pttgrl, ptngrl, pointl
  85       integer ppovos, pvoiso
  86       integer laligd, nbfd00, nblign, nbf
  87       integer ptrav2
  88       integer lalign, noelig, arelig
  89 c
  90       integer iaux, jaux, nsomli
  91       integer codre1, codre2, codre3, codre4, codre5
  92       integer codre6, codre7
  93       integer codre0
  94 c
  95       character*8 ntrav1, ntrav2
  96       character*8 ncinfo, ncnoeu, nccono, nccode
  97       character*8 nccocl, ncfami
  98       character*8 ncequi, ncfron, ncnomb
  99 c
 100       character*8 norenu
 101       character*8 nhnoeu, nhmapo, nharet, nhtria, nhquad
 102       character*8 nhtetr, nhhexa, nhpyra, nhpent
 103       character*8 nhelig
 104       character*8 nhvois, nhsupe, nhsups
 105 c
 106       integer nbmess
 107       parameter ( nbmess = 10 )
 108       character*80 texte(nblang,nbmess)
 109 c
 110 c 0.5. ==> initialisations
 111 c ______________________________________________________________________
 112 c
 113 c====
 114 c 1. messages
 115 c====
 116 c
 117 #include "impr01.h"
 118 c
 119 #ifdef _DEBUG_HOMARD_
 120       write (ulsort,texte(langue,1)) 'Entree', nompro
 121       call dmflsh (iaux)
 122 #endif
 123 c
 124 #include "impr03.h"
 125 c
 126 c====
 127 c 2. recuperation des donnees du maillage HOMARD
 128 c    Le seul but est de recuperer dimcst. Il faut le dimcst du maillage
 129 c    de calcul et pas celui de la frontiere car ils peuvent etre
 130 c    differents : le maillage de calcul est 3D alors que la frontiere
 131 c    est dans un plan.
 132 c
 133 c====
 134 c 2.1. ==> nom interne des branches
 135 c
 136       if ( codret.eq.0 ) then
 137 c
 138 #ifdef _DEBUG_HOMARD_
 139       write (ulsort,texte(langue,3)) 'UTNOMH', nompro
 140 #endif
 141       call utnomh ( nohman,
 142      >                sdim,   mdim,
 143      >               degre, maconf, homolo, hierar,
 144      >              rafdef, nbmane, typcca, typsfr, maextr,
 145      >              mailet,
 146      >              norenu,
 147      >              nhnoeu, nhmapo, nharet,
 148      >              nhtria, nhquad,
 149      >              nhtetr, nhhexa, nhpyra, nhpent,
 150      >              nhelig,
 151      >              nhvois, nhsupe, nhsups,
 152      >              ulsort, langue, codret )
 153 c
 154       endif
 155 c
 156 c 2.2. ==> recuperation de la caracteristique des dimensions
 157 c
 158       if ( codret.eq.0 ) then
 159 c
 160       call gmliat ( nhnoeu, 2, dimcst, codre0 )
 161       codret = abs(codre0)
 162 c
 163 #ifdef _DEBUG_HOMARD_
 164       write (ulsort,90002) 'dimcst', dimcst
 165 #endif
 166 c
 167       endif
 168 c
 169 c====
 170 c 3. recuperation des donnees du maillage de la frontiere
 171 c====
 172 #ifdef _DEBUG_HOMARD_
 173       write (ulsort,90002) '3. recuperation ; codret', codret
 174 #endif
 175 c
 176 c 3.1. ==> nom interne des branches
 177 c
 178       if ( codret.eq.0 ) then
 179 c
 180 #ifdef _DEBUG_HOMARD_
 181       write (ulsort,texte(langue,3)) 'UTNOMC - Frontiere', nompro
 182 #endif
 183       call utnomc ( mafrmd,
 184      >              sdimca, mdimca,
 185      >               degre, mailet, maconf, homolo, hierar,
 186      >              nbnomb,
 187      >              ncinfo, ncnoeu, nccono, nccode,
 188      >              nccocl, ncfami,
 189      >              ncequi, ncfron, ncnomb,
 190      >              ulsort, langue, codret)
 191 c
 192       endif
 193 #ifdef _DEBUG_HOMARD_
 194       call gmprsx ( nompro, nccono )
 195 #endif
 196 c
 197 c 3.2. ==> recuperation des pointeurs
 198 c
 199       if ( codret.eq.0 ) then
 200 c
 201       call gmliat ( ncnoeu, 1, nbnoto, codre1 )
 202       call gmliat ( nccono, 1, nbelem, codre2 )
 203       call gmliat ( nccono, 2, nbmane, codre3 )
 204 c
 205       codre0 = min ( codre1, codre2, codre3 )
 206       codret = max ( abs(codre0), codret,
 207      >               codre1, codre2, codre3 )
 208 #ifdef _DEBUG_HOMARD_
 209       write (ulsort,texte(langue,3)) 'UTAD11', nompro
 210 #endif
 211       iaux = 2002
 212       call utad11 ( iaux, ncnoeu, nccono,
 213      >              pcoonc, jaux, jaux, jaux,
 214      >              ptypel, pfamee, pnoeel, jaux,
 215      >              ulsort, langue, codret )
 216 c
 217       endif
 218 c
 219       if ( codret.eq.0 ) then
 220 c
 221       call gmliat ( ncfami, 1, nbf, codret )
 222 c
 223 #ifdef _DEBUG_HOMARD_
 224       write (ulsort,texte(langue,3)) 'UTAD13', nompro
 225 #endif
 226       iaux = 30
 227       call utad13 ( iaux, ncfami,
 228      >              pnumfa, pnomfa,
 229      >              pointe,  jaux, ptngrf,
 230      >              ulsort, langue, codret )
 231 c
 232       endif
 233 c
 234       if ( codret.eq.0 ) then
 235 c
 236       call gmadoj ( ncfron, pligfa, iaux, codret )
 237 c
 238       endif
 239 c
 240 c====
 241 c 4. correspondance entre les familles du maillage de calcul et
 242 c    les lignes dont on demande le suivi
 243 c====
 244 #ifdef _DEBUG_HOMARD_
 245       write (ulsort,90002) '4. correspondance ; codret', codret
 246 #endif
 247 c
 248 c 4.1. ==> Enregistrement des groupes du suivi
 249 c
 250       if ( codret.eq.0 ) then
 251 c
 252       iaux = 6
 253 #ifdef _DEBUG_HOMARD_
 254       write (ulsort,texte(langue,3)) 'UTADPT', nompro
 255 #endif
 256       call utadpt ( ncafdg, iaux,
 257      >              nbfd00,   jaux,
 258      >              pointl, pttgrl, ptngrl,
 259      >              ulsort, langue, codret )
 260 c
 261       endif
 262 c
 263       if ( codret.eq.0 ) then
 264 c
 265       iaux = 0
 266 #ifdef _DEBUG_HOMARD_
 267       write (ulsort,texte(langue,3)) 'VCSFLG', nompro
 268 #endif
 269       call vcsflg ( nbfd00, nbf,
 270      >              imem(pointl), imem(pttgrl), smem(ptngrl),
 271      >              imem(pointe), smem(ptngrf),
 272      >              imem(pnumfa), smem(pnomfa),
 273      >              imem(pligfa), iaux,
 274      >              ulsort, langue, codret )
 275 c
 276       endif
 277 c
 278 c====
 279 c 5. Allocation de la tete du maillage au format C
 280 c====
 281 #ifdef _DEBUG_HOMARD_
 282       write (ulsort,90002) '5. tete du maillage ; codret', codret
 283 #endif
 284 c
 285       if ( codret.eq.0 ) then
 286 c
 287       call gmalot ( nocdfr, 'Cal_Fron', 0, iaux, codre1 )
 288       call gmaloj ( nocdfr//'.TypeLign', ' ', nbfd00, ptypli, codre2 )
 289 c
 290       codre0 = min ( codre1, codre2 )
 291       codret = max ( abs(codre0), codret,
 292      >               codre1, codre2 )
 293 c
 294       endif
 295 c
 296       if ( codret.eq.0 ) then
 297 c
 298       do 50 , iaux = 1 , nbfd00
 299         imem(ptypli+iaux-1) = 0
 300    50 continue
 301 c
 302       endif
 303 c
 304 c====
 305 c 6. Examen des lignes jusqu'a ne plus avoir de ligne fermee
 306 c====
 307 c
 308       laligd = 1
 309 c
 310    60 continue
 311 c
 312 c 6.1. ==>  determination des elements voisins des sommets
 313 #ifdef _DEBUG_HOMARD_
 314       write (ulsort,90002) '6.1. elements voisins ; codret', codret
 315 #endif
 316 c
 317 c 6.1.1. ==> comptage du nombre d'elements pour chaque sommet
 318 c            et determination des pointeurs par sommets sur "voisom",
 319 c            ranges dans la structure "povoso"
 320 c
 321       if ( codret.eq.0 ) then
 322 c
 323       call gmalot ( ntrav1, 'PtTabEnt', 0, iaux, codret )
 324 c
 325       endif
 326 c
 327       if ( codret.eq.0 ) then
 328 c
 329       iaux = nbnoto + 1
 330       call gmaloj ( ntrav1//'.Pointeur', ' ', iaux, ppovos, codret )
 331 c
 332       endif
 333 c
 334       if ( codret.eq.0 ) then
 335 c
 336 #ifdef _DEBUG_HOMARD_
 337       write (ulsort,texte(langue,3)) 'VCVOS1', nompro
 338 #endif
 339       call vcvos1 ( imem(pnoeel), imem(ptypel), imem(ppovos),
 340      >              nvosom, nbelem, nbmane, nbnoto )
 341 c
 342       endif
 343 c
 344 c 6.1.2. ==> reperage des voisins : la structure voisom contient la
 345 c            liste des elements 1d, 2d ou 3d voisins de chaque sommet
 346 c            (allocation du tableau des voisins a une taille egale
 347 c             au nombre cumule de voisins des sommets)
 348 c
 349       if ( codret.eq.0 ) then
 350 c
 351       call gmaloj ( ntrav1//'.Table', ' ', nvosom, pvoiso, codret )
 352 c
 353       endif
 354 c
 355       if ( codret.eq.0 ) then
 356 c
 357 #ifdef _DEBUG_HOMARD_
 358       write (ulsort,texte(langue,3)) 'VCVOS2', nompro
 359 #endif
 360       call vcvos2 ( imem(pnoeel), imem(ptypel), imem(ppovos),
 361      >              imem(pvoiso), nvosom, nbelem, nbmane, nbnoto )
 362 c
 363       endif
 364 c
 365 c 6.2. ==> Recherche d'eventuelles lignes fermees
 366 #ifdef _DEBUG_HOMARD_
 367       write (ulsort,90002) '6.2. lignes fermees ; codret', codret
 368 #endif
 369 c
 370       if ( codret.eq.0 ) then
 371 c
 372 #ifdef _DEBUG_HOMARD_
 373       write (ulsort,texte(langue,3)) 'VCSFL0', nompro
 374 #endif
 375       call vcsfl0 ( sdimca, nbelem, nvosom, nbnoto, nbf,
 376      >              rmem(pcoonc),
 377      >              imem(ptypel), imem(pfamee),
 378      >              imem(ppovos), imem(pvoiso),
 379      >              imem(pnumfa), smem(pnomfa), imem(pligfa),
 380      >              laligd, nbfd00,
 381      >              lalign, noelig, arelig,
 382      >              ulsort, langue, codret )
 383 c
 384       endif
 385 #ifdef _DEBUG_HOMARD_
 386       write (ulsort,90002) 'lalign', lalign
 387 #endif
 388 c
 389 c 6.3. ==> Si on a une ligne fermee, on l'ouvre par duplication du noeud
 390 #ifdef _DEBUG_HOMARD_
 391       write (ulsort,90002) '6.3. ligne fermee ; codret', codret
 392 #endif
 393 c
 394       if ( codret.eq.0 ) then
 395 c
 396       if ( lalign.gt.0 ) then
 397 c
 398 #ifdef _DEBUG_HOMARD_
 399         write (ulsort,90002) 'noelig, arelig', noelig, arelig
 400         write (ulsort,92010)
 401      > (rmem(pcoonc+noelig-1+nbnoto*(iaux-1)), iaux=1,sdimca)
 402 #endif
 403 c
 404         imem(ptypli+lalign-1) = 1
 405 c
 406 c 6.3.1. ==> Ajout d'un noeud
 407 c
 408         if ( codret.eq.0 ) then
 409 c
 410         iaux = nbnoto+1
 411         call gmmod ( ncnoeu//'.Coor',
 412      >               pcoonc, nbnoto, iaux, sdimca, sdimca, codre0 )
 413         codret = abs(codre0)
 414 c
 415         endif
 416 c
 417         if ( codret.eq.0 ) then
 418 c
 419         nbnoto = nbnoto + 1
 420         do 631 , iaux = 1 , sdimca
 421           rmem(pcoonc+nbnoto-1+nbnoto*(iaux-1)) =
 422      >    rmem(pcoonc+noelig-1+nbnoto*(iaux-1))
 423   631   continue
 424 c
 425         endif
 426 c
 427 c 6.3.2. ==> Modification de la description de l'arete terminale
 428 c
 429         if ( codret.eq.0 ) then
 430 c
 431         if ( imem(pnoeel+arelig-1).eq.noelig ) then
 432           imem(pnoeel+arelig-1) = nbnoto
 433         elseif ( imem(pnoeel+arelig-1+nbelem).eq.noelig ) then
 434           imem(pnoeel+arelig-1+nbelem) = nbnoto
 435         else
 436           codret = 632
 437         endif
 438 c
 439         endif
 440 c
 441 c 6.3.3. ==> Menage
 442 c
 443         if ( codret.eq.0 ) then
 444 c
 445         call gmsgoj ( ntrav1, codre0 )
 446         codret = abs(codre0)
 447 c
 448         endif
 449 c
 450 c 6.3.4. ==> Maintenant que la ligne est ouverte, on recommence.
 451 c
 452         laligd = lalign
 453 c
 454         goto 60
 455 c
 456       endif
 457 c
 458       endif
 459 c
 460 #ifdef _DEBUG_HOMARD_
 461       call gmprsx(nompro, nocdfr//'.TypeLign')
 462 #endif
 463   700 continue
 464 c
 465 c====
 466 c 7. Les coordonnees
 467 c====
 468 #ifdef _DEBUG_HOMARD_
 469       write (ulsort,90002) '7. coordonnees ; codret', codret
 470 #endif
 471 c 7.1. ==> La dimension
 472 c
 473       sfnbso = nbnoto
 474       if ( dimcst.eq.0 ) then
 475         sfsdim = sdimca
 476       else
 477         sfsdim = sdimca - 1
 478       endif
 479       sfmdim = mdim
 480 #ifdef _DEBUG_HOMARD_
 481       write (ulsort,90002) 'dimcst', dimcst
 482       write (ulsort,90002) 'sdimca, sfsdim', sdimca, sfsdim
 483       write (ulsort,90002) 'sfmdim', sfmdim
 484 #endif
 485 c
 486 c 7.2. ==> Memoire
 487 c
 488       if ( codret.eq.0 ) then
 489 c
 490       call gmecat ( nocdfr, 1, sfsdim, codre1 )
 491       call gmecat ( nocdfr, 2, sfmdim, codre2 )
 492       call gmecat ( nocdfr, 3, sfnbso, codre3 )
 493       iaux = sfsdim*sfnbso
 494       call gmaloj ( nocdfr//'.CoorNoeu', ' ', iaux, pgeoco, codre4 )
 495 c
 496       codre0 = min ( codre1, codre2, codre3, codre4 )
 497       codret = max ( abs(codre0), codret,
 498      >               codre1, codre2, codre3, codre4 )
 499 c
 500       endif
 501 c
 502 c 7.3. ==> Transfert
 503 c
 504       if ( codret.eq.0 ) then
 505 c
 506 #ifdef _DEBUG_HOMARD_
 507       write (ulsort,texte(langue,3)) 'SFCVCO', nompro
 508 #endif
 509       call sfcvco ( dimcst, nbnoto, sfsdim,
 510      >              rmem(pcoonc), rmem(pgeoco),
 511      >              ulsort, langue, codret )
 512 c
 513       endif
 514 c
 515 c====
 516 c 8. conversion du format MED au format C
 517 c====
 518 #ifdef _DEBUG_HOMARD_
 519       write (ulsort,90002) '8. Conversion MED C ; codret', codret
 520 #endif
 521 c
 522 c 8.1. ==> Allocation : on surdimensionne
 523 c
 524       sfnbli = nbfd00
 525       sfnbse = 2*(nbnoto+nbfd00)
 526 c
 527       if ( codret.eq.0 ) then
 528 c
 529       call gmecat ( nocdfr, 4, sfnbli, codre1 )
 530       call gmecat ( nocdfr, 5, sfnbse, codre2 )
 531       call gmaloj ( nocdfr//'.NumeLign', ' ', sfnbli, pnumli, codre3 )
 532       call gmaloj ( nocdfr//'.PtrSomLi', ' ', sfnbli+1, psegli, codre4 )
 533       call gmaloj ( nocdfr//'.SommSegm', ' ', sfnbse, psomse, codre5 )
 534       call gmaloj ( nocdfr//'.AbsCurvi', ' ', sfnbse, adabsc, codre6 )
 535       call gmalot ( ntrav2, 'entier', nbelem, ptrav2, codre7 )
 536 c
 537       codre0 = min ( codre1, codre2, codre3, codre4, codre5,
 538      >               codre6, codre7 )
 539       codret = max ( abs(codre0), codret,
 540      >               codre1, codre2, codre3, codre4, codre5,
 541      >               codre6, codre7 )
 542 c
 543       endif
 544 c
 545 c 8.2. ==> Conversion
 546 c
 547       if ( codret.eq.0 ) then
 548 c
 549       imem(psegli) = 0
 550       imem(psegli+1) = nbnoto+1
 551 cgn      print *,'appel de vcsfli'
 552 cgn      print *,'nbfd00 = ', nbfd00
 553 cgn      print *,'nbelem, nbmane, nvosom, nbnoto, nbf = ',
 554 cgn     >         nbelem, nbmane, nvosom, nbnoto, nbf
 555 c
 556 #ifdef _DEBUG_HOMARD_
 557       write (ulsort,texte(langue,3)) 'VCSFLI', nompro
 558 #endif
 559       call vcsfli ( sdimca, nbelem, nbmane, nvosom, nbnoto, nbf,
 560      >              rmem(pcoonc),
 561      >              imem(pnoeel), imem(ptypel), imem(pfamee),
 562      >              imem(ppovos), imem(pvoiso),
 563      >              imem(pnumfa), smem(pnomfa), imem(pligfa),
 564      >              nbfd00, nblign, nsomli,
 565      >              imem(pnumli), imem(psegli), imem(psomse),
 566      >              rmem(adabsc), imem(ptrav2),
 567      >              ulsort, langue, codret )
 568 c
 569       endif
 570 c
 571 c 8.3. ==> Redimensionnement en tenant compte du vrai nombre de lignes
 572 c          et de sommets decrivant les lignes
 573 c
 574       if ( codret.eq.0 ) then
 575 c
 576       sfnbli = nblign
 577 c
 578       call gmmod ( nocdfr//'.NumeLign',
 579      >             pnumli, nbfd00, sfnbli, 1, 1, codre1 )
 580       call gmmod ( nocdfr//'.TypeLign',
 581      >             ptypli, nbfd00, sfnbli, 1, 1, codre2 )
 582       call gmmod ( nocdfr//'.PtrSomLi',
 583      >             pnumli, nbfd00+1, sfnbli+1, 1, 1, codre3 )
 584       call gmmod ( nocdfr//'.SommSegm',
 585      >             psomse, sfnbse, nsomli, 1, 1, codre4 )
 586       call gmmod ( nocdfr//'.AbsCurvi',
 587      >             adabsc, sfnbse, nsomli, 1, 1, codre5 )
 588 c
 589       codre0 = min ( codre1, codre2, codre3, codre4, codre5 )
 590       codret = max ( abs(codre0), codret,
 591      >               codre1, codre2, codre3, codre4, codre5 )
 592 c
 593       sfnbse = nsomli
 594 c
 595       call gmecat ( nocdfr, 4, sfnbli, codre1 )
 596       call gmecat ( nocdfr, 5, sfnbse, codre2 )
 597 c
 598       codre0 = min ( codre1, codre2 )
 599       codret = max ( abs(codre0), codret,
 600      >               codre1, codre2 )
 601 c
 602       endif
 603 c
 604       if ( codret.eq.0 ) then
 605 c
 606       call gmsgoj ( ntrav1, codre1 )
 607       call gmlboj ( ntrav2, codre2 )
 608 c
 609       codre0 = min ( codre1, codre2 )
 610       codret = max ( abs(codre0), codret,
 611      >               codre1, codre2 )
 612 c
 613       endif
 614 c
 615 c 8.4. ==> Enregistrement des groupes du suivi
 616 c
 617       if ( codret.eq.0 ) then
 618 c
 619       call gmatoj ( nocdfr//'.Groupes', ncafdg, codret )
 620 c
 621       endif
 622 c
 623 #ifdef _DEBUG_HOMARD_
 624       if ( codret.eq.0 ) then
 625       call gmprsx (nompro, nocdfr )
 626       call gmprot (nompro, nocdfr//'.CoorNoeu', 1 , 20 )
 627       call gmprot (nompro, nocdfr//'.CoorNoeu', sfnbso-20 , sfnbso )
 628       call gmprsx (nompro, nocdfr//'.NumeLign' )
 629       call gmprsx (nompro, nocdfr//'.PtrSomLi' )
 630       call gmprot (nompro, nocdfr//'.SommSegm', 1 , 20 )
 631       call gmprot (nompro, nocdfr//'.SommSegm', sfnbse-20 , sfnbse )
 632       call gmprot (nompro, nocdfr//'.AbsCurvi', 1 , 20 )
 633       call gmprot (nompro, nocdfr//'.AbsCurvi', sfnbse-20 , sfnbse )
 634       call gmprsx (nompro, nocdfr//'.Groupes')
 635       endif
 636 #endif
 637 c
 638 c====
 639 c 9. controle des intersections
 640 c====
 641 #ifdef _DEBUG_HOMARD_
 642       write (ulsort,90002) '9. controle intersections ; codret', codret
 643 #endif
 644 c
 645 c 9.1. ==> Allocation : on surdimensionne
 646 c
 647       if ( codret.eq.0 ) then
 648 c
 649       call gmalot ( ntrav2, 'entier', sfnbso, ptrav2, codre0 )
 650       codret = abs(codre0)
 651 c
 652       endif
 653 c
 654 c 9.2. ==> Controle
 655 c
 656       if ( codret.eq.0 ) then
 657 c
 658 #ifdef _DEBUG_HOMARD_
 659       write (ulsort,texte(langue,3)) 'SFCTRI', nompro
 660 #endif
 661       call sfctri ( imem(psomse), imem(psegli),
 662      >              imem(ptrav2),
 663      >              ulsort, langue, codret)
 664 c
 665       endif
 666 c
 667 c 9.3. ==> menage
 668 c
 669       if ( codret.eq.0 ) then
 670 c
 671       call gmlboj ( ntrav2, codre0 )
 672       codret = abs(codre0)
 673 c
 674       endif
 675 c
 676 c====
 677 c 10. la fin
 678 c====
 679 c
 680       if ( codret.ne.0 ) then
 681 c
 682 #include "envex2.h"
 683 c
 684       write (ulsort,texte(langue,1)) 'Sortie', nompro
 685       write (ulsort,texte(langue,2)) codret
 686 c
 687       endif
 688 c
 689 #ifdef _DEBUG_HOMARD_
 690       write (ulsort,texte(langue,1)) 'Sortie', nompro
 691       call dmflsh (iaux)
 692 #endif
 693 c
 694       end