src/tool/Decision/deisv5.F

   1       subroutine deisv5 ( lamail, ncmpin, usacmp,
   2      >                    nbenti, enindi, eninin,
   3      >                    tesupp, teinin,
   4      >                    hesupp, heinin,
   5      >                    pysupp, pyinin,
   6      >                    pesupp, peinin,
   7      >                    nbvote, voiste,
   8      >                    nbvohe, voishe,
   9      >                    nbvopy, voispy,
  10      >                    nbvope, voispe,
  11      >                    valaux,
  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    traitement des DEcisions - Initialisations - par Saut - Volumes - 5
  34 c                   --          -                     -      -         -
  35 c    Calcul des sauts sur tous les voisins
  36 c ______________________________________________________________________
  37 c .        .     .        .                                            .
  38 c .  nom   . e/s . taille .           description                      .
  39 c .____________________________________________________________________.
  40 c . lamail . e   .   1    . la maille en cours d'examen                .
  41 c . ncmpin .  e  .   1    . nombre de composantes de l'indicateur      .
  42 c . usacmp . e   .   1    . usage des composantes de l'indicateur      .
  43 c .        .     .        . 0 : norme L2                               .
  44 c .        .     .        . 1 : norme infinie -max des valeurs absolues.
  45 c .        .     .        . 2 : valeur relative si une seule composante.
  46 c . nbenti . e   .   1    . nombre d'entites courantes                 .
  47 c . eninin . e   . ncmpin . valeur brute de l'indicateur sur la maille .
  48 c . enindi . es  . ncmpin . valeur du saut de l'indicateur             .
  49 c . tesupp . e   . nbteto . support pour les tetraedres                .
  50 c . teinin . e   . nbteto . valeurs initiales pour les tetraedres      .
  51 c . hesupp . e   . nbheto . support pour les hexaedres                 .
  52 c . heinin . e   . nbheto . valeurs initiales pour les hexaedres       .
  53 c . pysupp . e   . nbpyto . support pour les pyramides                 .
  54 c . pyinin . e   . nbpyto . valeurs initiales pour les pyramides       .
  55 c . pesupp . e   . nbpeto . support pour les pentaedres                .
  56 c . peinin . e   . nbpeto . valeurs initiales pour les pentaedres      .
  57 c . nbvote . e   .    1   . nombre de voisins de type tetraedre        .
  58 c . voiste . e   . nbvote . les voisins de type tetraedre              .
  59 c . nbvohe . e   .    1   . nombre de voisins de type hexaedre         .
  60 c . voishe . e   . nbvohe . les voisins de type hexaedre               .
  61 c . nbvopy . e   .    1   . nombre de voisins de type pyramide         .
  62 c . voispy . e   . nbvopy . les voisins de type pyramide               .
  63 c . nbvope . e   .    1   . nombre de voisins de type pentaedre        .
  64 c . voispe . e   . nbvope . les voisins de type pentaedre              .
  65 c . valaux . a   . ncmpin . tableau auxiliaire                         .
  66 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  67 c . langue . e   .    1   . langue des messages                        .
  68 c .        .     .        . 1 : francais, 2 : anglais                  .
  69 c . codret . es  .    1   . code de retour des modules                 .
  70 c .        .     .        . 0 : pas de probleme                        .
  71 c .        .     .        . 2 : probleme dans le traitement            .
  72 c ______________________________________________________________________
  73 c
  74 c====
  75 c 0. declarations et dimensionnement
  76 c====
  77 c
  78 c 0.1. ==> generalites
  79 c
  80       implicit none
  81       save
  82 c
  83       character*6 nompro
  84       parameter ( nompro = 'DEISV5' )
  85 c
  86 #include "nblang.h"
  87 c
  88 c 0.2. ==> communs
  89 c
  90 #include "envex1.h"
  91 c
  92 #include "infini.h"
  93 #include "impr02.h"
  94 #include "nombte.h"
  95 #include "nombhe.h"
  96 #include "nombpy.h"
  97 #include "nombpe.h"
  98 c
  99 c 0.3. ==> arguments
 100 c
 101       integer lamail
 102       integer ncmpin
 103       integer usacmp
 104       integer nbenti
 105       integer tesupp(nbteto)
 106       integer hesupp(nbheto)
 107       integer pysupp(nbpyto)
 108       integer pesupp(nbpeto)
 109 c
 110       integer nbvote, voiste(*)
 111       integer nbvohe, voishe(*)
 112       integer nbvopy, voispy(*)
 113       integer nbvope, voispe(*)
 114 c
 115       integer ulsort, langue, codret
 116 c
 117       double precision eninin(nbenti,ncmpin), enindi(nbenti,ncmpin)
 118       double precision teinin(nbteto,ncmpin)
 119       double precision heinin(nbheto,ncmpin)
 120       double precision pyinin(nbpyto,ncmpin)
 121       double precision peinin(nbpeto,ncmpin)
 122       double precision valaux(ncmpin)
 123 c
 124 c 0.4. ==> variables locales
 125 c
 126       integer iaux
 127 c
 128       double precision vasmax
 129 c
 130       integer nbmess
 131       parameter (nbmess = 10 )
 132       character*80 texte(nblang,nbmess)
 133 c ______________________________________________________________________
 134 c
 135 c====
 136 c 1. initialisation
 137 c====
 138 c
 139 #include "impr01.h"
 140 #include "impr03.h"
 141 c
 142 #ifdef _DEBUG_HOMARD_
 143       write (ulsort,texte(langue,1)) 'Entree', nompro
 144       call dmflsh (iaux)
 145 #endif
 146 c
 147       texte(1,4) = '(''. Saut avec les '',i10,1x,a)'
 148 c
 149       texte(2,4) = '(''. Jump with the '',i10,1x,a)'
 150 c
 151       codret = 0
 152 c
 153 #ifdef _DEBUG_HOMARD_
 154       write (ulsort,90002) 'nbvote', nbvote
 155       write (ulsort,90002) 'nbvohe', nbvohe
 156       write (ulsort,90002) 'nbvopy', nbvopy
 157       write (ulsort,90002) 'nbvope', nbvope
 158 #endif
 159 c
 160       vasmax = vinfne
 161 c
 162 c====
 163 c 2. Saut avec des voisins tetraedres
 164 c====
 165 #ifdef _DEBUG_HOMARD_
 166       write (ulsort,*) '2. Saut avec tetraedres ; codret = ', codret
 167 #endif
 168 c
 169       if ( nbvote.gt.0 ) then
 170 c
 171         if ( codret.eq.0 ) then
 172 c
 173 #ifdef _DEBUG_HOMARD_
 174       write (ulsort,texte(langue,4)) nbvote, mess14(langue,3,3)
 175 #endif
 176 c
 177 #ifdef _DEBUG_HOMARD_
 178       write (ulsort,texte(langue,3)) 'DEISV4 / tetr', nompro
 179 #endif
 180         call deisv4 ( ncmpin, usacmp, vasmax,
 181      >                lamail, nbvote, voiste,
 182      >                nbenti, enindi, eninin,
 183      >                nbteto, tesupp, teinin,
 184      >                valaux,
 185      >                ulsort, langue, codret )
 186 c
 187         endif
 188 c
 189       endif
 190 c
 191 c====
 192 c 3. Saut avec des voisins hexaedres
 193 c====
 194 #ifdef _DEBUG_HOMARD_
 195       write (ulsort,*) '3. Saut avec hexaedres ; codret = ', codret
 196 #endif
 197 c
 198       if ( nbvohe.gt.0 ) then
 199 c
 200         if ( codret.eq.0 ) then
 201 c
 202 #ifdef _DEBUG_HOMARD_
 203       write (ulsort,texte(langue,4)) nbvohe, mess14(langue,3,6)
 204 #endif
 205 c
 206 #ifdef _DEBUG_HOMARD_
 207       write (ulsort,texte(langue,3)) 'DEISV4 / hexa', nompro
 208 #endif
 209         call deisv4 ( ncmpin, usacmp, vasmax,
 210      >                lamail, nbvohe, voishe,
 211      >                nbenti, enindi, eninin,
 212      >                nbheto, hesupp, heinin,
 213      >                valaux,
 214      >                ulsort, langue, codret )
 215 c
 216         endif
 217 c
 218       endif
 219 c
 220 c====
 221 c 4. Saut avec des voisins pyramides
 222 c====
 223 #ifdef _DEBUG_HOMARD_
 224       write (ulsort,*) '4. Saut avec pyramides ; codret = ', codret
 225 #endif
 226 c
 227       if ( nbvopy.gt.0 ) then
 228 c
 229         if ( codret.eq.0 ) then
 230 c
 231 #ifdef _DEBUG_HOMARD_
 232       write (ulsort,texte(langue,4)) nbvopy, mess14(langue,3,5)
 233 #endif
 234 c
 235 #ifdef _DEBUG_HOMARD_
 236       write (ulsort,texte(langue,3)) 'DEISV4 / pyra', nompro
 237 #endif
 238         call deisv4 ( ncmpin, usacmp, vasmax,
 239      >                lamail, nbvopy, voispy,
 240      >                nbenti, enindi, eninin,
 241      >                nbpyto, pysupp, pyinin,
 242      >                valaux,
 243      >                ulsort, langue, codret )
 244 c
 245         endif
 246 c
 247       endif
 248 c
 249 c====
 250 c 5. Saut avec des voisins pentaedres
 251 c====
 252 #ifdef _DEBUG_HOMARD_
 253       write (ulsort,*) '5. Saut avec pentaedres ; codret = ', codret
 254 #endif
 255 c
 256       if ( nbvope.gt.0 ) then
 257 c
 258         if ( codret.eq.0 ) then
 259 c
 260 #ifdef _DEBUG_HOMARD_
 261       write (ulsort,texte(langue,4)) nbvope, mess14(langue,3,7)
 262 #endif
 263 c
 264 #ifdef _DEBUG_HOMARD_
 265       write (ulsort,texte(langue,3)) 'DEISV4 / pent', nompro
 266 #endif
 267         call deisv4 ( ncmpin, usacmp, vasmax,
 268      >                lamail, nbvope, voispe,
 269      >                nbenti, enindi, eninin,
 270      >                nbpeto, pesupp, peinin,
 271      >                valaux,
 272      >                ulsort, langue, codret )
 273 c
 274         endif
 275 c
 276       endif
 277 c
 278 c====
 279 c 6. la fin
 280 c====
 281 c
 282       if ( codret.ne.0 ) then
 283 c
 284 #include "envex2.h"
 285 c
 286       write (ulsort,texte(langue,1)) 'Sortie', nompro
 287       write (ulsort,texte(langue,2)) codret
 288 c
 289       endif
 290 c
 291 #ifdef _DEBUG_HOMARD_
 292       write (ulsort,texte(langue,1)) 'Sortie', nompro
 293       call dmflsh (iaux)
 294 #endif
 295 c
 296       end