src/tool/Gestion_MTU/gmecpr.F

   1       subroutine gmecpr ( nuroul, numann )
   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       Gestionnaire de la Memoire : ECriture du PRogramme
  23 c       -                  -         --          --
  24 c ______________________________________________________________________
  25 c
  26 c     ecrit un programme qui realise l'initialisation des tables
  27 c     de description des types d'objet structure.
  28 c ______________________________________________________________________
  29 c .        .     .        .                                            .
  30 c .  nom   . e/s . taille .           description                      .
  31 c .____________________________________________________________________.
  32 c . numann . e   .   1    . numero de l'annee                          .
  33 c . nuroul . e   .    1   . numero de l'unite logique ou on ecrit      .
  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       character*6 nompro
  46       parameter ( nompro = 'GMECPR' )
  47 c
  48 #include "genbla.h"
  49 c
  50 #include "gmmatc.h"
  51 c
  52 #include "nuvers.h"
  53 c
  54 c 0.2. ==> communs
  55 c
  56 #include "gmtori.h"
  57 #include "gmtors.h"
  58 #include "gmtove.h"
  59 c
  60 #ifdef _DEBUG_HOMARD_
  61 #include "gmimpr.h"
  62 #include "gmlang.h"
  63 #endif
  64 c
  65 c 0.3. ==> arguments
  66 c
  67       integer nuroul
  68       integer numann
  69 c
  70       character*48 ladate
  71 c
  72 c 0.4. ==> variables locales
  73 c
  74 #include "gmnelx.h"
  75 c
  76       integer iaux, jaux, jdeb, jfin
  77 c
  78       integer nbmess
  79       parameter ( nbmess = 10 )
  80 c
  81       character*80 texte(nblang,nbmess)
  82 c
  83 c 0.5. ==> initialisations
  84 c ______________________________________________________________________
  85 c
  86 c====
  87 c 1.  les messages
  88 c====
  89 c
  90 #include "impr01.h"
  91 c
  92 #ifdef _DEBUG_HOMARD_
  93       write (ulsort,texte(langue,1)) 'Entree', nompro
  94       call dmflsh (iaux)
  95 #endif
  96 c
  97 c====
  98 c 2. ecriture du fichier
  99 c====
 100 c
 101 c 2.1. ==> en-tete
 102 c
 103       write (nuroul,21001) nuvers
 104       write (nuroul,21002) numann
 105       write (nuroul,21003)
 106       write (nuroul,21004)
 107 c
 108 21001 format (
 109      >  '      subroutine gmitob',
 110      >/,'c ',70('_'),
 111      >/,'c',
 112      >/,'c',25x,'H O M A R D     ',a8,
 113      >/,'c')
 114 c
 115 21002 format (
 116      >  'c Outil de Maillage Adaptatif par Raffinement',
 117      >  ' et Deraffinement d''EDF R&D',
 118      >/,'c',
 119      >/,'c Version originale enregistree le 18 juin 1996',
 120      >  ' sous le numero 96036',
 121      >/,'c aupres des huissiers de justice Simart et Lavoir a Clamart',
 122      >/,'c Version 11.2 enregistree le 13 fevrier 2015',
 123      >  ' sous le numero 2015/014',
 124      >/,'c aupres des huissiers de justice',
 125      >/,'c Lavoir, Silinski & Cherqui-Abrahmi a Clamart',
 126      >/,'c',
 127      >/,'c',
 128      >/,'c Copyright EDF 1996, ',i4,
 129      >/,'c ',70('_'),
 130      >/,'c')
 131 21003 format (
 132      >  'c       Gestionnaire de la Memoire :',
 133      >/,'c       -                  -',
 134      >/,'c       Initialisation des Tables d''OBjets',
 135      >/,'c       -                  -        --',
 136      >/,'c',
 137      >/,'      save',
 138      >/,'c')
 139 c
 140 21004 format (
 141      >  '#include "gmmatc.h"',
 142      >/,'c',
 143      >/,'#include "gmtoas.h"',
 144      >/,'#include "gmtori.h"',
 145      >/,'#include "gmtors.h"',
 146      >/,'#include "gmtove.h"',
 147      >/,'c',
 148      >/,'      integer iaux',
 149      >/,'c')
 150 c
 151 c 2.2. ==> numeros de version
 152 c
 153       write (nuroul,22001) nuveto, nusvto, daheto, nuanto
 154 c
 155 22001 format (
 156      >  'c numeros de version des tables d''objets',
 157      >/,'c',
 158      >/,'      nuveto = ',i12,
 159      >/,'      nusvto = ',i12,
 160      >/,'      daheto = ',i12,
 161      >/,'      nuanto = ',i12,
 162      >/,'c')
 163 c
 164 c 2.3. ==> tables
 165 c
 166       write (nuroul,23001) nbrtyp
 167       do 23 , iaux = 1 , nbrtyp
 168         write (nuroul,23002) iaux, nomtyp(iaux),
 169      >                       iaux, nbratt(iaux),
 170      >                       iaux, nbcham(iaux),
 171      >                       iaux, adrdst(iaux)
 172         jdeb = adrdst(iaux)
 173         jfin = jdeb + nbcham(iaux) - 1
 174         do 231 , jaux = jdeb , jfin
 175           write (nuroul,23003) jaux, nomcha(jaux),
 176      >                         jaux, typcha(jaux)
 177   231   continue
 178    23 continue
 179 c
 180 23001 format (
 181      >  'c objets structures',
 182      >/,'c',
 183      >/,'      nbrtyp = ',i12)
 184 23002 format (
 185      >  'c',
 186      >/,'c--------------------------------------------------',
 187      >/,'c',
 188      >/,'      nomtyp(',i10,') = ''',a8,'''',
 189      >/,'      nbratt(',i10,') = ',i12,
 190      >/,'      nbcham(',i10,') = ',i12,
 191      >/,'      adrdst(',i10,') = ',i12,
 192      >/,'c')
 193 23003 format (
 194      >  '        nomcha(',i10,') = ''',a8,'''',
 195      >/,'        typcha(',i10,') = ',i12)
 196 c
 197 c 2.4. ==> transfert
 198 c
 199       write (nuroul,24001)
 200 c
 201 24001 format (
 202      >  'c',
 203      >/,'      do 24 , iaux = 1 , nbrtyp',
 204      >/,'        nomtbp(iaux) = nomtyp(iaux)',
 205      >/,'   24 continue',
 206      >/,'c')
 207 c
 208 c 2.5. ==> la fin
 209 c
 210       write (nuroul,25001)
 211 c
 212 25001 format (
 213      >  '      end')
 214 c
 215       end