src/tool/Utilitaire/utimpg.F

   1       subroutine utimpg ( choix, ngauss, nbnorf, sdim,
   2      >                    conorf, copgrf, wipg,
   3      >                    ulsort, langue, 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    UTilitaire - IMpressions relatives aux Points de Gauss
  25 c    --           --                        -         -
  26 c ______________________________________________________________________
  27 c .        .     .        .                                            .
  28 c .  nom   . e/s . taille .           description                      .
  29 c .____________________________________________________________________.
  30 c . choix  . e   .   1    . choix des impressions                      .
  31 c .        .     .        . 2n : les localisations de l'element de     .
  32 c .        .     .        .      reference                             .
  33 c .        .     .        . 3n : les fonctions de forme                .
  34 c . ngauss . e   .   1    . nbre de points de Gauss des fonctions pg   .
  35 c . nbnorf . e   .   1    . nbre de noeuds de l'element de reference   .
  36 c . sdim   . e   .   1    . dimension de l'element de reference        .
  37 c . conorf . e   .  sdim* . coordonnees des noeuds de l'element de     .
  38 c .        .     . nbnorf . reference                                  .
  39 c . copgrf . e   .  sdim* . coordonnees des points de Gauss            .
  40 c .        .     . ngauss . de l'element de reference                  .
  41 c . wipg   .   s . nbnorf*. fonctions de forme exprimees aux points de .
  42 c .        .     . ngauss . Gauss                                      .
  43 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  44 c . langue . e   .    1   . langue des messages                        .
  45 c .        .     .        . 1 : francais, 2 : anglais                  .
  46 c . codret . es  .    1   . code de retour des modules                 .
  47 c .        .     .        . 0 : pas de probleme                        .
  48 c .        .     .        . 1 : probleme                               .
  49 c ______________________________________________________________________
  50 c
  51 c====
  52 c 0. declarations et dimensionnement
  53 c====
  54 c
  55 c 0.1. ==> generalites
  56 c
  57       implicit none
  58       save
  59 c
  60       character*6 nompro
  61       parameter ( nompro = 'UTIMPG' )
  62 c
  63 #include "nblang.h"
  64 c
  65 c 0.2. ==> communs
  66 c
  67 #include "envex1.h"
  68 c
  69 c 0.3. ==> arguments
  70 c
  71       integer choix
  72       integer ngauss, nbnorf, sdim
  73 c
  74       double precision conorf(sdim,nbnorf), copgrf(sdim,ngauss)
  75       double precision wipg(nbnorf,ngauss)
  76 c
  77       integer ulsort, langue, codret
  78 c
  79 c 0.4. ==> variables locales
  80 c
  81       integer iaux, jaux
  82 c
  83       integer nbmess
  84       parameter ( nbmess = 10 )
  85       character*80 texte(nblang,nbmess)
  86 c
  87 c 0.5. ==> initialisations
  88 c ______________________________________________________________________
  89 c
  90 c====
  91 c 1. initialisations
  92 c====
  93 c
  94 #include "impr01.h"
  95 c
  96 #ifdef _DEBUG_HOMARD_
  97       write (ulsort,texte(langue,1)) 'Entree', nompro
  98       call dmflsh (iaux)
  99 #endif
 100 c
 101       codret = 0
 102 c
 103       if ( choix.gt.0 ) then
 104 c
 105 c====
 106 c 2. Ecriture des localisations
 107 c====
 108 c
 109       if ( mod(choix,2).eq.0 ) then
 110 c
 111 c 2.1. ==> dimension 1
 112 c
 113         if ( sdim.eq.1 ) then
 114 c                            123456789012345
 115           write (ulsort,20001) 'noeuds         '
 116           do 2011 , iaux = 1 , nbnorf
 117             write (ulsort,20011) iaux, conorf(1,iaux)
 118  2011     continue
 119           write (ulsort,20021)
 120           write (ulsort,20001) 'points de Gauss'
 121           do 2021 , iaux = 1 , ngauss
 122             write (ulsort,20011) iaux, copgrf(1,iaux)
 123  2021     continue
 124           write (ulsort,20021)
 125 c
 126 c 2.2. ==> dimension 2
 127 c
 128         elseif ( sdim.eq.2 ) then
 129 c
 130           write (ulsort,20002) 'noeuds         '
 131           do 2012 , iaux = 1 , nbnorf
 132             write (ulsort,20012) iaux, conorf(1,iaux), conorf(2,iaux)
 133  2012     continue
 134           write (ulsort,20022)
 135           write (ulsort,20002) 'points de Gauss'
 136           do 2022 , iaux = 1 , ngauss
 137             write (ulsort,20012) iaux, copgrf(1,iaux), copgrf(2,iaux)
 138  2022     continue
 139           write (ulsort,20022)
 140 c
 141 c 2.3. ==> dimension 3
 142 c
 143         else
 144 c
 145           write (ulsort,20003) 'noeuds         '
 146           do 2013 , iaux = 1 , nbnorf
 147             write (ulsort,20013) iaux, conorf(1,iaux), conorf(2,iaux),
 148      >                           conorf(3,iaux)
 149  2013     continue
 150           write (ulsort,20023)
 151           write (ulsort,20003) 'points de Gauss'
 152           do 2023 , iaux = 1 , ngauss
 153             write (ulsort,20013) iaux, copgrf(1,iaux), copgrf(2,iaux),
 154      >                           copgrf(3,iaux)
 155  2023     continue
 156           write (ulsort,20023)
 157         endif
 158 c
 159 20001 format(
 160      >/,28('*'),
 161      >/,'*      Coordonnees des     *',
 162      >/,'*      ',a15        ,'     *',
 163      >/,28('*'),
 164      >/,'*  Numero  *       x       *',
 165      >/,28('*'))
 166 20002 format(
 167      >/,44('*'),
 168      >/,'*       Coordonnees des ',a15        ,'    *',
 169      >/,44('*'),
 170      >/,'*  Numero  *       x       *       y       *',
 171      >/,44('*'))
 172 20003 format(
 173      >/,60('*'),
 174      >/,'*            Coordonnees des ',a15         ,
 175      >'               *',
 176      >/,60('*'),
 177      >/,'*  Numero  *       x       *       y       *',
 178      >'       z       *',
 179      >/,60('*'))
 180 20011 format('* ',i5,'    *  ',g11.5,'  *')
 181 20012 format('* ',i5,2x,2('  *  ',g11.5),'  *')
 182 20013 format('* ',i5,2x,3('  *  ',g11.5),'  *')
 183 20021 format(28('*'))
 184 20022 format(44('*'))
 185 20023 format(60('*'))
 186 c
 187 c====
 188 c 3. Ecriture des fonctions de forme aux points de Gauss
 189 c====
 190 c
 191       elseif ( mod(choix,3).eq.0 ) then
 192 c                            123456789012345
 193         do 3011 , iaux = 1 , nbnorf
 194           write (ulsort,30001) iaux
 195           do 3021 , jaux = 1 , ngauss
 196             write (ulsort,20011) jaux, wipg(iaux,jaux)
 197  3021     continue
 198           write (ulsort,20021)
 199  3011   continue
 200 c
 201       endif
 202 c
 203 c        123456789012345678901234567890
 204 30001 format(
 205      >/,28('*'),
 206      >/,'*  Fonction associee au    *',
 207      >/,'*  noeud numero',  i8,'    *',
 208      >/,28('*'),
 209      >/,'* Point de *     Valeur    *',
 210      >/,'*  Gauss   *               *',
 211      >/,28('*'))
 212 c
 213       endif
 214 c
 215 c====
 216 c 4. la fin
 217 c====
 218 c
 219       if ( codret.ne.0 ) then
 220 c
 221 #include "envex2.h"
 222 c
 223       write (ulsort,texte(langue,1)) 'Sortie', nompro
 224       write (ulsort,texte(langue,2)) codret
 225 c
 226       endif
 227 c
 228 #ifdef _DEBUG_HOMARD_
 229       write (ulsort,texte(langue,1)) 'Sortie', nompro
 230       call dmflsh (iaux)
 231 #endif
 232 c
 233       end