src/tool/AV_Conversion/vcme25.F

   1       subroutine vcme25 ( typenh,
   2      >                    nctfen, ncffen, cofxet, cofxep,
   3      >                    notfen, nofaen, cofaen,
   4      >                    nhenfa,
   5      >                    nbfaen, pcfaen,
   6      >                    ulsort, langue, codret )
   7 c ______________________________________________________________________
   8 c
   9 c                             H O M A R D
  10 c
  11 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  12 c
  13 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  14 c aupres des huissiers de justice Simart et Lavoir a Clamart
  15 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  16 c aupres des huissiers de justice
  17 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  18 c
  19 c    HOMARD est une marque deposee d'Electricite de France
  20 c
  21 c Copyright EDF 1996
  22 c Copyright EDF 1998
  23 c Copyright EDF 2002
  24 c Copyright EDF 2020
  25 c ______________________________________________________________________
  26 c
  27 c    aVant adaptation - Conversion de Maillage Extrude - phase 25
  28 c     -                 -             -        -               --
  29 c Determine les familles pour le lien face avant / face arriere
  30 c ______________________________________________________________________
  31 c .        .     .        .                                            .
  32 c .  nom   . e/s . taille .           description                      .
  33 c .____________________________________________________________________.
  34 c . typenh . e   .    1   . type d'entites                             .
  35 c .        .     .        .  -1 : noeuds                               .
  36 c .        .     .        .   0 : mailles-points                       .
  37 c .        .     .        .   1 : segments                             .
  38 c .        .     .        .   2 : triangles                            .
  39 c .        .     .        .   3 : tetraedres                           .
  40 c .        .     .        .   4 : quadrangles                          .
  41 c .        .     .        .   5 : pyramides                            .
  42 c .        .     .        .   6 : hexaedres                            .
  43 c .        .     .        .   7 : pentaedres                           .
  44 c . nctfen . e   .    1   . nombre de caracteristique des f. entite    .
  45 c . ncffen . e   .    1   . nombre de caracteristique figees entite    .
  46 c . cofxet . e   .    1   . code de la famille de l'entite translatee  .
  47 c . cofxep . e   .    1   . code de la position de l'entite            .
  48 c . nbenti . e   .    1   . nombre d'entites                           .
  49 c . notfen . e   .  1     . nombre d'origine des carac. des f. entite  .
  50 c . nofaen . e   .  1     . nombre d'origine de familles de l'entite   .
  51 c . cofaen . e   . notfen*. codes d'origine des familles de l'entite   .
  52 c .        .     . nofaen .                                            .
  53 c . nhenfa . e   . char8  . objet decrivant les familles de l'entite   .
  54 c . nbfaen .  s  .  1     . nombre de familles de l'entite             .
  55 c . pcfaen .  s  .  1     . codes des familles de l'entite             .
  56 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  57 c . langue . e   .    1   . langue des messages                        .
  58 c .        .     .        . 1 : francais, 2 : anglais                  .
  59 c . codret . e   .    1   . code de retour des modules                 .
  60 c .        .     .        . 0 : pas de probleme                        .
  61 c .        .     .        . 1 : probleme                               .
  62 c ______________________________________________________________________
  63 c
  64 c====
  65 c 0. declarations et dimensionnement
  66 c====
  67 c
  68 c 0.1. ==> generalites
  69 c
  70       implicit none
  71       save
  72 c
  73       character*6 nompro
  74       parameter ( nompro = 'VCME25' )
  75 c
  76 #include "nblang.h"
  77 c
  78 c 0.2. ==> communs
  79 c
  80 #include "envex1.h"
  81 #include "gmenti.h"
  82 c
  83 #include "impr02.h"
  84 c
  85 c 0.3. ==> arguments
  86 c
  87       integer typenh
  88       integer nctfen, ncffen, cofxet, cofxep
  89       integer notfen, nofaen, cofaen(notfen,nofaen)
  90       integer nbfaen, pcfaen
  91 c
  92       character*8 nhenfa
  93 c
  94       integer ulsort, langue, codret
  95 c
  96 c 0.4. ==> variables locales
  97 c
  98       integer iaux
  99       integer nbfae0
 100       integer numfam
 101 c
 102       integer nbmess
 103       parameter ( nbmess = 10 )
 104       character*80 texte(nblang,nbmess)
 105 c
 106 c 0.5. ==> initialisations
 107 c ______________________________________________________________________
 108 c
 109 c====
 110 c 1. messages
 111 c====
 112 c
 113 #include "impr01.h"
 114 c
 115 #ifdef _DEBUG_HOMARD_
 116       write (ulsort,texte(langue,1)) 'Entree', nompro
 117       call dmflsh (iaux)
 118 #endif
 119 c
 120 #include "impr03.h"
 121 c
 122       texte(1,4) = '(''Familles d''''extrusion des '',a)'
 123 c
 124       texte(2,4) = '(''Description of families of extruded '',a)'
 125 c
 126 #ifdef _DEBUG_HOMARD_
 127       write (ulsort,texte(langue,4)) mess14(langue,3,typenh)
 128       write (ulsort,90002) 'nctfen', nctfen
 129 #endif
 130 c
 131       codret = 0
 132 c
 133 c====
 134 c. Parcours des familles initiales
 135 c====
 136 #ifdef _DEBUG_HOMARD_
 137       write (ulsort,90002) '3. parcours ; codret', codret
 138 #endif
 139 c
 140 c 2.1. ==> Taille initiale du tableau
 141 c
 142       nbfae0 = nbfaen
 143       numfam = 0
 144 c
 145 c 2.2. ==> Allongement de la taille du tableau des familles
 146 c
 147    22 continue
 148 c
 149       if ( codret.eq.0 ) then
 150 c
 151       nbfae0 = nbfae0 + 25
 152 c
 153 #ifdef _DEBUG_HOMARD_
 154       write (ulsort,texte(langue,3)) 'UTFAM2', nompro
 155 #endif
 156       call utfam2 ( typenh, nhenfa, nctfen, nbfae0,
 157      >              pcfaen,
 158      >              ulsort, langue, codret)
 159 c
 160       endif
 161 c
 162 c 2.3. ==> Programme utilitaire
 163 c
 164       if ( codret.eq.0 ) then
 165 c
 166 #ifdef _DEBUG_HOMARD_
 167       write (ulsort,texte(langue,3)) 'VCME26', nompro
 168 #endif
 169       call vcme26 ( typenh, numfam,
 170      >              nctfen, ncffen, cofxet, cofxep,
 171      >              notfen, nofaen, cofaen,
 172      >              nbfae0, nbfaen, imem(pcfaen),
 173      >              ulsort, langue, codret )
 174 c
 175       endif
 176 c
 177 c 2.4. ==> A rallonger ?
 178 c
 179       if ( codret.eq.0 ) then
 180 c
 181       if ( nbfaen.lt.0 ) then
 182 c
 183         nbfaen = -nbfaen
 184         goto 22
 185 c
 186       endif
 187 c
 188       endif
 189 c
 190 c====
 191 c 3. Redimensionnement final
 192 c====
 193 #ifdef _DEBUG_HOMARD_
 194       write (ulsort,90002) '3. Redimensionnement ; codret', codret
 195       write (ulsort,90002) 'nbfaen', nbfaen
 196       write (ulsort,90002) 'nbfae0', nbfae0
 197 #endif
 198 c
 199       if ( nbfaen.ne.nbfae0 ) then
 200 c
 201         if ( codret.eq.0 ) then
 202 c
 203 #ifdef _DEBUG_HOMARD_
 204         write (ulsort,texte(langue,3)) 'UTFAM2', nompro
 205 #endif
 206         call utfam2 ( typenh, nhenfa, nctfen, nbfaen,
 207      >                pcfaen,
 208      >                ulsort, langue, codret)
 209 c
 210         endif
 211 c
 212       endif
 213 c
 214 #ifdef _DEBUG_HOMARD_
 215       call gmprsx ( mess14(langue,3,typenh), nhenfa//'.Codes')
 216 #endif
 217 c
 218 c====
 219 c 4. la fin
 220 c====
 221 c
 222       if ( codret.ne.0 ) then
 223 c
 224 #include "envex2.h"
 225 c
 226       write (ulsort,texte(langue,1)) 'Sortie', nompro
 227       write (ulsort,texte(langue,2)) codret
 228 c
 229       endif
 230 c
 231 #ifdef _DEBUG_HOMARD_
 232       write (ulsort,texte(langue,1)) 'Sortie', nompro
 233       call dmflsh (iaux)
 234 #endif
 235 c
 236       end