src/tool/Gestion_MTU/gbdnoe.F

   1       subroutine gbdnoe (nome,objrep,objter,chater,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     decodage d'un nom etentu 'nome' pour determiner
  23 c     l'objet-repertoire,l'objet-terminal et le champ-terminal
  24 c     (contexte MC)
  25 c     ...........................................................
  26 c
  27 c     entrees :
  28 c       nome  : character*(*) : nom etendu a decoder
  29 c
  30 c     ...........................................................
  31 c
  32 c     sorties :
  33 c     objrep  : character*8 : objet repertoire
  34 c     objter  : character*8 : objet terminal
  35 c     chater  : character*8 : champ terminal
  36 c     codret  : code de retour :
  37 c       -1    : erreur : nom etendu non valide
  38 c        0    : OK     : nom etendu n'a qu'un element :
  39 c                        objter = nome
  40 c                        objrep = '        '
  41 c                        chater = '        '
  42 c        1    : OK     : objet-terminal non defini :
  43 c                        aucun objet n'a ete attache au
  44 c                        champ-terminal dans l'objet-repertoire ;
  45 c                        objter = indefini
  46 c        2    : OK     : objet-terminal defini mais non alloue
  47 c        3    : OK     : objet-terminal defini et alloue
  48 c
  49 c     ...........................................................
  50 c
  51 c====
  52 c 0. declarations et dimensionnement
  53 c====
  54 c
  55 c 0.1. ==> generalites
  56 c
  57       implicit none
  58       save
  59 c
  60       character*6 nompro
  61       parameter ( nompro = 'GBDNOE' )
  62 c
  63 c 0.2. ==> communs
  64 c
  65 #include "gminds.h"
  66 #include "gmcoer.h"
  67 #ifdef _DEBUG_HOMARD_
  68 #include "gmimpr.h"
  69 #endif
  70 c
  71 c 0.3. ==> arguments
  72 c
  73       character*(*) nome
  74       character*8   objrep,objter,chater
  75 c
  76       integer codret
  77 c
  78 c 0.4. ==> variables locales
  79 c
  80 #include "gmnelx.h"
  81 c
  82       character*1 sepa(4)
  83       character*8 nomfis
  84       character*80 elem(nelx)
  85 c
  86       integer lelm(nelx),nelm,lgtot,ns
  87       integer ipart,i,iel,codref,ityp,codrel
  88 c
  89 c 0.5. ==> initialisations
  90 c
  91       data sepa /'.' , ' ' , ' ' , ' '/
  92 c ______________________________________________________________________
  93 c
  94 c====
  95 c 1.  decomposition du nom-etendu
  96 c====
  97 c
  98 c 1.1. ==> recherche des differents champs du nom etendu
  99 c          seul le premier separateur, '.', est pris en compte
 100 c
 101       ns = 1
 102       call gbpart(nome,elem,lelm,nelm,lgtot,sepa,ns,ipart)
 103 c
 104       if (ipart.eq.-1) then
 105          codret = -1
 106          goto 9999
 107       endif
 108 c
 109 c 1.2. ==> longueur des noms de chacun des champs <= 8
 110 c
 111       do 12 , i = 1,nelm
 112          if (lelm(i).gt.8) then
 113             codret = -1
 114             goto 9999
 115          endif
 116    12 continue
 117 c
 118 c 1.3. ==> c'est une tete
 119 c
 120       if (nelm.eq.1) then
 121 c
 122          objter = elem(1)(1:8)
 123          objrep = '        '
 124          chater = '        '
 125          codret = 0
 126 c
 127       else
 128 c
 129 c 1.4. ==> reperage des noms des differents champs
 130 c
 131          objrep = elem(1)(1:8)
 132          do 14 iel = 2,nelm-1
 133             call gbdnof(objrep,elem(iel),nomfis,codref)
 134             objrep = nomfis
 135             if (codref.lt.0) then
 136                codret = -1
 137                goto 9999
 138             endif
 139    14    continue
 140 c
 141 c 1.5. ==> pour le dernier champ
 142 c
 143          chater = elem(nelm)(1:8)
 144          call gbdnof(objrep,elem(iel),objter,codref)
 145 c
 146          if (codref.eq.-1) then
 147 c
 148             objter = sindef
 149             codret = 1
 150 c
 151          else if (codref.eq.0) then
 152 c
 153             call gbobal(objter,ityp,codrel)
 154 #ifdef _DEBUG_HOMARD_
 155       write (ulsort,*) 'apres gbobal ; codrel = ', codrel
 156 #endif
 157             if (codrel.ge.1) then
 158                codret = 3
 159             else
 160                codret = 2
 161             endif
 162 c
 163          else
 164 c
 165             codret = -1
 166 c
 167          endif
 168 c
 169       endif
 170 c
 171 c 1.6. ==> sortie
 172 c
 173  9999 continue
 174 c
 175 #ifdef _DEBUG_HOMARD_
 176       if ( codret.eq.-1 ) then
 177          write (ulsort,*) 'Probleme dans ', nompro, ' :'
 178          write (ulsort,*) 'Ce nom etendu est invalide : ', nome
 179       endif
 180 #endif
 181 c
 182       end