src/tool/Information/infami.F

   1       subroutine infami ( nomail, maext0,
   2      >                    ulsort, langue, codret )
   3 c ______________________________________________________________________
   4 c
   5 c                             H O M A R D
   6 c
   7 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   8 c
   9 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  10 c aupres des huissiers de justice Simart et Lavoir a Clamart
  11 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  12 c aupres des huissiers de justice
  13 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  14 c
  15 c    HOMARD est une marque deposee d'Electricite de France
  16 c
  17 c Copyright EDF 1996
  18 c Copyright EDF 1998
  19 c Copyright EDF 2002
  20 c Copyright EDF 2020
  21 c ______________________________________________________________________
  22 c
  23 c   INformation : FAMIlles
  24 c   --            ----
  25 c ______________________________________________________________________
  26 c .        .     .        .                                            .
  27 c .  nom   . e/s . taille .           description                      .
  28 c .____________________________________________________________________.
  29 c . nomail . e   . char8  . nom de l'objet maillage homard iteration n .
  30 c . maext0 . e   .   1    . maillage extrude                           .
  31 c .        .     .        . 0 : non                                    .
  32 c .        .     .        . 1 : selon X                                .
  33 c .        .     .        . 2 : selon Y                                .
  34 c .        .     .        . 3 : selon Z (cas de Saturne ou Neptune)    .
  35 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  36 c . langue . e   .    1   . langue des messages                        .
  37 c .        .     .        . 1 : francais, 2 : anglais                  .
  38 c . codret . es  .    1   . code de retour des modules                 .
  39 c .        .     .        . 0 : pas de probleme                        .
  40 c .        .     .        . 2 : probleme dans les memoires             .
  41 c .        .     .        . 3 : probleme dans les fichiers             .
  42 c .        .     .        . 5 : probleme autre                         .
  43 c ______________________________________________________________________
  44 c
  45 c====
  46 c 0. declarations et dimensionnement
  47 c====
  48 c
  49 c 0.1. ==> generalites
  50 c
  51       implicit none
  52       save
  53 c
  54       character*6 nompro
  55       parameter ( nompro = 'INFAMI' )
  56 c
  57 #include "nblang.h"
  58 #include "consts.h"
  59 c
  60 c 0.2. ==> communs
  61 c
  62 #include "envex1.h"
  63 c
  64 #include "gmenti.h"
  65 c
  66 #include "meddc0.h"
  67 #include "envca1.h"
  68 #include "nombmp.h"
  69 #include "nombtr.h"
  70 #include "nombqu.h"
  71 #include "nombte.h"
  72 #include "nombhe.h"
  73 #include "nombpy.h"
  74 #include "nombpe.h"
  75 #include "nbfami.h"
  76 c
  77 c 0.3. ==> arguments
  78 c
  79       integer maext0
  80 c
  81       character*8 nomail
  82 c
  83       integer ulsort, langue, codret
  84 c
  85 c 0.4. ==> variables locales
  86 c
  87       integer iaux, jaux
  88 c
  89       integer pfamno, pcfano
  90       integer pfammp, pcfamp
  91       integer pfamar, pcfaar
  92       integer pfamtr, pcfatr
  93       integer pfamqu, pcfaqu
  94       integer pfamte, pcfate
  95       integer pfamhe, pcfahe
  96       integer pfampy, pcfapy
  97       integer pfampe, pcfape
  98 c
  99       character*8 norenu
 100       character*8 nhnoeu, nhmapo, nharet, nhtria, nhquad
 101       character*8 nhtetr, nhhexa, nhpyra, nhpent
 102       character*8 nhelig
 103       character*8 nhvois, nhsupe, nhsups
 104 c
 105       integer nbmess
 106       parameter ( nbmess = 10 )
 107       character*80 texte(nblang,nbmess)
 108 c
 109 c 0.5. ==> initialisations
 110 c ______________________________________________________________________
 111 c
 112 c====
 113 c 1. messages
 114 c====
 115 c
 116 #include "impr01.h"
 117 c
 118 #ifdef _DEBUG_HOMARD_
 119       write (ulsort,texte(langue,1)) 'Entree', nompro
 120       call dmflsh (iaux)
 121 #endif
 122 c
 123 #include "impr03.h"
 124 c
 125 c====
 126 c 2. recuperation des pointeurs
 127 c====
 128 c
 129 c 2.1. ==> structure generale
 130 c
 131       if ( codret.eq.0 ) then
 132 c
 133 #ifdef _DEBUG_HOMARD_
 134       write (ulsort,texte(langue,3)) 'UTNOMH', nompro
 135 #endif
 136       call utnomh ( nomail,
 137      >                sdim,   mdim,
 138      >               degre, maconf, homolo, hierar,
 139      >              rafdef, nbmane, typcca, typsfr, maextr,
 140      >              mailet,
 141      >              norenu,
 142      >              nhnoeu, nhmapo, nharet,
 143      >              nhtria, nhquad,
 144      >              nhtetr, nhhexa, nhpyra, nhpent,
 145      >              nhelig,
 146      >              nhvois, nhsupe, nhsups,
 147      >              ulsort, langue, codret)
 148 c
 149       endif
 150 c
 151 c 2.2. ==> tableaux
 152 #ifdef _DEBUG_HOMARD_
 153       write (ulsort,90002) '2.2. tableaux ; codret', codret
 154 #endif
 155 c
 156       if ( codret.eq.0 ) then
 157 c
 158 #ifdef _DEBUG_HOMARD_
 159       write (ulsort,texte(langue,3)) 'UTAD01', nompro
 160 #endif
 161       iaux = 7
 162       call utad01 ( iaux, nhnoeu,
 163      >                jaux,
 164      >              pfamno, pcfano,   jaux,
 165      >                jaux,   jaux,   jaux,   jaux,
 166      >              ulsort, langue, codret )
 167 c
 168       if ( nbmpto.ne.0 ) then
 169 c
 170 #ifdef _DEBUG_HOMARD_
 171       write (ulsort,texte(langue,3)) 'UTAD02_mp', nompro
 172 #endif
 173         iaux = 259
 174         call utad02 (   iaux, nhmapo,
 175      >                  jaux,   jaux,   jaux,   jaux,
 176      >                pfammp, pcfamp,   jaux,
 177      >                  jaux,   jaux,   jaux,
 178      >                  jaux,   jaux,   jaux,
 179      >                ulsort, langue, codret )
 180 c
 181       endif
 182 c
 183 #ifdef _DEBUG_HOMARD_
 184       write (ulsort,texte(langue,3)) 'UTAD02_ar', nompro
 185 #endif
 186       iaux = 259
 187       call utad02 (   iaux, nharet,
 188      >                jaux,   jaux,   jaux,   jaux,
 189      >              pfamar, pcfaar,   jaux,
 190      >                jaux,   jaux,   jaux,
 191      >                jaux,   jaux,   jaux,
 192      >              ulsort, langue, codret )
 193 c
 194       if ( nbftri.ne.0 ) then
 195 c
 196 #ifdef _DEBUG_HOMARD_
 197       write (ulsort,texte(langue,3)) 'UTAD02_tr', nompro
 198 #endif
 199         iaux = 37
 200         if ( nbtrto.ne.0 ) then
 201           iaux = iaux*7
 202         endif
 203         call utad02 (   iaux, nhtria,
 204      >                  jaux,   jaux,   jaux,   jaux,
 205      >                pfamtr, pcfatr,   jaux,
 206      >                  jaux,   jaux,   jaux,
 207      >                  jaux,   jaux,   jaux,
 208      >                ulsort, langue, codret )
 209 c
 210       endif
 211 c
 212       if ( nbfqua.ne.0 ) then
 213 c
 214 #ifdef _DEBUG_HOMARD_
 215       write (ulsort,texte(langue,3)) 'UTAD02_qu', nompro
 216 #endif
 217         iaux = 37
 218         if ( nbquto.ne.0 ) then
 219           iaux = iaux*7
 220         endif
 221         call utad02 (   iaux, nhquad,
 222      >                  jaux,   jaux,   jaux,   jaux,
 223      >                pfamqu, pcfaqu,   jaux,
 224      >                  jaux,   jaux,   jaux,
 225      >                  jaux,   jaux,   jaux,
 226      >                ulsort, langue, codret )
 227 c
 228       endif
 229 c
 230       if ( nbftet.ne.0 ) then
 231 c
 232 #ifdef _DEBUG_HOMARD_
 233       write (ulsort,texte(langue,3)) 'UTAD02_te', nompro
 234 #endif
 235         iaux = 37
 236         if ( nbteto.ne.0 ) then
 237           iaux = iaux*7
 238         endif
 239         call utad02 (   iaux, nhtetr,
 240      >                  jaux,   jaux,   jaux,   jaux,
 241      >                pfamte, pcfate,   jaux,
 242      >                  jaux,   jaux,   jaux,
 243      >                  jaux,   jaux,   jaux,
 244      >                ulsort, langue, codret )
 245 c
 246       endif
 247 c
 248       if ( nbfhex.ne.0 ) then
 249 c
 250 #ifdef _DEBUG_HOMARD_
 251       write (ulsort,texte(langue,3)) 'UTAD02_he', nompro
 252 #endif
 253         iaux = 37
 254         if ( nbheto.ne.0 ) then
 255           iaux = iaux*7
 256         endif
 257         call utad02 (   iaux, nhhexa,
 258      >                  jaux,   jaux,   jaux,   jaux,
 259      >                pfamhe, pcfahe,   jaux,
 260      >                  jaux,   jaux,   jaux,
 261      >                  jaux,   jaux,   jaux,
 262      >                ulsort, langue, codret )
 263 c
 264       endif
 265 c
 266       if ( nbfpyr.ne.0 ) then
 267 c
 268 #ifdef _DEBUG_HOMARD_
 269       write (ulsort,texte(langue,3)) 'UTAD02_py', nompro
 270 #endif
 271         iaux = 37
 272         if ( nbpyto.ne.0 ) then
 273           iaux = iaux*7
 274         endif
 275         call utad02 (   iaux, nhpyra,
 276      >                  jaux,   jaux,   jaux,   jaux,
 277      >                pfampy, pcfapy,   jaux,
 278      >                  jaux,   jaux,   jaux,
 279      >                  jaux,   jaux,   jaux,
 280      >                ulsort, langue, codret )
 281 c
 282       endif
 283 c
 284       if ( nbfpen.ne.0 ) then
 285 c
 286 #ifdef _DEBUG_HOMARD_
 287       write (ulsort,texte(langue,3)) 'UTAD02_pe', nompro
 288 #endif
 289         iaux = 37
 290         if ( nbpeto.ne.0 ) then
 291           iaux = iaux*7
 292         endif
 293         call utad02 (   iaux, nhpent,
 294      >                  jaux,   jaux,   jaux,   jaux,
 295      >                pfampe, pcfape,   jaux,
 296      >                  jaux,   jaux,   jaux,
 297      >                  jaux,   jaux,   jaux,
 298      >                ulsort, langue, codret )
 299 c
 300       endif
 301 c
 302       endif
 303 c
 304 c====
 305 c 3. impression de la description des familles
 306 c====
 307 #ifdef _DEBUG_HOMARD_
 308       write (ulsort,90002) '3. impressions familles ; codret', codret
 309 #endif
 310
 311       if ( codret.eq.0 ) then
 312 c
 313 #ifdef _DEBUG_HOMARD_
 314       write (ulsort,texte(langue,3)) 'UTECFE', nompro
 315 #endif
 316 c
 317       call utecfe ( maext0,
 318      >              imem(pfamno), imem(pcfano),
 319      >              imem(pfammp), imem(pcfamp),
 320      >              imem(pfamar), imem(pcfaar),
 321      >              imem(pfamtr), imem(pcfatr),
 322      >              imem(pfamqu), imem(pcfaqu),
 323      >              imem(pfamte), imem(pcfate),
 324      >              imem(pfamhe), imem(pcfahe),
 325      >              imem(pfampy), imem(pcfapy),
 326      >              imem(pfampe), imem(pcfape),
 327      >              ulsort, langue, codret )
 328 c
 329       endif
 330 c
 331 c====
 332 c 4. fin
 333 c====
 334 c
 335       if ( codret.ne.0 ) then
 336 c
 337 #include "envex2.h"
 338 c
 339       write (ulsort,texte(langue,1)) 'Sortie', nompro
 340       write (ulsort,texte(langue,2)) codret
 341 c
 342       endif
 343 c
 344 #ifdef _DEBUG_HOMARD_
 345       write (ulsort,texte(langue,1)) 'Sortie', nompro
 346       call dmflsh (iaux)
 347 #endif
 348 c
 349       end