src/tool/Suivi_Frontiere/sfnofl.F

   1       subroutine sfnofl ( ntrav1, ntrav2, ntrav3,
   2      >                    adnuno, adlino, adacno,
   3      >                    unst2x, epsid2,
   4      >                    coonoe,
   5      >                    somare, hetare, filare, np2are,
   6      >                    cfaare, famare,
   7      >                    geocoo, abscur,
   8      >                    somseg, seglig,
   9      >                    lgetco, taetco,
  10      >                    ulsort, langue, codret)
  11 c ______________________________________________________________________
  12 c
  13 c                             H O M A R D
  14 c
  15 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  16 c
  17 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  18 c aupres des huissiers de justice Simart et Lavoir a Clamart
  19 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  20 c aupres des huissiers de justice
  21 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  22 c
  23 c    HOMARD est une marque deposee d'Electricite de France
  24 c
  25 c Copyright EDF 1996
  26 c Copyright EDF 1998
  27 c Copyright EDF 2002
  28 c Copyright EDF 2020
  29 c ______________________________________________________________________
  30 c
  31 c   Suivi de Frontiere - NOeuds du maillage de calcul
  32 c   -        -           --
  33 c                        sur la Frontiere - Lignes
  34 c                               -           -
  35 c ______________________________________________________________________
  36 c .        .     .        .                                            .
  37 c .  nom   . e/s . taille .           description                      .
  38 c .____________________________________________________________________.
  39 c . ntrav1 .  s  .   1    . tableau de numnoe = imem(adnuno)           .
  40 c . ntra2v .  s  .   1    . tableau de lignoe = imem(adlino)           .
  41 c . ntrav3 .  s  .   1    . tableau de abscno = rmem(adacno)           .
  42 c . adnuno .  s  .   1    . liste des noeuds de calcul sur le bord     .
  43 c . adlino .  s  .   1    . liste lignes pour ces noeuds               .
  44 c . adacno .  s  .   1    . abscisse curviligne de ces noeuds          .
  45 c . unst2x . e   .   1    . inverse de la taille maximale au carre     .
  46 c . epsid2 . e   .   1    . precision relative pour carre de distance  .
  47 c . coonoe . es  . nbnoto . coordonnees des noeuds                     .
  48 c .        .     . *sdim  .                                            .
  49 c . somare . e   .2*nbarto. numeros des extremites d'arete             .
  50 c . hetare . e   . nbarto . historique de l'etat des aretes            .
  51 c . filare . e   . nbarto . premiere fille des aretes                  .
  52 c . np2are . e   . nbarto . noeud milieux des aretes                   .
  53 c . cfaare . e   . nctfar*. codes des familles des aretes              .
  54 c .        .     . nbfare .   1 : famille MED                          .
  55 c .        .     .        .   2 : type de segment                      .
  56 c .        .     .        .   3 : orientation                          .
  57 c .        .     .        .   4 : famille d'orientation inverse        .
  58 c .        .     .        .   5 : numero de ligne de frontiere         .
  59 c .        .     .        .  > 0 si concernee par le suivi de frontiere.
  60 c .        .     .        . <= 0 si non concernee                      .
  61 c .        .     .        .   6 : famille frontiere active/inactive    .
  62 c .        .     .        .   7 : numero de surface de frontiere       .
  63 c .        .     .        . + l : appartenance a l'equivalence l       .
  64 c . famare . e   . nbarto . famille des aretes                         .
  65 c . geocoo . e   .sfnbso**. coordonnees des sommets de la frontiere    .
  66 c . abscur . e   . sfnbse . abscisse curviligne des somm des segments  .
  67 c . somseg . e   . sfnbse . liste des sommets des lignes separees par  .
  68 c                           des 0                                      .
  69 c . seglig . e   .0:sfnbli. pointeur dans le tableau somseg : les      .
  70 c .        .     .        . segments de la ligne i sont aux places de  .
  71 c .        .     .        . seglig(i-1)+1 a seglig(i)-1 inclus         .
  72 c . lgetco . e   .   1    . longueur du tableau de l'etat courant      .
  73 c . taetco . e   . lgetco . tableau de l'etat courant                  .
  74 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  75 c . langue . e   .    1   . langue des messages                        .
  76 c .        .     .        . 1 : francais, 2 : anglais                  .
  77 c . codret . es  .    1   . code de retour des modules                 .
  78 c .        .     .        . 0 : pas de probleme                        .
  79 c .        .     .        . x : probleme                               .
  80 c ______________________________________________________________________
  81 c
  82 c====
  83 c 0. declarations et dimensionnement
  84 c====
  85 c
  86 c 0.1. ==> generalites
  87 c
  88       implicit none
  89       save
  90 c
  91       character*6 nompro
  92       parameter ( nompro = 'SFNOFL' )
  93 c
  94 #include "nblang.h"
  95 c
  96 c 0.2. ==> communs
  97 c
  98 #include "envex1.h"
  99 c
 100 #include "gmenti.h"
 101 #include "gmreel.h"
 102 c
 103 #include "envca1.h"
 104 #include "front1.h"
 105 #include "front2.h"
 106 #include "dicfen.h"
 107 #include "nbfami.h"
 108 #include "nombno.h"
 109 #include "nombar.h"
 110 #include "impr02.h"
 111 c
 112 c 0.3. ==> arguments
 113 c
 114       double precision unst2x, epsid2
 115       double precision coonoe(nbnoto,sdim), geocoo(sfnbso,sdim)
 116       double precision abscur(sfnbse)
 117 c
 118       integer adnuno, adlino, adacno
 119       integer seglig(0:sfnbli), somseg(sfnbse)
 120       integer famare(nbarto), cfaare(nctfar,nbfare)
 121       integer somare(2,nbarto), hetare(nbarto), filare(nbarto)
 122       integer np2are(nbarto)
 123 c
 124       character*8 ntrav1, ntrav2, ntrav3
 125 c
 126       integer lgetco
 127       integer taetco(lgetco)
 128 c
 129       integer ulsort, langue, codret
 130 c
 131 c 0.4. ==> variables locales
 132 c
 133       integer nretap, nrsset
 134       integer iaux
 135 c
 136       integer adsegn
 137       integer codre0
 138       integer codre1, codre2, codre3, codre4
 139 c
 140       character*6 saux
 141       character*8 ntrava
 142 c
 143       integer nbmess
 144       parameter ( nbmess = 10 )
 145       character*80 texte(nblang,nbmess)
 146 c
 147 c 0.5. ==> initialisations
 148 c ______________________________________________________________________
 149 c
 150 c====
 151 c 1. messages
 152 c====
 153 c
 154 c 1.3. ==> les messages
 155 c
 156 #include "impr01.h"
 157 c
 158 #ifdef _DEBUG_HOMARD_
 159       write (ulsort,texte(langue,1)) 'Entree', nompro
 160       call dmflsh (iaux)
 161 #endif
 162 c
 163       texte(1,4) = '(/,a6,'' NOEUDS INITIAUX SUR LA FRONTIERE'')'
 164       texte(1,5) = '(39(''=''),/)'
 165       texte(1,6) = '(''. Nombre de '',a,''   :'',i10)'
 166       texte(1,7) = '(''. Inverse du carre de la taille :'',g15.7)'
 167       texte(1,8) = '(''. Precision relative            :'',g15.7)'
 168 c
 169       texte(2,4) = '(/,a6,'' INITIAL NODES AND BOUNDARY'')'
 170       texte(2,5) = '(33(''=''),/)'
 171       texte(2,6) = '(''. Number of '',a,''    :'',i10)'
 172       texte(2,7) = '(''. 1./max distance ** 2            :'',g15.7)'
 173       texte(2,8) = '(''. Relative precision for equality :'',g15.7)'
 174 c
 175 c 1.4. ==> le numero de sous-etape
 176 c
 177       nretap = taetco(1)
 178       nrsset = taetco(2) + 1
 179       taetco(2) = nrsset
 180 c
 181       call utcvne ( nretap, nrsset, saux, iaux, codret )
 182 c
 183 c 1.5. ==> le titre
 184 c
 185       write (ulsort,texte(langue,4)) saux
 186       write (ulsort,texte(langue,5))
 187 c
 188 #ifdef _DEBUG_HOMARD_
 189       write (ulsort,texte(langue,6)) mess14(langue,3,-1), nbnoto
 190       write (ulsort,texte(langue,6)) mess14(langue,3,1), nbarto
 191       write (ulsort,texte(langue,7)) unst2x
 192       write (ulsort,texte(langue,8)) epsid2
 193 #endif
 194 c
 195 c====
 196 c 2. Estimation du nombre de noeuds du maillage de calcul qui sont
 197 c    sur une ligne de frontiere
 198 c====
 199 #ifdef _DEBUG_HOMARD_
 200         write (ulsort,*) '2. Estimation ; codret = ', codret
 201 #endif
 202 c
 203       if ( codret.eq.0 ) then
 204 c
 205 #ifdef _DEBUG_HOMARD_
 206       write (ulsort,texte(langue,3)) 'SFNNFL', nompro
 207 #endif
 208       call sfnnfl ( hetare,
 209      >              cfaare, famare,
 210      >              ulsort, langue, codret)
 211 c
 212       endif
 213 c
 214 c====
 215 c 3. Allocations
 216 c====
 217 #ifdef _DEBUG_HOMARD_
 218         write (ulsort,*) '3. Allocations ; codret = ', codret
 219 #endif
 220 c
 221       if ( codret.eq.0 ) then
 222 c
 223       call gmalot ( ntrav1, 'entier  ', mcnxnf, adnuno, codre1 )
 224       call gmalot ( ntrav2, 'entier  ', mcnxnf, adlino, codre2 )
 225       call gmalot ( ntrav3, 'reel    ', mcnxnf, adacno, codre3 )
 226       call gmalot ( ntrava, 'entier  ', nbnoto, adsegn, codre4 )
 227 c
 228       codre0 = min ( codre1, codre2, codre3, codre4 )
 229       codret = max ( abs(codre0), codret,
 230      >               codre1, codre2, codre3, codre4 )
 231 c
 232       endif
 233 c
 234 c====
 235 c 4. Etablissement du lien des sommets
 236 c====
 237 c
 238 #ifdef _DEBUG_HOMARD_
 239         write (ulsort,*) '4. Liens sommets/lignes ; codret = ', codret
 240 #endif
 241 cgn 1001 format(a,' :',i10,', ',3g13.5)
 242 cgn      do 41 ,codre0=1,nbnoto
 243 cgn      write (ulsort,1001) 'n', codre0,
 244 cgn     >(coonoe(codre0,iaux),iaux = 1 , sdim)
 245 cgn   41 continue
 246 c
 247       if ( codret.eq.0 ) then
 248 c
 249 cgn 1001 format('Noeud ',i8,' :',3g16.9)
 250 cgn      codre1=115
 251 cgn      write (ulsort,1001)
 252 cgn     >    codre1,(coonoe(codre1,iaux),iaux=1,sdim)
 253 #ifdef _DEBUG_HOMARD_
 254       write (ulsort,texte(langue,3)) 'SFLISO', nompro
 255 #endif
 256       call sfliso ( imem(adnuno), imem(adlino), rmem(adacno),
 257      >              unst2x, epsid2,
 258      >              coonoe,
 259      >              somare, hetare, filare, np2are,
 260      >              cfaare, famare,
 261      >              geocoo, abscur,
 262      >              somseg, seglig, imem(adsegn),
 263      >              ulsort, langue, codret )
 264 c
 265       endif
 266 cgn      codre1=115
 267 cgn      write (ulsort,1001)
 268 cgn     >    codre1,(coonoe(codre1,iaux),iaux=1,sdim)
 269 cgn      do 42 ,codre0=1,nbnoto
 270 cgn      write (ulsort,1001) 'n', codre0,
 271 cgn     >(coonoe(codre0,iaux),iaux = 1 , sdim)
 272 cgn   42 continue
 273 c
 274 cgn      call gmprot ( nompro//' apres SFLISO', ntrav1, 1, mcnvnf )
 275 cgn      call gmprot ( nompro//' apres SFLISO', ntrav2, 1, mcnvnf )
 276 cgn      call gmprot ( nompro//' apres SFLISO', ntrav3, 1, mcnvnf )
 277 c
 278 c====
 279 c 5. Menage
 280 c====
 281 #ifdef _DEBUG_HOMARD_
 282         write (ulsort,*) '5. Menage ; codret = ', codret
 283 #endif
 284 c
 285       if ( codret.eq.0 ) then
 286 c
 287       call gmlboj ( ntrava, codret )
 288 c
 289       endif
 290 c
 291 c====
 292 c 6. la fin
 293 c====
 294 c
 295       if ( codret.ne.0 ) then
 296 c
 297 #include "envex2.h"
 298 c
 299       write (ulsort,texte(langue,1)) 'Sortie', nompro
 300       write (ulsort,texte(langue,2)) codret
 301 c
 302       endif
 303 c
 304 #ifdef _DEBUG_HOMARD_
 305       write (ulsort,texte(langue,1)) 'Sortie', nompro
 306       call dmflsh (iaux)
 307 #endif
 308 c
 309       end
 310
 311