src/tool/Gestion_MTU/gagpmc.F

   1       subroutine gagpmc ( objet,
   2      >                    ix, jx, chemin, lgchem, nbchem,
   3      >                    impopt, codret)
   4 c ______________________________________________________________________
   5 c
   6 c                             H O M A R D
   7 c
   8 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   9 c
  10 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  11 c aupres des huissiers de justice Simart et Lavoir a Clamart
  12 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  13 c aupres des huissiers de justice
  14 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  15 c
  16 c    HOMARD est une marque deposee d'Electricite de France
  17 c
  18 c Copyright EDF 1996
  19 c Copyright EDF 1998
  20 c Copyright EDF 2002
  21 c Copyright EDF 2020
  22 c ______________________________________________________________________
  23 c
  24 c     construction du graphe d'un objet structure
  25 c     en memoire centrale
  26 c ______________________________________________________________________
  27 c .        .     .        .                                            .
  28 c .  nom   . e/s . taille .           description                      .
  29 c .____________________________________________________________________.
  30 c . objet  . e   .  ch8   . nom de l'objet dont on doit construire le  .
  31 c .        .     .        . graphe                                     .
  32 c . ix,jx  . e   .   1    . dimension du tableau chemin(.,.)           .
  33 c . chemin .  s  .(ix,jx) . tableau des chemins du graphe de l'objet   .
  34 c . lgchem .  s  .  ix    . longueur des chemins                       .
  35 c . nbchem .  s  .   1    . nombre de chemins                          .
  36 c . impopt . e   .   1    . 1 : on imprime le graphe ; 0 : non         .
  37 c . codret .  s  .   1    . code de retour :                           .
  38 c .        .     .        .  0    : OK                                 .
  39 c .        .     .        . -1    : dimensionnement insuffisant        .
  40 c .        .     .        . -2    : objet non structure                .
  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       character*6 nompro
  52       parameter ( nompro = 'GAGPMC' )
  53 c
  54 c
  55 #include "genbla.h"
  56 c
  57 #include "gmmaxt.h"
  58 #include "gmmatc.h"
  59 c
  60 c 0.2. ==> communs
  61 c
  62 #include "gmtoai.h"
  63 #include "gmtoas.h"
  64 c
  65 #include "gmtrrl.h"
  66 #include "gmtren.h"
  67 #include "gmtrst.h"
  68 c
  69 #include "gmalrl.h"
  70 #include "gmalen.h"
  71 #include "gmalst.h"
  72 c
  73 #include "gmimpr.h"
  74 #include "gmlang.h"
  75 c
  76 c 0.3. ==> arguments
  77 c
  78       integer ix,jx,nbchem, impopt, codret
  79       integer lgchem(ix)
  80 c
  81       character*(*) objet
  82       character*8 chemin(ix,jx)
  83 c
  84       integer nbmess
  85       parameter ( nbmess = 10 )
  86       character*80 texte(nblang,nbmess)
  87 c
  88 c 0.4. ==> variables locales
  89 c
  90 #ifdef _DEBUG_HOMARD_
  91       integer iaux
  92 #endif
  93 c
  94       integer nbrobj, nbrcha
  95 c
  96 c 0.5. ==> initialisations
  97 c ______________________________________________________________________
  98 c
  99 c====
 100 c 1. messages
 101 c====
 102 c
 103 #include "impr01.h"
 104 c
 105 #ifdef _DEBUG_HOMARD_
 106       write (ulsort,texte(langue,1)) 'Entree', nompro
 107       call dmflsh (iaux)
 108 #endif
 109 c
 110       texte(1,10) =
 111      > '(/,''=======> graphe VTOC-MC de '',a8,'' <========'',/)'
 112 c
 113       texte(2,10) =
 114      > '(/,''=======> graph VTOC-CM of '',a8,'' <========'',/)'
 115 #ifdef _DEBUG_HOMARD_
 116       write (ulsort,90000)
 117         write (ulsort,texte(langue,1)) 'Sortie', nompro
 118 90000 format (70('='))
 119 #endif
 120 c
 121 c====
 122 c 2. appel du programme generique
 123 c====
 124 c
 125       if (impopt.eq.1) then
 126         write (ulsort,texte(langue,10)) objet
 127       endif
 128 c
 129       nbrobj = iptobj-1
 130       nbrcha = iptchp-1
 131       call gagpmf ( objet, chemin, lgchem, nbchem,
 132      >              ix, jx, nbrobj, nbrcha,
 133      >              nomobj, typobj, adrdso, nomobc,
 134      >              nballi, nomali,
 135      >              nballr, nomalr,
 136      >              nballs, nomals,
 137      >              impopt, codret)
 138 c
 139       if (impopt.eq.1) then
 140         write (ulsort,texte(langue,10)) objet
 141       endif
 142 c
 143 #ifdef _DEBUG_HOMARD_
 144       write (ulsort,90000)
 145 #endif
 146 c
 147       end