src/tool/Suivi_Frontiere/sffaf2.F

   1       subroutine sffaf2 ( nbfrgr, nbfran,
   2      >                    casfre,
   3      >                    cacfpo, cacfta, cacfnm,
   4      >                    calfpo, calfta, calfnm,
   5      >                    calgpo, calgta, calgnm,
   6      >                    ulsort, langue, codret)
   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   Suivi de Frontiere - Frontieres AFfichage - 2
  27 c   -        -           -          --          -
  28 c remarque : sffaf1, sffaf2 et sffaf3 sont des clones
  29 c ______________________________________________________________________
  30 c .        .     .        .                                            .
  31 c .  nom   . e/s . taille .           description                      .
  32 c .____________________________________________________________________.
  33 c . nbfrgr . e   .   1    . nombre de liens frontiere/groupe           .
  34 c . nbfran . e   .   1    . nombre de frontieres analytiques           .
  35 c . casfre . e   .13nbfran. caracteristiques des frontieres analytiques.
  36 c .        .     .        . 1 : 1., si cylindre                        .
  37 c .        .     .        .     2., si sphere                          .
  38 c .        .     .        .     3., si cone par  origine, axe et angle .
  39 c .        .     .        .     4., si cone par 2 centres et 2 rayons  .
  40 c .        .     .        .     5., si tore                            .
  41 c .        .     .        . de 2 a 13 :                                .
  42 c .        .     .        . . cylindre : 2,3,4 : xcentr, ycentr, zcentr.
  43 c .        .     .        .              5,6,7 : xaxe, yaxe, zaxe      .
  44 c .        .     .        .              8 :     rayon                 .
  45 c .        .     .        . . sphere   : 2,3,4 : xcentr, ycentr, zcentr.
  46 c .        .     .        .              8 :     rayon                 .
  47 c .        .     .        . . cone     : 2,3,4 : xcentr, ycentr, zcentr.
  48 c .        .     .        .              5,6,7 : xaxe, yaxe, zaxe      .
  49 c .        .     .        .              13 :    angle en degre        .
  50 c .        .     .        . . cone 2   : 2,3,4 : xcentr, ycentr, zcentr.
  51 c .        .     .        .              8 :     rayon                 .
  52 c .        .     .        .              9,10,11:xcent2, ycent2, zcent2.
  53 c .        .     .        .              12 :    rayon2                .
  54 c .        .     .        . . tore     : 2,3,4 : xcentr, ycentr, zcentr.
  55 c .        .     .        .              5,6,7 : xaxe, yaxe, zaxe      .
  56 c .        .     .        .              8 :     rayon de revolution   .
  57 c .        .     .        .              12 :    rayon primaire        .
  58 c . cacfpo . e   .0:nbfran. pointeurs sur le tableau du nom frontieres .
  59 c . cacfta . e   .10nbfran. taille du nom des frontieres               .
  60 c . cacfnm . e   .10nbfran. nom des frontieres                         .
  61 c . calfpo . e   .0:nbfrgr. pointeurs sur le tableau du nom frontieres .
  62 c . calfta . e   .10nbfrgr. taille du nom des frontieres               .
  63 c . calfnm . e   .10nbfrgr. nom des frontieres                         .
  64 c . calgpo . e   .0:nbfrgr. pointeurs sur le tableau du nom groupes    .
  65 c . calgta . e   .10nbfrgr. taille du nom des groupes                  .
  66 c . calgnm . e   .10nbfrgr. nom des groupes                            .
  67 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  68 c . langue . e   .    1   . langue des messages                        .
  69 c .        .     .        . 1 : francais, 2 : anglais                  .
  70 c . codret . es  .    1   . code de retour des modules                 .
  71 c .        .     .        . 0 : pas de probleme                        .
  72 c .        .     .        . x : probleme                               .
  73 c ______________________________________________________________________
  74 c
  75 c====
  76 c 0. declarations et dimensionnement
  77 c====
  78 c
  79 c 0.1. ==> generalites
  80 c
  81       implicit none
  82       save
  83 c
  84       character*6 nompro
  85       parameter ( nompro = 'SFFAF2' )
  86 c
  87 #include "nblang.h"
  88 c
  89 c 0.2. ==> communs
  90 c
  91 #include "envex1.h"
  92 c
  93 c 0.3. ==> arguments
  94 c
  95       integer nbfrgr, nbfran
  96       integer cacfpo(0:nbfran), cacfta(10*nbfran)
  97       integer calfpo(0:nbfrgr), calfta(10*nbfrgr)
  98       integer calgpo(0:nbfrgr), calgta(10*nbfrgr)
  99 c
 100       double precision casfre(13,nbfran)
 101 c
 102       character*8 cacfnm(10*nbfran)
 103       character*8 calfnm(10*nbfrgr)
 104       character*8 calgnm(10*nbfrgr)
 105 c
 106       integer ulsort, langue, codret
 107 c
 108 c 0.4. ==> variables locales
 109 c
 110       integer iaux, jaux
 111 c
 112       integer nufrgr, nufran, tyfran
 113       integer lgnom, lgnomf
 114 c
 115       character*8 nomsur(0:5)
 116       character*80 nom, nomf
 117 c
 118       integer nbmess
 119       parameter ( nbmess = 12 )
 120       character*80 texte(nblang,nbmess)
 121 c
 122 c 0.5. ==> initialisations
 123 c ______________________________________________________________________
 124 c
 125 c====
 126 c 1. messages
 127 c====
 128 c
 129       codret = 0
 130 c
 131 #include "impr01.h"
 132 c
 133 #ifdef _DEBUG_HOMARD_
 134       write (ulsort,texte(langue,1)) 'Entree', nompro
 135       call dmflsh (iaux)
 136 #endif
 137 c
 138       texte(1,4) =
 139      >'(''*'',30x,''Liens groupe/frontiere'',30x,''*'')'
 140       texte(1,5) =
 141      >'(''*'',30x,''Frontieres analytiques'',30x,''*'')'
 142       texte(1,6) = '(''* Rayon  : '',g14.7,58x,''*'')'
 143       texte(1,7) = '(''* Angle  : '',g14.7,58x,''*'')'
 144 c
 145       texte(2,4) =
 146      >'(''*'',31x,''Links boundary/group'',31x,''*'')'
 147       texte(2,5) =
 148      >'(''*'',31x,''Analytical boundaries'',30x,''*'')'
 149       texte(2,6) = '(''* Radius:  '',g14.7,58x,''*'')'
 150       texte(2,7) = '(''* Angle:  '',g14.7,58x,''*'')'
 151 c
 152 #include "impr03.h"
 153 c
 154  1000 format('* ',a80,' *')
 155  1100 format(84('*'))
 156  1101 format(//,84('*'))
 157  1201 format('* Type : ',a8,66x,'*')
 158  1202 format('* ',a6,' :  X =',g14.7,' Y =',g14.7,' Z =',g14.7,18x,'*')
 159 c
 160 c====
 161 c 2. Descriptions des frontieres
 162 c====
 163 c
 164 #ifdef _DEBUG_HOMARD_
 165       write (ulsort,90002) '2. Descriptions frontieres ; codret', codret
 166 #endif
 167 c
 168       if ( langue.eq.1 ) then
 169         nomsur(0) = 'Inconnu '
 170         nomsur(1) = 'Cylindre'
 171         nomsur(2) = 'Sphere  '
 172         nomsur(3) = 'Cone    '
 173         nomsur(4) = 'Cone    '
 174         nomsur(5) = 'Tore    '
 175       else
 176         nomsur(0) = 'Unknwown'
 177         nomsur(1) = 'Cylinder'
 178         nomsur(2) = 'Sphere  '
 179         nomsur(3) = 'Cone    '
 180         nomsur(4) = 'Cone    '
 181         nomsur(5) = 'Torus   '
 182       endif
 183 c
 184       write (ulsort,1101)
 185       write (ulsort,texte(langue,5))
 186       write (ulsort,1100)
 187 c
 188       do 21 , nufran = 1 , nbfran
 189 c
 190 c 2.1. ==> Nom de la frontiere
 191 c
 192         if ( codret.eq.0 ) then
 193 c
 194         jaux = cacfpo(nufran-1) + 1
 195 c
 196         lgnom = 0
 197         do 211 , iaux = jaux , cacfpo(nufran)
 198           lgnom = lgnom + cacfta(iaux)
 199   211   continue
 200 c
 201         endif
 202 c
 203         if ( codret.eq.0 ) then
 204 c
 205         call uts8ch ( cacfnm(jaux), lgnom, nom,
 206      >                ulsort, langue, codret )
 207 c
 208         endif
 209 c
 210         if ( codret.eq.0 ) then
 211           write (ulsort,1000) nom
 212         endif
 213 c
 214 c 2.2. ==> Type de la frontiere
 215 c
 216         tyfran = nint(casfre(1,nufran))
 217         if ( tyfran.le.-1 .or. tyfran.ge.6 ) then
 218           tyfran = 0
 219         endif
 220         write (ulsort,1201) nomsur(tyfran)
 221 c
 222         if ( tyfran.gt.0 ) then
 223           write (ulsort,1202) 'Centre',
 224      >                        (casfre(iaux,nufran), iaux = 2 , 4 )
 225           if ( tyfran.eq.1 .or. tyfran.eq.3 .or. tyfran.eq.5 ) then
 226             write (ulsort,1202) 'Axe   ',
 227      >                          (casfre(iaux,nufran), iaux = 5 , 7 )
 228           endif
 229           if ( tyfran.le.2 ) then
 230             write (ulsort,texte(langue,6)) casfre(8,nufran)
 231           elseif ( tyfran.eq.3 ) then
 232             write (ulsort,texte(langue,7)) casfre(13,nufran)
 233           elseif ( tyfran.eq.5 ) then
 234             write (ulsort,texte(langue,6)) casfre(8,nufran)
 235             write (ulsort,texte(langue,6)) casfre(12,nufran)
 236           else
 237             write (ulsort,texte(langue,6)) casfre(8,nufran)
 238             write (ulsort,1202) 'Centre',
 239      >                          (casfre(iaux,nufran), iaux = 9 , 11 )
 240             write (ulsort,texte(langue,6)) casfre(12,nufran)
 241           endif
 242         endif
 243 c
 244         write (ulsort,1100)
 245 c
 246    21 continue
 247 c
 248 c====
 249 c 3. affichage des liens frontieres/groupe
 250 c====
 251 c
 252 #ifdef _DEBUG_HOMARD_
 253       write (ulsort,90002) '3. affichage liens ; codret', codret
 254 #endif
 255 c
 256       write (ulsort,1100)
 257       write (ulsort,texte(langue,4))
 258       write (ulsort,1100)
 259 c
 260       do 31 , nufrgr = 1 , nbfrgr
 261 c
 262 c 3.1. ==> Nom du groupe
 263 c
 264         if ( codret.eq.0 ) then
 265 c
 266         jaux = calgpo(nufrgr-1) + 1
 267 c
 268         lgnom = 0
 269         do 311 , iaux = jaux , calgpo(nufrgr)
 270           lgnom = lgnom + calgta(iaux)
 271   311   continue
 272 c
 273         call uts8ch ( calgnm(jaux), lgnom, nom,
 274      >                ulsort, langue, codret )
 275 c
 276         endif
 277 c
 278         if ( codret.eq.0 ) then
 279           write (ulsort,1000) nom
 280         endif
 281 c
 282 c 3.2. ==> Nom de la frontiere
 283 c
 284         if ( codret.eq.0 ) then
 285 c
 286         jaux = calfpo(nufrgr-1) + 1
 287 c
 288         lgnomf = 0
 289         do 321 , iaux = jaux , calfpo(nufrgr)
 290           lgnomf = lgnomf + calfta(iaux)
 291   321   continue
 292 c
 293         call uts8ch ( calfnm(jaux), lgnomf, nomf,
 294      >                ulsort, langue, codret )
 295 c
 296         endif
 297 c
 298         if ( codret.eq.0 ) then
 299           write (ulsort,1000) nomf
 300         endif
 301 c
 302         write (ulsort,1100)
 303 c
 304    31 continue
 305 c
 306 c====
 307 c 4. La fin
 308 c====
 309 c
 310       if ( codret.ne.0 ) then
 311 c
 312 #include "envex2.h"
 313 c
 314       write (ulsort,texte(langue,1)) 'Sortie', nompro
 315       write (ulsort,texte(langue,2)) codret
 316 c
 317       endif
 318 c
 319 #ifdef _DEBUG_HOMARD_
 320       write (ulsort,texte(langue,1)) 'Sortie', nompro
 321       call dmflsh (iaux)
 322 #endif
 323 c
 324       end