src/tool/Suivi_Frontiere/sfdefg.F

   1       subroutine sfdefg ( suifro,
   2      >                    nocman, nocmaf, ncafdg,
   3      >                    ulsort, langue, codret)
   4 c ______________________________________________________________________
   5 c
   6 c                             H O M A R D
   7 c
   8 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   9 c
  10 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  11 c aupres des huissiers de justice Simart et Lavoir a Clamart
  12 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  13 c aupres des huissiers de justice
  14 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  15 c
  16 c    HOMARD est une marque deposee d'Electricite de France
  17 c
  18 c Copyright EDF 1996
  19 c Copyright EDF 1998
  20 c Copyright EDF 2002
  21 c Copyright EDF 2020
  22 c ______________________________________________________________________
  23 c
  24 c   Suivi de Frontiere - DEFinition des Groupes
  25 c   -        -           ---            -
  26 c ______________________________________________________________________
  27 c .  nom   . e/s . taille .           description                      .
  28 c .____________________________________________________________________.
  29 c . suifro . e   .   1    . 1 : pas de suivi de frontiere              .
  30 c .        .     .        . 2x : frontiere discrete                    .
  31 c .        .     .        . 3x : frontiere analytique                  .
  32 c .        .     .        . 5x : frontiere cao                         .
  33 c . nocman . e   . char*8 . nom de l'objet maillage calcul iteration n .
  34 c . nocmaf . e   . char*8 . nom de l'objet maillage frontiere discrete .
  35 c . ncafdg . e   . char*8 . nom de l'objet des frontieres discretes/CAO.
  36 c .        .     .        . nom des groupes                            .
  37 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  38 c . langue . e   .    1   . langue des messages                        .
  39 c .        .     .        . 1 : francais, 2 : anglais                  .
  40 c . codret . es  .    1   . code de retour des modules                 .
  41 c .        .     .        . 0 : pas de probleme                        .
  42 c .        .     .        . 2 : probleme avec la memoire               .
  43 c .        .     .        . 3 : probleme avec le fichier               .
  44 c .        .     .        . 5 : contenu incorrect                      .
  45 c ______________________________________________________________________
  46 c
  47 c====
  48 c 0. declarations et dimensionnement
  49 c====
  50 c
  51 c 0.1. ==> generalites
  52 c
  53       implicit none
  54       save
  55 c
  56       character*6 nompro
  57       parameter ( nompro = 'SFDEFG' )
  58 c
  59 #include "nblang.h"
  60 c
  61 c 0.2. ==> communs
  62 c
  63 #include "envex1.h"
  64 c
  65 #include "motcle.h"
  66 c
  67 c 0.3. ==> arguments
  68 c
  69       integer suifro
  70 c
  71       character*8 nocman, nocmaf, ncafdg
  72 c
  73       integer ulsort, langue, codret
  74 c
  75 c 0.4. ==> variables locales
  76 c
  77       integer iaux
  78 c
  79       integer nbf, nblign, nbgrmx
  80 c
  81       character*8 ncfami
  82       character*8 saux08
  83 c
  84       integer nbmess
  85       parameter ( nbmess = 10 )
  86       character*80 texte(nblang,nbmess)
  87 c
  88 c 0.5. ==> initialisations
  89 c ______________________________________________________________________
  90 c
  91 c====
  92 c 1. messages
  93 c====
  94 c
  95 #include "impr01.h"
  96 c
  97 #ifdef _DEBUG_HOMARD_
  98       write (ulsort,texte(langue,1)) 'Entree', nompro
  99       call dmflsh (iaux)
 100 #endif
 101 c
 102 #ifdef _DEBUG_HOMARD_
 103       write (ulsort,90002) 'suifro', suifro
 104       if ( mod(suifro,2).eq.0 ) then
 105         call gmprsx (nompro//' - maillage frontiere', nocmaf)
 106       else
 107         call gmprsx (nompro//' - maillage calcul', nocman)
 108       endif
 109       call gmprsx (nompro//' - groupes de la frontiere', ncafdg)
 110       call gmprsx (nompro//' - groupes de la frontiere',
 111      >             ncafdg//'.Table')
 112 #endif
 113 c
 114 #include "impr03.h"
 115 c====
 116 c 2. les structures
 117 c====
 118 c 2.1. ==> Allocation de la branche de la frontiere de taille egale au
 119 c          nombre de familles MED presentes
 120 c
 121       if ( mod(suifro,2).eq.0 ) then
 122         saux08 = nocmaf
 123       else
 124         saux08 = nocman
 125       endif
 126 #ifdef _DEBUG_HOMARD_
 127       call gmprsx ( nompro//' - saux08', saux08 )
 128 #endif
 129 c
 130 c 2.3.1. ==> Caracteristiques des familles du maillage de la frontiere
 131 c
 132       if ( codret.eq.0 ) then
 133 c
 134       call gmnomc ( saux08//'.Famille' , ncfami, codret )
 135 c
 136       endif
 137 c
 138       if ( codret.eq.0 ) then
 139 c
 140       call gmliat ( ncfami, 1, nbf, codret )
 141 c
 142 #ifdef _DEBUG_HOMARD_
 143       write (ulsort,90002) 'nbf', nbf
 144 #endif
 145 c
 146       endif
 147 c
 148       if ( codret.eq.0 ) then
 149 c
 150       call gmmod ( saux08//'.Frontier',
 151      >             iaux, 0, nbf, 1, 1, codret )
 152 c
 153       endif
 154 #ifdef _DEBUG_HOMARD_
 155       call gmprsx ( nompro, saux08//'.Frontier' )
 156 #endif
 157 c
 158 c====
 159 c 3. Les bords sont-ils definis par des groupes dans les donnees,
 160 c    ou par des groupes dans les familles du maillage de frontiere ?
 161 c====
 162 #ifdef _DEBUG_HOMARD_
 163       write (ulsort,90002) '3. Bords ; codret', codret
 164 #endif
 165 c
 166       if ( codret.eq.0 ) then
 167 c
 168 #ifdef _DEBUG_HOMARD_
 169       write (ulsort,texte(langue,3)) 'SFGROU', nompro
 170 #endif
 171       call sfgrou ( ncfami, ncafdg,
 172      >              nblign, nbgrmx,
 173      >              ulsort, langue, codret)
 174 c
 175 #ifdef _DEBUG_HOMARD_
 176       write (ulsort,90002) 'nblign', nblign
 177       write (ulsort,90002) 'nbgrmx', nbgrmx
 178       call gmprsx ( nompro, ncafdg )
 179 #endif
 180 c
 181       endif
 182 c
 183 c====
 184 c 4. Quand aucune ligne n'a ete definie dans le fichier de configuration
 185 c    on suivra toutes celles definies dans le maillage de la frontiere
 186 c====
 187 #ifdef _DEBUG_HOMARD_
 188       write (ulsort,90002) '4. ; codret', codret
 189 #endif
 190 c
 191       if ( nblign.eq.0 ) then
 192 c
 193 #ifdef _DEBUG_HOMARD_
 194       write (ulsort,90002) '4. 0 ligne ; codret', codret
 195 #endif
 196 c
 197         if ( codret.eq.0 ) then
 198 c
 199 #ifdef _DEBUG_HOMARD_
 200         write (ulsort,texte(langue,3)) 'SFGRFA', nompro
 201 #endif
 202         call sfgrfa ( saux08, ncafdg,
 203      >                nblign, nbf, nbgrmx,
 204      >                ulsort, langue, codret)
 205 c
 206         endif
 207 c
 208 c====
 209 c 5. Quand des lignes ont ete definies dans le fichier de configuration
 210 c    on eliminera toutes celles inconnues dans le maillage de la
 211 c    frontiere
 212 c====
 213 c
 214       else
 215 c
 216 #ifdef _DEBUG_HOMARD_
 217       write (ulsort,90015) '5.', nblign, 'lignes ; codret', codret
 218 #endif
 219 c
 220         if ( codret.eq.0 ) then
 221 c
 222 #ifdef _DEBUG_HOMARD_
 223         write (ulsort,texte(langue,3)) 'SFGRFB', nompro
 224 #endif
 225         call sfgrfb ( saux08, ncafdg,
 226      >                nblign, nbf, nbgrmx,
 227      >                ulsort, langue, codret)
 228 c
 229         endif
 230 c
 231       endif
 232 c
 233 #ifdef _DEBUG_HOMARD_
 234       call gmprsx ( nompro, ncafdg )
 235       call gmprsx ( nompro, ncafdg//'.Pointeur' )
 236       call gmprsx ( nompro, ncafdg//'.Taille' )
 237       call gmprsx ( nompro, ncafdg//'.Table' )
 238 #endif
 239 c
 240 c====
 241 c 6. la fin
 242 c====
 243 c
 244       if ( codret.ne.0 ) then
 245 c
 246 #include "envex2.h"
 247 c
 248       write (ulsort,texte(langue,1)) 'Sortie', nompro
 249       write (ulsort,texte(langue,2)) codret
 250 c
 251       endif
 252 c
 253 #ifdef _DEBUG_HOMARD_
 254       write (ulsort,texte(langue,1)) 'Sortie', nompro
 255       call dmflsh (iaux)
 256 #endif
 257 c
 258       end