src/tool/Gestion_MTU/gbaloj.F

   1       subroutine gbaloj (nom,type,iret)
   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     fonction d'allocation d'un objet "nom", structure, de type
  23 c     "type"
  24 c     ...........................................................
  25 c
  26 c     entrees :
  27 c       nom   : character*8 : nom de l'objet a allouer
  28 c       type  : character*8 : nom du type de l'objet a allouer
  29 c
  30 c             ( ou chaine de 8 caracteres au plus )
  31 c
  32 c     ...........................................................
  33 c
  34 c     sorties : iret   :
  35 c       -3    : erreur : type inconnu
  36 c       -2    : erreur : il existe deja un objet de ce nom
  37 c                        (structure ou simple)
  38 c       -1    : erreur : allocation impossible :
  39 c                        dimensionnement des tables insuffisant
  40 c        0    : OK
  41 c
  42 c     ...........................................................
  43 c
  44 c 0. declarations et dimensionnement
  45 c
  46 c
  47 c 0.1. ==> generalites
  48 c
  49       implicit none
  50       save
  51 c
  52 #include "gmmatc.h"
  53 c
  54 c 0.2. ==> communs
  55 c
  56 #include "gmtori.h"
  57 #include "gmtoai.h"
  58 #include "gmtors.h"
  59 #include "gmtoas.h"
  60 c
  61 c 0.3. ==> arguments
  62 c
  63       character*(*) nom, type
  64       integer iret
  65 c
  66 c 0.4. ==> variables locales
  67 c
  68       integer ityp, ity, ioal, ityptr
  69 c
  70 c 1.  recherche du type
  71 c
  72       do 10 ity = 1, nbrtyp
  73          if (nomtyp(ity).eq.type) then
  74            ityptr = ity
  75            goto 20
  76          endif
  77    10 continue
  78 c
  79       iret = -3
  80       goto 30
  81 c
  82 c 2.  verification si cet objet existe deja
  83 c
  84    20 continue
  85 c
  86       call gbobal(nom,ityp,ioal)
  87 c
  88       if (ioal.ge.1) then
  89          iret = -2
  90          goto 30
  91       endif
  92 c
  93 c 3.  mise a jour des tables
  94 c
  95       if ( (iptobj.gt.nobjx) .or.
  96      >     (iptchp+nbcham(ity).gt.nobcx+1) .or.
  97      >     (iptatt+nbratt(ity).gt.nobcx+1)      ) then
  98          iret = -1
  99       else
 100 c
 101       nomobj(iptobj) = nom
 102       typobj(iptobj) = ityptr
 103       adrdso(iptobj) = iptchp
 104       adrdsa(iptobj) = iptatt
 105       iptobj = iptobj+1
 106       iptchp = iptchp + nbcham(ityptr)
 107       iptatt = iptatt+nbratt(ityptr)
 108 c
 109         if ((iptobj.eq.nobjx).or.(iptchp.gt.nobcx)
 110      >                       .or.(iptatt.gt.nobcx)) then
 111            iret = -1
 112         else
 113            iret = 0
 114         endif
 115       endif
 116 c
 117    30 continue
 118 c
 119       end