src/tool/Gestion_MTU/gttabl.F

   1       subroutine gttabl ( code, nbsep1, nbrapp, ouvert, titsec, tpscpu )
   2 c ______________________________________________________________________
   3 c
   4 c                             H O M A R D
   5 c
   6 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   7 c
   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
  13 c
  14 c    HOMARD est une marque deposee d'Electricite de France
  15 c
  16 c Copyright EDF 1996
  17 c Copyright EDF 1998
  18 c Copyright EDF 2002
  19 c Copyright EDF 2020
  20 c ______________________________________________________________________
  21 c
  22 c    'Gestion du Temps : memorisation des TABLes'
  23 c     -          -                        ----
  24 c ______________________________________________________________________
  25 c
  26 c but : archiver ou redonner les listes caracteristiques de la
  27 c       gestion des mesures de temps
  28 c ______________________________________________________________________
  29 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      .
  49 c .        .     .        . section                                    .
  50 c ______________________________________________________________________
  51 c
  52 c====
  53 c 0. declarations et dimensionnement
  54 c====
  55 c
  56 c 0.1. ==> generalites
  57 c
  58       implicit none
  59       save
  60 c
  61       character*6 nompro
  62       parameter ( nompro = 'GTTABL' )
  63 c
  64 #include "genbla.h"
  65 c
  66 c 0.2. ==> communs
  67 c
  68 c 0.3. ==> arguments
  69 c
  70       integer code, nbsep1
  71 c
  72 #include "gtdita.h"
  73 c
  74 c 0.4. ==> variables locales
  75 c
  76       integer enstul
  77       integer iaux
  78 c
  79       integer nbsec0
  80       parameter ( nbsec0 = 301 )
  81 c
  82       integer ulsort, langue
  83       integer nbrap0(-4:nbsec0)
  84 c
  85       double precision tpscp0(0:nbsec0)
  86 c
  87       logical ouver0(nbsec0)
  88       logical initia
  89 c
  90       character*24 titse0(nblang,nbsec0)
  91 c
  92       integer nbmess
  93       parameter ( nbmess = 10 )
  94 c
  95       character*80 texte(nblang,nbmess)
  96 c
  97 c 0.5. ==> initialisations
  98 c
  99       data initia / .false. /
 100       data langue / 1 /
 101 c
 102 c ... juste pour ne plus avoir de messages ftnchek :
 103 c
 104       data nbrap0(0) / 6 /
 105 c ______________________________________________________________________
 106 c
 107 c====
 108 c 1. initialisation des messages
 109 c====
 110 c
 111 #include "impr01.h"
 112 c
 113 c====
 114 c 2. verifications
 115 c====
 116 c
 117 c 2.1. ==> unite pour la sortie standard
 118 c
 119       if ( initia ) then
 120 c
 121         ulsort = nbrap0(0)
 122 c
 123       else
 124 c
 125         call dmunit ( enstul, ulsort )
 126 c
 127 c 2.2. ==> l'initialisation n'est pas faite
 128 c
 129         if ( code.ne.0 ) then
 130       write (ulsort,texte(langue,1)) 'Entree', nompro
 131           write (ulsort,22000)
 132           call dmflsh (iaux)
 133           call dmabor
 134         else
 135           initia = .true.
 136         endif
 137 c
 138       endif
 139 c
 140 c 2.3. ==> la place reservee ici est trop petite
 141 c
 142       if ( nbsep1.gt.nbsec0 ) then
 143         write (ulsort,texte(langue,1)) 'Sortie', nompro
 144         write (ulsort,23000) nbsec0, nbsep1
 145         call dmabor
 146       endif
 147 c
 148 22000 format(
 149      > 'L''initialisation du gestionnaire des mesures de temps',
 150      >/'de calcul n''a pas ete faite.',
 151      >/'Il faut faire appel a GTINIT.',//)
 152 c
 153 23000 format(
 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.',//)
 157 c
 158 c====
 159 c 2. on archive les informations transmises par l'appelant
 160 c====
 161 c
 162       if ( code.eq.0 ) then
 163 c
 164         call ugtaci (nbrap0, nbrapp, -4, nbsep1)
 165         call ugtacr (tpscp0, tpscpu, 0, nbsep1)
 166         call ugtacl (ouver0, ouvert, 1, nbsep1)
 167         iaux = nblang*nbsep1
 168         call ugtacs (titse0, titsec, 1, iaux )
 169 c
 170 c===
 171 c 3. on renvoie a l'appelant
 172 c====
 173 c
 174       else if ( code.eq.1 ) then
 175 c
 176         call ugtaci (nbrapp, nbrap0, -4, nbsep1)
 177         call ugtacr (tpscpu, tpscp0, 0, nbsep1)
 178         call ugtacl (ouvert, ouver0, 1, nbsep1)
 179         iaux = nblang*nbsep1
 180         call ugtacs (titsec, titse0, 1, iaux )
 181 c
 182 c===
 183 c 4. probleme
 184 c====
 185 c
 186       else
 187 c
 188         write (ulsort,texte(langue,1)) 'Sortie', nompro
 189         write (ulsort,40000) code
 190         call dmabor
 191 c
 192       endif
 193 c
 194 40000 format(
 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.',/)
 198 c
 199       end