src/tool/Gestion_MTU/gmdtoj.F

   1       subroutine gmdtoj ( 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     detacher l'objet terminal d'un nom etendu "nom" de son
  23 c     support (sans suppression de cet objet)
  24 c     ...........................................................
  25 c
  26 c     entrees  :
  27 c        nom   : character*(*) : nom etendu
  28 c
  29 c     sorties  : codret   : code de retour :
  30 c       -5     : erreur : champ introuvable dans les tables
  31 c       -4     : erreur : support introuvable dans les tables
  32 c       -3     : erreur : nom etendu invalide
  33 c       -2     : erreur : objet-terminal non defini
  34 c       -1     : erreur : nom a un seul element
  35 c        0     : OK
  36 c     ...........................................................
  37 c
  38 c 0. declarations et dimensionnement
  39 c
  40 c
  41 c 0.1. ==> generalites
  42 c
  43       implicit none
  44       save
  45 c
  46       character*6 nompro
  47       parameter ( nompro = 'GMDTOJ' )
  48 c
  49 #include "genbla.h"
  50 #include "gmmatc.h"
  51 c
  52 c 0.2. ==> communs
  53 c
  54 #include "gmimpr.h"
  55 #include "envex1.h"
  56 #include "gmlang.h"
  57 #include "gmcoer.h"
  58 c
  59 c 0.3. ==> arguments
  60 c
  61       character*(*) nom
  62 c
  63       integer codret
  64 c
  65 c 0.4. ==> variables locales
  66 c
  67       character*8   objrep,objter,chater
  68       integer idec
  69       integer iaux
  70 c
  71       integer nbmess
  72       parameter ( nbmess = 10 )
  73       character*80 texte(nblang,nbmess)
  74 c
  75 c====
  76 c 1. initialisations
  77 c====
  78 c
  79 #include "impr01.h"
  80 c
  81 #ifdef _DEBUG_HOMARD_
  82       write (ulsort,texte(langue,1)) 'Entree', nompro
  83       call dmflsh (iaux)
  84 #endif
  85 c
  86 c====
  87 c 2.  decodage du nom etendu
  88 c====
  89 #ifdef _DEBUG_HOMARD_
  90       write (ulsort,*) '2.  decodage du nom etendu ; coergm = ', coergm
  91 #endif
  92 c
  93 c 2.1. ==> decodage du nom etendu
  94 c
  95       call gbdnoe(nom,objrep,objter,chater,idec)
  96 c
  97 c 2.2. ==> nom etendu invalide
  98 c
  99       if (idec.lt.0) then
 100 c
 101         codret = -3
 102 c
 103 c 2.3. ==> objet-terminal non defini
 104 c
 105       else if (idec.eq.1) then
 106 c
 107         codret = -2
 108 c
 109 c 2.4. ==> nom etendu a un seul element
 110 c
 111       else if (idec.eq.0) then
 112 c
 113         codret = -1
 114 c
 115       else
 116 c
 117         codret = 0
 118 c
 119       endif
 120 c
 121 c====
 122 c 3. appel du programme generique
 123 c====
 124 #ifdef _DEBUG_HOMARD_
 125       write (ulsort,*) '3. programme generique ; codret = ', codret
 126       write (ulsort,*) '3. programme generique ; coergm = ', coergm
 127 #endif
 128 c
 129       if ( codret.eq.0 ) then
 130 c
 131         call gbdtoj ( objrep, objter )
 132         codret = coergm
 133 c
 134       endif
 135 c
 136 c====
 137 c 4. Fin
 138 c====
 139 c
 140       if ( codret.ne.0 ) then
 141 c
 142 #include "envex2.h"
 143 c
 144       endif
 145 c
 146       end