src/tool/Creation_Maillage/cminma.F

   1       subroutine cminma ( indnoe, indare, indtri, indqua,
   2      >                    indtet, indhex, indpyr, indpen,
   3      >                    lgopti, taopti,
   4      >                    ulsort, langue, codret )
   5 c ______________________________________________________________________
   6 c
   7 c                             H O M A R D
   8 c
   9 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  10 c
  11 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  12 c aupres des huissiers de justice Simart et Lavoir a Clamart
  13 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  14 c aupres des huissiers de justice
  15 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  16 c
  17 c    HOMARD est une marque deposee d'Electricite de France
  18 c
  19 c Copyright EDF 1996
  20 c Copyright EDF 1998
  21 c Copyright EDF 2002
  22 c Copyright EDF 2020
  23 c ______________________________________________________________________
  24 c
  25 c    Creation du Maillage - INitialisation du MAillage
  26 c    -           -          --                --
  27 c ______________________________________________________________________
  28 c .        .     .        .                                            .
  29 c .  nom   . e/s . taille .           description                      .
  30 c .____________________________________________________________________.
  31 c . indnoe .  s  .   1    . indice du dernier noeud cree               .
  32 c . indare .  s  .   1    . indice de la derniere arete creee          .
  33 c . indtri .  s  .   1    . indice du dernier triangle cree            .
  34 c . indqua .  s  .   1    . indice du dernier quadrangle cree          .
  35 c . indtet .  s  .   1    . indice du dernier tetraedre cree           .
  36 c . indhex .  s  .   1    . indice du dernier hexaedre cree            .
  37 c . indpyr .  s  .   1    . indice de la derniere pyramide creee       .
  38 c . indpen .  s  .   1    . indice du dernier pentaedre cree           .
  39 c . lgopti . e   .   1    . longueur du tableau des options entieres   .
  40 c . taopti . e   . lgopti . tableau des options                        .
  41 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  42 c . langue . e   .    1   . langue des messages                        .
  43 c .        .     .        . 1 : francais, 2 : anglais                  .
  44 c . codret . es  .    1   . code de retour des modules                 .
  45 c .        .     .        . 0 : pas de probleme                        .
  46 c ______________________________________________________________________
  47 c
  48 c====
  49 c 0. declarations et dimensionnement
  50 c====
  51 c
  52 c 0.1. ==> generalites
  53 c
  54       implicit none
  55       save
  56 c
  57       character*6 nompro
  58       parameter ( nompro = 'CMINMA' )
  59 c
  60 #include "nblang.h"
  61 c
  62 c 0.2. ==> communs
  63 c
  64 #include "envex1.h"
  65 #include "envada.h"
  66 #include "nombar.h"
  67 #include "nombtr.h"
  68 #include "nombqu.h"
  69 #include "nombno.h"
  70 #include "nombte.h"
  71 #include "nombhe.h"
  72 #include "nombpy.h"
  73 #include "nombpe.h"
  74 c
  75 #include "nouvnb.h"
  76 c
  77 c 0.3. ==> arguments
  78 c
  79       integer indnoe, indare, indtri, indqua
  80       integer indtet, indhex, indpyr, indpen
  81 c
  82       integer lgopti
  83       integer taopti(lgopti)
  84 c
  85       integer ulsort, langue, codret
  86 c
  87 c 0.4. ==> variables locales
  88 c
  89       integer iaux
  90 c
  91       integer nbmess
  92       parameter ( nbmess = 10 )
  93       character*80 texte(nblang,nbmess)
  94 c
  95 c 0.5. ==> initialisations
  96 c ______________________________________________________________________
  97 c
  98 c====
  99 c 1. messages
 100 c====
 101 c
 102 #include "impr01.h"
 103 c
 104 #ifdef _DEBUG_HOMARD_
 105       write (ulsort,texte(langue,1)) 'Entree', nompro
 106       call dmflsh (iaux)
 107 #endif
 108 c
 109 #include "impr03.h"
 110 c
 111 c====
 112 c 2. initialisation des pointeurs
 113 c    Quand le maillage ne change pas, il faut initialiser les pointeurs.
 114 c    Cela arrive dans deux cas :
 115 c    A l'iteration 0 : si pas de raffinement, quel que soit le type de
 116 c                      deraffinement car il sera ete inhibe
 117 c    Aux iterations suivantes : si ni raffinement, ni deraffinement
 118 c====
 119 c
 120 #ifdef _DEBUG_HOMARD_
 121       write (ulsort,90002) '2. initial. pointeurs ; codret', codret
 122 #endif
 123 c
 124 #ifdef _DEBUG_HOMARD_
 125       write (ulsort,90002) 'nbiter', nbiter
 126       write (ulsort,90002) 'taopti(31)', taopti(31)
 127       write (ulsort,90002) 'taopti(32)', taopti(32)
 128 #endif
 129 c
 130       if ( codret.eq.0 ) then
 131 c
 132       if ( ( nbiter.eq.0 .and. taopti(31).eq.0 ) .or.
 133      >     ( nbiter.gt.0 .and.
 134      >       taopti(31).eq.0 .and. taopti(32).eq.0 ) ) then
 135 c
 136         permno = nbnoto
 137         permp2 = nbnop2
 138         permim = nbnoim
 139         permar = nbarpe
 140         permtr = nbtrpe
 141         permqu = nbqupe
 142         permte = nbtepe
 143         permhe = nbhepe
 144         permpy = nbpype
 145         permpe = nbpepe
 146 c
 147         nouvno = nbnoto
 148         nouvp2 = nbnop2
 149         nouvim = nbnoim
 150         nouvar = nbarto
 151         nouvtr = nbtrto
 152         nouvqu = nbquto
 153         nouvte = nbteto
 154         nouvtf = nouvte
 155         nouvta = 0
 156         nouvhe = nbheto
 157         nouvhf = nouvhe
 158         nouvha = 0
 159         nouvpy = nbpyto
 160         nouvyf = nouvpy
 161         nouvya = 0
 162         nouvpe = nbpeto
 163         nouvpf = nouvpe
 164         nouvpa = 0
 165 c
 166         indnoe = nbnoto
 167         indare = nbarto
 168         indtri = nbtrto
 169         indqua = nbquto
 170         indtet = nbteto
 171         indhex = nbheto
 172         indpyr = nbpyto
 173         indpen = nbpeto
 174 c
 175 #ifdef _DEBUG_HOMARD_
 176       write (ulsort,90002)
 177      >'permar, permtr, permno, permp2, permim, permqu',
 178      > permar, permtr, permno, permp2, permim, permqu
 179       write (ulsort,90002)
 180      >'nouvar, nouvtr, nouvno, nouvp2, nouvim, nouvqu',
 181      > nouvar, nouvtr, nouvno, nouvp2, nouvim, nouvqu
 182       write (ulsort,90002)
 183      >'provar, provtr, provp1, provp2, provim, provqu',
 184      > provar, provtr, provp1, provp2, provim, provqu
 185       write (ulsort,90002)
 186      >'permte, permhe, permpy, permpe',
 187      > permte, permhe, permpy, permpe
 188       write (ulsort,90002)
 189      >'nouvte, nouvhe, nouvpy, nouvpe',
 190      > nouvte, nouvhe, nouvpy, nouvpe
 191       write (ulsort,90002)
 192      >'provta, provha, provya, provpa',
 193      > provta, provha, provya, provpa
 194       write (ulsort,90002)
 195      >'provtf, provhf, provyf, provpf',
 196      > provtf, provhf, provyf, provpf
 197 #endif
 198 c
 199       endif
 200 c
 201       endif
 202 c
 203 c====
 204 c 4. la fin
 205 c====
 206 c
 207       if ( codret.ne.0 ) then
 208 c
 209 #include "envex2.h"
 210 c
 211       write (ulsort,texte(langue,1)) 'Sortie', nompro
 212       write (ulsort,texte(langue,2)) codret
 213 c
 214       endif
 215 c
 216 #ifdef _DEBUG_HOMARD_
 217       write (ulsort,texte(langue,1)) 'Sortie', nompro
 218       call dmflsh (iaux)
 219 #endif
 220 c
 221       end