src/tool/Utilitaire/utad21.F

   1       subroutine utad21 ( nhnoeu,
   2      >                    adcoor, adhist, adarno,
   3      >                    adhono, addera,
   4      >                    adcoco, adinfg,
   5      >                    adreco,
   6      >                    adfami, adcofa,
   7      >                    ulsort, langue, codret )
   8 c ______________________________________________________________________
   9 c
  10 c                             H O M A R D
  11 c
  12 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  13 c
  14 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  15 c aupres des huissiers de justice Simart et Lavoir a Clamart
  16 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  17 c aupres des huissiers de justice
  18 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  19 c
  20 c    HOMARD est une marque deposee d'Electricite de France
  21 c
  22 c Copyright EDF 1996
  23 c Copyright EDF 1998
  24 c Copyright EDF 2002
  25 c Copyright EDF 2020
  26 c ______________________________________________________________________
  27 c
  28 c    UTilitaire - ADresses - phase 21
  29 c    --           --               --
  30 c ______________________________________________________________________
  31 c   Recuperation des adresses des tableaux pour les noeuds HOM_Noeu
  32 c   Attention : Si le tableau est absent ou de longueur nulle, on
  33 c               retourne une adresse valant 0. C'est une valeur
  34 c               impossible car cela voudrait dire que malloc a reserve
  35 c               une place exactement la ou est le common.
  36 c ______________________________________________________________________
  37 c .        .     .        .                                            .
  38 c .  nom   . e/s . taille .           description                      .
  39 c .____________________________________________________________________.
  40 c . nhnoeu . e   . char8  . nom de l'objet decrivant l'entite          .
  41 c . adhist .   s  .  1    . historique de l'etat                       .
  42 c . adfami .   s  .  1    . famille des noeuds                         .
  43 c . adcofa .   s  .  1    . codes des familles des noeuds              .
  44 c . adcoor .   s  .  1    . coordonnees                                .
  45 c . adarno .   s  .  1    . arete supportant le noeud                  .
  46 c . adhono .   s  .  1    . homologue du noeud                         .
  47 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  48 c . langue . e   .    1   . langue des messages                        .
  49 c .        .     .        . 1 : francais, 2 : anglais                  .
  50 c . codret . es  .    1   . code de retour des modules                 .
  51 c ______________________________________________________________________
  52 c
  53 c====
  54 c 0. declarations et dimensionnement
  55 c====
  56 c
  57 c 0.1. ==> generalites
  58 c
  59       implicit none
  60       save
  61 c
  62       character*6 nompro
  63       parameter ( nompro = 'UTAD21' )
  64 c
  65 #include "nblang.h"
  66 c
  67 c 0.2. ==> communs
  68 c
  69 #include "envex1.h"
  70 c
  71 c 0.3. ==> arguments
  72 c
  73       character*8 nhnoeu
  74 c
  75       integer adcoor, adhist, adarno
  76       integer adhono, addera
  77       integer adcoco, adinfg
  78       integer adreco
  79       integer adfami, adcofa
  80 c
  81       integer ulsort, langue, codret
  82 c
  83 c 0.4. ==> variables locales
  84 c
  85       integer iaux, jaux, kaux
  86       integer codre0
  87 c
  88       character*16 saux16
  89 c
  90       integer nbmess
  91       parameter ( nbmess = 10 )
  92       character*80 texte(nblang,nbmess)
  93 c
  94 c 0.5. ==> initialisations
  95 c ______________________________________________________________________
  96 c
  97 c====
  98 c 1. messages
  99 c====
 100 c
 101 c 1.3. ==> les messages
 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,4) = '(''Adresses relatives aux noeuds'')'
 111 c
 112       texte(2,4) = '(''Adresses for nodes'')'
 113 c
 114 #ifdef _DEBUG_HOMARD_
 115       write (ulsort,texte(langue,4))
 116 ccc      call gmprsx(nompro,nhnoeu)
 117 #endif
 118 c
 119       codret = 0
 120 c
 121 c====
 122 c 2. Reperage des tableaux
 123 c    On explore tous ceux possibles dans HOM_Noeu (cf. typobj.stu)
 124 c====
 125 c
 126       do 21 , iaux = 1 , 10
 127 c
 128 c 2.1. ==> Le nom de la iaux-ieme branche
 129 c
 130         if ( codret.eq.0 ) then
 131 c
 132 c                   1234567890123456
 133         if ( iaux.eq.1 ) then
 134           saux16 = 'Coor            '
 135         elseif ( iaux.eq.2 ) then
 136           saux16 = 'HistEtat        '
 137         elseif ( iaux.eq.3 ) then
 138           saux16 = 'AretSupp        '
 139         elseif ( iaux.eq.4 ) then
 140           saux16 = 'Homologu        '
 141         elseif ( iaux.eq.5 ) then
 142           saux16 = 'Deraffin '
 143         elseif ( iaux.eq.6 ) then
 144           saux16 = 'CoorCons        '
 145         elseif ( iaux.eq.7 ) then
 146           saux16 = 'InfoGene        '
 147         elseif ( iaux.eq.8 ) then
 148           saux16 = 'Recollem        '
 149         elseif ( iaux.eq.9 ) then
 150           saux16 = 'Famille.EntiFamm'
 151         elseif ( iaux.eq.10 ) then
 152           saux16 = 'Famille.Codes   '
 153         endif
 154 c
 155         endif
 156 c
 157 c 2.2. ==> Recherche du tableau
 158 c
 159         if ( codret.eq.0 ) then
 160 c
 161 c 2.2.1. ==> Existence du tableau
 162 c
 163         call gmobal ( nhnoeu//'.'//saux16, codre0 )
 164 c
 165 c 2.2.1. ==> Le tableau existe : quelles adresse et longueur ?
 166 c
 167         if ( codre0.eq.2 ) then
 168 c
 169           call gmadoj ( nhnoeu//'.'//saux16, jaux, kaux, codre0 )
 170 c
 171           if ( codre0.eq.0 ) then
 172             if ( kaux.eq.0 ) then
 173               jaux = 0
 174             endif
 175           else
 176             codret = codret + 1
 177           endif
 178 c
 179 c 2.2.2. ==> Probleme
 180 c
 181         elseif ( codre0.ne.0 ) then
 182           codret = codret + 1
 183 c
 184 c 2.2.3. ==> Le tableau n'existe pas
 185 c
 186         else
 187           jaux = 0
 188         endif
 189 c
 190         endif
 191 c
 192 c 2.3. ==> Stockage de l'adresse et eventuellement de la longueur
 193 c
 194         if ( codret.eq.0 ) then
 195 c
 196         if ( iaux.eq.1 ) then
 197           adcoor = jaux
 198         elseif ( iaux.eq.2 ) then
 199           adhist = jaux
 200         elseif ( iaux.eq.3 ) then
 201           adarno = jaux
 202         elseif ( iaux.eq.4 ) then
 203           adhono = jaux
 204         elseif ( iaux.eq.5 ) then
 205           addera = jaux
 206         elseif ( iaux.eq.6 ) then
 207           adcoco = jaux
 208         elseif ( iaux.eq.7 ) then
 209           adinfg = jaux
 210         elseif ( iaux.eq.8 ) then
 211           adreco = jaux
 212         elseif ( iaux.eq.9 ) then
 213           adfami = jaux
 214         elseif ( iaux.eq.10 ) then
 215           adcofa = jaux
 216         endif
 217 c
 218         endif
 219 c
 220    21 continue
 221 c
 222 c====
 223 c 3. la fin
 224 c====
 225 c
 226       if ( codret.ne.0 ) then
 227 c
 228 #include "envex2.h"
 229 c
 230       write (ulsort,texte(langue,1)) 'Sortie', nompro
 231       write (ulsort,texte(langue,2)) codret
 232 c
 233       endif
 234 c
 235 #ifdef _DEBUG_HOMARD_
 236       write (ulsort,texte(langue,1)) 'Sortie', nompro
 237       call dmflsh (iaux)
 238 #endif
 239 c
 240       end