1 subroutine guinfg ( liste, codret, imprim )
2 c ______________________________________________________________________
6 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
8 c Version originale enregistree le 18 juin 1996 sous le numero 96036
9 c aupres des huissiers de justice Simart et Lavoir a Clamart
10 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
11 c aupres des huissiers de justice
12 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
14 c HOMARD est une marque deposee d'Electricite de France
20 c ______________________________________________________________________
22 c but : donne l'etat d'une ou de toutes les unites logiques
23 c ______________________________________________________________________
25 c . nom . e/s . taille . description .
26 c .____________________________________________________________________.
27 c . liste . e . 1 . 0 : toutes les unites sont a renseigner .
28 c . . . . 1<liste<mbmxul : numero de l'unite a .
29 c . . . . renseigner .
30 c . imprim . e . logical. vrai -> impression, faux -> pas d'impres. .
31 c . codret . s . 1 . statut de l'unite a renseigner si 1 seule .
32 c . . . . 0 si probleme, -1 si tous les fichiers .
33 c ______________________________________________________________________
36 c 0. declarations et dimensionnement
39 c 0.1. ==> generalites
45 parameter ( nompro = 'GUINFG' )
59 c 0.4. ==> variables locales
61 integer unideb, unifin
62 integer ulsort, langue
63 integer iaux, code, unite
64 integer gunmbr(lgunmb)
65 integer statut(mbmxul), lnomfi(mbmxul)
67 character*200 nomfic(mbmxul)
72 parameter ( nbmess = 10 )
73 character*80 texte(nblang,nbmess)
75 character*59 chstat(nblang,0:8), chau59
77 c 0.5. ==> initialisations
78 c ______________________________________________________________________
88 c 1 234 567890 123456789012345678901234567890123456789
89 chau49 = '(''*'',12x,''Recapitulatif des unites logiques activ'
90 texte(1,10) = chau49//'es'',13x,''*'')'
92 > '(''* No *'',18x,''Statut de l''''unite logique'',18x,''*'')'
93 texte(1,5) = '(''* * Fichier : '',a49,'' *'')'
96 > '(''*'',17x,''Summary of active logical units'',18x,''*'')'
98 > '(''* # *'',17x,''Status of the logical unit'',18x,''*'')'
99 texte(2,5) = '(''* * File : '',a49,'' *'')'
101 c 1.2. ==> recuperation de l'information
104 call gutabl ( code, gunmbr, statut, nomfic, lnomfi )
109 #ifdef _DEBUG_HOMARD_
110 write (ulsort,texte(langue,1)) 'Entree', nompro
114 c 1.3. ==> variables auxiliaires
116 c 1234567890123456789012345678901234567890123456789
117 chstat(1,0) = 'Disponible '
118 chstat(1,1) = 'Entree standard (sequentiel formate) '
119 chstat(1,2) = 'Sortie standard (sequentiel formate) '
120 chstat(1,3) = 'Ouvert en acces sequentiel formate '
121 chstat(1,4) = 'Ouvert en acces sequentiel binaire '
122 chstat(1,5) = 'Ouvert en acces direct binaire standard '
123 chstat(1,6) = 'Ouvert en acces direct binaire special '
124 chstat(1,7) = 'Interdit '
125 chstat(1,8) = 'standard de la machine '
127 chstat(2,0) = 'Available '
128 chstat(2,1) = 'Standard input (formatted, sequential access) '
129 chstat(2,2) = 'Standard output (formatted, sequential access) '
130 chstat(2,3) = 'Opened in formatted sequential access mode '
131 chstat(2,4) = 'Opened in binary sequential access mode '
132 chstat(2,5) = 'Opened in binary direct access mode '
133 chstat(2,6) = 'Opened in special binary direct access mode '
134 chstat(2,7) = 'Forbidden '
135 chstat(2,8) = 'standard of the computer '
137 do 11 , iaux = 1 , 200
138 bla200(iaux:iaux) = ' '
145 if ( liste.eq.0 ) then
149 elseif ( liste.ge.1 .and. liste.le.mbmxul ) then
154 if ( ulsort.ge.1 .and. ulsort.le.mbmxul ) then
155 write (ulsort,texte(langue,1)) 'Sortie', nompro
156 write (ulsort,20000) liste, mbmxul
171 if ( liste.eq.0 ) then
173 write (ulsort,texte(langue,10))
176 write (ulsort,texte(langue,4))
179 c 3.2. ==> pour chaque unite retenue
181 do 32 , unite = unideb , unifin
183 if ( statut(unite).ne.iaux ) then
185 write (ulsort,30010) unite, chstat(langue,statut(unite))
187 if ( statut(unite).ge.1 .and. statut(unite).le.2 ) then
189 write (ulsort,texte(langue,5)) chstat(langue,8)
191 elseif ( statut(unite).ge.3 .and. statut(unite).le.6 ) then
193 if ( lnomfi(unite).le.49 ) then
194 chau49(1:49) = bla200(1:49)
195 if ( lnomfi(unite).gt.0 ) then
196 chau49(1:lnomfi(unite)) =nomfic(unite)(1:lnomfi(unite))
198 write (ulsort,texte(langue,5)) chau49
200 elseif ( lnomfi(unite).le.108 ) then
201 chau49 = nomfic(unite)(1:49)
202 write (ulsort,texte(langue,5)) chau49
203 chau59(1:59) = bla200(1:59)
204 chau59(1:lnomfi(unite)-49) =
205 > nomfic(unite)(50:lnomfi(unite))
206 write (ulsort,30020) chau59
208 elseif ( lnomfi(unite).le.167 ) then
209 chau49 = nomfic(unite)(1:49)
210 write (ulsort,texte(langue,5)) chau49
211 chau59 = nomfic(unite)(50:108)
212 write (ulsort,30020) chau59
213 chau59(1:59) = bla200(1:59)
214 chau59(1:lnomfi(unite)-108) =
215 > nomfic(unite)(109:lnomfi(unite))
216 write (ulsort,30020) chau59
219 chau49 = nomfic(unite)(1:49)
220 write (ulsort,texte(langue,5)) chau49
221 chau59 = nomfic(unite)(50:108)
222 write (ulsort,30020) chau59
223 chau59 = nomfic(unite)(109:167)
224 write (ulsort,30020) chau59
225 chau59(1:59) = bla200(1:59)
226 chau59(1:lnomfi(unite)-167) =
227 > nomfic(unite)(168:lnomfi(unite))
228 write (ulsort,30020) chau59
238 c 3.3. ==> fin du recapitulatif
246 c 4. si une seule unite a ete interrogee, on renvoie le statut
249 if ( liste.ge.1 .and. liste.le.mbmxul ) then
250 codret = statut(liste)
260 >/,'Le numero ',i4,' ne correspond a aucun code possible.',
261 >/,'Il faut soit un numero d''unite logique, donc compris ',
263 >/,'soit 0 pour les avoir toutes.',/)
265 30000 format(68('*'))
266 30010 format('* ',i2,' * ',a59,' *')
267 30020 format('* * ',a59,' *')