1 subroutine utench ( entier, cadrag, lgchac, chacar,
2 > ulsort, langue, codret )
3 c ______________________________________________________________________
7 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
9 c Version originale enregistree le 18 juin 1996 sous le numero 96036
10 c aupres des huissiers de justice Simart et Lavoir a Clamart
11 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
12 c aupres des huissiers de justice
13 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
15 c HOMARD est une marque deposee d'Electricite de France
21 c ______________________________________________________________________
23 c UTilitaire - convertit un ENtier en CHaine de caractere
26 c Si la chaine fournie est plus longue que le nombre de chiffres a
27 c ecrire, on complete par des blancs a droite ou a gauche, ou des 0
28 c a gauche selon le type de cadrage demande.
29 c ______________________________________________________________________
31 c . nom . e/s . taille . description .
32 c .____________________________________________________________________.
33 c . entier . e . 1 . entier a convertir .
34 c . cadrag . e . char*1 . type de cadrage d'entier ecrit .
35 c . . . . g/G : le nombre est cadre a gauche : '83 '.
36 c . . . . d/D : le nombre est cadre a droite : ' 83'.
37 c . . . . et on complete par des blancs .
38 c . . . . 0 : le nombre est cadre a droite et on .
39 c . . . . complete par des 0 : '0083' .
40 c . . . . _ : le nombre est cadre a droite et on .
41 c . . . . complete par des _ : '__83' .
42 c . lgchac . s . 1 . longueur de la chaine obtenue .
43 c . chacar . s .char*(*). chaine de caractere .
44 c . ulsort . e . 1 . unite logique de la sortie generale .
45 c . langue . e . 1 . langue des messages .
46 c . . . . 1 : francais, 2 : anglais .
47 c . codret . s . 1 . code de retour des modules .
48 c . . . . 0 : pas de probleme .
49 c . . . . 1 : chaine trop courte .
50 c . . . . 2 : le nombre est trop grand .
51 c . . . . 3 : type de cadrage inconnu .
52 c ______________________________________________________________________
55 c 0. declarations et dimensionnement
58 c 0.1. ==> generalites
64 parameter ( nompro = 'UTENCH' )
74 integer entier, lgchac
79 integer ulsort, langue, codret
82 parameter (nbmess = 20 )
83 character*80 texte(nblang,nbmess)
85 c 0.4. ==> variables locales
87 integer iaux, jaux, kaux, lgch00
89 logical cadgau, negati
94 c 0.5. ==> initialisations
95 c ______________________________________________________________________
103 #ifdef _DEBUG_HOMARD_
104 write (ulsort,texte(langue,1)) 'Entree', nompro
108 texte(1,4) = '(''Cadrage voulu : '',a1)'
109 texte(1,5) = '(''La chaine est trop petite : longueur = '',i4)'
110 texte(1,6) = '(''Il faudrait au moins '',i4,'' places.'')'
111 texte(1,7) = '(''Le nombre est trop grand.'')'
112 texte(1,8) = '(''Le type de cadrage est mauvais : '',a1)'
113 texte(1,9) = '(''Longueur de la chaine obtenue : '',i8)'
114 texte(1,10) = '(''Chaine obtenue : '',a,/)'
115 texte(1,20) = '(''Entier a convertir : '',i8)'
117 texte(2,4) = '(''Choice : '',a1)'
118 texte(2,5) = '(''The string is too short : length = '',i4)'
119 texte(2,6) = '(''At less'',i4,'' places are needed.'')'
120 texte(2,7) = '(''The integer is too big.'')'
121 texte(2,8) = '(''Bad choice : '',a1)'
122 texte(2,9) = '(''Lenght of chain : '',i8)'
123 texte(2,10) = '(''Chain : '',a,/)'
124 texte(2,20) = '(''Integer to convert : '',i8)'
126 #ifdef _DEBUG_HOMARD_
127 write (ulsort,texte(langue,20)) entier
128 write (ulsort,texte(langue,4)) cadrag
137 c 2.1. ==> type de cadrage
139 if ( cadrag.eq.'d' .or. cadrag.eq.'D' .or.
140 > cadrag.eq.'0' .or. cadrag.eq.'_' ) then
142 elseif ( cadrag.eq.'g' .or. cadrag.eq.'G' ) then
148 c 2.2. ==> point de depart
153 c 2.3. ==> si le numero est strictement negatif, il faut inserer -
155 if ( codret.eq.0 ) then
157 if ( kaux.lt.0 ) then
159 if ( lgch00.le.1 ) then
162 if ( codret.eq.0 ) then
173 c 2.4. ==> nombre de chiffres de l'entier a convertir et ecriture
175 if ( codret.eq.0 ) then
177 c 2.4.1. ==> si le numero est nul : on le traite tout de suite car cela
178 c simplifie l'algorithme general
180 if ( kaux.eq.0 ) then
182 if ( lgch00.eq.0 ) then
185 if ( codret.eq.0 ) then
189 chacar(lgch00:lgch00) = '0'
194 c 2.4.2. ==> pour un nombre non nul, le puissance de 10 immediatement
195 c superieure equivaut au nombre de chiffres.
200 do 2421 , iaux = 1 , 99
201 if ( kaux.lt.10**iaux ) then
209 if ( jaux.eq.0 ) then
211 elseif ( lgchac+jaux.gt.lgch00 ) then
216 if ( jaux.lt.10 ) then
217 write(fmt(3:3),'(i1)') jaux
220 write(fmt(3:4),'(i2)') jaux
224 write (chacar(lgchac+1:lgchac+jaux),fmt) kaux
226 chacar(lgchac:lgchac) = '-'
229 write (chacar(lgch00-jaux+1:lgch00),fmt) kaux
231 chacar(lgch00-jaux:lgch00-jaux) = '-'
241 c 2.5. ==> complement avec des blancs ou des zeros
243 if ( codret.eq.0 ) then
250 if ( cadrag.eq.'0' ) then
252 elseif ( cadrag.eq.'_' ) then
262 do 25 , iaux = jaux, kaux
263 chacar(iaux:iaux) = saux01
266 #ifdef _DEBUG_HOMARD_
267 write (ulsort,texte(langue,9)) lgchac
268 write (ulsort,texte(langue,10)) chacar
277 if ( codret.ne.0 ) then
281 write (ulsort,texte(langue,1)) 'Sortie', nompro
282 write (ulsort,texte(langue,2)) codret
283 write (ulsort,texte(langue,20)) entier
284 if ( codret.eq.1 ) then
285 write (ulsort,texte(langue,5)) lgch00
286 write (ulsort,texte(langue,6)) lgchac
287 elseif ( codret.eq.2 ) then
288 write (ulsort,texte(langue,7))
289 elseif ( codret.eq.3 ) then
290 write (ulsort,texte(langue,8)) cadrag
293 #ifdef _DEBUG_HOMARD_
294 write (ulsort,texte(langue,1)) 'Sortie', nompro