src/tool/Gestion_MTU/gtnoms.F

   1       subroutine gtnoms ( numero, langue, titre )
   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                                       premiere creation le 30.12.88 gn
  22 c ______________________________________________________________________
  23 c
  24 c    'Gestion du Temps : NOM de Section'
  25 c     -          -       ---    _
  26 c ______________________________________________________________________
  27 c .        .     .        .                                            .
  28 c .  nom   . e/s . taille .           description                      .
  29 c .____________________________________________________________________.
  30 c . numero . e   .    1   . numero de la section a mesurer             .
  31 c . langue . e   .    1   . langue des messages                        .
  32 c .        .     .        . 1 : francais, 2 : anglais                  .
  33 c . titre  . e   . ch*24  . nom a donner a la section                  .
  34 c ______________________________________________________________________
  35 c
  36 c====
  37 c 0. declarations et dimensionnement
  38 c====
  39 c
  40 c 0.1. ==> generalites
  41 c
  42       implicit none
  43       save
  44 c
  45       character*6 nompro
  46       parameter ( nompro = 'GTNOMS' )
  47 c
  48 #include "gtnbse.h"
  49 #include "genbla.h"
  50 c
  51 c 0.2. ==> communs
  52 c
  53 c 0.3. ==> arguments
  54 c
  55       integer numero, langue
  56 c
  57       character*(*) titre
  58 c
  59 c 0.4. ==> variables locales
  60 c
  61 #include "gtdita.h"
  62 c
  63       integer code, iaux, ifin, lontit
  64       integer ulsort
  65 c
  66       character*24 titr2
  67 c
  68       integer nbmess
  69       parameter ( nbmess = 10 )
  70 c
  71       character*80 texte(nblang,nbmess)
  72 c
  73 c====
  74 c 1. initialisation des messages
  75 c====
  76 c
  77 #include "impr01.h"
  78 c
  79 c====
  80 c 2. recuperation de l'information
  81 c====
  82 c
  83       code = 1
  84       iaux = nbsep1
  85       call gttabl ( code, iaux, nbrapp, ouvert, titsec, tpscpu )
  86 c
  87       ulsort = nbrapp(0)
  88 c
  89 #ifdef _DEBUG_HOMARD_
  90       write (ulsort,texte(langue,1)) 'Entree', nompro
  91       call dmflsh (iaux)
  92 #endif
  93 c
  94 c====
  95 c 3. gestion de la section
  96 c====
  97 c
  98 c 3.1. ==> verification du numero
  99 c
 100       if ( numero.lt.1 .or. numero.gt.nbsect ) then
 101         write (ulsort,texte(langue,1)) 'Sortie', nompro
 102         lontit = min(24,len(titre))
 103         if (lontit.gt.0) then
 104           write (ulsort,31000) titre(1:lontit), numero, nbsect
 105         else
 106           write (ulsort,31000) '                        ',
 107      >                        numero, nbsect
 108         endif
 109         iaux = 1
 110         call gtstop ( nompro , ulsort , iaux )
 111       endif
 112 c
 113 31000 format(
 114      > 'On veut donner le nom ''',a24,''' a la section',i8,'.',
 115      >/'C''est impossible. Il faut un numero entre 1 et',i8,'.',/)
 116 c
 117 c 3.2. ==> verification du numero de la langue
 118 c
 119       if ( langue.lt.1 .or. langue.gt.nblang ) then
 120         write (ulsort,texte(langue,1)) 'Sortie', nompro
 121         lontit = min(24,len(titre))
 122         if (lontit.gt.0) then
 123           write (ulsort,32000) titre(1:lontit), numero, langue, nblang
 124         else
 125           write (ulsort,32000) '                        ',
 126      >                        numero, langue, nblang
 127         endif
 128         iaux = 1
 129         call gtstop ( nompro , ulsort , iaux )
 130       endif
 131 c
 132 32000 format(
 133      > 'On veut donner le nom ''',a24,''' a la section',i8,'.',
 134      >/'Il est impossible de donner la langue',i8,'.',
 135      >/'Il faut un code de langue entre 1 et',i8,'.',/)
 136 c
 137 c 3.3. ==> determination de la longueur de la chaine de caracteres
 138 c          de titre
 139 c
 140       lontit = min(24,len(titre))
 141 c
 142       if ( lontit.le.0 ) then
 143         ifin = 0
 144       else
 145         ifin = 0
 146         do 33 , iaux = lontit , 1 , -1
 147           if ( titre(iaux:iaux) .ne. ' ' ) then
 148             ifin = iaux
 149             goto 34
 150           endif
 151    33   continue
 152       endif
 153 c
 154 c 3.4. ==> affectation du titre a la section en cours
 155 c
 156    34 continue
 157 c
 158       if ( ifin.gt.0 ) then
 159         titr2 (1:ifin) = titre (1:ifin)
 160       endif
 161 c
 162       do 341 , iaux = ifin+1 , 24
 163         titr2 (iaux:iaux) = ' '
 164   341 continue
 165 c
 166       titsec (langue,numero) = titr2
 167 c
 168 c====
 169 c 4. on archive l'information
 170 c====
 171 c
 172       code = 0
 173       iaux = nbsep1
 174       call gttabl ( code, iaux, nbrapp, ouvert, titsec, tpscpu )
 175 c
 176 #ifdef _DEBUG_HOMARD_
 177       write (ulsort,texte(langue,1)) 'Sortie', nompro
 178       call dmflsh (iaux)
 179 #endif
 180 c
 181       end