1 subroutine uts8ch ( tabch8, 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 - transfere un tableau de String*8 dans une CHaine
25 c Remarque : on transfere stricto sensu le nombre de caracteres
26 c demandes, sans se preoccuper de savoir s'il y a des
27 c blancs ou des "mauvais" caracteres.
28 c Remarque : si la chaine est declaree plus grande que le nombre de
29 c caracteres a transferer, on complete a droite par des
33 c : tabch8 (1) = 'Sous le '
34 c tabch8 (2) = 'pont Mir'
35 c tabch8 (3) = 'abeau co'
36 c tabch8 (4) = 'ule la S'
37 c tabch8 (5) = 'eine '
40 c chacar = 'Sous le pont Mirabeau coule la Seine '
41 c 1234567890123456789012345678901234567890123
42 c ______________________________________________________________________
44 c . nom . e/s . taille . description .
45 c .____________________________________________________________________.
46 c . tabch8 . e . * . tableau a transferer .
47 c . lgchac . e . 1 . nombre de caracteres a transferer .
48 c . chacar . s .char*(*). chaine de caractere .
49 c . ulsort . e . 1 . unite logique de la sortie generale .
50 c . langue . e . 1 . langue des messages .
51 c . . . . 1 : francais, 2 : anglais .
52 c . codret . s . 1 . code de retour des modules .
53 c . . . . 0 : pas de probleme .
54 c . . . . 1 : chaine trop courte .
55 c ______________________________________________________________________
58 c 0. declarations et dimensionnement
61 c 0.1. ==> generalites
67 parameter ( nompro = 'UTS8CH' )
82 integer ulsort, langue, codret
85 parameter (nbmess = 10 )
86 character*80 texte(nblang,nbmess)
88 c 0.4. ==> variables locales
91 integer lencha, nbchar, nbpack
93 c 0.5. ==> initialisations
94 c ______________________________________________________________________
102 #ifdef _DEBUG_HOMARD_
103 write (ulsort,texte(langue,1)) 'Entree', nompro
107 texte(1,4) = '(''La chaine est declaree en char*'',i4)'
108 texte(1,5) = '(''mais on veut transferer '',i4,'' caracteres !'')'
110 texte(2,4) = '(''The string is declared as char*'',i4)'
111 texte(2,5) = '(''but, '',i4,'' characters must be moved !'')'
114 c 2. verification de la longueur
120 if ( lgchac.gt.lencha ) then
128 if ( codret.eq.0 ) then
130 nbchar = mod(lgchac,8)
131 nbpack = ( lgchac - nbchar ) / 8
134 do 31 , iaux = 1 , nbpack
135 chacar(jaux:jaux+7) = tabch8(iaux)
139 if ( nbchar.gt.0 ) then
140 chacar(jaux:jaux+nbchar-1) = tabch8(nbpack+1)(1:nbchar)
144 do 32 , iaux = jaux , lencha
145 chacar(iaux:iaux) = ' '
154 if ( codret.ne.0 ) then
157 write (ulsort,texte(langue,1)) 'Sortie', nompro
158 write (ulsort,texte(langue,2)) codret
159 write (ulsort,texte(langue,4)) lencha
160 write (ulsort,texte(langue,5)) lgchac
163 #ifdef _DEBUG_HOMARD_
164 write (ulsort,texte(langue,1)) 'Sortie', nompro