src/tool/Suivi_Frontiere/sffaff.F

   1       subroutine sffaff ( suifro,
   2      >                    ncafdg, ncafan, ncfgnf, ncfgng, ncafar,
   3      >                    nhsupe, nhsups,
   4      >                    ulsort, langue, codret )
   5 c ______________________________________________________________________
   6 c
   7 c                             H O M A R D
   8 c
   9 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  10 c
  11 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  12 c aupres des huissiers de justice Simart et Lavoir a Clamart
  13 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  14 c aupres des huissiers de justice
  15 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  16 c
  17 c    HOMARD est une marque deposee d'Electricite de France
  18 c
  19 c Copyright EDF 1996
  20 c Copyright EDF 1998
  21 c Copyright EDF 2002
  22 c Copyright EDF 2020
  23 c ______________________________________________________________________
  24 c
  25 c   Suivi de Frontiere - Frontieres AFFichage
  26 c   -        -           -          ---
  27 c ______________________________________________________________________
  28 c .        .     .        .                                            .
  29 c .  nom   . e/s . taille .           description                      .
  30 c .____________________________________________________________________.
  31 c . suifro . e   .   1    . 1 : pas de suivi de frontiere              .
  32 c .        .     .        . 2x : frontiere discrete                    .
  33 c .        .     .        . 3x : frontiere analytique                  .
  34 c .        .     .        . 5x : frontiere cao                         .
  35 c . ncafdg . e   . char*8 . nom de l'objet des frontieres discretes/CAO.
  36 c .        .     .        . nom des groupes                            .
  37 c . ncafan . e   . char*8 . nom de l'objet des frontieres analytiques :.
  38 c .        .     .        . nom des groupes                            .
  39 c . ncfgnf . es  . char*8 . lien frontiere/groupe : nom des frontieres .
  40 c . ncfgng . e   . char*8 . lien frontiere/groupe : nom des groupes    .
  41 c . ncafar . e   . char*8 . nom de l'objet des frontieres analytiques :.
  42 c .        .     .        . valeurs reelles                            .
  43 c . nhsupe . e   . char*8 . informations supplementaires maillage      .
  44 c . nhsups . e   . char*8 . informations supplementaires maillage      .
  45 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  46 c . langue . e   .    1   . langue des messages                        .
  47 c .        .     .        . 1 : francais, 2 : anglais                  .
  48 c . codret . es  .    1   . code de retour des modules                 .
  49 c .        .     .        . en entree = celui du module d'avant        .
  50 c .        .     .        . en sortie = celui du module en cours       .
  51 c .        .     .        . 0 : pas de probleme                        .
  52 c .        .     .        . 1 : manque de temps cpu                    .
  53 c .        .     .        . 2x : probleme dans les memoires            .
  54 c .        .     .        . 2x : probleme dans les fichiers            .
  55 c .        .     .        . 5 : mauvaises options                      .
  56 c .        .     .        . 6 : problemes dans les noms d'objet        .
  57 c ______________________________________________________________________
  58 c
  59 c====
  60 c 0. declarations et dimensionnement
  61 c====
  62 c
  63 c 0.1. ==> generalites
  64 c
  65       implicit none
  66       save
  67 c
  68       character*6 nompro
  69       parameter ( nompro = 'SFFAFF' )
  70 c
  71 #include "nblang.h"
  72 c
  73 c 0.2. ==> communs
  74 c
  75 #include "envex1.h"
  76 #include "envada.h"
  77 c
  78 #include "gmenti.h"
  79 #include "gmreel.h"
  80 #include "gmstri.h"
  81 c
  82 c 0.3. ==> arguments
  83 c
  84       integer suifro
  85 c
  86       character*8 ncafdg, ncafan, ncfgnf, ncfgng, ncafar
  87       character*8 nhsupe, nhsups
  88 c
  89       integer ulsort, langue, codret
  90 c
  91 c 0.4. ==> variables locales
  92 c
  93       integer iaux, jaux, kaux
  94 c
  95       integer adcafr, adfrgr, adnogr
  96       integer pttgrd, ptngrd, pointd
  97       integer adcpoi, adctai, adctab
  98       integer adfpoi, adftai, adftab
  99       integer adgpoi, adgtai, adgtab
 100       integer nbfrdc, nbfrgr, nbfran
 101 c
 102       integer codre0
 103       integer codre1, codre2, codre3
 104 c
 105       integer nbmess
 106       parameter ( nbmess = 10 )
 107       character*80 texte(nblang,nbmess)
 108 c
 109 c 0.5. ==> initialisations
 110 c ______________________________________________________________________
 111 c
 112 c====
 113 c 1. messages
 114 c====
 115 c
 116 #include "impr01.h"
 117 c
 118 #ifdef _DEBUG_HOMARD_
 119       write (ulsort,texte(langue,1)) 'Entree', nompro
 120       call dmflsh (iaux)
 121 #endif
 122 c
 123       texte(1,6) = '(''Nombre de frontieres discretes   :'',i8)'
 124       texte(1,7) = '(''Nombre de liens frontiere/groupe :'',i8)'
 125       texte(1,8) = '(''Nombre de frontieres analytiques :'',i8)'
 126 c
 127       texte(2,6) = '(''Number of discrete boundaries  :'',i8)'
 128       texte(2,7) = '(''Number of links boundary/group :'',i8)'
 129       texte(2,8) = '(''Number of analytical boundaries:'',i8)'
 130 c
 131 #include "impr03.h"
 132 c
 133 #ifdef _DEBUG_HOMARD_
 134       write (ulsort,90002) 'suifro', suifro
 135 #endif
 136 c
 137 c====
 138 c 2. Les frontieres discretes
 139 c====
 140 #ifdef _DEBUG_HOMARD_
 141       write (ulsort,90002) '2. Fr. discretes ; codret', codret
 142 #endif
 143 c
 144       if ( ( mod(suifro,2).eq.0 )  .and.
 145      >     ( nbiter.eq.0 ) ) then
 146 c
 147 c 2.1. ==> Combien de frontieres discretes
 148 c
 149 #ifdef _DEBUG_HOMARD_
 150         call gmprsx (nompro, ncafdg )
 151 #endif
 152 c
 153         if ( codret.eq.0 ) then
 154 c
 155         call gmliat ( ncafdg, 1, nbfrdc, codret )
 156 c
 157         endif
 158 c
 159 #ifdef _DEBUG_HOMARD_
 160         write (ulsort,texte(langue,6)) nbfrdc
 161 #endif
 162 c
 163 c 2.2. ==> Affichage des frontieres discretes
 164 c
 165         if ( nbfrdc.gt.0 ) then
 166 c
 167           if ( codret.eq.0 ) then
 168 c
 169 #ifdef _DEBUG_HOMARD_
 170           call gmprsx(nompro,ncafdg//'.Pointeur')
 171           call gmprsx(nompro,ncafdg//'.Taille')
 172           call gmprsx(nompro,ncafdg//'.Table')
 173 #endif
 174           iaux = 3
 175 #ifdef _DEBUG_HOMARD_
 176       write (ulsort,texte(langue,3)) 'UTADPT', nompro
 177 #endif
 178           call utadpt ( ncafdg, iaux,
 179      >                    jaux,   jaux,
 180      >                  pointd, pttgrd, ptngrd,
 181      >                  ulsort, langue, codret )
 182 c
 183           endif
 184 c
 185           if ( codret.eq.0 ) then
 186 #ifdef _DEBUG_HOMARD_
 187       write (ulsort,texte(langue,3)) 'SFFAF1', nompro
 188 #endif
 189           call sffaf1 ( nbfrdc,
 190      >                  imem(pointd), imem(pttgrd), smem(ptngrd),
 191      >                  ulsort, langue, codret )
 192 c
 193           endif
 194 c
 195         endif
 196 c
 197       endif
 198 c
 199 c====
 200 c 3. Les frontieres analytiques
 201 c====
 202 #ifdef _DEBUG_HOMARD_
 203       write (ulsort,90002) '3. Fr. analytiques; codret', codret
 204 #endif
 205 c
 206       if ( ( mod(suifro,3).eq.0 )  .and.
 207      >     ( nbiter.eq.0 ) ) then
 208 c
 209 c 3.1. ==> Combien de liens frontiere/groupe ?
 210 c
 211 cgn        call gmprsx (nompro,ncfgng )
 212 c
 213         if ( codret.eq.0 ) then
 214 c
 215         call gmliat ( ncfgnf, 1, nbfrgr, codret )
 216 c
 217         endif
 218 c
 219 #ifdef _DEBUG_HOMARD_
 220       write (ulsort,texte(langue,7)) nbfrgr
 221 #endif
 222 c
 223         if ( nbfrgr.gt.0 ) then
 224 c
 225 c 3.2. ==> Description des noms des frontieres dans les liens
 226 c
 227           if ( codret.eq.0 ) then
 228 c
 229 cgn        call gmprsx (nompro,ncfgnf//'.Pointeur' )
 230 cgn        call gmprsx (nompro,ncfgnf//'.Table' )
 231 cgn        call gmprsx (nompro,ncfgnf//'.Taille' )
 232           iaux = 3
 233 #ifdef _DEBUG_HOMARD_
 234         write (ulsort,texte(langue,3)) 'UTADPT', nompro
 235 #endif
 236           call utadpt ( ncfgnf, iaux,
 237      >                  jaux, kaux,
 238      >                  adfpoi, adftai, adftab,
 239      >                  ulsort, langue, codret )
 240 c
 241           endif
 242 c
 243 c 3.3. ==> Description des noms des groupes dans les liens
 244 c
 245           if ( codret.eq.0 ) then
 246 cgn        call gmprsx (nompro,ncfgng//'.Pointeur' )
 247 cgn        call gmprsx (nompro,ncfgng//'.Table' )
 248 cgn        call gmprsx (nompro,ncfgng//'.Taille' )
 249           iaux = 3
 250 #ifdef _DEBUG_HOMARD_
 251         write (ulsort,texte(langue,3)) 'UTADPT', nompro
 252 #endif
 253           call utadpt ( ncfgng, iaux,
 254      >                  jaux, kaux,
 255      >                  adgpoi, adgtai, adgtab,
 256      >                  ulsort, langue, codret )
 257 c
 258           endif
 259 c
 260 c 3.4. ==> Description des frontieres
 261 c
 262 #ifdef _DEBUG_HOMARD_
 263         call gmprsx (nompro, ncafar )
 264 #endif
 265 c
 266           if ( codret.eq.0 ) then
 267 c
 268           call gmadoj ( ncafar, adcafr, iaux, codret )
 269 c
 270           endif
 271 c
 272           if ( codret.eq.0 ) then
 273 #ifdef _DEBUG_HOMARD_
 274           call gmprsx(nompro,ncafan//'.Pointeur')
 275           call gmprsx(nompro,ncafan//'.Taille')
 276           call gmprsx(nompro,ncafan//'.Table')
 277 #endif
 278 c
 279             iaux = 6
 280 #ifdef _DEBUG_HOMARD_
 281         write (ulsort,texte(langue,3)) 'UTADPT', nompro
 282 #endif
 283             call utadpt ( ncafan, iaux,
 284      >                    nbfran, kaux,
 285      >                    adcpoi, adctai, adctab,
 286      >                    ulsort, langue, codret )
 287 #ifdef _DEBUG_HOMARD_
 288       write (ulsort,texte(langue,8)) nbfran
 289 #endif
 290 c
 291             endif
 292 c
 293 c 3.5. ==> Affichage des frontieres analytiques
 294 c
 295           if ( codret.eq.0 ) then
 296 c
 297 #ifdef _DEBUG_HOMARD_
 298       write (ulsort,texte(langue,3)) 'SFFAF2', nompro
 299 #endif
 300           call sffaf2 ( nbfrgr, nbfran,
 301      >                  rmem(adcafr),
 302      >                  imem(adcpoi), imem(adctai), smem(adctab),
 303      >                  imem(adfpoi), imem(adftai), smem(adftab),
 304      >                  imem(adgpoi), imem(adgtai), smem(adgtab),
 305      >                  ulsort, langue, codret )
 306 c
 307           endif
 308 c
 309         endif
 310 c
 311       endif
 312 c
 313 c====
 314 c 4. Les frontieres CAO
 315 c====
 316 #ifdef _DEBUG_HOMARD_
 317       write (ulsort,90002) '4. frontieres  CAO ; codret', codret
 318 #endif
 319 c
 320       if ( ( mod(suifro,5).eq.0 ) .or.
 321      >     ( nbiter.ge.1 ) ) then
 322 c
 323 c 4.1. ==> Combien de frontieres ?
 324 c
 325 #ifdef _DEBUG_HOMARD_
 326         call gmprsx (nompro, nhsupe//'.Tab10' )
 327         call gmprsx (nompro, nhsups//'.Tab10' )
 328 #endif
 329 c
 330         if ( codret.eq.0 ) then
 331 c
 332         call gmadoj ( nhsupe//'.Tab10', adfrgr, iaux, codre1 )
 333         call gmadoj ( nhsups//'.Tab10', adnogr, iaux, codre2 )
 334         call gmliat ( nhsupe, 10, nbfrgr, codre3 )
 335 c
 336         codre0 = min ( codre1, codre2, codre3 )
 337         codret = max ( abs(codre0), codret,
 338      >                 codre1, codre2, codre3 )
 339 c
 340         endif
 341 c
 342 #ifdef _DEBUG_HOMARD_
 343         write (ulsort,texte(langue,7)) nbfrgr
 344 #endif
 345 c
 346 c 4.2. ==> Affichage des frontieres
 347 c
 348         if ( nbfrgr.gt.0 ) then
 349 c
 350           if ( codret.eq.0 ) then
 351 #ifdef _DEBUG_HOMARD_
 352       write (ulsort,texte(langue,3)) 'SFFAF3', nompro
 353 #endif
 354           call sffaf3 ( nbfrgr, imem(adfrgr), smem(adnogr),
 355      >                  ulsort, langue, codret )
 356 c
 357           endif
 358 c
 359         endif
 360 c
 361       endif
 362 c
 363 c====
 364 c 5. la fin
 365 c====
 366 c
 367       if ( codret.ne.0 ) then
 368 c
 369 #include "envex2.h"
 370 c
 371       write (ulsort,texte(langue,1)) 'Sortie', nompro
 372       write (ulsort,texte(langue,2)) codret
 373 c
 374       endif
 375 c
 376 #ifdef _DEBUG_HOMARD_
 377       write (ulsort,texte(langue,1)) 'Sortie', nompro
 378       call dmflsh (iaux)
 379 #endif
 380 c
 381       end