src/tool/ES_HOMARD/eslmh2.F

   1       subroutine eslmh2 ( idfmed,
   2      >                    nomail, lnomai,
   3      >                      sdim,   mdim,
   4      >                     degre, maconf, homolo, hierar,
   5      >                    rafdef, nbmane, typcca, typsfr, maextr,
   6      >                    mailet,
   7      >                    dimcst, lgnoig, nbnoco,
   8      >                    sdimca, mdimca,
   9      >                    exiren, lgpeli,
  10      >                    suifro, nomafr, lnomaf,
  11      >                    ulsort, langue, codret)
  12 c
  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  Entree-Sortie : Lecture du Maillage Homard - phase 2
  34 c  -      -        -          -        -              -
  35 c ______________________________________________________________________
  36 c .  nom   . e/s . taille .           description                      .
  37 c .____________________________________________________________________.
  38 c . idfmed . e   .   1    . identificateur du fichier MED              .
  39 c . nomail . e   . char*8 . nom du maillage a lire                     .
  40 c . lnomai . e   .   1    . longueur du nom du maillage                .
  41 c . sdim   .  s  .    1   . dimension de l'espace                      .
  42 c . mdim   .  s  .    1   . dimension du maillage                      .
  43 c . degre  .  s  .    1   . degre du maillage                          .
  44 c . maconf .  s  .    1   . conformite du maillage                     .
  45 c .        .     .        .  0 : oui                                   .
  46 c .        .     .        .  1 : non-conforme avec au minimum 2 aretes .
  47 c .        .     .        .      non decoupees en 2 par face           .
  48 c .        .     .        .  2 : non-conforme avec 1 seul noeud pendant.
  49 c .        .     .        .      par arete                             .
  50 c .        .     .        .  3 : non-conforme fidele a l'indicateur    .
  51 c .        .     .        . -1 : conforme, avec des boites pour les    .
  52 c .        .     .        .      quadrangles, hexaedres et pentaedres  .
  53 c .        .     .        . -2 : non-conforme avec au maximum 1 arete  .
  54 c .        .     .        .      decoupee en 2 et des boites pour les  .
  55 c .        .     .        .       quadrangles, hexaedres et pentaedres .
  56 c .        .     .        . 10 : non-conforme sans autre connaissance  .
  57 c . homolo .  s  .    1   . type de relations par homologues           .
  58 c .        .     .        . 0 : pas d'homologues                       .
  59 c .        .     .        . 1 : relations sur les noeuds               .
  60 c .        .     .        . 2 : relations sur les noeuds et les aretes .
  61 c .        .     .        . 3 : relations sur les noeuds, les aretes   .
  62 c .        .     .        .     et les triangles                       .
  63 c . hierar .  s  .    1   . maillage hierarchique                      .
  64 c .        .     .        . 0 : non                                    .
  65 c .        .     .        . 1 : oui                                    .
  66 c . rafdef .  s  .    1   . 0 : macro-maillage                         .
  67 c .        .     .        . 1 : le maillage est inchange               .
  68 c .        .     .        . 2 : le maillage est issu du raffinement pur.
  69 c .        .     .        .     d'un autre maillage                    .
  70 c .        .     .        . 3 : le maillage est issu du deraffinement  .
  71 c .        .     .        .     pur d'un autre maillage                .
  72 c .        .     .        . 4 : le maillage est issu de raffinement et .
  73 c .        .     .        .     de deraffinement d'un autre maillage   .
  74 c .        .     .        . 12 : le maillage est un maillage passe de  .
  75 c .        .     .        .      degre 1 a 2                           .
  76 c .        .     .        . 21 : le maillage est un maillage passe de  .
  77 c .        .     .        .      degre 2 a 1                           .
  78 c . nbmane .  s  .    1   . nombre maximum de noeuds par element       .
  79 c . typcca .  s  .   1    . type du code de calcul                     .
  80 c . typsfr .  s  .   1    . type du suivi de frontiere                 .
  81 c .        .     .        . 0 : aucun                                  .
  82 c .        .     .        . 1 : maillage de degre 1, avec projection   .
  83 c .        .     .        .     des nouveaux sommets                   .
  84 c .        .     .        . 2 : maillage de degre 2, seuls les noeuds  .
  85 c .        .     .        .     P1 sont sur la frontiere ; les noeuds  .
  86 c .        .     .        .     P2 restent au milieu des P1            .
  87 c .        .     .        . 3 : maillage de degre 2, les noeuds P2     .
  88 c .        .     .        .     etant sur la frontiere                 .
  89 c . maextr .  s  .   1    . maillage extrude                           .
  90 c .        .     .        . 0 : non                                    .
  91 c .        .     .        . 1 : selon X                                .
  92 c .        .     .        . 2 : selon Y                                .
  93 c .        .     .        . 3 : selon Z (cas de Saturne ou Neptune)    .
  94 c . mailet .  s  .    1   . presence de mailles etendues               .
  95 c .        .     .        .  1 : aucune                                .
  96 c .        .     .        . 2x : TRIA7                                 .
  97 c .        .     .        . 3x : QUAD9                                 .
  98 c .        .     .        . 5x : HEXA27                                .
  99 c . dimcst .  s  .   1    . 0, si toutes les coordonnees varient       .
 100 c .        .     .        . i, si la i-eme est constante et n'est pas  .
 101 c .        .     .        .    memorisee sur chaque noeud              .
 102 c . lgnoig .  s  .   1    . nombre de noeuds lies aux elements ignores .
 103 c . nbnoco .  s  .   1    . nbr noeuds pour la non-conformite initiale .
 104 c . sdimca .  s  .    1   . dimension de l'espace du maillage de calcul.
 105 c . mdimca .  s  .    1   . dimension du maillage du maillage de calcul.
 106 c . exiren .  s  .   1    . vrai/faux selon presence de renumerotations.
 107 c . lgpeli .  s  .   1    . longueur du profil des elements elimines   .
 108 c . suifro . e   .   1    . 1 : pas de suivi de frontiere              .
 109 c .        .     .        . 2x : frontiere discrete                    .
 110 c .        .     .        . 3x : frontiere analytique                  .
 111 c .        .     .        . 5x : frontiere cao                         .
 112 c . nomafr .  s  . char64 . nom du maillage MED de la frontiere        .
 113 c . lnomaf .  s  .   1    . longueur du nom du maillage de la frontiere.
 114 c .        .     .        . 0 : le maillage est absent du fichier      .
 115 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
 116 c . langue . e   .    1   . langue des messages                        .
 117 c .        .     .        . 1 : francais, 2 : anglais                  .
 118 c . codret . es  .    1   . code de retour des modules                 .
 119 c .        .     .        . 0 : pas de probleme                        .
 120 c ______________________________________________________________________
 121 c
 122 c====
 123 c 0. declarations et dimensionnement
 124 c====
 125 c
 126 c 0.1. ==> generalites
 127 c
 128       implicit none
 129       save
 130 c
 131       character*6 nompro
 132       parameter ( nompro = 'ESLMH2' )
 133 c
 134 #include "nblang.h"
 135 #include "consts.h"
 136 c
 137 c 0.2. ==> communs
 138 c
 139 #include "envex1.h"
 140 #include "front1.h"
 141 c
 142 c 0.3. ==> arguments
 143 c
 144       integer lnomai
 145       integer*8 idfmed
 146       integer   sdim,   mdim
 147       integer  degre, maconf, homolo, hierar
 148       integer rafdef, nbmane, typcca, typsfr, maextr
 149       integer mailet
 150       integer dimcst, lgnoig, nbnoco
 151       integer sdimca, mdimca
 152       integer lgpeli
 153       integer suifro
 154       integer lnomaf
 155 c
 156       character*64 nomail
 157       character*64 nomafr
 158 c
 159       logical exiren
 160 c
 161       integer ulsort, langue, codret
 162 c
 163 c 0.4. ==> variables locales
 164 c
 165 #include "meddc0.h"
 166 c
 167       integer iaux, jaux
 168       integer infmgl(30)
 169       integer nbprof
 170       integer nbvapr
 171 c
 172       logical exiigl
 173 c
 174       character*64 noprof
 175       character*64 nomam2
 176       integer typrep
 177 c
 178       character*16 nomaxe(3), uniaxe(3)
 179 c
 180       integer nbmess
 181       parameter ( nbmess = 150 )
 182       character*80 texte(nblang,nbmess)
 183 c ______________________________________________________________________
 184 c
 185 c====
 186 c 1. intialisations
 187 c====
 188 c
 189 #include "impr01.h"
 190 c
 191 #ifdef _DEBUG_HOMARD_
 192       write (ulsort,texte(langue,1)) 'Entree', nompro
 193       call dmflsh (iaux)
 194 #endif
 195 c
 196       texte(1,4) = '(''Aucun profil dans le fichier ?'')'
 197       texte(1,5) = '(''Les informations globales sont absentes.'')'
 198 c
 199       texte(2,5) = '(''No profile into the file?'')'
 200       texte(2,5) = '(''Global information are missing.'')'
 201 c
 202 #include "esimpr.h"
 203 c
 204 #include "impr03.h"
 205 c
 206 c====
 207 c 2. Le maillage est-il present dans le fichier ?
 208 c    si oui, on retourne les dimensions de l'espace et du maillage
 209 c====
 210 c
 211       if ( codret.eq.0 ) then
 212 c
 213 #ifdef _DEBUG_HOMARD_
 214       write (ulsort,texte(langue,3)) 'ESLNOM', nompro
 215 #endif
 216       call eslnom ( idfmed, nomail, lnomai,
 217      >                sdim,   mdim,
 218      >              typrep, nomaxe, uniaxe,
 219      >              ulsort, langue, codret )
 220       if ( codret.ne.0 ) then
 221         codret = 2
 222       endif
 223 c
 224       endif
 225 c
 226 #ifdef _DEBUG_HOMARD_
 227       if ( codret.eq.0 ) then
 228       write (ulsort,texte(langue,22)) nomail(1:lnomai)
 229       write (ulsort,texte(langue,23)) 'de l''espace', sdim
 230       write (ulsort,texte(langue,23)) 'du maillage', mdim
 231       endif
 232 #endif
 233 c
 234 c====
 235 c 3. Recuperation des parametres essentiels
 236 c====
 237 c 3.1. ==> Nombre de profils
 238 #ifdef _DEBUG_HOMARD_
 239       write (ulsort,90002) '3.1. Nombre de profils ; codret', codret
 240 #endif
 241 c
 242       if ( codret.eq.0 ) then
 243 c
 244 #ifdef _DEBUG_HOMARD_
 245       write (ulsort,texte(langue,3)) 'MPFNPF', nompro
 246 #endif
 247       call mpfnpf ( idfmed, nbprof, codret )
 248 #ifdef _DEBUG_HOMARD_
 249       write (ulsort,texte(langue,86)) nbprof
 250 #endif
 251 c
 252       endif
 253 c
 254       if ( codret.eq.0 ) then
 255 c
 256       if ( nbprof.eq.0 ) then
 257         write (ulsort,texte(langue,86)) nbprof
 258         write (ulsort,texte(langue,4))
 259         codret = 31
 260       endif
 261 c
 262       endif
 263 c
 264 c 3.2. ==> Parcours des profils
 265 #ifdef _DEBUG_HOMARD_
 266       write (ulsort,90002) '3.2. Parcours des profils ; codret', codret
 267 #endif
 268 c
 269       if ( codret.eq.0 ) then
 270 c
 271       exiigl = .false.
 272       exiren = .false.
 273       lgpeli = 0
 274 c
 275       do 32 , iaux = 1 , nbprof
 276 c
 277 c 3.2.1. ==> nom et taille du profil a lire
 278 c
 279         if ( codret.eq.0 ) then
 280 c
 281         jaux = iaux
 282 c
 283 #ifdef _DEBUG_HOMARD_
 284       write (ulsort,texte(langue,3)) 'MPFPFI', nompro
 285 #endif
 286         call mpfpfi ( idfmed, jaux, noprof, nbvapr, codret )
 287         if ( codret.ne.0 ) then
 288         write (ulsort,texte(langue,79))
 289         endif
 290 c
 291 #ifdef _DEBUG_HOMARD_
 292         write (ulsort,texte(langue,61)) noprof
 293         write (ulsort,texte(langue,62)) nbvapr
 294 #endif
 295 c
 296         endif
 297 c
 298 c 3.2.2. ==> Les profils que l'on cherche
 299 c
 300         if ( codret.eq.0 ) then
 301 c
 302 c 3.2.2.1 ==> Recuperation des parametres essentiels
 303 c
 304 c                             1234567890123456789012
 305         if ( noprof(1:22).eq.'Info_maillage_globales' ) then
 306 c
 307           if ( codret.eq.0 ) then
 308 c
 309 #ifdef _DEBUG_HOMARD_
 310           write (ulsort,texte(langue,3)) 'MPFPRR', nompro
 311 #endif
 312           call mpfprr ( idfmed, noprof, infmgl, codret )
 313 c
 314           if ( codret.ne.0 ) then
 315             write (ulsort,texte(langue,61)) noprof
 316             write (ulsort,texte(langue,79))
 317           endif
 318 c
 319           endif
 320 c
 321           if ( codret.eq.0 ) then
 322 c
 323           exiigl = .true.
 324 c
 325 c envca1 + divers
 326           degre  = infmgl( 3)
 327           maconf = infmgl( 4)
 328           homolo = infmgl( 5)
 329           hierar = infmgl( 6)
 330           rafdef = infmgl( 7)
 331           nbmane = infmgl( 8)
 332           typcca = infmgl( 9)
 333           typsfr = infmgl(10)
 334           maextr = infmgl(11)
 335           mailet = infmgl(12)
 336           dimcst = infmgl(13)
 337           lgnoig = infmgl(14)
 338           nbnoco = infmgl(15)
 339 c nbutil
 340           sdimca = infmgl(16)
 341           mdimca = infmgl(17)
 342 c
 343           endif
 344 c
 345 c 3.2.2.2. ==> Presence de renumerotation
 346 c
 347 c                                 1234567890123456789
 348         elseif ( noprof(1:19).eq.'Attributs_de_norenu' ) then
 349 c
 350           exiren = .true.
 351 c
 352 c 3.2.2.3. ==> Presence d'elements ignores
 353 c
 354 c                                 1234567890123456
 355         elseif ( noprof(1:16).eq.'Elements_Ignores' ) then
 356 c
 357           lgpeli = nbvapr
 358 c
 359         endif
 360 c
 361         endif
 362 c
 363    32 continue
 364 c
 365       endif
 366 c
 367 c 3.3. ==> controle
 368 #ifdef _DEBUG_HOMARD_
 369       write (ulsort,90002) '3.3. controle ; codret', codret
 370 #endif
 371 c
 372       if ( codret.eq.0 ) then
 373 c
 374       if ( .not.exiigl ) then
 375 c
 376       write (ulsort,texte(langue,5))
 377       codret = 33
 378 c
 379       endif
 380 c
 381       endif
 382 c
 383 #ifdef _DEBUG_HOMARD_
 384       write (ulsort,90002) 'lgpeli', lgpeli
 385 #endif
 386 c
 387 c====
 388 c 4. L'eventuelle frontiere discrete
 389 c    Le nom doit etre coherent avec esecfd
 390 c====
 391 #ifdef _DEBUG_HOMARD_
 392       write (ulsort,90002) '4. Frontiere discrete ; codret', codret
 393 #endif
 394 #ifdef _DEBUG_HOMARD_
 395       write (ulsort,90002) 'suifro', suifro
 396 #endif
 397 c
 398       if ( mod(suifro,2).eq.0 ) then
 399 c
 400 c 4.1. ==> Nom du maillage de la frontiere
 401 c
 402         if ( codret.eq.0 ) then
 403 c
 404         nomam2 = blan64
 405         nomam2(1:8) = 'AbsCurvi'
 406         iaux = 8
 407 c
 408 #ifdef _DEBUG_HOMARD_
 409       write (ulsort,texte(langue,3)) 'ESLNOF', nompro
 410 #endif
 411         call eslnof ( idfmed,
 412      >                nomail, lnomai,
 413      >                nomam2,   iaux,
 414      >                nomafr, lnomaf, sfsdim, sfmdim,
 415      >                typrep, nomaxe, uniaxe,
 416      >                ulsort, langue, codret )
 417         if ( codret.ne.0 ) then
 418           codret = 2
 419         endif
 420 c
 421 #ifdef _DEBUG_HOMARD_
 422       if ( codret.eq.0 ) then
 423       write (ulsort,texte(langue,22)) nomafr
 424       write (ulsort,texte(langue,23)) 'de l''espace', sfsdim
 425       write (ulsort,texte(langue,23)) 'du maillage', sfmdim
 426       endif
 427 #endif
 428 c
 429         endif
 430 c
 431 c 4.2. ==> Si le maillage de la frontiere existe :
 432 c
 433         if ( lnomaf.gt.0 ) then
 434 c
 435 c 4.2.1. ==> Nombre de noeuds du maillage de la frontiere
 436 c
 437           if ( codret.eq.0 ) then
 438 c
 439 #ifdef _DEBUG_HOMARD_
 440       write (ulsort,texte(langue,3)) 'ESLMMN-'//nomafr(1:lnomaf),nompro
 441 #endif
 442           call eslmmn ( idfmed, nomafr, lnomaf,
 443      >                  sfnbso,
 444      >                  ulsort, langue, codret )
 445 c
 446           endif
 447 c
 448 c 4.2.2. ==> Nombre de noeuds de la description
 449 c
 450           if ( codret.eq.0 ) then
 451 c
 452           iaux = 8
 453 #ifdef _DEBUG_HOMARD_
 454       write (ulsort,texte(langue,3)) 'ESLMMN-'//nomam2(1:iaux),nompro
 455 #endif
 456           call eslmmn ( idfmed, nomam2, iaux,
 457      >                  sfnbse,
 458      >                  ulsort, langue, codret )
 459 c
 460           endif
 461 c
 462         endif
 463 c
 464       else
 465 c
 466         sfsdim = 0
 467         sfmdim = 0
 468         sfnbso = 0
 469         sfnbse = 0
 470 c
 471       endif
 472 c
 473 #ifdef _DEBUG_HOMARD_
 474       write (ulsort,90002) 'sfsdim', sfsdim
 475       write (ulsort,90002) 'sfmdim', sfmdim
 476       write (ulsort,90002) 'sfnbso', sfnbso
 477       write (ulsort,90002) 'sfnbse', sfnbse
 478 #endif
 479 c
 480 c====
 481 c 5. la fin
 482 c====
 483 c
 484       if ( codret.ne.0 ) then
 485 c
 486 #include "envex2.h"
 487 c
 488       write (ulsort,texte(langue,1)) 'Sortie', nompro
 489       write (ulsort,texte(langue,2)) codret
 490 c
 491       endif
 492 c
 493 #ifdef _DEBUG_HOMARD_
 494       write (ulsort,texte(langue,1)) 'Sortie', nompro
 495       call dmflsh (iaux)
 496 #endif
 497 c
 498       end