src/tool/Decision/deinii.F

   1       subroutine deinii ( pilraf, pilder, nivmax, nivmin, iniada,
   2      >                    decare, decfac,
   3      >                    somare, hetare, filare, merare, np2are,
   4      >                    posifa, facare,
   5      >                    aretri, hettri, filtri, pertri, nivtri,
   6      >                    arequa, hetqua, filqua, perqua, nivqua,
   7      >                    tritet, hettet, filtet,
   8      >                    quahex, hethex, filhex,
   9      >                    facpyr, hetpyr,
  10      >                    facpen, hetpen, filpen,
  11      >                    nbvpen, nbvpyr, nbvhex, nbvtet,
  12      >                    nbvqua, nbvtri, nbvare, nbvnoe,
  13      >                    nosupp, noindi,
  14      >                    arsupp, arindi,
  15      >                    trsupp, trindi,
  16      >                    qusupp, quindi,
  17      >                    tesupp, teindi,
  18      >                    hesupp, heindi,
  19      >                    pysupp, pyindi,
  20      >                    pesupp, peindi,
  21      >                    ulsort, langue, codret)
  22 c ______________________________________________________________________
  23 c
  24 c                             H O M A R D
  25 c
  26 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  27 c
  28 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  29 c aupres des huissiers de justice Simart et Lavoir a Clamart
  30 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  31 c aupres des huissiers de justice
  32 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  33 c
  34 c    HOMARD est une marque deposee d'Electricite de France
  35 c
  36 c Copyright EDF 1996
  37 c Copyright EDF 1998
  38 c Copyright EDF 2002
  39 c Copyright EDF 2020
  40 c ______________________________________________________________________
  41 c
  42 c traitement des DEcisions - INitialisation de l'indicateur entier
  43 c                --          --
  44 c ______________________________________________________________________
  45 c
  46 c but : initialisation des decisions sur les faces et les aretes
  47 c       dans le cas ou les valeurs de l'indicateur sont entieres
  48 c ______________________________________________________________________
  49 c .        .     .        .                                            .
  50 c .  nom   . e/s . taille .           description                      .
  51 c .____________________________________________________________________.
  52 c . pilraf . e   .   1    . pilotage du raffinement                    .
  53 c .        .     .        . -1 : raffinement uniforme                  .
  54 c .        .     .        .  0 : pas de raffinement                    .
  55 c .        .     .        .  1 : raffinement libre                     .
  56 c .        .     .        .  2 : raff. libre homogene en type d'element.
  57 c . pilder . e   .   1    . pilotage du deraffinement                  .
  58 c .        .     .        . -1 : deraffinement uniforme                .
  59 c .        .     .        .  0 : pas de deraffinement                  .
  60 c .        .     .        .  1 : deraffinement libre                   .
  61 c . nivmax . e   .   1    . niveau max a ne pas depasser en raffinement.
  62 c . nivmin . e   .   1    . niveau min a ne pas depasser en deraffinemt.
  63 c . iniada . e   .   1    . initialisation de l'adaptation             .
  64 c .        .     .        . 0 : on garde tout (defaut)                 .
  65 c .        .     .        .-1 : reactivation des mailles ou aucun      .
  66 c .        .     .        .     indicateur n'est defini                .
  67 c .        .     .        . 1 : raffinement des mailles ou aucun       .
  68 c .        .     .        .     indicateur n'est defini                .
  69 c . decare .  s  .0:nbarto. decisions des aretes                       .
  70 c . decfac .  s  . -nbquto. decision sur les faces (quad. + tri.)      .
  71 c .        .     . :nbtrto.                                            .
  72 c . somare . e   .2*nbarto. numeros des extremites d'arete             .
  73 c . hetare . e   . nbarto . historique de l'etat des aretes            .
  74 c . filare . e   . nbarto . premiere fille des aretes                  .
  75 c . merare . e   . nbarto . mere des aretes                            .
  76 c . np2are . e   . nbarto . noeud milieux des aretes                   .
  77 c . posifa . e   . nbarto . pointeur sur tableau facare                .
  78 c . facare . e   . nbfaar . liste des faces contenant une arete        .
  79 c . aretri . e   .nbtrto*3. numeros des 3 aretes des triangles         .
  80 c . hettri . e   . nbtrto . historique de l'etat des triangles         .
  81 c . filtri . e   . nbtrto . premier fils des triangles                 .
  82 c . pertri . e   . nbtrto . pere des triangles                         .
  83 c . nivtri . e   . nbtrto . niveau des triangles                       .
  84 c . arequa . e   .nbquto*4. numeros des 4 aretes des quadrangles       .
  85 c . hetqua . e   . nbquto . historique de l'etat des quadrangles       .
  86 c . filqua . e   . nbquto . premier fils des quadrangles               .
  87 c . perqua . e   . nbquto . pere des quadrangles                       .
  88 c . nivqua . e   . nbquto . niveau des quadrangles                     .
  89 c . tritet . e   .nbtecf*4. numeros des 4 triangles des tetraedres     .
  90 c . hettet . e   . nbteto . historique de l'etat des tetraedres        .
  91 c . filtet . e   . nbteto . premier fils des tetraedres                .
  92 c . quahex . e   .nbhecf*6. numeros des 6 quadrangles des hexaedres    .
  93 c . hethex . e   . nbheto . historique de l'etat des hexaedres         .
  94 c . filhex . e   . nbheto . premier fils des hexaedres                 .
  95 c . facpyr . e   .nbpycf*5. numeros des 5 faces des pyramides          .
  96 c . hetpyr . e   . nbpyto . historique de l'etat des pyramides         .
  97 c . facpen . e   .nbpecf*5. numeros des faces des pentaedres           .
  98 c . hetpen . e   . nbpeto . historique de l'etat des pentaedres        .
  99 c . filpen . e   . nbpeto . premier fils des pentaedres                .
 100 c . nbvpen . e   .   1    . nombre de valeurs par pentaedres           .
 101 c . nbvpyr . e   .   1    . nombre de valeurs par pyramides            .
 102 c . nbvhex . e   .   1    . nombre de valeurs par hexaedres            .
 103 c . nbvtet . e   .   1    . nombre de valeurs par tetraedres           .
 104 c . nbvqua . e   .   1    . nombre de valeurs par quadrangles          .
 105 c . nbvtri . e   .   1    . nombre de valeurs par triangles            .
 106 c . nbvare . e   .   1    . nombre de valeurs par aretes               .
 107 c . nbvnoe . e   .   1    . nombre de valeurs par noeuds               .
 108 c . nosupp . e   . nbnoto . support pour les noeuds                    .
 109 c . noindi . e   . nbnoto . valeurs entieres pour les noeuds           .
 110 c . arsupp . e   . nbarto . support pour les aretes                    .
 111 c . arindi . e   . nbarto . valeurs entieres pour les aretes           .
 112 c . trsupp . e   . nbtrto . support pour les triangles                 .
 113 c . trindi . e   . nbtrto . valeurs entieres pour les triangles        .
 114 c . qusupp . e   . nbquto . support pour les quadrangles               .
 115 c . quindi . e   . nbquto . valeurs entieres pour les quadrangles      .
 116 c . tesupp . e   . nbteto . support pour les tetraedres                .
 117 c . teindi . e   . nbteto . valeurs entieres pour les tetraedres       .
 118 c . hesupp . e   . nbheto . support pour les hexaedres                 .
 119 c . heindi . e   . nbheto . valeurs entieres pour les hexaedres        .
 120 c . pysupp . e   . nbpyto . support pour les pyramides                 .
 121 c . pyindi . e   . nbpyto . valeurs entieres pour les pyramides        .
 122 c . pesupp . e   . nbpeto . support pour les pentaedres                .
 123 c . peindi . e   . nbpeto . valeurs entieres pour les pentaedres       .
 124 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
 125 c . langue . e   .    1   . langue des messages                        .
 126 c .        .     .        . 1 : francais, 2 : anglais                  .
 127 c . codret . es  .    1   . code de retour des modules                 .
 128 c .        .     .        . 0 : pas de probleme                        .
 129 c .        .     .        . 2 : probleme dans le traitement            .
 130 c ______________________________________________________________________
 131 c
 132 c====
 133 c 0. declarations et dimensionnement
 134 c====
 135 c
 136 c 0.1. ==> generalites
 137 c
 138       implicit none
 139       save
 140 c
 141       character*6 nompro
 142       parameter ( nompro = 'DEINII' )
 143 c
 144 #include "nblang.h"
 145 c
 146 c 0.2. ==> communs
 147 c
 148 #include "envex1.h"
 149 #include "envada.h"
 150 #include "nombno.h"
 151 #include "nombar.h"
 152 #include "nombtr.h"
 153 #include "nombqu.h"
 154 #include "nombte.h"
 155 #include "nombhe.h"
 156 #include "nombpy.h"
 157 #include "nombpe.h"
 158 c
 159 c 0.3. ==> arguments
 160 c
 161       integer pilraf, pilder, nivmax, nivmin, iniada
 162       integer decare(0:nbarto), decfac(-nbquto:nbtrto)
 163       integer somare(2,nbarto)
 164       integer hetare(nbarto), filare(nbarto), merare(nbarto)
 165       integer np2are(nbarto)
 166       integer posifa(0:nbarto), facare(nbfaar)
 167       integer aretri(nbtrto,3), hettri(nbtrto)
 168       integer filtri(nbtrto), pertri(nbtrto), nivtri(nbtrto)
 169       integer arequa(nbquto,4), hetqua(nbquto)
 170       integer filqua(nbquto), perqua(nbquto), nivqua(nbquto)
 171       integer tritet(nbtecf,4), hettet(nbteto), filtet(nbteto)
 172       integer quahex(nbhecf,6), hethex(nbheto), filhex(nbheto)
 173       integer facpyr(nbpycf,5), hetpyr(nbpyto)
 174       integer facpen(nbpecf,5), hetpen(nbpeto), filpen(nbpeto)
 175       integer nbvpen, nbvpyr, nbvhex, nbvtet
 176       integer nbvqua, nbvtri, nbvare, nbvnoe
 177       integer nosupp(nbnoto), noindi(nbnoto)
 178       integer arsupp(nbarto), arindi(nbarto)
 179       integer trsupp(nbtrto), trindi(nbtrto)
 180       integer qusupp(nbquto), quindi(nbquto)
 181       integer tesupp(nbteto), teindi(nbteto)
 182       integer hesupp(nbheto), heindi(nbheto)
 183       integer pysupp(nbpyto), pyindi(nbpyto)
 184       integer pesupp(nbpeto), peindi(nbpeto)
 185 c
 186       integer ulsort, langue, codret
 187 c
 188 c 0.4. ==> variables locales
 189 c
 190       integer iaux
 191       integer etat
 192 c
 193       integer nbmess
 194       parameter (nbmess = 10 )
 195       character*80 texte(nblang,nbmess)
 196 c ______________________________________________________________________
 197 c
 198 c====
 199 c 1. initialisation
 200 c====
 201 c
 202 #include "impr01.h"
 203 c
 204 #ifdef _DEBUG_HOMARD_
 205       write (ulsort,texte(langue,1)) 'Entree', nompro
 206       call dmflsh (iaux)
 207 #endif
 208 c
 209       texte(1,4) =
 210      > '(/5x,''Deraffinement des mailles sans indicateur'')'
 211       texte(1,5) =
 212      > '(/5x,''Raffinement des mailles sans indicateur'')'
 213       texte(1,6) = '(''Apres initialisation brute'')'
 214       texte(1,7) = '(''Apres prise en compte des lieux du champ'')'
 215       texte(1,8) = '(5x,''Apres prise en compte du deraffinement'')'
 216       texte(1,9) = '(5x,''Apres prise en compte du raffinement'')'
 217 c
 218       texte(2,4) =
 219      > '(/5x,''Unrefinement of the meshes without any indicator'')'
 220       texte(2,5) =
 221      > '(/5x,''Refinement of the meshes without any indicator'')'
 222       texte(2,6) = '(''After brute initialization'')'
 223       texte(2,7) = '(''After localization of the field'')'
 224       texte(2,8) = '(5x,''After unrefinement indications'')'
 225       texte(2,9) = '(5x,''After refinement indications'')'
 226 c
 227 #include "impr03.h"
 228 c
 229       codret = 0
 230 c
 231 c====
 232 c 2. Initialisations des tableaux de decisions
 233 c    . Dans l'option 0, les decisions sont initialisees a 0, ce qui
 234 c    veut dire qu'a priori, rien ne se passe
 235 c    . Dans l'option -1, les decisions sont initialisees a -1 partout
 236 c    ou l'indicateur n'est pas defini ; cela force le deraffinement
 237 c    des regions ou rien n'a ete precise
 238 c    . Dans l'option 1, les decisions sont initialisees a 2 partout
 239 c    ou l'indicateur n'est pas defini ; cela force le raffinement
 240 c    des regions ou rien n'a ete precise
 241 c====
 242 #ifdef _DEBUG_HOMARD_
 243       write (ulsort,90002) '2. initialisations ; codret', codret
 244 #endif
 245 #ifdef _DEBUG_HOMARD_
 246       write (ulsort,90002) 'nbiter', nbiter
 247       write (ulsort,90002) 'iniada', iniada
 248 #endif
 249 c
 250       if ( nbiter.gt.0 .and. iniada.ne.0 ) then
 251 c
 252 c 2.0. ==> initialisations au defaut
 253 c
 254       if ( iniada.eq.-1 ) then
 255 c
 256         write (ulsort,texte(langue,4))
 257 c
 258 cgn                  write(ulsort,*) 'aretes'
 259         do 201 , iaux = 1, nbarto
 260           if (  mod(hetare(iaux),10).ge.2 ) then
 261             decare (iaux) = -1
 262 cgn                    write(ulsort,*) iaux
 263           endif
 264   201   continue
 265 c
 266 cgn                  write(ulsort,*) 'triangles'
 267         do 202 , iaux = 1, nbtrto
 268           etat = mod(hettri(iaux),10)
 269           if ( etat.eq.4 .or.
 270      >         etat.eq.6 .or. etat.eq.7 .or. etat.eq.8 .or.
 271      >         etat.eq.9 ) then
 272             decfac (iaux) = -1
 273 cgn                    write(ulsort,*) iaux
 274           endif
 275   202   continue
 276 c
 277 cgn                    write(ulsort,*) 'quadrangles'
 278         do 203 , iaux = 1, nbquto
 279           etat = mod(hetqua(iaux),100)
 280           if ( etat.eq.4 .or.
 281      >         etat.eq.99 ) then
 282             decfac (-iaux) = -1
 283           endif
 284   203   continue
 285 c
 286       elseif ( iniada.eq.1 ) then
 287 c
 288         write (ulsort,texte(langue,5))
 289 c
 290 cgn                  write(ulsort,*) 'aretes'
 291         do 204 , iaux = 1, nbarto
 292           if (  mod(hetare(iaux),10).eq.0 ) then
 293             decare (iaux) = 2
 294 cgn                    write(ulsort,*) iaux
 295           endif
 296   204   continue
 297 c
 298 cgn                  write(ulsort,*) 'triangles'
 299         do 205 , iaux = 1, nbtrto
 300           if ( mod(hettri(iaux),10).eq.0 ) then
 301             decfac (iaux) = 4
 302 cgn                    write(ulsort,*) iaux
 303           endif
 304   205   continue
 305 c
 306 cgn                    write(ulsort,*) 'quadrangles'
 307         do 206 , iaux = 1, nbquto
 308           if ( mod(hetqua(iaux),100).eq.0 ) then
 309             decfac (-iaux) = 4
 310           endif
 311   206   continue
 312 c
 313       endif
 314 c
 315 #ifdef _DEBUG_HOMARD_
 316 c
 317       if ( codret.eq.0 ) then
 318 c
 319       write (ulsort,texte(langue,6))
 320 c
 321       call decpte ( pilraf, pilder,
 322      >              decare, decfac,
 323      >              hettri, hetqua, tritet, hettet,
 324      >              quahex, hethex,
 325      >              facpyr, hetpyr,
 326      >              facpen, hetpen,
 327      >              ulsort, langue, codret )
 328 c
 329       endif
 330 c
 331 #endif
 332 c
 333 c 2.1. ==> traitement des indicateurs portant sur les noeuds
 334 c
 335 #ifdef _DEBUG_HOMARD_
 336       write (ulsort,90002) '2.1. noeuds ; codret', codret
 337 #endif
 338 c
 339       if ( codret.eq.0 ) then
 340 c
 341       if ( nbvnoe.ne.0 ) then
 342 c
 343 #ifdef _DEBUG_HOMARD_
 344       write (ulsort,texte(langue,3)) 'DEINOI', nompro
 345 #endif
 346         call deinoi ( decare, decfac,
 347      >                somare, merare,
 348      >                np2are, posifa, facare,
 349      >                nosupp,
 350      >                ulsort, langue, codret)
 351 c
 352       endif
 353 c
 354       endif
 355 c
 356 c 2.2. ==> traitement des indicateurs portant sur les aretes
 357 c
 358 #ifdef _DEBUG_HOMARD_
 359       write (ulsort,90002) '2.2. aretes ; codret', codret
 360 #endif
 361 c
 362       if ( codret.eq.0 ) then
 363 c
 364       if ( nbvare.ne.0 ) then
 365 c
 366 #ifdef _DEBUG_HOMARD_
 367       write (ulsort,texte(langue,3)) 'DEIARI', nompro
 368 #endif
 369         call deiari ( decare, decfac,
 370      >                merare,
 371      >                posifa, facare,
 372      >                arsupp,
 373      >                ulsort, langue, codret)
 374 c
 375       endif
 376 c
 377       endif
 378 c
 379 c 2.3. ==> traitement des indicateurs portant sur les triangles
 380 c
 381 #ifdef _DEBUG_HOMARD_
 382       write (ulsort,90002) '2.3. Triangles ; codret', codret
 383 #endif
 384 c
 385       if ( codret.eq.0 ) then
 386 c
 387       if ( nbvtri.ne.0 ) then
 388 c
 389 #ifdef _DEBUG_HOMARD_
 390       write (ulsort,texte(langue,3)) 'DEITRI', nompro
 391 #endif
 392         call deitri ( decare, decfac,
 393      >                aretri, pertri,
 394      >                trsupp,
 395      >                ulsort, langue, codret)
 396 c
 397       endif
 398 c
 399       endif
 400 c
 401 c 2.4. ==> traitement des indicateurs portant sur les quadrangles
 402 c
 403 #ifdef _DEBUG_HOMARD_
 404       write (ulsort,90002) '2.4. Quadrangles ; codret', codret
 405 #endif
 406 c
 407       if ( codret.eq.0 ) then
 408 c
 409       if ( nbvqua.ne.0 ) then
 410 c
 411 #ifdef _DEBUG_HOMARD_
 412       write (ulsort,texte(langue,3)) 'DEIQUI', nompro
 413 #endif
 414         call deiqui ( decare, decfac,
 415      >                arequa, perqua,
 416      >                qusupp,
 417      >                ulsort, langue, codret)
 418 c
 419       endif
 420 c
 421       endif
 422 c
 423 c 2.5. ==> traitement des indicateurs portant sur les tetraedres
 424 c
 425 #ifdef _DEBUG_HOMARD_
 426       write (ulsort,90002) '2.5. Tetraedres ; codret', codret
 427 #endif
 428 c
 429       if ( codret.eq.0 ) then
 430 c
 431       if ( nbvtet.ne.0 ) then
 432 c
 433 #ifdef _DEBUG_HOMARD_
 434       write (ulsort,texte(langue,3)) 'DEITEI', nompro
 435 #endif
 436         call deitei ( decare, decfac,
 437      >                aretri, pertri,
 438      >                tritet,
 439      >                tesupp,
 440      >                ulsort, langue, codret)
 441 c
 442       endif
 443 c
 444       endif
 445 c
 446 c 2.6. ==> traitement des indicateurs portant sur les hexaedres
 447 c
 448 #ifdef _DEBUG_HOMARD_
 449       write (ulsort,90002) '2.6. Hexaedres ; codret', codret
 450 #endif
 451 c
 452       if ( codret.eq.0 ) then
 453 c
 454       if ( nbvhex.ne.0 ) then
 455 c
 456 #ifdef _DEBUG_HOMARD_
 457       write (ulsort,texte(langue,3)) 'DEIHEI', nompro
 458 #endif
 459         call deihei ( decare, decfac,
 460      >                arequa, perqua,
 461      >                quahex,
 462      >                hesupp,
 463      >                ulsort, langue, codret)
 464 c
 465       endif
 466 c
 467       endif
 468 c
 469 c 2.7. ==> traitement des indicateurs portant sur les pyramides
 470 c
 471 #ifdef _DEBUG_HOMARD_
 472       write (ulsort,90002) '2.7. Pyramides ; codret', codret
 473 #endif
 474 c
 475       if ( codret.eq.0 ) then
 476 c
 477       if ( nbvpyr.ne.0 ) then
 478 c
 479 #ifdef _DEBUG_HOMARD_
 480       write (ulsort,texte(langue,3)) 'DEIPYI', nompro
 481 #endif
 482         call deipyi ( decare, decfac,
 483      >                aretri, pertri,
 484      >                arequa, perqua,
 485      >                facpyr,
 486      >                pysupp,
 487      >                ulsort, langue, codret)
 488 c
 489       endif
 490 c
 491       endif
 492 c
 493 c 2.8. ==> traitement des indicateurs portant sur les pentaedres
 494 c
 495 #ifdef _DEBUG_HOMARD_
 496       write (ulsort,90002) '2.8. pentaedres ; codret', codret
 497 #endif
 498 c
 499       if ( codret.eq.0 ) then
 500 c
 501       if ( nbvpen.ne.0 ) then
 502 c
 503 #ifdef _DEBUG_HOMARD_
 504       write (ulsort,texte(langue,3)) 'DEIPEI', nompro
 505 #endif
 506         call deipei ( decare, decfac,
 507      >                aretri, pertri,
 508      >                arequa, perqua,
 509      >                facpen,
 510      >                pesupp,
 511      >                ulsort, langue, codret)
 512 c
 513       endif
 514 c
 515       endif
 516 c
 517 c 2.9. ==> Bilan
 518 c
 519       if ( codret.eq.0 ) then
 520 c
 521 #ifdef _DEBUG_HOMARD_
 522       write (ulsort,texte(langue,7))
 523 #endif
 524 c
 525       call decpte
 526      >        ( pilraf, pilder,
 527      >          decare, decfac,
 528      >          hettri, hetqua, tritet, hettet,
 529      >          quahex, hethex,
 530      >          facpyr, hetpyr,
 531      >          facpen, hetpen,
 532      >          ulsort, langue, codret )
 533 c
 534       endif
 535 c
 536       endif
 537 c
 538 c====
 539 c 3. traitement du deraffinement
 540 c    il faut d'abord examiner les decisions de deraffinement exprimees
 541 c    sur tous les types d'entites. ensuite, on examinera les decisions
 542 c    de raffinement. ainsi, en cas de conflit, on est certain d'avoir
 543 c    ecrasement du deraffinement par le raffinement.
 544 c====
 545 #ifdef _DEBUG_HOMARD_
 546       write (ulsort,90002) '3. deraffinement ; codret', codret
 547 #endif
 548 #ifdef _DEBUG_HOMARD_
 549       write (ulsort,90002) 'nbiter', nbiter
 550       write (ulsort,90002) 'pilder', pilder
 551 #endif
 552 c
 553       if ( pilder.ne.0 .and. nbiter.ne.0 ) then
 554 c
 555 c 3.1. ==> traitement des indicateurs portant sur les noeuds
 556 c
 557 #ifdef _DEBUG_HOMARD_
 558       write (ulsort,90002) '3.1. noeuds ; codret', codret
 559 #endif
 560 c
 561       if ( codret.eq.0 ) then
 562 c
 563       if ( nbvnoe.ne.0 ) then
 564 c
 565 #ifdef _DEBUG_HOMARD_
 566       write (ulsort,texte(langue,3)) 'DEINOD', nompro
 567 #endif
 568         call deinod ( nivmin,
 569      >                decare, decfac,
 570      >                somare, hetare, filare,
 571      >                np2are, posifa, facare,
 572      >                aretri, hettri, nivtri,
 573      >                arequa, hetqua, nivqua,
 574      >                nosupp, noindi,
 575      >                ulsort, langue, codret)
 576 c
 577       endif
 578 c
 579       endif
 580 c
 581 c 3.2. ==> traitement des indicateurs portant sur les aretes
 582 c
 583 #ifdef _DEBUG_HOMARD_
 584       write (ulsort,90002) '3.2. aretes ; codret', codret
 585 #endif
 586 c
 587       if ( codret.eq.0 ) then
 588 c
 589       if ( nbvare.ne.0 ) then
 590 c
 591 #ifdef _DEBUG_HOMARD_
 592       write (ulsort,texte(langue,3)) 'DEIARD', nompro
 593 #endif
 594         call deiard ( nivmin,
 595      >                decare, decfac,
 596      >                hetare, filare,
 597      >                posifa, facare,
 598      >                aretri, hettri, nivtri,
 599      >                arequa, hetqua, nivqua,
 600      >                arsupp, arindi,
 601      >                ulsort, langue, codret)
 602 c
 603       endif
 604 c
 605       endif
 606 c
 607 c 3.3. ==> traitement des indicateurs portant sur les triangles
 608 c
 609 #ifdef _DEBUG_HOMARD_
 610       write (ulsort,90002) '3.3. Triangles ; codret', codret
 611 #endif
 612 c
 613       if ( codret.eq.0 ) then
 614 c
 615       if ( nbvtri.ne.0 ) then
 616 c
 617 #ifdef _DEBUG_HOMARD_
 618       write (ulsort,texte(langue,3)) 'DEITRD', nompro
 619 #endif
 620         call deitrd ( nivmin,
 621      >                decare, decfac,
 622      >                aretri, hettri, filtri, nivtri,
 623      >                trsupp, trindi,
 624      >                ulsort, langue, codret)
 625 c
 626       endif
 627 c
 628       endif
 629 c
 630 c 3.4. ==> traitement des indicateurs portant sur les quadrangles
 631 c
 632 #ifdef _DEBUG_HOMARD_
 633       write (ulsort,90002) '3.4. Quadrangles ; codret', codret
 634 #endif
 635 c
 636       if ( codret.eq.0 ) then
 637 c
 638       if ( nbvqua.ne.0 ) then
 639 c
 640 #ifdef _DEBUG_HOMARD_
 641       write (ulsort,texte(langue,3)) 'DEIQUD', nompro
 642 #endif
 643         call deiqud ( nivmin,
 644      >                decare, decfac,
 645      >                arequa, hetqua, filqua, nivqua,
 646      >                qusupp, quindi,
 647      >                ulsort, langue, codret)
 648 c
 649       endif
 650 c
 651       endif
 652 c
 653 c 3.5. ==> traitement des indicateurs portant sur les tetraedres
 654 c
 655 #ifdef _DEBUG_HOMARD_
 656       write (ulsort,90002) '3.5. Tetraedres ; codret', codret
 657 #endif
 658 c
 659       if ( codret.eq.0 ) then
 660 c
 661       if ( nbvtet.ne.0 ) then
 662 c
 663 #ifdef _DEBUG_HOMARD_
 664       write (ulsort,texte(langue,3)) 'DEITED', nompro
 665 #endif
 666         call deited ( nivmin,
 667      >                decare, decfac,
 668      >                aretri, nivtri,
 669      >                tritet, hettet, filtet,
 670      >                tesupp, teindi,
 671      >                ulsort, langue, codret)
 672 c
 673       endif
 674 c
 675       endif
 676 c
 677 c 3.6. ==> traitement des indicateurs portant sur les hexaedres
 678 c
 679 #ifdef _DEBUG_HOMARD_
 680       write (ulsort,90002) '3.6. Hexaedres ; codret', codret
 681 #endif
 682 c
 683       if ( codret.eq.0 ) then
 684 c
 685       if ( nbvhex.ne.0 ) then
 686 c
 687 #ifdef _DEBUG_HOMARD_
 688       write (ulsort,texte(langue,3)) 'DEIHED', nompro
 689 #endif
 690         call deihed ( nivmin,
 691      >                decare, decfac,
 692      >                arequa, nivqua,
 693      >                quahex, hethex, filhex,
 694      >                hesupp, heindi,
 695      >                ulsort, langue, codret)
 696 c
 697       endif
 698 c
 699       endif
 700 c
 701 c 3.7. ==> traitement des indicateurs portant sur les pyramides
 702 c
 703 #ifdef _DEBUG_HOMARD_
 704       write (ulsort,90002) '3.7. Pyramides ; codret', codret
 705 #endif
 706 c
 707       if ( codret.eq.0 ) then
 708 c
 709       if ( nbvpyr.ne.0 ) then
 710 c
 711 #ifdef _DEBUG_HOMARD_
 712       write (ulsort,texte(langue,3)) 'DEIPYD', nompro
 713 #endif
 714         call deipyd ( nivmin,
 715      >                hetpyr,
 716      >                ulsort, langue, codret)
 717 c
 718       endif
 719 c
 720       endif
 721 c
 722 c 3.8. ==> traitement des indicateurs portant sur les pentaedres
 723 c
 724 #ifdef _DEBUG_HOMARD_
 725       write (ulsort,90002) '3.8. pentaedres ; codret', codret
 726 #endif
 727 c
 728       if ( codret.eq.0 ) then
 729 c
 730       if ( nbvpen.ne.0 ) then
 731 c
 732 #ifdef _DEBUG_HOMARD_
 733       write (ulsort,texte(langue,3)) 'DEIPED', nompro
 734 #endif
 735         call deiped ( nivmin,
 736      >                decare, decfac,
 737      >                aretri, nivtri,
 738      >                arequa,
 739      >                facpen, hetpen, filpen,
 740      >                pesupp, peindi,
 741      >                ulsort, langue, codret)
 742 c
 743       endif
 744 c
 745       endif
 746 c
 747 c
 748       if ( codret.eq.0 ) then
 749 c
 750       write (ulsort,texte(langue,8))
 751 c
 752       call decpte
 753      >        ( pilraf, pilder,
 754      >          decare, decfac,
 755      >          hettri, hetqua, tritet, hettet,
 756      >          quahex, hethex,
 757      >          facpyr, hetpyr,
 758      >          facpen, hetpen,
 759      >          ulsort, langue, codret )
 760 c
 761       endif
 762 c
 763       endif
 764 c
 765 c====
 766 c 4. traitement du raffinement
 767 c====
 768 #ifdef _DEBUG_HOMARD_
 769       write (ulsort,90002) '4. raffinement ; codret', codret
 770 #endif
 771 #ifdef _DEBUG_HOMARD_
 772       write (ulsort,90002) 'pilraf', pilraf
 773 #endif
 774 c
 775       if ( pilraf.ne.0 ) then
 776 c
 777 c 4.1. ==> traitement des indicateurs portant sur les noeuds
 778 c
 779 #ifdef _DEBUG_HOMARD_
 780       write (ulsort,90002) '4.1. noeuds ; codret', codret
 781 #endif
 782 c
 783       if ( codret.eq.0 ) then
 784 c
 785       if ( nbvnoe.ne.0 ) then
 786 c
 787 #ifdef _DEBUG_HOMARD_
 788       write (ulsort,texte(langue,3)) 'DEINOR', nompro
 789 #endif
 790         call deinor ( nivmax,
 791      >                decare,
 792      >                somare, hetare,
 793      >                np2are, posifa, facare,
 794      >                nivtri,
 795      >                nivqua,
 796      >                nosupp, noindi,
 797      >                ulsort, langue, codret)
 798 c
 799       endif
 800 c
 801       endif
 802 c
 803 c 4.2. ==> traitement des indicateurs portant sur les aretes
 804 c
 805 #ifdef _DEBUG_HOMARD_
 806       write (ulsort,90002) '4.2. aretes ; codret', codret
 807 #endif
 808 c
 809       if ( codret.eq.0 ) then
 810 c
 811       if ( nbvare.ne.0 ) then
 812 c
 813 #ifdef _DEBUG_HOMARD_
 814       write (ulsort,texte(langue,3)) 'DEIARR', nompro
 815 #endif
 816         call deiarr ( nivmax,
 817      >                decare,
 818      >                hetare,
 819      >                posifa, facare,
 820      >                nivtri,
 821      >                nivqua,
 822      >                arsupp, arindi,
 823      >                ulsort, langue, codret)
 824 c
 825       endif
 826 c
 827       endif
 828 c
 829 c 4.3. ==> traitement des indicateurs portant sur les triangles
 830 c
 831 #ifdef _DEBUG_HOMARD_
 832       write (ulsort,90002) '4.3. Triangles ; codret', codret
 833 #endif
 834 c
 835       if ( codret.eq.0 ) then
 836 c
 837       if ( nbvtri.ne.0 ) then
 838 c
 839 #ifdef _DEBUG_HOMARD_
 840       write (ulsort,texte(langue,3)) 'DEITRR', nompro
 841 #endif
 842         call deitrr ( nivmax,
 843      >                decare, decfac,
 844      >                hetare,
 845      >                aretri, hettri, nivtri,
 846      >                trsupp, trindi,
 847      >                ulsort, langue, codret)
 848 c
 849       endif
 850 c
 851       endif
 852 c
 853 c 4.4. ==> traitement des indicateurs portant sur les quadrangles
 854 c
 855 #ifdef _DEBUG_HOMARD_
 856       write (ulsort,90002) '4.4. Quadrangles ; codret', codret
 857 #endif
 858 c
 859       if ( codret.eq.0 ) then
 860 c
 861       if ( nbvqua.ne.0 ) then
 862 c
 863 #ifdef _DEBUG_HOMARD_
 864       write (ulsort,texte(langue,3)) 'DEIQUR', nompro
 865 #endif
 866         call deiqur ( nivmax,
 867      >                decare, decfac,
 868      >                hetare,
 869      >                arequa, hetqua, nivqua,
 870      >                qusupp, quindi,
 871      >                ulsort, langue, codret)
 872 c
 873       endif
 874 c
 875       endif
 876 c
 877 c 4.5. ==> traitement des indicateurs portant sur les tetraedres
 878 c
 879 #ifdef _DEBUG_HOMARD_
 880       write (ulsort,90002) '4.5. Tetraedres ; codret', codret
 881 #endif
 882 c
 883       if ( codret.eq.0 ) then
 884 c
 885       if ( nbvtet.ne.0 ) then
 886 c
 887 #ifdef _DEBUG_HOMARD_
 888       write (ulsort,texte(langue,3)) 'DEITER', nompro
 889 #endif
 890         call deiter ( nivmax,
 891      >                decare, decfac,
 892      >                hetare,
 893      >                aretri, hettri, nivtri,
 894      >                tritet,
 895      >                tesupp, teindi,
 896      >                ulsort, langue, codret)
 897 c
 898       endif
 899 c
 900       endif
 901 c
 902 c 4.6. ==> traitement des indicateurs portant sur les hexaedres
 903 c
 904 #ifdef _DEBUG_HOMARD_
 905       write (ulsort,90002) '4.6. Hexaedres ; codret', codret
 906 #endif
 907 c
 908       if ( codret.eq.0 ) then
 909 c
 910       if ( nbvhex.ne.0 ) then
 911 c
 912 #ifdef _DEBUG_HOMARD_
 913       write (ulsort,texte(langue,3)) 'DEIHER', nompro
 914 #endif
 915         call deiher ( nivmax,
 916      >                decare, decfac,
 917      >                hetare,
 918      >                arequa, hetqua, nivqua,
 919      >                quahex,
 920      >                hesupp, heindi,
 921      >                ulsort, langue, codret)
 922 c
 923       endif
 924 c
 925       endif
 926 c
 927 c 4.7. ==> traitement des indicateurs portant sur les pyramides
 928 c
 929 #ifdef _DEBUG_HOMARD_
 930       write (ulsort,90002) '4.7. Pyramides ; codret', codret
 931 #endif
 932 c
 933       if ( codret.eq.0 ) then
 934 c
 935       if ( nbvpyr.ne.0 ) then
 936 c
 937 #ifdef _DEBUG_HOMARD_
 938       write (ulsort,texte(langue,3)) 'DEIPYR', nompro
 939 #endif
 940         call deipyr ( nivmax,
 941      >                decare, decfac,
 942      >                hetare,
 943      >                aretri, hettri, nivtri,
 944      >                arequa, hetqua,
 945      >                facpyr,
 946      >                pysupp, pyindi,
 947      >                ulsort, langue, codret)
 948 c
 949       endif
 950 c
 951       endif
 952 c
 953 c 4.8. ==> traitement des indicateurs portant sur les pentaedres
 954 c
 955 #ifdef _DEBUG_HOMARD_
 956       write (ulsort,90002) '4.8. pentaedres ; codret', codret
 957 #endif
 958 c
 959       if ( codret.eq.0 ) then
 960 c
 961       if ( nbvpen.ne.0 ) then
 962 c
 963 #ifdef _DEBUG_HOMARD_
 964       write (ulsort,texte(langue,3)) 'DEIPER', nompro
 965 #endif
 966         call deiper ( nivmax,
 967      >                decare, decfac,
 968      >                hetare,
 969      >                aretri, hettri, nivtri,
 970      >                arequa, hetqua,
 971      >                facpen,
 972      >                pesupp, peindi,
 973      >                ulsort, langue, codret)
 974 c
 975       endif
 976 c
 977       endif
 978 c
 979       if ( codret.eq.0 ) then
 980 c
 981       write (ulsort,texte(langue,9))
 982 c
 983       call decpte
 984      >        ( pilraf, pilder,
 985      >          decare, decfac,
 986      >          hettri, hetqua, tritet, hettet,
 987      >          quahex, hethex,
 988      >          facpyr, hetpyr,
 989      >          facpen, hetpen,
 990      >          ulsort, langue, codret )
 991 c
 992       endif
 993 c
 994       endif
 995 c
 996 #ifdef _DEBUG_HOMARD_
 997 cgn      write (ulsort,*) 'en sortie de ', nompro
 998 cgn        do 1105 , iaux = 1 , nbquto
 999 cgn          write (ulsort,90001) 'decision quadrangle', iaux,decfac(-iaux)
