src/tool/Gestion_MTU/gmaloj.F

   1       subroutine gmaloj (nom, typobj, long, adress, 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     allocation l'objet terminal d'un nom etendu "nom"
  23 c ______________________________________________________________________
  24 c .        .     .        .                                            .
  25 c .  nom   . e/s . taille .           description                      .
  26 c .____________________________________________________________________.
  27 c . nom    . e   . char(*). nom etendu                                 .
  28 c . typobj . e   .char(*) . type de l'objet a allouer                  .
  29 c . long   . e   .   1    . 0 si on veut un objet structure            .
  30 c .        .     .        . longueur si on veut un objet simple        .
  31 c . adress .  s  . ent    . 0 si on veut un objet structure            .
  32 c .        .     .        . adresse de l'objet simple alloue           .
  33 c . codret .  s  . ent    . code retour de l'operation                 .
  34 c .        .     .        .  0 : OK                                    .
  35 c .        .     .        . -1 : dimensionnement des tables insuffisant.
  36 c .        .     .        . -2 : le type de l'objet-terminal est celui .
  37 c .        .     .        .      d'un objet structure et long /= 0     .
  38 c .        .     .        . -3 : "nom" a plus d'un element et "type" ne.
  39 c .        .     .        .      correspond pas au type du champ       .
  40 c .        .     .        .      terminal sauf si "type" = ' ' alors   .
  41 c .        .     .        .      c'est le type du champ-terminal       .
  42 c .        .     .        .      qui serait considere                  .
  43 c .        .     .        . -4 : "nom" a un seul element et "type"     .
  44 c .        .     .        .      n'est pas connu
  45 c .        .     .        . -5 : l'objet-terminal est deja alloue      .
  46 c .        .     .        . -6 : nom etendu invalide                   .
  47 c .        .     .        . -7 : premier caractere interdit            .
  48 c ______________________________________________________________________
  49 c
  50 c====
  51 c 0. declarations et dimensionnement
  52 c====
  53 c
  54 c 0.1. ==> generalites
  55 c
  56       implicit none
  57       save
  58 c
  59       character*6 nompro
  60       parameter ( nompro = 'GMALOJ' )
  61 c
  62 #include "gmcain.h"
  63 #include "genbla.h"
  64 c
  65 c 0.2. ==> communs
  66 c
  67 #include "gmimpr.h"
  68 #include "envex1.h"
  69 #include "gmlang.h"
  70 c
  71 c 0.3. ==> arguments
  72 c
  73       character*(*) nom, typobj
  74       integer       long, adress, codret
  75 c
  76 c 0.4. ==> variables locales
  77 c
  78       integer nbcain
  79       integer iaux
  80 c
  81       character*1 carint(ncainx)
  82 c
  83       integer nbmess
  84       parameter ( nbmess = 10 )
  85       character*80 texte(nblang,nbmess)
  86 c
  87 c====
  88 c 1. Initialisations
  89 c====
  90 c
  91 #include "impr01.h"
  92 c
  93 #ifdef _DEBUG_HOMARD_
  94       write (ulsort,texte(langue,1)) 'Entree', nompro
  95       call dmflsh (iaux)
  96 #endif
  97 c
  98       texte(1,4) = '(''Objet a allouer : '', a)'
  99       texte(1,5) = '(''. Type voulu : '',a)'
 100       texte(1,6) = '(''. Longueur : '',i12)'
 101 c
 102       texte(2,4) = '(''Object : '',a)'
 103       texte(2,5) = '(''. Type : '',a)'
 104       texte(2,6) = '(''. Length : '',i12)'
 105 c
 106 #ifdef _DEBUG_HOMARD_
 107       write (ulsort,texte(langue,4)) nom
 108       write (ulsort,texte(langue,5)) typobj
 109       write (ulsort,texte(langue,6)) long
 110 #endif
 111 c
 112 c====
 113 c 2. on appelle le programme generique avec interdiction de certains
 114 c    caracteres en premiere position
 115 c    de plus, on autorise tous les types de noms
 116 c====
 117 c
 118       nbcain = ncainx
 119       carint(1) = caint1
 120       if ( nbcain.ge.2 ) then
 121         carint(2) = caint2
 122       endif
 123       if ( nbcain.ge.3 ) then
 124         carint(3) = caint3
 125       endif
 126       if ( nbcain.ge.4 ) then
 127         carint(4) = caint4
 128       endif
 129 c
 130 #ifdef _DEBUG_HOMARD_
 131       write (*,*) 'Appel de gballo par gmaloj'
 132 #endif
 133       call gballo ( nom, typobj, long, adress,
 134      >              nbcain, carint, codret )
 135 c
 136 c====
 137 c 3. Fin
 138 c====
 139 c
 140       if ( codret.ne.0 ) then
 141 c
 142       write (ulsort,texte(langue,4)) nom
 143       write (ulsort,texte(langue,5)) typobj
 144       write (ulsort,texte(langue,6)) long
 145 c
 146 #include "envex2.h"
 147 c
 148       endif
 149 c
 150       end