src/tool/Gestion_MTU/gmstat.F

   1       subroutine gmstat ( 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       fonction impression des statistiques du gestionnaire de memoire
  23 c_______________________________________________________________________
  24 c .        .     .        .                                            .
  25 c .  nom   . e/s . taille .           description                      .
  26 c .____________________________________________________________________.
  27 c . gmimp  . e   .    1   . Pour le mode dynamique :                   .
  28 c .        .     .        . 0 => pas d'impression                      .
  29 c .        .     .        . 1 => impression                            .
  30 c ______________________________________________________________________
  31 c
  32 c====
  33 c 0. declarations et dimensionnement
  34 c====
  35 c
  36 c 0.1. ==> generalites
  37 c
  38       implicit none
  39       save
  40 c
  41       character*6 nompro
  42       parameter ( nompro = 'GMSTAT' )
  43 c
  44 #include "genbla.h"
  45 c
  46 #include "gmmatc.h"
  47 c
  48 #include "gmmaxt.h"
  49 c
  50 c 0.2. ==> communs
  51 c
  52 #include "gmtori.h"
  53 #include "gmtoai.h"
  54 c
  55 #include "gmenti.h"
  56 #include "gmreel.h"
  57 #include "gmstri.h"
  58 c
  59 #include "gmtrrl.h"
  60 #include "gmtren.h"
  61 #include "gmtrst.h"
  62 c
  63 #include "gmimpr.h"
  64 #include "gmlang.h"
  65 #include "gmopim.h"
  66 #include "gmtail.h"
  67 #include "gmtyge.h"
  68 c
  69 c 0.3. ==> arguments
  70 c
  71       integer gmimp
  72 c
  73 c 0.4. ==> variables locales
  74 c
  75       integer iaux, jaux, kaux
  76       integer ltypei, ltyper, ltypes
  77       integer ecrire
  78 c
  79       character*2 saux02
  80       character*16 typtab(nblang,4)
  81 c
  82       double precision daux
  83 c
  84       integer nbmess
  85       parameter ( nbmess = 15 )
  86       character*80 texte(nblang,nbmess)
  87 c
  88 c
  89 c 0.5. ==> initialisations
  90 c ______________________________________________________________________
  91 c
  92 #include "impr01.h"
  93 c
  94 #ifdef _DEBUG_HOMARD_
  95       write (ulsort,texte(langue,1)) 'Entree', nompro
  96       call dmflsh (iaux)
  97 #endif
  98 cgn         print *,'dans gmstat, gmimp = ', gmimp
  99 c
 100 c====
 101 c 1. Niveau d'impression
 102 c====
 103 c
 104 #ifdef _DEBUG_HOMARD_
 105       ecrire = 1
 106 #else
 107       if ( modgm.eq.2 ) then
 108         if ( mod(imprgm,5).eq.0 ) then
 109           ecrire = 1
 110         else
 111           ecrire = 0
 112         endif
 113       else
 114         ecrire = 1
 115       endif
 116 #endif
 117 c
 118       if ( ecrire.ge.1 ) then
 119       write (ulsort,10000)
 120       endif
 121 c
 122 10000 format (//)
 123 c
 124 cgn        print *,'dans gmstat, ecrire = ', ecrire
 125 c
 126 c====
 127 c 2. statistiques concernant les objets structures
 128 c====
 129 c
 130       if ( ecrire.ge.1 ) then
 131 c
 132       texte(1,4) = '(15x,'':       Gestion de la memoire        :'')'
 133       texte(1,5) = '(5x,''Nombre de types de structure        : '',i14)'
 134       texte(1,6) =
 135      > '(5x,''Nombre d''''objets structures presents : '',i14)'
 136 c
 137       texte(2,4) = '(15x,'':           Memory management        :'')'
 138       texte(2,5) =
 139      >        '(5x,''Number of types of structures         : '',i14)'
 140       texte(2,6) =
 141      > '(5x,''Number of present structured objects  : '',i14)'
 142 c
 143 10001 format (/,
 144      > /,15x,'......................................',
 145      > /,15x,':                                    :')
 146 10002 format (
 147      >   15x,':                                    :',
 148      > /,15x,':....................................:',//)
 149 c
 150       write (ulsort,10001)
 151       write (ulsort,texte(langue,4))
 152       write (ulsort,10002)
 153       write (ulsort,texte(langue,5)) nbrtyp
 154 #ifdef _DEBUG_HOMARD_
 155       write (ulsort,texte(langue,6)) iptobj-1
 156 #endif
 157 c
 158       endif
 159 c
 160 c====
 161 c 2. statistiques concernant les tableaux dynamiques
 162 c====
 163 c
 164       texte(1,4) = '(/,''La gestion de la memoire est statique.'')'
 165       texte(1,5) ='(/,''La gestion de la memoire est semi-dynamique.'')'
 166       texte(1,6) = '(/,''La gestion de la memoire est dynamique.'')'
 167       texte(1,7) = '(/,''1 mot = '',i2,'' octets'')'
 168       texte(1,8) = '(/,''1 mot = 1 octet'')'
 169 c
 170       texte(2,4) = '(/,''A static memory management is used.'')'
 171       texte(2,5) = '(/,''A semi-dynamic memory management is used.'')'
 172       texte(2,6) = '(/,''A dynamic memory management is used.'')'
 173       texte(2,7) = '(/,''1 word = '',i2,'' bytes'')'
 174       texte(2,8) = '(/,''1 word = 1 byte'')'
 175 c
 176 50010 format(
 177      >/,90('.'),
 178      >/': ',a16,14x,': ',a16,' : ',a16,' : ',a16,' :',
 179      >/':',88('.'),':')
 180 50011 format(
 181      >/,71('.'),
 182      >/': ',a16,14x,': ',a16,' : ',a16,' :',
 183      >/':',69('.'),':')
 184 50020 format(
 185      > ': ',a16,14x,': ',i16,' : ',i16,' : ',i16,' :')
 186 50021 format(
 187      > ': ',a16,14x,': ',i16,' : ',i16,' :')
 188 50030 format(
 189      >  90('.'),
 190      >/': ',2a16,36x,':',6x,f8.2,1x,a2,' :',
 191      >/':',88('.'),':')
 192 50031 format(
 193      >  71('.'),
 194      >/': ',2a16,17x,':',6x,f8.2,1x,a2,' :',
 195      >/':',69('.'),':')
 196 50040 format(
 197      >/,'1 entier = ',i2,' octets,',
 198      >/,'1 reel =',i2,' octets,',
 199      >/,'1 character*8 =',i2,' octets')
 200 50041 format(
 201      >/,'1 integer = ',i2,' bytes,',
 202      >/,'1 real =',i2,' bytes,',
 203      >/,'1 character*8 =',i2,' bytes')
 204 50090 format(90('.'))
 205 50091 format(71('.'))
 206 c
 207 c 2.1. ==> Mode de gestion de la memoire
 208 c
 209       if ( ecrire.ge.1 ) then
 210 c
 211         write (ulsort,texte(langue,modgm+4))
 212 c
 213       endif
 214 c
 215 c 2.2. ==> En-tete
 216 c
 217       if ( ecrire.ge.1 ) then
 218 c
 219 c                      1234567890123456
 220         typtab(1,1) = 'Type de tableau '
 221         typtab(1,2) = 'Nombre demande  '
 222         typtab(1,3) = 'Nombre totalise '
 223         typtab(1,4) = 'Nombre utilise  '
 224         typtab(2,1) = ' Type of array  '
 225         typtab(2,2) = '  Asked number  '
 226         typtab(2,3) = '  Total number  '
 227         typtab(2,4) = '  Used number   '
 228 c
 229         if ( modgm.le.1 ) then
 230           write (ulsort,50010) (typtab(langue,iaux),iaux=1,4)
 231         else
 232           write (ulsort,50011) (typtab(langue,iaux),iaux=1,3)
 233         endif
 234 c
 235       endif
 236 c
 237 c 2.3. ==> Par type
 238 c
 239 c                    1234567890123456
 240       typtab(1,1) = 'Entier          '
 241       typtab(1,2) = 'Reel            '
 242       typtab(1,3) = 'Caracteres*8    '
 243       typtab(2,1) = 'Integer         '
 244       typtab(2,2) = 'Real            '
 245       typtab(2,3) = 'Character*8     '
 246 c
 247       if ( modgm.le.1 ) then
 248 c
 249         minlei = min(minmei,minlei)
 250         minler = min(minmer,minler)
 251         minles = min(minmes,minles)
 252 c
 253       else
 254 c
 255 c en mode dynamique (modgm=2), les quantites minmex memorisent a tout
 256 c instant l'ecart entre la taille max allouee precedemment (dans le type
 257 c x concerne) et la taille couramment allouee. Typiquement,
 258 c a la fin d'une execution ou tout a ete proprement desalloue,
 259 c on doit avoir imem(1) = minmei ...
 260 c
 261         minlei = max(minmei,0)
 262         minler = max(minmer,0)
 263         minles = max(minmes,0)
 264 c
 265       endif
 266 c
 267       kaux = 0
 268 c
 269 #ifdef _DEBUG_HOMARD_
 270       jaux = -1
 271 #else
 272       jaux = 0
 273 #endif
 274 c
 275       iaux = imem(1)
 276       ltypei = tentie
 277       if ( iaux.gt.jaux ) then
 278         if ( modgm.le.1 ) then
 279           kaux = kaux + (iaux-minlei)*ltypei
 280         else
 281           kaux = kaux + iaux*ltypei
 282         endif
 283         if ( ecrire.ge.1 ) then
 284           if ( modgm.le.1 ) then
 285             write (ulsort,50020) typtab(langue,1), iaux, totali,
 286      >                           iaux-minlei
 287           else
 288             write (ulsort,50021) typtab(langue,1), iaux, totali
 289           endif
 290         endif
 291       endif
 292 c
 293       iaux = int(rmem(1))
 294       ltyper = treel
 295       if ( iaux.gt.jaux ) then
 296         if ( modgm.le.1 ) then
 297           kaux = kaux + (iaux-minler)*ltyper
 298         else
 299           kaux = kaux + iaux*ltyper
 300         endif
 301         if ( ecrire.ge.1 ) then
 302           if ( modgm.le.1 ) then
 303             write (ulsort,50020) typtab(langue,2), iaux, totalr,
 304      >                           iaux-minler
 305           else
 306             write (ulsort,50021) typtab(langue,2), iaux, totalr
 307           endif
 308         endif
 309       endif
 310 c
 311       if (index(smem(1),'*').le.0) then
 312         read(smem(1),'(i8)') iaux
 313       else
 314         iaux = 99999999 + minles
 315       endif
 316       ltypes = tchain
 317       if ( iaux.gt.jaux ) then
 318         if ( modgm.le.1 ) then
 319           kaux = kaux + (iaux-minles)*ltypes
 320         else
 321           kaux = kaux + iaux*ltypes
 322         endif
 323         if ( ecrire.ge.1 ) then
 324           if ( modgm.le.1 ) then
 325             write (ulsort,50020) typtab(langue,3), iaux, totals,
 326      >                           iaux-minles
 327           else
 328             write (ulsort,50021) typtab(langue,3), iaux, totals
 329           endif
 330         endif
 331       endif
 332 c
 333       if ( ecrire.ge.11 ) then
 334 c
 335         if ( modgm.le.1 ) then
 336           write (ulsort,50090)
 337         else
 338           write (ulsort,50091)
 339         endif
 340 c
 341       endif
 342 c
 343 c 2.3. ==> Bilan
 344 c
 345       if ( ecrire.ge.1 ) then
 346 c
 347 c                    1234567890123456
 348       typtab(1,1) = 'Memoire totale u'
 349       typtab(1,2) = 'tilisee         '
 350 c
 351       typtab(2,1) = 'Total used memor'
 352       typtab(2,2) = 'y               '
 353 c
 354       if ( kaux.ge.1000000000 ) then
 355         daux = dble(kaux) / 1000000000.d0
 356         saux02 = 'Go'
 357       elseif ( kaux.ge.1000000 ) then
 358         daux = dble(kaux) / 1000000.d0
 359         saux02 = 'Mo'
 360       elseif ( kaux.ge.1000 ) then
 361         daux = dble(kaux) / 1000.d0
 362         saux02 = 'ko'
 363       else
 364         daux = dble(kaux)
 365         saux02 = 'o '
 366       endif
 367       if ( modgm.le.1 ) then
 368         write (ulsort,50030) typtab(langue,1), typtab(langue,2),
 369      >                       daux, saux02
 370       else
 371         write (ulsort,50031) typtab(langue,1), typtab(langue,2),
 372      >                       daux, saux02
 373       endif
 374 c
 375 #ifdef _DEBUG_HOMARD_
 376 c
 377         write (ulsort,texte(langue,8))
 378 c
 379         if ( langue.eq.1 ) then
 380 c
 381           write (ulsort,50040) ltypei, ltyper, ltypes
 382 c
 383         else
 384 c
 385           write (ulsort,50041) ltypei, ltyper, ltypes
 386 c
 387         endif
 388 #endif
 389 c
 390       endif
 391 c
 392 #ifdef _DEBUG_HOMARD_
 393       write (ulsort,texte(langue,1)) 'Sortie', nompro
 394       call dmflsh (iaux)
 395 #endif
 396 c
 397       end