src/tool/Gestion_MTU/gmlboj.F

   1       subroutine gmlboj ( nom, 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     liberation de l'objet terminal de nom etendu "nom"
  23 c     tous les attachements de l'objet sont supprimes
  24 c ______________________________________________________________________
  25 c .        .     .        .                                            .
  26 c .  nom   . e/s . taille .           description                      .
  27 c .____________________________________________________________________.
  28 c . nom    . e   .char(*) . nom etendu de l'objet a liberer            .
  29 c . codret .  s  . ent    . code retour de l'operation                 .
  30 c .        .     .        .  1 : nom d'objet temporaire inconnu        .
  31 c .        .     .        .  0 : OK                                    .
  32 c .        .     .        . -1 : objet-terminal non alloue             .
  33 c .        .     .        . -2 : objet-terminal non defini             .
  34 c .        .     .        . -3 : nom etendu invalide                   .
  35 c .        .     .        . -4 : support introuvable dans les tables   .
  36 c .        .     .        . -5 : champ introuvable dans les tables     .
  37 c ______________________________________________________________________
  38 c
  39 c====
  40 c 0. declarations et dimensionnement
  41 c====
  42 c
  43 c 0.1. ==> generalites
  44 c
  45       implicit none
  46       save
  47 c
  48       character*6 nompro
  49       parameter ( nompro = 'GMLBOJ' )
  50 c
  51 #include "genbla.h"
  52 #include "gmcain.h"
  53 c
  54 c 0.2. ==> communs
  55 c
  56 #include "gmimpr.h"
  57 #include "envex1.h"
  58 #include "gmlang.h"
  59 #include "gmcoer.h"
  60 c
  61 c 0.3. ==> arguments
  62 c
  63       character*(*) nom
  64 c
  65       integer codret
  66 c
  67 c 0.4. ==> variables locales
  68 c
  69       character*8 nomaux
  70       character*8 objrep, objter, chater
  71 c
  72       integer iaux
  73       integer idec
  74       integer icar, imin, imax
  75 c
  76       integer nbmess
  77       parameter ( nbmess = 10 )
  78       character*80 texte(nblang,nbmess)
  79 c
  80 c====
  81 c 1. initialisations
  82 c====
  83 c
  84 #include "impr01.h"
  85 c
  86 #ifdef _DEBUG_HOMARD_
  87       write (ulsort,texte(langue,1)) 'Entree', nompro
  88       call dmflsh (iaux)
  89 #endif
  90 c====
  91 c 1.  decodage du nom etendu
  92 c====
  93 c
  94       call gbdnoe(nom,objrep,objter,chater,idec)
  95 c
  96       if (idec.lt.0) then
  97 c
  98 c        nom etendu invalide
  99 c
 100          codret = -3
 101 c
 102       else if (idec.eq.1) then
 103 c
 104 c        objet-terminal non defini
 105 c
 106          codret = -2
 107 c
 108       else if (idec.eq.2) then
 109 c
 110 c        objet-terminal defini mais non alloue
 111 c
 112          codret = -1
 113 c
 114       else
 115 c
 116 c====
 117 c 2. liberation de l'objet alloue
 118 c    detachement de l'objet de tous ses supports
 119 c    si c'est un objet temporaire et que c'est une tete, on le raye
 120 c    de la liste
 121 c====
 122 c
 123         call gblboj ( objter )
 124 c
 125         if ( coergm.eq.0 ) then
 126 c
 127           nomaux = '        '
 128           call gbdtoj ( nomaux, objter )
 129           codret = coergm
 130 c
 131         else
 132 c
 133           codret = coergm
 134 c
 135         endif
 136 c
 137         if ( idec.eq.0 .and. codret.eq.0 ) then
 138 c
 139           if ( nom(1:1).eq.caint1 ) then
 140 c
 141 c avant de supprimer le nom de la liste des noms d'objets temporaires,
 142 c on verifie que le nom (terminal) a bien la structure d'un nom
 143 c temporaire : un certain nombre (>0) de caracteres caint1 (% a priori),
 144 c suivis d'un entier (le tout, code sur 8 caracteres).
 145 c
 146             imin = 2
 147             imax = 11
 148             do 20 icar = 2, 8
 149               iaux = index('0123456789'//caint1, objter(icar:icar))
 150               if (iaux.lt.imin.or.iaux.gt.imax) then
 151                 goto 21
 152               else
 153                 if (iaux.ne.11) then
 154                   imin = 1
 155                   imax = 10
 156                 endif
 157               endif
 158    20       continue
 159             if (imax.ne.11) then
 160               call gbntde ( objter , iaux )
 161             endif
 162           endif
 163 c
 164         endif
 165 c
 166       endif
 167 c
 168    21 continue
 169 c
 170 c====
 171 c 4. Fin
 172 c====
 173 c
 174       if ( codret.ne.0 ) then
 175 c
 176 #include "envex2.h"
 177 c
 178       endif
 179 c
 180       end