src/tool/ES_MED/esemmb.F

   1       subroutine esemmb ( idfmed, nomamd,
   2      >                    typenh, typent, typgeo,
   3      >                    nbmato, nbrfma, nbelem, numfam,
   4      >                    typcon, dim1,
   5      >                    conmai, infosu, fammai, listma,
   6      >                    numdt, numit, instan,
   7      >                    tabaux,
   8      >                    ulsort, langue, codret )
   9 c ______________________________________________________________________
  10 c
  11 c                             H O M A R D
  12 c
  13 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  14 c
  15 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  16 c aupres des huissiers de justice Simart et Lavoir a Clamart
  17 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  18 c aupres des huissiers de justice
  19 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  20 c
  21 c    HOMARD est une marque deposee d'Electricite de France
  22 c
  23 c Copyright EDF 1996
  24 c Copyright EDF 1998
  25 c Copyright EDF 2002
  26 c Copyright EDF 2020
  27 c ______________________________________________________________________
  28 c
  29 c  Entree-Sortie - Ecriture d'un Maillage au format MED
  30 c  -      -        -            -                  -
  31 c                - phase B
  32 c                        -
  33 c ______________________________________________________________________
  34 c .        .     .        .                                            .
  35 c .  nom   . e/s . taille .           description                      .
  36 c .____________________________________________________________________.
  37 c . idfmed . e   .   1    . identificateur du fichier de               .
  38 c .        .     .        . maillage de sortie                         .
  39 c . nomamd . e   . char64 . nom du maillage MED                        .
  40 c . nbmato . e   .   1    . nombre de mailles                          .
  41 c . nbrfma . e   .   1    . nbre noeuds par maille si connec. par noeud.
  42 c .        .     .        . nbre faces par maille si connectivite desce.
  43 c . nbelem . e   .   1    . nombre d'elements, tous types confondus    .
  44 c . numfam . e   .   1    . decalage dans la numerotation des familles .
  45 c .        .     .        .   1 : le tableau est pris tel quel         .
  46 c .        .     .        .  <=0 : le tableau passe negatif et est     .
  47 c .        .     .        .        decale de numfam                    .
  48 c . typenh . e   .   1    . code des entites au sens homard            .
  49 c .        .     .        .  -1 : noeuds                               .
  50 c .        .     .        .   0 : mailles-points                       .
  51 c .        .     .        .   1 : segments                             .
  52 c .        .     .        .   2 : triangles                            .
  53 c .        .     .        .   3 : tetraedres                           .
  54 c .        .     .        .   4 : quadrangles                          .
  55 c .        .     .        .   5 : pyramides                            .
  56 c .        .     .        .   6 : hexaedres                            .
  57 c .        .     .        .   7 : pentaedres                           .
  58 c . typent . e   .   1    . type des entites au sens MED               .
  59 c . typgeo . e   .   1    . type geometrique au sens MED               .
  60 c . typcon . e   .   1    . type de connectivite                       .
  61 c .        .     .        . 0 : par noeud (ednoda)                     .
  62 c .        .     .        . 1 : descendante (eddesc)                   .
  63 c . dim1   . e   .   1    . 1ere dimension de la connectivite          .
  64 c . conmai . e   .nbelem**. connectivite des mailles                   .
  65 c . infosu . e   . nbelem . informations supplementaire sur les mailles.
  66 c . fammai . e   . nbelem . famille med des mailles                    .
  67 c . listma . e   .   1    . liste des mailles a ecrire                 .
  68 c .        .     .        . si listma(1) vaut 0, on ecrit tout         .
  69 c .        .     .        . si listma(1) vaut -1, on ecrit tout et les .
  70 c .        .     .        . descriptions sont inversees                .
  71 c .        .     .        . si listma(1) vaut -2, on ecrit les segments.
  72 c .        .     .        . en degre 2 a partir de esece0              .
  73 c .        .     .        . si listma(1) vaut -3, on ecrit les segments.
  74 c .        .     .        . en degre 3 a partir de esece0              .
  75 c . numdt  . e   .   1    . numero du pas de temps                     .
  76 c . numit  . e   .   1    . numero d'iteration                         .
  77 c . instan . e   .   1    . pas de temps                               .
  78 c . tabaux .     . nbelem . tableau tampon                             .
  79 c .        .     . *nbmane.                                            .
  80 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  81 c . langue . e   .    1   . langue des messages                        .
  82 c .        .     .        . 1 : francais, 2 : anglais                  .
  83 c . codret . es  .    1   . code de retour des modules                 .
  84 c .        .     .        . 0 : pas de probleme                        .
  85 c .        .     .        . 1 : probleme                               .
  86 c ______________________________________________________________________
  87 c
  88 c====
  89 c 0. declarations et dimensionnement
  90 c====
  91 c
  92 c 0.1. ==> generalites
  93 c
  94       implicit none
  95       save
  96 c
  97       character*6 nompro
  98       parameter ( nompro = 'ESEMMF' )
  99 c
 100 #include "nblang.h"
 101 c
 102 c 0.2. ==> communs
 103 c
 104 #include "envex1.h"
 105 #include "impr02.h"
 106 c
 107 c 0.3. ==> arguments
 108 c
 109       integer*8 idfmed
 110       integer typenh, typent, typgeo
 111       integer nbmato, nbrfma, nbelem, numfam
 112       integer typcon, dim1
 113       integer conmai(dim1,*), infosu(nbelem), fammai(nbelem)
 114       integer listma(nbmato), tabaux(*)
 115       integer numdt, numit
 116 c
 117       character*64 nomamd
 118 c
 119       double precision instan
 120 c
 121       integer ulsort, langue, codret
 122 c
 123 c 0.4. ==> variables locales
 124 c
 125       integer iaux
 126 c
 127       integer nbmess
 128       parameter ( nbmess = 150 )
 129       character*80 texte(nblang,nbmess)
 130 c ______________________________________________________________________
 131 c
 132 c====
 133 c 1. initialisations
 134 c====
 135 c
 136 c 1.1. ==> les messages
 137 c
 138 #include "impr01.h"
 139 c
 140 #ifdef _DEBUG_HOMARD_
 141       write (ulsort,texte(langue,1)) 'Entree', nompro
 142       call dmflsh (iaux)
 143 #endif
 144 c
 145       texte(1,4) = '(''. Ecriture des '',i10,1x,a)'
 146 c
 147       texte(2,4) = '(''. Writings of '',i10,1x,a)'
 148 c
 149 #include "esimpr.h"
 150 #include "impr03.h"
 151 c
 152 #ifdef _DEBUG_HOMARD_
 153       write (ulsort,texte(langue,4)) nbmato, mess14(langue,3,typenh)
 154 #endif
 155 #ifdef _DEBUG_HOMARD_
 156       write (ulsort,90002) 'listma(1)', listma(1)
 157       write (ulsort,90002) 'typenh', typenh
 158       write (ulsort,90002) 'typent', typent
 159       write (ulsort,90002) 'typgeo', typgeo
 160       write (ulsort,90002) 'nbmato', nbmato
 161       write (ulsort,90002) 'nbrfma', nbrfma
 162       write (ulsort,90002) 'typcon', typcon
 163       write (ulsort,90002) 'dim1  ', dim1
 164       write (ulsort,90002) 'numdt', numdt
 165       write (ulsort,90002) 'numit', numit
 166 #endif
 167 c
 168       codret = 0
 169 c
 170 c====
 171 c 2. Ecriture de la connectivite
 172 c====
 173 c
 174       if ( codret.eq.0 ) then
 175 c
 176 #ifdef _DEBUG_HOMARD_
 177       write (ulsort,texte(langue,3)) 'ESEMMC', nompro
 178 #endif
 179       call esemmc ( idfmed, nomamd,
 180      >              typenh, typent, typgeo,
 181      >              nbmato, nbrfma, nbelem,
 182      >              typcon, dim1,
 183      >              conmai, infosu, listma,
 184      >              numdt, numit, instan,
 185      >              tabaux,
 186      >              ulsort, langue, codret )
 187 c
 188       endif
 189 c
 190 c====
 191 c 3. Ecriture de la famille d'appartenance
 192 c====
 193 c
 194       if ( codret.eq.0 ) then
 195 c
 196 #ifdef _DEBUG_HOMARD_
 197       write (ulsort,texte(langue,3)) 'ESEMMF', nompro
 198 #endif
 199       call esemmf ( idfmed, nomamd,
 200      >              typenh, typent, typgeo,
 201      >              nbmato, nbelem, numfam,
 202      >              fammai, listma,
 203      >              numdt, numit,
 204      >              tabaux,
 205      >              ulsort, langue, codret )
 206 c
 207       endif
 208 c
 209 c====
 210 c 4. la fin
 211 c====
 212 c
 213       if ( codret.ne.0 ) then
 214 c
 215 #include "envex2.h"
 216 c
 217       write (ulsort,texte(langue,1)) 'Sortie', nompro
 218       write (ulsort,texte(langue,2)) codret
 219 c
 220       endif
 221 c
 222 #ifdef _DEBUG_HOMARD_
 223       write (ulsort,texte(langue,1)) 'Sortie', nompro
 224       call dmflsh (iaux)
 225 #endif
 226 c
 227       end