src/tool/ES_MED/eslmmc.F

   1       subroutine eslmmc ( idfmed, nomamd,
   2      >                    typenh, typent, typgeo,
   3      >                    nmadeb, nbmato, dim1, dim2,
   4      >                    typcon,
   5      >                    conmai,
   6      >                    tbiaux,
   7      >                    ulsort, langue, codret )
   8 c ______________________________________________________________________
   9 c
  10 c                             H O M A R D
  11 c
  12 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  13 c
  14 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  15 c aupres des huissiers de justice Simart et Lavoir a Clamart
  16 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  17 c aupres des huissiers de justice
  18 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  19 c
  20 c    HOMARD est une marque deposee d'Electricite de France
  21 c
  22 c Copyright EDF 1996
  23 c Copyright EDF 1998
  24 c Copyright EDF 2002
  25 c Copyright EDF 2020
  26 c ______________________________________________________________________
  27 c
  28 c  Entree-Sortie - Lecture d'un Maillage au format MED
  29 c  -      -        -            -                  -
  30 c                - Connectivites
  31 c                  -
  32 c ______________________________________________________________________
  33 c .        .     .        .                                            .
  34 c .  nom   . e/s . taille .           description                      .
  35 c .____________________________________________________________________.
  36 c . idfmed . e   .   1    . identificateur du fichier de               .
  37 c .        .     .        . maillage de sortie                         .
  38 c . nomamd . e   . char64 . nom du maillage MED                        .
  39 c . typenh . e   .   1    . code des entites au sens homard            .
  40 c .        .     .        .  -1 : noeuds                               .
  41 c .        .     .        .   0 : mailles-points                       .
  42 c .        .     .        .   1 : segments                             .
  43 c .        .     .        .   2 : triangles                            .
  44 c .        .     .        .   3 : tetraedres                           .
  45 c .        .     .        .   4 : quadrangles                          .
  46 c .        .     .        .   5 : pyramides                            .
  47 c .        .     .        .   6 : hexaedres                            .
  48 c .        .     .        .   7 : pentaedres                           .
  49 c . typent . e   .   1    . type des entites au sens MED               .
  50 c . typgeo . e   .   1    . type geometrique au sens MED               .
  51 c . nmadeb . e   .   1    . numero de la maille de debut               .
  52 c .        .     .        .  >=0 : le tableau est pris tel quel        .
  53 c .        .     .        .   <0 : les descriptions sont inversees     .
  54 c . nbmato . e   .   1    . nombre de mailles a lire                   .
  55 c . dim1   . e   .   1    . 1ere dimension de la connectivite          .
  56 c . dim2   . e   .   1    . 2nde dimension de la connectivite          .
  57 c . typcon . e   .   1    . type de connectivite                       .
  58 c .        .     .        . 0 : par noeud (ednoda)                     .
  59 c .        .     .        . 1 : descendante (eddesc)                   .
  60 c . conmai .  s  .dim1dim2. connectivite des mailles                   .
  61 c . tbiaux .     .    *   . tableau tampon                             .
  62 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  63 c . langue . e   .    1   . langue des messages                        .
  64 c .        .     .        . 1 : francais, 2 : anglais                  .
  65 c . codret . es  .    1   . code de retour des modules                 .
  66 c .        .     .        . 0 : pas de probleme                        .
  67 c .        .     .        . 1 : 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 = 'ESLMMC' )
  81 c
  82 #include "nblang.h"
  83 #include "consts.h"
  84 c
  85 c 0.2. ==> communs
  86 c
  87 #include "envex1.h"
  88 #include "impr02.h"
  89 c
  90 c 0.3. ==> arguments
  91 c
  92       integer*8 idfmed
  93       integer typenh, typent, typgeo
  94       integer nmadeb, nbmato, dim1, dim2
  95       integer typcon
  96       integer conmai(dim1,dim2)
  97       integer tbiaux(*)
  98 c
  99       character*64 nomamd
 100 c
 101       integer ulsort, langue, codret
 102 c
 103 c 0.4. ==> variables locales
 104 c
 105 #include "meddc0.h"
 106 c
 107       integer iaux, jaux, kaux, laux
 108       integer nmafin
 109       integer numdt, numit
 110 c
 111       character*6 saux06
 112 c
 113       integer nbmess
 114       parameter ( nbmess = 150 )
 115       character*80 texte(nblang,nbmess)
 116 c ______________________________________________________________________
 117 c
 118 c====
 119 c 1. initialisations
 120 c====
 121 c
 122 c 1.1. ==> les messages
 123 c
 124 #include "impr01.h"
 125 c
 126 #ifdef _DEBUG_HOMARD_
 127       write (ulsort,texte(langue,1)) 'Entree', nompro
 128       call dmflsh (iaux)
 129 #endif
 130 c
 131       texte(1,4) = '(''... Lecture des '',i10,1x,a)'
 132       texte(1,63) = '(''Toutes les familles sont nulles.'')'
 133 c
 134       texte(2,4) = '(''... Readings of '',i10,1x,a)'
 135       texte(2,63) = '(''All the families are 0.'')'
 136 c
 137 #include "impr03.h"
 138 c
 139 #include "esimpr.h"
 140 c
 141 #ifdef _DEBUG_HOMARD_
 142       write (ulsort,texte(langue,4)) nbmato, mess14(langue,3,typenh)
 143 #endif
 144 c
 145       codret = 0
 146       nmafin = nmadeb + nbmato - 1
 147 c
 148 #ifdef _DEBUG_HOMARD_
 149       write (ulsort,90002) 'typcon', typcon
 150       write (ulsort,90002) 'typenh', typenh
 151       write (ulsort,90002) 'typent', typent
 152       write (ulsort,90002) 'typgeo', typgeo
 153       write (ulsort,90002) 'nmadeb', nmadeb
 154       write (ulsort,90002) 'nbmato', nbmato
 155       write (ulsort,90002) 'nmafin', nmafin
 156       write (ulsort,90002) 'dim1  ', dim1
 157       write (ulsort,90002) 'dim2  ', dim2
 158 #endif
 159 c
 160       numdt = ednodt
 161       numit = ednoit
 162 c
 163 c====
 164 c 2. Lecture de la connectivite des mailles
 165 c====
 166 c
 167       if ( codret.eq.0 ) then
 168 c
 169 #ifdef _DEBUG_HOMARD_
 170       write (ulsort,texte(langue,3)) 'MMHCYR', nompro
 171 #endif
 172       call mmhcyr ( idfmed, nomamd, numdt, numit,
 173      >              typent, typgeo,
 174      >              typcon, edfuin,
 175      >              tbiaux, codret )
 176       if ( codret.ne.0 ) then
 177         saux06 = 'mmhcyr'
 178       endif
 179 c
 180       endif
 181 c
 182 c====
 183 c 3. Creation de la connectivite par noeud
 184 c====
 185 c
 186       kaux = 0
 187 c
 188       if ( typcon.eq.ednoda ) then
 189 c
 190         if ( codret.eq.0 ) then
 191 c
 192         if ( nmadeb.ge.0 ) then
 193 c
 194           do 31 , iaux = nmadeb , nmafin
 195             do 311, jaux = 1, dim2
 196               kaux = kaux + 1
 197               conmai(iaux,jaux) = tbiaux(kaux)
 198   311       continue
 199    31     continue
 200 c
 201         else
 202 cgn      print *,'passage 32 avec dim2 =', dim2
 203 c
 204           do 32 , iaux = 1, nbmato
 205 cgn          print *,conmai(1,iaux), conmai(2,iaux)
 206             do 321, jaux = 1, dim2
 207               kaux = kaux + 1
 208               conmai(jaux,iaux) = tbiaux(kaux)
 209   321       continue
 210    32     continue
 211 c
 212         endif
 213 c
 214         endif
 215 c
 216 c====
 217 c 4. Creation de la connectivite descendante, sauf pour les volumes
 218 c====
 219 c
 220       else
 221 c
 222         if ( codret.eq.0 ) then
 223 c
 224 c 4.1. ==> Pour les faces
 225 c
 226         if ( typenh.eq.2 .or. typenh.eq.4 ) then
 227 c
 228 cgn      print *,'passage 231 avec nmadeb , nmafin =', nmadeb , nmafin
 229           do 41 , iaux = nmadeb , nmafin
 230 cgn            print *,(conmai(iaux,jaux),jaux = 1, dim2)
 231             do 411, jaux = 1, dim2
 232               kaux = kaux + 1
 233               conmai(iaux,jaux) = abs(tbiaux(kaux))
 234   411       continue
 235    41     continue
 236 c
 237 c 4.2. ==> Pour les segments
 238 c
 239         elseif ( typenh.eq.1 ) then
 240 c
 241 c  Le noeud milieu sera gere par les informations supplementaires
 242 c
 243           laux = dim2 - 2
 244 c
 245 cgn      print *,'passage 42 avec dim2, nbmato =', dim2, nbmato
 246           do 42 , iaux = 1, nbmato
 247             do 421, jaux = 1, 2
 248               kaux = kaux + 1
 249               conmai(jaux,iaux) = tbiaux(kaux)
 250   421       continue
 251             kaux = kaux + laux
 252 cgn          print *,conmai(1,iaux), conmai(2,iaux)
 253    42     continue
 254 c
 255         endif
 256 c
 257         endif
 258 c
 259       endif
 260 c
 261 c====
 262 c 5. la fin
 263 c====
 264 c
 265       if ( codret.ne.0 ) then
 266 c
 267 #include "envex2.h"
 268 c
 269       write (ulsort,texte(langue,1)) 'Sortie', nompro
 270       write (ulsort,texte(langue,2)) codret
 271       write (ulsort,texte(langue,4)) nbmato, mess14(langue,3,typenh)
 272       write (ulsort,texte(langue,78)) saux06, codret
 273       write (ulsort,texte(langue,79))
 274 c
 275       endif
 276 c
 277 #ifdef _DEBUG_HOMARD_
 278       write (ulsort,texte(langue,1)) 'Sortie', nompro
 279       call dmflsh (iaux)
 280 #endif
 281 c
 282       end