--- /dev/null
+ subroutine eslmh2 ( idfmed,
+ > nomail, lnomai,
+ > sdim, mdim,
+ > degre, maconf, homolo, hierar,
+ > rafdef, nbmane, typcca, typsfr, maextr,
+ > mailet,
+ > dimcst, lgnoig, nbnoco,
+ > sdimca, mdimca,
+ > exiren, lgpeli,
+ > suifro, nomafr, lnomaf,
+ > ulsort, langue, codret)
+c
+c ______________________________________________________________________
+c
+c H O M A R D
+c
+c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
+c
+c Version originale enregistree le 18 juin 1996 sous le numero 96036
+c aupres des huissiers de justice Simart et Lavoir a Clamart
+c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
+c aupres des huissiers de justice
+c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
+c
+c HOMARD est une marque deposee d'Electricite de France
+c
+c Copyright EDF 1996
+c Copyright EDF 1998
+c Copyright EDF 2002
+c Copyright EDF 2020
+c ______________________________________________________________________
+c
+c Entree-Sortie : Lecture du Maillage Homard - phase 2
+c - - - - - -
+c ______________________________________________________________________
+c . nom . e/s . taille . description .
+c .____________________________________________________________________.
+c . idfmed . e . 1 . identificateur du fichier MED .
+c . nomail . e . char*8 . nom du maillage a lire .
+c . lnomai . e . 1 . longueur du nom du maillage .
+c . sdim . s . 1 . dimension de l'espace .
+c . mdim . s . 1 . dimension du maillage .
+c . degre . s . 1 . degre du maillage .
+c . maconf . s . 1 . conformite du maillage .
+c . . . . 0 : oui .
+c . . . . 1 : non-conforme avec au minimum 2 aretes .
+c . . . . non decoupees en 2 par face .
+c . . . . 2 : non-conforme avec 1 seul noeud pendant.
+c . . . . par arete .
+c . . . . 3 : non-conforme fidele a l'indicateur .
+c . . . . -1 : conforme, avec des boites pour les .
+c . . . . quadrangles, hexaedres et pentaedres .
+c . . . . -2 : non-conforme avec au maximum 1 arete .
+c . . . . decoupee en 2 et des boites pour les .
+c . . . . quadrangles, hexaedres et pentaedres .
+c . . . . 10 : non-conforme sans autre connaissance .
+c . homolo . s . 1 . type de relations par homologues .
+c . . . . 0 : pas d'homologues .
+c . . . . 1 : relations sur les noeuds .
+c . . . . 2 : relations sur les noeuds et les aretes .
+c . . . . 3 : relations sur les noeuds, les aretes .
+c . . . . et les triangles .
+c . hierar . s . 1 . maillage hierarchique .
+c . . . . 0 : non .
+c . . . . 1 : oui .
+c . rafdef . s . 1 . 0 : macro-maillage .
+c . . . . 1 : le maillage est inchange .
+c . . . . 2 : le maillage est issu du raffinement pur.
+c . . . . d'un autre maillage .
+c . . . . 3 : le maillage est issu du deraffinement .
+c . . . . pur d'un autre maillage .
+c . . . . 4 : le maillage est issu de raffinement et .
+c . . . . de deraffinement d'un autre maillage .
+c . . . . 12 : le maillage est un maillage passe de .
+c . . . . degre 1 a 2 .
+c . . . . 21 : le maillage est un maillage passe de .
+c . . . . degre 2 a 1 .
+c . nbmane . s . 1 . nombre maximum de noeuds par element .
+c . typcca . s . 1 . type du code de calcul .
+c . typsfr . s . 1 . type du suivi de frontiere .
+c . . . . 0 : aucun .
+c . . . . 1 : maillage de degre 1, avec projection .
+c . . . . des nouveaux sommets .
+c . . . . 2 : maillage de degre 2, seuls les noeuds .
+c . . . . P1 sont sur la frontiere ; les noeuds .
+c . . . . P2 restent au milieu des P1 .
+c . . . . 3 : maillage de degre 2, les noeuds P2 .
+c . . . . etant sur la frontiere .
+c . maextr . s . 1 . maillage extrude .
+c . . . . 0 : non .
+c . . . . 1 : selon X .
+c . . . . 2 : selon Y .
+c . . . . 3 : selon Z (cas de Saturne ou Neptune) .
+c . mailet . s . 1 . presence de mailles etendues .
+c . . . . 1 : aucune .
+c . . . . 2x : TRIA7 .
+c . . . . 3x : QUAD9 .
+c . . . . 5x : HEXA27 .
+c . dimcst . s . 1 . 0, si toutes les coordonnees varient .
+c . . . . i, si la i-eme est constante et n'est pas .
+c . . . . memorisee sur chaque noeud .
+c . lgnoig . s . 1 . nombre de noeuds lies aux elements ignores .
+c . nbnoco . s . 1 . nbr noeuds pour la non-conformite initiale .
+c . sdimca . s . 1 . dimension de l'espace du maillage de calcul.
+c . mdimca . s . 1 . dimension du maillage du maillage de calcul.
+c . exiren . s . 1 . vrai/faux selon presence de renumerotations.
+c . lgpeli . s . 1 . longueur du profil des elements elimines .
+c . suifro . e . 1 . 1 : pas de suivi de frontiere .
+c . . . . 2x : frontiere discrete .
+c . . . . 3x : frontiere analytique .
+c . . . . 5x : frontiere cao .
+c . nomafr . s . char64 . nom du maillage MED de la frontiere .
+c . lnomaf . s . 1 . longueur du nom du maillage de la frontiere.
+c . . . . 0 : le maillage est absent du fichier .
+c . ulsort . e . 1 . numero d'unite logique de la liste standard.
+c . langue . e . 1 . langue des messages .
+c . . . . 1 : francais, 2 : anglais .
+c . codret . es . 1 . code de retour des modules .
+c . . . . 0 : pas de probleme .
+c ______________________________________________________________________
+c
+c====
+c 0. declarations et dimensionnement
+c====
+c
+c 0.1. ==> generalites
+c
+ implicit none
+ save
+c
+ character*6 nompro
+ parameter ( nompro = 'ESLMH2' )
+c
+#include "nblang.h"
+#include "consts.h"
+c
+c 0.2. ==> communs
+c
+#include "envex1.h"
+#include "front1.h"
+c
+c 0.3. ==> arguments
+c
+ integer lnomai
+ integer*8 idfmed
+ integer sdim, mdim
+ integer degre, maconf, homolo, hierar
+ integer rafdef, nbmane, typcca, typsfr, maextr
+ integer mailet
+ integer dimcst, lgnoig, nbnoco
+ integer sdimca, mdimca
+ integer lgpeli
+ integer suifro
+ integer lnomaf
+c
+ character*64 nomail
+ character*64 nomafr
+c
+ logical exiren
+c
+ integer ulsort, langue, codret
+c
+c 0.4. ==> variables locales
+c
+#include "meddc0.h"
+c
+ integer iaux, jaux
+ integer infmgl(30)
+ integer nbprof
+ integer nbvapr
+c
+ logical exiigl
+c
+ character*64 noprof
+ character*64 nomam2
+ integer typrep
+c
+ character*16 nomaxe(3), uniaxe(3)
+c
+ integer nbmess
+ parameter ( nbmess = 150 )
+ character*80 texte(nblang,nbmess)
+c ______________________________________________________________________
+c
+c====
+c 1. intialisations
+c====
+c
+#include "impr01.h"
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,1)) 'Entree', nompro
+ call dmflsh (iaux)
+#endif
+c
+ texte(1,4) = '(''Aucun profil dans le fichier ?'')'
+ texte(1,5) = '(''Les informations globales sont absentes.'')'
+c
+ texte(2,5) = '(''No profile into the file?'')'
+ texte(2,5) = '(''Global information are missing.'')'
+c
+#include "esimpr.h"
+c
+#include "impr03.h"
+c
+c====
+c 2. Le maillage est-il present dans le fichier ?
+c si oui, on retourne les dimensions de l'espace et du maillage
+c====
+c
+ if ( codret.eq.0 ) then
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,3)) 'ESLNOM', nompro
+#endif
+ call eslnom ( idfmed, nomail, lnomai,
+ > sdim, mdim,
+ > typrep, nomaxe, uniaxe,
+ > ulsort, langue, codret )
+ if ( codret.ne.0 ) then
+ codret = 2
+ endif
+c
+ endif
+c
+#ifdef _DEBUG_HOMARD_
+ if ( codret.eq.0 ) then
+ write (ulsort,texte(langue,22)) nomail(1:lnomai)
+ write (ulsort,texte(langue,23)) 'de l''espace', sdim
+ write (ulsort,texte(langue,23)) 'du maillage', mdim
+ endif
+#endif
+c
+c====
+c 3. Recuperation des parametres essentiels
+c====
+c 3.1. ==> Nombre de profils
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,90002) '3.1. Nombre de profils ; codret', codret
+#endif
+c
+ if ( codret.eq.0 ) then
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,3)) 'MPFNPF', nompro
+#endif
+ call mpfnpf ( idfmed, nbprof, codret )
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,86)) nbprof
+#endif
+c
+ endif
+c
+ if ( codret.eq.0 ) then
+c
+ if ( nbprof.eq.0 ) then
+ write (ulsort,texte(langue,86)) nbprof
+ write (ulsort,texte(langue,4))
+ codret = 31
+ endif
+c
+ endif
+c
+c 3.2. ==> Parcours des profils
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,90002) '3.2. Parcours des profils ; codret', codret
+#endif
+c
+ if ( codret.eq.0 ) then
+c
+ exiigl = .false.
+ exiren = .false.
+ lgpeli = 0
+c
+ do 32 , iaux = 1 , nbprof
+c
+c 3.2.1. ==> nom et taille du profil a lire
+c
+ if ( codret.eq.0 ) then
+c
+ jaux = iaux
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,3)) 'MPFPFI', nompro
+#endif
+ call mpfpfi ( idfmed, jaux, noprof, nbvapr, codret )
+ if ( codret.ne.0 ) then
+ write (ulsort,texte(langue,79))
+ endif
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,61)) noprof
+ write (ulsort,texte(langue,62)) nbvapr
+#endif
+c
+ endif
+c
+c 3.2.2. ==> Les profils que l'on cherche
+c
+ if ( codret.eq.0 ) then
+c
+c 3.2.2.1 ==> Recuperation des parametres essentiels
+c
+c 1234567890123456789012
+ if ( noprof(1:22).eq.'Info_maillage_globales' ) then
+c
+ if ( codret.eq.0 ) then
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,3)) 'MPFPRR', nompro
+#endif
+ call mpfprr ( idfmed, noprof, infmgl, codret )
+c
+ if ( codret.ne.0 ) then
+ write (ulsort,texte(langue,61)) noprof
+ write (ulsort,texte(langue,79))
+ endif
+c
+ endif
+c
+ if ( codret.eq.0 ) then
+c
+ exiigl = .true.
+c
+c envca1 + divers
+ degre = infmgl( 3)
+ maconf = infmgl( 4)
+ homolo = infmgl( 5)
+ hierar = infmgl( 6)
+ rafdef = infmgl( 7)
+ nbmane = infmgl( 8)
+ typcca = infmgl( 9)
+ typsfr = infmgl(10)
+ maextr = infmgl(11)
+ mailet = infmgl(12)
+ dimcst = infmgl(13)
+ lgnoig = infmgl(14)
+ nbnoco = infmgl(15)
+c nbutil
+ sdimca = infmgl(16)
+ mdimca = infmgl(17)
+c
+ endif
+c
+c 3.2.2.2. ==> Presence de renumerotation
+c
+c 1234567890123456789
+ elseif ( noprof(1:19).eq.'Attributs_de_norenu' ) then
+c
+ exiren = .true.
+c
+c 3.2.2.3. ==> Presence d'elements ignores
+c
+c 1234567890123456
+ elseif ( noprof(1:16).eq.'Elements_Ignores' ) then
+c
+ lgpeli = nbvapr
+c
+ endif
+c
+ endif
+c
+ 32 continue
+c
+ endif
+c
+c 3.3. ==> controle
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,90002) '3.3. controle ; codret', codret
+#endif
+c
+ if ( codret.eq.0 ) then
+c
+ if ( .not.exiigl ) then
+c
+ write (ulsort,texte(langue,5))
+ codret = 33
+c
+ endif
+c
+ endif
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,90002) 'lgpeli', lgpeli
+#endif
+c
+c====
+c 4. L'eventuelle frontiere discrete
+c Le nom doit etre coherent avec esecfd
+c====
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,90002) '4. Frontiere discrete ; codret', codret
+#endif
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,90002) 'suifro', suifro
+#endif
+c
+ if ( mod(suifro,2).eq.0 ) then
+c
+c 4.1. ==> Nom du maillage de la frontiere
+c
+ if ( codret.eq.0 ) then
+c
+ nomam2 = blan64
+ nomam2(1:8) = 'AbsCurvi'
+ iaux = 8
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,3)) 'ESLNOF', nompro
+#endif
+ call eslnof ( idfmed,
+ > nomail, lnomai,
+ > nomam2, iaux,
+ > nomafr, lnomaf, sfsdim, sfmdim,
+ > typrep, nomaxe, uniaxe,
+ > ulsort, langue, codret )
+ if ( codret.ne.0 ) then
+ codret = 2
+ endif
+c
+#ifdef _DEBUG_HOMARD_
+ if ( codret.eq.0 ) then
+ write (ulsort,texte(langue,22)) nomafr
+ write (ulsort,texte(langue,23)) 'de l''espace', sfsdim
+ write (ulsort,texte(langue,23)) 'du maillage', sfmdim
+ endif
+#endif
+c
+ endif
+c
+c 4.2. ==> Si le maillage de la frontiere existe :
+c
+ if ( lnomaf.gt.0 ) then
+c
+c 4.2.1. ==> Nombre de noeuds du maillage de la frontiere
+c
+ if ( codret.eq.0 ) then
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,3)) 'ESLMMN-'//nomafr(1:lnomaf),nompro
+#endif
+ call eslmmn ( idfmed, nomafr, lnomaf,
+ > sfnbso,
+ > ulsort, langue, codret )
+c
+ endif
+c
+c 4.2.2. ==> Nombre de noeuds de la description
+c
+ if ( codret.eq.0 ) then
+c
+ iaux = 8
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,3)) 'ESLMMN-'//nomam2(1:iaux),nompro
+#endif
+ call eslmmn ( idfmed, nomam2, iaux,
+ > sfnbse,
+ > ulsort, langue, codret )
+c
+ endif
+c
+ endif
+c
+ else
+c
+ sfsdim = 0
+ sfmdim = 0
+ sfnbso = 0
+ sfnbse = 0
+c
+ endif
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,90002) 'sfsdim', sfsdim
+ write (ulsort,90002) 'sfmdim', sfmdim
+ write (ulsort,90002) 'sfnbso', sfnbso
+ write (ulsort,90002) 'sfnbse', sfnbse
+#endif
+c
+c====
+c 5. la fin
+c====
+c
+ if ( codret.ne.0 ) then
+c
+#include "envex2.h"
+c
+ write (ulsort,texte(langue,1)) 'Sortie', nompro
+ write (ulsort,texte(langue,2)) codret
+c
+ endif
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,1)) 'Sortie', nompro
+ call dmflsh (iaux)
+#endif
+c
+ end
