src/tool/Information/infomp.F

   1       subroutine infomp ( choix,  lamapo,
   2      >                    noempo, hetmpo,
   3      >                    fammpo,
   4      >                    nmpoho, nmpoca, nmpocs,
   5      >                    coonoe,
   6      >                    nbpafo, nopafo,
   7      >                    ulsost,
   8      >                    ulsort, langue, codret )
   9 c ______________________________________________________________________
  10 c
  11 c                             H O M A R D
  12 c
  13 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  14 c
  15 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  16 c aupres des huissiers de justice Simart et Lavoir a Clamart
  17 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  18 c aupres des huissiers de justice
  19 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  20 c
  21 c    HOMARD est une marque deposee d'Electricite de France
  22 c
  23 c Copyright EDF 1996
  24 c Copyright EDF 1998
  25 c Copyright EDF 2002
  26 c Copyright EDF 2020
  27 c ______________________________________________________________________
  28 c
  29 c   INFOrmation : Maille-Point
  30 c   ----          -      -
  31 c ______________________________________________________________________
  32 c .        .     .        .                                            .
  33 c .  nom   . e/s . taille .           description                      .
  34 c .____________________________________________________________________.
  35 c . choix  . e   .  ch2   . choix                                      .
  36 c . lamapo . e   .   1    . numero de la maille-point a analyser       .
  37 c . noempo . e   . nbmpto . numeros des noeuds associes aux mailles    .
  38 c . hetmpo . e   . nbmpto . historique de l'etat des maille-points     .
  39 c . fammpo . e   . nbmpto . famille des mailles-points                 .
  40 c . nmpoho . e   . rearac . numero des maille-points dans HOMARD       .
  41 c . nmpoca . e   . rearto . numero des maille-points du code de calcul .
  42 c . nmpocs . e   . rearto . numero des m-pts du calcul pour la solution.
  43 c . coonoe . e   . nbnoto . coordonnees des noeuds                     .
  44 c .        .     . * sdim .                                            .
  45 c . nbpafo . e   .   1    . nombre de paquets de fonctions             .
  46 c . nopafo . e   . nbpafo . nom des objets qui contiennent la          .
  47 c .        .     .        . description de chaque paquet de fonctions  .
  48 c . ulsost . e   .   1    . unite logique de la sortie standard        .
  49 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  50 c . langue . e   .    1   . langue des messages                        .
  51 c .        .     .        . 1 : francais, 2 : anglais                  .
  52 c . codret . es  .    1   . code de retour des modules                 .
  53 c .        .     .        . 0 : pas de probleme                        .
  54 c .        .     .        . non nul : probleme                         .
  55 c ______________________________________________________________________
  56 c
  57 c====
  58 c 0. declarations et dimensionnement
  59 c====
  60 c
  61 c 0.1. ==> generalites
  62 c
  63       implicit none
  64       save
  65 c
  66       character*6 nompro
  67       parameter ( nompro = 'INFOMP' )
  68 c
  69 #include "nblang.h"
  70 #include "consts.h"
  71 #include "meddc0.h"
  72 c
  73 c 0.2. ==> communs
  74 c
  75 #include "envex1.h"
  76 #include "inmess.h"
  77 c
  78 #include "nombno.h"
  79 #include "nombmp.h"
  80 #include "nomber.h"
  81 #include "envca1.h"
  82 #include "envada.h"
  83 c
  84 c 0.3. ==> arguments
  85 c
  86       character*2 choix
  87 c
  88       integer lamapo
  89 c
  90       integer noempo(nbmpto), hetmpo(nbmpto)
  91       integer fammpo(nbmpto)
  92       integer nmpoho(rempac), nmpoca(*), nmpocs(*)
  93       integer nbpafo
  94 c
  95       double precision coonoe(nbnoto,sdim)
  96 c
  97       character*8 nopafo(*)
  98 c
  99       integer ulsost
 100       integer ulsort, langue, codret
 101 c
 102 c 0.4. ==> variables locales
 103 c
 104       integer iaux, jaux, kaux
 105       integer numcal
 106       integer etat00, etat01
 107       integer somsup
 108       integer uldeb, ulfin, ulpas, ulecr
 109 c
 110       character*40 taux40
 111 c
 112       integer nbmess
 113       parameter ( nbmess = 10 )
 114       character*80 texte(nblang,nbmess)
 115 c ______________________________________________________________________
 116 c
 117 c====
 118 c 1. initialisation
 119 c====
 120 c
 121 #include "impr01.h"
 122 #include "infoen.h"
 123 c
 124 #ifdef _DEBUG_HOMARD_
 125       write (ulsort,texte(langue,1)) 'Entree', nompro
 126       call dmflsh (iaux)
 127 #endif
 128 c
 129       codret = 0
 130 c
 131       uldeb = min(ulsost,ulsort)
 132       ulfin = max(ulsost,ulsort)
 133       ulpas = max ( 1 , ulfin-uldeb )
 134 c
 135 c====
 136 c 2. numero de la maille-point dans HOMARD
 137 c====
 138 c
 139       if ( choix.eq.'MP' ) then
 140         iaux = lamapo
 141         if ( lamapo.gt.0 .and. lamapo.le.rearac ) then
 142           lamapo = nmpoho(iaux)
 143         else
 144           lamapo = 0
 145         endif
 146       endif
 147 c
 148 c====
 149 c 3. reponses
 150 c====
 151 c
 152       do 30 , ulecr = uldeb , ulfin, ulpas
 153 c
 154       write (ulecr,40000)
 155 c
 156 c 3.1. ==> numero de maille-point impossible
 157 c
 158       if ( lamapo.le.0 .or. lamapo.gt.nbmpto ) then
 159 c
 160         if ( choix.eq.'MP' ) then
 161           write (ulecr,40010) iaux
 162         else
 163           write (ulecr,40020) lamapo
 164         endif
 165         write (ulecr,40031)
 166 c
 167 c 3.2. ==> numero de maille-point correct
 168 c
 169       else
 170 c
 171         numcal = nmpoca(lamapo)
 172         write (ulecr,40020) lamapo
 173         write (ulecr,40010) numcal
 174 c
 175 c 3.2.1. ==> caracteristiques
 176 c
 177         write (ulecr,42000) fammpo(lamapo)
 178 c
 179 c 3.2.2. ==> etat
 180 c
 181         etat01 = mod(hetmpo(lamapo),10)
 182         etat00 = (hetmpo(lamapo)-etat01) / 10
 183 c
 184         taux40 = textmp(etat01)
 185         write (ulecr,44010)
 186         write (ulecr,40001) taux40
 187         if ( nbiter.ge.1 ) then
 188           taux40 = textmp(etat00)
 189           write (ulecr,44020)
 190           write (ulecr,40001) taux40
 191         endif
 192 c
 193 c 3.2.3. ==> le noeud support
 194 c
 195         somsup = noempo(lamapo)
 196         write (ulecr,43000) somsup
 197 c
 198 c 3.2.4. ==> la position
 199 c
 200         if ( sdim.eq.1 ) then
 201           write (ulecr,44001) coonoe(somsup,1)
 202         elseif ( sdim.eq.2 ) then
 203           write (ulecr,44002) (coonoe(somsup,iaux), iaux = 1 , sdim)
 204         else
 205           write (ulecr,44003) (coonoe(somsup,iaux), iaux = 1 , sdim)
 206         endif
 207 c
 208 c 3.2.5. ==> les valeurs des fonctions
 209 c
 210         if ( nbpafo.ne.0 .and. numcal.ne.0 ) then
 211 c
 212           iaux = edpoi1
 213           jaux = nmpocs(numcal)
 214           kaux = ulecr
 215 #ifdef _DEBUG_HOMARD_
 216       write (ulsort,texte(langue,3)) 'INFOPF', nompro
 217 #endif
 218           call infopf ( nbpafo, nopafo,
 219      >                  iaux, jaux,
 220      >                  kaux,
 221      >                  ulsort, langue, codret )
 222 c
 223         endif
 224 c
 225       endif
 226 c
 227       write (ulecr,40000)
 228 c
 229    30 continue
 230 c
 231 c===
 232 c 4. formats
 233 c===
 234 c
 235 40020 format(
 236      >  '* Maille-point numero :',i10,   ' dans HOMARD               *')
 237 c
 238 43000 format(
 239      >  '* Le noeud support est ',i10,   '                           *')
 240 c
 241 44001 format(
 242      >  '* . Position  : ',   g15.5   ,'                             *')
 243 44002 format(
 244      >  '* . Position  : ',   g15.5   ,   g15.5     ,'               *')
 245 44003 format(
 246      >  '* . Position  : ',   g14.4   ,   g14.4    ,   g14.4     ,'  *')
 247 c
 248 c====
 249 c 5. La fin
 250 c====
 251 c
 252       if ( codret.ne.0 ) then
 253 c
 254 #include "envex2.h"
 255 c
 256       write (ulsort,texte(langue,1)) 'Sortie', nompro
 257       write (ulsort,texte(langue,2)) codret
 258 c
 259       endif
 260 c
 261 #ifdef _DEBUG_HOMARD_
 262       write (ulsort,texte(langue,1)) 'Sortie', nompro
 263       call dmflsh (iaux)
 264 #endif
 265 c
 266       end