src/tool/Utilitaire/utinma.F

   1       subroutine utinma ( option, saux,
   2      >                      sdim,   mdim,  degre,
   3      >                    nbnoto, nbnop1, nbnop2, nbnoim,
   4      >                    nbnois, nbnomp,
   5      >                    nbnoei, nbmail,
   6      >                    nbmapo, nbsegm, nbtria, nbquad,
   7      >                    nbtetr, nbhexa, nbpyra, nbpent,
   8      >                    nbelig,
   9      >                    nbmane, nbmaae, nbmafe,
  10      >                    ulsort, langue, codret )
  11 c ______________________________________________________________________
  12 c
  13 c                             H O M A R D
  14 c
  15 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  16 c
  17 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  18 c aupres des huissiers de justice Simart et Lavoir a Clamart
  19 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  20 c aupres des huissiers de justice
  21 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  22 c
  23 c    HOMARD est une marque deposee d'Electricite de France
  24 c
  25 c Copyright EDF 1996
  26 c Copyright EDF 1998
  27 c Copyright EDF 2002
  28 c Copyright EDF 2020
  29 c ______________________________________________________________________
  30 c    UTilitaire - INformation sur le MAillage
  31 c    --           --                 --
  32 c ______________________________________________________________________
  33 c .        .     .        .                                            .
  34 c .  nom   . e/s . taille .           description                      .
  35 c .____________________________________________________________________.
  36 c . option .  e  .    1   . option d'impressions                       .
  37 c .        .     .        . 0 : tout                                   .
  38 c .        .     .        . 1 : le minimum                             .
  39 c . saux   .  e  .   *    . texte complementaire                       .
  40 c . sdim   .  e  .   1    . dimension de l'espace                      .
  41 c . mdim   .  e  .   1    . dimension du maillage                      .
  42 c . degre  .  e  .   1    . degre du maillage                          .
  43 c . nbnoto .  e  .   1    . nombre total de noeuds du maillage         .
  44 c . nbnop1 .  e  .   1    . nombre de sommets du maillage (noeuds p1)  .
  45 c . nbnop2 .  e  .   1    . nombre de noeuds milieux d'aretes du       .
  46 c .        .     .        .  maillage (noeuds p2)                      .
  47 c . nbnoim .  e  .   1    . nombre de noeuds internes aux mailles      .
  48 c . nbnois .  e  .   1    . nombre de noeuds isoles                    .
  49 c . nbnomp .  e  .   1    . nombre de noeuds support de maille-point   .
  50 c .        .     .        . uniquement                                 .
  51 c . nbnoei .  e  .   1    . nombre de noeuds d'elements ignores        .
  52 c . nbmail .  e  .   1    . nombre de mailles dans le maillage         .
  53 c . nbmapo .  e  .   1    . nombre de mailles-points dans le maillage  .
  54 c . nbsegm .  e  .   1    . nombre de segments dans le maillage        .
  55 c . nbtria .  e  .   1    . nombre de triangles dans le maillage       .
  56 c . nbtetr .  e  .   1    . nombre de tetraedres dans le maillage      .
  57 c . nbquad .  e  .   1    . nombre de quadrangles dans le maillage     .
  58 c . nbhexa .  e  .   1    . nombre d'hexaedres dans le maillage        .
  59 c . nbpent .  e  .   1    . nombre de pentaedres dans le maillage      .
  60 c . nbpyra .  e  .   1    . nombre de pyramides dans le maillage       .
  61 c . nbelig .  e  .   1    . nombre de mailles ignorees                 .
  62 c . nbmane .  e  .   1    . nombre maximum de noeuds par element       .
  63 c . nbmaae .  e  .   1    . nombre maximum d'aretes par element        .
  64 c . nbmafe .  e  .   1    . nombre maximum de faces par element        .
  65 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  66 c . langue . e   .    1   . langue des messages                        .
  67 c .        .     .        . 1 : francais, 2 : anglais                  .
  68 c . codret . es  .    1   . code de retour des modules                 .
  69 c .        .     .        . 0 : pas de probleme                        .
  70 c .        .     .        . 1 : probleme                               .
  71 c ______________________________________________________________________
  72 c
  73 c====
  74 c 0. declarations et dimensionnement
  75 c====
  76 c
  77 c 0.1. ==> generalites
  78 c
  79       implicit none
  80       save
  81 c
  82       character*6 nompro
  83       parameter ( nompro = 'UTINMA' )
  84 c
  85 #include "nblang.h"
  86 c
  87 c 0.2. ==> communs
  88 c
  89 #include "envex1.h"
  90 #include "impr02.h"
  91 c
  92 c 0.3. ==> arguments
  93 c
  94       integer option
  95       integer sdim, mdim, degre
  96       integer nbnoto, nbnop1, nbnop2, nbnoim
  97       integer nbnois, nbnomp
  98       integer nbnoei
  99       integer nbmail
 100       integer nbmapo, nbsegm, nbtria, nbquad
 101       integer nbtetr, nbhexa, nbpyra, nbpent
 102       integer nbelig
 103       integer nbmane, nbmaae, nbmafe
 104 c
 105       character*(*) saux
 106 c
 107       integer ulsort, langue, codret
 108 c
 109 c 0.4. ==> variables locales
 110 c
 111       integer iaux
 112 c
 113       integer nbmess
 114       parameter ( nbmess = 40 )
 115       character*80 texte(nblang,nbmess)
 116 c
 117 c 0.5. ==> initialisations
 118 c ______________________________________________________________________
 119 c
 120 c====
 121 c 1. messages
 122 c====
 123 c
 124 #include "impr01.h"
 125 c
 126 #ifdef _DEBUG_HOMARD_
 127       write (ulsort,texte(langue,1)) 'Entree', nompro
 128       call dmflsh (iaux)
 129 #endif
 130 c
 131       texte(1,4) =
 132      > '(5x,''Caracteristiques du maillage '',a,/)'
 133       texte(1,5) =
 134      > '(8x,''Degre                                         :'',i11)'
 135       texte(1,6) =
 136      > '(8x,''Dimension de l''''espace                         :'',i11)'
 137       texte(1,7) =
 138      > '(8x,''Dimension du maillage                         :'',i11)'
 139       texte(1,11) =
 140      > '(8x,''Nombre de noeuds                              :'',i11)'
 141       texte(1,12) =
 142      > '(8x,''. dont noeuds isoles                          :'',i11)'
 143       texte(1,13) =
 144      > '(8x,''. dont noeuds maille-point uniquement         :'',i11)'
 145       texte(1,14) =
 146      > '(8x,''. dont noeuds sommets                         :'',i11)'
 147       texte(1,15) =
 148      > '(8x,''. dont noeuds milieux                         :'',i11)'
 149       texte(1,16) =
 150      > '(8x,''. dont noeuds internes aux mailles            :'',i11)'
 151       texte(1,21) =
 152      > '(8x,''Nombre de mailles                             :'',i11)'
 153       texte(1,22) =
 154      > '(8x,''. Mailles'',i2,''D'',34x,'':'',i11)'
 155       texte(1,23) =
 156      > '(8x,''. '',a14,30x,'':'',i11)'
 157       texte(1,24) =
 158      > '(10x,''. '',a14,28x,'':'',i11)'
 159       texte(1,31) =
 160      > '(8x,''Nombre maximum de faces par maille            :'',i11)'
 161       texte(1,32) =
 162      > '(8x,''Nombre maximum d''''aretes par maille            :'',i11)'
 163       texte(1,33) =
 164      > '(8x,''Nombre maximum de noeuds par maille           :'',i11)'
 165       texte(1,39) =
 166      > '(8x,''. dont noeuds de mailles ignorees uniquement  :'',i11)'
 167       texte(1,40) =
 168      > '(8x,''. Elimination de'',i11,1x,a14)'
 169 c
 170       texte(2,4) =
 171      > '(5x,''Characteristics of the mesh '',a,/)'
 172       texte(2,5) =
 173      > '(8x,''Degree                                        :'',i11)'
 174       texte(2,6) =
 175      > '(8x,''Dimension of the space                        :'',i11)'
 176       texte(2,7) =
 177      > '(8x,''Dimension of the mesh                         :'',i11)'
 178       texte(2,11) =
 179      > '(8x,''Number of nodes                               :'',i11)'
 180       texte(2,12) =
 181      > '(8x,''. included isolated nodes                     :'',i11)'
 182       texte(2,13) =
 183      > '(8x,''. included only mesh-point nodes              :'',i11)'
 184       texte(2,14) =
 185      > '(8x,''. included nodes vertices                     :'',i11)'
 186       texte(2,15) =
 187      > '(8x,''. included nodes center of edges              :'',i11)'
 188       texte(2,16) =
 189      > '(8x,''. included internal nodes                     :'',i11)'
 190       texte(2,21) =
 191      > '(8x,''Number of meshes                              :'',i11)'
 192       texte(2,22) =
 193      > '(8x,''.'',i2,''D meshes'',35x,'':'',i11)'
 194       texte(2,23) =
 195      > '(8x,''. '',a14,30x,'':'',i11)'
 196       texte(2,24) =
 197      > '(10x,''. '',a14,28x,'':'',i11)'
 198       texte(2,31) =
 199      > '(8x,''Maximum number of faces per mesh              :'',i11)'
 200       texte(2,32) =
 201      > '(8x,''Maximum number of edges per mesh              :'',i11)'
 202       texte(2,33) =
 203      > '(8x,''Maximum number of nodes per mesh              :'',i11)'
 204       texte(2,39) =
 205      > '(8x,''. included only ignored meshes nodes          :'',i11)'
 206       texte(2,40) =
 207      > '(8x,''. Elimination of'',i11,1x,a14)'
 208 c
 209 #include "impr03.h"
 210 c
 211       codret = 0
 212 c
 213 c====
 214 c 2. impression
 215 c====
 216 c
 217 #ifdef _DEBUG_HOMARD_
 218       write (ulsort,90002) '2. impression ; codret', codret
 219       call dmflsh(iaux)
 220 #endif
 221 c
 222       if ( codret.eq.0 ) then
 223 c
 224       write(ulsort,texte(langue,4)) saux
 225       write(ulsort,texte(langue,6)) sdim
 226       write(ulsort,texte(langue,7)) mdim
 227       write(ulsort,texte(langue,5)) degre
 228 c
 229 c 2.1. ==> Les noeuds
 230 c
 231       write(ulsort,texte(langue,11)) nbnoto
 232 c
 233       if ( option.eq.0 ) then
 234 c
 235         if ( nbnois.ne.0 ) then
 236           write(ulsort,texte(langue,12)) nbnois
 237         endif
 238         if ( nbnomp.ne.0 ) then
 239           write(ulsort,texte(langue,13)) nbnomp
 240         endif
 241         write(ulsort,texte(langue,14)) nbnop1
 242         if ( nbnop2.ne.0 ) then
 243           write(ulsort,texte(langue,15)) nbnop2
 244         endif
 245         if ( nbnoim.ne.0 ) then
 246           write(ulsort,texte(langue,16)) nbnoim
 247         endif
 248         if ( nbnoei.ne.0 ) then
 249           write(ulsort,texte(langue,39)) nbnoei
 250         endif
 251 c
 252       endif
 253 c
 254 c 2.2. ==> Les mailles
 255 c
 256       write(ulsort,texte(langue,21)) nbmail
 257 c
 258 c 2.2.1. ==> 0D
 259 c
 260       if ( nbmapo.ne.0 ) then
 261         write(ulsort,texte(langue,23)) mess14(langue,4,0), nbmapo
 262       endif
 263 c
 264 c 2.2.2. ==> 1D
 265 c
 266       if ( nbsegm.ne.0 ) then
 267         write(ulsort,texte(langue,23)) mess14(langue,4,1), nbsegm
 268       endif
 269 c
 270 c 2.2.3. ==> 2D
 271 c
 272       iaux = nbtria + nbquad
 273 c
 274       if ( iaux.eq.nbtria .or. iaux.eq.nbquad ) then
 275 c
 276         if ( nbtria.ne.0 ) then
 277           write(ulsort,texte(langue,23)) mess14(langue,4,2), nbtria
 278         endif
 279         if ( nbquad.ne.0 ) then
 280           write(ulsort,texte(langue,23)) mess14(langue,4,4), nbquad
 281         endif
 282 c
 283       else
 284 c
 285         write(ulsort,texte(langue,22)) 2, iaux
 286         write(ulsort,texte(langue,24)) mess14(langue,3,2), nbtria
 287         write(ulsort,texte(langue,24)) mess14(langue,3,4), nbquad
 288 c
 289       endif
 290 c
 291 c 2.2.4. ==> 3D
 292 c
 293       iaux = nbtetr + nbhexa + nbpyra + nbpent
 294 c
 295       if ( iaux.eq.nbtetr .or. iaux.eq.nbhexa .or.
 296      >     iaux.eq.nbpyra .or. iaux.eq.nbpent ) then
 297 c
 298         if ( nbtetr.ne.0 ) then
 299           write(ulsort,texte(langue,23)) mess14(langue,4,3), nbtetr
 300         endif
 301         if ( nbhexa.ne.0 ) then
 302           write(ulsort,texte(langue,23)) mess14(langue,4,6), nbhexa
 303         endif
 304         if ( nbpyra.ne.0 ) then
 305           write(ulsort,texte(langue,23)) mess14(langue,4,5), nbpyra
 306         endif
 307         if ( nbpent.ne.0 ) then
 308           write(ulsort,texte(langue,23)) mess14(langue,4,7), nbpent
 309         endif
 310 c
 311       else
 312 c
 313         write(ulsort,texte(langue,22)) 3, iaux
 314         if ( nbtetr.ne.0 ) then
 315           write(ulsort,texte(langue,24)) mess14(langue,3,3), nbtetr
 316         endif
 317         if ( nbhexa.ne.0 ) then
 318           write(ulsort,texte(langue,24)) mess14(langue,3,6), nbhexa
 319         endif
 320         if ( nbpyra.ne.0 ) then
 321           write(ulsort,texte(langue,24)) mess14(langue,3,5), nbpyra
 322         endif
 323         if ( nbpent.ne.0 ) then
 324           write(ulsort,texte(langue,24)) mess14(langue,3,7), nbpent
 325         endif
 326 c
 327       endif
 328 c
 329 c 2.2.5. ==> Caracteristiques des mailles
 330 c
 331       if ( option.eq.0 ) then
 332 c
 333 #ifdef _DEBUG_HOMARD_
 334         if ( nbmafe.ge.0 ) then
 335 #else
 336         if ( nbmafe.gt.0 ) then
 337 #endif
 338           write(ulsort,texte(langue,31)) nbmafe
 339         endif
 340         write(ulsort,texte(langue,32)) nbmaae
 341         write(ulsort,texte(langue,33)) nbmane
 342 c
 343       endif
 344 c
 345 c 2.2.6. ==> Mailles eliminees
 346 c
 347       if ( option.eq.0 ) then
 348 c
 349 #ifdef _DEBUG_HOMARD_
 350         if ( nbelig.ne.0 ) then
 351           write(ulsort,texte(langue,40)) nbelig, mess14(langue,3,5)
 352         endif
 353 #endif
 354 c
 355       endif
 356 c
 357       endif
 358 c
 359 c====
 360 c 3. la fin
 361 c====
 362 c
 363       if ( codret.ne.0 ) then
 364 c
 365 #include "envex2.h"
 366 c
 367       write (ulsort,texte(langue,1)) 'Sortie', nompro
 368       write (ulsort,texte(langue,2)) codret
 369 c
 370       endif
 371 c
 372 #ifdef _DEBUG_HOMARD_
 373       write (ulsort,texte(langue,1)) 'Sortie', nompro
 374       call dmflsh (iaux)
 375 #endif
 376 c
 377       end