src/tool/Creation_Maillage/cmcp5c.F

   1       subroutine cmcp5c ( indtri, triint,
   2      >                    lesare,
   3      >                    areint, areqtr, niveau,
   4      >                    aretri, famtri, hettri,
   5      >                    filtri, pertri, nivtri,
   6      >                    ulsort, langue, codret )
   7 c ______________________________________________________________________
   8 c
   9 c                             H O M A R D
  10 c
  11 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  12 c
  13 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  14 c aupres des huissiers de justice Simart et Lavoir a Clamart
  15 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  16 c aupres des huissiers de justice
  17 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  18 c
  19 c    HOMARD est une marque deposee d'Electricite de France
  20 c
  21 c Copyright EDF 1996
  22 c Copyright EDF 1998
  23 c Copyright EDF 2002
  24 c Copyright EDF 2020
  25 c ______________________________________________________________________
  26 c
  27 c    Creation du Maillage - Conformite - decoupage des Pentaedres
  28 c    -           -          -                          -
  29 c                         - cas 5, phase C
  30 c                               -        -
  31 c    Construction des triangles internes
  32 c ______________________________________________________________________
  33 c .        .     .        .                                            .
  34 c .  nom   . e/s . taille .           description                      .
  35 c .____________________________________________________________________.
  36 c . indtri . es  .   1    . indice du dernier triangle cree            .
  37 c . triint .  s  .  15    . triangles internes au pentaedre            .
  38 c .        .     .        .  1-3 = milieu/milieu et sommet face opposee.
  39 c .        .     .        .  4-6 = milieu/milieu et noeud central      .
  40 c .        .     .        .  7-9 = arete face oppose et noeud central  .
  41 c .        .     .        . 10-15 = appuyes sur une arete interne a    .
  42 c .        .     .        .        une face quadrangulaire coupee      .
  43 c . lesare . e   .   3    . liste des aretes du pentaedre utiles       .
  44 c .        .     .        .  1-3 = arete face oppose                   .
  45 c . areint . e  .    6    . aretes internes au pentaedre               .
  46 c . areqtr . e   .(4,0:3) . aretes tracees sur les faces decoupees     .
  47 c . aretri . es  .nouvtr*3. numeros des 3 aretes des triangles         .
  48 c . hettri . es  . nouvtr . historique de l'etat des triangles         .
  49 c . filtri . es  . nouvtr . premier fils des triangles                 .
  50 c . pertri . es  . nouvtr . pere des triangles                         .
  51 c . nivtri . es  . nouvtr . niveau des triangles                       .
  52 c . famtri . es  . nouvtr . famille des triangles                      .
  53 c . niveau . e   . 1      . niveau a attribuer aux triangles           .
  54 c . ulsort . e   .   1    . unite logique de la sortie generale        .
  55 c . langue . e   .    1   . langue des messages                        .
  56 c .        .     .        . 1 : francais, 2 : anglais                  .
  57 c . codret . es  .    1   . code de retour des modules                 .
  58 c .        .     .        . 0 : pas de probleme                        .
  59 c .        .     .        . 1 : aucune arete ne correspond             .
  60 c ______________________________________________________________________
  61 c
  62 c====
  63 c 0. declarations et dimensionnement
  64 c====
  65 c
  66 c 0.1. ==> generalites
  67 c
  68       implicit none
  69       save
  70 c
  71       character*6 nompro
  72       parameter ( nompro = 'CMCP5C' )
  73 c
  74 #include "nblang.h"
  75 c
  76 c 0.2. ==> communs
  77 c
  78 #include "envex1.h"
  79 c
  80 #include "nouvnb.h"
  81 #include "ope1a3.h"
  82 c
  83 c 0.3. ==> arguments
  84 c
  85       integer indtri
  86       integer niveau
  87       integer triint(15)
  88       integer lesare(3)
  89       integer areint(6)
  90       integer areqtr(4,0:3)
  91       integer aretri(nouvtr,3), famtri(nouvtr)
  92       integer hettri(nouvtr), filtri(nouvtr), pertri(nouvtr)
  93       integer nivtri(nouvtr)
  94 c
  95       integer ulsort, langue, codret
  96 c
  97 c 0.4. ==> variables locales
  98 c
  99       integer iaux, jaux
 100       integer codetr
 101 c
 102       integer nbmess
 103       parameter ( nbmess = 10 )
 104       character*80 texte(nblang,nbmess)
 105 c
 106 c 0.5. ==> initialisations
 107 c ______________________________________________________________________
 108 c
 109 c====
 110 c 1. initialisations
 111 c====
 112 c
 113 c 1.1. ==> messages
 114 c
 115 #include "impr01.h"
 116 c
 117 #ifdef _DEBUG_HOMARD_
 118       write (ulsort,texte(langue,1)) 'Entree', nompro
 119       call dmflsh (iaux)
 120 #endif
 121 c
 122       codret = 0
 123 c
 124       codetr = 1
 125 c
 126 c====
 127 c 2. Les triangles entre les aretes tracees sur la face coupee et
 128 c    les sommets de la face opposee
 129 c====
 130 c
 131       do 21 , iaux = 1 , 3
 132 c
 133         jaux = per1a3(1,iaux)
 134 c
 135         indtri = indtri + 1
 136         triint(iaux) = indtri
 137 #ifdef _DEBUG_HOMARD_
 138       write (ulsort,texte(langue,3)) 'CMCTRI_123', nompro
 139 #endif
 140         call cmctri ( aretri, famtri, hettri,
 141      >                filtri, pertri, nivtri,
 142      >                indtri,
 143      >                areqtr(iaux,1), areqtr(4,iaux), areqtr(jaux,2),
 144      >                codetr, niveau )
 145 c
 146    21 continue
 147 c
 148 c====
 149 c 3. Les triangles entre les aretes tracees sur la face coupee et
 150 c    le noeud central
 151 c====
 152 c
 153       do 31 , iaux = 1 , 3
 154 c
 155         jaux = per1a3(1,iaux)
 156 c
 157         indtri = indtri + 1
 158         triint(iaux+3) = indtri
 159 #ifdef _DEBUG_HOMARD_
 160       write (ulsort,texte(langue,3)) 'CMCTRI_456', nompro
 161 #endif
 162         call cmctri ( aretri, famtri, hettri,
 163      >                filtri, pertri, nivtri,
 164      >                indtri,
 165      >                areint(iaux+3), areqtr(4,iaux), areint(jaux+3),
 166      >                codetr, niveau )
 167 c
 168    31 continue
 169 c
 170 c====
 171 c 4. Les triangles s'appuyant sur les 3 aretes de la face non decoupee
 172 c====
 173 c
 174       do 41 , iaux = 1 , 3
 175 c
 176         jaux = per1a3(-1,iaux)
 177 c
 178         indtri = indtri + 1
 179         triint(iaux+6) = indtri
 180 #ifdef _DEBUG_HOMARD_
 181       write (ulsort,texte(langue,3)) 'CMCTRI_789', nompro
 182 #endif
 183         call cmctri ( aretri, famtri, hettri,
 184      >                filtri, pertri, nivtri,
 185      >                indtri,
 186      >                areint(iaux), lesare(iaux), areint(jaux),
 187      >                codetr, niveau )
 188 c
 189    41 continue
 190 c
 191 c====
 192 c 5. Les triangles s'appuyant sur les aretes tracees sur
 193 c    les quadrangles coupes
 194 c====
 195 c
 196       do 511 , iaux = 1 , 3
 197 c
 198         indtri = indtri + 1
 199         triint(iaux+9) = indtri
 200 #ifdef _DEBUG_HOMARD_
 201       write (ulsort,texte(langue,3)) 'CMCTRI_10-11-12', nompro
 202 #endif
 203         call cmctri ( aretri, famtri, hettri,
 204      >                filtri, pertri, nivtri,
 205      >                indtri,
 206      >                areint(iaux), areqtr(iaux,1), areint(iaux+3),
 207      >                codetr, niveau )
 208 c
 209   511 continue
 210 c
 211       do 512 , iaux = 1 , 3
 212 c
 213         jaux = per1a3(-1,iaux)
 214 c
 215         indtri = indtri + 1
 216         triint(iaux+12) = indtri
 217 #ifdef _DEBUG_HOMARD_
 218       write (ulsort,texte(langue,3)) 'CMCTRI_13-14-15', nompro
 219 #endif
 220         call cmctri ( aretri, famtri, hettri,
 221      >                filtri, pertri, nivtri,
 222      >                indtri,
 223      >                areint(iaux+3), areqtr(iaux,2), areint(jaux),
 224      >                codetr, niveau )
 225 c
 226   512 continue
 227 c
 228 c====
 229 c 6. la fin
 230 c====
 231 c
 232       if ( codret.ne.0 ) then
 233 c
 234 #include "envex2.h"
 235 c
 236       write (ulsort,texte(langue,1)) 'Sortie', nompro
 237       write (ulsort,texte(langue,2)) codret
 238 c
 239       endif
 240 c
 241 #ifdef _DEBUG_HOMARD_
 242       write (ulsort,texte(langue,1)) 'Sortie', nompro
 243       call dmflsh (iaux)
 244 #endif
 245 c
 246       end