src/tool/AV_Conversion/vcsfal.F

   1       subroutine vcsfal ( nbelem, nbf,
   2      >                    pointl, taigrl, nomgrl,
   3      >                    coexar,
   4      >                    frofam, typefr, nogrfr,
   5      >                    nuelex, narsho,
   6      >                    fameel, typele, numfam,
   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    aVant adaptation - Conversion
  29 c     -                 -
  30 c                     - Suivi de Frontiere - lien Arete Ligne
  31 c                       -        -                -     -
  32 c ______________________________________________________________________
  33 c .        .     .        .                                            .
  34 c .  nom   . e/s . taille .           description                      .
  35 c .____________________________________________________________________.
  36 c . nbelem . e   .   1    . nombre d'elements dans le maillage         .
  37 c . nbf    . e   .   1    . nombre de familles du maillage de calcul   .
  38 c . pointl . e   .0:nbfron. pointeur sur le tableau nomgrl             .
  39 c . taigrl . e   .   *    . taille des noms des groupes des frontieres .
  40 c . nomgrl . e   .   *    . noms des groupes des frontieres            .
  41 c . coexar . es  . nbarto*. codes de conditions aux limites portants   .
  42 c .        .     . nctfar . sur les aretes                             .
  43 c . frofam . e   . nbfami . donne l'eventuel numero de ligne           .
  44 c .        .     .        . associee a chaque famille MED              .
  45 c . typefr . es  .   nbf  . type de frontiere (1:ligne/-1:surface)     .
  46 c . nogrfr . es  . 10*nbf . nom des groupes frontieres CAO             .
  47 c . nuelex . e   . nbelem . numerotation des elements en exterieur     .
  48 c . narsho . e   . rsarac . numero des aretes dans HOMARD              .
  49 c . fameel . e   . nbelem . famille med des elements                   .
  50 c . typele . e   . nbelem . type des elements pour le code de calcul   .
  51 c . numfam . e   .   1    . numero MED des familles                    .
  52 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  53 c . langue . e   .    1   . langue des messages                        .
  54 c .        .     .        . 1 : francais, 2 : anglais                  .
  55 c . codret . es  .    1   . code de retour des modules                 .
  56 c .        .     .        . 0 : pas de probleme                        .
  57 c .        .     .        . 1 : probleme                               .
  58 c ______________________________________________________________________
  59 c
  60 c====
  61 c 0. declarations et dimensionnement
  62 c====
  63 c
  64 c 0.1. ==> generalites
  65 c
  66       implicit none
  67       save
  68 c
  69       character*6 nompro
  70       parameter ( nompro = 'VCSFAL' )
  71 c
  72 #include "nblang.h"
  73 #include "cofaar.h"
  74 c
  75 c 0.2. ==> communs
  76 c
  77 #include "envex1.h"
  78 c
  79 #include "dicfen.h"
  80 #include "nombar.h"
  81 #include "refert.h"
  82 #include "rftmed.h"
  83 c
  84 c 0.3. ==> arguments
  85 c
  86       integer nbelem, nbf
  87       integer pointl(0:*)
  88       integer taigrl(*)
  89       integer coexar(nbarto,nctfar)
  90       integer frofam(nbf), typefr(nbf)
  91       integer nuelex(nbelem)
  92       integer narsho(*), fameel(nbelem), typele(nbelem)
  93       integer numfam(*)
  94 c
  95       integer ulsort, langue, codret
  96 c
  97       character*8 nomgrl(*)
  98       character*8 nogrfr(10*nbf)
  99 c
 100 c 0.4. ==> variables locales
 101 c
 102       integer iaux, jaux
 103       integer el, nufro
 104       integer typhom
 105       integer lgngro
 106 c
 107       character*80 nomgro
 108 c
 109       integer nbmess
 110       parameter ( nbmess = 10 )
 111       character*80 texte(nblang,nbmess)
 112 c
 113 c 0.5. ==> initialisations
 114 c
 115 c====
 116 c 1. messages
 117 c====
 118 c
 119 #include "impr01.h"
 120 c
 121 #ifdef _DEBUG_HOMARD_
 122       write (ulsort,texte(langue,1)) 'Entree', nompro
 123       call dmflsh (iaux)
 124 #endif
 125 c
 126 #include "impr03.h"
 127 c
 128       codret = 0
 129 c
 130 c====
 131 c 2. prise en compte du suivi de frontiere
 132 c    prise en compte de la correspondance entre les aretes de bord
 133 c    et des lignes du format c pour le suivi de frontiere.
 134 c====
 135 c
 136 c     si une arete est attachee a une frontiere alors le premier code
 137 c     contient le numero de la frontiere ; sinon 0
 138 c     le numero de la frontiere est positif si le suivi de frontiere
 139 c     est actif pour cette arete, negatif sinon
 140 c     le deuxieme code contient le numero de la famille dont le
 141 c     numero de frontiere est l'oppose
 142 c
 143       do 21 , el = 1 , nbelem
 144 c
 145         typhom = medtrf(typele(el))
 146 c
 147         if ( typhom.eq.tyhse1 .or. typhom.eq.tyhse2 ) then
 148 c
 149           nufro = 0
 150           if ( fameel(el).ne.0 ) then
 151             do 211 , iaux = 1 , nbf
 152               if ( numfam(iaux).eq.fameel(el) ) then
 153                 nufro = frofam(iaux)
 154               endif
 155   211       continue
 156           endif
 157 c
 158           coexar(narsho(nuelex(el)),cosfli) = nufro
 159 c
 160 c     Si on a trouve une frontiere, on doit supprimer
 161 c     l'eventuelle surface
 162 c
 163           if ( nufro.ne.0 ) then
 164 c
 165             coexar(narsho(nuelex(el)),cosfsa) = 0
 166 c
 167 c             memorisation pour le suivi
 168 c
 169             if ( typefr(nufro).eq.0 ) then
 170 c
 171               if ( codret.eq.0 ) then
 172 c
 173 c       adresse du debut du groupe associe a la frontiere nufro
 174               iaux = pointl(nufro-1) + 1
 175 c
 176 c       longueur utile du nom du groupe
 177               lgngro = 0
 178               do 31 , jaux = iaux , pointl(nufro)
 179                 lgngro = lgngro + taigrl(jaux)
 180    31         continue
 181 c
 182               endif
 183 c
 184               if ( codret.eq.0 ) then
 185 c
 186 c       recuperation du nom du groupe associe a la frontiere nufro
 187               call uts8ch ( nomgrl(iaux), lgngro, nomgro,
 188      >                      ulsort, langue, codret )
 189 c
 190               endif
 191 c
 192               if ( codret.eq.0 ) then
 193 c
 194               typefr(nufro) = 1
 195               call utchs8 ( nomgro, lgngro, nogrfr(10*(nufro-1)+1),
 196      >                      ulsort, langue, codret )
 197 c
 198               endif
 199 c
 200             endif
 201 c
 202           endif
 203 c
 204         endif
 205 c
 206    21 continue
 207 c
 208 c====
 209 c 3. bilan
 210 c====
 211 c
 212       if ( codret.ne.0 ) then
 213 c
 214 #include "envex2.h"
 215 c
 216       write (ulsort,texte(langue,1)) 'Sortie', nompro
 217       write (ulsort,texte(langue,2)) codret
 218 c
 219       endif
 220 c
 221 #ifdef _DEBUG_HOMARD_
 222       write (ulsort,texte(langue,1)) 'Sortie', nompro
 223       call dmflsh (iaux)
 224 #endif
 225 c
 226       end