1 subroutine utmcf2 ( nbfrgr,
2 > calfpo, calfta, calfnm,
3 > calgpo, calgta, calgnm,
5 > nomref, lgnofi, poinno,
7 > ulsort, langue, codret )
8 c ______________________________________________________________________
12 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
14 c Version originale enregistree le 18 juin 1996 sous le numero 96036
15 c aupres des huissiers de justice Simart et Lavoir a Clamart
16 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
17 c aupres des huissiers de justice
18 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
20 c HOMARD est une marque deposee d'Electricite de France
26 c ______________________________________________________________________
28 c UTilitaire : Mot-Cle - caracterisation des Frontieres - 2
30 c ______________________________________________________________________
32 c . nom . e/s . taille . description .
33 c .____________________________________________________________________.
34 c . nbfrgr . e . 1 . nombre de liens frontieres/groupes .
35 c . calfpo . s .0:nbfrgr. pointeurs sur le tableau du nom frontieres .
36 c . calfta . s .10nbfrgr. taille du nom des frontieres .
37 c . calfnm . s .10nbfrgr. nom des frontieres .
38 c . calgpo . s .0:nbfrgr. pointeurs sur le tableau du nom groupes .
39 c . calgta . s .10nbfrgr. taille du nom des groupes .
40 c . calgnm . s .10nbfrgr. nom des groupes .
41 c . nbfich . e . 1 . nombre de fichiers .
42 c . nomref . e . nbfich . nom de reference des fichiers .
43 c . lgnofi . e . nbfich . longueurs des noms des fichiers .
44 c . poinno . e .0:nbfich. pointeur dans le tableau des noms .
45 c . nomufi . e . lgtanf . noms des fichiers .
46 c . nomstr . e . nbfich . nom des structures .
47 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
48 c . langue . e . 1 . langue des messages .
49 c . . . . 1 : francais, 2 : anglais .
50 c . codret . es . 1 . code de retour des modules .
51 c . . . . 0 : pas de probleme .
52 c . . . . 2 : probleme de lecture .
53 c . . . . 3 : type inconnu .
54 c ______________________________________________________________________
57 c 0. declarations et dimensionnement
60 c 0.1. ==> generalites
66 parameter ( nompro = 'UTMCF2' )
72 parameter ( nbmcle = 1 )
82 integer lgnofi(nbfich), poinno(0:nbfich)
83 integer calfpo(0:nbfrgr), calfta(10*nbfrgr)
84 integer calgpo(0:nbfrgr), calgta(10*nbfrgr)
86 character*8 calfnm(10*nbfrgr)
87 character*8 calgnm(10*nbfrgr)
88 character*8 nomref(nbfich), nomufi(*), nomstr(nbfich)
90 integer ulsort, langue, codret
92 c 0.4. ==> variables locales
94 integer iaux, jaux, kaux
97 integer numero, nrmcle
99 character*8 mclref(0:nbmcle)
102 logical mccode(0:nbmcle)
105 parameter ( nbmess = 10 )
106 character*80 texte(nblang,nbmess)
108 c 0.5. ==> initialisations
109 c ______________________________________________________________________
115 c 1.1. ==> tout va bien
119 c 1.2. ==> les messages
123 #ifdef _DEBUG_HOMARD_
124 write (ulsort,texte(langue,1)) 'Entree', nompro
128 texte(1,4) = '(''Nombre de lien(s) frontiere/groupe :'',i8)'
130 > '(''Numero du lien en cours de recherche :'',i8)'
131 texte(1,8) = '(''La valeur de '',a,'' est indecodable.'')'
133 texte(2,4) = '(''Number of link(s) boundary/group:'',i8)'
134 texte(2,5) = '(''Search for link #'',i8)'
135 texte(2,8) = '(''The value for '',a,'' cannot be uncoded.'')'
137 c 1.3. ==> preliminaires
139 #ifdef _DEBUG_HOMARD_
140 write (ulsort,texte(langue,4)) nbfrgr
145 #ifdef _DEBUG_HOMARD_
146 write(ulsort,*) mclref
153 c 2. on parcourt toutes les posssibilites de liens
156 do 20 , nrfrgr = 1 , nbfrgr
158 #ifdef _DEBUG_HOMARD_
159 write (ulsort,texte(langue,5)) nrfrgr
162 c 2.0. ==> On n'a rien au debut
164 do 201 , iaux = 0 , nbmcle
165 mccode(iaux) = .false.
168 do 200 , nrfich = 1 , nbfich
170 c 2.1. ==> si c'est un des mots-cles possibles, on verifie si c'est
173 if ( codret.eq.0 ) then
176 do 21 , iaux = 0 , nbmcle
177 if ( nomref(nrfich).eq.mclref(iaux) ) then
185 if ( nrmcle.ge.0 ) then
187 call utchen ( nomstr(nrfich), numero,
188 > ulsort, langue, codret )
190 if ( nrfrgr.ne.numero ) then
203 c 2.2. ==> recherche de la valeur
204 c 2.2.1. ==> Mise sous forme de chaine de la 3eme donnee sur la ligne
206 if ( codret.eq.0 ) then
208 iaux = poinno(nrfich-1) + 1
209 jaux = lgnofi(nrfich)
210 call uts8ch ( nomufi(iaux), jaux, sau200,
211 > ulsort, langue, codret )
213 #ifdef _DEBUG_HOMARD_
214 write (ulsort,*) sau200
218 c 2.2.2. ==> Conversions
220 if ( codret.eq.0 ) then
221 #ifdef _DEBUG_HOMARD_
222 write (ulsort,*) 'nrmcle =', nrmcle
225 c 2.2.2.1. ==> Stockage du nom de la frontiere
227 if ( nrmcle.eq.0 ) then
228 #ifdef _DEBUG_HOMARD_
229 write (ulsort,*) 'Stockage du nom de la frontiere'
232 iaux = mod(lgnofi(nrfich),8)
233 kaux = (lgnofi(nrfich) - iaux)/8
234 if ( iaux.ne.0 ) then
237 calfpo(nrfrgr) = calfpo(nrfrgr-1) + kaux
239 do 2221 , iaux = 1 , kaux
240 calfta(calfpo(nrfrgr-1)+iaux) = 8
241 calfnm(calfpo(nrfrgr-1)+iaux) = sau200(jaux:jaux+7)
244 iaux = mod(lgnofi(nrfich),8)
245 if ( iaux.ne.0 ) then
246 calfta(calfpo(nrfrgr)) = iaux
249 c 2.2.2.2. ==> Stockage du nom du groupe
252 #ifdef _DEBUG_HOMARD_
253 write (ulsort,*) 'Stockage du nom du groupe'
256 iaux = mod(lgnofi(nrfich),8)
257 kaux = (lgnofi(nrfich) - iaux)/8
258 if ( iaux.ne.0 ) then
261 calgpo(nrfrgr) = calgpo(nrfrgr-1) + kaux
263 do 2222 , iaux = 1 , kaux
264 calgta(calgpo(nrfrgr-1)+iaux) = 8
265 calgnm(calgpo(nrfrgr-1)+iaux) = sau200(jaux:jaux+7)
268 iaux = mod(lgnofi(nrfich),8)
269 if ( iaux.ne.0 ) then
270 calgta(calgpo(nrfrgr)) = iaux
277 c 2.2.3. ==> Archivage
279 if ( codret.eq.0 ) then
281 mccode(nrmcle) = .true.
285 c 2.3. ==> si on a tout trouve, on passe a la frontiere suivante,
288 if ( codret.eq.0 ) then
290 if ( mccode(0) .and. mccode(1) ) then
301 c 2.4. ==> si on arrive ici, c'est qu'il en manque pour la
304 if ( codret.eq.0 ) then
306 write (ulsort,texte(langue,5)) nrfrgr
307 do 24 , iaux = 0 , nbmcle
308 if ( .not.mccode(iaux) ) then
309 write (ulsort,texte(langue,8)) mclref(iaux)
323 if ( codret.ne.0 ) then
329 write (ulsort,texte(langue,1)) 'Sortie', nompro
330 write (ulsort,texte(langue,2)) codret
334 #ifdef _DEBUG_HOMARD_
335 write (ulsort,texte(langue,1)) 'Sortie', nompro