src/tool/AV_Conversion/vcsflg.F

   1       subroutine vcsflg ( nbfron, nbf,
   2      >                    pointl, taigrl, nomgrl,
   3      >                    pointe, nomgrf, numfam, nomfam,
   4      >                    frofam, decala,
   5      >                    ulsort, langue, codret )
   6 c ______________________________________________________________________
   7 c
   8 c                             H O M A R D
   9 c
  10 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  11 c
  12 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  13 c aupres des huissiers de justice Simart et Lavoir a Clamart
  14 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  15 c aupres des huissiers de justice
  16 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  17 c
  18 c    HOMARD est une marque deposee d'Electricite de France
  19 c
  20 c Copyright EDF 1996
  21 c Copyright EDF 1998
  22 c Copyright EDF 2002
  23 c Copyright EDF 2020
  24 c ______________________________________________________________________
  25 c
  26 c    aVant adaptation - Conversion - Suivi de Frontiere
  27 c     -                 -            -        -
  28 c                     - Lien famille/ligne.surface - par les Groupes
  29 c                       -                                    -
  30 c ______________________________________________________________________
  31 c
  32 c  Chaque element de frontiere (ligne ou surface) dont on demande le
  33 c  suivi est designe par son nom.
  34 c  On passe en revue toutes les familles du maillage MED. Quand
  35 c  le nom du groupe lie a une frontiere apparait dans la description
  36 c  des groupes definissant la famille, on indique que la famille est
  37 c  liee a la frontiere  courante. La sortie est donc un tableau donnant
  38 c  pour chaque famille MED l'eventuel numero de frontiere qui lui
  39 c  correspond.
  40 c  remarque : vcsflg et vcsfll sont des clones
  41 c ______________________________________________________________________
  42 c .        .     .        .                                            .
  43 c .  nom   . e/s . taille .           description                      .
  44 c .____________________________________________________________________.
  45 c . nbfron . e   .   1    . nombre de frontieres decrites              .
  46 c . nbf    . e   .   1    . nombre de familles du maillage de calcul   .
  47 c . pointl . e   .0:nbfron. pointeur sur le tableau nomgrl             .
  48 c . taigrl . e   .   *    . taille des noms des groupes des frontieres .
  49 c . nomgrl . e   .   *    . noms des groupes des frontieres            .
  50 c . pointf . e   . 0:nbf  . pointeur sur le tableau nomgrf             .
  51 c . nomgrf . e   .   *    . noms des groupes des familles              .
  52 c . numfam . e   .   1    . numero MED des familles                    .
  53 c . nomfam . e   . 10*nbf . nom des familles MED                       .
  54 c . frofam .  s  .  nbf   . donne l'eventuel numero de frontiere       .
  55 c .        .     .        . associee a chaque famille MED              .
  56 c . decala . e   .   1    . decalage dans le stockage des numeros de fr.
  57 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  58 c . langue . e   .    1   . langue des messages                        .
  59 c .        .     .        . 1 : francais, 2 : anglais                  .
  60 c . codret . es  .    1   . code de retour des modules                 .
  61 c .        .     .        . 0 : pas de probleme                        .
  62 c .        .     .        . sinon probleme                             .
  63 c ______________________________________________________________________
  64 c
  65 c====
  66 c 0. declarations et dimensionnement
  67 c====
  68 c
  69 c 0.1. ==> generalites
  70 c
  71       implicit none
  72       save
  73 c
  74       character*6 nompro
  75       parameter ( nompro = 'VCSFLG' )
  76 c
  77 #include "nblang.h"
  78 c
  79 c 0.2. ==> communs
  80 c
  81 #include "envex1.h"
  82 c
  83 c 0.3. ==> arguments
  84 c
  85       integer nbfron, nbf
  86       integer numfam(nbf)
  87       integer frofam(nbf), decala
  88       integer pointl(0:nbfron), pointe(0:nbf)
  89       integer taigrl(*)
  90 c
  91       character*8 nomgrl(*)
  92       character*8 nomgrf(*)
  93       character*8 nomfam(10,nbf)
  94 c
  95       integer ulsort, langue, codret
  96 c
  97 c 0.4. ==> variables locales
  98 c
  99       integer iaux, jaux, nufro, fam
 100       integer nbgr, gr
 101       integer lgngro, lgngrm
 102 c
 103       character*64 saux64
 104       character*80 nomgro, groupm
 105 c
 106       integer nbmess
 107       parameter ( nbmess = 11 )
 108       character*80 texte(nblang,nbmess)
 109 c
 110 c 0.5. ==> initialisations
 111 c ______________________________________________________________________
 112 c
 113 c====
 114 c 1. messages
 115 c====
 116 c
 117 #include "impr01.h"
 118 c
 119 #ifdef _DEBUG_HOMARD_
 120       write (ulsort,texte(langue,1)) 'Entree', nompro
 121       call dmflsh (iaux)
 122 #endif
 123 c
 124       texte(1,4) = '(/,''Frontiere numero '',i5,/,16(''=''))'
 125       texte(1,5) = '(''. Elle est definie sur le groupe : '',a)'
 126       texte(1,6) = '(7x,''. Comparaison avec le groupe : '',a)'
 127       texte(1,7) =
 128      > '(''.'',i5,''-eme famille, de numero MED '',i5,'', de nom '',a)'
 129       texte(1,8) =
 130      > '(''Cette famille est deja liee a la frontiere '',i5)'
 131       texte(1,9) = '(''On veut ajouter le groupe : '',a)'
 132       texte(1,10) =
 133      > '(i5,'' probleme(s) dans la definition des frontieres.'')'
 134       texte(1,11) = '(7x,''. Cette famille correspond'')'
 135 c
 136       texte(2,4) = '(/,''Boundary #'',i5,/,12(''=''))'
 137       texte(2,5) = '(''. It is defined on group: '',a)'
 138       texte(2,6) = '(7x,''. Comparizon with group: '',a)'
 139       texte(2,7) = '(''.'',i5,''-th family, MED # '',i5,'', name '',a)'
 140       texte(2,8) =
 141      > '(''This family is already connected to boundary'',i5)'
 142       texte(2,9) = '(''Group : '',a,'' is to be added.'')'
 143       texte(2,10) = '(i5,'' problem(s) in boundary definition'')'
 144       texte(2,11) = '(7x,''. This family matches.'')'
 145 c
 146 #include "impr03.h"
 147 c
 148       codret = 0
 149 c
 150 c====
 151 c 2. a priori, aucune famille n'est liee a une frontiere
 152 c====
 153 c
 154       do 21 , iaux = 1, nbf
 155         frofam(iaux) = 0
 156    21 continue
 157 c
 158 c On parcourt tous les liens frontiere/groupe
 159 c          Remarque : le decodage est analogue a celui de vcfia2
 160 c
 161       do 10 , nufro = 1, nbfron
 162 c
 163 #ifdef _DEBUG_HOMARD_
 164         if ( codret.eq.0 ) then
 165         write (ulsort,texte(langue,4)) nufro
 166         endif
 167 #endif
 168 c
 169 c====
 170 c 3. Nom du groupe associe a ce lien
 171 c====
 172 c
 173         if ( codret.eq.0 ) then
 174 c
 175 c       adresse du debut du groupe associe a la frontiere nufro
 176         iaux = pointl(nufro-1) + 1
 177 c
 178 c       longueur utile du nom du groupe
 179         lgngro = 0
 180         do 31 , jaux = iaux , pointl(nufro)
 181           lgngro = lgngro + taigrl(jaux)
 182    31   continue
 183 c
 184         endif
 185 c
 186         if ( codret.eq.0 ) then
 187 c
 188 c       recuperation du nom du groupe associe a la frontiere nufro
 189         call uts8ch ( nomgrl(iaux), lgngro, nomgro,
 190      >                ulsort, langue, codret )
 191 c
 192         endif
 193 c
 194 #ifdef _DEBUG_HOMARD_
 195         write (ulsort,texte(langue,5)) nomgro(1:lgngro)
 196 #endif
 197 c
 198 c====
 199 c 4. On parcourt toutes les familles de mailles
 200 c====
 201 c
 202         if ( codret.eq.0 ) then
 203 c
 204         do 40 , fam = 1, nbf
 205 c
 206           if ( numfam(fam).lt.0 ) then
 207 c
 208 #ifdef _DEBUG_HOMARD_
 209           saux64( 1: 8) = nomfam(1,fam)
 210           saux64( 9:16) = nomfam(2,fam)
 211           saux64(17:24) = nomfam(3,fam)
 212           saux64(25:32) = nomfam(4,fam)
 213           saux64(33:40) = nomfam(5,fam)
 214           saux64(41:48) = nomfam(6,fam)
 215           saux64(49:56) = nomfam(7,fam)
 216           saux64(57:64) = nomfam(8,fam)
 217           call utlgut ( jaux, saux64, ulsort, langue, codret )
 218           write (ulsort,texte(langue,7))
 219      >          fam, numfam(fam), saux64(1:jaux)
 220 #endif
 221 c
 222           nbgr = (pointe(fam)-pointe(fam-1))/10
 223 c
 224 c 4.1. ==> on parcourt tous les groupes entrant dans la
 225 c              definition de la famille
 226 c
 227           do 41 , gr = 1, nbgr
 228 c
 229 c 4.1.1. ==> nom du groupe
 230 c
 231             if ( codret.eq.0 ) then
 232 c
 233 c           adresse du debut du groupe numero gr de la famille fam
 234             iaux = pointe(fam-1)+1+10*(gr-1)
 235 c
 236 c           recuperation du nom du groupe numero gr dans la famille
 237 c           numero fam
 238             call uts8ch ( nomgrf(iaux), 80, groupm,
 239      >                    ulsort, langue, codret )
 240 c
 241             endif
 242 c
 243             if ( codret.eq.0 ) then
 244 c
 245 c           longueur utile du nom du groupe
 246             call utlgut ( lgngrm, groupm, ulsort, langue, codret )
 247 c
 248 #ifdef _DEBUG_HOMARD_
 249             write (ulsort,texte(langue,6)) groupm(1:lgngrm)
 250 #endif
 251 c
 252             endif
 253 c
 254 c 4.1.2. ==> si le groupe de la frontiere et le groupe courant
 255 c            coincident, on declare que la famille est concernee par
 256 c            cette frontiere
 257 c            attention, on n'autorise qu'une seule frontiere par famille
 258 c
 259             if ( codret.eq.0 ) then
 260 c
 261             if ( lgngro.eq.lgngrm ) then
 262 c
 263               if ( nomgro(1:lgngro).eq.groupm(1:lgngrm) ) then
 264 c
 265                 if ( frofam(fam).eq.0 ) then
 266 c
 267                   frofam(fam) = nufro + decala
 268 #ifdef _DEBUG_HOMARD_
 269                   write (ulsort,texte(langue,11))
 270 #endif
 271                 else
 272                   saux64( 1: 8) = nomfam(1,fam)
 273                   saux64( 9:16) = nomfam(2,fam)
 274                   saux64(17:24) = nomfam(3,fam)
 275                   saux64(25:32) = nomfam(4,fam)
 276                   saux64(33:40) = nomfam(5,fam)
 277                   saux64(41:48) = nomfam(6,fam)
 278                   saux64(49:56) = nomfam(7,fam)
 279                   saux64(57:64) = nomfam(8,fam)
 280                   call utlgut ( jaux, saux64, ulsort, langue, codret )
 281                   write (ulsort,texte(langue,7))
 282      >                   fam, numfam(fam), saux64(1:jaux)
 283                   write (ulsort,texte(langue,8)) frofam(fam)
 284                   write (ulsort,texte(langue,9)) groupm(1:lgngrm)
 285                   codret = codret + 1
 286                 endif
 287 c
 288               endif
 289 c
 290             endif
 291 c
 292             endif
 293 c
 294    41     continue
 295 c
 296           endif
 297 c
 298    40   continue
 299 c
 300         endif
 301 c
 302    10 continue
 303 c
 304 #ifdef _DEBUG_HOMARD_
 305       write (ulsort,*) ' '
 306       do 3000 , iaux = 1, nbf
 307        write (ulsort,90112) 'frofam', iaux, frofam(iaux)
 308  3000 continue
 309       write (ulsort,*) ' '
 310 #endif
 311 c
 312 c====
 313 c 5. la fin
 314 c====
 315 c
 316       if ( codret.ne.0 ) then
 317 c
 318 #include "envex2.h"
 319 c
 320       write (ulsort,texte(langue,1)) 'Sortie', nompro
 321       write (ulsort,texte(langue,2)) codret
 322       write (ulsort,texte(langue,10)) codret
 323 c
 324       endif
 325 c
 326 #ifdef _DEBUG_HOMARD_
 327       write (ulsort,texte(langue,1)) 'Sortie', nompro
 328       call dmflsh (iaux)
 329 #endif
 330 c
 331       end