src/tool/Creation_Maillage/cmcdqu.F

   1       subroutine cmcdqu ( indnoe, indare, indtri, indqua, decfac,
   2      >                    coonoe, hetnoe, arenoe, famnoe,
   3      >                    hetare, somare,
   4      >                    filare, merare, famare,
   5      >                    hettri, aretri,
   6      >                    filtri, pertri, famtri,
   7      >                    nivtri,
   8      >                    hetqua, arequa,
   9      >                    filqua, perqua, famqua,
  10      >                    nivqua, ninqua,
  11      >                    cfaqua,
  12      >                    ulsort, langue, codret )
  13 c ______________________________________________________________________
  14 c
  15 c                             H O M A R D
  16 c
  17 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  18 c
  19 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  20 c aupres des huissiers de justice Simart et Lavoir a Clamart
  21 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  22 c aupres des huissiers de justice
  23 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  24 c
  25 c    HOMARD est une marque deposee d'Electricite de France
  26 c
  27 c Copyright EDF 1996
  28 c Copyright EDF 1998
  29 c Copyright EDF 2002
  30 c Copyright EDF 2020
  31 c ______________________________________________________________________
  32 c
  33 c    Creation du Maillage - Conformite - Decoupage des QUadrangles
  34 c    -           -          -            -             --
  35 c ______________________________________________________________________
  36 c .        .     .        .                                            .
  37 c .  nom   . e/s . taille .           description                      .
  38 c .____________________________________________________________________.
  39 c . indnoe . es  .   1    . indice du dernier noeud cree               .
  40 c . indare . es  . 1      . indice de la derniere arete creee          .
  41 c . indtri . es  . 1      . indice du dernier triangle cree            .
  42 c . indqua . es  . 1      . indice du dernier quadrangle cree          .
  43 c . decfac . es  . -nbquto. decision sur les faces (quad. + tri.)      .
  44 c .        .     . :nbtrto.                                            .
  45 c . coonoe . es  .nouvno*3. coordonnees des noeuds                     .
  46 c . hetnoe . es  . nouvno . historique de l'etat des noeuds            .
  47 c . arenoe . es  . nouvno . arete liee a un nouveau noeud              .
  48 c . famnoe .     . nouvno . famille des noeuds                         .
  49 c . hetare . es  . nouvar . historique de l'etat des aretes            .
  50 c . somare . es  .2*nouvar. numeros des extremites d'arete             .
  51 c . filare . es  . nouvar . premiere fille des aretes                  .
  52 c . merare . es  . nouvar . mere des aretes                            .
  53 c . famare . es  . nouvar . caracteristiques des aretes                .
  54 c . hettri . es  . nouvtr . historique de l'etat des triangles         .
  55 c . aretri . es  .nouvtr*3. numeros des 3 aretes des triangles         .
  56 c . filtri . es  . nouvtr . premier fils des triangles                 .
  57 c . pertri . es  . nouvtr . pere des triangles                         .
  58 c . nivtri . es  . nouvtr . niveau des triangles                       .
  59 c . famtri . es  . nouvtr . famille des triangles                      .
  60 c . hetqua . es  . nouvqu . historique de l'etat des quadrangles       .
  61 c . arequa . es  .nouvqu*3. numeros des 4 aretes des quadrangles       .
  62 c . filqua . es  . nouvqu . premier fils des quadrangles               .
  63 c . famqua . es  . nouvqu . famille des quadrangles                    .
  64 c . perqua . es  . nouvqu . pere des quadrangles                       .
  65 c . nivqua . es  . nouvqu . niveau des quadrangles                     .
  66 c . ninqua . es  . nouvqu . noeud interne au quadrangle                .
  67 c . cfaqua . e   . nctfqu*. codes des familles des quadrangles         .
  68 c .        .     . nbfqua .   1 : famille MED                          .
  69 c .        .     .        .   2 : type de quadrangle                   .
  70 c .        .     .        .   3 : numero de surface de frontiere       .
  71 c .        .     .        .   4 : famille des aretes internes apres raf.
  72 c .        .     .        .   5 : famille des triangles de conformite  .
  73 c .        .     .        .   6 : famille de sf active/inactive        .
  74 c .        .     .        . + l : appartenance a l'equivalence l       .
  75 c . ulsort . e   .   1    . unite logique de la sortie generale        .
  76 c . langue . e   .    1   . langue des messages                        .
  77 c .        .     .        . 1 : francais, 2 : anglais                  .
  78 c . codret . es  .    1   . code de retour des modules                 .
  79 c .        .     .        . 0 : pas de probleme                        .
  80 c ______________________________________________________________________
  81 c
  82 c====
  83 c 0. declarations et dimensionnement
  84 c====
  85 c
  86 c 0.1. ==> generalites
  87 c
  88       implicit none
  89       save
  90 c
  91       character*6 nompro
  92       parameter ( nompro = 'CMCDQU' )
  93 c
  94 #include "nblang.h"
  95 c
  96 c 0.2. ==> communs
  97 c
  98 #include "envex1.h"
  99 #include "envca1.h"
 100 c
 101 #include "nouvnb.h"
 102 #include "dicfen.h"
 103 #include "nbfami.h"
 104 c
 105 c 0.3. ==> arguments
 106 c
 107       double precision coonoe(nouvno,sdim)
 108 c
 109       integer indnoe, indare, indtri, indqua
 110       integer decfac(-permqu:permtr)
 111       integer hetnoe(nouvno), arenoe(nouvno), famnoe(nouvno)
 112       integer hetare(nouvar), somare(2,nouvar)
 113       integer filare(nouvar), merare(nouvar), famare(nouvar)
 114       integer hettri(nouvtr), aretri(nouvtr,3)
 115       integer filtri(nouvtr), pertri(nouvtr), famtri(nouvtr)
 116       integer nivtri(nouvtr)
 117       integer hetqua(nouvqu), arequa(nouvqu,4)
 118       integer filqua(nouvqu), perqua(nouvqu), famqua(nouvqu)
 119       integer nivqua(nouvqu)
 120       integer ninqua(nouvqu)
 121       integer cfaqua(nctfqu,nbfqua)
 122 c
 123       integer ulsort, langue, codret
 124 c
 125 c 0.4. ==> variables locales
 126 c
 127       integer lequad
 128       integer iaux
 129 c
 130       integer nbmess
 131       parameter ( nbmess = 10 )
 132       character*80 texte(nblang,nbmess)
 133 c
 134 c 0.5. ==> initialisations
 135 c ______________________________________________________________________
 136 c
 137 c====
 138 c 1. messages
 139 c====
 140 c
 141 #include "impr01.h"
 142 c
 143 #ifdef _DEBUG_HOMARD_
 144       write (ulsort,texte(langue,1)) 'Entree', nompro
 145       call dmflsh (iaux)
 146 #endif
 147 c
 148 #include "impr03.h"
 149 c
 150       codret = 0
 151 c
 152 #ifdef _DEBUG_HOMARD_
 153       write (ulsort,90002) 'au debut de'//nompro//', indnoe= ', indnoe
 154       write (ulsort,90002) 'au debut de'//nompro//', indare= ', indare
 155 #endif
 156 c====
 157 c 2. Parcours des quadrangles
 158 c====
 159 c
 160       do 200 , iaux = 1 , permqu
 161 cgn      print *,iaux,decfac(-iaux)
 162 c
 163         if ( codret.eq.0 ) then
 164 c
 165         lequad = iaux
 166 c
 167 c 2.1. ==> decoupage en 2 quadrangles des quadrangles
 168 c
 169         if ( decfac(-iaux).eq.2 ) then
 170 c
 171 #ifdef _DEBUG_HOMARD_
 172       write (ulsort,texte(langue,3)) 'CMCDQ2', nompro
 173 #endif
 174           call cmcdq2 ( lequad,
 175      >                  indare, indqua,
 176      >                  hetare, somare,
 177      >                  filare, merare, famare,
 178      >                  hetqua, arequa,
 179      >                  filqua, perqua, famqua,
 180      >                  nivqua,
 181      >                  cfaqua,
 182      >                  ulsort, langue, codret)
 183 c
 184 c 2.2. ==> decoupage en 3 triangles des quadrangles
 185 c
 186         elseif ( decfac(-iaux).eq.3 ) then
 187 c
 188 #ifdef _DEBUG_HOMARD_
 189       write (ulsort,texte(langue,3)) 'CMCDQ3', nompro
 190 #endif
 191           call cmcdq3 ( lequad,
 192      >                  indare, indtri,
 193      >                  hetare, somare,
 194      >                  filare, merare, famare,
 195      >                  hettri, aretri,
 196      >                  filtri, pertri, famtri,
 197      >                  nivtri,
 198      >                  hetqua, arequa,
 199      >                  filqua, famqua,
 200      >                  nivqua,
 201      >                  cfaqua,
 202      >                  ulsort, langue, codret)
 203 c
 204 c 2.3. ==> decoupage en 3 quadrangles des quadrangles
 205 c
 206         elseif ( decfac(-iaux).eq.5 ) then
 207 c
 208 #ifdef _DEBUG_HOMARD_
 209       write (ulsort,texte(langue,3)) 'CMCDQ5', nompro
 210 #endif
 211           call cmcdq5 ( lequad,
 212      >                  indnoe, indare, indqua,
 213      >                  coonoe, hetnoe, arenoe, famnoe,
 214      >                  hetare, somare,
 215      >                  filare, merare, famare,
 216      >                  hetqua, arequa,
 217      >                  filqua, perqua, famqua,
 218      >                  nivqua, ninqua,
 219      >                  cfaqua,
 220      >                  ulsort, langue, codret)
 221 c
 222         endif
 223 c
 224         endif
 225 c
 226   200 continue
 227 #ifdef _DEBUG_HOMARD_
 228       write (ulsort,90002) 'a la fin de'//nompro//', indnoe= ', indnoe
 229       write (ulsort,90002) 'a la fin de'//nompro//', indare= ', indare
 230 #endif
 231 c
 232 c====
 233 c 3. la fin
 234 c====
 235 c
 236       if ( codret.ne.0 ) then
 237 c
 238 #include "envex2.h"
 239 c
 240       write (ulsort,texte(langue,1)) 'Sortie', nompro
 241       write (ulsort,texte(langue,2)) codret
 242 c
 243       endif
 244 cgn      print *,'fin de ',nompro,', indtri = ',indtri
 245 cgn      print *,'fin de ',nompro,', indqua = ',indqua
 246 cgn      print *,'fin de ',nompro,', nivtri = ',nivtri
 247 cgn      print *,'fin de ',nompro,', nivqua = ',nivqua
 248 c
 249 #ifdef _DEBUG_HOMARD_
 250       write (ulsort,texte(langue,1)) 'Sortie', nompro
 251       call dmflsh (iaux)
 252 #endif
 253 c
 254       end