src/tool/Gestion_MTU/gbgeno.F

   1       subroutine gbgeno ( nomet, champ, nomgen, codret )
   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     GM - Base - GEneration d'un Nom d'Objet
  23 c     -    -      --              -     -
  24 c
  25 c     Le nom genere est forme par :
  26 c     - caracteres 1 et 2 : les 2 premiers du nom etendu
  27 c     - caracteres 3 et 4 : les 2 premiers du champ
  28 c     - caracteres 5, 6, 7 et 8 : un caractere alphanumerique
  29 c
  30 c     On a le choix entre 10 chiffres, 26 lettres minuscules,
  31 c     26 lettres majuscules, soit 62 signes pour former l'un des
  32 c     caracteres 5, 6, 7 et 8.
  33 c     Cela revient a ecrire le nombre d'appels de ce programme
  34 c     en base 62.
  35 c     Ce qui fait 62**4 - 1 = 14 776 335 possibilites.
  36 c
  37 c     Meme si l'objet est desalloue, on ne reutilise pas sa sequence,
  38 c     donc il y a un risque d'arriver en limite pour un transitoire
  39 c     avec de nombreux pas de temps. Ce risque est tres faible
  40 c     car il faudrait environ 10 000 pas de temps pour l'atteindre.
  41 c     Si cela se produit, il faudra gerer la reutilisation des codes.
  42 c
  43 c     Gerald NICOLAS le 12 mars 1998
  44 c ______________________________________________________________________
  45 c .        .     .        .                                            .
  46 c .  nom   . e/s . taille .           description                      .
  47 c .____________________________________________________________________.
  48 c . nomet  . e   . char*  . nom etendu a traduire                      .
  49 c . champ  . e   . char8  . . si nom-etendu a plusieurs elements :     .
  50 c .        .     .        . = ' ' ou champ-terminal                    .
  51 c .        .     .        . . si nom-etendu a un seul element :        .
  52 c .        .     .        . = champ de l'objet 'nomet'                 .
  53 c . nomgen .  s  . char8  . nom genere                                 .
  54 c . codret .  s  .    1   . code de retour                             .
  55 c .        .     .        . -4 : nom-etendu invalide                   .
  56 c .        .     .        . -3 : 'nomet' n'a qu'un element et n'est    .
  57 c .        .     .        .      pas un objet structure                .
  58 c .        .     .        . -2 : 'nomet' a plusieurs elements et       .
  59 c .        .     .        .      'champ' /= '  ' et /= champ-terminal  .
  60 c .        .     .        . -1 : 'nomet' a un seul element et 'champ'  .
  61 c .        .     .        .      ne correspond pas a un champ de 'nomet.
  62 c .        .     .        .  0 : tout va bien                          .
  63 c ______________________________________________________________________
  64 c
  65 c====
  66 c 0. declarations et dimensionnement
  67 c====
  68 c
  69 c
  70 c 0.1. ==> generalites
  71 c
  72       implicit none
  73       save
  74 c
  75 #include "gmmatc.h"
  76 c
  77 c 0.2. ==> communs
  78 c
  79 #include "gmtori.h"
  80 #include "gmtoai.h"
  81 #include "gmtors.h"
  82 #include "gmtoas.h"
  83 #include "gminom.h"
  84 c
  85 #include "gmimpr.h"
  86 c
  87 c 0.3. ==> arguments
  88 c
  89       character*(*) nomet,champ
  90       character*8 nomgen
  91 c
  92       integer       codret
  93 c
  94 c 0.4. ==> variables locales
  95 c
  96       character*8 objrep, objter, chater
  97 c
  98       integer idec,ity,nbc
  99       integer nroobj
 100       integer iaux, jaux
 101 c
 102 c 0.5. ==> initialisations
 103 c
 104 #include "alphnu.h"
 105 c ______________________________________________________________________
 106 c
 107 c====
 108 c 1. decodage 'nomet'
 109 c====
 110 c
 111       codret = 0
 112 c
 113 c 1.1. ==> prgramme de decodage
 114 c
 115       call gbdnoe(nomet,objrep,objter,chater,idec)
 116 c
 117 c 1.2. ==> le nom etendu est invalide
 118 c
 119       if (idec.eq.-1) then
 120 c
 121         codret = -4
 122 c
 123 c 1.3. ==> le nom etendu n'a qu'un element
 124 c
 125       elseif (idec.eq.0) then
 126 c
 127         do 131 , iaux = 1,iptobj-1
 128           if (nomobj(iaux).eq.nomet) then
 129             nroobj = iaux
 130             goto 132
 131           endif
 132   131   continue
 133         codret = -3
 134         goto 134
 135 c
 136   132   continue
 137         ity = typobj(nroobj)
 138         nbc = nbcham(ity)
 139         do 133 , iaux = adrdst(ity),adrdst(ity)+nbc-1
 140           if (nomcha(iaux).eq.champ) then
 141             goto 134
 142           endif
 143   133   continue
 144         codret = -1
 145 c
 146   134   continue
 147 c
 148 c 1.4. ==> autres cas
 149 c
 150       else
 151 c
 152         if ( champ.ne.' ' .and. champ.ne.chater ) then
 153           codret = -2
 154         endif
 155 c
 156       endif
 157 c
 158 c====
 159 c 2. formation du nom genere
 160 c====
 161 c
 162       if ( codret.eq.0 ) then
 163 c
 164 c 2.1. ==> 4 premiers caracteres deduits du nom etendu
 165 c
 166         if (champ.eq.' ') then
 167           nomgen(1:4) = nomet(1:2)//chater(1:2)
 168         else
 169           nomgen(1:4) = nomet(1:2)//champ(1:2)
 170         endif
 171         do 21 , iaux = 1,4
 172           if (nomgen(iaux:iaux).eq.' ') then
 173             nomgen(iaux:iaux) = '$'
 174           endif
 175    21   continue
 176 c
 177 c 2.2. ==> 4 caracteres suivants
 178 c
 179         nomgen(5:8) = '0000'
 180 c
 181         indnom = indnom+1
 182 c
 183         iaux = mod(indnom,lgalnu)
 184         nomgen(8:8) = alphnu(iaux)
 185 c
 186         if ( indnom.ge.lgalnu ) then
 187 c
 188           jaux = (indnom-iaux) / lgalnu
 189           iaux = mod(jaux,lgalnu)
 190           nomgen(7:7) = alphnu(iaux)
 191 c
 192           if ( indnom.ge.lgaln2 ) then
 193 c
 194             jaux = (jaux-iaux) / lgalnu
 195             iaux = mod(jaux,lgalnu)
 196             nomgen(6:6) = alphnu(iaux)
 197 c
 198             if ( indnom.ge.lgaln3 ) then
 199               jaux = (jaux-iaux) / lgalnu
 200               iaux = mod(jaux,lgalnu)
 201               nomgen(5:5) = alphnu(iaux)
 202             endif
 203 c
 204           endif
 205 c
 206         endif
 207 c
 208       endif
 209 c
 210 c====
 211 c 3. la fin
 212 c====
 213 c
 214       if ( codret.ne.0 ) then
 215         write (ulsort,*) 'Probleme dans gbgeno'
 216         write (ulsort,*) 'Code de retour = ',codret
 217       endif
 218 c
 219       end