1 subroutine utfmlg ( nbfmed, ngrouc,
2 > grfmpo, grfmtl, grfmtb,
3 > nbgrfm, nomgro, lgnogr,
4 > ulsort, langue, codret )
5 c ______________________________________________________________________
9 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
11 c Version originale enregistree le 18 juin 1996 sous le numero 96036
12 c aupres des huissiers de justice Simart et Lavoir a Clamart
13 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
14 c aupres des huissiers de justice
15 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
17 c HOMARD est une marque deposee d'Electricite de France
23 c ______________________________________________________________________
25 c UTilitaire : Famille MED : Liste des Groupes
27 c ______________________________________________________________________
29 c . nom . e/s . taille . description .
30 c .____________________________________________________________________.
31 c . nbfmed . e . 1 . nombre de familles MED .
32 c . ngrouc . e . 1 . nombre cumule de groupes dans les familles .
33 c . grfmpo . e .0:nbfmed. pointeur des groupes des familles .
34 c . grfmtl . e . * . taille des groupes des familles .
35 c . grfmtb . e .10nbgroc. table des groupes des familles .
36 c . nbgrfm . s . 1 . nombre de groupes .
37 c . nomgro . s .char*(*). noms des groupes (paquets de 10char8) .
38 c . lgnogr . s . * . longueur des noms des groupes .
39 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
40 c . langue . e . 1 . langue des messages .
41 c . . . . 1 : francais, 2 : anglais .
42 c . codret . es . 1 . code de retour des modules .
43 c . . . . 0 : pas de probleme .
44 c ______________________________________________________________________
47 c 0. declarations et dimensionnement
50 c 0.1. ==> generalites
56 parameter ( nompro = 'UTFMLG' )
66 integer nbfmed, ngrouc
67 integer grfmpo(0:nbfmed)
69 integer nbgrfm, lgnogr(ngrouc)
74 integer ulsort, langue, codret
76 c 0.4. ==> variables locales
78 integer iaux, jaux, kaux
79 integer nfam, ngro, nbgrou
82 character*80 nomgrf, nomgrl
85 parameter ( nbmess = 10 )
86 character*80 texte(nblang,nbmess)
88 c 0.5. ==> initialisations
89 c ______________________________________________________________________
98 write (ulsort,texte(langue,1)) 'Entree', nompro
107 c 2. Explorations de toutes les familles, s'il y a des groupes
112 if ( ngrouc.gt.0 ) then
114 do 21 , nfam = 1 , nbfmed
116 if ( codret.eq.0 ) then
118 nbgrou = ( grfmpo(nfam) - grfmpo(nfam-1) ) / 10
120 #ifdef _DEBUG_HOMARD_
121 write(ulsort,90002) 'nfam', nfam
122 write(ulsort,90002) 'nbgrou', nbgrou
125 c 2.1. ==> Explorations de tous les groupes associes a la famille
127 do 211 , ngro = 1 , nbgrou
129 c 2.1.1. ==> Longueur du nom
131 iaux = grfmpo(nfam-1) + 1 + 10*(ngro-1)
133 do 2111 , jaux = 1 , 10
134 lnogrf = lnogrf + grfmtl(iaux+jaux-1)
137 #ifdef _DEBUG_HOMARD_
138 write(ulsort,90002) 'ngro / lnogrf', ngro, lnogrf
143 call uts8ch ( grfmtb(iaux), lnogrf, nomgrf,
144 > ulsort, langue, codret )
145 cgn write(ulsort,90003) 'Groupe ', nomgrf(1:lnogrf)
147 c 2.1.3. ==> Le nom est-il deja enregistre ?
149 do 2113 , jaux = 1 , nbgrfm
150 if ( lnogrf.eq.lgnogr(jaux) ) then
151 kaux = 10*(jaux-1) + 1
152 call uts8ch ( nomgro(kaux), lnogrf, nomgrl,
153 > ulsort, langue, codret )
154 cgn write(ulsort,90003) '. Groupe ', nomgrl(1:lnogrf)
155 if ( nomgrf(1:lnogrf).eq.nomgrl(1:lnogrf) ) then
161 c 2.1.4. ==> Enregistrement d'un nouveau nom
164 lgnogr(nbgrfm) = lnogrf
165 kaux = 10*(nbgrfm-1) + 1
166 call utchs8 ( nomgrf, 80, nomgro(kaux),
167 > ulsort, langue, codret )
179 #ifdef _DEBUG_HOMARD_
180 write(ulsort,90002) 'nbgrfm', nbgrfm
187 if ( codret.ne.0 ) then
191 write (ulsort,texte(langue,1)) 'Sortie', nompro
192 write (ulsort,texte(langue,2)) codret
196 #ifdef _DEBUG_HOMARD_
197 write (ulsort,texte(langue,1)) 'Sortie', nompro