src/tool/Gestion_MTU/gmdmpt.F

   1       subroutine gmdmpt  ( choix, gmimp )
   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     sous programme d'impression de toutes les tables servant
  23 c     a la gestion des objets structures en memoire centrale
  24 c ______________________________________________________________________
  25 c .        .     .        .                                            .
  26 c .  nom   . e/s . taille .           description                      .
  27 c .____________________________________________________________________.
  28 c . choix  . e   . ent    . type d'impression                          .
  29 c .        .     .        . 1 : le dictionnaire des structures         .
  30 c .        .     .        . 2 : les objets structures presents         .
  31 c . gmimp  . e   .    1   . 0 => pas d'impression                      .
  32 c .        .     .        . <=2 => impression simple                   .
  33 c .        .     .        . >2 => impression etendue                   .
  34 c ______________________________________________________________________
  35 c
  36 c====
  37 c 0. declarations et dimensionnement
  38 c====
  39 c
  40 c 0.1. ==> generalites
  41 c
  42       implicit none
  43       save
  44 c
  45 #include "gmmatc.h"
  46 c
  47 c 0.2. ==> communs
  48 c
  49 #include "gmtori.h"
  50 #include "gmtoai.h"
  51 #include "gmtors.h"
  52 #include "gmtoas.h"
  53 #include "gmimpr.h"
  54 c
  55 c 0.3. ==> arguments
  56 c
  57       integer choix
  58       integer gmimp
  59 c
  60 c 0.4. ==> variables locales
  61 c
  62       character*8 nomf
  63       integer     i,j,ityp,ity,nba,iat,nbc,iad,k,l
  64 c
  65 c 0.5. ==> initialisations
  66 c
  67 c ______________________________________________________________________
  68 c
  69 c====
  70 c 1. les structures declarees
  71 c====
  72 c
  73       if ( gmimp.gt.0 ) then
  74 c
  75       if ( choix.eq.1 ) then
  76 c
  77       write(ulsort,*) ' '
  78       write(ulsort,*) ' '
  79       write(ulsort,*) ' '
  80       write(ulsort,*) ' * Impression des tables des objets structures *'
  81       write(ulsort,*) ' ==============================================='
  82       write(ulsort,*) ' '
  83       write(ulsort,*) ' Etat des tables des structures declarees '
  84       write(ulsort,*) ' ---------------------------------------- '
  85       write(ulsort,*) ' '
  86 c
  87     1 format(1x,i3,a,a8)
  88     2 format(4x,a,i8)
  89     3 format(4x,a,a8,' -> ',i8)
  90     4 format(4x,a,a8)
  91 c
  92       write(ulsort,*) ' Nombre de types de structure = ',nbrtyp
  93       write(ulsort,*) ' '
  94       do 10 , i = 1,nbrtyp
  95          write(ulsort,*) ' '
  96          write(ulsort,1) i,' -> nom     du type   =  ',nomtyp(i)
  97          write(ulsort,*) ' '
  98          write(ulsort,2)   '    nombre  de attri  =  ',nbratt(i)
  99          write(ulsort,2)   '    nombre  de champ  =  ',nbcham(i)
 100          write(ulsort,2)   '    adresse de champ  =  ',adrdst(i)
 101          write(ulsort,*) ' '
 102         if ( gmimp.gt.2 ) then
 103         do 11 , j = adrdst(i),adrdst(i)+nbcham(i)-1
 104             write(ulsort,3) ' -> -> nom  de champ  =  ',nomcha(j)
 105             ityp = typcha(j)
 106             if ( ityp.gt.0) then
 107                nomf = nomtyp(ityp)
 108             else if (ityp.eq.-1) then
 109                nomf = nomtyb(1)
 110             else if (ityp.eq.-2) then
 111                nomf = nomtyb(2)
 112             else if (ityp.eq.-3) then
 113                nomf = nomtyb(3)
 114             endif
 115             write(ulsort,3) '       type de champ  =  ',nomf,ityp
 116             write(ulsort,*) ' '
 117    11    continue
 118          endif
 119          write(ulsort,*) ' '
 120    10 continue
 121       write(ulsort,*) ' -----------------------------------------------'
 122 c
 123       endif
 124 c
 125       endif
 126 c
 127 c====
 128 c 2. les objets structures presents
 129 c====
 130 c
 131       if ( gmimp.gt.0 ) then
 132 c
 133       if ( choix.eq.2 ) then
 134 c
 135       write(ulsort,*) ' '
 136       write(ulsort,*) ' '
 137       write(ulsort,*) ' Etat des tables des objets structures - VTOC-MC'
 138       write(ulsort,*) ' -----------------------------------------------'
 139       write(ulsort,*) ' '
 140 c
 141       write(ulsort,*) ' Nombre objets structures presents : ',iptobj-1
 142       write(ulsort,*) ' '
 143       do 20 , i = 1,iptobj-1
 144          write(ulsort,*) ' '
 145          write(ulsort,1) i,' -> nom objet  =  ',nomobj(i)
 146          write(ulsort,*) ' '
 147          ity = typobj(i)
 148          nba = nbratt(ity)
 149          iat = adrdsa(i)
 150          nbc = nbcham(ity)
 151          iad = adrdso(i)
 152          write(ulsort,3)   '    typ objet  =  ',nomtyp(ity),ity
 153          write(ulsort,*) ' '
 154          write(ulsort,2)   '    nbr-attri  =  ',nba
 155          if ( gmimp.gt.2 ) then
 156          write(ulsort,2)   '    adr attri  =  ',iat
 157          write(ulsort,*) ' '
 158          do 21 , j = 1,nba
 159             k = iat+j-1
 160             write(ulsort,2) ' -> -> numero-attr  =  ',j
 161             write(ulsort,2) '       valeur-attr  =  ',valatt(k)
 162             write(ulsort,*) '  '
 163    21    continue
 164          endif
 165          write(ulsort,2)   '    nbr-champ  =  ',nbc
 166          if ( gmimp.gt.2 ) then
 167          write(ulsort,2)   '    adr objet  =  ',iad
 168          write(ulsort,*) ' '
 169          do 22 , j = 1,nbc
 170             k = iad+j-1
 171             l = adrdst(ity)+j-1
 172             ityp = typcha(l)
 173             if ( ityp.gt.0) then
 174                nomf = nomtyp(ityp)
 175             else if (ityp.eq.-1) then
 176                nomf = nomtyb(1)
 177             else if (ityp.eq.-2) then
 178                nomf = nomtyb(2)
 179             else if (ityp.eq.-3) then
 180                nomf = nomtyb(3)
 181             endif
 182             write(ulsort,4) ' -> -> objet-champ  =  ',nomobc(k)
 183             write(ulsort,4) '       nom  -champ  =  ',nomcha(l)
 184             write(ulsort,3) '       type -champ  =  ',nomf,ityp
 185             write(ulsort,*) '  '
 186    22    continue
 187          endif
 188    20 continue
 189 c
 190       write(ulsort,*) ' '
 191       write(ulsort,*) ' pointeur -> iptchp    =  ',iptchp
 192       write(ulsort,*) ' '
 193       write(ulsort,*) ' '
 194       write(ulsort,*) ' ==============================================='
 195 c
 196       endif
 197 c
 198       endif
 199 c
 200       end