src/tool/ES_HOMARD/esece0.F

   1       subroutine esece0 ( idfmed, nomamd,
   2      >                    typenh, typgeo, typent,
   3      >                    nbenti, nbencf, nbenca, nbrfma,
   4      >                    somare,
   5      >                    codeen, infosu, codear,
   6      >                     numdt,  numit, instan,
   7      >                    ltbiau, tbiaux,
   8      >                    ulsort, langue, codret)
   9 c
  10 c ______________________________________________________________________
  11 c
  12 c                             H O M A R D
  13 c
  14 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  15 c
  16 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  17 c aupres des huissiers de justice Simart et Lavoir a Clamart
  18 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  19 c aupres des huissiers de justice
  20 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  21 c
  22 c    HOMARD est une marque deposee d'Electricite de France
  23 c
  24 c Copyright EDF 1996
  25 c Copyright EDF 1998
  26 c Copyright EDF 2002
  27 c Copyright EDF 2020
  28 c ______________________________________________________________________
  29 c
  30 c  Entree-Sortie : ECriture d'une Entite - 0
  31 c  -      -        --             -        -
  32 c ______________________________________________________________________
  33 c .  nom   . e/s . taille .           description                      .
  34 c .____________________________________________________________________.
  35 c . idfmed . e   .   1    . identificateur du fichier MED              .
  36 c . nomamd . e   . char64 . nom du maillage MED voulu                  .
  37 c . typenh . e   .   1    . code des entites                           .
  38 c .        .     .        .  -1 : noeuds                               .
  39 c .        .     .        .   0 : mailles-points                       .
  40 c .        .     .        .   1 : aretes                               .
  41 c .        .     .        .   2 : triangles                            .
  42 c .        .     .        .   3 : tetraedres                           .
  43 c .        .     .        .   4 : quadrangles                          .
  44 c .        .     .        .   5 : pyramides                            .
  45 c .        .     .        .   6 : hexaedres                            .
  46 c .        .     .        .   7 : pentaedres                           .
  47 c . typgeo . e   .   1    . type geometrique au sens MED               .
  48 c . typent . e   .   1    . type d'entite au sens MED                  .
  49 c . nbenti . e   .   1    . nombre d'entites                           .
  50 c . nbencf . e   .   1    . nombre d'entites decrites par faces        .
  51 c . nbenca . e   .   1    . nombre d'entites decrites par aretes       .
  52 c . nbrfma . e   .   1    . nbre noeuds par maille si connec. par noeud.
  53 c .        .     .        . nbre faces par maille si connectivite desce.
  54 c . somare . e   .2*nbarto. numeros des extremites d'arete             .
  55 c . codeen . e   .nbencf**. connectivite descendante des mailles       .
  56 c . infosu . e   .nbencf**. code des faces dans les mailles 3D         .
  57 c . codear . e   .nbenca**. connectivite des mailles par aretes        .
  58 c . numdt  . e   .   1    . numero du pas de temps                     .
  59 c . numit  . e   .   1    . numero d'iteration                         .
  60 c . instan . e   .   1    . pas de temps                               .
  61 c . ltbiau . e   .    1   . longueur allouee a tbiaux                  .
  62 c . tbiaux .     .    *   . tableau tampon entier                      .
  63 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  64 c . langue . e   .    1   . langue des messages                        .
  65 c .        .     .        . 1 : francais, 2 : anglais                  .
  66 c . codret . es  .    1   . code de retour des modules                 .
  67 c .        .     .        . 0 : pas de probleme                        .
  68 c ______________________________________________________________________
  69 c
  70 c====
  71 c 0. declarations et dimensionnement
  72 c====
  73 c
  74 c 0.1. ==> generalites
  75 c
  76       implicit none
  77       save
  78 c
  79       character*6 nompro
  80       parameter ( nompro = 'ESECE0' )
  81 c
  82 #include "nblang.h"
  83 #include "consts.h"
  84 c
  85 c 0.2. ==> communs
  86 c
  87 #include "envex1.h"
  88 c
  89 #include "impr02.h"
  90 c
  91 c 0.3. ==> arguments
  92 c
  93       integer*8 idfmed
  94       integer typenh, typgeo, typent
  95       integer nbenti, nbencf, nbenca, nbrfma
  96       integer somare(2,*)
  97       integer codeen(nbencf,*), infosu(nbencf,*), codear(nbenca,*)
  98       integer numdt, numit
  99       integer ltbiau, tbiaux(*)
 100 c
 101       character*64 nomamd
 102 c
 103       double precision instan
 104 c
 105       integer ulsort, langue, codret
 106 c
 107 c 0.4. ==> variables locales
 108 c
 109 #include "meddc0.h"
 110 c
 111       integer iaux
 112       integer listma(1)
 113       integer dim1
 114       integer typcon
 115 c
 116       integer nbmess
 117       parameter ( nbmess = 150 )
 118       character*80 texte(nblang,nbmess)
 119 c ______________________________________________________________________
 120 c
 121 c====
 122 c 1. messages
 123 c====
 124 c
 125 #include "impr01.h"
 126 c
 127 #ifdef _DEBUG_HOMARD_
 128       write (ulsort,texte(langue,1)) 'Entree', nompro
 129       call dmflsh (iaux)
 130 #endif
 131 c
 132       texte(1,4) = '(''... Ecriture des '',i10,1x,a)'
 133 c
 134       texte(2,4) = '(''... Writings of '',i10,1x,a)'
 135 c
 136 #include "esimpr.h"
 137 c
 138       texte(1,81) = '(''Longueur allouee pour tbiaux    : '',i10)'
 139       texte(1,82) = '(''Longueur necessaire pour tbiaux : '',i10)'
 140 c
 141       texte(2,81) = '(''Allocated length for tbiaux    : '',i10)'
 142       texte(2,82) = '(''Used length for tbiaux : '',i10)'
 143 c
 144 #include "impr03.h"
 145 c
 146 #ifdef _DEBUG_HOMARD_
 147       write (ulsort,texte(langue,4)) nbenti, mess14(langue,3,typenh)
 148       write (ulsort,90002) 'nbencf', nbencf
 149       write (ulsort,90002) 'nbenca', nbenca
 150 #endif
 151 c
 152 c====
 153 c 2. Preparation des donnees
 154 c====
 155 c 2.1. ==> Verification
 156 c
 157       if ( codret.eq.0 ) then
 158 c
 159       if ( nbenti*nbrfma.gt.ltbiau ) then
 160         write (ulsort,texte(langue,81)) ltbiau
 161         write (ulsort,texte(langue,82)) nbenti*nbrfma
 162         codret = 7
 163       endif
 164 c
 165       endif
 166 c
 167 c 2.2. ==> Creation du tableau
 168 c
 169       if ( codret.eq.0 ) then
 170 c
 171       dim1 = nbenti
 172 c
 173 c 2.2.2. ==> Mailles-points
 174 c
 175       if ( typenh.eq.0 ) then
 176 c
 177         listma(1) = 0
 178         typcon = ednoda
 179 c
 180 c 2.2.1. ==> Segments
 181 c
 182       elseif ( typenh.eq.1 ) then
 183 c
 184         dim1 = 2
 185         listma(1) = -nbrfma
 186         typcon = eddesc
 187 c
 188 c 2.2.4. ==> Autres : on cree directement le tableau a ecrire
 189 c
 190       else
 191 c
 192         listma(1) = 0
 193         typcon = eddesc
 194 c
 195 #ifdef _DEBUG_HOMARD_
 196         write (ulsort,texte(langue,3)) 'ESECE2', nompro
 197 #endif
 198         call esece2 ( typenh, nbencf, nbenca, nbrfma,
 199      >                somare, codeen, infosu, codear,
 200      >                tbiaux,
 201      >                ulsort, langue, codret )
 202 c
 203       endif
 204 c
 205       endif
 206 c
 207 c====
 208 c 3. Ecriture veritable
 209 c====
 210 c
 211       if ( codret.eq.0 ) then
 212 c
 213 #ifdef _DEBUG_HOMARD_
 214       write (ulsort,texte(langue,3)) 'ESEMMC', nompro
 215 #endif
 216       call esemmc ( idfmed, nomamd,
 217      >              typenh, typent, typgeo,
 218      >              nbenti, nbrfma, nbenti,
 219      >              typcon,   dim1,
 220      >              codeen, infosu, listma,
 221      >               numdt,  numit, instan,
 222      >              tbiaux,
 223      >              ulsort, langue, codret )
 224 c
 225       endif
 226 c
 227 c====
 228 c 4. la fin
 229 c====
 230 c
 231       if ( codret.ne.0 ) then
 232 c
 233 #include "envex2.h"
 234 c
 235       write (ulsort,texte(langue,1)) 'Sortie', nompro
 236       write (ulsort,texte(langue,2)) codret
 237 c
 238       endif
 239 c
 240 #ifdef _DEBUG_HOMARD_
 241       write (ulsort,texte(langue,1)) 'Sortie', nompro
 242       call dmflsh (iaux)
 243 #endif
 244 c
 245       end