1 subroutine gttabl ( code, nbsep1, nbrapp, ouvert, titsec, tpscpu )
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 'Gestion du Temps : memorisation des TABLes'
24 c ______________________________________________________________________
26 c but : archiver ou redonner les listes caracteristiques de la
27 c gestion des mesures de temps
28 c ______________________________________________________________________
30 c . nom . e/s . taille . description .
31 c .____________________________________________________________________.
32 c . code . e . 1 . 0 : on archive les tableaux de l'appelant .
33 c . . . . 1 : on renvoie les tableaux vers l'appelant.
34 c . nbsep1 . e . 1 . nombre de sections possibles .
35 c . nbrapp . e/s . -4: . -4 : pilotage des impressions .
36 c . . . nbsep1 . -3 : numero de code de la langue des messa..
37 c . . . . -2 : numero de l'annee de depart .
38 c . . . . -1 : nombre de secondes au depart depuis le.
39 c . . . . depuis le debut de l'annee .
40 c . . . . 0 : numero de l'unite logique ou imprimer .
41 c . . . . les messages du gestionnaire de temps .
42 c . . . . i>0 : nombre de fois ou la i-eme section a .
43 c . . . . ete mesuree .
44 c . ouvert . e/s . nbsep1 . vrai ou faux, selon que la i-eme section .
45 c . . . . est en cours de mesure ou non .
46 c . titsec . e/s . nbsep1 . titre de la i-eme section .
47 c . tpscpu . e/s .0:nbsep1. 0 : cumul du temps systeme .
48 c . . . . i>0 : cumul du temps user de la i-eme .
50 c ______________________________________________________________________
53 c 0. declarations et dimensionnement
56 c 0.1. ==> generalites
62 parameter ( nompro = 'GTTABL' )
74 c 0.4. ==> variables locales
80 parameter ( nbsec0 = 301 )
82 integer ulsort, langue
83 integer nbrap0(-4:nbsec0)
85 double precision tpscp0(0:nbsec0)
87 logical ouver0(nbsec0)
90 character*24 titse0(nblang,nbsec0)
93 parameter ( nbmess = 10 )
95 character*80 texte(nblang,nbmess)
97 c 0.5. ==> initialisations
99 data initia / .false. /
102 c ... juste pour ne plus avoir de messages ftnchek :
105 c ______________________________________________________________________
108 c 1. initialisation des messages
117 c 2.1. ==> unite pour la sortie standard
125 call dmunit ( enstul, ulsort )
127 c 2.2. ==> l'initialisation n'est pas faite
129 if ( code.ne.0 ) then
130 write (ulsort,texte(langue,1)) 'Entree', nompro
140 c 2.3. ==> la place reservee ici est trop petite
142 if ( nbsep1.gt.nbsec0 ) then
143 write (ulsort,texte(langue,1)) 'Sortie', nompro
144 write (ulsort,23000) nbsec0, nbsep1
149 > 'L''initialisation du gestionnaire des mesures de temps',
150 >/'de calcul n''a pas ete faite.',
151 >/'Il faut faire appel a GTINIT.',//)
154 > 'Les tableaux d''archivage sont dimensionnes a nbsec0 = ',i4,
155 >/'Or il doit archiver des tableaux dimensionnes a nbsep1 = ',i9,
156 >/'C''est trop juste. Il faut augmenter nbsec0 dans GTTABL.',//)
159 c 2. on archive les informations transmises par l'appelant
162 if ( code.eq.0 ) then
164 call ugtaci (nbrap0, nbrapp, -4, nbsep1)
165 call ugtacr (tpscp0, tpscpu, 0, nbsep1)
166 call ugtacl (ouver0, ouvert, 1, nbsep1)
168 call ugtacs (titse0, titsec, 1, iaux )
171 c 3. on renvoie a l'appelant
174 else if ( code.eq.1 ) then
176 call ugtaci (nbrapp, nbrap0, -4, nbsep1)
177 call ugtacr (tpscpu, tpscp0, 0, nbsep1)
178 call ugtacl (ouvert, ouver0, 1, nbsep1)
180 call ugtacs (titsec, titse0, 1, iaux )
188 write (ulsort,texte(langue,1)) 'Sortie', nompro
189 write (ulsort,40000) code
195 > 'Le choix ',i4,' pour le premier argument ne correspond ',
196 > 'a aucune option possible.',
197 >/'Il faut 0 pour archiver ou 1 pour recuperer.',/)