1 subroutine gutabl ( code, gunmbr, statut, nomfic, lnomfi )
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 : archiver ou redonner les listes caracteristiques de la
23 c gestion des unites logiques.
24 c ______________________________________________________________________
26 c . nom . e/s . taille . description .
27 c .____________________________________________________________________.
28 c . code . e . 1 . 0 : on archive les tableaux de l'appelant .
29 c . . . . 1 : on renvoie les tableaux vers l'appelant.
30 c . gunmbr . e/s . lgunmb . les nombres caracteristiques de la gestion .
31 c . . . .(1): nb maxi d'unites ouvertes form/sequ .
32 c . . . .(2): nb maxi d'unites ouvertes bina/sequ .
33 c . . . .(3): nb maxi d'unites ouvertes bina/dire sta.
34 c . . . .(4): nb maxi d'unites ouvertes bina/dire spe.
35 c . . . .(5): nb total d'unites ouvertes form/sequ .
36 c . . . .(6): nb total d'unites ouvertes bina/sequ .
37 c . . . .(7): nb total d'unites ouvertes bina/dire st.
38 c . . . .(8): nb total d'unites ouvertes bina/dire sp.
39 c . . . .(9): nb actuel d'unites ouvertes form/sequ .
40 c . . . .(10): nb actuel d'unites ouvertes bina/sequ .
41 c . . . .(11): nb actuel d'unites ouvertes bina/dire .
42 c . . . .(12): nb actuel d'unites ouvertes bina/dire .
43 c . . . .(13): nb maxi d'unites ouvertes tous types .
44 c . . . .(14): numero de l'entree standard .
45 c . . . .(15): numero de la sortie standard .
46 c . . . .(16): numero de l'unite des messages du gu .
47 c . . . .(17): langue des messages du gu .
48 c . . . .(18): type d'arret du gu .
49 c . statut . e/s . mbmxul . statut de chaque unite logique : .
50 c . . . . 0 : disponible .
51 c . . . . 1 : entree standard (form/sequ) .
52 c . . . . 2 : sortie standard (form/sequ) .
53 c . . . . 3 : ouvert en form/sequ .
54 c . . . . 4 : ouvert en bina/sequ .
55 c . . . . 5 : ouvert en form/dire .
56 c . . . . 6 : ouvert en bina/dire .
57 c . . . . 7 : interdit .
58 c . nomfic . e/s . mbmxul . nom du fichier attache a chaque unite .
59 c . . . . logique ouverte .
60 c . lnomfi . e/s . mbmxul . longueur du nom du fichier attache a chaque.
61 c . . . . unite logique ouverte .
62 c ______________________________________________________________________
65 c 0. declarations et dimensionnement
68 c 0.1. ==> generalites
74 parameter ( nompro = 'GUTABL' )
87 integer statut(mbmxul), lnomfi(mbmxul)
89 character*(*) nomfic(mbmxul)
91 c 0.4. ==> variables locales
94 parameter ( sortst = 6 )
96 integer ulsort, langue
98 integer gunmb0(lgunmb)
99 integer statu0(mbmxul), lnomf0(mbmxul)
103 character*200 nomfi0(mbmxul)
106 parameter ( nbmess = 3 )
107 character*80 texte(nblang,nbmess)
109 c 0.5. ==> intialisations
111 data initia / .false. /
113 c ... juste pour ne plus avoir de messages ftnchek :
115 data gunmb0(16) / sortst /
117 c ______________________________________________________________________
125 c 1.1. ==> unite pour la sortie standard et langue
127 if ( .not.initia ) then
130 else if ( gunmb0(16).gt.0 .and. gunmb0(16).le.mbmxul ) then
138 c 1.2. ==> L'initialisation n'est pas faite
140 if ( code.ne.0 .and. .not.initia ) then
141 write (ulsort,texte(langue,1)) 'Entree', nompro
147 > 'L''initialisation du gestionnaire n''a pas ete faite.',
148 >/'Il faut faire appel a GUINIT.',//)
151 c 2. on archive les informations transmises par l'appelant
154 if ( code.eq.0 ) then
156 call ugtaci (gunmb0, gunmbr, 1, lgunmb)
157 call ugtaci (statu0, statut, 1, mbmxul)
158 call ugtaci (lnomf0, lnomfi, 1, mbmxul)
159 call ugtac2 (nomfi0, nomfic, 1, mbmxul)
164 c 3. on renvoie a l'appelant
167 elseif ( code.eq.1 ) then
169 call ugtaci (gunmbr, gunmb0, 1, lgunmb)
170 call ugtaci (statut, statu0, 1, mbmxul)
171 call ugtaci (lnomfi, lnomf0, 1, mbmxul)
172 call ugtac2 (nomfic, nomfi0, 1, mbmxul)
180 write (ulsort,texte(langue,1)) 'Sortie', nompro
181 write(ulsort,40000) code
187 > 'Le choix ',i4,' pour le premier argument ne correspond ',
188 > 'a aucune option possible.',
189 >/'Il faut 0 pour archiver ou 1 pour recuperer.',/)