src/tool/Modification/mmelde.F

   1       subroutine mmelde ( typcca,
   2      >                    nbfare, cfaare,
   3      >                    nbftri, cfatri,
   4      >                    nbfqua, cfaqua,
   5      >                    nbftet, cfatet,
   6      >                    nbfhex, cfahex,
   7      >                    nbfpyr, cfapyr,
   8      >                    nbfpen, cfapen,
   9      >                    ulsort, langue, codret )
  10 c ______________________________________________________________________
  11 c
  12 c                             H O M A R D
  13 c
  14 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  15 c
  16 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  17 c aupres des huissiers de justice Simart et Lavoir a Clamart
  18 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  19 c aupres des huissiers de justice
  20 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  21 c
  22 c    HOMARD est une marque deposee d'Electricite de France
  23 c
  24 c Copyright EDF 1996
  25 c Copyright EDF 1998
  26 c Copyright EDF 2002
  27 c Copyright EDF 2020
  28 c ______________________________________________________________________
  29 c
  30 c  Modification de Maillage - ELements - changement de DEgre
  31 c  -               -          --                       --
  32 c ______________________________________________________________________
  33 c .        .     .        .                                            .
  34 c .  nom   . e/s . taille .           description                      .
  35 c .____________________________________________________________________.
  36 c . typcca . e   .   1    . type du code de calcul                     .
  37 c . nbfare . e   .   1    . nombre de familles d'aretes                .
  38 c . cfaare . e   . nctfar*. codes des familles des aretes              .
  39 c .        .     . nbfare .   1 : famille MED                          .
  40 c .        .     .        .   2 : type de segment                      .
  41 c .        .     .        .   3 : orientation                          .
  42 c .        .     .        .   4 : famille d'orientation inverse        .
  43 c .        .     .        .   5 : numero de ligne de frontiere         .
  44 c .        .     .        .  > 0 si concernee par le suivi de frontiere.
  45 c .        .     .        . <= 0 si non concernee                      .
  46 c .        .     .        .   6 : famille frontiere active/inactive    .
  47 c .        .     .        .   7 : numero de surface de frontiere       .
  48 c .        .     .        . + l : appartenance a l'equivalence l       .
  49 c . nbftri . e   .   1    . nombre de familles de triangles            .
  50 c . cfatri . e   . nctftr*. codes des familles des triangles           .
  51 c .        .     . nbftri .   1 : famille MED                          .
  52 c .        .     .        .   2 : type de triangle                     .
  53 c .        .     .        .   3 : numero de surface de frontiere       .
  54 c .        .     .        .   4 : famille des aretes internes apres raf.
  55 c .        .     .        . + l : appartenance a l'equivalence l       .
  56 c . nbfqua . e   .   1    . nombre de familles de quadrangles          .
  57 c . cfaqua . e   . nctfqu*. codes des familles des quadrangles         .
  58 c .        .     . nbfqua .   1 : famille MED                          .
  59 c .        .     .        .   2 : type de quadrangle                   .
  60 c .        .     .        .   3 : numero de surface de frontiere       .
  61 c .        .     .        .   4 : famille des aretes internes apres raf.
  62 c .        .     .        .   5 : famille des triangles de conformite  .
  63 c .        .     .        .   6 : famille de sf active/inactive        .
  64 c .        .     .        . + l : appartenance a l'equivalence l       .
  65 c . nbftet . e   .   1    . nombre de familles de tetraedres           .
  66 c . cfatet .     . nctfte. codes des familles des tetraedres          .
  67 c .        .     . nbftet .   1 : famille MED                          .
  68 c .        .     .        .   2 : type de tetraedres                   .
  69 c .        .     .        . + l : appartenance a l'equivalence l       .
  70 c . nbfhex . e   .   1    . nombre de familles d'hexaedres             .
  71 c . cfahex .     . nctfhe. codes des familles des hexaedres            .
  72 c .        .     . nbfhex .   1 : famille MED                          .
  73 c .        .     .        .   2 : type d'hexaedres                     .
  74 c .        .     .        .   3 : famille des tetraedres de conformite .
  75 c .        .     .        .   4 : famille des pyramides de conformite  .
  76 c . nbfpyr . e   .   1    . nombre de familles de pyramides            .
  77 c . cfapyr .     . nctfpy. codes des familles des pyramides            .
  78 c .        .     . nbfpyr .   1 : famille MED                          .
  79 c .        .     .        .   2 : type de pyramides                    .
  80 c . nbfpen . e   .   1    . nombre de familles de pyramides            .
  81 c . cfapen .     . nctfpe. codes des familles des pentaedres           .
  82 c .        .     . nbfpen .   1 : famille MED                          .
  83 c .        .     .        .   2 : type de pentaedres                   .
  84 c .        .     .        .   3 : famille des tetraedres de conformite .
  85 c .        .     .        .   4 : famille des pyramides de conformite  .
  86 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  87 c . langue . e   .    1   . langue des messages                        .
  88 c .        .     .        . 1 : francais, 2 : anglais                  .
  89 c . codret . es  .    1   . code de retour des modules                 .
  90 c .        .     .        . 0 : pas de probleme                        .
  91 c .        .     .        . 1 : probleme                               .
  92 c ______________________________________________________________________
  93 c
  94 c====
  95 c 0. declarations et dimensionnement
  96 c====
  97 c
  98 c 0.1. ==> generalites
  99 c
 100       implicit none
 101       save
 102 c
 103       character*6 nompro
 104       parameter ( nompro = 'MMELDE' )
 105 c
 106 #include "nblang.h"
 107 #include "coftex.h"
 108 c
 109 c 0.2. ==> communs
 110 c
 111 #include "envex1.h"
 112 c
 113 #include "dicfen.h"
 114 #include "rftmed.h"
 115 #include "impr02.h"
 116 c
 117 c 0.3. ==> arguments
 118 c
 119       integer typcca
 120 c
 121       integer nbfare, nbftri, nbfqua, nbftet, nbfhex, nbfpyr, nbfpen
 122       integer cfaare(nctfar,nbfare)
 123       integer cfatri(nctftr,nbftri)
 124       integer cfaqua(nctfqu,nbfqua)
 125       integer cfatet(nctfte,nbftet)
 126       integer cfahex(nctfhe,nbfhex)
 127       integer cfapyr(nctfpy,nbfpyr)
 128       integer cfapen(nctfpe,nbfpen)
 129 c
 130       integer ulsort, langue, codret
 131 c
 132 c 0.4. ==> variables locales
 133 c
 134       integer iaux
 135 c
 136       integer nbmess
 137       parameter ( nbmess = 10 )
 138       character*80 texte(nblang,nbmess)
 139 c
 140 c 0.5. ==> initialisations
 141 c ______________________________________________________________________
 142 c
 143 c====
 144 c 1. messages
 145 c====
 146 c
 147 #include "impr01.h"
 148 c
 149 #ifdef _DEBUG_HOMARD_
 150       write (ulsort,texte(langue,1)) 'Entree', nompro
 151       call dmflsh (iaux)
 152 #endif
 153 c
 154       codret = 0
 155 c
 156       texte(1,4) = '(''Nombre de familles de '',a,'' :'',i8)'
 157 c
 158       texte(2,4) = '(''Number of families of '',a,'' :'',i8)'
 159 c
 160 #ifdef _DEBUG_HOMARD_
 161       write (ulsort,texte(langue,4)) mess14(langue,3,1), nbfare
 162       write (ulsort,texte(langue,4)) mess14(langue,3,2), nbftri
 163       write (ulsort,texte(langue,4)) mess14(langue,3,4), nbfqua
 164       write (ulsort,texte(langue,4)) mess14(langue,3,3), nbftet
 165       write (ulsort,texte(langue,4)) mess14(langue,3,5), nbfpyr
 166       write (ulsort,texte(langue,4)) mess14(langue,3,6), nbfhex
 167       write (ulsort,texte(langue,4)) mess14(langue,3,7), nbfpen
 168 #endif
 169 c
 170 c====
 171 c 2. Modification des codes du type d'element
 172 c====
 173 c
 174       do 21 , iaux = 1, nbfare
 175         if ( cfaare(cotyel,iaux).ne.0 ) then
 176           cfaare(cotyel,iaux) = medt12(cfaare(cotyel,iaux))
 177         endif
 178    21 continue
 179 c
 180       do 22 , iaux = 1, nbftri
 181         if ( cfatri(cotyel,iaux).ne.0 ) then
 182           cfatri(cotyel,iaux) = medt12(cfatri(cotyel,iaux))
 183         endif
 184    22 continue
 185 c
 186       do 23 , iaux = 1, nbfqua
 187         if ( cfaqua(cotyel,iaux).ne.0 ) then
 188           cfaqua(cotyel,iaux) = medt12(cfaqua(cotyel,iaux))
 189         endif
 190    23 continue
 191 c
 192       do 24 , iaux = 1, nbftet
 193         if ( cfatet(cotyel,iaux).ne.0 ) then
 194           cfatet(cotyel,iaux) = medt12(cfatet(cotyel,iaux))
 195         endif
 196    24 continue
 197 c
 198       do 25 , iaux = 1, nbfpyr
 199         if ( cfapyr(cotyel,iaux).ne.0 ) then
 200           cfapyr(cotyel,iaux) = medt12(cfapyr(cotyel,iaux))
 201         endif
 202    25 continue
 203 c
 204       do 26 , iaux = 1, nbfhex
 205         if ( cfahex(cotyel,iaux).ne.0 ) then
 206           cfahex(cotyel,iaux) = medt12(cfahex(cotyel,iaux))
 207         endif
 208    26 continue
 209 c
 210       do 27 , iaux = 1, nbfpen
 211         if ( cfapen(cotyel,iaux).ne.0 ) then
 212           cfapen(cotyel,iaux) = medt12(cfapen(cotyel,iaux))
 213         endif
 214    27 continue
 215 c
 216 c====
 217 c 3. la fin
 218 c====
 219 c
 220       if ( codret.ne.0 ) then
 221 c
 222 #include "envex2.h"
 223 c
 224       write (ulsort,texte(langue,1)) 'Sortie', nompro
 225       write (ulsort,texte(langue,2)) codret
 226 c
 227       endif
 228 c
 229 #ifdef _DEBUG_HOMARD_
 230       write (ulsort,texte(langue,1)) 'Sortie', nompro
 231       call dmflsh (iaux)
 232 #endif
 233 c
 234       end