1 subroutine ugfia3 ( ligne,
2 > ideb1, ifin1, ideb2, ifin2,
3 > ideb3, ifin3, ideb4, ifin4,
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 retourne les indices de debut et de fin de chacun des 4 mots possibles
26 c ______________________________________________________________________
28 c . nom . e/s . taille . description .
29 c .____________________________________________________________________.
30 c . ligne . e . 1 . ligne a decoder .
31 c . ulsort . e . 1 . unite logique d'impression .
32 c . idebi . s . 1 . debut du mot numero i .
33 c . ifini . s . 1 . fin du mot numero i .
34 c . langue . e . 1 . langue des messages .
35 c . . . . 1 : francais, 2 : anglais .
36 c . codret . s . 1 . code de retour .
37 c . . . . 0 : pas de probleme .
38 c . . . . 3 : probleme de decodage des noms .
39 c . . . . 7 : impossible de decoder le $HOME .
40 c . . . . : (ou une autre variable d'environnement).
41 c . . . . 9 : probleme avec le fichier .
42 c ______________________________________________________________________
45 c 0. declarations et dimensionnement
48 c 0.1. ==> generalites
54 parameter ( nompro = 'UGFIA3' )
64 integer ideb1, ideb2, ideb3, ideb4
65 integer ifin1, ifin2, ifin3, ifin4
67 integer ulsort, langue, codret
69 c 0.4. ==> variables locales
71 integer iaux, jaux, kaux
72 integer lemot2, lemot3
76 logical ouverd, quotd2, quotd3
77 logical ouvers, quots2, quots3
80 parameter ( nbmess = 10 )
81 character*80 texte(nblang,nbmess)
83 c 0.5. ==> initialisations
85 parameter ( lgmax = 400 )
86 c ______________________________________________________________________
94 c 1.1. ==> les messages
99 write (ulsort,texte(langue,1)) 'Entree', nompro
103 texte(1,4) = '(''Nombre de quotes dans la ligne :'',i4)'
104 texte(1,5) = '(''Il en faut 0, 2 ou 4.'')'
106 texte(2,4) = '(''Number of quotes in line :'',i4)'
107 texte(2,5) = '(''0, 2 or 4 is required.'')'
112 c 2. recherche de la position du premier mot
115 c 2.1. ==> recherche de la position du debut du premier mot : ideb1
118 do 21 , jaux = 1 , lgmax
119 if ( ligne(jaux:jaux).ne.' ' ) then
126 cgn write (ulsort,90002) 'ideb1',ideb1
128 c 2.2. ==> recherche de la position de la fin du premier mot : ifin1
132 do 23 , jaux = iaux , lgmax
133 if ( ligne(jaux:jaux).eq.' ' ) then
140 cgn write (ulsort,90002) 'ifin1',ifin1
143 c 3. reperage des debuts et fin des mots 2 et 3
144 c on en profite pour reperer s'ils sont encadres par des quotes,
145 c en distinguant les simples et les doubles
160 do 31 , jaux = iaux , lgmax
162 c 3.1. ==> c'est une quote double
164 if ( ligne(jaux:jaux).eq.'"' ) then
167 if ( lemot2.eq.1 ) then
171 elseif ( lemot3.eq.1 ) then
181 c 3.2. ==> c'est une quote simple
182 c . si une quote double est ouverte, c'est un caractere comme
183 c un autre, donc on ne fait rien de special
184 c . sinon, c'est une ouverture
186 elseif ( ligne(jaux:jaux).eq.'''' ) then
190 elseif ( ouvers ) then
192 if ( lemot2.eq.1 ) then
196 elseif ( lemot3.eq.1 ) then
206 c 3.3. ==> c'est un caractere non blanc : debut de mot
208 elseif ( ligne(jaux:jaux).ne.' ' ) then
209 if ( lemot2.le.1 ) then
211 if ( ideb2.eq.-1 ) then
216 if ( ideb3.eq.-1 ) then
221 c 3.4. ==> c'est un caractere blanc : fin de mot si pas entre quotes
223 elseif ( ligne(jaux:jaux).eq.' ' .and. .not.ouverd ) then
224 if ( lemot2.eq.1 ) then
227 elseif ( lemot3.eq.1 ) then
234 cgn if ( ideb1.eq.1 .and. jaux.le.80) then
235 cgn 3499 format( i8, a2, l2, l2, i2, i2)
236 cgn write (ulsort,3499)jaux,ligne(jaux:jaux),ouverd,ouvers,lemot2,lemot3
240 c 3.n. ==> controle des quotes
242 cgn write (ulsort,*) kaux, quotd2, quotd3
243 cgn write (ulsort,*) kaux, quots2, quots3
244 cgn write (ulsort,*) ideb2, ifin2, ideb3,ifin3
246 > ( kaux.eq.2 .and. quotd2 .and. .not.quotd3 ) .or.
247 > ( kaux.eq.2 .and. quotd3 .and. .not.quotd2 ) .or.
248 > ( kaux.eq.4 .and. quotd2 .and. quotd3 ) .or.
249 > ( kaux.eq.2 .and. quots2 .and. .not.quots3 ) .or.
250 > ( kaux.eq.2 .and. quots3 .and. .not.quots2 ) .or.
251 > ( kaux.eq.4 .and. quots2 .and. quots3 ) ) then
255 write (ulsort,*) ligne
256 write (ulsort,texte(langue,4)) kaux
257 write (ulsort,texte(langue,5))
263 c 4. recherche de la position du quatrieme nom
264 c s'il n'y en n'a pas, on passe directement au decodage.
271 if ( codret.eq.0 ) then
273 if ( ideb3.gt.0 ) then
275 c 3.4.1. ==> recherche du debut du quatrieme nom : ideb4
282 do 41 , jaux = iaux , lgmax
283 if ( ligne(jaux:jaux).ne.' ' ) then
293 c 3.4.2. ==> recherche de la fin du quatrieme nom : ifin4
297 do 43 , jaux = iaux , lgmax
298 if ( ligne(jaux:jaux).eq.' ' ) then
315 cgn write (ulsort,90002) 'ideb4, ifin4',ideb4, ifin4