1000 cgn          write (ulsort,90001) 'quadrangle', iaux,
1001 cgn     >    arequa(iaux,1), arequa(iaux,2),
1002 cgn     >    arequa(iaux,3), arequa(iaux,4)
1003 cgn 1105   continue
1004 #endif
1005 cgn      iaux = 14808
1006 cgn      write (ulsort,90002) 'quadrangle ', iaux
1007 cgn      write (ulsort,*) 'decfac(',iaux,') =',decfac(-iaux)
1008 cgn      write (ulsort,*) arequa(iaux,1),arequa(iaux,2),
1009 cgn     >arequa(iaux,3),arequa(iaux,4)
1010 cgn      write (ulsort,*) decare(arequa(iaux,1)),decare(arequa(iaux,2)),
1011 cgn     >decare(arequa(iaux,3)),decare(arequa(iaux,4))
1012 cgn      write (ulsort,*) hetare(arequa(iaux,1)),hetare(arequa(iaux,2)),
1013 cgn     >hetare(arequa(iaux,3)),hetare(arequa(iaux,4))
1014 cgn      write (ulsort,*) ' '
1015 cgn      print 1789,(iaux, decfac(iaux),iaux = 0, nbtrto)
1016 cgn      print 1789,(iaux, decfac(iaux),iaux = -nbquto,0)
1017 cgn      print 1789,(iaux, decare(iaux),iaux = 1, nbarto)
1018 c
1019 cgn      write (ulsort,*) 'decision triangle'
1020 cgn      write (ulsort,91030) (decfac(iaux),iaux= 1 , nbtrto)
1021 cgn      write (ulsort,*) 'decision quadrangle'
1022 cgn      write (ulsort,91030) (decfac(-iaux),iaux= 1 , nbquto)
1023 c
1024 c====
1025 c 5. la fin
1026 c====
1027 c
1028       if ( codret.ne.0 ) then
1029 c
1030 #include "envex2.h"
1031 c
1032       write (ulsort,texte(langue,1)) 'Sortie', nompro
1033       write (ulsort,texte(langue,2)) codret
1034 c
1035       endif
1036 c
1037 #ifdef _DEBUG_HOMARD_
1038       write (ulsort,texte(langue,1)) 'Sortie', nompro
1039       call dmflsh (iaux)
1040 #endif
1041 c
1042       end