src/tool/ES_MED/esemmf.F

   1       subroutine esemmf ( idfmed, nomamd,
   2      >                    typenh, typent, typgeo,
   3      >                    nbmato, nbelem, numfam,
   4      >                    fammai, listma,
   5      >                    numdt, numit,
   6      >                    tabaux,
   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 - Ecriture d'un Maillage au format MED
  29 c  -      -        -            -                   -
  30 c                - Familles
  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 . nbmato . e   .   1    . nombre de mailles                          .
  40 c . nbelem . e   .   1    . nombre d'elements, tous types confondus    .
  41 c . numfam . e   .   1    . decalage dans la numerotation des familles .
  42 c .        .     .        .   1 : le tableau est pris tel quel         .
  43 c .        .     .        .  <=0 : le tableau passe negatif et est     .
  44 c .        .     .        .        decale de numfam                    .
  45 c . typenh . e   .   1    . code des entites au sens homard            .
  46 c .        .     .        .  -1 : noeuds                               .
  47 c .        .     .        .   0 : mailles-points                       .
  48 c .        .     .        .   1 : segments                             .
  49 c .        .     .        .   2 : triangles                            .
  50 c .        .     .        .   3 : tetraedres                           .
  51 c .        .     .        .   4 : quadrangles                          .
  52 c .        .     .        .   5 : pyramides                            .
  53 c .        .     .        .   6 : hexaedres                            .
  54 c .        .     .        .   7 : pentaedres                           .
  55 c . typent . e   .   1    . type des entites au sens MED               .
  56 c . typgeo . e   .   1    . type geometrique au sens MED               .
  57 c . fammai . e   . nbelem . famille med des mailles                    .
  58 c . listma . e   .   1    . liste des mailles a ecrire                 .
  59 c .        .     .        . si listma(1) vaut 0, on ecrit tout         .
  60 c .        .     .        . si listma(1) vaut -1, on ecrit tout et les .
  61 c .        .     .        . descriptions sont inversees                .
  62 c .        .     .        . si listma(1) vaut -2, on ecrit les segments.
  63 c .        .     .        . en degre 2 a partir de esece0              .
  64 c .        .     .        . si listma(1) vaut -3, on ecrit les segments.
  65 c .        .     .        . en degre 3 a partir de esece0              .
  66 c . numdt  . e   .   1    . numero du pas de temps                     .
  67 c . numit  . e   .   1    . numero d'iteration                         .
  68 c . tabaux .     . nbelem . tableau tampon                             .
  69 c .        .     . *nbmane.                                            .
  70 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  71 c . langue . e   .    1   . langue des messages                        .
  72 c .        .     .        . 1 : francais, 2 : anglais                  .
  73 c . codret . es  .    1   . code de retour des modules                 .
  74 c .        .     .        . 0 : pas de probleme                        .
  75 c .        .     .        . 1 : probleme                               .
  76 c ______________________________________________________________________
  77 c
  78 c====
  79 c 0. declarations et dimensionnement
  80 c====
  81 c
  82 c 0.1. ==> generalites
  83 c
  84       implicit none
  85       save
  86 c
  87       character*6 nompro
  88       parameter ( nompro = 'ESEMMF' )
  89 c
  90 #include "nblang.h"
  91 #include "consts.h"
  92 c
  93 c 0.2. ==> communs
  94 c
  95 #include "envex1.h"
  96 #include "impr02.h"
  97 c
  98 c 0.3. ==> arguments
  99 c
 100       integer*8 idfmed
 101       integer typenh, typent, typgeo
 102       integer nbmato, nbelem, numfam
 103       integer fammai(nbelem)
 104       integer listma(nbmato), tabaux(*)
 105       integer numdt, numit
 106 c
 107       character*64 nomamd
 108 c
 109       integer ulsort, langue, codret
 110 c
 111 c 0.4. ==> variables locales
 112 c
 113 #include "meddc0.h"
 114 c
 115       integer iaux
 116 c
 117       character*6 saux06
 118 c
 119       integer nbmess
 120       parameter ( nbmess = 150 )
 121       character*80 texte(nblang,nbmess)
 122 c ______________________________________________________________________
 123 c
 124 c====
 125 c 1. initialisations
 126 c====
 127 c
 128 c 1.1. ==> les messages
 129 c
 130 #include "impr01.h"
 131 c
 132 #ifdef _DEBUG_HOMARD_
 133       write (ulsort,texte(langue,1)) 'Entree', nompro
 134       call dmflsh (iaux)
 135 #endif
 136 c
 137       texte(1,4) = '(''. Ecriture des '',i10,1x,a)'
 138 c
 139       texte(2,4) = '(''. Writings of '',i10,1x,a)'
 140 c
 141 #include "esimpr.h"
 142 #include "impr03.h"
 143 c
 144 #ifdef _DEBUG_HOMARD_
 145       write (ulsort,texte(langue,4)) nbmato, mess14(langue,3,typenh)
 146 #endif
 147 #ifdef _DEBUG_HOMARD_
 148       write (ulsort,90002) 'listma(1)', listma(1)
 149       write (ulsort,90002) 'typenh', typenh
 150       write (ulsort,90002) 'typent', typent
 151       write (ulsort,90002) 'typgeo', typgeo
 152       write (ulsort,90002) 'nbmato', nbmato
 153       write (ulsort,90002) 'numdt', numdt
 154       write (ulsort,90002) 'numit', numit
 155 #endif
 156 c
 157       codret = 0
 158 c
 159 c====
 160 c 2. Creation du tableau de travail
 161 c====
 162 c
 163       if ( codret.eq.0 ) then
 164 c
 165 cgn      write(ulsort,*)'fammai',(fammai(iaux),iaux=1,min(30,nbmato))
 166       if ( listma(1).le.0 ) then
 167 c
 168         if ( numfam.gt.0 ) then
 169 c
 170           do 211 , iaux = 1, nbmato
 171             tabaux(iaux) = fammai(iaux)
 172   211     continue
 173 c
 174         else
 175 c
 176           do 212 , iaux = 1, nbmato
 177             tabaux(iaux) = -fammai(iaux) + numfam
 178   212     continue
 179 c
 180         endif
 181 c
 182       else
 183 c
 184         if ( numfam.gt.0 ) then
 185 c
 186           do 221 , iaux = 1, nbmato
 187             tabaux(iaux) = fammai(listma(iaux))
 188   221     continue
 189 c
 190         else
 191 c
 192           do 222 , iaux = 1, nbmato
 193             tabaux(iaux) = -fammai(listma(iaux)) + numfam
 194   222     continue
 195 c
 196         endif
 197 c
 198       endif
 199 c
 200 c====
 201 c 3. Ecritures
 202 c====
 203 c
 204 #ifdef _DEBUG_HOMARD_
 205       write (ulsort,texte(langue,3)) 'MMHFNW', nompro
 206 #endif
 207       call mmhfnw ( idfmed, nomamd, numdt, numit,
 208      >              typent, typgeo,
 209      >              nbmato, tabaux, codret )
 210       if ( codret.ne.0 ) then
 211         saux06 = 'mmhfnw'
 212       endif
 213 c
 214       endif
 215 c
 216 c====
 217 c 4. la fin
 218 c====
 219 c
 220       if ( codret.ne.0 ) then
 221 c
 222 #include "envex2.h"
 223 c
 224       write (ulsort,texte(langue,1)) 'Sortie', nompro
 225       write (ulsort,texte(langue,2)) codret
 226       write (ulsort,texte(langue,4)) nbmato, mess14(langue,3,typenh)
 227       write (ulsort,texte(langue,78)) saux06, codret
 228       write (ulsort,texte(langue,80))
 229 c
 230       endif
 231 c
 232 #ifdef _DEBUG_HOMARD_
 233       write (ulsort,texte(langue,1)) 'Sortie', nompro
 234       call dmflsh (iaux)
 235 #endif
 236 c
 237       end