src/tool/Utilitaire/utad99.F

   1       subroutine utad99 ( nomail,
   2      >                    phetar, psomar, pfilar, pmerar, adhoar,
   3      >                    phettr, paretr, pfiltr, ppertr, pnivtr,
   4      >                    adnmtr, adhotr,
   5      >                    phetqu, parequ, pfilqu, pperqu, pnivqu,
   6      >                    adnmqu, adhoqu,
   7      >                    phette, ptrite,
   8      >                    phethe, pquahe, pcoquh,
   9      >                    phetpy, pfacpy, pcofay,
  10      >                    phetpe, pfacpe, pcofap,
  11      >                    nhvois, nharet, nhtria, nhquad,
  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    UTilitaire - ADresses - phase 99
  34 c    --           --               --
  35 c ______________________________________________________________________
  36 c .        .     .        .                                            .
  37 c .  nom   . e/s . taille .           description                      .
  38 c .____________________________________________________________________.
  39 c . nomail . e   .  ch8   . nom de l'objet contenant le maillage       .
  40 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  41 c . langue . e   .    1   . langue des messages                        .
  42 c .        .     .        . 1 : francais, 2 : anglais                  .
  43 c . codret . es  .    1   . code de retour des modules                 .
  44 c .        .     .        . 0 : pas de probleme                        .
  45 c .        .     .        . 5 : mauvais type de code de calcul associe .
  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 = 'UTAD99' )
  59 c
  60 #include "nblang.h"
  61 c
  62 c 0.2. ==> communs
  63 c
  64 #include "envex1.h"
  65 c
  66 #include "envca1.h"
  67 #include "nombtr.h"
  68 #include "nombqu.h"
  69 #include "nombte.h"
  70 #include "nombhe.h"
  71 #include "nombpy.h"
  72 #include "nombpe.h"
  73 c
  74 c 0.3. ==> arguments
  75 c
  76       character*8 nomail
  77 c
  78       integer phetar, psomar, pfilar, pmerar, adhoar
  79       integer phettr, paretr, pfiltr, ppertr, pnivtr
  80       integer adnmtr, adhotr
  81       integer phetqu, parequ, pfilqu, pperqu, pnivqu
  82       integer adnmqu, adhoqu
  83       integer phette, ptrite
  84       integer phethe, pquahe, pcoquh
  85       integer phetpy, pfacpy, pcofay
  86       integer phetpe, pfacpe, pcofap
  87 c
  88       integer ulsort, langue, codret
  89 c
  90 c 0.4. ==> variables locales
  91 c
  92       integer iaux, jaux
  93 c
  94 c
  95       character*8 norenu
  96       character*8 nhnoeu, nhmapo, nharet, nhtria, nhquad
  97       character*8 nhtetr, nhhexa, nhpyra, nhpent
  98       character*8 nhelig
  99       character*8 nhvois, nhsupe, nhsups
 100 c
 101       integer nbmess
 102       parameter ( nbmess = 10 )
 103       character*80 texte(nblang,nbmess)
 104 c
 105 c 0.5. ==> initialisations
 106 c ______________________________________________________________________
 107 c
 108 c====
 109 c 1. messages
 110 c====
 111 c
 112 #include "impr01.h"
 113 c
 114 #ifdef _DEBUG_HOMARD_
 115       write (ulsort,texte(langue,1)) 'Entree', nompro
 116       call dmflsh (iaux)
 117 #endif
 118 c
 119 c====
 120 c 2. structure generale
 121 c====
 122 c
 123 #ifdef _DEBUG_HOMARD_
 124       write (ulsort,texte(langue,3)) 'UTNOMH', nompro
 125 #endif
 126       call utnomh ( nomail,
 127      >                sdim,   mdim,
 128      >               degre, maconf, homolo, hierar,
 129      >              rafdef, nbmane, typcca, typsfr, maextr,
 130      >              mailet,
 131      >              norenu,
 132      >              nhnoeu, nhmapo, nharet,
 133      >              nhtria, nhquad,
 134      >              nhtetr, nhhexa, nhpyra, nhpent,
 135      >              nhelig,
 136      >              nhvois, nhsupe, nhsups,
 137      >              ulsort, langue, codret)
 138 c
 139 c====
 140 c 3. tableaux
 141 c====
 142 #ifdef _DEBUG_HOMARD_
 143       write (ulsort,*) '3. tableaux ; codret = ', codret
 144 #endif
 145 c
 146       if ( codret.eq.0 ) then
 147 c
 148       iaux = 30
 149       if ( homolo.ge.2 ) then
 150         iaux = iaux*29
 151       endif
 152 #ifdef _DEBUG_HOMARD_
 153       write (ulsort,texte(langue,3)) 'UTAD02_ar', nompro
 154 #endif
 155       call utad02 (   iaux, nharet,
 156      >              phetar, psomar, pfilar, pmerar,
 157      >                jaux,   jaux,   jaux,
 158      >                jaux,   jaux,   jaux,
 159      >                jaux, adhoar,   jaux,
 160      >              ulsort, langue, codret )
 161 c
 162       if ( nbtrto.ne.0 ) then
 163 c
 164         iaux = 330
 165         if ( mod(mailet,2).eq.0 ) then
 166           iaux = iaux*19
 167         endif
 168         if ( homolo.ge.3 ) then
 169           iaux = iaux*29
 170         endif
 171 #ifdef _DEBUG_HOMARD_
 172       write (ulsort,texte(langue,3)) 'UTAD02_tr', nompro
 173 #endif
 174         call utad02 (   iaux, nhtria,
 175      >                phettr, paretr, pfiltr, ppertr,
 176      >                  jaux,   jaux,   jaux,
 177      >                pnivtr,   jaux,   jaux,
 178      >                adnmtr, adhotr,   jaux,
 179      >                ulsort, langue, codret )
 180 c
 181       endif
 182 c
 183       if ( nbquto.ne.0 ) then
 184 c
 185         iaux = 330
 186         if ( mod(mailet,3).eq.0 ) then
 187           iaux = iaux*19
 188         endif
 189         if ( homolo.ge.3 ) then
 190           iaux = iaux*29
 191         endif
 192 #ifdef _DEBUG_HOMARD_
 193       write (ulsort,texte(langue,3)) 'UTAD02_qu', nompro
 194 #endif
 195         call utad02 (   iaux, nhquad,
 196      >                phetqu, parequ, pfilqu, pperqu,
 197      >                  jaux,   jaux,   jaux,
 198      >                pnivqu,   jaux,   jaux,
 199      >                adnmqu, adhoqu,   jaux,
 200      >                ulsort, langue, codret )
 201 c
 202       endif
 203 c
 204       if ( nbteto.ne.0 ) then
 205 c
 206 #ifdef _DEBUG_HOMARD_
 207       write (ulsort,texte(langue,3)) 'UTAD02_te', nompro
 208 #endif
 209         iaux = 2
 210         call utad02 (   iaux, nhtetr,
 211      >                phette, ptrite, jaux  , jaux,
 212      >                  jaux,   jaux,   jaux,
 213      >                  jaux,   jaux,   jaux,
 214      >                  jaux,   jaux,   jaux,
 215      >                ulsort, langue, codret )
 216 c
 217       endif
 218 c
 219       if ( nbheto.ne.0 ) then
 220 c
 221 #ifdef _DEBUG_HOMARD_
 222       write (ulsort,texte(langue,3)) 'UTAD02_he', nompro
 223 #endif
 224         iaux = 26
 225         call utad02 (   iaux, nhhexa,
 226      >                phethe, pquahe, jaux  , jaux,
 227      >                  jaux,   jaux,   jaux,
 228      >                  jaux, pcoquh,   jaux,
 229      >                  jaux,   jaux,   jaux,
 230      >                ulsort, langue, codret )
 231 c
 232       endif
 233 c
 234       if ( nbpyto.ne.0 ) then
 235 c
 236 #ifdef _DEBUG_HOMARD_
 237       write (ulsort,texte(langue,3)) 'UTAD02_py', nompro
 238 #endif
 239         iaux = 26
 240         call utad02 (   iaux, nhpyra,
 241      >                phetpy, pfacpy, jaux  , jaux,
 242      >                  jaux,   jaux,   jaux,
 243      >                  jaux, pcofay,   jaux,
 244      >                  jaux,   jaux,   jaux,
 245      >                ulsort, langue, codret )
 246 c
 247       endif
 248 c
 249       if ( nbpeto.ne.0 ) then
 250 c
 251 #ifdef _DEBUG_HOMARD_
 252       write (ulsort,texte(langue,3)) 'UTAD02_pe', nompro
 253 #endif
 254         iaux = 26
 255         call utad02 (   iaux, nhpent,
 256      >                phetpe, pfacpe, jaux  , jaux,
 257      >                  jaux,   jaux,   jaux,
 258      >                  jaux, pcofap,   jaux,
 259      >                  jaux,   jaux,   jaux,
 260      >                ulsort, langue, codret )
 261 c
 262       endif
 263 c
 264       endif
 265 c
 266 c====
 267 c 4. la fin
 268 c====
 269 c
 270       if ( codret.ne.0 ) then
 271 c
 272 #include "envex2.h"
 273 c
 274       write (ulsort,texte(langue,1)) 'Sortie', nompro
 275       write (ulsort,texte(langue,2)) codret
 276 c
 277       endif
 278 c
 279 #ifdef _DEBUG_HOMARD_
 280       write (ulsort,texte(langue,1)) 'Sortie', nompro
 281       call dmflsh (iaux)
 282 #endif
 283 c
 284       end